diff --git a/A-INSTALL b/A-INSTALL
index cdfa1b9e5d4a6b8c29d0af113c6ddc0bd3faad58..7d0d2ad77ff178889189042e7a7db047c77c9946 100644
--- a/A-INSTALL
+++ b/A-INSTALL
@@ -1,8 +1,8 @@
#
# Version of PACKAGE MESONH "Open distribution"
-# PACK-MNH-V5-4-1
-# DATE : 20/07/2018
-# VERSION : MESONH MASDEV5_4 + BUG-1
+# PACK-MNH-V5-4-2
+# DATE : 03/04/2019
+# VERSION : MESONH MASDEV5_4 + BUG-2
#
# MAP
#
@@ -74,21 +74,21 @@
# ==========================================
#
# With your preferred web browser go to the MESONH WEB SITE
-#
+#
# http://mesonh.aero.obs-mip.fr/mesonh
# ---> Download
#
# or directly
#
-# http://mesonh.aero.obs-mip.fr/mesonh/dir_open/dir_MESONH/MNH-V5-4-1.tar.gz
+# http://mesonh.aero.obs-mip.fr/mesonh/dir_open/dir_MESONH/MNH-V5-4-2.tar.gz
#
-# Then untar the file "PACK-MNH-V5-4-1.tar.gz" where you want to.
+# Then untar the file "MNH-V5-4-2.tar.gz" where you want to.
# For example, in your home directory:
#
-
+
cd ~
-tar xvfz PACK-MNH-V5-4-1.tar.gz
-
+tar xvfz MNH-V5-4-2.tar.gz
+
#
# Process now to the chapter to configure the MesoNH package.
#
@@ -121,7 +121,7 @@ git --version
git lfs install
# that will set up some filters under the name "lfs" in the global Git
-# config file ($HOME/.gitconfig)
+# config file ($HOME/.gitconfig)
#
# b) Before cloning
# -----------------
@@ -167,10 +167,10 @@ git config --global http.sslverify false
# 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-1
+git lfs clone anongit@anongit_mesonh:/gitrepos/MNH-git_open_source-lfs.git -b MNH-54-branch MNH-V5-4-2
#
-# that will create the MNH-V5-4-1 directory containing a clone (copy) of the
+# 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
#
#
@@ -180,34 +180,34 @@ git lfs clone anongit@anongit_mesonh:/gitrepos/MNH-git_open_source-lfs.git -b MN
# 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 ).
#
-# To create your local branch corresponding to the V5-4-1 version, type:
+# To create your local branch corresponding to the V5-4-2 version, type:
#
-cd MNH-V5-4-1
-git checkout -b MYB-MNH-V5-4-1 PACK-MNH-V5-4-1
+cd MNH-V5-4-2
+git checkout -b MYB-MNH-V5-4-2 PACK-MNH-V5-4-2
#
-# MYB-MNH-V5-4-1 is the name of the local branch you created
+# MYB-MNH-V5-4-2 is the name of the local branch you created
# and
-# PACK-MNH-V5-4-1 is the remote/origin tag on which it is based.
+# PACK-MNH-V5-4-2 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-1", is announced.
+# Suppose that a new version, for example "PACK-MNH-V5-4-2", is announced.
#
# To see the differences with your working copy, do:
#
git fetch
-git diff HEAD PACK-MNH-V5-4-1
+git diff HEAD PACK-MNH-V5-4-2
#
# To go to the new version, you can, for example, create a new local branch:
#
-git checkout -b MYB-MNH-V5-4-1 PACK-MNH-V5-4-1
+git checkout -b MYB-MNH-V5-4-2 PACK-MNH-V5-4-2
#
# At any time, you can also check for "uptodate" changes in the Git branch
@@ -217,7 +217,7 @@ git checkout -b MYB-MNH-V5-4-1 PACK-MNH-V5-4-1
git fetch
git diff HEAD MNH-54-branch
-
+
#
# And, test this development (not yet official) version by going to this branch:
#
@@ -253,7 +253,7 @@ git clone anongit@anongit_mesonh:/gitrepos/MNH-DOC.git
# use the "./configure" script like this
#
-cd ~/MNH-V5-4-1/src
+cd ~/MNH-V5-4-2/src
./configure
. ../conf/profile_mesonh
@@ -261,14 +261,20 @@ cd ~/MNH-V5-4-1/src
# this will create a configuration file "profile_mesonh" with
# an extension reflecting the different "choices" made automatically
# to match the computer on which you want to install MESONH
-#
+#
# WARNING :
# =========
-# On GENCI & ECMWF & METEO/CNRM computers, the './configure' is tuned to
+# On GENCI & ECMWF & METEO/CNRM & METEO/DSI computers, the './configure' is tuned to
# identify the computer on which the command is used
# so the good compiler, MPI & netCDF libraries,...
# are automatically chosen
#
+# To install this version on one of these machines, go to the chapter
+#
+# => VI) COMPILING/INSTALLING ON GENCI & ECMWF & METEO COMPUTERS
+#
+# else follow the guidelines below.
+#
# /!\ This is not the case in your "own" personal Linux computer ...
# So is up to you to set the ARCH variable correctly
# ARCH = Fortran compiler to use,
@@ -298,7 +304,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-1.MPIAUTO.O2
+. ../conf/profile_mesonh.LXifort.MNH-V5-4-2.MPIAUTO.O2
#
# REM:
@@ -323,7 +329,7 @@ export OPTLEVEL=O2 # Compile in O2, 4 times faster then DEBUG, but less
# go to the directory "src"
#
-cd ~/MNH-V5-4-1/src
+cd ~/MNH-V5-4-2/src
#
# if you have not already configured your MESONH environment
@@ -488,7 +494,7 @@ export VER_USER=MY_MODIF
#
# as before load it & and compile with the command "make user"
-. ../conf/profile_mesnh...${VER_USER}...
+. ../conf/profile_mesonh...${VER_USER}...
make user
@@ -550,7 +556,7 @@ make examples
#
cd $WORKDIR
-cd MNH-V5-4-1/src
+cd MNH-V5-4-2/src
./configure
@@ -611,21 +617,63 @@ export ARCH=LXifort
...
-création du fichier --> ../conf/profile_mesonh-LXifortI4-MNH-V5-4-1-MPICRAY-O2
+creation du fichier --> ../conf/profile_mesonh-LXifortI4-MNH-V5-4-2-MPICRAY-O2
-# And for the compilation & example job , switch the ARCH variable to LXiort :
+# And for the compilation & example job , switch the ARCH variable to LXifort :
vi job_make_mesonh_CRAY_cca(job_make_examples_CRAY_cca)
ARCH=LXifort
#ARCH=LXcray # this is the default one
-. ../conf/profile_mesonh-${ARCH}I4-MNH-V5-4-1-MPICRAY-O2
+. ../conf/profile_mesonh-${ARCH}I4-MNH-V5-4-2-MPICRAY-O2
+
+#
+# - 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 :
+cd ~
+tar xvf $MESONH/pack_MNH-V5-4-2.tar.gz
+
+# run the "./configure" command :
+cd MNH-V5-4-2/src
+./configure
#
-# EXAMPLES ON GENCI & ECMWF PLATFORMS
-# ====================================
+# Due to limitation in time & memory on interactive connection
+# then compile the MESONH PACKAGE in batch mode with the job_make_mesonh_BullX file :
+
+sbatch job_make_mesonh_BullX
+
+# This job does : gmake -j 4
+# then : make installmaster
+
+# To run basic KTEST examples :
+
+sbatch job_make_examples_BullX
+
+# Step-2 : configure/compiling with VER_USER=...
+# ----------------------------------------------
+# In a new session set the variable "VER_USER" with the name of your "USER VERSION",
+# and run again the "./configure" command
+#
+
+export VER_USER=MY_MODIF
+./configure
+
+# this will regenerate the "profile-mesonh" file and a copy
+# of this with the extent "profile_mesonh...${VER_USER)..."
+#
+# in job_make_mesonh_user_BullX insert " export VER_USER=MY_MODIF "
+# then submit in batch mode
+
+sbatch job_make_mesonh_user_BullX
+
+#
+# EXAMPLES ON GENCI & ECMWF PLATFORMS & METEO COMPUTERS
+# =====================================================
#
# - At IDRIS
#
@@ -656,6 +704,12 @@ make examples
llsubmit job_make_examples_CRAY_cca
+#
+# - At Meteo-France DSI on beaufix or prolix
+#
+
+sbatch job_make_examples_BullX
+
#
# That's all for the basic INSTALLATION of the "MESONH PACKAGE"
#
@@ -710,7 +764,7 @@ scandollar
## OUTPUT ::
-># read default config file :: ---> CONF_DOLLAR=/home/escj/DEV64/PACK-MNH-V5-4-1/conf/post/confdollar_aeropc_default
+># read default config file :: ---> CONF_DOLLAR=/home/escj/DEV64/PACK-MNH-V5-4-2/conf/post/confdollar_aeropc_default
>#
># read user config file :: ---> CONFIG=confdollar
>#
@@ -732,7 +786,7 @@ scandollar 0*
## OUTPUT ::
>#
-># read default config file :: ---> CONF_DOLLAR=/home/escj/DEV64/PACK-MNH-V5-4-1/conf/post/confdollar_aeropc_default
+># read default config file :: ---> CONF_DOLLAR=/home/escj/DEV64/PACK-MNH-V5-4-2/conf/post/confdollar_aeropc_default
>#
># read user config file :: ---> CONFIG=confdollar
>#
@@ -806,22 +860,22 @@ cp -R 007_16janvier_scandollar /.../your_directory
#
# use this "profile_mesonh" :
-. /home/rech/mnh/rmnh007/DEV/MNH-V5-4-1/conf/profile_mesonh-SX8-MNH-V5-4-1-MPIAUTO-O4
+. /home/rech/mnh/rmnh007/DEV/MNH-V5-4-2/conf/profile_mesonh-SX8-MNH-V5-4-2-MPIAUTO-O4
# And the examples are here ( link to my $WORKDIR in actually )
-/home/rech/mnh/rmnh007/DEV/MNH-V5-4-1/MY_RUN/KTEST/007_16janvier_scandollar
+/home/rech/mnh/rmnh007/DEV/MNH-V5-4-2/MY_RUN/KTEST/007_16janvier_scandollar
#
# On vargas
# ---------
# use this "profile_mesonh" :
-. /workgpfs/rech/mnh/rmnh007/DEV/MNH-V5-4-1/conf/profile_mesonh-AIX64-MNH-V5-4-1-MPIAUTO-O2
+. /workgpfs/rech/mnh/rmnh007/DEV/MNH-V5-4-2/conf/profile_mesonh-AIX64-MNH-V5-4-2-MPIAUTO-O2
# and examples here :
-/workgpfs/rech/mnh/rmnh007/DEV/MNH-V5-4-1/MY_RUN/KTEST/007_16janvier_scandollar
+/workgpfs/rech/mnh/rmnh007/DEV/MNH-V5-4-2/MY_RUN/KTEST/007_16janvier_scandollar
#
# - At CINES on JADE :
@@ -829,11 +883,11 @@ cp -R 007_16janvier_scandollar /.../your_directory
#
# use
-. /work/escobar/DEV/MNH-V5-4-1/conf/profile_mesonh-LXifort-MNH-V5-4-1-MPIICE-O2
+. /work/escobar/DEV/MNH-V5-4-2/conf/profile_mesonh-LXifort-MNH-V5-4-2-MPIICE-O2
# and the exemples
-/work/escobar/DEV/MNH-V5-4-1/MY_RUN/KTEST/007_16janvier_scandollar
+/work/escobar/DEV/MNH-V5-4-2/MY_RUN/KTEST/007_16janvier_scandollar
#
# - At ECMWF on cxa :
@@ -841,11 +895,11 @@ cp -R 007_16janvier_scandollar /.../your_directory
#
# use
-. /c1a/ms_perm/au5/MNH-V5-4-1/conf/profile_mesonh-AIX64-MNH-V5-4-1-MPIAUTO-O2
+. /c1a/ms_perm/au5/MNH-V5-4-2/conf/profile_mesonh-AIX64-MNH-V5-4-2-MPIAUTO-O2
# and the examples
-/c1a/ms_perm/au5/MNH-V5-4-1/MY_RUN/KTEST/007_16janvier_scandollar
+/c1a/ms_perm/au5/MNH-V5-4-2/MY_RUN/KTEST/007_16janvier_scandollar
#
diff --git a/LIBTOOLS/lib/COMPRESS/src/compress.f90 b/LIBTOOLS/lib/COMPRESS/src/compress.f90
index 2bc2dfaf3afcef1c5dadadcd0053d18659904d51..950fdfb1739651d8208cb1e4b9ad24b2772da7cd 100644
--- a/LIBTOOLS/lib/COMPRESS/src/compress.f90
+++ b/LIBTOOLS/lib/COMPRESS/src/compress.f90
@@ -1,15 +1,13 @@
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$ $Date$
+!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.
!-----------------------------------------------------------------
SUBROUTINE COMPRESS_FIELD(XTAB,KX,KY,KNBTOT,KNBUSE)
USE MODD_COMPPAR
USE MODE_SEARCHGRP
-#ifdef NAGf95
USE,INTRINSIC :: IEEE_ARITHMETIC
-#endif
IMPLICIT NONE
@@ -38,17 +36,21 @@ INTEGER :: IEXTCOD
CHARACTER(LEN=8),PARAMETER :: KEYWORD='COMPRESS'
REAL,DIMENSION(KNBTOT) :: XWORKTAB
LOGICAL :: LUPREAL,LNAN
-#ifndef NAGf95
-LOGICAL, EXTERNAL :: IEEE_IS_NAN
-#endif
+logical :: gnansupport
ILEVNBELT = KX*KY
LUPREAL = .FALSE.
LNAN = .FALSE.
+if ( IEEE_SUPPORT_NAN( xtab(1)) ) then
+ gnansupport=.true.
+else
+ gnansupport=.false.
+end if
+
! Check for NAN and change Upper and Lower bound according to 32bits real limits.
DO JI=1,KNBTOT
- IF (IEEE_IS_NAN(XTAB(JI))) THEN
+ IF ( gnansupport .and. IEEE_IS_NAN(XTAB(JI)) ) THEN
XTAB(JI)=0.
LNAN = .TRUE.
ELSE IF (ABS(XTAB(JI)) > HUGE(1.0_4)) THEN
diff --git a/LIBTOOLS/lib/COMPRESS/src/ieee_is_nan.c b/LIBTOOLS/lib/COMPRESS/src/ieee_is_nan.c
deleted file mode 100644
index f8682fbdba4e1ae2c55900c9127279a6de445fb9..0000000000000000000000000000000000000000
--- a/LIBTOOLS/lib/COMPRESS/src/ieee_is_nan.c
+++ /dev/null
@@ -1,11 +0,0 @@
-#include <math.h>
-
-#ifdef NO_UNDERSCORE
-# define IEEE_IS_NAN ieee_is_nan
-#else
-# define IEEE_IS_NAN ieee_is_nan_
-#endif
-
-int IEEE_IS_NAN(double *x){
- return isnan(*x);
-}
diff --git a/LIBTOOLS/tools/lfi2cdf/src/lfi2cdf.f90 b/LIBTOOLS/tools/lfi2cdf/src/lfi2cdf.f90
index 3e0a8b2d75ab14e94b8bb20b0cddcc38ea04fff9..bb8534b6dedc4aa9b89775f7106dd6a45efef4ca 100644
--- a/LIBTOOLS/tools/lfi2cdf/src/lfi2cdf.f90
+++ b/LIBTOOLS/tools/lfi2cdf/src/lfi2cdf.f90
@@ -1,21 +1,22 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
program LFI2CDF
USE MODD_CONF, ONLY: CPROGRAM
USE MODD_CONFZ, ONLY: NB_PROCIO_R
USE MODD_DIM_n, ONLY: NIMAX_ll, NJMAX_ll, NKMAX
- USE MODD_IO_ll, ONLY: LVERB_OUTLST, LVERB_STDOUT, NIO_ABORT_LEVEL, NIO_VERB, NGEN_ABORT_LEVEL, NGEN_VERB
+ USE MODD_IO, ONLY: LVERB_OUTLST, LVERB_STDOUT, NIO_ABORT_LEVEL, NIO_VERB, NGEN_ABORT_LEVEL, NGEN_VERB
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
USE MODD_TIMEZ, ONLY: TIMEZ
- USE MODE_IO_ll, ONLY: INITIO_ll, SET_CONFIO_ll
USE MODE_FIELD, ONLY: INI_FIELD_LIST
+ USE MODE_IO, ONLY: IO_Init, IO_Config_set
USE mode_options
USE MODE_SPLITTINGZ_ll, ONLY: INI_PARAZ_ll
USE mode_util
+
USE MODI_VERSION
USE MODN_CONFIO, ONLY: LCDF4, LLFIOUT, LLFIREAD
@@ -43,7 +44,7 @@ program LFI2CDF
CPROGRAM = 'LFICDF'
- CALL INITIO_ll()
+ CALL IO_Init()
CALL VERSION
CALL INI_CST
@@ -73,17 +74,17 @@ program LFI2CDF
LCDF4 = .TRUE.
LLFIOUT = .FALSE.
LLFIREAD = .TRUE.
- CALL SET_CONFIO_ll()
+ CALL IO_Config_set()
ELSE IF (runmode == MODECDF2CDF) THEN
LCDF4 = .TRUE.
LLFIOUT = .FALSE.
LLFIREAD = .FALSE.
- CALL SET_CONFIO_ll()
+ CALL IO_Config_set()
ELSE
LCDF4 = .TRUE.
LLFIOUT = .TRUE.
LLFIREAD = .FALSE.
- CALL SET_CONFIO_ll()
+ CALL IO_Config_set()
END IF
CALL INI_FIELD_LIST(1)
diff --git a/LIBTOOLS/tools/lfi2cdf/src/mode_util.f90 b/LIBTOOLS/tools/lfi2cdf/src/mode_util.f90
index 0f55191e7867f722116c7cbe48987c428c26bdad..7a4d853e97417d32893df6b8ba3d94a9d8af2e8a 100644
--- a/LIBTOOLS/tools/lfi2cdf/src/mode_util.f90
+++ b/LIBTOOLS/tools/lfi2cdf/src/mode_util.f90
@@ -1,16 +1,22 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 07/02/2019: force TYPE to a known value for IO_FILE_ADD2LIST
+! P. Wautelet 10/04/2019: use IO_Err_handle_nc4 to handle netCDF errors
+!-----------------------------------------------------------------
MODULE mode_util
- USE MODD_IO_ll, ONLY: TFILE_ELT
- USE MODD_NETCDF, ONLY: DIMCDF, IDCDF_KIND
+ USE MODD_IO, ONLY: TFILE_ELT
+ USE MODD_NETCDF, ONLY: DIMCDF, CDFINT
USE MODD_PARAMETERS, ONLY: NLFIMAXCOMMENTLENGTH, NMNHNAMELGTMAX
+ use modd_precision, only: LFIINT
USE MODE_FIELD
- USE MODE_FMREAD
- USE MODE_FMWRIT
+ USE MODE_IO_FIELD_READ
+ USE MODE_IO_FIELD_WRITE
+ use mode_io_tools_nc4, only: IO_Err_handle_nc4
USE mode_options
@@ -45,8 +51,8 @@ MODULE mode_util
TYPE(DIMCDF),DIMENSION(:),ALLOCATABLE :: TDIMS ! Dimensions of the field
END TYPE workfield
- LOGICAL(KIND=LFI_INT), PARAMETER :: ltrue = .TRUE.
- LOGICAL(KIND=LFI_INT), PARAMETER :: lfalse = .FALSE.
+ LOGICAL(KIND=LFIINT), PARAMETER :: ltrue = .TRUE.
+ LOGICAL(KIND=LFIINT), PARAMETER :: lfalse = .FALSE.
CHARACTER(LEN=6) :: CPROGRAM_ORIG
@@ -56,7 +62,7 @@ CONTAINS
USE MODD_DIM_n, ONLY: NIMAX_ll, NJMAX_ll, NKMAX
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT, NGRIDUNKNOWN
- use mode_io_tools_nc4, only: io_guess_dimids_nc4
+ use mode_io_tools_nc4, only: IO_Dimids_guess_nc4
TYPE(TFILE_ELT),DIMENSION(:), INTENT(IN) :: infiles
TYPE(TFILE_ELT),DIMENSION(:), INTENT(IN) :: outfiles
@@ -82,9 +88,9 @@ CONTAINS
INTEGER :: leng
INTEGER :: IID, IRESP, IDATES, ICURDATE
INTEGER :: IDXDATE, IDXTIME
- INTEGER(KIND=LFI_INT) :: iresp2,ilu,ileng,ipos
- INTEGER(KIND=IDCDF_KIND) :: kcdf_id, kcdf_id2, var_id
- INTEGER(KIND=IDCDF_KIND) :: status
+ INTEGER(KIND=LFIINT) :: iresp2,ilu,ileng,ipos
+ INTEGER(KIND=CDFINT) :: kcdf_id, kcdf_id2, var_id
+ INTEGER(KIND=CDFINT) :: status
LOGICAL :: ladvan
LOGICAL :: GOK
TYPE(TLFIDATE),DIMENSION(MAXDATES) :: TLFIDATES
@@ -229,17 +235,18 @@ CONTAINS
tpreclist(tpreclist(ji)%tgt)%LSPLIT = .true.
END IF
ELSE
- CALL HANDLE_ERR(status,__LINE__)
+ if ( status /= NF90_NOERR ) &
+ call IO_Err_handle_nc4( status, 'parse_infiles', 'NF90_INQ_VARID', trim(yrecfm)//'0001' )
END IF
ELSE IF (status /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__)
+ call IO_Err_handle_nc4( status, 'parse_infiles', 'NF90_INQ_VARID', trim(yrecfm) )
ELSE
kcdf_id2 = kcdf_id
ENDIF
!
IF (status == NF90_NOERR) THEN
tpreclist(ji)%found = .true.
- CALL IO_GET_METADATA_NC4(kcdf_id2,var_id,tpreclist(ji))
+ CALL IO_Metadata_get_nc4(kcdf_id2,var_id,tpreclist(ji))
END IF
END IF
@@ -329,9 +336,10 @@ END DO
DO ji=1,nbvar_infile
var_id = ji
status = NF90_INQUIRE_VARIABLE(kcdf_id,var_id, name = tpreclist(ji)%name)
- IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
+ if ( status /= NF90_NOERR ) &
+ call IO_Err_handle_nc4( status, 'parse_infiles', 'NF90_INQUIRE_VARIABLE', tpreclist(ji)%name )
tpreclist(ji)%found = .TRUE.
- CALL IO_GET_METADATA_NC4(kcdf_id,var_id,tpreclist(ji))
+ CALL IO_Metadata_get_nc4(kcdf_id,var_id,tpreclist(ji))
END DO
END IF
@@ -372,13 +380,13 @@ END DO
! Determine TDIMS
IF (runmode==MODELFI2CDF) THEN
ALLOCATE(tpreclist(ji)%TDIMS(tpreclist(ji)%TFIELD%NDIMS))
- CALL IO_GUESS_DIMIDS_NC4(outfiles(idx_out)%TFILE,tpreclist(ji)%TFIELD,&
+ CALL IO_Dimids_guess_nc4(outfiles(idx_out)%TFILE,tpreclist(ji)%TFIELD,&
tpreclist(ji)%NSIZE,tpreclist(ji)%TDIMS,IRESP)
ELSE !If we read netCDF4, we already have all necessary data
!Special case for EMIS (only the first band is read/written) -> NDIMS reduced to 2
if(tpreclist(ji)%TFIELD%CMNHNAME=="EMIS") tpreclist(ji)%TFIELD%NDIMS = 2
- CALL IO_FILL_DIMS_NC4(outfiles(idx_out)%TFILE,tpreclist(ji),IRESP)
+ CALL IO_Dims_fill_nc4(outfiles(idx_out)%TFILE,tpreclist(ji),IRESP)
ENDIF
IF (IRESP/=0) THEN
CALL PRINT_MSG(NVERB_WARNING,'IO','parse_infiles','can not guess dimensions for '//tpreclist(ji)%TFIELD%CMNHNAME// &
@@ -406,14 +414,14 @@ END DO
! Determine TDIMS
CALL PRINT_MSG(NVERB_DEBUG,'IO','parse_infiles',tpreclist(ji)%TFIELD%CMNHNAME//': try 3D')
tpreclist(ji)%TFIELD%NDIMS = 3 !Try with 3D
- CALL IO_GUESS_DIMIDS_NC4(outfiles(idx_out)%TFILE,tpreclist(ji)%TFIELD,&
+ 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
CALL PRINT_MSG(NVERB_DEBUG,'IO','parse_infiles',tpreclist(ji)%TFIELD%CMNHNAME//': try 2D')
!Try again with 2D
tpreclist(ji)%TFIELD%NDIMS = 2
- CALL IO_GUESS_DIMIDS_NC4(outfiles(idx_out)%TFILE,tpreclist(ji)%TFIELD,&
+ CALL IO_Dimids_guess_nc4(outfiles(idx_out)%TFILE,tpreclist(ji)%TFIELD,&
tpreclist(ji)%NSIZE,tpreclist(ji)%TDIMS,IRESP)
END IF
!
@@ -422,7 +430,7 @@ END DO
!Try again with 1D
tpreclist(ji)%TFIELD%NDIMS = 1
tpreclist(ji)%TFIELD%CDIR = '--' !Assumption...
- CALL IO_GUESS_DIMIDS_NC4(outfiles(idx_out)%TFILE,tpreclist(ji)%TFIELD,&
+ CALL IO_Dimids_guess_nc4(outfiles(idx_out)%TFILE,tpreclist(ji)%TFIELD,&
tpreclist(ji)%NSIZE,tpreclist(ji)%TDIMS,IRESP)
END IF
!
@@ -471,7 +479,7 @@ END DO
tpreclist(ji)%TFIELD%CDIR = 'XY' !Assumption
END IF
- CALL IO_FILL_DIMS_NC4(outfiles(idx_out)%TFILE,tpreclist(ji),IRESP)
+ CALL IO_Dims_fill_nc4(outfiles(idx_out)%TFILE,tpreclist(ji),IRESP)
IF (tpreclist(ji)%NDIMS_FILE>0) THEN
IF (tpreclist(ji)%CDIMNAMES_FILE(tpreclist(ji)%NDIMS_FILE)=='time') THEN
@@ -608,19 +616,10 @@ END DO
END IF !nbvar_calc>0
END SUBROUTINE parse_infiles
-
- SUBROUTINE HANDLE_ERR(status,line)
- INTEGER :: status,line
-
- IF (status /= NF90_NOERR) THEN
- PRINT *, 'line ',line,': ',NF90_STRERROR(status)
- STOP
- END IF
- END SUBROUTINE HANDLE_ERR
SUBROUTINE def_ncdf(infiles,outfiles,KNFILES_OUT)
USE MODD_CONF, ONLY: NMNHVERSION
- use mode_io_write_nc4, only: io_write_header_nc4
+ use mode_io_write_nc4, only: IO_Header_write_nc4
TYPE(TFILE_ELT),DIMENSION(:),INTENT(IN) :: infiles
TYPE(TFILE_ELT),DIMENSION(:),INTENT(IN) :: outfiles
@@ -631,8 +630,8 @@ END DO
CHARACTER(LEN=16) :: YMNHVERSION
CHARACTER(LEN=:),ALLOCATABLE :: YHISTORY
INTEGER :: ilen, ji
- INTEGER(KIND=IDCDF_KIND) :: status
- INTEGER(KIND=IDCDF_KIND) :: kcdf_id
+ INTEGER(KIND=CDFINT) :: status
+ INTEGER(KIND=CDFINT) :: kcdf_id
CALL PRINT_MSG(NVERB_DEBUG,'IO','def_ncdf','called')
@@ -654,7 +653,7 @@ END DO
DO ji = 1,KNFILES_OUT
kcdf_id = outfiles(ji)%TFILE%NNCID
status = NF90_PUT_ATT(kcdf_id,NF90_GLOBAL,'history',YHISTORY)
- IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
+ if ( status /= NF90_NOERR ) call IO_Err_handle_nc4( status, 'def_ncdf', 'NF90_PUT_ATT', 'history' )
END DO
END IF
@@ -663,11 +662,11 @@ END DO
kcdf_id = outfiles(ji)%TFILE%NNCID
! global attributes
- CALL IO_WRITE_HEADER_NC4(outfiles(ji)%TFILE)
+ CALL IO_Header_write_nc4(outfiles(ji)%TFILE)
!
WRITE(YMNHVERSION,"( I0,'.',I0,'.',I0 )" ) NMNHVERSION(1),NMNHVERSION(2),NMNHVERSION(3)
status = NF90_PUT_ATT(kcdf_id,NF90_GLOBAL,'lfi2cdf_version',TRIM(YMNHVERSION))
- IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
+ if ( status /= NF90_NOERR ) call IO_Err_handle_nc4( status, 'def_ncdf', 'NF90_PUT_ATT', 'lfi2cdf_version' )
END DO
END SUBROUTINE def_ncdf
@@ -685,7 +684,7 @@ END DO
INTEGER :: IDIMS
INTEGER :: INSRC
INTEGER :: ISRC
- INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IDIMLEN
+ INTEGER(KIND=CDFINT),DIMENSION(NF90_MAX_VAR_DIMS) :: IDIMLEN
logical,dimension(knaf) :: gtimedep_in, gtimedep_out
CHARACTER(LEN=:), ALLOCATABLE :: YTAB0D
@@ -734,15 +733,15 @@ END DO
CASE (0)
ALLOCATE(ITAB1D(1))
IF (tpreclist(ji)%calc) ALLOCATE(ITAB1D2(1))
- CALL IO_READ_FIELD(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB1D(1))
+ CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB1D(1))
CASE (1)
ALLOCATE(ITAB1D(IDIMLEN(1)))
IF (tpreclist(ji)%calc) ALLOCATE(ITAB1D2(IDIMLEN(1)))
- CALL IO_READ_FIELD(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB1D)
+ CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB1D)
CASE (2)
ALLOCATE(ITAB2D(IDIMLEN(1),IDIMLEN(2)))
IF (tpreclist(ji)%calc) ALLOCATE(ITAB2D2(IDIMLEN(1),IDIMLEN(2)))
- CALL IO_READ_FIELD(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB2D)
+ CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB2D)
CASE DEFAULT
CALL PRINT_MSG(NVERB_WARNING,'IO','fill_files','too many dimensions for ' &
//TRIM(tpreclist(ISRC)%name)//' => ignored')
@@ -755,13 +754,13 @@ END DO
SELECT CASE(IDIMS)
CASE (0)
- CALL IO_READ_FIELD(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB1D2(1))
+ CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB1D2(1))
ITAB1D(1) = ITAB1D(1) + ITAB1D2(1)
CASE (1)
- CALL IO_READ_FIELD(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB1D2)
+ CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB1D2)
ITAB1D(:) = ITAB1D(:) + ITAB1D2(:)
CASE (2)
- CALL IO_READ_FIELD(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB2D2)
+ CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB2D2)
ITAB2D(:,:) = ITAB2D(:,:) + ITAB2D2(:,:)
END SELECT
END DO
@@ -769,15 +768,15 @@ END DO
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_out(ji)
SELECT CASE(IDIMS)
CASE (0)
- CALL IO_WRITE_FIELD(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,ITAB1D(1))
+ CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,ITAB1D(1))
DEALLOCATE(ITAB1D)
IF (tpreclist(ji)%calc) DEALLOCATE(ITAB1D2)
CASE (1)
- CALL IO_WRITE_FIELD(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,ITAB1D)
+ CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,ITAB1D)
DEALLOCATE(ITAB1D)
IF (tpreclist(ji)%calc) DEALLOCATE(ITAB1D2)
CASE (2)
- CALL IO_WRITE_FIELD(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,ITAB2D)
+ CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,ITAB2D)
DEALLOCATE(ITAB2D)
IF (tpreclist(ji)%calc) DEALLOCATE(ITAB2D2)
END SELECT
@@ -790,15 +789,15 @@ END DO
SELECT CASE(IDIMS)
CASE (0)
ALLOCATE(GTAB1D(1))
- CALL IO_READ_FIELD (INFILES(1)%TFILE, tpreclist(ji)%TFIELD,GTAB1D(1))
+ CALL IO_Field_read (INFILES(1)%TFILE, tpreclist(ji)%TFIELD,GTAB1D(1))
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_out(ji)
- CALL IO_WRITE_FIELD(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,GTAB1D(1))
+ CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,GTAB1D(1))
DEALLOCATE(GTAB1D)
CASE (1)
ALLOCATE(GTAB1D(IDIMLEN(1)))
- CALL IO_READ_FIELD (INFILES(1)%TFILE, tpreclist(ji)%TFIELD,GTAB1D)
+ CALL IO_Field_read (INFILES(1)%TFILE, tpreclist(ji)%TFIELD,GTAB1D)
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_out(ji)
- CALL IO_WRITE_FIELD(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,GTAB1D)
+ CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,GTAB1D)
DEALLOCATE(GTAB1D)
CASE DEFAULT
CALL PRINT_MSG(NVERB_WARNING,'IO','fill_files','too many dimensions for ' &
@@ -823,23 +822,23 @@ END DO
CASE (0)
ALLOCATE(XTAB1D(1))
IF (tpreclist(ji)%calc) ALLOCATE(XTAB1D2(1))
- CALL IO_READ_FIELD(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB1D(1))
+ CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB1D(1))
CASE (1)
ALLOCATE(XTAB1D(IDIMLEN(1)))
IF (tpreclist(ji)%calc) ALLOCATE(XTAB1D2(IDIMLEN(1)))
- CALL IO_READ_FIELD(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB1D)
+ CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB1D)
CASE (2)
ALLOCATE(XTAB2D(IDIMLEN(1),IDIMLEN(2)))
IF (tpreclist(ji)%calc) ALLOCATE(XTAB2D2(IDIMLEN(1),IDIMLEN(2)))
- CALL IO_READ_FIELD(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB2D)
+ CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB2D)
CASE (3)
ALLOCATE(XTAB3D(IDIMLEN(1),IDIMLEN(2),IDIMLEN(3)))
IF (tpreclist(ji)%calc) ALLOCATE(XTAB3D2(IDIMLEN(1),IDIMLEN(2),IDIMLEN(3)))
- CALL IO_READ_FIELD(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB3D)
+ CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB3D)
CASE (4)
ALLOCATE(XTAB4D(IDIMLEN(1),IDIMLEN(2),IDIMLEN(3),IDIMLEN(4)))
IF (tpreclist(ji)%calc) ALLOCATE(XTAB4D2(IDIMLEN(1),IDIMLEN(2),IDIMLEN(3),IDIMLEN(4)))
- CALL IO_READ_FIELD(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB4D)
+ CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB4D)
CASE DEFAULT
CALL PRINT_MSG(NVERB_WARNING,'IO','fill_files','too many dimensions for ' &
//TRIM(tpreclist(ISRC)%name)//' => ignored')
@@ -852,19 +851,19 @@ END DO
SELECT CASE(IDIMS)
CASE (0)
- CALL IO_READ_FIELD(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB1D2(1))
+ CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB1D2(1))
XTAB1D(1) = XTAB1D(1) + XTAB1D2(1)
CASE (1)
- CALL IO_READ_FIELD(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB1D2)
+ CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB1D2)
XTAB1D(:) = XTAB1D(:) + XTAB1D2(:)
CASE (2)
- CALL IO_READ_FIELD(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB2D2)
+ CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB2D2)
XTAB2D(:,:) = XTAB2D(:,:) + XTAB2D2(:,:)
CASE (3)
- CALL IO_READ_FIELD(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB3D2)
+ CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB3D2)
XTAB3D(:,:,:) = XTAB3D(:,:,:) + XTAB3D2(:,:,:)
CASE (4)
- CALL IO_READ_FIELD(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB4D2)
+ CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB4D2)
XTAB4D(:,:,:,:) = XTAB4D(:,:,:,:) + XTAB4D2(:,:,:,:)
END SELECT
END DO
@@ -872,23 +871,23 @@ END DO
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_out(ji)
SELECT CASE(IDIMS)
CASE (0)
- CALL IO_WRITE_FIELD(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,XTAB1D(1))
+ CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,XTAB1D(1))
DEALLOCATE(XTAB1D)
IF (tpreclist(ji)%calc) DEALLOCATE(XTAB1D2)
CASE (1)
- CALL IO_WRITE_FIELD(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,XTAB1D)
+ CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,XTAB1D)
DEALLOCATE(XTAB1D)
IF (tpreclist(ji)%calc) DEALLOCATE(XTAB1D2)
CASE (2)
- CALL IO_WRITE_FIELD(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,XTAB2D)
+ CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,XTAB2D)
DEALLOCATE(XTAB2D)
IF (tpreclist(ji)%calc) DEALLOCATE(XTAB2D2)
CASE (3)
- CALL IO_WRITE_FIELD(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,XTAB3D)
+ CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,XTAB3D)
DEALLOCATE(XTAB3D)
IF (tpreclist(ji)%calc) DEALLOCATE(XTAB3D2)
CASE (4)
- CALL IO_WRITE_FIELD(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,XTAB4D)
+ CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,XTAB4D)
DEALLOCATE(XTAB4D)
IF (tpreclist(ji)%calc) DEALLOCATE(XTAB4D2)
END SELECT
@@ -905,9 +904,9 @@ END DO
ALLOCATE(CHARACTER(LEN=tpreclist(ji)%NSIZE)::YTAB0D)
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_in(ji)
- CALL IO_READ_FIELD (INFILES(1)%TFILE, tpreclist(ji)%TFIELD,YTAB0D)
+ CALL IO_Field_read (INFILES(1)%TFILE, tpreclist(ji)%TFIELD,YTAB0D)
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_out(ji)
- CALL IO_WRITE_FIELD(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,YTAB0D)
+ CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,YTAB0D)
DEALLOCATE(YTAB0D)
@@ -920,9 +919,9 @@ END DO
CYCLE
END IF
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_in(ji)
- CALL IO_READ_FIELD (INFILES(1)%TFILE, tpreclist(ji)%TFIELD%CMNHNAME,TZDATE)
+ CALL IO_Field_read (INFILES(1)%TFILE, tpreclist(ji)%TFIELD%CMNHNAME,TZDATE)
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_out(ji)
- CALL IO_WRITE_FIELD(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,TZDATE)
+ CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,TZDATE)
CASE default
@@ -944,12 +943,12 @@ END DO
USE MODD_DIM_n, ONLY: NIMAX_ll, NJMAX_ll, NKMAX
USE MODD_GRID, ONLY: XBETA, XRPK, XLAT0, XLON0, XLATORI, XLONORI
USE MODD_GRID_n, ONLY: LSLEVE, XXHAT, XYHAT, XZHAT
- USE MODD_IO_ll, ONLY: LIOCDF4
+ USE MODD_IO, ONLY: LIOCDF4
USE MODD_PARAMETERS, ONLY: JPHEXT
USE MODD_PARAMETERS_ll, ONLY: JPHEXT_ll=>JPHEXT, JPVEXT_ll=>JPVEXT
USE MODD_TIME_n, ONLY: TDTCUR, TDTMOD
- USE MODE_FM, ONLY: IO_FILE_OPEN_ll, IO_FILE_CLOSE_ll
+ USE MODE_IO_FILE, ONLY: IO_FILE_OPEN, IO_FILE_CLOSE
USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST
TYPE(TFILE_ELT),DIMENSION(:),INTENT(OUT) :: infiles
@@ -961,10 +960,10 @@ END DO
TYPE(option),DIMENSION(:), INTENT(IN) :: options
INTEGER, INTENT(IN) :: runmode
- INTEGER :: idx, IRESP2
- INTEGER(KIND=IDCDF_KIND) :: omode
- INTEGER(KIND=IDCDF_KIND) :: status
- INTEGER(KIND=LFI_INT) :: ilu,iresp
+ INTEGER :: idx, IRESP2
+ INTEGER(KIND=CDFINT) :: omode
+ INTEGER(KIND=CDFINT) :: status
+ INTEGER(KIND=LFIINT) :: ilu,iresp
CALL PRINT_MSG(NVERB_DEBUG,'IO','OPEN_FILES','called')
@@ -977,17 +976,17 @@ END DO
!
! NetCDF
!
- CALL IO_FILE_ADD2LIST(INFILES(1)%TFILE,HINFILE,'UNKNOWN','READ',HFORMAT='NETCDF4')
- CALL IO_FILE_OPEN_ll(INFILES(1)%TFILE)
+ CALL IO_FILE_ADD2LIST(INFILES(1)%TFILE,HINFILE,'MNH','READ',HFORMAT='NETCDF4')
+ CALL IO_FILE_OPEN(INFILES(1)%TFILE)
nbvar_infile = INFILES(1)%TFILE%NNCNAR
ELSE
!
! LFI
!
- CALL IO_FILE_ADD2LIST(INFILES(1)%TFILE,HINFILE,'UNKNOWN','READ', &
+ CALL IO_FILE_ADD2LIST(INFILES(1)%TFILE,HINFILE,'MNH','READ', &
HFORMAT='LFI',KLFIVERB=0)
- CALL IO_FILE_OPEN_ll(INFILES(1)%TFILE)
+ CALL IO_FILE_OPEN(INFILES(1)%TFILE)
ilu = INFILES(1)%TFILE%NLFIFLU
@@ -995,54 +994,54 @@ END DO
IF (options(OPTLIST)%set) THEN
CALL LFILAF(iresp,ilu,lfalse)
- CALL IO_FILE_CLOSE_ll(INFILES(1)%TFILE)
+ CALL IO_FILE_CLOSE(INFILES(1)%TFILE)
return
END IF
END IF
!
- !Read problem dimensions and some grid variables (needed to determine domain size and also by IO_FILE_OPEN_ll to create netCDF files)
- CALL IO_READ_FIELD(INFILES(1)%TFILE,'JPHEXT',JPHEXT)
+ !Read problem dimensions and some grid variables (needed to determine domain size and also by IO_FILE_OPEN to create netCDF files)
+ CALL IO_Field_read(INFILES(1)%TFILE,'JPHEXT',JPHEXT)
JPHEXT_ll = JPHEXT
JPVEXT_ll = JPVEXT
!
ALLOCATE(NIMAX_ll,NJMAX_ll,NKMAX)
- CALL IO_READ_FIELD(INFILES(1)%TFILE,'IMAX',NIMAX_ll)
- CALL IO_READ_FIELD(INFILES(1)%TFILE,'JMAX',NJMAX_ll)
- CALL IO_READ_FIELD(INFILES(1)%TFILE,'KMAX',NKMAX,IRESP2)
+ CALL IO_Field_read(INFILES(1)%TFILE,'IMAX',NIMAX_ll)
+ CALL IO_Field_read(INFILES(1)%TFILE,'JMAX',NJMAX_ll)
+ CALL IO_Field_read(INFILES(1)%TFILE,'KMAX',NKMAX,IRESP2)
IF (IRESP2/=0) NKMAX = 0
!
- CALL IO_READ_FIELD(INFILES(1)%TFILE,'PROGRAM',CPROGRAM_ORIG)
+ CALL IO_Field_read(INFILES(1)%TFILE,'PROGRAM',CPROGRAM_ORIG)
!
ALLOCATE(CSTORAGE_TYPE)
- CALL IO_READ_FIELD(INFILES(1)%TFILE,'STORAGE_TYPE',CSTORAGE_TYPE)
+ CALL IO_Field_read(INFILES(1)%TFILE,'STORAGE_TYPE',CSTORAGE_TYPE)
!
ALLOCATE(XXHAT(NIMAX_ll+2*JPHEXT))
- CALL IO_READ_FIELD(INFILES(1)%TFILE,'XHAT',XXHAT)
+ CALL IO_Field_read(INFILES(1)%TFILE,'XHAT',XXHAT)
ALLOCATE(XYHAT(NJMAX_ll+2*JPHEXT))
- CALL IO_READ_FIELD(INFILES(1)%TFILE,'YHAT',XYHAT)
- CALL IO_READ_FIELD(INFILES(1)%TFILE,'CARTESIAN',LCARTESIAN)
+ CALL IO_Field_read(INFILES(1)%TFILE,'YHAT',XYHAT)
+ CALL IO_Field_read(INFILES(1)%TFILE,'CARTESIAN',LCARTESIAN)
!
- CALL IO_READ_FIELD(INFILES(1)%TFILE,'LAT0',XLAT0)
- CALL IO_READ_FIELD(INFILES(1)%TFILE,'LON0',XLON0)
- CALL IO_READ_FIELD(INFILES(1)%TFILE,'BETA',XBETA)
+ CALL IO_Field_read(INFILES(1)%TFILE,'LAT0',XLAT0)
+ CALL IO_Field_read(INFILES(1)%TFILE,'LON0',XLON0)
+ CALL IO_Field_read(INFILES(1)%TFILE,'BETA',XBETA)
!
IF (.NOT.LCARTESIAN) THEN
- CALL IO_READ_FIELD(INFILES(1)%TFILE,'RPK', XRPK)
- CALL IO_READ_FIELD(INFILES(1)%TFILE,'LATORI',XLATORI)
- CALL IO_READ_FIELD(INFILES(1)%TFILE,'LONORI',XLONORI)
+ CALL IO_Field_read(INFILES(1)%TFILE,'RPK', XRPK)
+ CALL IO_Field_read(INFILES(1)%TFILE,'LATORI',XLATORI)
+ CALL IO_Field_read(INFILES(1)%TFILE,'LONORI',XLONORI)
ENDIF
!
IF (TRIM(CPROGRAM_ORIG)/='PGD' .AND. TRIM(CPROGRAM_ORIG)/='NESPGD' .AND. TRIM(CPROGRAM_ORIG)/='ZOOMPG' &
.AND. .NOT.(TRIM(CPROGRAM_ORIG)=='REAL' .AND. CSTORAGE_TYPE=='SU') ) THEN !condition to detect PREP_SURFEX
ALLOCATE(XZHAT(NKMAX+2*JPVEXT))
- CALL IO_READ_FIELD(INFILES(1)%TFILE,'ZHAT',XZHAT)
+ CALL IO_Field_read(INFILES(1)%TFILE,'ZHAT',XZHAT)
ALLOCATE(LSLEVE)
- CALL IO_READ_FIELD(INFILES(1)%TFILE,'SLEVE',LSLEVE)
+ CALL IO_Field_read(INFILES(1)%TFILE,'SLEVE',LSLEVE)
ALLOCATE(TDTMOD)
- CALL IO_READ_FIELD(INFILES(1)%TFILE,'DTMOD',TDTMOD,IRESP2)
+ CALL IO_Field_read(INFILES(1)%TFILE,'DTMOD',TDTMOD,IRESP2)
IF(IRESP2/=0) DEALLOCATE(TDTMOD)
ALLOCATE(TDTCUR)
- CALL IO_READ_FIELD(INFILES(1)%TFILE,'DTCUR',TDTCUR,IRESP2)
+ CALL IO_Field_read(INFILES(1)%TFILE,'DTCUR',TDTCUR,IRESP2)
IF(IRESP2/=0) DEALLOCATE(TDTCUR)
END IF
!
@@ -1056,9 +1055,9 @@ END DO
KNFILES_OUT = KNFILES_OUT + 1
idx = KNFILES_OUT
- CALL IO_FILE_ADD2LIST(outfiles(idx)%TFILE,HOUTFILE,'UNKNOWN','WRITE', &
+ CALL IO_FILE_ADD2LIST(outfiles(idx)%TFILE,HOUTFILE,'MNH','WRITE', &
HFORMAT='NETCDF4',OOLD=.TRUE.)
- CALL IO_FILE_OPEN_ll(outfiles(idx)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)
+ CALL IO_FILE_OPEN(outfiles(idx)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)
IF (options(OPTCOMPRESS)%set) THEN
outfiles(idx)%tfile%LNCCOMPRESS = .TRUE.
@@ -1070,7 +1069,7 @@ END DO
END IF
status = NF90_SET_FILL(outfiles(idx)%TFILE%NNCID,NF90_NOFILL,omode)
- IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
+ if ( status /= NF90_NOERR ) call IO_Err_handle_nc4( status, 'OPEN_FILES', 'NF90_SET_FILL', '' )
END IF ! .NOT.osplit
ELSE
!
@@ -1078,10 +1077,10 @@ END DO
!
KNFILES_OUT = KNFILES_OUT + 1
idx = KNFILES_OUT
- CALL IO_FILE_ADD2LIST(outfiles(idx)%TFILE,houtfile,'UNKNOWN','WRITE', &
+ CALL IO_FILE_ADD2LIST(outfiles(idx)%TFILE,houtfile,'MNH','WRITE', &
HFORMAT='LFI',KLFIVERB=0,OOLD=.TRUE.)
LIOCDF4 = .FALSE. !Necessary to open correctly the LFI file
- CALL IO_FILE_OPEN_ll(outfiles(idx)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)
+ CALL IO_FILE_OPEN(outfiles(idx)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)
LIOCDF4 = .TRUE.
END IF
!
@@ -1090,9 +1089,9 @@ END DO
KNFILES_OUT = KNFILES_OUT + 1
idx = KNFILES_OUT
- CALL IO_FILE_ADD2LIST(outfiles(idx)%TFILE,'dummy_file','UNKNOWN','WRITE', &
+ CALL IO_FILE_ADD2LIST(outfiles(idx)%TFILE,'dummy_file','MNH','WRITE', &
HFORMAT='NETCDF4',OOLD=.TRUE.)
- CALL IO_FILE_OPEN_ll(outfiles(idx)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)
+ CALL IO_FILE_OPEN(outfiles(idx)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)
END IF
PRINT *,'--> Converted to file: ', TRIM(houtfile)
@@ -1100,7 +1099,7 @@ END DO
END SUBROUTINE OPEN_FILES
SUBROUTINE OPEN_SPLIT_NCFILES_OUT(outfiles,KNFILES_OUT,houtfile,nbvar,options)
- USE MODE_FM, ONLY: IO_FILE_OPEN_ll
+ USE MODE_IO_FILE, ONLY: IO_FILE_OPEN
USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST
TYPE(TFILE_ELT),DIMENSION(:), INTENT(INOUT) :: outfiles
@@ -1114,8 +1113,8 @@ END DO
CHARACTER(LEN=NMNHNAMELGTMAX),DIMENSION(nbvar) :: YVARS
INTEGER :: ji
INTEGER :: idx1, idx2
- INTEGER(KIND=IDCDF_KIND) :: status
- INTEGER(KIND=IDCDF_KIND) :: omode
+ INTEGER(KIND=CDFINT) :: status
+ INTEGER(KIND=CDFINT) :: omode
CALL PRINT_MSG(NVERB_DEBUG,'IO','OPEN_SPLIT_NCFILES_OUT','called')
@@ -1145,9 +1144,9 @@ END DO
DO ji = 1,nbvar
filename = trim(houtfile)//'.'//TRIM(YVARS(ji))
- CALL IO_FILE_ADD2LIST(outfiles(ji)%TFILE,filename,'UNKNOWN','WRITE', &
+ CALL IO_FILE_ADD2LIST(outfiles(ji)%TFILE,filename,'MNH','WRITE', &
HFORMAT='NETCDF4')
- CALL IO_FILE_OPEN_ll(outfiles(ji)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)
+ CALL IO_FILE_OPEN(outfiles(ji)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)
IF (options(OPTCOMPRESS)%set) THEN
outfiles(ji)%tfile%LNCCOMPRESS = .TRUE.
@@ -1159,13 +1158,13 @@ END DO
END IF
status = NF90_SET_FILL(outfiles(ji)%TFILE%NNCID,NF90_NOFILL,omode)
- IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
+ if ( status /= NF90_NOERR ) call IO_Err_handle_nc4( status, 'OPEN_SPLIT_NCFILES_OUT', 'NF90_SET_FILL', '' )
END DO
END SUBROUTINE OPEN_SPLIT_NCFILES_OUT
SUBROUTINE CLOSE_FILES(filelist,KNFILES)
- USE MODE_FM, ONLY: IO_FILE_CLOSE_ll
+ USE MODE_IO_FILE, ONLY: IO_FILE_CLOSE
TYPE(TFILE_ELT),DIMENSION(:),INTENT(INOUT) :: filelist
INTEGER, INTENT(IN) :: KNFILES
@@ -1176,30 +1175,30 @@ END DO
CALL PRINT_MSG(NVERB_DEBUG,'IO','CLOSE_FILES','called')
DO ji=1,KNFILES
- IF (filelist(ji)%TFILE%LOPENED) CALL IO_FILE_CLOSE_ll(filelist(ji)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)
+ IF (filelist(ji)%TFILE%LOPENED) CALL IO_FILE_CLOSE(filelist(ji)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)
END DO
END SUBROUTINE CLOSE_FILES
- SUBROUTINE IO_GET_METADATA_NC4(KFILE_ID,KVAR_ID,TPREC)
+ SUBROUTINE IO_Metadata_get_nc4(KFILE_ID,KVAR_ID,TPREC)
USE MODD_DIM_n, ONLY: NKMAX
USE MODD_PARAMETERS, ONLY: JPVEXT
- INTEGER, INTENT(IN) :: KFILE_ID
- INTEGER, INTENT(IN) :: KVAR_ID
- TYPE(workfield),INTENT(INOUT) :: TPREC
+ INTEGER(KIND=CDFINT), INTENT(IN) :: KFILE_ID
+ INTEGER(KIND=CDFINT), INTENT(IN) :: KVAR_ID
+ TYPE(workfield), INTENT(INOUT) :: TPREC
INTEGER :: ILENG
INTEGER :: JDIM
- INTEGER(KIND=IDCDF_KIND) :: ISTATUS
- INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IDIMS_ID
+ INTEGER(KIND=CDFINT) :: ISTATUS
+ INTEGER(KIND=CDFINT),DIMENSION(NF90_MAX_VAR_DIMS) :: IDIMS_ID
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_GET_METADATA_NC4','called')
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Metadata_get_nc4','called')
ISTATUS = NF90_INQUIRE_VARIABLE(KFILE_ID,KVAR_ID,NDIMS = TPREC%NDIMS_FILE, &
XTYPE = TPREC%NTYPE_FILE, DIMIDS = IDIMS_ID)
- IF (ISTATUS /= NF90_NOERR) CALL HANDLE_ERR(ISTATUS,__LINE__)
+ if ( istatus /= NF90_NOERR ) call IO_Err_handle_nc4( istatus, 'IO_Metadata_get_nc4', 'NF90_INQUIRE_VARIABLE', '' )
IF (.NOT.TPREC%LSPLIT) THEN
ALLOCATE(TPREC%NDIMSIZES_FILE(TPREC%NDIMS_FILE))
@@ -1219,7 +1218,7 @@ END DO
ISTATUS = NF90_INQUIRE_DIMENSION(KFILE_ID,IDIMS_ID(JDIM), &
len = TPREC%NDIMSIZES_FILE(JDIM), &
name = TPREC%CDIMNAMES_FILE(JDIM) )
- IF (ISTATUS /= NF90_NOERR) CALL HANDLE_ERR(ISTATUS,__LINE__)
+ if ( istatus /= NF90_NOERR ) call IO_Err_handle_nc4( istatus, 'IO_Metadata_get_nc4', 'NF90_INQUIRE_DIMENSION', '' )
ILENG = ILENG*TPREC%NDIMSIZES_FILE(JDIM)
END DO
@@ -1259,12 +1258,12 @@ END DO
ISTATUS = NF90_GET_ATT(KFILE_ID,KVAR_ID,'units',TPREC%CUNITS_FILE)
IF (ISTATUS /= NF90_NOERR) TPREC%CUNITS_FILE = ''
- END SUBROUTINE IO_GET_METADATA_NC4
+ END SUBROUTINE IO_Metadata_get_nc4
- SUBROUTINE IO_FILL_DIMS_NC4(TPFILE,TPREC,KRESP)
- USE MODD_IO_ll, ONLY: TFILEDATA
- use mode_io_tools_nc4, only: getdimcdf, io_find_dim_byname_nc4
+ 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
TYPE(TFILEDATA),INTENT(IN) :: TPFILE
TYPE(workfield),INTENT(INOUT) :: TPREC
@@ -1273,12 +1272,12 @@ END DO
INTEGER :: JJ
TYPE(DIMCDF),POINTER :: TZDIMPTR
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_FILL_DIMS_NC4','called')
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Dims_fill_nc4','called')
KRESP = 0
IF (TPREC%NDIMS_FILE<TPREC%TFIELD%NDIMS) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_FILL_DIMS_NC4','less dimensions than expected for '//TRIM(TPREC%TFIELD%CMNHNAME)// &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Dims_fill_nc4','less dimensions than expected for '//TRIM(TPREC%TFIELD%CMNHNAME)// &
' => ignored')
TPREC%tbw = .FALSE.
TPREC%tbr = .FALSE.
@@ -1290,10 +1289,10 @@ END DO
DO JJ=1,TPREC%TFIELD%NDIMS
!DO JJ=1,TPREC%NDIMS_FILE !NDIMS_FILE can be bigger than NDIMS due to time dimension (it can be ignored here)
- CALL IO_FIND_DIM_BYNAME_NC4(TPFILE,TPREC%CDIMNAMES_FILE(JJ),TPREC%TDIMS(JJ),KRESP)
+ 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 => GETDIMCDF(TPFILE,TPREC%NDIMSIZES_FILE(JJ))
+ TZDIMPTR => IO_Dimcdf_get_nc4(TPFILE,TPREC%NDIMSIZES_FILE(JJ))
TPREC%TDIMS(JJ) = TZDIMPTR
KRESP = 0
END IF
@@ -1305,6 +1304,6 @@ END DO
END IF
END DO
- END SUBROUTINE IO_FILL_DIMS_NC4
+ END SUBROUTINE IO_Dims_fill_nc4
END MODULE mode_util
diff --git a/LIBTOOLS/tools/lfiz/src/lfiz.f90 b/LIBTOOLS/tools/lfiz/src/lfiz.f90
index de9b42b530b34fe53112a708238ae02139763af2..d72a01bc602a8c406ec9c9d16164e7957702cb1c 100644
--- a/LIBTOOLS/tools/lfiz/src/lfiz.f90
+++ b/LIBTOOLS/tools/lfiz/src/lfiz.f90
@@ -14,25 +14,27 @@ INTEGER :: arglen
INTEGER :: inarg
CHARACTER(LEN=50) :: yexe
+LOGICAL(KIND=LFI_INT),PARAMETER :: GTRUE = .TRUE.
+LOGICAL(KIND=LFI_INT),PARAMETER :: GFALSE = .FALSE.
INTEGER, PARAMETER :: FM_FIELD_SIZE = 16
-INTEGER, PARAMETER :: ISRCLU = 11
-INTEGER, PARAMETER :: IDESTLU = 12
+INTEGER(KIND=LFI_INT), PARAMETER :: ISRCLU = 11
+INTEGER(KIND=LFI_INT), PARAMETER :: IDESTLU = 12
INTEGER :: JPHEXT
-INTEGER :: iverb
-INTEGER :: inap ! nb d'articles prevus (utile a la creation)
-INTEGER :: inaf ! nb d'articles presents dans un fichier existant
-INTEGER :: inafdest
+INTEGER(KIND=LFI_INT) :: iverb
+INTEGER(KIND=LFI_INT) :: inap ! nb d'articles prevus (utile a la creation)
+INTEGER(KIND=LFI_INT) :: inaf ! nb d'articles presents dans un fichier existant
+INTEGER(KIND=LFI_INT) :: inafdest
CHARACTER(LEN=128) :: filename,DESTFNAME
INTEGER :: JI,JJ
-INTEGER :: IRESP
+INTEGER(KIND=LFI_INT) :: IRESP
CHARACTER(LEN=FM_FIELD_SIZE),DIMENSION(:),ALLOCATABLE :: yrecfm
-INTEGER, DIMENSION(:),ALLOCATABLE :: ileng
+INTEGER(KIND=LFI_INT), DIMENSION(:),ALLOCATABLE :: ileng
INTEGER(KIND=8), DIMENSION(:),ALLOCATABLE :: iwork
-INTEGER :: ilengs
-INTEGER :: ipos
+INTEGER(KIND=LFI_INT) :: ilengs
+INTEGER(KIND=LFI_INT) :: ipos
INTEGER :: sizemax
INTEGER :: IGRID
@@ -46,7 +48,9 @@ INTEGER :: LFICOMP
INTEGER :: NEWSIZE
INTEGER :: searchndx
INTEGER :: INDDATIM
-INARG = IARGC()
+
+!OLD: INARG = IARGC()
+INARG = COMMAND_ARGUMENT_COUNT()
#if defined(F90HP)
#define HPINCR 1
@@ -54,6 +58,9 @@ INARG = IARGC()
#define HPINCR 0
#endif
+ CALL GET_COMMAND_ARGUMENT(0,yexe)
+#if 0
+!OLD:
#if defined(FUJI) || defined(NAGf95) || defined(NEC) || defined(HP) || defined(pgf) || defined(G95) || defined(GFORTRAN)
CALL GETARG(0+HPINCR,yexe)
IF (LEN_TRIM(yexe) == 0) THEN
@@ -63,12 +70,17 @@ INARG = IARGC()
#else
CALL PXFGETARG(0,yexe,arglen,iresp)
#endif
+#endif
! PRINT *,yexe, ' avec ',INARG,' arguments.'
IF (INARG == 1) THEN
+ CALL GET_COMMAND_ARGUMENT(1,filename)
+#if 0
+!OLD:
#if defined(FUJI) || defined(NAGf95) || defined(NEC) || defined(HP) || defined(pgf) || defined(G95)|| defined(GFORTRAN)
CALL GETARG(1+HPINCR,filename)
#else
CALL PXFGETARG(1,filename,arglen,iresp)
+#endif
#endif
ELSE
PRINT *,'Usage : ', TRIM(yexe), ' [fichier lfi]'
@@ -91,8 +103,8 @@ IDIMY = 0
IDIMZ = 0
GUSEDIM = .FALSE.
-CALL LFIOUV(IRESP,ISRCLU,.TRUE.,filename,'OLD',.FALSE.&
- & ,.FALSE.,iverb,inap,inaf)
+CALL LFIOUV(IRESP,ISRCLU,GTRUE,filename,'OLD',GFALSE&
+ & ,GFALSE,iverb,inap,inaf)
CALL FMREADLFIN1(ISRCLU,'LFI_COMPRESSED',LFICOMP,iresp)
IF (iresp == 0) THEN
@@ -139,8 +151,8 @@ END IF
PRINT *,'compressed file : ',DESTFNAME
-CALL LFIOUV(IRESP,IDESTLU,.TRUE.,DESTFNAME,'NEW'&
- & ,.FALSE.,.FALSE.,iverb,inaf+1,inafdest)
+CALL LFIOUV(IRESP,IDESTLU,GTRUE,DESTFNAME,'NEW'&
+ & ,GFALSE,GFALSE,iverb,inaf+1,inafdest)
CALL LFIPOS(IRESP,ISRCLU)
ALLOCATE(yrecfm(inaf))
@@ -148,7 +160,7 @@ ALLOCATE(ileng(inaf))
yrecfm(:) = ''
sizemax=0
DO ji=1,inaf
- CALL LFICAS(IRESP,ISRCLU,yrecfm(ji),ileng(ji),ipos,.TRUE.)
+ CALL LFICAS(IRESP,ISRCLU,yrecfm(ji),ileng(ji),ipos,GTRUE)
IF (ileng(ji) > sizemax) sizemax=ileng(ji)
END DO
PRINT *,' Nombre total d''articles dans fichier source :', inaf
@@ -218,13 +230,13 @@ CALL LFIFER(IRESP,IDESTLU,'KEEP')
CONTAINS
SUBROUTINE FMREADLFIN1(klu,hrecfm,kval,kresp)
-INTEGER, INTENT(IN) :: klu ! logical fortran unit au lfi file
-CHARACTER(LEN=*),INTENT(IN) :: hrecfm ! article name to be read
-INTEGER, INTENT(OUT) :: kval ! integer value for hrecfm article
-INTEGER, INTENT(OUT) :: kresp! return code null if OK
+INTEGER(KIND=LFI_INT), INTENT(IN) :: klu ! logical fortran unit au lfi file
+CHARACTER(LEN=*), INTENT(IN) :: hrecfm ! article name to be read
+INTEGER, INTENT(OUT) :: kval ! integer value for hrecfm article
+INTEGER(KIND=LFI_INT), INTENT(OUT) :: kresp! return code null if OK
!
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE::iwork
-INTEGER :: iresp,ilenga,iposex,icomlen
+INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: iwork
+INTEGER(KIND=LFI_INT) :: iresp,ilenga,iposex,icomlen
!
CALL LFINFO(iresp,klu,hrecfm,ilenga,iposex)
IF (iresp /=0 .OR. ilenga == 0) THEN
diff --git a/LIBTOOLS/tools/lfiz/src/unlfiz.f90 b/LIBTOOLS/tools/lfiz/src/unlfiz.f90
index bd5a3008fe8b085eb2b1b1eb501d25bf56cfe49f..d2c0e814b62840d4c6d2269b3f4bb30281d5dc06 100644
--- a/LIBTOOLS/tools/lfiz/src/unlfiz.f90
+++ b/LIBTOOLS/tools/lfiz/src/unlfiz.f90
@@ -14,24 +14,26 @@ INTEGER :: arglen
INTEGER :: inarg
CHARACTER(LEN=50) :: yexe
+LOGICAL(KIND=LFI_INT),PARAMETER :: GTRUE = .TRUE.
+LOGICAL(KIND=LFI_INT),PARAMETER :: GFALSE = .FALSE.
INTEGER, PARAMETER :: FM_FIELD_SIZE = 16
-INTEGER, PARAMETER :: ISRCLU = 11
-INTEGER, PARAMETER :: IDESTLU = 12
-INTEGER :: iverb
-INTEGER :: inap ! nb d'articles prevus (utile a la creation)
-INTEGER :: inaf ! nb d'articles presents dans un fichier existant
-INTEGER :: inafdest
+INTEGER(KIND=LFI_INT), PARAMETER :: ISRCLU = 11
+INTEGER(KIND=LFI_INT), PARAMETER :: IDESTLU = 12
+INTEGER(KIND=LFI_INT) :: iverb
+INTEGER(KIND=LFI_INT) :: inap ! nb d'articles prevus (utile a la creation)
+INTEGER(KIND=LFI_INT) :: inaf ! nb d'articles presents dans un fichier existant
+INTEGER(KIND=LFI_INT) :: inafdest
CHARACTER(LEN=128) :: filename,DESTFNAME
INTEGER :: JI,JJ
-INTEGER :: IRESP
+INTEGER(KIND=LFI_INT) :: IRESP
CHARACTER(LEN=FM_FIELD_SIZE),DIMENSION(:),ALLOCATABLE :: yrecfm
-INTEGER, DIMENSION(:),ALLOCATABLE :: ileng
+INTEGER(KIND=LFI_INT), DIMENSION(:),ALLOCATABLE :: ileng
INTEGER(KIND=8), DIMENSION(:),ALLOCATABLE :: iwork,iworknew
-INTEGER :: ilengs
-INTEGER :: ipos
+INTEGER(KIND=LFI_INT) :: ilengs
+INTEGER(KIND=LFI_INT) :: ipos
INTEGER :: sizemax
INTEGER :: ICOMLEN
@@ -43,9 +45,10 @@ INTEGER :: CPT
INTEGER :: LFICOMP
INTEGER :: searchndx
INTEGER :: ITYPCOD
-INTEGER :: ITOTAL,ITOTALMAX
+INTEGER(KIND=LFI_INT) :: ITOTAL,ITOTALMAX
-INARG = IARGC()
+!OLD: INARG = IARGC()
+INARG = COMMAND_ARGUMENT_COUNT()
#if defined(F90HP)
#define HPINCR 1
@@ -53,6 +56,9 @@ INARG = IARGC()
#define HPINCR 0
#endif
+ CALL GET_COMMAND_ARGUMENT(0,yexe)
+#if 0
+!OLD:
#if defined(FUJI) || defined(NAGf95) || defined(NEC) || defined(HP) || defined(pgf) || defined(G95) || defined(GFORTRAN)
CALL GETARG(0+HPINCR,yexe)
IF (LEN_TRIM(yexe) == 0) THEN
@@ -62,12 +68,17 @@ INARG = IARGC()
#else
CALL PXFGETARG(0,yexe,arglen,iresp)
#endif
+#endif
! PRINT *,yexe, ' avec ',INARG,' arguments.'
IF (INARG == 1) THEN
+ CALL GET_COMMAND_ARGUMENT(1,filename)
+#if 0
+!OLD:
#if defined(FUJI) || defined(NAGf95) || defined(NEC) || defined(HP) || defined(pgf) || defined(G95) || defined(GFORTRAN)
CALL GETARG(1+HPINCR,filename)
#else
CALL PXFGETARG(1,filename,arglen,iresp)
+#endif
#endif
ELSE
PRINT *,'Usage : ', TRIM(yexe), ' [fichier lfi]'
@@ -93,8 +104,8 @@ IDIMY = 0
IDIMZ = 0
GUSEDIM = .FALSE.
-CALL LFIOUV(IRESP,ISRCLU,.TRUE.,filename,'OLD',.FALSE.&
- & ,.FALSE.,iverb,inap,inaf)
+CALL LFIOUV(IRESP,ISRCLU,GTRUE,filename,'OLD',GFALSE&
+ & ,GFALSE,iverb,inap,inaf)
CALL FMREADLFIN1(ISRCLU,'LFI_COMPRESSED',LFICOMP,iresp)
IF (iresp /= 0 .OR. LFICOMP /= 1) THEN
@@ -104,8 +115,8 @@ IF (iresp /= 0 .OR. LFICOMP /= 1) THEN
END IF
PRINT *,'Uncompressed (but 32 bits REAL precision) file : ',DESTFNAME
-CALL LFIOUV(IRESP,IDESTLU,.TRUE.,DESTFNAME,'NEW'&
- & ,.FALSE.,.FALSE.,iverb,inaf,inafdest)
+CALL LFIOUV(IRESP,IDESTLU,GTRUE,DESTFNAME,'NEW'&
+ & ,GFALSE,GFALSE,iverb,inaf,inafdest)
CALL LFIPOS(IRESP,ISRCLU)
ALLOCATE(yrecfm(inaf))
@@ -113,7 +124,7 @@ ALLOCATE(ileng(inaf))
yrecfm(:) = ''
sizemax=0
DO ji=1,inaf
- CALL LFICAS(IRESP,ISRCLU,yrecfm(ji),ileng(ji),ipos,.TRUE.)
+ CALL LFICAS(IRESP,ISRCLU,yrecfm(ji),ileng(ji),ipos,GTRUE)
IF (ileng(ji) > sizemax) sizemax=ileng(ji)
END DO
PRINT *,' Nombre total d''articles dans fichier source :', inaf
@@ -173,13 +184,13 @@ CALL LFIFER(IRESP,IDESTLU,'KEEP')
CONTAINS
SUBROUTINE FMREADLFIN1(klu,hrecfm,kval,kresp)
-INTEGER, INTENT(IN) :: klu ! logical fortran unit au lfi file
-CHARACTER(LEN=*),INTENT(IN) :: hrecfm ! article name to be read
-INTEGER, INTENT(OUT) :: kval ! integer value for hrecfm article
-INTEGER, INTENT(OUT) :: kresp! return code null if OK
+INTEGER(KIND=LFI_INT), INTENT(IN) :: klu ! logical fortran unit au lfi file
+CHARACTER(LEN=*), INTENT(IN) :: hrecfm ! article name to be read
+INTEGER, INTENT(OUT) :: kval ! integer value for hrecfm article
+INTEGER(KIND=LFI_INT), INTENT(OUT) :: kresp! return code null if OK
!
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE::iwork
-INTEGER :: iresp,ilenga,iposex,icomlen
+INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: iwork
+INTEGER(KIND=LFI_INT) :: iresp,ilenga,iposex,icomlen
!
CALL LFINFO(iresp,klu,hrecfm,ilenga,iposex)
IF (iresp /=0 .OR. ilenga == 0) THEN
diff --git a/MY_RUN/KTEST/001_2Drelief/005_ncl/run_ncl b/MY_RUN/KTEST/001_2Drelief/005_ncl/run_ncl
index c5bac61b46c8ab3e2c167dc70a4babd5a08c8db4..392a13cbfb0da4a39f491ba806d7af46a2bd1759 100755
--- a/MY_RUN/KTEST/001_2Drelief/005_ncl/run_ncl
+++ b/MY_RUN/KTEST/001_2Drelief/005_ncl/run_ncl
@@ -10,20 +10,20 @@ ln -sf ../002_mesonh/EXPER.1.HYD2D.003.nc .
rm -f visu_2Drelief.*.png
ncl plot_2Drelief.ncl
-display visu_2Drelief.000001.png
-display visu_2Drelief.000002.png
-display visu_2Drelief.000003.png
-display visu_2Drelief.000004.png
-display visu_2Drelief.000005.png
-display visu_2Drelief.000006.png
-display visu_2Drelief.000007.png
-display visu_2Drelief.000008.png
-display visu_2Drelief.000009.png
-display visu_2Drelief.000010.png
-display visu_2Drelief.000011.png
-display visu_2Drelief.000012.png
-display visu_2Drelief.000013.png
-display visu_2Drelief.000014.png
-display visu_2Drelief.000015.png
-display visu_2Drelief.000016.png
+${POSTRUN} display visu_2Drelief.000001.png
+${POSTRUN} display visu_2Drelief.000002.png
+${POSTRUN} display visu_2Drelief.000003.png
+${POSTRUN} display visu_2Drelief.000004.png
+${POSTRUN} display visu_2Drelief.000005.png
+${POSTRUN} display visu_2Drelief.000006.png
+${POSTRUN} display visu_2Drelief.000007.png
+${POSTRUN} display visu_2Drelief.000008.png
+${POSTRUN} display visu_2Drelief.000009.png
+${POSTRUN} display visu_2Drelief.000010.png
+${POSTRUN} display visu_2Drelief.000011.png
+${POSTRUN} display visu_2Drelief.000012.png
+${POSTRUN} display visu_2Drelief.000013.png
+${POSTRUN} display visu_2Drelief.000014.png
+${POSTRUN} display visu_2Drelief.000015.png
+${POSTRUN} display visu_2Drelief.000016.png
exit 0
diff --git a/MY_RUN/KTEST/002_3Drelief/002_mesonh/run_mesonh_xyz b/MY_RUN/KTEST/002_3Drelief/002_mesonh/run_mesonh_xyz
index 88fee2ebc2b98339a6ed29820856c42b15253850..97878c3aaab53f7da79e1c2c56aa2627a740b118 100755
--- a/MY_RUN/KTEST/002_3Drelief/002_mesonh/run_mesonh_xyz
+++ b/MY_RUN/KTEST/002_3Drelief/002_mesonh/run_mesonh_xyz
@@ -4,6 +4,6 @@
#MNH_LIC for details. version 1.
set -x
set -e
-ln -fs ../001_prep_ideal_case/RELIEF3D.{des,lfi,nc} .
+ln -fs ../001_prep_ideal_case/RELIEF3D*.{des,lfi,nc} .
rm -f REL3D.1* OUT*
time ${MPIRUN} MESONH${XYZ}
diff --git a/MY_RUN/KTEST/002_3Drelief/005_ncl/run_ncl b/MY_RUN/KTEST/002_3Drelief/005_ncl/run_ncl
index ee22f054e60770cf8115212b0cac841194bcbf75..a087673baa375bd6505f5843cf76566725260137 100755
--- a/MY_RUN/KTEST/002_3Drelief/005_ncl/run_ncl
+++ b/MY_RUN/KTEST/002_3Drelief/005_ncl/run_ncl
@@ -9,5 +9,5 @@ ln -sf ../002_mesonh/REL3D.1.EXP01.002.nc .
rm -f visu_3Drelief*
ncl plot_3Drelief.ncl
-display visu_3Drelief.png
+${POSTRUN} display visu_3Drelief.png
exit 0
diff --git a/MY_RUN/KTEST/003_KW78/002_mesonh/run_mesonh_xyz b/MY_RUN/KTEST/003_KW78/002_mesonh/run_mesonh_xyz
index cfee5d1657b2ccc6520eefd9bc39eb16b189bbe7..e86549305e114ff5c83fbcbc2c90417a44c1d717 100755
--- a/MY_RUN/KTEST/003_KW78/002_mesonh/run_mesonh_xyz
+++ b/MY_RUN/KTEST/003_KW78/002_mesonh/run_mesonh_xyz
@@ -4,6 +4,6 @@
#MNH_LIC for details. version 1.
set -x
set -e
-ln -fs ../001_prep_ideal_case/KWRAIN.{des,lfi,nc} .
+ln -fs ../001_prep_ideal_case/KWRAIN*.{des,lfi,nc} .
rm -f KWRAI.1.* OUT*
time ${MPIRUN} MESONH${XYZ}
diff --git a/MY_RUN/KTEST/003_KW78/004_diaprog/dir_KW78 b/MY_RUN/KTEST/003_KW78/004_diaprog/dir_KW78
index 50b7f9243359884896ec3c3b79cb54afcf52f15a..f23437c1cdb46db72e54e3be4890ccbcbb5ae125 100644
--- a/MY_RUN/KTEST/003_KW78/004_diaprog/dir_KW78
+++ b/MY_RUN/KTEST/003_KW78/004_diaprog/dir_KW78
@@ -1,14 +1,12 @@
+visu
! directives de presentation
LINVWB=T NIGRNC=10 nhi=0 lminmax=t xsizel=0.015
-! fenetre graphique
-visu
! 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'
-!visu
! couleur de fond pour le 1er intervalle
LCOLZERO=T NCOLZERO=1
! precipitations explicites instantanees
diff --git a/MY_RUN/KTEST/003_KW78/005_ncl/run_ncl b/MY_RUN/KTEST/003_KW78/005_ncl/run_ncl
index 26bc2d37386a86c4e79f245f1b755d66b8653bff..fe611614ef801d781cb98a6ae2e47f19b429795b 100755
--- a/MY_RUN/KTEST/003_KW78/005_ncl/run_ncl
+++ b/MY_RUN/KTEST/003_KW78/005_ncl/run_ncl
@@ -9,17 +9,17 @@ ln -sf ../002_mesonh/KWRAI.1.SEG01.004.nc .
rm -f visu_KW78.*.png
ncl plot_KW78.ncl
-display visu_KW78.000001.png
-display visu_KW78.000002.png
-display visu_KW78.000003.png
-display visu_KW78.000004.png
-display visu_KW78.000005.png
-display visu_KW78.000006.png
-display visu_KW78.000007.png
-display visu_KW78.000008.png
-display visu_KW78.000009.png
-display visu_KW78.000010.png
-display visu_KW78.000011.png
-display visu_KW78.000012.png
-display visu_KW78.000013.png
+${POSTRUN} display visu_KW78.000001.png
+${POSTRUN} display visu_KW78.000002.png
+${POSTRUN} display visu_KW78.000003.png
+${POSTRUN} display visu_KW78.000004.png
+${POSTRUN} display visu_KW78.000005.png
+${POSTRUN} display visu_KW78.000006.png
+${POSTRUN} display visu_KW78.000007.png
+${POSTRUN} display visu_KW78.000008.png
+${POSTRUN} display visu_KW78.000009.png
+${POSTRUN} display visu_KW78.000010.png
+${POSTRUN} display visu_KW78.000011.png
+${POSTRUN} display visu_KW78.000012.png
+${POSTRUN} display visu_KW78.000013.png
exit 0
diff --git a/MY_RUN/KTEST/003_KW78/006_diag/run_diag_xyz b/MY_RUN/KTEST/003_KW78/006_diag/run_diag_xyz
index 99484f4931114142f9f407d058a8a2e1cdd34c14..dae2b32d951a7dfac048db8131c2b54a6973ae4e 100755
--- a/MY_RUN/KTEST/003_KW78/006_diag/run_diag_xyz
+++ b/MY_RUN/KTEST/003_KW78/006_diag/run_diag_xyz
@@ -9,7 +9,7 @@ rm -f KWRAI* OUT*
#
#
ln -sf ../002_mesonh/KWRAI.1.SEG01.004.des .
-ln -sf ../002_mesonh/KWRAI.1.SEG01.004.nc .
+ln -sf ../002_mesonh/KWRAI.1.SEG01.004.*nc .
time ${MPIRUN} DIAG${XYZ}
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 ec3585d714f6f3da190ab8572ddc1a0754f0222a..3b96c630eb395cf69794129acd8956b140ba3e37 100755
--- a/MY_RUN/KTEST/003_KW78/007_ncl_diag/run_ncl
+++ b/MY_RUN/KTEST/003_KW78/007_ncl_diag/run_ncl
@@ -10,6 +10,6 @@ ln -sf ../006_diag/KWRAI.1.SEG01.004dia.nc .
rm -f visu_KW78_diag.png
ncl plot_KW78_diag.ncl
-display visu_KW78_diag.png
+${POSTRUN} display visu_KW78_diag.png
exit 0
diff --git a/MY_RUN/KTEST/004_Reunion/001_prep_pgd/PRE_PGD1.nam b/MY_RUN/KTEST/004_Reunion/001_prep_pgd/PRE_PGD1.nam
index a441625117cef8e81e8ada2d1e17a7a0ad5a4054..8c6897877f8d98fc52e0631188a04ec3ca1e8fa8 100644
--- a/MY_RUN/KTEST/004_Reunion/001_prep_pgd/PRE_PGD1.nam
+++ b/MY_RUN/KTEST/004_Reunion/001_prep_pgd/PRE_PGD1.nam
@@ -3,7 +3,7 @@
!JPHEXT = 3 , NHALO_MNH = 3
/
&NAM_CONFZ
- ! NZ_VERB=5 , NB_PROCIO_W=8
+ !NZ_VERB=5 , NB_PROCIO_W=1
/
&NAM_PGDFILE CPGDFILE='REUNION_PGD_1km5' /
&NAM_CONF_PROJ
diff --git a/MY_RUN/KTEST/004_Reunion/002_prep_ideal_case/PRE_IDEA1.nam b/MY_RUN/KTEST/004_Reunion/002_prep_ideal_case/PRE_IDEA1.nam
index a30e8bbc6f9ad95cab10d8e487b32bfcc8361d6c..76198aa8ace251fc46eec9f4079ef620b9d55881 100644
--- a/MY_RUN/KTEST/004_Reunion/002_prep_ideal_case/PRE_IDEA1.nam
+++ b/MY_RUN/KTEST/004_Reunion/002_prep_ideal_case/PRE_IDEA1.nam
@@ -1,6 +1,6 @@
&NAM_CONFIO LCDF4=T, LLFIOUT=T, LLFIREAD=F /
&NAM_CONFZ
- ! NZ_VERB=5 , NB_PROCIO_R=8 , NB_PROCIO_W=8
+ !NZ_VERB=5 , NB_PROCIO_R=1 , NB_PROCIO_W=8
/
&NAM_REAL_PGD CPGD_FILE = 'REUNION_PGD_1km5',
LREAD_ZS= T, LREAD_GROUND_PARAM= T /
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 20bd41ff753622a8a6be00253681cb6b70bd6a7b..ce9bd3dc383068a96cab69ce6d6391bc1cd8926e 100755
--- a/MY_RUN/KTEST/004_Reunion/003_mesonh/run_mesonh_xyz
+++ b/MY_RUN/KTEST/004_Reunion/003_mesonh/run_mesonh_xyz
@@ -6,7 +6,7 @@
set -x
set -e
-ln -fs ../002_prep_ideal_case/REUNION_IDEA.{des,lfi,nc} .
+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
diff --git a/MY_RUN/KTEST/004_Reunion/005_diaprog/dir_Reunion b/MY_RUN/KTEST/004_Reunion/005_diaprog/dir_Reunion
index 014efaae35eaa787d2f91c79b79f27496ad497fe..7fafdea2284ea209c372c3efc69dd859416b6280 100644
--- a/MY_RUN/KTEST/004_Reunion/005_diaprog/dir_Reunion
+++ b/MY_RUN/KTEST/004_Reunion/005_diaprog/dir_Reunion
@@ -1,11 +1,10 @@
+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'
-! ouverture de la fenetre d affichage
-visu
! module du vent et vecteurs du niveau K=2
MUTVT_K_2_ON_UTVT_K_2
! temperature potentielle a 1500m
diff --git a/MY_RUN/KTEST/004_Reunion/006_ncl/run_ncl b/MY_RUN/KTEST/004_Reunion/006_ncl/run_ncl
index 52fe4902f4e48c777cb11e772fe113a9b7b5e87f..1728e92ca8fb5f6213f90a02990fddcbd0455a92 100755
--- a/MY_RUN/KTEST/004_Reunion/006_ncl/run_ncl
+++ b/MY_RUN/KTEST/004_Reunion/006_ncl/run_ncl
@@ -9,11 +9,11 @@ ln -sf ../003_mesonh/REUNI.1.00A20.004.nc .
rm -f visu_Reunion.*.png
ncl plot_Reunion.ncl
-display visu_Reunion.000001.png
-display visu_Reunion.000002.png
-display visu_Reunion.000003.png
-display visu_Reunion.000004.png
-display visu_Reunion.000005.png
-display visu_Reunion.000006.png
-display visu_Reunion.000007.png
+${POSTRUN} display visu_Reunion.000001.png
+${POSTRUN} display visu_Reunion.000002.png
+${POSTRUN} display visu_Reunion.000003.png
+${POSTRUN} display visu_Reunion.000004.png
+${POSTRUN} display visu_Reunion.000005.png
+${POSTRUN} display visu_Reunion.000006.png
+${POSTRUN} display visu_Reunion.000007.png
exit 0
diff --git a/MY_RUN/KTEST/005_ARM/004_ncl/run_ncl b/MY_RUN/KTEST/005_ARM/004_ncl/run_ncl
index a23cea5ff244d91db37164fd6d4b13d9f6ea618d..31723fe2e450eb4c05f771c4afba434945a37b02 100755
--- a/MY_RUN/KTEST/005_ARM/004_ncl/run_ncl
+++ b/MY_RUN/KTEST/005_ARM/004_ncl/run_ncl
@@ -9,28 +9,28 @@ ln -sf ../002_mesonh/ARM__.1.CEN4T.000.* .
rm -f visu_ARM.*.png
ncl plot_arm.ncl
-display visu_ARM.000001.png
-display visu_ARM.000002.png
-display visu_ARM.000003.png
-display visu_ARM.000004.png
-display visu_ARM.000005.png
-display visu_ARM.000006.png
-display visu_ARM.000007.png
-display visu_ARM.000008.png
-display visu_ARM.000009.png
-display visu_ARM.000010.png
-display visu_ARM.000011.png
-display visu_ARM.000012.png
-display visu_ARM.000013.png
-display visu_ARM.000014.png
-display visu_ARM.000015.png
-display visu_ARM.000016.png
-display visu_ARM.000017.png
-display visu_ARM.000018.png
-display visu_ARM.000019.png
-display visu_ARM.000020.png
-display visu_ARM.000021.png
-display visu_ARM.000022.png
-display visu_ARM.000023.png
-display visu_ARM.000024.png
+${POSTRUN} display visu_ARM.000001.png
+${POSTRUN} display visu_ARM.000002.png
+${POSTRUN} display visu_ARM.000003.png
+${POSTRUN} display visu_ARM.000004.png
+${POSTRUN} display visu_ARM.000005.png
+${POSTRUN} display visu_ARM.000006.png
+${POSTRUN} display visu_ARM.000007.png
+${POSTRUN} display visu_ARM.000008.png
+${POSTRUN} display visu_ARM.000009.png
+${POSTRUN} display visu_ARM.000010.png
+${POSTRUN} display visu_ARM.000011.png
+${POSTRUN} display visu_ARM.000012.png
+${POSTRUN} display visu_ARM.000013.png
+${POSTRUN} display visu_ARM.000014.png
+${POSTRUN} display visu_ARM.000015.png
+${POSTRUN} display visu_ARM.000016.png
+${POSTRUN} display visu_ARM.000017.png
+${POSTRUN} display visu_ARM.000018.png
+${POSTRUN} display visu_ARM.000019.png
+${POSTRUN} display visu_ARM.000020.png
+${POSTRUN} display visu_ARM.000021.png
+${POSTRUN} display visu_ARM.000022.png
+${POSTRUN} display visu_ARM.000023.png
+${POSTRUN} display visu_ARM.000024.png
exit 0
diff --git a/MY_RUN/KTEST/007_16janvier/004_arp2lfi/PRE_REAL1.nam b/MY_RUN/KTEST/007_16janvier/004_arp2lfi/PRE_REAL1.nam
index 681314cdd549e129f8580bae0ca4f23379c7898e..48e51ec5612c96efe17d3b99bea170b4a25d8a1b 100644
--- a/MY_RUN/KTEST/007_16janvier/004_arp2lfi/PRE_REAL1.nam
+++ b/MY_RUN/KTEST/007_16janvier/004_arp2lfi/PRE_REAL1.nam
@@ -1,6 +1,6 @@
&NAM_CONFIO LCDF4=T, LLFIOUT=T, LLFIREAD=F /
&NAM_CONFZ
- ! NZ_VERB=5 , NZ_PROC=0 , NB_PROCIO_R=1 , NB_PROCIO_W=1
+ !NZ_VERB=5 , NZ_PROC=0 , NB_PROCIO_R=1 , NB_PROCIO_W=8
/
&NAM_REAL_CONF NVERB=5 , CPRESOPT='ZRESI'
!JPHEXT=3 , NHALO=3
diff --git a/MY_RUN/KTEST/007_16janvier/005_spa_mod1_mod2/SPAWN1.nam b/MY_RUN/KTEST/007_16janvier/005_spa_mod1_mod2/SPAWN1.nam
index fe016986138efa70c933c9112b5ddc720012c881..3794021433cd7111083a89f0f60ad213b85e8969 100644
--- a/MY_RUN/KTEST/007_16janvier/005_spa_mod1_mod2/SPAWN1.nam
+++ b/MY_RUN/KTEST/007_16janvier/005_spa_mod1_mod2/SPAWN1.nam
@@ -1,4 +1,8 @@
&NAM_CONFIO LCDF4=T, LLFIOUT=T, LLFIREAD=F /
+&NAM_CONFZ
+ !NZ_VERB=5 , NZ_PROC=0 , NB_PROCIO_R=8 , NB_PROCIO_W=8
+/
+
&NAM_LUNIT2_SPA CINIFILE = "16JAN_06_MNH",
CINIFILEPGD="16JAN98_36km.neste1",
YDOMAIN = "16JAN98_9km.neste1",
diff --git a/MY_RUN/KTEST/007_16janvier/006_preal/PRE_REAL1.nam b/MY_RUN/KTEST/007_16janvier/006_preal/PRE_REAL1.nam
index 963196cc0bb040d7cc466e81cc65722c520f5704..25d4ccf12ee2686910853991a6f3af2292c79a51 100644
--- a/MY_RUN/KTEST/007_16janvier/006_preal/PRE_REAL1.nam
+++ b/MY_RUN/KTEST/007_16janvier/006_preal/PRE_REAL1.nam
@@ -1,4 +1,7 @@
&NAM_CONFIO LCDF4=T, LLFIOUT=T, LLFIREAD=F /
+&NAM_CONFZ
+ !NZ_VERB=5 , NZ_PROC=0 , NB_PROCIO_R=8 , NB_PROCIO_W=8
+/
&NAM_FILE_NAMES HATMFILE ='16JAN_06_MNH.spa04' , HATMFILETYPE='MESONH',
HPGDFILE ='16JAN98_9km.neste1' , CINIFILE='16JAN_06_MNH2' /
&NAM_REAL_CONF NVERB=5
diff --git a/MY_RUN/KTEST/007_16janvier/006_preal/run_preal_xyz b/MY_RUN/KTEST/007_16janvier/006_preal/run_preal_xyz
index 56c362fd8d624cffa53341a466ef91e47b43d7f3..0c88f2ff30e0628198b3d83518dce5339db61e66 100755
--- a/MY_RUN/KTEST/007_16janvier/006_preal/run_preal_xyz
+++ b/MY_RUN/KTEST/007_16janvier/006_preal/run_preal_xyz
@@ -8,8 +8,8 @@ set -e
rm -f 16JAN* OUTPUT_LISTING* pipe* *.tex
ln -sf ../003_nest/16JAN98_9km.neste1.{des,lfi,nc} .
ln -sf ../003_nest/16JAN98_36km.neste1.{des,lfi,nc} .
-ln -sf ../004_arp2lfi/16JAN_06_MNH.{des,lfi,nc} .
-ln -sf ../005_spa_mod1_mod2/16JAN_06_MNH.spa04.{des,lfi,nc} .
+ln -sf ../004_arp2lfi/16JAN_06_MNH*.{des,lfi,nc} .
+ln -sf ../005_spa_mod1_mod2/16JAN_06_MNH.spa04*.{des,lfi,nc} .
#exit
time ${MPIRUN} PREP_REAL_CASE${XYZ}
#ddd --directory=~/DEV/MNH.V4.6.2/src/dir_obj_bug2 PREP_REAL_CASE
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 43a028c9c68c856bd4b021b0b2454646d6c28dee..7040ceed94b9baf614d5e6b49c932a05112ed433 100644
--- a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src
+++ b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src
@@ -2,7 +2,7 @@
! , NIO_VERB=5, NGEN_VERB=5
/
&NAM_CONFZ
- ! NZ_VERB=5 , NZ_PROC=0 , NB_PROCIO_R=1 , NB_PROCIO_W=8
+ !NZ_VERB=5 , NZ_PROC=0 , NB_PROCIO_R=8 , NB_PROCIO_W=8
/
&NAM_LUNITn CINIFILE = "16JAN_06_MNH",CINIFILEPGD="16JAN98_36km.neste1" /
&NAM_DYNn XTSTEP = 60.,
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 056e03e5d59195a194e20a2e9a32b79726f0ca18..654ba1e180deb107aac81bcbf4257e0c53b85f8b 100755
--- a/MY_RUN/KTEST/007_16janvier/008_run2/run_mesonh_xyz
+++ b/MY_RUN/KTEST/007_16janvier/008_run2/run_mesonh_xyz
@@ -8,8 +8,8 @@ set -e
rm -f 16JAN* OUT* EXSEG?.nam
-ln -sf ../004_arp2lfi/16JAN_06_MNH.{des,lfi,nc} .
-ln -sf ../006_preal/16JAN_06_MNH2.{des,lfi,nc} .
+ln -sf ../004_arp2lfi/16JAN_06_MNH*.{des,lfi,nc} .
+ln -sf ../006_preal/16JAN_06_MNH2*.{des,lfi,nc} .
ln -sf ../003_nest/16JAN98_36km.neste1.{des,lfi,nc} .
ln -sf ../003_nest/16JAN98_9km.neste1.{des,lfi,nc} .
diff --git a/MY_RUN/KTEST/007_16janvier/011_ncl/run_ncl b/MY_RUN/KTEST/007_16janvier/011_ncl/run_ncl
index 2fd8e11b66a7dd4c9ea25a68bf64dba6a11e3833..584bbad27cca2954aaa41b098ed973082bdbddd8 100755
--- a/MY_RUN/KTEST/007_16janvier/011_ncl/run_ncl
+++ b/MY_RUN/KTEST/007_16janvier/011_ncl/run_ncl
@@ -6,14 +6,14 @@ ln -sf ../008_run2/16JAN.1.12B18.001.nc .
ln -sf ../008_run2/16JAN.2.12B18.001.nc .
ncl plot_16j.ncl
-display visu_16j.000001.png
-display visu_16j.000002.png
-display visu_16j.000003.png
-display visu_16j.000004.png
+${POSTRUN} display visu_16j.000001.png
+${POSTRUN} display visu_16j.000002.png
+${POSTRUN} display visu_16j.000003.png
+${POSTRUN} display visu_16j.000004.png
ncl plot_16j_2.ncl
-display visu_16j_2.000001.png
-display visu_16j_2.000002.png
-display visu_16j_2.000003.png
+${POSTRUN} display visu_16j_2.000001.png
+${POSTRUN} display visu_16j_2.000002.png
+${POSTRUN} display visu_16j_2.000003.png
exit 0
diff --git a/MY_RUN/KTEST/009_ICARTT/006_ncl/run_ncl b/MY_RUN/KTEST/009_ICARTT/006_ncl/run_ncl
index 7ca559b5af2d293ae2f0519ae870fa5c6f742c0b..af5b7a5b21fca82683f7407ddbba81fb9d5e7c1c 100755
--- a/MY_RUN/KTEST/009_ICARTT/006_ncl/run_ncl
+++ b/MY_RUN/KTEST/009_ICARTT/006_ncl/run_ncl
@@ -12,7 +12,7 @@ rm -f *.png
ncl plot_ICARTT.ncl
ncl plot_ICARTT_budget.ncl
-display zsection_1250.*.png
-display zsection_1250_bud.*.png
+${POSTRUN} display zsection_1250.*.png
+${POSTRUN} display zsection_1250_bud.*.png
exit 0
diff --git a/MY_RUN/KTEST/011_KW78CHEM/004_diaprog/dir_KW78_chem b/MY_RUN/KTEST/011_KW78CHEM/004_diaprog/dir_KW78_chem
index ab5a3a2d7a9d37b3a0a7ffe5bde668f982a0bd11..834ade876fb27691c47f1d02cbaaae22a7429f0e 100644
--- a/MY_RUN/KTEST/011_KW78CHEM/004_diaprog/dir_KW78_chem
+++ b/MY_RUN/KTEST/011_KW78CHEM/004_diaprog/dir_KW78_chem
@@ -1,14 +1,12 @@
+visu
! directives de presentation
LINVWB=T NIGRNC=10 nhi=0 lminmax=t xsizel=0.015
-! fenetre graphique
-visu
! 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'
-!visu
! couleur de fond pour le 1er intervalle
LCOLZERO=T NCOLZERO=1
! precipitations explicites instantanees
diff --git a/MY_RUN/KTEST/011_KW78CHEM/005_ncl/run_ncl b/MY_RUN/KTEST/011_KW78CHEM/005_ncl/run_ncl
index cadb68fd8c69b3a1080eecfc5b67d47f7582e4e4..b9830c1ecdd95dbb3464830c503a8ee787c63821 100755
--- a/MY_RUN/KTEST/011_KW78CHEM/005_ncl/run_ncl
+++ b/MY_RUN/KTEST/011_KW78CHEM/005_ncl/run_ncl
@@ -11,6 +11,6 @@ rm -f visu_KW78_chem.*.png
ncl plot_KW78_chem.ncl
for ECH in '000001' '000002' '000003' '000004' '000005' '000006' '000007' '000008' '000009' '000010' '000011' '000012' '000013' '000014' '000015' '000016' '000017' '000018' '000019' '000020' '000021' '000022' '000023' '000024' '000025' '000026' '000027'
do
-display visu_KW78_chem.${ECH}.png
+${POSTRUN} display visu_KW78_chem.${ECH}.png
done
exit 0
diff --git a/MY_RUN/KTEST/012_dust/007_ncl/run_ncl b/MY_RUN/KTEST/012_dust/007_ncl/run_ncl
index 581980c82a89420d876b26945121004a0c33f02e..153224ed0557d77066ba648357527acc6beb939e 100755
--- a/MY_RUN/KTEST/012_dust/007_ncl/run_ncl
+++ b/MY_RUN/KTEST/012_dust/007_ncl/run_ncl
@@ -10,5 +10,5 @@ for ECH in '000001' '000002' '000003' '000004' '000005' '000006' '000007' '00000
do
-display visu_dust.${ECH}.png
+${POSTRUN} display visu_dust.${ECH}.png
done
diff --git a/MY_RUN/KTEST/013_Iroise_ideal_case_coupling/A_RUN_MNH_TOY/run_plot b/MY_RUN/KTEST/013_Iroise_ideal_case_coupling/A_RUN_MNH_TOY/run_plot
index 77081ee33a84ef4a8234bde522328c7f34af6174..4736ce861e2c6378068826c434916bd00c8fcca5 100755
--- a/MY_RUN/KTEST/013_Iroise_ideal_case_coupling/A_RUN_MNH_TOY/run_plot
+++ b/MY_RUN/KTEST/013_Iroise_ideal_case_coupling/A_RUN_MNH_TOY/run_plot
@@ -3,9 +3,9 @@
ncl plot_coupling_model_toy.ncl
#python plot_coupling_model_toy.py
-display */*0.png
-display */*1.png
-display */*2.png
-display */*3.png
-display */*4.png
+${POSTRUN} display */*0.png
+${POSTRUN} display */*1.png
+${POSTRUN} display */*2.png
+${POSTRUN} display */*3.png
+${POSTRUN} display */*4.png
diff --git a/MY_RUN/KTEST/014_LIMA/003_ncl/run_ncl b/MY_RUN/KTEST/014_LIMA/003_ncl/run_ncl
index 084de8fdd4777de1dc05f440a3edf7dc31cff6d2..e4da2340c321aa464d7e891ee56364e2fabbe473 100755
--- a/MY_RUN/KTEST/014_LIMA/003_ncl/run_ncl
+++ b/MY_RUN/KTEST/014_LIMA/003_ncl/run_ncl
@@ -9,13 +9,12 @@ ln -sf ../002_mesonh/XPREF.1.SEG01.000.nc .
rm -f visu_LIMA.*.png
ncl plot_LIMA.ncl
-display visu_LIMA.*.png
-#display visu_LIMA.000001.png
-#display visu_LIMA.000002.png
-#display visu_LIMA.000003.png
-#display visu_LIMA.000004.png
-#display visu_LIMA.000005.png
-#display visu_LIMA.000006.png
-#display visu_LIMA.000007.png
+${POSTRUN} display visu_LIMA.000001.png
+${POSTRUN} display visu_LIMA.000002.png
+${POSTRUN} display visu_LIMA.000003.png
+${POSTRUN} display visu_LIMA.000004.png
+${POSTRUN} display visu_LIMA.000005.png
+${POSTRUN} display visu_LIMA.000006.png
+${POSTRUN} display visu_LIMA.000007.png
exit 0
diff --git a/bin/spll b/bin/spll
index c8b0ada9e568862d70b7ffd1e3d8a9689e091453..ba2fd7884933a0040563bbb5c72637abd64dde54 100755
--- a/bin/spll
+++ b/bin/spll
@@ -1,7 +1,7 @@
#!/bin/bash
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
#MNH_LIC for details. version 1.
#set -x
if [ $# -ne 2 ]
@@ -26,7 +26,8 @@ ini_cmfshall.f90|mode_double_double.f90|mode_fgau.f90|\
extern_usersurc_ll.f90|\
extern_userio.f90|fmreadwrit.f90|fm_read_ll.f90|poub.f90|\
mode_glt.*.F90|\
-rrtm_.*.F90|srtm_.*.F90"
+rrtm_.*.F90|srtm_.*.F90|\
+libs4py.f90"
#
if [ "$SUF" = "f" ]
diff --git a/conf/profile_mesonh.ihm b/conf/profile_mesonh.ihm
index 576185e854d5b04ede432efe2d0251e5a33a8804..7a9aa3618dc70b0056b463ac73f2742d1c3cf7b1 100755
--- a/conf/profile_mesonh.ihm
+++ b/conf/profile_mesonh.ihm
@@ -67,6 +67,7 @@ export CONF_DOLLAR=${CONF_DOLLAR}
#
export VER_CDF=${VER_CDF}
export VERSION_CDFC=${VERSION_CDFC}
+export VERSION_CDFCXX=${VERSION_CDFCXX}
export VERSION_CDFF=${VERSION_CDFF}
export VERSION_HDF=${VERSION_HDF}
export VERSION_LIBAEC=${VERSION_LIBAEC}
@@ -115,6 +116,10 @@ export VER_OASIS=${VER_OASIS}
#
export VERSION_NCL=${VERSION_NCL}
#
+# MEGAN
+#
+export MNH_MEGAN=${MNH_MEGAN}
+#
##########################################################
##########################################################
##########################################################
@@ -125,7 +130,7 @@ export VERSION_NCL=${VERSION_NCL}
##########################################################
##########################################################
#
-export XYZ="-\${ARCH}-R\${MNH_REAL}I\${MNH_INT}-\${VERSION_XYZ}\${MNH_ECRAD:+-ECRAD}\${VER_USER:+-\${VER_USER}}-\${VER_MPI}-\${OPTLEVEL}"
+export XYZ="-\${ARCH}-R\${MNH_REAL}I\${MNH_INT}-\${VERSION_XYZ}\${MNH_ECRAD:+-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/SURCOUCHE/src/io_write_field.f90 b/src/LIB/SURCOUCHE/src/io_write_field.f90
deleted file mode 100644
index 70bca359e632030a6b7282d3c8a23c3d54e0e692..0000000000000000000000000000000000000000
--- a/src/LIB/SURCOUCHE/src/io_write_field.f90
+++ /dev/null
@@ -1,500 +0,0 @@
-!MNH_LIC Copyright 2016-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.
-!-----------------------------------------------------------------
-! Original version:
-! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!
-MODULE MODE_IO_WRITE_FIELD
-!
-USE MODD_IO_ll, ONLY: TOUTBAK
-USE MODE_FIELD
-USE MODE_FMWRIT
-!
-IMPLICIT NONE
-!
-CONTAINS
-!
-SUBROUTINE IO_WRITE_FIELDLIST(TPOUTPUT)
-!
-USE MODE_MODELN_HANDLER, ONLY : GET_CURRENT_MODEL_INDEX
-!
-IMPLICIT NONE
-!
-TYPE(TOUTBAK), INTENT(IN) :: TPOUTPUT !Output structure
-!
-INTEGER :: IDX
-INTEGER :: IMI
-INTEGER :: JI
-!
-IMI = GET_CURRENT_MODEL_INDEX()
-!
-DO JI = 1,SIZE(TPOUTPUT%NFIELDLIST)
- IDX = TPOUTPUT%NFIELDLIST(JI)
- SELECT CASE (TFIELDLIST(IDX)%NDIMS)
- !
- !0D output
- !
- CASE (0)
- SELECT CASE (TFIELDLIST(IDX)%NTYPE)
- !
- !0D real
- !
- CASE (TYPEREAL)
- IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_X0D) ) THEN
- PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_X0D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END IF
- IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_X0D(IMI)%DATA) ) THEN
- PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_X0D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END IF
- IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
- CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_X0D(IMI)%DATA)
- ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELDLIST','CLBTYPE/=NONE not allowed for 0D logical fields')
- END IF
- !
- !0D integer
- !
- CASE (TYPEINT)
- IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_N0D) ) THEN
- PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_N0D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END IF
- IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_N0D(IMI)%DATA) ) THEN
- PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_N0D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END IF
- IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
- CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_N0D(IMI)%DATA)
- ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELDLIST','CLBTYPE/=NONE not allowed for 0D integer fields')
- END IF
- !
- !0D logical
- !
- CASE (TYPELOG)
- IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_L0D) ) THEN
- PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_L0D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END IF
- IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_L0D(IMI)%DATA) ) THEN
- PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_L0D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END IF
- IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
- CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_L0D(IMI)%DATA)
- ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELDLIST','CLBTYPE/=NONE not allowed for 0D logical fields')
- END IF
- !
- !0D string
- !
- CASE (TYPECHAR)
- IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_C0D) ) THEN
- PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_C0D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END IF
- IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_C0D(IMI)%DATA) ) THEN
- PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_C0D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END IF
- IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
- CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_C0D(IMI)%DATA)
- ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELDLIST','CLBTYPE/=NONE not allowed for 0D character fields')
- END IF
- !
- !0D date/time
- !
- CASE (TYPEDATE)
- IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_T0D) ) THEN
- PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_T0D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END IF
- IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_T0D(IMI)%DATA) ) THEN
- PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_T0D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END IF
- IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
- CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_T0D(IMI)%DATA)
- ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELDLIST','CLBTYPE/=NONE not allowed for 0D date/time fields')
- END IF
- !
- !0D other types
- !
- CASE DEFAULT
- PRINT *,'FATAL: IO_WRITE_FIELDLIST: type not yet supported for 0D output of ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END SELECT
- !
- !1D output
- !
- CASE (1)
- SELECT CASE (TFIELDLIST(IDX)%NTYPE)
- !
- !1D real
- !
- CASE (TYPEREAL)
- IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_X1D) ) THEN
- PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_X1D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END IF
- IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_X1D(IMI)%DATA) ) THEN
- PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_X1D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END IF
- IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
- CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_X1D(IMI)%DATA)
- ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELDLIST','CLBTYPE/=NONE not allowed for 1D real fields')
- END IF
-! !
-! !1D integer
-! !
-! CASE (TYPEINT)
-! IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_N1D) ) THEN
-! PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_N1D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
-! STOP
-! END IF
-! IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_N1D(IMI)%DATA) ) THEN
-! PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_N1D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
-! STOP
-! END IF
-! IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
-! CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_N1D(IMI)%DATA)
-! ELSE
-! CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELDLIST','CLBTYPE/=NONE not allowed for 1D integer fields')
-! END IF
-! !
-! !1D logical
-! !
-! CASE (TYPELOG)
-! IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_L1D) ) THEN
-! PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_L1D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
-! STOP
-! END IF
-! IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_L1D(IMI)%DATA) ) THEN
-! PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_L1D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
-! STOP
-! END IF
-! IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
-! CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_L1D(IMI)%DATA)
-! ELSE
-! CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELDLIST','CLBTYPE/=NONE not allowed for 1D logical fields')
-! END IF
-! !
-! !1D string
-! !
-! CASE (TYPECHAR)
-! IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_C1D) ) THEN
-! PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_C1D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
-! STOP
-! END IF
-! IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_C1D(IMI)%DATA) ) THEN
-! PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_C1D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
-! STOP
-! END IF
-! IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
-! CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_C1D(IMI)%DATA)
-! ELSE
-! CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELDLIST','CLBTYPE/=NONE not allowed for 1D character fields')
-! END IF
- !
- !1D other types
- !
- CASE DEFAULT
- PRINT *,'FATAL: IO_WRITE_FIELDLIST: type not yet supported for 1D output of ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END SELECT
- !
- !2D output
- !
- CASE (2)
- SELECT CASE (TFIELDLIST(IDX)%NTYPE)
- !
- !2D real
- !
- CASE (TYPEREAL)
- IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_X2D) ) THEN
- PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_X2D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END IF
- IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_X2D(IMI)%DATA) ) THEN
- PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_X2D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END IF
- IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
- CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_X2D(IMI)%DATA)
- ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELDLIST','CLBTYPE/=NONE not allowed for 2D real fields')
- END IF
- !
- !2D integer
- !
- CASE (TYPEINT)
- IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_N2D) ) THEN
- PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_N2D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END IF
- IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_N2D(IMI)%DATA) ) THEN
- PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_N2D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END IF
- IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
- CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_N2D(IMI)%DATA)
- ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELDLIST','CLBTYPE/=NONE not allowed for 2D integer fields')
- END IF
- !
- !2D other types
- !
- CASE DEFAULT
- PRINT *,'FATAL: IO_WRITE_FIELDLIST: type not yet supported for 2D output of ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END SELECT
- !
- !3D output
- !
- CASE (3)
- SELECT CASE (TFIELDLIST(IDX)%NTYPE)
- !
- !3D real
- !
- CASE (TYPEREAL)
- IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_X3D) ) THEN
- PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_X3D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END IF
- IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_X3D(IMI)%DATA) ) THEN
- PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_X3D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END IF
- IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
- CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_X3D(IMI)%DATA)
- ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELDLIST','CLBTYPE/=NONE not (yet) allowed for 3D real fields')
- !PW: TODO?: add missing field in TFIELDLIST?
- !CALL IO_WRITE_FIELD_LB(TPOUTPUT%TFILE,TFIELDLIST(IDX),***,TFIELDLIST(IDX)%TFIELD_X3D(IMI)%DATA)
- END IF
- !
- !3D integer
- !
- CASE (TYPEINT)
- IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_N3D) ) THEN
- PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_N3D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END IF
- IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_N3D(IMI)%DATA) ) THEN
- PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_N3D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END IF
- IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
- CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_N3D(IMI)%DATA)
- ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELDLIST','CLBTYPE/=NONE not (yet) allowed for 3D integer fields')
- !PW: TODO?: add missing field in TFIELDLIST?
- !CALL IO_WRITE_FIELD_LB(TPOUTPUT%TFILE,TFIELDLIST(IDX),***,TFIELDLIST(IDX)%TFIELD_N3D(IMI)%DATA)
- END IF
- !
- !3D other types
- !
- CASE DEFAULT
- PRINT *,'FATAL: IO_WRITE_FIELDLIST: type not yet supported for 3D output of ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END SELECT
- !
- !4D output
- !
- CASE (4)
- SELECT CASE (TFIELDLIST(IDX)%NTYPE)
- !
- !4D real
- !
- CASE (TYPEREAL)
- IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_X4D) ) THEN
- PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_X4D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END IF
- IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_X4D(IMI)%DATA) ) THEN
- PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_X4D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END IF
- IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
- CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_X4D(IMI)%DATA)
- ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELDLIST','CLBTYPE/=NONE not (yet) allowed for 4D real fields')
- !PW: TODO?: add missing field in TFIELDLIST?
- !CALL IO_WRITE_FIELD_LB(TPOUTPUT%TFILE,TFIELDLIST(IDX),***,TFIELDLIST(IDX)%TFIELD_X4D(IMI)%DATA)
- END IF
- !
- !4D other types
- !
- CASE DEFAULT
- PRINT *,'FATAL: IO_WRITE_FIELDLIST: type not yet supported for 4D output of ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END SELECT
-! !
-! !5D output
-! !
-! CASE (5)
-! SELECT CASE (TFIELDLIST(IDX)%NTYPE)
-! !
-! !5D real
-! !
-! CASE (TYPEREAL)
-! IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_X5D) ) THEN
-! PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_X5D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
-! STOP
-! END IF
-! IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_X5D(IMI)%DATA) ) THEN
-! PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_X5D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
-! STOP
-! END IF
-! IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
-! CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_X5D(IMI)%DATA)
-! ELSE
-! CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELDLIST','CLBTYPE/=NONE not (yet) allowed for 5D real fields')
-! !PW: TODO?: add missing field in TFIELDLIST?
-! !CALL IO_WRITE_FIELD_LB(TPOUTPUT%TFILE,TFIELDLIST(IDX),***,TFIELDLIST(IDX)%TFIELD_X5D(IMI)%DATA)
-! END IF
-! !
-! !5D other types
-! !
-! CASE DEFAULT
-! PRINT *,'FATAL: IO_WRITE_FIELDLIST: type not yet supported for 5D output of ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
-! STOP
-! END SELECT
-! !
-! !6D output
-! !
-! CASE (6)
-! SELECT CASE (TFIELDLIST(IDX)%NTYPE)
-! !
-! !6D real
-! !
-! CASE (TYPEREAL)
-! IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_X6D) ) THEN
-! PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_X6D is NOT allocated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
-! STOP
-! END IF
-! IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_X6D(IMI)%DATA) ) THEN
-! PRINT *,'FATAL: IO_WRITE_FIELDLIST: TFIELD_X6D%DATA is not associated for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
-! STOP
-! END IF
-! IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
-! CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_X6D(IMI)%DATA)
-! ELSE
-! CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELDLIST','CLBTYPE/=NONE not (yet) allowed for 6D real fields')
-! !PW: TODO?: add missing field in TFIELDLIST?
-! !CALL IO_WRITE_FIELD_LB(TPOUTPUT%TFILE,TFIELDLIST(IDX),***,TFIELDLIST(IDX)%TFIELD_X6D(IMI)%DATA)
-! END IF
-! !
-! !6D other types
-! !
-! CASE DEFAULT
-! PRINT *,'FATAL: IO_WRITE_FIELDLIST: type not yet supported for 4D output of ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
-! STOP
-! END SELECT
- !
- !Other number of dimensions
- !
- CASE DEFAULT
- PRINT *,'FATAL: IO_WRITE_FIELDLIST: number of dimensions not yet supported for ',TRIM(TFIELDLIST(IDX)%CMNHNAME)
- STOP
- END SELECT
-END DO
-!
-END SUBROUTINE IO_WRITE_FIELDLIST
-!
-!
-!
-SUBROUTINE IO_WRITE_FIELD_USER(TPOUTPUT)
-!
-#if 0
-USE MODD_PARAMETERS, ONLY : JPVEXT
-USE MODD_DYN_n, ONLY: XTSTEP
-USE MODD_FIELD_n, ONLY: XUT, XVT, XRT, XTHT
-USE MODD_PRECIP_n, ONLY: XINPRR
-#endif
-!
-IMPLICIT NONE
-!
-TYPE(TOUTBAK), INTENT(IN) :: TPOUTPUT !Output structure
-!
-TYPE(TFIELDDATA) :: TZFIELD
-!
-#if 0
-INTEGER :: IKB
-!
-IKB=JPVEXT+1
-!
-TZFIELD%CMNHNAME = 'UTLOW'
-TZFIELD%CSTDNAME = 'x_wind'
-TZFIELD%CLONGNAME = ''
-TZFIELD%CUNITS = 'm s-1'
-TZFIELD%CDIR = 'XY'
-TZFIELD%CCOMMENT = 'X_Y_Z_U component of wind at lowest physical level'
-TZFIELD%NGRID = 2
-TZFIELD%NTYPE = TYPEREAL
-TZFIELD%NDIMS = 2
-TZFIELD%LTIMEDEP = .TRUE.
-CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TZFIELD,XUT(:,:,IKB))
-!
-TZFIELD%CMNHNAME = 'VTLOW'
-TZFIELD%CSTDNAME = 'y_wind'
-TZFIELD%CLONGNAME = ''
-TZFIELD%CUNITS = 'm s-1'
-TZFIELD%CDIR = 'XY'
-TZFIELD%CCOMMENT = 'X_Y_Z_V component of wind at lowest physical level'
-TZFIELD%NGRID = 3
-TZFIELD%NTYPE = TYPEREAL
-TZFIELD%NDIMS = 2
-TZFIELD%LTIMEDEP = .TRUE.
-CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TZFIELD,XVT(:,:,IKB))
-!
-TZFIELD%CMNHNAME = 'THTLOW'
-TZFIELD%CSTDNAME = 'air_potential_temperature'
-TZFIELD%CLONGNAME = ''
-TZFIELD%CUNITS = 'K'
-TZFIELD%CDIR = 'XY'
-TZFIELD%CCOMMENT = 'X_Y_Z_potential temperature at lowest physical level'
-TZFIELD%NGRID = 1
-TZFIELD%NTYPE = TYPEREAL
-TZFIELD%NDIMS = 2
-TZFIELD%LTIMEDEP = .TRUE.
-CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TZFIELD,XTHT(:,:,IKB))
-!
-TZFIELD%CMNHNAME = 'RVTLOW'
-!TZFIELD%CSTDNAME = 'humidity_mixing_ratio' !ratio of the mass of water vapor to the mass of dry air
-TZFIELD%CSTDNAME = 'specific_humidity' !mass fraction of water vapor in (moist) air
-TZFIELD%CLONGNAME = ''
-TZFIELD%CUNITS = 'kg kg-1'
-TZFIELD%CDIR = 'XY'
-TZFIELD%CCOMMENT = 'X_Y_Z_Vapor mixing Ratio at lowest physical level'
-TZFIELD%NGRID = 1
-TZFIELD%NTYPE = TYPEREAL
-TZFIELD%NDIMS = 2
-TZFIELD%LTIMEDEP = .TRUE.
-CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TZFIELD,XRT(:,:,IKB,1))
-!
-TZFIELD%CMNHNAME = 'ACPRRSTEP'
-TZFIELD%CSTDNAME = 'rainfall_amount'
-TZFIELD%CLONGNAME = ''
-TZFIELD%CUNITS = 'kg m-2'
-TZFIELD%CDIR = ''
-TZFIELD%CCOMMENT = 'X_Y_ACcumulated Precipitation Rain Rate during timestep'
-TZFIELD%NGRID = 1
-TZFIELD%NTYPE = TYPEREAL
-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_WRITE_FIELD(TPOUTPUT%TFILE,TZFIELD,XINPRR*XTSTEP*1.0E3)
-#endif
-!
-END SUBROUTINE IO_WRITE_FIELD_USER
-!
-END MODULE MODE_IO_WRITE_FIELD
diff --git a/src/LIB/SURCOUCHE/src/modd_io.f90 b/src/LIB/SURCOUCHE/src/modd_io.f90
index 62a02bf94ee83faaff7ed36a2c3666a0d7e82e9a..a27528eebe0f92b06e94ef1464a3f3f11396d382 100644
--- a/src/LIB/SURCOUCHE/src/modd_io.f90
+++ b/src/LIB/SURCOUCHE/src/modd_io.f90
@@ -4,25 +4,28 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! Modifications:
-! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! Philippe Wautelet: 10/01/2019: use NEWUNIT argument of OPEN (removed ISTDOUT, ISTDERR, added NNULLUNIT, CNULLFILE)
-! 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 10/01/2019: use NEWUNIT argument of OPEN (removed ISTDOUT, ISTDERR, added NNULLUNIT, CNULLFILE)
+! 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
!-----------------------------------------------------------------
-MODULE MODD_IO_ll
+MODULE MODD_IO
!
-USE MODD_NETCDF, ONLY: IDCDF_KIND, IOCDF, TPTR2DIMCDF
+USE MODD_NETCDF, ONLY: IOCDF, TPTR2DIMCDF
USE MODD_PARAMETERS, ONLY: NDIRNAMELGTMAX, NFILENAMELGTMAX
+use modd_precision, only: CDFINT, LFIINT
!
IMPLICIT NONE
!
!
INTEGER, PARAMETER :: NVERB_NO=0, NVERB_FATAL=1, NVERB_ERROR=2, NVERB_WARNING=3, NVERB_INFO=4, NVERB_DEBUG=5
-INTEGER :: NNULLUNIT = -1 ! /dev/null fortran unit, value set in INITIO_ll
+INTEGER :: NNULLUNIT = -1 ! /dev/null fortran unit, value set in IO_Init
CHARACTER(LEN=*), PARAMETER :: CNULLFILE = "/dev/null"
-INTEGER, SAVE :: ISIOP !! IOproc number
+INTEGER, SAVE :: NIO_RANK ! Rank of IO process
INTEGER, SAVE :: ISP !! Actual proc number
INTEGER, SAVE :: ISNPROC !! Total number of allocated processes
LOGICAL, SAVE :: GSMONOPROC = .FALSE. !! True if sequential execution (ISNPROC = 1)
@@ -70,7 +73,7 @@ END TYPE TOUTBAK
TYPE TFILEDATA
CHARACTER(LEN=NFILENAMELGTMAX) :: CNAME = '' !Filename
CHARACTER(LEN=:),ALLOCATABLE :: CDIRNAME !Directory name
- CHARACTER(LEN=13) :: CTYPE = "UNKNOWN" !Filetype (backup, output, prepidealcase...)
+ CHARACTER(LEN=13) :: CTYPE = "UNKNOWN" !Filetype (PGD, MNH, DES, NML...)
CHARACTER(LEN=7) :: CFORMAT = "UNKNOWN" !Fileformat (NETCDF4, LFI, LFICDF4...)
CHARACTER(LEN=7) :: CMODE = "UNKNOWN" !Opening mode (read, write...)
LOGICAL :: LOPENED = .FALSE. !Is the file opened
@@ -92,31 +95,33 @@ TYPE TFILEDATA
INTEGER,DIMENSION(3) :: NMNHVERSION = (/0,0,0/) !MesoNH version used to create the file
!
! Fields for LFI files
- INTEGER(KIND=LFI_INT) :: NLFININAR = 0 !Number of articles of the LFI file (only accurate if file opened in read mode)
- INTEGER(KIND=LFI_INT) :: 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=LFI_INT) :: NLFIFLU = -1 !File identifier
+ 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
!
! Fields for netCDF files
- INTEGER(KIND=IDCDF_KIND) :: NNCID = -1 !File identifier
- INTEGER(KIND=IDCDF_KIND) :: 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
+ 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=IDCDF_KIND) :: NNCCOMPRESS_LEVEL = 0 ! Compression level
- TYPE(IOCDF),POINTER :: TNCDIMS => NULL() ! Structure containing netCDF dimensions
+ 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
!
!Fields for other files
INTEGER :: NLU = -1 !Logical unit number
INTEGER :: NRECL = -1 !Fortran RECL (record length)
CHARACTER(LEN=11) :: CFORM = "UNKNOWN" !Fortran FORM (FORMATTED/UNFORMATTED)
- CHARACTER(LEN=10) :: CACCESS = "UNKNOWN" !Fortran ACCESS (DIRECT/SEQUENTIAL)
+ CHARACTER(LEN=10) :: CACCESS = "UNKNOWN" !Fortran ACCESS (DIRECT/SEQUENTIAL/STREAM)
!
TYPE(TFILEDATA),POINTER :: TDADFILE => NULL() !Corresponding dad file
TYPE(TFILEDATA),POINTER :: TDESFILE => NULL() !Corresponding .des file
TYPE(TFILEDATA),POINTER :: TDATAFILE => NULL() !Corresponding data file (if .des file)
+ TYPE(TFILEDATA),POINTER :: TMAINFILE => NULL() !Corresponding main file if the file is an sub-file
+ !
TYPE(TFILEDATA),POINTER :: TFILE_PREV => NULL()
TYPE(TFILEDATA),POINTER :: TFILE_NEXT => NULL()
END TYPE TFILEDATA
@@ -136,4 +141,4 @@ TYPE(TFILEDATA),POINTER,SAVE :: TFILE_OUTPUTLISTING => NULL() !Pointer used to
!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())
-END MODULE MODD_IO_ll
+END MODULE MODD_IO
diff --git a/src/LIB/SURCOUCHE/src/modd_netcdf.f90 b/src/LIB/SURCOUCHE/src/modd_netcdf.f90
index 24541396d350d2544517e86aaef83918b1bc81f0..b73380b5636a81333b7eeafce263fc062f56bf5d 100644
--- a/src/LIB/SURCOUCHE/src/modd_netcdf.f90
+++ b/src/LIB/SURCOUCHE/src/modd_netcdf.f90
@@ -7,9 +7,10 @@
! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!-----------------------------------------------------------------
MODULE MODD_NETCDF
-IMPLICIT NONE
-INTEGER,PARAMETER :: IDCDF_KIND = SELECTED_INT_KIND(8)
+use modd_precision, only: CDFINT
+
+IMPLICIT NONE
TYPE IOCDF
TYPE(DIMCDF), POINTER :: DIM_NI => NULL()
@@ -26,10 +27,10 @@ TYPE IOCDF
END TYPE IOCDF
TYPE DIMCDF
- CHARACTER(LEN=32) :: NAME = ''
- INTEGER(KIND=IDCDF_KIND) :: LEN = 0
- INTEGER(KIND=IDCDF_KIND) :: ID = -1
- TYPE(DIMCDF), POINTER :: NEXT => NULL()
+ CHARACTER(LEN=32) :: NAME = ''
+ INTEGER(KIND=CDFINT) :: LEN = 0
+ INTEGER(KIND=CDFINT) :: ID = -1
+ TYPE(DIMCDF), POINTER :: NEXT => NULL()
END TYPE DIMCDF
TYPE TPTR2DIMCDF
diff --git a/src/LIB/SURCOUCHE/src/modd_var_ll.f90 b/src/LIB/SURCOUCHE/src/modd_var_ll.f90
index b0688132fb2fb390fe09fa702f175279b3817949..cffb275aa3389461dd575d1c32ea877980898af4 100644
--- a/src/LIB/SURCOUCHE/src/modd_var_ll.f90
+++ b/src/LIB/SURCOUCHE/src/modd_var_ll.f90
@@ -1,17 +1,8 @@
-
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
!-----------------------------------------------------------------
-!--------------- special set of characters for CVS information
-!-----------------------------------------------------------------
-! $Source$
-! $Name$
-! $Revision$
-! $Date$
-!-----------------------------------------------------------------
-!-----------------------------------------------------------------
! ##################
MODULE MODD_VAR_ll
@@ -46,6 +37,7 @@
! Original 04/05/99
! Modifications
! J.Escobar 5/06/2018 : add cpp key MNH_USE_MPI_STATUSES_IGNORE for use of true MPI_STATUSES_IGNORE
+! P. Wautelet 22/03/2019: remove MPI_PRECISION and MPI_2PRECISION (replaced by MNHREAL_MPI and MNH2REAL_MPI in modd_precision)
!-------------------------------------------------------------------------------
!
USE MODD_STRUCTURE_ll
@@ -118,11 +110,6 @@ INTEGER,SAVE :: NZ_PROC_ll = 0 ! Number of proc to use in the Z splitting
! DIMX = NIMAX + 2*JPHEXT ...
!
INTEGER :: DIMX,DIMY,DIMZ
-!
-! MPI_PRECISION, MPI_2PRECISION
-!
- INTEGER :: MPI_PRECISION
- INTEGER :: MPI_2PRECISION
!
INTEGER, PARAMETER :: NTMAX = 100
!
diff --git a/src/LIB/SURCOUCHE/src/mode_allocbuff.f90 b/src/LIB/SURCOUCHE/src/mode_allocbuff.f90
index b6ba6013377e30cd3a9dc5bee796f87a0e1df4cc..e6d0e9a1a0fd514b227262f16a607f59a7710e2b 100644
--- a/src/LIB/SURCOUCHE/src/mode_allocbuff.f90
+++ b/src/LIB/SURCOUCHE/src/mode_allocbuff.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! Modifications:
@@ -8,8 +8,8 @@
!-----------------------------------------------------------------
MODULE MODE_ALLOCBUFFER_ll
-USE MODE_TOOLS_ll, ONLY : GET_GLOBALDIMS_ll
-USE MODD_PARAMETERS_ll,ONLY : JPHEXT
+USE MODE_TOOLS_ll, ONLY: GET_GLOBALDIMS_ll
+USE MODD_PARAMETERS_ll, ONLY: JPHEXT
IMPLICIT NONE
@@ -51,7 +51,7 @@ END SELECT
END SUBROUTINE ALLOCBUFFER_N1
SUBROUTINE ALLOCBUFFER_N2(KTAB_P,KTAB,HDIR,OALLOC)
-USE MODD_IO_ll, ONLY : LPACK, L2D
+USE MODD_IO, ONLY: LPACK, L2D
!
INTEGER,DIMENSION(:,:),POINTER :: KTAB_P
INTEGER,DIMENSION(:,:),TARGET,INTENT(IN) :: KTAB
@@ -85,7 +85,7 @@ END SELECT
END SUBROUTINE ALLOCBUFFER_N2
SUBROUTINE ALLOCBUFFER_N3(KTAB_P,KTAB,HDIR,OALLOC)
-USE MODD_IO_ll, ONLY : LPACK, L2D
+USE MODD_IO, ONLY: LPACK, L2D
!
INTEGER,DIMENSION(:,:,:),POINTER :: KTAB_P
INTEGER,DIMENSION(:,:,:),TARGET,INTENT(IN) :: KTAB
@@ -179,7 +179,7 @@ END SELECT
END SUBROUTINE ALLOCBUFFER_X1
SUBROUTINE ALLOCBUFFER_X2(PTAB_P,PTAB,HDIR,OALLOC, KIMAX_ll, KJMAX_ll)
-USE MODD_IO_ll, ONLY : LPACK, L2D
+USE MODD_IO, ONLY: LPACK, L2D
!
REAL,DIMENSION(:,:),POINTER :: PTAB_P
REAL,DIMENSION(:,:),TARGET,INTENT(IN) :: PTAB
@@ -229,7 +229,7 @@ END SELECT
END SUBROUTINE ALLOCBUFFER_X2
SUBROUTINE ALLOCBUFFER_X3(PTAB_P,PTAB,HDIR,OALLOC)
-USE MODD_IO_ll, ONLY : LPACK, L2D
+USE MODD_IO, ONLY: LPACK, L2D
!
REAL,DIMENSION(:,:,:),POINTER :: PTAB_P
REAL,DIMENSION(:,:,:),TARGET,INTENT(IN) :: PTAB
@@ -263,7 +263,7 @@ END SELECT
END SUBROUTINE ALLOCBUFFER_X3
SUBROUTINE ALLOCBUFFER_X4(PTAB_P,PTAB,HDIR,OALLOC)
-USE MODD_IO_ll, ONLY : LPACK, L2D
+USE MODD_IO, ONLY: LPACK, L2D
!
REAL,DIMENSION(:,:,:,:),POINTER :: PTAB_P
REAL,DIMENSION(:,:,:,:),TARGET,INTENT(IN) :: PTAB
@@ -299,7 +299,7 @@ END SELECT
END SUBROUTINE ALLOCBUFFER_X4
SUBROUTINE ALLOCBUFFER_X5(PTAB_P,PTAB,HDIR,OALLOC)
-USE MODD_IO_ll, ONLY : LPACK, L2D
+USE MODD_IO, ONLY: LPACK, L2D
!
REAL,DIMENSION(:,:,:,:,:),POINTER :: PTAB_P
REAL,DIMENSION(:,:,:,:,:),TARGET,INTENT(IN) :: PTAB
@@ -337,7 +337,7 @@ END SELECT
END SUBROUTINE ALLOCBUFFER_X5
SUBROUTINE ALLOCBUFFER_X6(PTAB_P,PTAB,HDIR,OALLOC)
-USE MODD_IO_ll, ONLY : LPACK, L2D
+USE MODD_IO, ONLY: LPACK, L2D
!
REAL,DIMENSION(:,:,:,:,:,:),POINTER :: PTAB_P
REAL,DIMENSION(:,:,:,:,:,:),TARGET,INTENT(IN) :: PTAB
diff --git a/src/LIB/SURCOUCHE/src/mode_argslist_ll.f90 b/src/LIB/SURCOUCHE/src/mode_argslist_ll.f90
index 75cf82b4e94662d4aa0fac4898f686313f0403ec..c88faab8c9d573f85b7d552aed9ca4050fa1f5df 100644
--- a/src/LIB/SURCOUCHE/src/mode_argslist_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_argslist_ll.f90
@@ -1,16 +1,8 @@
-!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 MODE_ARGSLIST_ll
@@ -55,6 +47,7 @@
!! Modifications
!! -------------
! Original May 19, 1998
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!
!-------------------------------------------------------------------------------
!
@@ -100,6 +93,8 @@
!
!* 0.1 declarations of arguments
!
+ use mode_msg
+
IMPLICIT NONE
!
TYPE(LIST1D_ll), POINTER :: TPLIST ! list of fields
@@ -116,8 +111,7 @@
!* 1. Test value of HDIR
!
IF (HDIR /= "X" .AND. HDIR /= "Y") THEN
- WRITE(*,*) 'Error ADD1DFIELD : Bad HDIR argument'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'ADD1DFIELD', 'bad HDIR argument ('//HDIR//')' )
ENDIF
!
!-------------------------------------------------------------------------------
diff --git a/src/LIB/SURCOUCHE/src/mode_distriblb.f90 b/src/LIB/SURCOUCHE/src/mode_distriblb.f90
index e3d13ec6fb584c37f1202ed2e0af152b3c1f180a..5a5c40fff8093fe7b063a94510a77b5f76ec8842 100644
--- a/src/LIB/SURCOUCHE/src/mode_distriblb.f90
+++ b/src/LIB/SURCOUCHE/src/mode_distriblb.f90
@@ -1,17 +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$
-!-----------------------------------------------------------------
-!Correction :
-! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+! Modifications:
+! J. Escobar 15/09/2015: WENO5 & JPHEXT <> 1
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-----------------------------------------------------------------
! #############################
@@ -103,12 +97,16 @@ END SUBROUTINE GET_DISTRIB_LB
!! MODIFICATIONS
!! -------------
!! Original 23/09/98
+!! Modif
+!! J.Escobar 28/03/2019: for very small domain , force N/S/E/W check on getting LB bounds
!-------------------------------------------------------------------------------
!
-USE MODD_PARAMETERS_ll,ONLY : JPHEXT
-USE MODD_VAR_ll, ONLY : TCRRT_PROCONF
-USE MODD_STRUCTURE_ll, ONLY : MODELSPLITTING_ll
-USE MODE_TOOLS_ll, ONLY : GET_INTERSECTION_ll,GET_GLOBALDIMS_ll,LWEST_ll
+USE MODD_PARAMETERS_ll, ONLY: JPHEXT
+USE MODD_STRUCTURE_ll, ONLY: MODELSPLITTING_ll
+USE MODD_VAR_ll, ONLY: TCRRT_PROCONF
+
+use mode_msg
+USE MODE_TOOLS_ll, ONLY: GET_INTERSECTION_ll, GET_GLOBALDIMS_ll, LWEST_ll, LEAST_ll
!* 0. DECLARATIONS
! ------------
@@ -150,8 +148,7 @@ CASE('READ')
CASE('WRITE')
YMODE = 'PHYS'
CASE default
- WRITE(*,*) 'Error in GET_DISTRIBX_LB...'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'GET_DISTRIBX_LB', 'invalid dummy argument HMODE ('//trim(HMODE)//')' )
END SELECT
!
CALL GET_GLOBALDIMS_ll(IIMAX_ll, IJMAX_ll)
@@ -191,7 +188,7 @@ ELSE
IYEND=IJMAX_ll+ 2 * JPHEXT
ENDIF
CALL GET_INTERSECTION_ll(IXOR,IYOR,IXEND,IYEND,IXORI,IYORI,IXENDI,IYENDI,YMODE,IINFO,KIP)
-IF (IINFO /= 1) THEN ! no empty intersection
+IF (IINFO/=1 .AND. LWEST_ll(KIP) ) THEN ! no empty intersection
IF (HCOORD == 'LOC') THEN
KIB=IXORI
KIE=IXENDI
@@ -219,8 +216,7 @@ IF (IINFO /= 1) THEN ! no empty intersection
KJB=IYORI + IYOR3DX -1
KJE=IYENDI+ IYOR3DX- 1
ELSE
- WRITE(*,*) 'Error in GET_DISTRIBX_LB...'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'GET_DISTRIBX_LB', 'invalid dummy argument HCOORD ('//trim(HCOORD)//')' )
ENDIF
END IF
@@ -242,7 +238,7 @@ ELSE
IYEND=IJMAX_ll+ 2 * JPHEXT
ENDIF
CALL GET_INTERSECTION_ll(IXOR,IYOR,IXEND,IYEND,IXORI,IYORI,IXENDI,IYENDI,YMODE,IINFO,KIP)
-IF (IINFO /=1) THEN
+IF (IINFO/=1 .AND. LEAST_ll(KIP) ) THEN
IF (HCOORD == 'LOC') THEN
IF (KIB == 0) KIB=1+KIE
KIE=KIE+1+IXENDI-IXORI
@@ -314,10 +310,12 @@ END SUBROUTINE GET_DISTRIBX_LB
!! Original 23/09/98
!-------------------------------------------------------------------------------
!
-USE MODD_PARAMETERS_ll,ONLY : JPHEXT
-USE MODD_VAR_ll, ONLY : TCRRT_PROCONF
-USE MODD_STRUCTURE_ll, ONLY : MODELSPLITTING_ll
-USE MODE_TOOLS_ll, ONLY : GET_INTERSECTION_ll,GET_GLOBALDIMS_ll,LSOUTH_ll
+USE MODD_PARAMETERS_ll, ONLY: JPHEXT
+USE MODD_STRUCTURE_ll, ONLY: MODELSPLITTING_ll
+USE MODD_VAR_ll, ONLY: TCRRT_PROCONF
+
+use mode_msg
+USE MODE_TOOLS_ll, ONLY: GET_INTERSECTION_ll, GET_GLOBALDIMS_ll, LNORTH_ll, LSOUTH_ll
!* 0. DECLARATIONS
! ------------
!* 0.1 declarations of arguments
@@ -356,8 +354,7 @@ CASE('READ')
CASE('WRITE')
YMODE = 'PHYS'
CASE default
- WRITE(*,*) 'Error in GET_DISTRIBX_LB...'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'GET_DISTRIBY_LB', 'invalid dummy argument HMODE ('//trim(HMODE)//')' )
END SELECT
!
CALL GET_GLOBALDIMS_ll(IIMAX_ll, IJMAX_ll)
@@ -396,7 +393,7 @@ ELSE
IYEND=JPHEXT !1
ENDIF
CALL GET_INTERSECTION_ll(IXOR,IYOR,IXEND,IYEND,IXORI,IYORI,IXENDI,IYENDI,YMODE,IINFO,KIP)
-IF (IINFO /= 1) THEN ! no empty intersection
+IF (IINFO/=1 .AND. LSOUTH_ll(KIP) ) THEN ! no empty intersection
IF (HCOORD == 'LOC') THEN
KIB=IXORI
KIE=IXENDI
@@ -442,7 +439,7 @@ ELSE
IYEND=IJMAX_ll + 2 * JPHEXT - JPHEXT + JPHEXT ! + 2 * JPHEXT
ENDIF
CALL GET_INTERSECTION_ll(IXOR,IYOR,IXEND,IYEND,IXORI,IYORI,IXENDI,IYENDI,YMODE,IINFO,KIP)
-IF (IINFO /=1) THEN
+IF (IINFO/=1 .AND. LNORTH_ll(KIP) ) THEN
IF (HCOORD == 'LOC') THEN
KIB=IXORI
KIE=IXENDI
diff --git a/src/LIB/SURCOUCHE/src/mode_double_double.f90 b/src/LIB/SURCOUCHE/src/mode_double_double.f90
index 19f0b36104e273539c2579bf71471b2806546eef..809944ce84da22fcc09397b1a5ff0542bc96b098 100644
--- a/src/LIB/SURCOUCHE/src/mode_double_double.f90
+++ b/src/LIB/SURCOUCHE/src/mode_double_double.f90
@@ -43,24 +43,13 @@ MODULE mode_repro_sum
CONTAINS
SUBROUTINE INIT_DD(KINFO)
+ use modd_precision, only: MNHREAL_MPI
IMPLICIT NONE
INTEGER, INTENT(OUT) :: KINFO ! MPI return status
- REAL :: REAL_DEFAULT
- INTEGER,PARAMETER :: REAL_KIND=KIND(REAL_DEFAULT)
- INTEGER :: MNH_MPI_REAL
-
- !
- ! find the default type of REAL for MESONH on MPI
- !
- IF (REAL_KIND .EQ. 4 ) THEN
- MNH_MPI_REAL = MPI_REAL4
- ELSE
- MNH_MPI_REAL = MPI_REAL8
- END IF
!
! define the double-double for MPI
!
- CALL MPI_TYPE_CONTIGUOUS(2, MNH_MPI_REAL ,MNH_DOUBLE_DOUBLE , KINFO)
+ CALL MPI_TYPE_CONTIGUOUS(2, MNHREAL_MPI ,MNH_DOUBLE_DOUBLE , KINFO)
CALL MPI_TYPE_COMMIT(MNH_DOUBLE_DOUBLE , KINFO)
!
! define the double-double sum = MNH_SUM_DD for MPI
diff --git a/src/LIB/SURCOUCHE/src/mode_exchange2_ll.f90 b/src/LIB/SURCOUCHE/src/mode_exchange2_ll.f90
index 767482a5ccab76a4db3d721566ebbc2e0e097dcc..dec89ca379f9b9850675115ac64a81174c89ab45 100644
--- a/src/LIB/SURCOUCHE/src/mode_exchange2_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_exchange2_ll.f90
@@ -1,14 +1,8 @@
-!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$
!-----------------------------------------------------------------
!Correction :
! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
@@ -61,14 +55,14 @@
! and local processor
! NHALO2_COM - MPI communicator for halo 2
! NCOMBUFFSIZE2 - buffer size
-! MPI_PRECISION - mpi precision
+! MNHREAL_MPI - mpi precision
! NNEXTTAG, NMAXTAG - variable to define message tag
!
!! Modifications
!! -------------
! Original May 19, 1998
! R. Guivarch June 24, 1998 _ll
-! R. Guivarch June 29, 1998 MPI_PRECISION
+! R. Guivarch June 29, 1998 MNHREAL_MPI
! N. Gicquel October 30, 1998 COPY_CRSPD2
! J.Escobar 10/02/2012 : Bug , in MPI_RECV replace
! MPI_STATUSES_IGNORE with MPI_STATUS_IGNORE
@@ -691,7 +685,6 @@
! Module MODD_VAR_ll
! IP - Number of local processor=subdomain
! NCOMBUFFSIZE2 - buffer size
-! MPI_PRECISION - mpi precision
! NNEXTTAG, NMAXTAG - variable to define message tag
!
!! Reference
@@ -707,8 +700,8 @@
!
USE MODD_STRUCTURE_ll, ONLY : CRSPD_ll, ZONE_ll
USE MODD_ARGSLIST_ll, ONLY : LIST_ll, HALO2LIST_ll
-!
- USE MODD_VAR_ll, ONLY : NCOMBUFFSIZE2, IP, MPI_PRECISION, NNEXTTAG, NMAXTAG
+ use modd_precision, only: MNHREAL_MPI
+ USE MODD_VAR_ll, ONLY : NCOMBUFFSIZE2, IP, NNEXTTAG, NMAXTAG
USE MODE_EXCHANGE_ll, ONLY : FILLIN_BUFFERS
USE MODD_MPIF
!JUANZ
@@ -829,13 +822,13 @@ INTEGER :: NB_REQ,NFIRST_REQ_RECV
!JUAN
!if defined(MNH_MPI_BSEND)
IF (LMNH_MPI_BSEND) THEN
- CALL MPI_BSEND(TZBUFFER, JINC, MPI_PRECISION, &
+ CALL MPI_BSEND(TZBUFFER, JINC, MNHREAL_MPI, &
TZZONESEND%NUMBER - 1, TZZONESEND%MSSGTAG + ITAGOFFSET, &
KMPI_COMM, KERROR)
else
!JUAN
!if defined(MNH_MPI_ISEND)
- CALL MPI_ISEND(TZBUFFER(1,NB_REQ), JINC, MPI_PRECISION, &
+ CALL MPI_ISEND(TZBUFFER(1,NB_REQ), JINC, MNHREAL_MPI, &
TZZONESEND%NUMBER - 1, TZZONESEND%MSSGTAG + ITAGOFFSET, &
KMPI_COMM, REQ_TAB(NB_REQ), KERROR)
@@ -864,12 +857,12 @@ else
!if defined (MNH_MPI_ISEND)
IF ( .NOT. LMNH_MPI_BSEND) THEN
NB_REQ = NB_REQ + 1
- CALL MPI_IRECV(TZBUFFER(1,NB_REQ), NCOMBUFFSIZE2, MPI_PRECISION, &
+ CALL MPI_IRECV(TZBUFFER(1,NB_REQ), NCOMBUFFSIZE2, MNHREAL_MPI, &
TPMAILRECV%TELT%NUMBER-1, &
TPMAILRECV%TELT%MSSGTAG + ITAGOFFSET, &
KMPI_COMM, REQ_TAB(NB_REQ), KERROR)
else
- CALL MPI_RECV(TZBUFFER, NCOMBUFFSIZE2, MPI_PRECISION, &
+ CALL MPI_RECV(TZBUFFER, NCOMBUFFSIZE2, MNHREAL_MPI, &
TPMAILRECV%TELT%NUMBER-1, &
TPMAILRECV%TELT%MSSGTAG + ITAGOFFSET, &
KMPI_COMM, MPI_STATUS_IGNORE, KERROR)
diff --git a/src/LIB/SURCOUCHE/src/mode_exchange_ll.f90 b/src/LIB/SURCOUCHE/src/mode_exchange_ll.f90
index 990c2182856eaa0b485e253101cc1654a867ccfc..d9bd7a2666576b244c0621cbe56ecc3b4b69cb84 100644
--- a/src/LIB/SURCOUCHE/src/mode_exchange_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_exchange_ll.f90
@@ -1,6 +1,6 @@
-!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.
!-----------------------------------------------------------------
! Modifications:
@@ -37,7 +37,6 @@
! IP - Number of local processor=subdomain
! TCRRT_COMDATA - Current communication data structure for current model
! and local processor
-! MPI_PRECISION - mpi precision
! JPHALO - size of the halo
! NCOMBUFFSIZE1 - buffer sizs
! NHALO_COM - mpi communicator
@@ -68,7 +67,7 @@
!! Modifications
!! -------------
! Original May 19, 1998
-! R. Guivarch June 29, 1998 MPI_PRECISION
+! R. Guivarch June 29, 1998 MNHREAL_MPI
! N. Gicquel, P. Kloos - October 01, 1998 - COPY_CRSPD,
! COPY_ZONE, COPY_CRSPD_TRANS, COPY_ZONE_TRANS
! M. Moge 01/12/14 UPDATE_HALO_EXTENDED
@@ -399,7 +398,6 @@
! Module MODD_VAR_ll
! TCRRT_COMDATA - Current communication data structure for current model
! and local processor
-! MPI_PRECISION - mpi precision
! JPHALO - size of the halo
!
! Module MODD_DIM_ll
@@ -419,7 +417,8 @@
!* 0. DECLARATIONS
!
USE MODD_DIM_ll, ONLY : CLBCX, CLBCY
- USE MODD_VAR_ll, ONLY : TCRRT_COMDATA, MPI_PRECISION, JPHALO
+ use modd_precision, only: MNHREAL_MPI
+ USE MODD_VAR_ll, ONLY : TCRRT_COMDATA, JPHALO
!
USE MODE_TOOLS_ll, ONLY : GET_INDICE_ll, LEAST_ll, LWEST_ll
!JUANZ
@@ -476,12 +475,12 @@ INTEGER :: NB_REQ
!
!if defined(MNH_MPI_BSEND)
IF (LMNH_MPI_BSEND) THEN
- CALL MPI_BSEND(PFIELD(IXOR), JPHALO, MPI_PRECISION, &
+ CALL MPI_BSEND(PFIELD(IXOR), JPHALO, MNHREAL_MPI, &
TCRRT_COMDATA%HALO1DX%NSEND_WEST(J)-1, &
1, NMNH_COMM_WORLD, KINFO)
else
NB_REQ = NB_REQ + 1
- CALL MPI_ISEND(PFIELD(IXOR), JPHALO, MPI_PRECISION, &
+ CALL MPI_ISEND(PFIELD(IXOR), JPHALO, MNHREAL_MPI, &
TCRRT_COMDATA%HALO1DX%NSEND_WEST(J)-1, &
1, NMNH_COMM_WORLD, REQ_TAB(NB_REQ), KINFO)
@@ -493,14 +492,14 @@ INTEGER :: NB_REQ
!
!if defined(MNH_MPI_BSEND)
IF (LMNH_MPI_BSEND) THEN
- CALL MPI_BSEND(PFIELD(IXEND-JPHALO+1), JPHALO, MPI_PRECISION, &
+ CALL MPI_BSEND(PFIELD(IXEND-JPHALO+1), JPHALO, MNHREAL_MPI, &
TCRRT_COMDATA%HALO1DX%NSEND_EAST(J)-1, &
2, NMNH_COMM_WORLD, KINFO)
else
!JUAN
!if defined(MNH_MPI_ISEND)
NB_REQ = NB_REQ + 1
- CALL MPI_ISEND(PFIELD(IXEND-JPHALO+1), JPHALO, MPI_PRECISION, &
+ CALL MPI_ISEND(PFIELD(IXEND-JPHALO+1), JPHALO, MNHREAL_MPI, &
TCRRT_COMDATA%HALO1DX%NSEND_EAST(J)-1, &
2, NMNH_COMM_WORLD, REQ_TAB(NB_REQ), KINFO)
@@ -520,11 +519,11 @@ INTEGER :: NB_REQ
!if defined(MNH_MPI_ISEND)
IF ( .NOT. LMNH_MPI_BSEND) THEN
NB_REQ = NB_REQ + 1
- CALL MPI_IRECV(PFIELD(IXEND+1), JPHALO, MPI_PRECISION, &
+ CALL MPI_IRECV(PFIELD(IXEND+1), JPHALO, MNHREAL_MPI, &
TCRRT_COMDATA%HALO1DX%NRECV_EAST-1, 1, &
NMNH_COMM_WORLD, REQ_TAB(NB_REQ), KINFO)
else
- CALL MPI_RECV(PFIELD(IXEND+1), JPHALO, MPI_PRECISION, &
+ CALL MPI_RECV(PFIELD(IXEND+1), JPHALO, MNHREAL_MPI, &
TCRRT_COMDATA%HALO1DX%NRECV_EAST-1, 1, &
NMNH_COMM_WORLD, ISTATUS, KINFO)
endif
@@ -538,11 +537,11 @@ INTEGER :: NB_REQ
!if defined(MNH_MPI_ISEND)
IF ( .NOT. LMNH_MPI_BSEND) THEN
NB_REQ = NB_REQ + 1
- CALL MPI_IRECV(PFIELD(1), JPHALO, MPI_PRECISION, &
+ CALL MPI_IRECV(PFIELD(1), JPHALO, MNHREAL_MPI, &
TCRRT_COMDATA%HALO1DX%NRECV_WEST-1, 2, &
NMNH_COMM_WORLD, REQ_TAB(NB_REQ), KINFO)
else
- CALL MPI_RECV(PFIELD(1), JPHALO, MPI_PRECISION, &
+ CALL MPI_RECV(PFIELD(1), JPHALO, MNHREAL_MPI, &
TCRRT_COMDATA%HALO1DX%NRECV_WEST-1, 2, &
NMNH_COMM_WORLD, ISTATUS, KINFO)
endif
@@ -587,7 +586,6 @@ INTEGER :: NB_REQ
! Module MODD_VAR_ll
! TCRRT_COMDATA - Current communication data structure for current model
! and local processor
-! MPI_PRECISION - mpi precision
! JPHALO - size of the halo
!
! Module MODD_DIM_ll
@@ -599,7 +597,8 @@ INTEGER :: NB_REQ
!* 0. DECLARATIONS
!
USE MODD_DIM_ll, ONLY : CLBCX, CLBCY
- USE MODD_VAR_ll, ONLY : TCRRT_COMDATA, JPHALO, MPI_PRECISION
+ use modd_precision, only: MNHREAL_MPI
+ USE MODD_VAR_ll, ONLY : TCRRT_COMDATA, JPHALO
!
USE MODE_TOOLS_ll, ONLY : GET_INDICE_ll, LNORTH_ll, LSOUTH_ll
!
@@ -655,13 +654,13 @@ INTEGER :: NB_REQ
!
!if defined(MNH_MPI_BSEND)
IF (LMNH_MPI_BSEND) THEN
- CALL MPI_BSEND(PFIELD(IYOR), JPHALO, MPI_PRECISION, &
+ CALL MPI_BSEND(PFIELD(IYOR), JPHALO, MNHREAL_MPI, &
TCRRT_COMDATA%HALO1DY%NSEND_SOUTH(J)-1, &
1, NMNH_COMM_WORLD, KINFO)
else
NB_REQ = NB_REQ + 1
- CALL MPI_ISEND(PFIELD(IYOR), JPHALO, MPI_PRECISION, &
+ CALL MPI_ISEND(PFIELD(IYOR), JPHALO, MNHREAL_MPI, &
TCRRT_COMDATA%HALO1DY%NSEND_SOUTH(J)-1, &
1, NMNH_COMM_WORLD, REQ_TAB(NB_REQ), KINFO)
@@ -673,14 +672,14 @@ INTEGER :: NB_REQ
!
!if defined(MNH_MPI_BSEND)
IF (LMNH_MPI_BSEND) THEN
- CALL MPI_BSEND(PFIELD(IYEND-JPHALO+1), JPHALO, MPI_PRECISION, &
+ CALL MPI_BSEND(PFIELD(IYEND-JPHALO+1), JPHALO, MNHREAL_MPI, &
TCRRT_COMDATA%HALO1DY%NSEND_NORTH(J)-1, &
2, NMNH_COMM_WORLD, KINFO)
else
!JUAN
!if defined(MNH_MPI_ISEND)
NB_REQ = NB_REQ + 1
- CALL MPI_ISEND(PFIELD(IYEND-JPHALO+1), JPHALO, MPI_PRECISION, &
+ CALL MPI_ISEND(PFIELD(IYEND-JPHALO+1), JPHALO, MNHREAL_MPI, &
TCRRT_COMDATA%HALO1DY%NSEND_NORTH(J)-1, &
2, NMNH_COMM_WORLD, REQ_TAB(NB_REQ), KINFO)
@@ -699,11 +698,11 @@ INTEGER :: NB_REQ
!if defined(MNH_MPI_ISEND)
IF ( .NOT. LMNH_MPI_BSEND) THEN
NB_REQ = NB_REQ + 1
- CALL MPI_IRECV(PFIELD(IYEND+1), JPHALO, MPI_PRECISION, &
+ CALL MPI_IRECV(PFIELD(IYEND+1), JPHALO, MNHREAL_MPI, &
TCRRT_COMDATA%HALO1DY%NRECV_NORTH-1, 1, &
NMNH_COMM_WORLD, REQ_TAB(NB_REQ), KINFO)
else
- CALL MPI_RECV(PFIELD(IYEND+1), JPHALO, MPI_PRECISION, &
+ CALL MPI_RECV(PFIELD(IYEND+1), JPHALO, MNHREAL_MPI, &
TCRRT_COMDATA%HALO1DY%NRECV_NORTH-1, 1, &
NMNH_COMM_WORLD, ISTATUS, KINFO)
endif
@@ -717,11 +716,11 @@ INTEGER :: NB_REQ
!if defined(MNH_MPI_ISEND)
IF ( .NOT. LMNH_MPI_BSEND) THEN
NB_REQ = NB_REQ + 1
- CALL MPI_IRECV(PFIELD(1), JPHALO, MPI_PRECISION, &
+ CALL MPI_IRECV(PFIELD(1), JPHALO, MNHREAL_MPI, &
TCRRT_COMDATA%HALO1DY%NRECV_SOUTH-1, 2, &
NMNH_COMM_WORLD, REQ_TAB(NB_REQ), KINFO)
else
- CALL MPI_RECV(PFIELD(1), JPHALO, MPI_PRECISION, &
+ CALL MPI_RECV(PFIELD(1), JPHALO, MNHREAL_MPI, &
TCRRT_COMDATA%HALO1DY%NRECV_SOUTH-1, 2, &
NMNH_COMM_WORLD, ISTATUS, KINFO)
endif
@@ -1899,7 +1898,6 @@ INTEGER :: NB_REQ
! IP - Number of local processor=subdomain
! NCOMBUFFSIZE1 - buffer size
! NTRANS_COM - mpi communicator
-! MPI_PRECISION - mpi precision
! NNEXTTAG, NMAXTAG - variable to define message tag
!
! Module MODD_PARAMETERS_ll
@@ -1922,8 +1920,9 @@ INTEGER :: NB_REQ
! ------------
!
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ use modd_precision, only: MNHREAL_MPI
USE MODD_STRUCTURE_ll, ONLY : CRSPD_ll, ZONE_ll
- USE MODD_VAR_ll, ONLY : NCOMBUFFSIZE1, IP, NTRANS_COM, MPI_PRECISION, &
+ USE MODD_VAR_ll, ONLY : NCOMBUFFSIZE1, IP, NTRANS_COM, &
NNEXTTAG, NMAXTAG
USE MODD_PARAMETERS_ll, ONLY : JPVEXT
USE MODD_DIM_ll, ONLY : NKMAX_TMP_ll
@@ -2096,11 +2095,11 @@ INTEGER :: NB_REQ,NFIRST_REQ_RECV
!
!if defined(MNH_MPI_BSEND)
IF (LMNH_MPI_BSEND) THEN
- CALL MPI_BSEND(TZBUFFER, JINC, MPI_PRECISION, TZZONESEND%NUMBER - 1, &
+ CALL MPI_BSEND(TZBUFFER, JINC, MNHREAL_MPI, TZZONESEND%NUMBER - 1, &
TZZONESEND%MSSGTAG + ITAGOFFSET, NTRANS_COM, KERROR)
else
- CALL MPI_ISEND(TZBUFFER(1,NB_REQ), JINC, MPI_PRECISION, TZZONESEND%NUMBER - 1, &
+ CALL MPI_ISEND(TZBUFFER(1,NB_REQ), JINC, MNHREAL_MPI, TZZONESEND%NUMBER - 1, &
TZZONESEND%MSSGTAG + ITAGOFFSET, NTRANS_COM, REQ_TAB(NB_REQ), KERROR)
endif
@@ -2128,13 +2127,13 @@ INTEGER :: NB_REQ,NFIRST_REQ_RECV
!if defined (MNH_MPI_ISEND)
IF ( .NOT. LMNH_MPI_BSEND) THEN
NB_REQ = NB_REQ + 1
- !JUAN NZ CALL MPI_IRECV(TZBUFFER(1,NB_REQ), NCOMBUFFSIZE1, MPI_PRECISION, &
- CALL MPI_IRECV(TZBUFFER(1,NB_REQ), IBUFFSIZE, MPI_PRECISION, &
+ !JUAN NZ CALL MPI_IRECV(TZBUFFER(1,NB_REQ), NCOMBUFFSIZE1, MNHREAL_MPI, &
+ CALL MPI_IRECV(TZBUFFER(1,NB_REQ), IBUFFSIZE, MNHREAL_MPI, &
TZZONERECV%NUMBER-1, TZZONERECV%MSSGTAG + ITAGOFFSET, &
NTRANS_COM, REQ_TAB(NB_REQ), KERROR)
else
- !JUAN NZ CALL MPI_RECV(TZBUFFER, NCOMBUFFSIZE1, MPI_PRECISION, TZZONERECV%NUMBER-1, &
- CALL MPI_RECV(TZBUFFER, IBUFFSIZE, MPI_PRECISION, TZZONERECV%NUMBER-1, &
+ !JUAN NZ CALL MPI_RECV(TZBUFFER, NCOMBUFFSIZE1, MNHREAL_MPI, TZZONERECV%NUMBER-1, &
+ CALL MPI_RECV(TZBUFFER, IBUFFSIZE, MNHREAL_MPI, TZZONERECV%NUMBER-1, &
TZZONERECV%MSSGTAG + ITAGOFFSET, NTRANS_COM, IRECVSTATUS, KERROR)
!JUAN
! Z axe
@@ -2292,7 +2291,6 @@ INTEGER :: NB_REQ,NFIRST_REQ_RECV
! IP - Number of local processor=subdomain
! NCOMBUFFSIZE1 - buffer size
! NTRANS_COM - mpi communicator
-! MPI_PRECISION - mpi precision
! NNEXTTAG, NMAXTAG - variable to define message tag
!
! Module MODD_PARAMETERS_ll
@@ -2311,8 +2309,9 @@ INTEGER :: NB_REQ,NFIRST_REQ_RECV
!-------------------------------------------------------------------------------
!
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ use modd_precision, only: MNHREAL_MPI
USE MODD_STRUCTURE_ll, ONLY : CRSPD_ll, ZONE_ll
- USE MODD_VAR_ll, ONLY : NCOMBUFFSIZE1, IP, MPI_PRECISION, NNEXTTAG, NMAXTAG
+ USE MODD_VAR_ll, ONLY : NCOMBUFFSIZE1, IP, NNEXTTAG, NMAXTAG
USE MODD_DIM_ll, ONLY : NKMAX_TMP_ll
USE MODD_PARAMETERS_ll, ONLY : JPVEXT
!
@@ -2464,12 +2463,12 @@ endif
! JUAN
!if defined(MNH_MPI_BSEND)
IF (LMNH_MPI_BSEND) THEN
- CALL MPI_BSEND(TZBUFFER, JINC, MPI_PRECISION, TZZONESEND%NUMBER - 1, &
+ CALL MPI_BSEND(TZBUFFER, JINC, MNHREAL_MPI, TZZONESEND%NUMBER - 1, &
TZZONESEND%MSSGTAG + ITAGOFFSET, KMPI_COMM, KERROR)
else
! JUAN
!if defined (MNH_MPI_ISEND)
- CALL MPI_ISEND(TZBUFFER(1,NB_REQ), JINC, MPI_PRECISION, TZZONESEND%NUMBER - 1, &
+ CALL MPI_ISEND(TZBUFFER(1,NB_REQ), JINC, MNHREAL_MPI, TZZONESEND%NUMBER - 1, &
TZZONESEND%MSSGTAG + ITAGOFFSET, KMPI_COMM, REQ_TAB(NB_REQ), KERROR)
endif
@@ -2495,12 +2494,12 @@ endif
!if defined (MNH_MPI_ISEND)
IF ( .NOT. LMNH_MPI_BSEND) THEN
NB_REQ = NB_REQ + 1
- CALL MPI_IRECV(TZBUFFER(1,NB_REQ), IBUFFSIZE, MPI_PRECISION, &
+ CALL MPI_IRECV(TZBUFFER(1,NB_REQ), IBUFFSIZE, MNHREAL_MPI, &
TPMAILRECV%TELT%NUMBER -1 , &
TPMAILRECV%TELT%MSSGTAG + ITAGOFFSET, &
KMPI_COMM, REQ_TAB(NB_REQ), KERROR)
else
- CALL MPI_RECV(TZBUFFER, IBUFFSIZE, MPI_PRECISION, &
+ CALL MPI_RECV(TZBUFFER, IBUFFSIZE, MNHREAL_MPI, &
TPMAILRECV%TELT%NUMBER -1 , &
TPMAILRECV%TELT%MSSGTAG + ITAGOFFSET, &
KMPI_COMM, IRECVSTATUS, KERROR)
diff --git a/src/LIB/SURCOUCHE/src/mode_field.f90 b/src/LIB/SURCOUCHE/src/mode_field.f90
index 8dce892d63c429a17a98a9d3a7cf1cc2546f3949..e025ae83960cd53d6284e71614dea75092f5602b 100644
--- a/src/LIB/SURCOUCHE/src/mode_field.f90
+++ b/src/LIB/SURCOUCHE/src/mode_field.f90
@@ -1,15 +1,22 @@
-!MNH_LIC Copyright 2016-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2016-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.
!-----------------------------------------------------------------
! Original version:
-! 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
+! Modifications:
+! P. Wautelet 29/01/2019: small bug correction (null pointers) in FIELDLIST_GOTO_MODEL if NESPGD or PGD
+! P. Wautelet 01/02/2019: bug correction in case XRT is not associated
+! 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
!-----------------------------------------------------------------
MODULE MODE_FIELD
!
USE MODD_CONF, ONLY : CPROGRAM
-USE MODD_IO_ll, ONLY : NVERB_DEBUG,NVERB_INFO,NVERB_WARNING,NVERB_ERROR,NVERB_FATAL
+USE MODD_IO, ONLY : NVERB_DEBUG, NVERB_INFO, NVERB_WARNING, NVERB_ERROR, NVERB_FATAL
USE MODD_PARAMETERS
USE MODD_TYPE_DATE, ONLY : DATE_TIME
#if defined(MNH_IOCDF4)
@@ -27,14 +34,26 @@ 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
@@ -63,6 +82,14 @@ 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
@@ -97,10 +124,13 @@ TYPE TFIELDDATA
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)
!
@@ -109,6 +139,8 @@ TYPE TFIELDDATA
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
@@ -892,6 +924,20 @@ ALLOCATE(TFIELDLIST(IDX)%TFIELD_X2D(IMODEL))
IDX = IDX+1
!
IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
+TFIELDLIST(IDX)%CMNHNAME = 'ZWS'
+TFIELDLIST(IDX)%CSTDNAME = 'sea_surface_wave_significant_height'
+TFIELDLIST(IDX)%CLONGNAME = 'ZWS'
+TFIELDLIST(IDX)%CUNITS = 'm'
+TFIELDLIST(IDX)%CDIR = 'XY'
+TFIELDLIST(IDX)%CCOMMENT = 'sea wave height'
+TFIELDLIST(IDX)%NGRID = 4
+TFIELDLIST(IDX)%NTYPE = TYPEREAL
+TFIELDLIST(IDX)%NDIMS = 2
+TFIELDLIST(IDX)%LTIMEDEP = .TRUE.
+ALLOCATE(TFIELDLIST(IDX)%TFIELD_X2D(IMODEL))
+IDX = IDX+1
+!
+IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
TFIELDLIST(IDX)%CMNHNAME = 'ZSMT'
TFIELDLIST(IDX)%CSTDNAME = ''
TFIELDLIST(IDX)%CLONGNAME = 'ZSMT'
@@ -2336,6 +2382,20 @@ TFIELDLIST(IDX)%LTIMEDEP = .TRUE.
ALLOCATE(TFIELDLIST(IDX)%TFIELD_X3D(IMODEL))
IDX = IDX+1
!
+IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
+TFIELDLIST(IDX)%CMNHNAME = 'RAINFR'
+TFIELDLIST(IDX)%CSTDNAME = ''
+TFIELDLIST(IDX)%CLONGNAME = 'RAINFR'
+TFIELDLIST(IDX)%CUNITS = '1'
+TFIELDLIST(IDX)%CDIR = 'XY'
+TFIELDLIST(IDX)%CCOMMENT = 'X_Y_Z_Rain FRaction'
+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
+!
END IF ! CPROGRAM=MESONH .OR. DIAG .OR. LFICDF
!
!
@@ -3806,18 +3866,17 @@ END IF
!
! 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)
IF (KFROM == KTO) THEN
- IF (.NOT.ALLOCATED(XRHODREFZ) .AND. CPROGRAM/='NESPGD' .AND. CPROGRAM/='PGD') THEN
- CALL PRINT_MSG(NVERB_FATAL,'GEN','FIELDLIST_GOTO_MODEL','XRHODREFZ not yet allocated')
+ IF ( CPROGRAM/='NESPGD' .AND. CPROGRAM/='PGD' ) THEN
+ IF (.NOT.ALLOCATED(XRHODREFZ)) CALL PRINT_MSG(NVERB_FATAL,'GEN','FIELDLIST_GOTO_MODEL','XRHODREFZ not yet allocated')
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RHOREFZ',IID,IRESP)
+ TFIELDLIST(IID)%TFIELD_X1D(KFROM)%DATA=>XRHODREFZ
+ !
+ IF (.NOT.ALLOCATED(XTHVREFZ)) CALL PRINT_MSG(NVERB_FATAL,'GEN','FIELDLIST_GOTO_MODEL','XTHVREFZ not yet allocated')
+ CALL FIND_FIELD_ID_FROM_MNHNAME('THVREFZ',IID,IRESP)
+ TFIELDLIST(IID)%TFIELD_X1D(KFROM)%DATA=>XTHVREFZ
END IF
- CALL FIND_FIELD_ID_FROM_MNHNAME('RHOREFZ',IID,IRESP)
- TFIELDLIST(IID)%TFIELD_X1D(KFROM)%DATA=>XRHODREFZ
- !
- IF (.NOT.ALLOCATED(XTHVREFZ) .AND. CPROGRAM/='NESPGD' .AND. CPROGRAM/='PGD') THEN
- CALL PRINT_MSG(NVERB_FATAL,'GEN','FIELDLIST_GOTO_MODEL','XTHVREFZ not yet allocated')
- END IF
- CALL FIND_FIELD_ID_FROM_MNHNAME('THVREFZ',IID,IRESP)
- TFIELDLIST(IID)%TFIELD_X1D(KFROM)%DATA=>XTHVREFZ
END IF
!
!
@@ -3831,6 +3890,7 @@ END IF
!
! MODD_FIELD_n variables
!
+CALL FIND_FIELD_ID_FROM_MNHNAME('ZWS', IID,IRESP); TFIELDLIST(IID)%TFIELD_X2D(KFROM)%DATA => XZWS
CALL FIND_FIELD_ID_FROM_MNHNAME('UT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XUT
CALL FIND_FIELD_ID_FROM_MNHNAME('VT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XVT
CALL FIND_FIELD_ID_FROM_MNHNAME('WT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XWT
@@ -3839,26 +3899,51 @@ CALL FIND_FIELD_ID_FROM_MNHNAME('TKET', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(K
CALL FIND_FIELD_ID_FROM_MNHNAME('PABST',IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XPABST
CALL FIND_FIELD_ID_FROM_MNHNAME('RT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X4D(KFROM)%DATA => XRT
!
-IF (CONF_MODEL(KFROM)%IDX_RVT>0) THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('RVT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA=>XRT(:,:,:,CONF_MODEL(KFROM)%IDX_RVT)
-END IF
-IF (CONF_MODEL(KFROM)%IDX_RCT>0) THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('RCT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA=>XRT(:,:,:,CONF_MODEL(KFROM)%IDX_RCT)
-END IF
-IF (CONF_MODEL(KFROM)%IDX_RRT>0) THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('RRT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA=>XRT(:,:,:,CONF_MODEL(KFROM)%IDX_RRT)
-END IF
-IF (CONF_MODEL(KFROM)%IDX_RIT>0) THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('RIT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA=>XRT(:,:,:,CONF_MODEL(KFROM)%IDX_RIT)
-END IF
-IF (CONF_MODEL(KFROM)%IDX_RST>0) THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('RST', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA=>XRT(:,:,:,CONF_MODEL(KFROM)%IDX_RST)
-END IF
-IF (CONF_MODEL(KFROM)%IDX_RGT>0) THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('RGT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA=>XRT(:,:,:,CONF_MODEL(KFROM)%IDX_RGT)
-END IF
-IF (CONF_MODEL(KFROM)%IDX_RHT>0) THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('RHT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA=>XRT(:,:,:,CONF_MODEL(KFROM)%IDX_RHT)
+IF (ASSOCIATED(XRT)) THEN
+ IF (CONF_MODEL(KFROM)%IDX_RVT>0) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RVT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA=>XRT(:,:,:,CONF_MODEL(KFROM)%IDX_RVT)
+ END IF
+ IF (CONF_MODEL(KFROM)%IDX_RCT>0) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RCT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA=>XRT(:,:,:,CONF_MODEL(KFROM)%IDX_RCT)
+ END IF
+ IF (CONF_MODEL(KFROM)%IDX_RRT>0) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RRT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA=>XRT(:,:,:,CONF_MODEL(KFROM)%IDX_RRT)
+ END IF
+ IF (CONF_MODEL(KFROM)%IDX_RIT>0) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RIT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA=>XRT(:,:,:,CONF_MODEL(KFROM)%IDX_RIT)
+ END IF
+ IF (CONF_MODEL(KFROM)%IDX_RST>0) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RST', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA=>XRT(:,:,:,CONF_MODEL(KFROM)%IDX_RST)
+ END IF
+ IF (CONF_MODEL(KFROM)%IDX_RGT>0) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RGT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA=>XRT(:,:,:,CONF_MODEL(KFROM)%IDX_RGT)
+ END IF
+ IF (CONF_MODEL(KFROM)%IDX_RHT>0) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RHT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA=>XRT(:,:,:,CONF_MODEL(KFROM)%IDX_RHT)
+ END IF
+ELSE
+ IF (CONF_MODEL(KFROM)%IDX_RVT>0) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RVT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA=>NULL()
+ END IF
+ IF (CONF_MODEL(KFROM)%IDX_RCT>0) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RCT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA=>NULL()
+ END IF
+ IF (CONF_MODEL(KFROM)%IDX_RRT>0) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RRT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA=>NULL()
+ END IF
+ IF (CONF_MODEL(KFROM)%IDX_RIT>0) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RIT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA=>NULL()
+ END IF
+ IF (CONF_MODEL(KFROM)%IDX_RST>0) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RST', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA=>NULL()
+ END IF
+ IF (CONF_MODEL(KFROM)%IDX_RGT>0) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RGT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA=>NULL()
+ END IF
+ IF (CONF_MODEL(KFROM)%IDX_RHT>0) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RHT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA=>NULL()
+ END IF
+
END IF
!
CALL FIND_FIELD_ID_FROM_MNHNAME('SUPSATMAX',IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XSUPSAT
@@ -3907,6 +3992,7 @@ IF (CPROGRAM == 'MESONH') THEN
END IF
CALL FIND_FIELD_ID_FROM_MNHNAME('CLDFR',IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XCLDFR
CALL FIND_FIELD_ID_FROM_MNHNAME('CIT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XCIT
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RAINFR',IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XRAINFR
!
END IF
!
@@ -4117,6 +4203,7 @@ IF( KFROM/=KTO) THEN
!
! MODD_FIELD_n variables
!
+CALL FIND_FIELD_ID_FROM_MNHNAME('ZWS', IID,IRESP); XZWS => TFIELDLIST(IID)%TFIELD_X2D(KTO)%DATA
CALL FIND_FIELD_ID_FROM_MNHNAME('UT', IID,IRESP); XUT => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
CALL FIND_FIELD_ID_FROM_MNHNAME('VT', IID,IRESP); XVT => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
CALL FIND_FIELD_ID_FROM_MNHNAME('WT', IID,IRESP); XWT => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
@@ -4125,33 +4212,64 @@ CALL FIND_FIELD_ID_FROM_MNHNAME('TKET', IID,IRESP); XTKET => TFIELDLIST(IID)%TF
CALL FIND_FIELD_ID_FROM_MNHNAME('PABST',IID,IRESP); XPABST => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
CALL FIND_FIELD_ID_FROM_MNHNAME('RT', IID,IRESP); XRT => TFIELDLIST(IID)%TFIELD_X4D(KTO)%DATA
!
-IF (CONF_MODEL(KTO)%IDX_RVT>0) THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('RVT',IID2,IRESP)
- TFIELDLIST(IID2)%TFIELD_X3D(KTO)%DATA => TFIELDLIST(IID)%TFIELD_X4D(KTO)%DATA(:,:,:,CONF_MODEL(KTO)%IDX_RVT)
-END IF
-IF (CONF_MODEL(KTO)%IDX_RCT>0) THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('RCT',IID2,IRESP)
- TFIELDLIST(IID2)%TFIELD_X3D(KTO)%DATA => TFIELDLIST(IID)%TFIELD_X4D(KTO)%DATA(:,:,:,CONF_MODEL(KTO)%IDX_RCT)
-END IF
-IF (CONF_MODEL(KTO)%IDX_RRT>0) THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('RRT',IID2,IRESP)
- TFIELDLIST(IID2)%TFIELD_X3D(KTO)%DATA => TFIELDLIST(IID)%TFIELD_X4D(KTO)%DATA(:,:,:,CONF_MODEL(KTO)%IDX_RRT)
-END IF
-IF (CONF_MODEL(KTO)%IDX_RIT>0) THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('RIT',IID2,IRESP)
- TFIELDLIST(IID2)%TFIELD_X3D(KTO)%DATA => TFIELDLIST(IID)%TFIELD_X4D(KTO)%DATA(:,:,:,CONF_MODEL(KTO)%IDX_RIT)
-END IF
-IF (CONF_MODEL(KTO)%IDX_RST>0) THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('RST',IID2,IRESP)
- TFIELDLIST(IID2)%TFIELD_X3D(KTO)%DATA => TFIELDLIST(IID)%TFIELD_X4D(KTO)%DATA(:,:,:,CONF_MODEL(KTO)%IDX_RST)
-END IF
-IF (CONF_MODEL(KTO)%IDX_RGT>0) THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('RGT',IID2,IRESP)
- TFIELDLIST(IID2)%TFIELD_X3D(KTO)%DATA => TFIELDLIST(IID)%TFIELD_X4D(KTO)%DATA(:,:,:,CONF_MODEL(KTO)%IDX_RGT)
-END IF
-IF (CONF_MODEL(KTO)%IDX_RHT>0) THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('RHT',IID2,IRESP)
- TFIELDLIST(IID2)%TFIELD_X3D(KTO)%DATA => TFIELDLIST(IID)%TFIELD_X4D(KTO)%DATA(:,:,:,CONF_MODEL(KTO)%IDX_RHT)
+IF (ASSOCIATED(XRT)) THEN
+ IF (CONF_MODEL(KTO)%IDX_RVT>0) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RVT',IID2,IRESP)
+ TFIELDLIST(IID2)%TFIELD_X3D(KTO)%DATA => TFIELDLIST(IID)%TFIELD_X4D(KTO)%DATA(:,:,:,CONF_MODEL(KTO)%IDX_RVT)
+ END IF
+ IF (CONF_MODEL(KTO)%IDX_RCT>0) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RCT',IID2,IRESP)
+ TFIELDLIST(IID2)%TFIELD_X3D(KTO)%DATA => TFIELDLIST(IID)%TFIELD_X4D(KTO)%DATA(:,:,:,CONF_MODEL(KTO)%IDX_RCT)
+ END IF
+ IF (CONF_MODEL(KTO)%IDX_RRT>0) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RRT',IID2,IRESP)
+ TFIELDLIST(IID2)%TFIELD_X3D(KTO)%DATA => TFIELDLIST(IID)%TFIELD_X4D(KTO)%DATA(:,:,:,CONF_MODEL(KTO)%IDX_RRT)
+ END IF
+ IF (CONF_MODEL(KTO)%IDX_RIT>0) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RIT',IID2,IRESP)
+ TFIELDLIST(IID2)%TFIELD_X3D(KTO)%DATA => TFIELDLIST(IID)%TFIELD_X4D(KTO)%DATA(:,:,:,CONF_MODEL(KTO)%IDX_RIT)
+ END IF
+ IF (CONF_MODEL(KTO)%IDX_RST>0) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RST',IID2,IRESP)
+ TFIELDLIST(IID2)%TFIELD_X3D(KTO)%DATA => TFIELDLIST(IID)%TFIELD_X4D(KTO)%DATA(:,:,:,CONF_MODEL(KTO)%IDX_RST)
+ END IF
+ IF (CONF_MODEL(KTO)%IDX_RGT>0) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RGT',IID2,IRESP)
+ TFIELDLIST(IID2)%TFIELD_X3D(KTO)%DATA => TFIELDLIST(IID)%TFIELD_X4D(KTO)%DATA(:,:,:,CONF_MODEL(KTO)%IDX_RGT)
+ END IF
+ IF (CONF_MODEL(KTO)%IDX_RHT>0) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RHT',IID2,IRESP)
+ TFIELDLIST(IID2)%TFIELD_X3D(KTO)%DATA => TFIELDLIST(IID)%TFIELD_X4D(KTO)%DATA(:,:,:,CONF_MODEL(KTO)%IDX_RHT)
+ END IF
+ELSE
+ IF (CONF_MODEL(KTO)%IDX_RVT>0) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RVT',IID2,IRESP)
+ TFIELDLIST(IID2)%TFIELD_X3D(KTO)%DATA => NULL()
+ END IF
+ IF (CONF_MODEL(KTO)%IDX_RCT>0) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RCT',IID2,IRESP)
+ TFIELDLIST(IID2)%TFIELD_X3D(KTO)%DATA => NULL()
+ END IF
+ IF (CONF_MODEL(KTO)%IDX_RRT>0) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RRT',IID2,IRESP)
+ TFIELDLIST(IID2)%TFIELD_X3D(KTO)%DATA => NULL()
+ END IF
+ IF (CONF_MODEL(KTO)%IDX_RIT>0) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RIT',IID2,IRESP)
+ TFIELDLIST(IID2)%TFIELD_X3D(KTO)%DATA => NULL()
+ END IF
+ IF (CONF_MODEL(KTO)%IDX_RST>0) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RST',IID2,IRESP)
+ TFIELDLIST(IID2)%TFIELD_X3D(KTO)%DATA => NULL()
+ END IF
+ IF (CONF_MODEL(KTO)%IDX_RGT>0) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RGT',IID2,IRESP)
+ TFIELDLIST(IID2)%TFIELD_X3D(KTO)%DATA => NULL()
+ END IF
+ IF (CONF_MODEL(KTO)%IDX_RHT>0) THEN
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RHT',IID2,IRESP)
+ TFIELDLIST(IID2)%TFIELD_X3D(KTO)%DATA => NULL()
+ END IF
END IF
!
CALL FIND_FIELD_ID_FROM_MNHNAME('SUPSATMAX',IID,IRESP); XSUPSAT => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
@@ -4200,6 +4318,7 @@ IF (CPROGRAM == 'MESONH') THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('THS_CLD',IID,IRESP); XRTHS_CLD => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
CALL FIND_FIELD_ID_FROM_MNHNAME('CLDFR', IID,IRESP); XCLDFR => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
CALL FIND_FIELD_ID_FROM_MNHNAME('CIT', IID,IRESP); XCIT => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
+ CALL FIND_FIELD_ID_FROM_MNHNAME('RAINFR', IID,IRESP); XRAINFR => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
END IF
!
! MODD_PAST_FIELD_n variables
diff --git a/src/LIB/SURCOUCHE/src/mode_fm.f90 b/src/LIB/SURCOUCHE/src/mode_fm.f90
deleted file mode 100644
index 02265538caf83cd8da4c91da4ec9c7bf87bf3cac..0000000000000000000000000000000000000000
--- a/src/LIB/SURCOUCHE/src/mode_fm.f90
+++ /dev/null
@@ -1,574 +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:
-! D.Gazen : avril 2016 change error message
-! P. Wautelet : may 2016: use NetCDF Fortran module
-! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! Philippe Wautelet: 29/10/2018: better detection of older MNH version numbers
-! Philippe Wautelet: 13/12/2018: moved some operations to new mode_io_*_nc4 modules
-! Philippe Wautelet: 10/01/2019: use NEWUNIT argument of OPEN + move management
-! of NNCID and NLFIFLU to the nc4 and lfi subroutines
-! 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)
-!-----------------------------------------------------------------
-
-MODULE MODE_FM
-USE MODD_MPIF
-
-USE MODE_MSG
-
-IMPLICIT NONE
-
-PRIVATE
-
-PUBLIC SET_FMPACK_ll
-PUBLIC IO_FILE_OPEN_ll, IO_FILE_CLOSE_ll
-
-CONTAINS
-
-SUBROUTINE SET_FMPACK_ll(O1D,O2D,OPACK)
-USE MODD_IO_ll, ONLY : LPACK,L1D,L2D
-!JUAN
-USE MODD_VAR_ll, ONLY : IP
-!JUAN
-
-IMPLICIT NONE
-
-LOGICAL, INTENT(IN) :: O1D,O2D,OPACK
-
-LPACK = OPACK
-L1D = O1D
-L2D = O2D
-
-IF ( IP .EQ. 1 ) PRINT *,'INIT L1D,L2D,LPACK = ',L1D,L2D,LPACK
-
-END SUBROUTINE SET_FMPACK_ll
-
-SUBROUTINE IO_FILE_OPEN_ll(TPFILE,KRESP,OPARALLELIO,HPOSITION,HSTATUS,HPROGRAM_ORIG)
-!
-USE MODD_CONF, ONLY: CPROGRAM
-USE MODD_IO_ll, ONLY: LIO_NO_WRITE, TFILEDATA
-USE MODE_FMREAD
-USE MODE_IO_ll, ONLY : OPEN_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST,IO_FILE_FIND_BYNAME
-!
-TYPE(TFILEDATA),POINTER,INTENT(INOUT) :: TPFILE ! File structure
-INTEGER, INTENT(OUT), OPTIONAL :: KRESP ! Return code
-LOGICAL, INTENT(IN), OPTIONAL :: OPARALLELIO
-CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HPOSITION
-CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HSTATUS
-CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HPROGRAM_ORIG !To emulate a file coming from this program
-!
-INTEGER :: IRESP
-TYPE(TFILEDATA),POINTER :: TZFILE_DES
-TYPE(TFILEDATA),POINTER :: TZFILE_DUMMY
-!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_FILE_OPEN_ll','opening '//TRIM(TPFILE%CNAME)//' for '//TRIM(TPFILE%CMODE)// &
- ' (filetype='//TRIM(TPFILE%CTYPE)//')')
-!
-IF (.NOT.ASSOCIATED(TPFILE)) CALL PRINT_MSG(NVERB_FATAL,'IO','IO_FILE_OPEN_ll','TPFILE is not associated')
-!
-IF ( LIO_NO_WRITE .AND. TPFILE%CMODE == 'WRITE' .AND. TPFILE%CTYPE/='OUTPUTLISTING') THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_FILE_OPEN_ll','opening file '//TRIM(TPFILE%CNAME)//' in write mode but LIO_NO_WRITE is set')
-END IF
-!
-TZFILE_DES => NULL()
-TZFILE_DUMMY => NULL()
-!
-TPFILE%NOPEN = TPFILE%NOPEN + 1
-TPFILE%NOPEN_CURRENT = TPFILE%NOPEN_CURRENT + 1
-!
-IF (TPFILE%LOPENED) THEN
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_FILE_OPEN_ll','file '//TRIM(TPFILE%CNAME)//' is already in open state')
- RETURN
-END IF
-!
-TPFILE%LOPENED = .TRUE.
-!
-!Check if file is in filelist
-CALL IO_FILE_FIND_BYNAME(TRIM(TPFILE%CNAME),TZFILE_DUMMY,IRESP)
-IF (IRESP/=0) CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_OPEN_ll','file '//TRIM(TPFILE%CNAME)//' not in filelist')
-!
-SELECT CASE(TPFILE%CTYPE)
- !Chemistry input files
- CASE('CHEMINPUT')
- CALL OPEN_ll(TPFILE,IOSTAT=IRESP,FORM='FORMATTED',POSITION='REWIND',STATUS='OLD',MODE='GLOBAL')
-
-
- !Chemistry tabulation files
- CASE('CHEMTAB')
- CALL OPEN_ll(TPFILE,IOSTAT=IRESP,FORM='FORMATTED',MODE='GLOBAL')
-
-
- !GPS files
- CASE('GPS')
- CALL OPEN_ll(TPFILE,IOSTAT=IRESP,FORM='FORMATTED',MODE='SPECIFIC')
-
-
- !Meteo files
- CASE('METEO')
- CALL OPEN_ll(TPFILE,IOSTAT=IRESP,FORM='UNFORMATTED',MODE='GLOBAL',RECL=100000000)
-
-
- !Namelist files
- CASE('NML')
- CALL OPEN_ll(TPFILE,IOSTAT=IRESP,DELIM='QUOTE',MODE='GLOBAL')
-
-
- !OUTPUTLISTING files
- CASE('OUTPUTLISTING')
- CALL OPEN_ll(TPFILE,IOSTAT=IRESP,FORM='FORMATTED',MODE='GLOBAL')
-
-
- !SURFACE_DATA files
- CASE('SURFACE_DATA')
- IF (TPFILE%CFORM=='FORMATTED') THEN
- CALL OPEN_ll(TPFILE,IOSTAT=IRESP,FORM=TPFILE%CFORM,MODE='GLOBAL')
- ELSE IF (TPFILE%CACCESS=='DIRECT') THEN
- CALL OPEN_ll(TPFILE,IOSTAT=IRESP,FORM=TPFILE%CFORM,ACCESS=TPFILE%CACCESS,RECL=TPFILE%NRECL,MODE='GLOBAL')
- ELSE
- CALL OPEN_ll(TPFILE,IOSTAT=IRESP,FORM=TPFILE%CFORM,MODE='GLOBAL')
- END IF
-
-
- !Text files
- CASE('TXT')
- IF(TPFILE%NRECL>0) THEN
- CALL OPEN_ll(TPFILE,IOSTAT=IRESP,FORM='FORMATTED',POSITION=HPOSITION,STATUS=HSTATUS,RECL=TPFILE%NRECL,MODE='GLOBAL')
- ELSE
- CALL OPEN_ll(TPFILE,IOSTAT=IRESP,FORM='FORMATTED',POSITION=HPOSITION,STATUS=HSTATUS,MODE='GLOBAL')
- END IF
-
-
- CASE DEFAULT
- !Do not open '.des' file if OUTPUT
- IF(TPFILE%CTYPE/='OUTPUT' .AND. CPROGRAM/='LFICDF') THEN
- CALL IO_FILE_ADD2LIST(TZFILE_DES,TRIM(TPFILE%CNAME)//'.des','DES',TPFILE%CMODE,TPDATAFILE=TPFILE,OOLD=.TRUE.) !OOLD=T because the file may already be in the list
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_FILE_OPEN_ll','OPEN_ll for '//TRIM(TPFILE%CNAME)//'.des')
- CALL OPEN_ll(TZFILE_DES,FORM='FORMATTED',DELIM='QUOTE',IOSTAT=IRESP,RECL=1024*8,OPARALLELIO=OPARALLELIO)
- TZFILE_DES%LOPENED = .TRUE.
- TZFILE_DES%NOPEN_CURRENT = TZFILE_DES%NOPEN_CURRENT + 1
- TZFILE_DES%NOPEN = TZFILE_DES%NOPEN + 1
- ENDIF
- !
- CALL FMOPEN_ll(TPFILE,IRESP,OPARALLELIO=OPARALLELIO,HPROGRAM_ORIG=HPROGRAM_ORIG)
-
-END SELECT
-!
-IF (PRESENT(KRESP)) KRESP = IRESP
-!
-END SUBROUTINE IO_FILE_OPEN_ll
-
-SUBROUTINE FMOPEN_ll(TPFILE,KRESP,OPARALLELIO,HPROGRAM_ORIG)
-USE MODD_IO_ll, ONLY: TFILEDATA
-USE MODE_IO_ll, ONLY: OPEN_ll,GCONFIO
-!JUANZ
-USE MODD_CONFZ,ONLY : NB_PROCIO_R,NB_PROCIO_W
-!JUANZ
-#if defined(MNH_IOCDF4)
-USE MODD_NETCDF, ONLY:IDCDF_KIND
-use mode_io_file_nc4, only: io_create_file_nc4, io_open_file_nc4
-#endif
-use mode_io_file_lfi, only: io_create_file_lfi, io_open_file_lfi
-
-TYPE(TFILEDATA), INTENT(INOUT) :: TPFILE ! File structure
-INTEGER, INTENT(OUT) :: KRESP ! return-code
-LOGICAL, INTENT(IN), OPTIONAL :: OPARALLELIO
-CHARACTER(LEN=*),INTENT(IN), OPTIONAL :: HPROGRAM_ORIG !To emulate a file coming from this program
-!
-! Local variables
-!
-INTEGER :: IROWF, IRESP
-CHARACTER(LEN=7) :: YACTION ! Action upon the file ('READ' or 'WRITE')
-CHARACTER(LEN=8) :: YRESP
-INTEGER :: IERR
-INTEGER :: INB_PROCIO
-LOGICAL :: GPARALLELIO
-LOGICAL :: GEXIST_LFI, GEXIST_NC4
-
-YACTION = TPFILE%CMODE
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','FMOPEN_ll','opening '//TRIM(TPFILE%CNAME)//' for '//TRIM(YACTION))
-
-IF ( PRESENT(OPARALLELIO) ) THEN
- GPARALLELIO = OPARALLELIO
-ELSE !par defaut on active les IO paralleles en Z si possible
- GPARALLELIO = .TRUE.
-ENDIF
-
-IF (.NOT. GCONFIO) THEN
- PRINT *, 'FMOPEN_ll Aborting... Please, ensure to call SET_CONFIO_ll before &
- &the first FMOPEN_ll call.'
- STOP
-END IF
-
-IROWF = 0
-IRESP = 0
-
-IROWF=LEN_TRIM(TPFILE%CNAME)
-
-IF (IROWF.EQ.0) THEN
- IRESP=-45
- GOTO 1000
-ENDIF
-
- SELECT CASE (YACTION)
- CASE('READ')
- INB_PROCIO = NB_PROCIO_R
- CASE('WRITE')
- INB_PROCIO = NB_PROCIO_W
- END SELECT
-CALL OPEN_ll(TPFILE,STATUS="UNKNOWN",MODE='IO_ZSPLIT',IOSTAT=IRESP, &
- KNB_PROCIO=INB_PROCIO,OPARALLELIO=GPARALLELIO,HPROGRAM_ORIG=HPROGRAM_ORIG)
-
-IF (IRESP /= 0) GOTO 1000
-
-IF (TPFILE%LMASTER) THEN
- ! Proc I/O case
- INQUIRE(FILE=TRIM(TPFILE%CNAME)//'.lfi',EXIST=GEXIST_LFI)
- INQUIRE(FILE=TRIM(TPFILE%CNAME)//'.nc',EXIST=GEXIST_NC4)
-
- IF (YACTION == 'READ') THEN
- IF (.NOT.GEXIST_LFI .AND. .NOT.GEXIST_NC4) &
- CALL PRINT_MSG(NVERB_FATAL,'IO','FMOPEN_ll',TRIM(TPFILE%CNAME)//': no .nc or .lfi file')
-
- SELECT CASE (TRIM(TPFILE%CFORMAT))
- CASE ('NETCDF4')
- IF (.NOT.GEXIST_NC4 .AND. GEXIST_LFI) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','FMOPEN_ll',TRIM(TPFILE%CNAME)// &
- ': .nc file does not exist but .lfi exists -> forced to LFI')
- TPFILE%CFORMAT='LFI'
- END IF
- CASE ('LFI')
- IF (.NOT.GEXIST_LFI .AND. GEXIST_NC4) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','FMOPEN_ll',TRIM(TPFILE%CNAME)// &
- ': .lfi file does not exist but .nc exists -> forced to NETCDF4')
- TPFILE%CFORMAT='NETCDF4'
- END IF
- CASE ('LFICDF4')
- IF (GEXIST_NC4) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','FMOPEN_ll',TRIM(TPFILE%CNAME)// &
- ': LFICDF4 format is not allowed in READ mode -> forced to NETCDF4')
- TPFILE%CFORMAT='NETCDF4'
- ELSE IF (GEXIST_LFI) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','FMOPEN_ll',TRIM(TPFILE%CNAME)// &
- ': LFICDF4 format is not allowed in READ mode -> forced to LFI')
- TPFILE%CFORMAT='LFI'
- END IF
- CASE DEFAULT
- IF (GEXIST_NC4) THEN
- CALL PRINT_MSG(NVERB_ERROR,'IO','FMOPEN_ll',TRIM(TPFILE%CNAME)// &
- ': invalid fileformat (-> forced to NETCDF4 if no abort)')
- TPFILE%CFORMAT='NETCDF4'
- ELSE IF (GEXIST_LFI) THEN
- CALL PRINT_MSG(NVERB_ERROR,'IO','FMOPEN_ll',TRIM(TPFILE%CNAME)// &
- ': invalid fileformat (-> forced to LFI if no abort)')
- TPFILE%CFORMAT='LFI'
- END IF
- END SELECT
- END IF
-END IF
-
-#if defined(MNH_IOCDF4)
-IF (TPFILE%CFORMAT=='NETCDF4' .OR. TPFILE%CFORMAT=='LFICDF4') THEN
- SELECT CASE (YACTION)
- CASE('READ')
- call io_open_file_nc4(tpfile)
- CASE('WRITE')
- call io_create_file_nc4(TPFILE, hprogram_orig=HPROGRAM_ORIG)
- END SELECT
-END IF
-#endif
-
-IF (TPFILE%CFORMAT=='LFI' .OR. TPFILE%CFORMAT=='LFICDF4') THEN
- SELECT CASE (YACTION)
- CASE('READ')
- call io_open_file_lfi(tpfile,iresp)
- CASE('WRITE')
- call io_create_file_lfi(tpfile,iresp)
- END SELECT
-END IF
-
-! Broadcast ERROR
-CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
-IF (IRESP /= 0) GOTO 1000
-
-
-1000 CONTINUE
-
-IF (IRESP.NE.0) THEN
- WRITE(YRESP,"( I0 )") IRESP
- CALL PRINT_MSG(NVERB_ERROR,'IO','FMOPEN_ll',TRIM(TPFILE%CNAME)//': exit with IRESP='//TRIM(YRESP))
-END IF
-
-KRESP=IRESP
-
-END SUBROUTINE FMOPEN_ll
-
-SUBROUTINE IO_FILE_CLOSE_ll(TPFILE,KRESP,OPARALLELIO,HPROGRAM_ORIG)
-!
-USE MODD_CONF, ONLY: CPROGRAM
-USE MODD_IO_ll, ONLY: TFILEDATA
-USE MODE_IO_ll, ONLY : CLOSE_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_FIND_BYNAME
-!
-TYPE(TFILEDATA), INTENT(INOUT) :: TPFILE ! File structure
-INTEGER, INTENT(OUT), OPTIONAL :: KRESP ! Return code
-LOGICAL, INTENT(IN), OPTIONAL :: OPARALLELIO
-CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HPROGRAM_ORIG !To emulate a file coming from this program
-!
-INTEGER :: IRESP, JI
-TYPE(TFILEDATA),POINTER :: TZFILE_DES
-TYPE(TFILEDATA),POINTER :: TZFILE_IOZ
-!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_FILE_CLOSE_ll','closing '//TRIM(TPFILE%CNAME))
-!
-IF (.NOT.TPFILE%LOPENED) THEN
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_CLOSE_ll','trying to close a file not opened: '//TRIM(TPFILE%CNAME))
- RETURN
-ENDIF
-!
-IF (TPFILE%NOPEN_CURRENT>1) THEN
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_FILE_CLOSE_ll',TRIM(TPFILE%CNAME)// &
- ': decrementing NOPEN_CURRENT (still opened after this call)')
- TPFILE%NOPEN_CURRENT = TPFILE%NOPEN_CURRENT - 1
- TPFILE%NCLOSE = TPFILE%NCLOSE + 1
- !
- DO JI = 1,TPFILE%NSUBFILES_IOZ
- TZFILE_IOZ => TPFILE%TFILES_IOZ(JI)%TFILE
- TZFILE_IOZ%NOPEN_CURRENT = TZFILE_IOZ%NOPEN_CURRENT - 1
- TZFILE_IOZ%NCLOSE = TZFILE_IOZ%NCLOSE + 1
- END DO
- !
- RETURN
-END IF
-!
-SELECT CASE(TPFILE%CTYPE)
- !Chemistry input files
- CASE('CHEMINPUT')
- CALL CLOSE_ll(TPFILE,IOSTAT=IRESP)
- !
- TPFILE%NLU = -1
-
-
- !Chemistry tabulation files
- CASE('CHEMTAB')
- CALL CLOSE_ll(TPFILE,IOSTAT=IRESP)
- !
- TPFILE%NLU = -1
-
-
- !GPS files
- CASE('GPS')
- CALL CLOSE_ll(TPFILE,IOSTAT=IRESP)
- !
- TPFILE%NLU = -1
-
-
- !Meteo files
- CASE('METEO')
- CALL CLOSE_ll(TPFILE,IOSTAT=IRESP)
- !
- TPFILE%NLU = -1
-
-
- !Namelist files
- CASE('NML')
- CALL CLOSE_ll(TPFILE,IOSTAT=IRESP)
- !
- TPFILE%NLU = -1
-
-
- !OUTPUTLISTING files
- CASE('OUTPUTLISTING')
- CALL CLOSE_ll(TPFILE,IOSTAT=IRESP,OPARALLELIO=.FALSE.)
- !
- TPFILE%NLU = -1
-
-
- !SURFACE_DATA files
- CASE('SURFACE_DATA')
- CALL CLOSE_ll(TPFILE,IOSTAT=IRESP)
- !
- TPFILE%NLU = -1
-
-
- !Text files
- CASE('TXT')
- CALL CLOSE_ll(TPFILE,IOSTAT=IRESP)
- !
- TPFILE%NLU = -1
-
-
- CASE DEFAULT
- !Do not close (non-existing) '.des' file if OUTPUT
- IF(TPFILE%CTYPE/='OUTPUT' .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_ll','file '//TRIM(TPFILE%CNAME)//'.des not in filelist')
- !
- TZFILE_DES%NOPEN_CURRENT = TZFILE_DES%NOPEN_CURRENT - 1
- TZFILE_DES%NCLOSE = TZFILE_DES%NCLOSE + 1
- !
- IF (TZFILE_DES%NOPEN_CURRENT==0) THEN
- CALL CLOSE_ll(TZFILE_DES,IOSTAT=IRESP)
- TZFILE_DES%LOPENED = .FALSE.
- TZFILE_DES%NLU = -1
- END IF
- ENDIF
- !
- CALL FMCLOS_ll(TPFILE,KRESP=IRESP,OPARALLELIO=OPARALLELIO,HPROGRAM_ORIG=HPROGRAM_ORIG)
- !
- DO JI = 1,TPFILE%NSUBFILES_IOZ
- TZFILE_IOZ => TPFILE%TFILES_IOZ(JI)%TFILE
- IF (.NOT.TZFILE_IOZ%LOPENED) &
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_CLOSE_ll','file '//TRIM(TZFILE_IOZ%CNAME)//' is not opened')
- IF (TZFILE_IOZ%NOPEN_CURRENT/=1) &
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_FILE_CLOSE_ll','file '//TRIM(TZFILE_IOZ%CNAME)//&
- ' is currently opened 0 or several times (expected only 1)')
- TZFILE_IOZ%LOPENED = .FALSE.
- TZFILE_IOZ%NOPEN_CURRENT = 0
- TZFILE_IOZ%NCLOSE = TZFILE_IOZ%NCLOSE + 1
- END DO
-END SELECT
-!
-TPFILE%LOPENED = .FALSE.
-TPFILE%NOPEN_CURRENT = 0
-TPFILE%NCLOSE = TPFILE%NCLOSE + 1
-!
-IF (PRESENT(KRESP)) KRESP=IRESP
-!
-END SUBROUTINE IO_FILE_CLOSE_ll
-
-SUBROUTINE FMCLOS_ll(TPFILE,KRESP,OPARALLELIO,HPROGRAM_ORIG)
-!
-!! MODIFICATIONS
-!! -------------
-!
-!! J.Escobar 18/10/10 bug with PGI compiler on ADJUSTL
-!-------------------------------------------------------------------------------
-USE MODD_CONF, ONLY : CPROGRAM
-USE MODD_IO_ll, ONLY : TFILEDATA
-USE MODE_IO_ll, ONLY : CLOSE_ll,UPCASE
-#if !defined(MNH_SGI)
-USE MODI_SYSTEM_MNH
-#endif
- use mode_io_file_lfi, only: io_close_file_lfi
-#if defined(MNH_IOCDF4)
- use mode_io_file_nc4, only: io_close_file_nc4
- use mode_io_write_nc4, only: io_write_coordvar_nc4
-#endif
-TYPE(TFILEDATA), INTENT(INOUT) :: TPFILE ! File structure
-INTEGER, INTENT(OUT), OPTIONAL :: KRESP ! return-code if problems araised
-LOGICAL, INTENT(IN), OPTIONAL :: OPARALLELIO
-CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HPROGRAM_ORIG !To emulate a file coming from this program
-
-INTEGER :: IRESP,IROWF
-CHARACTER(LEN=28) :: YFILEM ! name of the file
-CHARACTER(LEN=8) :: YRESP
-CHARACTER(LEN=10) :: YCPIO
-CHARACTER(LEN=14) :: YTRANS
-CHARACTER(LEN=100) :: YCOMMAND
-INTEGER :: IERR, IFITYP
-INTEGER, SAVE :: ICPT=0
-LOGICAL :: GPARALLELIO
-
-YFILEM = TPFILE%CNAME
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','FMCLOS_ll','closing '//TRIM(YFILEM))
-
-IF ( PRESENT(OPARALLELIO) ) THEN
- GPARALLELIO = OPARALLELIO
-ELSE
- GPARALLELIO = .TRUE. !par defaut on active les IO paralleles en Z si possible
-ENDIF
-
-IRESP = 0
-IROWF = 0
-
-IROWF=LEN_TRIM(YFILEM)
-
-IF (IROWF.EQ.0) THEN
- IRESP=-59
- GOTO 1000
-ENDIF
-
-#if defined(MNH_IOCDF4)
-!Write coordinates variables in NetCDF file
-IF (TPFILE%CMODE == 'WRITE' .AND. (TPFILE%CFORMAT=='NETCDF4' .OR. TPFILE%CFORMAT=='LFICDF4')) THEN
- CALL IO_WRITE_COORDVAR_NC4(TPFILE,HPROGRAM_ORIG=HPROGRAM_ORIG)
-END IF
-#endif
-
-IF (TPFILE%LMASTER) THEN
- if (tpfile%cformat == 'LFI' .or. tpfile%cformat == 'LFICDF4') call io_close_file_lfi(tpfile,iresp)
-#if defined(MNH_IOCDF4)
- if (tpfile%cformat == 'NETCDF4' .or. tpfile%cformat == 'LFICDF4') call io_close_file_nc4(tpfile,iresp)
-#endif
- IF (IRESP == 0 .AND. CPROGRAM/='LFICDF') THEN
- !! Write in pipe
-#if defined(MNH_LINUX) || defined(MNH_SP4)
- YTRANS='xtransfer.x'
-#elif defined(MNH_SX5)
- YTRANS='nectransfer.x'
-#else
- YTRANS='fujitransfer.x'
-#endif
- IFITYP = TPFILE%NLFITYPE
-
- SELECT CASE (IFITYP)
- CASE(:-1)
- IRESP=-66
- GOTO 500
- CASE(0)
- YCPIO='NIL'
- CASE(1)
- YCPIO='MESONH'
- CASE(2)
- PRINT *,'FILE ',YFILEM,' NOT TRANSFERED'
- GOTO 500
- CASE(3:)
- IRESP=-66
- GOTO 500
- END SELECT
-! WRITE (YCOMMAND,*) YTRANS,' ',YCPIO,' ',YFILEM
-#if defined(MNH_LINUX) || defined(MNH_VPP) || defined(MNH_SX5) || defined(MNH_SP4)
- ICPT=ICPT+1
- WRITE (YCOMMAND,'(A," ",A," ",A," >> OUTPUT_TRANSFER",I3.3," 2>&1 &")') TRIM(YTRANS),TRIM(YCPIO),TRIM(YFILEM),ICPT
-!JUAN jusqu'a MASDEV4_4 WRITE (YCOMMAND,'(A," ",A," ",A," ")') TRIM(YTRANS),TRIM(YCPIO),TRIM(YFILEM)
-#endif
-#if defined(MNH_SGI)
- WRITE (YCOMMAND,'(A," ",A," ",A," &")') TRIM(YTRANS),TRIM(YCPIO),TRIM(YFILEM)
-#endif
-
- PRINT *,'YCOMMAND =',YCOMMAND
-#if !defined(MNH_SGI)
- CALL SYSTEM_MNH(YCOMMAND)
-#endif
- END IF
-END IF
-
-500 CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
-IF (IRESP /= 0) GOTO 1000
-
-CALL CLOSE_ll(TPFILE,IOSTAT=IRESP,OPARALLELIO=GPARALLELIO)
-
-1000 CONTINUE
-
-IF (IRESP.NE.0) THEN
- WRITE(YRESP,"( I0 )") IRESP
- CALL PRINT_MSG(NVERB_ERROR,'IO','FMCLOS_ll',TRIM(YFILEM)//': exit with IRESP='//TRIM(YRESP))
-END IF
-
-IF (PRESENT(KRESP)) KRESP=IRESP
-
-! format: 14c for fujitransfer.x and mesonh/nil
-! 32c for file name
-! if you have to change this format one day, don't forget the blank after 1H
-! 20 FORMAT(A14,1H ,A10,1H ,A32,1H ,A1)
-!
-END SUBROUTINE FMCLOS_ll
-
-END MODULE MODE_FM
diff --git a/src/LIB/SURCOUCHE/src/mode_ga.f90 b/src/LIB/SURCOUCHE/src/mode_ga.f90
index 7457a7f3e20a8cdc4efc505078488034d0e698b9..9a2d05b6d6fe372ce51c922e91b467e545ed0b0b 100644
--- a/src/LIB/SURCOUCHE/src/mode_ga.f90
+++ b/src/LIB/SURCOUCHE/src/mode_ga.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-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.
@@ -6,7 +6,9 @@
! Author: J.Escobar
!
! Modifications:
-! P.Wautelet: 14/12/2018: split from fmwrit_ll.f90
+! 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
!-----------------------------------------------------------------
#ifdef MNH_GA
MODULE MODE_GA
@@ -36,15 +38,13 @@ MODULE MODE_GA
SUBROUTINE MNH_INIT_GA(MY_NI,MY_NJ,MY_NK,HRECFM,HRW_MODE)
-!
-! Modification
-! J.Escobar 5/02/2015 : use JPHEXT from MODD_PARAMETERS_ll
+ USE MODD_IO, ONLY: ISP
+ USE MODD_PARAMETERS_ll, ONLY: JPHEXT
- USE MODE_TOOLS_ll, ONLY : GET_GLOBALDIMS_ll
- USE MODD_PARAMETERS_ll, ONLY : JPHEXT
- USE MODD_IO_ll, ONLY : ISP
- USE MODE_GATHER_ll, ONLY : GET_DOMWRITE_ll
- USE MODE_SCATTER_ll, ONLY : GET_DOMREAD_ll
+ USE MODE_GATHER_ll, ONLY: GET_DOMWRITE_ll
+ use mode_msg
+ USE MODE_SCATTER_ll, ONLY: GET_DOMREAD_ll
+ USE MODE_TOOLS_ll, ONLY: GET_GLOBALDIMS_ll
IMPLICIT NONE
@@ -60,7 +60,7 @@ MODULE MODE_GA
stack = heap
!gstatus_ga = ma_init(MT_F_DBL, stack/ISNPROC, heap/ISNPROC)
gstatus_ga = ma_init(MT_F_DBL, stack, heap)
- if ( .not. gstatus_ga ) STOP " MA_INIT FAILED "
+ if ( .not. gstatus_ga ) call Print_msg( NVERB_FATAL, 'GEN', 'MNH_INIT_GA', 'MA_INIT failed' )
!
! Initialize GA library
!
diff --git a/src/LIB/SURCOUCHE/src/mode_gather.f90 b/src/LIB/SURCOUCHE/src/mode_gather.f90
index 4aec0e9b3efe5cb795b407d6848c8d51c441d15e..613aa8f280036112a77b8a467fe6b90a26a0a26d 100644
--- a/src/LIB/SURCOUCHE/src/mode_gather.f90
+++ b/src/LIB/SURCOUCHE/src/mode_gather.f90
@@ -1,27 +1,21 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-
-#ifdef MNH_MPI_DOUBLE_PRECISION
-#define MPI_FLOAT MPI_DOUBLE_PRECISION
-#else
-#define MPI_FLOAT MPI_REAL
-#endif
-
-MODULE MODE_GATHER_ll
-
! Modifications:
! J.Escobar 10/02/2012 : Bug , in MPI_RECV replace MPI_STATUSES_IGNORE
! with MPI_STATUS_IGNORE
! J.Escobar 22/05/2012 : Bug in ISEND with non-contiguous buffer , reintroduce intermediate buffer
! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!
+!-----------------------------------------------------------------
+
+MODULE MODE_GATHER_ll
+
USE MODD_MPIF
-!JUANZ
-USE MODD_VAR_ll, ONLY : NMNH_COMM_WORLD
-!JUANZ
+use modd_precision, only: MNHREAL_MPI
+USE MODD_VAR_ll, ONLY: NMNH_COMM_WORLD
IMPLICIT NONE
@@ -71,7 +65,7 @@ ELSE
PRINT *,'Error GATHERALL_X1'
END IF
! PRECV variable of IROOT processor contains the global field
-CALL MPI_BCAST(PRECV,SIZE(PRECV),MPI_FLOAT,IROOT-1,NMNH_COMM_WORLD,KRESP)
+CALL MPI_BCAST(PRECV,SIZE(PRECV),MNHREAL_MPI,IROOT-1,NMNH_COMM_WORLD,KRESP)
END SUBROUTINE GATHERALL_X1
@@ -94,7 +88,7 @@ ELSE
PRINT *,'Error GATHERALL_X2'
END IF
! PRECV variable of IROOT processor contains the global field
-CALL MPI_BCAST(PRECV,SIZE(PRECV),MPI_FLOAT,IROOT-1,NMNH_COMM_WORLD,KRESP)
+CALL MPI_BCAST(PRECV,SIZE(PRECV),MNHREAL_MPI,IROOT-1,NMNH_COMM_WORLD,KRESP)
END SUBROUTINE GATHERALL_X2
@@ -118,7 +112,7 @@ ELSE
KRESP = -1
END IF
! PRECV variable of IROOT processor contains the global field
-CALL MPI_BCAST(PRECV,SIZE(PRECV),MPI_FLOAT,IROOT-1,NMNH_COMM_WORLD,KRESP)
+CALL MPI_BCAST(PRECV,SIZE(PRECV),MNHREAL_MPI,IROOT-1,NMNH_COMM_WORLD,KRESP)
END SUBROUTINE GATHERALL_X3
@@ -195,8 +189,8 @@ END SUBROUTINE GATHERALL_L3
! Gather des champs XX (ou YY)
!
SUBROUTINE GATHERXX_X1(HDIR,PSEND,PRECV,KROOT,KCOMM)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
-USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
+USE MODD_IO, ONLY: ISP, ISNPROC
+USE MODD_VAR_ll, ONLY: MNH_STATUSES_IGNORE
CHARACTER(LEN=*), INTENT(IN) :: HDIR
REAL,DIMENSION(:),TARGET,INTENT(IN) :: PSEND
@@ -230,7 +224,7 @@ IF (ISP == KROOT) THEN
IF (JI == KROOT) THEN
XP = PSEND(IXO:IXE)
ELSE
- CALL MPI_RECV(XP,SIZE(XP),MPI_FLOAT,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
+ CALL MPI_RECV(XP,SIZE(XP),MNHREAL_MPI,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
END IF
ELSE IF (HDIR == 'YY' .AND. IXM <= IGXE .AND. IXM >= IGXO) THEN
@@ -238,7 +232,7 @@ IF (ISP == KROOT) THEN
IF (JI==KROOT) THEN
XP = PSEND(IYO:IYE)
ELSE
- CALL MPI_RECV(XP,SIZE(XP),MPI_FLOAT,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
+ CALL MPI_RECV(XP,SIZE(XP),MNHREAL_MPI,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
END IF
END IF
END DO
@@ -251,15 +245,15 @@ ELSE
IF (HDIR == 'XX' .AND. IYM <= IGYE .AND. IYM >= IGYO) THEN
XP=>PSEND(IXO:IXE)
NB_REQ = 1
- CALL MPI_ISEND(XP,SIZE(XP),MPI_FLOAT,KROOT-1,99+KROOT,KCOMM,REQ(NB_REQ),IERR)
+ CALL MPI_ISEND(XP,SIZE(XP),MNHREAL_MPI,KROOT-1,99+KROOT,KCOMM,REQ(NB_REQ),IERR)
CALL MPI_WAITALL(NB_REQ,REQ,MNH_STATUSES_IGNORE,IERR)
- !CALL MPI_BSEND(XP,SIZE(XP),MPI_FLOAT,KROOT-1,99+KROOT,KCOMM,IERR)
+ !CALL MPI_BSEND(XP,SIZE(XP),MNHREAL_MPI,KROOT-1,99+KROOT,KCOMM,IERR)
ELSE IF (HDIR == 'YY' .AND. IXM <= IGXE .AND. IXM >= IGXO) THEN
XP=>PSEND(IYO:IYE)
NB_REQ = 1
- CALL MPI_ISEND(XP,SIZE(XP),MPI_FLOAT,KROOT-1,99+KROOT,KCOMM,REQ(NB_REQ),IERR)
+ CALL MPI_ISEND(XP,SIZE(XP),MNHREAL_MPI,KROOT-1,99+KROOT,KCOMM,REQ(NB_REQ),IERR)
CALL MPI_WAITALL(NB_REQ,REQ,MNH_STATUSES_IGNORE,IERR)
- !CALL MPI_BSEND(XP,SIZE(XP),MPI_FLOAT,KROOT-1,99+KROOT,KCOMM,IERR)
+ !CALL MPI_BSEND(XP,SIZE(XP),MNHREAL_MPI,KROOT-1,99+KROOT,KCOMM,IERR)
END IF
END IF
@@ -267,7 +261,7 @@ END SUBROUTINE GATHERXX_X1
SUBROUTINE GATHERXX_X2(HDIR,PSEND,PRECV,KROOT,KCOMM)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_IO, ONLY: ISP, ISNPROC
CHARACTER(LEN=*), INTENT(IN) :: HDIR
REAL,DIMENSION(:,:),TARGET,INTENT(IN) :: PSEND
@@ -298,7 +292,7 @@ IF (ISP == KROOT) THEN
IF (JI == KROOT) THEN
XP = PSEND(IXO:IXE,:)
ELSE
- CALL MPI_RECV(XP,SIZE(XP),MPI_FLOAT,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
+ CALL MPI_RECV(XP,SIZE(XP),MNHREAL_MPI,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
END IF
ELSE IF (HDIR == 'YY' .AND. IXM <= IGXE .AND. IXM >= IGXO) THEN
@@ -306,7 +300,7 @@ IF (ISP == KROOT) THEN
IF (JI==KROOT) THEN
XP = PSEND(IYO:IYE,:)
ELSE
- CALL MPI_RECV(XP,SIZE(XP),MPI_FLOAT,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
+ CALL MPI_RECV(XP,SIZE(XP),MNHREAL_MPI,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
END IF
END IF
END DO
@@ -318,17 +312,17 @@ ELSE
IF (HDIR == 'XX' .AND. IYM <= IGYE .AND. IYM >= IGYO) THEN
XP=>PSEND(IXO:IXE,:)
- CALL MPI_BSEND(XP,SIZE(XP),MPI_FLOAT,KROOT-1,99+KROOT,KCOMM,IERR)
+ CALL MPI_BSEND(XP,SIZE(XP),MNHREAL_MPI,KROOT-1,99+KROOT,KCOMM,IERR)
ELSE IF (HDIR == 'YY' .AND. IXM <= IGXE .AND. IXM >= IGXO) THEN
XP=>PSEND(IYO:IYE,:)
- CALL MPI_BSEND(XP,SIZE(XP),MPI_FLOAT,KROOT-1,99+KROOT,KCOMM,IERR)
+ CALL MPI_BSEND(XP,SIZE(XP),MNHREAL_MPI,KROOT-1,99+KROOT,KCOMM,IERR)
END IF
END IF
END SUBROUTINE GATHERXX_X2
SUBROUTINE GATHERXX_X3(HDIR,PSEND,PRECV,KROOT,KCOMM)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_IO, ONLY: ISP, ISNPROC
CHARACTER(LEN=*), INTENT(IN) :: HDIR
REAL,DIMENSION(:,:,:),TARGET,INTENT(IN) :: PSEND
@@ -359,7 +353,7 @@ IF (ISP == KROOT) THEN
IF (JI == KROOT) THEN
XP = PSEND(IXO:IXE,:,:)
ELSE
- CALL MPI_RECV(XP,SIZE(XP),MPI_FLOAT,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
+ CALL MPI_RECV(XP,SIZE(XP),MNHREAL_MPI,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
END IF
ELSE IF (HDIR == 'YY' .AND. IXM <= IGXE .AND. IXM >= IGXO) THEN
@@ -367,7 +361,7 @@ IF (ISP == KROOT) THEN
IF (JI==KROOT) THEN
XP = PSEND(IYO:IYE,:,:)
ELSE
- CALL MPI_RECV(XP,SIZE(XP),MPI_FLOAT,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
+ CALL MPI_RECV(XP,SIZE(XP),MNHREAL_MPI,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
END IF
END IF
END DO
@@ -379,17 +373,17 @@ ELSE
IF (HDIR == 'XX' .AND. IYM <= IGYE .AND. IYM >= IGYO) THEN
XP=>PSEND(IXO:IXE,:,:)
- CALL MPI_BSEND(XP,SIZE(XP),MPI_FLOAT,KROOT-1,99+KROOT,KCOMM,IERR)
+ CALL MPI_BSEND(XP,SIZE(XP),MNHREAL_MPI,KROOT-1,99+KROOT,KCOMM,IERR)
ELSE IF (HDIR == 'YY' .AND. IXM <= IGXE .AND. IXM >= IGXO) THEN
XP=>PSEND(IYO:IYE,:,:)
- CALL MPI_BSEND(XP,SIZE(XP),MPI_FLOAT,KROOT-1,99+KROOT,KCOMM,IERR)
+ CALL MPI_BSEND(XP,SIZE(XP),MNHREAL_MPI,KROOT-1,99+KROOT,KCOMM,IERR)
END IF
END IF
END SUBROUTINE GATHERXX_X3
SUBROUTINE GATHERXX_X4(HDIR,PSEND,PRECV,KROOT,KCOMM)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_IO, ONLY: ISP, ISNPROC
CHARACTER(LEN=*), INTENT(IN) :: HDIR
REAL,DIMENSION(:,:,:,:),TARGET,INTENT(IN) :: PSEND
@@ -420,7 +414,7 @@ IF (ISP == KROOT) THEN
IF (JI == KROOT) THEN
XP = PSEND(IXO:IXE,:,:,:)
ELSE
- CALL MPI_RECV(XP,SIZE(XP),MPI_FLOAT,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
+ CALL MPI_RECV(XP,SIZE(XP),MNHREAL_MPI,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
END IF
ELSE IF (HDIR == 'YY' .AND. IXM <= IGXE .AND. IXM >= IGXO) THEN
@@ -428,7 +422,7 @@ IF (ISP == KROOT) THEN
IF (JI==KROOT) THEN
XP = PSEND(IYO:IYE,:,:,:)
ELSE
- CALL MPI_RECV(XP,SIZE(XP),MPI_FLOAT,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
+ CALL MPI_RECV(XP,SIZE(XP),MNHREAL_MPI,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
END IF
END IF
END DO
@@ -440,17 +434,17 @@ ELSE
IF (HDIR == 'XX' .AND. IYM <= IGYE .AND. IYM >= IGYO) THEN
XP=>PSEND(IXO:IXE,:,:,:)
- CALL MPI_BSEND(XP,SIZE(XP),MPI_FLOAT,KROOT-1,99+KROOT,KCOMM,IERR)
+ CALL MPI_BSEND(XP,SIZE(XP),MNHREAL_MPI,KROOT-1,99+KROOT,KCOMM,IERR)
ELSE IF (HDIR == 'YY' .AND. IXM <= IGXE .AND. IXM >= IGXO) THEN
XP=>PSEND(IYO:IYE,:,:,:)
- CALL MPI_BSEND(XP,SIZE(XP),MPI_FLOAT,KROOT-1,99+KROOT,KCOMM,IERR)
+ CALL MPI_BSEND(XP,SIZE(XP),MNHREAL_MPI,KROOT-1,99+KROOT,KCOMM,IERR)
END IF
END IF
END SUBROUTINE GATHERXX_X4
SUBROUTINE GATHERXX_X5(HDIR,PSEND,PRECV,KROOT,KCOMM)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_IO, ONLY: ISP, ISNPROC
CHARACTER(LEN=*), INTENT(IN) :: HDIR
REAL,DIMENSION(:,:,:,:,:),TARGET,INTENT(IN) :: PSEND
@@ -481,7 +475,7 @@ IF (ISP == KROOT) THEN
IF (JI == KROOT) THEN
XP = PSEND(IXO:IXE,:,:,:,:)
ELSE
- CALL MPI_RECV(XP,SIZE(XP),MPI_FLOAT,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
+ CALL MPI_RECV(XP,SIZE(XP),MNHREAL_MPI,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
END IF
ELSE IF (HDIR == 'YY' .AND. IXM <= IGXE .AND. IXM >= IGXO) THEN
@@ -489,7 +483,7 @@ IF (ISP == KROOT) THEN
IF (JI==KROOT) THEN
XP = PSEND(IYO:IYE,:,:,:,:)
ELSE
- CALL MPI_RECV(XP,SIZE(XP),MPI_FLOAT,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
+ CALL MPI_RECV(XP,SIZE(XP),MNHREAL_MPI,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
END IF
END IF
END DO
@@ -501,17 +495,17 @@ ELSE
IF (HDIR == 'XX' .AND. IYM <= IGYE .AND. IYM >= IGYO) THEN
XP=>PSEND(IXO:IXE,:,:,:,:)
- CALL MPI_BSEND(XP,SIZE(XP),MPI_FLOAT,KROOT-1,99+KROOT,KCOMM,IERR)
+ CALL MPI_BSEND(XP,SIZE(XP),MNHREAL_MPI,KROOT-1,99+KROOT,KCOMM,IERR)
ELSE IF (HDIR == 'YY' .AND. IXM <= IGXE .AND. IXM >= IGXO) THEN
XP=>PSEND(IYO:IYE,:,:,:,:)
- CALL MPI_BSEND(XP,SIZE(XP),MPI_FLOAT,KROOT-1,99+KROOT,KCOMM,IERR)
+ CALL MPI_BSEND(XP,SIZE(XP),MNHREAL_MPI,KROOT-1,99+KROOT,KCOMM,IERR)
END IF
END IF
END SUBROUTINE GATHERXX_X5
SUBROUTINE GATHERXX_X6(HDIR,PSEND,PRECV,KROOT,KCOMM)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_IO, ONLY: ISP, ISNPROC
CHARACTER(LEN=*), INTENT(IN) :: HDIR
REAL,DIMENSION(:,:,:,:,:,:),TARGET,INTENT(IN) :: PSEND
@@ -542,7 +536,7 @@ IF (ISP == KROOT) THEN
IF (JI == KROOT) THEN
XP = PSEND(IXO:IXE,:,:,:,:,:)
ELSE
- CALL MPI_RECV(XP,SIZE(XP),MPI_FLOAT,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
+ CALL MPI_RECV(XP,SIZE(XP),MNHREAL_MPI,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
END IF
ELSE IF (HDIR == 'YY' .AND. IXM <= IGXE .AND. IXM >= IGXO) THEN
@@ -550,7 +544,7 @@ IF (ISP == KROOT) THEN
IF (JI==KROOT) THEN
XP = PSEND(IYO:IYE,:,:,:,:,:)
ELSE
- CALL MPI_RECV(XP,SIZE(XP),MPI_FLOAT,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
+ CALL MPI_RECV(XP,SIZE(XP),MNHREAL_MPI,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
END IF
END IF
END DO
@@ -562,17 +556,17 @@ ELSE
IF (HDIR == 'XX' .AND. IYM <= IGYE .AND. IYM >= IGYO) THEN
XP=>PSEND(IXO:IXE,:,:,:,:,:)
- CALL MPI_BSEND(XP,SIZE(XP),MPI_FLOAT,KROOT-1,99+KROOT,KCOMM,IERR)
+ CALL MPI_BSEND(XP,SIZE(XP),MNHREAL_MPI,KROOT-1,99+KROOT,KCOMM,IERR)
ELSE IF (HDIR == 'YY' .AND. IXM <= IGXE .AND. IXM >= IGXO) THEN
XP=>PSEND(IYO:IYE,:,:,:,:,:)
- CALL MPI_BSEND(XP,SIZE(XP),MPI_FLOAT,KROOT-1,99+KROOT,KCOMM,IERR)
+ CALL MPI_BSEND(XP,SIZE(XP),MNHREAL_MPI,KROOT-1,99+KROOT,KCOMM,IERR)
END IF
END IF
END SUBROUTINE GATHERXX_X6
SUBROUTINE GATHERXX_N1(HDIR,KSEND,KRECV,KROOT,KCOMM)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_IO, ONLY: ISP, ISNPROC
CHARACTER(LEN=*), INTENT(IN) :: HDIR
INTEGER,DIMENSION(:),TARGET,INTENT(IN) :: KSEND
@@ -635,7 +629,7 @@ END SUBROUTINE GATHERXX_N1
SUBROUTINE GATHERXX_N2(HDIR,KSEND,KRECV,KROOT,KCOMM)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_IO, ONLY: ISP, ISNPROC
CHARACTER(LEN=*), INTENT(IN) :: HDIR
INTEGER,DIMENSION(:,:),TARGET,INTENT(IN) :: KSEND
@@ -697,7 +691,7 @@ END IF
END SUBROUTINE GATHERXX_N2
SUBROUTINE GATHERXX_N3(HDIR,KSEND,KRECV,KROOT,KCOMM)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_IO, ONLY: ISP, ISNPROC
CHARACTER(LEN=*), INTENT(IN) :: HDIR
INTEGER,DIMENSION(:,:,:),TARGET,INTENT(IN) :: KSEND
@@ -758,7 +752,7 @@ END IF
END SUBROUTINE GATHERXX_N3
SUBROUTINE GATHERXX_L1(HDIR,OSEND,ORECV,KROOT,KCOMM)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_IO, ONLY: ISP, ISNPROC
CHARACTER(LEN=*), INTENT(IN) :: HDIR
LOGICAL,DIMENSION(:),TARGET,INTENT(IN) :: OSEND
@@ -820,7 +814,7 @@ END IF
END SUBROUTINE GATHERXX_L1
SUBROUTINE GATHERXX_L3(HDIR,OSEND,ORECV,KROOT,KCOMM)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_IO, ONLY : ISP, ISNPROC
CHARACTER(LEN=*), INTENT(IN) :: HDIR
LOGICAL,DIMENSION(:,:,:),TARGET,INTENT(IN) :: OSEND
@@ -884,8 +878,8 @@ END SUBROUTINE GATHERXX_L3
! Gather des champs XY
!
SUBROUTINE GATHERXY_X2(PSEND,PRECV,KROOT,KCOMM,KXOBOX,KXEBOX,KYOBOX,KYEBOX,HINTER)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
-USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
+USE MODD_IO, ONLY: ISP, ISNPROC
+USE MODD_VAR_ll, ONLY: MNH_STATUSES_IGNORE
REAL,DIMENSION(:,:),TARGET,INTENT(IN) :: PSEND
REAL,DIMENSION(:,:),TARGET,INTENT(INOUT):: PRECV
@@ -915,7 +909,7 @@ IF (ISP == KROOT) THEN
CALL GET_DOMWRITE_ll(JI,'local',IXO,IXE,IYO,IYE,KXOBOX,KXEBOX,KYOBOX,KYEBOX,HINTER)
XP = PSEND(IXO:IXE,IYO:IYE)
ELSE
- CALL MPI_RECV(XP,SIZE(XP),MPI_FLOAT,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
+ CALL MPI_RECV(XP,SIZE(XP),MNHREAL_MPI,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
END IF
END IF
END DO
@@ -927,17 +921,17 @@ ELSE
NB_REQ = 1
ALLOCATE(X_2DP(IXO:IXE,IYO:IYE))
X_2DP=XP
- CALL MPI_ISEND(X_2DP,SIZE(XP),MPI_FLOAT,KROOT-1,99+KROOT,KCOMM,REQ(NB_REQ),IERR)
+ CALL MPI_ISEND(X_2DP,SIZE(XP),MNHREAL_MPI,KROOT-1,99+KROOT,KCOMM,REQ(NB_REQ),IERR)
CALL MPI_WAITALL(NB_REQ,REQ,MNH_STATUSES_IGNORE,IERR)
DEALLOCATE(X_2DP)
- !CALL MPI_BSEND(XP,SIZE(XP),MPI_FLOAT,KROOT-1,99+KROOT,KCOMM,IERR)
+ !CALL MPI_BSEND(XP,SIZE(XP),MNHREAL_MPI,KROOT-1,99+KROOT,KCOMM,IERR)
END IF
END IF
END SUBROUTINE GATHERXY_X2
SUBROUTINE GATHERXY_X3(PSEND,PRECV,KROOT,KCOMM,KXOBOX,KXEBOX,KYOBOX,KYEBOX,HINTER)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_IO, ONLY: ISP, ISNPROC
REAL,DIMENSION(:,:,:),TARGET,INTENT(IN) :: PSEND
REAL,DIMENSION(:,:,:),TARGET,INTENT(INOUT):: PRECV
@@ -962,7 +956,7 @@ IF (ISP == KROOT) THEN
CALL GET_DOMWRITE_ll(JI,'local',IXO,IXE,IYO,IYE,KXOBOX,KXEBOX,KYOBOX,KYEBOX,HINTER)
XP = PSEND(IXO:IXE,IYO:IYE,:)
ELSE
- CALL MPI_RECV(XP,SIZE(XP),MPI_FLOAT,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
+ CALL MPI_RECV(XP,SIZE(XP),MNHREAL_MPI,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
END IF
END IF
END DO
@@ -971,14 +965,14 @@ ELSE
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,:)
- CALL MPI_BSEND(XP,SIZE(XP),MPI_FLOAT,KROOT-1,99+KROOT,KCOMM,IERR)
+ CALL MPI_BSEND(XP,SIZE(XP),MNHREAL_MPI,KROOT-1,99+KROOT,KCOMM,IERR)
END IF
END IF
END SUBROUTINE GATHERXY_X3
SUBROUTINE GATHERXY_X4(PSEND,PRECV,KROOT,KCOMM,KXOBOX,KXEBOX,KYOBOX,KYEBOX,HINTER)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_IO, ONLY: ISP, ISNPROC
REAL,DIMENSION(:,:,:,:),TARGET,INTENT(IN) :: PSEND
REAL,DIMENSION(:,:,:,:),TARGET,INTENT(INOUT):: PRECV
@@ -1003,7 +997,7 @@ IF (ISP == KROOT) THEN
CALL GET_DOMWRITE_ll(JI,'local',IXO,IXE,IYO,IYE,KXOBOX,KXEBOX,KYOBOX,KYEBOX,HINTER)
XP = PSEND(IXO:IXE,IYO:IYE,:,:)
ELSE
- CALL MPI_RECV(XP,SIZE(XP),MPI_FLOAT,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
+ CALL MPI_RECV(XP,SIZE(XP),MNHREAL_MPI,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
END IF
END IF
END DO
@@ -1012,14 +1006,14 @@ ELSE
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,:,:)
- CALL MPI_BSEND(XP,SIZE(XP),MPI_FLOAT,KROOT-1,99+KROOT,KCOMM,IERR)
+ CALL MPI_BSEND(XP,SIZE(XP),MNHREAL_MPI,KROOT-1,99+KROOT,KCOMM,IERR)
END IF
END IF
END SUBROUTINE GATHERXY_X4
SUBROUTINE GATHERXY_X5(PSEND,PRECV,KROOT,KCOMM,KXOBOX,KXEBOX,KYOBOX,KYEBOX,HINTER)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_IO, ONLY: ISP, ISNPROC
REAL,DIMENSION(:,:,:,:,:),TARGET,INTENT(IN) :: PSEND
REAL,DIMENSION(:,:,:,:,:),TARGET,INTENT(INOUT):: PRECV
@@ -1044,7 +1038,7 @@ IF (ISP == KROOT) THEN
CALL GET_DOMWRITE_ll(JI,'local',IXO,IXE,IYO,IYE,KXOBOX,KXEBOX,KYOBOX,KYEBOX,HINTER)
XP = PSEND(IXO:IXE,IYO:IYE,:,:,:)
ELSE
- CALL MPI_RECV(XP,SIZE(XP),MPI_FLOAT,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
+ CALL MPI_RECV(XP,SIZE(XP),MNHREAL_MPI,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
END IF
END IF
END DO
@@ -1053,14 +1047,14 @@ ELSE
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,:,:,:)
- CALL MPI_BSEND(XP,SIZE(XP),MPI_FLOAT,KROOT-1,99+KROOT,KCOMM,IERR)
+ CALL MPI_BSEND(XP,SIZE(XP),MNHREAL_MPI,KROOT-1,99+KROOT,KCOMM,IERR)
END IF
END IF
END SUBROUTINE GATHERXY_X5
SUBROUTINE GATHERXY_X6(PSEND,PRECV,KROOT,KCOMM,KXOBOX,KXEBOX,KYOBOX,KYEBOX,HINTER)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_IO, ONLY: ISP, ISNPROC
REAL,DIMENSION(:,:,:,:,:,:),TARGET,INTENT(IN) :: PSEND
REAL,DIMENSION(:,:,:,:,:,:),TARGET,INTENT(INOUT):: PRECV
@@ -1085,7 +1079,7 @@ IF (ISP == KROOT) THEN
CALL GET_DOMWRITE_ll(JI,'local',IXO,IXE,IYO,IYE,KXOBOX,KXEBOX,KYOBOX,KYEBOX,HINTER)
XP = PSEND(IXO:IXE,IYO:IYE,:,:,:,:)
ELSE
- CALL MPI_RECV(XP,SIZE(XP),MPI_FLOAT,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
+ CALL MPI_RECV(XP,SIZE(XP),MNHREAL_MPI,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
END IF
END IF
END DO
@@ -1094,14 +1088,14 @@ ELSE
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,:,:,:,:)
- CALL MPI_BSEND(XP,SIZE(XP),MPI_FLOAT,KROOT-1,99+KROOT,KCOMM,IERR)
+ CALL MPI_BSEND(XP,SIZE(XP),MNHREAL_MPI,KROOT-1,99+KROOT,KCOMM,IERR)
END IF
END IF
END SUBROUTINE GATHERXY_X6
SUBROUTINE GATHERXY_N2(KSEND,KRECV,KROOT,KCOMM)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_IO, ONLY: ISP, ISNPROC
INTEGER,DIMENSION(:,:),TARGET,INTENT(IN) :: KSEND
INTEGER,DIMENSION(:,:),TARGET,INTENT(INOUT):: KRECV
@@ -1136,7 +1130,7 @@ END IF
END SUBROUTINE GATHERXY_N2
SUBROUTINE GATHERXY_N3(KSEND,KRECV,KROOT,KCOMM,KXOBOX,KXEBOX,KYOBOX,KYEBOX,HINTER)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_IO, ONLY: ISP, ISNPROC
INTEGER,DIMENSION(:,:,:),TARGET,INTENT(IN) :: KSEND
INTEGER,DIMENSION(:,:,:),TARGET,INTENT(INOUT):: KRECV
@@ -1177,7 +1171,7 @@ END IF
END SUBROUTINE GATHERXY_N3
SUBROUTINE GATHERXY_L3(OSEND,ORECV,KROOT,KCOMM,KXOBOX,KXEBOX,KYOBOX,KYEBOX,HINTER)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_IO, ONLY : ISP, ISNPROC
LOGICAL,DIMENSION(:,:,:),TARGET,INTENT(IN) :: OSEND
LOGICAL,DIMENSION(:,:,:),TARGET,INTENT(INOUT):: ORECV
@@ -1218,7 +1212,7 @@ END IF
END SUBROUTINE GATHERXY_L3
SUBROUTINE GATHERBOX_X2(PSEND,PRECV,KROOT,KCOMM,KXOBOX,KXEBOX,KYOBOX,KYEBOX)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_IO, ONLY: ISP, ISNPROC
REAL,DIMENSION(:,:),TARGET,INTENT(IN) :: PSEND
REAL,DIMENSION(:,:),TARGET,INTENT(INOUT):: PRECV
@@ -1242,7 +1236,7 @@ IF (ISP == KROOT) THEN
CALL GET_DOMWRITE_ll(JI,'local',IXO,IXE,IYO,IYE,KXOBOX,KXEBOX,KYOBOX,KYEBOX)
XP = PSEND(IXO:IXE,IYO:IYE)
ELSE
- CALL MPI_RECV(XP,SIZE(XP),MPI_FLOAT,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
+ CALL MPI_RECV(XP,SIZE(XP),MNHREAL_MPI,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
END IF
END IF
END DO
@@ -1251,7 +1245,7 @@ ELSE
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)
- CALL MPI_BSEND(XP,SIZE(XP),MPI_FLOAT,KROOT-1,99+KROOT,KCOMM,IERR)
+ CALL MPI_BSEND(XP,SIZE(XP),MNHREAL_MPI,KROOT-1,99+KROOT,KCOMM,IERR)
END IF
END IF
@@ -1260,10 +1254,11 @@ END SUBROUTINE GATHERBOX_X2
SUBROUTINE GET_DOMWRITE_ll(KIP,HTYPE,KXOR,KXEND,KYOR,KYEND,&
& KXORBOX,KXENDBOX,KYORBOX,KYENDBOX,HINTER)
-USE MODD_VAR_ll, ONLY : TCRRT_PROCONF
-USE MODD_STRUCTURE_ll, ONLY : MODELSPLITTING_ll
-USE MODE_TOOLS_ll, ONLY : LWEST_ll,LEAST_ll,LSOUTH_ll,LNORTH_ll
-IMPLICIT NONE
+USE MODD_STRUCTURE_ll, ONLY: MODELSPLITTING_ll
+USE MODE_TOOLS_ll, ONLY: LWEST_ll, LEAST_ll, LSOUTH_ll, LNORTH_ll
+USE MODD_VAR_ll, ONLY: TCRRT_PROCONF
+
+IMPLICIT NONE
INTEGER, INTENT(IN) :: KIP
CHARACTER(LEN=*), INTENT(IN) :: HTYPE
diff --git a/src/LIB/SURCOUCHE/src/mode_init_ll.f90 b/src/LIB/SURCOUCHE/src/mode_init_ll.f90
index 6cd17f9c6963b90888e4781b9c1c55450be59db9..f6d436cf531b13fbc527b896b125050a3acb53a3 100644
--- a/src/LIB/SURCOUCHE/src/mode_init_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_init_ll.f90
@@ -1,17 +1,8 @@
-!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.
!-----------------------------------------------------------------
-
-#ifdef MNH_MPI_DOUBLE_PRECISION
-#define MNH_MPI_REAL MPI_DOUBLE_PRECISION
-#define MNH_MPI_2REAL MPI_2DOUBLE_PRECISION
-#else
-#define MNH_MPI_REAL MPI_REAL
-#define MNH_MPI_2REAL MPI_2REAL
-#endif
-
! ###################
MODULE MODE_INIT_ll
! ###################
@@ -61,8 +52,6 @@
USE MODD_MPIF
!
IMPLICIT NONE
-!
-! INCLUDE 'mpif.h'
!
CONTAINS
!
@@ -555,17 +544,6 @@
!
IP = IP + 1
!
- MPI_PRECISION = MNH_MPI_REAL
- MPI_2PRECISION = MNH_MPI_2REAL
- !
- !-------------------------------------------------------------------------------
- !
- !* 2. SET OUTPUT FILE :
- ! ---------------
-
- ! CALL OPEN_ll(UNIT=NIOUNIT,FILE=YOUTPUTFILE,ACTION='write',form&
- ! &='FORMATTED',MODE=SPECIFIC,IOSTAT=IRESP)
- !
!-------------------------------------------------------------------------------
!
!* 3. ALLOCATION :
@@ -752,15 +730,13 @@
!* 0. DECLARATIONS
!
USE MODD_DIM_ll
-! USE MODD_STRUCTURE_ll
-! USE MODD_VAR_ll, ONLY : NIOUNIT, YOUTPUTFILE
- USE MODD_IO_ll, ONLY : ISP
+ USE MODD_IO, ONLY: ISP
#ifdef CPLOASIS
- USE MODD_SFX_OASIS, ONLY : LOASIS
+ USE MODD_SFX_OASIS, ONLY: LOASIS
#endif
!
#ifdef MNH_GA
-USE MODE_GA
+ USE MODE_GA
#endif
!
IMPLICIT NONE
@@ -776,8 +752,6 @@ USE MODE_GA
!
!* 1. CALL TO MPI_FINALIZE
!
-! CALL CLOSE_ll(YOUTPUTFILE)
-
#ifdef MNH_GA
if (.not. GFIRST_GA ) then
call ga_sync()
diff --git a/src/LIB/SURCOUCHE/src/mode_io.f90 b/src/LIB/SURCOUCHE/src/mode_io.f90
index 0434b5ea16e1eee43b1dda7f2d0f594c167090dd..09f3f32ee8466d421b437975dc887220e8585cc2 100644
--- a/src/LIB/SURCOUCHE/src/mode_io.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io.f90
@@ -3,33 +3,17 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!! Authors
-!! -------
+! Author(s)
+! D. Gazen
+! Modifications:
+! P. Wautelet 01/03/2019: move OPEN_ll to mode_io_file.f90 and IO_Pack_set to here from mode_fm.f90
+! P. Wautelet 05/03/2019: rename IO subroutines and modules
!
-! D. Gazen
-! Juan 19/08/2005: bug argument optinonel ACCESS --> YACCESS
-! Juan 22/05/2008: bug mode SPECIFIC in OPEN_ll
-! Juan 05/11/2009: allow JPMAX_UNIT=48 open files
-! J.Escobar 18/10/10 bug with PGI compiler on ADJUSTL
-! P. Wautelet 04/02/2016: bug with DELIM='NONE' and GCC 5.2/5.3
-! D.Gazen : avril 2016 change error message
-! P. Wautelet : may 2016: use netCDF Fortran module
-! P. Wautelet : July 2016: added type OUTBAK
-! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! J. Pianezze 01/08/2016 add LOASIS flag
-! Philippe Wautelet: 13/12/2018: moved some operations to new mode_io_*_nc4 modules
-! Philippe Wautelet: 10/01/2019: bug correction: close correctly Z-split files
-! Philippe Wautelet: 10/01/2019: use NEWUNIT argument of OPEN
-! + move IOFREEFLU and IONEWFLU to mode_io_file_lfi.f90
-! + move management of NNCID and NLFIFLU to the nc4 and lfi subroutines
-! Philippe Wautelet: 10/01/2019: bug: modify some metadata before open calls
-! 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)
-!
-MODULE MODE_IO_ll
+!-----------------------------------------------------------------
+MODULE MODE_IO
USE MODD_MPIF
- USE MODD_VAR_ll, ONLY : NMNH_COMM_WORLD
+ USE MODD_VAR_ll, ONLY: NMNH_COMM_WORLD
USE MODE_MSG
@@ -37,46 +21,30 @@ MODULE MODE_IO_ll
PRIVATE
- LOGICAL,SAVE :: GCONFIO = .FALSE. ! Turn TRUE when SET_CONFIO_ll is called.
+ LOGICAL,SAVE :: GCONFIO = .FALSE. ! Turn TRUE when IO_Config_set is called.
- PUBLIC UPCASE,INITIO_ll,OPEN_ll,CLOSE_ll
- PUBLIC SET_CONFIO_ll,GCONFIO
+ public :: GCONFIO
+ public :: IO_Init, IO_Config_set
+ public :: IO_Pack_set
CONTAINS
- FUNCTION UPCASE(HSTRING)
- CHARACTER(LEN=*) :: HSTRING
- CHARACTER(LEN=LEN(HSTRING)) :: UPCASE
-
- INTEGER :: JC
- INTEGER, PARAMETER :: IAMIN = IACHAR("a")
- INTEGER, PARAMETER :: IAMAJ = IACHAR("A")
-
- DO JC=1,LEN(HSTRING)
- IF (HSTRING(JC:JC) >= "a" .AND. HSTRING(JC:JC) <= "z") THEN
- UPCASE(JC:JC) = ACHAR(IACHAR(HSTRING(JC:JC)) - IAMIN + IAMAJ)
- ELSE
- UPCASE(JC:JC) = HSTRING(JC:JC)
- END IF
- END DO
-
- END FUNCTION UPCASE
-
- SUBROUTINE SET_CONFIO_ll()
- USE MODN_CONFIO
+ SUBROUTINE IO_Config_set()
+ USE MODN_CONFIO, only: LCDF4, LLFIOUT, LLFIREAD
!Use MODN_CONFIO namelist variables
- CALL SET_CONFIO_INTERN_ll(LCDF4, LLFIOUT, LLFIREAD)
- END SUBROUTINE SET_CONFIO_ll
+ CALL IO_Config_set_intern(LCDF4, LLFIOUT, LLFIREAD)
+ END SUBROUTINE IO_Config_set
+
+ SUBROUTINE IO_Config_set_intern(OIOCDF4, OLFIOUT, OLFIREAD)
+ USE MODD_IO, ONLY: LIOCDF4, LLFIOUT, LLFIREAD, LIO_ALLOW_NO_BACKUP, LIO_NO_WRITE
- SUBROUTINE SET_CONFIO_INTERN_ll(OIOCDF4, OLFIOUT, OLFIREAD)
- USE MODD_IO_ll, ONLY : LIOCDF4, LLFIOUT, LLFIREAD, LIO_ALLOW_NO_BACKUP, LIO_NO_WRITE
LOGICAL, INTENT(IN) :: OIOCDF4, OLFIOUT, OLFIREAD
- CALL PRINT_MSG(NVERB_DEBUG,'IO','SET_CONFIO_ll','called')
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Config_set','called')
IF (GCONFIO) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','SET_CONFIO_ll','already called (ignoring this call)')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Config_set','already called (ignoring this call)')
ELSE
#if defined(MNH_IOCDF4)
LIOCDF4 = OIOCDF4
@@ -84,7 +52,7 @@ CONTAINS
LLFIREAD = OLFIREAD
IF (.NOT.LIOCDF4 .AND. .NOT.LLFIOUT) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','SET_CONFIO_ll','output format forced to netCDF')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Config_set','output format forced to netCDF')
LIOCDF4 = .TRUE.
END IF
#else
@@ -96,30 +64,32 @@ CONTAINS
! Set LIO_ALLOW_NO_BACKUP=.true. if writes are disabled (to be coherent)
IF (LIO_NO_WRITE) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','SET_CONFIO_ll','file writes are disabled')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Config_set','file writes are disabled')
LIO_ALLOW_NO_BACKUP = .true.
END IF
END IF
- END SUBROUTINE SET_CONFIO_INTERN_ll
+ END SUBROUTINE IO_Config_set_intern
+
+ SUBROUTINE IO_Init()
+ use MODD_IO, only: CNULLFILE, GSMONOPROC, nio_rank, ISNPROC, ISP, NNULLUNIT
- SUBROUTINE INITIO_ll()
USE MODE_MNH_WORLD, ONLY: INIT_NMNH_COMM_WORLD
- USE MODD_IO_ll
- USE MODE_FIELD
+
IMPLICIT NONE
INTEGER :: IERR, IOS
+ character(len=256) :: yioerrmsg
- CALL PRINT_MSG(NVERB_DEBUG,'IO','INITIO_ll','called')
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Init','called')
CALL INIT_NMNH_COMM_WORLD(IERR)
- IF (IERR .NE.0) CALL PRINT_MSG(NVERB_FATAL,'IO','INITIO_ll','problem with remapping of NMNH_COMM_WORLD')
+ IF (IERR .NE.0) CALL PRINT_MSG(NVERB_FATAL,'IO','IO_Init','problem with remapping of NMNH_COMM_WORLD')
!! Now MPI is initialized for sure
!! Default number for Processor I/O
- ISIOP = 1
+ nio_rank = 1
!! Get number of allocated processors
CALL MPI_COMM_SIZE(NMNH_COMM_WORLD, ISNPROC,IERR)
@@ -131,745 +101,31 @@ CONTAINS
!! Open /dev/null for GLOBAL mode
#if defined(DEV_NULL)
- OPEN(NEWUNIT=NNULLUNIT,FILE=CNULLFILE ,ACTION='WRITE',IOSTAT=IOS)
+ OPEN(NEWUNIT=NNULLUNIT,FILE=CNULLFILE ,ACTION='WRITE',IOSTAT=IOS, IOMSG=yioerrmsg)
#else
- OPEN(NEWUNIT=NNULLUNIT,STATUS='SCRATCH',ACTION='WRITE',IOSTAT=IOS)
-#endif
- IF (IOS > 0) THEN
- CALL PRINT_MSG(NVERB_FATAL,'IO','INITIO_ll','error opening /dev/null')
- END IF
- END SUBROUTINE INITIO_ll
-
- SUBROUTINE OPEN_ll(&
- TPFILE, &
- MODE, &
- COMM, &
- STATUS, &
- ACCESS, &
- IOSTAT, &
- FORM, &
- RECL, &
- BLANK, &
- POSITION,&
- DELIM, &
- PAD, &
- KNB_PROCIO,&
- OPARALLELIO, &
- HPROGRAM_ORIG)
-
- USE MODD_IO_ll
-#if defined(MNH_IOCDF4)
- USE MODD_NETCDF, ONLY:IDCDF_KIND
- use mode_io_file_nc4, only: io_create_file_nc4, io_open_file_nc4
-#endif
- use mode_io_file_lfi, only: io_create_file_lfi, io_open_file_lfi
- USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST, IO_FILE_FIND_BYNAME
- use mode_io_tools, only: io_rank
-
- TYPE(TFILEDATA), INTENT(INOUT) :: TPFILE
- CHARACTER(len=*),INTENT(IN), OPTIONAL :: MODE
- CHARACTER(len=*),INTENT(IN), OPTIONAL :: STATUS
- CHARACTER(len=*),INTENT(IN), OPTIONAL :: ACCESS
- INTEGER, INTENT(OUT) :: IOSTAT
- CHARACTER(len=*),INTENT(IN), OPTIONAL :: FORM
- INTEGER, INTENT(IN), OPTIONAL :: RECL
- CHARACTER(len=*),INTENT(IN), OPTIONAL :: BLANK
- CHARACTER(len=*),INTENT(IN), OPTIONAL :: POSITION
- CHARACTER(len=*),INTENT(IN), OPTIONAL :: DELIM
- CHARACTER(len=*),INTENT(IN), OPTIONAL :: PAD
- INTEGER, INTENT(IN), OPTIONAL :: COMM
- INTEGER, INTENT(IN), OPTIONAL :: KNB_PROCIO
- LOGICAL, INTENT(IN), OPTIONAL :: OPARALLELIO
- CHARACTER(LEN=*),INTENT(IN), OPTIONAL :: HPROGRAM_ORIG !To emulate a file coming from this program
- !
- ! local var
- !
- CHARACTER(len=5) :: CFILE
- INTEGER :: IFILE, IRANK_PROCIO
-
-#if defined(MNH_SX5) || defined(MNH_SP4) || defined(MNH_LINUX)
- CHARACTER(len=20) :: YSTATUS
- CHARACTER(len=20) :: YACCESS
- CHARACTER(len=20) :: YFORM
- INTEGER :: YRECL
- INTEGER ,PARAMETER :: RECL_DEF = 10000
- CHARACTER(len=20) :: YBLANK
- CHARACTER(len=20) :: YPOSITION
- CHARACTER(len=20) :: YDELIM
- CHARACTER(len=20) :: YPAD
- !JUAN
-#endif
- CHARACTER(len=20) :: YACTION
- CHARACTER(len=20) :: YMODE
- CHARACTER(LEN=256) :: YIOERRMSG
- INTEGER :: IOS,IRESP
- INTEGER :: ICOMM
- LOGICAL :: GPARALLELIO
- TYPE(TFILEDATA),POINTER :: TZSPLITFILE
- CHARACTER(LEN=:),ALLOCATABLE :: YPREFILENAME !To store the directory + filename
- CHARACTER(LEN=:),ALLOCATABLE :: YFORSTATUS ! Status for open of a file (for LFI) ('OLD','NEW','UNKNOWN','SCRATCH','REPLACE')
-
- CALL PRINT_MSG(NVERB_DEBUG,'IO','OPEN_ll','opening '//TRIM(TPFILE%CNAME)//' for '//TRIM(TPFILE%CMODE))
- !
- IF ( PRESENT(OPARALLELIO) ) THEN
- GPARALLELIO = OPARALLELIO
- ELSE !par defaut on active les IO paralleles en Z si possible
- GPARALLELIO = .TRUE.
- ENDIF
-
-#ifdef MNH_VPP
- !! BUG Fuji avec RECL non fourni en argument de MYOPEN
- INTEGER :: IRECSIZE
- IF (PRESENT(RECL)) THEN
- IRECSIZE = RECL
- ELSE
- IRECSIZE = 2147483647 ! Default value for FUJI RECL
- END IF
-#endif
-
- IOS = 0
- IF (PRESENT(COMM)) THEN
- ICOMM = COMM
- ELSE
- ICOMM = NMNH_COMM_WORLD ! Default communicator
- END IF
-
- IF (PRESENT(MODE)) THEN
- YMODE = MODE
- YMODE = UPCASE(TRIM(ADJUSTL(YMODE)))
- ELSE
- YMODE = 'GLOBAL' ! Default Mode
- END IF
-
- YACTION = TPFILE%CMODE
- YACTION = UPCASE(TRIM(ADJUSTL(YACTION)))
- IF (YACTION /= "READ" .AND. YACTION /= "WRITE") THEN
- IOSTAT = 99
- TPFILE%NLU = -1
- CALL PRINT_MSG(NVERB_ERROR,'IO','OPEN_ll','action='//TRIM(YACTION)//' not supported')
- RETURN
- END IF
-
- IF (.NOT. ANY(YMODE == (/'GLOBAL ','SPECIFIC ','DISTRIBUTED' , 'IO_ZSPLIT '/))) THEN
- IOSTAT = 99
- TPFILE%NLU = -1
- CALL PRINT_MSG(NVERB_ERROR,'IO','OPEN_ll','ymode='//TRIM(YMODE)//' not supported')
- RETURN
- END IF
-
-#if defined(MNH_SX5) || defined(MNH_SP4) || defined(MNH_LINUX)
- !JUAN
- IF (PRESENT(STATUS)) THEN
- YSTATUS=STATUS
- ELSE
- YSTATUS='UNKNOWN'
- ENDIF
- IF (PRESENT(ACCESS)) THEN
- YACCESS=ACCESS
- ELSE
- YACCESS='SEQUENTIAL'
- ENDIF
- IF (PRESENT(FORM)) THEN
- YFORM=FORM
- ELSE
- YFORM='FORMATTED'
- ENDIF
- IF (PRESENT(RECL)) THEN
- YRECL=RECL
- ELSE
- YRECL=RECL_DEF
- ENDIF
- IF (PRESENT(BLANK)) THEN
- YBLANK=BLANK
- ELSE
- YBLANK='NULL'
- ENDIF
- IF (PRESENT(POSITION)) THEN
- YPOSITION=POSITION
- ELSE
- YPOSITION='ASIS'
- ENDIF
- IF (PRESENT(DELIM)) THEN
- YDELIM=DELIM
- ELSE
- YDELIM='NONE'
- ENDIF
- IF (PRESENT(PAD)) THEN
- YPAD=PAD
- ELSE
- YPAD='YES'
- ENDIF
+ OPEN(NEWUNIT=NNULLUNIT,STATUS='SCRATCH',ACTION='WRITE',IOSTAT=IOS, IOMSG=yioerrmsg)
#endif
-
- IF (ALLOCATED(TPFILE%CDIRNAME)) THEN
- IF(LEN_TRIM(TPFILE%CDIRNAME)>0) THEN
- YPREFILENAME = TRIM(TPFILE%CDIRNAME)//'/'//TRIM(TPFILE%CNAME)
- ELSE
- YPREFILENAME = TRIM(TPFILE%CNAME)
- END IF
- ELSE
- YPREFILENAME = TRIM(TPFILE%CNAME)
+ IF (IOS /= 0) THEN
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_Init','problem opening /dev/null :'//trim(yioerrmsg))
END IF
+ END SUBROUTINE IO_Init
- SELECT CASE(YMODE)
-
- CASE('GLOBAL')
- IF (YACTION == 'READ') THEN
- TPFILE%NMASTER_RANK = -1
- TPFILE%LMASTER = .TRUE. !Every process read the file
- TPFILE%LMULTIMASTERS = .TRUE.
- ELSE
- IF (TPFILE%CTYPE=='OUTPUTLISTING') THEN
- IF (LVERB_ALLPRC) THEN
- TPFILE%NMASTER_RANK = -1
- TPFILE%LMASTER = .TRUE. !Every process may write in the file
- TPFILE%LMULTIMASTERS = .TRUE.
- ELSE
- TPFILE%NMASTER_RANK = ISIOP
- TPFILE%LMASTER = (ISP == ISIOP)
- TPFILE%LMULTIMASTERS = .FALSE.
- END IF
- ELSE
- TPFILE%NMASTER_RANK = ISIOP
- TPFILE%LMASTER = (ISP == ISIOP)
- TPFILE%LMULTIMASTERS = .FALSE.
- END IF
- END IF
- TPFILE%NSUBFILES_IOZ = 0
-
- IF (TPFILE%LMASTER) THEN
- !! I/O processor case
-#ifdef MNH_VPP
- OPEN(NEWUNIT=TPFILE%NLU, &
- FILE=TRIM(YPREFILENAME),&
- STATUS=STATUS, &
- ACCESS=ACCESS, &
- IOSTAT=IOS, &
- IOMSG=YIOERRMSG, &
- FORM=FORM, &
- RECL=IRECSIZE, &
- BLANK=BLANK, &
- POSITION=POSITION, &
- ACTION=YACTION, &
- DELIM=DELIM, &
- PAD=PAD)
-
-#else
-#if defined(MNH_SX5) || defined(MNH_SP4) || defined(MNH_LINUX)
- !JUAN : 31/03/2000 modif pour acces direct
- IF (YACCESS=='STREAM') THEN
- OPEN(NEWUNIT=TPFILE%NLU, &
- FILE=TRIM(YPREFILENAME),&
- STATUS=YSTATUS, &
- ACCESS=YACCESS, &
- IOSTAT=IOS, &
- IOMSG=YIOERRMSG, &
- FORM=YFORM, &
- ACTION=YACTION)
- ELSEIF (YACCESS=='DIRECT') THEN
- OPEN(NEWUNIT=TPFILE%NLU, &
- FILE=TRIM(YPREFILENAME),&
- STATUS=YSTATUS, &
- ACCESS=YACCESS, &
- IOSTAT=IOS, &
- IOMSG=YIOERRMSG, &
- FORM=YFORM, &
- RECL=YRECL, &
- ACTION=YACTION)
- ELSE
- IF (YFORM=="FORMATTED") THEN
- IF (YACTION=='READ') THEN
- OPEN(NEWUNIT=TPFILE%NLU, &
- FILE=TRIM(YPREFILENAME),&
- STATUS=YSTATUS, &
- ACCESS=YACCESS, &
- IOSTAT=IOS, &
- IOMSG=YIOERRMSG, &
- FORM=YFORM, &
- RECL=YRECL, &
- BLANK=YBLANK, &
- POSITION=YPOSITION, &
- ACTION=YACTION, &
- !DELIM=YDELIM, & !Philippe: commented because bug with GCC 5.X
- PAD=YPAD)
- ELSE
- OPEN(NEWUNIT=TPFILE%NLU, &
- FILE=TRIM(YPREFILENAME),&
- STATUS=YSTATUS, &
- ACCESS=YACCESS, &
- IOSTAT=IOS, &
- IOMSG=YIOERRMSG, &
- FORM=YFORM, &
- RECL=YRECL, &
- BLANK=YBLANK, &
- POSITION=YPOSITION, &
- ACTION=YACTION, &
- DELIM=YDELIM, &
- PAD=YPAD)
- ENDIF
- ELSE
- OPEN(NEWUNIT=TPFILE%NLU, &
- FILE=TRIM(YPREFILENAME),&
- STATUS=YSTATUS, &
- ACCESS=YACCESS, &
- IOSTAT=IOS, &
- IOMSG=YIOERRMSG, &
- FORM=YFORM, &
- RECL=YRECL, &
- POSITION=YPOSITION, &
- ACTION=YACTION)
- ENDIF
- ENDIF
-
-
- !print*,' OPEN_ll'
- !print*,' OPEN(NEWUNIT=',TPFILE%NLU
- !print*,' FILE=',TRIM(YPREFILENAME)
- !print*,' STATUS=',YSTATUS
- !print*,' ACCESS=',YACCESS
- !print*,' IOSTAT=',IOS
- !print*,' FORM=',YFORM
- !print*,' RECL=',YRECL
- !print*,' BLANK=',YBLANK
- !print*,' POSITION=',YPOSITION
- !print*,' ACTION=',YACTION
- !print*,' DELIM=',YDELIM
- !print*,' PAD=',YPAD
-#else
- OPEN(NEWUNIT=TPFILE%NLU, &
- FILE=TRIM(YPREFILENAME),&
- STATUS=STATUS, &
- ACCESS=ACCESS, &
- IOSTAT=IOS, &
- IOMSG=YIOERRMSG, &
- FORM=FORM, &
- RECL=RECL, &
- BLANK=BLANK, &
- POSITION=POSITION, &
- ACTION=YACTION, &
- DELIM=DELIM, &
- PAD=PAD)
-#endif
-
-#endif
- IF (IOS/=0) CALL PRINT_MSG(NVERB_FATAL,'IO','OPEN_ll','Problem when opening '//TRIM(YPREFILENAME)//': '//TRIM(YIOERRMSG))
- ELSE
- !! NON I/O processors case
- IOS = 0
- TPFILE%NLU = NNULLUNIT
- END IF
-
-
- CASE('SPECIFIC')
- TPFILE%NMASTER_RANK = -1
- TPFILE%LMASTER = .TRUE. !Every process use the file
- TPFILE%LMULTIMASTERS = .TRUE.
- TPFILE%NSUBFILES_IOZ = 0
-
-#ifdef MNH_VPP
- OPEN(NEWUNIT=TPFILE%NLU, &
- FILE=TRIM(YPREFILENAME)//SUFFIX(".P"), &
- STATUS=STATUS, &
- ACCESS=ACCESS, &
- IOSTAT=IOS, &
- IOMSG=YIOERRMSG, &
- FORM=FORM, &
- RECL=IRECSIZE, &
- BLANK=BLANK, &
- POSITION=POSITION, &
- ACTION=YACTION, &
- DELIM=DELIM, &
- PAD=PAD)
-
-#else
-#if defined(MNH_SX5) || defined(MNH_SP4) || defined(MNH_LINUX)
- IF (ACCESS=='DIRECT') THEN
- OPEN(NEWUNIT=TPFILE%NLU, &
- FILE=TRIM(YPREFILENAME)//SUFFIX(".P"), &
- STATUS=YSTATUS, &
- ACCESS=YACCESS, &
- IOSTAT=IOS, &
- IOMSG=YIOERRMSG, &
- FORM=YFORM, &
- RECL=YRECL, &
- ACTION=YACTION)
- ELSE
- IF (YACTION=='READ') THEN
- OPEN(NEWUNIT=TPFILE%NLU, &
- FILE=TRIM(YPREFILENAME)//SUFFIX(".P"), &
- STATUS=YSTATUS, &
- ACCESS=YACCESS, &
- IOSTAT=IOS, &
- IOMSG=YIOERRMSG, &
- FORM=YFORM, &
- RECL=YRECL, &
- BLANK=YBLANK, &
- POSITION=YPOSITION, &
- ACTION=YACTION, &
- !DELIM=YDELIM, & !Philippe: commented because bug with GCC 5.X
- PAD=YPAD)
- ELSE
- OPEN(NEWUNIT=TPFILE%NLU, &
- FILE=TRIM(YPREFILENAME)//SUFFIX(".P"), &
- STATUS=YSTATUS, &
- ACCESS=YACCESS, &
- IOSTAT=IOS, &
- IOMSG=YIOERRMSG, &
- FORM=YFORM, &
- RECL=YRECL, &
- BLANK=YBLANK, &
- POSITION=YPOSITION, &
- ACTION=YACTION, &
- DELIM=YDELIM, &
- PAD=YPAD)
- ENDIF
- ENDIF
-#else
- OPEN(NEWUNIT=TPFILE%NLU, &
- FILE=TRIM(YPREFILENAME)//SUFFIX(".P"), &
- STATUS=STATUS, &
- ACCESS=ACCESS, &
- IOSTAT=IOS, &
- IOMSG=YIOERRMSG, &
- FORM=FORM, &
- RECL=RECL, &
- BLANK=BLANK, &
- POSITION=POSITION, &
- ACTION=YACTION, &
- DELIM=DELIM, &
- PAD=PAD)
-#endif
-
-#endif
- IF (IOS/=0) CALL PRINT_MSG(NVERB_FATAL,'IO','OPEN_ll','Problem when opening '//TRIM(YPREFILENAME)//': '//TRIM(YIOERRMSG))
-
-
-
- CASE('DISTRIBUTED')
- TPFILE%NMASTER_RANK = ISIOP
- TPFILE%LMASTER = (ISP == ISIOP)
- TPFILE%LMULTIMASTERS = .FALSE.
- TPFILE%NSUBFILES_IOZ = 0
- IF (.NOT.TPFILE%LMASTER) THEN
- !! NON I/O processors case
- IOS = 0
- END IF
+SUBROUTINE IO_Pack_set(O1D,O2D,OPACK)
+USE MODD_IO, ONLY: LPACK, L1D, L2D
+USE MODD_VAR_ll, ONLY: IP
+IMPLICIT NONE
+LOGICAL, INTENT(IN) :: O1D,O2D,OPACK
- CASE('IO_ZSPLIT')
- TPFILE%NMASTER_RANK = ISIOP
- TPFILE%LMASTER = (ISP == ISIOP)
- TPFILE%LMULTIMASTERS = .FALSE.
- TPFILE%NSUBFILES_IOZ = 0
- IF ( GPARALLELIO .AND. PRESENT(KNB_PROCIO) ) THEN
- IF (KNB_PROCIO>1) THEN
- TPFILE%NSUBFILES_IOZ = KNB_PROCIO
- END IF
- END IF
-
-#if defined(MNH_IOCDF4)
- IF (TPFILE%LMASTER .AND. (TPFILE%CFORMAT=='LFI' .OR. TPFILE%CFORMAT=='LFICDF4') ) THEN
-#else
- IF (TPFILE%LMASTER) THEN
-#endif
- ELSE
- !! NON I/O processors OR netCDF read case
- IOS = 0
- END IF
-
- IF (TPFILE%NSUBFILES_IOZ > 0) THEN
- IF (.NOT.ALLOCATED(TPFILE%TFILES_IOZ)) THEN
- ALLOCATE(TPFILE%TFILES_IOZ(TPFILE%NSUBFILES_IOZ))
- ELSE IF ( SIZE(TPFILE%TFILES_IOZ) /= TPFILE%NSUBFILES_IOZ ) THEN
- CALL PRINT_MSG(NVERB_FATAL,'IO','OPEN_ll','SIZE(PFILE%TFILES_IOZ) /= TPFILE%NSUBFILES_IOZ for '//TRIM(TPFILE%CNAME))
- END IF
- DO IFILE=1,TPFILE%NSUBFILES_IOZ
- IRANK_PROCIO = 1 + IO_RANK(IFILE-1,ISNPROC,TPFILE%NSUBFILES_IOZ)
- WRITE(CFILE ,'(".Z",i3.3)') IFILE
-
- CALL IO_FILE_FIND_BYNAME(TRIM(TPFILE%CNAME)//TRIM(CFILE),TZSPLITFILE,IRESP)
-
- 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(TZSPLITFILE,TRIM(TPFILE%CNAME)//TRIM(CFILE),TPFILE%CTYPE,TPFILE%CMODE, &
- HDIRNAME=TPFILE%CDIRNAME, &
- KLFINPRAR=TPFILE%NLFINPRAR,KLFITYPE=TPFILE%NLFITYPE,KLFIVERB=TPFILE%NLFIVERB, &
- HFORMAT=TPFILE%CFORMAT)
- ELSE
- CALL IO_FILE_ADD2LIST(TZSPLITFILE,TRIM(TPFILE%CNAME)//TRIM(CFILE),TPFILE%CTYPE,TPFILE%CMODE, &
- KLFINPRAR=TPFILE%NLFINPRAR,KLFITYPE=TPFILE%NLFITYPE,KLFIVERB=TPFILE%NLFIVERB, &
- HFORMAT=TPFILE%CFORMAT)
- END IF
- END IF
-
- IF (ALLOCATED(TPFILE%CDIRNAME)) THEN
- IF (LEN_TRIM(TZSPLITFILE%CDIRNAME)>0) THEN
- YPREFILENAME = TRIM(TZSPLITFILE%CDIRNAME)//'/'//TRIM(TZSPLITFILE%CNAME)
- ELSE
- YPREFILENAME = TRIM(TZSPLITFILE%CNAME)
- END IF
- ELSE
- YPREFILENAME = TRIM(TZSPLITFILE%CNAME)
- END IF
-
- TPFILE%TFILES_IOZ(IFILE)%TFILE => TZSPLITFILE
- !Done outside of the previous IF to prevent problems with .OUT files
- TZSPLITFILE%NMPICOMM = ICOMM
- TZSPLITFILE%NMASTER_RANK = IRANK_PROCIO
- TZSPLITFILE%LMASTER = (ISP == IRANK_PROCIO)
- TZSPLITFILE%LMULTIMASTERS = .FALSE.
- TZSPLITFILE%NSUBFILES_IOZ = 0
-
- ! Must be done BEFORE the call to io_open_file_* because we need to read things in these subroutines
- TZSPLITFILE%LOPENED = .TRUE.
- TZSPLITFILE%NOPEN = TZSPLITFILE%NOPEN + 1
- TZSPLITFILE%NOPEN_CURRENT = TZSPLITFILE%NOPEN_CURRENT + 1
-
-#if defined(MNH_IOCDF4)
- IF (TZSPLITFILE%CFORMAT=='NETCDF4' .OR. TZSPLITFILE%CFORMAT=='LFICDF4') THEN
- IF (YACTION == 'READ') THEN
- ! Open netCDF File for reading
- call io_open_file_nc4(tzsplitfile)
- IOS = 0
- END IF
-
- IF (YACTION == 'WRITE') THEN
- ! Create netCDF File for writing
- call io_create_file_nc4(TZSPLITFILE, hprogram_orig=HPROGRAM_ORIG)
- IOS = 0
- END IF
- END IF
-#endif
- IF (TZSPLITFILE%CFORMAT=='LFI' .OR. TZSPLITFILE%CFORMAT=='LFICDF4') THEN
- SELECT CASE (YACTION)
- CASE('READ')
- call io_open_file_lfi(tzsplitfile,iresp)
- CASE('WRITE')
- call io_create_file_lfi(tzsplitfile,iresp)
- END SELECT
- ENDIF
- !
- ENDDO
- END IF
-
-
- END SELECT
-
- TPFILE%NMPICOMM = ICOMM
-
- IOSTAT = IOS
-
- CONTAINS
- FUNCTION SUFFIX(HEXT)
-
- CHARACTER(len=*) :: HEXT
- CHARACTER(len=LEN(HEXT)+3) :: SUFFIX
-
- WRITE(SUFFIX,'(A,i3.3)') TRIM(HEXT), ISP
-
- END FUNCTION SUFFIX
-
- END SUBROUTINE OPEN_ll
-
- SUBROUTINE CLOSE_ll(TPFILE,IOSTAT,OPARALLELIO,HPROGRAM_ORIG)
- USE MODD_IO_ll
+LPACK = OPACK
+L1D = O1D
+L2D = O2D
- USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_FIND_BYNAME
- use mode_io_file_lfi, only: io_close_file_lfi
-#if defined(MNH_IOCDF4)
- use mode_io_file_nc4, only: io_close_file_nc4
- use mode_io_write_nc4, only: io_write_coordvar_nc4
-#endif
- TYPE(TFILEDATA), INTENT(IN) :: TPFILE
- INTEGER, INTENT(OUT), OPTIONAL :: IOSTAT
- LOGICAL, INTENT(IN), OPTIONAL :: OPARALLELIO
- CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HPROGRAM_ORIG !To emulate a file coming from this program
-
- INTEGER :: IERR, IGLOBALERR, IGLOBALERR2, IRESP, IRESP2
-
- INTEGER :: IFILE
- LOGICAL :: GPARALLELIO
- TYPE(TFILEDATA),POINTER :: TZFILE
-
- CALL PRINT_MSG(NVERB_DEBUG,'IO','CLOSE_ll','closing '//TRIM(TPFILE%CNAME))
-
- IF ( PRESENT(OPARALLELIO) ) THEN
- GPARALLELIO = OPARALLELIO
- ELSE !par defaut on active les IO paralleles en Z si possible
- GPARALLELIO = .TRUE.
- ENDIF
- !JUANZ
-
- IRESP = 0
- IRESP2 = 0
- IGLOBALERR = 0
- IGLOBALERR2 = 0
-
- IF (TPFILE%LMASTER) THEN
- IF (TPFILE%NLU/=-1 .AND. TPFILE%NLU/=NNULLUNIT) THEN
- CLOSE(UNIT=TPFILE%NLU, IOSTAT=IRESP,STATUS='KEEP')
- END IF
- END IF
- !
- IF( GPARALLELIO ) THEN
- DO IFILE=1,TPFILE%NSUBFILES_IOZ
- TZFILE => TPFILE%TFILES_IOZ(IFILE)%TFILE
-#if defined(MNH_IOCDF4)
- !Write coordinates variables in netCDF file
- IF (TZFILE%CMODE == 'WRITE' .AND. (TZFILE%CFORMAT=='NETCDF4' .OR. TZFILE%CFORMAT=='LFICDF4')) THEN
- CALL IO_WRITE_COORDVAR_NC4(TZFILE,HPROGRAM_ORIG=HPROGRAM_ORIG)
- END IF
-#endif
- IF (TZFILE%LMASTER) THEN
- if (tzfile%cformat == 'LFI' .or. tzfile%cformat == 'LFICDF4') call io_close_file_lfi(tzfile,iresp2)
-#if defined(MNH_IOCDF4)
- if (tzfile%cformat == 'NETCDF4' .or. tzfile%cformat == 'LFICDF4') call io_close_file_nc4(tzfile,iresp2)
-#endif
- END IF
- END DO
- !
- CALL MPI_ALLREDUCE(IRESP2,IGLOBALERR2,1,MPI_INTEGER,MPI_BOR,TPFILE%NMPICOMM,IERR)
- END IF
- !
- CALL MPI_ALLREDUCE(IRESP, IGLOBALERR, 1,MPI_INTEGER,MPI_BOR,TPFILE%NMPICOMM,IERR)
-
- IF (PRESENT(IOSTAT)) THEN
- IF (IGLOBALERR/=0) THEN
- IOSTAT = IGLOBALERR
- ELSE
- IOSTAT = IGLOBALERR2
- END IF
- END IF
+IF ( IP == 1 ) PRINT *,'INIT L1D,L2D,LPACK = ',L1D,L2D,LPACK
- END SUBROUTINE CLOSE_ll
- !
- !
-END MODULE MODE_IO_ll
+END SUBROUTINE IO_Pack_set
+END MODULE MODE_IO
-MODULE MODE_MSG
-!
-USE MODD_IO_ll, ONLY : NVERB_FATAL,NVERB_ERROR,NVERB_WARNING,NVERB_INFO,NVERB_DEBUG
-!
-IMPLICIT NONE
-!
-CONTAINS
-!
-SUBROUTINE PRINT_MSG(KVERB,HDOMAIN,HSUBR,HMSG)
-!
-USE ISO_FORTRAN_ENV, ONLY : ERROR_UNIT, OUTPUT_UNIT
-!
-USE MODD_CONF, ONLY : CPROGRAM
-USE MODD_IO_ll, ONLY : 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 modi_tools_c
-!
-!USE MODE_FM, ONLY : IO_FILE_CLOSE_ll
-!
-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
-!
-CHARACTER(LEN=8) :: YPRC
-CHARACTER(LEN=9) :: YPRE
-CHARACTER(LEN=30) :: YSUBR
-INTEGER :: IERR, IMAXVERB,IABORTLEVEL
-INTEGER :: ILU
-LOGICAL :: GWRITE_OUTLST,GWRITE_STDOUT
-!
-!Determine if the process will write
-GWRITE_OUTLST = .FALSE.
-GWRITE_STDOUT = .FALSE.
-IF (IP == 1 .OR. LVERB_ALLPRC) THEN
- IF (LVERB_OUTLST) GWRITE_OUTLST = .TRUE.
- IF (LVERB_STDOUT) GWRITE_STDOUT = .TRUE.
-END IF
-!
-YPRC=''
-IF (LVERB_ALLPRC) WRITE(YPRC,'( I8 )') IP-1
-!
-!Check if the output file is available
-ILU = -1
-IF (ASSOCIATED(TFILE_OUTPUTLISTING)) THEN
- IF (TFILE_OUTPUTLISTING%LOPENED) THEN
- ILU = TFILE_OUTPUTLISTING%NLU
- ELSE
- GWRITE_OUTLST = .FALSE.
- IF (GWRITE_STDOUT) WRITE(UNIT=OUTPUT_UNIT,FMT=*) 'TFILE_OUTPUTLISTING not opened'
- END IF
-ELSE
-!PW: TODO?: temporary to detect non-initialisation
-! should disappear except at the beginning of a run
- GWRITE_OUTLST = .FALSE.
- IF (GWRITE_STDOUT .AND. CPROGRAM/='LFICDF') WRITE(UNIT=OUTPUT_UNIT,FMT=*) 'TFILE_OUTPUTLISTING not associated'
-END IF
-!
-SELECT CASE(HDOMAIN)
- CASE('IO')
- IMAXVERB = NIO_VERB
- IABORTLEVEL = NIO_ABORT_LEVEL
- CASE ('GEN')
- IMAXVERB = NGEN_VERB
- IABORTLEVEL = NGEN_ABORT_LEVEL
- CASE DEFAULT
- IF (GWRITE_STDOUT) WRITE(UNIT=OUTPUT_UNIT,FMT=*) 'ERROR: PRINT_MSG: wrong message category (',TRIM(HDOMAIN),')'
- IF (GWRITE_OUTLST) WRITE(UNIT=ILU, FMT=*) 'ERROR: PRINT_MSG: wrong message category (',TRIM(HDOMAIN),')'
- RETURN
-END SELECT
-!
-IF (KVERB>IMAXVERB) RETURN
-!
-SELECT CASE(KVERB)
- CASE(NVERB_FATAL)
- YPRE='FATAL: '
- CASE(NVERB_ERROR)
- YPRE='ERROR: '
- CASE(NVERB_WARNING)
- YPRE='WARNING: '
- CASE(NVERB_INFO)
- YPRE='INFO: '
- CASE(NVERB_DEBUG)
- YPRE='DEBUG: '
- 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
-!
-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 (KVERB<=IABORTLEVEL) THEN
- IF (IP==1) WRITE(UNIT=ERROR_UNIT,FMT=*) 'ABORT asked by application '//TRIM(CPROGRAM)
- 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)
-#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)
- IF (ILU>0) CALL IO_FILE_CLOSE_ll(TFILE_OUTPUTLISTING) !To flush it
-#else
- IF (ILU>0) FLUSH(UNIT=ILU) !OK in F2003
- IF (ASSOCIATED(TLUOUT0)) FLUSH(UNIT=TLUOUT0%NLU)
-#endif
- !Add a sleep to ensure that the process(es) that have to write to stderr and to file
- !have enough time before an other process calls mpi_abort
- CALL SLEEP_C(5)
- !
- CALL MPI_ABORT(NMNH_COMM_WORLD, -10, IERR)
- CALL ABORT
-END IF
-!
-END SUBROUTINE PRINT_MSG
-!
-END MODULE MODE_MSG
diff --git a/src/LIB/SURCOUCHE/src/fmread_ll.f90 b/src/LIB/SURCOUCHE/src/mode_io_field_read.f90
similarity index 70%
rename from src/LIB/SURCOUCHE/src/fmread_ll.f90
rename to src/LIB/SURCOUCHE/src/mode_io_field_read.f90
index 10c862803697fb325900115f9959c08f3c687512..5f97e45f608226807385b7b3056e2ab092ffad46 100644
--- a/src/LIB/SURCOUCHE/src/fmread_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_field_read.f90
@@ -1,27 +1,25 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
+! Modifications:
+! J. Escobar 22/08/2005: BUG : missing "GOTO 1000" if read field not found
+! J. Escobar 13/01/2015: remove comment on BCAST(IRESP in FMREADX2_ll
+! J. Escobar 15/09/2015: WENO5 & JPHEXT <> 1
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! J. Escobar 17/07/2018: reintroduce needed MPI_BARRIER in IO_Field_read_byfield_X3
+! P. Wautelet 29/01/2019: small bug correction in time measurement in IO_Field_read_byfield_X2
+! P. Wautelet 05/03/2019: rename IO subroutines and modules
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 12/04/2019: use MNHTIME for time measurement variables
+!-----------------------------------------------------------------
-#ifdef MNH_MPI_DOUBLE_PRECISION
-#define MPI_FLOAT MPI_DOUBLE_PRECISION
-#else
-#define MPI_FLOAT MPI_REAL
-#endif
-
-MODULE MODE_FMREAD
+MODULE MODE_IO_FIELD_READ
!
-!Correction :
-! J.Escobar : 22/08/2005 : BUG : manque un "GOTO 1000" si champs
-! lue non trouvé !!!
-! J.Escobar : 13/01/2015 : remove comment on BCAST(IRESP in FMREADX2_ll
-! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! J.Escobar : 17/07/2018 : reintroduce needed MPI_BARRIER in IO_READ_FIELD_BYFIELD_X3
-!
-USE MODD_IO_ll, ONLY : NVERB_FATAL,NVERB_ERROR,NVERB_WARNING,NVERB_INFO,NVERB_DEBUG,TFILEDATA
+USE MODD_IO, ONLY : NVERB_FATAL,NVERB_ERROR,NVERB_WARNING,NVERB_INFO,NVERB_DEBUG,TFILEDATA
USE MODD_MPIF
+use modd_precision, only: MNHREAL_MPI, MNHTIME
!
USE MODE_FIELD
USE MODE_IO_READ_LFI
@@ -34,36 +32,36 @@ IMPLICIT NONE
PRIVATE
-INTERFACE IO_READ_FIELD
- MODULE PROCEDURE IO_READ_FIELD_BYNAME_X0, IO_READ_FIELD_BYNAME_X1, &
- IO_READ_FIELD_BYNAME_X2, IO_READ_FIELD_BYNAME_X3, &
- IO_READ_FIELD_BYNAME_X4, IO_READ_FIELD_BYNAME_X5, &
- IO_READ_FIELD_BYNAME_X6, &
- IO_READ_FIELD_BYNAME_N0, IO_READ_FIELD_BYNAME_N1, &
- IO_READ_FIELD_BYNAME_N2, &
- IO_READ_FIELD_BYNAME_L0, IO_READ_FIELD_BYNAME_L1, &
- IO_READ_FIELD_BYNAME_C0, &
- IO_READ_FIELD_BYNAME_T0, &
- IO_READ_FIELD_BYFIELD_X0,IO_READ_FIELD_BYFIELD_X1, &
- IO_READ_FIELD_BYFIELD_X2,IO_READ_FIELD_BYFIELD_X3, &
- IO_READ_FIELD_BYFIELD_X4,IO_READ_FIELD_BYFIELD_X5, &
- IO_READ_FIELD_BYFIELD_X6, &
- IO_READ_FIELD_BYFIELD_N0,IO_READ_FIELD_BYFIELD_N1, &
- IO_READ_FIELD_BYFIELD_N2, &
- IO_READ_FIELD_BYFIELD_L0,IO_READ_FIELD_BYFIELD_L1, &
- IO_READ_FIELD_BYFIELD_C0, &
- IO_READ_FIELD_BYFIELD_T0
-END INTERFACE
+public :: IO_Field_read, IO_Field_read_lb
-INTERFACE IO_READ_FIELD_LB
- MODULE PROCEDURE IO_READ_FIELD_BYNAME_LB, IO_READ_FIELD_BYFIELD_LB
+INTERFACE IO_Field_read
+ MODULE PROCEDURE IO_Field_read_byname_X0, IO_Field_read_byname_X1, &
+ IO_Field_read_byname_X2, IO_Field_read_byname_X3, &
+ IO_Field_read_byname_X4, IO_Field_read_byname_X5, &
+ IO_Field_read_byname_X6, &
+ IO_Field_read_byname_N0, IO_Field_read_byname_N1, &
+ IO_Field_read_byname_N2, &
+ IO_Field_read_byname_L0, IO_Field_read_byname_L1, &
+ IO_Field_read_byname_C0, &
+ IO_Field_read_byname_T0, &
+ IO_Field_read_byfield_X0,IO_Field_read_byfield_X1, &
+ IO_Field_read_byfield_X2,IO_Field_read_byfield_X3, &
+ IO_Field_read_byfield_X4,IO_Field_read_byfield_X5, &
+ IO_Field_read_byfield_X6, &
+ IO_Field_read_byfield_N0,IO_Field_read_byfield_N1, &
+ IO_Field_read_byfield_N2, &
+ IO_Field_read_byfield_L0,IO_Field_read_byfield_L1, &
+ IO_Field_read_byfield_C0, &
+ IO_Field_read_byfield_T0
END INTERFACE
-PUBLIC IO_READ_FIELD,IO_READ_FIELD_LB
+INTERFACE IO_Field_read_lb
+ MODULE PROCEDURE IO_Field_read_byname_lb, IO_Field_read_byfield_lb
+END INTERFACE
CONTAINS
-SUBROUTINE IO_FILE_READ_CHECK(TPFILE,HSUBR,KRESP)
+SUBROUTINE IO_File_read_check(TPFILE,HSUBR,KRESP)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
CHARACTER(LEN=*), INTENT(IN) :: HSUBR
INTEGER, INTENT(OUT) :: KRESP
@@ -91,16 +89,16 @@ IF (TPFILE%CFORMAT/='NETCDF4' .AND. TPFILE%CFORMAT/='LFI' .AND. TPFILE%CFORMAT/=
RETURN
END IF
!
-END SUBROUTINE IO_FILE_READ_CHECK
+END SUBROUTINE IO_File_read_check
-SUBROUTINE IO_BCAST_FIELD_METADATA(TPFILE,TPFIELD)
+SUBROUTINE IO_Field_metadata_bcast(TPFILE,TPFIELD)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
!
INTEGER :: IERR
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_BCAST_FIELD_METADATA','called for '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_metadata_bcast','called for '//TRIM(TPFIELD%CMNHNAME))
!
CALL MPI_BCAST(TPFIELD%CMNHNAME, LEN(TPFIELD%CMNHNAME), MPI_CHARACTER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
CALL MPI_BCAST(TPFIELD%CSTDNAME, LEN(TPFIELD%CSTDNAME), MPI_CHARACTER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
@@ -113,10 +111,10 @@ CALL MPI_BCAST(TPFIELD%NGRID, 1, MPI_INTEGER, TPFILE%NMA
CALL MPI_BCAST(TPFIELD%NTYPE, 1, MPI_INTEGER, TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
CALL MPI_BCAST(TPFIELD%NDIMS, 1, MPI_INTEGER, TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
!
-END SUBROUTINE IO_BCAST_FIELD_METADATA
+END SUBROUTINE IO_Field_metadata_bcast
-SUBROUTINE IO_READ_FIELD_BYNAME_X0(TPFILE,HNAME,PFIELD,KRESP)
+SUBROUTINE IO_Field_read_byname_X0(TPFILE,HNAME,PFIELD,KRESP)
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
@@ -126,19 +124,19 @@ INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYNAME_X0',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byname_X0',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
-IF(IRESP==0) CALL IO_READ_FIELD(TPFILE,TFIELDLIST(ID),PFIELD,IRESP)
+IF(IRESP==0) CALL IO_Field_read(TPFILE,TFIELDLIST(ID),PFIELD,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
-END SUBROUTINE IO_READ_FIELD_BYNAME_X0
+END SUBROUTINE IO_Field_read_byname_X0
-SUBROUTINE IO_READ_FIELD_BYFIELD_X0(TPFILE,TPFIELD,PFIELD,KRESP)
+SUBROUTINE IO_Field_read_byfield_X0(TPFILE,TPFIELD,PFIELD,KRESP)
!
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
+USE MODD_IO, ONLY: ISP,GSMONOPROC
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
@@ -148,40 +146,40 @@ INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
INTEGER :: IERR
INTEGER :: IRESP
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYFIELD_X0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+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_READ_FIELD_BYFIELD_X0',IRESP)
+CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_X0',IRESP)
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,PFIELD,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,PFIELD,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,PFIELD,IRESP)
+ CALL IO_Field_read_lfi(TPFILE,TPFIELD,PFIELD,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,PFIELD,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,PFIELD,IRESP)
END IF
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,PFIELD,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,PFIELD,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,PFIELD,IRESP)
+ CALL IO_Field_read_lfi(TPFILE,TPFIELD,PFIELD,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,PFIELD,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,PFIELD,IRESP)
END IF
END IF
!
CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
!
!Broadcast header only if IRESP==-111
- !because metadata of field has been modified in IO_READ_FIELD_xxx
- IF (IRESP==-111) CALL IO_BCAST_FIELD_METADATA(TPFILE,TPFIELD)
+ !because metadata of field has been modified in IO_Field_read_xxx
+ IF (IRESP==-111) CALL IO_Field_metadata_bcast(TPFILE,TPFIELD)
!
! Broadcast Field
- CALL MPI_BCAST(PFIELD,1,MPI_FLOAT,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ CALL MPI_BCAST(PFIELD,1,MNHREAL_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
END IF
END IF
!
@@ -189,13 +187,13 @@ IF (IRESP==-111) IRESP = 0 !-111 is not really an error (metadata has changed)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
-END SUBROUTINE IO_READ_FIELD_BYFIELD_X0
+END SUBROUTINE IO_Field_read_byfield_X0
-SUBROUTINE IO_READ_FIELD_BYNAME_X1(TPFILE,HNAME,PFIELD,KRESP,KIMAX_ll,KJMAX_ll,TPSPLITTING)
+SUBROUTINE IO_Field_read_byname_X1(TPFILE,HNAME,PFIELD,KRESP,KIMAX_ll,KJMAX_ll,TPSPLITTING)
!
-USE MODD_IO_ll, ONLY : ISNPROC
-USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
+USE MODD_IO, ONLY: ISNPROC
+USE MODD_STRUCTURE_ll, ONLY: ZONE_ll
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
@@ -208,20 +206,20 @@ TYPE(ZONE_ll),DIMENSION(ISNPROC),OPTIONAL,INTENT(IN) :: TPSPLITTING ! splitting
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYNAME_X1',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byname_X1',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
-IF(IRESP==0) CALL IO_READ_FIELD(TPFILE,TFIELDLIST(ID),PFIELD,IRESP,KIMAX_ll,KJMAX_ll,TPSPLITTING)
+IF(IRESP==0) CALL IO_Field_read(TPFILE,TFIELDLIST(ID),PFIELD,IRESP,KIMAX_ll,KJMAX_ll,TPSPLITTING)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
-END SUBROUTINE IO_READ_FIELD_BYNAME_X1
+END SUBROUTINE IO_Field_read_byname_X1
-SUBROUTINE IO_READ_FIELD_BYFIELD_X1(TPFILE,TPFIELD,PFIELD,KRESP,KIMAX_ll,KJMAX_ll,TPSPLITTING)
+SUBROUTINE IO_Field_read_byfield_X1(TPFILE,TPFIELD,PFIELD,KRESP,KIMAX_ll,KJMAX_ll,TPSPLITTING)
!
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,ISNPROC
-USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
+USE MODD_IO, ONLY: ISP, GSMONOPROC, ISNPROC
+USE MODD_STRUCTURE_ll, ONLY: ZONE_ll
!
USE MODE_SCATTER_ll
USE MODE_ALLOCBUFFER_ll
@@ -239,32 +237,32 @@ REAL,DIMENSION(:),POINTER :: ZFIELDP
LOGICAL :: GALLOC
INTEGER :: IRESP
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYFIELD_X1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_X1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
GALLOC = .FALSE.
IRESP = 0
ZFIELDP => NULL()
!
-CALL IO_FILE_READ_CHECK(TPFILE,'IO_READ_FIELD_BYFIELD_X1',IRESP)
+CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_X1',IRESP)
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,PFIELD,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,PFIELD,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,PFIELD,IRESP)
+ CALL IO_Field_read_lfi(TPFILE,TPFIELD,PFIELD,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,PFIELD,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,PFIELD,IRESP)
END IF
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_READ_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ CALL IO_Field_read_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
END IF
ELSE
!Not really necessary but useful to suppress alerts with Valgrind
@@ -275,12 +273,12 @@ IF (IRESP==0) THEN
CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
!
!Broadcast header only if IRESP==-111
- !because metadata of field has been modified in IO_READ_FIELD_xxx
- IF (IRESP==-111) CALL IO_BCAST_FIELD_METADATA(TPFILE,TPFIELD)
+ !because metadata of field has been modified in IO_Field_read_xxx
+ IF (IRESP==-111) CALL IO_Field_metadata_bcast(TPFILE,TPFIELD)
!
IF (TPFIELD%CDIR /= 'XX' .AND. TPFIELD%CDIR /='YY') THEN
! Broadcast Field
- CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MNHREAL_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
ELSE
!Scatter Field
CALL SCATTER_XXFIELD(TPFIELD%CDIR,ZFIELDP,PFIELD,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM,TPSPLITTING)
@@ -294,13 +292,13 @@ IF (IRESP==-111) IRESP = 0 !-111 is not really an error (metadata has changed)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
-END SUBROUTINE IO_READ_FIELD_BYFIELD_X1
+END SUBROUTINE IO_Field_read_byfield_X1
-SUBROUTINE IO_READ_FIELD_BYNAME_X2(TPFILE,HNAME,PFIELD,KRESP,KIMAX_ll,KJMAX_ll,TPSPLITTING)
+SUBROUTINE IO_Field_read_byname_X2(TPFILE,HNAME,PFIELD,KRESP,KIMAX_ll,KJMAX_ll,TPSPLITTING)
!
-USE MODD_IO_ll, ONLY : ISNPROC
-USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
+USE MODD_IO, ONLY: ISNPROC
+USE MODD_STRUCTURE_ll, ONLY: ZONE_ll
!
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
@@ -314,27 +312,27 @@ TYPE(ZONE_ll),DIMENSION(ISNPROC),OPTIONAL,INTENT(IN) :: TPSPLITTING ! splitting
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYNAME_X2',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byname_X2',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
-IF(IRESP==0) CALL IO_READ_FIELD(TPFILE,TFIELDLIST(ID),PFIELD,IRESP,KIMAX_ll,KJMAX_ll,TPSPLITTING)
+IF(IRESP==0) CALL IO_Field_read(TPFILE,TFIELDLIST(ID),PFIELD,IRESP,KIMAX_ll,KJMAX_ll,TPSPLITTING)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
-END SUBROUTINE IO_READ_FIELD_BYNAME_X2
+END SUBROUTINE IO_Field_read_byname_X2
-SUBROUTINE IO_READ_FIELD_BYFIELD_X2(TPFILE,TPFIELD,PFIELD,KRESP,KIMAX_ll,KJMAX_ll,TPSPLITTING)
+SUBROUTINE IO_Field_read_byfield_X2(TPFILE,TPFIELD,PFIELD,KRESP,KIMAX_ll,KJMAX_ll,TPSPLITTING)
!
-USE MODD_IO_ll, ONLY : GSMONOPROC,ISP,ISNPROC,LPACK,L1D,L2D
-USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
-USE MODD_TIMEZ, ONLY : TIMEZ
+USE MODD_IO, ONLY: GSMONOPROC, ISP, ISNPROC, LPACK, L1D, L2D
+USE MODD_STRUCTURE_ll, ONLY: ZONE_ll
+USE MODD_TIMEZ, ONLY: TIMEZ
!
USE MODE_ALLOCBUFFER_ll
#ifdef MNH_GA
USE MODE_GA
#endif
-USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
+USE MODE_MNH_TIMING, ONLY: SECOND_MNH2
USE MODE_SCATTER_ll
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
@@ -350,13 +348,13 @@ REAL,DIMENSION(:,:),POINTER :: ZFIELDP
LOGICAL :: GALLOC
INTEGER :: IRESP
INTEGER :: IHEXTOT
-REAL(KIND=8),DIMENSION(2) :: T0,T1,T2
-REAL(KIND=8),DIMENSION(2) :: T11,T22
+REAL(kind=MNHTIME), DIMENSION(2) :: T0, T1, T2
+REAL(kind=MNHTIME), DIMENSION(2) :: T11, T22
#ifdef MNH_GA
REAL,DIMENSION(:,:),POINTER :: ZFIELD_GA
#endif
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYFIELD_X2',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_X2',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
CALL SECOND_MNH2(T11)
GALLOC = .FALSE.
@@ -364,7 +362,7 @@ IRESP = 0
ZFIELDP => NULL()
!
IHEXTOT = 2*JPHEXT+1
-CALL IO_FILE_READ_CHECK(TPFILE,'IO_READ_FIELD_BYFIELD_X2',IRESP)
+CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_X2',IRESP)
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
@@ -376,11 +374,11 @@ IF (IRESP==0) THEN
ZFIELDP=>PFIELD(:,:)
END IF
IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ CALL IO_Field_read_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ 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)
@@ -393,11 +391,11 @@ IF (IRESP==0) THEN
! I/O process case
CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,TPFIELD%CDIR,GALLOC, KIMAX_ll, KJMAX_ll)
IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ CALL IO_Field_read_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
END IF
ELSE
!Not really necessary but useful to suppress alerts with Valgrind
@@ -410,8 +408,8 @@ IF (IRESP==0) THEN
CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
!
!Broadcast header only if IRESP==-111
- !because metadata of field has been modified in IO_READ_FIELD_xxx
- IF (IRESP==-111) CALL IO_BCAST_FIELD_METADATA(TPFILE,TPFIELD)
+ !because metadata of field has been modified in IO_Field_read_xxx
+ IF (IRESP==-111) CALL IO_Field_metadata_bcast(TPFILE,TPFIELD)
!
IF (TPFIELD%CDIR == 'XX' .OR. TPFIELD%CDIR == 'YY') THEN
! XX or YY Scatter Field
@@ -450,11 +448,11 @@ IF (IRESP==0) THEN
#endif
END IF
ELSE
- CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ 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
END IF
- CALL SECOND_MNH2(T2)
- TIMEZ%T_READ2D_SCAT=TIMEZ%T_READ2D_SCAT + T2 - T1
END IF
!
IF (GALLOC) DEALLOCATE (ZFIELDP)
@@ -466,10 +464,10 @@ IF (PRESENT(KRESP)) KRESP = IRESP
CALL SECOND_MNH2(T22)
TIMEZ%T_READ2D_ALL=TIMEZ%T_READ2D_ALL + T22 - T11
!
-END SUBROUTINE IO_READ_FIELD_BYFIELD_X2
+END SUBROUTINE IO_Field_read_byfield_X2
-SUBROUTINE IO_READ_FIELD_BYNAME_X3(TPFILE,HNAME,PFIELD,KRESP)
+SUBROUTINE IO_Field_read_byname_X3(TPFILE,HNAME,PFIELD,KRESP)
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
@@ -479,29 +477,29 @@ INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYNAME_X3',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byname_X3',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
-IF(IRESP==0) CALL IO_READ_FIELD(TPFILE,TFIELDLIST(ID),PFIELD,IRESP)
+IF(IRESP==0) CALL IO_Field_read(TPFILE,TFIELDLIST(ID),PFIELD,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
-END SUBROUTINE IO_READ_FIELD_BYNAME_X3
+END SUBROUTINE IO_Field_read_byname_X3
-SUBROUTINE IO_READ_FIELD_BYFIELD_X3(TPFILE,TPFIELD,PFIELD,KRESP)
+SUBROUTINE IO_Field_read_byfield_X3(TPFILE,TPFIELD,PFIELD,KRESP)
!
-USE MODD_IO_ll, ONLY : GSMONOPROC,ISP,ISNPROC,LPACK,L1D,L2D
-USE MODD_TIMEZ, ONLY : TIMEZ
-USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
+USE MODD_IO, ONLY: GSMONOPROC, ISP, ISNPROC, LPACK, L1D, L2D
+USE MODD_TIMEZ, ONLY: TIMEZ
+USE MODD_VAR_ll, ONLY: MNH_STATUSES_IGNORE
!
USE MODE_ALLOCBUFFER_ll
#ifdef MNH_GA
USE MODE_GA
#endif
-USE MODE_IO_TOOLS, ONLY : IO_FILE
-USE MODE_IO_MANAGE_STRUCT, ONLY : IO_FILE_FIND_BYNAME
-USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
+USE MODE_IO_TOOLS, ONLY: IO_Level2filenumber_get
+USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_find_byname
+USE MODE_MNH_TIMING, ONLY: SECOND_MNH2
USE MODE_SCATTER_ll
!
TYPE(TFILEDATA),TARGET, INTENT(IN) :: TPFILE
@@ -525,8 +523,8 @@ LOGICAL :: GALLOC, GALLOC_ll
REAL,DIMENSION(:,:),POINTER :: TX2DP
REAL,DIMENSION(:,:),POINTER :: ZSLICE_ll,ZSLICE
REAL,DIMENSION(:,:,:),POINTER :: ZFIELDP
-REAL(KIND=8),DIMENSION(2) :: T0,T1,T2
-REAL(KIND=8),DIMENSION(2) :: T11,T22
+REAL(kind=MNHTIME), DIMENSION(2) :: T0, T1, T2
+REAL(kind=MNHTIME), DIMENSION(2) :: T11, T22
CHARACTER(LEN=2) :: YDIR
CHARACTER(LEN=4) :: YK
CHARACTER(LEN=NMNHNAMELGTMAX+4) :: YRECZSLICE
@@ -538,7 +536,7 @@ TYPE(TX_2DP),ALLOCATABLE,DIMENSION(:) :: T_TX2DP
REAL,DIMENSION(:,:,:),POINTER :: ZFIELD_GA
#endif
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYFIELD_X3',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_X3',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
CALL SECOND_MNH2(T11)
!
@@ -551,7 +549,7 @@ YDIR = TPFIELD%CDIR
!
IHEXTOT = 2*JPHEXT+1
!
-CALL IO_FILE_READ_CHECK(TPFILE,'IO_READ_FIELD_BYFIELD_X3',IRESP)
+CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_X3',IRESP)
!
IF (IRESP==0) THEN
IF (GSMONOPROC .AND. TPFILE%NSUBFILES_IOZ==0 ) THEN ! sequential execution
@@ -564,11 +562,11 @@ IF (IRESP==0) THEN
ZFIELDP=>PFIELD(:,:,:)
END IF
IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ CALL IO_Field_read_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ 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)
@@ -580,11 +578,11 @@ IF (IRESP==0) THEN
! I/O process case
CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,YDIR,GALLOC)
IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ CALL IO_Field_read_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
END IF
ELSE
!Not really necessary but useful to suppress alerts with Valgrind
@@ -595,8 +593,8 @@ IF (IRESP==0) THEN
CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
!
!Broadcast header only if IRESP==-111
- !because metadata of field has been modified in IO_READ_FIELD_xxx
- IF (IRESP==-111) CALL IO_BCAST_FIELD_METADATA(TPFILE,TPFIELD)
+ !because metadata of field has been modified in IO_Field_read_xxx
+ IF (IRESP==-111) CALL IO_Field_metadata_bcast(TPFILE,TPFIELD)
!
IF (YDIR == 'XX' .OR. YDIR =='YY') THEN
! XX or YY Scatter Field
@@ -612,7 +610,7 @@ IF (IRESP==0) THEN
END IF
ELSE
! Broadcast Field
- CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MNHREAL_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
END IF
ELSE ! multiprocesses execution & // IO
!
@@ -630,7 +628,7 @@ IF (IRESP==0) THEN
ALLOCATE(ZSLICE_ll(0,0)) ! to avoid bug on test of size
GALLOC_ll = .TRUE.
DO JKK=1,IKU_ll
- IK_FILE = IO_FILE(JKK,TPFILE%NSUBFILES_IOZ)
+ IK_FILE = IO_Level2filenumber_get(JKK,TPFILE%NSUBFILES_IOZ)
TZFILE => TPFILE%TFILES_IOZ(IK_FILE+1)%TFILE
TZFIELD = TPFIELD
WRITE(YSUFFIX,'(I4.4)') JKK
@@ -651,11 +649,11 @@ IF (IRESP==0) THEN
WRITE(YK,'(I4.4)') JKK
YRECZSLICE = TRIM(TPFIELD%CMNHNAME)//YK
IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_READ_FIELD_NC4(TZFILE,TZFIELD,ZSLICE_ll,IRESP_TMP)
+ CALL IO_Field_read_nc4(TZFILE,TZFIELD,ZSLICE_ll,IRESP_TMP)
ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_READ_FIELD_LFI(TZFILE,TZFIELD,ZSLICE_ll,IRESP_TMP)
+ CALL IO_Field_read_lfi(TZFILE,TZFIELD,ZSLICE_ll,IRESP_TMP)
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_READ_FIELD_NC4(TZFILE,TZFIELD,ZSLICE_ll,IRESP_TMP)
+ 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
@@ -695,7 +693,7 @@ IF (IRESP==0) THEN
NB_REQ=0
DO JKK=JK,JK_MAX
IF (TPFILE%NSUBFILES_IOZ .GT. 1 ) THEN
- IK_FILE = IO_FILE(JKK,TPFILE%NSUBFILES_IOZ)
+ IK_FILE = IO_Level2filenumber_get(JKK,TPFILE%NSUBFILES_IOZ)
TZFILE => TPFILE%TFILES_IOZ(IK_FILE+1)%TFILE
TZFIELD = TPFIELD
WRITE(YSUFFIX,'(I4.4)') JKK
@@ -717,11 +715,11 @@ IF (IRESP==0) THEN
WRITE(YK,'(I4.4)') JKK
YRECZSLICE = TRIM(TPFIELD%CMNHNAME)//YK
IF (TZFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_READ_FIELD_NC4(TZFILE,TZFIELD,ZSLICE_ll,IRESP_TMP)
+ CALL IO_Field_read_nc4(TZFILE,TZFIELD,ZSLICE_ll,IRESP_TMP)
ELSE IF (TZFILE%CFORMAT=='LFI') THEN
- CALL IO_READ_FIELD_LFI(TZFILE,TZFIELD,ZSLICE_ll,IRESP_TMP)
+ CALL IO_Field_read_lfi(TZFILE,TZFIELD,ZSLICE_ll,IRESP_TMP)
ELSE IF (TZFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_READ_FIELD_NC4(TZFILE,TZFIELD,ZSLICE_ll,IRESP_TMP)
+ 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
@@ -732,9 +730,9 @@ IF (IRESP==0) 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),MPI_FLOAT,JI-1,199+IK_RANK, &
+ 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),MPI_FLOAT,JI-1,199+IK_RANK,TZFILE%NMPICOMM,IERR)
+ !CALL MPI_BSEND(TX2DP,SIZE(TX2DP),MNHREAL_MPI,JI-1,199+IK_RANK,TZFILE%NMPICOMM,IERR)
ELSE
PFIELD(:,:,JKK) = TX2DP(:,:)
END IF
@@ -752,12 +750,12 @@ IF (IRESP==0) THEN
!
IF (YDIR == 'XX' .OR. YDIR =='YY') THEN
! XX or YY Scatter Field
- STOP " XX ou YY NON PREVU SUR BG POUR LE MOMENT "
+ call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_read_byfield_X3', 'XX or YY not yet planned on Blue Gene' )
CALL SCATTER_XXFIELD(YDIR,ZFIELDP,PFIELD,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
ELSE IF (YDIR == 'XY') THEN
IF (LPACK .AND. L2D) THEN
! 2D compact case
- STOP " L2D NON PREVU SUR BG POUR LE MOMENT "
+ call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_read_byfield_X3', 'L2D not yet planned on Blue Gene' )
CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1,:),PFIELD(:,JPHEXT+1,:),TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
PFIELD(:,:,:) = SPREAD(PFIELD(:,JPHEXT+1,:),DIM=2,NCOPIES=IHEXTOT)
ELSE
@@ -770,7 +768,7 @@ IF (IRESP==0) THEN
! get the file & rank
!
IF (TPFILE%NSUBFILES_IOZ .GT. 1 ) THEN
- IK_FILE = IO_FILE(JKK,TPFILE%NSUBFILES_IOZ)
+ IK_FILE = IO_Level2filenumber_get(JKK,TPFILE%NSUBFILES_IOZ)
TZFILE => TPFILE%TFILES_IOZ(IK_FILE+1)%TFILE
ELSE
TZFILE => TPFILE
@@ -781,7 +779,7 @@ IF (IRESP==0) THEN
ZSLICE => PFIELD(:,:,JKK)
!CALL SCATTER_XYFIELD(ZSLICE_ll,ZSLICE,TZFILE%NMASTER_RANK,TZFILE%NMPICOMM)
IF (ISP .NE. IK_RANK) THEN
- CALL MPI_RECV(ZSLICE,SIZE(ZSLICE),MPI_FLOAT,IK_RANK-1,199+IK_RANK, &
+ CALL MPI_RECV(ZSLICE,SIZE(ZSLICE),MNHREAL_MPI,IK_RANK-1,199+IK_RANK, &
TZFILE%NMPICOMM,STATUS,IERR)
END IF
TZFILE => NULL()
@@ -791,8 +789,8 @@ IF (IRESP==0) THEN
END IF
ELSE
! Broadcast Field
- STOP " Broadcast Field NON PREVU SUR BG POUR LE MOMENT "
- CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ 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
@@ -807,8 +805,8 @@ IF (IRESP==0) THEN
DEALLOCATE(REQ_TAB)
!
!Broadcast header only if IRESP==-111
- !because metadata of field has been modified in IO_READ_FIELD_xxx
- IF (IRESP==-111) CALL IO_BCAST_FIELD_METADATA(TPFILE,TPFIELD)
+ !because metadata of field has been modified in IO_Field_read_xxx
+ IF (IRESP==-111) CALL IO_Field_metadata_bcast(TPFILE,TPFIELD)
!
#endif
!JUAN BG Z SLICE
@@ -826,13 +824,13 @@ CALL MPI_BARRIER(TPFILE%NMPICOMM,IERR)
CALL SECOND_MNH2(T22)
TIMEZ%T_READ3D_ALL=TIMEZ%T_READ3D_ALL + T22 - T11
!
-END SUBROUTINE IO_READ_FIELD_BYFIELD_X3
+END SUBROUTINE IO_Field_read_byfield_X3
-SUBROUTINE IO_READ_FIELD_BYNAME_X4(TPFILE,HNAME,PFIELD,KRESP)
+SUBROUTINE IO_Field_read_byname_X4(TPFILE,HNAME,PFIELD,KRESP)
!
-USE MODD_IO_ll, ONLY : ISNPROC
-USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
+USE MODD_IO, ONLY: ISNPROC
+USE MODD_STRUCTURE_ll, ONLY: ZONE_ll
!
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
@@ -843,24 +841,24 @@ INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYNAME_X4',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byname_X4',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
-IF(IRESP==0) CALL IO_READ_FIELD(TPFILE,TFIELDLIST(ID),PFIELD,IRESP)
+IF(IRESP==0) CALL IO_Field_read(TPFILE,TFIELDLIST(ID),PFIELD,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
-END SUBROUTINE IO_READ_FIELD_BYNAME_X4
+END SUBROUTINE IO_Field_read_byname_X4
-SUBROUTINE IO_READ_FIELD_BYFIELD_X4(TPFILE,TPFIELD,PFIELD,KRESP)
+SUBROUTINE IO_Field_read_byfield_X4(TPFILE,TPFIELD,PFIELD,KRESP)
!
-USE MODD_IO_ll, ONLY : GSMONOPROC,ISP,ISNPROC,LPACK,L1D,L2D
-USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
-USE MODD_TIMEZ, ONLY : TIMEZ
+USE MODD_IO, ONLY: GSMONOPROC, ISP, ISNPROC, LPACK, L1D, L2D
+USE MODD_STRUCTURE_ll, ONLY: ZONE_ll
+USE MODD_TIMEZ, ONLY: TIMEZ
!
USE MODE_ALLOCBUFFER_ll
-USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
+USE MODE_MNH_TIMING, ONLY: SECOND_MNH2
USE MODE_SCATTER_ll
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
@@ -874,14 +872,14 @@ LOGICAL :: GALLOC
INTEGER :: IRESP
INTEGER :: IHEXTOT
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYFIELD_X4',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_X4',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
GALLOC = .FALSE.
IRESP = 0
ZFIELDP => NULL()
!
IHEXTOT = 2*JPHEXT+1
-CALL IO_FILE_READ_CHECK(TPFILE,'IO_READ_FIELD_BYFIELD_X4',IRESP)
+CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_X4',IRESP)
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
@@ -893,11 +891,11 @@ IF (IRESP==0) THEN
ZFIELDP=>PFIELD(:,:,:,:)
END IF
IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ CALL IO_Field_read_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ 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)
@@ -909,11 +907,11 @@ IF (IRESP==0) THEN
! I/O process case
CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,TPFIELD%CDIR,GALLOC)
IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ CALL IO_Field_read_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
END IF
ELSE
!Not really necessary but useful to suppress alerts with Valgrind
@@ -924,8 +922,8 @@ IF (IRESP==0) THEN
CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
!
!Broadcast header only if IRESP==-111
- !because metadata of field has been modified in IO_READ_FIELD_xxx
- IF (IRESP==-111) CALL IO_BCAST_FIELD_METADATA(TPFILE,TPFIELD)
+ !because metadata of field has been modified in IO_Field_read_xxx
+ IF (IRESP==-111) CALL IO_Field_metadata_bcast(TPFILE,TPFIELD)
!
IF (TPFIELD%CDIR == 'XX' .OR. TPFIELD%CDIR == 'YY') THEN
! XX or YY Scatter Field
@@ -940,7 +938,7 @@ IF (IRESP==0) THEN
CALL SCATTER_XYFIELD(ZFIELDP,PFIELD,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
END IF
ELSE
- CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MNHREAL_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
END IF
END IF
END IF
@@ -951,13 +949,13 @@ IF (IRESP==-111) IRESP = 0 !-111 is not really an error (metadata has changed)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
-END SUBROUTINE IO_READ_FIELD_BYFIELD_X4
+END SUBROUTINE IO_Field_read_byfield_X4
-SUBROUTINE IO_READ_FIELD_BYNAME_X5(TPFILE,HNAME,PFIELD,KRESP)
+SUBROUTINE IO_Field_read_byname_X5(TPFILE,HNAME,PFIELD,KRESP)
!
-USE MODD_IO_ll, ONLY : ISNPROC
-USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
+USE MODD_IO, ONLY: ISNPROC
+USE MODD_STRUCTURE_ll, ONLY: ZONE_ll
!
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
@@ -968,24 +966,24 @@ INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYNAME_X5',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byname_X5',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
-IF(IRESP==0) CALL IO_READ_FIELD(TPFILE,TFIELDLIST(ID),PFIELD,IRESP)
+IF(IRESP==0) CALL IO_Field_read(TPFILE,TFIELDLIST(ID),PFIELD,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
-END SUBROUTINE IO_READ_FIELD_BYNAME_X5
+END SUBROUTINE IO_Field_read_byname_X5
-SUBROUTINE IO_READ_FIELD_BYFIELD_X5(TPFILE,TPFIELD,PFIELD,KRESP)
+SUBROUTINE IO_Field_read_byfield_X5(TPFILE,TPFIELD,PFIELD,KRESP)
!
-USE MODD_IO_ll, ONLY : GSMONOPROC,ISP,ISNPROC,LPACK,L1D,L2D
-USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
-USE MODD_TIMEZ, ONLY : TIMEZ
+USE MODD_IO, ONLY: GSMONOPROC, ISP, ISNPROC, LPACK, L1D, L2D
+USE MODD_STRUCTURE_ll, ONLY: ZONE_ll
+USE MODD_TIMEZ, ONLY: TIMEZ
!
USE MODE_ALLOCBUFFER_ll
-USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
+USE MODE_MNH_TIMING, ONLY: SECOND_MNH2
USE MODE_SCATTER_ll
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
@@ -999,14 +997,14 @@ LOGICAL :: GALLOC
INTEGER :: IRESP
INTEGER :: IHEXTOT
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYFIELD_X5',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_X5',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
GALLOC = .FALSE.
IRESP = 0
ZFIELDP => NULL()
!
IHEXTOT = 2*JPHEXT+1
-CALL IO_FILE_READ_CHECK(TPFILE,'IO_READ_FIELD_BYFIELD_X5',IRESP)
+CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_X5',IRESP)
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
@@ -1018,11 +1016,11 @@ IF (IRESP==0) THEN
ZFIELDP=>PFIELD(:,:,:,:,:)
END IF
IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ CALL IO_Field_read_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ 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)
@@ -1034,11 +1032,11 @@ IF (IRESP==0) THEN
! I/O process case
CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,TPFIELD%CDIR,GALLOC)
IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ CALL IO_Field_read_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
END IF
ELSE
!Not really necessary but useful to suppress alerts with Valgrind
@@ -1049,8 +1047,8 @@ IF (IRESP==0) THEN
CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
!
!Broadcast header only if IRESP==-111
- !because metadata of field has been modified in IO_READ_FIELD_xxx
- IF (IRESP==-111) CALL IO_BCAST_FIELD_METADATA(TPFILE,TPFIELD)
+ !because metadata of field has been modified in IO_Field_read_xxx
+ IF (IRESP==-111) CALL IO_Field_metadata_bcast(TPFILE,TPFIELD)
!
IF (TPFIELD%CDIR == 'XX' .OR. TPFIELD%CDIR == 'YY') THEN
! XX or YY Scatter Field
@@ -1065,7 +1063,7 @@ IF (IRESP==0) THEN
CALL SCATTER_XYFIELD(ZFIELDP,PFIELD,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
END IF
ELSE
- CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MNHREAL_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
END IF
END IF
END IF
@@ -1076,13 +1074,13 @@ IF (IRESP==-111) IRESP = 0 !-111 is not really an error (metadata has changed)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
-END SUBROUTINE IO_READ_FIELD_BYFIELD_X5
+END SUBROUTINE IO_Field_read_byfield_X5
-SUBROUTINE IO_READ_FIELD_BYNAME_X6(TPFILE,HNAME,PFIELD,KRESP)
+SUBROUTINE IO_Field_read_byname_X6(TPFILE,HNAME,PFIELD,KRESP)
!
-USE MODD_IO_ll, ONLY : ISNPROC
-USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
+USE MODD_IO, ONLY: ISNPROC
+USE MODD_STRUCTURE_ll, ONLY: ZONE_ll
!
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
@@ -1093,24 +1091,24 @@ INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYNAME_X6',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byname_X6',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
-IF(IRESP==0) CALL IO_READ_FIELD(TPFILE,TFIELDLIST(ID),PFIELD,IRESP)
+IF(IRESP==0) CALL IO_Field_read(TPFILE,TFIELDLIST(ID),PFIELD,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
-END SUBROUTINE IO_READ_FIELD_BYNAME_X6
+END SUBROUTINE IO_Field_read_byname_X6
-SUBROUTINE IO_READ_FIELD_BYFIELD_X6(TPFILE,TPFIELD,PFIELD,KRESP)
+SUBROUTINE IO_Field_read_byfield_X6(TPFILE,TPFIELD,PFIELD,KRESP)
!
-USE MODD_IO_ll, ONLY : GSMONOPROC,ISP,ISNPROC,LPACK,L1D,L2D
-USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
-USE MODD_TIMEZ, ONLY : TIMEZ
+USE MODD_IO, ONLY: GSMONOPROC,ISP,ISNPROC,LPACK,L1D,L2D
+USE MODD_STRUCTURE_ll, ONLY: ZONE_ll
+USE MODD_TIMEZ, ONLY: TIMEZ
!
USE MODE_ALLOCBUFFER_ll
-USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
+USE MODE_MNH_TIMING, ONLY: SECOND_MNH2
USE MODE_SCATTER_ll
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
@@ -1124,34 +1122,34 @@ LOGICAL :: GALLOC
INTEGER :: IRESP
INTEGER :: IHEXTOT
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYFIELD_X6',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_X6',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
GALLOC = .FALSE.
IRESP = 0
ZFIELDP => NULL()
!
IHEXTOT = 2*JPHEXT+1
-CALL IO_FILE_READ_CHECK(TPFILE,'IO_READ_FIELD_BYFIELD_X6',IRESP)
+CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_X6',IRESP)
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,PFIELD,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,PFIELD,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,PFIELD,IRESP)
+ CALL IO_Field_read_lfi(TPFILE,TPFIELD,PFIELD,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,PFIELD,IRESP)
+ CALL IO_Field_read_nc4(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_READ_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ CALL IO_Field_read_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
END IF
ELSE
!Not really necessary but useful to suppress alerts with Valgrind
@@ -1162,8 +1160,8 @@ IF (IRESP==0) THEN
CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
!
!Broadcast header only if IRESP==-111
- !because metadata of field has been modified in IO_READ_FIELD_xxx
- IF (IRESP==-111) CALL IO_BCAST_FIELD_METADATA(TPFILE,TPFIELD)
+ !because metadata of field has been modified in IO_Field_read_xxx
+ IF (IRESP==-111) CALL IO_Field_metadata_bcast(TPFILE,TPFIELD)
!
IF (TPFIELD%CDIR == 'XX' .OR. TPFIELD%CDIR == 'YY') THEN
! XX or YY Scatter Field
@@ -1172,7 +1170,7 @@ IF (IRESP==0) THEN
! XY Scatter Field
CALL SCATTER_XYFIELD(ZFIELDP,PFIELD,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
ELSE
- CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MNHREAL_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
END IF
END IF
END IF
@@ -1183,10 +1181,10 @@ IF (IRESP==-111) IRESP = 0 !-111 is not really an error (metadata has changed)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
-END SUBROUTINE IO_READ_FIELD_BYFIELD_X6
+END SUBROUTINE IO_Field_read_byfield_X6
-SUBROUTINE IO_READ_FIELD_BYNAME_N0(TPFILE,HNAME,KFIELD,KRESP)
+SUBROUTINE IO_Field_read_byname_N0(TPFILE,HNAME,KFIELD,KRESP)
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
@@ -1196,19 +1194,19 @@ INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYNAME_N0',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byname_N0',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
-IF(IRESP==0) CALL IO_READ_FIELD(TPFILE,TFIELDLIST(ID),KFIELD,IRESP)
+IF(IRESP==0) CALL IO_Field_read(TPFILE,TFIELDLIST(ID),KFIELD,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
-END SUBROUTINE IO_READ_FIELD_BYNAME_N0
+END SUBROUTINE IO_Field_read_byname_N0
-SUBROUTINE IO_READ_FIELD_BYFIELD_N0(TPFILE,TPFIELD,KFIELD,KRESP)
+SUBROUTINE IO_Field_read_byfield_N0(TPFILE,TPFIELD,KFIELD,KRESP)
!
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
+USE MODD_IO, ONLY: ISP,GSMONOPROC
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
@@ -1218,37 +1216,37 @@ INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
INTEGER :: IERR
INTEGER :: IRESP
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYFIELD_N0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+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_READ_FIELD_BYFIELD_N0',IRESP)
+CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_N0',IRESP)
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,KFIELD,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,KFIELD,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,KFIELD,IRESP)
+ CALL IO_Field_read_lfi(TPFILE,TPFIELD,KFIELD,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,KFIELD,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,KFIELD,IRESP)
END IF
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,KFIELD,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,KFIELD,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,KFIELD,IRESP)
+ CALL IO_Field_read_lfi(TPFILE,TPFIELD,KFIELD,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,KFIELD,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,KFIELD,IRESP)
END IF
END IF
!
CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
!
!Broadcast header only if IRESP==-111
- !because metadata of field has been modified in IO_READ_FIELD_xxx
- IF (IRESP==-111) CALL IO_BCAST_FIELD_METADATA(TPFILE,TPFIELD)
+ !because metadata of field has been modified in IO_Field_read_xxx
+ IF (IRESP==-111) CALL IO_Field_metadata_bcast(TPFILE,TPFIELD)
!
CALL MPI_BCAST(KFIELD,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
END IF
@@ -1258,10 +1256,10 @@ IF (IRESP==-111) IRESP = 0 !-111 is not really an error (metadata has changed)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
-END SUBROUTINE IO_READ_FIELD_BYFIELD_N0
+END SUBROUTINE IO_Field_read_byfield_N0
-SUBROUTINE IO_READ_FIELD_BYNAME_N1(TPFILE,HNAME,KFIELD,KRESP)
+SUBROUTINE IO_Field_read_byname_N1(TPFILE,HNAME,KFIELD,KRESP)
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
@@ -1271,19 +1269,19 @@ INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYNAME_N1',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byname_N1',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
-IF(IRESP==0) CALL IO_READ_FIELD(TPFILE,TFIELDLIST(ID),KFIELD,IRESP)
+IF(IRESP==0) CALL IO_Field_read(TPFILE,TFIELDLIST(ID),KFIELD,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
-END SUBROUTINE IO_READ_FIELD_BYNAME_N1
+END SUBROUTINE IO_Field_read_byname_N1
-SUBROUTINE IO_READ_FIELD_BYFIELD_N1(TPFILE,TPFIELD,KFIELD,KRESP)
+SUBROUTINE IO_Field_read_byfield_N1(TPFILE,TPFIELD,KFIELD,KRESP)
!
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
+USE MODD_IO, ONLY: ISP, GSMONOPROC
!
USE MODE_ALLOCBUFFER_ll
USE MODE_SCATTER_ll
@@ -1298,32 +1296,32 @@ INTEGER :: IRESP
INTEGER,DIMENSION(:),POINTER :: IFIELDP
LOGICAL :: GALLOC
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYFIELD_N1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_N1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
GALLOC = .FALSE.
IRESP = 0
IFIELDP => NULL()
!
-CALL IO_FILE_READ_CHECK(TPFILE,'IO_READ_FIELD_BYFIELD_N1',IRESP)
+CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_N1',IRESP)
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,KFIELD,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,KFIELD,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,KFIELD,IRESP)
+ CALL IO_Field_read_lfi(TPFILE,TPFIELD,KFIELD,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,KFIELD,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,KFIELD,IRESP)
END IF
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
CALL ALLOCBUFFER_ll(IFIELDP,KFIELD,TPFIELD%CDIR,GALLOC)
IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,IFIELDP,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,IFIELDP,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,IFIELDP,IRESP)
+ CALL IO_Field_read_lfi(TPFILE,TPFIELD,IFIELDP,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,IFIELDP,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,IFIELDP,IRESP)
END IF
ELSE
!Not really necessary but useful to suppress alerts with Valgrind
@@ -1334,8 +1332,8 @@ IF (IRESP==0) THEN
CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
!
!Broadcast header only if IRESP==-111
- !because metadata of field has been modified in IO_READ_FIELD_xxx
- IF (IRESP==-111) CALL IO_BCAST_FIELD_METADATA(TPFILE,TPFIELD)
+ !because metadata of field has been modified in IO_Field_read_xxx
+ IF (IRESP==-111) CALL IO_Field_metadata_bcast(TPFILE,TPFIELD)
!
IF (TPFIELD%CDIR /= 'XX' .AND. TPFIELD%CDIR /='YY') THEN
! Broadcast Field
@@ -1353,13 +1351,13 @@ IF (IRESP==-111) IRESP = 0 !-111 is not really an error (metadata has changed)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
-END SUBROUTINE IO_READ_FIELD_BYFIELD_N1
+END SUBROUTINE IO_Field_read_byfield_N1
-SUBROUTINE IO_READ_FIELD_BYNAME_N2(TPFILE,HNAME,KFIELD,KRESP)
+SUBROUTINE IO_Field_read_byname_N2(TPFILE,HNAME,KFIELD,KRESP)
!
-USE MODD_IO_ll, ONLY : ISNPROC
-USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
+USE MODD_IO, ONLY: ISNPROC
+USE MODD_STRUCTURE_ll, ONLY: ZONE_ll
!
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
@@ -1370,21 +1368,21 @@ INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYNAME_N2',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byname_N2',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
-IF(IRESP==0) CALL IO_READ_FIELD(TPFILE,TFIELDLIST(ID),KFIELD,IRESP)
+IF(IRESP==0) CALL IO_Field_read(TPFILE,TFIELDLIST(ID),KFIELD,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
-END SUBROUTINE IO_READ_FIELD_BYNAME_N2
+END SUBROUTINE IO_Field_read_byname_N2
-SUBROUTINE IO_READ_FIELD_BYFIELD_N2(TPFILE,TPFIELD,KFIELD,KRESP)
+SUBROUTINE IO_Field_read_byfield_N2(TPFILE,TPFIELD,KFIELD,KRESP)
!
-USE MODD_IO_ll, ONLY : GSMONOPROC,ISP,ISNPROC,LPACK,L1D,L2D
-USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
-USE MODD_TIMEZ, ONLY : TIMEZ
+USE MODD_IO, ONLY: GSMONOPROC, ISP, ISNPROC, LPACK, L1D, L2D
+USE MODD_STRUCTURE_ll, ONLY: ZONE_ll
+USE MODD_TIMEZ, ONLY: TIMEZ
!
USE MODE_ALLOCBUFFER_ll
USE MODE_SCATTER_ll
@@ -1400,14 +1398,14 @@ LOGICAL :: GALLOC
INTEGER :: IRESP
INTEGER :: IHEXTOT
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYFIELD_N2',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_N2',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
GALLOC = .FALSE.
IRESP = 0
IFIELDP => NULL()
!
IHEXTOT = 2*JPHEXT+1
-CALL IO_FILE_READ_CHECK(TPFILE,'IO_READ_FIELD_BYFIELD_N2',IRESP)
+CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_N2',IRESP)
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
@@ -1419,11 +1417,11 @@ IF (IRESP==0) THEN
IFIELDP=>KFIELD(:,:)
END IF
IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,IFIELDP,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,IFIELDP,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,IFIELDP,IRESP)
+ CALL IO_Field_read_lfi(TPFILE,TPFIELD,IFIELDP,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,IFIELDP,IRESP)
+ 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)
@@ -1435,11 +1433,11 @@ IF (IRESP==0) THEN
! I/O process case
CALL ALLOCBUFFER_ll(IFIELDP,KFIELD,TPFIELD%CDIR,GALLOC)
IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,IFIELDP,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,IFIELDP,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,IFIELDP,IRESP)
+ CALL IO_Field_read_lfi(TPFILE,TPFIELD,IFIELDP,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,IFIELDP,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,IFIELDP,IRESP)
END IF
ELSE
!Not really necessary but useful to suppress alerts with Valgrind
@@ -1450,14 +1448,14 @@ IF (IRESP==0) THEN
CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
!
!Broadcast header only if IRESP==-111
- !because metadata of field has been modified in IO_READ_FIELD_xxx
- IF (IRESP==-111) CALL IO_BCAST_FIELD_METADATA(TPFILE,TPFIELD)
+ !because metadata of field has been modified in IO_Field_read_xxx
+ IF (IRESP==-111) CALL IO_Field_metadata_bcast(TPFILE,TPFIELD)
!
IF (TPFIELD%CDIR == 'XX' .OR. TPFIELD%CDIR == 'YY') THEN
! XX or YY Scatter Field
CALL SCATTER_XXFIELD(TPFIELD%CDIR,IFIELDP,KFIELD,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
! Broadcast Field
- CALL MPI_BCAST(KFIELD,SIZE(KFIELD),MPI_FLOAT,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ CALL MPI_BCAST(KFIELD,SIZE(KFIELD),MNHREAL_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
ELSE IF (TPFIELD%CDIR == 'XY') THEN
IF (LPACK .AND. L2D) THEN
! 2D compact case
@@ -1480,10 +1478,10 @@ IF (IRESP==-111) IRESP = 0 !-111 is not really an error (metadata has changed)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
-END SUBROUTINE IO_READ_FIELD_BYFIELD_N2
+END SUBROUTINE IO_Field_read_byfield_N2
-SUBROUTINE IO_READ_FIELD_BYNAME_L0(TPFILE,HNAME,OFIELD,KRESP)
+SUBROUTINE IO_Field_read_byname_L0(TPFILE,HNAME,OFIELD,KRESP)
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
@@ -1493,19 +1491,19 @@ INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYNAME_L0',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byname_L0',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
-IF(IRESP==0) CALL IO_READ_FIELD(TPFILE,TFIELDLIST(ID),OFIELD,IRESP)
+IF(IRESP==0) CALL IO_Field_read(TPFILE,TFIELDLIST(ID),OFIELD,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
-END SUBROUTINE IO_READ_FIELD_BYNAME_L0
+END SUBROUTINE IO_Field_read_byname_L0
-SUBROUTINE IO_READ_FIELD_BYFIELD_L0(TPFILE,TPFIELD,OFIELD,KRESP)
+SUBROUTINE IO_Field_read_byfield_L0(TPFILE,TPFIELD,OFIELD,KRESP)
!
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
+USE MODD_IO, ONLY: ISP, GSMONOPROC
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
@@ -1515,37 +1513,37 @@ INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
INTEGER :: IERR
INTEGER :: IRESP
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYFIELD_L0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+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_READ_FIELD_BYFIELD_L0',IRESP)
+CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_L0',IRESP)
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,OFIELD,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,OFIELD,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,OFIELD,IRESP)
+ CALL IO_Field_read_lfi(TPFILE,TPFIELD,OFIELD,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,OFIELD,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,OFIELD,IRESP)
END IF
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,OFIELD,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,OFIELD,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,OFIELD,IRESP)
+ CALL IO_Field_read_lfi(TPFILE,TPFIELD,OFIELD,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,OFIELD,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,OFIELD,IRESP)
END IF
END IF
!
CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
!
!Broadcast header only if IRESP==-111
- !because metadata of field has been modified in IO_READ_FIELD_xxx
- IF (IRESP==-111) CALL IO_BCAST_FIELD_METADATA(TPFILE,TPFIELD)
+ !because metadata of field has been modified in IO_Field_read_xxx
+ IF (IRESP==-111) CALL IO_Field_metadata_bcast(TPFILE,TPFIELD)
!
CALL MPI_BCAST(OFIELD,1,MPI_LOGICAL,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
END IF
@@ -1555,10 +1553,10 @@ IF (IRESP==-111) IRESP = 0 !-111 is not really an error (metadata has changed)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
-END SUBROUTINE IO_READ_FIELD_BYFIELD_L0
+END SUBROUTINE IO_Field_read_byfield_L0
-SUBROUTINE IO_READ_FIELD_BYNAME_L1(TPFILE,HNAME,OFIELD,KRESP)
+SUBROUTINE IO_Field_read_byname_L1(TPFILE,HNAME,OFIELD,KRESP)
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
@@ -1568,19 +1566,19 @@ INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYNAME_L1',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byname_L1',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
-IF(IRESP==0) CALL IO_READ_FIELD(TPFILE,TFIELDLIST(ID),OFIELD,IRESP)
+IF(IRESP==0) CALL IO_Field_read(TPFILE,TFIELDLIST(ID),OFIELD,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
-END SUBROUTINE IO_READ_FIELD_BYNAME_L1
+END SUBROUTINE IO_Field_read_byname_L1
-SUBROUTINE IO_READ_FIELD_BYFIELD_L1(TPFILE,TPFIELD,OFIELD,KRESP)
+SUBROUTINE IO_Field_read_byfield_L1(TPFILE,TPFIELD,OFIELD,KRESP)
!
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
+USE MODD_IO, ONLY: ISP, GSMONOPROC
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
@@ -1590,37 +1588,37 @@ INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
INTEGER :: IERR
INTEGER :: IRESP
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYFIELD_L1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+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_READ_FIELD_BYFIELD_L1',IRESP)
+CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_L1',IRESP)
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,OFIELD,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,OFIELD,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,OFIELD,IRESP)
+ CALL IO_Field_read_lfi(TPFILE,TPFIELD,OFIELD,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,OFIELD,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,OFIELD,IRESP)
END IF
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,OFIELD,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,OFIELD,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,OFIELD,IRESP)
+ CALL IO_Field_read_lfi(TPFILE,TPFIELD,OFIELD,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,OFIELD,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,OFIELD,IRESP)
END IF
END IF
!
CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
!
!Broadcast header only if IRESP==-111
- !because metadata of field has been modified in IO_READ_FIELD_xxx
- IF (IRESP==-111) CALL IO_BCAST_FIELD_METADATA(TPFILE,TPFIELD)
+ !because metadata of field has been modified in IO_Field_read_xxx
+ IF (IRESP==-111) CALL IO_Field_metadata_bcast(TPFILE,TPFIELD)
!
CALL MPI_BCAST(OFIELD,SIZE(OFIELD),MPI_LOGICAL,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
END IF
@@ -1630,10 +1628,10 @@ IF (IRESP==-111) IRESP = 0 !-111 is not really an error (metadata has changed)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
-END SUBROUTINE IO_READ_FIELD_BYFIELD_L1
+END SUBROUTINE IO_Field_read_byfield_L1
-SUBROUTINE IO_READ_FIELD_BYNAME_C0(TPFILE,HNAME,HFIELD,KRESP)
+SUBROUTINE IO_Field_read_byname_C0(TPFILE,HNAME,HFIELD,KRESP)
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
@@ -1643,19 +1641,19 @@ INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYNAME_C0',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byname_C0',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
-IF(IRESP==0) CALL IO_READ_FIELD(TPFILE,TFIELDLIST(ID),HFIELD,IRESP)
+IF(IRESP==0) CALL IO_Field_read(TPFILE,TFIELDLIST(ID),HFIELD,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
-END SUBROUTINE IO_READ_FIELD_BYNAME_C0
+END SUBROUTINE IO_Field_read_byname_C0
-SUBROUTINE IO_READ_FIELD_BYFIELD_C0(TPFILE,TPFIELD,HFIELD,KRESP)
+SUBROUTINE IO_Field_read_byfield_C0(TPFILE,TPFIELD,HFIELD,KRESP)
!
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
+USE MODD_IO, ONLY: ISP, GSMONOPROC
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
@@ -1665,37 +1663,37 @@ INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
INTEGER :: IERR
INTEGER :: IRESP
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYFIELD_C0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+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_READ_FIELD_BYFIELD_C0',IRESP)
+CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_C0',IRESP)
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,HFIELD,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,HFIELD,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,HFIELD,IRESP)
+ CALL IO_Field_read_lfi(TPFILE,TPFIELD,HFIELD,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,HFIELD,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,HFIELD,IRESP)
END IF
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,HFIELD,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,HFIELD,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,HFIELD,IRESP)
+ CALL IO_Field_read_lfi(TPFILE,TPFIELD,HFIELD,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,HFIELD,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,HFIELD,IRESP)
END IF
END IF
!
CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
!
!Broadcast header only if IRESP==-111
- !because metadata of field has been modified in IO_READ_FIELD_xxx
- IF (IRESP==-111) CALL IO_BCAST_FIELD_METADATA(TPFILE,TPFIELD)
+ !because metadata of field has been modified in IO_Field_read_xxx
+ IF (IRESP==-111) CALL IO_Field_metadata_bcast(TPFILE,TPFIELD)
!
CALL MPI_BCAST(HFIELD,LEN(HFIELD),MPI_CHARACTER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
END IF
@@ -1705,10 +1703,10 @@ IF (IRESP==-111) IRESP = 0 !-111 is not really an error (metadata has changed)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
-END SUBROUTINE IO_READ_FIELD_BYFIELD_C0
+END SUBROUTINE IO_Field_read_byfield_C0
-SUBROUTINE IO_READ_FIELD_BYNAME_T0(TPFILE,HNAME,TPDATA,KRESP)
+SUBROUTINE IO_Field_read_byname_T0(TPFILE,HNAME,TPDATA,KRESP)
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
@@ -1718,19 +1716,19 @@ INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYNAME_T0',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byname_T0',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
-IF(IRESP==0) CALL IO_READ_FIELD(TPFILE,TFIELDLIST(ID),TPDATA,IRESP)
+IF(IRESP==0) CALL IO_Field_read(TPFILE,TFIELDLIST(ID),TPDATA,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
-END SUBROUTINE IO_READ_FIELD_BYNAME_T0
+END SUBROUTINE IO_Field_read_byname_T0
-SUBROUTINE IO_READ_FIELD_BYFIELD_T0(TPFILE,TPFIELD,TPDATA,KRESP)
+SUBROUTINE IO_Field_read_byfield_T0(TPFILE,TPFIELD,TPDATA,KRESP)
!
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
+USE MODD_IO, ONLY: ISP, GSMONOPROC
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
@@ -1741,29 +1739,29 @@ INTEGER :: IERR
INTEGER :: IRESP
INTEGER,DIMENSION(3) :: ITDATE
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYFIELD_T0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+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_READ_FIELD_BYFIELD_T0',IRESP)
+CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_T0',IRESP)
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,TPDATA,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,TPDATA,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,TPDATA,IRESP)
+ CALL IO_Field_read_lfi(TPFILE,TPFIELD,TPDATA,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,TPDATA,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,TPDATA,IRESP)
END IF
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,TPDATA,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,TPDATA,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,TPDATA,IRESP)
+ CALL IO_Field_read_lfi(TPFILE,TPFIELD,TPDATA,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,TPDATA,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,TPDATA,IRESP)
END IF
ITDATE(1) = TPDATA%TDATE%YEAR
ITDATE(2) = TPDATA%TDATE%MONTH
@@ -1773,11 +1771,11 @@ IF (IRESP==0) THEN
CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
!
!Broadcast header only if IRESP==-111
- !because metadata of field has been modified in IO_READ_FIELD_xxx
- IF (IRESP==-111) CALL IO_BCAST_FIELD_METADATA(TPFILE,TPFIELD)
+ !because metadata of field has been modified in IO_Field_read_xxx
+ IF (IRESP==-111) CALL IO_Field_metadata_bcast(TPFILE,TPFIELD)
!
CALL MPI_BCAST(ITDATE, 3,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
- CALL MPI_BCAST(TPDATA%TIME,1,MPI_FLOAT, 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)
@@ -1788,10 +1786,10 @@ IF (IRESP==-111) IRESP = 0 !-111 is not really an error (metadata has changed)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
-END SUBROUTINE IO_READ_FIELD_BYFIELD_T0
+END SUBROUTINE IO_Field_read_byfield_T0
-SUBROUTINE IO_READ_FIELD_BYNAME_LB(TPFILE,HNAME,KL3D,KRIM,PLB,KRESP)
+SUBROUTINE IO_Field_read_byname_lb(TPFILE,HNAME,KL3D,KRIM,PLB,KRESP)
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
@@ -1803,26 +1801,26 @@ INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYNAME_LB',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byname_lb',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
-IF(IRESP==0) CALL IO_READ_FIELD_LB(TPFILE,TFIELDLIST(ID),KL3D,KRIM,PLB,IRESP)
+IF(IRESP==0) CALL IO_Field_read_lb(TPFILE,TFIELDLIST(ID),KL3D,KRIM,PLB,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
-END SUBROUTINE IO_READ_FIELD_BYNAME_LB
+END SUBROUTINE IO_Field_read_byname_lb
-SUBROUTINE IO_READ_FIELD_BYFIELD_LB(TPFILE,TPFIELD,KL3D,KRIM,PLB,KRESP)
+SUBROUTINE IO_Field_read_byfield_lb(TPFILE,TPFIELD,KL3D,KRIM,PLB,KRESP)
!
-USE MODD_IO_ll, ONLY : ISP,ISNPROC,GSMONOPROC,LPACK,L2D
-USE MODD_PARAMETERS_ll,ONLY : JPHEXT
-USE MODD_TIMEZ, ONLY : TIMEZ
-USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
+USE MODD_IO, ONLY: GSMONOPROC, ISP, ISNPROC, LPACK, L2D
+USE MODD_PARAMETERS_ll, ONLY: JPHEXT
+USE MODD_TIMEZ, ONLY: TIMEZ
+USE MODD_VAR_ll, ONLY: MNH_STATUSES_IGNORE
!
-USE MODE_DISTRIB_LB
-USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
-USE MODE_TOOLS_ll, ONLY : GET_GLOBALDIMS_ll
+USE MODE_DISTRIB_lb
+USE MODE_MNH_TIMING, ONLY: SECOND_MNH2
+USE MODE_TOOLS_ll, ONLY: GET_GLOBALDIMS_ll
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
@@ -1849,16 +1847,16 @@ INTEGER, ALLOCATABLE,DIMENSION(:,:) :: STATUSES
INTEGER,ALLOCATABLE,DIMENSION(:) :: REQ_TAB
REAL,DIMENSION(:,:,:),ALLOCATABLE,TARGET :: Z3D
REAL,DIMENSION(:,:,:), POINTER :: TX3DP
-REAL(KIND=8),DIMENSION(2) :: T0,T1,T2,T3
-REAL(KIND=8),DIMENSION(2) :: T11,T22
+REAL(kind=MNHTIME), DIMENSION(2) :: T0, T1, T2, T3
+REAL(kind=MNHTIME), DIMENSION(2) :: T11, T22
TYPE(TX_3DP),ALLOCATABLE,DIMENSION(:) :: T_TX3DP
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYFIELD_LB','reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_lb','reading '//TRIM(TPFIELD%CMNHNAME))
!
YLBTYPE = TPFIELD%CLBTYPE
!
IF (YLBTYPE/='LBX' .AND. YLBTYPE/='LBXU' .AND. YLBTYPE/='LBY' .AND. YLBTYPE/='LBYV') THEN
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_BYFIELD_LB',TRIM(TPFILE%CNAME)//': invalid CLBTYPE (' &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_byfield_lb',TRIM(TPFILE%CNAME)//': invalid CLBTYPE (' &
//TRIM(TPFIELD%CLBTYPE)//') for '//TRIM(TPFIELD%CMNHNAME))
RETURN
END IF
@@ -1869,7 +1867,7 @@ CALL SECOND_MNH2(T11)
IRESP = 0
!------------------------------------------------------------------
IHEXTOT = 2*JPHEXT+1
-CALL IO_FILE_READ_CHECK(TPFILE,'IO_READ_FIELD_BYFIELD_LB',IRESP)
+CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_lb',IRESP)
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
@@ -1887,11 +1885,11 @@ IF (IRESP==0) THEN
TX3DP => Z3D(:,:,:)
END IF
IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,TX3DP,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,TX3DP,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,TX3DP,IRESP)
+ CALL IO_Field_read_lfi(TPFILE,TPFIELD,TX3DP,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,TX3DP,IRESP)
+ 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)
@@ -1919,11 +1917,11 @@ IF (IRESP==0) THEN
TX3DP => Z3D(:,:,:)
END IF
IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,TX3DP,IRESP)
+ CALL IO_Field_read_nc4(TPFILE,TPFIELD,TX3DP,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_READ_FIELD_LFI(TPFILE,TPFIELD,TX3DP,IRESP)
+ CALL IO_Field_read_lfi(TPFILE,TPFIELD,TX3DP,IRESP)
ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_READ_FIELD_NC4(TPFILE,TPFIELD,TX3DP,IRESP)
+ 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)
@@ -1940,8 +1938,8 @@ IF (IRESP==0) THEN
CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
!
!Broadcast header only if IRESP==-111
- !because metadata of field has been modified in IO_READ_FIELD_xxx
- IF (IRESP==-111) CALL IO_BCAST_FIELD_METADATA(TPFILE,TPFIELD)
+ !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))
@@ -1953,17 +1951,17 @@ IF (IRESP==0) THEN
ALLOCATE(T_TX3DP(ISNPROC-1))
IKU = SIZE(Z3D,3)
DO JI = 1,ISNPROC
- CALL GET_DISTRIB_LB(YLBTYPE,JI,'FM','READ',KRIM,IIB,IIE,IJB,IJE)
+ CALL GET_DISTRIB_lb(YLBTYPE,JI,'FM','READ',KRIM,IIB,IIE,IJB,IJE)
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),MPI_FLOAT,JI-1,99,TPFILE%NMPICOMM,REQ_TAB(NB_REQ),IERR)
- !CALL MPI_BSEND(T_TX3DP(NB_REQ)%X,SIZE(TX3DP),MPI_FLOAT,JI-1,99,TPFILE%NMPICOMM,IERR)
+ 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)
ELSE
- CALL GET_DISTRIB_LB(YLBTYPE,JI,'LOC','READ',KRIM,IIB,IIE,IJB,IJE)
+ CALL GET_DISTRIB_lb(YLBTYPE,JI,'LOC','READ',KRIM,IIB,IIE,IJB,IJE)
PLB(IIB:IIE,IJB:IJE,:) = TX3DP(:,:,:)
END IF
END IF
@@ -1985,12 +1983,12 @@ IF (IRESP==0) THEN
CALL SECOND_MNH2(T0)
!ALLOCATE(REQ_TAB(1))
!REQ_TAB=MPI_REQUEST_NULL
- CALL GET_DISTRIB_LB(YLBTYPE,ISP,'LOC','READ',KRIM,IIB,IIE,IJB,IJE)
+ 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),MPI_FLOAT,TPFILE%NMASTER_RANK-1,99,TPFILE%NMPICOMM,STATUS,IERR)
+ 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),MPI_FLOAT,TPFILE%NMASTER_RANK-1,99,TPFILE%NMPICOMM,REQ_TAB(NB_REQ),IERR)
+ !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)
END IF
CALL SECOND_MNH2(T1)
@@ -2010,6 +2008,6 @@ IF (PRESENT(KRESP)) KRESP = IRESP
CALL SECOND_MNH2(T22)
TIMEZ%T_READLB_ALL=TIMEZ%T_READLB_ALL + T22 - T11
!
-END SUBROUTINE IO_READ_FIELD_BYFIELD_LB
+END SUBROUTINE IO_Field_read_byfield_lb
-END MODULE MODE_FMREAD
+END MODULE MODE_IO_FIELD_READ
diff --git a/src/LIB/SURCOUCHE/src/fmwrit_ll.f90 b/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
similarity index 57%
rename from src/LIB/SURCOUCHE/src/fmwrit_ll.f90
rename to src/LIB/SURCOUCHE/src/mode_io_field_write.f90
index 41c6594214b86069aef302e437bd94647921c409..8d44c988922528505514f7691eb5d1d2edf1ec74 100644
--- a/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
@@ -4,24 +4,23 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! Modifications:
-! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! Philippe Wautelet: 10/01/2019: do not write scalars in Z-split files
-! Philippe Wautelet: 10/01/2019: write header also for Z-split files
+! J. Escobar 15/09/2015: WENO5 & JPHEXT <> 1
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 10/01/2019: do not write scalars in Z-split files
+! P. Wautelet 10/01/2019: write header also for Z-split files
+! P. Wautelet 05/03/2019: rename IO subroutines and modules
+! 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
!-----------------------------------------------------------------
-#ifdef MNH_MPI_DOUBLE_PRECISION
-#define MPI_FLOAT MPI_DOUBLE_PRECISION
-#else
-#define MPI_FLOAT MPI_REAL
-#endif
-
#define MNH_SCALARS_IN_SPLITFILES 0
-MODULE MODE_FMWRIT
+MODULE MODE_IO_FIELD_WRITE
+ USE MODD_IO, ONLY: TFILEDATA, TOUTBAK
USE MODD_MPIF
- USE MODD_IO_ll, ONLY: TFILEDATA
+ use modd_precision, only: MNHINT_MPI, MNHREAL_MPI, MNHTIME
USE MODE_FIELD
USE MODE_IO_WRITE_LFI
@@ -33,41 +32,42 @@ MODULE MODE_FMWRIT
PRIVATE
- INTERFACE IO_WRITE_FIELD
- MODULE PROCEDURE IO_WRITE_FIELD_BYNAME_X0, IO_WRITE_FIELD_BYNAME_X1, &
- IO_WRITE_FIELD_BYNAME_X2, IO_WRITE_FIELD_BYNAME_X3, &
- IO_WRITE_FIELD_BYNAME_X4, IO_WRITE_FIELD_BYNAME_X5, &
- IO_WRITE_FIELD_BYNAME_X6, &
- IO_WRITE_FIELD_BYNAME_N0, IO_WRITE_FIELD_BYNAME_N1, &
- IO_WRITE_FIELD_BYNAME_N2, IO_WRITE_FIELD_BYNAME_N3, &
- IO_WRITE_FIELD_BYNAME_L0, IO_WRITE_FIELD_BYNAME_L1, &
- IO_WRITE_FIELD_BYNAME_C0, IO_WRITE_FIELD_BYNAME_C1, &
- IO_WRITE_FIELD_BYNAME_T0, &
- IO_WRITE_FIELD_BYFIELD_X0,IO_WRITE_FIELD_BYFIELD_X1, &
- IO_WRITE_FIELD_BYFIELD_X2,IO_WRITE_FIELD_BYFIELD_X3, &
- IO_WRITE_FIELD_BYFIELD_X4,IO_WRITE_FIELD_BYFIELD_X5, &
- IO_WRITE_FIELD_BYFIELD_X6, &
- IO_WRITE_FIELD_BYFIELD_N0,IO_WRITE_FIELD_BYFIELD_N1, &
- IO_WRITE_FIELD_BYFIELD_N2,IO_WRITE_FIELD_BYFIELD_N3, &
- IO_WRITE_FIELD_BYFIELD_L0,IO_WRITE_FIELD_BYFIELD_L1, &
- IO_WRITE_FIELD_BYFIELD_C0,IO_WRITE_FIELD_BYFIELD_C1, &
- IO_WRITE_FIELD_BYFIELD_T0
+ public :: IO_Field_write, IO_Field_write_box, IO_Field_write_lb
+ public :: IO_Header_write
+ public :: IO_Fieldlist_write, IO_Field_user_write
+
+ INTERFACE IO_Field_write
+ MODULE PROCEDURE IO_Field_write_byname_X0, IO_Field_write_byname_X1, &
+ IO_Field_write_byname_X2, IO_Field_write_byname_X3, &
+ IO_Field_write_byname_X4, IO_Field_write_byname_X5, &
+ 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_L0, IO_Field_write_byname_L1, &
+ IO_Field_write_byname_C0, IO_Field_write_byname_C1, &
+ IO_Field_write_byname_T0, &
+ 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_L0,IO_Field_write_byfield_L1, &
+ IO_Field_write_byfield_C0,IO_Field_write_byfield_C1, &
+ IO_Field_write_byfield_T0
END INTERFACE
- INTERFACE IO_WRITE_FIELD_BOX
- MODULE PROCEDURE IO_WRITE_FIELD_BOX_BYFIELD_X5
+ INTERFACE IO_Field_write_box
+ MODULE PROCEDURE IO_Field_write_box_byfield_X5
END INTERFACE
- INTERFACE IO_WRITE_FIELD_LB
- MODULE PROCEDURE IO_WRITE_FIELD_BYNAME_LB, IO_WRITE_FIELD_BYFIELD_LB
+ INTERFACE IO_Field_write_lb
+ MODULE PROCEDURE IO_Field_write_byname_lb, IO_Field_write_byfield_lb
END INTERFACE
- PUBLIC IO_WRITE_FIELD, IO_WRITE_FIELD_BOX, IO_WRITE_FIELD_LB
- PUBLIC IO_WRITE_HEADER
-
CONTAINS
- SUBROUTINE FIELD_METADATA_CHECK(TPFIELD,KTYPE,KDIMS,HCALLER)
+ SUBROUTINE IO_Field_metadata_check(TPFIELD,KTYPE,KDIMS,HCALLER)
TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD ! Field to check
INTEGER, INTENT(IN) :: KTYPE ! Expected datatype
INTEGER, INTENT(IN) :: KDIMS ! Expected number of dimensions
@@ -113,10 +113,10 @@ CONTAINS
END SELECT
!
END SUBROUTINE TYPE_WRITE
- END SUBROUTINE FIELD_METADATA_CHECK
+ END SUBROUTINE IO_Field_metadata_check
- SUBROUTINE IO_FILE_WRITE_CHECK(TPFILE,HSUBR,KRESP)
+ SUBROUTINE IO_File_write_check(TPFILE,HSUBR,KRESP)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
CHARACTER(LEN=*), INTENT(IN) :: HSUBR
INTEGER, INTENT(OUT) :: KRESP
@@ -144,10 +144,10 @@ CONTAINS
RETURN
END IF
!
- END SUBROUTINE IO_FILE_WRITE_CHECK
+ END SUBROUTINE IO_File_write_check
- SUBROUTINE IO_WRITE_SELECT_FORMAT(TPFILE,OLFI,ONC4)
+ SUBROUTINE IO_Format_write_select(TPFILE,OLFI,ONC4)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File structure
LOGICAL, INTENT(OUT) :: OLFI ! Write in LFI format?
LOGICAL, INTENT(OUT) :: ONC4 ! Write in netCDF format?
@@ -156,27 +156,27 @@ CONTAINS
ONC4 = .FALSE.
IF (TPFILE%CFORMAT=='LFI' .OR. TPFILE%CFORMAT=='LFICDF4') OLFI = .TRUE.
IF (TPFILE%CFORMAT=='NETCDF4' .OR. TPFILE%CFORMAT=='LFICDF4') ONC4 = .TRUE.
- END SUBROUTINE IO_WRITE_SELECT_FORMAT
+ END SUBROUTINE IO_Format_write_select
- SUBROUTINE IO_WRITE_HEADER(TPFILE,HDAD_NAME)
+ SUBROUTINE IO_Header_write(TPFILE,HDAD_NAME)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File structure
CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: HDAD_NAME
integer :: ifile
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_HEADER_FILE','called for file '//TRIM(TPFILE%CNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Header_write_FILE','called for file '//TRIM(TPFILE%CNAME))
- CALL IO_WRITE_HEADER_ONEFILE(TPFILE,HDAD_NAME)
+ CALL IO_Header_onefile_write(TPFILE,HDAD_NAME)
!Write header also for the Z-split files
DO IFILE=1,TPFILE%NSUBFILES_IOZ
- CALL IO_WRITE_HEADER_ONEFILE(TPFILE%TFILES_IOZ(IFILE)%TFILE,HDAD_NAME)
+ CALL IO_Header_onefile_write(TPFILE%TFILES_IOZ(IFILE)%TFILE,HDAD_NAME)
END DO
- END SUBROUTINE IO_WRITE_HEADER
+ END SUBROUTINE IO_Header_write
- SUBROUTINE IO_WRITE_HEADER_ONEFILE(TPFILE,HDAD_NAME)
+ SUBROUTINE IO_Header_onefile_write(TPFILE,HDAD_NAME)
!
USE MODD_CONF
USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
@@ -188,23 +188,23 @@ CONTAINS
CHARACTER(LEN=:),ALLOCATABLE :: YDAD_NAME
INTEGER :: ILEN,ILEN2
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_HEADER_ONEFILE','called for file '//TRIM(TPFILE%CNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Header_onefile_write','called for file '//TRIM(TPFILE%CNAME))
!
IF ( ASSOCIATED(TPFILE%TDADFILE) .AND. PRESENT(HDAD_NAME) ) THEN
IF ( TRIM(TPFILE%TDADFILE%CNAME) /= TRIM(HDAD_NAME) ) THEN
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_HEADER_ONEFILE','TPFILE%TDADFILE%CNAME /= HDAD_NAME')
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Header_onefile_write','TPFILE%TDADFILE%CNAME /= HDAD_NAME')
END IF
END IF
!
- CALL IO_WRITE_HEADER_NC4(TPFILE)
+ CALL IO_Header_write_nc4(TPFILE)
!
- CALL IO_WRITE_FIELD(TPFILE,'MNHVERSION', NMNHVERSION)
- CALL IO_WRITE_FIELD(TPFILE,'MASDEV', NMASDEV)
- CALL IO_WRITE_FIELD(TPFILE,'BUGFIX', NBUGFIX)
- CALL IO_WRITE_FIELD(TPFILE,'BIBUSER', CBIBUSER)
- CALL IO_WRITE_FIELD(TPFILE,'PROGRAM', CPROGRAM)
- CALL IO_WRITE_FIELD(TPFILE,'STORAGE_TYPE',CSTORAGE_TYPE)
- CALL IO_WRITE_FIELD(TPFILE,'MY_NAME', TPFILE%CNAME)
+ CALL IO_Field_write(TPFILE,'MNHVERSION', NMNHVERSION)
+ CALL IO_Field_write(TPFILE,'MASDEV', NMASDEV)
+ CALL IO_Field_write(TPFILE,'BUGFIX', NBUGFIX)
+ CALL IO_Field_write(TPFILE,'BIBUSER', CBIBUSER)
+ CALL IO_Field_write(TPFILE,'PROGRAM', CPROGRAM)
+ CALL IO_Field_write(TPFILE,'STORAGE_TYPE',CSTORAGE_TYPE)
+ CALL IO_Field_write(TPFILE,'MY_NAME', TPFILE%CNAME)
!
IF ( ASSOCIATED(TPFILE%TDADFILE) ) THEN
ILEN = LEN_TRIM(TPFILE%TDADFILE%CNAME)
@@ -227,18 +227,18 @@ CONTAINS
YDAD_NAME(:) = ' '
END IF
ELSE
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_HEADER_ONEFILE',TRIM(TPFILE%CNAME)// &
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Header_onefile_write',TRIM(TPFILE%CNAME)// &
': TPFILE%TDADFILE not associated and HDAD_NAME not provided')
ALLOCATE(CHARACTER(LEN=NFILENAMELGTMAXLFI) :: YDAD_NAME)
YDAD_NAME(:) = ' '
ENDIF
- CALL IO_WRITE_FIELD(TPFILE,'DAD_NAME',YDAD_NAME)
+ CALL IO_Field_write(TPFILE,'DAD_NAME',YDAD_NAME)
DEALLOCATE(YDAD_NAME)
!
- END SUBROUTINE IO_WRITE_HEADER_ONEFILE
+ END SUBROUTINE IO_Header_onefile_write
- SUBROUTINE IO_WRITE_FIELD_BYNAME_X0(TPFILE,HNAME,PFIELD,KRESP)
+ SUBROUTINE IO_Field_write_byname_X0(TPFILE,HNAME,PFIELD,KRESP)
!
!* 0.1 Declarations of arguments
!
@@ -252,21 +252,21 @@ CONTAINS
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_X0',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byname_X0',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
- IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),PFIELD,IRESP)
+ IF(IRESP==0) CALL IO_Field_write(TPFILE,TFIELDLIST(ID),PFIELD,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
- END SUBROUTINE IO_WRITE_FIELD_BYNAME_X0
+ END SUBROUTINE IO_Field_write_byname_X0
- SUBROUTINE IO_WRITE_FIELD_BYFIELD_X0(TPFILE,TPFIELD,PFIELD,KRESP)
- USE MODD_IO_ll, ONLY: GSMONOPROC,ISP
+ SUBROUTINE IO_Field_write_byfield_X0(TPFILE,TPFIELD,PFIELD,KRESP)
+ USE MODD_IO, ONLY: GSMONOPROC, ISP
!
- USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_FIND_BYNAME
+ USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_find_byname
!
IMPLICIT NONE
!
@@ -298,25 +298,25 @@ CONTAINS
IRESP = 0
TZFILE => NULL()
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_X0',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byfield_X0',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
!
- CALL FIELD_METADATA_CHECK(TPFIELD,TYPEREAL,0,'IO_WRITE_FIELD_BYFIELD_X0')
+ CALL IO_Field_metadata_check(TPFIELD,TYPEREAL,0,'IO_Field_write_byfield_X0')
!
- CALL IO_FILE_WRITE_CHECK(TPFILE,'IO_WRITE_FIELD_BYFIELD_X0',IRESP)
+ CALL IO_File_write_check(TPFILE,'IO_Field_write_byfield_X0',IRESP)
!
- CALL IO_WRITE_SELECT_FORMAT(TPFILE,GLFI,GNC4)
+ CALL IO_Format_write_select(TPFILE,GLFI,GNC4)
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,PFIELD,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,PFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,PFIELD,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,PFIELD,IRESP)
ELSE ! multiprocesses execution
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,PFIELD,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,PFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,PFIELD,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,PFIELD,IRESP)
END IF
!
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ 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
@@ -324,8 +324,8 @@ 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_WRITE_FIELD_LFI(TZFILE,TPFIELD,PFIELD,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TZFILE,TPFIELD,PFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TZFILE,TPFIELD,PFIELD,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TZFILE,TPFIELD,PFIELD,IRESP)
END IF
END DO
ENDIF
@@ -335,13 +335,13 @@ CONTAINS
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_WRITE_FIELD_BYFIELD_X0',YMSG)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_X0',YMSG)
END IF
IF (PRESENT(KRESP)) KRESP = IRESP
- END SUBROUTINE IO_WRITE_FIELD_BYFIELD_X0
+ END SUBROUTINE IO_Field_write_byfield_X0
- SUBROUTINE IO_WRITE_FIELD_BYNAME_X1(TPFILE,HNAME,PFIELD,KRESP)
+ SUBROUTINE IO_Field_write_byname_X1(TPFILE,HNAME,PFIELD,KRESP)
!
!* 0.1 Declarations of arguments
!
@@ -355,23 +355,23 @@ CONTAINS
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return-code
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_X1',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byname_X1',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
- IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),PFIELD,IRESP)
+ IF(IRESP==0) CALL IO_Field_write(TPFILE,TFIELDLIST(ID),PFIELD,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
- END SUBROUTINE IO_WRITE_FIELD_BYNAME_X1
+ END SUBROUTINE IO_Field_write_byname_X1
- SUBROUTINE IO_WRITE_FIELD_BYFIELD_X1(TPFILE,TPFIELD,PFIELD,KRESP)
- USE MODD_IO_ll, ONLY: GSMONOPROC,ISP
+ SUBROUTINE IO_Field_write_byfield_X1(TPFILE,TPFIELD,PFIELD,KRESP)
+ USE MODD_IO, ONLY: GSMONOPROC, ISP
!
USE MODE_ALLOCBUFFER_ll
USE MODE_GATHER_ll
- USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_FIND_BYNAME
+ USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_find_byname
!
IMPLICIT NONE
!
@@ -404,26 +404,22 @@ CONTAINS
YRECFM = TPFIELD%CMNHNAME
YDIR = TPFIELD%CDIR
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_X1',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byfield_X1',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
!
- CALL FIELD_METADATA_CHECK(TPFIELD,TYPEREAL,1,'IO_WRITE_FIELD_BYFIELD_X1')
+ CALL IO_Field_metadata_check(TPFIELD,TYPEREAL,1,'IO_Field_write_byfield_X1')
!
- CALL IO_FILE_WRITE_CHECK(TPFILE,'IO_WRITE_FIELD_BYFIELD_X1',IRESP)
+ CALL IO_File_write_check(TPFILE,'IO_Field_write_byfield_X1',IRESP)
!
- CALL IO_WRITE_SELECT_FORMAT(TPFILE,GLFI,GNC4)
+ CALL IO_Format_write_select(TPFILE,GLFI,GNC4)
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,PFIELD,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,PFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,PFIELD,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,PFIELD,IRESP)
ELSE ! multiprocesses execution
-#if ( MNH_INT == 4 )
- CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MPI_INTEGER,MPI_MAX,TPFILE%NMPICOMM,IRESP)
-#else
- CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MPI_INTEGER8,MPI_MAX,TPFILE%NMPICOMM,IRESP)
-#endif
+ CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IRESP)
IF (ISIZEMAX==0) THEN
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_WRITE_FIELD_BYFIELD_X1','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_write_byfield_X1','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
IF (PRESENT(KRESP)) KRESP=0
RETURN
END IF
@@ -440,25 +436,25 @@ CONTAINS
END IF
!
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,ZFIELDP,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
END IF
!
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ 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_WRITE_FIELD_BYFIELD_X1',YMSG)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_X1',YMSG)
END IF
IF (GALLOC) DEALLOCATE(ZFIELDP)
IF (PRESENT(KRESP)) KRESP = IRESP
- END SUBROUTINE IO_WRITE_FIELD_BYFIELD_X1
+ END SUBROUTINE IO_Field_write_byfield_X1
- SUBROUTINE IO_WRITE_FIELD_BYNAME_X2(TPFILE,HNAME,PFIELD,KRESP)
+ SUBROUTINE IO_Field_write_byname_X2(TPFILE,HNAME,PFIELD,KRESP)
!
!* 0.1 Declarations of arguments
!
@@ -472,28 +468,28 @@ CONTAINS
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return-code
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_X2',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byname_X2',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
- IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),PFIELD,IRESP)
+ IF(IRESP==0) CALL IO_Field_write(TPFILE,TFIELDLIST(ID),PFIELD,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
- END SUBROUTINE IO_WRITE_FIELD_BYNAME_X2
+ END SUBROUTINE IO_Field_write_byname_X2
- SUBROUTINE IO_WRITE_FIELD_BYFIELD_X2(TPFILE,TPFIELD,PFIELD,KRESP)
- USE MODD_IO_ll, ONLY : GSMONOPROC,ISP,L1D,L2D,LPACK
- USE MODD_PARAMETERS_ll, ONLY : JPHEXT
- USE MODD_TIMEZ, ONLY : TIMEZ
+ SUBROUTINE IO_Field_write_byfield_X2(TPFILE,TPFIELD,PFIELD,KRESP)
+ USE MODD_IO, ONLY: GSMONOPROC,ISP,L1D,L2D,LPACK
+ USE MODD_PARAMETERS_ll, ONLY: JPHEXT
+ USE MODD_TIMEZ, ONLY: TIMEZ
!
USE MODE_ALLOCBUFFER_ll
#ifdef MNH_GA
USE MODE_GA
#endif
USE MODE_GATHER_ll
- USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
+ USE MODE_MNH_TIMING, ONLY: SECOND_MNH2
!
IMPLICIT NONE
!
@@ -516,14 +512,14 @@ CONTAINS
LOGICAL :: GALLOC
LOGICAL :: GLFI, GNC4
!
- REAL*8,DIMENSION(2) :: T0,T1,T2
- REAL*8,DIMENSION(2) :: T11,T22
+ REAL(kind=MNHTIME), DIMENSION(2) :: T0, T1, T2
+ REAL(kind=MNHTIME), DIMENSION(2) :: T11, T22
#ifdef MNH_GA
- REAL,DIMENSION(:,:),POINTER :: ZFIELD_GA
+ REAL,DIMENSION(:,:),POINTER :: ZFIELD_GA
#endif
- INTEGER :: IHEXTOT
- CHARACTER(LEN=:),ALLOCATABLE :: YMSG
- CHARACTER(LEN=6) :: YRESP
+ INTEGER :: IHEXTOT
+ CHARACTER(LEN=:),ALLOCATABLE :: YMSG
+ CHARACTER(LEN=6) :: YRESP
!
YFILEM = TPFILE%CNAME
YRECFM = TPFIELD%CMNHNAME
@@ -535,39 +531,35 @@ CONTAINS
!
CALL SECOND_MNH2(T11)
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_X2',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byfield_X2',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
!
- CALL FIELD_METADATA_CHECK(TPFIELD,TYPEREAL,2,'IO_WRITE_FIELD_BYFIELD_X2')
+ CALL IO_Field_metadata_check(TPFIELD,TYPEREAL,2,'IO_Field_write_byfield_X2')
!
- CALL IO_FILE_WRITE_CHECK(TPFILE,'IO_WRITE_FIELD_BYFIELD_X2',IRESP)
+ CALL IO_File_write_check(TPFILE,'IO_Field_write_byfield_X2',IRESP)
!
- CALL IO_WRITE_SELECT_FORMAT(TPFILE,GLFI,GNC4)
+ 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 (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,ZFIELDP,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ 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_WRITE_FIELD_LFI(TPFILE,TPFIELD,ZFIELDP,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ 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_WRITE_FIELD_LFI(TPFILE,TPFIELD,PFIELD,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,PFIELD,IRESP)
+ 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)
-#if ( MNH_INT == 4 )
- CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MPI_INTEGER,MPI_MAX,TPFILE%NMPICOMM,IRESP)
-#else
- CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MPI_INTEGER8,MPI_MAX,TPFILE%NMPICOMM,IRESP)
-#endif
+ CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IRESP)
IF (ISIZEMAX==0) THEN
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_WRITE_FIELD_BYFIELD_X2','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_write_byfield_X2','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
IF (PRESENT(KRESP)) KRESP=0
RETURN
END IF
@@ -616,8 +608,8 @@ CONTAINS
TIMEZ%T_WRIT2D_GATH=TIMEZ%T_WRIT2D_GATH + T1 - T0
!
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,ZFIELDP,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
END IF
#ifdef MNH_GA
call ga_sync
@@ -625,23 +617,23 @@ CONTAINS
CALL SECOND_MNH2(T2)
TIMEZ%T_WRIT2D_WRIT=TIMEZ%T_WRIT2D_WRIT + T2 - T1
!
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ 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_WRITE_FIELD_BYFIELD_X2',YMSG)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_X2',YMSG)
END IF
IF (GALLOC) DEALLOCATE(ZFIELDP)
IF (PRESENT(KRESP)) KRESP = IRESP
CALL SECOND_MNH2(T22)
TIMEZ%T_WRIT2D_ALL=TIMEZ%T_WRIT2D_ALL + T22 - T11
- END SUBROUTINE IO_WRITE_FIELD_BYFIELD_X2
+ END SUBROUTINE IO_Field_write_byfield_X2
- SUBROUTINE IO_WRITE_FIELD_BYNAME_X3(TPFILE,HNAME,PFIELD,KRESP)
+ SUBROUTINE IO_Field_write_byname_X3(TPFILE,HNAME,PFIELD,KRESP)
!
!* 0.1 Declarations of arguments
!
@@ -655,31 +647,31 @@ CONTAINS
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_X3',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byname_X3',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
- IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),PFIELD,IRESP)
+ IF(IRESP==0) CALL IO_Field_write(TPFILE,TFIELDLIST(ID),PFIELD,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
- END SUBROUTINE IO_WRITE_FIELD_BYNAME_X3
+ END SUBROUTINE IO_Field_write_byname_X3
- SUBROUTINE IO_WRITE_FIELD_BYFIELD_X3(TPFILE,TPFIELD,PFIELD,KRESP)
- USE MODD_IO_ll, ONLY : GSMONOPROC,ISNPROC,ISP,L1D,L2D,LPACK
- USE MODD_PARAMETERS_ll, ONLY : JPHEXT
- USE MODD_TIMEZ, ONLY : TIMEZ
+ SUBROUTINE IO_Field_write_byfield_X3(TPFILE,TPFIELD,PFIELD,KRESP)
+ USE MODD_IO, ONLY: GSMONOPROC, ISNPROC, ISP, L1D, L2D, LPACK
+ USE MODD_PARAMETERS_ll, ONLY: JPHEXT
+ USE MODD_TIMEZ, ONLY: TIMEZ
+ USE MODD_VAR_ll, ONLY: MNH_STATUSES_IGNORE
!
USE MODE_ALLOCBUFFER_ll
- USE MODE_GATHER_ll
- USE MODE_IO_TOOLS, ONLY : IO_FILE
- USE MODE_IO_MANAGE_STRUCT, ONLY : IO_FILE_FIND_BYNAME
- USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
#ifdef MNH_GA
USE MODE_GA
#endif
- USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
+ USE MODE_GATHER_ll
+ USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_find_byname
+ USE MODE_IO_TOOLS, ONLY: IO_Level2filenumber_get
+ USE MODE_MNH_TIMING, ONLY: SECOND_MNH2
!
!
!* 0.1 Declarations of arguments
@@ -710,13 +702,13 @@ CONTAINS
INTEGER,ALLOCATABLE,DIMENSION(:) :: REQ_TAB
INTEGER :: NB_REQ
TYPE TX_2DP
- REAL,DIMENSION(:,:), POINTER :: X
+ REAL, DIMENSION(:,:), POINTER :: X
END TYPE TX_2DP
- TYPE(TX_2DP),ALLOCATABLE,DIMENSION(:) :: T_TX2DP
- REAL*8,DIMENSION(2) :: T0,T1,T2
- REAL*8,DIMENSION(2) :: T11,T22
+ TYPE(TX_2DP),ALLOCATABLE,DIMENSION(:) :: T_TX2DP
+ REAL(kind=MNHTIME), DIMENSION(2) :: T0, T1, T2
+ REAL(kind=MNHTIME), DIMENSION(2) :: T11, T22
#ifdef MNH_GA
- REAL,DIMENSION(:,:,:),POINTER :: ZFIELD_GA
+ REAL,DIMENSION(:,:,:),POINTER :: ZFIELD_GA
#endif
INTEGER :: IHEXTOT
CHARACTER(LEN=:),ALLOCATABLE :: YMSG
@@ -737,40 +729,36 @@ CONTAINS
GALLOC_ll = .FALSE.
IHEXTOT = 2*JPHEXT+1
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_X3',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byfield_X3',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
!
CALL SECOND_MNH2(T11)
!
- CALL FIELD_METADATA_CHECK(TPFIELD,TYPEREAL,3,'IO_WRITE_FIELD_BYFIELD_X3')
+ CALL IO_Field_metadata_check(TPFIELD,TYPEREAL,3,'IO_Field_write_byfield_X3')
!
- CALL IO_FILE_WRITE_CHECK(TPFILE,'IO_WRITE_FIELD_BYFIELD_X3',IRESP)
+ CALL IO_File_write_check(TPFILE,'IO_Field_write_byfield_X3',IRESP)
!
- CALL IO_WRITE_SELECT_FORMAT(TPFILE,GLFI,GNC4)
+ CALL IO_Format_write_select(TPFILE,GLFI,GNC4)
!
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_WRITE_FIELD_LFI(TPFILE,TPFIELD,ZFIELDP,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ 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_WRITE_FIELD_LFI(TPFILE,TPFIELD,ZFIELDP,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ 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_WRITE_FIELD_LFI(TPFILE,TPFIELD,PFIELD,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,PFIELD,IRESP)
+ 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
-#if ( MNH_INT == 4 )
- CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MPI_INTEGER,MPI_MAX,TPFILE%NMPICOMM,IRESP)
-#else
- CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MPI_INTEGER8,MPI_MAX,TPFILE%NMPICOMM,IRESP)
-#endif
+ CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IRESP)
IF (ISIZEMAX==0) THEN
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_WRITE_FIELD_BYFIELD_X3','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
+ 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
@@ -794,20 +782,16 @@ CONTAINS
END IF
!
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,ZFIELDP,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
END IF
!
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
!
ELSE ! multiprocesses execution & // IO
-#if ( MNH_INT == 4 )
- CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MPI_INTEGER,MPI_MAX,TPFILE%NMPICOMM,IRESP)
-#else
- CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MPI_INTEGER8,MPI_MAX,TPFILE%NMPICOMM,IRESP)
-#endif
+ CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IRESP)
IF (ISIZEMAX==0) THEN
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_WRITE_FIELD_BYFIELD_X3','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
+ 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
@@ -839,7 +823,7 @@ CONTAINS
!
DO JKK=1,IKU_ll
!
- IK_FILE = IO_FILE(JKK,TPFILE%NSUBFILES_IOZ)
+ IK_FILE = IO_Level2filenumber_get(JKK,TPFILE%NSUBFILES_IOZ)
TZFILE => TPFILE%TFILES_IOZ(IK_FILE+1)%TFILE
!
IK_RANK = TZFILE%NMASTER_RANK
@@ -860,8 +844,8 @@ CONTAINS
CALL SECOND_MNH2(T1)
TIMEZ%T_WRIT3D_RECV=TIMEZ%T_WRIT3D_RECV + T1 - T0
!
- IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,ZSLICE_ll,IRESP,KVERTLEVEL=JKK,KZFILE=IK_FILE+1)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,ZSLICE_ll,IRESP,KVERTLEVEL=JKK,KZFILE=IK_FILE+1)
+ 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
END IF
@@ -890,7 +874,7 @@ CONTAINS
! get the file & rank to write this level
!
IF (TPFILE%NSUBFILES_IOZ .GT. 1 ) THEN
- IK_FILE = IO_FILE(JKK,TPFILE%NSUBFILES_IOZ)
+ IK_FILE = IO_Level2filenumber_get(JKK,TPFILE%NSUBFILES_IOZ)
TZFILE => TPFILE%TFILES_IOZ(IK_FILE+1)%TFILE
ELSE
TZFILE => TPFILE
@@ -899,11 +883,11 @@ CONTAINS
IK_RANK = TZFILE%NMASTER_RANK
!
IF (YDIR == 'XX' .OR. YDIR =='YY') THEN
- STOP " XX NON PREVU SUR BG POUR LE MOMENT "
+ call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_write_byfield_X3', 'XX not yet planned on Blue Gene' )
CALL GATHER_XXFIELD(YDIR,PFIELD,ZFIELDP,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
ELSEIF (YDIR == 'XY') THEN
IF (LPACK .AND. L2D) THEN
- STOP " L2D NON PREVU SUR BG POUR LE MOMENT "
+ call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_write_byfield_X3', 'L2D not yet planned on Blue Gene' )
CALL GATHER_XXFIELD('XX',PFIELD(:,JPHEXT+1,:),ZFIELDP(:,1,:),TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
ELSE
CALL SECOND_MNH2(T0)
@@ -916,9 +900,9 @@ CONTAINS
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),MPI_FLOAT,IK_RANK-1,99+IK_RANK &
+ 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),MPI_FLOAT,IK_RANK-1,99+IK_RANK,TZFILE%NMPICOMM,IERR)
+ !CALL MPI_BSEND(TX2DP,SIZE(TX2DP),MNHREAL_MPI,IK_RANK-1,99+IK_RANK,TZFILE%NMPICOMM,IERR)
END IF
END IF
CALL SECOND_MNH2(T1)
@@ -931,7 +915,7 @@ CONTAINS
!
DO JKK=JK,JK_MAX
IF (TPFILE%NSUBFILES_IOZ .GT. 1 ) THEN
- IK_FILE = IO_FILE(JKK,TPFILE%NSUBFILES_IOZ)
+ IK_FILE = IO_Level2filenumber_get(JKK,TPFILE%NSUBFILES_IOZ)
TZFILE => TPFILE%TFILES_IOZ(IK_FILE+1)%TFILE
ELSE
TZFILE => TPFILE
@@ -954,14 +938,14 @@ CONTAINS
ZSLICE => PFIELD(:,:,JKK)
TX2DP = ZSLICE(IXO:IXE,IYO:IYE)
ELSE
- CALL MPI_RECV(TX2DP,SIZE(TX2DP),MPI_FLOAT,JI-1,99+IK_RANK,TZFILE%NMPICOMM,STATUS,IERR)
+ CALL MPI_RECV(TX2DP,SIZE(TX2DP),MNHREAL_MPI,JI-1,99+IK_RANK,TZFILE%NMPICOMM,STATUS,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_WRITE_FIELD_LFI(TPFILE,TPFIELD,ZSLICE_ll,IRESP,KVERTLEVEL=JKK,KZFILE=IK_FILE+1)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,ZSLICE_ll,IRESP,KVERTLEVEL=JKK,KZFILE=IK_FILE+1)
+ 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
END IF
@@ -986,17 +970,17 @@ CONTAINS
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_WRITE_FIELD_BYFIELD_X3',YMSG)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_X3',YMSG)
END IF
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
- END SUBROUTINE IO_WRITE_FIELD_BYFIELD_X3
+ END SUBROUTINE IO_Field_write_byfield_X3
- SUBROUTINE IO_WRITE_FIELD_BYNAME_X4(TPFILE,HNAME,PFIELD,KRESP)
+ SUBROUTINE IO_Field_write_byname_X4(TPFILE,HNAME,PFIELD,KRESP)
!
!* 0.1 Declarations of arguments
!
@@ -1010,27 +994,27 @@ CONTAINS
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_X4',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byname_X4',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
- IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),PFIELD,IRESP)
+ IF(IRESP==0) CALL IO_Field_write(TPFILE,TFIELDLIST(ID),PFIELD,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
- END SUBROUTINE IO_WRITE_FIELD_BYNAME_X4
+ END SUBROUTINE IO_Field_write_byname_X4
- SUBROUTINE IO_WRITE_FIELD_BYFIELD_X4(TPFILE,TPFIELD,PFIELD,KRESP)
- USE MODD_IO_ll, ONLY : GSMONOPROC,ISP,L1D,L2D,LPACK
- USE MODD_PARAMETERS_ll, ONLY : JPHEXT
- USE MODD_TIMEZ, ONLY : TIMEZ
+ SUBROUTINE IO_Field_write_byfield_X4(TPFILE,TPFIELD,PFIELD,KRESP)
+ USE MODD_IO, ONLY: GSMONOPROC, ISP, L1D, L2D, LPACK
+ USE MODD_PARAMETERS_ll, ONLY: JPHEXT
+ USE MODD_TIMEZ, ONLY: TIMEZ
!
USE MODE_ALLOCBUFFER_ll
USE MODE_GATHER_ll
- USE MODE_IO_TOOLS, ONLY : IO_FILE,IO_RANK
- USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
- USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
+ 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
@@ -1064,13 +1048,13 @@ CONTAINS
!
IHEXTOT = 2*JPHEXT+1
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_X4',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byfield_X4',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
!
- CALL FIELD_METADATA_CHECK(TPFIELD,TYPEREAL,4,'IO_WRITE_FIELD_BYFIELD_X4')
+ CALL IO_Field_metadata_check(TPFIELD,TYPEREAL,4,'IO_Field_write_byfield_X4')
!
- CALL IO_FILE_WRITE_CHECK(TPFILE,'IO_WRITE_FIELD_BYFIELD_X4',IRESP)
+ CALL IO_File_write_check(TPFILE,'IO_Field_write_byfield_X4',IRESP)
!
- CALL IO_WRITE_SELECT_FORMAT(TPFILE,GLFI,GNC4)
+ CALL IO_Format_write_select(TPFILE,GLFI,GNC4)
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
@@ -1080,20 +1064,16 @@ CONTAINS
! 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_WRITE_FIELD_LFI(TPFILE,TPFIELD,ZFIELDP,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ 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_WRITE_FIELD_LFI(TPFILE,TPFIELD,PFIELD,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,PFIELD,IRESP)
+ 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
-#if ( MNH_INT == 4 )
- CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MPI_INTEGER,MPI_MAX,TPFILE%NMPICOMM,IRESP)
-#else
- CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MPI_INTEGER8,MPI_MAX,TPFILE%NMPICOMM,IRESP)
-#endif
+ CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IRESP)
IF (ISIZEMAX==0) THEN
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_WRITE_FIELD_BYFIELD_X4','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_write_byfield_X4','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
IF (PRESENT(KRESP)) KRESP=0
RETURN
END IF
@@ -1116,25 +1096,25 @@ CONTAINS
END IF
!
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,ZFIELDP,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
END IF
!
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ 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_WRITE_FIELD_BYFIELD_X4',YMSG)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_X4',YMSG)
END IF
IF (GALLOC) DEALLOCATE(ZFIELDP)
IF (PRESENT(KRESP)) KRESP = IRESP
- END SUBROUTINE IO_WRITE_FIELD_BYFIELD_X4
+ END SUBROUTINE IO_Field_write_byfield_X4
- SUBROUTINE IO_WRITE_FIELD_BYNAME_X5(TPFILE,HNAME,PFIELD,KRESP)
+ SUBROUTINE IO_Field_write_byname_X5(TPFILE,HNAME,PFIELD,KRESP)
!
!* 0.1 Declarations of arguments
!
@@ -1148,27 +1128,27 @@ CONTAINS
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_X5',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byname_X5',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
- IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),PFIELD,IRESP)
+ IF(IRESP==0) CALL IO_Field_write(TPFILE,TFIELDLIST(ID),PFIELD,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
- END SUBROUTINE IO_WRITE_FIELD_BYNAME_X5
+ END SUBROUTINE IO_Field_write_byname_X5
- SUBROUTINE IO_WRITE_FIELD_BYFIELD_X5(TPFILE,TPFIELD,PFIELD,KRESP)
- USE MODD_IO_ll, ONLY : GSMONOPROC,ISP,L1D,L2D,LPACK
- USE MODD_PARAMETERS_ll, ONLY : JPHEXT
- USE MODD_TIMEZ, ONLY : TIMEZ
+ SUBROUTINE IO_Field_write_byfield_X5(TPFILE,TPFIELD,PFIELD,KRESP)
+ USE MODD_IO, ONLY: GSMONOPROC, ISP, L1D, L2D, LPACK
+ USE MODD_PARAMETERS_ll, ONLY: JPHEXT
+ USE MODD_TIMEZ, ONLY: TIMEZ
!
USE MODE_ALLOCBUFFER_ll
USE MODE_GATHER_ll
- USE MODE_IO_TOOLS, ONLY : IO_FILE,IO_RANK
- USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
- USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
+ 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
@@ -1202,13 +1182,13 @@ CONTAINS
!
IHEXTOT = 2*JPHEXT+1
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_X5',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byfield_X5',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
!
- CALL FIELD_METADATA_CHECK(TPFIELD,TYPEREAL,5,'IO_WRITE_FIELD_BYFIELD_X5')
+ CALL IO_Field_metadata_check(TPFIELD,TYPEREAL,5,'IO_Field_write_byfield_X5')
!
- CALL IO_FILE_WRITE_CHECK(TPFILE,'IO_WRITE_FIELD_BYFIELD_X5',IRESP)
+ CALL IO_File_write_check(TPFILE,'IO_Field_write_byfield_X5',IRESP)
!
- CALL IO_WRITE_SELECT_FORMAT(TPFILE,GLFI,GNC4)
+ CALL IO_Format_write_select(TPFILE,GLFI,GNC4)
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
@@ -1218,20 +1198,16 @@ CONTAINS
! 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_WRITE_FIELD_LFI(TPFILE,TPFIELD,ZFIELDP,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ 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_WRITE_FIELD_LFI(TPFILE,TPFIELD,PFIELD,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,PFIELD,IRESP)
+ 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
-#if ( MNH_INT == 4 )
- CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MPI_INTEGER,MPI_MAX,TPFILE%NMPICOMM,IRESP)
-#else
- CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MPI_INTEGER8,MPI_MAX,TPFILE%NMPICOMM,IRESP)
-#endif
+ CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IRESP)
IF (ISIZEMAX==0) THEN
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_WRITE_FIELD_BYFIELD_X5','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_write_byfield_X5','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
IF (PRESENT(KRESP)) KRESP=0
RETURN
END IF
@@ -1255,25 +1231,25 @@ CONTAINS
END IF
!
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,ZFIELDP,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
END IF
!
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ 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_WRITE_FIELD_BYFIELD_X5',YMSG)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_X5',YMSG)
END IF
IF (GALLOC) DEALLOCATE(ZFIELDP)
IF (PRESENT(KRESP)) KRESP = IRESP
- END SUBROUTINE IO_WRITE_FIELD_BYFIELD_X5
+ END SUBROUTINE IO_Field_write_byfield_X5
- SUBROUTINE IO_WRITE_FIELD_BYNAME_X6(TPFILE,HNAME,PFIELD,KRESP)
+ SUBROUTINE IO_Field_write_byname_X6(TPFILE,HNAME,PFIELD,KRESP)
!
!* 0.1 Declarations of arguments
!
@@ -1287,26 +1263,26 @@ CONTAINS
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_X6',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byname_X6',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
- IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),PFIELD,IRESP)
+ IF(IRESP==0) CALL IO_Field_write(TPFILE,TFIELDLIST(ID),PFIELD,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
- END SUBROUTINE IO_WRITE_FIELD_BYNAME_X6
+ END SUBROUTINE IO_Field_write_byname_X6
- SUBROUTINE IO_WRITE_FIELD_BYFIELD_X6(TPFILE,TPFIELD,PFIELD,KRESP)
- USE MODD_IO_ll, ONLY : GSMONOPROC, ISP
- USE MODD_PARAMETERS_ll, ONLY : JPHEXT
- USE MODD_TIMEZ, ONLY : TIMEZ
+ SUBROUTINE IO_Field_write_byfield_X6(TPFILE,TPFIELD,PFIELD,KRESP)
+ USE MODD_IO, ONLY: GSMONOPROC, ISP
+ USE MODD_PARAMETERS_ll, ONLY: JPHEXT
+ USE MODD_TIMEZ, ONLY: TIMEZ
!
USE MODE_ALLOCBUFFER_ll
USE MODE_GATHER_ll
- USE MODE_IO_TOOLS, ONLY : IO_FILE,IO_RANK
- USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
- USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
+ 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
@@ -1340,26 +1316,22 @@ CONTAINS
!
IHEXTOT = 2*JPHEXT+1
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_X6',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byfield_X6',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
!
- CALL FIELD_METADATA_CHECK(TPFIELD,TYPEREAL,6,'IO_WRITE_FIELD_BYFIELD_X6')
+ CALL IO_Field_metadata_check(TPFIELD,TYPEREAL,6,'IO_Field_write_byfield_X6')
!
- CALL IO_FILE_WRITE_CHECK(TPFILE,'IO_WRITE_FIELD_BYFIELD_X6',IRESP)
+ CALL IO_File_write_check(TPFILE,'IO_Field_write_byfield_X6',IRESP)
!
- CALL IO_WRITE_SELECT_FORMAT(TPFILE,GLFI,GNC4)
+ CALL IO_Format_write_select(TPFILE,GLFI,GNC4)
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,PFIELD,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,PFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,PFIELD,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,PFIELD,IRESP)
ELSE
-#if ( MNH_INT == 4 )
- CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MPI_INTEGER,MPI_MAX,TPFILE%NMPICOMM,IRESP)
-#else
- CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MPI_INTEGER8,MPI_MAX,TPFILE%NMPICOMM,IRESP)
-#endif
+ CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IRESP)
IF (ISIZEMAX==0) THEN
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_WRITE_FIELD_BYFIELD_X6','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_write_byfield_X6','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
IF (PRESENT(KRESP)) KRESP=0
RETURN
END IF
@@ -1378,25 +1350,25 @@ CONTAINS
END IF
!
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,ZFIELDP,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
END IF
!
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ 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_WRITE_FIELD_BYFIELD_X6',YMSG)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_X6',YMSG)
END IF
IF (GALLOC) DEALLOCATE(ZFIELDP)
IF (PRESENT(KRESP)) KRESP = IRESP
- END SUBROUTINE IO_WRITE_FIELD_BYFIELD_X6
+ END SUBROUTINE IO_Field_write_byfield_X6
- SUBROUTINE IO_WRITE_FIELD_BYNAME_N0(TPFILE,HNAME,KFIELD,KRESP)
+ SUBROUTINE IO_Field_write_byname_N0(TPFILE,HNAME,KFIELD,KRESP)
!
!* 0.1 Declarations of arguments
!
@@ -1410,19 +1382,19 @@ CONTAINS
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_N0',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byname_N0',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
- IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),KFIELD,IRESP)
+ IF(IRESP==0) CALL IO_Field_write(TPFILE,TFIELDLIST(ID),KFIELD,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
- END SUBROUTINE IO_WRITE_FIELD_BYNAME_N0
+ END SUBROUTINE IO_Field_write_byname_N0
- SUBROUTINE IO_WRITE_FIELD_BYFIELD_N0(TPFILE,TPFIELD,KFIELD,KRESP)
- USE MODD_IO_ll, ONLY : GSMONOPROC, ISP
+ SUBROUTINE IO_Field_write_byfield_N0(TPFILE,TPFIELD,KFIELD,KRESP)
+ USE MODD_IO, ONLY: GSMONOPROC, ISP
!* 0. DECLARATIONS
! ------------
!
@@ -1447,25 +1419,25 @@ CONTAINS
IRESP = 0
TZFILE => NULL()
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_N0',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byfield_N0',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
!
- CALL FIELD_METADATA_CHECK(TPFIELD,TYPEINT,0,'IO_WRITE_FIELD_BYFIELD_N0')
+ CALL IO_Field_metadata_check(TPFIELD,TYPEINT,0,'IO_Field_write_byfield_N0')
!
- CALL IO_FILE_WRITE_CHECK(TPFILE,'IO_WRITE_FIELD_BYFIELD_N0',IRESP)
+ CALL IO_File_write_check(TPFILE,'IO_Field_write_byfield_N0',IRESP)
!
- CALL IO_WRITE_SELECT_FORMAT(TPFILE,GLFI,GNC4)
+ CALL IO_Format_write_select(TPFILE,GLFI,GNC4)
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,KFIELD,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,KFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,KFIELD,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,KFIELD,IRESP)
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,KFIELD,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,KFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,KFIELD,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,KFIELD,IRESP)
END IF
!
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ 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
@@ -1473,8 +1445,8 @@ 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_WRITE_FIELD_LFI(TZFILE,TPFIELD,KFIELD,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TZFILE,TPFIELD,KFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TZFILE,TPFIELD,KFIELD,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TZFILE,TPFIELD,KFIELD,IRESP)
END IF
END DO
ENDIF
@@ -1484,13 +1456,13 @@ CONTAINS
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_WRITE_FIELD_BYFIELD_N0',YMSG)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_N0',YMSG)
END IF
IF (PRESENT(KRESP)) KRESP = IRESP
- END SUBROUTINE IO_WRITE_FIELD_BYFIELD_N0
+ END SUBROUTINE IO_Field_write_byfield_N0
- SUBROUTINE IO_WRITE_FIELD_BYNAME_N1(TPFILE,HNAME,KFIELD,KRESP)
+ SUBROUTINE IO_Field_write_byname_N1(TPFILE,HNAME,KFIELD,KRESP)
!
!* 0.1 Declarations of arguments
!
@@ -1504,20 +1476,20 @@ CONTAINS
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_N1',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byname_N1',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
- IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),KFIELD,IRESP)
+ IF(IRESP==0) CALL IO_Field_write(TPFILE,TFIELDLIST(ID),KFIELD,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
- END SUBROUTINE IO_WRITE_FIELD_BYNAME_N1
+ END SUBROUTINE IO_Field_write_byname_N1
- SUBROUTINE IO_WRITE_FIELD_BYFIELD_N1(TPFILE,TPFIELD,KFIELD,KRESP)
+ SUBROUTINE IO_Field_write_byfield_N1(TPFILE,TPFIELD,KFIELD,KRESP)
!
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
+ USE MODD_IO, ONLY: ISP,GSMONOPROC
!
USE MODE_ALLOCBUFFER_ll
USE MODE_GATHER_ll
@@ -1552,26 +1524,22 @@ CONTAINS
IRESP = 0
GALLOC = .FALSE.
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_N1',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byfield_N1',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
!
- CALL FIELD_METADATA_CHECK(TPFIELD,TYPEINT,1,'IO_WRITE_FIELD_BYFIELD_N1')
+ CALL IO_Field_metadata_check(TPFIELD,TYPEINT,1,'IO_Field_write_byfield_N1')
!
- CALL IO_FILE_WRITE_CHECK(TPFILE,'IO_WRITE_FIELD_BYFIELD_N1',IRESP)
+ CALL IO_File_write_check(TPFILE,'IO_Field_write_byfield_N1',IRESP)
!
- CALL IO_WRITE_SELECT_FORMAT(TPFILE,GLFI,GNC4)
+ CALL IO_Format_write_select(TPFILE,GLFI,GNC4)
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,KFIELD,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,KFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,KFIELD,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,KFIELD,IRESP)
ELSE ! multiprocesses execution
-#if ( MNH_INT == 4 )
- CALL MPI_ALLREDUCE(SIZE(KFIELD),ISIZEMAX,1,MPI_INTEGER,MPI_MAX,TPFILE%NMPICOMM,IRESP)
-#else
- CALL MPI_ALLREDUCE(SIZE(KFIELD),ISIZEMAX,1,MPI_INTEGER8,MPI_MAX,TPFILE%NMPICOMM,IRESP)
-#endif
+ CALL MPI_ALLREDUCE(SIZE(KFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IRESP)
IF (ISIZEMAX==0) THEN
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_WRITE_FIELD_BYFIELD_N1','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_write_byfield_N1','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
IF (PRESENT(KRESP)) KRESP=0
RETURN
END IF
@@ -1588,26 +1556,26 @@ CONTAINS
END IF
!
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,IFIELDP,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,IFIELDP,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,IFIELDP,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,IFIELDP,IRESP)
END IF
!
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ 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_WRITE_FIELD_BYFIELD_N1',YMSG)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_N1',YMSG)
END IF
IF (GALLOC) DEALLOCATE(IFIELDP)
IF (PRESENT(KRESP)) KRESP = IRESP
!
- END SUBROUTINE IO_WRITE_FIELD_BYFIELD_N1
+ END SUBROUTINE IO_Field_write_byfield_N1
- SUBROUTINE IO_WRITE_FIELD_BYNAME_N2(TPFILE,HNAME,KFIELD,KRESP)
+ SUBROUTINE IO_Field_write_byname_N2(TPFILE,HNAME,KFIELD,KRESP)
!
!* 0.1 Declarations of arguments
!
@@ -1621,25 +1589,25 @@ CONTAINS
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_N2',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byname_N2',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
- IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),KFIELD,IRESP)
+ IF(IRESP==0) CALL IO_Field_write(TPFILE,TFIELDLIST(ID),KFIELD,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
- END SUBROUTINE IO_WRITE_FIELD_BYNAME_N2
+ END SUBROUTINE IO_Field_write_byname_N2
- SUBROUTINE IO_WRITE_FIELD_BYFIELD_N2(TPFILE,TPFIELD,KFIELD,KRESP)
- USE MODD_IO_ll, ONLY : GSMONOPROC,ISP,L1D,L2D,LPACK
- USE MODD_PARAMETERS_ll, ONLY : JPHEXT
- USE MODD_TIMEZ, ONLY : TIMEZ
+ SUBROUTINE IO_Field_write_byfield_N2(TPFILE,TPFIELD,KFIELD,KRESP)
+ USE MODD_IO, ONLY: GSMONOPROC, ISP, L1D, L2D, LPACK
+ USE MODD_PARAMETERS_ll, ONLY: JPHEXT
+ USE MODD_TIMEZ, ONLY: TIMEZ
!
USE MODE_ALLOCBUFFER_ll
USE MODE_GATHER_ll
- USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
+ USE MODE_MNH_TIMING, ONLY: SECOND_MNH2
!
IMPLICIT NONE
!
@@ -1662,8 +1630,8 @@ CONTAINS
LOGICAL :: GALLOC
LOGICAL :: GLFI, GNC4
!
- REAL*8,DIMENSION(2) :: T0,T1,T2
- REAL*8,DIMENSION(2) :: T11,T22
+ REAL(kind=MNHTIME), DIMENSION(2) :: T0, T1, T2
+ REAL(kind=MNHTIME), DIMENSION(2) :: T11, T22
INTEGER :: IHEXTOT
CHARACTER(LEN=:),ALLOCATABLE :: YMSG
CHARACTER(LEN=6) :: YRESP
@@ -1677,39 +1645,35 @@ CONTAINS
!
IHEXTOT = 2*JPHEXT+1
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_N2',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byfield_N2',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
!
CALL SECOND_MNH2(T11)
!
- CALL FIELD_METADATA_CHECK(TPFIELD,TYPEINT,2,'IO_WRITE_FIELD_BYFIELD_N2')
+ CALL IO_Field_metadata_check(TPFIELD,TYPEINT,2,'IO_Field_write_byfield_N2')
!
- CALL IO_FILE_WRITE_CHECK(TPFILE,'IO_WRITE_FIELD_BYFIELD_N2',IRESP)
+ CALL IO_File_write_check(TPFILE,'IO_Field_write_byfield_N2',IRESP)
!
- CALL IO_WRITE_SELECT_FORMAT(TPFILE,GLFI,GNC4)
+ 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_WRITE_FIELD_LFI(TPFILE,TPFIELD,IFIELDP,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,IFIELDP,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,IFIELDP,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,IFIELDP,IRESP)
! 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_WRITE_FIELD_LFI(TPFILE,TPFIELD,IFIELDP,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,IFIELDP,IRESP)
+ 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_WRITE_FIELD_LFI(TPFILE,TPFIELD,KFIELD,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,KFIELD,IRESP)
+ 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
-#if ( MNH_INT == 4 )
- CALL MPI_ALLREDUCE(SIZE(KFIELD),ISIZEMAX,1,MPI_INTEGER,MPI_MAX,TPFILE%NMPICOMM,IRESP)
-#else
- CALL MPI_ALLREDUCE(SIZE(KFIELD),ISIZEMAX,1,MPI_INTEGER8,MPI_MAX,TPFILE%NMPICOMM,IRESP)
-#endif
+ CALL MPI_ALLREDUCE(SIZE(KFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IRESP)
IF (ISIZEMAX==0) THEN
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_WRITE_FIELD_BYFIELD_N2','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
+ 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
@@ -1736,30 +1700,30 @@ CONTAINS
TIMEZ%T_WRIT2D_GATH=TIMEZ%T_WRIT2D_GATH + T1 - T0
!
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,IFIELDP,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,IFIELDP,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,IFIELDP,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,IFIELDP,IRESP)
END IF
CALL SECOND_MNH2(T2)
TIMEZ%T_WRIT2D_WRIT=TIMEZ%T_WRIT2D_WRIT + T2 - T1
!
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ 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_WRITE_FIELD_BYFIELD_N2',YMSG)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_N2',YMSG)
END IF
IF (GALLOC) DEALLOCATE(IFIELDP)
IF (PRESENT(KRESP)) KRESP = IRESP
CALL SECOND_MNH2(T22)
TIMEZ%T_WRIT2D_ALL=TIMEZ%T_WRIT2D_ALL + T22 - T11
!
- END SUBROUTINE IO_WRITE_FIELD_BYFIELD_N2
+ END SUBROUTINE IO_Field_write_byfield_N2
- SUBROUTINE IO_WRITE_FIELD_BYNAME_N3(TPFILE,HNAME,KFIELD,KRESP)
+ SUBROUTINE IO_Field_write_byname_N3(TPFILE,HNAME,KFIELD,KRESP)
!
!* 0.1 Declarations of arguments
!
@@ -1773,24 +1737,24 @@ CONTAINS
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_N3',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byname_N3',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
- IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),KFIELD,IRESP)
+ IF(IRESP==0) CALL IO_Field_write(TPFILE,TFIELDLIST(ID),KFIELD,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
- END SUBROUTINE IO_WRITE_FIELD_BYNAME_N3
+ END SUBROUTINE IO_Field_write_byname_N3
- SUBROUTINE IO_WRITE_FIELD_BYFIELD_N3(TPFILE,TPFIELD,KFIELD,KRESP)
- USE MODD_IO_ll, ONLY : GSMONOPROC,ISP,L1D,L2D,LPACK
- USE MODD_PARAMETERS_ll, ONLY : JPHEXT
- USE MODD_TIMEZ, ONLY : TIMEZ
+ SUBROUTINE IO_Field_write_byfield_N3(TPFILE,TPFIELD,KFIELD,KRESP)
+ USE MODD_IO, ONLY: GSMONOPROC, ISP, L1D, L2D, LPACK
+ USE MODD_PARAMETERS_ll, ONLY: JPHEXT
+ USE MODD_TIMEZ, ONLY: TIMEZ
!
USE MODE_ALLOCBUFFER_ll
USE MODE_GATHER_ll
- USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
+ USE MODE_MNH_TIMING, ONLY: SECOND_MNH2
!
IMPLICIT NONE
!
@@ -1813,7 +1777,7 @@ CONTAINS
LOGICAL :: GALLOC
LOGICAL :: GLFI, GNC4
!
- REAL*8,DIMENSION(2) :: T11,T22
+ REAL(kind=MNHTIME), DIMENSION(2) :: T11, T22
INTEGER :: IHEXTOT
CHARACTER(LEN=:),ALLOCATABLE :: YMSG
CHARACTER(LEN=6) :: YRESP
@@ -1827,39 +1791,35 @@ CONTAINS
!
IHEXTOT = 2*JPHEXT+1
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_N3',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byfield_N3',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
!
CALL SECOND_MNH2(T11)
!
- CALL FIELD_METADATA_CHECK(TPFIELD,TYPEINT,3,'IO_WRITE_FIELD_BYFIELD_N3')
+ CALL IO_Field_metadata_check(TPFIELD,TYPEINT,3,'IO_Field_write_byfield_N3')
!
- CALL IO_FILE_WRITE_CHECK(TPFILE,'IO_WRITE_FIELD_BYFIELD_N3',IRESP)
+ CALL IO_File_write_check(TPFILE,'IO_Field_write_byfield_N3',IRESP)
!
- CALL IO_WRITE_SELECT_FORMAT(TPFILE,GLFI,GNC4)
+ 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_WRITE_FIELD_LFI(TPFILE,TPFIELD,IFIELDP,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,IFIELDP,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,IFIELDP,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,IFIELDP,IRESP)
! 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_WRITE_FIELD_LFI(TPFILE,TPFIELD,IFIELDP,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,IFIELDP,IRESP)
+ 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_WRITE_FIELD_LFI(TPFILE,TPFIELD,KFIELD,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,KFIELD,IRESP)
+ 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
-#if ( MNH_INT == 4 )
- CALL MPI_ALLREDUCE(SIZE(KFIELD),ISIZEMAX,1,MPI_INTEGER,MPI_MAX,TPFILE%NMPICOMM,IRESP)
-#else
- CALL MPI_ALLREDUCE(SIZE(KFIELD),ISIZEMAX,1,MPI_INTEGER8,MPI_MAX,TPFILE%NMPICOMM,IRESP)
-#endif
+ CALL MPI_ALLREDUCE(SIZE(KFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IRESP)
IF (ISIZEMAX==0) THEN
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_WRITE_FIELD_BYFIELD_N3','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_write_byfield_N3','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
IF (PRESENT(KRESP)) KRESP=0
RETURN
END IF
@@ -1883,28 +1843,28 @@ CONTAINS
END IF
!
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,IFIELDP,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,IFIELDP,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,IFIELDP,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,IFIELDP,IRESP)
END IF
!
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ 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_WRITE_FIELD_BYFIELD_N3',YMSG)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_N3',YMSG)
END IF
IF (GALLOC) DEALLOCATE(IFIELDP)
IF (PRESENT(KRESP)) KRESP = IRESP
CALL SECOND_MNH2(T22)
TIMEZ%T_WRIT3D_ALL=TIMEZ%T_WRIT3D_ALL + T22 - T11
!
- END SUBROUTINE IO_WRITE_FIELD_BYFIELD_N3
+ END SUBROUTINE IO_Field_write_byfield_N3
- SUBROUTINE IO_WRITE_FIELD_BYNAME_L0(TPFILE,HNAME,OFIELD,KRESP)
+ SUBROUTINE IO_Field_write_byname_L0(TPFILE,HNAME,OFIELD,KRESP)
!
!* 0.1 Declarations of arguments
!
@@ -1918,20 +1878,20 @@ CONTAINS
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_L0',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ 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_WRITE_FIELD(TPFILE,TFIELDLIST(ID),OFIELD,IRESP)
+ IF(IRESP==0) CALL IO_Field_write(TPFILE,TFIELDLIST(ID),OFIELD,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
- END SUBROUTINE IO_WRITE_FIELD_BYNAME_L0
+ END SUBROUTINE IO_Field_write_byname_L0
- SUBROUTINE IO_WRITE_FIELD_BYFIELD_L0(TPFILE,TPFIELD,OFIELD,KRESP)
- USE MODD_IO_ll, ONLY : GSMONOPROC, ISP
+ 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
+ USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_find_byname
!* 0. DECLARATIONS
! ------------
!
@@ -1956,25 +1916,25 @@ CONTAINS
IRESP = 0
TZFILE => NULL()
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_L0',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byfield_L0',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
!
- CALL FIELD_METADATA_CHECK(TPFIELD,TYPELOG,0,'IO_WRITE_FIELD_BYFIELD_L0')
+ CALL IO_Field_metadata_check(TPFIELD,TYPELOG,0,'IO_Field_write_byfield_L0')
!
- CALL IO_FILE_WRITE_CHECK(TPFILE,'IO_WRITE_FIELD_BYFIELD_L0',IRESP)
+ CALL IO_File_write_check(TPFILE,'IO_Field_write_byfield_L0',IRESP)
!
- CALL IO_WRITE_SELECT_FORMAT(TPFILE,GLFI,GNC4)
+ CALL IO_Format_write_select(TPFILE,GLFI,GNC4)
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,OFIELD,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,OFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,OFIELD,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,OFIELD,IRESP)
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,OFIELD,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,OFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,OFIELD,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,OFIELD,IRESP)
END IF
!
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ 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
@@ -1982,8 +1942,8 @@ 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_WRITE_FIELD_LFI(TZFILE,TPFIELD,OFIELD,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TZFILE,TPFIELD,OFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TZFILE,TPFIELD,OFIELD,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TZFILE,TPFIELD,OFIELD,IRESP)
END IF
END DO
ENDIF
@@ -1993,13 +1953,13 @@ CONTAINS
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_WRITE_FIELD_BYFIELD_L0',YMSG)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_L0',YMSG)
END IF
IF (PRESENT(KRESP)) KRESP = IRESP
- END SUBROUTINE IO_WRITE_FIELD_BYFIELD_L0
+ END SUBROUTINE IO_Field_write_byfield_L0
- SUBROUTINE IO_WRITE_FIELD_BYNAME_L1(TPFILE,HNAME,OFIELD,KRESP)
+ SUBROUTINE IO_Field_write_byname_L1(TPFILE,HNAME,OFIELD,KRESP)
!
!* 0.1 Declarations of arguments
!
@@ -2013,20 +1973,20 @@ CONTAINS
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_L1',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byname_L1',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
- IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),OFIELD,IRESP)
+ IF(IRESP==0) CALL IO_Field_write(TPFILE,TFIELDLIST(ID),OFIELD,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
- END SUBROUTINE IO_WRITE_FIELD_BYNAME_L1
+ END SUBROUTINE IO_Field_write_byname_L1
- SUBROUTINE IO_WRITE_FIELD_BYFIELD_L1(TPFILE,TPFIELD,OFIELD,KRESP)
+ SUBROUTINE IO_Field_write_byfield_L1(TPFILE,TPFIELD,OFIELD,KRESP)
!
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
+ USE MODD_IO, ONLY: ISP, GSMONOPROC
!
USE MODE_ALLOCBUFFER_ll
USE MODE_GATHER_ll
@@ -2061,26 +2021,22 @@ CONTAINS
IRESP = 0
GALLOC = .FALSE.
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_L1',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byfield_L1',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
!
- CALL FIELD_METADATA_CHECK(TPFIELD,TYPELOG,1,'IO_WRITE_FIELD_BYFIELD_L1')
+ CALL IO_Field_metadata_check(TPFIELD,TYPELOG,1,'IO_Field_write_byfield_L1')
!
- CALL IO_FILE_WRITE_CHECK(TPFILE,'IO_WRITE_FIELD_BYFIELD_L1',IRESP)
+ CALL IO_File_write_check(TPFILE,'IO_Field_write_byfield_L1',IRESP)
!
- CALL IO_WRITE_SELECT_FORMAT(TPFILE,GLFI,GNC4)
+ CALL IO_Format_write_select(TPFILE,GLFI,GNC4)
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,OFIELD,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,OFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,OFIELD,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,OFIELD,IRESP)
ELSE ! multiprocesses execution
-#if ( MNH_INT == 4 )
- CALL MPI_ALLREDUCE(SIZE(OFIELD),ISIZEMAX,1,MPI_INTEGER,MPI_MAX,TPFILE%NMPICOMM,IRESP)
-#else
- CALL MPI_ALLREDUCE(SIZE(OFIELD),ISIZEMAX,1,MPI_INTEGER8,MPI_MAX,TPFILE%NMPICOMM,IRESP)
-#endif
+ CALL MPI_ALLREDUCE(SIZE(OFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IRESP)
IF (ISIZEMAX==0) THEN
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_WRITE_FIELD_BYFIELD_L1','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_write_byfield_L1','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
IF (PRESENT(KRESP)) KRESP=0
RETURN
END IF
@@ -2097,26 +2053,26 @@ CONTAINS
END IF
!
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,GFIELDP,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,GFIELDP,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,GFIELDP,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,GFIELDP,IRESP)
END IF
!
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ 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_WRITE_FIELD_BYFIELD_L1',YMSG)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_L1',YMSG)
END IF
IF (GALLOC) DEALLOCATE(GFIELDP)
IF (PRESENT(KRESP)) KRESP = IRESP
!
- END SUBROUTINE IO_WRITE_FIELD_BYFIELD_L1
+ END SUBROUTINE IO_Field_write_byfield_L1
- SUBROUTINE IO_WRITE_FIELD_BYNAME_C0(TPFILE,HNAME,HFIELD,KRESP)
+ SUBROUTINE IO_Field_write_byname_C0(TPFILE,HNAME,HFIELD,KRESP)
!
!* 0.1 Declarations of arguments
!
@@ -2130,19 +2086,19 @@ CONTAINS
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_C0',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byname_C0',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
- IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),HFIELD,IRESP)
+ IF(IRESP==0) CALL IO_Field_write(TPFILE,TFIELDLIST(ID),HFIELD,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
- END SUBROUTINE IO_WRITE_FIELD_BYNAME_C0
+ END SUBROUTINE IO_Field_write_byname_C0
- SUBROUTINE IO_WRITE_FIELD_BYFIELD_C0(TPFILE,TPFIELD,HFIELD,KRESP)
- USE MODD_IO_ll, ONLY : GSMONOPROC, ISP
+ SUBROUTINE IO_Field_write_byfield_C0(TPFILE,TPFIELD,HFIELD,KRESP)
+ USE MODD_IO, ONLY: GSMONOPROC, ISP
!
!* 0. DECLARATIONS
! ------------
@@ -2165,43 +2121,43 @@ CONTAINS
!
IRESP = 0
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_C0',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byfield_C0',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
!
- CALL FIELD_METADATA_CHECK(TPFIELD,TYPECHAR,0,'IO_WRITE_FIELD_BYFIELD_C0')
+ CALL IO_Field_metadata_check(TPFIELD,TYPECHAR,0,'IO_Field_write_byfield_C0')
!
- CALL IO_WRITE_SELECT_FORMAT(TPFILE,GLFI,GNC4)
+ CALL IO_Format_write_select(TPFILE,GLFI,GNC4)
!
IF (LEN(HFIELD)==0 .AND. GLFI) THEN
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_C0',&
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_C0',&
'zero-size string not allowed if LFI output for '//TRIM(TPFIELD%CMNHNAME))
END IF
!
- CALL IO_FILE_WRITE_CHECK(TPFILE,'IO_WRITE_FIELD_BYFIELD_C0',IRESP)
+ CALL IO_File_write_check(TPFILE,'IO_Field_write_byfield_C0',IRESP)
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,HFIELD,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,HFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,HFIELD,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,HFIELD,IRESP)
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,HFIELD,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,HFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,HFIELD,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,HFIELD,IRESP)
END IF
!
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ 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_WRITE_FIELD_BYFIELD_C0',YMSG)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_C0',YMSG)
END IF
IF (PRESENT(KRESP)) KRESP = IRESP
- END SUBROUTINE IO_WRITE_FIELD_BYFIELD_C0
+ END SUBROUTINE IO_Field_write_byfield_C0
- SUBROUTINE IO_WRITE_FIELD_BYNAME_C1(TPFILE,HNAME,HFIELD,KRESP)
+ SUBROUTINE IO_Field_write_byname_C1(TPFILE,HNAME,HFIELD,KRESP)
!
!* 0.1 Declarations of arguments
!
@@ -2215,19 +2171,19 @@ CONTAINS
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_C1',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byname_C1',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
- IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),HFIELD,IRESP)
+ IF(IRESP==0) CALL IO_Field_write(TPFILE,TFIELDLIST(ID),HFIELD,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
- END SUBROUTINE IO_WRITE_FIELD_BYNAME_C1
+ END SUBROUTINE IO_Field_write_byname_C1
- SUBROUTINE IO_WRITE_FIELD_BYFIELD_C1(TPFILE,TPFIELD,HFIELD,KRESP)
- USE MODD_IO_ll, ONLY : GSMONOPROC, ISP
+ SUBROUTINE IO_Field_write_byfield_C1(TPFILE,TPFIELD,HFIELD,KRESP)
+ USE MODD_IO, ONLY: GSMONOPROC, ISP
!
!* 0. DECLARATIONS
! ------------
@@ -2252,13 +2208,13 @@ CONTAINS
CHARACTER(LEN=:),ALLOCATABLE :: YMSG
CHARACTER(LEN=6) :: YRESP
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_C1',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byfield_C1',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
!
- CALL FIELD_METADATA_CHECK(TPFIELD,TYPECHAR,1,'IO_WRITE_FIELD_BYFIELD_C1')
+ CALL IO_Field_metadata_check(TPFIELD,TYPECHAR,1,'IO_Field_write_byfield_C1')
!
IRESP = 0
!
- CALL IO_WRITE_SELECT_FORMAT(TPFILE,GLFI,GNC4)
+ CALL IO_Format_write_select(TPFILE,GLFI,GNC4)
!
IF(GLFI) THEN
ILE=LEN(HFIELD)
@@ -2281,33 +2237,33 @@ CONTAINS
END IF
END IF
!
- CALL IO_FILE_WRITE_CHECK(TPFILE,'IO_WRITE_FIELD_BYFIELD_C1',IRESP)
+ CALL IO_File_write_check(TPFILE,'IO_Field_write_byfield_C1',IRESP)
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,IFIELD,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,HFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,IFIELD,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,HFIELD,IRESP)
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,IFIELD,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,HFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,IFIELD,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,HFIELD,IRESP)
END IF
!
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ 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_WRITE_FIELD_BYFIELD_C1',YMSG)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_C1',YMSG)
END IF
IF (ALLOCATED(IFIELD)) DEALLOCATE(IFIELD)
IF (PRESENT(KRESP)) KRESP = IRESP
- END SUBROUTINE IO_WRITE_FIELD_BYFIELD_C1
+ END SUBROUTINE IO_Field_write_byfield_C1
- SUBROUTINE IO_WRITE_FIELD_BYNAME_T0(TPFILE,HNAME,TFIELD,KRESP)
+ SUBROUTINE IO_Field_write_byname_T0(TPFILE,HNAME,TFIELD,KRESP)
!
!* 0.1 Declarations of arguments
!
@@ -2321,19 +2277,19 @@ CONTAINS
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_T0',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byname_T0',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
- IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),TFIELD,IRESP)
+ IF(IRESP==0) CALL IO_Field_write(TPFILE,TFIELDLIST(ID),TFIELD,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
- END SUBROUTINE IO_WRITE_FIELD_BYNAME_T0
+ END SUBROUTINE IO_Field_write_byname_T0
- SUBROUTINE IO_WRITE_FIELD_BYFIELD_T0(TPFILE,TPFIELD,TFIELD,KRESP)
- USE MODD_IO_ll, ONLY : GSMONOPROC, ISP
+ SUBROUTINE IO_Field_write_byfield_T0(TPFILE,TPFIELD,TFIELD,KRESP)
+ USE MODD_IO, ONLY: GSMONOPROC, ISP
USE MODD_TYPE_DATE
!
!* 0. DECLARATIONS
@@ -2355,40 +2311,40 @@ CONTAINS
CHARACTER(LEN=:),ALLOCATABLE :: YMSG
CHARACTER(LEN=6) :: YRESP
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_T0',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byfield_T0',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
!
- CALL FIELD_METADATA_CHECK(TPFIELD,TYPEDATE,0,'IO_WRITE_FIELD_BYFIELD_T0')
+ CALL IO_Field_metadata_check(TPFIELD,TYPEDATE,0,'IO_Field_write_byfield_T0')
!
IRESP = 0
!
- CALL IO_FILE_WRITE_CHECK(TPFILE,'IO_WRITE_FIELD_BYFIELD_T0',IRESP)
+ CALL IO_File_write_check(TPFILE,'IO_Field_write_byfield_T0',IRESP)
!
- CALL IO_WRITE_SELECT_FORMAT(TPFILE,GLFI,GNC4)
+ CALL IO_Format_write_select(TPFILE,GLFI,GNC4)
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,TFIELD,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,TFIELD,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,TFIELD,IRESP)
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,TFIELD,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,TFIELD,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,TFIELD,IRESP)
END IF
!
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ 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_WRITE_FIELD_BYFIELD_T0',YMSG)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_T0',YMSG)
END IF
IF (PRESENT(KRESP)) KRESP = IRESP
- END SUBROUTINE IO_WRITE_FIELD_BYFIELD_T0
+ END SUBROUTINE IO_Field_write_byfield_T0
- SUBROUTINE IO_WRITE_FIELD_BYNAME_LB(TPFILE,HNAME,KL3D,PLB,KRESP)
+ SUBROUTINE IO_Field_write_byname_lb(TPFILE,HNAME,KL3D,PLB,KRESP)
!
!* 0.1 Declarations of arguments
!
@@ -2403,25 +2359,25 @@ CONTAINS
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_LB',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byname_lb',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
- IF(IRESP==0) CALL IO_WRITE_FIELD_LB(TPFILE,TFIELDLIST(ID),KL3D,PLB,IRESP)
+ IF(IRESP==0) CALL IO_Field_write_lb(TPFILE,TFIELDLIST(ID),KL3D,PLB,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
- END SUBROUTINE IO_WRITE_FIELD_BYNAME_LB
+ END SUBROUTINE IO_Field_write_byname_lb
- SUBROUTINE IO_WRITE_FIELD_BYFIELD_LB(TPFILE,TPFIELD,KL3D,PLB,KRESP)
+ SUBROUTINE IO_Field_write_byfield_lb(TPFILE,TPFIELD,KL3D,PLB,KRESP)
!
- USE MODD_IO_ll, ONLY : GSMONOPROC,ISNPROC,ISP,L1D,L2D,LPACK
- USE MODD_PARAMETERS_ll, ONLY : JPHEXT
- USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
+ USE MODD_IO, ONLY: GSMONOPROC, ISNPROC, ISP, L1D, L2D, LPACK
+ USE MODD_PARAMETERS_ll, ONLY: JPHEXT
+ USE MODD_VAR_ll, ONLY: MNH_STATUSES_IGNORE
!
- USE MODE_DISTRIB_LB
- USE MODE_TOOLS_ll, ONLY : GET_GLOBALDIMS_ll
+ USE MODE_DISTRIB_lb
+ USE MODE_TOOLS_ll, ONLY: GET_GLOBALDIMS_ll
!
!
!* 0.1 Declarations of arguments
@@ -2462,15 +2418,15 @@ CONTAINS
!
IRESP = 0
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_LB',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byfield_lb',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
!
IF (YLBTYPE/='LBX' .AND. YLBTYPE/='LBXU' .AND. YLBTYPE/='LBY' .AND. YLBTYPE/='LBYV') THEN
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_LB','unknown LBTYPE ('//YLBTYPE//')')
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_lb','unknown LBTYPE ('//YLBTYPE//')')
RETURN
END IF
!
IF (TPFIELD%CDIR/='') THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_BYFIELD_LB','CDIR was set for '//TRIM(YRECFM))
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_byfield_lb','CDIR was set for '//TRIM(YRECFM))
TPFIELD%CDIR=''
END IF
!
@@ -2480,19 +2436,19 @@ CONTAINS
GOTO 1000
END IF
!
- CALL IO_FILE_WRITE_CHECK(TPFILE,'IO_WRITE_FIELD_BYFIELD_LB',IRESP)
+ CALL IO_File_write_check(TPFILE,'IO_Field_write_byfield_lb',IRESP)
!
- CALL IO_WRITE_SELECT_FORMAT(TPFILE,GLFI,GNC4)
+ 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_WRITE_FIELD_LFI(TPFILE,TPFIELD,TX3DP,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TX3DP,IRESP)
+ 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_WRITE_FIELD_LFI(TPFILE,TPFIELD,PLB,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,PLB,IRESP)
+ 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 (ISP == TPFILE%NMASTER_RANK) THEN
@@ -2504,13 +2460,13 @@ CONTAINS
ALLOCATE(Z3D(IIMAX_ll+2*JPHEXT,(IRIM+JPHEXT)*2,SIZE(PLB,3)))
END IF
DO JI = 1,ISNPROC
- CALL GET_DISTRIB_LB(YLBTYPE,JI,'FM','WRITE',IRIM,IIB,IIE,IJB,IJE)
+ CALL GET_DISTRIB_lb(YLBTYPE,JI,'FM','WRITE',IRIM,IIB,IIE,IJB,IJE)
IF (IIB /= 0) THEN
TX3DP=>Z3D(IIB:IIE,IJB:IJE,:)
IF (ISP /= JI) THEN
- CALL MPI_RECV(TX3DP,SIZE(TX3DP),MPI_FLOAT,JI-1,99,TPFILE%NMPICOMM,STATUS,IERR)
+ CALL MPI_RECV(TX3DP,SIZE(TX3DP),MNHREAL_MPI,JI-1,99,TPFILE%NMPICOMM,STATUS,IERR)
ELSE
- CALL GET_DISTRIB_LB(YLBTYPE,JI,'LOC','WRITE',IRIM,IIB,IIE,IJB,IJE)
+ CALL GET_DISTRIB_lb(YLBTYPE,JI,'LOC','WRITE',IRIM,IIB,IIE,IJB,IJE)
TX3DP = PLB(IIB:IIE,IJB:IJE,:)
END IF
END IF
@@ -2520,23 +2476,23 @@ CONTAINS
ELSE
TX3DP=>Z3D
END IF
- IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,TX3DP,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TX3DP,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,TX3DP,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,TX3DP,IRESP)
ELSE
NB_REQ=0
ALLOCATE(REQ_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)
+ 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),MPI_FLOAT,TPFILE%NMASTER_RANK-1,99, &
+ CALL MPI_ISEND(T_TX3DP(NB_REQ)%X,SIZE(TX3DP),MNHREAL_MPI,TPFILE%NMASTER_RANK-1,99, &
TPFILE%NMPICOMM,REQ_TAB(NB_REQ),IERR)
- !CALL MPI_BSEND(TX3DP,SIZE(TX3DP),MPI_FLOAT,TPFILE%NMASTER_RANK-1,99,TPFILE%NMPICOMM,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)
@@ -2545,7 +2501,7 @@ CONTAINS
DEALLOCATE(T_TX3DP,REQ_TAB)
END IF
!
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
END IF
END IF
!
@@ -2553,17 +2509,17 @@ CONTAINS
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_WRITE_FIELD_BYFIELD_LB',YMSG)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_lb',YMSG)
END IF
!
IF (ALLOCATED(Z3D)) DEALLOCATE(Z3D)
IF (PRESENT(KRESP)) KRESP = IRESP
- END SUBROUTINE IO_WRITE_FIELD_BYFIELD_LB
+ END SUBROUTINE IO_Field_write_byfield_lb
- SUBROUTINE IO_WRITE_FIELD_BOX_BYFIELD_X5(TPFILE,TPFIELD,HBUDGET,PFIELD,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
+ SUBROUTINE IO_Field_write_box_byfield_X5(TPFILE,TPFIELD,HBUDGET,PFIELD,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
!
- USE MODD_IO_ll, ONLY : GSMONOPROC, ISP
+ USE MODD_IO, ONLY: GSMONOPROC, ISP
!
USE MODE_GATHER_ll
!
@@ -2590,14 +2546,14 @@ CONTAINS
CHARACTER(LEN=:),ALLOCATABLE :: YMSG
CHARACTER(LEN=6) :: YRESP
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BOX_BYFIELD_X5',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_box_byfield_X5',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
!
IRESP = 0
GALLOC = .FALSE.
!
- CALL IO_FILE_WRITE_CHECK(TPFILE,'IO_WRITE_FIELD_BOX_BYFIELD_X5',IRESP)
+ CALL IO_File_write_check(TPFILE,'IO_Field_write_box_byfield_X5',IRESP)
!
- CALL IO_WRITE_SELECT_FORMAT(TPFILE,GLFI,GNC4)
+ CALL IO_Format_write_select(TPFILE,GLFI,GNC4)
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
@@ -2608,8 +2564,8 @@ CONTAINS
! take the field as a budget
ZFIELDP=>PFIELD
END IF
- IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,ZFIELDP,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
ELSE ! multiprocesses execution
IF (ISP == TPFILE%NMASTER_RANK) THEN
! Allocate the box
@@ -2625,21 +2581,519 @@ CONTAINS
& KXOBOX,KXEBOX,KYOBOX,KYEBOX,HBUDGET)
!
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_WRITE_FIELD_LFI(TPFILE,TPFIELD,ZFIELDP,IRESP)
- IF (GNC4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
END IF
!
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ 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_WRITE_FIELD_BOX_BYFIELD_X5',YMSG)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_box_byfield_X5',YMSG)
END IF
IF (GALLOC) DEALLOCATE(ZFIELDP)
IF (PRESENT(KRESP)) KRESP = IRESP
- END SUBROUTINE IO_WRITE_FIELD_BOX_BYFIELD_X5
+ END SUBROUTINE IO_Field_write_box_byfield_X5
+
+
+SUBROUTINE IO_Fieldlist_write(TPOUTPUT)
+!
+USE MODE_MODELN_HANDLER, ONLY: GET_CURRENT_MODEL_INDEX
+!
+IMPLICIT NONE
+!
+TYPE(TOUTBAK), INTENT(IN) :: TPOUTPUT !Output structure
+!
+INTEGER :: IDX
+INTEGER :: IMI
+INTEGER :: JI
+!
+IMI = GET_CURRENT_MODEL_INDEX()
+!
+DO JI = 1,SIZE(TPOUTPUT%NFIELDLIST)
+ IDX = TPOUTPUT%NFIELDLIST(JI)
+ NDIMS: SELECT CASE (TFIELDLIST(IDX)%NDIMS)
+ !
+ !0D output
+ !
+ CASE (0)
+ NTYPE0D: SELECT CASE (TFIELDLIST(IDX)%NTYPE)
+ !
+ !0D real
+ !
+ CASE (TYPEREAL)
+ IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_X0D) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_X0D is NOT allocated ' )
+ END IF
+ IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_X0D(IMI)%DATA) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_X0D%DATA is NOT associated' )
+ END IF
+ IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
+ CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_X0D(IMI)%DATA)
+ ELSE
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': CLBTYPE/=NONE not allowed for 0D real fields' )
+ END IF
+ !
+ !0D integer
+ !
+ CASE (TYPEINT)
+ IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_N0D) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_N0D is NOT allocated ' )
+ END IF
+ IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_N0D(IMI)%DATA) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_N0D%DATA is NOT associated' )
+ END IF
+ IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
+ CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_N0D(IMI)%DATA)
+ ELSE
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': CLBTYPE/=NONE not allowed for 0D integer fields' )
+ END IF
+ !
+ !0D logical
+ !
+ CASE (TYPELOG)
+ IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_L0D) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_L0D is NOT allocated ' )
+ END IF
+ IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_L0D(IMI)%DATA) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_L0D%DATA is NOT associated' )
+ END IF
+ IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
+ CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_L0D(IMI)%DATA)
+ ELSE
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': CLBTYPE/=NONE not allowed for 0D logical fields' )
+ END IF
+ !
+ !0D string
+ !
+ CASE (TYPECHAR)
+ IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_C0D) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_C0D is NOT allocated ' )
+ END IF
+ IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_C0D(IMI)%DATA) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_C0D%DATA is NOT associated' )
+ END IF
+ IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
+ CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_C0D(IMI)%DATA)
+ ELSE
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': CLBTYPE/=NONE not allowed for 0D character fields' )
+ END IF
+ !
+ !0D date/time
+ !
+ CASE (TYPEDATE)
+ IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_T0D) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_T0D is NOT allocated ' )
+ END IF
+ IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_T0D(IMI)%DATA) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_T0D%DATA is NOT associated' )
+ END IF
+ IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
+ CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_T0D(IMI)%DATA)
+ ELSE
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': CLBTYPE/=NONE not allowed for 0D date/time fields' )
+ END IF
+ !
+ !0D other types
+ !
+ CASE DEFAULT
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': type not yet supported for 0D output' )
+ END SELECT NTYPE0D
+ !
+ !1D output
+ !
+ CASE (1)
+ NTYPE1D: SELECT CASE (TFIELDLIST(IDX)%NTYPE)
+ !
+ !1D real
+ !
+ CASE (TYPEREAL)
+ IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_X1D) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_X1D is NOT allocated ' )
+ END IF
+ IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_X1D(IMI)%DATA) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_X1D%DATA is NOT associated' )
+ END IF
+ IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
+ CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_X1D(IMI)%DATA)
+ ELSE
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': CLBTYPE/=NONE not allowed for 1D real fields' )
+ END IF
+ !
+ !1D integer
+ !
+ CASE (TYPEINT)
+ IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_N1D) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_N1D is NOT allocated ' )
+ END IF
+ IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_N1D(IMI)%DATA) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_N1D%DATA is NOT associated' )
+ END IF
+ IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
+ CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_N1D(IMI)%DATA)
+ ELSE
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': CLBTYPE/=NONE not allowed for 1D integer fields' )
+ END IF
+ !
+ !1D logical
+ !
+ CASE (TYPELOG)
+ IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_L1D) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_L1D is NOT allocated ' )
+ END IF
+ IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_L1D(IMI)%DATA) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_L1D%DATA is NOT associated' )
+ END IF
+ IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
+ CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_L1D(IMI)%DATA)
+ ELSE
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': CLBTYPE/=NONE not allowed for 1D logical fields' )
+ END IF
+ !
+ !1D string
+ !
+ CASE (TYPECHAR)
+ IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_C1D) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_C1D is NOT allocated ' )
+ END IF
+ IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_C1D(IMI)%DATA) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_C1D%DATA is NOT associated' )
+ END IF
+ IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
+ CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_C1D(IMI)%DATA)
+ ELSE
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': CLBTYPE/=NONE not allowed for 1D character fields' )
+ END IF
+ !
+ !1D other types
+ !
+ CASE DEFAULT
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': type not yet supported for 1D output' )
+ END SELECT NTYPE1D
+ !
+ !2D output
+ !
+ CASE (2)
+ NTYPE2D: SELECT CASE (TFIELDLIST(IDX)%NTYPE)
+ !
+ !2D real
+ !
+ CASE (TYPEREAL)
+ IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_X2D) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_X2D is NOT allocated ' )
+ END IF
+ IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_X2D(IMI)%DATA) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_X2D%DATA is NOT associated' )
+ END IF
+ IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
+ CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_X2D(IMI)%DATA)
+ ELSE
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': CLBTYPE/=NONE not allowed for 2D real fields' )
+ END IF
+ !
+ !2D integer
+ !
+ CASE (TYPEINT)
+ IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_N2D) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_N2D is NOT allocated ' )
+ END IF
+ IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_N2D(IMI)%DATA) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_N2D%DATA is NOT associated' )
+ END IF
+ IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
+ CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_N2D(IMI)%DATA)
+ ELSE
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': CLBTYPE/=NONE not allowed for 2D integer fields' )
+ END IF
+ !
+ !2D other types
+ !
+ CASE DEFAULT
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': type not yet supported for 2D output' )
+ END SELECT NTYPE2D
+ !
+ !3D output
+ !
+ CASE (3)
+ NTYPE3D: SELECT CASE (TFIELDLIST(IDX)%NTYPE)
+ !
+ !3D real
+ !
+ CASE (TYPEREAL)
+ IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_X3D) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_X3D is NOT allocated ' )
+ END IF
+ IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_X3D(IMI)%DATA) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_X3D%DATA is NOT associated' )
+ END IF
+ IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
+ CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_X3D(IMI)%DATA)
+ ELSE
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': CLBTYPE/=NONE not (yet) allowed for 3D real fields' )
+ !PW: TODO?: add missing field in TFIELDLIST?
+ !CALL IO_Field_write_lb(TPOUTPUT%TFILE,TFIELDLIST(IDX),***,TFIELDLIST(IDX)%TFIELD_X3D(IMI)%DATA)
+ END IF
+ !
+ !3D integer
+ !
+ CASE (TYPEINT)
+ IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_N3D) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_N3D is NOT allocated ' )
+ END IF
+ IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_N3D(IMI)%DATA) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_N3D%DATA is NOT associated' )
+ END IF
+ IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
+ CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_N3D(IMI)%DATA)
+ ELSE
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': CLBTYPE/=NONE not (yet) allowed for 3D integer fields' )
+ !PW: TODO?: add missing field in TFIELDLIST?
+ !CALL IO_Field_write_lb(TPOUTPUT%TFILE,TFIELDLIST(IDX),***,TFIELDLIST(IDX)%TFIELD_N3D(IMI)%DATA)
+ END IF
+ !
+ !3D other types
+ !
+ CASE DEFAULT
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': type not yet supported for 3D output' )
+ END SELECT NTYPE3D
+ !
+ !4D output
+ !
+ CASE (4)
+ NTYPE4D: SELECT CASE (TFIELDLIST(IDX)%NTYPE)
+ !
+ !4D real
+ !
+ CASE (TYPEREAL)
+ IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_X4D) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_X4D is NOT allocated ' )
+ END IF
+ IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_X4D(IMI)%DATA) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_X4D%DATA is NOT associated' )
+ END IF
+ IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
+ CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_X4D(IMI)%DATA)
+ ELSE
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': CLBTYPE/=NONE not (yet) allowed for 4D real fields' )
+ !PW: TODO?: add missing field in TFIELDLIST?
+ !CALL IO_Field_write_lb(TPOUTPUT%TFILE,TFIELDLIST(IDX),***,TFIELDLIST(IDX)%TFIELD_X4D(IMI)%DATA)
+ END IF
+ !
+ !4D other types
+ !
+ CASE DEFAULT
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': type not yet supported for 4D output' )
+ END SELECT NTYPE4D
+ !
+ !5D output
+ !
+ CASE (5)
+ NTYPE5D: SELECT CASE (TFIELDLIST(IDX)%NTYPE)
+ !
+ !5D real
+ !
+ CASE (TYPEREAL)
+ IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_X5D) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_X5D is NOT allocated ' )
+ END IF
+ IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_X5D(IMI)%DATA) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_X5D%DATA is NOT associated' )
+ END IF
+ IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
+ CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_X5D(IMI)%DATA)
+ ELSE
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': CLBTYPE/=NONE not (yet) allowed for 5D real fields' )
+ !PW: TODO?: add missing field in TFIELDLIST?
+ !CALL IO_Field_write_lb(TPOUTPUT%TFILE,TFIELDLIST(IDX),***,TFIELDLIST(IDX)%TFIELD_X5D(IMI)%DATA)
+ END IF
+ !
+ !5D other types
+ !
+ CASE DEFAULT
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': type not yet supported for 5D output' )
+ END SELECT NTYPE5D
+ !
+ !6D output
+ !
+ CASE (6)
+ NTYPE6D: SELECT CASE (TFIELDLIST(IDX)%NTYPE)
+ !
+ !6D real
+ !
+ CASE (TYPEREAL)
+ IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_X6D) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_X6D is NOT allocated ' )
+ END IF
+ IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_X6D(IMI)%DATA) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_X6D%DATA is NOT associated' )
+ END IF
+ IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
+ CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_X6D(IMI)%DATA)
+ ELSE
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': CLBTYPE/=NONE not (yet) allowed for 6D real fields' )
+ !PW: TODO?: add missing field in TFIELDLIST?
+ !CALL IO_Field_write_lb(TPOUTPUT%TFILE,TFIELDLIST(IDX),***,TFIELDLIST(IDX)%TFIELD_X6D(IMI)%DATA)
+ END IF
+ !
+ !6D other types
+ !
+ CASE DEFAULT
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': type not yet supported for 6D output' )
+ END SELECT NTYPE6D
+ !
+ !Other number of dimensions
+ !
+ CASE DEFAULT
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': number of dimensions not yet supported' )
+ END SELECT NDIMS
+END DO
+!
+END SUBROUTINE IO_Fieldlist_write
+
+
+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_PARAMETERS, ONLY: JPVEXT
+USE MODD_PRECIP_n, ONLY: XINPRR
+#endif
+!
+IMPLICIT NONE
+!
+TYPE(TOUTBAK), INTENT(IN) :: TPOUTPUT !Output structure
+!
+TYPE(TFIELDDATA) :: TZFIELD
+!
+#if 0
+INTEGER :: IKB
+!
+IKB=JPVEXT+1
+!
+TZFIELD%CMNHNAME = 'UTLOW'
+TZFIELD%CSTDNAME = 'x_wind'
+TZFIELD%CLONGNAME = ''
+TZFIELD%CUNITS = 'm s-1'
+TZFIELD%CDIR = 'XY'
+TZFIELD%CCOMMENT = 'X_Y_Z_U component of wind at lowest physical level'
+TZFIELD%NGRID = 2
+TZFIELD%NTYPE = TYPEREAL
+TZFIELD%NDIMS = 2
+TZFIELD%LTIMEDEP = .TRUE.
+CALL IO_Field_write(TPOUTPUT%TFILE,TZFIELD,XUT(:,:,IKB))
+!
+TZFIELD%CMNHNAME = 'VTLOW'
+TZFIELD%CSTDNAME = 'y_wind'
+TZFIELD%CLONGNAME = ''
+TZFIELD%CUNITS = 'm s-1'
+TZFIELD%CDIR = 'XY'
+TZFIELD%CCOMMENT = 'X_Y_Z_V component of wind at lowest physical level'
+TZFIELD%NGRID = 3
+TZFIELD%NTYPE = TYPEREAL
+TZFIELD%NDIMS = 2
+TZFIELD%LTIMEDEP = .TRUE.
+CALL IO_Field_write(TPOUTPUT%TFILE,TZFIELD,XVT(:,:,IKB))
+!
+TZFIELD%CMNHNAME = 'THTLOW'
+TZFIELD%CSTDNAME = 'air_potential_temperature'
+TZFIELD%CLONGNAME = ''
+TZFIELD%CUNITS = 'K'
+TZFIELD%CDIR = 'XY'
+TZFIELD%CCOMMENT = 'X_Y_Z_potential temperature at lowest physical level'
+TZFIELD%NGRID = 1
+TZFIELD%NTYPE = TYPEREAL
+TZFIELD%NDIMS = 2
+TZFIELD%LTIMEDEP = .TRUE.
+CALL IO_Field_write(TPOUTPUT%TFILE,TZFIELD,XTHT(:,:,IKB))
+!
+TZFIELD%CMNHNAME = 'RVTLOW'
+!TZFIELD%CSTDNAME = 'humidity_mixing_ratio' !ratio of the mass of water vapor to the mass of dry air
+TZFIELD%CSTDNAME = 'specific_humidity' !mass fraction of water vapor in (moist) air
+TZFIELD%CLONGNAME = ''
+TZFIELD%CUNITS = 'kg kg-1'
+TZFIELD%CDIR = 'XY'
+TZFIELD%CCOMMENT = 'X_Y_Z_Vapor mixing Ratio at lowest physical level'
+TZFIELD%NGRID = 1
+TZFIELD%NTYPE = TYPEREAL
+TZFIELD%NDIMS = 2
+TZFIELD%LTIMEDEP = .TRUE.
+CALL IO_Field_write(TPOUTPUT%TFILE,TZFIELD,XRT(:,:,IKB,1))
+!
+TZFIELD%CMNHNAME = 'ACPRRSTEP'
+TZFIELD%CSTDNAME = 'rainfall_amount'
+TZFIELD%CLONGNAME = ''
+TZFIELD%CUNITS = 'kg m-2'
+TZFIELD%CDIR = ''
+TZFIELD%CCOMMENT = 'X_Y_ACcumulated Precipitation Rain Rate during timestep'
+TZFIELD%NGRID = 1
+TZFIELD%NTYPE = TYPEREAL
+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)
+#endif
+!
+END SUBROUTINE IO_Field_user_write
+
+END MODULE MODE_IO_FIELD_WRITE
-END MODULE MODE_FMWRIT
diff --git a/src/LIB/SURCOUCHE/src/mode_io_file.f90 b/src/LIB/SURCOUCHE/src/mode_io_file.f90
new file mode 100644
index 0000000000000000000000000000000000000000..fc766f55219d6ad3d9e8321af35156acf77878fc
--- /dev/null
+++ b/src/LIB/SURCOUCHE/src/mode_io_file.f90
@@ -0,0 +1,753 @@
+!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.
+!-----------------------------------------------------------------
+! Author(s)
+! D. Gazen, P. Wautelet
+! Modifications:
+! J. Escobar 19/08/2005: bug argument optinonel ACCESS --> YACCESS
+! J. Escobar 22/05/2008: bug mode SPECIFIC in IO_File_doopen
+! J. Escobar 05/11/2009: allow JPMAX_UNIT=48 open files
+! J. Escobar 18/10/2010: bug with PGI compiler on ADJUSTL
+! P. Wautelet 04/02/2016: bug with DELIM='NONE' and GCC 5.2/5.3
+! D. Gazen April 2016: change error message
+! P. Wautelet May 2016 : use netCDF Fortran module
+! P. Wautelet July 2016 : added type OUTBAK
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! J. Pianezze 01/08/2016: add LOASIS flag
+! P. Wautelet 29/10/2018: better detection of older MNH version numbers
+! P. Wautelet 13/12/2018: moved some operations to new mode_io_*_nc4 modules
+! P. Wautelet 10/01/2019: bug correction: close correctly Z-split files
+! P. Wautelet 10/01/2019: use NEWUNIT argument of OPEN
+! + move IOFREEFLU and IONEWFLU to mode_io_file_lfi.f90
+! + move management of NNCID and NLFIFLU to the nc4 and lfi subroutines
+! P. Wautelet 10/01/2019: bug: modify some metadata before open calls
+! 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 06/02/2019: simplify IO_File_doopen and do somme assignments at a more logical place
+! 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 07/02/2019: force TYPE to a known value for IO_File_add2list
+! P. Wautelet 14/02/2019: move UPCASE function to tools.f90
+! P. Wautelet 19/02/2019: simplification/restructuration/cleaning of open/close subroutines (TBCto be continued)
+! P. Wautelet 27/02/2019: use recursive calls to open/close DES files
+! P. Wautelet 27/02/2019: remove CLOSE_ll subroutine
+! P. Wautelet 01/03/2019: move open/close subroutines to mode_io_file.f90
+! P. Wautelet 05/03/2019: rename IO subroutines and modules
+! P. Wautelet 12/03/2019: simplify opening of IO split files
+!-----------------------------------------------------------------
+module mode_io_file
+
+use modd_io, only: tfiledata
+
+use mode_msg
+
+implicit none
+
+private
+
+public :: IO_File_close, IO_File_open
+
+
+contains
+
+
+recursive SUBROUTINE IO_File_open(TPFILE,KRESP,kmasterrank, HPOSITION,HSTATUS,HPROGRAM_ORIG)
+!
+USE MODD_CONF, ONLY: CPROGRAM
+USE MODD_IO, ONLY: ISNPROC, LIO_NO_WRITE
+!
+use mode_io, only: gconfio
+use mode_io_manage_struct, only: IO_File_add2list, IO_File_find_byname
+use mode_io_tools, only: IO_Rank_master_get
+!
+TYPE(TFILEDATA), POINTER, INTENT(INOUT) :: TPFILE ! File structure
+INTEGER, optional, INTENT(OUT) :: KRESP ! Return code
+integer, optional, intent(in) :: kmasterrank !Rank of the master process
+CHARACTER(LEN=*), optional, INTENT(IN) :: HPOSITION
+CHARACTER(LEN=*), optional, INTENT(IN) :: HSTATUS
+CHARACTER(LEN=*), optional, INTENT(IN) :: HPROGRAM_ORIG !To emulate a file coming from this program
+!
+CHARACTER(len=5) :: YFILE
+INTEGER :: IFILE, IRANK_PROCIO
+INTEGER :: IRESP
+TYPE(TFILEDATA), POINTER :: TZFILE_DES
+TYPE(TFILEDATA), POINTER :: TZFILE_DUMMY
+TYPE(TFILEDATA), POINTER :: TZFILE_SPLIT
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_File_open','opening '//TRIM(TPFILE%CNAME)//' for '//TRIM(TPFILE%CMODE)// &
+ ' (filetype='//TRIM(TPFILE%CTYPE)//')')
+!
+IF (.NOT.ASSOCIATED(TPFILE)) CALL PRINT_MSG(NVERB_FATAL,'IO','IO_File_open','TPFILE is not associated')
+!
+IF ( LIO_NO_WRITE .AND. TPFILE%CMODE == 'WRITE' .AND. TPFILE%CTYPE/='OUTPUTLISTING') THEN
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_File_open','opening file '//TRIM(TPFILE%CNAME)// &
+ ' in write mode but LIO_NO_WRITE is set')
+END IF
+!
+TZFILE_DES => NULL()
+TZFILE_DUMMY => NULL()
+TZFILE_SPLIT => NULL()
+!
+TPFILE%NOPEN = TPFILE%NOPEN + 1
+TPFILE%NOPEN_CURRENT = TPFILE%NOPEN_CURRENT + 1
+!
+IF (TPFILE%LOPENED) THEN
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_File_open','file '//TRIM(TPFILE%CNAME)//' is already in open state')
+ RETURN
+END IF
+!
+TPFILE%LOPENED = .TRUE.
+!
+!Check if file is in filelist
+CALL IO_File_find_byname(TRIM(TPFILE%CNAME),TZFILE_DUMMY,IRESP)
+IF (IRESP/=0) CALL PRINT_MSG(NVERB_ERROR,'IO','IO_File_open','file '//TRIM(TPFILE%CNAME)//' not in filelist')
+!
+SELECT CASE(TPFILE%CTYPE)
+ !Chemistry input files
+ CASE('CHEMINPUT')
+ CALL IO_File_doopen(TPFILE,IRESP,HPOSITION='REWIND',HSTATUS='OLD',HMODE='GLOBAL')
+
+
+ !Chemistry tabulation files
+ CASE('CHEMTAB')
+ CALL IO_File_doopen(TPFILE,IRESP,HMODE='GLOBAL')
+
+
+ !DES files
+ CASE('DES')
+ CALL IO_File_doopen(TPFILE,IRESP,HDELIM='QUOTE')
+
+
+ !GPS files
+ CASE('GPS')
+ CALL IO_File_doopen(TPFILE,IRESP,HMODE='SPECIFIC')
+
+
+ !Meteo files
+ CASE('METEO')
+ CALL IO_File_doopen(TPFILE,IRESP,HMODE='GLOBAL')
+
+
+ !Namelist files
+ CASE('NML')
+ CALL IO_File_doopen(TPFILE,IRESP,HDELIM='QUOTE',HMODE='GLOBAL')
+
+
+ !OUTPUTLISTING files
+ CASE('OUTPUTLISTING')
+ CALL IO_File_doopen(TPFILE,IRESP,HMODE='GLOBAL')
+
+
+ !SURFACE_DATA files
+ CASE('SURFACE_DATA')
+ CALL IO_File_doopen(TPFILE,IRESP,HMODE='GLOBAL')
+
+
+ !Text files
+ CASE('TXT')
+ CALL IO_File_doopen(TPFILE,IRESP,HPOSITION=HPOSITION,HSTATUS=HSTATUS,HMODE='GLOBAL')
+
+
+ !MesoNH files
+ !Remark: 'MNH' is more general than MNHBACKUP and could be in fact a MNHBACKUP file
+ CASE ('MNH', 'MNHBACKUP', 'MNHDIACHRONIC', 'MNHDIAG', 'MNHOUTPUT', 'PGD')
+ if (.not.GCONFIO) CALL PRINT_MSG(NVERB_FATAL,'IO','IO_File_open','IO_Config_set must be called before IO_File_open')
+
+ !Do not open '.des' file if OUTPUT or if is a "subfile" (tmainfile is associated)
+ IF(TPFILE%CTYPE/='MNHOUTPUT' .AND. CPROGRAM/='LFICDF' .and. .not.associated(tpfile%tmainfile) ) THEN
+ !OOLD=T because the file may already be in the list
+ CALL IO_File_add2list(TZFILE_DES,TRIM(TPFILE%CNAME)//'.des','DES',TPFILE%CMODE,TPDATAFILE=TPFILE,OOLD=.TRUE.)
+ CALL IO_File_open(TZFILE_DES,HPROGRAM_ORIG=HPROGRAM_ORIG)
+ ENDIF
+
+ !Manage split files
+ IF (TPFILE%NSUBFILES_IOZ > 0) THEN
+ IF (.NOT.ALLOCATED(TPFILE%TFILES_IOZ)) THEN
+ ALLOCATE(TPFILE%TFILES_IOZ(TPFILE%NSUBFILES_IOZ))
+ ELSE IF ( SIZE(TPFILE%TFILES_IOZ) /= TPFILE%NSUBFILES_IOZ ) THEN
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_File_open','SIZE(TPFILE%TFILES_IOZ) /= TPFILE%NSUBFILES_IOZ for '//TRIM(TPFILE%CNAME))
+ END IF
+
+ DO IFILE=1,TPFILE%NSUBFILES_IOZ
+ IRANK_PROCIO = 1 + IO_Rank_master_get( IFILE-1, ISNPROC, TPFILE%NSUBFILES_IOZ )
+ WRITE(YFILE ,'(".Z",i3.3)') IFILE
+
+ tzfile_split => null()
+ CALL IO_File_find_byname(TRIM(TPFILE%CNAME)//TRIM(YFILE),TZFILE_SPLIT,IRESP)
+
+ 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.)
+ 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
+
+ TZFILE_SPLIT%TMAINFILE => TPFILE
+ END IF
+
+ TPFILE%TFILES_IOZ(IFILE)%TFILE => TZFILE_SPLIT
+
+ CALL IO_File_open(TZFILE_SPLIT, kmasterrank=IRANK_PROCIO,HPROGRAM_ORIG=HPROGRAM_ORIG)
+ END DO
+ end if
+
+ CALL IO_File_doopen(TPFILE,IRESP,kmasterrank=kmasterrank,HMODE='MASTER',HPROGRAM_ORIG=HPROGRAM_ORIG)
+
+
+ CASE DEFAULT
+ call print_msg(NVERB_FATAL,'IO','IO_File_open','invalid type '//trim(tpfile%ctype)//' for file '//trim(tpfile%cname))
+END SELECT
+!
+IF (PRESENT(KRESP)) KRESP = IRESP
+!
+END SUBROUTINE IO_File_open
+
+
+SUBROUTINE IO_File_doopen(TPFILE, KRESP, kmasterrank, HMODE, HSTATUS, HPOSITION, HDELIM, HPROGRAM_ORIG)
+
+use modd_io, only: ISP, LVERB_ALLPRC, nio_rank, NNULLUNIT
+use modd_var_ll, only: nmnh_comm_world
+
+use mode_tools, only: upcase
+
+TYPE(TFILEDATA), pointer, INTENT(INOUT) :: TPFILE
+INTEGER, INTENT(OUT) :: KRESP
+integer, optional, intent(in) :: kmasterrank !Rank of the master process
+CHARACTER(len=*), OPTIONAL, INTENT(IN) :: HMODE
+CHARACTER(len=*), OPTIONAL, INTENT(IN) :: HSTATUS
+CHARACTER(len=*), OPTIONAL, INTENT(IN) :: HPOSITION
+CHARACTER(len=*), OPTIONAL, INTENT(IN) :: HDELIM
+CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HPROGRAM_ORIG !To emulate a file coming from this program
+!
+! local var
+!
+INTEGER, PARAMETER :: RECL_DEF = 10000
+!
+CHARACTER(len=20) :: YSTATUS
+CHARACTER(len=20) :: YPOSITION
+CHARACTER(len=20) :: YDELIM
+CHARACTER(len=20) :: YACTION
+CHARACTER(len=20) :: YMODE
+CHARACTER(LEN=256) :: YIOERRMSG
+CHARACTER(LEN=:),ALLOCATABLE :: YPREFILENAME !To store the directory + filename
+integer :: imasterrank
+INTEGER :: irecl
+INTEGER :: IOS
+
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_File_doopen','opening '//TRIM(TPFILE%CNAME)//' for '//TRIM(TPFILE%CMODE))
+
+IOS = 0
+
+if ( present( kmasterrank ) ) then
+ imasterrank = kmasterrank
+else
+ imasterrank = nio_rank
+end if
+
+IF (PRESENT(HMODE)) THEN
+ YMODE = HMODE
+ YMODE = UPCASE(TRIM(ADJUSTL(YMODE)))
+ELSE
+ YMODE = 'GLOBAL' ! Default Mode
+END IF
+
+YACTION = TPFILE%CMODE
+YACTION = UPCASE(TRIM(ADJUSTL(YACTION)))
+IF (YACTION /= "READ" .AND. YACTION /= "WRITE") THEN
+ KRESP = 99
+ TPFILE%NLU = -1
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_File_doopen','action='//TRIM(YACTION)//' not supported')
+ RETURN
+END IF
+
+if ( trim(ymode) /= 'GLOBAL' .and. trim(ymode) /= 'SPECIFIC' &
+ .and. trim(ymode) /= 'IO_ZSPLIT' .and. trim(ymode) /= 'MASTER' ) then
+ KRESP = 99
+ TPFILE%NLU = -1
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_File_doopen','ymode='//TRIM(YMODE)//' not supported')
+ RETURN
+end if
+
+IF (PRESENT(HSTATUS)) THEN
+ YSTATUS=HSTATUS
+ELSE
+ YSTATUS='UNKNOWN'
+ENDIF
+
+IF (TPFILE%NRECL == -1) THEN
+ irecl = RECL_DEF
+ELSE
+ irecl = TPFILE%NRECL
+END IF
+
+IF (PRESENT(HPOSITION)) THEN
+ YPOSITION=HPOSITION
+ELSE
+ YPOSITION='ASIS'
+ENDIF
+IF (PRESENT(HDELIM)) THEN
+ YDELIM=HDELIM
+ELSE
+ YDELIM='NONE'
+ENDIF
+
+IF (ALLOCATED(TPFILE%CDIRNAME)) THEN
+ IF(LEN_TRIM(TPFILE%CDIRNAME)>0) THEN
+ YPREFILENAME = TRIM(TPFILE%CDIRNAME)//'/'//TRIM(TPFILE%CNAME)
+ ELSE
+ YPREFILENAME = TRIM(TPFILE%CNAME)
+ END IF
+ELSE
+ YPREFILENAME = TRIM(TPFILE%CNAME)
+END IF
+
+!NMPICOMM must be set before this select case (necessary for case MASTER)
+TPFILE%NMPICOMM = NMNH_COMM_WORLD
+
+SELECT CASE(YMODE)
+
+ CASE('GLOBAL')
+ IF (YACTION == 'READ') THEN
+ TPFILE%NMASTER_RANK = -1
+ TPFILE%LMASTER = .TRUE. !Every process read the file
+ TPFILE%LMULTIMASTERS = .TRUE.
+ ELSE
+ IF (TPFILE%CTYPE=='OUTPUTLISTING') THEN
+ IF (LVERB_ALLPRC) THEN
+ TPFILE%NMASTER_RANK = -1
+ TPFILE%LMASTER = .TRUE. !Every process may write in the file
+ TPFILE%LMULTIMASTERS = .TRUE.
+ ELSE
+ TPFILE%NMASTER_RANK = imasterrank
+ TPFILE%LMASTER = (ISP == imasterrank)
+ TPFILE%LMULTIMASTERS = .FALSE.
+ END IF
+ ELSE
+ TPFILE%NMASTER_RANK = imasterrank
+ TPFILE%LMASTER = (ISP == imasterrank)
+ TPFILE%LMULTIMASTERS = .FALSE.
+ END IF
+ END IF
+ TPFILE%NSUBFILES_IOZ = 0
+
+ IF (TPFILE%LMASTER) THEN
+ !! I/O processor case
+ !JUAN : 31/03/2000 modif pour acces direct
+ IF (TPFILE%CACCESS=='STREAM') THEN
+ OPEN(NEWUNIT=TPFILE%NLU, &
+ FILE=TRIM(YPREFILENAME),&
+ STATUS=YSTATUS, &
+ ACCESS=TPFILE%CACCESS, &
+ IOSTAT=IOS, &
+ IOMSG=YIOERRMSG, &
+ FORM=TPFILE%CFORM, &
+ ACTION=YACTION)
+ ELSEIF (TPFILE%CACCESS=='DIRECT') THEN
+ OPEN(NEWUNIT=TPFILE%NLU, &
+ FILE=TRIM(YPREFILENAME),&
+ STATUS=YSTATUS, &
+ ACCESS=TPFILE%CACCESS, &
+ IOSTAT=IOS, &
+ IOMSG=YIOERRMSG, &
+ FORM=TPFILE%CFORM, &
+ RECL=irecl, &
+ ACTION=YACTION)
+ ELSE
+ IF (TPFILE%CFORM=="FORMATTED") THEN
+ IF (YACTION=='READ') THEN
+ OPEN(NEWUNIT=TPFILE%NLU, &
+ FILE=TRIM(YPREFILENAME),&
+ STATUS=YSTATUS, &
+ ACCESS=TPFILE%CACCESS, &
+ IOSTAT=IOS, &
+ IOMSG=YIOERRMSG, &
+ FORM=TPFILE%CFORM, &
+ RECL=irecl, &
+ POSITION=YPOSITION, &
+ ACTION=YACTION)
+ !DELIM=YDELIM, & !Philippe: commented because bug with GCC 5.X
+ ELSE
+ OPEN(NEWUNIT=TPFILE%NLU, &
+ FILE=TRIM(YPREFILENAME),&
+ STATUS=YSTATUS, &
+ ACCESS=TPFILE%CACCESS, &
+ IOSTAT=IOS, &
+ IOMSG=YIOERRMSG, &
+ FORM=TPFILE%CFORM, &
+ RECL=irecl, &
+ POSITION=YPOSITION, &
+ ACTION=YACTION, &
+ DELIM=YDELIM)
+ ENDIF
+ ELSE
+ OPEN(NEWUNIT=TPFILE%NLU, &
+ FILE=TRIM(YPREFILENAME),&
+ STATUS=YSTATUS, &
+ ACCESS=TPFILE%CACCESS, &
+ IOSTAT=IOS, &
+ IOMSG=YIOERRMSG, &
+ FORM=TPFILE%CFORM, &
+ RECL=irecl, &
+ POSITION=YPOSITION, &
+ ACTION=YACTION)
+ ENDIF
+ ENDIF
+
+ IF ( IOS /= 0 ) &
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_File_doopen','Problem when opening '//TRIM(YPREFILENAME)//': '//TRIM(YIOERRMSG))
+ ELSE
+ !! NON I/O processors case
+ IOS = 0
+ TPFILE%NLU = NNULLUNIT
+ END IF
+
+
+ CASE('SPECIFIC')
+ TPFILE%NMASTER_RANK = -1
+ TPFILE%LMASTER = .TRUE. !Every process use the file
+ TPFILE%LMULTIMASTERS = .TRUE.
+ TPFILE%NSUBFILES_IOZ = 0
+
+ IF (TPFILE%CACCESS=='DIRECT') THEN
+ OPEN(NEWUNIT=TPFILE%NLU, &
+ FILE=TRIM(YPREFILENAME)//SUFFIX(".P"), &
+ STATUS=YSTATUS, &
+ ACCESS=TPFILE%CACCESS, &
+ IOSTAT=IOS, &
+ IOMSG=YIOERRMSG, &
+ FORM=TPFILE%CFORM, &
+ RECL=irecl, &
+ ACTION=YACTION)
+ ELSE
+ IF (YACTION=='READ') THEN
+ OPEN(NEWUNIT=TPFILE%NLU, &
+ FILE=TRIM(YPREFILENAME)//SUFFIX(".P"), &
+ STATUS=YSTATUS, &
+ ACCESS=TPFILE%CACCESS, &
+ IOSTAT=IOS, &
+ IOMSG=YIOERRMSG, &
+ FORM=TPFILE%CFORM, &
+ RECL=irecl, &
+ POSITION=YPOSITION, &
+ ACTION=YACTION)
+ !DELIM=YDELIM, & !Philippe: commented because bug with GCC 5.X
+ ELSE
+ OPEN(NEWUNIT=TPFILE%NLU, &
+ FILE=TRIM(YPREFILENAME)//SUFFIX(".P"), &
+ STATUS=YSTATUS, &
+ ACCESS=TPFILE%CACCESS, &
+ IOSTAT=IOS, &
+ IOMSG=YIOERRMSG, &
+ FORM=TPFILE%CFORM, &
+ RECL=irecl, &
+ POSITION=YPOSITION, &
+ ACTION=YACTION, &
+ DELIM=YDELIM)
+ ENDIF
+ ENDIF
+
+ IF ( IOS /= 0 ) &
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_File_doopen','Problem when opening '//TRIM(YPREFILENAME)//': '//TRIM(YIOERRMSG))
+
+
+ case ( 'MASTER' )
+ tpfile%nmaster_rank = imasterrank
+ tpfile%lmaster = (isp == imasterrank)
+ tpfile%lmultimasters = .false.
+
+ call IO_File_check_format_exist( tpfile )
+
+ call IO_File_open_format( tpfile, hprogram_orig=hprogram_orig )
+END SELECT
+
+KRESP = IOS
+
+CONTAINS
+
+FUNCTION SUFFIX(HEXT)
+
+ CHARACTER(len=*) :: HEXT
+ CHARACTER(len=LEN(HEXT)+3) :: SUFFIX
+
+ if ( isp > 999 ) call Print_msg(NVERB_FATAL,'IO','IO_File_doopen','SUFFIX: ISP>999')
+
+ WRITE(SUFFIX,'(A,i3.3)') TRIM(HEXT), ISP
+
+END FUNCTION SUFFIX
+
+END SUBROUTINE IO_File_doopen
+
+
+recursive SUBROUTINE IO_File_close(TPFILE,KRESP,HPROGRAM_ORIG)
+!
+use modd_conf, only: cprogram
+use modd_io, only: nnullunit
+
+use mode_io_file_lfi, only: IO_File_close_lfi
+#if defined(MNH_IOCDF4)
+use mode_io_file_nc4, only: IO_File_close_nc4
+use mode_io_write_nc4, only: IO_Coordvar_write_nc4
+#endif
+use mode_io_manage_struct, only: IO_File_find_byname
+!
+TYPE(TFILEDATA), INTENT(INOUT) :: TPFILE ! File structure
+INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! Return code
+CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HPROGRAM_ORIG !To emulate a file coming from this program
+!
+character(len=256) :: yioerrmsg
+INTEGER :: IRESP, JI
+TYPE(TFILEDATA),POINTER :: TZFILE_DES
+TYPE(TFILEDATA),POINTER :: TZFILE_IOZ
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_File_close','closing '//TRIM(TPFILE%CNAME))
+!
+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
+ENDIF
+!
+IF (TPFILE%NOPEN_CURRENT>1) THEN
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_File_close',TRIM(TPFILE%CNAME)// &
+ ': decrementing NOPEN_CURRENT (still opened after this call)')
+ TPFILE%NOPEN_CURRENT = TPFILE%NOPEN_CURRENT - 1
+ TPFILE%NCLOSE = TPFILE%NCLOSE + 1
+ !
+ DO JI = 1,TPFILE%NSUBFILES_IOZ
+ TZFILE_IOZ => TPFILE%TFILES_IOZ(JI)%TFILE
+ TZFILE_IOZ%NOPEN_CURRENT = TZFILE_IOZ%NOPEN_CURRENT - 1
+ TZFILE_IOZ%NCLOSE = TZFILE_IOZ%NCLOSE + 1
+ END DO
+ !
+ RETURN
+END IF
+!
+SELECT CASE(TPFILE%CTYPE)
+ CASE('CHEMINPUT','CHEMTAB','DES','GPS','METEO','NML','OUTPUTLISTING','SURFACE_DATA','TXT')
+ IF (TPFILE%LMASTER) THEN
+ IF (TPFILE%NLU/=-1 .AND. TPFILE%NLU/=NNULLUNIT) THEN
+ CLOSE(UNIT=TPFILE%NLU, STATUS='KEEP', IOSTAT=IRESP, IOMSG=yioerrmsg)
+ END IF
+ END IF
+
+ !Warning and not error or fatal if close fails to allow continuation of execution
+ IF (IRESP/=0) CALL PRINT_MSG(NVERB_WARNING,'IO','IO_File_close','Problem when closing ' &
+ //TRIM(TPFILE%CNAME)//': '//TRIM(YIOERRMSG))
+
+ TPFILE%NLU = -1
+
+
+ !MesoNH files
+ !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
+ 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)
+ !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)
+ END IF
+#endif
+
+ if (tpfile%lmaster) then
+ if (tpfile%cformat == 'LFI' .or. tpfile%cformat == 'LFICDF4') call IO_File_close_lfi(tpfile,iresp)
+#if defined(MNH_IOCDF4)
+ if (tpfile%cformat == 'NETCDF4' .or. tpfile%cformat == 'LFICDF4') call IO_File_close_nc4(tpfile,iresp)
+#endif
+ end if
+ !
+ CALL IO_Transfer_list_addto(TPFILE)
+ !
+ SUBFILES: DO JI = 1,TPFILE%NSUBFILES_IOZ
+ TZFILE_IOZ => TPFILE%TFILES_IOZ(JI)%TFILE
+ IF (.NOT.TZFILE_IOZ%LOPENED) &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_File_close','file '//TRIM(TZFILE_IOZ%CNAME)//' is not opened')
+ IF (TZFILE_IOZ%NOPEN_CURRENT/=1) &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_File_close','file '//TRIM(TZFILE_IOZ%CNAME)//&
+ ' is currently opened 0 or several times (expected only 1)')
+ TZFILE_IOZ%LOPENED = .FALSE.
+ TZFILE_IOZ%NOPEN_CURRENT = 0
+ TZFILE_IOZ%NCLOSE = TZFILE_IOZ%NCLOSE + 1
+#if defined(MNH_IOCDF4)
+ !Write coordinates variables in netCDF file
+ IF (TZFILE_IOZ%CMODE == 'WRITE' .AND. (TZFILE_IOZ%CFORMAT=='NETCDF4' .OR. TZFILE_IOZ%CFORMAT=='LFICDF4')) THEN
+ CALL IO_Coordvar_write_nc4(TZFILE_IOZ,HPROGRAM_ORIG=HPROGRAM_ORIG)
+ END IF
+#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)
+ if (tzfile_ioz%cformat == 'NETCDF4' .or. tzfile_ioz%cformat == 'LFICDF4') call IO_File_close_nc4(tzfile_ioz,iresp)
+#endif
+ END IF
+ END DO SUBFILES
+
+
+ CASE DEFAULT
+ call print_msg(NVERB_FATAL,'IO','IO_File_close','invalid type '//trim(tpfile%ctype)//' for file '//trim(tpfile%cname))
+END SELECT
+!
+TPFILE%LOPENED = .FALSE.
+TPFILE%NOPEN_CURRENT = 0
+TPFILE%NCLOSE = TPFILE%NCLOSE + 1
+!
+IF (PRESENT(KRESP)) KRESP=IRESP
+!
+END SUBROUTINE IO_File_close
+
+
+subroutine IO_Transfer_list_addto(TPFILE)
+
+USE MODD_CONF, ONLY: CPROGRAM
+
+USE MODI_SYSTEM_MNH
+
+TYPE(TFILEDATA), INTENT(INOUT) :: TPFILE ! File structure
+
+CHARACTER(len=:),allocatable :: YFILEM ! name of the file
+CHARACTER(len=:),allocatable :: YCPIO
+CHARACTER(len=:),allocatable :: YTRANS
+CHARACTER(LEN=100) :: YCOMMAND
+INTEGER, SAVE :: ICPT = 0
+
+YFILEM = TPFILE%CNAME
+
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Transfer_list_addto','called for '//TRIM(YFILEM))
+
+IF (TPFILE%LMASTER .AND. CPROGRAM/='LFICDF') THEN
+ !! Write in pipe
+#if defined(MNH_SX5)
+ YTRANS='nectransfer.x'
+#else
+ YTRANS='xtransfer.x'
+#endif
+
+ SELECT CASE (TPFILE%NLFITYPE)
+ CASE(:-1,3:)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Transfer_list_addto',TRIM(YFILEM)//': incorrect NLFITYPE')
+ CASE(0)
+ YCPIO='NIL'
+ CASE(1)
+ YCPIO='MESONH'
+ CASE(2)
+ CALL PRINT_MSG(NVERB_INFO,'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 SYSTEM_MNH(YCOMMAND)
+ end if
+END IF
+
+end subroutine IO_Transfer_list_addto
+
+
+subroutine IO_File_check_format_exist( tpfile )
+
+type(tfiledata), intent(inout) :: tpfile ! File structure
+
+logical :: gexist_lfi, gexist_nc4
+
+
+call Print_msg( NVERB_DEBUG, 'IO', 'IO_File_check_format_exist', 'called for '//TRIM(tpfile%cname) )
+
+IF (TPFILE%LMASTER) THEN
+ ! Proc I/O case
+ INQUIRE(FILE=TRIM(TPFILE%CNAME)//'.lfi',EXIST=GEXIST_LFI)
+ INQUIRE(FILE=TRIM(TPFILE%CNAME)//'.nc', EXIST=GEXIST_NC4)
+
+ MODE: if ( tpfile%cmode == 'READ' ) then
+ IF (.NOT.GEXIST_LFI .AND. .NOT.GEXIST_NC4) &
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_File_check_format_exist',TRIM(TPFILE%CNAME)//': no .nc or .lfi file')
+
+ SELECT CASE (TRIM(TPFILE%CFORMAT))
+ CASE ('NETCDF4')
+ IF (.NOT.GEXIST_NC4 .AND. GEXIST_LFI) THEN
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_File_check_format_exist',TRIM(TPFILE%CNAME)// &
+ ': .nc file does not exist but .lfi exists -> forced to LFI')
+ TPFILE%CFORMAT='LFI'
+ END IF
+ CASE ('LFI')
+ IF (.NOT.GEXIST_LFI .AND. GEXIST_NC4) THEN
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_File_check_format_exist',TRIM(TPFILE%CNAME)// &
+ ': .lfi file does not exist but .nc exists -> forced to NETCDF4')
+ TPFILE%CFORMAT='NETCDF4'
+ END IF
+ CASE ('LFICDF4')
+ IF (GEXIST_NC4) THEN
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_File_check_format_exist',TRIM(TPFILE%CNAME)// &
+ ': LFICDF4 format is not allowed in READ mode -> forced to NETCDF4')
+ TPFILE%CFORMAT='NETCDF4'
+ ELSE IF (GEXIST_LFI) THEN
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_File_check_format_exist',TRIM(TPFILE%CNAME)// &
+ ': LFICDF4 format is not allowed in READ mode -> forced to LFI')
+ TPFILE%CFORMAT='LFI'
+ END IF
+ CASE DEFAULT
+ IF (GEXIST_NC4) THEN
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_File_check_format_exist',TRIM(TPFILE%CNAME)// &
+ ': invalid fileformat (-> forced to NETCDF4 if no abort)')
+ TPFILE%CFORMAT='NETCDF4'
+ ELSE IF (GEXIST_LFI) THEN
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_File_check_format_exist',TRIM(TPFILE%CNAME)// &
+ ': invalid fileformat (-> forced to LFI if no abort)')
+ TPFILE%CFORMAT='LFI'
+ END IF
+ END SELECT
+ end if MODE
+END IF
+
+end subroutine IO_File_check_format_exist
+
+
+subroutine IO_File_open_format( tpfile, hprogram_orig )
+
+#if defined(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
+
+type(tfiledata), intent(inout) :: tpfile ! File structure
+character(len=*), optional, intent(in) :: hprogram_orig !To emulate a file coming from this program
+
+integer :: iresp
+
+
+call Print_msg( NVERB_DEBUG, 'IO', 'IO_File_open_format', 'called for '//TRIM(tpfile%cname) )
+
+#if defined(MNH_IOCDF4)
+ IF (TPFILE%CFORMAT=='NETCDF4' .OR. TPFILE%CFORMAT=='LFICDF4') THEN
+ SELECT CASE (TPFILE%CMODE)
+ CASE('READ')
+ call IO_File_open_nc4(tpfile)
+ CASE('WRITE')
+ call IO_File_create_nc4(TPFILE, hprogram_orig=HPROGRAM_ORIG)
+ END SELECT
+ END IF
+#endif
+
+ IF (TPFILE%CFORMAT=='LFI' .OR. TPFILE%CFORMAT=='LFICDF4') THEN
+ SELECT CASE (TPFILE%CMODE)
+ CASE('READ')
+ call IO_File_open_lfi(tpfile,iresp)
+ CASE('WRITE')
+ call IO_File_create_lfi(tpfile,iresp)
+ END SELECT
+ END IF
+
+end subroutine IO_File_open_format
+
+end module mode_io_file
diff --git a/src/LIB/SURCOUCHE/src/mode_io_file_lfi.f90 b/src/LIB/SURCOUCHE/src/mode_io_file_lfi.f90
index b79ff2ec1bb67c395249497bc4f61f403f30227b..1d07379957d7f74d8d407d23b450d51f87f96067 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_file_lfi.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_file_lfi.f90
@@ -3,21 +3,23 @@
!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 14/12/2018
+! Author
+! P. Wautelet 14/12/2018
!
! Remarks: some of the code comes from mode_fm.f90 and mode_io.f90
! (was duplicated in the 2 files)
!
-! Modifications:
-! Philippe Wautelet: 10/01/2019: use NEWUNIT argument of OPEN
-! + move IOFREEFLU and IONEWFLU to mode_io_file_lfi.f90
-! + move management of NNCID and NLFIFLU to the nc4 and lfi subroutines
+! Modifications:
+! P. Wautelet 10/01/2019: use NEWUNIT argument of OPEN
+! + move IO_Flu_dealloc and IO_Flu_alloc to mode_io_file_lfi.f90
+! + move management of NNCID and NLFIFLU to the nc4 and lfi subroutines
+! P. Wautelet 05/03/2019: rename IO subroutines and modules
!
!-----------------------------------------------------------------
module mode_io_file_lfi
-use modd_io_ll, only: tfiledata
-use modd_netcdf, only: idcdf_kind
+use modd_io, only: tfiledata
+use modd_precision, only: LFIINT
use mode_msg
@@ -25,7 +27,7 @@ implicit none
private
-public :: io_create_file_lfi, io_close_file_lfi, io_open_file_lfi
+public :: IO_File_create_lfi, IO_File_close_lfi, IO_File_open_lfi
integer, parameter :: JPRESERVED_UNIT = 11
integer, parameter :: JPMAX_UNIT_NUMBER = JPRESERVED_UNIT + 300
@@ -34,38 +36,38 @@ logical,save :: galloc(JPRESERVED_UNIT:JPMAX_UNIT_NUMBER) = .false.
contains
-subroutine io_create_file_lfi(tpfile, kstatus)
- use mode_io_tools, only: io_construct_filename
- use mode_io_tools_lfi, only: io_prepare_verbosity_lfi
- use mode_io_tools_mnhversion, only: io_set_mnhversion
+subroutine IO_File_create_lfi(tpfile, kstatus)
+ use mode_io_tools, only: IO_Filename_construct
+ use mode_io_tools_mnhversion, only: IO_Mnhversion_set
+ use mode_io_tools_lfi, only: IO_Verbosity_prepare_lfi
type(tfiledata), intent(inout) :: tpfile
integer, intent(inout) :: kstatus
character(len=:), allocatable :: yfilem ! name of the file
character(len=:), allocatable :: yforstatus ! Status for open of a file (for LFI) ('OLD','NEW','UNKNOWN','SCRATCH','REPLACE')
- integer(kind=LFI_INT) :: iresou, inumbr
- integer(kind=LFI_INT) :: imelev, inprar
- integer(kind=LFI_INT) :: ininar ! Number of articles present in LFI file
+ integer(kind=LFIINT) :: iresou, inumbr
+ integer(kind=LFIINT) :: imelev, inprar
+ integer(kind=LFIINT) :: ininar ! Number of articles present in LFI file
logical :: gnewfi
logical :: gnamfi, gfater, gstats
- call print_msg(NVERB_DEBUG,'IO','io_create_file_lfi','called for '//trim(tpfile%cname))
+ call print_msg(NVERB_DEBUG,'IO','IO_File_create_lfi','called for '//trim(tpfile%cname))
kstatus = 0
if (tpfile%lmaster) then
- call io_construct_filename(tpfile, yfilem)
+ call IO_Filename_construct(tpfile, yfilem)
iresou = 0
if ( tpfile%nlfiflu /= -1 ) call print_msg(NVERB_ERROR,'IO', &
- 'io_create_file_lfi','file '//trim(yfilem)//'.lfi has already a unit number')
- tpfile%nlfiflu = ionewflu()
+ 'IO_File_create_lfi','file '//trim(yfilem)//'.lfi has already a unit number')
+ tpfile%nlfiflu = IO_Flu_alloc()
gnamfi = .true.
yforstatus = 'REPLACE'
gfater = .true.
- call io_prepare_verbosity_lfi(tpfile, imelev, gstats)
+ call IO_Verbosity_prepare_lfi(tpfile, imelev, gstats)
inumbr = tpfile%nlfiflu
inprar = tpfile%nlfinprar
@@ -78,44 +80,44 @@ subroutine io_create_file_lfi(tpfile, kstatus)
!test if file is newly defined
gnewfi = (ininar==0) .or. (imelev<2)
if (.not.gnewfi) then
- call print_msg(NVERB_INFO,'IO','io_create_file_lfi','file '//trim(yfilem)//'.lfi previously created with LFI')
+ call print_msg(NVERB_INFO,'IO','IO_File_create_lfi','file '//trim(yfilem)//'.lfi previously created with LFI')
endif
end if
- call io_set_mnhversion(tpfile)
-end subroutine io_create_file_lfi
+ call IO_Mnhversion_set(tpfile)
+end subroutine IO_File_create_lfi
-subroutine io_close_file_lfi(tpfile, kstatus)
+subroutine IO_File_close_lfi(tpfile, kstatus)
type(tfiledata), intent(inout) :: tpfile
integer, optional, intent(out) :: kstatus
character(len=*), parameter :: YSTATUS = 'KEEP'
- integer(kind=LFI_INT) :: istatus
+ integer(kind=LFIINT) :: istatus
- call print_msg(NVERB_DEBUG,'IO','io_close_file_lfi','called for '//trim(tpfile%cname))
+ call print_msg(NVERB_DEBUG,'IO','IO_File_close_lfi','called for '//trim(tpfile%cname))
istatus = 0
if (tpfile%lmaster) then
if ( tpfile%nlfiflu /= -1 ) then
call lfifer(istatus, tpfile%nlfiflu, YSTATUS)
- call iofreeflu(int(tpfile%nlfiflu))
+ call IO_Flu_dealloc(int(tpfile%nlfiflu))
tpfile%nlfiflu = -1
else
istatus = -1
- call print_msg(NVERB_WARNING, 'IO', 'io_close_file_lfi', 'file '//trim(tpfile%cname)//'.lfi is not opened')
+ call print_msg(NVERB_WARNING, 'IO', 'IO_File_close_lfi', 'file '//trim(tpfile%cname)//'.lfi is not opened')
end if
end if
if (present(kstatus)) kstatus = int(istatus,kind=kind(kstatus))
-end subroutine io_close_file_lfi
+end subroutine IO_File_close_lfi
-subroutine io_open_file_lfi(tpfile, kstatus)
- use mode_io_tools, only: io_construct_filename
- use mode_io_tools_lfi, only: io_prepare_verbosity_lfi
- use mode_io_tools_mnhversion, only: io_get_mnhversion
+subroutine IO_File_open_lfi(tpfile, kstatus)
+ use mode_io_tools, only: IO_Filename_construct
+ use mode_io_tools_mnhversion, only: IO_Mnhversion_get
+ use mode_io_tools_lfi, only: IO_Verbosity_prepare_lfi
type(tfiledata), intent(inout) :: tpfile
integer, intent(inout) :: kstatus
@@ -123,28 +125,28 @@ subroutine io_open_file_lfi(tpfile, kstatus)
character(len=:),allocatable :: yfilem ! name of the file
character(len=:),allocatable :: yforstatus ! Status for open of a file (for LFI) ('OLD','NEW','UNKNOWN','SCRATCH','REPLACE')
integer :: istatus
- integer(kind=LFI_INT) :: iresou, inumbr
- integer(kind=LFI_INT) :: imelev, inprar
- integer(kind=LFI_INT) :: ininar ! Number of articles present in LFI file
+ integer(kind=LFIINT) :: iresou, inumbr
+ integer(kind=LFIINT) :: imelev, inprar
+ integer(kind=LFIINT) :: ininar ! Number of articles present in LFI file
logical :: gnewfi
logical :: gnamfi, gfater, gstats
- call print_msg(NVERB_DEBUG,'IO','io_open_file_lfi','called for '//trim(tpfile%cname))
+ call print_msg(NVERB_DEBUG,'IO','IO_File_open_lfi','called for '//trim(tpfile%cname))
kstatus = 0
if (tpfile%lmaster) then
- call io_construct_filename(tpfile, yfilem)
+ call IO_Filename_construct(tpfile, yfilem)
iresou = 0
if ( tpfile%nlfiflu /= -1 ) call print_msg(NVERB_ERROR,'IO', &
- 'io_open_file_lfi','file '//trim(yfilem)//'.lfi has already a unit number')
- tpfile%nlfiflu = ionewflu()
+ 'IO_File_open_lfi','file '//trim(yfilem)//'.lfi has already a unit number')
+ tpfile%nlfiflu = IO_Flu_alloc()
gnamfi = .true.
yforstatus = 'OLD'
gfater = .true.
- call io_prepare_verbosity_lfi(tpfile, imelev, gstats)
+ call IO_Verbosity_prepare_lfi(tpfile, imelev, gstats)
inumbr = tpfile%nlfiflu
inprar = tpfile%nlfinprar
@@ -155,14 +157,14 @@ subroutine io_open_file_lfi(tpfile, kstatus)
if (iresou/=0) kstatus = int(iresou, kind=kind(kstatus))
end if
- call io_get_mnhversion(tpfile)
-end subroutine io_open_file_lfi
+ call IO_Mnhversion_get(tpfile)
+end subroutine IO_File_open_lfi
-function ionewflu()
- use modd_io_ll, only: nnullunit
+function IO_Flu_alloc()
+ use modd_io, only: nnullunit
- integer :: ionewflu
+ integer :: IO_Flu_alloc
integer :: ji
integer :: ios
@@ -174,7 +176,7 @@ function ionewflu()
if ( galloc(ji) ) cycle
inquire(unit=ji, exist=gexists, opened=gopened, iostat=ios)
if (gexists .and. .not. gopened .and. ios == 0) then
- ionewflu = ji
+ IO_Flu_alloc = ji
gfound = .true.
galloc(ji) = .true.
exit
@@ -182,21 +184,21 @@ function ionewflu()
end do
if (.not. gfound) then
- call print_msg(NVERB_ERROR,'IO','ionewflu','wrong unit number')
- ionewflu = nnullunit !/dev/null Fortran unit
+ call print_msg(NVERB_ERROR,'IO','IO_Flu_alloc','wrong unit number')
+ IO_Flu_alloc = nnullunit !/dev/null Fortran unit
end if
-end function ionewflu
+end function IO_Flu_alloc
-subroutine iofreeflu(koflu)
+subroutine IO_Flu_dealloc(koflu)
integer :: koflu
if ( (koflu >= JPRESERVED_UNIT) .and. (koflu <= JPMAX_UNIT_NUMBER) ) then
galloc(koflu) = .false.
else
- call print_msg(NVERB_ERROR,'IO','iofreeflu','wrong unit number')
+ call print_msg(NVERB_ERROR,'IO','IO_Flu_dealloc','wrong unit number')
end if
-end subroutine iofreeflu
+end subroutine IO_Flu_dealloc
end module mode_io_file_lfi
diff --git a/src/LIB/SURCOUCHE/src/mode_io_file_nc4.f90 b/src/LIB/SURCOUCHE/src/mode_io_file_nc4.f90
index 34b375157c278e113c4943426db5f8bf14a79176..746e5746e59b97bb174194ac81d125d22a6f9a1f 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_file_nc4.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_file_nc4.f90
@@ -3,218 +3,221 @@
!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 13/12/2018
+! Author
+! P. Wautelet 13/12/2018
!
! Remarks: some of the code comes from mode_fm.f90 and mode_io.f90
! (was duplicated in the 2 files)
!
-! Modifications:
-! Philippe Wautelet: 10/01/2019: use NEWUNIT argument of OPEN
-! + move IOFREEFLU and IONEWFLU to mode_io_file_lfi.f90
-! + move management of NNCID and NLFIFLU to the nc4 and lfi subroutines
-! Philippe Wautelet: 10/01/2019: replace handle_err by io_handle_err_nc4 for better netCDF error messages
+! Modifications:
+! P. Wautelet 10/01/2019: use NEWUNIT argument of OPEN
+! + move IOFREEFLU and IONEWFLU to mode_io_file_lfi.f90
+! + move management of NNCID and NLFIFLU to the nc4 and lfi subroutines
+! 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 07/03/2019: bugfix: io_set_mnhversion must be called by all the processes
!
!-----------------------------------------------------------------
#if defined(MNH_IOCDF4)
module mode_io_file_nc4
-use modd_io_ll, only: tfiledata
-use modd_netcdf, only: IDCDF_KIND
+use modd_io, only: tfiledata
+use modd_precision, only: CDFINT
-use mode_io_tools_nc4, only: io_handle_err_nc4, io_set_knowndims_nc4, newiocdf
+use mode_io_tools_nc4, only: IO_Err_handle_nc4, IO_Knowndims_set_nc4, IO_Iocdf_alloc_nc4
use mode_msg
-use NETCDF, only: NF90_CLOBBER, NF90_GLOBAL, NF90_NETCDF4, NF90_NOERR, NF90_NOWRITE, &
- NF90_CLOSE, NF90_CREATE, NF90_GET_ATT, NF90_INQUIRE, NF90_INQUIRE_ATTRIBUTE, &
- NF90_OPEN, NF90_PUT_ATT, NF90_STRERROR
+use NETCDF, only: NF90_CLOBBER, NF90_GLOBAL, NF90_NETCDF4, NF90_NOERR, NF90_NOWRITE, &
+ NF90_CLOSE, NF90_CREATE, NF90_GET_ATT, NF90_INQUIRE, NF90_INQUIRE_ATTRIBUTE, &
+ NF90_OPEN, NF90_PUT_ATT, NF90_STRERROR
implicit none
private
-public :: io_create_file_nc4, io_close_file_nc4, io_open_file_nc4
+public :: IO_File_create_nc4, IO_File_close_nc4, IO_File_open_nc4
contains
-subroutine io_create_file_nc4(tpfile,hprogram_orig)
- use mode_io_tools, only: io_construct_filename
- use mode_io_tools_mnhversion, only: io_set_mnhversion
+subroutine IO_File_create_nc4(tpfile,hprogram_orig)
+ use mode_io_tools, only: IO_Filename_construct
+ use mode_io_tools_mnhversion, only: IO_Mnhversion_set
type(tfiledata), intent(inout) :: tpfile
character(len=*),optional, intent(in) :: hprogram_orig !to emulate a file coming from this program
character(len=:),allocatable :: yfilem ! name of the file
- integer(kind=IDCDF_KIND) :: istatus
+ integer(kind=CDFINT) :: istatus
- call print_msg(NVERB_DEBUG,'IO','io_create_file_nc4','called for '//trim(tpfile%cname))
+ call print_msg(NVERB_DEBUG,'IO','IO_File_create_nc4','called for '//trim(tpfile%cname))
if (tpfile%lmaster) then
- call io_construct_filename(tpfile, yfilem)
+ call IO_Filename_construct(tpfile, yfilem)
- tpfile%tncdims => newiocdf()
+ tpfile%tncdims => IO_Iocdf_alloc_nc4()
istatus = NF90_CREATE(adjustl(trim(yfilem))//".nc", ior(NF90_CLOBBER,NF90_NETCDF4), tpfile%nncid)
if (istatus /= NF90_NOERR) then
- call print_msg(NVERB_FATAL,'IO','io_create_file_nc4','NF90_CREATE for '//trim(yfilem)//'.nc: '//NF90_STRERROR(istatus))
+ call print_msg(NVERB_FATAL,'IO','IO_File_create_nc4','NF90_CREATE for '//trim(yfilem)//'.nc: '//NF90_STRERROR(istatus))
end if
- call io_set_not_cleanly_closed_nc4(tpfile)
- call io_set_mnhversion(tpfile)
- call io_set_knowndims_nc4(tpfile, hprogram_orig=hprogram_orig)
+ call IO_Not_cleanly_closed_set_nc4(tpfile)
+ call IO_Knowndims_set_nc4(tpfile, hprogram_orig=hprogram_orig)
end if
-end subroutine io_create_file_nc4
+ call IO_Mnhversion_set(tpfile)
+end subroutine IO_File_create_nc4
-subroutine io_close_file_nc4(tpfile,kstatus)
- use mode_io_tools_nc4, only: cleaniocdf
+subroutine IO_File_close_nc4(tpfile,kstatus)
+ use mode_io_tools_nc4, only: IO_Iocdf_dealloc_nc4
- type(tfiledata), intent(inout) :: tpfile
- integer(kind=IDCDF_KIND), optional, intent(out) :: kstatus
+ type(tfiledata), intent(inout) :: tpfile
+ integer(kind=CDFINT), optional, intent(out) :: kstatus
- integer(kind=IDCDF_KIND) :: istatus
+ integer(kind=CDFINT) :: istatus
- call print_msg(NVERB_DEBUG,'IO','io_close_file_nc4','called for '//trim(tpfile%cname))
+ call print_msg(NVERB_DEBUG,'IO','IO_File_close_nc4','called for '//trim(tpfile%cname))
istatus = 0
if (tpfile%lmaster ) then
if (tpfile%nncid == -1) then
- call print_msg(NVERB_WARNING, 'IO', 'io_close_file_nc4', 'file '//trim(tpfile%cname)//'.nc is not opened')
+ call print_msg(NVERB_WARNING, 'IO', 'IO_File_close_nc4', 'file '//trim(tpfile%cname)//'.nc is not opened')
else
- if (trim(tpfile%cmode) == 'WRITE') call io_set_cleanly_closed_nc4(tpfile)
+ if (trim(tpfile%cmode) == 'WRITE') call IO_Cleanly_closed_set_nc4(tpfile)
istatus = NF90_CLOSE(tpfile%nncid)
if (istatus /= NF90_NOERR) then
- call print_msg(NVERB_WARNING, 'IO', 'io_close_file_nc4', 'NF90_CLOSE error: '//trim(NF90_STRERROR(istatus)))
+ call print_msg(NVERB_WARNING, 'IO', 'IO_File_close_nc4', 'NF90_CLOSE error: '//trim(NF90_STRERROR(istatus)))
end if
tpfile%nncid = -1
- if (associated(tpfile%tncdims)) call cleaniocdf(tpfile%tncdims)
+ if (associated(tpfile%tncdims)) call IO_Iocdf_dealloc_nc4(tpfile%tncdims)
end if
end if
if (present(kstatus)) kstatus = istatus
-end subroutine io_close_file_nc4
+end subroutine IO_File_close_nc4
-subroutine io_open_file_nc4(tpfile)
- use mode_io_tools, only: io_construct_filename
- use mode_io_tools_mnhversion, only: io_get_mnhversion
+subroutine IO_File_open_nc4(tpfile)
+ use mode_io_tools, only: IO_Filename_construct
+ use mode_io_tools_mnhversion, only: IO_Mnhversion_get
type(tfiledata), intent(inout) :: tpfile
character(len=:),allocatable :: yfilem ! name of the file
- integer(kind=IDCDF_KIND) :: istatus
+ integer(kind=CDFINT) :: istatus
- call print_msg(NVERB_DEBUG,'IO','io_open_file_nc4','called for '//trim(tpfile%cname))
+ call print_msg(NVERB_DEBUG,'IO','IO_File_open_nc4','called for '//trim(tpfile%cname))
if (tpfile%lmaster) then
- call io_construct_filename(tpfile, yfilem)
+ call IO_Filename_construct(tpfile, yfilem)
- tpfile%tncdims => newiocdf()
+ tpfile%tncdims => IO_Iocdf_alloc_nc4()
istatus = NF90_OPEN(adjustl(trim(yfilem))//".nc", NF90_NOWRITE, tpfile%nncid)
if (istatus /= NF90_NOERR) then
- call print_msg(NVERB_FATAL, 'IO', 'io_open_file_nc4', 'NF90_OPEN for '//trim(yfilem)//'.nc: '//NF90_STRERROR(istatus))
+ call print_msg(NVERB_FATAL, 'IO', 'IO_File_open_nc4', 'NF90_OPEN for '//trim(yfilem)//'.nc: '//NF90_STRERROR(istatus))
end if
istatus = NF90_INQUIRE(tpfile%nncid, nvariables=tpfile%nncnar)
if (istatus /= NF90_NOERR) then
- call print_msg(NVERB_FATAL,'IO','io_open_file_nc4','NF90_INQUIRE for '//trim(yfilem)//'.nc: '//NF90_STRERROR(istatus))
+ call print_msg(NVERB_FATAL,'IO','IO_File_open_nc4','NF90_INQUIRE for '//trim(yfilem)//'.nc: '//NF90_STRERROR(istatus))
end if
end if
if (trim(tpfile%cmode) == 'READ') then
- call io_get_mnhversion(tpfile)
- if (tpfile%lmaster) call io_check_cleanly_closed_nc4(tpfile)
+ call IO_Mnhversion_get(tpfile)
+ if (tpfile%lmaster) call IO_Cleanly_closed_check_nc4(tpfile)
end if
-end subroutine io_open_file_nc4
+end subroutine IO_File_open_nc4
-subroutine io_check_cleanly_closed_nc4(tpfile)
+subroutine IO_Cleanly_closed_check_nc4(tpfile)
type(tfiledata), intent(in) :: tpfile
character(len=:), allocatable :: yclean
- integer(kind=IDCDF_KIND) :: ilen, istatus
- integer, dimension(3) :: imnhversion
+ integer(kind=CDFINT) :: ilen, istatus
+ integer, dimension(3) :: imnhversion
- call print_msg(NVERB_DEBUG,'IO','io_check_cleanly_closed_nc4','called for '//trim(tpfile%cname))
+ call print_msg(NVERB_DEBUG,'IO','IO_Cleanly_closed_check_nc4','called for '//trim(tpfile%cname))
imnhversion = tpfile%nmnhversion
if ( imnhversion(1)<5 .OR. &
(imnhversion(1)==5 .AND. imnhversion(2)<4) .OR. &
(imnhversion(1)==5 .AND. imnhversion(2)==4 .AND. imnhversion(3)<2) ) then
- call print_msg(NVERB_DEBUG,'IO','io_check_cleanly_closed_nc4', &
+ call print_msg(NVERB_DEBUG,'IO','IO_Cleanly_closed_check_nc4', &
'file '//trim(tpfile%cname)//' is too old (before MNH 5.4.2) to check if cleanly closed')
return
end if
istatus = NF90_INQUIRE_ATTRIBUTE(tpfile%nncid, NF90_GLOBAL, 'MNH_cleanly_closed', len = ilen)
if (istatus /= NF90_NOERR) then
- call print_msg(NVERB_ERROR,'IO','io_check_cleanly_closed_nc4', &
+ call print_msg(NVERB_ERROR,'IO','IO_Cleanly_closed_check_nc4', &
'MNH_cleanly_closed attribute not found in file '//trim(tpfile%cname))
else
allocate( character(len=ilen) :: yclean )
istatus = NF90_GET_ATT(tpfile%nncid, NF90_GLOBAL, 'MNH_cleanly_closed', yclean)
if (istatus /= NF90_NOERR) then
- call print_msg(NVERB_WARNING,'IO','io_check_cleanly_closed_nc4', &
+ call print_msg(NVERB_WARNING,'IO','IO_Cleanly_closed_check_nc4', &
'MNH_cleanly_closed attribute not found in file '//trim(tpfile%cname))
else
if (yclean == 'yes') then
- call print_msg(NVERB_DEBUG,'IO','io_check_cleanly_closed_nc4', &
+ call print_msg(NVERB_DEBUG,'IO','IO_Cleanly_closed_check_nc4', &
'file '//trim(tpfile%cname)//' was cleanly closed before opening')
else if (yclean == 'no') then
- call print_msg(NVERB_ERROR,'IO','io_check_cleanly_closed_nc4', &
+ call print_msg(NVERB_ERROR,'IO','IO_Cleanly_closed_check_nc4', &
'file '//trim(tpfile%cname)//' was not cleanly closed before opening')
else
- call print_msg(NVERB_ERROR,'IO','io_check_cleanly_closed_nc4', &
+ call print_msg(NVERB_ERROR,'IO','IO_Cleanly_closed_check_nc4', &
'invalid MNH_cleanly_closed attribute for file '//trim(tpfile%cname))
end if
end if
end if
-end subroutine io_check_cleanly_closed_nc4
+end subroutine IO_Cleanly_closed_check_nc4
-subroutine io_set_cleanly_closed_nc4(tpfile)
+subroutine IO_Cleanly_closed_set_nc4(tpfile)
type(tfiledata), intent(in) :: tpfile
- integer(kind=IDCDF_KIND) :: istatus
+ integer(kind=CDFINT) :: istatus
- call print_msg(NVERB_DEBUG,'IO','io_set_cleanly_closed_nc4','called for '//trim(tpfile%cname))
+ call print_msg(NVERB_DEBUG,'IO','IO_Cleanly_closed_set_nc4','called for '//trim(tpfile%cname))
istatus = NF90_PUT_ATT(tpfile%nncid, NF90_GLOBAL, 'MNH_cleanly_closed', 'yes')
- if (istatus /= NF90_NOERR) call io_handle_err_nc4(istatus,'io_set_cleanly_closed_nc4','NF90_PUT_ATT','MNH_cleanly_closed')
-end subroutine io_set_cleanly_closed_nc4
+ if (istatus /= NF90_NOERR) call IO_Err_handle_nc4(istatus,'IO_Cleanly_closed_set_nc4','NF90_PUT_ATT','MNH_cleanly_closed')
+end subroutine IO_Cleanly_closed_set_nc4
-subroutine io_set_not_cleanly_closed_nc4(tpfile)
+subroutine IO_Not_cleanly_closed_set_nc4(tpfile)
type(tfiledata), intent(in) :: tpfile
- integer(kind=IDCDF_KIND) :: istatus
+ integer(kind=CDFINT) :: istatus
- call print_msg(NVERB_DEBUG,'IO','io_set_not_cleanly_closed_nc4','called for '//trim(tpfile%cname))
+ call print_msg(NVERB_DEBUG,'IO','IO_Not_cleanly_closed_set_nc4','called for '//trim(tpfile%cname))
istatus = NF90_PUT_ATT(tpfile%nncid, NF90_GLOBAL, 'MNH_cleanly_closed', 'no')
- if (istatus /= NF90_NOERR) call io_handle_err_nc4(istatus,'io_set_not_cleanly_closed_nc4','NF90_PUT_ATT','MNH_cleanly_closed')
-end subroutine io_set_not_cleanly_closed_nc4
+ if (istatus /= NF90_NOERR) call IO_Err_handle_nc4(istatus,'IO_Not_cleanly_closed_set_nc4','NF90_PUT_ATT','MNH_cleanly_closed')
+end subroutine IO_Not_cleanly_closed_set_nc4
end module mode_io_file_nc4
#else
!
! External dummy subroutines
!
-subroutine io_create_file_nc4(a, b)
+subroutine IO_File_create_nc4(a, b)
use mode_msg
integer :: a, b
-CALL PRINT_MSG(NVERB_ERROR,'IO','io_create_file_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
-end subroutine io_create_file_nc4
+CALL PRINT_MSG(NVERB_ERROR,'IO','IO_File_create_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end subroutine IO_File_create_nc4
!
-subroutine io_close_file_nc4(a)
+subroutine IO_File_close_nc4(a)
use mode_msg
integer :: a
-CALL PRINT_MSG(NVERB_ERROR,'IO','io_close_file_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
-end subroutine io_close_file_nc4
+CALL PRINT_MSG(NVERB_ERROR,'IO','IO_File_close_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end subroutine IO_File_close_nc4
!
-subroutine io_open_file_nc4(a)
+subroutine IO_File_open_nc4(a)
use mode_msg
integer :: a
-CALL PRINT_MSG(NVERB_ERROR,'IO','io_open_file_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
-end subroutine io_open_file_nc4
+CALL PRINT_MSG(NVERB_ERROR,'IO','IO_File_open_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end subroutine IO_File_open_nc4
!
#endif
diff --git a/src/LIB/SURCOUCHE/src/mode_io_manage_struct.f90 b/src/LIB/SURCOUCHE/src/mode_io_manage_struct.f90
index 8745773f089fa8ce4b2f61cc5e3890d78cf10d55..4e6bce3f26e7f74836495171a3da9dcab91a5e6b 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_manage_struct.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_manage_struct.f90
@@ -3,26 +3,37 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!! Authors
-!! -------
-!
-! P. Wautelet : 2016: original version
+! Author(s)
+! P. Wautelet 2016
! Modifications:
-! 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 06/02/2019: simplify OPEN_ll and do somme assignments at a more logical place
+! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list
+! 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 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
!-----------------------------------------------------------------
MODULE MODE_IO_MANAGE_STRUCT
!
-USE MODD_IO_ll
+USE MODD_IO
+use modd_precision, only: LFIINT
+!
USE MODE_MSG
!
IMPLICIT NONE
!
+private
+!
+public :: IO_Bakout_struct_prepare, IO_File_add2list, IO_File_find_byname, IO_Filelist_print
+!
CONTAINS
!
!#########################################################################
-SUBROUTINE IO_PREPARE_BAKOUT_STRUCT(KSUP,PTSTEP,PSEGLEN)
+SUBROUTINE IO_Bakout_struct_prepare(KSUP,PTSTEP,PSEGLEN)
!#########################################################################
!
USE MODD_BAKOUT
@@ -56,7 +67,7 @@ INTEGER, DIMENSION(:), ALLOCATABLE :: IBAK_STEP, IOUT_STEP
CHARACTER (LEN=4) :: YDADNUMBER ! Character string for the DAD model file number
!
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_PREPARE_BAKOUT_STRUCT','called')
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Bakout_struct_prepare','called')
!
! Special case if writes are forced to NO
IF (LIO_NO_WRITE) THEN
@@ -177,7 +188,7 @@ DO IMI = 1, NMODEL
ELSE
IERR_LVL = NVERB_ERROR
END IF
- CALL PRINT_MSG(IERR_LVL,'IO','IO_PREPARE_BAKOUT_STRUCT','no (valid) backup time')
+ CALL PRINT_MSG(IERR_LVL,'IO','IO_Bakout_struct_prepare','no (valid) backup time')
END IF
!
IOUT_NUMB = 0
@@ -195,13 +206,13 @@ DO IMI = 1, NMODEL
ALLOCATE(OUT_MODEL(IMI)%TBACKUPN(IBAK_NUMB))
ALLOCATE(OUT_MODEL(IMI)%TOUTPUTN(IOUT_NUMB))
!
- CALL POPULATE_STRUCT(TFILE_FIRST,TFILE_LAST,IBAK_STEP,"BACKUP",OUT_MODEL(IMI)%TBACKUPN)
- CALL POPULATE_STRUCT(TFILE_FIRST,TFILE_LAST,IOUT_STEP,"OUTPUT",OUT_MODEL(IMI)%TOUTPUTN)
+ CALL POPULATE_STRUCT(TFILE_FIRST,TFILE_LAST,IBAK_STEP,"MNHBACKUP",OUT_MODEL(IMI)%TBACKUPN)
+ CALL POPULATE_STRUCT(TFILE_FIRST,TFILE_LAST,IOUT_STEP,"MNHOUTPUT",OUT_MODEL(IMI)%TOUTPUTN)
!
!* Find dad output number
!
!Security check (if it happens, this part of the code should be exported outside of the IMI loop)
- IF (NDAD(IMI)>IMI) CALL PRINT_MSG(NVERB_FATAL,'IO','IO_PREPARE_BAKOUT_STRUCT','NDAD(IMI)>IMI')
+ IF (NDAD(IMI)>IMI) CALL PRINT_MSG(NVERB_FATAL,'IO','IO_Bakout_struct_prepare','NDAD(IMI)>IMI')
IF (NDAD(IMI) == IMI .OR. IMI == 1) THEN
OUT_MODEL(IMI)%TBACKUPN(:)%NOUTDAD = 0
DO IPOS = 1,OUT_MODEL(IMI)%NBAK_NUMB
@@ -257,7 +268,7 @@ 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_PREPARE_BAKOUT_STRUCT','no fields chosen for output')
+ IF (IVAR==0) CALL PRINT_MSG(NVERB_ERROR,'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
@@ -268,7 +279,7 @@ DO IMI = 1, NMODEL
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_PREPARE_BAKOUT_STRUCT','unknown field for output: '//TRIM(COUT_VAR(IMI,IPOS)))
+ 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
!
@@ -285,20 +296,24 @@ DO IMI = 1, NMODEL
DEALLOCATE(IOUT_STEP)
!
IF (IP==1) THEN
- PRINT *,'-------------------------'
+ PRINT *,'-------------------------------'
PRINT *,'Model number: ',IMI
PRINT *,'Number of backups: ',IBAK_NUMB
- PRINT *,'Timestep Time'
- DO JOUT = 1,IBAK_NUMB
- WRITE(*,'( I9,F12.3 )' ) OUT_MODEL(IMI)%TBACKUPN(JOUT)%NSTEP,OUT_MODEL(IMI)%TBACKUPN(JOUT)%XTIME
- END DO
- PRINT *,'-------------------------'
+ if ( ibak_numb > 0 ) then
+ PRINT *,'Timestep Time'
+ DO JOUT = 1,IBAK_NUMB
+ WRITE(*,'( I9,F12.3 )' ) OUT_MODEL(IMI)%TBACKUPN(JOUT)%NSTEP,OUT_MODEL(IMI)%TBACKUPN(JOUT)%XTIME
+ END DO
+ end if
+ PRINT *,'-------------------------------'
PRINT *,'Model number: ',IMI
PRINT *,'Number of outputs: ',IOUT_NUMB
- PRINT *,'Timestep Time'
- DO JOUT = 1,IOUT_NUMB
- WRITE(*,'( I9,F12.3 )' ) OUT_MODEL(IMI)%TOUTPUTN(JOUT)%NSTEP,OUT_MODEL(IMI)%TOUTPUTN(JOUT)%XTIME
- END DO
+ if ( iout_numb > 0 ) then
+ PRINT *,'Timestep Time'
+ DO JOUT = 1,IOUT_NUMB
+ WRITE(*,'( I9,F12.3 )' ) OUT_MODEL(IMI)%TOUTPUTN(JOUT)%NSTEP,OUT_MODEL(IMI)%TOUTPUTN(JOUT)%XTIME
+ END DO
+ end if
!
IF (IOUT_NUMB>0) THEN
PRINT *,'Field list:'
@@ -308,7 +323,7 @@ DO IMI = 1, NMODEL
END DO
END IF
!
- PRINT *,'-------------------------'
+ PRINT *,'-------------------------------'
END IF
!
END DO ! IMI=1,NMODEL
@@ -529,7 +544,7 @@ SUBROUTINE POPULATE_STRUCT(TPFILE_FIRST,TPFILE_LAST,KSTEPS,HFILETYPE,TPBAKOUTN)
TPBAKOUTN(IPOS)%TFILE%CTYPE=HFILETYPE
TPBAKOUTN(IPOS)%TFILE%CMODE="WRITE"
WRITE (YNUMBER,FMT="(I3.3)") IPOS
- IF (TRIM(HFILETYPE)=='OUTPUT') THEN
+ IF (TRIM(HFILETYPE)=='MNHOUTPUT') THEN
! Add a "OUT" suffix for output files
TPBAKOUTN(IPOS)%TFILE%CNAME=ADJUSTL(ADJUSTR(IO_SURF_MNH_MODEL(IMI)%COUTFILE)//'.OUT.'//YNUMBER)
!Reduce the float precision if asked
@@ -547,7 +562,7 @@ SUBROUTINE POPULATE_STRUCT(TPFILE_FIRST,TPFILE_LAST,KSTEPS,HFILETYPE,TPBAKOUTN)
ELSE IF (LEN_TRIM(CIO_DIR)>0) THEN
TPBAKOUTN(IPOS)%TFILE%CDIRNAME=TRIM(CIO_DIR)
END IF
- ELSE IF (TRIM(HFILETYPE)=='BACKUP') THEN
+ ELSE IF (TRIM(HFILETYPE)=='MNHBACKUP') THEN
TPBAKOUTN(IPOS)%TFILE%CNAME=ADJUSTL(ADJUSTR(IO_SURF_MNH_MODEL(IMI)%COUTFILE)//'.'//YNUMBER)
IF (LEN_TRIM(CBAK_DIR)>0) THEN
TPBAKOUTN(IPOS)%TFILE%CDIRNAME=TRIM(CBAK_DIR)
@@ -557,7 +572,7 @@ SUBROUTINE POPULATE_STRUCT(TPFILE_FIRST,TPFILE_LAST,KSTEPS,HFILETYPE,TPBAKOUTN)
ELSE
CALL PRINT_MSG(NVERB_FATAL,'IO','POPULATE_STRUCT','unknown filetype ('//TRIM(HFILETYPE)//')')
ENDIF
- TPBAKOUTN(IPOS)%TFILE%NLFITYPE=1 !1: to be transfered
+ TPBAKOUTN(IPOS)%TFILE%NLFITYPE=1 !1: to be transferred
!PW: TODO: set NLFIVERB only when useful (only if LFI file...)
TPBAKOUTN(IPOS)%TFILE%NLFIVERB=NVERB
IF (LIOCDF4) THEN
@@ -565,19 +580,19 @@ SUBROUTINE POPULATE_STRUCT(TPFILE_FIRST,TPFILE_LAST,KSTEPS,HFILETYPE,TPBAKOUTN)
TPBAKOUTN(IPOS)%TFILE%CFORMAT='NETCDF4'
ELSE
TPBAKOUTN(IPOS)%TFILE%CFORMAT='LFICDF4'
- IF (TRIM(HFILETYPE)=='BACKUP') TPBAKOUTN(IPOS)%TFILE%NLFINPRAR= 22+2*(4+NRR+NSV)
+ IF (TRIM(HFILETYPE)=='MNHBACKUP') TPBAKOUTN(IPOS)%TFILE%NLFINPRAR= 22+2*(4+NRR+NSV)
END IF
ELSE IF (LLFIOUT) THEN
TPBAKOUTN(IPOS)%TFILE%CFORMAT='LFI'
- IF (TRIM(HFILETYPE)=='BACKUP') TPBAKOUTN(IPOS)%TFILE%NLFINPRAR= 22+2*(4+NRR+NSV)
+ IF (TRIM(HFILETYPE)=='MNHBACKUP') TPBAKOUTN(IPOS)%TFILE%NLFINPRAR= 22+2*(4+NRR+NSV)
ELSE
CALL PRINT_MSG(NVERB_FATAL,'IO','POPULATE_STRUCT','unknown backup/output fileformat')
ENDIF
!
!Create file structures if Z-splitted files
IF (NB_PROCIO_W>1) THEN
+ TPBAKOUTN(IPOS)%TFILE%NSUBFILES_IOZ = NB_PROCIO_W
ALLOCATE(TPBAKOUTN(IPOS)%TFILE%TFILES_IOZ(NB_PROCIO_W))
-! ALLOCATE(TPBAKOUTN(IPOS)%TFILE_IOZ(NB_PROCIO_W))
IF (NB_PROCIO_W>999) THEN
CALL PRINT_MSG(NVERB_FATAL,'IO','POPULATE_STRUCT','more than 999 z-levels')
END IF
@@ -592,7 +607,7 @@ SUBROUTINE POPULATE_STRUCT(TPFILE_FIRST,TPFILE_LAST,KSTEPS,HFILETYPE,TPBAKOUTN)
TPBAKOUTN(IPOS)%TFILE%TFILES_IOZ(JI)%TFILE%CNAME = TRIM(TPBAKOUTN(IPOS)%TFILE%CNAME)//'.Z'//YNUMBER
IF(ALLOCATED(TPBAKOUTN(IPOS)%TFILE%CDIRNAME)) &
TPBAKOUTN(IPOS)%TFILE%TFILES_IOZ(JI)%TFILE%CDIRNAME = TRIM(TPBAKOUTN(IPOS)%TFILE%CDIRNAME)
- IF (TRIM(HFILETYPE)=='OUTPUT') THEN
+ IF (TRIM(HFILETYPE)=='MNHOUTPUT') THEN
!Reduce the float precision if asked
TPBAKOUTN(IPOS)%TFILE%TFILES_IOZ(JI)%TFILE%LNCREDUCE_FLOAT_PRECISION = LOUT_REDUCE_FLOAT_PRECISION(IMI)
!Set compression if asked
@@ -603,7 +618,7 @@ SUBROUTINE POPULATE_STRUCT(TPFILE_FIRST,TPFILE_LAST,KSTEPS,HFILETYPE,TPBAKOUTN)
END IF
TPBAKOUTN(IPOS)%TFILE%TFILES_IOZ(JI)%TFILE%NNCCOMPRESS_LEVEL = NOUT_COMPRESS_LEVEL(IMI)
END IF
- TPBAKOUTN(IPOS)%TFILE%TFILES_IOZ(JI)%TFILE%NLFITYPE=1 !1: to be transfered
+ TPBAKOUTN(IPOS)%TFILE%TFILES_IOZ(JI)%TFILE%NLFITYPE=1 !1: to be transferred
!PW: TODO: set NLFIVERB only when useful (only if LFI file...)
TPBAKOUTN(IPOS)%TFILE%TFILES_IOZ(JI)%TFILE%NLFIVERB=NVERB
IF (LIOCDF4) THEN
@@ -618,6 +633,7 @@ SUBROUTINE POPULATE_STRUCT(TPFILE_FIRST,TPFILE_LAST,KSTEPS,HFILETYPE,TPBAKOUTN)
ELSE
CALL PRINT_MSG(NVERB_FATAL,'IO','POPULATE_STRUCT','unknown backup/output fileformat')
ENDIF
+ TPBAKOUTN(IPOS)%TFILE%TFILES_IOZ(JI)%TFILE%TMAINFILE => TPBAKOUTN(IPOS)%TFILE
END DO
END IF
!
@@ -625,15 +641,16 @@ SUBROUTINE POPULATE_STRUCT(TPFILE_FIRST,TPFILE_LAST,KSTEPS,HFILETYPE,TPBAKOUTN)
END DO
END SUBROUTINE POPULATE_STRUCT
!
-END SUBROUTINE IO_PREPARE_BAKOUT_STRUCT
+END SUBROUTINE IO_Bakout_struct_prepare
!
-SUBROUTINE IO_FILE_ADD2LIST(TPFILE,HNAME,HTYPE,HMODE, &
+SUBROUTINE IO_File_add2list(TPFILE,HNAME,HTYPE,HMODE, &
HFORM,HACCESS,HFORMAT,HDIRNAME, &
KLFINPRAR,KLFITYPE,KLFIVERB,KRECL,KMODEL, &
- TPDADFILE,TPDATAFILE,OOLD)
+ TPDADFILE,TPDATAFILE,OOLD,OSPLIT_IOZ)
!
USE MODD_BAKOUT, ONLY: LOUT_COMPRESS,LOUT_REDUCE_FLOAT_PRECISION,NOUT_COMPRESS_LEVEL
USE MODD_CONF, ONLY: CPROGRAM
+use modd_confz, only: nb_procio_r,nb_procio_w
!
USE MODE_MODELN_HANDLER, ONLY: GET_CURRENT_MODEL_INDEX
!
@@ -642,10 +659,10 @@ CHARACTER(LEN=*), INTENT(IN) :: HNAME !Filename
CHARACTER(LEN=*), INTENT(IN) :: HTYPE !Filetype (backup, output, prepidealcase...)
CHARACTER(LEN=*), INTENT(IN) :: HMODE !Opening mode (read, write...)
CHARACTER(LEN=*), OPTIONAL,INTENT(IN) :: HFORM !Formatted/unformatted
-CHARACTER(LEN=*), OPTIONAL,INTENT(IN) :: HACCESS !Direct/sequential
+CHARACTER(LEN=*), OPTIONAL,INTENT(IN) :: HACCESS !Direct/sequential/stream
CHARACTER(LEN=*), OPTIONAL,INTENT(IN) :: HFORMAT !Fileformat (NETCDF4, LFI, LFICDF4...)
CHARACTER(LEN=*), OPTIONAL,INTENT(IN) :: HDIRNAME !File directory
-INTEGER(KIND=LFI_INT), OPTIONAL,INTENT(IN) :: KLFINPRAR !Number of predicted articles of the LFI file (non crucial)
+INTEGER(KIND=LFIINT), OPTIONAL,INTENT(IN) :: KLFINPRAR !Number of predicted articles of the LFI file (non crucial)
INTEGER, OPTIONAL,INTENT(IN) :: KLFITYPE !Type of the file (used to generate list of files to transfers)
INTEGER, OPTIONAL,INTENT(IN) :: KLFIVERB !LFI verbosity level
INTEGER, OPTIONAL,INTENT(IN) :: KRECL !Record length
@@ -655,14 +672,18 @@ TYPE(TFILEDATA),POINTER,OPTIONAL,INTENT(IN) :: TPDATAFILE!Corresponding data
LOGICAL, OPTIONAL,INTENT(IN) :: OOLD !FALSE if new file (should not be found)
!TRUE if the file could already be in the list
! (add it only if not yet present)
+logical, optional,intent(in) :: osplit_ioz !Is the file split vertically
!
INTEGER :: IMI,IRESP
-INTEGER(KIND=LFI_INT) :: ILFINPRAR
+INTEGER(KIND=LFIINT) :: ILFINPRAR
INTEGER :: ILFITYPE
INTEGER :: ILFIVERB
LOGICAL :: GOLD
+logical :: gsplit_ioz
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_FILE_ADD2LIST','called for '//TRIM(HNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_File_add2list','called for '//TRIM(HNAME))
+!
+IMI = GET_CURRENT_MODEL_INDEX()
!
IF (PRESENT(OOLD)) THEN
GOLD = OOLD
@@ -672,59 +693,57 @@ END IF
!
IF (ASSOCIATED(TPFILE)) THEN
IF (GOLD) THEN
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_FILE_ADD2LIST','file '//TRIM(HNAME)//' already associated. Pointer will be overwritten')
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_File_add2list','file '//TRIM(HNAME)//' already associated. Pointer will be overwritten')
TPFILE => NULL()
ELSE
- CALL PRINT_MSG(NVERB_FATAL,'IO','IO_FILE_ADD2LIST','file '//TRIM(HNAME)//' already associated')
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_File_add2list','file '//TRIM(HNAME)//' already associated')
END IF
END IF
!
-CALL IO_FILE_FIND_BYNAME(HNAME,TPFILE,IRESP,OOLD=GOLD)
+CALL IO_File_find_byname(HNAME,TPFILE,IRESP,OOLD=GOLD)
IF (IRESP==0) THEN
!File has been found
!Check if really same one (LFI vs netCDF)
IF (PRESENT(HFORMAT)) THEN
IF ( (HFORMAT=='LFI' .AND. TPFILE%CFORMAT/='NETCDF4') .OR. (HFORMAT=='NETCDF4' .AND. TPFILE%CFORMAT/='LFI') ) THEN
- CALL PRINT_MSG(NVERB_FATAL,'IO','IO_FILE_ADD2LIST','file '//TRIM(HNAME)//' already in filelist')
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_File_add2list','file '//TRIM(HNAME)//' already in filelist')
END IF
ELSE
IF (.NOT.GOLD) THEN
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_ADD2LIST','file '//TRIM(HNAME)//' already in filelist')
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_File_add2list','file '//TRIM(HNAME)//' already in filelist')
ELSE
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_FILE_ADD2LIST','file '//TRIM(HNAME)//' already in filelist (not unexpected)')
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_File_add2list','file '//TRIM(HNAME)//' already in filelist (not unexpected)')
END IF
RETURN
END IF
END IF
!
-IMI = GET_CURRENT_MODEL_INDEX()
-!
IF( PRESENT(HFORM) .AND. TRIM(HTYPE)/='SURFACE_DATA') &
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_FILE_ADD2LIST','optional argument HFORM is not used by '//TRIM(HTYPE)//' files')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_File_add2list','optional argument HFORM is not used by '//TRIM(HTYPE)//' files')
IF(.NOT.PRESENT(HFORM) .AND. TRIM(HTYPE)=='SURFACE_DATA') &
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_ADD2LIST','optional argument HFORM is necessary for '//TRIM(HTYPE)//' files')
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_File_add2list','optional argument HFORM is necessary for '//TRIM(HTYPE)//' files')
IF(PRESENT(HFORM)) THEN
IF(HFORM/='FORMATTED' .AND. HFORM/='UNFORMATTED') &
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_ADD2LIST','HFORM should be FORMATTED or UNFORMATTED and not '//TRIM(HFORM))
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_File_add2list','HFORM should be FORMATTED or UNFORMATTED and not '//TRIM(HFORM))
END IF
!
IF( PRESENT(HACCESS) .AND. TRIM(HTYPE)/='SURFACE_DATA') &
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_FILE_ADD2LIST','optional argument HACCESS is not used by '//TRIM(HTYPE)//' files')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_File_add2list','optional argument HACCESS is not used by '//TRIM(HTYPE)//' files')
IF(.NOT.PRESENT(HACCESS) .AND. TRIM(HTYPE)=='SURFACE_DATA') &
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_ADD2LIST','optional argument HACCESS is necessary for '//TRIM(HTYPE)//' files')
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_File_add2list','optional argument HACCESS is necessary for '//TRIM(HTYPE)//' files')
IF(PRESENT(HACCESS)) THEN
- IF(HACCESS/='DIRECT' .AND. HACCESS/='SEQUENTIAL') &
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_ADD2LIST','HACCESS should be DIRECT or SEQUENTIAL and not '//TRIM(HACCESS))
+ IF(HACCESS/='DIRECT' .AND. HACCESS/='SEQUENTIAL' .AND. HACCESS/='STREAM') &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_File_add2list','HACCESS should be DIRECT, SEQUENTIAL or STREAM and not '//TRIM(HACCESS))
END IF
!
IF (PRESENT(HFORMAT)) THEN
IF(CPROGRAM=='LFICDF') THEN
IF (HFORMAT/='LFI' .AND. HFORMAT/='NETCDF4') &
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_ADD2LIST','invalid HFORMAT ('//TRIM(HFORMAT)//')')
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_File_add2list','invalid HFORMAT ('//TRIM(HFORMAT)//')')
END IF
ELSE
IF(CPROGRAM=='LFICDF') &
- CALL PRINT_MSG(NVERB_FATAL,'IO','IO_FILE_ADD2LIST','optional argument HFORMAT is necessary for CPROGRAM='//TRIM(CPROGRAM))
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_File_add2list','optional argument HFORMAT is necessary for CPROGRAM='//TRIM(CPROGRAM))
END IF
!
IF(PRESENT(KLFINPRAR)) THEN
@@ -746,15 +765,15 @@ ELSE
END IF
!
IF( PRESENT(KRECL) .AND. TRIM(HTYPE)/='SURFACE_DATA' .AND. TRIM(HTYPE)/='TXT') &
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_FILE_ADD2LIST','optional argument KRECL is not used by '//TRIM(HTYPE)//' files')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_File_add2list','optional argument KRECL is not used by '//TRIM(HTYPE)//' files')
IF(.NOT.PRESENT(KRECL) .AND. TRIM(HTYPE)=='SURFACE_DATA') THEN
IF(TRIM(HACCESS)=='DIRECT') &
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_ADD2LIST','optional argument KRECL is necessary for '//TRIM(HTYPE)// &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_File_add2list','optional argument KRECL is necessary for '//TRIM(HTYPE)// &
' files in DIRECT access')
END IF
!
IF (PRESENT(TPDATAFILE) .AND. TRIM(HTYPE)/='DES') &
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_FILE_ADD2LIST','optional argument TPDATAFILE is not used by '//TRIM(HTYPE)//' files')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_File_add2list','optional argument TPDATAFILE is not used by '//TRIM(HTYPE)//' files')
!
IF (.NOT.ASSOCIATED(TFILE_LAST)) THEN
ALLOCATE(TFILE_LAST)
@@ -775,38 +794,70 @@ IF (PRESENT(HDIRNAME)) THEN
END IF
!
IF (TRIM(HMODE)/='READ' .AND. TRIM(HMODE)/='WRITE') THEN
- CALL PRINT_MSG(NVERB_FATAL,'IO','IO_FILE_ADD2LIST','unknown mode ('//TRIM(HMODE)//') for file '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_File_add2list','unknown mode ('//TRIM(HMODE)//') for file '//TRIM(HNAME))
END IF
!
TPFILE%CMODE = HMODE
!
+if ( present(osplit_ioz) ) then
+ gsplit_ioz = osplit_ioz
+else
+ gsplit_ioz = .false.
+ if ( len_trim(htype) >= 3 ) then
+ if ( htype(1:3) == 'MNH' ) then
+ ! MNH/MNHBACKUP/MNHOUTPUT
+ !Remark: 'MNH' is more general than MNHBACKUP and could be in fact a MNHBACKUP file
+ gsplit_ioz = .true.
+ end if
+ end if
+end if
+
+if ( gsplit_ioz ) then
+ select case (hmode)
+ case('READ')
+ tpfile%nsubfiles_ioz = nb_procio_r
+ case('WRITE')
+ tpfile%nsubfiles_ioz = nb_procio_w
+ end select
+ if (tpfile%nsubfiles_ioz == 1) tpfile%nsubfiles_ioz = 0
+else
+ tpfile%nsubfiles_ioz = 0
+end if
+
SELECT CASE(TPFILE%CTYPE)
!Chemistry input files
CASE('CHEMINPUT')
IF (TRIM(HMODE)/='READ') & !Invalid because not (yet) necessary
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_ADD2LIST','invalid mode '//TRIM(HMODE)//' for file '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_File_add2list','invalid mode '//TRIM(HMODE)//' for file '//TRIM(HNAME))
+ TPFILE%CACCESS = 'SEQUENTIAL'
+ TPFILE%CFORM = 'FORMATTED'
TPFILE%CFORMAT = 'TEXT'
!Chemistry tabulation files
CASE('CHEMTAB')
IF (TRIM(HMODE)/='READ') & !Invalid because not (yet) necessary
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_ADD2LIST','invalid mode '//TRIM(HMODE)//' for file '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_File_add2list','invalid mode '//TRIM(HMODE)//' for file '//TRIM(HNAME))
+ TPFILE%CACCESS = 'SEQUENTIAL'
+ TPFILE%CFORM = 'FORMATTED'
TPFILE%CFORMAT = 'TEXT'
!DES files
CASE('DES')
+ TPFILE%CACCESS = 'SEQUENTIAL'
+ TPFILE%CFORM = 'FORMATTED'
TPFILE%CFORMAT = 'TEXT'
+ TPFILE%NRECL = 8*1024
IF (.NOT.PRESENT(TPDATAFILE)) THEN
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_ADD2LIST','missing TPDATAFILE argument for DES file '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_File_add2list','missing TPDATAFILE argument for DES file '//TRIM(HNAME))
ELSE
IF (.NOT.ASSOCIATED(TPDATAFILE)) &
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_ADD2LIST','TPDATAFILE is not associated for DES file '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_File_add2list','TPDATAFILE is not associated for DES file '//TRIM(HNAME))
TPFILE%TDATAFILE => TPDATAFILE
TPDATAFILE%TDESFILE => TPFILE
IF (PRESENT(HDIRNAME)) &
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_FILE_ADD2LIST','HDIRNAME argument ignored for DES file '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_File_add2list','HDIRNAME argument ignored for DES file '//TRIM(HNAME))
IF (ALLOCATED(TPDATAFILE%CDIRNAME)) TPFILE%CDIRNAME = TPDATAFILE%CDIRNAME
END IF
@@ -814,48 +865,61 @@ SELECT CASE(TPFILE%CTYPE)
!GPS files
CASE('GPS')
IF (TRIM(HMODE)/='WRITE') & !Invalid because not (yet) necessary
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_ADD2LIST','invalid mode '//TRIM(HMODE)//' for file '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_File_add2list','invalid mode '//TRIM(HMODE)//' for file '//TRIM(HNAME))
+ TPFILE%CACCESS = 'SEQUENTIAL'
+ TPFILE%CFORM = 'FORMATTED'
TPFILE%CFORMAT = 'TEXT'
!Meteo files
CASE('METEO')
IF (TRIM(HMODE)/='WRITE') & !Invalid because not (yet) necessary
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_ADD2LIST','invalid mode '//TRIM(HMODE)//' for file '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_File_add2list','invalid mode '//TRIM(HMODE)//' for file '//TRIM(HNAME))
+ TPFILE%CACCESS = 'SEQUENTIAL'
+ TPFILE%CFORM = 'UNFORMATTED'
TPFILE%CFORMAT = 'BINARY'
+ TPFILE%NRECL = 100000000
!Namelist files
CASE('NML')
IF (TRIM(HMODE)/='READ') & !Invalid because not (yet) necessary
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_ADD2LIST','invalid mode '//TRIM(HMODE)//' for file '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_File_add2list','invalid mode '//TRIM(HMODE)//' for file '//TRIM(HNAME))
+ TPFILE%CACCESS = 'SEQUENTIAL'
+ TPFILE%CFORM = 'FORMATTED'
TPFILE%CFORMAT = 'TEXT'
!OUTPUTLISTING files
CASE('OUTPUTLISTING')
IF (TRIM(HMODE)/='WRITE') & !Invalid because not (yet) necessary
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_ADD2LIST','invalid mode '//TRIM(HMODE)//' for file '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_File_add2list','invalid mode '//TRIM(HMODE)//' for file '//TRIM(HNAME))
+ TPFILE%CACCESS = 'SEQUENTIAL'
+ TPFILE%CFORM = 'FORMATTED'
TPFILE%CFORMAT = 'TEXT'
!SURFACE_DATA files
CASE('SURFACE_DATA')
IF (TRIM(HMODE)/='READ') & !Invalid because not (yet) necessary
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_ADD2LIST','invalid mode '//TRIM(HMODE)//' for file '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_File_add2list','invalid mode '//TRIM(HMODE)//' for file '//TRIM(HNAME))
TPFILE%CFORMAT = 'SURFACE_DATA'
TPFILE%CFORM = HFORM
TPFILE%CACCESS = HACCESS
- IF(TRIM(HACCESS)=='DIRECT') TPFILE%NRECL = KRECL
+ IF(TRIM(HACCESS)=='DIRECT') TPFILE%NRECL = KRECL
!Text files
CASE('TXT')
+ TPFILE%CACCESS = 'SEQUENTIAL'
+ TPFILE%CFORM = 'FORMATTED'
TPFILE%CFORMAT = 'TEXT'
IF(PRESENT(KRECL)) TPFILE%NRECL = KRECL
- CASE DEFAULT
+ !MesoNH files
+ !Remark: 'MNH' is more general than MNHBACKUP and could be in fact a MNHBACKUP file
+ CASE ('MNH', 'MNHBACKUP', 'MNHDIACHRONIC', 'MNHDIAG', 'MNHOUTPUT', 'PGD')
IF (TRIM(HMODE)=='READ') THEN
IF (PRESENT(HFORMAT)) THEN
TPFILE%CFORMAT = TRIM(HFORMAT)
@@ -865,7 +929,7 @@ SELECT CASE(TPFILE%CTYPE)
ELSE IF (LIOCDF4) THEN
TPFILE%CFORMAT = 'NETCDF4'
ELSE
- CALL PRINT_MSG(NVERB_FATAL,'IO','IO_FILE_ADD2LIST','invalid format for file '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_File_add2list','invalid format for file '//TRIM(HNAME))
END IF
ELSE IF (TRIM(HMODE)=='WRITE') THEN
IF (PRESENT(HFORMAT)) THEN
@@ -879,7 +943,7 @@ SELECT CASE(TPFILE%CTYPE)
TPFILE%CFORMAT = 'LFI'
TPFILE%NLFINPRAR = ILFINPRAR
ELSE
- CALL PRINT_MSG(NVERB_FATAL,'IO','IO_FILE_ADD2LIST','invalid format for file '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_File_add2list','invalid format for file '//TRIM(HNAME))
END IF
END IF
!
@@ -893,12 +957,16 @@ SELECT CASE(TPFILE%CTYPE)
END IF
!
IF(PRESENT(TPDADFILE)) THEN
- IF (.NOT.ASSOCIATED(TPDADFILE)) CALL PRINT_MSG(NVERB_WARNING,'IO','IO_FILE_ADD2LIST', &
+ IF (.NOT.ASSOCIATED(TPDADFILE)) CALL PRINT_MSG(NVERB_WARNING,'IO','IO_File_add2list', &
'TPDADFILE provided but not associated for file '//TRIM(HNAME))
TPFILE%TDADFILE => TPDADFILE
ELSE
TPFILE%TDADFILE => NULL()
END IF
+
+
+ CASE default
+ call print_msg(NVERB_FATAL,'IO','IO_File_add2list','invalid type '//trim(tpfile%ctype)//' for file '//trim(hname))
END SELECT
!
IF(PRESENT(KMODEL)) TPFILE%NMODEL = KMODEL
@@ -907,9 +975,9 @@ TPFILE%LOPENED = .FALSE.
TPFILE%NOPEN = 0
TPFILE%NCLOSE = 0
!
-END SUBROUTINE IO_FILE_ADD2LIST
+END SUBROUTINE IO_File_add2list
!
-SUBROUTINE IO_FILE_FIND_BYNAME(HNAME,TPFILE,KRESP,OOLD)
+SUBROUTINE IO_File_find_byname(HNAME,TPFILE,KRESP,OOLD)
!
USE MODD_PARAMETERS, ONLY: NFILENAMELGTMAX
!
@@ -922,7 +990,7 @@ LOGICAL, OPTIONAL, INTENT(IN) :: OOLD ! FALSE if new file (should not be
TYPE(TFILEDATA),POINTER :: TZFILE ! File structure
LOGICAL :: GOLD
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_FILE_FIND_BYNAME','looking for '//TRIM(HNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_File_find_byname','looking for '//TRIM(HNAME))
!
NULLIFY(TPFILE)
KRESP = 0
@@ -934,10 +1002,10 @@ ELSE
END IF
!
IF (LEN_TRIM(HNAME)>NFILENAMELGTMAX) &
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_FILE_FIND_BYNAME','HNAME length is bigger than NFILENAMELGTMAX for '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_File_find_byname','HNAME length is bigger than NFILENAMELGTMAX for '//TRIM(HNAME))
!
IF (.NOT.ASSOCIATED(TFILE_FIRST)) THEN
- IF (GOLD) CALL PRINT_MSG(NVERB_WARNING,'IO','IO_FILE_FIND_BYNAME','filelist is empty')
+ IF (GOLD) CALL PRINT_MSG(NVERB_WARNING,'IO','IO_File_find_byname','filelist is empty')
ELSE
!
TZFILE => TFILE_FIRST
@@ -953,19 +1021,19 @@ ELSE
END IF
!
IF (.NOT.ASSOCIATED(TPFILE)) THEN
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_FILE_FIND_BYNAME','file '//TRIM(HNAME)//' not found in list')
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_File_find_byname','file '//TRIM(HNAME)//' not found in list')
KRESP = -1 !File not found
ELSE
IF (GOLD) THEN
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_FILE_FIND_BYNAME',TRIM(HNAME)//' was found')
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_File_find_byname',TRIM(HNAME)//' was found')
ELSE !File should not be found
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_FILE_FIND_BYNAME',TRIM(HNAME)//' was found (unexpected)')
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_File_find_byname',TRIM(HNAME)//' was found (unexpected)')
END IF
END IF
!
-END SUBROUTINE IO_FILE_FIND_BYNAME
+END SUBROUTINE IO_File_find_byname
!
-SUBROUTINE IO_FILE_PRINT_LIST(TPFILE_FIRST)
+SUBROUTINE IO_Filelist_print(TPFILE_FIRST)
!
USE MODD_VAR_ll, ONLY : IP
!
@@ -975,7 +1043,7 @@ TYPE(TFILEDATA),POINTER :: TZFILE ! File structure
!
IF (IP/=1 .AND. .NOT.LVERB_ALLPRC) RETURN
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_FILE_PRINT_LIST','called')
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Filelist_print','called')
!
IF (PRESENT(TPFILE_FIRST)) THEN
IF (.NOT.ASSOCIATED(TPFILE_FIRST)) RETURN
@@ -985,22 +1053,25 @@ ELSE
TZFILE => TFILE_FIRST
END IF
!
-WRITE (*,'( /,A28," ",A13," ",A7," ",A7," ",A7," ",A7," ",A6," ",A6," ",A5," ",A6," ",A13)' ) 'CNAME ', &
- 'CTYPE ','CFORMAT','CMODE ','LOPENED','NLFIFLU','NNCID','NLU','NOPEN','NCLOSE','NOPEN_CURRENT'
+WRITE (*,'( /,A28," ",A13," ",A7," ",A7," ",A7," ",A7," ",A6," ",A6," ",A5," ",A6," ",A13," ",A13)' ) &
+ 'CNAME ', &
+ 'CTYPE ','CFORMAT','CMODE ','LOPENED','NLFIFLU','NNCID','NLU','NOPEN','NCLOSE','NOPEN_CURRENT','NSUBFILES_IOZ'
WRITE (*,'( A,A )') '--------------------------------------------------------------------------------------------------------', &
- '-----------'
-WRITE (*,'(A28," ",A13," ",A7," ",A7," ",L7," ",I7," ",I6," ",I6," ",I5," ",I6," ",I13)' ) &
+ '------------------------'
+WRITE (*,'(A28," ",A13," ",A7," ",A7," ",L7," ",I7," ",I6," ",I6," ",I5," ",I6," ",I13," ",I13)' ) &
TZFILE%CNAME,TZFILE%CTYPE,TZFILE%CFORMAT,&
- TZFILE%CMODE,TZFILE%LOPENED,TZFILE%NLFIFLU,TZFILE%NNCID,TZFILE%NLU,TZFILE%NOPEN,TZFILE%NCLOSE,TZFILE%NOPEN_CURRENT
+ TZFILE%CMODE,TZFILE%LOPENED,TZFILE%NLFIFLU,TZFILE%NNCID,TZFILE%NLU,TZFILE%NOPEN,TZFILE%NCLOSE,TZFILE%NOPEN_CURRENT,&
+ TZFILE%NSUBFILES_IOZ
!
DO WHILE (ASSOCIATED(TZFILE%TFILE_NEXT))
TZFILE => TZFILE%TFILE_NEXT
- WRITE (*,'(A28," ",A13," ",A7," ",A7," ",L7," ",I7," ",I6," ",I6," ",I5," ",I6," ",I13)' ) &
+ WRITE (*,'(A28," ",A13," ",A7," ",A7," ",L7," ",I7," ",I6," ",I6," ",I5," ",I6," ",I13," ",I13)' ) &
TZFILE%CNAME,TZFILE%CTYPE,TZFILE%CFORMAT,&
- TZFILE%CMODE,TZFILE%LOPENED,TZFILE%NLFIFLU,TZFILE%NNCID,TZFILE%NLU,TZFILE%NOPEN,TZFILE%NCLOSE,TZFILE%NOPEN_CURRENT
+ TZFILE%CMODE,TZFILE%LOPENED,TZFILE%NLFIFLU,TZFILE%NNCID,TZFILE%NLU,TZFILE%NOPEN,TZFILE%NCLOSE,TZFILE%NOPEN_CURRENT,&
+ TZFILE%NSUBFILES_IOZ
END DO
WRITE (*,'(/)')
!
-END SUBROUTINE IO_FILE_PRINT_LIST
+END SUBROUTINE IO_Filelist_print
!
END MODULE MODE_IO_MANAGE_STRUCT
diff --git a/src/LIB/SURCOUCHE/src/mode_io_read_lfi.f90 b/src/LIB/SURCOUCHE/src/mode_io_read_lfi.f90
index 91e4e003121e20e44b39b5fa3ef2a067a4ccea8c..525930eefaaacc6ab5082f76e814085488220ca2 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_read_lfi.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_read_lfi.f90
@@ -1,16 +1,20 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 mode_io_read_lfi
! Modifications:
-! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! Philippe Wautelet: 21/06/2018: read and write correctly if MNH_REAL=4
-! Philippe Wautelet: 14/12/2018: split fmreadwrit.f90
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 21/06/2018: read and write correctly if MNH_REAL=4
+! P. Wautelet 14/12/2018: split fmreadwrit.f90
+! P. Wautelet 21/02/2019: bugfix: intent of read fields: OUT->INOUT to keep initial value if not found in file
+! P. Wautelet 05/03/2019: rename IO subroutines and modules
+!-----------------------------------------------------------------
+module mode_io_read_lfi
!
-USE MODD_IO_ll
+USE MODD_IO
USE MODD_PARAMETERS, ONLY: NLFIMAXCOMMENTLENGTH
+use modd_precision, only: LFIINT
!
USE MODE_FIELD, ONLY : TFIELDDATA
USE MODE_MSG
@@ -19,26 +23,26 @@ IMPLICIT NONE
!
PRIVATE
!
+public :: IO_Field_read_lfi
+!
INTEGER, PARAMETER :: JPXKRK = NLFIMAXCOMMENTLENGTH
INTEGER, PARAMETER :: JPXFIE = 1.5E8
!
-INTERFACE IO_READ_FIELD_LFI
- MODULE PROCEDURE IO_READ_FIELD_LFI_X0, IO_READ_FIELD_LFI_X1, &
- IO_READ_FIELD_LFI_X2, IO_READ_FIELD_LFI_X3, &
- IO_READ_FIELD_LFI_X4, IO_READ_FIELD_LFI_X5, &
- IO_READ_FIELD_LFI_X6, &
- IO_READ_FIELD_LFI_N0, IO_READ_FIELD_LFI_N1, &
- IO_READ_FIELD_LFI_N2, &
- IO_READ_FIELD_LFI_L0, IO_READ_FIELD_LFI_L1, &
- IO_READ_FIELD_LFI_C0, &
- IO_READ_FIELD_LFI_T0
-END INTERFACE IO_READ_FIELD_LFI
-!
-PUBLIC IO_READ_FIELD_LFI
+INTERFACE IO_Field_read_lfi
+ MODULE PROCEDURE IO_Field_read_lfi_X0, IO_Field_read_lfi_X1, &
+ IO_Field_read_lfi_X2, IO_Field_read_lfi_X3, &
+ IO_Field_read_lfi_X4, IO_Field_read_lfi_X5, &
+ IO_Field_read_lfi_X6, &
+ IO_Field_read_lfi_N0, IO_Field_read_lfi_N1, &
+ IO_Field_read_lfi_N2, &
+ IO_Field_read_lfi_L0, IO_Field_read_lfi_L1, &
+ IO_Field_read_lfi_C0, &
+ IO_Field_read_lfi_T0
+END INTERFACE IO_Field_read_lfi
!
CONTAINS
!
-SUBROUTINE IO_READ_FIELD_LFI_X0(TPFILE,TPFIELD,PFIELD,KRESP)
+SUBROUTINE IO_Field_read_lfi_X0(TPFILE,TPFIELD,PFIELD,KRESP)
USE MODE_MSG
!
IMPLICIT NONE
@@ -47,22 +51,22 @@ IMPLICIT NONE
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-REAL, INTENT(OUT) :: PFIELD ! array containing the data field
+REAL, INTENT(INOUT) :: PFIELD ! array containing the data field
INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured
!
!* 0.2 Declarations of local variables
!
-INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL
+INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
INTEGER :: ILENG
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
LOGICAL :: GGOOD
REAL,DIMENSION(1) :: ZFIELD
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_X0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_X0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
ILENG = 1
!
-CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
+CALL IO_Field_read_check_lfi(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
!
IF (GGOOD) THEN
!TRANSFER_I8_R works with 1D arrays
@@ -74,10 +78,10 @@ KRESP=IRESP
!
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
-END SUBROUTINE IO_READ_FIELD_LFI_X0
+END SUBROUTINE IO_Field_read_lfi_X0
!
!
-SUBROUTINE IO_READ_FIELD_LFI_X1(TPFILE,TPFIELD,PFIELD,KRESP)
+SUBROUTINE IO_Field_read_lfi_X1(TPFILE,TPFIELD,PFIELD,KRESP)
USE MODE_MSG
!
IMPLICIT NONE
@@ -86,21 +90,21 @@ IMPLICIT NONE
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-REAL,DIMENSION(:),INTENT(OUT) :: PFIELD ! array containing the data field
+REAL,DIMENSION(:),INTENT(INOUT) :: PFIELD ! array containing the data field
INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured
!
!* 0.2 Declarations of local variables
!
-INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL
+INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
INTEGER :: ILENG
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
LOGICAL :: GGOOD
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_X1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_X1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
ILENG = SIZE(PFIELD)
!
-CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
+CALL IO_Field_read_check_lfi(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
!
IF (GGOOD) PFIELD = TRANSFER_I8_R(IWORK(IWORK(2)+3:))
!
@@ -108,10 +112,10 @@ KRESP=IRESP
!
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
-END SUBROUTINE IO_READ_FIELD_LFI_X1
+END SUBROUTINE IO_Field_read_lfi_X1
!
!
-SUBROUTINE IO_READ_FIELD_LFI_X2(TPFILE,TPFIELD,PFIELD,KRESP)
+SUBROUTINE IO_Field_read_lfi_X2(TPFILE,TPFIELD,PFIELD,KRESP)
USE MODE_MSG
!
IMPLICIT NONE
@@ -120,21 +124,21 @@ IMPLICIT NONE
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-REAL,DIMENSION(:,:),INTENT(OUT) :: PFIELD ! array containing the data field
+REAL,DIMENSION(:,:),INTENT(INOUT) :: PFIELD ! array containing the data field
INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured
!
!* 0.2 Declarations of local variables
!
-INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL
+INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
INTEGER :: ILENG
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
LOGICAL :: GGOOD
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_X2',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_X2',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
ILENG = SIZE(PFIELD)
!
-CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
+CALL IO_Field_read_check_lfi(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
!
IF (GGOOD) PFIELD = RESHAPE( TRANSFER_I8_R(IWORK(IWORK(2)+3:)) , SHAPE(PFIELD) )
!
@@ -142,10 +146,10 @@ KRESP=IRESP
!
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
-END SUBROUTINE IO_READ_FIELD_LFI_X2
+END SUBROUTINE IO_Field_read_lfi_X2
!
!
-SUBROUTINE IO_READ_FIELD_LFI_X3(TPFILE,TPFIELD,PFIELD,KRESP)
+SUBROUTINE IO_Field_read_lfi_X3(TPFILE,TPFIELD,PFIELD,KRESP)
USE MODE_MSG
!
IMPLICIT NONE
@@ -154,21 +158,21 @@ IMPLICIT NONE
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-REAL,DIMENSION(:,:,:),INTENT(OUT) :: PFIELD ! array containing the data field
+REAL,DIMENSION(:,:,:),INTENT(INOUT) :: PFIELD ! array containing the data field
INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured
!
!* 0.2 Declarations of local variables
!
-INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL
+INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
INTEGER :: ILENG
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
LOGICAL :: GGOOD
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_X3',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_X3',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
ILENG = SIZE(PFIELD)
!
-CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
+CALL IO_Field_read_check_lfi(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
!
IF (GGOOD) PFIELD = RESHAPE( TRANSFER_I8_R(IWORK(IWORK(2)+3:)) , SHAPE(PFIELD) )
!
@@ -176,10 +180,10 @@ KRESP=IRESP
!
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
-END SUBROUTINE IO_READ_FIELD_LFI_X3
+END SUBROUTINE IO_Field_read_lfi_X3
!
!
-SUBROUTINE IO_READ_FIELD_LFI_X4(TPFILE,TPFIELD,PFIELD,KRESP)
+SUBROUTINE IO_Field_read_lfi_X4(TPFILE,TPFIELD,PFIELD,KRESP)
USE MODE_MSG
!
IMPLICIT NONE
@@ -188,21 +192,21 @@ IMPLICIT NONE
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-REAL,DIMENSION(:,:,:,:),INTENT(OUT) :: PFIELD ! array containing the data field
+REAL,DIMENSION(:,:,:,:),INTENT(INOUT) :: PFIELD ! array containing the data field
INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured
!
!* 0.2 Declarations of local variables
!
-INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL
+INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
INTEGER :: ILENG
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
LOGICAL :: GGOOD
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_X4',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_X4',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
ILENG = SIZE(PFIELD)
!
-CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
+CALL IO_Field_read_check_lfi(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
!
IF (GGOOD) PFIELD = RESHAPE( TRANSFER_I8_R(IWORK(IWORK(2)+3:)) , SHAPE(PFIELD) )
!
@@ -210,10 +214,10 @@ KRESP=IRESP
!
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
-END SUBROUTINE IO_READ_FIELD_LFI_X4
+END SUBROUTINE IO_Field_read_lfi_X4
!
!
-SUBROUTINE IO_READ_FIELD_LFI_X5(TPFILE,TPFIELD,PFIELD,KRESP)
+SUBROUTINE IO_Field_read_lfi_X5(TPFILE,TPFIELD,PFIELD,KRESP)
USE MODE_MSG
!
IMPLICIT NONE
@@ -222,21 +226,21 @@ IMPLICIT NONE
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-REAL,DIMENSION(:,:,:,:,:),INTENT(OUT) :: PFIELD ! array containing the data field
+REAL,DIMENSION(:,:,:,:,:),INTENT(INOUT) :: PFIELD ! array containing the data field
INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured
!
!* 0.2 Declarations of local variables
!
-INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL
+INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
INTEGER :: ILENG
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
LOGICAL :: GGOOD
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_X5',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_X5',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
ILENG = SIZE(PFIELD)
!
-CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
+CALL IO_Field_read_check_lfi(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
!
IF (GGOOD) PFIELD = RESHAPE( TRANSFER_I8_R(IWORK(IWORK(2)+3:)) , SHAPE(PFIELD) )
!
@@ -244,10 +248,10 @@ KRESP=IRESP
!
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
-END SUBROUTINE IO_READ_FIELD_LFI_X5
+END SUBROUTINE IO_Field_read_lfi_X5
!
!
-SUBROUTINE IO_READ_FIELD_LFI_X6(TPFILE,TPFIELD,PFIELD,KRESP)
+SUBROUTINE IO_Field_read_lfi_X6(TPFILE,TPFIELD,PFIELD,KRESP)
USE MODE_MSG
!
IMPLICIT NONE
@@ -256,21 +260,21 @@ IMPLICIT NONE
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-REAL,DIMENSION(:,:,:,:,:,:),INTENT(OUT) :: PFIELD ! array containing the data field
+REAL,DIMENSION(:,:,:,:,:,:),INTENT(INOUT) :: PFIELD ! array containing the data field
INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured
!
!* 0.2 Declarations of local variables
!
-INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL
+INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
INTEGER :: ILENG
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
LOGICAL :: GGOOD
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_X6',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_X6',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
ILENG = SIZE(PFIELD)
!
-CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
+CALL IO_Field_read_check_lfi(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
!
IF (GGOOD) PFIELD = RESHAPE( TRANSFER_I8_R(IWORK(IWORK(2)+3:)) , SHAPE(PFIELD) )
!
@@ -278,10 +282,10 @@ KRESP=IRESP
!
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
-END SUBROUTINE IO_READ_FIELD_LFI_X6
+END SUBROUTINE IO_Field_read_lfi_X6
!
!
-SUBROUTINE IO_READ_FIELD_LFI_N0(TPFILE,TPFIELD,KFIELD,KRESP)
+SUBROUTINE IO_Field_read_lfi_N0(TPFILE,TPFIELD,KFIELD,KRESP)
USE MODE_MSG
!
IMPLICIT NONE
@@ -290,21 +294,21 @@ IMPLICIT NONE
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA),INTENT(INOUT) :: TPFIELD
-INTEGER, INTENT(OUT) :: KFIELD ! array containing the data field
+INTEGER, INTENT(INOUT) :: KFIELD ! array containing the data field
INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured
!
!* 0.2 Declarations of local variables
!
-INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL
+INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
INTEGER :: ILENG
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
LOGICAL :: GGOOD
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_N0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_N0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
ILENG = 1
!
-CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
+CALL IO_Field_read_check_lfi(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
!
IF (GGOOD) KFIELD = IWORK(IWORK(2)+3)
!
@@ -312,10 +316,10 @@ KRESP=IRESP
!
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
-END SUBROUTINE IO_READ_FIELD_LFI_N0
+END SUBROUTINE IO_Field_read_lfi_N0
!
!
-SUBROUTINE IO_READ_FIELD_LFI_N1(TPFILE,TPFIELD,KFIELD,KRESP)
+SUBROUTINE IO_Field_read_lfi_N1(TPFILE,TPFIELD,KFIELD,KRESP)
USE MODE_MSG
!
IMPLICIT NONE
@@ -324,21 +328,21 @@ IMPLICIT NONE
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-INTEGER,DIMENSION(:),INTENT(OUT) :: KFIELD ! array containing the data field
+INTEGER,DIMENSION(:),INTENT(INOUT) :: KFIELD ! array containing the data field
INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured
!
!* 0.2 Declarations of local variables
!
-INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL
+INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
INTEGER :: ILENG
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
LOGICAL :: GGOOD
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_N1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_N1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
ILENG = SIZE(KFIELD)
!
-CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
+CALL IO_Field_read_check_lfi(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
!
IF (GGOOD) KFIELD(:) = IWORK(IWORK(2)+3:)
!
@@ -346,10 +350,10 @@ KRESP=IRESP
!
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
-END SUBROUTINE IO_READ_FIELD_LFI_N1
+END SUBROUTINE IO_Field_read_lfi_N1
!
!
-SUBROUTINE IO_READ_FIELD_LFI_N2(TPFILE,TPFIELD,KFIELD,KRESP)
+SUBROUTINE IO_Field_read_lfi_N2(TPFILE,TPFIELD,KFIELD,KRESP)
USE MODE_MSG
!
IMPLICIT NONE
@@ -358,21 +362,21 @@ IMPLICIT NONE
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-INTEGER,DIMENSION(:,:),INTENT(OUT) :: KFIELD ! array containing the data field
+INTEGER,DIMENSION(:,:),INTENT(INOUT) :: KFIELD ! array containing the data field
INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured
!
!* 0.2 Declarations of local variables
!
-INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL
+INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
INTEGER :: ILENG
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
LOGICAL :: GGOOD
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_N2',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_N2',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
ILENG = SIZE(KFIELD)
!
-CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
+CALL IO_Field_read_check_lfi(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
!
IF (GGOOD) KFIELD(:,:) = RESHAPE(IWORK(IWORK(2)+3:),SHAPE(KFIELD))
!
@@ -380,10 +384,10 @@ KRESP=IRESP
!
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
-END SUBROUTINE IO_READ_FIELD_LFI_N2
+END SUBROUTINE IO_Field_read_lfi_N2
!
!
-SUBROUTINE IO_READ_FIELD_LFI_L0(TPFILE,TPFIELD,OFIELD,KRESP)
+SUBROUTINE IO_Field_read_lfi_L0(TPFILE,TPFIELD,OFIELD,KRESP)
USE MODE_MSG
!
IMPLICIT NONE
@@ -392,22 +396,22 @@ IMPLICIT NONE
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA),INTENT(INOUT) :: TPFIELD
-LOGICAL, INTENT(OUT) :: OFIELD ! array containing the data field
+LOGICAL, INTENT(INOUT) :: OFIELD ! array containing the data field
INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured
!
!* 0.2 Declarations of local variables
!
-INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL
+INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
INTEGER :: ILENG
INTEGER :: IFIELD
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
LOGICAL :: GGOOD
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_L0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_L0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
ILENG = 1
!
-CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
+CALL IO_Field_read_check_lfi(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
!
IF (GGOOD) THEN
IFIELD = IWORK(IWORK(2)+3)
@@ -416,7 +420,7 @@ IF (GGOOD) THEN
ELSE IF (IFIELD==1) THEN
OFIELD = .TRUE.
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_LFI_L0',TRIM(TPFILE%CNAME)//': invalid value in file for ' &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_lfi_L0',TRIM(TPFILE%CNAME)//': invalid value in file for ' &
//TRIM(TPFIELD%CMNHNAME))
OFIELD = .TRUE.
IRESP = -112
@@ -427,10 +431,10 @@ KRESP=IRESP
!
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
-END SUBROUTINE IO_READ_FIELD_LFI_L0
+END SUBROUTINE IO_Field_read_lfi_L0
!
!
-SUBROUTINE IO_READ_FIELD_LFI_L1(TPFILE,TPFIELD,OFIELD,KRESP)
+SUBROUTINE IO_Field_read_lfi_L1(TPFILE,TPFIELD,OFIELD,KRESP)
USE MODE_MSG
!
IMPLICIT NONE
@@ -439,23 +443,23 @@ IMPLICIT NONE
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-LOGICAL,DIMENSION(:),INTENT(OUT) :: OFIELD ! array containing the data field
+LOGICAL,DIMENSION(:),INTENT(INOUT) :: OFIELD ! array containing the data field
INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured
!
!* 0.2 Declarations of local variables
!
-INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL
+INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
INTEGER :: ILENG
INTEGER :: JI
INTEGER, DIMENSION(SIZE(OFIELD)) :: IFIELD
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
LOGICAL :: GGOOD
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_L1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_L1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
ILENG = SIZE(OFIELD)
!
-CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
+CALL IO_Field_read_check_lfi(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
!
IF (GGOOD) THEN
IFIELD(:) = IWORK(IWORK(2)+3:)
@@ -470,7 +474,7 @@ IF (GGOOD) THEN
END IF
END DO
IF (IRESP==-112) THEN
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_LFI_L1',TRIM(TPFILE%CNAME)//': invalid value(s) in file for ' &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_lfi_L1',TRIM(TPFILE%CNAME)//': invalid value(s) in file for ' &
//TRIM(TPFIELD%CMNHNAME))
END IF
END IF
@@ -479,10 +483,10 @@ KRESP=IRESP
!
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
-END SUBROUTINE IO_READ_FIELD_LFI_L1
+END SUBROUTINE IO_Field_read_lfi_L1
!
!
-SUBROUTINE IO_READ_FIELD_LFI_C0(TPFILE,TPFIELD,HFIELD,KRESP)
+SUBROUTINE IO_Field_read_lfi_C0(TPFILE,TPFIELD,HFIELD,KRESP)
!
USE MODD_PARAMETERS, ONLY: NFILENAMELGTMAXLFI
!
@@ -494,17 +498,17 @@ IMPLICIT NONE
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA),INTENT(INOUT) :: TPFIELD
-CHARACTER(LEN=*),INTENT(OUT) :: HFIELD ! array containing the data field
+CHARACTER(LEN=*),INTENT(INOUT) :: HFIELD ! array containing the data field
INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured
!
!* 0.2 Declarations of local variables
!
-INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL
+INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
INTEGER :: ILENG, ILENGMAX, JLOOP
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
LOGICAL :: GGOOD
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_C0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_C0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
ILENG = LEN(HFIELD)
ILENGMAX = ILENG
@@ -514,11 +518,11 @@ IF (TPFIELD%CMNHNAME=='MY_NAME' .OR. TPFIELD%CMNHNAME=='DAD_NAME') THEN
ILENG = MIN(LEN(HFIELD),NFILENAMELGTMAXLFI)
ILENGMAX = NFILENAMELGTMAXLFI
IF (LEN(HFIELD)<NFILENAMELGTMAXLFI) &
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_FIELD_LFI_C0',TRIM(TPFILE%CNAME)// &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_read_lfi_C0',TRIM(TPFILE%CNAME)// &
': LEN(HFIELD)<NFILENAMELGTMAXLFI')
END IF
!
-CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENGMAX,IWORK,ITOTAL,IRESP,GGOOD)
+CALL IO_Field_read_check_lfi(TPFILE,TPFIELD,ILENGMAX,IWORK,ITOTAL,IRESP,GGOOD)
!
IF (GGOOD) THEN
DO JLOOP=1,ILENG
@@ -530,10 +534,10 @@ KRESP=IRESP
!
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
-END SUBROUTINE IO_READ_FIELD_LFI_C0
+END SUBROUTINE IO_Field_read_lfi_C0
!
!
-SUBROUTINE IO_READ_FIELD_LFI_T0(TPFILE,TPFIELD,TPDATA,KRESP)
+SUBROUTINE IO_Field_read_lfi_T0(TPFILE,TPFIELD,TPDATA,KRESP)
!
USE MODE_MSG
USE MODD_TYPE_DATE
@@ -549,7 +553,7 @@ INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured
!
!* 0.2 Declarations of local variables
!
-INTEGER(KIND=LFI_INT) :: IRESP, ITOTAL
+INTEGER(KIND=LFIINT) :: IRESP, ITOTAL
INTEGER :: ILENG
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
LOGICAL :: GGOOD
@@ -557,7 +561,7 @@ TYPE(TFIELDDATA) :: TZFIELD
INTEGER, DIMENSION(3) :: ITDATE ! date array
REAL,DIMENSION(1) :: ZTIME
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_T0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_T0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
TZFIELD = TPFIELD
!
@@ -568,7 +572,7 @@ TZFIELD%CCOMMENT = 'YYYYMMDD'
!
ILENG=SIZE(ITDATE)
!
-CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TZFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
+CALL IO_Field_read_check_lfi(TPFILE,TZFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
!
IF (GGOOD) THEN
TPDATA%TDATE%YEAR = IWORK(IWORK(2)+2+1)
@@ -590,7 +594,7 @@ TZFIELD%CCOMMENT = 'SECONDS'
!
ILENG=1
!
-CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TZFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
+CALL IO_Field_read_check_lfi(TPFILE,TZFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
!
IF (GGOOD) THEN
!TRANSFER_I8_R works with 1D arrays
@@ -602,10 +606,10 @@ IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
KRESP = IRESP
!
-END SUBROUTINE IO_READ_FIELD_LFI_T0
+END SUBROUTINE IO_Field_read_lfi_T0
!
!
-SUBROUTINE IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,KLENG,KWORK,KTOTAL,KRESP,OGOOD)
+SUBROUTINE IO_Field_read_check_lfi(TPFILE,TPFIELD,KLENG,KWORK,KTOTAL,KRESP,OGOOD)
!
USE MODD_PARAMETERS, ONLY: NGRIDUNKNOWN
!
@@ -613,13 +617,13 @@ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
INTEGER, INTENT(IN) :: KLENG
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE,INTENT(OUT) :: KWORK
-INTEGER(KIND=LFI_INT), INTENT(OUT) :: KTOTAL
-INTEGER(KIND=LFI_INT), INTENT(OUT) :: KRESP
+INTEGER(KIND=LFIINT), INTENT(OUT) :: KTOTAL
+INTEGER(KIND=LFIINT), INTENT(OUT) :: KRESP
LOGICAL, INTENT(OUT) :: OGOOD
!
INTEGER :: IERRLEVEL,IROW,J
INTEGER,DIMENSION(JPXKRK) :: ICOMMENT
-INTEGER(KIND=LFI_INT) :: ICOMLEN,INUMBR,IPOSEX
+INTEGER(KIND=LFIINT) :: ICOMLEN,INUMBR,IPOSEX
CHARACTER(LEN=:),ALLOCATABLE :: YMSG
CHARACTER(LEN=12) :: YRECLENGTH_FILE, YRECLENGTH_MEM
CHARACTER(LEN=12) :: YVAL_FILE, YVAL_MEM
@@ -634,7 +638,7 @@ GOLDMNH = TPFILE%NMNHVERSION(1)<5 .OR. (TPFILE%NMNHVERSION(1)==5 .AND. TPFILE%NM
!
YRECFM=TRIM(TPFIELD%CMNHNAME)
IF( LEN_TRIM(TPFIELD%CMNHNAME) > LEN(YRECFM) ) &
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_LFI','field name was truncated to '&
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_read_check_lfi','field name was truncated to '&
//YRECFM//' for '//TRIM(TPFIELD%CMNHNAME))
!
!* 2.a LET'S GET SOME INFORMATION ON THE DESIRED ARTICLE
@@ -645,17 +649,17 @@ CALL LFINFO(KRESP,INUMBR,YRECFM,KTOTAL,IPOSEX)
IF (KRESP.NE.0) THEN
WRITE(YRESP, '( I12 )') KRESP
YMSG = 'RESP='//TRIM(ADJUSTL(YRESP))//' in call to LFINFO when reading '//TRIM(TPFIELD%CMNHNAME)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_CHECK_FIELD_LFI',YMSG)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_check_lfi',YMSG)
OGOOD = .FALSE.
RETURN
ELSEIF (KTOTAL.EQ.0) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_LFI',TRIM(TPFILE%CNAME)//': record length is zero for ' &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_read_check_lfi',TRIM(TPFILE%CNAME)//': record length is zero for ' &
//TRIM(TPFIELD%CMNHNAME))
KRESP=-47
OGOOD = .FALSE.
RETURN
ELSEIF (KTOTAL.GT.JPXFIE) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_LFI',TRIM(TPFILE%CNAME)// &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_read_check_lfi',TRIM(TPFILE%CNAME)// &
': record length exceeds the maximum value in FM for '//TRIM(TPFIELD%CMNHNAME))
KRESP=-48
OGOOD = .FALSE.
@@ -670,7 +674,7 @@ CALL LFILEC(KRESP,INUMBR,YRECFM,KWORK,KTOTAL)
IF (KRESP.NE.0) THEN
WRITE(YRESP, '( I12 )') KRESP
YMSG = 'RESP='//TRIM(ADJUSTL(YRESP))//' in call to LFILEC when reading '//TRIM(TPFIELD%CMNHNAME)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_CHECK_FIELD_LFI',YMSG)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_check_lfi',YMSG)
OGOOD = .FALSE.
RETURN
ENDIF
@@ -683,7 +687,7 @@ IROW=KLENG+ICOMLEN+2
IF (KTOTAL.NE.IROW) THEN
WRITE(YRECLENGTH_FILE,'(I12)') KTOTAL-2-ICOMLEN
WRITE(YRECLENGTH_MEM, '(I12)') KLENG
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_CHECK_FIELD_LFI','wrong field size for '//TRIM(TPFIELD%CMNHNAME) &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_check_lfi','wrong field size for '//TRIM(TPFIELD%CMNHNAME) &
//' (expected: '//TRIM(ADJUSTL(YRECLENGTH_MEM))// &
', in file: ' //TRIM(ADJUSTL(YRECLENGTH_FILE))//')')
KRESP=-63
@@ -701,21 +705,21 @@ IF (KWORK(1)/=TPFIELD%NGRID) THEN
ELSE
IERRLEVEL = NVERB_ERROR
END IF
- CALL PRINT_MSG(IERRLEVEL,'IO','IO_READ_CHECK_FIELD_LFI','expected GRID value ('//TRIM(ADJUSTL(YVAL_MEM))// &
+ CALL PRINT_MSG(IERRLEVEL,'IO','IO_Field_read_check_lfi','expected GRID value ('//TRIM(ADJUSTL(YVAL_MEM))// &
') is different than found in file ('//TRIM(ADJUSTL(YVAL_FILE))//') for variable '//TRIM(TPFIELD%CMNHNAME))
IF(.NOT.GOLDMNH) THEN !Do not modify probably incorrect grid number (to prevent problems later with other correct files)
TPFIELD%NGRID = KWORK(1)
KRESP = -111 !Used later to broadcast modified metadata
END IF
ELSE
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_LFI','expected GRID found in file for field ' &
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_check_lfi','expected GRID found in file for field ' &
//TRIM(TPFIELD%CMNHNAME))
ENDIF
!
YCOMMENT=''
SELECT CASE (ICOMLEN)
CASE(:-1)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_CHECK_FIELD_LFI',TRIM(TPFILE%CNAME)//': comment length is negative for ' &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_check_lfi',TRIM(TPFILE%CNAME)//': comment length is negative for ' &
//TRIM(TPFIELD%CMNHNAME))
KRESP=-58
OGOOD = .FALSE.
@@ -728,23 +732,23 @@ CASE(1:JPXKRK)
YCOMMENT(J:J)=CHAR(ICOMMENT(J))
ENDDO
CASE(JPXKRK+1:)
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_LFI',TRIM(TPFILE%CNAME)//': comment is too long in file for ' &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_read_check_lfi',TRIM(TPFILE%CNAME)//': comment is too long in file for ' &
//TRIM(TPFIELD%CMNHNAME))
KRESP=-56
RETURN
END SELECT
!
IF (TRIM(YCOMMENT)/=TRIM(TPFIELD%CCOMMENT)) THEN
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_READ_CHECK_FIELD_LFI','expected COMMENT ('//TRIM(TPFIELD%CCOMMENT)// &
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_read_check_lfi','expected COMMENT ('//TRIM(TPFIELD%CCOMMENT)// &
') is different than found ('//TRIM(YCOMMENT)//') in file for field '//TRIM(TPFIELD%CMNHNAME))
TPFIELD%CCOMMENT=TRIM(YCOMMENT)
KRESP = -111 !Used later to broadcast modified metadata
ELSE
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_LFI','expected COMMENT found in file for field ' &
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_check_lfi','expected COMMENT found in file for field ' &
//TRIM(TPFIELD%CMNHNAME))
END IF
!
-END SUBROUTINE IO_READ_CHECK_FIELD_LFI
+END SUBROUTINE IO_Field_read_check_lfi
!
!
FUNCTION TRANSFER_I8_R(KFIELDIN) RESULT(PFIELDOUT)
diff --git a/src/LIB/SURCOUCHE/src/mode_io_read_nc4.f90 b/src/LIB/SURCOUCHE/src/mode_io_read_nc4.f90
index 9fb6870ad093671b87190921cbca6bd90267f5bd..3aaed8fb95ca02eccf016fb1b8256d33b3dc435f 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_read_nc4.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_read_nc4.f90
@@ -3,21 +3,23 @@
!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 : may 2016 : use NetCDF Fortran module
-! J.Escobar : 14/12/2017 : Correction for MNH_INT=8
-! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet : 13/12/2018 : split of mode_netcdf into multiple modules/files
-! Philippe Wautelet: 10/01/2019: replace handle_err by io_handle_err_nc4 for better netCDF error messages
+! Modifications:
+! P. Wautelet may 2016 : use NetCDF Fortran module
+! J. Escobar 14/12/2017: correction for MNH_INT=8
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 13/12/2018: split of mode_netcdf into multiple modules/files
+! P. Wautelet 10/01/2019: replace handle_err by IO_Err_handle_nc4 for better netCDF error messages
+! P. Wautelet 21/02/2019: bugfix: intent of read fields: OUT->INOUT to keep initial value if not found in file
+! P. Wautelet 05/03/2019: rename IO subroutines and modules
!-----------------------------------------------------------------
#if defined(MNH_IOCDF4)
module mode_io_read_nc4
-use modd_io_ll, only: tfiledata
-use modd_netcdf, only: IDCDF_KIND
+use modd_io, only: tfiledata
+use modd_precision, only: CDFINT
use mode_field, only: tfielddata
-use mode_io_tools_nc4, only: cleanmnhname, io_handle_err_nc4
+use mode_io_tools_nc4, only: IO_Mnhname_clean, IO_Err_handle_nc4
use mode_msg
use NETCDF, only: NF90_CHAR, NF90_DOUBLE, NF90_FLOAT, NF90_INT, NF90_INT1, NF90_INT64, &
@@ -29,42 +31,42 @@ implicit none
private
-public :: io_read_field_nc4
+public :: IO_Field_read_nc4
-INTERFACE IO_READ_FIELD_NC4
- MODULE PROCEDURE IO_READ_FIELD_NC4_X0,IO_READ_FIELD_NC4_X1, &
- IO_READ_FIELD_NC4_X2,IO_READ_FIELD_NC4_X3, &
- IO_READ_FIELD_NC4_X4,IO_READ_FIELD_NC4_X5, &
- IO_READ_FIELD_NC4_X6, &
- IO_READ_FIELD_NC4_N0,IO_READ_FIELD_NC4_N1, &
- IO_READ_FIELD_NC4_N2, &
- IO_READ_FIELD_NC4_L0,IO_READ_FIELD_NC4_L1, &
- IO_READ_FIELD_NC4_C0, &
- IO_READ_FIELD_NC4_T0
-END INTERFACE IO_READ_FIELD_NC4
+INTERFACE IO_Field_read_nc4
+ MODULE PROCEDURE IO_Field_read_nc4_X0,IO_Field_read_nc4_X1, &
+ IO_Field_read_nc4_X2,IO_Field_read_nc4_X3, &
+ IO_Field_read_nc4_X4,IO_Field_read_nc4_X5, &
+ IO_Field_read_nc4_X6, &
+ IO_Field_read_nc4_N0,IO_Field_read_nc4_N1, &
+ IO_Field_read_nc4_N2, &
+ IO_Field_read_nc4_L0,IO_Field_read_nc4_L1, &
+ IO_Field_read_nc4_C0, &
+ IO_Field_read_nc4_T0
+END INTERFACE IO_Field_read_nc4
contains
-SUBROUTINE IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,KVARID,KRESP,HCALENDAR)
+SUBROUTINE IO_Field_attr_read_check_nc4(TPFILE,TPFIELD,KVARID,KRESP,HCALENDAR)
!
USE MODD_PARAMETERS, ONLY: NGRIDUNKNOWN
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-INTEGER(KIND=IDCDF_KIND), INTENT(IN) :: KVARID
+INTEGER(KIND=CDFINT), INTENT(IN) :: KVARID
INTEGER, INTENT(OUT) :: KRESP ! return-code
CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: HCALENDAR
!
INTEGER :: IERRLEVEL
INTEGER :: ILEN
INTEGER :: IGRID
-INTEGER(KIND=IDCDF_KIND) :: INCID
-INTEGER(KIND=IDCDF_KIND) :: STATUS
+INTEGER(KIND=CDFINT) :: INCID
+INTEGER(KIND=CDFINT) :: STATUS
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)
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)//': called for field '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_attr_read_check_nc4',TRIM(TPFILE%CNAME)//': called for field '//TRIM(TPFIELD%CMNHNAME))
!
KRESP = 0
INCID = TPFILE%NNCID
@@ -85,7 +87,7 @@ IF (STATUS == NF90_NOERR) THEN
IF (IGRID/=TPFIELD%NGRID) THEN
WRITE(YVAL_FILE,'(I12)') IGRID
WRITE(YVAL_MEM, '(I12)') TPFIELD%NGRID
- CALL PRINT_MSG(IERRLEVEL,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ CALL PRINT_MSG(IERRLEVEL,'IO','IO_Field_attr_read_check_nc4',TRIM(TPFILE%CNAME)// &
': expected GRID value ('//TRIM(ADJUSTL(YVAL_MEM))// &
') is different than found in file ('//TRIM(ADJUSTL(YVAL_FILE))//') for variable '//TRIM(TPFIELD%CMNHNAME))
IF (.NOT.GOLDMNH) THEN !Do not modify probably incorrect grid number (to prevent problems later with other correct files)
@@ -93,15 +95,15 @@ IF (STATUS == NF90_NOERR) THEN
KRESP = -111 !Used later to broadcast modified metadata
END IF
ELSE
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_attr_read_check_nc4',TRIM(TPFILE%CNAME)// &
': expected GRID found in file for field '//TRIM(TPFIELD%CMNHNAME))
ENDIF
ELSE !no GRID
IF (TPFIELD%NGRID==0 .OR. TPFIELD%NGRID==NGRIDUNKNOWN) THEN
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_attr_read_check_nc4',TRIM(TPFILE%CNAME)// &
': no GRID (as expected) in file for field '//TRIM(TPFIELD%CMNHNAME))
ELSE
- CALL PRINT_MSG(IERRLEVEL,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ CALL PRINT_MSG(IERRLEVEL,'IO','IO_Field_attr_read_check_nc4',TRIM(TPFILE%CNAME)// &
': expected GRID but not found in file for field '//TRIM(TPFIELD%CMNHNAME))
END IF
ENDIF
@@ -114,26 +116,26 @@ IF (STATUS == NF90_NOERR) THEN
STATUS = 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_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_attr_read_check_nc4',TRIM(TPFILE%CNAME)// &
': COMMENT found (unexpected) in file for field '//TRIM(TPFIELD%CMNHNAME))
TPFIELD%CCOMMENT=TRIM(YVALUE)
ELSE IF (TRIM(YVALUE)/=TRIM(TPFIELD%CCOMMENT)) THEN
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_attr_read_check_nc4',TRIM(TPFILE%CNAME)// &
': expected COMMENT ('//TRIM(TPFIELD%CCOMMENT)// &
') is different than found ('//TRIM(YVALUE)//') in file for field '//TRIM(TPFIELD%CMNHNAME))
TPFIELD%CCOMMENT=TRIM(YVALUE)
KRESP = -111 !Used later to broadcast modified metadata
ELSE
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_attr_read_check_nc4',TRIM(TPFILE%CNAME)// &
': expected COMMENT found in file for field '//TRIM(TPFIELD%CMNHNAME))
END IF
DEALLOCATE(YVALUE)
ELSE !no COMMENT
IF (LEN_TRIM(TPFIELD%CCOMMENT)==0) THEN
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_attr_read_check_nc4',TRIM(TPFILE%CNAME)// &
': no COMMENT (as expected) in file for field '//TRIM(TPFIELD%CMNHNAME))
ELSE
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_attr_read_check_nc4',TRIM(TPFILE%CNAME)// &
': expected COMMENT but not found in file for field '//TRIM(TPFIELD%CMNHNAME))
END IF
END IF
@@ -145,22 +147,22 @@ IF (STATUS == NF90_NOERR) THEN
ALLOCATE(CHARACTER(LEN=ILEN) :: YVALUE)
STATUS = NF90_GET_ATT(INCID, KVARID, 'standard_name', YVALUE)
IF (TRIM(YVALUE)/=TRIM(TPFIELD%CSTDNAME)) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_attr_read_check_nc4',TRIM(TPFILE%CNAME)// &
': expected STDNAME ('//TRIM(TPFIELD%CSTDNAME)// &
') is different than found ('//TRIM(YVALUE)//') in file for field '//TRIM(TPFIELD%CMNHNAME))
TPFIELD%CSTDNAME=TRIM(YVALUE)
KRESP = -111 !Used later to broadcast modified metadata
ELSE
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_attr_read_check_nc4',TRIM(TPFILE%CNAME)// &
': expected STDNAME found in file for field '//TRIM(TPFIELD%CMNHNAME))
END IF
DEALLOCATE(YVALUE)
ELSE !no STDNAME
IF (LEN_TRIM(TPFIELD%CSTDNAME)==0) THEN
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_attr_read_check_nc4',TRIM(TPFILE%CNAME)// &
': no STDNAME (as expected) in file for field '//TRIM(TPFIELD%CMNHNAME))
ELSE
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_attr_read_check_nc4',TRIM(TPFILE%CNAME)// &
': expected STDNAME but not found in file for field '//TRIM(TPFIELD%CMNHNAME))
END IF
END IF
@@ -172,22 +174,22 @@ IF (STATUS == NF90_NOERR) THEN
ALLOCATE(CHARACTER(LEN=ILEN) :: YVALUE)
STATUS = NF90_GET_ATT(INCID, KVARID, 'long_name', YVALUE)
IF (TRIM(YVALUE)/=TRIM(TPFIELD%CLONGNAME)) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_attr_read_check_nc4',TRIM(TPFILE%CNAME)// &
': expected LONGNAME ('//TRIM(TPFIELD%CLONGNAME)// &
') is different than found ('//TRIM(YVALUE)//') in file for field '//TRIM(TPFIELD%CMNHNAME))
TPFIELD%CLONGNAME=TRIM(YVALUE)
KRESP = -111 !Used later to broadcast modified metadata
ELSE
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_attr_read_check_nc4',TRIM(TPFILE%CNAME)// &
': expected LONGNAME found in file for field '//TRIM(TPFIELD%CMNHNAME))
END IF
DEALLOCATE(YVALUE)
ELSE !no LONGNAME
IF (LEN_TRIM(TPFIELD%CLONGNAME)==0) THEN
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_attr_read_check_nc4',TRIM(TPFILE%CNAME)// &
': no LONGNAME (as expected) in file for field '//TRIM(TPFIELD%CMNHNAME))
ELSE
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_attr_read_check_nc4',TRIM(TPFILE%CNAME)// &
': expected LONGNAME but not found in file for field '//TRIM(TPFIELD%CMNHNAME))
END IF
END IF
@@ -200,30 +202,30 @@ IF (STATUS == NF90_NOERR) THEN
STATUS = 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_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_attr_read_check_nc4',TRIM(TPFILE%CNAME)// &
': expected UNITS ('//TRIM(TPFIELD%CUNITS)// &
') is different than found ('//TRIM(YVALUE)//') in file for field '//TRIM(TPFIELD%CMNHNAME))
KRESP = -111 !Used later to broadcast modified metadata
ELSE
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_attr_read_check_nc4',TRIM(TPFILE%CNAME)// &
': UNITS found in file for field '//TRIM(TPFIELD%CMNHNAME)//' (will be analysed later)')
END IF
TPFIELD%CUNITS=TRIM(YVALUE)
ELSE
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_attr_read_check_nc4',TRIM(TPFILE%CNAME)// &
': expected UNITS found in file for field '//TRIM(TPFIELD%CMNHNAME))
END IF
DEALLOCATE(YVALUE)
ELSE !no UNITS
IF (LEN_TRIM(TPFIELD%CUNITS)==0) THEN
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_attr_read_check_nc4',TRIM(TPFILE%CNAME)// &
': no UNITS (as expected) in file for field '//TRIM(TPFIELD%CMNHNAME))
ELSE
IF(.NOT.PRESENT(HCALENDAR)) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_attr_read_check_nc4',TRIM(TPFILE%CNAME)// &
': expected UNITS but not found in file for field '//TRIM(TPFIELD%CMNHNAME))
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_attr_read_check_nc4',TRIM(TPFILE%CNAME)// &
': expected UNITS but not found in file for field '//TRIM(TPFIELD%CMNHNAME))
KRESP = -3
END IF
@@ -238,53 +240,53 @@ IF (STATUS == NF90_NOERR) THEN
ALLOCATE(CHARACTER(LEN=ILEN) :: YVALUE)
STATUS = NF90_GET_ATT(INCID, KVARID, 'calendar', YVALUE)
IF (TRIM(YVALUE)/=TRIM(HCALENDAR)) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_attr_read_check_nc4',TRIM(TPFILE%CNAME)// &
': expected CALENDAR ('//TRIM(HCALENDAR)// &
') is different than found ('//TRIM(YVALUE)//') in file for field '//TRIM(TPFIELD%CMNHNAME))
ELSE
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_attr_read_check_nc4',TRIM(TPFILE%CNAME)// &
': expected CALENDAR found in file for field '//TRIM(TPFIELD%CMNHNAME))
END IF
DEALLOCATE(YVALUE)
ELSE !no CALENDAR
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_ATTR_NC4',TRIM(TPFILE%CNAME)// &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_attr_read_check_nc4',TRIM(TPFILE%CNAME)// &
': expected CALENDAR but not found in file for field '//TRIM(TPFIELD%CMNHNAME))
END IF
ENDIF
!
-END SUBROUTINE IO_READ_CHECK_FIELD_ATTR_NC4
+END SUBROUTINE IO_Field_attr_read_check_nc4
-SUBROUTINE IO_READ_FIELD_NC4_X0(TPFILE, TPFIELD, PFIELD, KRESP)
+SUBROUTINE IO_Field_read_nc4_X0(TPFILE, TPFIELD, PFIELD, KRESP)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-REAL, INTENT(OUT) :: PFIELD
+REAL, INTENT(INOUT) :: PFIELD
INTEGER, INTENT(OUT) :: KRESP ! return-code
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER :: IRESP
+INTEGER(KIND=CDFINT) :: STATUS
+INTEGER(KIND=CDFINT) :: INCID
+INTEGER(KIND=CDFINT) :: IVARID
+INTEGER(KIND=CDFINT) :: ITYPE ! variable type
+INTEGER(KIND=CDFINT) :: IDIMS ! number of dimensions
+CHARACTER(LEN=30) :: YVARNAME
+INTEGER :: IRESP
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_X0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_nc4_X0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
IRESP = 0
! Get the Netcdf file ID
INCID = TPFILE%NNCID
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X0','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
+ CALL IO_Err_handle_nc4(status,'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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X0','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
+IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X0','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
!Neglect the time dimension (of size 1)
IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
@@ -293,13 +295,13 @@ 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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X0','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
+ CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X0','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
! Read and check attributes of variable
- CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
+ CALL IO_Field_attr_read_check_nc4(TPFILE,TPFIELD,IVARID,IRESP)
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_nc4_X0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
' not read (wrong size or type)')
IRESP = -3
END IF
@@ -307,41 +309,41 @@ END IF
1000 CONTINUE
KRESP = IRESP
-END SUBROUTINE IO_READ_FIELD_NC4_X0
+END SUBROUTINE IO_Field_read_nc4_X0
-SUBROUTINE IO_READ_FIELD_NC4_X1(TPFILE, TPFIELD, PFIELD, KRESP)
+SUBROUTINE IO_Field_read_nc4_X1(TPFILE, TPFIELD, PFIELD, KRESP)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-REAL,DIMENSION(:),INTENT(OUT) :: PFIELD
+REAL,DIMENSION(:),INTENT(INOUT) :: PFIELD
INTEGER, INTENT(OUT) :: KRESP ! return-code
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
-INTEGER :: IRESP
+INTEGER(KIND=CDFINT) :: STATUS
+INTEGER(KIND=CDFINT) :: INCID
+INTEGER(KIND=CDFINT) :: IVARID
+INTEGER(KIND=CDFINT) :: ITYPE ! variable type
+INTEGER(KIND=CDFINT) :: IDIMS ! number of dimensions
+INTEGER(KIND=CDFINT),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
+CHARACTER(LEN=30) :: YVARNAME
+INTEGER(KIND=CDFINT) :: IDIMLEN
+INTEGER :: IRESP
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_X1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_nc4_X1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
IRESP = 0
! Get the Netcdf file ID
INCID = TPFILE%NNCID
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X1','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
+ CALL IO_Err_handle_nc4(status,'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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X1','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
+IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X1','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
!Neglect the time dimension (of size 1)
IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
@@ -349,24 +351,24 @@ 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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X1','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X1','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
+ CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X1','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
! Read and check attributes of variable
- CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
+ CALL IO_Field_attr_read_check_nc4(TPFILE,TPFIELD,IVARID,IRESP)
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_nc4_X1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
' not read (wrong size)')
IRESP = -3
END IF
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_nc4_X1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
' not read (wrong number of dimensions or wrong type)')
IRESP = -3
END IF
@@ -374,41 +376,41 @@ END IF
1000 CONTINUE
KRESP = IRESP
-END SUBROUTINE IO_READ_FIELD_NC4_X1
+END SUBROUTINE IO_Field_read_nc4_X1
-SUBROUTINE IO_READ_FIELD_NC4_X2(TPFILE, TPFIELD, PFIELD, KRESP)
+SUBROUTINE IO_Field_read_nc4_X2(TPFILE, TPFIELD, PFIELD, KRESP)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-REAL,DIMENSION(:,:),INTENT(OUT) :: PFIELD
+REAL,DIMENSION(:,:),INTENT(INOUT) :: PFIELD
INTEGER, INTENT(OUT) :: KRESP ! return-code
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND),DIMENSION(3) :: IDIMLEN
-INTEGER :: IRESP
+INTEGER(KIND=CDFINT) :: STATUS
+INTEGER(KIND=CDFINT) :: INCID
+INTEGER(KIND=CDFINT) :: IVARID
+INTEGER(KIND=CDFINT) :: ITYPE ! variable type
+INTEGER(KIND=CDFINT) :: IDIMS ! number of dimensions
+INTEGER(KIND=CDFINT),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
+CHARACTER(LEN=30) :: YVARNAME
+INTEGER(KIND=CDFINT),DIMENSION(3) :: IDIMLEN
+INTEGER :: IRESP
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_X2',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_nc4_X2',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
IRESP = 0
! Get the Netcdf file ID
INCID = TPFILE%NNCID
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X2','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
+ CALL IO_Err_handle_nc4(status,'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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X2','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
+IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X2','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
!Neglect the time dimension (of size 1)
IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
@@ -416,39 +418,39 @@ 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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X2','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X2','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
IF (IDIMLEN(3)==1) THEN
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_READ_FIELD_NC4_X2',TRIM(TPFILE%CNAME)// &
+ 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))
IDIMS = 2
ELSE
- CALL PRINT_MSG(NVERB_FATAL,'IO','IO_READ_FIELD_NC4_X2',TRIM(TPFILE%CNAME)//': wrong number of dimensions for '//TRIM(YVARNAME))
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_Field_read_nc4_X2',TRIM(TPFILE%CNAME)//': wrong number of dimensions for '//TRIM(YVARNAME))
END IF
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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X2','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X2','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X2','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
+ CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X2','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
! Read and check attributes of variable
- CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
+ CALL IO_Field_attr_read_check_nc4(TPFILE,TPFIELD,IVARID,IRESP)
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X2',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_nc4_X2',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
' not read (wrong size)')
IRESP = -3
END IF
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X2',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_nc4_X2',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
' not read (wrong number of dimensions or wrong type)')
IRESP = -3
END IF
@@ -456,41 +458,41 @@ END IF
1000 CONTINUE
KRESP = IRESP
-END SUBROUTINE IO_READ_FIELD_NC4_X2
+END SUBROUTINE IO_Field_read_nc4_X2
-SUBROUTINE IO_READ_FIELD_NC4_X3(TPFILE, TPFIELD, PFIELD, KRESP)
+SUBROUTINE IO_Field_read_nc4_X3(TPFILE, TPFIELD, PFIELD, KRESP)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-REAL,DIMENSION(:,:,:),INTENT(OUT) :: PFIELD
+REAL,DIMENSION(:,:,:),INTENT(INOUT) :: PFIELD
INTEGER, INTENT(OUT) :: KRESP ! return-code
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
-INTEGER(KIND=IDCDF_KIND),DIMENSION(3) :: IDIMLEN
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER :: IRESP
+INTEGER(KIND=CDFINT) :: STATUS
+INTEGER(KIND=CDFINT) :: INCID
+INTEGER(KIND=CDFINT) :: IVARID
+INTEGER(KIND=CDFINT) :: ITYPE ! variable type
+INTEGER(KIND=CDFINT) :: IDIMS ! number of dimensions
+INTEGER(KIND=CDFINT),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
+INTEGER(KIND=CDFINT),DIMENSION(3) :: IDIMLEN
+CHARACTER(LEN=30) :: YVARNAME
+INTEGER :: IRESP
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_X3',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_nc4_X3',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
IRESP = 0
! Get the Netcdf file ID
INCID = TPFILE%NNCID
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X3','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
+ CALL IO_Err_handle_nc4(status,'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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X3','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
+IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X3','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
!Neglect the time dimension (of size 1)
IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
@@ -498,28 +500,28 @@ 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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X3','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X3','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X3','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X3','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
+ CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X3','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
! Read and check attributes of variable
- CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
+ CALL IO_Field_attr_read_check_nc4(TPFILE,TPFIELD,IVARID,IRESP)
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X3',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_nc4_X3',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
' not read (wrong size)')
IRESP = -3
END IF
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X3',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_nc4_X3',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
' not read (wrong number of dimensions or wrong type)')
IRESP = -3
END IF
@@ -527,41 +529,41 @@ END IF
1000 CONTINUE
KRESP = IRESP
-END SUBROUTINE IO_READ_FIELD_NC4_X3
+END SUBROUTINE IO_Field_read_nc4_X3
-SUBROUTINE IO_READ_FIELD_NC4_X4(TPFILE, TPFIELD, PFIELD, KRESP)
+SUBROUTINE IO_Field_read_nc4_X4(TPFILE, TPFIELD, PFIELD, KRESP)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-REAL,DIMENSION(:,:,:,:),INTENT(OUT) :: PFIELD
+REAL,DIMENSION(:,:,:,:),INTENT(INOUT) :: PFIELD
INTEGER, INTENT(OUT) :: KRESP ! return-code
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
-INTEGER(KIND=IDCDF_KIND),DIMENSION(4) :: IDIMLEN
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER :: IRESP
+INTEGER(KIND=CDFINT) :: STATUS
+INTEGER(KIND=CDFINT) :: INCID
+INTEGER(KIND=CDFINT) :: IVARID
+INTEGER(KIND=CDFINT) :: ITYPE ! variable type
+INTEGER(KIND=CDFINT) :: IDIMS ! number of dimensions
+INTEGER(KIND=CDFINT),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
+INTEGER(KIND=CDFINT),DIMENSION(4) :: IDIMLEN
+CHARACTER(LEN=30) :: YVARNAME
+INTEGER :: IRESP
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_X4',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_nc4_X4',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
IRESP = 0
! Get the Netcdf file ID
INCID = TPFILE%NNCID
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X4','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
+ CALL IO_Err_handle_nc4(status,'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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X4','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
+IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X4','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
!Neglect the time dimension (of size 1)
IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
@@ -569,31 +571,31 @@ 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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X4','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X4','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X4','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X4','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X4','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
+ CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X4','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
! Read and check attributes of variable
- CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
+ CALL IO_Field_attr_read_check_nc4(TPFILE,TPFIELD,IVARID,IRESP)
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X4',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_nc4_X4',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
' not read (wrong size)')
IRESP = -3
END IF
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X4',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_nc4_X4',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
' not read (wrong number of dimensions or wrong type)')
IRESP = -3
END IF
@@ -601,41 +603,41 @@ END IF
1000 CONTINUE
KRESP = IRESP
-END SUBROUTINE IO_READ_FIELD_NC4_X4
+END SUBROUTINE IO_Field_read_nc4_X4
-SUBROUTINE IO_READ_FIELD_NC4_X5(TPFILE, TPFIELD, PFIELD, KRESP)
+SUBROUTINE IO_Field_read_nc4_X5(TPFILE, TPFIELD, PFIELD, KRESP)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-REAL,DIMENSION(:,:,:,:,:),INTENT(OUT) :: PFIELD
+REAL,DIMENSION(:,:,:,:,:),INTENT(INOUT) :: PFIELD
INTEGER, INTENT(OUT) :: KRESP ! return-code
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
-INTEGER(KIND=IDCDF_KIND),DIMENSION(5) :: IDIMLEN
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER :: IRESP
+INTEGER(KIND=CDFINT) :: STATUS
+INTEGER(KIND=CDFINT) :: INCID
+INTEGER(KIND=CDFINT) :: IVARID
+INTEGER(KIND=CDFINT) :: ITYPE ! variable type
+INTEGER(KIND=CDFINT) :: IDIMS ! number of dimensions
+INTEGER(KIND=CDFINT),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
+INTEGER(KIND=CDFINT),DIMENSION(5) :: IDIMLEN
+CHARACTER(LEN=30) :: YVARNAME
+INTEGER :: IRESP
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_X5',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_nc4_X5',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
IRESP = 0
! Get the Netcdf file ID
INCID = TPFILE%NNCID
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X5','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
+ CALL IO_Err_handle_nc4(status,'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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X5','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
+IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X5','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
!Neglect the time dimension (of size 1)
IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
@@ -643,15 +645,15 @@ 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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X5','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X5','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X5','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X5','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X5','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'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. &
@@ -659,18 +661,18 @@ IF (IDIMS == 5 .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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X5','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
+ CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X5','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
! Read and check attributes of variable
- CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
+ CALL IO_Field_attr_read_check_nc4(TPFILE,TPFIELD,IVARID,IRESP)
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X5',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_nc4_X5',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
' not read (wrong size)')
IRESP = -3
END IF
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X5',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_nc4_X5',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
' not read (wrong number of dimensions or wrong type)')
IRESP = -3
END IF
@@ -678,41 +680,41 @@ END IF
1000 CONTINUE
KRESP = IRESP
-END SUBROUTINE IO_READ_FIELD_NC4_X5
+END SUBROUTINE IO_Field_read_nc4_X5
-SUBROUTINE IO_READ_FIELD_NC4_X6(TPFILE, TPFIELD, PFIELD, KRESP)
+SUBROUTINE IO_Field_read_nc4_X6(TPFILE, TPFIELD, PFIELD, KRESP)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-REAL,DIMENSION(:,:,:,:,:,:),INTENT(OUT) :: PFIELD
+REAL,DIMENSION(:,:,:,:,:,:),INTENT(INOUT) :: PFIELD
INTEGER, INTENT(OUT) :: KRESP ! return-code
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
-INTEGER(KIND=IDCDF_KIND),DIMENSION(6) :: IDIMLEN
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER :: IRESP
+INTEGER(KIND=CDFINT) :: STATUS
+INTEGER(KIND=CDFINT) :: INCID
+INTEGER(KIND=CDFINT) :: IVARID
+INTEGER(KIND=CDFINT) :: ITYPE ! variable type
+INTEGER(KIND=CDFINT) :: IDIMS ! number of dimensions
+INTEGER(KIND=CDFINT),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
+INTEGER(KIND=CDFINT),DIMENSION(6) :: IDIMLEN
+CHARACTER(LEN=30) :: YVARNAME
+INTEGER :: IRESP
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_X6',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_nc4_X6',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
IRESP = 0
! Get the Netcdf file ID
INCID = TPFILE%NNCID
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X6','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
+ CALL IO_Err_handle_nc4(status,'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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X6','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
+IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X6','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
!Neglect the time dimension (of size 1)
IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
@@ -720,17 +722,17 @@ 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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X6','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X6','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X6','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X6','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X6','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X6','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'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. &
@@ -738,18 +740,18 @@ IF (IDIMS == 6 .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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_X6','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
+ CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X6','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
! Read and check attributes of variable
- CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
+ CALL IO_Field_attr_read_check_nc4(TPFILE,TPFIELD,IVARID,IRESP)
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X6',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_nc4_X6',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
' not read (wrong size)')
IRESP = -3
END IF
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_X6',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_nc4_X6',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
' not read (wrong number of dimensions or wrong type)')
IRESP = -3
END IF
@@ -757,39 +759,39 @@ END IF
1000 CONTINUE
KRESP = IRESP
-END SUBROUTINE IO_READ_FIELD_NC4_X6
+END SUBROUTINE IO_Field_read_nc4_X6
-SUBROUTINE IO_READ_FIELD_NC4_N0(TPFILE, TPFIELD, KFIELD, KRESP)
+SUBROUTINE IO_Field_read_nc4_N0(TPFILE, TPFIELD, KFIELD, KRESP)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-INTEGER, INTENT(OUT) :: KFIELD
+INTEGER, INTENT(INOUT) :: KFIELD
INTEGER, INTENT(OUT) :: KRESP ! return-code
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER :: IRESP
+INTEGER(KIND=CDFINT) :: STATUS
+INTEGER(KIND=CDFINT) :: INCID
+INTEGER(KIND=CDFINT) :: IVARID
+INTEGER(KIND=CDFINT) :: ITYPE ! variable type
+INTEGER(KIND=CDFINT) :: IDIMS ! number of dimensions
+CHARACTER(LEN=30) :: YVARNAME
+INTEGER :: IRESP
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_N0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_nc4_N0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
IRESP = 0
! Get the Netcdf file ID
INCID = TPFILE%NNCID
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_N0','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
+ CALL IO_Err_handle_nc4(status,'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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_N0','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
+IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_N0','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
!Neglect the time dimension (of size 1)
IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
@@ -799,13 +801,13 @@ 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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_N0','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
+ CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_N0','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
! Read and check attributes of variable
- CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
+ CALL IO_Field_attr_read_check_nc4(TPFILE,TPFIELD,IVARID,IRESP)
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_N0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_nc4_N0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
' not read (wrong size or type)')
IRESP = -3
END IF
@@ -813,41 +815,41 @@ END IF
1000 CONTINUE
KRESP = IRESP
-END SUBROUTINE IO_READ_FIELD_NC4_N0
+END SUBROUTINE IO_Field_read_nc4_N0
-SUBROUTINE IO_READ_FIELD_NC4_N1(TPFILE, TPFIELD, KFIELD, KRESP)
+SUBROUTINE IO_Field_read_nc4_N1(TPFILE, TPFIELD, KFIELD, KRESP)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-INTEGER, DIMENSION(:), INTENT(OUT) :: KFIELD
+INTEGER, DIMENSION(:), INTENT(INOUT) :: KFIELD
INTEGER, INTENT(OUT) :: KRESP ! return-code
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
-INTEGER :: IRESP
+INTEGER(KIND=CDFINT) :: STATUS
+INTEGER(KIND=CDFINT) :: INCID
+INTEGER(KIND=CDFINT) :: IVARID
+INTEGER(KIND=CDFINT) :: ITYPE ! variable type
+INTEGER(KIND=CDFINT) :: IDIMS ! number of dimensions
+INTEGER(KIND=CDFINT),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
+CHARACTER(LEN=30) :: YVARNAME
+INTEGER(KIND=CDFINT) :: IDIMLEN
+INTEGER :: IRESP
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_N1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_nc4_N1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
IRESP = 0
! Get the Netcdf file ID
INCID = TPFILE%NNCID
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_N1','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
+ CALL IO_Err_handle_nc4(status,'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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_N1','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
+IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_N1','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
!Neglect the time dimension (of size 1)
IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
@@ -856,24 +858,24 @@ IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_N1','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_N1','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
+ CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_N1','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
! Read and check attributes of variable
- CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
+ CALL IO_Field_attr_read_check_nc4(TPFILE,TPFIELD,IVARID,IRESP)
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_N1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_nc4_N1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
' not read (wrong size)')
IRESP = -3
END IF
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_N1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_nc4_N1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
' not read (wrong number of dimensions or wrong type)')
IRESP = -3
END IF
@@ -881,41 +883,41 @@ END IF
1000 CONTINUE
KRESP = IRESP
-END SUBROUTINE IO_READ_FIELD_NC4_N1
+END SUBROUTINE IO_Field_read_nc4_N1
-SUBROUTINE IO_READ_FIELD_NC4_N2(TPFILE, TPFIELD, KFIELD, KRESP)
+SUBROUTINE IO_Field_read_nc4_N2(TPFILE, TPFIELD, KFIELD, KRESP)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-INTEGER, DIMENSION(:,:), INTENT(OUT) :: KFIELD
+INTEGER, DIMENSION(:,:), INTENT(INOUT) :: KFIELD
INTEGER, INTENT(OUT) :: KRESP ! return-code
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND),DIMENSION(3) :: IDIMLEN
-INTEGER :: IRESP
+INTEGER(KIND=CDFINT) :: STATUS
+INTEGER(KIND=CDFINT) :: INCID
+INTEGER(KIND=CDFINT) :: IVARID
+INTEGER(KIND=CDFINT) :: ITYPE ! variable type
+INTEGER(KIND=CDFINT) :: IDIMS ! number of dimensions
+INTEGER(KIND=CDFINT),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
+CHARACTER(LEN=30) :: YVARNAME
+INTEGER(KIND=CDFINT),DIMENSION(3) :: IDIMLEN
+INTEGER :: IRESP
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_N2',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_nc4_N2',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
IRESP = 0
! Get the Netcdf file ID
INCID = TPFILE%NNCID
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_N2','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
+ CALL IO_Err_handle_nc4(status,'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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_N2','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
+IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_N2','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
!Neglect the time dimension (of size 1)
IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
@@ -923,13 +925,13 @@ 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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_N2','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_N2','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
IF (IDIMLEN(3)==1) THEN
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_READ_FIELD_NC4_N2',TRIM(TPFILE%CNAME)// &
+ 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))
IDIMS = 2
ELSE
- CALL PRINT_MSG(NVERB_FATAL,'IO','IO_READ_FIELD_NC4_N2',TRIM(TPFILE%CNAME)//': wrong number of dimensions for '//TRIM(YVARNAME))
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_Field_read_nc4_N2',TRIM(TPFILE%CNAME)//': wrong number of dimensions for '//TRIM(YVARNAME))
END IF
END IF
@@ -937,26 +939,26 @@ END IF
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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_N2','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_N2','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_N2','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
+ CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_N2','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
! Read and check attributes of variable
- CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
+ CALL IO_Field_attr_read_check_nc4(TPFILE,TPFIELD,IVARID,IRESP)
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_N2',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_nc4_N2',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
' not read (wrong size)')
IRESP = -3
END IF
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_N2',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_nc4_N2',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
' not read (wrong number of dimensions or wrong type)')
IRESP = -3
END IF
@@ -964,39 +966,39 @@ END IF
1000 CONTINUE
KRESP = IRESP
-END SUBROUTINE IO_READ_FIELD_NC4_N2
+END SUBROUTINE IO_Field_read_nc4_N2
-SUBROUTINE IO_READ_FIELD_NC4_L0(TPFILE, TPFIELD, OFIELD, KRESP)
+SUBROUTINE IO_Field_read_nc4_L0(TPFILE, TPFIELD, OFIELD, KRESP)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-LOGICAL, INTENT(OUT) :: OFIELD
+LOGICAL, INTENT(INOUT) :: OFIELD
INTEGER, INTENT(OUT) :: KRESP ! return-code
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER :: IRESP
-INTEGER :: IFIELD
+INTEGER(KIND=CDFINT) :: STATUS
+INTEGER(KIND=CDFINT) :: INCID
+INTEGER(KIND=CDFINT) :: IVARID
+INTEGER(KIND=CDFINT) :: ITYPE ! variable type
+INTEGER(KIND=CDFINT) :: IDIMS ! number of dimensions
+CHARACTER(LEN=30) :: YVARNAME
+INTEGER :: IRESP
+INTEGER :: IFIELD
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_L0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_nc4_L0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
IRESP = 0
! Get the Netcdf file ID
INCID = TPFILE%NNCID
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_L0','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
+ CALL IO_Err_handle_nc4(status,'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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_L0','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
+IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_L0','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
!Neglect the time dimension (of size 1)
IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
@@ -1007,7 +1009,7 @@ IF (IDIMS == 0 .AND. (ITYPE == NF90_INT1 .OR. ITYPE == NF90_INT .OR. ITYPE == NF
! Read variable
STATUS = NF90_GET_VAR(INCID, IVARID, IFIELD)
IF (STATUS /= NF90_NOERR) THEN
- CALL IO_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_L0','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
+ CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_L0','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
@@ -1016,16 +1018,16 @@ IF (IDIMS == 0 .AND. (ITYPE == NF90_INT1 .OR. ITYPE == NF90_INT .OR. ITYPE == NF
ELSE IF (IFIELD==1) THEN
OFIELD = .TRUE.
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_LFI_L0',TRIM(TPFILE%CNAME)//': invalid value in file for ' &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_nc4_L0',TRIM(TPFILE%CNAME)//': invalid value in file for ' &
//TRIM(TPFIELD%CMNHNAME))
OFIELD = .TRUE.
IRESP = -112
END IF
! Read and check attributes of variable
- CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
+ CALL IO_Field_attr_read_check_nc4(TPFILE,TPFIELD,IVARID,IRESP)
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_L0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_nc4_L0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
' not read (wrong size or type)')
IRESP = -3
END IF
@@ -1033,43 +1035,43 @@ END IF
1000 CONTINUE
KRESP = IRESP
-END SUBROUTINE IO_READ_FIELD_NC4_L0
+END SUBROUTINE IO_Field_read_nc4_L0
-SUBROUTINE IO_READ_FIELD_NC4_L1(TPFILE, TPFIELD, OFIELD, KRESP)
+SUBROUTINE IO_Field_read_nc4_L1(TPFILE, TPFIELD, OFIELD, KRESP)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-LOGICAL,DIMENSION(:),INTENT(OUT) :: OFIELD
+LOGICAL,DIMENSION(:),INTENT(INOUT) :: OFIELD
INTEGER, INTENT(OUT) :: KRESP ! return-code
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
-INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER :: IRESP
-INTEGER :: JI
-INTEGER,DIMENSION(SIZE(OFIELD)) :: IFIELD
+INTEGER(KIND=CDFINT) :: STATUS
+INTEGER(KIND=CDFINT) :: INCID
+INTEGER(KIND=CDFINT) :: IVARID
+INTEGER(KIND=CDFINT) :: ITYPE ! variable type
+INTEGER(KIND=CDFINT) :: IDIMS ! number of dimensions
+INTEGER(KIND=CDFINT),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
+INTEGER(KIND=CDFINT) :: IDIMLEN
+CHARACTER(LEN=30) :: YVARNAME
+INTEGER :: IRESP
+INTEGER :: JI
+INTEGER,DIMENSION(SIZE(OFIELD)) :: IFIELD
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_L1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_nc4_L1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
IRESP = 0
! Get the Netcdf file ID
INCID = TPFILE%NNCID
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_L1','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
+ CALL IO_Err_handle_nc4(status,'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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_L1','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
+IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_L1','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
!Neglect the time dimension (of size 1)
IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
@@ -1079,13 +1081,13 @@ IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_L1','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_L1','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
+ CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_L1','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
@@ -1100,19 +1102,19 @@ IF (IDIMS == 1 .AND. (ITYPE == NF90_INT1 .OR. ITYPE == NF90_INT .OR. ITYPE == NF
END IF
END DO
IF (IRESP==-112) THEN
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_LFI_L1',TRIM(TPFILE%CNAME)//': invalid value(s) in file for ' &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_nc4_L1',TRIM(TPFILE%CNAME)//': invalid value(s) in file for ' &
//TRIM(TPFIELD%CMNHNAME))
END IF
! Read and check attributes of variable
- CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
+ CALL IO_Field_attr_read_check_nc4(TPFILE,TPFIELD,IVARID,IRESP)
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_L1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_nc4_L1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
' not read (wrong size)')
IRESP = -3
END IF
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_L1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_nc4_L1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
' not read (wrong number of dimensions or wrong type)')
IRESP = -3
END IF
@@ -1120,64 +1122,64 @@ END IF
1000 CONTINUE
KRESP = IRESP
-END SUBROUTINE IO_READ_FIELD_NC4_L1
+END SUBROUTINE IO_Field_read_nc4_L1
-SUBROUTINE IO_READ_FIELD_NC4_C0(TPFILE, TPFIELD, HFIELD, KRESP)
+SUBROUTINE IO_Field_read_nc4_C0(TPFILE, TPFIELD, HFIELD, KRESP)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-CHARACTER(LEN=*), INTENT(OUT) :: HFIELD
+CHARACTER(LEN=*), INTENT(INOUT) :: HFIELD
INTEGER, INTENT(OUT) :: KRESP ! return-code
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-INTEGER(KIND=IDCDF_KIND),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
-CHARACTER(LEN=30) :: YVARNAME
-CHARACTER(LEN=:),ALLOCATABLE :: YSTR
-INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
-INTEGER :: IRESP
+INTEGER(KIND=CDFINT) :: STATUS
+INTEGER(KIND=CDFINT) :: INCID
+INTEGER(KIND=CDFINT) :: IVARID
+INTEGER(KIND=CDFINT) :: ITYPE ! variable type
+INTEGER(KIND=CDFINT) :: IDIMS ! number of dimensions
+INTEGER(KIND=CDFINT),DIMENSION(NF90_MAX_VAR_DIMS) :: IVDIMS
+CHARACTER(LEN=30) :: YVARNAME
+CHARACTER(LEN=:),ALLOCATABLE :: YSTR
+INTEGER(KIND=CDFINT) :: IDIMLEN
+INTEGER :: IRESP
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_C0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_nc4_C0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
IRESP = 0
! Get the Netcdf file ID
INCID = TPFILE%NNCID
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_C0','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
+ CALL IO_Err_handle_nc4(status,'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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_C0','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
+IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_C0','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_C0','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
+ CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_C0','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
IF (LEN_TRIM(YSTR) > LEN(HFIELD)) &
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_C0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' truncated')
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_nc4_C0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' truncated')
HFIELD = TRIM(YSTR)
DEALLOCATE(YSTR)
! Read and check attributes of variable
- CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP)
+ CALL IO_Field_attr_read_check_nc4(TPFILE,TPFIELD,IVARID,IRESP)
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_C0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_nc4_C0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
' not read (wrong size or type)')
IRESP = -3
END IF
@@ -1185,9 +1187,9 @@ END IF
1000 CONTINUE
KRESP = IRESP
-END SUBROUTINE IO_READ_FIELD_NC4_C0
+END SUBROUTINE IO_Field_read_nc4_C0
-SUBROUTINE IO_READ_FIELD_NC4_T0(TPFILE, TPFIELD, TPDATA, KRESP)
+SUBROUTINE IO_Field_read_nc4_T0(TPFILE, TPFIELD, TPDATA, KRESP)
!
USE MODD_TYPE_DATE
!
@@ -1195,45 +1197,45 @@ USE MODE_DATETIME
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-TYPE (DATE_TIME), INTENT(OUT) :: TPDATA
+TYPE (DATE_TIME), INTENT(INOUT) :: TPDATA
INTEGER, INTENT(OUT) :: KRESP ! return-code
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
+INTEGER(KIND=CDFINT) :: STATUS
+INTEGER(KIND=CDFINT) :: INCID
+INTEGER(KIND=CDFINT) :: IVARID
+INTEGER(KIND=CDFINT) :: ITYPE ! variable type
+INTEGER(KIND=CDFINT) :: IDIMS ! number of dimensions
CHARACTER(LEN=30) :: YVARNAME
CHARACTER(LEN=:),ALLOCATABLE :: YSTR
-INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
+INTEGER(KIND=CDFINT) :: IDIMLEN
INTEGER :: IDX,IRESP
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_NC4_T0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_nc4_T0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
IRESP = 0
! Get the Netcdf file ID
INCID = TPFILE%NNCID
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_T0','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
+ CALL IO_Err_handle_nc4(status,'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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_T0','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
+IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'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_HANDLE_ERR_NC4(status,'IO_READ_FIELD_NC4_T0','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
+ CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_T0','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
! Read and check attributes of variable
- CALL IO_READ_CHECK_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,IRESP,HCALENDAR='standard')
+ 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
@@ -1241,14 +1243,14 @@ IF (IDIMS == 0 .AND. (ITYPE == NF90_FLOAT .OR. ITYPE == NF90_DOUBLE) ) THEN
READ(TPFIELD%CUNITS(IDX+14:IDX+15),'( I2.2 )') TPDATA%TDATE%DAY
! 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
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_T0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_nc4_T0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
' read date is invalid')
IRESP = -3
END IF
! Correct date and time (necessary for example if time is bigger than 86400 s)
CALL DATETIME_CORRECTDATE(TPDATA)
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_NC4_T0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_nc4_T0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
' not read (wrong size or type)')
IRESP = -3
END IF
@@ -1256,7 +1258,7 @@ END IF
1000 CONTINUE
KRESP = IRESP
-END SUBROUTINE IO_READ_FIELD_NC4_T0
+END SUBROUTINE IO_Field_read_nc4_T0
end module mode_io_read_nc4
@@ -1264,10 +1266,10 @@ end module mode_io_read_nc4
!
! External dummy subroutines
!
-subroutine io_read_field_nc4(a, b, c, d, e, f, g)
+subroutine IO_Field_read_nc4(a, b, c, d, e, f, g)
use mode_msg
integer :: a, b, c, d, e, f, g
-CALL PRINT_MSG(NVERB_ERROR,'IO','io_read_field_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
-end subroutine io_read_field_nc4
+CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end subroutine IO_Field_read_nc4
!
#endif
diff --git a/src/LIB/SURCOUCHE/src/mode_io_tools.f90 b/src/LIB/SURCOUCHE/src/mode_io_tools.f90
index 9e8dd1fc85b8dd0412cc535af1afa88752598c2b..b4d2a3d5fd80491940d3e6e0bb281ef086894af0 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_tools.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_tools.f90
@@ -1,69 +1,70 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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:
-! P. Wautelet : 13/12/2018 : extracted from mode_io.f90
-! P. Wautelet : 14/12/2018 : added io_construct_filename
+! Modifications:
+! 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
!-----------------------------------------------------------------
module mode_io_tools
-use modd_io_ll, only: tfiledata
+use modd_io, only: tfiledata
implicit none
private
-public :: io_file, io_rank, io_construct_filename
+public :: IO_Level2filenumber_get, IO_Rank_master_get, IO_Filename_construct
contains
- FUNCTION io_file(k,nb_proc_io)
- !
- ! return the file number where to write the K level of data
- !
- IMPLICIT NONE
- INTEGER(kind=MNH_MPI_RANK_KIND) :: k,nb_proc_io
- INTEGER(kind=MNH_MPI_RANK_KIND) :: io_file
+FUNCTION IO_Level2filenumber_get(k,nb_proc_io)
+ !
+ ! return the file number where to write the K level of data
+ !
+ IMPLICIT NONE
+ INTEGER :: k,nb_proc_io
+ INTEGER :: IO_Level2filenumber_get
- io_file = MOD ((k-1) , nb_proc_io )
+ IO_Level2filenumber_get = MOD ((k-1) , nb_proc_io )
- END FUNCTION io_file
+END FUNCTION IO_Level2filenumber_get
- FUNCTION IO_RANK(IFILE,nb_proc,nb_proc_io,offset_rank)
- !
- ! return the proc number which must write the 'IFILE' file
- !
- IMPLICIT NONE
- INTEGER(kind=MNH_MPI_RANK_KIND) :: IFILE,nb_proc,nb_proc_io
- INTEGER(kind=MNH_MPI_RANK_KIND),OPTIONAL :: offset_rank
+FUNCTION IO_Rank_master_get(IFILE,nb_proc,nb_proc_io,offset_rank)
+ !
+ ! return the proc number which must write the 'IFILE' file
+ !
+ IMPLICIT NONE
+ INTEGER, INTENT(IN) :: IFILE, nb_proc, nb_proc_io
+ INTEGER, OPTIONAL, INTENT(IN) :: offset_rank
- INTEGER(kind=MNH_MPI_RANK_KIND) :: IO_RANK
+ INTEGER :: IO_Rank_master_get
- INTEGER(kind=MNH_MPI_RANK_KIND) :: ipas,irest
+ INTEGER :: ipas, irest
- ipas = nb_proc / nb_proc_io
- irest = MOD ( nb_proc , nb_proc_io )
+ ipas = nb_proc / nb_proc_io
+ irest = MOD ( nb_proc , nb_proc_io )
- IF (ipas /= 0 ) THEN
- IO_RANK=ipas * IFILE + MIN(IFILE , irest )
- ELSE
- IO_RANK=MOD(IFILE , nb_proc )
- ENDIF
+ IF (ipas /= 0 ) THEN
+ IO_Rank_master_get=ipas * IFILE + MIN(IFILE , irest )
+ ELSE
+ IO_Rank_master_get=MOD(IFILE , nb_proc )
+ ENDIF
- !
- ! optional rank to shift for read test
- !
- IF (PRESENT(offset_rank)) THEN
- IF ( offset_rank .GT.0 ) IO_RANK=MOD(IO_RANK+offset_rank,nb_proc)
- IF ( offset_rank .LT.0 ) IO_RANK=MOD(nb_proc-IO_RANK+offset_rank,nb_proc)
- ENDIF
+ !
+ ! optional rank to shift for read test
+ !
+ IF (PRESENT(offset_rank)) THEN
+ IF ( offset_rank .GT.0 ) IO_Rank_master_get=MOD(IO_Rank_master_get+offset_rank,nb_proc)
+ IF ( offset_rank .LT.0 ) IO_Rank_master_get=MOD(nb_proc-IO_Rank_master_get+offset_rank,nb_proc)
+ ENDIF
- END FUNCTION IO_RANK
+END FUNCTION IO_Rank_master_get
-subroutine io_construct_filename(tpfile,hfilem)
+subroutine IO_Filename_construct(tpfile,hfilem)
type(tfiledata), intent(inout) :: tpfile
character(len=:), allocatable, intent(out) :: hfilem
@@ -77,8 +78,7 @@ subroutine io_construct_filename(tpfile,hfilem)
hfilem = trim(tpfile%cname)
end if
-end subroutine io_construct_filename
-
+end subroutine IO_Filename_construct
end module mode_io_tools
@@ -86,7 +86,7 @@ end module mode_io_tools
module mode_io_tools_mnhversion
-use modd_io_ll, only: tfiledata
+use modd_io, only: tfiledata
use mode_msg
@@ -94,109 +94,107 @@ implicit none
private
-public :: io_get_mnhversion, io_set_mnhversion
+public :: IO_Mnhversion_get, IO_Mnhversion_set
contains
- subroutine io_get_mnhversion(tpfile)
- !Compare MNHVERSION of file with current version and store it in file metadata
- use modd_conf, only: nmnhversion
- use modd_io_ll, only: tfiledata
- use mode_field, only: tfielddata,typeint
- use mode_fmread, only: io_read_field
-
- type(tfiledata), intent(inout) :: tpfile
-
- character(len=12) :: ymnhversion_file,ymnhversion_curr
- integer :: imasdev,ibugfix
- integer :: iresp
- integer,dimension(3) :: imnhversion
- type(tfielddata) :: tzfield
-
- call print_msg(NVERB_DEBUG,'IO','io_get_mnhversion','called for '//trim(tpfile%cname))
-
- if ( trim(tpfile%cmode) /= 'READ' ) &
- call print_msg(NVERB_FATAL,'IO','io_get_mnhversion',trim(tpfile%cname)// 'not opened in read mode')
-
- imnhversion(:) = 0
- !use tzfield because tfieldlist could be not initialised
- tzfield%cmnhname = 'MNHVERSION'
- tzfield%cstdname = ''
- tzfield%clongname = 'MesoNH version'
- tzfield%cunits = ''
- tzfield%cdir = '--'
- tzfield%ccomment = ''
- tzfield%ngrid = 0
- tzfield%ntype = TYPEINT
- tzfield%ndims = 1
- tzfield%ltimedep = .false.
- call io_read_field(tpfile,tzfield,imnhversion,iresp)
+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 mode_io_field_read, only: IO_Field_read
+
+ type(tfiledata), intent(inout) :: tpfile
+
+ character(len=12) :: ymnhversion_file,ymnhversion_curr
+ integer :: imasdev,ibugfix
+ integer :: iresp
+ integer,dimension(3) :: imnhversion
+ type(tfielddata) :: tzfield
+
+ call print_msg(NVERB_DEBUG,'IO','IO_Mnhversion_get','called for '//trim(tpfile%cname))
+
+ if ( trim(tpfile%cmode) /= 'READ' ) &
+ call print_msg(NVERB_FATAL,'IO','IO_Mnhversion_get',trim(tpfile%cname)// 'not opened in read mode')
+
+ imnhversion(:) = 0
+ !use tzfield because tfieldlist could be not initialised
+ tzfield%cmnhname = 'MNHVERSION'
+ tzfield%cstdname = ''
+ tzfield%clongname = 'MesoNH version'
+ tzfield%cunits = ''
+ tzfield%cdir = '--'
+ tzfield%ccomment = ''
+ tzfield%ngrid = 0
+ tzfield%ntype = TYPEINT
+ tzfield%ndims = 1
+ tzfield%ltimedep = .false.
+ call IO_Field_read(tpfile,tzfield,imnhversion,iresp)
+ if (iresp/=0) then
+ tzfield%cmnhname = 'MASDEV'
+ tzfield%clongname = 'MesoNH version (without bugfix)'
+ tzfield%ndims = 0
+ call IO_Field_read(tpfile,tzfield,imasdev,iresp)
if (iresp/=0) then
- tzfield%cmnhname = 'MASDEV'
- tzfield%clongname = 'MesoNH version (without bugfix)'
- tzfield%ndims = 0
- call io_read_field(tpfile,tzfield,imasdev,iresp)
- if (iresp/=0) then
- call print_msg(NVERB_WARNING,'IO','io_get_mnhversion','unknown MASDEV version for '//trim(tpfile%cname))
- else
- if (imasdev<100) then
- imnhversion(1)=imasdev/10
- imnhversion(2)=mod(imasdev,10)
- else !for example for mnh 4.10
- imnhversion(1)=imasdev/100
- imnhversion(2)=mod(imasdev,100)
- end if
- end if
- !
- tzfield%cmnhname = 'BUGFIX'
- tzfield%clongname = 'MesoNH bugfix number'
- call io_read_field(tpfile,tzfield,ibugfix,iresp)
- if (iresp/=0) then
- call print_msg(NVERB_WARNING,'IO','io_get_mnhversion','unknown BUGFIX version for '//trim(tpfile%cname))
- else
- imnhversion(3)=ibugfix
+ call print_msg(NVERB_WARNING,'IO','IO_Mnhversion_get','unknown MASDEV version for '//trim(tpfile%cname))
+ else
+ if (imasdev<100) then
+ imnhversion(1)=imasdev/10
+ imnhversion(2)=mod(imasdev,10)
+ else !for example for mnh 4.10
+ imnhversion(1)=imasdev/100
+ imnhversion(2)=mod(imasdev,100)
end if
end if
!
- write(ymnhversion_file,"( I0,'.',I0,'.',I0 )" ) imnhversion(1),imnhversion(2),imnhversion(3)
- write(ymnhversion_curr,"( I0,'.',I0,'.',I0 )" ) nmnhversion(1),nmnhversion(2),nmnhversion(3)
+ tzfield%cmnhname = 'BUGFIX'
+ tzfield%clongname = 'MesoNH bugfix number'
+ call IO_Field_read(tpfile,tzfield,ibugfix,iresp)
+ if (iresp/=0) then
+ call print_msg(NVERB_WARNING,'IO','IO_Mnhversion_get','unknown BUGFIX version for '//trim(tpfile%cname))
+ else
+ imnhversion(3)=ibugfix
+ end if
+ end if
+ !
+ write(ymnhversion_file,"( I0,'.',I0,'.',I0 )" ) imnhversion(1),imnhversion(2),imnhversion(3)
+ write(ymnhversion_curr,"( I0,'.',I0,'.',I0 )" ) nmnhversion(1),nmnhversion(2),nmnhversion(3)
+ !
+ 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. &
+ (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)//&
+ ' was written with the same version of MesoNH ('//trim(ymnhversion_curr)//')')
+ end if
!
- if ( imnhversion(1)==0 .and. imnhversion(2)==0 .and. imnhversion(3)==0 ) then
- call print_msg(NVERB_WARNING,'IO','io_get_mnhversion','file '//trim(tpfile%cname)//&
- ' was written with an unknown version of MesoNH')
- 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_get_mnhversion','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_get_mnhversion','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_get_mnhversion','file '//trim(tpfile%cname)//&
- ' was written with the same version of MesoNH ('//trim(ymnhversion_curr)//')')
- end if
- !
- tpfile%nmnhversion(:) = imnhversion(:)
- end subroutine io_get_mnhversion
+ tpfile%nmnhversion(:) = imnhversion(:)
+end subroutine IO_Mnhversion_get
- subroutine io_set_mnhversion(tpfile)
- use modd_conf, only: nmnhversion
- use modd_io_ll, only: tfiledata
+subroutine IO_Mnhversion_set(tpfile)
+ use modd_conf, only: nmnhversion
- type(tfiledata), intent(inout) :: tpfile
+ type(tfiledata), intent(inout) :: tpfile
- call print_msg(NVERB_DEBUG,'IO','io_set_mnhversion','called for '//trim(tpfile%cname))
+ call print_msg(NVERB_DEBUG,'IO','IO_Mnhversion_set','called for '//trim(tpfile%cname))
- if ( trim(tpfile%cmode) /= 'WRITE' ) &
- call print_msg(NVERB_FATAL,'IO','io_set_mnhversion',trim(tpfile%cname)// 'not opened in write mode')
+ if ( trim(tpfile%cmode) /= 'WRITE' ) &
+ call print_msg(NVERB_FATAL,'IO','IO_Mnhversion_set',trim(tpfile%cname)// 'not opened in write mode')
- tpfile%nmnhversion(:) = nmnhversion(:)
- end subroutine io_set_mnhversion
+ tpfile%nmnhversion(:) = nmnhversion(:)
+end subroutine IO_Mnhversion_set
end module mode_io_tools_mnhversion
diff --git a/src/LIB/SURCOUCHE/src/mode_io_tools_lfi.f90 b/src/LIB/SURCOUCHE/src/mode_io_tools_lfi.f90
index a55365550f8f8c0a0221da035e8315c2f2f487dc..d9af6e616af8b6383004d278fa2b644a6d277334 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_tools_lfi.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_tools_lfi.f90
@@ -1,27 +1,30 @@
-!MNH_LIC Copyright 2018-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2018-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.
!-----------------------------------------------------------------
-! Creation:
-! P. Wautelet : 14/12/2018
+! Author(s):
+! P. Wautelet : 14/12/2018
+! Modifications:
+! P. Wautelet 05/03/2019: rename IO subroutines and modules
!-----------------------------------------------------------------
module mode_io_tools_lfi
-use modd_io_ll, only: tfiledata
+use modd_io, only: tfiledata
+use modd_precision, only: LFIINT
implicit none
private
-public :: io_prepare_verbosity_lfi
+public :: IO_Verbosity_prepare_lfi
contains
-subroutine io_prepare_verbosity_lfi(tpfile, kmelev, ostats)
- type(tfiledata), intent(in) :: tpfile
- integer(kind=LFI_INT), intent(out) :: kmelev
- logical, intent(out) :: ostats
+subroutine IO_Verbosity_prepare_lfi(tpfile, kmelev, ostats)
+ type(tfiledata), intent(in) :: tpfile
+ integer(kind=LFIINT), intent(out) :: kmelev
+ logical, intent(out) :: ostats
select case (tpfile%nlfiverb)
case(:2)
@@ -38,7 +41,7 @@ subroutine io_prepare_verbosity_lfi(tpfile, kmelev, ostats)
kmelev = 2
end select
-end subroutine io_prepare_verbosity_lfi
+end subroutine IO_Verbosity_prepare_lfi
end module mode_io_tools_lfi
diff --git a/src/LIB/SURCOUCHE/src/mode_io_tools_nc4.f90 b/src/LIB/SURCOUCHE/src/mode_io_tools_nc4.f90
index b66011fac5d08bdc6fc9e122c8a7b89aa67d52eb..21734960714a0e90b1f0376525c179b08705d1a0 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_tools_nc4.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_tools_nc4.f90
@@ -3,18 +3,20 @@
!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 : may 2016 : use NetCDF Fortran module
-! J.Escobar : 14/12/2017 : Correction for MNH_INT=8
-! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet : 13/12/2018 : split of mode_netcdf into multiple modules/files
-! Philippe Wautelet: 10/01/2019: replace handle_err by io_handle_err_nc4 for better netCDF error messages
+! Modifications:
+! P. Wautelet may 2016 : use NetCDF Fortran module
+! J.Escobar 14/12/2017: correction for MNH_INT=8
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 13/12/2018: split of mode_netcdf into multiple modules/files
+! 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
!-----------------------------------------------------------------
#if defined(MNH_IOCDF4)
module mode_io_tools_nc4
-use modd_io_ll, only: tfiledata
-use modd_netcdf, only: dimcdf, IDCDF_KIND, iocdf, tdim_dummy
+use modd_io, only: tfiledata
+use modd_netcdf, only: dimcdf, iocdf, tdim_dummy
+use modd_precision, only: CDFINT
use mode_field, only: tfielddata
use mode_msg
@@ -26,12 +28,13 @@ implicit none
private
-public :: io_find_dim_byname_nc4, io_guess_dimids_nc4, io_set_knowndims_nc4
-public :: cleaniocdf, cleanmnhname, fillvdims, getdimcdf, getstrdimid, io_handle_err_nc4, newiocdf
+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
contains
-SUBROUTINE IO_FIND_DIM_BYNAME_NC4(TPFILE, HDIMNAME, TPDIM, KRESP)
+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
@@ -39,12 +42,12 @@ INTEGER, INTENT(OUT) :: KRESP
!
TYPE(DIMCDF), POINTER :: TMP
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_FIND_DIM_BYNAME_NC4','called for dimension name '//TRIM(HDIMNAME))
+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_FIND_DIM_BYNAME_NC4','DIMLIST not associated for file '//TRIM(TPFILE%CNAME))
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Dim_find_byname_nc4','DIMLIST not associated for file '//TRIM(TPFILE%CNAME))
KRESP = -1
RETURN
END IF
@@ -60,10 +63,10 @@ DO WHILE(ASSOCIATED(TMP))
TMP => TMP%NEXT
END DO
!
-END SUBROUTINE IO_FIND_DIM_BYNAME_NC4
+END SUBROUTINE IO_Dim_find_byname_nc4
-SUBROUTINE IO_GUESS_DIMIDS_NC4(TPFILE, TPFIELD, KLEN, TPDIMS, KRESP)
+SUBROUTINE IO_Dimids_guess_nc4(TPFILE, TPFIELD, KLEN, TPDIMS, KRESP)
!
USE MODE_FIELD, ONLY: TYPECHAR
!
@@ -81,7 +84,7 @@ CHARACTER(LEN=32) :: YINT
CHARACTER(LEN=2) :: YDIR
TYPE(DIMCDF), POINTER :: PTDIM
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_GUESS_DIMIDS_NC4','called for '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Dimids_guess_nc4','called for '//TRIM(TPFIELD%CMNHNAME))
!
IGRID = TPFIELD%NGRID
YDIR = TPFIELD%CDIR
@@ -92,11 +95,11 @@ PTDIM => NULL()
!
IF(IGRID<0 .OR. IGRID>8) THEN
WRITE(YINT,'( I0 )') IGRID
- CALL PRINT_MSG(NVERB_FATAL,'IO','IO_GUESS_DIMIDS_NC4','invalid NGRID ('//TRIM(YINT)//') for field '//TRIM(TPFIELD%CMNHNAME))
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_Dimids_guess_nc4','invalid NGRID ('//TRIM(YINT)//') for field '//TRIM(TPFIELD%CMNHNAME))
END IF
!
IF(IGRID==0 .AND. YDIR/='--' .AND. YDIR/='' ) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4','invalid YDIR ('//TRIM(YDIR)//') with NGRID=0 for field '&
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Dimids_guess_nc4','invalid YDIR ('//TRIM(YDIR)//') with NGRID=0 for field '&
//TRIM(TPFIELD%CMNHNAME))
END IF
!
@@ -109,16 +112,16 @@ IF (IGRID==0) THEN
ILEN = 1
END IF
CASE (1)
- PTDIM => GETDIMCDF(TPFILE,KLEN)
+ PTDIM => IO_Dimcdf_get_nc4(TPFILE,KLEN)
TPDIMS(1) = PTDIM
ILEN = PTDIM%LEN
CASE DEFAULT
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4','NGRID=0 and NDIMS>1 not yet supported (field '&
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Dimids_guess_nc4','NGRID=0 and NDIMS>1 not yet supported (field '&
//TRIM(TPFIELD%CMNHNAME)//')')
END SELECT
ELSE IF (TPFIELD%CLBTYPE/='NONE') THEN
IF (TPFIELD%NDIMS/=3) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4','CLBTYPE/=NONE and NDIMS/=3 not supported (field '&
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Dimids_guess_nc4','CLBTYPE/=NONE and NDIMS/=3 not supported (field '&
//TRIM(TPFIELD%CMNHNAME)//')')
END IF
!
@@ -129,9 +132,9 @@ ELSE IF (TPFIELD%CLBTYPE/='NONE') THEN
TPDIMS(3) = PTDIM
ILEN = TPDIMS(2)%LEN * TPDIMS(3)%LEN
ISIZE = KLEN/ILEN
- IF (MOD(KLEN,ILEN)/=0) CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4', &
+ 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 => GETDIMCDF(TPFILE, ISIZE)
+ PTDIM => IO_Dimcdf_get_nc4(TPFILE, ISIZE)
TPDIMS(1) = PTDIM
ILEN = ILEN * PTDIM%LEN
ELSE IF (TPFIELD%CLBTYPE=='LBY' .OR. TPFIELD%CLBTYPE=='LBYV') THEN
@@ -141,13 +144,13 @@ ELSE IF (TPFIELD%CLBTYPE/='NONE') THEN
TPDIMS(3) = PTDIM
ILEN = TPDIMS(1)%LEN * TPDIMS(3)%LEN
ISIZE = KLEN/ILEN
- IF (MOD(KLEN,ILEN)/=0) CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4', &
+ 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 => GETDIMCDF(TPFILE, ISIZE)
+ PTDIM => IO_Dimcdf_get_nc4(TPFILE, ISIZE)
TPDIMS(2) = PTDIM
ILEN = ILEN * PTDIM%LEN
ELSE
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4','invalid CLBTYPE ('//TPFIELD%CLBTYPE//') for field '&
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Dimids_guess_nc4','invalid CLBTYPE ('//TPFIELD%CLBTYPE//') for field '&
//TRIM(TPFIELD%CMNHNAME))
END IF
ELSE
@@ -162,7 +165,7 @@ ELSE
ELSE IF ( YDIR == 'ZZ' ) THEN
PTDIM => TPFILE%TNCCOORDS(3,IGRID)%TDIM
ELSE IF (JI==TPFIELD%NDIMS) THEN !Guess last dimension
- PTDIM => GETDIMCDF(TPFILE, KLEN)
+ PTDIM => IO_Dimcdf_get_nc4(TPFILE, KLEN)
END IF
ILEN = PTDIM%LEN
TPDIMS(JI) = PTDIM
@@ -172,13 +175,13 @@ ELSE
ELSE IF (JI==TPFIELD%NDIMS) THEN !Guess last dimension
ISIZE = KLEN/ILEN
IF (MOD(KLEN,ILEN)/=0) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4', &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Dimids_guess_nc4', &
'can not guess 2nd and last dimension for field '//TRIM(TPFIELD%CMNHNAME))
EXIT
END IF
- PTDIM => GETDIMCDF(TPFILE, ISIZE)
+ PTDIM => IO_Dimcdf_get_nc4(TPFILE, ISIZE)
ELSE
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4','can not guess 2nd dimension for field '//TRIM(TPFIELD%CMNHNAME))
+ 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
@@ -188,20 +191,20 @@ ELSE
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 => GETDIMCDF(TPFILE,ISIZE)
+ PTDIM => IO_Dimcdf_get_nc4(TPFILE,ISIZE)
ELSE
PTDIM => TPFILE%TNCCOORDS(3,IGRID)%TDIM
END IF
ELSE IF (JI==TPFIELD%NDIMS) THEN !Guess last dimension
ISIZE = KLEN/ILEN
IF (MOD(KLEN,ILEN)/=0) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4', &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Dimids_guess_nc4', &
'can not guess 3rd and last dimension for field '//TRIM(TPFIELD%CMNHNAME))
EXIT
END IF
- PTDIM => GETDIMCDF(TPFILE, ISIZE)
+ PTDIM => IO_Dimcdf_get_nc4(TPFILE, ISIZE)
ELSE
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4','can not guess 3rd dimension for field '//TRIM(TPFIELD%CMNHNAME))
+ 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
@@ -209,30 +212,30 @@ ELSE
ELSE IF (JI==4 .AND. JI==TPFIELD%NDIMS) THEN !Guess last dimension
ISIZE = KLEN/ILEN
IF (MOD(KLEN,ILEN)/=0) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4', &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Dimids_guess_nc4', &
'can not guess 4th and last dimension for field '//TRIM(TPFIELD%CMNHNAME))
EXIT
END IF
- PTDIM => GETDIMCDF(TPFILE, ISIZE)
+ PTDIM => IO_Dimcdf_get_nc4(TPFILE, ISIZE)
ILEN = ILEN * PTDIM%LEN
TPDIMS(JI) = PTDIM
ELSE
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_GUESS_DIMIDS_NC4','can not guess dimension above 4 for field '&
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Dimids_guess_nc4','can not guess dimension above 4 for field '&
//TRIM(TPFIELD%CMNHNAME))
END IF
END DO
END IF
!
IF (KLEN /= ILEN) THEN
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_GUESS_DIMIDS_NC4','can not guess dimensions of field '&
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_Dimids_guess_nc4','can not guess dimensions of field '&
//TRIM(TPFIELD%CMNHNAME))
KRESP = 1
END IF
!
-END SUBROUTINE IO_GUESS_DIMIDS_NC4
+END SUBROUTINE IO_Dimids_guess_nc4
-SUBROUTINE IO_SET_KNOWNDIMS_NC4(TPFILE,HPROGRAM_ORIG)
+SUBROUTINE IO_Knowndims_set_nc4(TPFILE,HPROGRAM_ORIG)
USE MODD_CONF, ONLY: CPROGRAM
USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
@@ -246,7 +249,7 @@ CHARACTER(LEN=:),ALLOCATABLE :: YPROGRAM
INTEGER :: IIU_ll, IJU_ll, IKU
TYPE(IOCDF), POINTER :: PIOCDF
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_SET_KNOWNDIMS_NC4','called for '//TRIM(TPFILE%CNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Knowndims_set_nc4','called for '//TRIM(TPFILE%CNAME))
PIOCDF => TPFILE%TNCDIMS
@@ -260,17 +263,17 @@ 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 => GETDIMCDF(TPFILE, IIU_ll, 'ni')
-IF (.NOT. ASSOCIATED(PIOCDF%DIM_NJ)) PIOCDF%DIM_NJ => GETDIMCDF(TPFILE, IJU_ll, 'nj')
-IF (.NOT. ASSOCIATED(PIOCDF%DIM_NI_U)) PIOCDF%DIM_NI_U => GETDIMCDF(TPFILE, IIU_ll, 'ni_u')
-IF (.NOT. ASSOCIATED(PIOCDF%DIM_NJ_U)) PIOCDF%DIM_NJ_U => GETDIMCDF(TPFILE, IJU_ll, 'nj_u')
-IF (.NOT. ASSOCIATED(PIOCDF%DIM_NI_V)) PIOCDF%DIM_NI_V => GETDIMCDF(TPFILE, IIU_ll, 'ni_v')
-IF (.NOT. ASSOCIATED(PIOCDF%DIM_NJ_V)) PIOCDF%DIM_NJ_V => GETDIMCDF(TPFILE, IJU_ll, 'nj_v')
+IF (.NOT. ASSOCIATED(PIOCDF%DIM_NI)) PIOCDF%DIM_NI => IO_Dimcdf_get_nc4(TPFILE, IIU_ll, 'ni')
+IF (.NOT. ASSOCIATED(PIOCDF%DIM_NJ)) PIOCDF%DIM_NJ => IO_Dimcdf_get_nc4(TPFILE, IJU_ll, 'nj')
+IF (.NOT. ASSOCIATED(PIOCDF%DIM_NI_U)) PIOCDF%DIM_NI_U => IO_Dimcdf_get_nc4(TPFILE, IIU_ll, 'ni_u')
+IF (.NOT. ASSOCIATED(PIOCDF%DIM_NJ_U)) PIOCDF%DIM_NJ_U => IO_Dimcdf_get_nc4(TPFILE, IJU_ll, 'nj_u')
+IF (.NOT. ASSOCIATED(PIOCDF%DIM_NI_V)) PIOCDF%DIM_NI_V => IO_Dimcdf_get_nc4(TPFILE, IIU_ll, 'ni_v')
+IF (.NOT. ASSOCIATED(PIOCDF%DIM_NJ_V)) PIOCDF%DIM_NJ_V => IO_Dimcdf_get_nc4(TPFILE, IJU_ll, '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 => GETDIMCDF(TPFILE, IKU , 'level')
- IF (.NOT. ASSOCIATED(PIOCDF%DIM_LEVEL_W)) PIOCDF%DIM_LEVEL_W => GETDIMCDF(TPFILE, IKU , 'level_w')
- IF (.NOT. ASSOCIATED(PIOCDF%DIMTIME)) PIOCDF%DIMTIME => GETDIMCDF(TPFILE, NF90_UNLIMITED, 'time')
+ IF (.NOT. ASSOCIATED(PIOCDF%DIM_LEVEL)) PIOCDF%DIM_LEVEL => IO_Dimcdf_get_nc4(TPFILE, IKU , 'level')
+ IF (.NOT. ASSOCIATED(PIOCDF%DIM_LEVEL_W)) PIOCDF%DIM_LEVEL_W => IO_Dimcdf_get_nc4(TPFILE, IKU , '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
@@ -321,15 +324,15 @@ TPFILE%TNCCOORDS(2,8)%TDIM => PIOCDF%DIM_NJ_V
TPFILE%TNCCOORDS(3,8)%TDIM => PIOCDF%DIM_LEVEL_W
-END SUBROUTINE IO_SET_KNOWNDIMS_NC4
+END SUBROUTINE IO_Knowndims_set_nc4
-SUBROUTINE CLEANIOCDF(PIOCDF)
+SUBROUTINE IO_Iocdf_dealloc_nc4(PIOCDF)
TYPE(IOCDF), POINTER :: PIOCDF
-INTEGER(KIND=IDCDF_KIND) :: IRESP
+INTEGER(KIND=CDFINT) :: IRESP
-CALL PRINT_MSG(NVERB_DEBUG,'IO','CLEANIOCDF','called')
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Iocdf_dealloc_nc4','called')
! Clean DIMLIST and DIMSTR
CALL CLEANLIST(PIOCDF%DIMLIST)
@@ -351,14 +354,14 @@ END DO
END SUBROUTINE CLEANLIST
-END SUBROUTINE CLEANIOCDF
+END SUBROUTINE IO_Iocdf_dealloc_nc4
-SUBROUTINE FILLVDIMS(TPFILE, TPFIELD, KSHAPE, KVDIMS)
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
-INTEGER(KIND=IDCDF_KIND),DIMENSION(:),INTENT(IN) :: KSHAPE
-INTEGER(KIND=IDCDF_KIND),DIMENSION(:),ALLOCATABLE,INTENT(OUT) :: KVDIMS
+SUBROUTINE IO_Vdims_fill_nc4(TPFILE, TPFIELD, KSHAPE, KVDIMS)
+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
@@ -366,16 +369,16 @@ CHARACTER(LEN=32) :: YINT
CHARACTER(LEN=2) :: YDIR
TYPE(DIMCDF), POINTER :: PTDIM
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','FILLVDIMS','called for '//TRIM(TPFIELD%CMNHNAME))
+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','FILLVDIMS','empty KSHAPE')
+IF (SIZE(KSHAPE) < 1 .AND. .NOT.TPFIELD%LTIMEDEP) CALL PRINT_MSG(NVERB_FATAL,'IO','IO_Vdims_fill_nc4','empty KSHAPE')
!
IGRID = TPFIELD%NGRID
YDIR = TPFIELD%CDIR
!
IF(SIZE(KSHAPE)/=TPFIELD%NDIMS) THEN
WRITE(YINT,'( I0,"/",I0 )') SIZE(KSHAPE),TPFIELD%NDIMS
- CALL PRINT_MSG(NVERB_FATAL,'IO','FILLVDIMS','SIZE(KSHAPE)/=TPFIELD%NDIMS ('//TRIM(YINT)//') for field ' &
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_Vdims_fill_nc4','SIZE(KSHAPE)/=TPFIELD%NDIMS ('//TRIM(YINT)//') for field ' &
//TRIM(TPFIELD%CMNHNAME))
END IF
!
@@ -389,11 +392,12 @@ END IF
!
IF(IGRID<0 .OR. IGRID>8) THEN
WRITE(YINT,'( I0 )') IGRID
- CALL PRINT_MSG(NVERB_FATAL,'IO','FILLVDIMS','invalid NGRID ('//TRIM(YINT)//') for field '//TRIM(TPFIELD%CMNHNAME))
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_Vdims_fill_nc4','invalid NGRID ('//TRIM(YINT)//') for field '//TRIM(TPFIELD%CMNHNAME))
END IF
!
IF(IGRID==0 .AND. YDIR/='--' .AND. YDIR/='' ) THEN
- CALL PRINT_MSG(NVERB_FATAL,'IO','FILLVDIMS','invalid YDIR ('//TRIM(YDIR)//') with NGRID=0 for field '//TRIM(TPFIELD%CMNHNAME))
+ 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)
@@ -405,44 +409,44 @@ DO JI=1,SIZE(KSHAPE)
ELSE IF ( YDIR == 'ZZ' .AND. KSHAPE(1)==TPFILE%TNCCOORDS(3,IGRID)%TDIM%LEN) THEN
KVDIMS(1) = TPFILE%TNCCOORDS(3,IGRID)%TDIM%ID
ELSE
- PTDIM => GETDIMCDF(TPFILE, KSHAPE(1)); KVDIMS(1) = PTDIM%ID
+ 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 => GETDIMCDF(TPFILE, KSHAPE(2)); KVDIMS(2) = PTDIM%ID
+ 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 => GETDIMCDF(TPFILE, KSHAPE(3)); KVDIMS(3) = PTDIM%ID
+ PTDIM => IO_Dimcdf_get_nc4(TPFILE, KSHAPE(3)); KVDIMS(3) = PTDIM%ID
END IF
ELSE
- PTDIM => GETDIMCDF(TPFILE, KSHAPE(JI)); KVDIMS(JI) = PTDIM%ID
+ PTDIM => IO_Dimcdf_get_nc4(TPFILE, KSHAPE(JI)); KVDIMS(JI) = PTDIM%ID
END IF
END DO
!
-END SUBROUTINE FILLVDIMS
+END SUBROUTINE IO_Vdims_fill_nc4
-FUNCTION GETDIMCDF(TPFILE, KLEN, HDIMNAME)
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KLEN
-CHARACTER(LEN=*), OPTIONAL :: HDIMNAME ! When provided don't search but
- ! simply create with name HDIMNAME
-TYPE(DIMCDF), POINTER :: GETDIMCDF
+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
TYPE(DIMCDF), POINTER :: TMP
INTEGER :: COUNT
CHARACTER(LEN=16) :: YSUFFIX
CHARACTER(LEN=20) :: YDIMNAME
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-LOGICAL :: GCHKLEN !Check if KLEN is valid
-TYPE(IOCDF), POINTER :: PIOCDF
+INTEGER(KIND=CDFINT) :: STATUS
+LOGICAL :: GCHKLEN !Check if KLEN is valid
+TYPE(IOCDF), POINTER :: PIOCDF
-CALL PRINT_MSG(NVERB_DEBUG,'IO','GETDIMCDF','called')
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Dimcdf_get_nc4','called')
PIOCDF => TPFILE%TNCDIMS
@@ -457,7 +461,7 @@ END IF
WRITE(YSUFFIX,'(I0)') KLEN
IF (GCHKLEN .AND. KLEN < 1) THEN
- CALL PRINT_MSG(NVERB_FATAL,'IO','GETDIMCDF','KLEN='//TRIM(YSUFFIX))
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_Dimcdf_get_nc4','KLEN='//TRIM(YSUFFIX))
END IF
IF (PRESENT(HDIMNAME)) THEN
@@ -481,34 +485,34 @@ IF (.NOT. ASSOCIATED(TMP)) THEN
TMP%NAME = YDIMNAME
TMP%LEN = KLEN
STATUS = NF90_DEF_DIM(TPFILE%NNCID, TMP%NAME, KLEN, TMP%ID)
- IF (STATUS /= NF90_NOERR) CALL io_handle_err_nc4(status,'GETDIMCDF','NF90_DEF_DIM',trim(TMP%NAME))
+ 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','GETDIMCDF','new dimension: '//TRIM(TMP%NAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Dimcdf_get_nc4','new dimension: '//TRIM(TMP%NAME))
END IF
-GETDIMCDF => TMP
+IO_Dimcdf_get_nc4 => TMP
-END FUNCTION GETDIMCDF
+END FUNCTION IO_Dimcdf_get_nc4
-FUNCTION GETSTRDIMID(TPFILE,KLEN)
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KLEN
-INTEGER(KIND=IDCDF_KIND) :: GETSTRDIMID
+FUNCTION IO_Strdimid_get_nc4(TPFILE,KLEN)
+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=IDCDF_KIND) :: STATUS
+INTEGER(KIND=CDFINT) :: STATUS
-CALL PRINT_MSG(NVERB_DEBUG,'IO','GETSTRDIMID','called')
+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','GETSTRDIMID','KLEN='//TRIM(YSUFFIX))
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_Strdimid_get_nc4','KLEN='//TRIM(YSUFFIX))
END IF
! Search string dimension with KLEN length
@@ -524,42 +528,41 @@ IF (.NOT. ASSOCIATED(TMP)) THEN
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_handle_err_nc4(status,'GETSTRDIMID','NF90_DEF_DIM',trim(TMP%NAME))
+ 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
-GETSTRDIMID = TMP%ID
+IO_Strdimid_get_nc4 = TMP%ID
-END FUNCTION GETSTRDIMID
+END FUNCTION IO_Strdimid_get_nc4
-FUNCTION NEWIOCDF()
-TYPE(IOCDF), POINTER :: NEWIOCDF
+FUNCTION IO_Iocdf_alloc_nc4()
+TYPE(IOCDF), POINTER :: IO_Iocdf_alloc_nc4
TYPE(IOCDF), POINTER :: TZIOCDF
INTEGER :: IRESP
-CALL PRINT_MSG(NVERB_DEBUG,'IO','NEWIOCDF','called')
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Iocdf_alloc_nc4','called')
ALLOCATE(TZIOCDF, STAT=IRESP)
IF (IRESP > 0) THEN
- CALL PRINT_MSG(NVERB_FATAL,'IO','NEWIOCDF','memory allocation error')
- STOP
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_Iocdf_alloc_nc4','memory allocation error')
END IF
-NEWIOCDF=>TZIOCDF
+IO_Iocdf_alloc_nc4=>TZIOCDF
-END FUNCTION NEWIOCDF
+END FUNCTION IO_Iocdf_alloc_nc4
-subroutine io_handle_err_nc4(kstatus,hsubr,hncsubr,hvar,kresp)
-integer(kind=IDCDF_KIND),intent(in) :: kstatus
-character(len=*), intent(in) :: hsubr
-character(len=*), intent(in) :: hncsubr
-character(len=*), intent(in) :: hvar
-integer, optional, intent(out) :: kresp
+subroutine IO_Err_handle_nc4(kstatus,hsubr,hncsubr,hvar,kresp)
+integer(kind=CDFINT), intent(in) :: kstatus
+character(len=*), intent(in) :: hsubr
+character(len=*), intent(in) :: hncsubr
+character(len=*), intent(in) :: hvar
+integer, optional, intent(out) :: kresp
! Don't stop (by default) the code when kresp is present
! and ensure kresp is a negative integer
@@ -575,10 +578,10 @@ if (kstatus /= NF90_NOERR) then
call print_msg(NVERB_ERROR, 'IO',trim(hsubr),trim(hvar)//': '//trim(hncsubr)//': '//trim(NF90_STRERROR(kstatus)))
end if
end if
-end subroutine io_handle_err_nc4
+end subroutine IO_Err_handle_nc4
-SUBROUTINE CLEANMNHNAME(HINNAME,HOUTNAME)
+SUBROUTINE IO_Mnhname_clean(HINNAME,HOUTNAME)
CHARACTER(LEN=*),INTENT(IN) :: HINNAME
CHARACTER(LEN=*),INTENT(OUT) :: HOUTNAME
@@ -610,66 +613,66 @@ end module mode_io_tools_nc4
!
! External dummy subroutines
!
-subroutine io_find_dim_byname_nc4(a, b, c, d)
+subroutine IO_Dim_find_byname_nc4(a, b, c, d)
use mode_msg
integer :: a, b, c, d
-CALL PRINT_MSG(NVERB_ERROR,'IO','io_find_dim_byname_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
-end subroutine io_find_dim_byname_nc4
+CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Dim_find_byname_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end subroutine IO_Dim_find_byname_nc4
!
-subroutine io_guess_dimids_nc4(a, b, c, d)
+subroutine IO_Dimids_guess_nc4(a, b, c, d)
use mode_msg
integer :: a, b, c, d
-CALL PRINT_MSG(NVERB_ERROR,'IO','io_guess_dimids_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
-end subroutine io_guess_dimids_nc4
+CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Dimids_guess_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end subroutine IO_Dimids_guess_nc4
!
-subroutine io_set_knowndims_nc4(a, b)
+subroutine IO_Knowndims_set_nc4(a, b)
use mode_msg
integer :: a, b,
-CALL PRINT_MSG(NVERB_ERROR,'IO','io_set_knowndims_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
-end subroutine io_set_knowndims_nc4
+CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Knowndims_set_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end subroutine IO_Knowndims_set_nc4
!
-subroutine cleaniocdf(a)
+subroutine IO_Iocdf_dealloc_nc4(a)
use mode_msg
integer :: a
-CALL PRINT_MSG(NVERB_ERROR,'IO','cleaniocdf','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
-end subroutine cleaniocdf
+CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Iocdf_dealloc_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end subroutine IO_Iocdf_dealloc_nc4
!
-subroutine cleanmnhname(a, b)
+subroutine IO_Mnhname_clean(a, b)
use mode_msg
integer :: a, b
-CALL PRINT_MSG(NVERB_ERROR,'IO','cleanmnhname','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
-end subroutine cleanmnhname
+CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Mnhname_clean','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end subroutine IO_Mnhname_clean
!
-subroutine fillvdims(a, b, c, d)
+subroutine IO_Vdims_fill_nc4(a, b, c, d)
use mode_msg
integer :: a, b, c, d
-CALL PRINT_MSG(NVERB_ERROR,'IO','fillvdims','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
-end subroutine fillvdims
+CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Vdims_fill_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end subroutine IO_Vdims_fill_nc4
!
-function getdimcdf(a, b, c)
+function IO_Dimcdf_get_nc4(a, b, c)
use mode_msg
-integer :: getdimcdf
+integer :: IO_Dimcdf_get_nc4
integer :: a, b, c
-CALL PRINT_MSG(NVERB_ERROR,'IO','getdimcdf','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
-end function getdimcdf
+CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Dimcdf_get_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end function IO_Dimcdf_get_nc4
!
-function getstrdimid(a, b)
+function IO_Strdimid_get_nc4(a, b)
use mode_msg
-integer :: getstrdimid
+integer :: IO_Strdimid_get_nc4
integer :: a, b
-CALL PRINT_MSG(NVERB_ERROR,'IO','getstrdimid','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
-end function getstrdimid
+CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Strdimid_get_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end function IO_Strdimid_get_nc4
!
-subroutine io_handle_err_nc4(a, b, c, d, e)
+subroutine IO_Err_handle_nc4(a, b, c, d, e)
use mode_msg
integer :: a, b, c, d, e
-CALL PRINT_MSG(NVERB_ERROR,'IO','io_handle_err_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
-end subroutine io_handle_err_nc4
+CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Err_handle_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end subroutine IO_Err_handle_nc4
!
-function newiocdf()
+function IO_Iocdf_alloc_nc4()
use mode_msg
-integer :: newiocdf
-CALL PRINT_MSG(NVERB_ERROR,'IO','newiocdf','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
-end function newiocdf()
+integer :: IO_Iocdf_alloc_nc4
+CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Iocdf_alloc_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end function IO_Iocdf_alloc_nc4()
!
#endif
diff --git a/src/LIB/SURCOUCHE/src/mode_io_write_lfi.f90 b/src/LIB/SURCOUCHE/src/mode_io_write_lfi.f90
index 0ec7744765e80f6213d09536da78c95a03946679..26f18bc04cee5ec685bbc4d1d07d1c83964aa6fa 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_write_lfi.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_write_lfi.f90
@@ -3,44 +3,47 @@
!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_io_write_lfi
! Modifications:
-! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! Philippe Wautelet: 21/06/2018: read and write correctly if MNH_REAL=4
-! Philippe Wautelet: 14/12/2018: split fmreadwrit.f90
-! Philippe Wautelet: 11/01/2019: do not write variables with a zero size
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 21/06/2018: read and write correctly if MNH_REAL=4
+! 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
+!-----------------------------------------------------------------
+module mode_io_write_lfi
!
-USE MODD_IO_ll
+USE MODD_IO
USE MODD_PARAMETERS, ONLY: NLFIMAXCOMMENTLENGTH
+use modd_precision, only: LFIINT
!
-USE MODE_FIELD, ONLY : TFIELDDATA
+USE MODE_FIELD, ONLY: TFIELDDATA
USE MODE_MSG
!
IMPLICIT NONE
!
PRIVATE
!
+public :: IO_Field_write_lfi
+!
INTEGER, PARAMETER :: JPXKRK = NLFIMAXCOMMENTLENGTH
INTEGER, PARAMETER :: JPXFIE = 1.5E8
!
-INTERFACE IO_WRITE_FIELD_LFI
- MODULE PROCEDURE IO_WRITE_FIELD_LFI_X0,IO_WRITE_FIELD_LFI_X1, &
- IO_WRITE_FIELD_LFI_X2,IO_WRITE_FIELD_LFI_X3, &
- IO_WRITE_FIELD_LFI_X4,IO_WRITE_FIELD_LFI_X5, &
- IO_WRITE_FIELD_LFI_X6, &
- IO_WRITE_FIELD_LFI_N0,IO_WRITE_FIELD_LFI_N1, &
- IO_WRITE_FIELD_LFI_N2,IO_WRITE_FIELD_LFI_N3, &
- IO_WRITE_FIELD_LFI_L0,IO_WRITE_FIELD_LFI_L1, &
- IO_WRITE_FIELD_LFI_C0, &
- IO_WRITE_FIELD_LFI_T0
-END INTERFACE IO_WRITE_FIELD_LFI
-!
-PUBLIC IO_WRITE_FIELD_LFI
+INTERFACE IO_Field_write_lfi
+ MODULE PROCEDURE IO_Field_write_lfi_X0,IO_Field_write_lfi_X1, &
+ IO_Field_write_lfi_X2,IO_Field_write_lfi_X3, &
+ IO_Field_write_lfi_X4,IO_Field_write_lfi_X5, &
+ 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_L0,IO_Field_write_lfi_L1, &
+ IO_Field_write_lfi_C0, &
+ IO_Field_write_lfi_T0
+END INTERFACE IO_Field_write_lfi
!
CONTAINS
!
!
-SUBROUTINE IO_WRITE_FIELD_LFI_X0(TPFILE,TPFIELD,PFIELD,KRESP)
+SUBROUTINE IO_Field_write_lfi_X0(TPFILE,TPFIELD,PFIELD,KRESP)
!
IMPLICIT NONE
!
@@ -54,11 +57,11 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
!* 0.2 Declarations of local variables
!
INTEGER :: ILENG
-INTEGER(KIND=LFI_INT) :: IRESP, ITOTAL
+INTEGER(KIND=LFIINT) :: IRESP, ITOTAL
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
CHARACTER(LEN=LEN_HREC) :: YRECFM
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_LFI_X0','writing '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_X0','writing '//TRIM(TPFIELD%CMNHNAME))
!
ILENG = 1
!
@@ -68,7 +71,7 @@ IF (IRESP==0) THEN
CALL TRANSFER_R_I8( (/PFIELD/) , IWORK(LEN(TPFIELD%CCOMMENT)+3:) )
YRECFM=TRIM(TPFIELD%CMNHNAME)
IF( LEN_TRIM(TPFIELD%CMNHNAME) > LEN(YRECFM) ) &
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_X0','field name was truncated to '&
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_X0','field name was truncated to '&
//YRECFM//' for '//TRIM(TPFIELD%CMNHNAME))
CALL LFIECR(IRESP,TPFILE%NLFIFLU,TRIM(TPFIELD%CMNHNAME),IWORK,ITOTAL)
ENDIF
@@ -77,9 +80,9 @@ KRESP=IRESP
!
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
-END SUBROUTINE IO_WRITE_FIELD_LFI_X0
+END SUBROUTINE IO_Field_write_lfi_X0
!
-SUBROUTINE IO_WRITE_FIELD_LFI_X1(TPFILE,TPFIELD,PFIELD,KRESP)
+SUBROUTINE IO_Field_write_lfi_X1(TPFILE,TPFIELD,PFIELD,KRESP)
!
IMPLICIT NONE
!
@@ -93,16 +96,16 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
!* 0.2 Declarations of local variables
!
INTEGER :: ILENG
-INTEGER(kind=LFI_INT) :: IRESP, ITOTAL
+INTEGER(kind=LFIINT) :: IRESP, ITOTAL
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
CHARACTER(LEN=LEN_HREC) :: YRECFM
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_LFI_X1','writing '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_X1','writing '//TRIM(TPFIELD%CMNHNAME))
!
ILENG = SIZE(PFIELD)
!
IF ( ILENG==0 ) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_X1','ignoring variable with a zero size ('//TRIM(TPFIELD%CMNHNAME)//')')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_X1','ignoring variable with a zero size ('//TRIM(TPFIELD%CMNHNAME)//')')
KRESP = 0
RETURN
END IF
@@ -113,7 +116,7 @@ IF (IRESP==0) THEN
CALL TRANSFER_R_I8(PFIELD,IWORK(LEN(TPFIELD%CCOMMENT)+3:))
YRECFM=TRIM(TPFIELD%CMNHNAME)
IF( LEN_TRIM(TPFIELD%CMNHNAME) > LEN(YRECFM) ) &
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_X1','field name was truncated to '&
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_X1','field name was truncated to '&
//YRECFM//' for '//TRIM(TPFIELD%CMNHNAME))
CALL LFIECR(IRESP,TPFILE%NLFIFLU,YRECFM,IWORK,ITOTAL)
ENDIF
@@ -122,9 +125,9 @@ KRESP=IRESP
!
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
-END SUBROUTINE IO_WRITE_FIELD_LFI_X1
+END SUBROUTINE IO_Field_write_lfi_X1
!
-SUBROUTINE IO_WRITE_FIELD_LFI_X2(TPFILE,TPFIELD,PFIELD,KRESP,KVERTLEVEL,KZFILE)
+SUBROUTINE IO_Field_write_lfi_X2(TPFILE,TPFIELD,PFIELD,KRESP,KVERTLEVEL,KZFILE)
!
IMPLICIT NONE
!
@@ -140,7 +143,7 @@ INTEGER,OPTIONAL, INTENT(IN) :: KZFILE ! Number of the Z-level splitted
!* 0.2 Declarations of local variables
!
INTEGER :: ILENG
-INTEGER(kind=LFI_INT) :: IRESP, ITOTAL
+INTEGER(kind=LFIINT) :: IRESP, ITOTAL
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
CHARACTER(LEN=4) :: YSUFFIX
CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)+4) :: YVARNAME
@@ -152,26 +155,26 @@ IRESP=0
ILENG = SIZE(PFIELD)
!
IF ( ILENG==0 ) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_X2','ignoring variable with a zero size ('//TRIM(TPFIELD%CMNHNAME)//')')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_X2','ignoring variable with a zero size ('//TRIM(TPFIELD%CMNHNAME)//')')
KRESP = 0
RETURN
END IF
!
IF (PRESENT(KVERTLEVEL)) THEN
IF (.NOT.PRESENT(KZFILE)) THEN
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_LFI_X2','KZFILE argument not provided')
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_lfi_X2','KZFILE argument not provided')
RETURN
END IF
WRITE(YSUFFIX,'(I4.4)') KVERTLEVEL
YVARNAME = TRIM(TPFIELD%CMNHNAME)//YSUFFIX
- IF (KZFILE>TPFILE%NSUBFILES_IOZ) CALL PRINT_MSG(NVERB_FATAL,'IO','IO_WRITE_FIELD_LFI_X2','KZFILE value too high')
+ IF (KZFILE>TPFILE%NSUBFILES_IOZ) CALL PRINT_MSG(NVERB_FATAL,'IO','IO_Field_write_lfi_X2','KZFILE value too high')
TZFILE => TPFILE%TFILES_IOZ(KZFILE)%TFILE
ELSE
YVARNAME = TRIM(TPFIELD%CMNHNAME)
TZFILE => TPFILE
ENDIF
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_LFI_X2','writing '//TRIM(YVARNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_X2','writing '//TRIM(YVARNAME))
!
CALL WRITE_PREPARE(TPFIELD,ILENG,IWORK,ITOTAL,IRESP)
!
@@ -179,7 +182,7 @@ IF (IRESP==0) THEN
CALL TRANSFER_R_I8(RESHAPE(PFIELD,(/ILENG/)),IWORK(LEN(TPFIELD%CCOMMENT)+3:))
YRECFM=TRIM(YVARNAME)
IF( LEN_TRIM(YVARNAME) > LEN(YRECFM) ) &
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_X2','field name was truncated to '&
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_X2','field name was truncated to '&
//YRECFM//' for '//TRIM(YVARNAME))
CALL LFIECR(IRESP,TZFILE%NLFIFLU,YRECFM,IWORK,ITOTAL)
ENDIF
@@ -188,9 +191,9 @@ KRESP=IRESP
!
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
-END SUBROUTINE IO_WRITE_FIELD_LFI_X2
+END SUBROUTINE IO_Field_write_lfi_X2
!
-SUBROUTINE IO_WRITE_FIELD_LFI_X3(TPFILE,TPFIELD,PFIELD,KRESP)
+SUBROUTINE IO_Field_write_lfi_X3(TPFILE,TPFIELD,PFIELD,KRESP)
!
IMPLICIT NONE
!
@@ -204,16 +207,16 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
!* 0.2 Declarations of local variables
!
INTEGER :: ILENG
-INTEGER(kind=LFI_INT) :: IRESP, ITOTAL
+INTEGER(kind=LFIINT) :: IRESP, ITOTAL
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
CHARACTER(LEN=LEN_HREC) :: YRECFM
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_LFI_X3','writing '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_X3','writing '//TRIM(TPFIELD%CMNHNAME))
!
ILENG = SIZE(PFIELD)
!
IF ( ILENG==0 ) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_X3','ignoring variable with a zero size ('//TRIM(TPFIELD%CMNHNAME)//')')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_X3','ignoring variable with a zero size ('//TRIM(TPFIELD%CMNHNAME)//')')
KRESP = 0
RETURN
END IF
@@ -224,7 +227,7 @@ IF (IRESP==0) THEN
CALL TRANSFER_R_I8(RESHAPE(PFIELD,(/ILENG/)),IWORK(LEN(TPFIELD%CCOMMENT)+3:))
YRECFM=TRIM(TPFIELD%CMNHNAME)
IF( LEN_TRIM(TPFIELD%CMNHNAME) > LEN(YRECFM) ) &
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_X3','field name was truncated to '&
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_X3','field name was truncated to '&
//YRECFM//' for '//TRIM(TPFIELD%CMNHNAME))
CALL LFIECR(IRESP,TPFILE%NLFIFLU,YRECFM,IWORK,ITOTAL)
ENDIF
@@ -233,9 +236,9 @@ KRESP=IRESP
!
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
-END SUBROUTINE IO_WRITE_FIELD_LFI_X3
+END SUBROUTINE IO_Field_write_lfi_X3
!
-SUBROUTINE IO_WRITE_FIELD_LFI_X4(TPFILE,TPFIELD,PFIELD,KRESP)
+SUBROUTINE IO_Field_write_lfi_X4(TPFILE,TPFIELD,PFIELD,KRESP)
!
IMPLICIT NONE
!
@@ -249,16 +252,16 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
!* 0.2 Declarations of local variables
!
INTEGER :: ILENG
-INTEGER(kind=LFI_INT) :: IRESP, ITOTAL
+INTEGER(kind=LFIINT) :: IRESP, ITOTAL
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
CHARACTER(LEN=LEN_HREC) :: YRECFM
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_LFI_X4','writing '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_X4','writing '//TRIM(TPFIELD%CMNHNAME))
!
ILENG = SIZE(PFIELD)
!
IF ( ILENG==0 ) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_X4','ignoring variable with a zero size ('//TRIM(TPFIELD%CMNHNAME)//')')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_X4','ignoring variable with a zero size ('//TRIM(TPFIELD%CMNHNAME)//')')
KRESP = 0
RETURN
END IF
@@ -269,7 +272,7 @@ IF (IRESP==0) THEN
CALL TRANSFER_R_I8(RESHAPE(PFIELD,(/ILENG/)),IWORK(LEN(TPFIELD%CCOMMENT)+3:))
YRECFM=TRIM(TPFIELD%CMNHNAME)
IF( LEN_TRIM(TPFIELD%CMNHNAME) > LEN(YRECFM) ) &
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_X4','field name was truncated to '&
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_X4','field name was truncated to '&
//YRECFM//' for '//TRIM(TPFIELD%CMNHNAME))
CALL LFIECR(IRESP,TPFILE%NLFIFLU,YRECFM,IWORK,ITOTAL)
ENDIF
@@ -278,9 +281,9 @@ KRESP=IRESP
!
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
-END SUBROUTINE IO_WRITE_FIELD_LFI_X4
+END SUBROUTINE IO_Field_write_lfi_X4
!
-SUBROUTINE IO_WRITE_FIELD_LFI_X5(TPFILE,TPFIELD,PFIELD,KRESP)
+SUBROUTINE IO_Field_write_lfi_X5(TPFILE,TPFIELD,PFIELD,KRESP)
!
IMPLICIT NONE
!
@@ -294,16 +297,16 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
!* 0.2 Declarations of local variables
!
INTEGER :: ILENG
-INTEGER(kind=LFI_INT) :: IRESP, ITOTAL
+INTEGER(kind=LFIINT) :: IRESP, ITOTAL
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
CHARACTER(LEN=LEN_HREC) :: YRECFM
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_LFI_X5','writing '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_X5','writing '//TRIM(TPFIELD%CMNHNAME))
!
ILENG = SIZE(PFIELD)
!
IF ( ILENG==0 ) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_X5','ignoring variable with a zero size ('//TRIM(TPFIELD%CMNHNAME)//')')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_X5','ignoring variable with a zero size ('//TRIM(TPFIELD%CMNHNAME)//')')
KRESP = 0
RETURN
END IF
@@ -314,7 +317,7 @@ IF (IRESP==0) THEN
CALL TRANSFER_R_I8(RESHAPE(PFIELD,(/ILENG/)),IWORK(LEN(TPFIELD%CCOMMENT)+3:))
YRECFM=TRIM(TPFIELD%CMNHNAME)
IF( LEN_TRIM(TPFIELD%CMNHNAME) > LEN(YRECFM) ) &
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_X5','field name was truncated to '&
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_X5','field name was truncated to '&
//YRECFM//' for '//TRIM(TPFIELD%CMNHNAME))
CALL LFIECR(IRESP,TPFILE%NLFIFLU,YRECFM,IWORK,ITOTAL)
ENDIF
@@ -323,9 +326,9 @@ KRESP=IRESP
!
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
-END SUBROUTINE IO_WRITE_FIELD_LFI_X5
+END SUBROUTINE IO_Field_write_lfi_X5
!
-SUBROUTINE IO_WRITE_FIELD_LFI_X6(TPFILE,TPFIELD,PFIELD,KRESP)
+SUBROUTINE IO_Field_write_lfi_X6(TPFILE,TPFIELD,PFIELD,KRESP)
!
IMPLICIT NONE
!
@@ -339,16 +342,16 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems arais
!* 0.2 Declarations of local variables
!
INTEGER :: ILENG
-INTEGER(kind=LFI_INT) :: IRESP, ITOTAL
+INTEGER(kind=LFIINT) :: IRESP, ITOTAL
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
CHARACTER(LEN=LEN_HREC) :: YRECFM
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_LFI_X6','writing '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_X6','writing '//TRIM(TPFIELD%CMNHNAME))
!
ILENG = SIZE(PFIELD)
!
IF ( ILENG==0 ) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_X6','ignoring variable with a zero size ('//TRIM(TPFIELD%CMNHNAME)//')')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_X6','ignoring variable with a zero size ('//TRIM(TPFIELD%CMNHNAME)//')')
KRESP = 0
RETURN
END IF
@@ -359,7 +362,7 @@ IF (IRESP==0) THEN
CALL TRANSFER_R_I8(RESHAPE(PFIELD,(/ILENG/)),IWORK(LEN(TPFIELD%CCOMMENT)+3:))
YRECFM=TRIM(TPFIELD%CMNHNAME)
IF( LEN_TRIM(TPFIELD%CMNHNAME) > LEN(YRECFM) ) &
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_X6','field name was truncated to '&
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_X6','field name was truncated to '&
//YRECFM//' for '//TRIM(TPFIELD%CMNHNAME))
CALL LFIECR(IRESP,TPFILE%NLFIFLU,YRECFM,IWORK,ITOTAL)
ENDIF
@@ -368,9 +371,9 @@ KRESP=IRESP
!
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
-END SUBROUTINE IO_WRITE_FIELD_LFI_X6
+END SUBROUTINE IO_Field_write_lfi_X6
!
-SUBROUTINE IO_WRITE_FIELD_LFI_N0(TPFILE,TPFIELD,KFIELD,KRESP)
+SUBROUTINE IO_Field_write_lfi_N0(TPFILE,TPFIELD,KFIELD,KRESP)
!
IMPLICIT NONE
!
@@ -384,11 +387,11 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
!* 0.2 Declarations of local variables
!
INTEGER :: ILENG
-INTEGER(kind=LFI_INT) :: IRESP, ITOTAL
+INTEGER(kind=LFIINT) :: IRESP, ITOTAL
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
CHARACTER(LEN=LEN_HREC) :: YRECFM
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_LFI_N0','writing '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_N0','writing '//TRIM(TPFIELD%CMNHNAME))
!
ILENG = 1
!
@@ -398,7 +401,7 @@ IF (IRESP==0) THEN
IWORK(LEN(TPFIELD%CCOMMENT)+3)=KFIELD
YRECFM=TRIM(TPFIELD%CMNHNAME)
IF( LEN_TRIM(TPFIELD%CMNHNAME) > LEN(YRECFM) ) &
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_N0','field name was truncated to '&
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_N0','field name was truncated to '&
//YRECFM//' for '//TRIM(TPFIELD%CMNHNAME))
CALL LFIECR(IRESP,TPFILE%NLFIFLU,YRECFM,IWORK,ITOTAL)
ENDIF
@@ -407,9 +410,9 @@ KRESP=IRESP
!
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
-END SUBROUTINE IO_WRITE_FIELD_LFI_N0
+END SUBROUTINE IO_Field_write_lfi_N0
!
-SUBROUTINE IO_WRITE_FIELD_LFI_N1(TPFILE,TPFIELD,KFIELD,KRESP)
+SUBROUTINE IO_Field_write_lfi_N1(TPFILE,TPFIELD,KFIELD,KRESP)
!
IMPLICIT NONE
!
@@ -423,16 +426,16 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
!* 0.2 Declarations of local variables
!
INTEGER :: ILENG
-INTEGER(kind=LFI_INT) :: IRESP, ITOTAL
+INTEGER(kind=LFIINT) :: IRESP, ITOTAL
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
CHARACTER(LEN=LEN_HREC) :: YRECFM
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_LFI_N1','writing '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_N1','writing '//TRIM(TPFIELD%CMNHNAME))
!
ILENG = SIZE(KFIELD)
!
IF ( ILENG==0 ) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_N1','ignoring variable with a zero size ('//TRIM(TPFIELD%CMNHNAME)//')')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_N1','ignoring variable with a zero size ('//TRIM(TPFIELD%CMNHNAME)//')')
KRESP = 0
RETURN
END IF
@@ -443,7 +446,7 @@ IF (IRESP==0) THEN
IWORK(LEN(TPFIELD%CCOMMENT)+3:) = KFIELD(:)
YRECFM=TRIM(TPFIELD%CMNHNAME)
IF( LEN_TRIM(TPFIELD%CMNHNAME) > LEN(YRECFM) ) &
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_N1','field name was truncated to '&
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_N1','field name was truncated to '&
//YRECFM//' for '//TRIM(TPFIELD%CMNHNAME))
CALL LFIECR(IRESP,TPFILE%NLFIFLU,YRECFM,IWORK,ITOTAL)
ENDIF
@@ -452,9 +455,9 @@ KRESP=IRESP
!
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
-END SUBROUTINE IO_WRITE_FIELD_LFI_N1
+END SUBROUTINE IO_Field_write_lfi_N1
!
-SUBROUTINE IO_WRITE_FIELD_LFI_N2(TPFILE,TPFIELD,KFIELD,KRESP)
+SUBROUTINE IO_Field_write_lfi_N2(TPFILE,TPFIELD,KFIELD,KRESP)
!
IMPLICIT NONE
!
@@ -468,16 +471,16 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
!* 0.2 Declarations of local variables
!
INTEGER :: ILENG
-INTEGER(kind=LFI_INT) :: IRESP, ITOTAL
+INTEGER(kind=LFIINT) :: IRESP, ITOTAL
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
CHARACTER(LEN=LEN_HREC) :: YRECFM
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_LFI_N2','writing '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_N2','writing '//TRIM(TPFIELD%CMNHNAME))
!
ILENG = SIZE(KFIELD)
!
IF ( ILENG==0 ) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_N2','ignoring variable with a zero size ('//TRIM(TPFIELD%CMNHNAME)//')')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_N2','ignoring variable with a zero size ('//TRIM(TPFIELD%CMNHNAME)//')')
KRESP = 0
RETURN
END IF
@@ -488,7 +491,7 @@ 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_WRITE_FIELD_LFI_N2','field name was truncated to '&
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_N2','field name was truncated to '&
//YRECFM//' for '//TRIM(TPFIELD%CMNHNAME))
CALL LFIECR(IRESP,TPFILE%NLFIFLU,YRECFM,IWORK,ITOTAL)
ENDIF
@@ -497,9 +500,9 @@ KRESP=IRESP
!
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
-END SUBROUTINE IO_WRITE_FIELD_LFI_N2
+END SUBROUTINE IO_Field_write_lfi_N2
!
-SUBROUTINE IO_WRITE_FIELD_LFI_N3(TPFILE,TPFIELD,KFIELD,KRESP)
+SUBROUTINE IO_Field_write_lfi_N3(TPFILE,TPFIELD,KFIELD,KRESP)
!
IMPLICIT NONE
!
@@ -513,16 +516,16 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
!* 0.2 Declarations of local variables
!
INTEGER :: ILENG
-INTEGER(kind=LFI_INT) :: IRESP, ITOTAL
+INTEGER(kind=LFIINT) :: IRESP, ITOTAL
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
CHARACTER(LEN=LEN_HREC) :: YRECFM
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_LFI_N3','writing '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_N3','writing '//TRIM(TPFIELD%CMNHNAME))
!
ILENG = SIZE(KFIELD)
!
IF ( ILENG==0 ) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_N3','ignoring variable with a zero size ('//TRIM(TPFIELD%CMNHNAME)//')')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_N3','ignoring variable with a zero size ('//TRIM(TPFIELD%CMNHNAME)//')')
KRESP = 0
RETURN
END IF
@@ -533,7 +536,7 @@ 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_WRITE_FIELD_LFI_N3','field name was truncated to '&
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_N3','field name was truncated to '&
//YRECFM//' for '//TRIM(TPFIELD%CMNHNAME))
CALL LFIECR(IRESP,TPFILE%NLFIFLU,YRECFM,IWORK,ITOTAL)
ENDIF
@@ -542,9 +545,9 @@ KRESP=IRESP
!
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
-END SUBROUTINE IO_WRITE_FIELD_LFI_N3
+END SUBROUTINE IO_Field_write_lfi_N3
!
-SUBROUTINE IO_WRITE_FIELD_LFI_L0(TPFILE,TPFIELD,OFIELD,KRESP)
+SUBROUTINE IO_Field_write_lfi_L0(TPFILE,TPFIELD,OFIELD,KRESP)
!
IMPLICIT NONE
!
@@ -559,11 +562,11 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
!
INTEGER :: IFIELD
INTEGER :: ILENG
-INTEGER(kind=LFI_INT) :: IRESP, ITOTAL
+INTEGER(kind=LFIINT) :: IRESP, ITOTAL
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
CHARACTER(LEN=LEN_HREC) :: YRECFM
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_LFI_L0','writing '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_L0','writing '//TRIM(TPFIELD%CMNHNAME))
!
ILENG = 1
!
@@ -580,7 +583,7 @@ IF (IRESP==0) THEN
IWORK(LEN(TPFIELD%CCOMMENT)+3)=IFIELD
YRECFM=TRIM(TPFIELD%CMNHNAME)
IF( LEN_TRIM(TPFIELD%CMNHNAME) > LEN(YRECFM) ) &
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_L0','field name was truncated to '&
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_L0','field name was truncated to '&
//YRECFM//' for '//TRIM(TPFIELD%CMNHNAME))
CALL LFIECR(IRESP,TPFILE%NLFIFLU,YRECFM,IWORK,ITOTAL)
ENDIF
@@ -589,9 +592,9 @@ KRESP=IRESP
!
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
-END SUBROUTINE IO_WRITE_FIELD_LFI_L0
+END SUBROUTINE IO_Field_write_lfi_L0
!
-SUBROUTINE IO_WRITE_FIELD_LFI_L1(TPFILE,TPFIELD,OFIELD,KRESP)
+SUBROUTINE IO_Field_write_lfi_L1(TPFILE,TPFIELD,OFIELD,KRESP)
!
IMPLICIT NONE
!
@@ -606,16 +609,16 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
!
INTEGER, DIMENSION(SIZE(OFIELD)) :: IFIELD
INTEGER :: ILENG
-INTEGER(kind=LFI_INT) :: IRESP, ITOTAL
+INTEGER(kind=LFIINT) :: IRESP, ITOTAL
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
CHARACTER(LEN=LEN_HREC) :: YRECFM
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_LFI_L1','writing '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_L1','writing '//TRIM(TPFIELD%CMNHNAME))
!
ILENG = SIZE(OFIELD)
!
IF ( ILENG==0 ) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_L1','ignoring variable with a zero size ('//TRIM(TPFIELD%CMNHNAME)//')')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_L1','ignoring variable with a zero size ('//TRIM(TPFIELD%CMNHNAME)//')')
KRESP = 0
RETURN
END IF
@@ -633,7 +636,7 @@ IF (IRESP==0) THEN
IWORK(LEN(TPFIELD%CCOMMENT)+3:) = IFIELD(:)
YRECFM=TRIM(TPFIELD%CMNHNAME)
IF( LEN_TRIM(TPFIELD%CMNHNAME) > LEN(YRECFM) ) &
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_L1','field name was truncated to '&
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_L1','field name was truncated to '&
//YRECFM//' for '//TRIM(TPFIELD%CMNHNAME))
CALL LFIECR(IRESP,TPFILE%NLFIFLU,YRECFM,IWORK,ITOTAL)
ENDIF
@@ -642,9 +645,9 @@ KRESP=IRESP
!
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
-END SUBROUTINE IO_WRITE_FIELD_LFI_L1
+END SUBROUTINE IO_Field_write_lfi_L1
!
-SUBROUTINE IO_WRITE_FIELD_LFI_C0(TPFILE,TPFIELD,HFIELD,KRESP)
+SUBROUTINE IO_Field_write_lfi_C0(TPFILE,TPFIELD,HFIELD,KRESP)
!
USE MODD_PARAMETERS, ONLY: NFILENAMELGTMAXLFI
!
@@ -660,11 +663,11 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
!* 0.2 Declarations of local variables
!
INTEGER :: ILENG, ILENGMAX, JLOOP
-INTEGER(kind=LFI_INT) :: IRESP, ITOTAL
+INTEGER(kind=LFIINT) :: IRESP, ITOTAL
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
CHARACTER(LEN=LEN_HREC) :: YRECFM
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_LFI_C0','writing '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_C0','writing '//TRIM(TPFIELD%CMNHNAME))
!
ILENG=LEN(HFIELD)
ILENGMAX = ILENG
@@ -675,7 +678,7 @@ IF (TPFIELD%CMNHNAME=='MY_NAME' .OR. TPFIELD%CMNHNAME=='DAD_NAME') THEN
ILENG = MIN(LEN(HFIELD),NFILENAMELGTMAXLFI)
ILENGMAX = NFILENAMELGTMAXLFI
IF (LEN_TRIM(HFIELD)>ILENGMAX) &
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_C0',TRIM(TPFILE%CNAME)// &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_C0',TRIM(TPFILE%CNAME)// &
': MY_NAME was truncated from '//TRIM(HFIELD)//' to '//HFIELD(1:NFILENAMELGTMAXLFI))
END IF
!
@@ -691,7 +694,7 @@ IF (IRESP==0) THEN
END DO
YRECFM=TRIM(TPFIELD%CMNHNAME)
IF( LEN_TRIM(TPFIELD%CMNHNAME) > LEN(YRECFM) ) &
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_C0','field name was truncated to '&
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_C0','field name was truncated to '&
//YRECFM//' for '//TRIM(TPFIELD%CMNHNAME))
CALL LFIECR(IRESP,TPFILE%NLFIFLU,YRECFM,IWORK,ITOTAL)
ENDIF
@@ -700,9 +703,9 @@ KRESP=IRESP
!
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
-END SUBROUTINE IO_WRITE_FIELD_LFI_C0
+END SUBROUTINE IO_Field_write_lfi_C0
!
-SUBROUTINE IO_WRITE_FIELD_LFI_T0(TPFILE,TPFIELD,TPDATA,KRESP)
+SUBROUTINE IO_Field_write_lfi_T0(TPFILE,TPFIELD,TPDATA,KRESP)
!
USE MODD_TYPE_DATE
!
@@ -718,13 +721,13 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
!* 0.2 Declarations of local variables
!
INTEGER :: ILENG
-INTEGER(kind=LFI_INT) :: IRESP, ITOTAL
+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
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_LFI_T0','writing '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_T0','writing '//TRIM(TPFIELD%CMNHNAME))
!
TZFIELD = TPFIELD
!
@@ -743,7 +746,7 @@ 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_WRITE_FIELD_LFI_T0','field name was truncated to '&
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_T0','field name was truncated to '&
//YRECFM//' for '//TRIM(TZFIELD%CMNHNAME))
CALL LFIECR(IRESP,TPFILE%NLFIFLU,YRECFM,IWORK,ITOTAL)
ENDIF
@@ -767,7 +770,7 @@ IF (IRESP==0) THEN
IWORK(LEN(TZFIELD%CCOMMENT)+3) = TRANSFER(TPDATA%TIME,IWORK(1))
YRECFM=TRIM(TZFIELD%CMNHNAME)
IF( LEN_TRIM(TZFIELD%CMNHNAME) > LEN(YRECFM) ) &
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_LFI_T0','field name was truncated to '&
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_T0','field name was truncated to '&
//YRECFM//' for '//TRIM(TZFIELD%CMNHNAME))
CALL LFIECR(IRESP,TPFILE%NLFIFLU,YRECFM,IWORK,ITOTAL)
ENDIF
@@ -776,15 +779,15 @@ KRESP=IRESP
!
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
-END SUBROUTINE IO_WRITE_FIELD_LFI_T0
+END SUBROUTINE IO_Field_write_lfi_T0
!
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=LFI_INT), INTENT(OUT) :: KTOTAL
-INTEGER(kind=LFI_INT), INTENT(OUT) :: KRESP
+INTEGER(kind=LFIINT), INTENT(OUT) :: KTOTAL
+INTEGER(kind=LFIINT), INTENT(OUT) :: KRESP
!
INTEGER :: ICOMLEN
INTEGER :: J
diff --git a/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90 b/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90
index eb032d9aff601e0e879d7989a067b29460e289d3..ebd476354fc5dba27d7ebfd8eb33b5adc5f3cf80 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90
@@ -3,25 +3,28 @@
!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 : may 2016 : use NetCDF Fortran module
-! J.Escobar : 14/12/2017 : Correction for MNH_INT=8
-! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet : 13/12/2018 : split of mode_netcdf into multiple modules/files
-! Philippe Wautelet: 10/01/2019: replace handle_err by io_handle_err_nc4 for better netCDF error messages
-! P. Wautelet : 11/01/2019 : NVERB_INFO->NVERB_WARNING for zero size fields
+! Modifications:
+! P. Wautelet may 2016 : use NetCDF Fortran module
+! J. Escobar 14/12/2017: correction for MNH_INT=8
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 13/12/2018: split of mode_netcdf into multiple modules/files
+! P. Wautelet 10/01/2019: replace handle_err by IO_Err_handle_nc4 for better netCDF error messages
+! 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
!-----------------------------------------------------------------
#if defined(MNH_IOCDF4)
module mode_io_write_nc4
-use modd_io_ll, only: gsmonoproc, tfiledata
-use modd_netcdf, only: dimcdf, IDCDF_KIND, iocdf
+use modd_io, only: gsmonoproc, tfiledata
+use modd_netcdf, only: dimcdf, iocdf
+use modd_precision, only: CDFINT, MNHINT_NF90, MNHREAL_NF90
use mode_field, only: tfielddata
-use mode_io_tools_nc4, only: cleanmnhname, fillvdims, getdimcdf, getstrdimid, io_handle_err_nc4
+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_msg
-use NETCDF, only: NF90_CHAR, NF90_DOUBLE, NF90_FLOAT, NF90_INT, NF90_INT1, NF90_INT64, &
+use NETCDF, only: NF90_CHAR, NF90_FLOAT, NF90_INT1, &
NF90_GLOBAL, NF90_NOERR, &
NF90_DEF_VAR, NF90_DEF_VAR_DEFLATE, NF90_GET_ATT, NF90_INQ_VARID, &
NF90_INQUIRE_ATTRIBUTE, NF90_PUT_ATT, NF90_PUT_VAR
@@ -30,57 +33,57 @@ implicit none
private
-public :: io_write_coordvar_nc4, io_write_field_nc4, io_write_header_nc4
+public :: IO_Coordvar_write_nc4, IO_Field_write_nc4, IO_Header_write_nc4
-INTERFACE IO_WRITE_FIELD_NC4
- MODULE PROCEDURE IO_WRITE_FIELD_NC4_X0,IO_WRITE_FIELD_NC4_X1, &
- IO_WRITE_FIELD_NC4_X2,IO_WRITE_FIELD_NC4_X3, &
- IO_WRITE_FIELD_NC4_X4,IO_WRITE_FIELD_NC4_X5, &
- IO_WRITE_FIELD_NC4_X6, &
- IO_WRITE_FIELD_NC4_N0,IO_WRITE_FIELD_NC4_N1, &
- IO_WRITE_FIELD_NC4_N2,IO_WRITE_FIELD_NC4_N3, &
- IO_WRITE_FIELD_NC4_L0,IO_WRITE_FIELD_NC4_L1, &
- IO_WRITE_FIELD_NC4_C0,IO_WRITE_FIELD_NC4_C1, &
- IO_WRITE_FIELD_NC4_T0
-END INTERFACE IO_WRITE_FIELD_NC4
+INTERFACE IO_Field_write_nc4
+ MODULE PROCEDURE IO_Field_write_nc4_X0,IO_Field_write_nc4_X1, &
+ IO_Field_write_nc4_X2,IO_Field_write_nc4_X3, &
+ IO_Field_write_nc4_X4,IO_Field_write_nc4_X5, &
+ 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_L0,IO_Field_write_nc4_L1, &
+ IO_Field_write_nc4_C0,IO_Field_write_nc4_C1, &
+ IO_Field_write_nc4_T0
+END INTERFACE IO_Field_write_nc4
integer,parameter :: NSTRINGCHUNKSIZE = 16 !Dimension of the chunks of strings
!(to limit the number of dimensions for strings)
-integer(kind=IDCDF_KIND),parameter :: SHUFFLE = 1 !Set to 1 for (usually) better compression
-integer(kind=IDCDF_KIND),parameter :: DEFLATE = 1
+integer(kind=CDFINT),parameter :: SHUFFLE = 1 !Set to 1 for (usually) better compression
+integer(kind=CDFINT),parameter :: DEFLATE = 1
contains
-SUBROUTINE IO_WRITE_FIELD_ATTR_NC4(TPFILE,TPFIELD,KVARID,OEXISTED,KSHAPE,HCALENDAR,OISCOORD)
+SUBROUTINE IO_Field_attr_write_nc4(TPFILE,TPFIELD,KVARID,OEXISTED,KSHAPE,HCALENDAR,OISCOORD)
!
USE MODD_CONF, ONLY: CPROGRAM, LCARTESIAN
USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
!
USE MODE_FIELD, ONLY: TYPEINT, TYPEREAL
!
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
-INTEGER(KIND=IDCDF_KIND), INTENT(IN) :: KVARID
-LOGICAL, INTENT(IN) :: OEXISTED !True if variable was already defined
-INTEGER(KIND=IDCDF_KIND),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)
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+INTEGER(KIND=CDFINT), INTENT(IN) :: KVARID
+LOGICAL, INTENT(IN) :: OEXISTED !True if variable was already defined
+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=IDCDF_KIND) :: INCID
-INTEGER(KIND=IDCDF_KIND) :: STATUS
+INTEGER(KIND=CDFINT) :: INCID
+INTEGER(KIND=CDFINT) :: STATUS
CHARACTER(LEN=:),ALLOCATABLE :: YCOORDS
LOGICAL :: GISCOORD
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_ATTR_NC4','called for field '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_attr_write_nc4','called for field '//TRIM(TPFIELD%CMNHNAME))
!
IF(LEN_TRIM(TPFIELD%CSTDNAME)==0 .AND. LEN_TRIM(TPFIELD%CLONGNAME)==0) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_ATTR_NC4','at least long_name or standard_name must be provided &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_attr_write_nc4','at least long_name or standard_name must be provided &
&to respect CF-convention for variable '//TRIM(TPFIELD%CMNHNAME))
ENDIF
!
IF (TPFIELD%NDIMS>1 .AND. .NOT.PRESENT(KSHAPE)) &
- CALL PRINT_MSG(NVERB_FATAL,'IO','IO_WRITE_FIELD_ATTR_NC4','KSHAPE not provided for '//TRIM(TPFIELD%CMNHNAME))
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_Field_attr_write_nc4','KSHAPE not provided for '//TRIM(TPFIELD%CMNHNAME))
!
IF (PRESENT(OISCOORD)) THEN
GISCOORD = OISCOORD
@@ -92,55 +95,55 @@ INCID = TPFILE%NNCID
!
! Standard_name attribute definition (CF convention)
IF(LEN_TRIM(TPFIELD%CSTDNAME)==0) THEN
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_ATTR_NC4','TPFIELD%CSTDNAME not set for variable '//TRIM(TPFIELD%CMNHNAME))
+ 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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_ATTR_NC4','NF90_PUT_ATT','standard_name for ' &
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_attr_write_nc4','NF90_PUT_ATT','standard_name for ' &
//trim(TPFIELD%CMNHNAME))
ENDIF
!
! Long_name attribute definition (CF convention)
IF(LEN_TRIM(TPFIELD%CLONGNAME)==0) THEN
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_ATTR_NC4','TPFIELD%CLONGNAME not set for variable '//TRIM(TPFIELD%CMNHNAME))
+ 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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_ATTR_NC4','NF90_PUT_ATT','long_name for ' &
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_attr_write_nc4','NF90_PUT_ATT','long_name for ' &
//trim(TPFIELD%CMNHNAME))
ENDIF
!
! Canonical units attribute definition (CF convention)
IF(LEN_TRIM(TPFIELD%CUNITS)==0) THEN
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_ATTR_NC4','TPFIELD%CUNITS not set for variable '//TRIM(TPFIELD%CMNHNAME))
+ 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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_ATTR_NC4','NF90_PUT_ATT','units for ' &
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_attr_write_nc4','NF90_PUT_ATT','units for ' &
//trim(TPFIELD%CMNHNAME))
ENDIF
!
! GRID attribute definition
IF(TPFIELD%NGRID<0) THEN
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_ATTR_NC4','TPFIELD%NGRID not set for variable '//TRIM(TPFIELD%CMNHNAME))
+ 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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_ATTR_NC4','NF90_PUT_ATT','grid for ' &
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_attr_write_nc4','NF90_PUT_ATT','grid for ' &
//trim(TPFIELD%CMNHNAME))
ENDIF
!
! COMMENT attribute definition
IF(LEN_TRIM(TPFIELD%CCOMMENT)==0) THEN
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_ATTR_NC4','TPFIELD%CCOMMENT not set for variable '//TRIM(TPFIELD%CMNHNAME))
+ 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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_ATTR_NC4','NF90_PUT_ATT','comment for ' &
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'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_WRITE_FIELD_ATTR_NC4','CALENDAR provided for variable '//TRIM(TPFIELD%CMNHNAME))
+ 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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_ATTR_NC4','NF90_PUT_ATT','calendar for ' &
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_attr_write_nc4','NF90_PUT_ATT','calendar for ' &
//trim(TPFIELD%CMNHNAME))
ENDIF
!
@@ -171,14 +174,14 @@ IF (.NOT.GISCOORD) THEN
CASE (8) !fw point (=uvw point)
YCOORDS='latitude_f longitude_f'
CASE DEFAULT
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_ATTR_NC4','invalid NGRID for variable '//TRIM(TPFIELD%CMNHNAME))
+ 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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_ATTR_NC4','NF90_PUT_ATT','coordinates')
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_attr_write_nc4','NF90_PUT_ATT','coordinates')
DEALLOCATE(YCOORDS)
ELSE
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_ATTR_NC4','coordinates not implemented for variable ' &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_attr_write_nc4','coordinates not implemented for variable ' &
//TRIM(TPFIELD%CMNHNAME))
END IF
ELSE
@@ -189,7 +192,7 @@ ENDIF
!
IF(TPFIELD%NTYPE==TYPEINT .AND. TPFIELD%NDIMS>0) THEN
IF (TPFIELD%NFILLVALUE>=TPFIELD%NVALIDMIN .AND. TPFIELD%NFILLVALUE<=TPFIELD%NVALIDMAX) &
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_ATTR_NC4','_FillValue is not outside of valid_min - valid_max'// &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_attr_write_nc4','_FillValue is not outside of valid_min - valid_max'// &
'interval for variable '//TRIM(TPFIELD%CMNHNAME))
!
! Fillvalue (CF/COMODO convention)
@@ -198,20 +201,20 @@ IF(TPFIELD%NTYPE==TYPEINT .AND. TPFIELD%NDIMS>0) THEN
! * it cannot be modified if some data has already been written (->check OEXISTED)
IF(.NOT.OEXISTED) THEN
STATUS = NF90_PUT_ATT(INCID, KVARID,'_FillValue', TPFIELD%NFILLVALUE)
- IF (STATUS /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_ATTR_NC4','NF90_PUT_ATT','_FillValue')
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_attr_write_nc4','NF90_PUT_ATT','_FillValue')
END IF
!
! Valid_min/max (CF/COMODO convention)
STATUS = NF90_PUT_ATT(INCID, KVARID,'valid_min', TPFIELD%NVALIDMIN)
- IF (STATUS /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_ATTR_NC4','NF90_PUT_ATT','valid_min')
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_ATTR_NC4','NF90_PUT_ATT','valid_max')
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_attr_write_nc4','NF90_PUT_ATT','valid_max')
ENDIF
!
IF(TPFIELD%NTYPE==TYPEREAL .AND. TPFIELD%NDIMS>0) THEN
IF (TPFIELD%XFILLVALUE>=TPFIELD%XVALIDMIN .AND. TPFIELD%XFILLVALUE<=TPFIELD%XVALIDMAX) &
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_ATTR_NC4','_FillValue is not outside of valid_min - valid_max'// &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_attr_write_nc4','_FillValue is not outside of valid_min - valid_max'// &
'interval for variable '//TRIM(TPFIELD%CMNHNAME))
!
! Fillvalue (CF/COMODO convention)
@@ -224,7 +227,7 @@ IF(TPFIELD%NTYPE==TYPEREAL .AND. TPFIELD%NDIMS>0) THEN
ELSE
STATUS = NF90_PUT_ATT(INCID, KVARID,'_FillValue', TPFIELD%XFILLVALUE)
END IF
- IF (STATUS /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_ATTR_NC4','NF90_PUT_ATT','_FillValue')
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_attr_write_nc4','NF90_PUT_ATT','_FillValue')
END IF
!
! Valid_min/max (CF/COMODO convention)
@@ -233,35 +236,35 @@ IF(TPFIELD%NTYPE==TYPEREAL .AND. TPFIELD%NDIMS>0) THEN
ELSE
STATUS = NF90_PUT_ATT(INCID, KVARID,'valid_min', TPFIELD%XVALIDMIN)
END IF
- IF (STATUS /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_ATTR_NC4','NF90_PUT_ATT','valid_min')
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'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))
ELSE
STATUS = NF90_PUT_ATT(INCID, KVARID,'valid_max',TPFIELD%XVALIDMAX)
END IF
- IF (STATUS /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_ATTR_NC4','NF90_PUT_ATT','valid_max')
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_attr_write_nc4','NF90_PUT_ATT','valid_max')
ENDIF
!
-END SUBROUTINE IO_WRITE_FIELD_ATTR_NC4
+END SUBROUTINE IO_Field_attr_write_nc4
-SUBROUTINE IO_WRITE_FIELD_NC4_X0(TPFILE,TPFIELD,PFIELD,KRESP)
+SUBROUTINE IO_Field_write_nc4_X0(TPFILE,TPFIELD,PFIELD,KRESP)
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
REAL, INTENT(IN) :: PFIELD
INTEGER, INTENT(OUT):: KRESP
!
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND), DIMENSION(:), ALLOCATABLE :: IVDIMS
-INTEGER :: IRESP
-LOGICAL :: GEXISTED !True if variable was already defined
+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
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_NC4_X0',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
+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
@@ -269,62 +272,54 @@ INCID = TPFILE%NNCID
!
GEXISTED = .FALSE.
!
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+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 FILLVDIMS(TPFILE, TPFIELD, INT(SHAPE(PFIELD),KIND=IDCDF_KIND), IVDIMS)
+ CALL IO_Vdims_fill_nc4(TPFILE, TPFIELD, INT(SHAPE(PFIELD),KIND=CDFINT), IVDIMS)
! Define the variable
-#if (MNH_REAL == 8)
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_DOUBLE, IVDIMS, IVARID)
-#else
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT, IVDIMS, IVARID)
-#endif
- IF (status /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_X0','NF90_DEF_VAR',trim(YVARNAME))
+ 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
-#if (MNH_REAL == 8)
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_DOUBLE, IVARID)
-#else
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT, IVARID)
-#endif
- IF (status /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_X0','NF90_DEF_VAR',trim(YVARNAME))
+ 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_WRITE_FIELD_NC4_X0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_X0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
END IF
! Write metadata
-CALL IO_WRITE_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,GEXISTED)
+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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_X0','NF90_PUT_VAR',trim(YVARNAME),IRESP)
+IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_X0','NF90_PUT_VAR',trim(YVARNAME),IRESP)
KRESP = IRESP
-END SUBROUTINE IO_WRITE_FIELD_NC4_X0
+END SUBROUTINE IO_Field_write_nc4_X0
-SUBROUTINE IO_WRITE_FIELD_NC4_X1(TPFILE,TPFIELD,PFIELD,KRESP)
+SUBROUTINE IO_Field_write_nc4_X1(TPFILE,TPFIELD,PFIELD,KRESP)
!
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
!
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)+4) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND), DIMENSION(:), ALLOCATABLE :: IVDIMS
-INTEGER :: IRESP
-LOGICAL :: GEXISTED !True if variable was already defined
+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
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_NC4_X1',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
+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
@@ -332,54 +327,50 @@ INCID = TPFILE%NNCID
!
GEXISTED = .FALSE.
!
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+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_WRITE_FIELD_NC4_X1','ignoring variable with a zero size ('//TRIM(YVARNAME)//')')
+ 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 FILLVDIMS(TPFILE, TPFIELD, INT(SHAPE(PFIELD),KIND=IDCDF_KIND), IVDIMS)
+ 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
-#if (MNH_REAL == 8)
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_DOUBLE, IVDIMS, IVARID)
-#else
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT, IVDIMS, IVARID)
-#endif
+ STATUS = NF90_DEF_VAR(INCID, YVARNAME, MNHREAL_NF90, IVDIMS, IVARID)
END IF
- IF (status /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_X1','NF90_DEF_VAR',trim(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_X1','NF90_DEF_VAR_DEFLATE',trim(YVARNAME))
+ 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_WRITE_FIELD_NC4_X1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_X1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
END IF
! Write metadata
-CALL IO_WRITE_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,GEXISTED)
+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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_X1','NF90_PUT_VAR',trim(YVARNAME),IRESP)
+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)
KRESP = IRESP
-END SUBROUTINE IO_WRITE_FIELD_NC4_X1
+END SUBROUTINE IO_Field_write_nc4_X1
-SUBROUTINE IO_WRITE_FIELD_NC4_X2(TPFILE,TPFIELD,PFIELD,KRESP,KVERTLEVEL,KZFILE,OISCOORD)
+SUBROUTINE IO_Field_write_nc4_X2(TPFILE,TPFIELD,PFIELD,KRESP,KVERTLEVEL,KZFILE,OISCOORD)
!
TYPE(TFILEDATA),TARGET,INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
@@ -389,26 +380,26 @@ INTEGER,OPTIONAL, INTENT(IN) :: KVERTLEVEL ! Number of the vertical level (
INTEGER,OPTIONAL, INTENT(IN) :: KZFILE ! Number of the Z-level splitted file
LOGICAL,OPTIONAL, INTENT(IN) :: OISCOORD ! Is a coordinate variable (->do not write coordinates attribute)
!
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-CHARACTER(LEN=4) :: YSUFFIX
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)+4) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND), DIMENSION(:), ALLOCATABLE :: IVDIMS
-INTEGER :: IRESP
-TYPE(TFIELDDATA) :: TZFIELD
-TYPE(TFILEDATA),POINTER :: TZFILE
-LOGICAL :: GEXISTED !True if variable was already defined
+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_WRITE_FIELD_NC4_X2','KZFILE argument not provided')
+ 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_WRITE_FIELD_NC4_X2','KZFILE value too high')
+ 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
@@ -420,77 +411,73 @@ ELSE
TZFIELD = TPFIELD
ENDIF
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_NC4_X2',TRIM(TZFILE%CNAME)//': writing '//TRIM(TZFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_nc4_X2',TRIM(TZFILE%CNAME)//': writing '//TRIM(TZFIELD%CMNHNAME))
!
! Get the Netcdf file ID
INCID = TZFILE%NNCID
!
GEXISTED = .FALSE.
!
-CALL CLEANMNHNAME(TZFIELD%CMNHNAME,YVARNAME)
+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_WRITE_FIELD_NC4_X2','ignoring variable with a zero size ('//TRIM(YVARNAME)//')')
+ 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 FILLVDIMS(TZFILE, TZFIELD, INT(SHAPE(PFIELD),KIND=IDCDF_KIND), IVDIMS)
+ 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
-#if (MNH_REAL == 8)
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_DOUBLE, IVDIMS, IVARID)
-#else
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT, IVDIMS, IVARID)
-#endif
+ STATUS = NF90_DEF_VAR(INCID, YVARNAME, MNHREAL_NF90, IVDIMS, IVARID)
END IF
- IF (status /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_X2','NF90_DEF_VAR',trim(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_X2','NF90_DEF_VAR_DEFLATE',trim(YVARNAME))
+ 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_WRITE_FIELD_NC4_X2',TRIM(TZFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_X2',TRIM(TZFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
END IF
! Write metadata
-CALL IO_WRITE_FIELD_ATTR_NC4(TZFILE,TZFIELD,IVARID,GEXISTED,KSHAPE=INT(SHAPE(PFIELD),KIND=IDCDF_KIND),OISCOORD=OISCOORD)
+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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_X2','NF90_PUT_VAR',trim(YVARNAME),IRESP)
+IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_X2','NF90_PUT_VAR',trim(YVARNAME),IRESP)
IF(ALLOCATED(IVDIMS)) DEALLOCATE(IVDIMS)
KRESP = IRESP
-END SUBROUTINE IO_WRITE_FIELD_NC4_X2
+END SUBROUTINE IO_Field_write_nc4_X2
-SUBROUTINE IO_WRITE_FIELD_NC4_X3(TPFILE,TPFIELD,PFIELD,KRESP)
+SUBROUTINE IO_Field_write_nc4_X3(TPFILE,TPFIELD,PFIELD,KRESP)
!
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(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND), DIMENSION(:), ALLOCATABLE :: IVDIMS
-INTEGER :: IRESP
-LOGICAL :: GEXISTED !True if variable was already defined
+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
!
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_NC4_X3',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
+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
@@ -498,71 +485,67 @@ INCID = TPFILE%NNCID
!
GEXISTED = .FALSE.
!
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+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_WRITE_FIELD_NC4_X3','ignoring variable with a zero size ('//TRIM(YVARNAME)//')')
+ 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 FILLVDIMS(TPFILE, TPFIELD, INT(SHAPE(PFIELD),KIND=IDCDF_KIND), IVDIMS)
+ 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
-#if (MNH_REAL == 8)
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_DOUBLE, IVDIMS, IVARID)
-#else
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT, IVDIMS, IVARID)
-#endif
+ STATUS = NF90_DEF_VAR(INCID, YVARNAME, MNHREAL_NF90, IVDIMS, IVARID)
END IF
- IF (status /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_X3','NF90_DEF_VAR',trim(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_X3','NF90_DEF_VAR_DEFLATE',trim(YVARNAME))
+ 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_WRITE_FIELD_NC4_X3',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_X3',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
END IF
! Write metadata
-CALL IO_WRITE_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,GEXISTED,KSHAPE=INT(SHAPE(PFIELD),KIND=IDCDF_KIND))
+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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_X3','NF90_PUT_VAR',trim(YVARNAME),IRESP)
+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)
KRESP = IRESP
-END SUBROUTINE IO_WRITE_FIELD_NC4_X3
+END SUBROUTINE IO_Field_write_nc4_X3
-SUBROUTINE IO_WRITE_FIELD_NC4_X4(TPFILE,TPFIELD,PFIELD,KRESP)
+SUBROUTINE IO_Field_write_nc4_X4(TPFILE,TPFIELD,PFIELD,KRESP)
!
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(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND), DIMENSION(:), ALLOCATABLE :: IVDIMS
-INTEGER :: IRESP
-LOGICAL :: GEXISTED !True if variable was already defined
+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
!
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_NC4_X4',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
+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
@@ -570,71 +553,67 @@ INCID = TPFILE%NNCID
!
GEXISTED = .FALSE.
!
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+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_WRITE_FIELD_NC4_X4','ignoring variable with a zero size ('//TRIM(YVARNAME)//')')
+ 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 FILLVDIMS(TPFILE, TPFIELD, INT(SHAPE(PFIELD),KIND=IDCDF_KIND), IVDIMS)
+ 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
-#if (MNH_REAL == 8)
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_DOUBLE, IVDIMS, IVARID)
-#else
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT, IVDIMS, IVARID)
-#endif
+ STATUS = NF90_DEF_VAR(INCID, YVARNAME, MNHREAL_NF90, IVDIMS, IVARID)
END IF
- IF (status /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_X4','NF90_DEF_VAR',trim(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_X4','NF90_DEF_VAR_DEFLATE',trim(YVARNAME))
+ 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_WRITE_FIELD_NC4_X4',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_X4',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
END IF
! Write metadata
-CALL IO_WRITE_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,GEXISTED,KSHAPE=INT(SHAPE(PFIELD),KIND=IDCDF_KIND))
+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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_X4','NF90_PUT_VAR',trim(YVARNAME),IRESP)
+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)
KRESP = IRESP
-END SUBROUTINE IO_WRITE_FIELD_NC4_X4
+END SUBROUTINE IO_Field_write_nc4_X4
-SUBROUTINE IO_WRITE_FIELD_NC4_X5(TPFILE,TPFIELD,PFIELD,KRESP)
+SUBROUTINE IO_Field_write_nc4_X5(TPFILE,TPFIELD,PFIELD,KRESP)
!
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(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND), DIMENSION(:), ALLOCATABLE :: IVDIMS
-INTEGER :: IRESP
-LOGICAL :: GEXISTED !True if variable was already defined
+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
!
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_NC4_X5',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
+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
@@ -642,71 +621,67 @@ INCID = TPFILE%NNCID
!
GEXISTED = .FALSE.
!
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+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_WRITE_FIELD_NC4_X5','ignoring variable with a zero size ('//TRIM(YVARNAME)//')')
+ 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 FILLVDIMS(TPFILE, TPFIELD, INT(SHAPE(PFIELD),KIND=IDCDF_KIND), IVDIMS)
+ 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
-#if (MNH_REAL == 8)
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_DOUBLE, IVDIMS, IVARID)
-#else
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT, IVDIMS, IVARID)
-#endif
+ STATUS = NF90_DEF_VAR(INCID, YVARNAME, MNHREAL_NF90, IVDIMS, IVARID)
END IF
- IF (status /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_X5','NF90_DEF_VAR',trim(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_X5','NF90_DEF_VAR_DEFLATE',trim(YVARNAME))
+ 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_WRITE_FIELD_NC4_X5',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_X5',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
END IF
! Write metadata
-CALL IO_WRITE_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,GEXISTED,KSHAPE=INT(SHAPE(PFIELD),KIND=IDCDF_KIND))
+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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_X5','NF90_PUT_VAR',trim(YVARNAME),IRESP)
+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)
KRESP = IRESP
-END SUBROUTINE IO_WRITE_FIELD_NC4_X5
+END SUBROUTINE IO_Field_write_nc4_X5
-SUBROUTINE IO_WRITE_FIELD_NC4_X6(TPFILE,TPFIELD,PFIELD,KRESP)
+SUBROUTINE IO_Field_write_nc4_X6(TPFILE,TPFIELD,PFIELD,KRESP)
!
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(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND), DIMENSION(:), ALLOCATABLE :: IVDIMS
-INTEGER :: IRESP
-LOGICAL :: GEXISTED !True if variable was already defined
+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
!
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_NC4_X6',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
+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
@@ -714,60 +689,57 @@ INCID = TPFILE%NNCID
!
GEXISTED = .FALSE.
!
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+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_WRITE_FIELD_NC4_X6','ignoring variable with a zero size ('//TRIM(YVARNAME)//')')
+ 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 FILLVDIMS(TPFILE, TPFIELD, INT(SHAPE(PFIELD),KIND=IDCDF_KIND), IVDIMS)
+ 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
-#if (MNH_REAL == 8)
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_DOUBLE, IVDIMS, IVARID)
-#else
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT, IVDIMS, IVARID)
-#endif
+ STATUS = NF90_DEF_VAR(INCID, YVARNAME, MNHREAL_NF90, IVDIMS, IVARID)
END IF
- IF (status /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_X6','NF90_DEF_VAR',trim(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_X6','NF90_DEF_VAR_DEFLATE',trim(YVARNAME))
+ 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_WRITE_FIELD_NC4_X6',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_X6',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
END IF
! Write metadata
-CALL IO_WRITE_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,GEXISTED,KSHAPE=INT(SHAPE(PFIELD),KIND=IDCDF_KIND))
+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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_X6','NF90_PUT_VAR',trim(YVARNAME),IRESP)
+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)
KRESP = IRESP
-END SUBROUTINE IO_WRITE_FIELD_NC4_X6
+END SUBROUTINE IO_Field_write_nc4_X6
-SUBROUTINE IO_WRITE_FIELD_NC4_N0(TPFILE,TPFIELD,KFIELD,KRESP)
+SUBROUTINE IO_Field_write_nc4_N0(TPFILE,TPFIELD,KFIELD,KRESP)
!
-USE MODD_PARAMETERS_ll, ONLY : JPVEXT
#if 0
-USE MODD_PARAMETERS_ll, ONLY : JPHEXT, JPVEXT
-USE MODD_IO_ll, ONLY : LPACK,L1D,L2D
+USE MODD_IO, ONLY: LPACK,L1D,L2D
+USE MODD_PARAMETERS_ll, ONLY: JPHEXT, JPVEXT
+#else
+USE MODD_PARAMETERS_ll, ONLY: JPVEXT
#endif
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
@@ -775,16 +747,16 @@ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
INTEGER, INTENT(IN) :: KFIELD
INTEGER, INTENT(OUT):: KRESP
!
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND), DIMENSION(:), ALLOCATABLE :: IVDIMS
-INTEGER :: IRESP
-LOGICAL :: GEXISTED !True if variable was already defined
-TYPE(IOCDF), POINTER :: TZIOCDF
+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
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_NC4_N0',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
+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
@@ -792,71 +764,64 @@ INCID = TPFILE%NNCID
!
GEXISTED = .FALSE.
!
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+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 FILLVDIMS(TPFILE, TPFIELD, INT(SHAPE(KFIELD),KIND=IDCDF_KIND), IVDIMS)
+ CALL IO_Vdims_fill_nc4(TPFILE, TPFIELD, INT(SHAPE(KFIELD),KIND=CDFINT), IVDIMS)
! Define the variable
-#if ( MNH_INT == 4 )
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT, IVDIMS, IVARID)
-#else
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT64, IVDIMS, IVARID)
-#endif
- IF (status /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_N0','NF90_DEF_VAR',trim(YVARNAME))
+ 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
-#if ( MNH_INT == 4 )
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT, IVARID)
-#else
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT64, IVARID)
-#endif
- IF (status /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_N0','NF90_DEF_VAR',trim(YVARNAME))
+ 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_WRITE_FIELD_NC4_N0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_N0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
END IF
! Write metadata
-CALL IO_WRITE_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,GEXISTED)
+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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_N0','NF90_PUT_VAR',trim(YVARNAME),IRESP)
+IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_N0','NF90_PUT_VAR',trim(YVARNAME),IRESP)
!
! 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=>GETDIMCDF(TPFILE%TNCDIMS,KFIELD+2*JPHEXT,'X')
+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=>GETDIMCDF(TPFILE, 1,'Y')
+ TPFILE%TNCDIMS%DIM_NJ=>IO_Dimcdf_get_nc4(TPFILE, 1,'Y')
ELSE
- TPFILE%TNCDIMS%DIM_NJ=>GETDIMCDF(TPFILE, KFIELD+2*JPHEXT, 'Y')
+ TPFILE%TNCDIMS%DIM_NJ=>IO_Dimcdf_get_nc4(TPFILE, KFIELD+2*JPHEXT, 'Y')
END IF
END IF
#endif
IF (YVARNAME == 'KMAX' .AND. .NOT. ASSOCIATED(TPFILE%TNCDIMS%DIM_LEVEL)) THEN
TZIOCDF => TPFILE%TNCDIMS
- TZIOCDF%DIM_LEVEL=>GETDIMCDF(TPFILE,INT(KFIELD+2*JPVEXT,KIND=IDCDF_KIND),'Z')
+ TZIOCDF%DIM_LEVEL=>IO_Dimcdf_get_nc4(TPFILE,INT(KFIELD+2*JPVEXT,KIND=CDFINT),'Z')
END IF
KRESP = IRESP
-END SUBROUTINE IO_WRITE_FIELD_NC4_N0
+END SUBROUTINE IO_Field_write_nc4_N0
-SUBROUTINE IO_WRITE_FIELD_NC4_N1(TPFILE,TPFIELD,KFIELD,KRESP)
+SUBROUTINE IO_Field_write_nc4_N1(TPFILE,TPFIELD,KFIELD,KRESP)
!
-USE MODD_PARAMETERS_ll, ONLY : JPVEXT
#if 0
-USE MODD_PARAMETERS_ll, ONLY : JPHEXT, JPVEXT
-USE MODD_IO_ll, ONLY : LPACK,L1D,L2D
+USE MODD_IO, ONLY: LPACK,L1D,L2D
+USE MODD_PARAMETERS_ll, ONLY: JPHEXT, JPVEXT
+#else
+USE MODD_PARAMETERS_ll, ONLY: JPVEXT
#endif
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
@@ -864,15 +829,15 @@ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
INTEGER, DIMENSION(:), INTENT(IN) :: KFIELD
INTEGER, INTENT(OUT):: KRESP
!
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND), DIMENSION(:), ALLOCATABLE :: IVDIMS
-INTEGER :: IRESP
-LOGICAL :: GEXISTED !True if variable was already defined
+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
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_NC4_N1',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
+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
@@ -880,195 +845,183 @@ INCID = TPFILE%NNCID
!
GEXISTED = .FALSE.
!
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+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_WRITE_FIELD_NC4_N1','ignoring variable with a zero size ('//TRIM(YVARNAME)//')')
+ 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 FILLVDIMS(TPFILE, TPFIELD, INT(SHAPE(KFIELD),KIND=IDCDF_KIND), IVDIMS)
+ CALL IO_Vdims_fill_nc4(TPFILE, TPFIELD, INT(SHAPE(KFIELD),KIND=CDFINT), IVDIMS)
! Define the variable
-#if ( MNH_INT == 4 )
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT, IVDIMS, IVARID)
-#else
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT64, IVDIMS, IVARID)
-#endif
- IF (status /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_N1','NF90_DEF_VAR',trim(YVARNAME))
+ STATUS = NF90_DEF_VAR(INCID, YVARNAME, MNHINT_NF90, IVDIMS, IVARID)
+ IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_WRITE_FIELD_NC4_N1','NF90_DEF_VAR',trim(YVARNAME))
ELSE
GEXISTED = .TRUE.
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_NC4_N1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_N1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
END IF
! Write metadata
-CALL IO_WRITE_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,GEXISTED)
+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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_N1','NF90_PUT_VAR',trim(YVARNAME),IRESP)
+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)
KRESP = IRESP
-END SUBROUTINE IO_WRITE_FIELD_NC4_N1
+END SUBROUTINE IO_Field_write_nc4_N1
-SUBROUTINE IO_WRITE_FIELD_NC4_N2(TPFILE,TPFIELD,KFIELD,KRESP)
+SUBROUTINE IO_Field_write_nc4_N2(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=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND), DIMENSION(:), ALLOCATABLE :: IVDIMS
-INTEGER :: IRESP
-LOGICAL :: GEXISTED !True if variable was already defined
+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
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_NC4_N2',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
+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
!
GEXISTED = .FALSE.
!
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+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_WRITE_FIELD_NC4_N2','ignoring variable with a zero size ('//TRIM(YVARNAME)//')')
+ 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 FILLVDIMS(TPFILE, TPFIELD, INT(SHAPE(KFIELD),KIND=IDCDF_KIND), IVDIMS)
+ CALL IO_Vdims_fill_nc4(TPFILE, TPFIELD, INT(SHAPE(KFIELD),KIND=CDFINT), IVDIMS)
! Define the variable
-#if ( MNH_INT == 4 )
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT, IVDIMS, IVARID)
-#else
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT64, IVDIMS, IVARID)
-#endif
- IF (status /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_N2','NF90_DEF_VAR',trim(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_N2','NF90_DEF_VAR_DEFLATE',trim(YVARNAME))
+ 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_WRITE_FIELD_NC4_N2',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_N2',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
END IF
! Write metadata
-CALL IO_WRITE_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,GEXISTED,KSHAPE=INT(SHAPE(KFIELD),KIND=IDCDF_KIND))
+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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_N2','NF90_PUT_VAR',trim(YVARNAME),IRESP)
+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)
KRESP = IRESP
-END SUBROUTINE IO_WRITE_FIELD_NC4_N2
+END SUBROUTINE IO_Field_write_nc4_N2
-SUBROUTINE IO_WRITE_FIELD_NC4_N3(TPFILE,TPFIELD,KFIELD,KRESP)
+SUBROUTINE IO_Field_write_nc4_N3(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=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND), DIMENSION(:), ALLOCATABLE :: IVDIMS
-INTEGER :: IRESP
-LOGICAL :: GEXISTED !True if variable was already defined
+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
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_NC4_N3',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
+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.
!
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+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_WRITE_FIELD_NC4_N3','ignoring variable with a zero size ('//TRIM(YVARNAME)//')')
+ 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 FILLVDIMS(TPFILE, TPFIELD, INT(SHAPE(KFIELD),KIND=IDCDF_KIND), IVDIMS)
+ CALL IO_Vdims_fill_nc4(TPFILE, TPFIELD, INT(SHAPE(KFIELD),KIND=CDFINT), IVDIMS)
! Define the variable
-#if ( MNH_INT == 4 )
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT, IVDIMS, IVARID)
-#else
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT64, IVDIMS, IVARID)
-#endif
- IF (status /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_N3','NF90_DEF_VAR',trim(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_N3','NF90_DEF_VAR_DEFLATE',trim(YVARNAME))
+ 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_WRITE_FIELD_NC4_N3',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_N3',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
END IF
! Write metadata
-CALL IO_WRITE_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,GEXISTED,KSHAPE=INT(SHAPE(KFIELD),KIND=IDCDF_KIND))
+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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_N3','NF90_PUT_VAR',trim(YVARNAME),IRESP)
+IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_N3','NF90_PUT_VAR',trim(YVARNAME),IRESP)
IF(ALLOCATED(IVDIMS)) DEALLOCATE(IVDIMS)
KRESP = IRESP
-END SUBROUTINE IO_WRITE_FIELD_NC4_N3
+END SUBROUTINE IO_Field_write_nc4_N3
-SUBROUTINE IO_WRITE_FIELD_NC4_L0(TPFILE,TPFIELD,OFIELD,KRESP)
+SUBROUTINE IO_Field_write_nc4_L0(TPFILE,TPFIELD,OFIELD,KRESP)
!
-USE MODD_PARAMETERS_ll, ONLY : JPVEXT
+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=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND), DIMENSION(:), ALLOCATABLE :: IVDIMS
-INTEGER :: IRESP
-LOGICAL :: GEXISTED !True if variable was already defined
+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
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_NC4_L0',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
+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
@@ -1076,28 +1029,28 @@ INCID = TPFILE%NNCID
!
GEXISTED = .FALSE.
!
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+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 FILLVDIMS(TPFILE, TPFIELD, INT(SHAPE(OFIELD),KIND=IDCDF_KIND), IVDIMS)
+ 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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_L0','NF90_DEF_VAR',trim(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_L0','NF90_DEF_VAR',trim(YVARNAME))
+ 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_WRITE_FIELD_NC4_L0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_L0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
END IF
!Convert LOGICAL to INTEGER (LOGICAL format not supported by netCDF files)
@@ -1108,33 +1061,33 @@ ELSE
END IF
! Write metadata
-CALL IO_WRITE_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,GEXISTED)
+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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_L0','NF90_PUT_VAR',trim(YVARNAME),IRESP)
+IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_L0','NF90_PUT_VAR',trim(YVARNAME),IRESP)
KRESP = IRESP
-END SUBROUTINE IO_WRITE_FIELD_NC4_L0
+END SUBROUTINE IO_Field_write_nc4_L0
-SUBROUTINE IO_WRITE_FIELD_NC4_L1(TPFILE,TPFIELD,OFIELD,KRESP)
+SUBROUTINE IO_Field_write_nc4_L1(TPFILE,TPFIELD,OFIELD,KRESP)
!
-USE MODD_PARAMETERS_ll, ONLY : JPVEXT
+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=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND), DIMENSION(:), ALLOCATABLE :: IVDIMS
-INTEGER :: IRESP
-LOGICAL :: GEXISTED !True if variable was already defined
+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
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_NC4_L1',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
+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
@@ -1142,27 +1095,27 @@ INCID = TPFILE%NNCID
!
GEXISTED = .FALSE.
!
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+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_WRITE_FIELD_NC4_L1','ignoring variable with a zero size ('//TRIM(YVARNAME)//')')
+ 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 FILLVDIMS(TPFILE, TPFIELD, INT(SHAPE(OFIELD),KIND=IDCDF_KIND), IVDIMS)
+ 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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_L1','NF90_DEF_VAR',trim(YVARNAME))
+ 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_WRITE_FIELD_NC4_L1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_L1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
END IF
!Convert LOGICAL to INTEGER (LOGICAL format not supported by netCDF files)
@@ -1173,34 +1126,34 @@ ELSEWHERE
END WHERE
! Write metadata
-CALL IO_WRITE_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,GEXISTED)
+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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_L1','NF90_PUT_VAR',trim(YVARNAME),IRESP)
+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)
KRESP = IRESP
-END SUBROUTINE IO_WRITE_FIELD_NC4_L1
+END SUBROUTINE IO_Field_write_nc4_L1
-SUBROUTINE IO_WRITE_FIELD_NC4_C0(TPFILE,TPFIELD,HFIELD,KRESP)
+SUBROUTINE IO_Field_write_nc4_C0(TPFILE,TPFIELD,HFIELD,KRESP)
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
CHARACTER(LEN=*), INTENT(IN) :: HFIELD
INTEGER, INTENT(OUT):: KRESP
!
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND), DIMENSION(1) :: IVDIMS
-INTEGER :: IRESP, ILEN
-CHARACTER(LEN=:),ALLOCATABLE :: YFIELD
-LOGICAL :: GEXISTED !True if variable was already defined
+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
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_NC4_C0',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_nc4_C0',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
!
IRESP = 0
!Store the character string in a string of a size multiple of NSTRINGCHUNKSIZE
@@ -1214,39 +1167,39 @@ INCID = TPFILE%NNCID
!
GEXISTED = .FALSE.
!
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+CALL IO_Mnhname_clean(TPFIELD%CMNHNAME,YVARNAME)
!
IF (TPFIELD%LTIMEDEP) &
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_NC4_C0',TRIM(TPFILE%CNAME)// &
+ 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) = GETSTRDIMID(TPFILE,INT(ILEN,KIND=IDCDF_KIND))
+ 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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_C0','NF90_DEF_VAR',trim(YVARNAME))
+ 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_WRITE_FIELD_NC4_C0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_C0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
END IF
ALLOCATE(CHARACTER(LEN=ILEN)::YFIELD)
YFIELD(1:LEN_TRIM(HFIELD))=TRIM(HFIELD)
YFIELD(LEN_TRIM(HFIELD)+1:)=' '
! Write metadata
-CALL IO_WRITE_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,GEXISTED)
+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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_C0','NF90_PUT_VAR',trim(YVARNAME),IRESP)
+IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_C0','NF90_PUT_VAR',trim(YVARNAME),IRESP)
DEALLOCATE(YFIELD)
KRESP = IRESP
-END SUBROUTINE IO_WRITE_FIELD_NC4_C0
+END SUBROUTINE IO_Field_write_nc4_C0
-SUBROUTINE IO_WRITE_FIELD_NC4_C1(TPFILE,TPFIELD,HFIELD,KRESP)
+SUBROUTINE IO_Field_write_nc4_C1(TPFILE,TPFIELD,HFIELD,KRESP)
! Modif
! J.Escobar : 25/04/2018 : missing 'IF ALLOCATED(IVDIMSTMP)' DEALLOCATE
!----------------------------------------------------------------
@@ -1255,19 +1208,19 @@ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
CHARACTER(LEN=*),DIMENSION(:),INTENT(IN) :: HFIELD
INTEGER, INTENT(OUT) :: KRESP
!
-INTEGER(KIND=IDCDF_KIND),PARAMETER :: IONE = 1
+INTEGER(KIND=CDFINT),PARAMETER :: IONE = 1
!
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND), DIMENSION(2) :: IVDIMS
-INTEGER(KIND=IDCDF_KIND), DIMENSION(:), ALLOCATABLE :: IVDIMSTMP
-INTEGER(KIND=IDCDF_KIND) :: ILEN, ISIZE
-INTEGER :: IRESP
-LOGICAL :: GEXISTED !True if variable was already defined
+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
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_NC4_C1',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_nc4_C1',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
!
IRESP = 0
@@ -1279,11 +1232,11 @@ INCID = TPFILE%NNCID
!
GEXISTED = .FALSE.
!
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+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_WRITE_FIELD_NC4_C1',TRIM(TPFILE%CNAME)// &
+ 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
@@ -1292,30 +1245,30 @@ END IF
STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
IF (STATUS /= NF90_NOERR) THEN
! Get the netcdf string dimensions id
- IVDIMS(1) = GETSTRDIMID(TPFILE,ILEN)
- CALL FILLVDIMS(TPFILE, TPFIELD, (/ISIZE/), IVDIMSTMP)
+ 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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_C1','NF90_DEF_VAR',trim(YVARNAME))
+ 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_WRITE_FIELD_NC4_C1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_C1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
END IF
! Write metadata
-CALL IO_WRITE_FIELD_ATTR_NC4(TPFILE,TPFIELD,IVARID,GEXISTED)
+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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_C1','NF90_PUT_VAR',trim(YVARNAME),IRESP)
+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)
KRESP = IRESP
-END SUBROUTINE IO_WRITE_FIELD_NC4_C1
+END SUBROUTINE IO_Field_write_nc4_C1
-SUBROUTINE IO_WRITE_FIELD_NC4_T0(TPFILE,TPFIELD,TPDATA,KRESP)
+SUBROUTINE IO_Field_write_nc4_T0(TPFILE,TPFIELD,TPDATA,KRESP)
!
USE MODD_TIME_n, ONLY: TDTMOD
USE MODD_TYPE_DATE
@@ -1327,19 +1280,19 @@ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
TYPE (DATE_TIME), INTENT(IN) :: TPDATA
INTEGER, INTENT(OUT):: KRESP
!
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND), 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) :: 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
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_NC4_T0',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_nc4_T0',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
!
IRESP = 0
!
@@ -1350,14 +1303,14 @@ INCID = TPFILE%NNCID
!
GEXISTED = .FALSE.
!
-CALL CLEANMNHNAME(TPFIELD%CMNHNAME,YVARNAME)
+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_WRITE_FIELD_NC4_T0',TRIM(TPFILE%CNAME)// &
+ 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
@@ -1372,33 +1325,29 @@ WRITE(YUNITS,'( "seconds since ",I4.4,"-",I2.2,"-",I2.2," 00:00:00 +0:00" )') &
TZFIELD%CUNITS = TRIM(YUNITS)
!
IF (TPFIELD%LTIMEDEP) &
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_NC4_T0',TRIM(TPFILE%CNAME)// &
+ 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
-#if (MNH_REAL == 8)
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_DOUBLE, IVARID)
-#else
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT, IVARID)
-#endif
- IF (status /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_T0','NF90_DEF_VAR',trim(YVARNAME))
+ 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_WRITE_FIELD_NC4_T0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_T0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
END IF
! Write metadata
-CALL IO_WRITE_FIELD_ATTR_NC4(TPFILE,TZFIELD,IVARID,GEXISTED,HCALENDAR='standard')
+CALL IO_Field_attr_write_nc4(TPFILE,TZFIELD,IVARID,GEXISTED,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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_T0','NF90_PUT_VAR',trim(YVARNAME),IRESP)
+IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_T0','NF90_PUT_VAR',trim(YVARNAME),IRESP)
IF (IRESP/=0) THEN
KRESP = IRESP
@@ -1420,19 +1369,19 @@ TZFIELD%CCOMMENT = 'YYYYMMDD'
STATUS = NF90_INQ_VARID(INCID, TZFIELD%CMNHNAME, IVARID)
IF (STATUS /= NF90_NOERR) THEN
! Get the netcdf dimensions
- CALL FILLVDIMS(TPFILE, TPFIELD, INT(SHAPE(ITDATE),KIND=IDCDF_KIND), IVDIMS)
+ 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_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_T0','NF90_DEF_VAR',trim(TZFIELD%CMNHNAME))
- CALL IO_WRITE_FIELD_ATTR_NC4(TPFILE,TZFIELD,IVARID,GEXISTED)
+ 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
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_NC4_T0',TRIM(TPFILE%CNAME)//': '//TRIM(TZFIELD%CMNHNAME)//' already defined')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_T0',TRIM(TPFILE%CNAME)//': '//TRIM(TZFIELD%CMNHNAME)//' already defined')
END IF
! Write the data
STATUS = NF90_PUT_VAR(INCID, IVARID, ITDATE)
-IF (status /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_T0','NF90_PUT_VAR',trim(TZFIELD%CMNHNAME),IRESP)
+IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_T0','NF90_PUT_VAR',trim(TZFIELD%CMNHNAME),IRESP)
IF (IRESP/=0) THEN
KRESP = IRESP
@@ -1450,31 +1399,28 @@ TZFIELD%CCOMMENT = 'SECONDS'
STATUS = NF90_INQ_VARID(INCID, TZFIELD%CMNHNAME, IVARID)
IF (STATUS /= NF90_NOERR) THEN
! Define the scalar variable
-#if (MNH_REAL == 8)
- STATUS = NF90_DEF_VAR(INCID, TZFIELD%CMNHNAME, NF90_DOUBLE, IVARID)
-#else
- STATUS = NF90_DEF_VAR(INCID, TZFIELD%CMNHNAME, NF90_FLOAT, IVARID)
-#endif
- IF (status /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_T0','NF90_DEF_VAR',trim(TZFIELD%CMNHNAME))
- CALL IO_WRITE_FIELD_ATTR_NC4(TPFILE,TZFIELD,IVARID,GEXISTED)
+ 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_WRITE_FIELD_NC4_T0',TRIM(TPFILE%CNAME)//': '//TRIM(TZFIELD%CMNHNAME)//' already defined')
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_T0',TRIM(TPFILE%CNAME)//': '//TRIM(TZFIELD%CMNHNAME)//' already defined')
END IF
! Write the data
STATUS = NF90_PUT_VAR(INCID, IVARID, TPDATA%TIME)
-IF (status /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(status,'IO_WRITE_FIELD_NC4_T0','NF90_PUT_VAR',trim(TZFIELD%CMNHNAME),IRESP)
+IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_T0','NF90_PUT_VAR',trim(TZFIELD%CMNHNAME),IRESP)
#endif
KRESP = IRESP
-END SUBROUTINE IO_WRITE_FIELD_NC4_T0
+END SUBROUTINE IO_Field_write_nc4_T0
-SUBROUTINE IO_WRITE_COORDVAR_NC4(TPFILE,HPROGRAM_ORIG)
+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
@@ -1489,15 +1435,16 @@ CHARACTER(LEN=:),ALLOCATABLE :: YPROGRAM
INTEGER :: IIU, IJU, IKU
INTEGER :: ID, IID, IRESP
INTEGER :: IMI
-INTEGER(KIND=IDCDF_KIND) :: INCID
+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(IOCDF), POINTER :: PIOCDF
+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_WRITE_COORDVAR_NC4','called for '//TRIM(TPFILE%CNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Coordvar_write_nc4','called for '//TRIM(TPFILE%CNAME))
ZXHAT => NULL()
ZYHAT => NULL()
@@ -1554,17 +1501,34 @@ IF (LCARTESIAN) THEN
ELSE
YSTDNAMEPREFIX = 'projection'
ENDIF
-CALL WRITE_HOR_COORD(PIOCDF%DIM_NI,'x-dimension of the grid',TRIM(YSTDNAMEPREFIX)//'_x_coordinate','X',0.,JPHEXT,JPHEXT,ZXHATM)
-CALL WRITE_HOR_COORD(PIOCDF%DIM_NJ,'y-dimension of the grid',TRIM(YSTDNAMEPREFIX)//'_y_coordinate','Y',0.,JPHEXT,JPHEXT,ZYHATM)
-CALL WRITE_HOR_COORD(PIOCDF%DIM_NI_U,'x-dimension of the grid at u location', &
+
+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
+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
+
+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(PIOCDF%DIM_NJ_U,'y-dimension of the grid at u location', &
+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(PIOCDF%DIM_NI_V,'x-dimension of the grid at v location', &
+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(PIOCDF%DIM_NJ_V,'y-dimension of the grid at v location', &
+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))
!
@@ -1633,9 +1597,9 @@ SUBROUTINE WRITE_HOR_COORD(TDIM,HLONGNAME,HSTDNAME,HAXIS,PSHIFT,KBOUNDLOW,KBOUND
INTEGER :: IRESP
INTEGER :: ISIZE
INTEGER :: JI
- INTEGER(KIND=IDCDF_KIND) :: IVARID
- INTEGER(KIND=IDCDF_KIND) :: IVDIM
- INTEGER(KIND=IDCDF_KIND) :: STATUS
+ INTEGER(KIND=CDFINT) :: IVARID
+ INTEGER(KIND=CDFINT) :: IVDIM
+ INTEGER(KIND=CDFINT) :: STATUS
LOGICAL :: GALLOC
REAL,DIMENSION(:),POINTER :: ZTAB
@@ -1679,38 +1643,34 @@ SUBROUTINE WRITE_HOR_COORD(TDIM,HLONGNAME,HSTDNAME,HAXIS,PSHIFT,KBOUNDLOW,KBOUND
STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
IF (STATUS /= NF90_NOERR) THEN
! Define the coordinate variable
-#if (MNH_REAL == 8)
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_DOUBLE, IVDIM, IVARID)
-#else
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT, IVDIM, IVARID)
-#endif
- IF (status /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(status,'WRITE_HOR_COORD','NF90_DEF_VAR',trim(YVARNAME))
+ 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))
ELSE
CALL PRINT_MSG(NVERB_ERROR,'IO','WRITE_HOR_COORD',TRIM(YVARNAME)//' already defined')
END IF
! Write metadata
STATUS = NF90_PUT_ATT(INCID, IVARID, 'long_name',HLONGNAME)
- IF (STATUS /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(status,'WRITE_HOR_COORD','NF90_PUT_ATT','long_name for '//trim(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'WRITE_HOR_COORD','NF90_PUT_ATT','standard_name for '//trim(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'WRITE_HOR_COORD','NF90_PUT_ATT','units for '//trim(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'WRITE_HOR_COORD','NF90_PUT_ATT','axis for '//trim(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'WRITE_HOR_COORD','NF90_PUT_ATT','c_grid_axis_shift for ' &
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_HOR_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_HANDLE_ERR_NC4(status,'WRITE_HOR_COORD','NF90_PUT_ATT','c_grid_dynamic_range for ' &
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_HOR_COORD','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_HANDLE_ERR_NC4(status,'WRITE_HOR_COORD','NF90_PUT_VAR',trim(YVARNAME),IRESP)
+ IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_HOR_COORD','NF90_PUT_VAR',trim(YVARNAME),IRESP)
END IF
IF (GALLOC) DEALLOCATE(ZTAB)
@@ -1755,9 +1715,9 @@ SUBROUTINE WRITE_HOR_2DCOORD(PX,PY,HLAT,HLON)
ENDIF
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HLAT,ID,IRESP)
- CALL IO_WRITE_FIELD_NC4_X2(TPFILE,TFIELDLIST(ID),ZTAB1,IRESP,OISCOORD=.TRUE.)
+ CALL IO_Field_write_nc4_X2(TPFILE,TFIELDLIST(ID),ZTAB1,IRESP,OISCOORD=.TRUE.)
CALL FIND_FIELD_ID_FROM_MNHNAME(HLON,ID,IRESP)
- CALL IO_WRITE_FIELD_NC4_X2(TPFILE,TFIELDLIST(ID),ZTAB2,IRESP,OISCOORD=.TRUE.)
+ CALL IO_Field_write_nc4_X2(TPFILE,TFIELDLIST(ID),ZTAB2,IRESP,OISCOORD=.TRUE.)
END IF
IF (GALLOC1) DEALLOCATE(ZTAB1)
@@ -1779,9 +1739,9 @@ SUBROUTINE WRITE_VER_COORD(TDIM,HLONGNAME,HSTDNAME,HCOMPNAME,PSHIFT,KBOUNDLOW,KB
INTEGER :: IRESP
INTEGER :: ISIZE
INTEGER :: JI
- INTEGER(KIND=IDCDF_KIND) :: IVARID
- INTEGER(KIND=IDCDF_KIND) :: IVDIM
- INTEGER(KIND=IDCDF_KIND) :: STATUS
+ INTEGER(KIND=CDFINT) :: IVARID
+ INTEGER(KIND=CDFINT) :: IVDIM
+ INTEGER(KIND=CDFINT) :: STATUS
ISIZE = TDIM%LEN
YVARNAME = TRIM(TDIM%NAME)
@@ -1790,61 +1750,57 @@ SUBROUTINE WRITE_VER_COORD(TDIM,HLONGNAME,HSTDNAME,HCOMPNAME,PSHIFT,KBOUNDLOW,KB
STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
IF (STATUS /= NF90_NOERR) THEN
! Define the coordinate variable
-#if (MNH_REAL == 8)
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_DOUBLE, IVDIM, IVARID)
-#else
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT, IVDIM, IVARID)
-#endif
- IF (status /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(status,'WRITE_VER_COORD','NF90_DEF_VAR',trim(YVARNAME))
+ 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))
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_HANDLE_ERR_NC4(status,'WRITE_VER_COORD','NF90_PUT_ATT','long_name for '//trim(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'WRITE_VER_COORD','NF90_PUT_ATT','standard_name for '//trim(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'WRITE_VER_COORD','NF90_PUT_ATT','units for '//trim(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'WRITE_VER_COORD','NF90_PUT_ATT','axis for '//trim(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'WRITE_VER_COORD','NF90_PUT_ATT','positive for '//trim(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'WRITE_VER_COORD','NF90_PUT_ATT','c_grid_axis_shift for ' &
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'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_HANDLE_ERR_NC4(status,'WRITE_VER_COORD','NF90_PUT_ATT','c_grid_dynamic_range for ' &
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'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_HANDLE_ERR_NC4(status,'WRITE_VER_COORD','NF90_PUT_ATT','formula_terms for '//trim(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'WRITE_VER_COORD','NF90_PUT_ATT','formula_definition for ' &
+ 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_HANDLE_ERR_NC4(status,'WRITE_VER_COORD','NF90_PUT_ATT','formula_terms for '//trim(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'WRITE_VER_COORD','NF90_PUT_ATT','formula_definition for ' &
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_VER_COORD','NF90_PUT_ATT','formula_definition for ' &
//trim(YVARNAME))
ENDIF
!
STATUS = NF90_PUT_ATT(INCID, IVARID, 'computed_standard_name',HCOMPNAME)
- IF (STATUS /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(status,'WRITE_VER_COORD','NF90_PUT_ATT','computed_standard_name for ' &
+ IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_VER_COORD','NF90_PUT_ATT','computed_standard_name for ' &
//trim(YVARNAME))
! Write the data
STATUS = NF90_PUT_VAR(INCID, IVARID, PCOORDS)
- IF (status /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(status,'WRITE_VER_COORD','NF90_PUT_VAR',trim(YVARNAME))
+ IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_VER_COORD','NF90_PUT_VAR',trim(YVARNAME))
END SUBROUTINE WRITE_VER_COORD
@@ -1861,9 +1817,9 @@ SUBROUTINE WRITE_TIME_COORD(TDIM)
REAL :: ZDELTATIME
CHARACTER(LEN=40) :: YUNITS
CHARACTER(LEN=:),ALLOCATABLE :: YVARNAME
- INTEGER(KIND=IDCDF_KIND) :: IVARID
- INTEGER(KIND=IDCDF_KIND) :: IVDIM
- INTEGER(KIND=IDCDF_KIND) :: STATUS
+ INTEGER(KIND=CDFINT) :: IVARID
+ INTEGER(KIND=CDFINT) :: IVDIM
+ INTEGER(KIND=CDFINT) :: STATUS
TYPE(DATE_TIME) :: TZREF
@@ -1874,29 +1830,25 @@ SUBROUTINE WRITE_TIME_COORD(TDIM)
STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
IF (STATUS /= NF90_NOERR) THEN
! Define the coordinate variable
-#if (MNH_REAL == 8)
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_DOUBLE, IVDIM, IVARID)
-#else
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT, IVDIM, IVARID)
-#endif
- IF (status /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(status,'WRITE_TIME_COORD','NF90_DEF_VAR',trim(YVARNAME))
+ 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
! Write metadata
STATUS = NF90_PUT_ATT(INCID, IVARID, 'long_name','time axis')
- IF (STATUS /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(status,'WRITE_TIME_COORD','NF90_PUT_ATT','long_name for '//trim(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'WRITE_TIME_COORD','NF90_PUT_ATT','standard_name for '//trim(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'WRITE_TIME_COORD','NF90_PUT_ATT','units for '//trim(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'WRITE_TIME_COORD','NF90_PUT_ATT','axis for '//trim(YVARNAME))
+ 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_HANDLE_ERR_NC4(status,'WRITE_TIME_COORD','NF90_PUT_ATT','calendar for '//trim(YVARNAME))
+ 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.
@@ -1906,46 +1858,46 @@ SUBROUTINE WRITE_TIME_COORD(TDIM)
CALL DATETIME_DISTANCE(TZREF,TDTCUR,ZDELTATIME)
! Write the data
STATUS = NF90_PUT_VAR(INCID, IVARID, ZDELTATIME)
- IF (status /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(status,'WRITE_TIME_COORD','NF90_PUT_VAR',trim(YVARNAME))
+ IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_TIME_COORD','NF90_PUT_VAR',trim(YVARNAME))
END IF
END SUBROUTINE WRITE_TIME_COORD
-END SUBROUTINE IO_WRITE_COORDVAR_NC4
+END SUBROUTINE IO_Coordvar_write_nc4
-SUBROUTINE IO_WRITE_HEADER_NC4(TPFILE)
+SUBROUTINE IO_Header_write_nc4(TPFILE)
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File structure
!
-INTEGER(KIND=IDCDF_KIND) :: ISTATUS
+INTEGER(KIND=CDFINT) :: ISTATUS
!
IF (TRIM(TPFILE%CFORMAT)/='NETCDF4' .AND. TRIM(TPFILE%CFORMAT)/='LFICDF4') RETURN
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_HEADER_NC4','called for file '//TRIM(TPFILE%CNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Header_write_nc4','called for file '//TRIM(TPFILE%CNAME))
!
IF (TPFILE%LMASTER) THEN
ISTATUS = NF90_PUT_ATT(TPFILE%NNCID, NF90_GLOBAL, 'Conventions', 'CF-1.7 COMODO-1.4')
- IF (ISTATUS /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(istatus,'IO_FILE_WRITE_HEADER','NF90_PUT_ATT','Conventions')
+ IF (ISTATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_FILE_WRITE_HEADER','NF90_PUT_ATT','Conventions')
#if (MNH_REAL == 8)
ISTATUS = NF90_PUT_ATT(TPFILE%NNCID, NF90_GLOBAL, 'MNH_REAL', '8')
#else
ISTATUS = NF90_PUT_ATT(TPFILE%NNCID, NF90_GLOBAL, 'MNH_REAL', '4')
#endif
- IF (ISTATUS /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(istatus,'IO_FILE_WRITE_HEADER','NF90_PUT_ATT','MNH_REAL')
+ IF (ISTATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_FILE_WRITE_HEADER','NF90_PUT_ATT','MNH_REAL')
#if (MNH_INT == 4)
ISTATUS = NF90_PUT_ATT(TPFILE%NNCID, NF90_GLOBAL, 'MNH_INT', '4')
#else
ISTATUS = NF90_PUT_ATT(TPFILE%NNCID, NF90_GLOBAL, 'MNH_INT', '8')
#endif
- IF (ISTATUS /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(istatus,'IO_FILE_WRITE_HEADER','NF90_PUT_ATT','MNH_INT')
+ IF (ISTATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_FILE_WRITE_HEADER','NF90_PUT_ATT','MNH_INT')
!title
!history
- CALL IO_APPEND_HISTORY_NC4(TPFILE)
+ CALL IO_History_append_nc4(TPFILE)
!institution
@@ -1956,12 +1908,12 @@ IF (TPFILE%LMASTER) THEN
!references
END IF
!
-END SUBROUTINE IO_WRITE_HEADER_NC4
+END SUBROUTINE IO_Header_write_nc4
-SUBROUTINE IO_APPEND_HISTORY_NC4(TPFILE)
+SUBROUTINE IO_History_append_nc4(TPFILE)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File structure
!
@@ -1970,12 +1922,12 @@ INTEGER,PARAMETER :: YEAR=1, MONTH=2, DAY=3, HH=5, MM=6, SS=7
CHARACTER(len=5) :: YZONE
CHARACTER(LEN=:),ALLOCATABLE :: YCMD, YHISTORY, YHISTORY_NEW, YHISTORY_PREV
INTEGER :: ILEN_CMD, ILEN_PREV
-INTEGER(KIND=IDCDF_KIND) :: ISTATUS
+INTEGER(KIND=CDFINT) :: ISTATUS
INTEGER,DIMENSION(8) :: IDATETIME
!
IF (TRIM(TPFILE%CFORMAT)/='NETCDF4' .AND. TRIM(TPFILE%CFORMAT)/='LFICDF4') RETURN
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_APPEND_HISTORY_NC4','called for file '//TRIM(TPFILE%CNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_History_append_nc4','called for file '//TRIM(TPFILE%CNAME))
!
IF (TPFILE%LMASTER) THEN
!Check if history attribute already exists in file and read it
@@ -1983,7 +1935,7 @@ IF (TPFILE%LMASTER) THEN
IF (ISTATUS == NF90_NOERR) THEN
ALLOCATE(CHARACTER(LEN=ILEN_PREV) :: YHISTORY_PREV)
ISTATUS = NF90_GET_ATT(TPFILE%NNCID, NF90_GLOBAL, 'history', YHISTORY_PREV)
- IF (ISTATUS /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(ISTATUS,'IO_APPEND_HISTORY_NC4','NF90_GET_ATT','history')
+ IF (ISTATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(ISTATUS,'IO_History_append_nc4','NF90_GET_ATT','history')
YHISTORY_PREV = YHISTORY_PREV
ELSE
ILEN_PREV = 0
@@ -2009,10 +1961,10 @@ IF (TPFILE%LMASTER) THEN
YHISTORY = YHISTORY_NEW//NEW_LINE('A')//YHISTORY_PREV
END IF
ISTATUS = NF90_PUT_ATT(TPFILE%NNCID, NF90_GLOBAL, 'history', YHISTORY )
- IF (ISTATUS /= NF90_NOERR) CALL IO_HANDLE_ERR_NC4(istatus,'IO_APPEND_HISTORY_NC4','NF90_PUT_ATT','history')
+ IF (ISTATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_History_append_nc4','NF90_PUT_ATT','history')
END IF
-END SUBROUTINE IO_APPEND_HISTORY_NC4
+END SUBROUTINE IO_History_append_nc4
end module mode_io_write_nc4
@@ -2020,22 +1972,22 @@ end module mode_io_write_nc4
!
! External dummy subroutines
!
-subroutine io_write_coordvar_nc4(a, b)
+subroutine IO_Coordvar_write_nc4(a, b)
use mode_msg
integer :: a, b
-CALL PRINT_MSG(NVERB_ERROR,'IO','io_write_coordvar_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
-end subroutine io_write_coordvar_nc4
+CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Coordvar_write_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end subroutine IO_Coordvar_write_nc4
!
-subroutine io_write_field_nc4(a, b, c, d, e, f, g)
+subroutine IO_Field_write_nc4(a, b, c, d, e, f, g)
use mode_msg
integer :: a, b, c, d, e, f, g
-CALL PRINT_MSG(NVERB_ERROR,'IO','io_write_field_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
-end subroutine io_write_field_nc4
+CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end subroutine IO_Field_write_nc4
!
-subroutine io_write_header_nc4(a)
+subroutine IO_Header_write_nc4(a)
use mode_msg
integer :: a
-CALL PRINT_MSG(NVERB_ERROR,'IO','io_write_header_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
-end subroutine io_write_header_nc4
+CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Header_write_nc4','empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF')
+end subroutine IO_Header_write_nc4
!
#endif
diff --git a/src/LIB/SURCOUCHE/src/mode_lb_ll.f90 b/src/LIB/SURCOUCHE/src/mode_lb_ll.f90
index 72b5dc99bf8ae0103382b04a826a479b7d87cb2e..805e607bc4feb4190007d10ce5003fd6bb328221 100644
--- a/src/LIB/SURCOUCHE/src/mode_lb_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_lb_ll.f90
@@ -1,8 +1,11 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+!-----------------------------------------------------------------
! #################
MODULE MODE_LB_ll
@@ -117,6 +120,7 @@
USE MODD_VAR_ll, ONLY : TCRRT_COMDATA
!
USE MODE_ARGSLIST_ll, ONLY : ADD2DFIELD_ll
+ use mode_msg
USE MODE_NEST_ll, ONLY : LBFINE2COARSE
!
IMPLICIT NONE
@@ -129,6 +133,7 @@
!
!* 0.2 declarations of local variables
!
+ CHARACTER(len=10) :: ymodel !String for error message
INTEGER :: ICOARSE
TYPE(LCRSPD_ll), POINTER :: TZPAR, TZCHILD
TYPE(LPROC_COM_DATA_ll), POINTER :: TZLCOMDATA
@@ -142,8 +147,7 @@
!
IF (.NOT.ASSOCIATED(TCRRT_COMDATA%TCHILDREN) &
& .OR. .NOT.ASSOCIATED(TCRRT_COMDATA%TP2C_DATA)) THEN
- WRITE(*,*) 'Problem in set_lbfield_ll'
- WRITE(*,*) 'The current model has no child'
+ call Print_msg( NVERB_WARNING, 'GEN', 'SET_LB2DFIELD_ll', 'the current model has no child' )
RETURN
ENDIF
!
@@ -165,9 +169,8 @@
TZLCOMDATA => TZLCOMDATA%TNEXT
ENDDO
IF (.NOT.ASSOCIATED(TZLCOMDATA)) THEN
- WRITE(*,*) 'Error SET_LBFIELD_ll : ', KMODEL, &
- ' is not a child of the current model'
- STOP
+ write( ymodel, '( I10 )' ) KMODEL
+ call Print_msg( NVERB_FATAL, 'GEN', 'SET_LB2DFIELD_ll', trim(ymodel)//' is not a child of the current model' )
ENDIF
!
!* 2.2 Point to the parent2child data structure
@@ -177,9 +180,8 @@
TZP2CDATA => TZP2CDATA%TNEXT
ENDDO
IF (.NOT.ASSOCIATED(TZP2CDATA)) THEN
- WRITE(*,*) 'Error SET_LBFIELD_ll : ', KMODEL, &
- ' is not a child of the current model'
- STOP
+ write( ymodel, '( I10 )' ) KMODEL
+ call Print_msg( NVERB_FATAL, 'GEN', 'SET_LB2DFIELD_ll', trim(ymodel)//' is not a child of the current model' )
ENDIF
!
!* 2.3 Point to the appropriate side
@@ -281,6 +283,7 @@
USE MODD_VAR_ll, ONLY : TCRRT_COMDATA
!
USE MODE_ARGSLIST_ll, ONLY : ADD3DFIELD_ll
+ use mode_msg
USE MODE_NEST_ll, ONLY : LBFINE2COARSE
!
!
@@ -294,6 +297,7 @@
!
!* 0.2 declarations of local variables
!
+ CHARACTER(len=10) :: ymodel !String for error message
INTEGER :: ICOARSE
TYPE(LCRSPD_ll), POINTER :: TZPAR, TZCHILD
TYPE(LPROC_COM_DATA_ll), POINTER :: TZLCOMDATA
@@ -307,8 +311,7 @@
!
IF (.NOT.ASSOCIATED(TCRRT_COMDATA%TCHILDREN) &
& .OR. .NOT.ASSOCIATED(TCRRT_COMDATA%TP2C_DATA)) THEN
- WRITE(*,*) 'Problem in set_lbfield_ll'
- WRITE(*,*) 'The current model has no child'
+ call Print_msg( NVERB_WARNING, 'GEN', 'SET_LB3DFIELD_ll', 'the current model has no child' )
RETURN
ENDIF
!
@@ -330,9 +333,8 @@
TZLCOMDATA => TZLCOMDATA%TNEXT
ENDDO
IF (.NOT.ASSOCIATED(TZLCOMDATA)) THEN
- WRITE(*,*) 'Error SET_LBFIELD_ll : ', KMODEL, &
- ' is not a child of the current model'
- STOP
+ write( ymodel, '( I10 )' ) KMODEL
+ call Print_msg( NVERB_FATAL, 'GEN', 'SET_LB3DFIELD_ll', trim(ymodel)//' is not a child of the current model' )
ENDIF
!
!* 2.2 Point to the parent2child data structure
@@ -342,9 +344,8 @@
TZP2CDATA => TZP2CDATA%TNEXT
ENDDO
IF (.NOT.ASSOCIATED(TZP2CDATA)) THEN
- WRITE(*,*) 'Error SET_LBFIELD_ll : ', KMODEL, &
- ' is not a child of the current model'
- STOP
+ write( ymodel, '( I10 )' ) KMODEL
+ call Print_msg( NVERB_FATAL, 'GEN', 'SET_LB3DFIELD_ll', trim(ymodel)//' is not a child of the current model' )
ENDIF
!
!* 2.3 Point to the appropriate side
@@ -433,7 +434,9 @@
!!
USE MODD_STRUCTURE_ll, ONLY : LPARENT2CHILD_DATA_ll, PARENT2CHILD_DATA_ll
USE MODD_VAR_ll, ONLY : TCRRT_COMDATA
+
USE MODE_CONSTRUCT_ll, ONLY : CLEANLIST_LCRSPD
+ use mode_msg
!
IMPLICIT NONE
!
@@ -475,8 +478,7 @@
!
ELSE
!
- WRITE(*,*) 'Problem in UNSET_LBFIELD'
- WRITE(*,*) 'The current model is 1'
+ call Print_msg( NVERB_WARNING, 'GEN', 'UNSET_LBFIELD', 'problem: the current model is 1' )
!
ENDIF
!
@@ -1666,14 +1668,12 @@
! ------------
!
USE MODD_CONF
-! USE MODD_DIM_n
USE MODD_DYN_n
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
-! USE MODE_ll
- USE MODE_IO_ll
- USE MODE_MPPDB
+ USE MODD_IO, ONLY: ISP
+ USE MODD_PARAMETERS_ll, ONLY: JPHEXT
+
USE MODE_DISTRIB_LB
- USE MODD_PARAMETERS_ll, ONLY : JPHEXT
+ use mode_msg
!
IMPLICIT NONE
!
@@ -1693,6 +1693,7 @@
! LOCAL VARIABLES
CHARACTER(4) :: YLBTYPEX ! LB type : 'LBX','LBXU'
CHARACTER(4) :: YLBTYPEY ! LB type : 'LBY','LBYV'
+ character(len=10) :: ydim1, ydim2 !Strings for error messages
! local indices for the intersection of the local subdomain and the LB zone
INTEGER :: IIB_LOCLB ! indice I Beginning in x direction
INTEGER :: IJB_LOCLB ! indice J Beginning in y direction
@@ -1714,8 +1715,7 @@
YLBTYPEX = 'LBXU'
YLBTYPEY = 'LBYV'
ELSE
- WRITE(*,*) "ERROR: from SET_LB_FIELD_ll, UNKNOWN LB TYPE", HLBTYPE
- CALL ABORT
+ call Print_msg( NVERB_FATAL, 'GEN', 'SET_LB_FIELD_ll', 'unknown HLBTYPE ('//trim(HLBTYPE)//')' )
ENDIF
!
! get the local indices of the West-East LB arrays for the local subdomain
@@ -1723,9 +1723,10 @@
! and the corresponding indices for the LB global arrays
CALL GET_DISTRIB_LB(YLBTYPEX,ISP,'FM','WRITE',NRIMX,IIB_GLBLB,IIE_GLBLB,IJB_GLBLB,IJE_GLBLB)
IF ( IIE_LOCLB-IIB_LOCLB /= IIE_GLBLB-IIB_GLBLB ) THEN
- WRITE(*,*) "ERROR: from SET_LB_FIELD_ll, West-East IIE_LOCLB-IIB_LOCLB =",&
- IIE_LOCLB-IIB_LOCLB, " /= IIE_GLBLB-IIB_GLBLB =", IIE_GLBLB-IIB_GLBLB
- CALL ABORT
+ write( ydim1, '( I10 )' ) IIE_LOCLB-IIB_LOCLB
+ write( ydim2, '( I10 )' ) IIE_GLBLB-IIB_GLBLB
+ call Print_msg( NVERB_FATAL, 'GEN', 'SET_LB_FIELD_ll', 'West-East IIE_LOCLB-IIB_LOCL='//trim(ydim1)// &
+ ' /= IIE_GLBLB-IIB_GLBLB='//trim(ydim2) )
ENDIF
LOCLBSIZEW = 0
LOCLBSIZEE = 0
@@ -1747,8 +1748,7 @@
PLBXFIELD(IIB_LOCLB:IIE_LOCLB,:,:) = PFIELD(GLBLBBEGIN:GLBLBEND,:,:)
! PLBXFIELD(NRIMX+1+IIB_LOCLB:NRIMX+1+IIE_LOCLB,:,:) = PFIELD(GLBLBBEGIN:GLBLBEND,:,:)
ELSE
- WRITE(*,*) "ERROR: from SET_LB_FIELD_ll, This type of partition is not allowed !"
- CALL ABORT
+ call Print_msg( NVERB_FATAL, 'GEN', 'SET_LB_FIELD_ll', 'this type of partition is not allowed' )
ENDIF
ENDIF !( IIB_LOCLB /= 0 )
!
@@ -1762,9 +1762,10 @@
! and the corresponding indices for the LB global arrays
CALL GET_DISTRIB_LB(YLBTYPEY,ISP,'FM','WRITE',NRIMY,IIB_GLBLB,IIE_GLBLB,IJB_GLBLB,IJE_GLBLB)
IF ( IJE_LOCLB-IJB_LOCLB /= IJE_GLBLB-IJB_GLBLB ) THEN
- WRITE(*,*) "ERROR: from SET_LB_FIELD_ll, South-North IJE_LOCLB-IJB_LOCLB =",&
- IJE_LOCLB-IJB_LOCLB, " /= IJE_GLBLB-IJB_GLBLB =", IJE_GLBLB-IJB_GLBLB
- CALL ABORT
+ write( ydim1, '( I10 )' ) IJE_LOCLB-IJB_LOCLB
+ write( ydim2, '( I10 )' ) IJE_GLBLB-IJB_GLBLB
+ call Print_msg( NVERB_FATAL, 'GEN', 'SET_LB_FIELD_ll', 'South-North IJE_LOCLB-IJB_LOCLB='//trim(ydim1)// &
+ ' /= IJE_GLBLB-IJB_GLBLB='//trim(ydim2) )
ENDIF
IF ( IJB_LOCLB /= 0 ) THEN ! if the LB zone of the local subdomain is non-empty
IF ( IJB_GLBLB <= NRIMY+JPHEXT .AND. IJE_GLBLB >= NRIMY+JPHEXT+1 ) THEN ! the local south and north LB zones are non empty
@@ -1780,8 +1781,7 @@
PLBYFIELD(:,IJB_LOCLB:IJE_LOCLB,:) = PFIELD(:,GLBLBBEGIN:GLBLBEND,:)
! PLBYFIELD(:,NRIMY+1+IJB_LOCLB:NRIMY+1+IJE_LOCLB,:) = PFIELD(:,GLBLBBEGIN:GLBLBEND,:)
ELSE
- WRITE(*,*) "ERROR: from SET_LB_FIELD_ll, This type of partition is not allowed !"
- CALL ABORT
+ call Print_msg( NVERB_FATAL, 'GEN', 'SET_LB_FIELD_ll', 'this type of partition is not allowed' )
ENDIF
ENDIF !( IJB_LOCLB /= 0 )
diff --git a/src/LIB/SURCOUCHE/src/mode_ls_ll.f90 b/src/LIB/SURCOUCHE/src/mode_ls_ll.f90
index 0626ce6ba719541e8e7c980b69172d802ff245e8..0af00e6c6d1cc7aee2b52b91264a799da758fe4a 100644
--- a/src/LIB/SURCOUCHE/src/mode_ls_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_ls_ll.f90
@@ -1,15 +1,10 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-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$
-!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-----------------------------------------------------------------
! #################
@@ -59,6 +54,8 @@
!------------------------------------------------------------------------------
!
USE MODD_STRUCTURE_ll
+
+ use mode_msg
!
CONTAINS
!
@@ -120,6 +117,7 @@
!
!* 0.2 declarations of local variables
!
+ character(len=10) :: ymodel ! String for error message
INTEGER :: ICOARSE
TYPE(LCRSPD_ll), POINTER :: TZPAR, TZCHILD
TYPE(LPROC_COM_DATA_ll), POINTER :: TZLCOMDATA
@@ -149,9 +147,8 @@
TZLCOMDATA => TZLCOMDATA%TNEXT
ENDDO
IF (.NOT.ASSOCIATED(TZLCOMDATA)) THEN
- WRITE(*,*) 'Error SET_LS2DFIELD_1WAY_ll : ', KMODEL, &
- ' is not a child of the current model'
- STOP
+ write( ymodel, '( I10 )' ) kmodel
+ call Print_msg( NVERB_FATAL, 'GEN', 'SET_LS2DFIELD_1WAY_ll', 'model '//trim(ymodel)//' is not a child of the current model' )
ENDIF
!
!* 2.2 Point to the parent2child data structure
@@ -161,9 +158,8 @@
TZP2CDATA => TZP2CDATA%TNEXT
ENDDO
IF (.NOT.ASSOCIATED(TZP2CDATA)) THEN
- WRITE(*,*) 'Error SET_LS2DFIELD_1WAY_ll : ', KMODEL, &
- ' is not a child of the current model'
- STOP
+ write( ymodel, '( I10 )' ) kmodel
+ call Print_msg( NVERB_FATAL, 'GEN', 'SET_LS2DFIELD_1WAY_ll', 'model '//trim(ymodel)//' is not a child of the current model' )
ENDIF
!
TZPAR => TZP2CDATA%TELT%TSEND_1WAY_LS
@@ -239,6 +235,7 @@
!
!* 0.2 declarations of local variables
!
+ character(len=10) :: ymodel ! String for error message
INTEGER :: ICOARSE
TYPE(LCRSPD_ll), POINTER :: TZPAR, TZCHILD
TYPE(LPROC_COM_DATA_ll), POINTER :: TZLCOMDATA
@@ -268,9 +265,8 @@
TZLCOMDATA => TZLCOMDATA%TNEXT
ENDDO
IF (.NOT.ASSOCIATED(TZLCOMDATA)) THEN
- WRITE(*,*) 'Error SET_LS3DFIELD_1WAY_ll : ', KMODEL, &
- ' is not a child of the current model'
- STOP
+ write( ymodel, '( I10 )' ) kmodel
+ call Print_msg( NVERB_FATAL, 'GEN', 'SET_LS3DFIELD_1WAY_ll', 'model '//trim(ymodel)//' is not a child of the current model' )
ENDIF
!
!* 2.2 Point to the parent2child data structure
@@ -280,9 +276,8 @@
TZP2CDATA => TZP2CDATA%TNEXT
ENDDO
IF (.NOT.ASSOCIATED(TZP2CDATA)) THEN
- WRITE(*,*) 'Error SET_LS3DFIELD_1WAY_ll : ', KMODEL, &
- ' is not a child of the current model'
- STOP
+ write( ymodel, '( I10 )' ) kmodel
+ call Print_msg( NVERB_FATAL, 'GEN', 'SET_LS3DFIELD_1WAY_ll', 'model '//trim(ymodel)//' is not a child of the current model' )
ENDIF
!
TZPAR => TZP2CDATA%TELT%TSEND_1WAY_LS
@@ -617,6 +612,7 @@
!
!* 0.2 declarations of local variables
!
+ character(len=10) :: ymodel ! String for error message
TYPE(LPARENT2CHILD_DATA_ll), POINTER :: TZP2CDATA
TYPE(LPROC_COM_DATA_ll), POINTER :: TZLCOMDATA
!
@@ -629,9 +625,8 @@
TZLCOMDATA => TZLCOMDATA%TNEXT
ENDDO
IF (.NOT.ASSOCIATED(TZLCOMDATA)) THEN
- WRITE(*,*) 'Error UNSET_LSFIELD_2WAY_ll : ', KMODEL, &
- ' is not a child of the current model'
- STOP
+ write( ymodel, '( I10 )' ) kmodel
+ call Print_msg( NVERB_FATAL, 'GEN', 'UNSET_LSFIELD_2WAY_ll', 'model '//trim(ymodel)//' is not a child of the current model' )
ENDIF
!
!* 2.2 Point to the parent2child data structure
@@ -641,9 +636,8 @@
TZP2CDATA => TZP2CDATA%TNEXT
ENDDO
IF (.NOT.ASSOCIATED(TZP2CDATA)) THEN
- WRITE(*,*) 'Error UNSET_LSFIELD_2WAY_ll : ', KMODEL, &
- ' is not a child of the current model'
- STOP
+ write( ymodel, '( I10 )' ) kmodel
+ call Print_msg( NVERB_FATAL, 'GEN', 'UNSET_LSFIELD_2WAY_ll', 'model '//trim(ymodel)//' is not a child of the current model' )
ENDIF
!
CALL CLEANLIST_LCRSPD(TZLCOMDATA%TELT%TSEND_2WAY_LS)
diff --git a/src/LIB/SURCOUCHE/src/mode_mppdb.f90 b/src/LIB/SURCOUCHE/src/mode_mppdb.f90
index a02facdac90a9dd2dcac40117e5735b394477589..f0cdedf531bd24cbe8a63eb28b2ac5f3b59b5944 100644
--- a/src/LIB/SURCOUCHE/src/mode_mppdb.f90
+++ b/src/LIB/SURCOUCHE/src/mode_mppdb.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2011-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.
@@ -8,7 +8,7 @@
!
MODULE MODE_MPPDB
!
-! Modifs :
+! Modifications:
!! J.Escobar 23/10/2012: correct CHECK_LB & format print output
!! M.Moge 05/02/2015: MPPDB_CHECK_SURFEX2D and MPPDB_CHECK_SURFEX3D + bug fix in MPPDB_CHECK2D and MPPDB_CHECK3D (call MPI_AllReduce at the beginning)
! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
@@ -19,11 +19,14 @@ MODULE MODE_MPPDB
! Philippe Wautelet: 10/01/2019: use NEWUNIT argument of OPEN
! Philippe Wautelet: 22/01/2019: use standard FLUSH statement instead of non standard intrinsics
! Philippe Wautelet: 22/01/2019: use sleep_c subroutine instead of non-standard call system
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+!-----------------------------------------------------------------
!
use ISO_FORTRAN_ENV, only: OUTPUT_UNIT
- USE MODE_MSG
+
+ use mode_msg
+
use modi_tools_c
-!
IMPLICIT NONE
@@ -185,7 +188,8 @@ MODULE MODE_MPPDB
CALL MPI_INFO_SET (INFO_SPAWN , "wdir", MPPDB_WDIR , ierr)
CALL MPI_INFO_GET (INFO_SPAWN , "wdir", 40, chaine, isset ,ierr)
IF (MPPDB_DEBUG) PRINT*,"MPPDB_INIT:: FATHER :: INFO_SPAWN , wdir=",isset,chaine
- IF (ierr.NE.0) STOP 'MPPDB_INIT:: PB MPI_INFO_SET "wdir" '
+ if (ierr /= 0 ) call Print_msg( NVERB_FATAL, 'GEN', 'MPPDB_INIT', 'MPI_INFO_SET failed' )
+
!
ELSE
! other father only do nothing but participate
@@ -648,8 +652,8 @@ MODULE MODE_MPPDB
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SUBROUTINE MPPDB_CHECK1D_REAL(PTAB,MESSAGE,PPRECISION)
!
- USE MODD_MPIF, ONLY: MPI_CHARACTER, MPI_INTEGER, MPI_STATUS_IGNORE, MPI_SUM, MPI_MAX
- USE MODD_VAR_ll, ONLY: MPI_PRECISION
+ USE MODD_MPIF, ONLY: MPI_CHARACTER, MPI_INTEGER, MPI_STATUS_IGNORE, MPI_SUM, MPI_MAX
+ use modd_precision, only: MNHREAL_MPI
!
USE MODE_DEVICE
!
@@ -732,7 +736,7 @@ MODULE MODE_MPPDB
ISIZEOTHER ,1,MPI_INTEGER,I_FIRST_SON,NTAG, &
MPPDB_INTRA_COMM,MPI_STATUS_IGNORE,IINFO_ll)
IF (SIZE(ZTAB)==ISIZEOTHER) THEN
- CALL MPI_RECV(ZTAB_SON,SIZE(ZTAB_SON),MPI_PRECISION,I_FIRST_SON, &
+ CALL MPI_RECV(ZTAB_SON,SIZE(ZTAB_SON),MNHREAL_MPI,I_FIRST_SON, &
NTAG,MPPDB_INTRA_COMM,MPI_STATUS_IGNORE,IINFO_ll)
ZTAB_DIFF = ABS ( ZTAB - ZTAB_SON )
MAX_VAL(IPAS) = MAXVAL( ABS (ZTAB_SON) )
@@ -756,7 +760,7 @@ MODULE MODE_MPPDB
ISIZEOTHER,1,MPI_INTEGER,I_FIRST_FATHER,NTAG, &
MPPDB_INTRA_COMM,MPI_STATUS_IGNORE,IINFO_ll)
IF (SIZE(ZTAB)==ISIZEOTHER) THEN
- CALL MPI_SEND(ZTAB,SIZE(ZTAB),MPI_PRECISION,I_FIRST_FATHER, &
+ CALL MPI_SEND(ZTAB,SIZE(ZTAB),MNHREAL_MPI,I_FIRST_FATHER, &
NTAG, MPPDB_INTRA_COMM, IINFO_ll)
END IF
END IF
@@ -1117,9 +1121,9 @@ MODULE MODE_MPPDB
SUBROUTINE MPPDB_CHECK3D_REAL(PTAB,MESSAGE,PPRECISION)
!
- USE MODD_PARAMETERS_ll, ONLY: JPHEXT
USE MODD_MPIF, ONLY: MPI_CHARACTER, MPI_INTEGER, MPI_STATUS_IGNORE, MPI_SUM, MPI_MAX
- USE MODD_VAR_ll, ONLY: MPI_PRECISION
+ USE MODD_PARAMETERS_ll, ONLY: JPHEXT
+ use modd_precision, only: MNHREAL_MPI
!
USE MODE_DEVICE
USE MODE_GATHER_ll
@@ -1238,7 +1242,7 @@ MODULE MODE_MPPDB
IF (.NOT. ALLOCATED(TAB_SON_ll)) ALLOCATE(TAB_SON_ll(IIU_SON_ll,IJU_SON_ll,IKU_SON_ll))
!
- CALL MPI_RECV(TAB_SON_ll,SIZE(TAB_SON_ll),MPI_PRECISION,I_FIRST_SON, &
+ CALL MPI_RECV(TAB_SON_ll,SIZE(TAB_SON_ll),MNHREAL_MPI,I_FIRST_SON, &
NTAG,MPPDB_INTRA_COMM,MPI_STATUS_IGNORE,IINFO_ll)
!
TAB_ll = ABS ( TAB_ll - TAB_SON_ll )
@@ -1317,7 +1321,7 @@ MODULE MODE_MPPDB
CALL MPI_BSEND(IHEXT_SON_ll,1,MPI_INTEGER,I_FIRST_FATHER, &
NTAG, MPPDB_INTRA_COMM, IINFO_ll)
- CALL MPI_BSEND(TAB_ll,SIZE(TAB_ll),MPI_PRECISION,I_FIRST_FATHER, &
+ CALL MPI_BSEND(TAB_ll,SIZE(TAB_ll),MNHREAL_MPI,I_FIRST_FATHER, &
NTAG, MPPDB_INTRA_COMM, IINFO_ll)
END IF
END IF
@@ -1434,9 +1438,9 @@ MODULE MODE_MPPDB
SUBROUTINE MPPDB_CHECK2D_REAL(PTAB,MESSAGE,PPRECISION)
!
- USE MODD_PARAMETERS_ll, ONLY: JPHEXT
USE MODD_MPIF, ONLY: MPI_CHARACTER, MPI_INTEGER, MPI_LOGICAL, MPI_STATUS_IGNORE, MPI_LAND, MPI_SUM, MPI_MAX
- USE MODD_VAR_ll, ONLY: MPI_PRECISION
+ USE MODD_PARAMETERS_ll, ONLY: JPHEXT
+ use modd_precision, only: MNHREAL_MPI
!
USE MODE_DEVICE
USE MODE_GATHER_ll
@@ -1572,7 +1576,7 @@ MODULE MODE_MPPDB
IF (.NOT. ALLOCATED(TAB_SON_ll)) ALLOCATE(TAB_SON_ll(IIU_SON_ll,IJU_SON_ll))
!
- CALL MPI_RECV(TAB_SON_ll,SIZE(TAB_SON_ll),MPI_PRECISION,I_FIRST_SON, &
+ CALL MPI_RECV(TAB_SON_ll,SIZE(TAB_SON_ll),MNHREAL_MPI,I_FIRST_SON, &
NTAG,MPPDB_INTRA_COMM,MPI_STATUS_IGNORE,IINFO_ll)
!
TAB_ll = ABS ( TAB_ll - TAB_SON_ll )
@@ -1669,7 +1673,7 @@ MODULE MODE_MPPDB
NTAG, MPPDB_INTRA_COMM, IINFO_ll)
END IF
- CALL MPI_BSEND(TAB_ll,SIZE(TAB_ll),MPI_PRECISION,I_FIRST_FATHER, &
+ CALL MPI_BSEND(TAB_ll,SIZE(TAB_ll),MNHREAL_MPI,I_FIRST_FATHER, &
NTAG, MPPDB_INTRA_COMM, IINFO_ll)
END IF
END IF
@@ -1749,13 +1753,15 @@ MODULE MODE_MPPDB
SUBROUTINE MPPDB_CHECKLB(PLB,MESSAGE,PPRECISION,HLBTYPE,KRIM)
- USE MODD_PARAMETERS_ll, ONLY : JPHEXT
- USE MODD_VAR_ll , ONLY : MPI_PRECISION , NMNH_COMM_WORLD
- USE MODD_IO_ll, ONLY : ISP,ISNPROC,GSMONOPROC,LPACK,L2D
- USE MODD_MPIF , ONLY : MPI_INTEGER, MPI_STATUS_IGNORE
+ USE MODD_IO, ONLY: GSMONOPROC, ISP, ISNPROC, L2D, LPACK
+ USE MODD_MPIF, ONLY: MPI_INTEGER, MPI_STATUS_IGNORE
+ USE MODD_PARAMETERS_ll, ONLY: JPHEXT
+ USE MODD_VAR_ll, ONLY: NMNH_COMM_WORLD
+ use modd_precision, only: MNHREAL_MPI
USE MODE_DISTRIB_LB
- USE MODE_TOOLS_ll, ONLY : GET_GLOBALDIMS_ll
+ USE MODE_TOOLS_ll, ONLY: GET_GLOBALDIMS_ll
+
IMPLICIT NONE
REAL, DIMENSION(:,:,:) , TARGET :: PLB
@@ -1816,7 +1822,8 @@ MODULE MODE_MPPDB
IF (IIB /= 0) THEN
TX3DP=>Z3D(IIB:IIE,IJB:IJE,:)
IF (ISP /= JI) THEN
- CALL MPI_RECV(TX3DP,SIZE(TX3DP),MPI_PRECISION,JI-1,99,NMNH_COMM_WORLD,MPI_STATUS_IGNORE,IINFO_ll)
+ CALL MPI_RECV(TX3DP,SIZE(TX3DP),MNHREAL_MPI,JI-1 &
+ ,99,NMNH_COMM_WORLD,MPI_STATUS_IGNORE,IINFO_ll)
ELSE
CALL GET_DISTRIB_LB(HLBTYPE,JI,'LOC','WRITE',KRIM,IIB,IIE,IJB,IJE)
TX3DP = PLB(IIB:IIE,IJB:IJE,:)
@@ -1831,7 +1838,7 @@ MODULE MODE_MPPDB
CALL GET_DISTRIB_LB(HLBTYPE,ISP,'LOC','WRITE',KRIM,IIB,IIE,IJB,IJE)
IF (IIB /= 0) THEN
TX3DP=>PLB(IIB:IIE,IJB:IJE,:)
- CALL MPI_BSEND(TX3DP,SIZE(TX3DP),MPI_PRECISION,0,99,NMNH_COMM_WORLD,IINFO_ll)
+ CALL MPI_BSEND(TX3DP,SIZE(TX3DP),MNHREAL_MPI,0,99,NMNH_COMM_WORLD,IINFO_ll)
END IF
END IF
@@ -1862,8 +1869,8 @@ MODULE MODE_MPPDB
!
ALLOCATE(TAB_SON_ll(IIU_SON_ll,IJU_SON_ll,IKU_SON_ll))
!
- CALL MPI_RECV(TAB_SON_ll,SIZE(TAB_SON_ll),MPI_PRECISION,I_FIRST_SON, &
- NTAG, MPPDB_INTRA_COMM,MPI_STATUS_IGNORE, IINFO_ll)
+ CALL MPI_RECV(TAB_SON_ll,SIZE(TAB_SON_ll),MNHREAL_MPI,I_FIRST_SON, &
+ ITAG, MPPDB_INTRA_COMM,MPI_STATUS_IGNORE, IINFO_ll)
!
IDIFF_HEXT = MIN(JPHEXT,IHEXT_SON_ll)
!
@@ -1913,9 +1920,9 @@ MODULE MODE_MPPDB
I_FIRST_FATHER = 0
IHEXT_SON_ll = JPHEXT
CALL MPI_BSEND(IHEXT_SON_ll,1,MPI_INTEGER,I_FIRST_FATHER, &
- NTAG, MPPDB_INTRA_COMM, IINFO_ll)
- CALL MPI_BSEND(PLB,SIZE(PLB),MPI_PRECISION,I_FIRST_FATHER, &
- NTAG, MPPDB_INTRA_COMM, IINFO_ll)
+ ITAG, MPPDB_INTRA_COMM, IINFO_ll)
+ CALL MPI_BSEND(PLB,SIZE(PLB),MNHREAL_MPI,I_FIRST_FATHER, &
+ ITAG, MPPDB_INTRA_COMM, IINFO_ll)
END IF
END IF
@@ -1928,7 +1935,6 @@ MODULE MODE_MPPDB
SUBROUTINE MPPDB_CHECK_SURFEX2D(PTAB,MESSAGE,PPRECISION,KLUOUT,HTYPE,KIU,KJU)
USE MODD_PARAMETERS, ONLY : JPHEXT
- USE MODD_VAR_ll , ONLY : MPI_PRECISION
USE MODI_GET_1D_MASK
USE MODI_UNPACK_SAME_RANK
USE MODI_GET_SURF_MASK_n
@@ -2026,7 +2032,6 @@ MODULE MODE_MPPDB
SUBROUTINE MPPDB_CHECK_SURFEX3D(PTAB,MESSAGE,PPRECISION,KLUOUT,HTYPE,KZSIZE)
USE MODD_PARAMETERS, ONLY : JPHEXT
- USE MODD_VAR_ll , ONLY : MPI_PRECISION
USE MODI_GET_1D_MASK
USE MODI_UNPACK_SAME_RANK
USE MODI_GET_SURF_MASK_n
diff --git a/src/LIB/SURCOUCHE/src/mode_msg.f90 b/src/LIB/SURCOUCHE/src/mode_msg.f90
new file mode 100644
index 0000000000000000000000000000000000000000..287dac1580ce59e12f9c567607e3e2173df1c0e6
--- /dev/null
+++ b/src/LIB/SURCOUCHE/src/mode_msg.f90
@@ -0,0 +1,134 @@
+!MNH_LIC Copyright 2017-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.
+!-----------------------------------------------------------------
+! Author(s)
+! P. Wautelet 24/01/2017
+! Modifications:
+! 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
+!-----------------------------------------------------------------
+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)
+!
+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, &
+ LVERB_OUTLST, LVERB_STDOUT, LVERB_ALLPRC, TFILE_OUTPUTLISTING
+USE MODD_LUNIT, ONLY: TLUOUT0
+USE MODD_VAR_ll, ONLY: IP, NMNH_COMM_WORLD
+!
+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
+!
+CHARACTER(LEN=8) :: YPRC
+CHARACTER(LEN=9) :: YPRE
+CHARACTER(LEN=30) :: YSUBR
+INTEGER :: IERR, IMAXVERB,IABORTLEVEL
+INTEGER :: ILU
+LOGICAL :: GWRITE_OUTLST,GWRITE_STDOUT
+!
+!Determine if the process will write
+GWRITE_OUTLST = .FALSE.
+GWRITE_STDOUT = .FALSE.
+IF (IP == 1 .OR. LVERB_ALLPRC) THEN
+ IF (LVERB_OUTLST) GWRITE_OUTLST = .TRUE.
+ IF (LVERB_STDOUT) GWRITE_STDOUT = .TRUE.
+END IF
+!
+!Check if the output file is available
+ILU = -1
+IF (ASSOCIATED(TFILE_OUTPUTLISTING)) THEN
+ IF (TFILE_OUTPUTLISTING%LOPENED) THEN
+ ILU = TFILE_OUTPUTLISTING%NLU
+ ELSE
+ GWRITE_OUTLST = .FALSE.
+ IF (GWRITE_STDOUT) WRITE(UNIT=OUTPUT_UNIT,FMT=*) 'TFILE_OUTPUTLISTING not opened'
+ END IF
+ELSE
+!PW: TODO?: temporary to detect non-initialisation
+! should disappear except at the beginning of a run
+ GWRITE_OUTLST = .FALSE.
+ IF (GWRITE_STDOUT .AND. CPROGRAM/='LFICDF') WRITE(UNIT=OUTPUT_UNIT,FMT=*) 'TFILE_OUTPUTLISTING not associated'
+END IF
+!
+SELECT CASE(HDOMAIN)
+ CASE('IO')
+ IMAXVERB = NIO_VERB
+ IABORTLEVEL = NIO_ABORT_LEVEL
+ CASE ('GEN')
+ IMAXVERB = NGEN_VERB
+ IABORTLEVEL = NGEN_ABORT_LEVEL
+ CASE DEFAULT
+ IF (GWRITE_STDOUT) WRITE(UNIT=OUTPUT_UNIT,FMT=*) 'ERROR: PRINT_MSG: wrong message category (',TRIM(HDOMAIN),')'
+ IF (GWRITE_OUTLST) WRITE(UNIT=ILU, FMT=*) 'ERROR: PRINT_MSG: wrong message category (',TRIM(HDOMAIN),')'
+ RETURN
+END SELECT
+!
+IF (KVERB>IMAXVERB) RETURN
+!
+SELECT CASE(KVERB)
+ CASE(NVERB_FATAL)
+ YPRE='FATAL: '
+ CASE(NVERB_ERROR)
+ YPRE='ERROR: '
+ CASE(NVERB_WARNING)
+ YPRE='WARNING: '
+ CASE(NVERB_INFO)
+ YPRE='INFO: '
+ CASE(NVERB_DEBUG)
+ YPRE='DEBUG: '
+ 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 (KVERB<=IABORTLEVEL) THEN
+ 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)
+#if 0
+ !Problem: loop dependency between MODE_MSG and MODE_IO_FILE (IO_File_close call PRINT_MSG)
+ NIO_VERB = 0 !To not get further messages (ABORT should be the last for readability)
+ IF (ILU>0) CALL IO_File_close(TFILE_OUTPUTLISTING) !To flush it
+#else
+ IF (ILU>0) FLUSH(UNIT=ILU) !OK in F2003
+ IF (ASSOCIATED(TLUOUT0)) FLUSH(UNIT=TLUOUT0%NLU)
+#endif
+ !Add a sleep to ensure that the process(es) that have to write to stderr and to file
+ !have enough time before an other process calls mpi_abort
+ CALL SLEEP_C(5)
+ !
+ CALL MPI_ABORT(NMNH_COMM_WORLD, -10, IERR)
+ CALL ABORT
+END IF
+!
+END SUBROUTINE PRINT_MSG
+!
+END MODULE MODE_MSG
diff --git a/src/LIB/SURCOUCHE/src/mode_scatter.f90 b/src/LIB/SURCOUCHE/src/mode_scatter.f90
index cc933744a2052426508949c9405c1be67f898089..12518db8bd6a1bd8222d637aee2de2264bf163a3 100644
--- a/src/LIB/SURCOUCHE/src/mode_scatter.f90
+++ b/src/LIB/SURCOUCHE/src/mode_scatter.f90
@@ -1,22 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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$
-!-----------------------------------------------------------------
-!-----------------------------------------------------------------
-
-#ifdef MNH_MPI_DOUBLE_PRECISION
-#define MPI_FLOAT MPI_DOUBLE_PRECISION
-#else
-#define MPI_FLOAT MPI_REAL
-#endif
MODULE MODE_SCATTER_ll
@@ -26,14 +12,13 @@ MODULE MODE_SCATTER_ll
!
USE MODD_MPIF
+use modd_precision, only: MNHREAL_MPI
IMPLICIT NONE
PRIVATE
-!INCLUDE 'mpif.h'
-
INTERFACE SCATTER_XXFIELD
MODULE PROCEDURE SCATTERXX_X1,SCATTERXX_X2,SCATTERXX_X3&
& ,SCATTERXX_X4,SCATTERXX_X5,SCATTERXX_X6,&
@@ -50,10 +35,10 @@ PUBLIC SCATTER_XXFIELD,SCATTER_XYFIELD,GET_DOMREAD_ll
CONTAINS
SUBROUTINE SCATTERXX_X1(HDIR,PSEND,PRECV,KROOT,KCOMM, TPSPLITTING)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
-USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
-USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
-USE MODD_PARAMETERS_ll, ONLY : JPHEXT
+USE MODD_IO, ONLY: ISP, ISNPROC
+USE MODD_PARAMETERS_ll, ONLY: JPHEXT
+USE MODD_STRUCTURE_ll, ONLY: ZONE_ll
+USE MODD_VAR_ll, ONLY: MNH_STATUSES_IGNORE
CHARACTER(LEN=*), INTENT(IN) :: HDIR
REAL,DIMENSION(:), TARGET, INTENT(IN) :: PSEND
@@ -61,14 +46,11 @@ REAL,DIMENSION(:), INTENT(INOUT):: PRECV
INTEGER, INTENT(IN) :: KROOT
INTEGER, INTENT(IN) :: KCOMM
TYPE(ZONE_ll), DIMENSION(ISNPROC), OPTIONAL :: TPSPLITTING ! splitting of the domain
-
-!INCLUDE 'mpif.h'
INTEGER :: IERR
INTEGER :: JI
INTEGER :: IXO,IXE,IYO,IYE
REAL,DIMENSION(:), POINTER :: TX1DP
-!INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
INTEGER,ALLOCATABLE,DIMENSION(:) :: REQ_TAB
INTEGER :: NB_REQ
@@ -100,9 +82,9 @@ IF (ISP == KROOT) THEN
NB_REQ = NB_REQ + 1
ALLOCATE(T_TX1DP(NB_REQ)%X(SIZE(TX1DP)))
T_TX1DP(NB_REQ)%X=TX1DP
- CALL MPI_ISEND(T_TX1DP(NB_REQ)%X,SIZE(TX1DP),MPI_FLOAT,JI-1,199+KROOT,KCOMM&
+ CALL MPI_ISEND(T_TX1DP(NB_REQ)%X,SIZE(TX1DP),MNHREAL_MPI,JI-1,199+KROOT,KCOMM&
& ,REQ_TAB(NB_REQ),IERR)
- !CALL MPI_BSEND(T12DP,SIZE(T12DP),MPI_FLOAT,JI-1,199+KROOT,KCOMM&
+ !CALL MPI_BSEND(T12DP,SIZE(T12DP),MNHREAL_MPI,JI-1,199+KROOT,KCOMM&
! & ,IERR)
ELSE
PRECV(:) = TX1DP(:)
@@ -115,16 +97,16 @@ IF (ISP == KROOT) THEN
DEALLOCATE(T_TX1DP)
DEALLOCATE(REQ_TAB)
ELSE
- CALL MPI_RECV(PRECV,SIZE(PRECV),MPI_FLOAT,KROOT-1,199+KROOT,KCOMM&
+ CALL MPI_RECV(PRECV,SIZE(PRECV),MNHREAL_MPI,KROOT-1,199+KROOT,KCOMM&
& ,MPI_STATUS_IGNORE,IERR)
END IF
END SUBROUTINE SCATTERXX_X1
SUBROUTINE SCATTERXX_X2(HDIR,PSEND,PRECV,KROOT,KCOMM, TPSPLITTING)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
-USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
-USE MODD_PARAMETERS_ll, ONLY : JPHEXT
+USE MODD_IO, ONLY: ISP, ISNPROC
+USE MODD_PARAMETERS_ll, ONLY: JPHEXT
+USE MODD_STRUCTURE_ll, ONLY: ZONE_ll
CHARACTER(LEN=*), INTENT(IN) :: HDIR
REAL,DIMENSION(:,:), TARGET,INTENT(IN) :: PSEND
@@ -133,13 +115,10 @@ INTEGER, INTENT(IN) :: KROOT
INTEGER, INTENT(IN) :: KCOMM
TYPE(ZONE_ll), DIMENSION(ISNPROC), OPTIONAL :: TPSPLITTING ! splitting of the domain
-!INCLUDE 'mpif.h'
-
INTEGER :: IERR
INTEGER :: JI
INTEGER :: IXO,IXE,IYO,IYE
REAL,DIMENSION(:,:), POINTER :: TX2DP
-!INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
IF (ISP == KROOT) THEN
DO JI = 1,ISNPROC
@@ -158,21 +137,21 @@ IF (ISP == KROOT) THEN
END IF
IF (ISP /= JI) THEN
- CALL MPI_BSEND(TX2DP,SIZE(TX2DP),MPI_FLOAT,JI-1,199+KROOT,KCOMM&
+ CALL MPI_BSEND(TX2DP,SIZE(TX2DP),MNHREAL_MPI,JI-1,199+KROOT,KCOMM&
& ,IERR)
ELSE
PRECV(:,:) = TX2DP(:,:)
END IF
END DO
ELSE
- CALL MPI_RECV(PRECV,SIZE(PRECV),MPI_FLOAT,KROOT-1,199+KROOT,KCOMM&
+ CALL MPI_RECV(PRECV,SIZE(PRECV),MNHREAL_MPI,KROOT-1,199+KROOT,KCOMM&
& ,MPI_STATUS_IGNORE,IERR)
END IF
END SUBROUTINE SCATTERXX_X2
SUBROUTINE SCATTERXX_X3(HDIR,PSEND,PRECV,KROOT,KCOMM)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_IO, ONLY: ISP, ISNPROC
CHARACTER(LEN=*), INTENT(IN) :: HDIR
REAL,DIMENSION(:,:,:), TARGET, INTENT(IN) :: PSEND
@@ -180,13 +159,10 @@ REAL,DIMENSION(:,:,:), INTENT(INOUT):: PRECV
INTEGER, INTENT(IN) :: KROOT
INTEGER, INTENT(IN) :: KCOMM
-!INCLUDE 'mpif.h'
-
INTEGER :: IERR
INTEGER :: JI
INTEGER :: IXO,IXE,IYO,IYE
REAL,DIMENSION(:,:,:), POINTER :: TX2DP
-!INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
IF (ISP == KROOT) THEN
DO JI = 1,ISNPROC
@@ -198,21 +174,21 @@ IF (ISP == KROOT) THEN
END IF
IF (ISP /= JI) THEN
- CALL MPI_BSEND(TX2DP,SIZE(TX2DP),MPI_FLOAT,JI-1,199+KROOT,KCOMM&
+ CALL MPI_BSEND(TX2DP,SIZE(TX2DP),MNHREAL_MPI,JI-1,199+KROOT,KCOMM&
& ,IERR)
ELSE
PRECV(:,:,:) = TX2DP(:,:,:)
END IF
END DO
ELSE
- CALL MPI_RECV(PRECV,SIZE(PRECV),MPI_FLOAT,KROOT-1,199+KROOT,KCOMM&
+ CALL MPI_RECV(PRECV,SIZE(PRECV),MNHREAL_MPI,KROOT-1,199+KROOT,KCOMM&
& ,MPI_STATUS_IGNORE,IERR)
END IF
END SUBROUTINE SCATTERXX_X3
SUBROUTINE SCATTERXX_X4(HDIR,PSEND,PRECV,KROOT,KCOMM)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_IO, ONLY: ISP, ISNPROC
CHARACTER(LEN=*), INTENT(IN) :: HDIR
REAL,DIMENSION(:,:,:,:),TARGET,INTENT(IN) :: PSEND
@@ -220,13 +196,10 @@ REAL,DIMENSION(:,:,:,:), INTENT(INOUT):: PRECV
INTEGER, INTENT(IN) :: KROOT
INTEGER, INTENT(IN) :: KCOMM
-!INCLUDE 'mpif.h'
-
INTEGER :: IERR
INTEGER :: JI
INTEGER :: IXO,IXE,IYO,IYE
REAL,DIMENSION(:,:,:,:), POINTER :: TX2DP
-!INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
IF (ISP == KROOT) THEN
DO JI = 1,ISNPROC
@@ -238,21 +211,21 @@ IF (ISP == KROOT) THEN
END IF
IF (ISP /= JI) THEN
- CALL MPI_BSEND(TX2DP,SIZE(TX2DP),MPI_FLOAT,JI-1,199+KROOT,KCOMM&
+ CALL MPI_BSEND(TX2DP,SIZE(TX2DP),MNHREAL_MPI,JI-1,199+KROOT,KCOMM&
& ,IERR)
ELSE
PRECV(:,:,:,:) = TX2DP(:,:,:,:)
END IF
END DO
ELSE
- CALL MPI_RECV(PRECV,SIZE(PRECV),MPI_FLOAT,KROOT-1,199+KROOT,KCOMM&
+ CALL MPI_RECV(PRECV,SIZE(PRECV),MNHREAL_MPI,KROOT-1,199+KROOT,KCOMM&
& ,MPI_STATUS_IGNORE,IERR)
END IF
END SUBROUTINE SCATTERXX_X4
SUBROUTINE SCATTERXX_X5(HDIR,PSEND,PRECV,KROOT,KCOMM)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_IO, ONLY: ISP, ISNPROC
CHARACTER(LEN=*), INTENT(IN) :: HDIR
REAL,DIMENSION(:,:,:,:,:),TARGET,INTENT(IN) :: PSEND
@@ -260,14 +233,11 @@ REAL,DIMENSION(:,:,:,:,:), INTENT(INOUT):: PRECV
INTEGER, INTENT(IN) :: KROOT
INTEGER, INTENT(IN) :: KCOMM
-!INCLUDE 'mpif.h'
-
INTEGER :: IERR
INTEGER :: JI
INTEGER :: IXO,IXE,IYO,IYE
REAL,DIMENSION(:,:,:,:,:), POINTER :: TX2DP
-!INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
-
+
IF (ISP == KROOT) THEN
DO JI = 1,ISNPROC
CALL GET_DOMREAD_ll(JI,IXO,IXE,IYO,IYE)
@@ -278,21 +248,21 @@ IF (ISP == KROOT) THEN
END IF
IF (ISP /= JI) THEN
- CALL MPI_BSEND(TX2DP,SIZE(TX2DP),MPI_FLOAT,JI-1,199+KROOT,KCOMM&
+ CALL MPI_BSEND(TX2DP,SIZE(TX2DP),MNHREAL_MPI,JI-1,199+KROOT,KCOMM&
& ,IERR)
ELSE
PRECV(:,:,:,:,:) = TX2DP(:,:,:,:,:)
END IF
END DO
ELSE
- CALL MPI_RECV(PRECV,SIZE(PRECV),MPI_FLOAT,KROOT-1,199+KROOT,KCOMM&
+ CALL MPI_RECV(PRECV,SIZE(PRECV),MNHREAL_MPI,KROOT-1,199+KROOT,KCOMM&
& ,MPI_STATUS_IGNORE,IERR)
END IF
END SUBROUTINE SCATTERXX_X5
SUBROUTINE SCATTERXX_X6(HDIR,PSEND,PRECV,KROOT,KCOMM)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_IO, ONLY: ISP, ISNPROC
CHARACTER(LEN=*), INTENT(IN) :: HDIR
REAL,DIMENSION(:,:,:,:,:,:),TARGET,INTENT(IN) :: PSEND
@@ -300,13 +270,10 @@ REAL,DIMENSION(:,:,:,:,:,:), INTENT(INOUT):: PRECV
INTEGER, INTENT(IN) :: KROOT
INTEGER, INTENT(IN) :: KCOMM
-!INCLUDE 'mpif.h'
-
INTEGER :: IERR
INTEGER :: JI
INTEGER :: IXO,IXE,IYO,IYE
REAL,DIMENSION(:,:,:,:,:,:), POINTER :: TX2DP
-!INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
IF (ISP == KROOT) THEN
DO JI = 1,ISNPROC
@@ -318,21 +285,21 @@ IF (ISP == KROOT) THEN
END IF
IF (ISP /= JI) THEN
- CALL MPI_BSEND(TX2DP,SIZE(TX2DP),MPI_FLOAT,JI-1,199+KROOT,KCOMM&
+ CALL MPI_BSEND(TX2DP,SIZE(TX2DP),MNHREAL_MPI,JI-1,199+KROOT,KCOMM&
& ,IERR)
ELSE
PRECV(:,:,:,:,:,:) = TX2DP(:,:,:,:,:,:)
END IF
END DO
ELSE
- CALL MPI_RECV(PRECV,SIZE(PRECV),MPI_FLOAT,KROOT-1,199+KROOT,KCOMM&
+ CALL MPI_RECV(PRECV,SIZE(PRECV),MNHREAL_MPI,KROOT-1,199+KROOT,KCOMM&
& ,MPI_STATUS_IGNORE,IERR)
END IF
END SUBROUTINE SCATTERXX_X6
SUBROUTINE SCATTERXX_N1(HDIR,KSEND,KRECV,KROOT,KCOMM)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_IO, ONLY: ISP, ISNPROC
CHARACTER(LEN=*), INTENT(IN) :: HDIR
INTEGER,DIMENSION(:),TARGET,INTENT(IN) :: KSEND
@@ -340,13 +307,10 @@ INTEGER,DIMENSION(:), INTENT(INOUT):: KRECV
INTEGER, INTENT(IN) :: KROOT
INTEGER, INTENT(IN) :: KCOMM
-!INCLUDE 'mpif.h'
-
INTEGER :: IERR
INTEGER :: JI
INTEGER :: IXO,IXE,IYO,IYE
INTEGER, DIMENSION(:), POINTER :: TI2DP
-!INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
IF (ISP == KROOT) THEN
DO JI = 1,ISNPROC
@@ -372,7 +336,7 @@ END IF
END SUBROUTINE SCATTERXX_N1
SUBROUTINE SCATTERXX_N2(HDIR,KSEND,KRECV,KROOT,KCOMM)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_IO, ONLY: ISP, ISNPROC
CHARACTER(LEN=*), INTENT(IN) :: HDIR
INTEGER, DIMENSION(:,:),TARGET,INTENT(IN) :: KSEND
@@ -380,13 +344,10 @@ INTEGER, DIMENSION(:,:), INTENT(INOUT):: KRECV
INTEGER, INTENT(IN) :: KROOT
INTEGER, INTENT(IN) :: KCOMM
-!INCLUDE 'mpif.h'
-
INTEGER :: IERR
INTEGER :: JI
INTEGER :: IXO,IXE,IYO,IYE
INTEGER, DIMENSION(:,:), POINTER :: TI2DP
-!INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
IF (ISP == KROOT) THEN
DO JI = 1,ISNPROC
@@ -412,21 +373,18 @@ END IF
END SUBROUTINE SCATTERXX_N2
SUBROUTINE SCATTERXY_X2(PSEND,PRECV,KROOT,KCOMM)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
-USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
+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
INTEGER, INTENT(IN) :: KROOT
INTEGER, INTENT(IN) :: KCOMM
-!INCLUDE 'mpif.h'
-
INTEGER :: IERR
INTEGER :: JI
INTEGER :: IXO,IXE,IYO,IYE
REAL,DIMENSION(:,:), POINTER :: TX2DP
-!INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
INTEGER,ALLOCATABLE,DIMENSION(:) :: REQ_TAB
INTEGER :: NB_REQ
@@ -446,9 +404,9 @@ IF (ISP == KROOT) 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),MPI_FLOAT,JI-1,199+KROOT,KCOMM&
+ CALL MPI_ISEND(T_TX2DP(NB_REQ)%X,SIZE(TX2DP),MNHREAL_MPI,JI-1,199+KROOT,KCOMM&
& ,REQ_TAB(NB_REQ),IERR)
- !CALL MPI_BSEND(TX2DP,SIZE(TX2DP),MPI_FLOAT,JI-1,199+KROOT,KCOMM&
+ !CALL MPI_BSEND(TX2DP,SIZE(TX2DP),MNHREAL_MPI,JI-1,199+KROOT,KCOMM&
! & ,IERR)
ELSE
PRECV(:,:) = TX2DP(:,:)
@@ -461,27 +419,24 @@ IF (ISP == KROOT) THEN
DEALLOCATE(T_TX2DP)
DEALLOCATE(REQ_TAB)
ELSE
- CALL MPI_RECV(PRECV,SIZE(PRECV),MPI_FLOAT,KROOT-1,199+KROOT,KCOMM&
+ CALL MPI_RECV(PRECV,SIZE(PRECV),MNHREAL_MPI,KROOT-1,199+KROOT,KCOMM&
& ,MPI_STATUS_IGNORE,IERR)
END IF
END SUBROUTINE SCATTERXY_X2
SUBROUTINE SCATTERXY_X3(PSEND,PRECV,KROOT,KCOMM)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_IO, ONLY: ISP, ISNPROC
REAL,DIMENSION(:,:,:),TARGET,INTENT(IN) :: PSEND
REAL,DIMENSION(:,:,:), INTENT(INOUT):: PRECV
INTEGER, INTENT(IN) :: KROOT
INTEGER, INTENT(IN) :: KCOMM
-!INCLUDE 'mpif.h'
-
INTEGER :: IERR
INTEGER :: JI
INTEGER :: IXO,IXE,IYO,IYE
REAL,DIMENSION(:,:,:), POINTER :: TX3DP
-!INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
IF (ISP == KROOT) THEN
DO JI = 1,ISNPROC
@@ -489,34 +444,31 @@ IF (ISP == KROOT) THEN
TX3DP=>PSEND(IXO:IXE,IYO:IYE,:)
IF (ISP /= JI) THEN
- CALL MPI_BSEND(TX3DP,SIZE(TX3DP),MPI_FLOAT,JI-1,199+KROOT,KCOMM&
+ CALL MPI_BSEND(TX3DP,SIZE(TX3DP),MNHREAL_MPI,JI-1,199+KROOT,KCOMM&
& ,IERR)
ELSE
PRECV(:,:,:) = TX3DP(:,:,:)
END IF
END DO
ELSE
- CALL MPI_RECV(PRECV,SIZE(PRECV),MPI_FLOAT,KROOT-1,199+KROOT,KCOMM&
+ CALL MPI_RECV(PRECV,SIZE(PRECV),MNHREAL_MPI,KROOT-1,199+KROOT,KCOMM&
& ,MPI_STATUS_IGNORE,IERR)
END IF
END SUBROUTINE SCATTERXY_X3
SUBROUTINE SCATTERXY_X4(PSEND,PRECV,KROOT,KCOMM)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_IO, ONLY: ISP, ISNPROC
REAL,DIMENSION(:,:,:,:),TARGET,INTENT(IN) :: PSEND
REAL,DIMENSION(:,:,:,:), INTENT(INOUT):: PRECV
INTEGER, INTENT(IN) :: KROOT
INTEGER, INTENT(IN) :: KCOMM
-!INCLUDE 'mpif.h'
-
INTEGER :: IERR
INTEGER :: JI
INTEGER :: IXO,IXE,IYO,IYE
REAL,DIMENSION(:,:,:,:), POINTER :: TX3DP
-!INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
IF (ISP == KROOT) THEN
DO JI = 1,ISNPROC
@@ -524,104 +476,95 @@ IF (ISP == KROOT) THEN
TX3DP=>PSEND(IXO:IXE,IYO:IYE,:,:)
IF (ISP /= JI) THEN
- CALL MPI_BSEND(TX3DP,SIZE(TX3DP),MPI_FLOAT,JI-1,199+KROOT,KCOMM&
+ CALL MPI_BSEND(TX3DP,SIZE(TX3DP),MNHREAL_MPI,JI-1,199+KROOT,KCOMM&
& ,IERR)
ELSE
PRECV(:,:,:,:) = TX3DP(:,:,:,:)
END IF
END DO
ELSE
- CALL MPI_RECV(PRECV,SIZE(PRECV),MPI_FLOAT,KROOT-1,199+KROOT,KCOMM&
+ CALL MPI_RECV(PRECV,SIZE(PRECV),MNHREAL_MPI,KROOT-1,199+KROOT,KCOMM&
& ,MPI_STATUS_IGNORE,IERR)
END IF
END SUBROUTINE SCATTERXY_X4
SUBROUTINE SCATTERXY_X5(PSEND,PRECV,KROOT,KCOMM)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_IO, ONLY: ISP, ISNPROC
REAL,DIMENSION(:,:,:,:,:),TARGET,INTENT(IN) :: PSEND
REAL,DIMENSION(:,:,:,:,:), INTENT(INOUT):: PRECV
INTEGER, INTENT(IN) :: KROOT
INTEGER, INTENT(IN) :: KCOMM
-!INCLUDE 'mpif.h'
-
INTEGER :: IERR
INTEGER :: JI
INTEGER :: IXO,IXE,IYO,IYE
REAL,DIMENSION(:,:,:,:,:), POINTER :: TX3DP
-!INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
-
+
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),MPI_FLOAT,JI-1,199+KROOT,KCOMM&
+ CALL MPI_BSEND(TX3DP,SIZE(TX3DP),MNHREAL_MPI,JI-1,199+KROOT,KCOMM&
& ,IERR)
ELSE
PRECV(:,:,:,:,:) = TX3DP(:,:,:,:,:)
END IF
END DO
ELSE
- CALL MPI_RECV(PRECV,SIZE(PRECV),MPI_FLOAT,KROOT-1,199+KROOT,KCOMM&
+ CALL MPI_RECV(PRECV,SIZE(PRECV),MNHREAL_MPI,KROOT-1,199+KROOT,KCOMM&
& ,MPI_STATUS_IGNORE,IERR)
END IF
END SUBROUTINE SCATTERXY_X5
SUBROUTINE SCATTERXY_X6(PSEND,PRECV,KROOT,KCOMM)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_IO, ONLY: ISP, ISNPROC
REAL,DIMENSION(:,:,:,:,:,:),TARGET,INTENT(IN) :: PSEND
REAL,DIMENSION(:,:,:,:,:,:), INTENT(INOUT):: PRECV
INTEGER, INTENT(IN) :: KROOT
INTEGER, INTENT(IN) :: KCOMM
-!INCLUDE 'mpif.h'
-
INTEGER :: IERR
INTEGER :: JI
INTEGER :: IXO,IXE,IYO,IYE
REAL,DIMENSION(:,:,:,:,:,:), POINTER :: TX3DP
-!INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
-
+
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),MPI_FLOAT,JI-1,199+KROOT,KCOMM&
+ CALL MPI_BSEND(TX3DP,SIZE(TX3DP),MNHREAL_MPI,JI-1,199+KROOT,KCOMM&
& ,IERR)
ELSE
PRECV(:,:,:,:,:,:) = TX3DP(:,:,:,:,:,:)
END IF
END DO
ELSE
- CALL MPI_RECV(PRECV,SIZE(PRECV),MPI_FLOAT,KROOT-1,199+KROOT,KCOMM&
+ CALL MPI_RECV(PRECV,SIZE(PRECV),MNHREAL_MPI,KROOT-1,199+KROOT,KCOMM&
& ,MPI_STATUS_IGNORE,IERR)
END IF
END SUBROUTINE SCATTERXY_X6
SUBROUTINE SCATTERXY_N2(KSEND,KRECV,KROOT,KCOMM)
-USE MODD_IO_ll, ONLY : ISP, ISNPROC
+USE MODD_IO, ONLY: ISP, ISNPROC
INTEGER,DIMENSION(:,:),TARGET,INTENT(IN) :: KSEND
INTEGER,DIMENSION(:,:), INTENT(INOUT):: KRECV
INTEGER, INTENT(IN) :: KROOT
INTEGER, INTENT(IN) :: KCOMM
-!INCLUDE 'mpif.h'
-
INTEGER :: IERR
INTEGER :: JI
INTEGER :: IXO,IXE,IYO,IYE
INTEGER ,DIMENSION(:,:), POINTER :: TI3DP
-!INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
IF (ISP == KROOT) THEN
DO JI = 1,ISNPROC
@@ -643,8 +586,8 @@ END IF
END SUBROUTINE SCATTERXY_N2
SUBROUTINE GET_DOMREAD_ll(KIP,KXOR,KXEND,KYOR,KYEND)
-USE MODD_VAR_ll, ONLY : TCRRT_PROCONF
-USE MODD_STRUCTURE_ll, ONLY : MODELSPLITTING_ll
+USE MODD_STRUCTURE_ll, ONLY: MODELSPLITTING_ll
+USE MODD_VAR_ll, ONLY: TCRRT_PROCONF
IMPLICIT NONE
diff --git a/src/LIB/SURCOUCHE/src/mode_splittingz_ll.f90 b/src/LIB/SURCOUCHE/src/mode_splittingz_ll.f90
index 754a30d12718d56d72cc93295de435f037f41046..fc5c40069db48cc06299afa288b986b0cf1d54db 100644
--- a/src/LIB/SURCOUCHE/src/mode_splittingz_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_splittingz_ll.f90
@@ -1,17 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2011-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.
!-----------------------------------------------------------------
-
-#ifdef MNH_MPI_DOUBLE_PRECISION
-#define MNH_MPI_REAL MPI_DOUBLE_PRECISION
-#define MNH_MPI_2REAL MPI_2DOUBLE_PRECISION
-#else
-#define MNH_MPI_REAL MPI_REAL
-#define MNH_MPI_2REAL MPI_2REAL
-#endif
-
! ########################
MODULE MODE_SPLITTINGZ_ll
! ########################
@@ -180,22 +171,11 @@ CONTAINS
!
CALL MPI_COMM_DUP(NMNH_COMM_WORLD, NGRID_COM, KINFO_ll)
!
- MPI_PRECISION = MNH_MPI_REAL
- MPI_2PRECISION = MNH_MPI_2REAL
- !
! For bug with intelmpi+ilp64+i8 declare MNH_STATUSES_IGNORE
!
#ifndef MNH_USE_MPI_STATUSES_IGNORE
ALLOCATE(MNH_STATUSES_IGNORE(MPI_STATUS_SIZE,NPROC*2))
#endif
- !
- !-------------------------------------------------------------------------------
- !
- !* 2. SET OUTPUT FILE :
- ! ---------------
-
- ! CALL OPEN_ll(UNIT=NIOUNIT,FILE=YOUTPUTFILE,ACTION='write',form&
- ! &='FORMATTED',MODE=SPECIFIC,IOSTAT=IRESP)
!
!-------------------------------------------------------------------------------
!
@@ -591,14 +571,6 @@ CONTAINS
!
!-------------------------------------------------------------------------------
!
- !* 2. SET OUTPUT FILE :
- ! ---------------
-
- ! CALL OPEN_ll(UNIT=NIOUNIT,FILE=YOUTPUTFILE,ACTION='write',form&
- ! &='FORMATTED',MODE=SPECIFIC,IOSTAT=IRESP)
- !
- !-------------------------------------------------------------------------------
- !
!* 3. ALLOCATION :
! ----------
!
@@ -1829,12 +1801,10 @@ END FUNCTION LSOUTHZ_ll
SUBROUTINE ALL_SEND_RECV(TSEND_BOX_FROM,TRECV_BOX_TO, &
PFIELDIN, PFIELDOUT, KINFO)
!
- USE MODD_STRUCTURE_ll , ONLY : BOX_ll
- USE MODD_VAR_ll , ONLY : MPI_PRECISION
- !JUANZ
- !USE MODD_MPIF , ONLY : MPI_COMM_WORLD
- USE MODD_VAR_ll , ONLY : NMNH_COMM_WORLD
- !JUANZ
+ use modd_precision, only: MNHREAL_MPI
+ USE MODD_STRUCTURE_ll, ONLY: BOX_ll
+ USE MODD_VAR_ll, ONLY: NMNH_COMM_WORLD
+ !
IMPLICIT NONE
!
! Argument
@@ -1867,8 +1837,8 @@ END FUNCTION LSOUTHZ_ll
END IF
END DO
!
- CALL mpi_alltoallv(ZSEND,TSEND_BOX_FROM%NCNT,TSEND_BOX_FROM%NSTRT,MPI_PRECISION,&
- ZRECV,TRECV_BOX_TO%NCNT ,TRECV_BOX_TO%NSTRT ,MPI_PRECISION,&
+ CALL mpi_alltoallv(ZSEND,TSEND_BOX_FROM%NCNT,TSEND_BOX_FROM%NSTRT,MNHREAL_MPI,&
+ ZRECV,TRECV_BOX_TO%NCNT ,TRECV_BOX_TO%NSTRT ,MNHREAL_MPI,&
TSEND_BOX_FROM%NCOM,KINFO)
!
JCNT = 0
diff --git a/src/LIB/SURCOUCHE/src/mode_sum2_ll.f90 b/src/LIB/SURCOUCHE/src/mode_sum2_ll.f90
index 1580724bde78a06009543ca6cfc72bdcc3b7e87a..23638d194e3273217719c90a1de448a05a7ec9e0 100644
--- a/src/LIB/SURCOUCHE/src/mode_sum2_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_sum2_ll.f90
@@ -1,16 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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_SUM2_ll
@@ -576,7 +568,6 @@ ENDIF
!
! Module MODD_VAR_ll
! IP -
-! MPI_2PRECISION
!
!! Author
!! ------
@@ -590,7 +581,8 @@ ENDIF
!
!* 0. DECLARATIONS
!
- USE MODD_VAR_ll, ONLY : IP, MPI_2PRECISION
+ use modd_precision, only: MNH2REAL_MPI
+ USE MODD_VAR_ll, ONLY: IP
!
IMPLICIT NONE
!
@@ -623,7 +615,7 @@ ENDIF
!
ZBUFIN (1) = PVALUE
ZBUFIN (2) = IP
- CALL MPI_ALLREDUCE(ZBUFIN, ZBUFOUT, 1, MPI_2PRECISION, MPI_MAXLOC, &
+ CALL MPI_ALLREDUCE(ZBUFIN, ZBUFOUT, 1, MNH2REAL_MPI, MPI_MAXLOC, &
NMNH_COMM_WORLD, IERR)
!
!
@@ -675,7 +667,6 @@ ENDIF
! Module MODD_VAR_ll
! TCRRT_PROCONF - Current configuration for current model
! IP -
-! MPI_2PRECISION
!
!! Author
!! ------
@@ -689,9 +680,9 @@ ENDIF
!
!* 0. DECLARATIONS
!
- USE MODD_VAR_ll, ONLY : IP, MPI_2PRECISION, TCRRT_PROCONF
-!
- USE MODD_STRUCTURE_ll, ONLY : MODELSPLITTING_ll
+ use modd_precision, only: MNH2REAL_MPI
+ USE MODD_STRUCTURE_ll, ONLY: MODELSPLITTING_ll
+ USE MODD_VAR_ll, ONLY: IP, TCRRT_PROCONF
!
IMPLICIT NONE
!
@@ -731,7 +722,7 @@ ENDIF
ZBUFIN (1) = PVALUE
ZBUFIN (2) = IP
!
- CALL MPI_ALLREDUCE(ZBUFIN, ZBUFOUT, 1, MPI_2PRECISION, MPI_MAXLOC, &
+ CALL MPI_ALLREDUCE(ZBUFIN, ZBUFOUT, 1, MNH2REAL_MPI, MPI_MAXLOC, &
NMNH_COMM_WORLD, INFO_ll)
!
!-------------------------------------------------------------------------------
diff --git a/src/LIB/SURCOUCHE/src/mode_sum_ll.f90 b/src/LIB/SURCOUCHE/src/mode_sum_ll.f90
index 983588cbb17c2280bacea7f275e12e8f35881b1e..ab948ab80cc8311b44593bde0ce70afcce6fedf4 100644
--- a/src/LIB/SURCOUCHE/src/mode_sum_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_sum_ll.f90
@@ -1,15 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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$
-!-----------------------------------------------------------------
!Correction :
! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!-----------------------------------------------------------------
@@ -57,7 +50,6 @@
! NPROC -
! IP -
! JPHALO -
-! MPI_PRECISION -
!
! Module MODD_STRUCTURE_ll
! type MODELSPLITTING_ll
@@ -65,11 +57,8 @@
!------------------------------------------------------------------------------
!
USE MODD_MPIF
- !JUANZ
- USE MODD_VAR_ll, ONLY : NMNH_COMM_WORLD
- !JUANZ
-!
-! INCLUDE 'mpif.h'
+ use modd_precision, only: MNHREAL_MPI
+ USE MODD_VAR_ll, ONLY: NMNH_COMM_WORLD
!
CONTAINS
!
@@ -110,7 +99,6 @@
! Module MODD_VAR_ll
! TCRRT_COMDATA - Current communication data structure for current model
! and local processor
-! MPI_PRECISION -
!
!! Reference
!! ---------
@@ -127,9 +115,9 @@
!
!* 0. DECLARATIONS
!
- USE MODD_PARAMETERS_ll, ONLY : JPHEXT, JPVEXT
- USE MODD_VAR_ll, ONLY : TCRRT_COMDATA, MPI_PRECISION
- USE MODE_TOOLS_ll, ONLY : LNORTH_ll, LSOUTH_ll, LEAST_ll, LWEST_ll
+ USE MODD_PARAMETERS_ll, ONLY: JPHEXT, JPVEXT
+ USE MODD_VAR_ll, ONLY: TCRRT_COMDATA
+ USE MODE_TOOLS_ll, ONLY: LNORTH_ll, LSOUTH_ll, LEAST_ll, LWEST_ll
!
IMPLICIT NONE
!
@@ -299,7 +287,7 @@
!
!* 3.4 Summation with all the processors
!
- CALL MPI_ALLREDUCE(ZBUF, ZBUFD, IDIM, MPI_PRECISION, &
+ CALL MPI_ALLREDUCE(ZBUF, ZBUFD, IDIM, MNHREAL_MPI, &
MPI_SUM, NMNH_COMM_WORLD, KINFO)
!
!* 3.5 Return the result
@@ -357,7 +345,6 @@
! Module MODD_VAR_ll
! TCRRT_COMDATA - Current communication data structure for current model
! and local processor
-! MPI_PRECISION -
!
!! Implicit Arguments
!! ------------------
@@ -377,10 +364,10 @@
!
!* 0. DECLARATIONS
!
- USE MODD_PARAMETERS_ll, ONLY : JPHEXT, JPVEXT
- USE MODD_VAR_ll, ONLY : TCRRT_COMDATA, MPI_PRECISION
+ USE MODD_PARAMETERS_ll, ONLY: JPHEXT, JPVEXT
+ USE MODD_VAR_ll, ONLY: TCRRT_COMDATA
!
- USE MODE_TOOLS_ll, ONLY : LNORTH_ll, LSOUTH_ll, LEAST_ll, LWEST_ll
+ USE MODE_TOOLS_ll, ONLY: LNORTH_ll, LSOUTH_ll, LEAST_ll, LWEST_ll
!
IMPLICIT NONE
!
@@ -601,7 +588,7 @@
!
!* 3.4 Summation with all the processors
!
- CALL MPI_ALLREDUCE(ZBUF, ZBUFD, IDIM, MPI_PRECISION, &
+ CALL MPI_ALLREDUCE(ZBUF, ZBUFD, IDIM, MNHREAL_MPI, &
MPI_SUM, NMNH_COMM_WORLD, KINFO)
!
!* 3.5 Return the result
@@ -659,7 +646,6 @@
! Module MODD_VAR_ll
! TCRRT_COMDATA - Current communication data structure for current model
! and local processor
-! MPI_PRECISION -
!
!! Implicit Arguments
!! ------------------
@@ -680,10 +666,10 @@
!
!* 0. DECLARATIONS
!
- USE MODD_PARAMETERS_ll, ONLY : JPHEXT, JPVEXT
- USE MODD_VAR_ll, ONLY : TCRRT_COMDATA, MPI_PRECISION
+ USE MODD_PARAMETERS_ll, ONLY: JPHEXT, JPVEXT
+ USE MODD_VAR_ll, ONLY: TCRRT_COMDATA
!
- USE MODE_TOOLS_ll, ONLY : LNORTH_ll, LSOUTH_ll, LEAST_ll, LWEST_ll
+ USE MODE_TOOLS_ll, ONLY: LNORTH_ll, LSOUTH_ll, LEAST_ll, LWEST_ll
!
IMPLICIT NONE
!
@@ -903,7 +889,7 @@
!
!* 3.4 Summation with all the processors
!
- CALL MPI_ALLREDUCE(ZBUF, ZBUFD, IDIM, MPI_PRECISION, &
+ CALL MPI_ALLREDUCE(ZBUF, ZBUFD, IDIM, MNHREAL_MPI, &
MPI_SUM, NMNH_COMM_WORLD, KINFO)
!
!* 3.5 Return the result
@@ -961,7 +947,6 @@
! Module MODD_VAR_ll
! TCRRT_COMDATA - Current communication data structure for current model
! and local processor
-! MPI_PRECISION -
!
!! Implicit Arguments
!! ------------------
@@ -982,10 +967,10 @@
!
!* 0. DECLARATIONS
!
- USE MODD_PARAMETERS_ll, ONLY : JPHEXT, JPVEXT
- USE MODD_VAR_ll, ONLY : TCRRT_COMDATA, MPI_PRECISION
+ USE MODD_PARAMETERS_ll, ONLY: JPHEXT, JPVEXT
+ USE MODD_VAR_ll, ONLY: TCRRT_COMDATA
!
- USE MODE_TOOLS_ll, ONLY : LNORTH_ll, LSOUTH_ll, LEAST_ll, LWEST_ll
+ USE MODE_TOOLS_ll, ONLY: LNORTH_ll, LSOUTH_ll, LEAST_ll, LWEST_ll
!
USE MODE_TOOLS_ll
!
@@ -1136,7 +1121,7 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
!
!* 3.4 Summation with all the processors
!
-!!$ CALL MPI_ALLREDUCE(ZSUM3D, SUM3D_ll, 1, MPI_PRECISION, &
+!!$ CALL MPI_ALLREDUCE(ZSUM3D, SUM3D_ll, 1, MNHREAL_MPI, &
!!$ MPI_SUM, NMNH_COMM_WORLD, KINFO)
!!$!
!!$! gathers the total 2D field
@@ -1197,7 +1182,6 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
! and local processor
! TCRRT_PROCONF - Current configuration for current model
! NPROC -
-! MPI_PRECISION -
!
!! Reference
!! ---------
@@ -1218,11 +1202,11 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
!
!* 0. DECLARATIONS
!
- USE MODD_PARAMETERS_ll, ONLY : JPHEXT
- USE MODD_STRUCTURE_ll, ONLY : MODELSPLITTING_ll
- USE MODD_VAR_ll, ONLY : IP, TCRRT_COMDATA, TCRRT_PROCONF, NPROC, MPI_PRECISION
+ USE MODD_PARAMETERS_ll, ONLY: JPHEXT
+ USE MODD_STRUCTURE_ll, ONLY: MODELSPLITTING_ll
+ USE MODD_VAR_ll, ONLY: IP, TCRRT_COMDATA, TCRRT_PROCONF, NPROC
!
- USE MODE_TOOLS_ll, ONLY : LNORTH_ll, LSOUTH_ll, LEAST_ll, LWEST_ll
+ USE MODE_TOOLS_ll, ONLY: LNORTH_ll, LSOUTH_ll, LEAST_ll, LWEST_ll
!
IMPLICIT NONE
!
@@ -1342,8 +1326,8 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
!
ALLOCATE(ZGLOBFIELD(IGE-IGB+1))
CALL MPI_ALLGATHERV(PFIELD(IB-IORE(IDIR)+1:), ISIZE, &
- MPI_PRECISION, ZGLOBFIELD, ISIZES, IDISPL, &
- MPI_PRECISION, NMNH_COMM_WORLD, IERR)
+ MNHREAL_MPI, ZGLOBFIELD, ISIZES, IDISPL, &
+ MNHREAL_MPI, NMNH_COMM_WORLD, IERR)
!
!-------------------------------------------------------------------------------
!
@@ -1408,7 +1392,6 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
! and local processor
! TCRRT_PROCONF - Current configuration for current model
! NPROC -
-! MPI_PRECISION -
!
!! Reference
!! ---------
@@ -1427,10 +1410,10 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
!
!* 0. DECLARATIONS
!
- USE MODD_PARAMETERS_ll, ONLY : JPHEXT, JPVEXT
- USE MODD_VAR_ll, ONLY : TCRRT_COMDATA, MPI_PRECISION
+ USE MODD_PARAMETERS_ll, ONLY: JPHEXT, JPVEXT
+ USE MODD_VAR_ll, ONLY: TCRRT_COMDATA
!
- USE MODE_TOOLS_ll, ONLY : LNORTH_ll, LSOUTH_ll, LEAST_ll, LWEST_ll
+ USE MODE_TOOLS_ll, ONLY: LNORTH_ll, LSOUTH_ll, LEAST_ll, LWEST_ll
!
IMPLICIT NONE
!
@@ -1569,7 +1552,7 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
!
!* 3.4 Reduction with all the processors
!
- CALL MPI_ALLREDUCE(ZMAX, MAX_ll, 1, MPI_PRECISION, &
+ CALL MPI_ALLREDUCE(ZMAX, MAX_ll, 1, MNHREAL_MPI, &
MPI_MAX, NMNH_COMM_WORLD, KINFO)
!
ENDIF
@@ -1621,7 +1604,6 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
! and local processor
! TCRRT_PROCONF - Current configuration for current model
! NPROC -
-! MPI_PRECISION -
!
!! Reference
!! ---------
@@ -1640,10 +1622,10 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
!
!* 0. DECLARATIONS
!
- USE MODD_PARAMETERS_ll, ONLY : JPHEXT, JPVEXT
- USE MODD_VAR_ll, ONLY : TCRRT_COMDATA, MPI_PRECISION
+ USE MODD_PARAMETERS_ll, ONLY: JPHEXT, JPVEXT
+ USE MODD_VAR_ll, ONLY: TCRRT_COMDATA
!
- USE MODE_TOOLS_ll, ONLY : LNORTH_ll, LSOUTH_ll, LEAST_ll, LWEST_ll
+ USE MODE_TOOLS_ll, ONLY: LNORTH_ll, LSOUTH_ll, LEAST_ll, LWEST_ll
!
IMPLICIT NONE
!
@@ -1782,7 +1764,7 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
!
! 3.4 Reduction with all the processors
!
- CALL MPI_ALLREDUCE(ZMIN, MIN_ll, 1, MPI_PRECISION, &
+ CALL MPI_ALLREDUCE(ZMIN, MIN_ll, 1, MNHREAL_MPI, &
MPI_MIN, NMNH_COMM_WORLD, KINFO)
!
ENDIF
@@ -1818,7 +1800,6 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
! Module MODD_VAR_ll
! TCRRT_COMDATA - Current communication data structure for current model
! and local processor
-! MPI_PRECISION -
!
!! Reference
!! ---------
@@ -1835,7 +1816,7 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
!
!* 0. DECLARATIONS
!
- USE MODD_VAR_ll, ONLY : TCRRT_COMDATA, MPI_PRECISION
+ USE MODD_VAR_ll, ONLY : TCRRT_COMDATA
!
!
IMPLICIT NONE
@@ -1871,7 +1852,7 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
! ---------------------------------
!
CALL MPI_ALLREDUCE(ZBUF, ZBUFD, SIZE(PFIELD,3), &
- MPI_PRECISION, MPI_SUM, NMNH_COMM_WORLD, KINFO)
+ MNHREAL_MPI, MPI_SUM, NMNH_COMM_WORLD, KINFO)
!
!-------------------------------------------------------------------------------
!
@@ -1908,8 +1889,6 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
!! Implicit Arguments
!! ------------------
!
-! Module MODD_VAR_ll
-! MPI_PRECISION -
!
!! Reference
!! ---------
@@ -1925,8 +1904,6 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
-!
- USE MODD_VAR_ll, ONLY : MPI_PRECISION
!
IMPLICIT NONE
!
@@ -1962,7 +1939,7 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
!* 2. REDUCTION WITH ALL THE PROCESSORS :
! ---------------------------------
!
- CALL MPI_ALLREDUCE(ZSUM, SUMMASKCOMP_ll, 1, MPI_PRECISION, &
+ CALL MPI_ALLREDUCE(ZSUM, SUMMASKCOMP_ll, 1, MNHREAL_MPI, &
MPI_SUM, NMNH_COMM_WORLD, KINFO)
!
!-------------------------------------------------------------------------------
@@ -2004,7 +1981,6 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
! and local processor
! TCRRT_PROCONF - Current configuration for current model
! IP -
-! MPI_PRECISION -
! JPHALO -
!
!! Author
@@ -2019,12 +1995,10 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
!
!* 0. DECLARATIONS
!
- USE MODD_STRUCTURE_ll, ONLY : MODELSPLITTING_ll
+ USE MODD_STRUCTURE_ll, ONLY: MODELSPLITTING_ll
+ USE MODD_VAR_ll, ONLY: IP, TCRRT_COMDATA, TCRRT_PROCONF, JPHALO
!
- USE MODD_VAR_ll, ONLY : IP, TCRRT_COMDATA, TCRRT_PROCONF, JPHALO, &
- MPI_PRECISION
-!
- USE MODE_TOOLS_ll, ONLY : LWEST_ll, LEAST_ll
+ USE MODE_TOOLS_ll, ONLY: LWEST_ll, LEAST_ll
!
IMPLICIT NONE
!
@@ -2080,7 +2054,7 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
!* 3. MERGE LOCAL SUMS
! ----------------
!
- CALL MPI_ALLREDUCE(ZBUF, PRES, SIZE(PRES), MPI_PRECISION, MPI_SUM, &
+ CALL MPI_ALLREDUCE(ZBUF, PRES, SIZE(PRES), MNHREAL_MPI, MPI_SUM, &
NMNH_COMM_WORLD,KINFO)
!
!-----------------------------------------------------------------
@@ -2122,7 +2096,6 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
! and local processor
! TCRRT_PROCONF - Current configuration for current model
! IP -
-! MPI_PRECISION -
! JPHALO -
!
!! Author
@@ -2138,14 +2111,11 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
!
!* 0. DECLARATIONS
!
- USE MODD_STRUCTURE_ll, ONLY : MODELSPLITTING_ll
-!
- USE MODD_VAR_ll, ONLY : IP, TCRRT_COMDATA, TCRRT_PROCONF, JPHALO, &
- MPI_PRECISION
-!
- USE MODE_TOOLS_ll, ONLY : LWEST_ll, LEAST_ll, LNORTH_ll, LSOUTH_ll
+ USE MODD_STRUCTURE_ll, ONLY: MODELSPLITTING_ll
+ USE MODD_VAR_ll, ONLY: IP, TCRRT_COMDATA, TCRRT_PROCONF, JPHALO
!
- USE MODE_REPRO_SUM
+ USE MODE_REPRO_SUM
+ USE MODE_TOOLS_ll, ONLY: LWEST_ll, LEAST_ll, LNORTH_ll, LSOUTH_ll
!
!* 0. DECLARATIONS
! ------------
@@ -2291,7 +2261,6 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
! and local processor
! TCRRT_PROCONF - Current configuration for current model
! IP -
-! MPI_PRECISION -
! JPHALO -
!
!! Author
@@ -2307,12 +2276,10 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
!
!* 0. DECLARATIONS
!
- USE MODD_STRUCTURE_ll, ONLY : MODELSPLITTING_ll
+ USE MODD_STRUCTURE_ll, ONLY: MODELSPLITTING_ll
+ USE MODD_VAR_ll, ONLY: IP, TCRRT_COMDATA, TCRRT_PROCONF, JPHALO
!
- USE MODD_VAR_ll, ONLY : IP, TCRRT_COMDATA, TCRRT_PROCONF, JPHALO, &
- MPI_PRECISION
-!
- USE MODE_TOOLS_ll, ONLY : LWEST_ll, LEAST_ll, LNORTH_ll, LSOUTH_ll
+ USE MODE_TOOLS_ll, ONLY: LWEST_ll, LEAST_ll, LNORTH_ll, LSOUTH_ll
!
!* 0. DECLARATIONS
! ------------
@@ -2373,7 +2340,7 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
!
!* 2. Merge local sums
!
- CALL MPI_ALLREDUCE(ZBUF, PRES, SIZE(PRES, 1) * SIZE(PRES, 2), MPI_PRECISION, MPI_SUM, NMNH_COMM_WORLD,KINFO)
+ CALL MPI_ALLREDUCE(ZBUF, PRES, SIZE(PRES, 1) * SIZE(PRES, 2), MNHREAL_MPI, MPI_SUM, NMNH_COMM_WORLD,KINFO)
!
!-----------------------------------------------------------------
ELSE
@@ -2405,7 +2372,7 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
!
!* 2. Merge local sums
!
- CALL MPI_ALLREDUCE(ZBUF, PRES, SIZE(PRES, 1) * SIZE(PRES,2), MPI_PRECISION, MPI_SUM, NMNH_COMM_WORLD,KINFO)
+ CALL MPI_ALLREDUCE(ZBUF, PRES, SIZE(PRES, 1) * SIZE(PRES,2), MNHREAL_MPI, MPI_SUM, NMNH_COMM_WORLD,KINFO)
ENDIF
ENDIF
@@ -2438,8 +2405,6 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
!! Implicit Arguments
!! ------------------
!
-! Module MODD_VAR_ll
-! MPI_PRECISION -
!
!! Author
!! ------
@@ -2454,7 +2419,7 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
!
!* 0. DECLARATIONS
!
- USE MODE_REPRO_SUM
+ USE MODE_REPRO_SUM
!
IMPLICIT NONE
!
@@ -2511,8 +2476,6 @@ END SUBROUTINE REDUCE_SUM_0DD_ll
!! Implicit Arguments
!! ------------------
!
-! Module MODD_VAR_ll
-! MPI_PRECISION -
!
!! Author
!! ------
@@ -2526,8 +2489,6 @@ END SUBROUTINE REDUCE_SUM_0DD_ll
!-----------------------------------------------------------------
!
!* 0. DECLARATIONS
-!
- USE MODD_VAR_ll, ONLY : MPI_PRECISION
!
IMPLICIT NONE
!
@@ -2546,7 +2507,7 @@ END SUBROUTINE REDUCE_SUM_0DD_ll
!* 1. CALL THE MPI_ALLREDUCE ROUTINE
! ------------------------------
!
- CALL MPI_ALLREDUCE(PRES, ZRES, 1, MPI_PRECISION, &
+ CALL MPI_ALLREDUCE(PRES, ZRES, 1, MNHREAL_MPI, &
MPI_SUM, NMNH_COMM_WORLD, KINFO)
!
PRES = ZRES
@@ -2629,8 +2590,6 @@ END SUBROUTINE REDUCE_SUM_1DD_ll
!! Implicit Arguments
!! ------------------
!
-! Module MODD_VAR_ll
-! MPI_PRECISION -
!
!! Author
!! ------
@@ -2644,8 +2603,6 @@ END SUBROUTINE REDUCE_SUM_1DD_ll
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
-!
- USE MODD_VAR_ll, ONLY : MPI_PRECISION
!
IMPLICIT NONE
!
@@ -2664,7 +2621,7 @@ END SUBROUTINE REDUCE_SUM_1DD_ll
!* 1. CALL THE MPI_ALLREDUCE ROUTINE
! ------------------------------
!
- CALL MPI_ALLREDUCE(PRES, ZRES, SIZE(PRES,1), MPI_PRECISION, &
+ CALL MPI_ALLREDUCE(PRES, ZRES, SIZE(PRES,1), MNHREAL_MPI, &
MPI_SUM, NMNH_COMM_WORLD, KINFO)
!
PRES = ZRES
@@ -2701,8 +2658,6 @@ END SUBROUTINE REDUCE_SUM_1DD_ll
!! Implicit Arguments
!! ------------------
!
-! Module MODD_VAR_ll
-! MPI_PRECISION -
!
!! Author
!! ------
@@ -2716,8 +2671,6 @@ END SUBROUTINE REDUCE_SUM_1DD_ll
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
-!
- USE MODD_VAR_ll, ONLY : MPI_PRECISION
!
IMPLICIT NONE
!
@@ -2740,7 +2693,7 @@ END SUBROUTINE REDUCE_SUM_1DD_ll
!
IDIM = SIZE(PRES,1) * SIZE(PRES,2)
!
- CALL MPI_ALLREDUCE(PRES, ZRES, IDIM, MPI_PRECISION, MPI_SUM, &
+ CALL MPI_ALLREDUCE(PRES, ZRES, IDIM, MNHREAL_MPI, MPI_SUM, &
NMNH_COMM_WORLD, KINFO)
!
PRES = ZRES
@@ -2777,8 +2730,6 @@ END SUBROUTINE REDUCE_SUM_1DD_ll
!! Implicit Arguments
!! ------------------
!
-! Module MODD_VAR_ll
-! MPI_PRECISION -
!
!! Author
!! ------
@@ -2792,8 +2743,6 @@ END SUBROUTINE REDUCE_SUM_1DD_ll
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
-!
- USE MODD_VAR_ll, ONLY : MPI_PRECISION
!
IMPLICIT NONE
!
@@ -2817,7 +2766,7 @@ END SUBROUTINE REDUCE_SUM_1DD_ll
!
IDIM = SIZE(PRES,1) * SIZE(PRES,2) * SIZE(PRES,3)
!
- CALL MPI_ALLREDUCE(PRES, ZRES, IDIM, MPI_PRECISION, MPI_SUM, &
+ CALL MPI_ALLREDUCE(PRES, ZRES, IDIM, MNHREAL_MPI, MPI_SUM, &
NMNH_COMM_WORLD, KINFO)
!
PRES = ZRES
@@ -3055,8 +3004,6 @@ END SUBROUTINE REDUCE_SUM_1DD_ll
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
-!
- USE MODD_VAR_ll, ONLY : MPI_PRECISION
!
IMPLICIT NONE
!
diff --git a/src/LIB/SURCOUCHE/src/mode_tools_ll.f90 b/src/LIB/SURCOUCHE/src/mode_tools_ll.f90
index 158d5313622d2681529fa70baeb453fce1d293af..626cc3614f8a594ac5dfcb5b7f25af6c99dfd506 100644
--- a/src/LIB/SURCOUCHE/src/mode_tools_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_tools_ll.f90
@@ -1,17 +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$
-!-----------------------------------------------------------------
-!Correction :
-! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+! Modifications:
+! J. Escobar 15/09/2015: WENO5 & JPHEXT <> 1
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-----------------------------------------------------------------
! ####################
@@ -52,11 +46,14 @@
! Juan/Didier 12/03/2009: array bound bug correction with 1proc/MPIVIDE
! J. Escobar 27/06/2011 correction for gridnesting with different SHAPE
!
- USE MODD_STRUCTURE_ll
USE MODD_MPIF
+ use modd_precision, only: MNHREAL_MPI
+ USE MODD_STRUCTURE_ll
!JUANZ
USE MODD_VAR_ll, ONLY : NMNH_COMM_WORLD
- !JUANZ
+ !JUANZ
+
+ use mode_msg
!
CONTAINS
@@ -1098,7 +1095,6 @@ ENDIF
! NPROC - Number of processors
! TCRRT_PROCONF - Current configuration for current model
! IP - Number of the local processor
-! MPI_PRECISION - mpi precision
!
! Module MODD_PARAMETERS_ll
! JPHEXT - halo size
@@ -1120,16 +1116,12 @@ ENDIF
!
!* 0. DECLARATIONS
!
- USE MODD_PARAMETERS_ll, ONLY : JPHEXT
- USE MODD_STRUCTURE_ll, ONLY : MODELSPLITTING_ll
- USE MODD_VAR_ll, ONLY : NPROC, TCRRT_PROCONF, IP, MPI_PRECISION
+ USE MODD_PARAMETERS_ll, ONLY: JPHEXT
+ USE MODD_STRUCTURE_ll, ONLY: MODELSPLITTING_ll
+ USE MODD_VAR_ll, ONLY: NPROC, TCRRT_PROCONF, IP
!
IMPLICIT NONE
!
-!* 0.099 Include MPI parameters
-!
-! INCLUDE 'mpif.h'
-!
!* 0.1 declarations of arguments
!
REAL, DIMENSION(:,:), TARGET, INTENT(IN) :: PARRAY ! horizontal field
@@ -1270,7 +1262,7 @@ ENDIF
ZPTR => PARRAY(ILOC,IB:IE)
!
CASE DEFAULT
- STOP 'GET_GLOBALSLICE_ll : Bad HDIR argument'
+ call Print_msg( NVERB_FATAL, 'GEN', 'GET_1DGLOBALSLICE_ll', 'invalid HDIR dummy argument ('//hdir//')' )
!
END SELECT
!
@@ -1332,8 +1324,8 @@ ENDIF
!* 3.3 Have the values of the local slice on each proc known
! by all procs on the global slice
!
- CALL MPI_ALLGATHERV(ZPTR, ISIZE, MPI_PRECISION, PGLOBALSLICE, &
- ISIZES, IDISPL, MPI_PRECISION, ICOMM_GLOBALSLICE, IERR)
+ CALL MPI_ALLGATHERV(ZPTR, ISIZE, MNHREAL_MPI, PGLOBALSLICE, &
+ ISIZES, IDISPL, MNHREAL_MPI, ICOMM_GLOBALSLICE, IERR)
!
!* 3.4 Delete slice communicator
!
@@ -1364,7 +1356,7 @@ ENDIF
IF (ICOMM .NE. MPI_COMM_NULL) THEN
!
CALL MPI_BCAST(IGLOBALSLICELENGTH, 1, MPI_INTEGER, IPROCS(1), ICOMM, IERR)
- CALL MPI_BCAST(PGLOBALSLICE(IDISPL1+1), IGLOBALSLICELENGTH, MPI_PRECISION, &
+ CALL MPI_BCAST(PGLOBALSLICE(IDISPL1+1), IGLOBALSLICELENGTH, MNHREAL_MPI, &
IPROCS(1), ICOMM, IERR)
!
CALL MPI_COMM_FREE(ICOMM, IERR)
@@ -1416,7 +1408,6 @@ ENDIF
! NPROC - Number of processors
! TCRRT_PROCONF - Current configuration for current model
! IP - Number of the local processor
-! MPI_PRECISION - mpi precision
!
! Module MODD_PARAMETERS_ll
! JPHEXT, JPVEXT - halo size
@@ -1438,16 +1429,12 @@ ENDIF
!
!* 0. DECLARATIONS
!
- USE MODD_PARAMETERS_ll, ONLY : JPHEXT, JPVEXT
- USE MODD_STRUCTURE_ll, ONLY : MODELSPLITTING_ll
- USE MODD_VAR_ll, ONLY : NPROC, TCRRT_PROCONF, IP, MPI_PRECISION
+ USE MODD_PARAMETERS_ll, ONLY: JPHEXT, JPVEXT
+ USE MODD_STRUCTURE_ll, ONLY: MODELSPLITTING_ll
+ USE MODD_VAR_ll, ONLY: NPROC, TCRRT_PROCONF, IP
!
IMPLICIT NONE
!
-!* 0.099 Include MPI parameters
-!
-! INCLUDE 'mpif.h'
-!
!* 0.1 declarations of arguments
!
REAL, DIMENSION(:,:,:), TARGET, INTENT(IN) :: PARRAY ! horizontal field
@@ -1602,7 +1589,7 @@ ENDIF
ZPTR = PARRAY(ILOC,IB:IE,KKB:KKE)
!
CASE DEFAULT
- STOP 'GET_GLOBALSLICE_ll : Bad HDIR argument'
+ call Print_msg( NVERB_FATAL, 'GEN', 'GET_2DGLOBALSLICE_ll', 'invalid HDIR dummy argument ('//hdir//')' )
!
END SELECT
!
@@ -1668,9 +1655,9 @@ ENDIF
! by all procs on the global slice
!
DO JK = 1, IGLOBALSLICEHEIGHT
- CALL MPI_ALLGATHERV(ZPTR(1,JK), ISIZE, MPI_PRECISION, &
+ CALL MPI_ALLGATHERV(ZPTR(1,JK), ISIZE, MNHREAL_MPI, &
PGLOBALSLICE(1,JK), ISIZES, IDISPL, &
- MPI_PRECISION, ICOMM_GLOBALSLICE, IERR)
+ MNHREAL_MPI, ICOMM_GLOBALSLICE, IERR)
ENDDO
!
!* 3.4 Delete slice communicator
@@ -1704,7 +1691,7 @@ ENDIF
!
CALL MPI_BCAST(IGLOBALSLICELENGTH, 1, MPI_INTEGER, IPROCS(1), ICOMM, IERR)
DO JK = 1, IGLOBALSLICEHEIGHT
- CALL MPI_BCAST(PGLOBALSLICE(1,JK), IGLOBALSLICELENGTH, MPI_PRECISION, &
+ CALL MPI_BCAST(PGLOBALSLICE(1,JK), IGLOBALSLICELENGTH, MNHREAL_MPI, &
IPROCS(1), ICOMM, IERR)
ENDDO
!
@@ -1764,7 +1751,6 @@ ENDIF
! NPROC - Number of processors
! TCRRT_PROCONF - Current configuration for current model
! IP - Number of the local processor
-! MPI_PRECISION - mpi precision
!
! Module MODD_PARAMETERS_ll
! JPHEXT, JPVEXT - halo size
@@ -1785,16 +1771,12 @@ ENDIF
!
!* 0. DECLARATIONS
!
- USE MODD_PARAMETERS_ll, ONLY : JPHEXT
- USE MODD_VAR_ll, ONLY : NPROC,TCRRT_PROCONF,IP,MPI_PRECISION
- USE MODD_STRUCTURE_ll, ONLY : MODELSPLITTING_ll
+ USE MODD_PARAMETERS_ll, ONLY: JPHEXT
+ USE MODD_STRUCTURE_ll, ONLY: MODELSPLITTING_ll
+ USE MODD_VAR_ll, ONLY: NPROC, TCRRT_PROCONF, IP
!
IMPLICIT NONE
!
-!* 0.099 Include MPI parameters
-!
-! INCLUDE 'mpif.h'
-!
!* 0.1 declarations of arguments
!
REAL, DIMENSION(:,:), TARGET, INTENT(IN) :: PARRAY ! horizontal field
@@ -1962,7 +1944,7 @@ ENDIF
ZPTR => PARRAY(ILOC,IJB:IJE)
!
CASE DEFAULT
- STOP 'GET_SLICE_ll : Bad HDIR argument'
+ call Print_msg( NVERB_FATAL, 'GEN', 'GET_1DSLICE_ll', 'invalid HDIR dummy argument ('//hdir//')' )
!
END SELECT
!
@@ -2024,8 +2006,8 @@ ENDIF
!* 3.3 Have the values of the local slice on each proc known
! by all procs on the global slice
!
- CALL MPI_ALLGATHERV(ZPTR, ISIZE, MPI_PRECISION, ITOTALSLICE, ISIZES, &
- IDISPL, MPI_PRECISION, ICOMM_SLICE, IERR)
+ CALL MPI_ALLGATHERV(ZPTR, ISIZE, MNHREAL_MPI, ITOTALSLICE, ISIZES, &
+ IDISPL, MNHREAL_MPI, ICOMM_SLICE, IERR)
!
DEALLOCATE(ISIZES, IDISPL)
!
@@ -2058,7 +2040,7 @@ ENDIF
IF (ICOMM .NE. MPI_COMM_NULL) THEN
!
CALL MPI_BCAST(ISLICELENGTH, 1, MPI_INTEGER, IPROCS(1), ICOMM, IERR)
- CALL MPI_BCAST(ITOTALSLICE, ISLICELENGTH, MPI_PRECISION, &
+ CALL MPI_BCAST(ITOTALSLICE, ISLICELENGTH, MNHREAL_MPI, &
IPROCS(1), ICOMM, IERR)
CALL MPI_COMM_FREE(ICOMM, IERR)
ENDIF
@@ -2112,7 +2094,6 @@ ENDIF
! NPROC - Number of processors
! TCRRT_PROCONF - Current configuration for current model
! IP - Number of the local processor
-! MPI_PRECISION - mpi precision
!
! Module MODD_PARAMETERS_ll
! JPHEXT, JPVEXT - halo size
@@ -2133,16 +2114,12 @@ ENDIF
!
!* 0. DECLARATIONS
!
- USE MODD_PARAMETERS_ll, ONLY : JPHEXT, JPVEXT
- USE MODD_VAR_ll, ONLY : NPROC,TCRRT_PROCONF,IP,MPI_PRECISION
- USE MODD_STRUCTURE_ll, ONLY : MODELSPLITTING_ll
+ USE MODD_PARAMETERS_ll, ONLY: JPHEXT, JPVEXT
+ USE MODD_STRUCTURE_ll, ONLY: MODELSPLITTING_ll
+ USE MODD_VAR_ll, ONLY: NPROC, TCRRT_PROCONF, IP
!
IMPLICIT NONE
!
-!* 0.099 Include MPI parameters
-!
-! INCLUDE 'mpif.h'
-!
!* 0.1 declarations of arguments
!
REAL, DIMENSION(:,:,:), TARGET, INTENT(IN) :: PARRAY ! horizontal field
@@ -2320,7 +2297,7 @@ ENDIF
ZPTR = PARRAY(ILOC,IJB:IJE,KKB:KKE)
!
CASE DEFAULT
- STOP 'GET_SLICE_ll : Bad HDIR argument'
+ call Print_msg( NVERB_FATAL, 'GEN', 'GET_2DSLICE_ll', 'invalid HDIR dummy argument ('//hdir//')' )
!
END SELECT
!
@@ -2384,9 +2361,9 @@ ENDIF
! by all procs on the global slice
!
DO JK = 1, ISLICEHEIGHT
- CALL MPI_ALLGATHERV(ZPTR(1,JK), ISIZE, MPI_PRECISION, &
+ CALL MPI_ALLGATHERV(ZPTR(1,JK), ISIZE, MNHREAL_MPI, &
ITOTALSLICE(1,JK), &
- ISIZES, IDISPL, MPI_PRECISION, ICOMM_SLICE, IERR)
+ ISIZES, IDISPL, MNHREAL_MPI, ICOMM_SLICE, IERR)
ENDDO
!
!* 3.4 Delete slice communicator
@@ -2420,7 +2397,7 @@ ENDIF
!
CALL MPI_BCAST(ISLICELENGTH, 1, MPI_INTEGER, IPROCS(1), ICOMM, IERR)
DO JK = 1, ISLICEHEIGHT
- CALL MPI_BCAST(ITOTALSLICE(1,JK), ISLICELENGTH, MPI_PRECISION, &
+ CALL MPI_BCAST(ITOTALSLICE(1,JK), ISLICELENGTH, MNHREAL_MPI, &
IPROCS(1), ICOMM, IERR)
ENDDO
!
@@ -3298,8 +3275,6 @@ ENDIF
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
-!
- USE MODD_VAR_ll, ONLY : MPI_PRECISION
!
IMPLICIT NONE
!
@@ -3319,7 +3294,7 @@ ENDIF
!-------------------------------------------------------------------------------
!
IMEANSQRTLOC = SUM(SQRT(PARRAY))
-CALL MPI_ALLREDUCE(IMEANSQRTLOC, PMEANSQRT, 1, MPI_PRECISION, MPI_SUM, NMNH_COMM_WORLD,IINFO)
+CALL MPI_ALLREDUCE(IMEANSQRTLOC, PMEANSQRT, 1, MNHREAL_MPI, MPI_SUM, NMNH_COMM_WORLD,IINFO)
PMEANSQRT = PMEANSQRT / KSIZEGLB
!
!-----------------------------------------------------------------------
diff --git a/src/LIB/SURCOUCHE/src/mode_toolsz_ll.f90 b/src/LIB/SURCOUCHE/src/mode_toolsz_ll.f90
index 91cc5b3292d52f895b04bce68152b0a70a0d0025..8794b9e36973903f350540e66c5b0062c57f1d8f 100644
--- a/src/LIB/SURCOUCHE/src/mode_toolsz_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_toolsz_ll.f90
@@ -1,7 +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.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+!-----------------------------------------------------------------
! ########################
MODULE MODE_TOOLSZ_ll
! ########################
@@ -202,6 +206,7 @@
!! -------------
! Original 01/05/98
! R.Guivarch 29/11/99 : x and y splitting : HSPLITTING
+ ! J.Escobar 28/03/2019: check very small domain(0 size)
!
!-------------------------------------------------------------------------------
!
@@ -213,6 +218,7 @@
USE MODD_VAR_ll, ONLY : IP
USE MODD_CONFZ , ONLY : NZ_VERB,NZ_SPLITTING ! for debug IZ=1=flat_inv; IZ=2=flat_invz ; IZ=1+2=the two
+ use mode_msg
USE MODE_SPLITTING_ll , ONLY : def_splitting2
USE MODE_TOOLS_ll , ONLY : SLIDE_COORD
!JUAN
@@ -234,6 +240,7 @@
!
!* 0.2 declarations of local variables
!
+ character(len=10) :: yval1, yval2 ! Strings for error message
INTEGER :: X_DOMAINS,Y_DOMAINS,Z_DOMAINS,X_DOMAINS_NEW
LOGICAL :: PREM
INTEGER :: IK
@@ -244,11 +251,9 @@
! 0. CHECK NB_PROC/NZ_PROC
PREM = .FALSE.
IF ( MOD(NB_PROC,KZ_PROC) .NE. 0 ) THEN
- PRINT*
- WRITE(*,1000) NB_PROC, KZ_PROC
- PRINT*
-1000 FORMAT("MODE_SPLITTINGZ::SPLITZ --> NB_PROC=", I4 ," NOT DIVISIBLE BY KZ_PROC=", I4)
- STOP
+ write( yval1, '( I10 )' ) nb_proc
+ write( yval2, '( I10 )' ) kz_proc
+ call Print_msg( NVERB_FATAL, 'GEN', 'SPLITZ', 'NB_PROC='//trim(yval1)//' not divisible by KZ_PROC='//trim(yval2) )
ENDIF
!
! Splitting in Z possible so
@@ -279,7 +284,7 @@
!
IF(HSPLITTING.EQ."P2P1SPLITT") THEN
IF ((PREM).AND.(NB_PROC_XY.GT.2)) THEN
- STOP "mode_toolsz_ll.f90::SPLITZ: NPROC PREMIER NON PREVUE !!! "
+ call Print_msg( NVERB_FATAL, 'GEN', 'SPLITZ', 'unexpected: NB_PROC_XY is a prime number' )
!
! split x direction only on NB_PROC_XY - 1 processors
! and on reducted x-size = X_DIM - X_DIM/NB_PROC_XY -1
@@ -332,6 +337,13 @@
CALL CARTESIANZ(TPROC,NB_PROC,X_DIM,Y_DIM,Z_DIM,X_DOMAINS,Y_DOMAINS,Z_DOMAINS,321)
!
END IF
+ IF ( ( (1+TPROC(IP)%NXEND-TPROC(IP)%NXOR) == 0 ) &
+ .OR. ( (1+TPROC(IP)%NYEND-TPROC(IP)%NYOR) == 0 ) ) THEN
+ write( yval1, '( I10 )' ) 1+TPROC(IP)%NXEND-TPROC(IP)%NXOR
+ write( yval2, '( I10 )' ) 1+TPROC(IP)%NYEND-TPROC(IP)%NYOR
+ call Print_msg( NVERB_FATAL, 'GEN', 'SPLITZ', 'zero-size local-domain dimensions: DIMX='// &
+ trim(yval1)//', DIMY='//trim(yval2)//'. Too many processes for this domain size.')
+ END IF
!
!* 3. shift from physical to extended domain
!
@@ -352,10 +364,10 @@
PRINT*,"NYOR=",TPROC(IK)%NYOR," NYEND=",TPROC(IK)%NYEND," TAILLE=",1+TPROC(IK)%NYEND-TPROC(IK)%NYOR
PRINT*,"NZOR=",TPROC(IK)%NZOR," NZEND=",TPROC(IK)%NZEND," TAILLE=",1+TPROC(IK)%NZEND-TPROC(IK)%NZOR
END DO
+
ENDIF
END IF
END IF
- ! STOP
!
! Add 'Halo points' to global coordonne in X & Y direction
!
diff --git a/src/LIB/SURCOUCHE/src/modi_fm.f90 b/src/LIB/SURCOUCHE/src/modi_fm.f90
deleted file mode 100644
index ad1466bd851def41679432a30d90630abe0a4094..0000000000000000000000000000000000000000
--- a/src/LIB/SURCOUCHE/src/modi_fm.f90
+++ /dev/null
@@ -1,37 +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.
-!-----------------------------------------------------------------
-! Modifications:
-! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!-----------------------------------------------------------------
-
-MODULE MODI_FM_ll
-!
-INTERFACE
-!
-SUBROUTINE SET_FMPACK_ll(O1D,O2D,OPACK)
-LOGICAL, INTENT(IN) :: O1D,O2D,OPACK
-END SUBROUTINE SET_FMPACK_ll
-!
-SUBROUTINE IO_FILE_OPEN_ll(TPFILE,KRESP,OPARALLELIO,HPOSITION,HSTATUS,HPROGRAM_ORIG)
-USE MODD_IO_ll, ONLY: TFILEDATA
-TYPE(TFILEDATA),POINTER,INTENT(INOUT) :: TPFILE ! File structure
-INTEGER, INTENT(OUT), OPTIONAL :: KRESP ! Return code
-LOGICAL, INTENT(IN), OPTIONAL :: OPARALLELIO
-CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HPOSITION
-CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HSTATUS
-CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HPROGRAM_ORIG !To emulate a file coming from this program
-END SUBROUTINE IO_FILE_OPEN_ll
-!
-SUBROUTINE IO_FILE_CLOSE_ll(TPFILE,KRESP,OPARALLELIO,HPROGRAM_ORIG)
-USE MODD_IO_ll, ONLY: TFILEDATA
-TYPE(TFILEDATA), INTENT(INOUT) :: TPFILE ! File structure
-INTEGER, INTENT(OUT), OPTIONAL :: KRESP ! Return code
-LOGICAL, INTENT(IN), OPTIONAL :: OPARALLELIO
-CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HPROGRAM_ORIG !To emulate a file coming from this program
-END SUBROUTINE IO_FILE_CLOSE_ll
-!
-END INTERFACE
-END MODULE MODI_FM_ll
diff --git a/src/LIB/SURCOUCHE/src/modi_io.f90 b/src/LIB/SURCOUCHE/src/modi_io.f90
deleted file mode 100644
index 6136b47f52da70663b49023c77d9b6408fa83f66..0000000000000000000000000000000000000000
--- a/src/LIB/SURCOUCHE/src/modi_io.f90
+++ /dev/null
@@ -1,63 +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.
-!-----------------------------------------------------------------
-! Modifications:
-! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!-----------------------------------------------------------------
-
-MODULE MODI_IO_ll
-!
-INTERFACE
- SUBROUTINE INITIO_ll()
- END SUBROUTINE INITIO_ll
-
- SUBROUTINE OPEN_ll(&
- TPFILE, &
- MODE, &
- COMM, &
- STATUS, &
- ACCESS, &
- IOSTAT, &
- FORM, &
- RECL, &
- BLANK, &
- POSITION,&
- DELIM, &
- PAD, &
- KNB_PROCIO,&
- OPARALLELIO, &
- HPROGRAM_ORIG)
-
- USE MODD_IO_ll, ONLY : TFILEDATA
-
- TYPE(TFILEDATA), INTENT(INOUT) :: TPFILE
- CHARACTER(len=*),INTENT(IN), OPTIONAL :: MODE
- CHARACTER(len=*),INTENT(IN), OPTIONAL :: STATUS
- CHARACTER(len=*),INTENT(IN), OPTIONAL :: ACCESS
- INTEGER, INTENT(OUT) :: IOSTAT
- CHARACTER(len=*),INTENT(IN), OPTIONAL :: FORM
- INTEGER, INTENT(IN), OPTIONAL :: RECL
- CHARACTER(len=*),INTENT(IN), OPTIONAL :: BLANK
- CHARACTER(len=*),INTENT(IN), OPTIONAL :: POSITION
- CHARACTER(len=*),INTENT(IN), OPTIONAL :: DELIM
- CHARACTER(len=*),INTENT(IN), OPTIONAL :: PAD
- INTEGER, INTENT(IN), OPTIONAL :: COMM
- INTEGER, INTENT(IN), OPTIONAL :: KNB_PROCIO
- LOGICAL, INTENT(IN), OPTIONAL :: OPARALLELIO
- CHARACTER(LEN=*),INTENT(IN), OPTIONAL :: HPROGRAM_ORIG !To emulate a file coming from this program
- END SUBROUTINE OPEN_ll
-
- SUBROUTINE CLOSE_ll(TPFILE,IOSTAT,OPARALLELIO,HPROGRAM_ORIG)
- USE MODD_IO_ll, ONLY : TFILEDATA
-
- TYPE(TFILEDATA), INTENT(IN) :: TPFILE
- INTEGER, INTENT(OUT), OPTIONAL :: IOSTAT
- LOGICAL, INTENT(IN), OPTIONAL :: OPARALLELIO
- CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HPROGRAM_ORIG !To emulate a file coming from this program
- END SUBROUTINE CLOSE_ll
-
-END INTERFACE
-!
-END MODULE MODI_IO_ll
diff --git a/src/LIB/SURCOUCHE/src/modn_confio.f90 b/src/LIB/SURCOUCHE/src/modn_confio.f90
index b4a4ea3be9b3782e6d7d3d375af6ffb1ecaf3108..8505a61f96ad0b37b485f5f7fe850abe34a72ec9 100644
--- a/src/LIB/SURCOUCHE/src/modn_confio.f90
+++ b/src/LIB/SURCOUCHE/src/modn_confio.f90
@@ -13,7 +13,7 @@
!! -------
! Define I/O configuration variables that can be set with the NAM_CONFIO namelist
!! /!\ These variables must be transmitted to the SURCOUCHE library via the
-!! SET_CONFIO_ll subroutine before the FIRST call to IO_FILE_OPEN_ll
+!! IO_Config_set subroutine before the FIRST call to IO_FILE_OPEN_ll
!
!!
!!** IMPLICIT ARGUMENTS
@@ -36,9 +36,9 @@
!* 0. DECLARATIONS
! ------------
!
-USE MODD_IO_ll, ONLY : LVERB_OUTLST, LVERB_STDOUT, LVERB_ALLPRC, &
- NIO_VERB, NIO_ABORT_LEVEL, NGEN_VERB, NGEN_ABORT_LEVEL, &
- CIO_DIR, LIO_ALLOW_NO_BACKUP, LIO_NO_WRITE
+USE MODD_IO, ONLY : LVERB_OUTLST, LVERB_STDOUT, LVERB_ALLPRC, &
+ NIO_VERB, NIO_ABORT_LEVEL, NGEN_VERB, NGEN_ABORT_LEVEL, &
+ CIO_DIR, LIO_ALLOW_NO_BACKUP, LIO_NO_WRITE
!
IMPLICIT NONE
!
diff --git a/src/LIB/SURCOUCHE/src/system_mnh.f90 b/src/LIB/SURCOUCHE/src/system_mnh.f90
index ef39625e42eee1684e444aef8f0fc4562c7816c7..b43981265170ba8f28768d5d1664868f6cba45b6 100644
--- a/src/LIB/SURCOUCHE/src/system_mnh.f90
+++ b/src/LIB/SURCOUCHE/src/system_mnh.f90
@@ -12,7 +12,6 @@ SUBROUTINE SYSTEM_MNH(HCOMMAND)
!! Modifications:
!! Philippe Wautelet: 10/01/2019: use NEWUNIT argument of OPEN
!!
- USE MODE_IO_ll
!!
!* 0. DECLARATIONS
! ------------
@@ -26,14 +25,10 @@ SUBROUTINE SYSTEM_MNH(HCOMMAND)
!
!* 0.2 Declaration of local variables
! ------------------------------
-#if defined(MNH_LINUX) || defined(MNH_SP4)
- CHARACTER(LEN=*),PARAMETER :: CFILE="file_for_xtransfer"
-#else
-#if !defined(MNH_SX5)
- CHARACTER(LEN=*),PARAMETER :: CFILE="file_for_fujitransfer"
-#else
+#ifdef MNH_SX5
CHARACTER(LEN=*),PARAMETER :: CFILE="file_for_nectransfer"
-#endif
+#else
+ CHARACTER(LEN=*),PARAMETER :: CFILE="file_for_xtransfer"
#endif
INTEGER :: IUNIT
!
diff --git a/src/LIB/SURCOUCHE/src/update_nhalo1d.f90 b/src/LIB/SURCOUCHE/src/update_nhalo1d.f90
index d899568add0df8399a37510ae28f707abcddb1ed..a4ac0bcac29aa2115a31e0b7751e557c9c5da432 100644
--- a/src/LIB/SURCOUCHE/src/update_nhalo1d.f90
+++ b/src/LIB/SURCOUCHE/src/update_nhalo1d.f90
@@ -2,6 +2,7 @@
!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SURFEX_LIC for details. version 1.
+!-----------------------------------------------------------------
! ################################################################
SUBROUTINE UPDATE_NHALO1D( NHALO, PFIELD1D, KISIZE_ll, KJSIZE_ll, KXOR, KXEND, KYOR, KYEND, HREC )
! ################################################################
@@ -39,25 +40,26 @@
!! M.Moge 08/2015 calling ABORT if local subdomain is of size < NHALO
!! (this causes problems on the boundary of the domain)
!! M.Moge 08/2015 bug fix : changing the computation of IISIZE
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_SURF_PAR, ONLY : NUNDEF
+USE PARKIND1, ONLY: JPRB
+USE YOMHOOK, ONLY: LHOOK, DR_HOOK
!
+USE MODD_MPIF
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
+USE MODD_STRUCTURE_ll, ONLY: ZONE_ll, CRSPD_ll
+USE MODD_SURF_PAR, ONLY: NUNDEF
+USE MODD_VAR_ll, ONLY: NPROC, IP, YSPLITTING, NMNH_COMM_WORLD
!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
+USE MODE_EXCHANGE_ll, ONLY: SEND_RECV_FIELD
USE MODE_ll
-USE MODE_EXCHANGE_ll, ONLY : SEND_RECV_FIELD
-USE MODE_SPLITTING_ll, ONLY : SPLIT2
-USE MODD_VAR_ll, ONLY : NPROC, IP, YSPLITTING, NMNH_COMM_WORLD
-USE MODD_MPIF
-USE MODD_STRUCTURE_ll, ONLY : ZONE_ll, CRSPD_ll
-USE MODE_TOOLS_ll, ONLY : INTERSECTION
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
+use mode_msg
+USE MODE_SPLITTING_ll, ONLY: SPLIT2
+USE MODE_TOOLS_ll, ONLY: INTERSECTION
!
IMPLICIT NONE
!
@@ -97,6 +99,7 @@ TYPE(ZONE_ll), ALLOCATABLE, DIMENSION(:) :: TZSEND, TZRECV
TYPE(CRSPD_ll), POINTER :: TZCRSPDSEND, TZCRSPDRECV
TYPE(CRSPD_ll), ALLOCATABLE, DIMENSION(:), TARGET :: TZCRSPDSENDTAB, TZCRSPDRECVTAB
!
+character(len=10) :: ydim1, ydim2, yhalo ! String for error message
INTEGER :: J
INTEGER :: INBMSG
INTEGER :: ICARD
@@ -134,10 +137,11 @@ ALLOCATE(TZSPLITTING_PHYS(NPROC),TZSPLITTING_EXT(NPROC))
! Donc on fait un WARNING et un ABORT
!
IF ( NHALO > KXEND - KXOR + 1 .OR. NHALO > KYEND - KYOR + 1 ) THEN
- WRITE(*,*) "ERROR in UPDATE_NHALO1D : size of local subdomain is (", KXEND - KXOR + 1,",",KYEND - KYOR + 1, &
- ") which is less than NHALO=",NHALO
- WRITE(*,*) "Try with less MPI processes or a larger domain"
- CALL ABORT
+ write( ydim1, '( I10 )' ) KXEND - KXOR + 1
+ write( ydim2, '( I10 )' ) KYEND - KYOR + 1
+ write( yhalo, '( I10 )' ) NHALO
+ call Print_msg( NVERB_FATAL, 'GEN', 'UPDATE_NHALO1D', 'local subdomain ('//trim(ydim1)//'x'//trim(ydim2)// &
+ ') is smaller than NHALO ('//trim(yhalo)//'). Try with less MPI processes or a larger domain.' )
ENDIF
!
! physical splitting of the field
diff --git a/src/LIB/megan.tar.gz b/src/LIB/megan.tar.gz
index 81d81c29fa83d9f4724ba3e2085cf3613549fbc5..c9f186360fd3c305db25d9c72af24cca87988203 100644
--- a/src/LIB/megan.tar.gz
+++ b/src/LIB/megan.tar.gz
@@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
-oid sha256:4f23728f9dae694a49c7a831686b8ee37a5f0be0b51839fa839bb8e022499bbc
-size 42352
+oid sha256:0d9386c64cbbdf2ffe32f1c52e51e2606869e136a95a65e21f8081961f8e48d3
+size 42865
diff --git a/src/LIB/netcdf-cxx-4.2.tar.gz b/src/LIB/netcdf-cxx-4.2.tar.gz
new file mode 100644
index 0000000000000000000000000000000000000000..11c1c15536cf186d606f9de7d6468223a68e838d
--- /dev/null
+++ b/src/LIB/netcdf-cxx-4.2.tar.gz
@@ -0,0 +1,3 @@
+version https://git-lfs.github.com/spec/v1
+oid sha256:95ed6ab49a0ee001255eac4e44aacb5ca4ea96ba850c08337a3e4c9a0872ccd1
+size 703482
diff --git a/src/LIB/s4py/init_gfortran.c b/src/LIB/s4py/init_gfortran.c
new file mode 100644
index 0000000000000000000000000000000000000000..2fb55869b0fa5f71140d424df2568442eed4f059
--- /dev/null
+++ b/src/LIB/s4py/init_gfortran.c
@@ -0,0 +1,15 @@
+//MNH_LIC Copyright 2019-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.
+//-----------------------------------------------------------------
+#ifdef __GFORTRAN__
+/* Philippe Marguinaud idea */
+
+void init_gfortran_big_endian_(){
+ _gfortran_set_convert (2);
+}
+void init_gfortran_native_endian_(){
+ _gfortran_set_convert (0);
+}
+#endif
diff --git a/src/LIB/s4py/libs4py.f90 b/src/LIB/s4py/libs4py.f90
new file mode 100644
index 0000000000000000000000000000000000000000..94a19975455b3621545d5261069e5cdc0dbbf5b8
--- /dev/null
+++ b/src/LIB/s4py/libs4py.f90
@@ -0,0 +1,532 @@
+!MNH_LIC Copyright 2014-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 WLFIOUV(KRETURNCODE, CDFILE, CDSTATE, KNUMER)
+! ** PURPOSE
+! Open a LFI file
+!
+! ** DUMMY ARGUMENTS
+! KRETURNCODE: error code
+! CDFILE: path to file to open
+! CDSTATE: state of file ('NEW', 'OLD', 'UNKNOWN', 'SCRATCH')
+! KNUMER: logical unit number associated to file
+!
+! ** AUTHOR
+! 9 April 2014, S. Riette
+!
+! ** MODIFICATIONS
+! 26 sept 2014, S. Riette: use 64bits LFI subroutines
+! 8 nov 2018, S. Riette: Meso-NH version
+! P. Wautelet 21/02/2019: add copyright notice + use INT64 for 64-bits integers
+!
+! I. Dummy arguments declaration
+use iso_fortran_env, only: INT64
+IMPLICIT NONE
+INTEGER(KIND=INT64), INTENT(OUT) :: KRETURNCODE
+CHARACTER(LEN=*), INTENT(IN) :: CDFILE
+CHARACTER(LEN=*), INTENT(IN) :: CDSTATE
+INTEGER(KIND=INT64), INTENT(OUT) :: KNUMER
+!
+! II. Local variables declaration
+INTEGER, PARAMETER :: JPMAXLOGICALUNITNUMBER=5000
+INTEGER(KIND=LFI_INT) :: IRETURNCODE
+LOGICAL :: LLEXISTS, LLOPEN
+INTEGER(KIND=LFI_INT) :: IRECORDNUMBER
+INTEGER(KIND=LFI_INT) :: INUMER
+!
+! III. File opening
+!
+! III.a Search for an available logical unit
+INUMER=0
+LLEXISTS=.FALSE.
+LLOPEN=.TRUE.
+IRETURNCODE=0
+DO WHILE(INUMER.LT.JPMAXLOGICALUNITNUMBER .AND. (LLOPEN .OR. .NOT. LLEXISTS))
+ INUMER=INUMER+1
+ INQUIRE(UNIT=INUMER, EXIST=LLEXISTS, OPENED=LLOPEN)
+ENDDO
+IF(LLOPEN .OR. .NOT. LLEXISTS) THEN
+ IRETURNCODE=-999
+ENDIF
+!
+#ifdef __GFORTRAN__
+! III.b (Re)-init of libgfortran to enable big_endian file reading
+!**** *** ** * only gfortran will work with this * ** *** ****
+CALL INIT_GFORTRAN_BIG_ENDIAN()
+#endif
+!
+! III.c LFI file opening
+CALL LFIOUV(IRETURNCODE, INUMER, .TRUE., CDFILE, CDSTATE, .FALSE.,&
+ &.FALSE., INT(0, LFI_INT), INT(1, LFI_INT), IRECORDNUMBER)
+IF(IRETURNCODE/=0)THEN
+ CALL LFIENG(INUMER, INT(0, LFI_INT), IRETURNCODE, .FALSE., '', 'LFIOUV', '')
+ENDIF
+!
+#ifdef __GFORTRAN__
+! III.d (Re)-init of libgfortran to enable native endianess file reading
+!**** *** ** * only gfortran will work with this * ** *** ****
+CALL INIT_GFORTRAN_NATIVE_ENDIAN()
+#endif
+!
+KNUMER=INT(INUMER, 8)
+KRETURNCODE=INT(IRETURNCODE,8)
+
+END SUBROUTINE WLFIOUV
+
+!______________________________________________________________________
+
+SUBROUTINE WLFINAF(KRETURNCODE, KNUMER, KNALDO, KNTROU, KNARES, KNAMAX)
+! ** PURPOSE
+! Wrapper to LFINAF
+!
+! ** DUMMY ARGUMENTS
+! KRETURNCODE: error code
+! KNUMER: logical unit number associated to file
+! KNALDO: Number of actual logical data records (holes excluded)
+! KNTROU: Number of logical records which are holes
+! KNARES: Number of logical records which can be written in the reserved part of index (holes included)
+! KNAMAX: Maximum number of logical records which one can write on logical unit
+!
+! ** AUTHOR
+! 9 April 2014, S. Riette
+!
+! ** MODIFICATIONS
+! 26 sept 2014, S. Riette: use 64bits LFI subroutines
+! 8 nov 2018, S. Riette: Meso-NH version
+!
+! I. Dummy arguments declaration
+use iso_fortran_env, only: INT64
+IMPLICIT NONE
+INTEGER(KIND=INT64), INTENT(OUT) :: KRETURNCODE
+INTEGER(KIND=INT64), INTENT(IN) :: KNUMER
+INTEGER(KIND=INT64), INTENT(OUT) :: KNALDO, KNTROU, KNARES, KNAMAX
+!
+! II. Local variables declaration
+INTEGER(KIND=LFI_INT) :: IRETURNCODE
+INTEGER(KIND=LFI_INT) :: INUMER
+INTEGER(KIND=LFI_INT) :: INALDO, INTROU, INARES, INAMAX
+!
+! III. LFINAF call
+INUMER=INT(KNUMER, KIND(INUMER))
+CALL LFINAF(IRETURNCODE, INUMER, INALDO, INTROU, INARES, INAMAX)
+IF(IRETURNCODE/=0)THEN
+ CALL LFIENG(INUMER, INT(0, LFI_INT), IRETURNCODE, .FALSE., '', 'LFINAF', '')
+ENDIF
+KRETURNCODE=INT(IRETURNCODE,8)
+KNALDO=INT(INALDO, 8)
+KNTROU=INT(INTROU, 8)
+KNARES=INT(INARES, 8)
+KNAMAX=INT(INAMAX, 8)
+!
+END SUBROUTINE WLFINAF
+
+!______________________________________________________________________
+
+SUBROUTINE WLFIPOS(KRETURNCODE, KNUMER)
+! ** PURPOSE
+! Wrapper to LFIPOS
+!
+! ** DUMMY ARGUMENTS
+! KRETURNCODE: error code
+! KNUMER: logical unit number associated to file
+!
+! ** AUTHOR
+! 9 April 2014, S. Riette
+!
+! ** MODIFICATIONS
+! 26 sept 2014, S. Riette: use 64bits LFI subroutines
+! 8 nov 2018, S. Riette: Meso-NH version
+!
+! I. Dummy arguments declaration
+use iso_fortran_env, only: INT64
+IMPLICIT NONE
+INTEGER(KIND=INT64), INTENT(OUT) :: KRETURNCODE
+INTEGER(KIND=INT64), INTENT(IN) :: KNUMER
+!
+! II. Local variables declaration
+INTEGER(KIND=LFI_INT) :: IRETURNCODE
+INTEGER(KIND=LFI_INT) :: INUMER
+!
+! III. LFIPOS call
+INUMER=INT(KNUMER, KIND(INUMER))
+CALL LFIPOS(IRETURNCODE, INUMER)
+IF(IRETURNCODE/=0)THEN
+ CALL LFIENG(INUMER, INT(0, LFI_INT), IRETURNCODE, .FALSE., '', 'LFIPOS', '')
+ENDIF
+KRETURNCODE=INT(IRETURNCODE,8)
+!
+END SUBROUTINE WLFIPOS
+
+!______________________________________________________________________
+
+SUBROUTINE WLFICAS(KRETURNCODE, KNUMER, CDNOMA, KLONG, KPOSEX, LDAVAN)
+! ** PURPOSE
+! Wrapper to LFICAS
+!
+! ** DUMMY ARGUMENTS
+! KRETURNCODE: error code
+! KNUMER: logical unit number associated to file
+! CDNOMA: name of next record
+! KLONG: length of next record
+! KPOSEX: position in file of the first word of next record
+! LDAVAN: true if one must move forward the pointer
+!
+! ** AUTHOR
+! 9 April 2014, S. Riette
+!
+! ** MODIFICATIONS
+! 26 sept 2014, S. Riette: use 64bits LFI subroutines
+! use of true logical instead of integer
+! 8 nov 2018, S. Riette: Meso-NH version
+!
+! I. Dummy arguments declaration
+use iso_fortran_env, only: INT64
+IMPLICIT NONE
+INTEGER(KIND=INT64), INTENT(OUT) :: KRETURNCODE
+INTEGER(KIND=INT64), INTENT(IN) :: KNUMER
+CHARACTER(LEN=16), INTENT(OUT) :: CDNOMA
+INTEGER(KIND=INT64), INTENT(OUT) :: KLONG, KPOSEX
+LOGICAL, INTENT(IN) :: LDAVAN
+!
+! II. Local variables declaration
+INTEGER(KIND=LFI_INT) :: IRETURNCODE
+INTEGER(KIND=LFI_INT) :: INUMER
+INTEGER(KIND=LFI_INT) :: ILONG, IPOSEX
+!
+! III. LFICAS call
+INUMER=INT(KNUMER, KIND(INUMER))
+CALL LFICAS(IRETURNCODE, INUMER, CDNOMA, ILONG, IPOSEX, LDAVAN)
+IF(IRETURNCODE/=0)THEN
+ CALL LFIENG(INUMER, INT(0, LFI_INT), IRETURNCODE, .FALSE., '', 'LFICAS', '')
+ENDIF
+KRETURNCODE=INT(IRETURNCODE,8)
+KLONG=INT(ILONG, 8)
+KPOSEX=INT(IPOSEX, 8)
+!
+END SUBROUTINE WLFICAS
+
+!______________________________________________________________________
+
+SUBROUTINE WLFINFO(KRETURNCODE, KNUMER, CDNOMA, KLONG, KPOSEX)
+! ** PURPOSE
+! Wrapper to LFINFO
+!
+! ** DUMMY ARGUMENTS
+! KRETURNCODE: error code
+! KNUMER: logical unit number associated to file
+! CDNOMA: name of record
+! KLONG: length of record
+! KPOSEX: position in file of the first word of next record
+
+! ** AUTHOR
+! 9 April 2014, S. Riette
+!
+! ** MODIFICATIONS
+! 26 sept 2014, S. Riette: use 64bits LFI subroutines
+! 8 nov 2018, S. Riette: Meso-NH version
+!
+! I. Dummy arguments declaration
+use iso_fortran_env, only: INT64
+IMPLICIT NONE
+INTEGER(KIND=INT64), INTENT(OUT) :: KRETURNCODE
+INTEGER(KIND=INT64), INTENT(IN) :: KNUMER
+CHARACTER(LEN=16), INTENT(IN) :: CDNOMA
+INTEGER(KIND=INT64), INTENT(OUT) :: KLONG, KPOSEX
+!
+! II. Local variables declaration
+INTEGER(KIND=LFI_INT) :: IRETURNCODE
+INTEGER(KIND=LFI_INT) :: INUMER
+INTEGER(KIND=LFI_INT) :: ILONG, IPOSEX
+!
+! III. LFINFO call
+INUMER=INT(KNUMER, KIND(INUMER))
+CALL LFINFO(IRETURNCODE, INUMER, CDNOMA, ILONG, IPOSEX)
+IF(IRETURNCODE/=0)THEN
+ CALL LFIENG(INUMER, INT(0, LFI_INT), IRETURNCODE, .FALSE., '', 'LFINFO', '')
+ENDIF
+KRETURNCODE=INT(IRETURNCODE,8)
+KLONG=INT(ILONG, 8)
+KPOSEX=INT(IPOSEX, 8)
+!
+END SUBROUTINE WLFINFO
+
+!______________________________________________________________________
+
+SUBROUTINE WLFILEC(KRETURNCODE, KNUMER, CDNOMA, KLONG, LDABORT, KTAB)
+! ** PURPOSE
+! Wrapper to LFILEC
+!
+! ** DUMMY ARGUMENTS
+! KRETURNCODE: error code
+! KNUMER: logical unit number associated to file
+! CDNOMA: name of record
+! KLONG: length of record
+! LDABORT: must we raise an exception on error -21 ?
+! KTAB: integer array read
+
+! ** AUTHOR
+! 9 April 2014, S. Riette
+!
+! ** MODIFICATIONS
+! 26 sept 2014, S. Riette: use 64bits LFI subroutines
+! use of true logical instead of integer
+! 8 nov 2018, S. Riette: Meso-NH version
+!
+! I. Dummy arguments declaration
+use iso_fortran_env, only: INT64
+IMPLICIT NONE
+INTEGER(KIND=INT64), INTENT(OUT) :: KRETURNCODE
+INTEGER(KIND=INT64), INTENT(IN) :: KNUMER
+CHARACTER(LEN=16), INTENT(IN) :: CDNOMA
+INTEGER(KIND=INT64), INTENT(IN) :: KLONG
+LOGICAL, INTENT(IN) :: LDABORT
+INTEGER(KIND=INT64), INTENT(OUT), DIMENSION(KLONG) :: KTAB
+!
+! II. Local variables declaration
+INTEGER(KIND=LFI_INT) :: IRETURNCODE
+INTEGER(KIND=LFI_INT) :: INUMER, ILONG
+INTEGER(KIND=LFI_INT) :: ITOTLONG, IPOSEX
+INTEGER(KIND=INT64), ALLOCATABLE :: KTABTOT(:)
+!
+! III. LFILEC call
+INUMER=INT(KNUMER, KIND(INUMER))
+ILONG=INT(KLONG, KIND(ILONG))
+!
+!Because NERFAG cannot be changed easily, we read the entire article
+!even if only a part is needed, otherwise NERFAG=2 would be sufficient
+CALL WLFINFO(IRETURNCODE, INUMER, CDNOMA, ITOTLONG, IPOSEX)
+IF(ILONG .LT. ITOTLONG) THEN
+ ALLOCATE(KTABTOT(ITOTLONG))
+ CALL LFILEC(IRETURNCODE, INUMER, CDNOMA, KTABTOT, ITOTLONG)
+ELSE
+ CALL LFILEC(IRETURNCODE, INUMER, CDNOMA, KTAB, ILONG)
+ENDIF
+IF (IRETURNCODE/=0 .AND. .NOT. (IRETURNCODE==-21 .AND. .NOT. LDABORT)) THEN
+ CALL LFIENG(INUMER, INT(0, LFI_INT), IRETURNCODE, .FALSE., '', 'LFILEC', '')
+ KRETURNCODE=INT(IRETURNCODE,8)
+ELSE
+ KRETURNCODE=INT(0,8)
+ENDIF
+IF(ILONG .LT. ITOTLONG) THEN
+ KTAB(:)=KTABTOT(1:ILONG)
+ DEALLOCATE(KTABTOT)
+ENDIF
+!
+END SUBROUTINE WLFILEC
+
+!_________________________________________________________________________________________________
+
+SUBROUTINE WGET_COMPHEADER(KSIZE, KDATA, KLONG, KLONU, KTYPECOMP)
+! ** PURPOSE
+! Wrapper to GET_COMPHEADER
+!
+! ** DUMMY ARGUMENTS
+! KSIZE: Size of KDATA
+! KDATA: (part of) integer array read from record
+! KLONG: length of compressed data
+! KLONU: length of uncompressed data
+! KTYPECOMP: type of compression
+!
+! ** AUTHOR
+! 9 April 2014, S. Riette
+!
+! ** MODIFICATIONS
+!
+! I. Dummy arguments declaration
+use iso_fortran_env, only: INT64
+IMPLICIT NONE
+INTEGER(KIND=INT64), INTENT(IN) :: KSIZE
+INTEGER(KIND=INT64), INTENT(IN), DIMENSION(KSIZE) :: KDATA
+INTEGER(KIND=INT64), INTENT(IN) :: KLONG
+INTEGER(KIND=INT64), INTENT(OUT) :: KLONU
+INTEGER(KIND=INT64), INTENT(OUT) :: KTYPECOMP
+!
+! II. Local variables declaration
+INTEGER :: ILONG
+INTEGER :: ILONU, ITYPECOMP
+!
+! III. GET_COMPHEADER call
+#ifdef MNH_COMPRESS
+ILONG=KLONG
+CALL GET_COMPHEADER(KDATA, ILONG, ILONU, ITYPECOMP)
+KLONU=INT(ILONU, 8)
+KTYPECOMP=INT(ITYPECOMP, 8)
+#else
+print*, "Error: code was compiled without COMPRESS support, please define MNH_COMPRESS"
+KLONU=INT(-1, 8)
+KTYPECOMP=INT(-1, 8)
+#endif
+!
+END SUBROUTINE WGET_COMPHEADER
+
+!_________________________________________________________________________________________________
+
+SUBROUTINE WCOMPRESS_FIELD(KTAB, KX, KY, KSIZEDECOMP, KSIZECOMP)
+! ** PURPOSE
+! Wrapper to COMPRESS_FIELD
+!
+! ** DUMMY ARGUMENTS
+! KTAB: decompressed integer array (IN)
+! compressed data integer array (OUT)
+! KX, KY: x and y dimensions
+! KSIZEDECOMP: size of decompressed data
+! KSIZECOMP: size of compressed integer array
+!
+! ** AUTHOR
+! 16 July 2015, S. Riette
+!
+! ** MODIFICATIONS
+!
+! I. Dummy arguments declaration
+use iso_fortran_env, only: INT64
+IMPLICIT NONE
+INTEGER(KIND=INT64), INTENT(IN) :: KX, KY, KSIZEDECOMP
+INTEGER(KIND=INT64), INTENT(INOUT), DIMENSION(KSIZEDECOMP) :: KTAB
+INTEGER(KIND=INT64), INTENT(OUT) :: KSIZECOMP
+!
+! II. Local variables declaration
+INTEGER :: ISIZEDECOMP, ISIZECOMP, IX, IY
+!
+! III. COMPRESS_FIELD call
+#ifdef MNH_COMPRESS
+ISIZEDECOMP=KSIZEDECOMP
+IX=KX
+IY=KY
+CALL COMPRESS_FIELD(KTAB, IX, IY, ISIZEDECOMP, ISIZECOMP)
+KSIZECOMP=ISIZECOMP
+#else
+print*, "Error: code was compiled without COMPRESS support, please define MNH_COMPRESS"
+KSIZECOMP=INT(-1, 8)
+#endif
+!
+END SUBROUTINE WCOMPRESS_FIELD
+
+!_________________________________________________________________________________________________
+
+SUBROUTINE WDECOMPRESS_FIELD(KSIZE, KCOMP, KTYPECOMP, KLDECOMP, KDECOMP)
+! ** PURPOSE
+! Wrapper to DECOMPRESS_FIELD
+!
+! ** DUMMY ARGUMENTS
+! KSIZE: size of KCOMP
+! KCOMP: compressed integer array
+! KTYPECOMP: type of compression
+! KDECOMP: decompressed data integer array
+! KLDECOMP: length of decompressed data
+!
+! ** AUTHOR
+! 9 April 2014, S. Riette
+!
+! ** MODIFICATIONS
+!
+! I. Dummy arguments declaration
+use iso_fortran_env, only: INT64
+IMPLICIT NONE
+INTEGER(KIND=INT64), INTENT(IN) :: KSIZE
+INTEGER(KIND=INT64), INTENT(IN), DIMENSION(KSIZE) :: KCOMP
+INTEGER(KIND=INT64), INTENT(IN) :: KTYPECOMP
+INTEGER(KIND=INT64), INTENT(IN) :: KLDECOMP
+INTEGER(KIND=INT64), INTENT(OUT), DIMENSION(KLDECOMP) :: KDECOMP
+!
+! II. Local variables declaration
+INTEGER :: ITYPECOMP, ILDECOMP
+!
+! III. DECOMPRESS_FIELD call
+#ifdef MNH_COMPRESS
+ILDECOMP=KLDECOMP
+ITYPECOMP=KTYPECOMP
+CALL DECOMPRESS_FIELD(KDECOMP, ILDECOMP, KCOMP, SIZE(KCOMP,1), ITYPECOMP)
+#else
+print*, "Error: code was compiled without COMPRESS support, please define MNH_COMPRESS"
+KDECOMP(:)=-1
+#endif
+!
+END SUBROUTINE WDECOMPRESS_FIELD
+
+!_________________________________________________________________________________________________
+
+SUBROUTINE WLFIFER(KRETURNCODE, KNUMER, CDSTTC)
+! ** PURPOSE
+! Close a LFI file
+!
+! ** DUMMY ARGUMENTS
+! KRETURNCODE: error code
+! KNUMER: logical unit number associated to file
+! CDSTTC: close status ('KEEP', 'SCRATCH', 'DELETE')
+!
+! ** AUTHOR
+! 9 April 2014, S. Riette
+!
+! ** MODIFICATIONS
+! 26 sept 2014, S. Riette: use 64bits LFI subroutines
+! 8 nov 2018, S. Riette: Meso-NH version
+!
+! I. Dummy arguments declaration
+use iso_fortran_env, only: INT64
+IMPLICIT NONE
+INTEGER(KIND=INT64), INTENT(OUT) :: KRETURNCODE
+INTEGER(KIND=INT64), INTENT(IN) :: KNUMER
+CHARACTER(LEN=7), INTENT(IN) :: CDSTTC
+!
+! II. Local variables declaration
+INTEGER(KIND=LFI_INT) :: IRETURNCODE
+INTEGER(KIND=LFI_INT) :: INUMER
+!
+! III. LFIFER call
+INUMER=INT(KNUMER, KIND(INUMER))
+CALL LFIFER(IRETURNCODE, INUMER, CDSTTC)
+IF(IRETURNCODE/=0)THEN
+ CALL LFIENG(INUMER, INT(0, LFI_INT), IRETURNCODE, .FALSE., '', 'LFIFER', '')
+ENDIF
+KRETURNCODE=INT(IRETURNCODE,8)
+!
+END SUBROUTINE WLFIFER
+
+!_________________________________________________________________________________________________
+
+SUBROUTINE WLFIECR(KRETURNCODE, KNUMER, CDNOMA, KSIZE, KTAB)
+! ** PURPOSE
+! Wrapper to LFIECR
+!
+! ** DUMMY ARGUMENTS
+! KRETURNCODE: error code
+! KNUMER: logical unit number associated to file
+! CDNOMA: name of field to write
+! KSIZE: Size of KTAB
+! KTAB: integer array to write
+!
+! ** AUTHOR
+! 9 April 2014, S. Riette
+!
+! ** MODIFICATIONS
+! 26 sept 2014, S. Riette: use 64bits LFI subroutines
+! 8 nov 2018, S. Riette: Meso-NH version
+!
+! I. Dummy arguments declaration
+use iso_fortran_env, only: INT64
+IMPLICIT NONE
+INTEGER(KIND=INT64), INTENT(OUT) :: KRETURNCODE
+INTEGER(KIND=INT64), INTENT(IN) :: KNUMER
+CHARACTER(LEN=16), INTENT(IN) :: CDNOMA
+INTEGER(KIND=INT64), INTENT(IN) :: KSIZE
+INTEGER(KIND=INT64), INTENT(IN), DIMENSION(KSIZE) :: KTAB
+!
+! II. Local variables declaration
+INTEGER(KIND=LFI_INT) :: IRETURNCODE
+INTEGER(KIND=LFI_INT) :: INUMER
+INTEGER(KIND=LFI_INT) :: ISIZE
+!
+! III. LFIECR call
+INUMER=INT(KNUMER, KIND(INUMER))
+ISIZE=INT(KSIZE, KIND(ISIZE))
+CALL LFIECR(IRETURNCODE, INUMER, CDNOMA, KTAB, ISIZE)
+IF(IRETURNCODE/=0)THEN
+ CALL LFIENG(INUMER, INT(0, LFI_INT), IRETURNCODE, .FALSE., '', 'LFIECR', '')
+ENDIF
+KRETURNCODE=INT(IRETURNCODE,8)
+!
+END SUBROUTINE WLFIECR
+
+!_________________________________________________________________________________________________
diff --git a/src/MNH/BASIC.f90 b/src/MNH/BASIC.f90
old mode 100644
new mode 100755
index 854c2bc061371c9013b47bae9cbb93f6b8f0d6b0..0160a3c40994be611effb8b9506eabb2fa0f9bf0
--- a/src/MNH/BASIC.f90
+++ b/src/MNH/BASIC.f90
@@ -1,3 +1,5 @@
+! Modifications:
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!
!========================================================================
!
@@ -35369,7 +35371,7 @@ CONTAINS
!!
!! EXTERNAL
!! --------
-!! none
+use mode_msg
!!
!! IMPLICIT ARGUMENTS
!! ------------------
@@ -35380,7 +35382,7 @@ CONTAINS
IMPLICIT NONE
! check if output array is large enough
IF (KINDEXDIM.LT.942) THEN
- STOP 'CH_NONZEROTERMS ERROR: array KINDEX is too small!'
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_NONZEROTERMS_AQ', 'array KINDEX is too small' )
END IF
KINDEX(1, 1)=3
KINDEX(2, 1)=1
@@ -37305,7 +37307,7 @@ END SUBROUTINE CH_NONZEROTERMS_AQ
!!
!! EXTERNAL
!! --------
-!! none
+use mode_msg
!!
!! IMPLICIT ARGUMENTS
!! ------------------
@@ -37316,7 +37318,7 @@ END SUBROUTINE CH_NONZEROTERMS_AQ
IMPLICIT NONE
! check if output array is large enough
IF (KINDEXDIM.LT.606) THEN
- STOP 'CH_NONZEROTERMS ERROR: array KINDEX is too small!'
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_NONZEROTERMS_GAZ', 'array KINDEX is too small' )
END IF
KINDEX(1, 1)=3
KINDEX(2, 1)=1
@@ -38643,7 +38645,7 @@ CONTAINS
!!
!! EXTERNAL
!! --------
-!! none
+use mode_msg
!!
!! IMPLICIT ARGUMENTS
!! ------------------
@@ -38662,7 +38664,7 @@ IMPLICIT NONE
!! ---------------------
! check if output array is large enough
IF (KSPARSEDIM.LT.745) THEN
- STOP 'CH_SPARSE ERROR: array KSPARSE is too small!'
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_SPARSE_AQ', 'array KSPARSE is too small' )
END IF
!O3/O3
KSPARSE(1, 1)=1
@@ -40935,7 +40937,7 @@ END SUBROUTINE CH_SPARSE_AQ
!!
!! EXTERNAL
!! --------
-!! none
+use mode_msg
!!
!! IMPLICIT ARGUMENTS
!! ------------------
@@ -40954,7 +40956,7 @@ IMPLICIT NONE
!! ---------------------
! check if output array is large enough
IF (KSPARSEDIM.LT.449) THEN
- STOP 'CH_SPARSE ERROR: array KSPARSE is too small!'
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_SPARSE_GAZ', 'array KSPARSE is too small' )
END IF
!O3/O3
KSPARSE(1, 1)=1
diff --git a/src/MNH/adjust_langlois.f90 b/src/MNH/adjust_langlois.f90
index 57f958bdff4c9b4d77107c4f09de5b9b486fa6c4..ed6df1d2ac06b4b3574e5b8c5b2673e8f3bcac0f 100644
--- a/src/MNH/adjust_langlois.f90
+++ b/src/MNH/adjust_langlois.f90
@@ -118,7 +118,6 @@ USE MODD_BUDGET
!
USE MODI_CONDENSATION
USE MODI_BUDGET
-USE MODE_FMWRIT
!
IMPLICIT NONE
!
diff --git a/src/MNH/adv_forcingn.f90 b/src/MNH/adv_forcingn.f90
index a4a4038b69145f130c04bb146b91eaab7b9809ac..5a824682580112b59bb000187ea54dcb2bc9d01d 100644
--- a/src/MNH/adv_forcingn.f90
+++ b/src/MNH/adv_forcingn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2010-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 MODI_ADV_FORCING_n
@@ -100,21 +100,17 @@ END MODULE MODI_ADV_FORCING_n
!* 0. DECLARATIONS
! ------------
!
-USE MODE_DATETIME
-USE MODE_FM
-USE MODE_IO_ll
-!
+USE MODD_ADVFRC_n ! Modules for time evolving advfrc
+USE MODD_BUDGET
USE MODD_DYN
USE MODD_LUNIT, ONLY: TLUOUT0
USE MODD_PARAMETERS
USE MODD_TIME
-USE MODD_BUDGET
!
-USE MODI_BUDGET
+USE MODE_DATETIME
!
-USE MODD_ADVFRC_n ! Modules for time evolving advfrc
+USE MODI_BUDGET
USE MODI_SHUMAN
-!USE MODD_FRC
!
IMPLICIT NONE
!
diff --git a/src/MNH/advec_4th_order_aux.f90 b/src/MNH/advec_4th_order_aux.f90
index 31f2eec8393a2d97d3aed211e2d96ea186df5624..47579b54c905adf48cfb76555992c13f4b2c9304 100644
--- a/src/MNH/advec_4th_order_aux.f90
+++ b/src/MNH/advec_4th_order_aux.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2005-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.
!-----------------------------------------------------------------
! ###############################
@@ -108,11 +108,9 @@ END MODULE MODI_ADVEC_4TH_ORDER_AUX
!* 0. DECLARATIONS
! ------------
!
-USE MODE_ll
-!
+USE MODD_ARGSLIST_ll, ONLY: HALO2LIST_ll
USE MODD_CONF
-USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
-USE MODE_IO_ll
+!
#ifdef _OPENACC
USE MODE_DEVICE
#endif
diff --git a/src/MNH/advec_weno_k_3_aux.f90 b/src/MNH/advec_weno_k_3_aux.f90
index c290158db699a34607e0c2fbec424c30fc555bde..180b3fc3164a9ec1248884f35b75b12cbdc7baa8 100644
--- a/src/MNH/advec_weno_k_3_aux.f90
+++ b/src/MNH/advec_weno_k_3_aux.f90
@@ -1,7 +1,11 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+!-----------------------------------------------------------------
! ##############################
MODULE MODI_ADVEC_WENO_K_3_AUX
! ##############################
@@ -287,9 +291,11 @@ END MODULE MODI_ADVEC_WENO_K_3_AUX
!!
!-------------------------------------------------------------------------------
!
-USE MODE_ll
-USE MODD_LUNIT
USE MODD_CONF
+USE MODD_LUNIT
+!
+USE MODE_ll
+use mode_msg
!
IMPLICIT NONE
!
@@ -516,9 +522,7 @@ ZFNEG3(IW,:,:) = 1./6 * (-1.0*PSRC(IW-1,:,:) + 5.0*PSRC(IW,:,:) + 2.0*PSRC(I
ZOMN3(IW-1:IW,:,:) = 3./10. / (ZEPS + ZBNEG3(IW-1:IW,:,:))**2 ! Non-normalized weight IW,IW-1
!
ELSE ! East boundary is proc border, with NHALO < 3 on west side
- PRINT *,'ERROR : WENO5/CYCL fluxes calculation needs JPHEXT (&NHALO) >= 3 on west side'
- CALL ABORT
- STOP ' Error in advec_weno_k_3_aux.f90 '
+ call Print_msg(NVERB_FATAL,'GEN','ADVEC_WENO_K_3_UX','WENO5/CYCL fluxes calculation needs JPHEXT (&NHALO) >= 3 on west side')
ENDIF
!
! Third positive stencil, needs indices i, i+1, i+2
@@ -601,9 +605,7 @@ ELSE
!-----------------------------------------------------------------------------
!
IF (NHALO<3) THEN
- PRINT *,'ERROR : WENO5/west-int not parallelisable with NHALO < 3'
- CALL ABORT
- STOP ' Error in advec_weno_k_3_aux.f90 '
+ call Print_msg(NVERB_FATAL,'GEN','ADVEC_WENO_K_3_UX','WENO5/west-int not parallelisable with NHALO < 3')
ELSEIF (NHALO>=3) THEN
!---------------------------------------------------------------------------
! NHALO >3 => WENO5 for all boundary points
@@ -758,9 +760,7 @@ IF( LEAST_ll() ) THEN
ZOMN2(IE-1:IE,:,:) = 3./5. / (ZEPS + ZBNEG2(IE-1:IE,:,:))**2 ! Non-normalized weight IE-1,IE
!
ELSE ! West boundary is proc border, with NHALO < 3 on east side
- PRINT *,'ERROR : WENO5/CYCL fluxes calculation needs JPHEXT (&NHALO) >= 3 on east side'
- CALL ABORT
- STOP ' Error in advec_weno_k_3_aux.f90 '
+ call Print_msg(NVERB_FATAL,'GEN','ADVEC_WENO_K_3_UX','WENO5/CYCL fluxes calculation needs JPHEXT (&NHALO) >= 3 on east side')
ENDIF
!
! First positive stencil, needs indices i-2, i-1, i
@@ -843,9 +843,7 @@ ELSE
!-----------------------------------------------------------------------------
!
IF (NHALO<3) THEN
- PRINT *,'ERROR : WENO5/east-int not parallelisable with NHALO < 3'
- CALL ABORT
- STOP ' Error in advec_weno_k_3_aux.f90 '
+ call Print_msg(NVERB_FATAL,'GEN','ADVEC_WENO_K_3_UX','WENO5/east-int not parallelisable with NHALO < 3')
ELSEIF (NHALO>=3) THEN
!---------------------------------------------------------------------------
! NHALO >= 3 => WENO5 for all boundary points
@@ -961,9 +959,11 @@ END SUBROUTINE ADVEC_WENO_K_3_UX
!!
!------------------------------------------------------------------------------
!
-USE MODE_ll
-USE MODD_LUNIT
USE MODD_CONF
+USE MODD_LUNIT
+!
+USE MODE_ll
+use mode_msg
!
IMPLICIT NONE
!
@@ -1191,9 +1191,7 @@ IF( LWEST_ll() ) THEN
ZOMN3(IW:IW+1,:,:) = 3./10. / (ZEPS + ZBNEG3(IW:IW+1,:,:))**2 ! Non-normalized weight IW+1,IW
!
ELSE ! East boundary is proc border, with NHALO < 3 on west side
- PRINT *,'ERROR : WENO5/CYCL fluxes calculation needs JPHEXT (&NHALO) >= 3 on west side'
- CALL ABORT
- STOP ' Error in advec_weno_k_3_aux.f90 '
+ call Print_msg(NVERB_FATAL,'GEN','ADVEC_WENO_K_3_MX','WENO5/CYCL fluxes calculation needs JPHEXT (&NHALO) >= 3 on west side')
ENDIF
!
! Third positive stencil, needs indices i-1, i, i+1
@@ -1276,9 +1274,7 @@ ELSE
!-----------------------------------------------------------------------------
!
IF (NHALO<3) THEN
- PRINT *,'ERROR : WENO5/west-int not parallelisable with NHALO < 3'
- CALL ABORT
- STOP ' Error in advec_weno_k_3_aux.f90 '
+ call Print_msg(NVERB_FATAL,'GEN','ADVEC_WENO_K_3_MX','WENO5/west-int not parallelisable with NHALO < 3')
ELSEIF (NHALO>=3) THEN
!---------------------------------------------------------------------------
! NHALO >3 => WENO5 for all boundary points
@@ -1432,9 +1428,7 @@ IF(LEAST_ll() ) THEN
ZOMN2(IE:IE+1,:,:) = 3./5. / (ZEPS + ZBNEG2(IE:IE+1,:,:))**2 ! Non-normalized weight IE,IE+1
!
ELSE ! West boundary is proc border, with NHALO < 3 on east side
- PRINT *,'ERROR : WENO5/CYCL fluxes calculation needs JPHEXT (&NHALO) >= 3 on east side'
- CALL ABORT
- STOP ' Error in advec_weno_k_3_aux.f90 '
+ call Print_msg(NVERB_FATAL,'GEN','ADVEC_WENO_K_3_MX','WENO5/CYCL fluxes calculation needs JPHEXT (&NHALO) >= 3 on east side')
ENDIF
!
! First positive stencil, needs indices i-3, i-2, i-1
@@ -1516,9 +1510,7 @@ ELSE
!-----------------------------------------------------------------------------
!
IF (NHALO<3) THEN
- PRINT *,'ERROR : WENO5/east-int not parallelisable with NHALO < 3'
- CALL ABORT
- STOP ' Error in advec_weno_k_3_aux.f90 '
+ call Print_msg(NVERB_FATAL,'GEN','ADVEC_WENO_K_3_MX','WENO5/east-int not parallelisable with NHALO < 3')
ELSEIF (NHALO>=3) THEN
!---------------------------------------------------------------------------
! NHALO >= 3 => WENO5 for all boundary points
@@ -1635,9 +1627,11 @@ END SUBROUTINE ADVEC_WENO_K_3_MX
!!
!-------------------------------------------------------------------------------
!
-USE MODE_ll
-USE MODD_LUNIT
USE MODD_CONF
+USE MODD_LUNIT
+!
+USE MODE_ll
+use mode_msg
!
IMPLICIT NONE
!
@@ -1867,9 +1861,7 @@ IF(LSOUTH_ll()) THEN
ZOMN3(:,IS:IS+1,:) = 3./10. / (ZEPS + ZBNEG3(:,IS:IS+1,:))**2 ! Non-normalized weight IS+1,IS
!
ELSE ! North boundary is proc border, with NHALO < 3 on south side
- PRINT *,'ERROR : WENO5/CYCL fluxes calculation needs JPHEXT (&NHALO) >= 3 on south side'
- CALL ABORT
- STOP ' Error in advec_weno_k_3_aux.f90 '
+ call Print_msg(NVERB_FATAL,'GEN','ADVEC_WENO_K_3_MY','WENO5/CYCL fluxes calculation needs JPHEXT (&NHALO) >= 3 on south side')
ENDIF
!
! Third positive stencil, needs indices i-1, i, i+1
@@ -1953,9 +1945,7 @@ ELSE
!-----------------------------------------------------------------------------
!
IF (NHALO<3) THEN
- PRINT *,'ERROR : WENO5/south-int not parallelisable with NHALO < 3'
- CALL ABORT
- STOP ' Error in advec_weno_k_3_aux.f90 '
+ call Print_msg(NVERB_FATAL,'GEN','ADVEC_WENO_K_3_MY','WENO5/south-int not parallelisable with NHALO < 3')
ELSEIF (NHALO>=3) THEN
!---------------------------------------------------------------------------
! NHALO >3 => WENO5 for all boundary points
@@ -2109,9 +2099,7 @@ IF( LNORTH_ll() ) THEN
ZOMN2(:,IN:IN+1,:) = 3./5. / (ZEPS + ZBNEG2(:,IN:IN+1,:))**2 ! Non-normalized weight IN,IN+1
!
ELSE ! South boundary is proc border, with NHALO < 3 on south side
- PRINT *,'ERROR : WENO5/CYCL fluxes calculation needs JPHEXT (&NHALO) >= 3 on south side'
- CALL ABORT
- STOP ' Error in advec_weno_k_3_aux.f90 '
+ call Print_msg(NVERB_FATAL,'GEN','ADVEC_WENO_K_3_MY','WENO5/CYCL fluxes calculation needs JPHEXT (&NHALO) >= 3 on south side')
ENDIF
!
! First positive stencil, needs indices i-3, i-2, i-1
@@ -2193,9 +2181,7 @@ ELSE
!-----------------------------------------------------------------------------
!
IF (NHALO<3) THEN
- PRINT *,'ERROR : WENO5/north-int not parallelisable with NHALO < 3'
- CALL ABORT
- STOP ' Error in advec_weno_k_3_aux.f90 '
+ call Print_msg(NVERB_FATAL,'GEN','ADVEC_WENO_K_3_MY','WENO5/north-int not parallelisable with NHALO < 3')
ELSEIF (NHALO>=3) THEN
!---------------------------------------------------------------------------
! NHALO >= 3 => WENO5 for all boundary points
@@ -2311,9 +2297,11 @@ END SUBROUTINE ADVEC_WENO_K_3_MY
!!
!-------------------------------------------------------------------------------
!
-USE MODE_ll
-USE MODD_LUNIT
USE MODD_CONF
+USE MODD_LUNIT
+!
+USE MODE_ll
+use mode_msg
!
IMPLICIT NONE
!
@@ -2544,9 +2532,7 @@ IF(LSOUTH_ll() ) THEN
ZOMN3(:,IS-1:IS,:) = 3./10. / (ZEPS + ZBNEG3(:,IS-1:IS,:))**2 ! Non-normalized weight IS,IS-1
!
ELSE ! North boundary is proc border, with NHALO < 3 on south side
- PRINT *,'ERROR : WENO5/CYCL fluxes calculation needs JPHEXT (&NHALO) >= 3 on south side'
- CALL ABORT
- STOP ' Error in advec_weno_k_3_aux.f90 '
+ call Print_msg(NVERB_FATAL,'GEN','ADVEC_WENO_K_3_VY','WENO5/CYCL fluxes calculation needs JPHEXT (&NHALO) >= 3 on south side')
ENDIF
!
! Third positive stencil, needs indices i, i+1, i+2
@@ -2631,9 +2617,7 @@ ELSE
!-----------------------------------------------------------------------------
!
IF (NHALO<3) THEN
- PRINT *,'ERROR : WENO5/south-int not parallelisable with NHALO < 3'
- CALL ABORT
- STOP ' Error in advec_weno_k_3_aux.f90 '
+ call Print_msg(NVERB_FATAL,'GEN','ADVEC_WENO_K_3_VY','WENO5/south-int not parallelisable with NHALO < 3')
ELSEIF (NHALO>=3) THEN
!---------------------------------------------------------------------------
! NHALO >3 => WENO5 for all boundary points
@@ -2787,9 +2771,7 @@ IF(LNORTH_ll()) THEN
ZOMN2(:,IN-1:IN,:) = 3./5. / (ZEPS + ZBNEG2(:,IN-1:IN,:))**2 ! Non-normalized weight IN-1,IN
!
ELSE ! South boundary is proc border, with NHALO < 3 on north side
- PRINT *,'ERROR : WENO5/CYCL fluxes calculation needs JPHEXT (&NHALO) >= 3 on north side'
- CALL ABORT
- STOP ' Error in advec_weno_k_3_aux.f90 '
+ call Print_msg(NVERB_FATAL,'GEN','ADVEC_WENO_K_3_VY','WENO5/CYCL fluxes calculation needs JPHEXT (&NHALO) >= 3 on north side')
ENDIF
!
! First positive stencil, needs indices i-2, i-1, i
@@ -2872,9 +2854,7 @@ ELSE
!-----------------------------------------------------------------------------
!
IF (NHALO<3) THEN
- PRINT *,'ERROR : WENO5/north-int not parallelisable with NHALO < 3'
- CALL ABORT
- STOP ' Error in advec_weno_k_3_aux.f90 '
+ call Print_msg(NVERB_FATAL,'GEN','ADVEC_WENO_K_3_VY','WENO5/north-int not parallelisable with NHALO < 3')
ELSEIF (NHALO>=3) THEN
!---------------------------------------------------------------------------
! NHALO >= 3 => WENO5 for all boundary points
diff --git a/src/MNH/advection.f90 b/src/MNH/advection.f90
deleted file mode 100644
index 363bd919cf0e3357588eecae9c4120610ff8b6e8..0000000000000000000000000000000000000000
--- a/src/MNH/advection.f90
+++ /dev/null
@@ -1,181 +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 MODI_ADVECTION
-! #####################
-!
-INTERFACE
- SUBROUTINE ADVECTION (HUVW_ADV_SCHEME,HMET_ADV_SCHEME,HSV_ADV_SCHEME, &
- KLITER, HLBCX, HLBCY,KRR, KSV, KTCOUNT, &
- PTSTEP_MET, PTSTEP_SV, &
- PUM, PVM, PWM, PTHM, PRM, PTKEM, PSVM, &
- PUT, PVT, PWT, PTHT, PRT, PTKET, PSVT, &
- PRHODJ, PDXX, PDYY, PDZZ, PDZX, PDZY, &
- PRUS,PRVS, PRWS, PRTHS, PRRS, PRTKES, PRSVS )
-!
-!
-CHARACTER(LEN=6), INTENT(IN) :: HMET_ADV_SCHEME, & ! Control of the
- HSV_ADV_SCHEME, & ! scheme applied
- HUVW_ADV_SCHEME ! to the selected
- ! variables
-!
-INTEGER, INTENT(IN) :: KLITER ! Iteration number for
- ! the MPDATA scheme
-!
-CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
-!
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
-INTEGER, INTENT(IN) :: KTCOUNT ! iteration count
-REAL, INTENT(IN) :: PTSTEP_MET ! Effective time step for
- ! meteorological scalar variables
- ! (depending on advection scheme)
-REAL, INTENT(IN) :: PTSTEP_SV ! Effective time step for
- ! tracer scalar variables
- ! (depending on advection scheme)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM, PTKEM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM , PSVM
- ! Variables at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM, PVM, PWM
- ! Variables at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT , PVT , PWT, PRHODJ
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT , PSVT
- ! Variables at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
- ! metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS , PRVS , PRWS
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS, PRTKES
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS , PRSVS
- ! Sources terms
-!
-!
-END SUBROUTINE ADVECTION
-!
-END INTERFACE
-!
-END MODULE MODI_ADVECTION
-! ##########################################################################
- SUBROUTINE ADVECTION (HUVW_ADV_SCHEME,HMET_ADV_SCHEME,HSV_ADV_SCHEME, &
- KLITER, HLBCX, HLBCY,KRR, KSV, KTCOUNT, &
- PTSTEP_MET, PTSTEP_SV, &
- PUM, PVM, PWM, PTHM, PRM, PTKEM, PSVM, &
- PUT, PVT, PWT, PTHT, PRT, PTKET, PSVT, &
- PRHODJ, PDXX, PDYY, PDZZ, PDZX, PDZY, &
- PRUS,PRVS, PRWS, PRTHS, PRRS, PRTKES, PRSVS )
-! ##########################################################################
-!
-!!**** *ADVECTION * - routine to call the specialized advection routines
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to control the advection routines.
-!! For that, it is first necessary to compute the metric coefficients
-!! and the contravariant components of the momentum.
-!!
-!!** METHOD
-!! ------
-!! The advection of momenta is calculated using a centred (second order)
-!! scheme. Three schemes can be used to calculated the advection of a
-!! scalar: centred (2nd) (ADVECSCALAR), Flux-Corrected Transport Scalar
-!! (FCT_SCALAR) and a Multidimensional Positive Definite Advection Transport
-!! Algorithm (MPDATA).
-!! Once the scheme is selected, it is applied to the following group of
-!! variables: METeorologicals (temperature, water substances, TKE,
-!! dissipation TKE) and Scalar Variables. It is possible to select different
-!! advection schemes for each group of variables.
-!!
-!! EXTERNAL
-!! --------
-!! Functions MXM,MYM,MZM : computes the averages along the 3 directions
-!! CONTRAV : computes the contravariant components.
-!! ADVECUVW : computes the advection terms for momentum.
-!! ADVECSCALAR : computes the advection terms for scalar fields.
-!! ADD3DFIELD_ll : add a field to 3D-list
-!! ADVEC_4TH_ORDER : 4th order advection scheme
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! NONE
-!!
-!! REFERENCE
-!! ---------
-!! Book1 and book2 ( routine ADVECTION )
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! J.-P. Lafore * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 06/07/94
-!! 01/04/95 (Ph. Hereil J. Nicolau) add the model number
-!! 23/10/95 (J. Vila and JP Lafore) advection schemes scalar
-!! 16/01/97 (JP Pinty) change presentation
-!! 30/04/98 (J. Stein P Jabouille) extrapolation for the cyclic
-!! case and parallelisation
-!! 24/06/99 (P Jabouille) case of NHALO>1
-!! 25/10/05 (JP Pinty) 4th order scheme
-!! 24/04/06 (C.Lac) Split scalar and passive
-!! tracer routines
-!! 08/06 (T.Maric) PPM scheme
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-!
-!-------------------------------------------------------------------------------
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-CHARACTER(LEN=6), INTENT(IN) :: HMET_ADV_SCHEME, & ! Control of the
- HSV_ADV_SCHEME, & ! scheme applied
- HUVW_ADV_SCHEME ! to the selected
- ! variables
-!
-INTEGER, INTENT(IN) :: KLITER ! Iteration number for
- ! the MPDATA scheme
-!
-CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
-!
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
-!
-INTEGER, INTENT(IN) :: KTCOUNT ! iteration count
-REAL, INTENT(IN) :: PTSTEP_MET ! Effective time step for
- ! meteorological scalar variables
- ! (depending on advection scheme)
-REAL, INTENT(IN) :: PTSTEP_SV ! Effective time step for
- ! tracer scalar variables
- ! (depending on advection scheme)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM, PTKEM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM , PSVM
- ! Variables at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM, PVM, PWM
- ! Variables at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT , PVT , PWT
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET, PRHODJ
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT , PSVT
- ! Variables at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
- ! metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS , PRVS, PRWS
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS, PRTKES
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS , PRSVS
- ! Sources terms
-!
-!
-! ROUTINE TO REMOVE
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE ADVECTION
diff --git a/src/MNH/advection_metsv.f90 b/src/MNH/advection_metsv.f90
index 48652670a498fd7faf429588d393cc22a038107a..e178f2fffeb22f12126b5e18ab0a503bf56cf5c0 100644
--- a/src/MNH/advection_metsv.f90
+++ b/src/MNH/advection_metsv.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ###########################
@@ -17,7 +17,7 @@ INTERFACE
PRTHS, PRRS, PRTKES, PRSVS, &
PRTHS_CLD, PRRS_CLD, PRSVS_CLD, PRTKES_ADV )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_TYPE_DATE, ONLY: DATE_TIME
!
LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
@@ -157,19 +157,18 @@ USE MODD_VAR_ll, ONLY : MPI_PRECISION,NMNH_COMM_WORLD
#endif
USE MODD_BUDGET
USE MODD_CST
-USE MODD_CTURB, ONLY: XTKEMIN
-USE MODD_CONF, ONLY: LNEUTRAL,NHALO,L1D, L2D
-USE MODD_IO_ll, ONLY: TFILEDATA
-USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_CTURB, ONLY: XTKEMIN
+USE MODD_CONF, ONLY: LNEUTRAL,NHALO,L1D, L2D
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_PARAM_n
-USE MODD_TYPE_DATE, ONLY: DATE_TIME
+USE MODD_TYPE_DATE, ONLY: DATE_TIME
USE MODD_BLOWSNOW
USE MODD_BLOWSNOW_n
USE MODD_PARAMETERS
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
-USE MODE_FMWRIT
-USE MODE_IO_ll
+USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_ll
USE MODE_MSG
!
@@ -456,7 +455,7 @@ IF (OCLOSE_OUT .AND. OCFL_WRIT .AND. (.NOT. L1D)) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZCFLU)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZCFLU)
!
IF (.NOT. L2D) THEN
TZFIELD%CMNHNAME = 'CFLV'
@@ -469,7 +468,7 @@ IF (OCLOSE_OUT .AND. OCFL_WRIT .AND. (.NOT. L1D)) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZCFLV)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZCFLV)
END IF
!
TZFIELD%CMNHNAME = 'CFLW'
@@ -482,7 +481,7 @@ IF (OCLOSE_OUT .AND. OCFL_WRIT .AND. (.NOT. L1D)) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZCFLW)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZCFLW)
!
TZFIELD%CMNHNAME = 'CFL'
TZFIELD%CSTDNAME = ''
@@ -494,7 +493,7 @@ IF (OCLOSE_OUT .AND. OCFL_WRIT .AND. (.NOT. L1D)) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZCFL)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZCFL)
END IF
!
!* prints in the output file the maximum CFL
diff --git a/src/MNH/advecuvw_rk.f90 b/src/MNH/advecuvw_rk.f90
index 72a71e156d021e54e54915622d4df3096257d6db..547384163f0428de088a68617036ad911b1e0c97 100644
--- a/src/MNH/advecuvw_rk.f90
+++ b/src/MNH/advecuvw_rk.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #####################
@@ -127,24 +127,27 @@ END MODULE MODI_ADVECUVW_RK
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! F.Auguste and C.Lac : 08/16 : CEN4TH with RKC4
!! C.Lac 10/16 : Correction on RK loop
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+USE MODD_ARGSLIST_ll, ONLY: LIST_ll, HALO2LIST_ll
+USE MODD_CONF, ONLY: NHALO
+USE MODD_PARAMETERS, ONLY: JPVEXT
+!
USE MODE_ll
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll, HALO2LIST_ll
-USE MODD_PARAMETERS, ONLY : JPVEXT
-USE MODD_CONF, ONLY : NHALO
+USE MODE_MPPDB
+use mode_msg
!
-USE MODI_SHUMAN
-USE MODI_ADVECUVW_WENO_K
USE MODI_ADV_BOUNDARIES
+USE MODI_ADVECUVW_4TH
+USE MODI_ADVECUVW_WENO_K
USE MODI_GET_HALO
-USE MODE_MPPDB
+USE MODI_SHUMAN
!
-USE MODI_ADVECUVW_4TH
!
#ifdef _OPENACC
USE MODE_DEVICE
@@ -276,8 +279,7 @@ SELECT CASE (HTEMP_SCHEME)
CASE('RK65')
ISPL = 6
CASE DEFAULT
- PRINT *,'ERROR: UNKNOWN HTEMP_SCHEME'
- CALL ABORT()
+ call Print_msg(NVERB_FATAL,'GEN','ADVECUVW_RK','unknown HTEMP_SCHEME')
END SELECT
!
!
diff --git a/src/MNH/aer_monitorn.f90 b/src/MNH/aer_monitorn.f90
index 245e8f67283a5e9db1824466f63025377bc5678d..21f1f177fdb72649cc8f5074726840a36ea06626 100644
--- a/src/MNH/aer_monitorn.f90
+++ b/src/MNH/aer_monitorn.f90
@@ -72,7 +72,8 @@ END MODULE MODI_AER_MONITOR_n
!!
!! MODIFICATIONS
!! -------------
-!!
+!
+!! Bielli S. (02/2019) : Sea salt : significant sea wave height influences salt emission; 5 salt modes
!! EXTERNAL
!! --------
!
@@ -112,7 +113,7 @@ USE MODD_LBC_n, ONLY: CLBCX, &!X-direction LBC type at left(1)
! and right(2) boundaries
USE MODD_CLOUDPAR_n, ONLY: NSPLITR ! Nb of required small time step integration
! for rain sedimentation computation
-USE MODD_CONF, ONLY: L1D, L2D
+USE MODD_CONF, ONLY: L1D, L2D, NVERB
USE MODD_CONF_n, ONLY: LUSERC,& ! Logical to use clouds
LUSERV,& ! Logical to use wapor water
LUSERR,& ! Logical to use rain water
@@ -185,9 +186,14 @@ IKE = IKU - JPVEXT
!
!* 1.2 calculate timestep variables
!
+! ++ JORIS DEBUG ++
+IF (NVERB == 10) WRITE(*,*) 'dans aer_monitorn.f90 1.'
+! -- JORIS DEBUG --
!
- XRSVS(:,:,:,NSV_DSTBEG:NSV_DSTEND) = &
- MAX(XRSVS(:,:,:,NSV_DSTBEG:NSV_DSTEND), 0.)
+! ++ PIERRE / MARINE SSA DUST - MODIF ++
+! XRSVS(:,:,:,NSV_DSTBEG:NSV_DSTEND) = &
+! MAX(XRSVS(:,:,:,NSV_DSTBEG:NSV_DSTEND), 0.)
+! -- PIERRE / MARINE SSA DUST - MODIF --
!
!* 2. Sedimentation of aerosols
! ------------------------
@@ -198,8 +204,11 @@ IF (LDUST.AND.LSEDIMDUST) THEN
DO JSV = NSV_DSTBEG, NSV_DSTEND
ZSVT(:,:,:,JSV-NSV_DSTBEG+1) = XRSVS(:,:,:,JSV) * PTSTEP / XRHODJ(:,:,:)
ENDDO
- CALL DUST_FILTER(ZSVT(IIB:IIE,IJB:IJE,IKB:IKE,:),&
- XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE))
+! ++ PIERRE / MARINE SSA DUST - MODIF ++
+ CALL DUST_FILTER(ZSVT,XRHODREF)
+! CALL DUST_FILTER(ZSVT(IIB:IIE,IJB:IJE,IKB:IKE,:),&
+! XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE))
+! -- PIERRE / MARINE SSA DUST - MODIF --
CALL SEDIM_DUST(XTHT(IIB:IIE,IJB:IJE,IKB:IKE), PTSTEP,&
XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), &
XPABST(IIB:IIE,IJB:IJE,IKB:IKE), &
@@ -222,14 +231,17 @@ IF ((LSALT).AND.(LSEDIMSALT)) THEN
ZSVT(:,:,:,JSV-NSV_SLTBEG+1) = XRSVS(:,:,:,JSV) * PTSTEP / XRHODJ(:,:,:)
ENDDO
+! ++ JORIS DEBUG ++
CALL SALT_FILTER(ZSVT(IIB:IIE,IJB:IJE,IKB:IKE,:),&
- XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE))
+ XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE))
+!
CALL SEDIM_SALT(XTHT(IIB:IIE,IJB:IJE,IKB:IKE),PTSTEP,&
XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), &
XPABST(IIB:IIE,IJB:IJE,IKB:IKE), &
XZZ(IIB:IIE,IJB:IJE,IKB:IKE+1), &
ZSVT(IIB:IIE,IJB:IJE,IKB:IKE,:)) !ppp (concentration)
-!
+! -- JORIS DEBUG --
+
DO JSV = NSV_SLTBEG, NSV_SLTEND
XRSVS(IIB:IIE,IJB:IJE,IKB:IKE,JSV) = &
ZSVT(IIB:IIE,IJB:IJE,IKB:IKE,JSV-NSV_SLTBEG+1) *&
@@ -365,7 +377,26 @@ SELECT CASE (CCLOUD)
ZVMASSMIN(IIB:IIE,IJB:IJE,IKB:IKE,:),&
PCCT=ZSVT(IIB:IIE,IJB:IJE,IKB:IKE,NSV_C2R2BEG+1),&
PCRT=ZSVT(IIB:IIE,IJB:IJE,IKB:IKE,NSV_C2R2BEG+2) )
-
+!++th++ 05/05/17 ajout LIMA
+CASE ('LIMA')
+ CALL AER_WET_DEP_KMT_WARM (NSPLITR, PTSTEP, &
+ XZZ(IIB:IIE,IJB:IJE,IKB:IKE), &
+ XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), &
+ XRT(IIB:IIE,IJB:IJE,IKB:IKE,2), &
+ XRT(IIB:IIE,IJB:IJE,IKB:IKE,3), &
+ ZRCS(IIB:IIE,IJB:IJE,IKB:IKE), &
+ ZRRS(IIB:IIE,IJB:IJE,IKB:IKE), &
+ ZSVDST(IIB:IIE,IJB:IJE,IKB:IKE,:), &
+ XTHT(IIB:IIE,IJB:IJE,IKB:IKE), &
+ XPABST(IIB:IIE,IJB:IJE,IKB:IKE), &
+ ZRGDST(IIB:IIE,IJB:IJE,IKB:IKE,:), &
+ XEVAP3D(IIB:IIE,IJB:IJE,IKB:IKE), &
+ NMODE_DST, &
+ ZDENSITY(IIB:IIE,IJB:IJE,IKB:IKE,:), &
+ ZVMASSMIN(IIB:IIE,IJB:IJE,IKB:IKE,:),&
+ PCCT=ZSVT(IIB:IIE,IJB:IJE,IKB:IKE,NSV_LIMA_NC),&
+ PCRT=ZSVT(IIB:IIE,IJB:IJE,IKB:IKE,NSV_LIMA_NR) )
+!--th--
END SELECT
! 3.5 Compute return to moment vector
@@ -441,25 +472,25 @@ ZDENSITY(:,:,:,:) = XDENSITY_SALT
!
! 4.1 Minimum mass to transfer between dry mass or in-cloud droplets
-
+! ++ PIERRE / MARINE SSA DUST - MODIF ++
DO JN=1,NMODE_SLT
IMODEIDX = JPSALTORDER(JN)
IF (CRGUNITD=="MASS") THEN
- ZINIRADIUS(JN) = XINIRADIUS(IMODEIDX) * EXP(-3.*(LOG(XINISIG(IMODEIDX)))**2)
+ ZINIRADIUS(JN) = XINIRADIUS_SLT(IMODEIDX) * EXP(-3.*(LOG(XINISIG_SLT(IMODEIDX)))**2)
ELSE
- ZINIRADIUS(JN) = XINIRADIUS(IMODEIDX)
+ ZINIRADIUS(JN) = XINIRADIUS_SLT(IMODEIDX)
END IF
IF (LVARSIG) THEN
- ZSIGMIN = XSIGMIN
+ ZSIGMIN = XSIGMIN_SLT
ELSE
- ZSIGMIN = XINISIG(IMODEIDX)
+ ZSIGMIN = XINISIG_SLT(IMODEIDX)
ENDIF
- ZMASSMIN(JN) = XN0MIN(IMODEIDX) * (ZINIRADIUS(JN)**3)*EXP(4.5 * LOG(ZSIGMIN)**2)
+ ZMASSMIN(JN) = XN0MIN_SLT(IMODEIDX) * (ZINIRADIUS(JN)**3)*EXP(4.5 * LOG(ZSIGMIN)**2)
! volume/um3 => #/molec_{air}
ZVMASSMIN(:,:,:,JN)= ZMASSMIN(JN) * XMD * XPI * 4./3. * XDENSITY_SALT / &
- (XMOLARWEIGHT_SALT*XM3TOUM3*XRHODREF(:,:,:))
+ (XMOLARWEIGHT_SALT*XM3TOUM3_SALT*XRHODREF(:,:,:))
ENDDO
-
+! -- PIERRE / MARINE SSA DUST - MODIF --
!
! 4.2 Derive moment from aerosol moments sources
@@ -536,7 +567,25 @@ SELECT CASE (CCLOUD)
ZVMASSMIN(IIB:IIE,IJB:IJE,IKB:IKE,:),&
PCCT=ZSVT(IIB:IIE,IJB:IJE,IKB:IKE,NSV_C2R2BEG+1),&
PCRT=ZSVT(IIB:IIE,IJB:IJE,IKB:IKE,NSV_C2R2BEG+2) )
-
+!++th++05/05/17 ajout LIMA
+ CALL AER_WET_DEP_KMT_WARM (NSPLITR, PTSTEP, &
+ XZZ(IIB:IIE,IJB:IJE,IKB:IKE), &
+ XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), &
+ XRT(IIB:IIE,IJB:IJE,IKB:IKE,2), &
+ XRT(IIB:IIE,IJB:IJE,IKB:IKE,3), &
+ ZRCS(IIB:IIE,IJB:IJE,IKB:IKE), &
+ ZRRS(IIB:IIE,IJB:IJE,IKB:IKE), &
+ ZSVSLT(IIB:IIE,IJB:IJE,IKB:IKE,:), &
+ XTHT(IIB:IIE,IJB:IJE,IKB:IKE), &
+ XPABST(IIB:IIE,IJB:IJE,IKB:IKE), &
+ ZRGSLT(IIB:IIE,IJB:IJE,IKB:IKE,:), &
+ XEVAP3D(IIB:IIE,IJB:IJE,IKB:IKE), &
+ NMODE_SLT, &
+ ZDENSITY(IIB:IIE,IJB:IJE,IKB:IKE,:), &
+ ZVMASSMIN(IIB:IIE,IJB:IJE,IKB:IKE,:),&
+ PCCT=ZSVT(IIB:IIE,IJB:IJE,IKB:IKE,NSV_LIMA_NC),&
+ PCRT=ZSVT(IIB:IIE,IJB:IJE,IKB:IKE,NSV_LIMA_NR) )
+!--th--
END SELECT
! 4.5 Compute return to moment vector
diff --git a/src/MNH/aeroopt_get.f90 b/src/MNH/aeroopt_get.f90
index c58b83a01cf31d2828f9cf3190bea346100b6bd1..485e87b687a9f0bbaf59085bedd73a4dd3d3a4aa 100644
--- a/src/MNH/aeroopt_get.f90
+++ b/src/MNH/aeroopt_get.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
! ###################
MODULE MODI_AEROOPT_GET
@@ -68,7 +68,8 @@
!! ------
!! Benjamin Aouizerats (CNRM/GMEI)
!!
-!!
+! Modifications:
+! P. Wautelet 22/02/2019: add kind parameter for CMPLX intrinsics (if not it default to single precision)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -160,48 +161,48 @@
DO JMDE=1,NMODE_AER
- Ri(1,1)=CMPLX(1.80,-7.40E-1)
- Ri(1,2)=CMPLX(1.80,-7.40E-1)
- Ri(1,3)=CMPLX(1.83,-7.40E-1)
- Ri(1,4)=CMPLX(1.88,-6.90E-1)
- Ri(1,5)=CMPLX(1.97,-6.80E-1)
- Ri(1,6)=CMPLX(2.10,-7.20E-1)
-
- Ri(2,1)=CMPLX(1.45,-1.00E-3)
- Ri(2,2)=CMPLX(1.45,-1.00E-3)
- Ri(2,3)=CMPLX(1.45,-1.00E-3)
- Ri(2,4)=CMPLX(1.46,-1.00E-3)
- Ri(2,5)=CMPLX(1.49,-1.00E-3)
- Ri(2,6)=CMPLX(1.42,-1.26E-2)
-
- Ri(3,1)=CMPLX(1.36,-3.60E-8)
- Ri(3,2)=CMPLX(1.34,-3.00E-9)
- Ri(3,3)=CMPLX(1.33,-1.80E-8)
- Ri(3,4)=CMPLX(1.33,-5.75E-7)
- Ri(3,5)=CMPLX(1.31,-1.28E-4)
- Ri(3,6)=CMPLX(1.42,-2.54E-1)
+ Ri(1,1)=CMPLX(1.80,-7.40E-1,kind=kind(Ri(1,1)))
+ Ri(1,2)=CMPLX(1.80,-7.40E-1,kind=kind(Ri(1,1)))
+ Ri(1,3)=CMPLX(1.83,-7.40E-1,kind=kind(Ri(1,1)))
+ Ri(1,4)=CMPLX(1.88,-6.90E-1,kind=kind(Ri(1,1)))
+ Ri(1,5)=CMPLX(1.97,-6.80E-1,kind=kind(Ri(1,1)))
+ Ri(1,6)=CMPLX(2.10,-7.20E-1,kind=kind(Ri(1,1)))
+
+ Ri(2,1)=CMPLX(1.45,-1.00E-3,kind=kind(Ri(1,1)))
+ Ri(2,2)=CMPLX(1.45,-1.00E-3,kind=kind(Ri(1,1)))
+ Ri(2,3)=CMPLX(1.45,-1.00E-3,kind=kind(Ri(1,1)))
+ Ri(2,4)=CMPLX(1.46,-1.00E-3,kind=kind(Ri(1,1)))
+ Ri(2,5)=CMPLX(1.49,-1.00E-3,kind=kind(Ri(1,1)))
+ Ri(2,6)=CMPLX(1.42,-1.26E-2,kind=kind(Ri(1,1)))
+
+ Ri(3,1)=CMPLX(1.36,-3.60E-8,kind=kind(Ri(1,1)))
+ Ri(3,2)=CMPLX(1.34,-3.00E-9,kind=kind(Ri(1,1)))
+ Ri(3,3)=CMPLX(1.33,-1.80E-8,kind=kind(Ri(1,1)))
+ Ri(3,4)=CMPLX(1.33,-5.75E-7,kind=kind(Ri(1,1)))
+ Ri(3,5)=CMPLX(1.31,-1.28E-4,kind=kind(Ri(1,1)))
+ Ri(3,6)=CMPLX(1.42,-2.54E-1,kind=kind(Ri(1,1)))
- Ri(4,1)=CMPLX(1.52,-5.00E-4)
- Ri(4,2)=CMPLX(1.52,-5.00E-4)
- Ri(4,3)=CMPLX(1.52,-5.00E-4)
- Ri(4,4)=CMPLX(1.52,-5.00E-4)
- Ri(4,5)=CMPLX(1.51,-5.00E-4)
- Ri(4,6)=CMPLX(1.35,-1.40E-2)
+ Ri(4,1)=CMPLX(1.52,-5.00E-4,kind=kind(Ri(1,1)))
+ Ri(4,2)=CMPLX(1.52,-5.00E-4,kind=kind(Ri(1,1)))
+ Ri(4,3)=CMPLX(1.52,-5.00E-4,kind=kind(Ri(1,1)))
+ Ri(4,4)=CMPLX(1.52,-5.00E-4,kind=kind(Ri(1,1)))
+ Ri(4,5)=CMPLX(1.51,-5.00E-4,kind=kind(Ri(1,1)))
+ Ri(4,6)=CMPLX(1.35,-1.40E-2,kind=kind(Ri(1,1)))
- Ri(5,1)=CMPLX(1.53,-5.00E-3)
- Ri(5,2)=CMPLX(1.53,-5.00E-3)
- Ri(5,3)=CMPLX(1.53,-6.00E-3)
- Ri(5,4)=CMPLX(1.52,-1.30E-2)
- Ri(5,5)=CMPLX(1.52,-1.30E-2)
- Ri(5,6)=CMPLX(1.45,-5.00E-1)
+ Ri(5,1)=CMPLX(1.53,-5.00E-3,kind=kind(Ri(1,1)))
+ Ri(5,2)=CMPLX(1.53,-5.00E-3,kind=kind(Ri(1,1)))
+ Ri(5,3)=CMPLX(1.53,-6.00E-3,kind=kind(Ri(1,1)))
+ Ri(5,4)=CMPLX(1.52,-1.30E-2,kind=kind(Ri(1,1)))
+ Ri(5,5)=CMPLX(1.52,-1.30E-2,kind=kind(Ri(1,1)))
+ Ri(5,6)=CMPLX(1.45,-5.00E-1,kind=kind(Ri(1,1)))
- Ri(6,1)=CMPLX(1.448,-0.00292)
- Ri(6,2)=CMPLX(1.448,-0.00292)
- Ri(6,3)=CMPLX(1.4777,-0.01897)
- Ri(6,4)=CMPLX(1.44023,-0.00116)
- Ri(6,5)=CMPLX(1.41163,-0.00106)
- Ri(6,6)=CMPLX(1.41163,-0.00106)
+ Ri(6,1)=CMPLX(1.448,-0.00292,kind=kind(Ri(1,1)))
+ Ri(6,2)=CMPLX(1.448,-0.00292,kind=kind(Ri(1,1)))
+ Ri(6,3)=CMPLX(1.4777,-0.01897,kind=kind(Ri(1,1)))
+ Ri(6,4)=CMPLX(1.44023,-0.00116,kind=kind(Ri(1,1)))
+ Ri(6,5)=CMPLX(1.41163,-0.00106,kind=kind(Ri(1,1)))
+ Ri(6,6)=CMPLX(1.41163,-0.00106,kind=kind(Ri(1,1)))
! Computation of the refractive index for the whole aerosol mode according to
! Maxwell-Garnett mixing rule
@@ -235,17 +236,18 @@
DO JWVL=1,KSWB !Number of SW wavelengths
- eps1(:,:,:)=CMPLX((Ri(1,JWVL)*VBC(:,:,:)+Ri(2,JWVL)*VOC(:,:,:)+VDDST(:,:,:)*Ri(6,JWVL))/(VBC(:,:,:)+VOC(:,:,:)))**2
- Req(:,:,:,JWVL)=sqrt(CMPLX(eps1(:,:,:)))
+ eps1(:,:,:)=CMPLX((Ri(1,JWVL)*VBC(:,:,:)+Ri(2,JWVL)*VOC(:,:,:)+VDDST(:,:,:)*Ri(6,JWVL))/(VBC(:,:,:)+VOC(:,:,:)), &
+ kind=kind(eps1(1,1,1)))**2
+ Req(:,:,:,JWVL)=sqrt(CMPLX(eps1(:,:,:),kind=kind(eps1(1,1,1))))
WHERE (VEXTR(:,:,:).NE.0. )
eps2(:,:,:)=CMPLX((VSOA(:,:,:)*Ri(2,JWVL)+VH2O(:,:,:)*Ri(3,JWVL)+VAM(:,:,:)*Ri(4,JWVL)&
+VSU(:,:,:)*Ri(4,JWVL)+VNI(:,:,:)*Ri(5,JWVL))/&
- (VSOA(:,:,:)+VH2O(:,:,:)+VAM(:,:,:)+VSU(:,:,:)+VNI(:,:,:)))**2
+ (VSOA(:,:,:)+VH2O(:,:,:)+VAM(:,:,:)+VSU(:,:,:)+VNI(:,:,:)),kind=kind(eps2(1,1,1)))**2
f1(:,:,:)=(VOC(:,:,:)+VBC(:,:,:))/(VSOA(:,:,:)+VH2O(:,:,:)+VAM(:,:,:)+VSU(:,:,:)+VNI(:,:,:)+VOC(:,:,:)+VBC(:,:,:))
eps3(:,:,:)=CMPLX(eps2(:,:,:)*(eps1(:,:,:)+2*eps2(:,:,:)+2*f1(:,:,:)*(eps1(:,:,:)-eps2(:,:,:)))/&
- (eps1(:,:,:)+2*eps2(:,:,:)-f1(:,:,:)*(eps1(:,:,:)-eps2(:,:,:))))
- Req(:,:,:,JWVL)=sqrt(CMPLX(eps3(:,:,:)))
+ (eps1(:,:,:)+2*eps2(:,:,:)-f1(:,:,:)*(eps1(:,:,:)-eps2(:,:,:))),kind=kind(eps3(1,1,1)))
+ Req(:,:,:,JWVL)=sqrt(CMPLX(eps3(:,:,:),kind=kind(eps3(1,1,1))))
ENDWHERE
ENDDO
@@ -254,8 +256,8 @@
+ZMASS(:,:,:,8,JMDE)+ZMASS(:,:,:,9,JMDE)+ZMASS(:,:,:,10,JMDE)+ZMASS(:,:,:,11,JMDE)&
+ZMASS(:,:,:,12,JMDE)+ZMASS(:,:,:,13,JMDE)+ZMASS(:,:,:,14,JMDE)+ZMASS(:,:,:,15,JMDE)&
+ZMASS(:,:,:,16,JMDE)
- PII(:,:,:,:) = aimag(CMPLX(Req(:,:,:,:)))
- PIR(:,:,:,:) = real(CMPLX(Req(:,:,:,:)))
+ PII(:,:,:,:) = aimag(CMPLX(Req(:,:,:,:),kind=kind(PII(1,1,1,1))))
+ PIR(:,:,:,:) = real( CMPLX(Req(:,:,:,:),kind=kind(PIR(1,1,1,1))))
!Get aerosol optical properties from look up tables
diff --git a/src/MNH/aerozon.f90 b/src/MNH/aerozon.f90
index 04808cb47b5e9041c1e79bced1cb28382c912a0c..41989f6b5f98b04486338f0b416b1bf47ba2c313 100644
--- a/src/MNH/aerozon.f90
+++ b/src/MNH/aerozon.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ##########################
@@ -162,8 +162,6 @@ USE MODD_GROUND_PAR
USE MODD_PARAM_RAD_n, ONLY: LFIX_DAT
!
USE MODE_ll
-USE MODE_FM
-USE MODE_FMREAD
!
USE MODI_SHUMAN
USE MODI_INI_RADCONF
diff --git a/src/MNH/aircraft_balloon_evol.f90 b/src/MNH/aircraft_balloon_evol.f90
index df46755874821a8398828a587259a1f068512053..12f4f595d6cf394d7379a31fabbf68d723013dba 100644
--- a/src/MNH/aircraft_balloon_evol.f90
+++ b/src/MNH/aircraft_balloon_evol.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-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.
!-----------------------------------------------------------------
! ##########################
@@ -175,7 +175,6 @@ USE MODE_DATETIME
USE MODE_FGAU, ONLY: GAULAG
USE MODE_FSCATTER, ONLY: QEPSW,QEPSI,BHMIE,MOMG,MG
USE MODE_GRIDPROJ
-USE MODE_IO_ll
USE MODE_ll
USE MODE_MSG
!
diff --git a/src/MNH/anel_balancen.f90 b/src/MNH/anel_balancen.f90
index 6c64978f61f5b68b741d664feafe6b4b6b4e0eb1..e5aa55cfe1125bbc0544e16010d78eb13fda0f78 100644
--- a/src/MNH/anel_balancen.f90
+++ b/src/MNH/anel_balancen.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ##########################
@@ -56,9 +56,6 @@ END MODULE MODI_ANEL_BALANCE_n
!! 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
-!! CLUOUT0 : name of output-listing
-!!
!! Module MODD_GRID_n : contains grid variables
!! XMAP,XXHAT,XYHAT,XZZ
!!
@@ -111,11 +108,9 @@ END MODULE MODI_ANEL_BALANCE_n
!
!
USE MODE_ll
-USE MODE_IO_ll
USE MODE_MODELN_HANDLER
!
USE MODD_CONF ! declarative modules
-USE MODD_LUNIT
USE MODD_PARAMETERS
USE MODD_GRID_n
USE MODD_DIM_n
diff --git a/src/MNH/bhmie.f90 b/src/MNH/bhmie.f90
index 5e1d0e340da78c6e97a3b1ad2262b172155834c4..8aeb78f034168f8f402e5f1edb9e4c9f96cd92d6 100644
--- a/src/MNH/bhmie.f90
+++ b/src/MNH/bhmie.f90
@@ -63,7 +63,8 @@ END MODULE MODI_BHMIE
!! portable. In event that portable version is
!! needed, use src/bhmie_f77.f
!! 93/06/01 (BTD): Changed AMAX1 to generic function MAX
-!! 22/01/2019 (P.Wautelet): correct kind of complex datatype
+! P. Wautelet 22/01/2019: correct kind of complex datatype
+! P. Wautelet 22/02/2019: add kind parameter for CMPLX intrinsics (if not it default to single precision)
!!***********************************************************************
!
!* 0. DECLARATIONS
@@ -151,11 +152,11 @@ ZPSI0 = COS(PSIZE_PARAM)
ZPSI1 = SIN(PSIZE_PARAM)
ZCHI0 =-SIN(PSIZE_PARAM)
ZCHI1 = COS(PSIZE_PARAM)
-ZZXI1 = CMPLX(ZPSI1,-ZCHI1)
+ZZXI1 = CMPLX(ZPSI1,-ZCHI1,kind=kind(ZZXI1))
ZONE = -1.
!
-ZZAN1 = CMPLX(0.0,0.0)
-ZZBN1 = CMPLX(0.0,0.0)
+ZZAN1 = CMPLX(0.0d0,0.0d0,kind=kind(ZZAN1))
+ZZBN1 = CMPLX(0.0d0,0.0d0,kind=kind(ZZBN1))
DO J = 1,ISTOP
ZEN = FLOAT(J)
ZFN = (2.0*ZEN+1.0)/(ZEN*(ZEN+1.0))
@@ -167,7 +168,7 @@ DO J = 1,ISTOP
!
ZPSI = (2.0*ZEN-1.0)*ZPSI1/PSIZE_PARAM-ZPSI0
ZCHI = (2.0*ZEN-1.0)*ZCHI1/PSIZE_PARAM-ZCHI0
- ZZXI = CMPLX(ZPSI,-ZCHI)
+ ZZXI = CMPLX(ZPSI,-ZCHI,kind=kind(ZZXI))
!
!*** Compute AN and BN:
!
@@ -206,7 +207,7 @@ DO J = 1,ISTOP
ZPSI1 = ZPSI
ZCHI0 = ZCHI1
ZCHI1 = ZCHI
- ZZXI1 = CMPLX(ZPSI1,-ZCHI1)
+ ZZXI1 = CMPLX(ZPSI1,-ZCHI1,kind=kind(ZZXI1))
!
!*** Compute pi_n for next value of n
! For each angle J, compute pi_n+1
diff --git a/src/MNH/bhmie_bhcoat.f90 b/src/MNH/bhmie_bhcoat.f90
index 6f315742c24959b912f69f0b1abe4b63e1cb555c..c235f2ab1bbdb94b9b7aa90b53c1f8207c08033a 100644
--- a/src/MNH/bhmie_bhcoat.f90
+++ b/src/MNH/bhmie_bhcoat.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
! ########################
MODULE MODI_BHMIE_BHCOAT
@@ -46,6 +46,7 @@ END MODULE MODI_BHMIE_BHCOAT
!!
!! History:
!! 92/11/24 (BTD) Explicit declaration of all variables
+! P. Wautelet 22/02/2019: add kind parameter for CMPLX intrinsics (if not it default to single precision)
!!***********************************************************************
!
!* 0. DECLARATIONS
@@ -114,8 +115,8 @@ ZPSI0Y = COS(PSIZE_PARAM_COAT)
ZPSI1Y = SIN(PSIZE_PARAM_COAT)
ZCHI0Y =-SIN(PSIZE_PARAM_COAT)
ZCHI1Y = COS(PSIZE_PARAM_COAT)
-ZZXI0Y = CMPLX(ZPSI0Y,-ZCHI0Y)
-ZZXI1Y = CMPLX(ZPSI1Y,-ZCHI1Y)
+ZZXI0Y = CMPLX(ZPSI0Y,-ZCHI0Y,kind=kind(ZZXI0Y))
+ZZXI1Y = CMPLX(ZPSI1Y,-ZCHI1Y,kind=kind(ZZXI1Y))
!
ZZCHI0Y2 =-SIN(ZZY2)
ZZCHI1Y2 = COS(ZZY2)
@@ -130,7 +131,7 @@ DO JJ = 1,ISTOP
ZEN = FLOAT(JJ)
ZPSIY = (2.0*ZEN-1.)*ZPSI1Y/PSIZE_PARAM_COAT - ZPSI0Y
ZCHIY = (2.0*ZEN-1.)*ZCHI1Y/PSIZE_PARAM_COAT - ZCHI0Y
- ZZXIY = CMPLX(ZPSIY,-ZCHIY)
+ ZZXIY = CMPLX(ZPSIY,-ZCHIY,kind=kind(ZZXIY))
!
ZZD1Y2 = 1.0/(ZEN/ZZY2-ZZD0Y2) - ZEN/ZZY2
!
@@ -179,7 +180,7 @@ DO JJ = 1,ISTOP
ZPSI1Y = ZPSIY
ZCHI0Y = ZCHI1Y
ZCHI1Y = ZCHIY
- ZZXI1Y = CMPLX(ZPSI1Y,-ZCHI1Y)
+ ZZXI1Y = CMPLX(ZPSI1Y,-ZCHI1Y,kind=kind(ZZXI1Y))
!
ZZCHI0X2 = ZZCHI1X2
ZZCHI1X2 = ZZCHIX2
diff --git a/src/MNH/bl89.f90 b/src/MNH/bl89.f90
index 872c21c38cf9672dc8b14d7b9291ce0349cbae94..35f99be024cf73f5215bf50851e92209463b9257 100644
--- a/src/MNH/bl89.f90
+++ b/src/MNH/bl89.f90
@@ -81,6 +81,8 @@ USE MODD_CONF, ONLY: CPROGRAM
USE MODD_CST
USE MODD_CTURB
USE MODD_PARAMETERS
+use modd_precision, only: MNHREAL
+
#ifdef MNH_BITREP
USE MODI_BITREP
#endif
@@ -355,13 +357,8 @@ DO JK=IKTB,IKTE
!* 7. final mixing length
!
DO J1D=1,IIU*IJU
-#if (MNH_REAL == 8)
- ZLWORK1=MAX(ZLMDN(J1D,JK),1.E-10)
- ZLWORK2=MAX(ZLWORK(J1D),1.E-10)
-#else
- ZLWORK1=MAX(ZLMDN(J1D,JK),1.D-10)
- ZLWORK2=MAX(ZLWORK(J1D),1.D-10)
-#endif
+ ZLWORK1=MAX(ZLMDN(J1D,JK),1.E-10_MNHREAL)
+ ZLWORK2=MAX(ZLWORK(J1D),1.E-10_MNHREAL)
ZPOTE = ZLWORK1 / ZLWORK2
ZLWORK2=1.d0 + ZPOTE**(2./3.)
ZLM(J1D,JK) = Z2SQRT2*ZLWORK1/(ZLWORK2*SQRT(ZLWORK2))
diff --git a/src/MNH/budget.f90 b/src/MNH/budget.f90
index 92f4267fc90ab31841f40638ee62d1cc79b07987..df646981dc6c0fb44a01cc69d12c459a4e692314 100644
--- a/src/MNH/budget.f90
+++ b/src/MNH/budget.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
!##################
@@ -90,8 +90,6 @@ USE MODD_CONF, ONLY : LCHECK
USE MODD_NSV, ONLY : NSV
USE MODD_LES
!
-USE MODE_FM
-USE MODE_IO_ll
USE MODE_MSG
!
USE MODI_LES_BUDGET
diff --git a/src/MNH/c2r2_adjust.f90 b/src/MNH/c2r2_adjust.f90
index 29333957d49f2de67fc0a58223f89a092fcb343d..aeaeaa05e1482dfb0ba2561f5923eb1ef034195d 100644
--- a/src/MNH/c2r2_adjust.f90
+++ b/src/MNH/c2r2_adjust.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
PTHS, PRVS, PRCS, PCNUCS, &
PCCS, PSRCS, PCLDFR, PRRS )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
@@ -152,18 +152,18 @@ END MODULE MODI_C2R2_ADJUST
USE MODD_BUDGET
USE MODD_CONF
USE MODD_CST
-USE MODD_IO_ll, ONLY: TFILEDATA
-USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODD_NSV, ONLY: NSV_C2R2BEG
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_NSV, ONLY: NSV_C2R2BEG
USE MODD_PARAMETERS
!
-USE MODI_CONDENS
-USE MODI_BUDGET
-!
USE MODE_FIELD
-USE MODE_FMWRIT
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_MSG
!
+USE MODI_CONDENS
+USE MODI_BUDGET
+!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -423,7 +423,7 @@ IF ( OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZW1)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZW1)
END IF
!
!
diff --git a/src/MNH/c3r5_adjust.f90 b/src/MNH/c3r5_adjust.f90
index 2beef3f30f94a0ac0c4821b38accaaf45a8710c2..84f3114c250296cc3318b4a973211ecd4b012e2d 100644
--- a/src/MNH/c3r5_adjust.f90
+++ b/src/MNH/c3r5_adjust.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 microph 2006/06/06 18:25:10
-!-----------------------------------------------------------------
! #######################
MODULE MODI_C3R5_ADJUST
! #######################
@@ -163,12 +158,14 @@ END MODULE MODI_C3R5_ADJUST
!! 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
!!
!-------------------------------------------------------------------------------
!
-PRINT *,'C3R5_ADJUST IS NOT YET DEVELOPPED'
-!callabortstop
-CALL ABORT
-STOP
+!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/call_rttov11.f90 b/src/MNH/call_rttov11.f90
index 3a5f6b338c917cf4a5befb2122cebb7e94ffdcab..254bc976c84de483419ce3623ca315b8bbc96a90 100644
--- a/src/MNH/call_rttov11.f90
+++ b/src/MNH/call_rttov11.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2003-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.
!-----------------------------------------------------------------
! ########################
@@ -12,7 +12,7 @@ INTERFACE
PTHT, PRT, PPABST, PZZ, PMFCONV, PCLDFR, PULVLKB, PVLVLKB, &
OUSERI, KRTTOVINFO, TPFILE )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KDLON !number of columns where the
!radiation calculations are performed
@@ -82,6 +82,7 @@ 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
!!----------------------------------------------------------------------------
!!
!!* 0. DECLARATIONS
@@ -90,23 +91,20 @@ SUBROUTINE CALL_RTTOV11(KDLON, KFLEV, PEMIS, PTSRAD, &
USE MODD_CST
USE MODD_PARAMETERS
USE MODD_GRID_n
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT_n
USE MODD_DEEP_CONVECTION_n
USE MODD_REF_n
USE MODD_RADIATIONS_n, ONLY : XSEA
!
USE MODN_CONF
-!
+!
USE MODI_DETER_ANGLE
USE MODI_PINTER
!
USE MODE_FIELD
-USE MODE_FMWRIT
-USE MODE_FMREAD
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_ll
-USE MODE_FM
-USE MODE_IO_ll
USE MODE_MSG
USE MODE_POS
!
@@ -424,8 +422,7 @@ DO JSAT=1,IJSAT ! loop over sensors
! Ensure the options and coefficients are consistent
CALL rttov_user_options_checkinput(errorstatus, opts, coef_rttov)
IF (errorstatus /= 0) THEN
- WRITE(*,*) 'error in rttov options'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'CALL_RTTOV11', 'error in rttov options' )
ENDIF
!! opts%interpolation%reg_limit_extrap = .TRUE.
@@ -579,7 +576,7 @@ DO JSAT=1,IJSAT ! loop over sensors
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .FALSE.
! PRINT *,'YRECFM='//TRIM(TZFIELD%CMNHNAME)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZBT(:,:,JCH))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZBT(:,:,JCH))
END DO
DEALLOCATE(chanprof,frequencies,emissivity,calcemis,profiles,cld_profiles)
DEALLOCATE(ZBT)
diff --git a/src/MNH/call_rttov8.f90 b/src/MNH/call_rttov8.f90
index d8ae1818b10392d41589fed07c33f9f24dc8a866..6180ec0f976c350520fcea3c780c413ffedcef51 100644
--- a/src/MNH/call_rttov8.f90
+++ b/src/MNH/call_rttov8.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2003-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.
!-----------------------------------------------------------------
! #######################
@@ -12,7 +12,7 @@ INTERFACE
PTHT, PRT, PPABST, PZZ, PMFCONV, PCLDFR, PULVLKB, PVLVLKB, &
OUSERI, KRTTOVINFO, TPFILE )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KDLON !number of columns where the
!radiation calculations are performed
@@ -90,7 +90,7 @@ SUBROUTINE CALL_RTTOV8(KDLON, KFLEV, KSTATM, PEMIS, PTSRAD, PSTATM, &
!! ------------
!!
USE MODD_CST
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_GRID_n
USE MODD_DEEP_CONVECTION_n
@@ -98,18 +98,15 @@ USE MODD_REF_n
USE MODD_RADIATIONS_n, ONLY : XSEA
!
USE MODN_CONF
-!
+!
USE MODD_RAD_TRANSF
-!
+!
USE MODI_DETER_ANGLE
USE MODI_PINTER
!
USE MODE_FIELD
-USE MODE_FMWRIT
-USE MODE_FMREAD
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_ll
-USE MODE_FM
-USE MODE_IO_ll
USE MODE_MSG
USE MODE_POS
!
@@ -1582,7 +1579,7 @@ DO JSAT=1,IJSAT ! loop over sensors
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
PRINT *,TZFIELD%CMNHNAME//TZFIELD%CCOMMENT
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZANTMP)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZANTMP)
END IF
DEALLOCATE(ZANTMP)
! -----------------------------------------------------------------------------
@@ -1641,7 +1638,7 @@ DO JSAT=1,IJSAT ! loop over sensors
PRINT *,TZFIELD%CMNHNAME//TZFIELD%CCOMMENT, &
MINVAL(ZTBTMP(:,:,JCH),ZTBTMP(:,:,JCH)/=XUNDEF), &
MAXVAL(ZTBTMP(:,:,JCH),ZTBTMP(:,:,JCH)/=XUNDEF)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZTBTMP(:,:,JCH))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZTBTMP(:,:,JCH))
IF (KRTTOVINFO(3,JSAT) == 4.AND. JCH==3 ) THEN ! AMSU-B
TZFIELD%CMNHNAME = TRIM(YBEG)//'_UTH'
TZFIELD%CSTDNAME = ''
@@ -1670,7 +1667,7 @@ DO JSAT=1,IJSAT ! loop over sensors
END IF
END DO
END DO
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZUTH)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZUTH)
DEALLOCATE(ZUTH)
END IF
END DO
@@ -1737,7 +1734,7 @@ DO JSAT=1,IJSAT ! loop over sensors
PRINT *,TZFIELD%CMNHNAME//TZFIELD%CCOMMENT, &
MINVAL(ZTEMPK(:,:,:),ZTEMPK(:,:,:)/=XUNDEF), &
MAXVAL(ZTEMPK(:,:,:),ZTEMPK(:,:,:)/=XUNDEF)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZTEMPK(:,:,:))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZTEMPK(:,:,:))
!
TZFIELD%CMNHNAME = TRIM(YBEG)//'_'//TRIM(YEND)//'JAV'
TZFIELD%CSTDNAME = ''
@@ -1754,7 +1751,7 @@ DO JSAT=1,IJSAT ! loop over sensors
PRINT *,TZFIELD%CMNHNAME//TZFIELD%CCOMMENT, &
MINVAL(ZWVAPK(:,:,:),ZWVAPK(:,:,:)/=XUNDEF), &
MAXVAL(ZWVAPK(:,:,:),ZWVAPK(:,:,:)/=XUNDEF)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWVAPK(:,:,:))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWVAPK(:,:,:))
END DO
DEALLOCATE(ZTEMPKP,ZWVAPKP,ZFIN)
ENDIF
diff --git a/src/MNH/ch_aer_eqm_init0d.f90 b/src/MNH/ch_aer_eqm_init0d.f90
index f6936c22d955afe568f97d051655a9886286303f..3f2dfddc421eb83810271bdcfd83fe858682b6f7 100644
--- a/src/MNH/ch_aer_eqm_init0d.f90
+++ b/src/MNH/ch_aer_eqm_init0d.f90
@@ -1,13 +1,8 @@
-!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!ORILAM_LIC Copyright 1994-2019 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.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 chimie 2006/05/18 13:07:25
-!-----------------------------------------------------------------
!! ########################
MODULE MODI_CH_AER_EQM_INIT0d
!! ########################
@@ -47,7 +42,7 @@ END MODULE MODI_CH_AER_EQM_INIT0d
!!
!! MODIFICATIONS
!! -------------
-!! none
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!! EXTERNAL
!! --------
@@ -59,9 +54,10 @@ USE MODD_CH_M9_n, ONLY : CNAMES
USE MODD_CH_AERO_n
USE MODD_CH_MNHC_n
-!!
+use mode_msg
+!
IMPLICIT NONE
-!!
+!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -214,9 +210,7 @@ print*, 'COMPATIBILITY ERROR: Initialization of particle number mode I < XN0IMIN
print*, ' MINIMAL NUMBER PARTICLE BY m3 is ', MINVAL(PM3D(:,1)),&
'located at ',MINLOC(PM3D(:,1))
print*, 'PLEASE CHANGE MASS OR XN0IMIN INITIALIZATION '
-!callabortstop
-CALL ABORT
-STOP
+call Print_msg( NVERB_FATAL, 'GEN', 'CH_AER_EQM_INIT0d', '' )
END IF
PM3D(:,4)= PM3D(:,5) / &
((XINIRADIUSJ**3)*EXP(4.5 * (LOG(XINISIGJ))**2))
@@ -227,9 +221,7 @@ print*, 'COMPATIBILITY ERROR: Initialization of particle number mode J < XN0JMIN
print*, ' MINIMAL NUMBER PARTICLE BY m3 is ',MINVAL(PM3D(:,4)),&
'located at ',MINLOC(PM3D(:,4))
print*, 'PLEASE CHANGE MASS OR XN0JMIN INITIALIZATION '
-!callabortstop
-CALL ABORT
-STOP
+call Print_msg( NVERB_FATAL, 'GEN', 'CH_AER_EQM_INIT0d', '' )
END IF
!* 1.3 calculate moment 6 from dispersion and mean radius
diff --git a/src/MNH/ch_aer_eqm_initn.f90 b/src/MNH/ch_aer_eqm_initn.f90
index ef4f69812ec13a06d9d50d27d85b37adf99ee756..acece90b873e701417f00e2f778e8936bca66df6 100644
--- a/src/MNH/ch_aer_eqm_initn.f90
+++ b/src/MNH/ch_aer_eqm_initn.f90
@@ -1,13 +1,8 @@
-!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!ORILAM_LIC Copyright 1994-2019 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.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$ $Date$
-!-----------------------------------------------------------------
-!-----------------------------------------------------------------
!! ########################
MODULE MODI_CH_AER_EQM_INIT_n
!! ########################
@@ -49,6 +44,7 @@ END MODULE MODI_CH_AER_EQM_INIT_n
!! MODIFICATIONS
!! -------------
!! M.Leriche 2015 : masse molaire Black carbon à 12 g/mol
+! P. Wautelet 05/03/2019: modify allocation procedure for XMI and XSOLORG
!!
!! EXTERNAL
!! --------
@@ -116,15 +112,27 @@ END DO
ZDEN2MOL = 1E-6 * XAVOGADRO / XMD
+IF ( ASSOCIATED(XMI) ) THEN
+ IF ( SIZE(XMI) == 0 ) THEN
+ DEALLOCATE( XMI )
+ XMI => NULL()
+ END IF
+END IF
IF (.NOT.(ASSOCIATED(XMI))) THEN
ALLOCATE(XMI(SIZE(PCHEM,1),SIZE(PCHEM,2),SIZE(PCHEM,3),NSP+NCARB+NSOA))
END IF
+IF ( ASSOCIATED(XSOLORG) ) THEN
+ IF ( SIZE(XSOLORG) == 0 ) THEN
+ DEALLOCATE( XSOLORG )
+ XSOLORG => NULL()
+ END IF
+END IF
IF (.NOT.(ASSOCIATED(XSOLORG))) THEN
ALLOCATE(XSOLORG(SIZE(PCHEM,1),SIZE(PCHEM,2),SIZE(PCHEM,3),10))
XSOLORG(:,:,:,:) = 0.
END IF
-
+!
! Default values of molar mass
XMI(:,:,:,:) = 250.
diff --git a/src/MNH/ch_aer_mod_init.f90 b/src/MNH/ch_aer_mod_init.f90
index 86313a9ed2daeb958e85610053bc4b0ad23c02f8..b5a2409aae881e642fc93e797a0c011284024e94 100644
--- a/src/MNH/ch_aer_mod_init.f90
+++ b/src/MNH/ch_aer_mod_init.f90
@@ -1,4 +1,4 @@
-!ORILAM_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!ORILAM_LIC Copyright 1994-2019 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.
@@ -50,11 +50,11 @@ END MODULE MODI_CH_AER_MOD_INIT
!! ------------------
USE MODD_CH_AEROSOL
USE MODD_GLO
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_UNIFACPARAM
!
-USE MODE_FM, ONLY: IO_FILE_OPEN_ll,IO_FILE_CLOSE_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST
+USE MODE_IO_FILE, ONLY: IO_File_open,IO_File_close
+USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list
USE MODE_UNIFAC
!
!
@@ -84,8 +84,8 @@ TZFILE => NULL()
! Initialize the mineral tabulation
IF (CMINERAL == 'NARES') THEN
! .. the file ares.w contains the weights of the model
- CALL IO_FILE_ADD2LIST(TZFILE,'ares1A.w','CHEMTAB','READ')
- CALL IO_FILE_OPEN_ll(TZFILE)
+ CALL IO_File_add2list(TZFILE,'ares1A.w','CHEMTAB','READ')
+ CALL IO_File_open(TZFILE)
ILU = TZFILE%NLU
READ(ILU,*) I1IA,J1JA,K1KA
DO JI=1,I1IA
@@ -100,11 +100,11 @@ IF (CMINERAL == 'NARES') THEN
DO JJ=1,J1JA+1
READ(ILU,*) (W1JKA(JJ,JK),JK=1,K1KA)
ENDDO
- CALL IO_FILE_CLOSE_ll(TZFILE)
+ CALL IO_File_close(TZFILE)
TZFILE => NULL()
!
- CALL IO_FILE_ADD2LIST(TZFILE,'ares1C.w','CHEMTAB','READ')
- CALL IO_FILE_OPEN_ll(TZFILE)
+ CALL IO_File_add2list(TZFILE,'ares1C.w','CHEMTAB','READ')
+ CALL IO_File_open(TZFILE)
ILU = TZFILE%NLU
READ(ILU,*) I1IC,J1JC,K1KC
DO JI=1,I1IC
@@ -119,11 +119,11 @@ IF (CMINERAL == 'NARES') THEN
DO JJ=1,J1JC+1
READ(ILU,*) (W1JKC(JJ,JK),JK=1,K1KC)
ENDDO
- CALL IO_FILE_CLOSE_ll(TZFILE)
+ CALL IO_File_close(TZFILE)
TZFILE => NULL()
!
- CALL IO_FILE_ADD2LIST(TZFILE,'ares2A.w','CHEMTAB','READ')
- CALL IO_FILE_OPEN_ll(TZFILE)
+ CALL IO_File_add2list(TZFILE,'ares2A.w','CHEMTAB','READ')
+ CALL IO_File_open(TZFILE)
ILU = TZFILE%NLU
READ(ILU,*) I2IA,J2JA,K2KA
DO JI=1,I2IA
@@ -138,11 +138,11 @@ IF (CMINERAL == 'NARES') THEN
DO JJ=1,J2JA+1
READ(ILU,*) (W2JKA(JJ,JK),JK=1,K2KA)
ENDDO
- CALL IO_FILE_CLOSE_ll(TZFILE)
+ CALL IO_File_close(TZFILE)
TZFILE => NULL()
!
- CALL IO_FILE_ADD2LIST(TZFILE,'ares2B.w','CHEMTAB','READ')
- CALL IO_FILE_OPEN_ll(TZFILE)
+ CALL IO_File_add2list(TZFILE,'ares2B.w','CHEMTAB','READ')
+ CALL IO_File_open(TZFILE)
ILU = TZFILE%NLU
READ(ILU,*) I2IB,J2JB,K2KB
DO JI=1,I2IB
@@ -157,11 +157,11 @@ IF (CMINERAL == 'NARES') THEN
DO JJ=1,J2JB+1
READ(ILU,*) (W2JKB(JJ,JK),JK=1,K2KB)
ENDDO
- CALL IO_FILE_CLOSE_ll(TZFILE)
+ CALL IO_File_close(TZFILE)
TZFILE => NULL()
!
- CALL IO_FILE_ADD2LIST(TZFILE,'ares2C.w','CHEMTAB','READ')
- CALL IO_FILE_OPEN_ll(TZFILE)
+ CALL IO_File_add2list(TZFILE,'ares2C.w','CHEMTAB','READ')
+ CALL IO_File_open(TZFILE)
ILU = TZFILE%NLU
READ(ILU,*) I2IC,J2JC,K2KC
DO JI=1,I2IC
@@ -176,7 +176,7 @@ IF (CMINERAL == 'NARES') THEN
DO JJ=1,J2JC+1
READ(ILU,*) (W2JKC(JJ,JK),JK=1,K2KC)
ENDDO
- CALL IO_FILE_CLOSE_ll(TZFILE)
+ CALL IO_File_close(TZFILE)
TZFILE => NULL()
!
END IF
@@ -188,8 +188,8 @@ IF (CMINERAL == 'TABUL') THEN
IF(.NOT.ALLOCATED(znh)) ALLOCATE(znh(22))
IF(.NOT.ALLOCATED(zni)) ALLOCATE(zni(22))
IF(.NOT.ALLOCATED(zf)) ALLOCATE(zf(16,11,22,22,22,3))
- CALL IO_FILE_ADD2LIST(TZFILE,'AEROMIN_NEW','CHEMTAB','READ')
- CALL IO_FILE_OPEN_ll(TZFILE)
+ CALL IO_File_add2list(TZFILE,'AEROMIN_NEW','CHEMTAB','READ')
+ CALL IO_File_open(TZFILE)
ILU = TZFILE%NLU
WRITE(*,*) 'LOADING MINERAL AEROSOL DATA ...'
@@ -220,7 +220,7 @@ IF (CMINERAL == 'TABUL') THEN
ENDDO
ENDDO
WRITE(*,*) 'END LOADING'
- CALL IO_FILE_CLOSE_ll(TZFILE)
+ CALL IO_File_close(TZFILE)
TZFILE => NULL()
ENDIF
diff --git a/src/MNH/ch_aqueous_sedim1mom.f90 b/src/MNH/ch_aqueous_sedim1mom.f90
index 9bf9109b022306bf0ef99d6fd47b8d62230da921..cd0cf2e146b3e3350801ed6264a93aa9f496a87a 100644
--- a/src/MNH/ch_aqueous_sedim1mom.f90
+++ b/src/MNH/ch_aqueous_sedim1mom.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2007-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 MODI_CH_AQUEOUS_SEDIM1MOM
@@ -79,6 +79,7 @@ END MODULE MODI_CH_AQUEOUS_SEDIM1MOM
!! 17/09/10 (M Leriche) add LUSECHIC flag
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! 16/12/15 (M Leriche) compute instantaneous rain at the surface
+! P. Wautelet 12/02/2019: bugfix: ZRR_SEDIM was not initialized everywhere
!!
!-------------------------------------------------------------------------------
!
@@ -268,6 +269,7 @@ DO JN = 1 , KSPLITR
!
ZZW(:) = ZFSEDR * ZZZRRS(:)**(ZEXSEDR) * ZRHODREF(:)**(ZEXSEDR-ZCEXVT)
ZWSED(:,:,:) = UNPACK( ZZW(:),MASK=GSEDIMR(:,:,:),FIELD=0.0 )
+ ZRR_SEDIM(:,:,:) = 0.0
DO JK = IKB , IKE
ZRR_SEDIM(:,:,JK) = ZW(:,:,JK)*(ZWSED(:,:,JK+1)-ZWSED(:,:,JK))
END DO
@@ -308,6 +310,7 @@ DO JN = 1 , KSPLITR
!
ZZW(:) = XFSEDS * ZZZRSS(:)**(XEXSEDS) * ZRHODREF(:)**(XEXSEDS-ZCEXVT)
ZWSED(:,:,:) = UNPACK( ZZW(:),MASK=GSEDIMS(:,:,:),FIELD=0.0 )
+ ZRR_SEDIM(:,:,:) = 0.0
DO JK = IKB , IKE
ZRR_SEDIM(:,:,JK) = ZW(:,:,JK)*(ZWSED(:,:,JK+1)-ZWSED(:,:,JK))
END DO
@@ -336,6 +339,7 @@ DO JN = 1 , KSPLITR
!
ZZW(:) = XFSEDG * ZZZRGS(:)**(XEXSEDG) * ZRHODREF(:)**(XEXSEDG-ZCEXVT)
ZWSED(:,:,:) = UNPACK( ZZW(:),MASK=GSEDIMG(:,:,:),FIELD=0.0 )
+ ZRR_SEDIM(:,:,:) = 0.0
DO JK = IKB , IKE
ZRR_SEDIM(:,:,JK) = ZW(:,:,JK)*(ZWSED(:,:,JK+1)-ZWSED(:,:,JK))
END DO
diff --git a/src/MNH/ch_cranck.f90 b/src/MNH/ch_cranck.f90
index 2e4ac3c98ca36ce48a0bf795d51c84fcad40dc56..a435c9a8e0ede12d3d7367864857f364a6010f6d 100644
--- a/src/MNH/ch_cranck.f90
+++ b/src/MNH/ch_cranck.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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/05/18 13:07:25
-!-----------------------------------------------------------------
!! #####################
MODULE MODI_CH_CRANCK
!! #####################
@@ -69,8 +64,12 @@ SUBROUTINE CH_CRANCK(PTSIMUL, PDTACT, PCONC, PNEWCONC, KEQ, KVECNPT, KMI, &
!! 31/07/96 (K. Suhre) restructured
!! 19/04/02 add PALPHA argument
!! 01/12/03 (Gazen) change Chemical scheme interface
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+!
!! EXTERNAL
!! --------
+use mode_msg
+
USE MODI_CH_FCN
USE MODI_CH_JAC
USE MODI_CH_GAUSS
@@ -128,9 +127,7 @@ newton: DO WHILE (MAXVAL(ZERR).GT.ZMAXERR)
!
IITERCOUNT = IITERCOUNT + 1
IF (IITERCOUNT.GT.IMAXITER) THEN
-!callabortstop
- CALL ABORT
- STOP "CH_CRANCK ERROR: no convergence of Newton-Raphson iteration obtained"
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_CRANCK', 'no convergence of Newton-Raphson iteration obtained' )
ENDIF
!
!* 2.1 calculate derivative F for next iteration
@@ -163,9 +160,7 @@ newton: DO WHILE (MAXVAL(ZERR).GT.ZMAXERR)
IFAIL = 1
CALL CH_GAUSS(ZB,ZC,KEQ,IFAIL)
IF (IFAIL.NE.0) THEN
-!callabortstop
- CALL ABORT
- STOP 'CH_CRANCK ERROR: matrix cannot be inverted by CH_GAUSS'
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_CRANCK', 'matrix cannot be inverted by CH_GAUSS' )
ENDIF
!
!* 2.5 calculate dY = ZB F (result is put in ZFTRAPEZ)
diff --git a/src/MNH/ch_emission_flux0d.f90 b/src/MNH/ch_emission_flux0d.f90
index f3ba65ed160f87e0e3565d7e7003908a3fd0724b..39f3d2947b77cb9aafb9263f354fb6fa3a478b82 100644
--- a/src/MNH/ch_emission_flux0d.f90
+++ b/src/MNH/ch_emission_flux0d.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
!! ############################
@@ -70,18 +70,20 @@ END MODULE MODI_CH_EMISSION_FLUX0D
!! -------------
!! Original 26/07/1999
!! 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
!!
!! EXTERNAL
!! --------
-USE MODD_IO_ll, ONLY: TFILEDATA
-USE MODE_FM, ONLY: IO_FILE_CLOSE_ll
-USE MODE_IO_ll
+USE MODD_IO, ONLY: TFILEDATA
+
+USE MODE_IO_FILE, ONLY: IO_File_close
+use mode_msg
!
USE MODI_CH_OPEN_INPUT
!!
!! IMPLICIT ARGUMENTS
!! ------------------
-USE MODD_CH_M9_n, ONLY: NEQ, CNAMES
+USE MODD_CH_M9_n, ONLY: NEQ, CNAMES
!!
!------------------------------------------------------------------------------
!
@@ -107,7 +109,6 @@ CHARACTER*80 :: YFORMAT ! format of the input data
INTEGER :: ICHEMIS ! number of variables for which a flux is given
! in the input file
INTEGER :: IIO ! I/O channel
-INTEGER :: IFAIL ! return code from CLOSE_ll
REAL :: ZALPHA ! interpolation weight
!
CHARACTER(LEN=3) :: YUNIT
@@ -199,7 +200,7 @@ IF (LSFIRSTCALL) THEN
!
! close file
!
- CALL IO_FILE_CLOSE_ll(TZFILE)
+ CALL IO_File_close(TZFILE)
!
!* 2. MAP DATA ONTO PROGNOSTIC VARIABLES
! ---------------------------------------
@@ -215,10 +216,7 @@ IF (LSFIRSTCALL) THEN
! where 1 microMol/m2/day = (22.414/86.400)*1E-12 ppp*m/s
ZCONVERSION = (22.414/86.400)*1E-12
CASE DEFAULT
- WRITE(KLUOUT,*) 'CH_EMISSION_FLUX0D: unknow conversion factor: ', YUNIT
-!callabortstop
- CALL ABORT
- STOP 'CH_EMISSION_FLUX0D: unknow conversion factor'
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_EMISSION_FLUX0D', 'unknow conversion factor: '//trim(YUNIT) )
END SELECT
!
! set all fluxes to zero
diff --git a/src/MNH/ch_f77.fx90 b/src/MNH/ch_f77.fx90
index 79387b824a2390553faa1a480964e9c3b9f034c0..aed9e28b8e028a40bdf8509717d5b76f57a44855 100644
--- a/src/MNH/ch_f77.fx90
+++ b/src/MNH/ch_f77.fx90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1989-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.
@@ -20,6 +20,9 @@ C**MODIFIED: 10/01/2019 (P.Wautelet) use newunit argument to open files
C + bug corrections: some files were not closed
C**MODIFIED: 10/01/2019 (P.Wautelet) replace double precision declarations by
C real(kind(0.0d0)) (to allow compilation by NAG compiler)
+C**MODIFIED: 08/02/2019 (P.Wautelet) bug fixes: missing argument
+C + wrong use of an non initialized value
+C**MODIFIED: P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
C!
C!
C!
@@ -3650,6 +3653,9 @@ CDECK XERRWV
C ##################################################################
SUBROUTINE XERRWV (MSG, NMES, NERR, LEVEL, NI, I1, I2, NR, R1, R2)
C ##################################################################
+
+ use mode_msg
+
REAL R1, R2
INTEGER NMES, NERR, LEVEL, NI, I1, I2, NR
C
@@ -3718,9 +3724,7 @@ C10 FORMAT(1X,80A1)
50 FORMAT(6X,'In above, R1 =',E21.13,3X,'R2 =',E21.13)
C Abort the run if LEVEL = 2. ------------------------------------------
100 IF (LEVEL .NE. 2) RETURN
-C callabortstop
- CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'XERRWV', trim(MSG) )
END
C####################### End of Subroutine XERRWV ######################
C
@@ -4504,6 +4508,8 @@ CCC FILE TUV.f
*-----------------------------------------------------------------------------*
*= Adapted to MesoNH : ONLY JVALUES are computed
+ use mode_msg
+
IMPLICIT NONE
SAVE
@@ -4974,7 +4980,6 @@ c IF(zaird .GT. nzero) aircon(izout) = zaird
* in subroutine.
* Optical depths in Lyman-alpha and SRB will be over-written
* in subroutine la_srb.f
-
CALL seto2(nz,z,nw,wl,aircol,o2xs1, dto2, kout)
* Ozone optical depths
@@ -5141,11 +5146,8 @@ c
C copy labels into output array
if (njout .ne. 42) then
- WRITE(kout,*) 'There should be 42 J-Values to be updated!'
- WRITE(kout,*) 'We better stop here ... in tuvmain.f'
-C callabortstop
- CALL ABORT
- STOP 1
+ call Print_msg( NVERB_FATAL, 'GEN', 'tuvmain',
+ & 'there should be 42 J-Values to be updated' )
endif
DO ij = 1, njout
@@ -5324,6 +5326,8 @@ CCC FILE grids.f
*= MOPT- INTEGER OPTION for wave-length IF 3 good for JO2 (O)=*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -5688,8 +5692,8 @@ c wlabel = 'isaksen.grid'
CALL gridck(kw,nw,wl,ok,kout)
IF (.NOT. ok) THEN
- WRITE(*,*)'STOP in GRIDW: The w-grid does not make sense'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'GRIDW', 'the w-grid &
+ &does not make sense' )
ENDIF
*_______________________________________________________________________
@@ -5713,6 +5717,8 @@ c wlabel = 'isaksen.grid'
*= z - REAL, vector of altitude levels (in km) (O)=*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
* BROADLY USED PARAMETERS:
@@ -5948,7 +5954,9 @@ C fill up between model top and 50km with 1km grid spacing
20 continue
if (z(nz) .ge. 50.) goto 30
nz = nz + 1
- if (nz .gt. kz) stop "GRIDZ: not enough memory, increase kz"
+ if (nz .gt. kz)
+ & call Print_msg( NVERB_FATAL, 'GEN', 'gridz',
+ & 'not enough memory, increase kz' )
z(nz) = z(nz-1) + 1.
goto 20
C
@@ -6012,8 +6020,8 @@ c 99 CONTINUE
CALL gridck(kz,nz,z,ok,kout)
IF (.NOT. ok) THEN
- WRITE(*,*)'STOP in GRIDZ: The z-grid does not make sense'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'GRIDZ', 'the z-grid &
+ &does not make sense' )
ENDIF
*_______________________________________________________________________
@@ -6415,6 +6423,8 @@ CCC FILE la_srb.f
*= continuum. =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c c INCLUDE 'params'
@@ -6562,12 +6572,13 @@ c c INCLUDE 'params'
WRITE(*,*) 'For wavelengths below 205.8 nm, only the'
WRITE(*,*) 'pre-specified wavelength grid is permitted'
WRITE(*,*) 'Use nwint=-156, or edit subroutine gridw.f'
- STOP ' Lyman alpha grid mis-match - 1'
+ call Print_msg( NVERB_FATAL, 'GEN', 'la_srb',
+ & 'Lyman alpha grid mis-match - 1' )
ENDIF
DO i = 2, nla + 1
IF(ABS(wl(ila + i - 1) - wlla(i)) .GT. 10.*precis) THEN
- WRITE(*,*) 'Lyman alpha grid mis-match - 2'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'la_srb',
+ & 'Lyman alpha grid mis-match - 2' )
ENDIF
ENDDO
@@ -6588,12 +6599,13 @@ c c INCLUDE 'params'
WRITE(*,*) 'For wavelengths below 205.8 nm, only the'
WRITE(*,*) 'pre-specified wavelength grid is permitted'
WRITE(*,*) 'Use nwint=-156, or edit subroutine gridw.f'
- STOP ' SRB grid mis-match - 1'
+ call Print_msg( NVERB_FATAL, 'GEN', 'la_srb',
+ & 'SRB grid mis-match - 1' )
ENDIF
DO i = 2, nsrb + 1
IF(ABS(wl(isrb + i - 1) - wlsrb(i)) .GT. 10.* precis) THEN
- WRITE(*,*) ' SRB grid mismatch - w'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'la_srb',
+ & 'SRB grid mis-match - w' )
ENDIF
ENDDO
@@ -7386,6 +7398,8 @@ CCC FILE numer.f
*= Y - REAL, input y-data (I)=*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
* input:
@@ -7427,11 +7441,9 @@ CCC FILE numer.f
* check for xg-values outside the x-range
IF ( (x(1) .GT. xg(1)) .OR. (x(n) .LT. xg(ng)) ) THEN
- WRITE(0,*) '>>> ERROR (inter2) <<< Data do not span '//
- > 'grid. '
- WRITE(0,*) ' Use ADDPNT to '//
- > 'expand data and re-run.'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'inter2',
+ & 'data do not span grid. Use ADDPNT'//
+ & 'to expand data and re-run.' )
ENDIF
* find the integral of each grid interval and use this to
@@ -7554,8 +7566,10 @@ CCC FILE numer.f
*= last target bin =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
-
+
* input:
INTEGER n, ng
REAL xg(ng)
@@ -7574,9 +7588,8 @@ CCC FILE numer.f
* check whether flag given is legal
IF ((FoldIn .NE. 0) .AND. (FoldIn .NE. 1)) THEN
- WRITE(0,*) '>>> ERROR (inter3) <<< Value for FOLDIN invalid. '
- WRITE(0,*) ' Must be 0 or 1'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'inter3',
+ & 'Value for FOLDIN invalid. Must be 0 or 1.' )
ENDIF
* do interpolation
@@ -7684,6 +7697,8 @@ CCC FILE numer.f
*= last target bin =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
* input:
@@ -7704,9 +7719,8 @@ CCC FILE numer.f
* check whether flag given is legal
IF ((FoldIn .NE. 0) .AND. (FoldIn .NE. 1)) THEN
- WRITE(0,*) '>>> ERROR (inter3) <<< Value for FOLDIN invalid. '
- WRITE(0,*) ' Must be 0 or 1'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'inter4',
+ & 'Value for FOLDIN invalid. Must be 0 or 1.' )
ENDIF
* do interpolation
@@ -7793,6 +7807,8 @@ CCC FILE numer.f
*= YNEW - REAL, y-value of point to be added (I)=*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
* calling parameters
@@ -7811,9 +7827,8 @@ CCC FILE numer.f
* check n<ld to make sure x will hold another point
IF (n .GE. ld) THEN
- WRITE(0,*) '>>> ERROR (ADDPNT) <<< Cannot expand array '
- WRITE(0,*) ' All elements used.'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'addpnt',
+ & 'Cannot expand array. All elements used.' )
ENDIF
insert = 1
@@ -7826,9 +7841,8 @@ CCC FILE numer.f
10 CONTINUE
IF (i .LT. n) THEN
IF (x(i) .LT. x(i-1)) THEN
- WRITE(0,*) '>>> ERROR (ADDPNT) <<< x-data must be '//
- > 'in ascending order!'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'addpnt',
+ & 'x-data must be in ascending order' )
ELSE
IF (xnew .GT. x(i)) insert = i + 1
ENDIF
@@ -8773,6 +8787,8 @@ CCC FILE qys.f
*= send email to: sasha@ucar.edu =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c c INCLUDE 'params'
@@ -8944,8 +8960,8 @@ c c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, fil
- STOP
- ENDIF
+ call Print_msg( NVERB_FATAL, 'GEN', 'rdetfl', '' )
+ ENDIF
DO iw = 1, nw-1
f(iw) = yg1(iw)
ENDDO
@@ -8970,8 +8986,8 @@ c c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, fil
- STOP
- ENDIF
+ call Print_msg( NVERB_FATAL, 'GEN', 'rdetfl', '' )
+ ENDIF
DO iw = 1, nw-1
f(iw) = yg1(iw)
ENDDO
@@ -8996,8 +9012,8 @@ c c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, fil
- STOP
- ENDIF
+ call Print_msg( NVERB_FATAL, 'GEN', 'rdetfl', '' )
+ ENDIF
DO iw = 1, nw-1
f(iw) = yg1(iw)
ENDDO
@@ -9022,8 +9038,8 @@ c c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, fil
- STOP
- ENDIF
+ call Print_msg( NVERB_FATAL, 'GEN', 'rdetfl', '' )
+ ENDIF
DO iw = 1, nw-1
f(iw) = yg1(iw)
ENDDO
@@ -9049,8 +9065,8 @@ c c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, fil
- STOP
- ENDIF
+ call Print_msg( NVERB_FATAL, 'GEN', 'rdetfl', '' )
+ ENDIF
DO iw = 1, nw-1
f(iw) = yg1(iw)
ENDDO
@@ -9077,8 +9093,8 @@ c c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, fil
- STOP
- ENDIF
+ call Print_msg( NVERB_FATAL, 'GEN', 'rdetfl', '' )
+ ENDIF
DO iw = 1, nw-1
f(iw) = yg1(iw)
ENDDO
@@ -9134,8 +9150,8 @@ c c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, fil
- STOP
- ENDIF
+ call Print_msg( NVERB_FATAL, 'GEN', 'rdetfl', '' )
+ ENDIF
DO iw = 1, nw-1
f(iw) = yg1(iw)
ENDDO
@@ -9160,8 +9176,8 @@ c c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, fil
- STOP
- ENDIF
+ call Print_msg( NVERB_FATAL, 'GEN', 'rdetfl', '' )
+ ENDIF
DO iw = 1, nw-1
f(iw) = yg1(iw)
ENDDO
@@ -9242,8 +9258,8 @@ c c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, fil
- STOP
- ENDIF
+ call Print_msg( NVERB_FATAL, 'GEN', 'rdetfl', '' )
+ ENDIF
fil = 'DATAE1/SUN/neckel.flx'
write(kout,*) fil
@@ -9337,8 +9353,8 @@ c c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, fil
- STOP
- ENDIF
+ call Print_msg( NVERB_FATAL, 'GEN', 'rdetfl', '' )
+ ENDIF
fil = 'DATAE1/SUN/neckel.flx'
write(kout,*) fil
@@ -9381,8 +9397,8 @@ c y1(i) = y1(i) * 1.E4 * hc / (x1(i) * 1.E-9)
CALL inter2(nw,wl,yg4,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, fil
- STOP
- ENDIF
+ call Print_msg( NVERB_FATAL, 'GEN', 'rdetfl', '' )
+ ENDIF
* for wl(iw) .lt. 150.01 susim_hi.flx
* for wl(iw) .ge. 150.01 .and. wl(iw) .lt. 200.07 atlas3.flx
@@ -9426,6 +9442,8 @@ c y1(i) = y1(i) * 1.E4 * hc / (x1(i) * 1.E-9)
*= each specified wavelength =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c c INCLUDE 'params'
@@ -9545,7 +9563,7 @@ c c INCLUDE 'params'
CALL inter2(nw,wl,f,n,lambda_hi,irrad_hi,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, fil
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'read1', '' )
ENDIF
RETURN
@@ -9737,6 +9755,8 @@ CCC FILE rdxs.f
*= each specified wavelength (WMO value at 273) =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -9957,7 +9977,7 @@ c INCLUDE 'params'
ENDDO
ELSE
- STOP 'mabs not set in rdxs.f'
+ call Print_msg( NVERB_FATAL, 'GEN', 'rdo3xs', 'mabs not set' )
ENDIF
RETURN
@@ -9987,6 +10007,8 @@ c INCLUDE 'params'
*= V830 - REAL, exact wavelength in vacuum for data breaks (O)=*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -10117,8 +10139,8 @@ c INCLUDE 'params'
CALL addpnt(x1,y1,kdata,n1, 1.e+38,0.)
CALL inter2(nw,wl,rei295,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
- WRITE(*,*) ierr, 'O3 xsect - Reims 295K'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'o3_rei',
+ & 'O3 xsect - Reims 295K' )
ENDIF
DO i = 1, n2
@@ -10136,8 +10158,8 @@ c INCLUDE 'params'
CALL addpnt(x2,y2,kdata,n2, 1.e+38,0.)
CALL inter2(nw,wl,rei243,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
- WRITE(*,*) ierr, 'O3 xsect - Reims 243K'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'o3_rei',
+ & 'O3 xsect - Reims 243K' )
ENDIF
CALL addpnt(x3,y3,kdata,n3,x3(1)*(1.-deltax),0.)
@@ -10146,8 +10168,8 @@ c INCLUDE 'params'
CALL addpnt(x3,y3,kdata,n3, 1.e+38,0.)
CALL inter2(nw,wl,rei228,n3,x3,y3,ierr)
IF (ierr .NE. 0) THEN
- WRITE(*,*) ierr, 'O3 xsect - Reims 228K'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'o3_rei',
+ & 'O3 xsect - Reims 228K' )
ENDIF
CALL addpnt(x4,y4,kdata,n4,x4(1)*(1.-deltax),0.)
@@ -10156,8 +10178,8 @@ c INCLUDE 'params'
CALL addpnt(x4,y4,kdata,n4, 1.e+38,0.)
CALL inter2(nw,wl,rei218,n4,x4,y4,ierr)
IF (ierr .NE. 0) THEN
- WRITE(*,*) ierr, 'O3 xsect - Reims 218K'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'o3_rei',
+ & 'O3 xsect - Reims 218K' )
ENDIF
* wavelength breaks must be converted to vacuum:
@@ -10190,6 +10212,8 @@ c INCLUDE 'params'
*= V850 - REAL, exact wavelength in vacuum for data breaks (O)=*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c c INCLUDE 'params'
@@ -10307,8 +10331,8 @@ c c INCLUDE 'params'
CALL addpnt(x1,y1,kdata,n1, 1.e+38,0.)
CALL inter2(nw,wl,wmo203,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
- WRITE(*,*) ierr, 'O3 cross section - WMO - 203K'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'o3_wmo',
+ & 'O3 cross section - WMO - 203K' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),0.)
@@ -10317,8 +10341,8 @@ c c INCLUDE 'params'
CALL addpnt(x2,y2,kdata,n2, 1.e+38,0.)
CALL inter2(nw,wl,wmo273,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
- WRITE(*,*) ierr, 'O3 cross section - WMO - 273K'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'o3_wmo',
+ & 'O3 cross section - WMO - 273K' )
ENDIF
* wavelength breaks must be converted to vacuum:
@@ -10352,6 +10376,8 @@ c c INCLUDE 'params'
*= V825 - REAL, exact wavelength in vacuum for data breaks (O)=*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -10467,8 +10493,8 @@ c INCLUDE 'params'
CALL addpnt(x1,y1,kdata,n1, 1.e+38,0.)
CALL inter2(nw,wl,jpl295,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
- WRITE(*,*) ierr, 'O3 cross section - WMO - 295K'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'o3_jpl',
+ & 'O3 cross section - WMO - 295K' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),0.)
@@ -10477,8 +10503,8 @@ c INCLUDE 'params'
CALL addpnt(x2,y2,kdata,n2, 1.e+38,0.)
CALL inter2(nw,wl,jpl218,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
- WRITE(*,*) ierr, 'O3 cross section - WMO - 218K'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'o3_jpl',
+ & 'O3 cross section - WMO - 218K' )
ENDIF
* wavelength breaks must be converted to vacuum:
@@ -10514,6 +10540,8 @@ c INCLUDE 'params'
*= V350 - REAL, exact wavelength in vacuum for data breaks (O)=*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -10658,8 +10686,8 @@ c INCLUDE 'params'
CALL addpnt(x1,y1,kdata,n1, 1.e+38,0.)
CALL inter2(nw,wl,mol226,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
- WRITE(*,*) ierr, 'O3 xsect - 226K Molina'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'o3_mol',
+ & 'O3 xsect - 226K Molina' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),0.)
@@ -10668,8 +10696,8 @@ c INCLUDE 'params'
CALL addpnt(x2,y2,kdata,n2, 1.e+38,0.)
CALL inter2(nw,wl,mol263,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
- WRITE(*,*) ierr, 'O3 xsect - 263K Molina'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'o3_mol',
+ & 'O3 xsect - 263K Molina' )
ENDIF
CALL addpnt(x3,y3,kdata,n3,x3(1)*(1.-deltax),0.)
@@ -10678,8 +10706,8 @@ c INCLUDE 'params'
CALL addpnt(x3,y3,kdata,n3, 1.e+38,0.)
CALL inter2(nw,wl,mol298,n3,x3,y3,ierr)
IF (ierr .NE. 0) THEN
- WRITE(*,*) ierr, 'O3 xsect - 298K Molina'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'o3_mol',
+ & 'O3 xsect - 298K Molina' )
ENDIF
RETURN
@@ -10706,6 +10734,8 @@ c INCLUDE 'params'
*= Vb342 - REAL, exact wavelength in vacuum for data breaks (O)=*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -10830,8 +10860,8 @@ c INCLUDE 'params'
CALL addpnt(x1,y1,kdata,n1, 1.e+38,0.)
CALL inter2(nw,wl,c0,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
- WRITE(*,*) ierr, 'O3 xsect - c0 Bass'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'o3_bas',
+ & 'O3 xsect - c0 Bass' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),0.)
@@ -10840,8 +10870,8 @@ c INCLUDE 'params'
CALL addpnt(x2,y2,kdata,n2, 1.e+38,0.)
CALL inter2(nw,wl,c1,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
- WRITE(*,*) ierr, 'O3 xsect - c1 Bass'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'o3_bas',
+ & 'O3 xsect - c1 Bass' )
ENDIF
CALL addpnt(x3,y3,kdata,n3,x3(1)*(1.-deltax),0.)
@@ -10850,8 +10880,8 @@ c INCLUDE 'params'
CALL addpnt(x3,y3,kdata,n3, 1.e+38,0.)
CALL inter2(nw,wl,c2,n3,x3,y3,ierr)
IF (ierr .NE. 0) THEN
- WRITE(*,*) ierr, 'O3 xsect - c2 Bass'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'o3_bas',
+ & 'O3 xsect - c2 Bass' )
ENDIF
RETURN
@@ -10876,6 +10906,8 @@ c INCLUDE 'params'
*=
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -10998,8 +11030,8 @@ c INCLUDE 'params'
CALL addpnt(x1,y1,kdata,n, 1.E+38,0.)
CALL inter2(nw,wl,o2xs1, n,x1,y1, ierr)
IF (ierr .NE. 0) THEN
- WRITE(*,*) ierr, 'O2 -> O + O'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'rdo2xs',
+ & 'O2 -> O + O' )
ENDIF
*------------------------------------------------------
@@ -11121,6 +11153,8 @@ c INCLUDE 'params'
SUBROUTINE no2xs_d(nz,t,nw,wl, no2xs,kout)
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -11227,8 +11261,8 @@ c INCLUDE 'params'
CALL addpnt(x1,y1,kdata,n, 1.e+38,0.)
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
- WRITE(*,*) ierr, fil
- STOP
+ WRITE(*,*) ierr, fil
+ call Print_msg( NVERB_FATAL, 'GEN', 'no2xs_d', '' )
ENDIF
* assign, same at all altitudes (no temperature effect)
@@ -11767,6 +11801,8 @@ c INCLUDE 'params'
*= send email to: sasha@ucar.edu =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -11869,7 +11905,7 @@ c n = 681
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, fil
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'rdso2xs', '' )
ENDIF
DO 13, l = 1, nw-1
@@ -12753,6 +12789,8 @@ c mu1(i) = 0.5
* solves tridiagonal system. From Numerical Recipies, p. 40
*_______________________________________________________________________
+ use mode_msg
+
IMPLICIT NONE
* input:
@@ -12825,13 +12863,17 @@ c INCLUDE 'params'
DIMENSION gam(2*kz)
*_______________________________________________________________________
- IF (b(1) .EQ. 0.) STOP 1001
+ IF (b(1) .EQ. 0.) THEN
+ call Print_msg( NVERB_FATAL, 'GEN', 'tridiag', '' )
+ END IF
bet = b(1)
u(1) = r(1)/bet
DO 11, j = 2, n
gam(j) = c(j - 1)/bet
bet = b(j) - a(j)*gam(j)
- IF (bet .EQ. 0.) STOP 2002
+ IF (bet .EQ. 0.) THEN
+ call Print_msg( NVERB_FATAL, 'GEN', 'tridiag', '' )
+ END IF
u(j) = (r(j) - a(j)*u(j - 1))/bet
11 CONTINUE
DO 12, j = n - 1, 1, -1
@@ -13677,6 +13719,8 @@ c Called by- SOLEIG
c Calls- D1MACH, ERRMSG
c +-------------------------------------------------------------------+
+ use mode_msg
+
c .. Scalar Arguments ..
INTEGER IA, IER, IEVEC, M
@@ -14100,8 +14144,8 @@ c ** One eigenvalue found
C next line has been included to avoid run time error caused by xlf
IF ( ( N1.LE.0 ).OR.( N.LE.0 ) ) THEN
- WRITE(0,*) 'Subscript out of bounds in ASYMTX'
- STOP 9999
+ call Print_msg( NVERB_FATAL, 'GEN', 'ASYMTX',
+ & 'subscript out of bounds' )
ENDIF
Y = AAD( N1, N1 )
@@ -17743,6 +17787,8 @@ c
c Print out a warning or error message; abort if error
c after making symbolic dump (machine-specific)
+ use mode_msg
+
LOGICAL FATAL, MsgLim, Cray
CHARACTER*(*) MESSAG
INTEGER MaxMsg, NumMsg
@@ -17751,24 +17797,21 @@ c after making symbolic dump (machine-specific)
IF ( FATAL ) THEN
- WRITE ( *, '(//,2A,//)' ) ' ******* ERROR >>>>>> ', MESSAG
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'ErrMsg', trim(MESSAG) )
END IF
NumMsg = NumMsg + 1
IF( MsgLim ) RETURN
IF ( NumMsg.LE.MaxMsg ) THEN
- WRITE ( *, '(/,2A,/)' ) ' ******* WARNING >>>>>> ', MESSAG
+ call Print_msg( NVERB_WARNING, 'GEN', 'ErrMsg', trim(MESSAG) )
ELSE
- WRITE ( *,99 )
- MsgLim = .True.
+ call Print_msg( NVERB_WARNING, 'GEN', 'ErrMsg',
+ & 'too many warning messages. ' //
+ & 'They will no longer be printed.' )
+ MsgLim = .True.
ENDIF
- RETURN
-
- 99 FORMAT( //,' >>>>>> TOO MANY WARNING MESSAGES -- ',
- $ 'They will no longer be printed <<<<<<<', // )
END
c -------------------------------------------------------------------------
@@ -19079,6 +19122,8 @@ C ##############################
*= (see routine T665D for more information on different constants) =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
EXTERNAL t665d
REAL(kind(0.0d0)) :: d1mach
INTEGER i
@@ -19098,8 +19143,8 @@ C ##############################
ENDIF
d1mach = dmach(i)
ELSE
- WRITE(0,*) '>>> ERROR (D1MACH) <<< invalid argument'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'D1MACH',
+ & 'invalid argument' )
ENDIF
*!csm
@@ -19342,6 +19387,8 @@ C---------- LAST CARD OF T665D ----------
*= (see routine T665R for more information on different constants) =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
REAL r1mach
INTEGER i
@@ -19360,8 +19407,8 @@ C---------- LAST CARD OF T665D ----------
ENDIF
r1mach = rmach(i)
ELSE
- WRITE(0,*) '>>> ERROR (R1MACH) <<< invalid argument'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'R1MACH',
+ & 'invalid argument' )
ENDIF
END
@@ -19685,6 +19732,8 @@ CCC FILE rxn.f
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -19864,7 +19913,7 @@ c myld = kjpl00
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r01', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),y2(1))
@@ -19874,7 +19923,7 @@ c myld = kjpl00
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r01', '' )
ENDIF
ENDIF
@@ -19901,7 +19950,7 @@ c myld = kjpl00
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r01', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),y2(1))
@@ -19911,7 +19960,7 @@ c myld = kjpl00
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r01', '' )
ENDIF
ENDIF
@@ -19952,7 +20001,7 @@ c myld = kjpl00
CALL inter2(nw,wl,yg1, n1,x1,y1, ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r01', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),y2(1))
@@ -19963,7 +20012,7 @@ c myld = kjpl00
CALL inter2(nw,wl,yg2, n2,x2,y2, ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r01', '' )
ENDIF
* phi data at 298 and 230 K
@@ -19976,7 +20025,7 @@ c myld = kjpl00
CALL inter2(nw,wl,yg3, n3,x3,y3, ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr,jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r01', '' )
ENDIF
CALL addpnt(x4,y4,kdata,n4,x4(1)*(1.-deltax),y4(1))
@@ -19987,7 +20036,7 @@ c myld = kjpl00
CALL inter2(nw,wl,yg4, n4,x4,y4, ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr,jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r01', '' )
ENDIF
ENDIF
@@ -20143,6 +20192,7 @@ c myld = kjpl00
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
IMPLICIT NONE
c INCLUDE 'params'
@@ -20251,11 +20301,11 @@ c INCLUDE 'params'
mabs = 4
- IF (mabs. EQ. 1) CALL no2xs_d(nz,tlev,nw,wl, no2xs)
- IF (mabs .EQ. 2) CALL no2xs_jpl94(nz,tlev,nw,wl, no2xs)
- IF (mabs .EQ. 3) CALL no2xs_har(nz,tlev,nw,wl, no2xs)
- IF (mabs .EQ. 4) CALL no2xs_jpl06a(nz,tlev,nw,wl, no2xs)
- IF (mabs .EQ. 5) CALL no2xs_jpl06b(nz,tlev,nw,wl, no2xs)
+ IF (mabs. EQ. 1) CALL no2xs_d(nz,tlev,nw,wl, no2xs, kout)
+ IF (mabs .EQ. 2) CALL no2xs_jpl94(nz,tlev,nw,wl, no2xs, kout)
+ IF (mabs .EQ. 3) CALL no2xs_har(nz,tlev,nw,wl, no2xs, kout)
+ IF (mabs .EQ. 4) CALL no2xs_jpl06a(nz,tlev,nw,wl, no2xs, kout)
+ IF (mabs .EQ. 5) CALL no2xs_jpl06b(nz,tlev,nw,wl, no2xs, kout)
* quantum yields
* myld = 1 NO2_calvert.yld (same as JPL2002)
@@ -20284,7 +20334,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r02', '' )
ENDIF
do iw = 1, nw - 1
@@ -20316,7 +20366,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r02', '' )
ENDIF
@@ -20327,7 +20377,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r02', '' )
ENDIF
DO iw = 1, nw - 1
@@ -20385,6 +20435,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
* BROADLY USED PARAMETERS:
@@ -20531,7 +20583,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r03', '' )
ENDIF
ELSEIF(mabs .EQ. 2) THEN
@@ -20555,7 +20607,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r03', '' )
ENDIF
* use JPL94 for wavelengths longer than 600 nm
@@ -20586,7 +20638,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r03', '' )
ENDIF
ENDIF
@@ -20793,6 +20845,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -20923,7 +20977,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1, n1,x1,y1, ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr,jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r04', '' )
ENDIF
CALL addpnt(x2,B,kdata, n2,x2(1)*(1.-deltax),0.)
@@ -20934,7 +20988,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2, n2,x2,B, ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr,jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r04', '' )
ENDIF
@@ -20999,6 +21053,8 @@ c INCLUDE 'params'
*= 05/98 Original, adapted from former JSPEC1 subroutine =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -21123,7 +21179,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r05', '' )
ENDIF
ELSEIF(mabs .eq. 2) then
@@ -21146,7 +21202,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r05', '' )
ENDIF
ENDIF
@@ -21196,6 +21252,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -21346,7 +21404,7 @@ C ENDDO
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r06', '' )
ENDIF
@@ -21357,7 +21415,7 @@ C ENDDO
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r06', '' )
ENDIF
* quantum yield = 1
@@ -21404,6 +21462,8 @@ C ENDDO
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -21517,7 +21577,7 @@ C* local
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r07', '' )
ENDIF
* quantum yield = 1
@@ -21566,6 +21626,8 @@ C* local
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -21718,7 +21780,7 @@ C ENDIF
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r08', '' )
ENDIF
A0 = 6.4761E+04
@@ -21802,6 +21864,8 @@ C ENDIF
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -21976,7 +22040,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r09', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),y2(1))
@@ -21986,7 +22050,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r09', '' )
ENDIF
CALL addpnt(x3,y3,kdata,n3,x3(1)*(1.-deltax),y3(1))
@@ -22006,7 +22070,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg4,n4,x4,y4,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r09', '' )
ENDIF
CALL addpnt(x5,y5,kdata,n5,x5(1)*(1.-deltax),y5(1))
@@ -22016,7 +22080,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg5,n5,x5,y5,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r09', '' )
ENDIF
@@ -22078,7 +22142,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r09', '' )
ENDIF
* quantum yield = 1
@@ -22150,6 +22214,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -22334,7 +22400,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j-1)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r09', '' )
ENDIF
ELSEIF (mopt1 .EQ. 2 .OR. mopt1 .EQ. 3 .OR. mopt1 .EQ. 4) THEN
@@ -22356,7 +22422,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j-1)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r09', '' )
ENDIF
IF(mopt1 .EQ. 3) THEN
@@ -22410,7 +22476,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r10', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),0.)
@@ -22420,7 +22486,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg3,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r10', '' )
ENDIF
ELSEIF(mopt1 .eq. 4) THEN
@@ -22446,7 +22512,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r10', '' )
ENDIF
CALL addpnt(x3,y3,kdata,n3,x3(1)*(1.-deltax),0.)
@@ -22456,7 +22522,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg3,n3,x3,y3,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r10', '' )
ENDIF
ENDIF
@@ -22483,7 +22549,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j-1)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r10', '' )
ENDIF
ELSEIF(mopt1 .EQ. 6) THEN
@@ -22509,7 +22575,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r10', '' )
ENDIF
CALL addpnt(x3,y3,kdata,n3,x3(1)*(1.-deltax),0.)
@@ -22519,7 +22585,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg3,n3,x3,y3,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r10', '' )
ENDIF
ENDIF
@@ -22545,7 +22611,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg4,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j-1)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r10', '' )
ENDIF
OPEN(NEWUNIT=ilu,FILE='DATAJ1/CH2O/CH2O_ii_mad.yld',
@@ -22565,7 +22631,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg5,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r10', '' )
ENDIF
ELSEIF(mopt2 .EQ. 2) then
@@ -22591,7 +22657,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg4,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r10', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),y2(1))
@@ -22601,7 +22667,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg5,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r10', '' )
ENDIF
* box-filling interpolation.
@@ -22652,7 +22718,7 @@ c ENDDO
CALL inter2(nw,wl,yg4,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r10', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),y2(1))
@@ -22662,7 +22728,7 @@ c ENDDO
CALL inter2(nw,wl,yg5,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r10', '' )
ENDIF
ENDIF
@@ -22770,6 +22836,8 @@ c ENDDO
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -22927,7 +22995,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r11', '' )
ENDIF
ELSEIF(mabs .EQ. 2) THEN
@@ -22954,7 +23022,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r11', '' )
ENDIF
ELSEIF(mabs .EQ. 3) THEN
@@ -22977,7 +23045,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r11', '' )
ENDIF
ELSEIF(mabs .EQ. 4) THEN
@@ -23015,7 +23083,7 @@ c n = 1705
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r11', '' )
ENDIF
ELSEIF (mabs .EQ. 5) THEN
@@ -23039,7 +23107,7 @@ c n = 1705
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r11', '' )
ENDIF
ENDIF
@@ -23069,7 +23137,7 @@ c n = 1705
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r11', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),0.)
@@ -23079,7 +23147,7 @@ c n = 1705
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r11', '' )
ENDIF
DO iw = 1, nw-1
@@ -23105,7 +23173,7 @@ c n = 1705
CALL inter2(nw,wl,yg1,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r11', '' )
ENDIF
OPEN(NEWUNIT=ilu,FILE='DATAJ1/CH3CHO/d021_ii.yld',
@@ -23126,7 +23194,7 @@ c n = 1705
CALL inter2(nw,wl,yg2,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r11', '' )
ENDIF
OPEN(NEWUNIT=ilu,FILE='DATAJ1/CH3CHO/d021_iii.yld',
@@ -23147,7 +23215,7 @@ c n = 1705
CALL inter2(nw,wl,yg3,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r11', '' )
ENDIF
ENDIF
@@ -23172,7 +23240,7 @@ c n = 1705
CALL inter2(nw,wl,yg4,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r11', '' )
ENDIF
* combine:
@@ -23264,6 +23332,8 @@ c x = yg4(iw)
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -23401,7 +23471,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r12', '' )
ENDIF
ELSEIF(mabs .EQ. 2) THEN
@@ -23424,7 +23494,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r12', '' )
ENDIF
ENDIF
@@ -23452,12 +23522,12 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r12', '' )
ENDIF
ELSEIF (myld .EQ. 2) THEN
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r12', '' )
ENDIF
@@ -23521,6 +23591,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -23694,7 +23766,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r13', '' )
ENDIF
@@ -23718,7 +23790,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r13', '' )
ENDIF
ELSEIF(mabs .EQ. 3) THEN
@@ -23746,7 +23818,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r13', '' )
ENDIF
ELSEIF(mabs .EQ. 4) THEN
@@ -23771,7 +23843,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r13', '' )
ENDIF
ELSEIF(mabs .eq. 5) then
@@ -23796,7 +23868,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r13', '' )
ENDIF
ENDIF
@@ -23829,7 +23901,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r13', '' )
ENDIF
n2 = n
@@ -23843,7 +23915,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n2,x1,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r13', '' )
ENDIF
n3 = n
@@ -23857,7 +23929,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg3,n3,x1,y3,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r13', '' )
ENDIF
ENDIF
@@ -23953,6 +24025,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -24111,7 +24185,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r14', '' )
ENDIF
OPEN(NEWUNIT=ilu,FILE='DATAJ1/CH3COCHO/CH3COCHO_iup2.abs',
@@ -24133,7 +24207,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r14', '' )
ENDIF
DO iw = 1, nw-1
@@ -24161,7 +24235,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r14', '' )
ENDIF
ELSEIF(mabs .GT. 2 .and. mabs .lt. 7) THEN
@@ -24202,7 +24276,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r14', '' )
ENDIF
ELSEIF(mabs .EQ. 7) THEN
@@ -24226,7 +24300,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r14', '' )
ENDIF
@@ -24248,7 +24322,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r14', '' )
ENDIF
do iw = 1, nw-1
@@ -24276,7 +24350,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r14', '' )
ENDIF
ENDIF
@@ -24305,7 +24379,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r14', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),1.)
@@ -24315,7 +24389,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r14', '' )
ENDIF
ENDIF
@@ -24435,6 +24509,8 @@ c kq = 1.93e4 * EXP(-5639/wc(iw))
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -24584,7 +24660,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r15', '' )
ENDIF
ELSEIF(mabs .EQ. 2) THEN
@@ -24608,7 +24684,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r15', '' )
ENDIF
ELSEIF(mabs .EQ. 3) THEN
@@ -24636,7 +24712,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r15', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),0.)
@@ -24646,7 +24722,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r15', '' )
ENDIF
@@ -24657,7 +24733,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg3,n3,x3,y3,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r15', '' )
ENDIF
ELSEIF(mabs.eq.4) then
@@ -24690,7 +24766,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r15', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),0.)
@@ -24700,7 +24776,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r15', '' )
ENDIF
CALL addpnt(x3,y3,kdata,n3,x3(1)*(1.-deltax),0.)
@@ -24710,7 +24786,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg3,n3,x3,y3,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r15', '' )
ENDIF
CALL addpnt(x4,y4,kdata,n4,x4(1)*(1.-deltax),0.)
@@ -24720,7 +24796,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg4,n4,x4,y4,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r15', '' )
ENDIF
ENDIF
@@ -24745,7 +24821,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r15', '' )
ENDIF
ENDIF
@@ -24856,6 +24932,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -24994,7 +25072,7 @@ c $ STATUS='old')
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r16', '' )
ENDIF
ELSEIF (mabs .EQ. 2) THEN
@@ -25018,7 +25096,7 @@ c $ STATUS='old')
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r16', '' )
ENDIF
ELSEIF (mabs .EQ. 3) THEN
@@ -25041,7 +25119,7 @@ c $ STATUS='old')
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r16', '' )
ENDIF
ELSEIF (mabs .EQ. 4) THEN
@@ -25064,7 +25142,7 @@ c $ STATUS='old')
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r16', '' )
ENDIF
ELSEIF (mabs .EQ. 5) THEN
@@ -25088,7 +25166,7 @@ c $ STATUS='old')
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r16', '' )
ENDIF
ENDIF
@@ -25150,6 +25228,8 @@ c $ STATUS='old')
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -25285,7 +25365,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r17', '' )
ENDIF
ELSEIF(mabs .EQ. 2) THEN
@@ -25314,7 +25394,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r17', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),y2(1))
@@ -25324,7 +25404,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r17', '' )
ENDIF
ELSEIF (mabs .EQ. 3) THEN
@@ -25349,7 +25429,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r17', '' )
ENDIF
ELSEIF(mabs .EQ. 4) THEN
@@ -25379,7 +25459,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r17', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),y2(1))
@@ -25389,7 +25469,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r17', '' )
ENDIF
ELSEIF (mabs .EQ. 5) THEN
@@ -25413,7 +25493,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r17', '' )
ENDIF
ELSEIF (mabs .EQ. 6) THEN
@@ -25448,7 +25528,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r17', '' )
ENDIF
ELSEIF (mabs .EQ. 8) THEN
@@ -25472,7 +25552,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r17', '' )
ENDIF
ELSEIF (mabs. eq. 9) THEN
@@ -25499,7 +25579,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r17', '' )
ENDIF
n2 = n
@@ -25510,7 +25590,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r17', '' )
ENDIF
ENDIF
@@ -25570,6 +25650,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -25719,7 +25801,7 @@ C ENDIF
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r18', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),0.)
@@ -25729,7 +25811,7 @@ C ENDIF
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r18', '' )
ENDIF
* quantum yield:
@@ -25785,6 +25867,8 @@ C ENDIF
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -25902,7 +25986,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r19', '' )
ENDIF
*** quantum yield unity (Calvert and Pitts)
@@ -25947,6 +26031,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -26075,7 +26161,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r20', '' )
ENDIF
ELSEIF(mabs .EQ. 2) THEN
@@ -26099,7 +26185,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r20', '' )
ENDIF
ENDIF
@@ -26179,6 +26265,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -26297,7 +26385,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r21', '' )
ENDIF
*** quantum yield unity
@@ -26342,6 +26430,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -26460,7 +26550,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r22', '' )
ENDIF
*** quantum yield unity (Nolle et al.)
@@ -26506,6 +26596,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -26635,7 +26727,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r23', '' )
ENDIF
* sigma @ 210 K
@@ -26649,7 +26741,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r23', '' )
ENDIF
*** quantum yield assumed to be unity
@@ -26698,6 +26790,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -26827,7 +26921,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r24', '' )
ENDIF
* sigma @ 210 K
@@ -26841,7 +26935,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r24', '' )
ENDIF
*** quantum yield assumed to be unity
@@ -26889,6 +26983,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -27008,7 +27104,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r25', '' )
ENDIF
**** quantum yield assumed to be unity
@@ -27054,6 +27150,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -27176,7 +27274,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r26', '' )
ENDIF
**** quantum yield assumed to be unity
@@ -27223,6 +27321,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -27345,7 +27445,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r27', '' )
ENDIF
**** quantum yield assumed to be unity
@@ -27392,6 +27492,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -27510,7 +27612,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r28', '' )
ENDIF
**** quantum yield assumed to be unity
@@ -27557,6 +27659,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -27689,7 +27793,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r29', '' )
ENDIF
** sigma @ 250 K
@@ -27703,7 +27807,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r29', '' )
ENDIF
** sigma @ 210 K
@@ -27717,7 +27821,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r29', '' )
ENDIF
**** quantum yield assumed to be unity
@@ -27773,6 +27877,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -27905,7 +28011,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r30', '' )
ENDIF
** sigma @ 279 K
@@ -27919,7 +28025,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r30', '' )
ENDIF
** sigma @ 255 K
@@ -27933,7 +28039,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r30', '' )
ENDIF
**** quantum yield assumed to be unity
@@ -27988,6 +28094,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -28108,7 +28216,7 @@ C INTEGER n1, n2, n3, n4, n5
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r31', '' )
ENDIF
**** quantum yield assumed to be unity
@@ -28154,6 +28262,8 @@ C INTEGER n1, n2, n3, n4, n5
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -28564,6 +28674,8 @@ C ENDDO
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -28684,7 +28796,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r34', '' )
ENDIF
**** quantum yield assumed to be unity
@@ -28945,6 +29057,8 @@ c sq(j,iz,iw) = qy * EXP(sum)
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -29065,7 +29179,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r36', '' )
ENDIF
**** quantum yield assumed to be unity
@@ -29112,6 +29226,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -29232,7 +29348,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r37', '' )
ENDIF
**** quantum yield assumed to be unity
@@ -29279,6 +29395,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -29417,7 +29535,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r38', '' )
ENDIF
** sigma @ 270 K
@@ -29431,7 +29549,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r38', '' )
ENDIF
** sigma @ 250 K
@@ -29445,7 +29563,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r38', '' )
ENDIF
** sigma @ 230 K
@@ -29459,7 +29577,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r38', '' )
ENDIF
** sigma @ 210 K
@@ -29473,7 +29591,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r38', '' )
ENDIF
**** quantum yield assumed to be unity
@@ -29539,6 +29657,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -29658,7 +29778,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r39', '' )
ENDIF
**** quantum yield: absolute quantum yield has not been reported yet, but
@@ -29713,6 +29833,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -29833,7 +29955,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r40', '' )
ENDIF
**** quantum yield unity (Molina and Molina)
@@ -29880,6 +30002,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -30000,7 +30124,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r41', '' )
ENDIF
**** quantum yield assumed to be unity
@@ -30047,6 +30171,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -30167,7 +30293,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r42', '' )
ENDIF
**** quantum yield assumed to be unity
@@ -30214,6 +30340,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -30336,7 +30464,7 @@ c INCLUDE 'params'
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r43', '' )
ENDIF
**** quantum yield assumed to be unity
@@ -30543,6 +30671,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -30664,7 +30794,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r45', '' )
ENDIF
n2 = n
@@ -30675,7 +30805,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r45', '' )
ENDIF
n3 = n
@@ -30686,7 +30816,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg3,n3,x3,y3,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r45', '' )
ENDIF
DO iw = 1, nw-1
@@ -30750,6 +30880,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -30871,7 +31003,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r46', '' )
ENDIF
*** quantum yields (from jpl97)
@@ -30921,6 +31053,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -31048,7 +31182,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r47', '' )
ENDIF
ELSEIF(mabs .EQ. 2) THEN
@@ -31122,6 +31256,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -31251,7 +31387,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r101', '' )
ENDIF
ELSEIF(mabs .EQ. 2) THEN
@@ -31276,7 +31412,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r101', '' )
ENDIF
ENDIF
@@ -31336,6 +31472,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -31460,7 +31598,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r102', '' )
ENDIF
ELSEIF(mabs. EQ. 2) THEN
@@ -31484,7 +31622,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r102', '' )
ENDIF
ENDIF
@@ -31541,6 +31679,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -31664,7 +31804,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r103', '' )
ENDIF
ELSEIF(mabs .EQ. 2) THEN
@@ -31688,7 +31828,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r103', '' )
ENDIF
ENDIF
@@ -31744,6 +31884,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -31865,7 +32007,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r104', '' )
ENDIF
* quantum yields assumed to be 0.01 (upper limit)
@@ -31919,6 +32061,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -32041,7 +32185,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r105', '' )
ENDIF
ELSEIF (mabs .eq. 2) then
@@ -32065,7 +32209,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r105', '' )
ENDIF
ENDIF
@@ -32120,6 +32264,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -32242,7 +32388,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r106', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2, 0.,y2(1))
@@ -32250,7 +32396,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r106', '' )
ENDIF
* quantum yield = 1
@@ -32304,6 +32450,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -32426,7 +32574,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r107', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2, 0.,y2(1))
@@ -32434,7 +32582,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r107', '' )
ENDIF
* quantum yield = 1
@@ -32929,6 +33077,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -33045,7 +33195,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r111', '' )
ENDIF
* quantum yield = 1
@@ -33096,6 +33246,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -33219,7 +33371,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r112', '' )
ENDIF
ELSEIF(mabs .eq. 2) then
@@ -33242,7 +33394,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r112', '' )
ENDIF
ENDIF
@@ -33576,6 +33728,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -33690,7 +33844,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r115', '' )
ENDIF
qy = 1.
@@ -33725,6 +33879,8 @@ c INCLUDE 'params'
*= T 75 NO3-(aq) -> NO2- + O(3P) =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -33856,7 +34012,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r118', '' )
ENDIF
n2 = n
@@ -33867,7 +34023,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r118', '' )
ENDIF
elseif (mabs .eq. 2) then
@@ -33894,7 +34050,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r118', '' )
ENDIF
endif
@@ -33953,6 +34109,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -34069,7 +34227,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r119', '' )
ENDIF
* Quantum Yields from
@@ -34124,6 +34282,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -34250,7 +34410,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r120', '' )
ENDIF
CALL addpnt(x2,y2,kdata,n2,x2(1)*(1.-deltax),0.)
@@ -34260,7 +34420,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r120', '' )
ENDIF
* quantum yields from Harwood et al., at 308 nm
@@ -34316,6 +34476,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -34436,7 +34598,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r121', '' )
ENDIF
* quantum yields assumed unity
@@ -34488,6 +34650,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -34608,7 +34772,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r122', '' )
ENDIF
* quantum yields are pressure dependent between air number densities
@@ -34666,6 +34830,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -34787,7 +34953,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r123', '' )
ENDIF
* quantum yields assumed unity
@@ -34837,6 +35003,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -34955,7 +35123,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r124', '' )
ENDIF
* quantum yields assumed unity
@@ -35003,6 +35171,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -35142,7 +35312,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r125', '' )
ENDIF
DO iw = 1, nw-1
@@ -35217,6 +35387,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -35340,7 +35512,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r126', '' )
ENDIF
elseif (mabs .eq. 2) then
@@ -35363,7 +35535,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r126', '' )
ENDIF
endif
@@ -35413,6 +35585,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -35530,7 +35704,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r127', '' )
ENDIF
* quantum yields assumed unity
@@ -35578,6 +35752,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -35696,7 +35872,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r128', '' )
ENDIF
* quantum yields assumed unity
@@ -35745,6 +35921,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
C INCLUDE 'params'
@@ -35864,7 +36042,7 @@ C INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r129', '' )
ENDIF
* quantum yields assumed unity
@@ -35914,6 +36092,8 @@ C INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -36031,7 +36211,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r130', '' )
ENDIF
* quantum yields assumed unity
@@ -36078,6 +36258,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -36231,7 +36413,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg223,nn,x223,y223,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r131', '' )
ENDIF
nn = n
@@ -36242,7 +36424,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg243,nn,x243,y243,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r131', '' )
ENDIF
nn = n
@@ -36253,7 +36435,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg263,nn,x263,y263,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r131', '' )
ENDIF
nn = n
@@ -36264,7 +36446,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg298,nn,x298,y298,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r131', '' )
ENDIF
nn = n
@@ -36275,7 +36457,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg323,nn,x323,y323,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r131', '' )
ENDIF
nn = n
@@ -36286,7 +36468,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg343,nn,x343,y343,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r131', '' )
ENDIF
* quantum yields assumed unity
@@ -36361,6 +36543,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -36497,7 +36681,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg204,nn,x204,y204,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r132', '' )
ENDIF
nn = n296
@@ -36508,7 +36692,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg296,nn,x296,y296,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r132', '' )
ENDIF
nn = n378
@@ -36519,7 +36703,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg378,nn,x378,y378,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r132', '' )
ENDIF
* quantum yields assumed unity
@@ -36584,6 +36768,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -36704,7 +36890,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,nn,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r133', '' )
ENDIF
* quantum yields assumed unity
@@ -36756,6 +36942,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -36876,7 +37064,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,nn,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r134', '' )
ENDIF
* quantum yields assumed unity
@@ -36927,6 +37115,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -37047,7 +37237,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,nn,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r135', '' )
ENDIF
* quantum yields assumed unity
@@ -37096,6 +37286,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -37221,7 +37413,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,nn,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r136', '' )
ENDIF
* quantum yields assumed unity
@@ -37270,6 +37462,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -37388,7 +37582,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,nn,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r137', '' )
ENDIF
* quantum yields assumed unity
@@ -37438,6 +37632,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -37574,7 +37770,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n1,x1,y298,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j-1)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'pxCH2O', '' )
ENDIF
CALL addpnt(x2,tcoef,kdata,n2,x2(1)*(1.-deltax),0.)
@@ -37584,7 +37780,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n2,x2,tcoef,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j-1)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'pxCH2O', '' )
ENDIF
* quantum yields: Read, terminate, interpolate:
@@ -37609,7 +37805,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg3,n1,x1,qr,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j-1)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'pxCH2O', '' )
ENDIF
CALL addpnt(x2,qm,kdata,n2,x2(1)*(1.-deltax),qm(1))
@@ -37619,7 +37815,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg4,n2,x2,qm,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j-1)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'pxCH2O', '' )
ENDIF
* combine gridded quantities:
@@ -37697,6 +37893,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -37815,7 +38013,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,nn,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r138', '' )
ENDIF
* quantum yields assumed unity
@@ -37864,6 +38062,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -37982,7 +38182,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,nn,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r139', '' )
ENDIF
* quantum yields assumed unity
@@ -38031,6 +38231,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -38150,7 +38352,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r140', '' )
ENDIF
* compute temperature correction factors:
@@ -38222,6 +38424,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -38348,7 +38552,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r141', '' )
ENDIF
n2 = n
@@ -38359,7 +38563,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,n2,x2,y2,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r141', '' )
ENDIF
* quantum yield = 1
@@ -38413,6 +38617,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -38536,7 +38742,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r142', '' )
ENDIF
* quantum yield = 1
@@ -38585,6 +38791,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -38708,7 +38916,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r143', '' )
ENDIF
* quantum yield = 1
@@ -38757,6 +38965,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -38880,7 +39090,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,n1,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r144', '' )
ENDIF
* quantum yield = 1
@@ -38927,6 +39137,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -39044,7 +39256,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,nn,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r145', '' )
ENDIF
* quantum yields assumed unity
@@ -39095,6 +39307,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -39211,7 +39425,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg1,nn,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r146', '' )
ENDIF
* quantum yields
@@ -39234,7 +39448,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg2,nn,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r146', '' )
ENDIF
* combine
@@ -39281,6 +39495,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -39397,7 +39613,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,nn,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r147', '' )
ENDIF
* quantum yields
@@ -39446,6 +39662,8 @@ c INCLUDE 'params'
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -39562,7 +39780,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,nn,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r148', '' )
ENDIF
* quantum yields
@@ -39616,6 +39834,8 @@ c INCLUDE 'params'
*= and ReLACS3 mecanisms - March 2018 =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -39732,7 +39952,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r149', '' )
ENDIF
* quantum yields assumed to be 0.34
@@ -39789,6 +40009,8 @@ c INCLUDE 'params'
*= Routine added by M. Leriche for BALD in RACM2 mecanism - March 2018 =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -39904,7 +40126,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r150', '' )
ENDIF
* quantum yields assumed to be 0.06
@@ -39960,6 +40182,8 @@ c INCLUDE 'params'
*= Adapted from TUVLaMP original 05/98 - March 2018 =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -40076,7 +40300,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r151', '' )
ENDIF
* quantum yields from:
@@ -40138,6 +40362,8 @@ c INCLUDE 'params'
*= Adapted from TUVLaMP original 05/98 - March 2018 =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -40254,7 +40480,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x,y,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, jlabel(j)
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'r152', '' )
ENDIF
* quantum yields from:
@@ -40670,6 +40896,8 @@ CCC FILE setcld.f
*= wavelength =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -40799,7 +41027,9 @@ C grid (which has NLEVEL points: Z(1:NLEVEL) = AZ(*)
* asymmetry factor = 0.85
n = nlevel + 1
- if (n .gt. kdata) stop "SETCLD: not enough memory: KDATA"
+ if (n .gt. kdata)
+ & call Print_msg( NVERB_FATAL, 'GEN', 'setcld',
+ & 'not enough memory: KDATA' )
zd(1) = 0.
do 110, i = 2, n
zd(i) = 0.5*( z(i-1) + z(i) )
@@ -41184,8 +41414,8 @@ c INCLUDE 'params'
* Assumes that O2 = 20.95 % of air density. If desire different O2
* profile (e.g. for upper atmosphere) then can load it here.
- DO iz = 1, nz
- DO iw =1, nw - 1
+ DO iz = 1, nz-1
+ DO iw =1, nw - 1
dto2(iz,iw) = 0.2095 * cz(iz) * o2xs1(iw)
ENDDO
ENDDO
@@ -41488,6 +41718,8 @@ c INCLUDE 'params'
*= send email to: sasha@ucar.edu =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -41591,7 +41823,7 @@ c INCLUDE 'params'
CALL inter2(nw,wl,yg,n,x1,y1,ierr)
IF (ierr .NE. 0) THEN
WRITE(*,*) ierr, fil
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'rdice_acff', '' )
ENDIF
DO 13, l = 1, nw-1
@@ -42212,6 +42444,8 @@ CCC FILE swchem.f
*= defined =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -42634,7 +42868,7 @@ C CALL r145(nw,wl,wc,nz,tlev,airden,j,sq,jlabel,tpflag,kout)
****************************************************************
- IF (j .GT. kj) STOP '1002'
+ IF (j .GT. kj) call Print_msg( NVERB_FATAL, 'GEN', 'swchem', '' )
RETURN
END
@@ -42663,6 +42897,8 @@ CCC FILE vpair.f
*= altitude layer (column vertical increment =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
c INCLUDE 'params'
@@ -42803,7 +43039,8 @@ c INCLUDE 'params'
airlog(i) = ALOG(air(i))
ENDDO
- IF(z(nz) .GT. zd(nd)) STOP 'in vpair: ztop < zdata'
+ IF(z(nz) .GT. zd(nd)) call Print_msg( NVERB_FATAL, 'GEN',
+ & 'vpair', 'ztop < zdata' )
CALL inter1(nz,z,conlog, nd,zd,airlog)
DO i = 1, nz
@@ -42824,7 +43061,8 @@ c INCLUDE 'params'
* calculation is based on nz-1 layers (not nz).
col(nz-1) = col(nz-1) + 1.E5 * hscale * con(nz)
-
+ col(nz) = 0.
+
* Scale by input surface pressure:
* min value = 1 molec cm-2
@@ -42879,6 +43117,8 @@ CCC FILE vpo3.f
*= case it is necessary to convert from mixing ratio units (e.g. ppb). =*
*-----------------------------------------------------------------------------*
+ use mode_msg
+
IMPLICIT NONE
********
@@ -43053,7 +43293,9 @@ c INCLUDE 'params'
IF (to3new .GT. nzero) THEN
to3old = fsum(nz-1, col)/2.687e16
- IF(to3old .LT. pzero) STOP 'in vpo3: to3old is too small'
+ IF(to3old .LT. pzero)
+ & call Print_msg( NVERB_FATAL, 'GEN', 'vpo3',
+ & 'to3old is too small' )
scale = to3new/to3old
DO i = 1, nz-1
col(i) = col(i) * scale
diff --git a/src/MNH/ch_field_valuen.f90 b/src/MNH/ch_field_valuen.f90
index c20e8e8581a283fc09737ca555cc0541ed5334d3..0693c28a24b13c14162aebc939e5b5d80508adcc 100644
--- a/src/MNH/ch_field_valuen.f90
+++ b/src/MNH/ch_field_valuen.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
!! ############################
@@ -70,12 +70,16 @@ END MODULE MODI_CH_FIELD_VALUE_n
!! 11/08/98 (N. Asencio) add parallel code
!! 28/07/99 (V. Crassier & K. Suhre) modify initialization scheme (1-D)
!! 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
!!
!! EXTERNAL
!! --------
+USE MODD_IO, ONLY: TFILEDATA
+
+USE MODE_IO_FILE, ONLY: IO_File_close
+use mode_msg
+
USE MODI_CH_OPEN_INPUT ! open general purpose ASCII input file
-USE MODD_IO_ll, ONLY: TFILEDATA
-USE MODE_FM, ONLY: IO_FILE_CLOSE_ll
!!
!! IMPLICIT ARGUMENTS
!! ------------------
@@ -100,6 +104,7 @@ INTEGER, INTENT(IN) :: KVERB ! verbosity level
!
!* 0.2 declarations local variables
!
+character(len=10) :: yval ! String for error message
INTEGER :: JI, JJ ! loop control variables
INTEGER :: ICHANNEL ! I/O channel for file input
CHARACTER(LEN=40) :: YFORMAT ! format for input
@@ -169,7 +174,7 @@ firstcall: IF (GSFIRSTCALL) THEN
END IF
!
! close file
- CALL IO_FILE_CLOSE_ll(TZFILE)
+ CALL IO_File_close(TZFILE)
TZFILE => NULL()
!
! check if Z-profile is given in increasing order, otherwise stop
@@ -177,12 +182,10 @@ firstcall: IF (GSFIRSTCALL) THEN
DO JI = 2, ISLEVEL
IF (ZINF .GE. ZSZPROF(JI)) THEN
WRITE(KLUOUT,*) &
- "CH_FIELD_VALUE_n-Error: Z-profile must be in increasing order!"
+ "CH_FIELD_VALUE_n-Error: Z-profile must be in increasing order!"
WRITE(KLUOUT,*) " minimum value: ",ZINF," at level ",IINF
WRITE(KLUOUT,*) " current value: ",ZSZPROF(JI)," at level ",JI
- ! callabortstop
- CALL ABORT
- STOP "Program stopped by CH_FIELD_VALUE_n"
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_FIELD_VALUE_n', 'Z-profile must be in increasing order' )
ENDIF
ZINF = ZSZPROF(JI) ; IINF=JI
ENDDO
@@ -214,7 +217,7 @@ firstcall: IF (GSFIRSTCALL) THEN
ENDDO
!
! close file
- CALL IO_FILE_CLOSE_ll(TZFILE)
+ CALL IO_File_close(TZFILE)
TZFILE => NULL()
!
!
@@ -236,10 +239,7 @@ firstcall: IF (GSFIRSTCALL) THEN
WRITE(KLUOUT,*) "initial data is given as mixing ratio (part per par)"
END IF
ELSE
- WRITE(KLUOUT,*) "CH_FIELD_VALUE_n ERROR: unit type unknown: ", HUNIT
- ! callabortstop
- CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_FIELD_VALUE_n', 'unknown unit type: '//trim(HUNIT) )
ENDIF
!
! read number of initial values ISINIT
@@ -261,7 +261,7 @@ firstcall: IF (GSFIRSTCALL) THEN
ENDDO
!
! close file
- CALL IO_FILE_CLOSE_ll(TZFILE)
+ CALL IO_File_close(TZFILE)
TZFILE => NULL()
!
ENDIF firstcall
@@ -327,19 +327,13 @@ ENDDO search_loop
!* 2.5 check boundaries of IASSOACT and IINITACT
!
IF ((IASSOACT.LE.0).OR.(IASSOACT.GT.ISPROF)) THEN
- WRITE(KLUOUT,*) &
- "CH_FIELD_VALUE_n-ERROR: unproper associated profile value:", IASSOACT
- ! callabortstop
- CALL ABORT
- STOP
+ write( yval, '( I10 )' ) IASSOACT
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_FIELD_VALUE_n', 'invalid associated profile value: '//trim(yval) )
ENDIF
!
IF ((IINITACT.LE.0).OR.(IINITACT.GT.ISINIT)) THEN
- WRITE(KLUOUT,*) &
- "CH_FIELD_VALUE_n-ERROR: unproper associated initial value:", IINITACT
- ! callabortstop
- CALL ABORT
- STOP
+ write( yval, '( I10 )' ) IINITACT
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_FIELD_VALUE_n', 'invalid associated initial value: '//trim(yval) )
ENDIF
!
!* 2.6 linear interpolation between IZINDEX and IZINDEX+1,
diff --git a/src/MNH/ch_gauss.f90 b/src/MNH/ch_gauss.f90
index e26ede04a9b48730097f58ead1bd7e268f4b749e..4d974eeb49311d301a67e53ed2c1d000d5253186 100644
--- a/src/MNH/ch_gauss.f90
+++ b/src/MNH/ch_gauss.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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/05/18 13:07:25
-!-----------------------------------------------------------------
!! #############################
MODULE MODI_CH_GAUSS
!! #############################
@@ -58,10 +53,11 @@ END MODULE MODI_CH_GAUSS
!! -------------
!! Original 24/02/95 (adapted from FORTRAN77 version in tools.k)
!! 27/02/95 (K. Suhre) put in some more array syntax
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!! EXTERNAL
!! --------
-!! none
+use mode_msg
!! IMPLICIT ARGUMENTS
!! ------------------
@@ -109,14 +105,11 @@ elimination_loop : DO JJ = 1, KDIM
!* check for singulary matrix, print error message and stop
!* if this is requested by KFAIL (see above for possible values for KFAIL)
error : IF (ZMAX.LE.PPEPS) THEN
- IF (KFAIL.GE.0) THEN
- PRINT *, "Error message from subroutine CH_GAUSS: ", &
- "singulary matrix cannot be inverted!"
+ IF ( KFAIL > 0 ) THEN
+ call Print_msg( NVERB_WARNING, 'GEN', 'CH_GAUSS', 'singulary matrix cannot be inverted' )
ENDIF
- IF (KFAIL.EQ.0) THEN
- !callabortstop
- CALL ABORT
- STOP 1
+ IF ( KFAIL == 0 ) THEN
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_GAUSS', 'singulary matrix cannot be inverted' )
ENDIF
KFAIL = 1
RETURN
diff --git a/src/MNH/ch_ini_orilam.f90 b/src/MNH/ch_ini_orilam.f90
index be7064e272cc36faf426dc2cea4d193cde4699e9..a317f49cb71b239f231abcf4ada36fa7c681a3b6 100644
--- a/src/MNH/ch_ini_orilam.f90
+++ b/src/MNH/ch_ini_orilam.f90
@@ -1,13 +1,8 @@
-!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!ORILAM_LIC Copyright 1994-2019 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.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 chimie 2007/03/02 13:59:36
-!-----------------------------------------------------------------
!! ###########################
MODULE MODI_CH_INI_ORILAM
!! ###########################
@@ -64,26 +59,30 @@ END MODULE MODI_CH_INI_ORILAM
!! MODIFICATIONS
!! -------------
!! Original
-!!
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+!!
!! EXTERNAL
!! --------
!!
!! IMPLICIT ARGUMENTS
!! ------------------
-USE MODI_CH_AER_SOLV
-USE MODI_CH_AER_TRANS
USE MODD_CH_AEROSOL
-USE MODD_CSTS_DUST, ONLY : XDENSITY_DUST
USE MODD_CH_M9_n, ONLY : CNAMES
USE MODD_CST, ONLY : &
XPI & !Definition of pi
- ,XBOLTZ & ! Boltzman constant
+ ,XBOLTZ & ! Boltzman constant
,XAVOGADRO & ![molec/mol] avogadros number
,XG & ! Gravity constant
,XP00 & ! Reference pressure
,XMD & ![kg/mol] molar weight of air
,XRD & ! Gaz constant for dry air
,XCPD ! Cpd (dry air)
+USE MODD_CSTS_DUST, ONLY : XDENSITY_DUST
+!
+use mode_msg
+!
+USE MODI_CH_AER_SOLV
+USE MODI_CH_AER_TRANS
!
!* 0. DECLARATIONS
! ------------
@@ -106,6 +105,7 @@ CHARACTER(LEN=10), INTENT(IN) :: GSCHEME
!
!* 0.2 declarations of local variables
!
+character(len=10) :: yspec ! String for error message
REAL, DIMENSION(SIZE(PM,1),(JPMODE)*3) :: ZDMINTRA, ZDMINTER, ZDMCOND
REAL, DIMENSION(SIZE(PM,1),JPMODE) :: ZMASK, ZSOLORG
@@ -151,10 +151,8 @@ ENDDO
! verify that all array elements are defined
DO JI = 1, SIZE(XRHOI)
IF (XRHOI(JI) .LE. 0.0) THEN
- PRINT *, 'CH_AER_MOD_INIT ERROR: density for species ', JI, ' not defined'
- ! callabortstop
- CALL ABORT
- STOP 'CH_AER_MOD_INIT ERROR: density not defined'
+ write( yspec, '( I10 )' ) JI
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_AER_MOD_INIT', 'density for species '//trim(yspec)//' not defined' )
END IF
ENDDO
!
diff --git a/src/MNH/ch_init_budgetn.f90 b/src/MNH/ch_init_budgetn.f90
index a8f26864b055bd6bf5ebbc1778fec9826ac019a1..d84ff1f7584f5f3346a4691330d6b43a9ad0cdee 100644
--- a/src/MNH/ch_init_budgetn.f90
+++ b/src/MNH/ch_init_budgetn.f90
@@ -1,4 +1,9 @@
-!! ###########################
+!MNH_LIC Copyright 2016-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_INIT_BUDGET_n
!! ###########################
!!
@@ -43,16 +48,19 @@ END MODULE MODI_CH_INIT_BUDGET_n
!!
!! MODIFICATIONS
!! -------------
-!! Original October 2016
+!! Original October 2016
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
-USE MODD_CH_MNHC_n, ONLY: LUSECHAQ, CSPEC_BUDGET
-USE MODD_CH_M9_n, ONLY: CNAMES, NEQ
USE MODD_CH_BUDGET_n, ONLY: NEQ_BUDGET, CNAMES_BUDGET, NSPEC_BUDGET
+USE MODD_CH_M9_n, ONLY: CNAMES, NEQ
+USE MODD_CH_MNHC_n, ONLY: LUSECHAQ, CSPEC_BUDGET
USE MODD_DIAG_FLAG, ONLY : LCHEMDIAG, CSPEC_BU_DIAG
-!
+
+use mode_msg
+
IMPLICIT NONE
INTEGER, INTENT(IN) :: KLUOUT ! output listing channel
@@ -112,9 +120,7 @@ IF (YWORKSTR /= '') THEN
END IF
END DO
IF (GCHECKFAILED) THEN
- WRITE(KLUOUT,*) 'Wrong (misspelled) CSPEC_BUDGET encountered...ABORTING !'
- CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_INIT_BUDGET_n', 'wrong (misspelled) CSPEC_BUDGET encountered' )
END IF
ELSE
DEALLOCATE(CNAMES_BUDGET)
diff --git a/src/MNH/ch_init_constn.f90 b/src/MNH/ch_init_constn.f90
index 4e306a0d0cc20d25b62887b04d73214af10aa50b..8473c00837d381118840260e24f6ec926bad5c1a 100644
--- a/src/MNH/ch_init_constn.f90
+++ b/src/MNH/ch_init_constn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2001-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.
!-----------------------------------------------------------------
!! ################################
@@ -56,13 +56,13 @@ END MODULE MODI_CH_INIT_CONST_n
!! MODIFICATIONS
!! -------------
!! Original 16/02/01
-!! 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: 25/02/2019: bug correction for the file unit numbers
!! EXTERNAL
!! --------
USE MODI_CH_OPEN_INPUT ! open the general purpose ASCII input file
-USE MODD_IO_ll, ONLY: TFILEDATA
-USE MODE_FM, ONLY: IO_FILE_CLOSE_ll
+USE MODD_IO, ONLY: TFILEDATA
+USE MODE_IO_FILE, ONLY: IO_File_close
!!
!! IMPLICIT ARGUMENTS
@@ -111,7 +111,6 @@ CHARACTER(LEN=40), DIMENSION(:), ALLOCATABLE :: YHENRYNAME !species names
REAL , DIMENSION(:,:), ALLOCATABLE :: ZHENRYVAL
!chemical Henry constant value
!
-INTEGER :: IFAIL ! return code from CLOSE_ll
INTEGER :: JI, JN, JNREAL ! loop control variables
INTEGER :: INACT ! array pointer
TYPE(TFILEDATA),POINTER :: TZFILE
@@ -152,7 +151,7 @@ DO JI = 1, IMASS
END DO
!
! close file
-CALL IO_FILE_CLOSE_ll(TZFILE)
+CALL IO_File_close(TZFILE)
TZFILE => NULL()
!
!
@@ -206,7 +205,7 @@ DO JI = 1, IREACT
END DO
!
! close file
-CALL IO_FILE_CLOSE_ll(TZFILE)
+CALL IO_File_close(TZFILE)
TZFILE => NULL()
!
!
@@ -241,6 +240,7 @@ IF (KVERB >= 5) WRITE(KLUOUT,*) &
"CH_INIT_CONST: reading effective Henry constant", &
" and its temperature correction "
CALL CH_OPEN_INPUT(CCHEM_INPUT_FILE, "HENRY_SP", TZFILE, KLUOUT, KVERB)
+ICHANNEL = TZFILE%NLU
!
! read number of molecular diffusivity IHENRY
READ(ICHANNEL, *) IHENRY
@@ -263,7 +263,7 @@ DO JNREAL = 1, IHENRY
END DO
!
! close file
-CALL IO_FILE_CLOSE_ll(TZFILE)
+CALL IO_File_close(TZFILE)
TZFILE => NULL()
!
IF (KVERB >= 10) THEN
diff --git a/src/MNH/ch_init_meteo.f90 b/src/MNH/ch_init_meteo.f90
index 95191d0f658be26c4252a93ea3e3dda87a6b9606..74bc0ec52fe8d4b96788f301e38767e7b3cd6c48 100644
--- a/src/MNH/ch_init_meteo.f90
+++ b/src/MNH/ch_init_meteo.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
!! #########################
@@ -53,13 +53,14 @@ END MODULE MODI_CH_INIT_METEO
!! to interpolate between different forcings)
!! 01/12/03 (Gazen) change Chemical scheme interface
!! 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
!!
!!
!! EXTERNAL
!! --------
USE MODI_CH_OPEN_INPUT
-USE MODE_FM, ONLY: IO_FILE_CLOSE_ll
-USE MODE_IO_ll
+USE MODE_IO_FILE, ONLY: IO_File_close
+use mode_msg
!!
!! IMPLICIT ARGUMENTS
!! ------------------
@@ -79,8 +80,8 @@ TYPE(METEOTRANSTYPE), INTENT(OUT) :: TPM ! the meteo variables
!
!* 0.2 declaration of local variables
!
+character(len=10) :: ynum1, ynum2 ! Strings for error message
INTEGER :: JI, JJ ! loop control
-CHARACTER*80 :: YCOMMENT ! comment line in meteo update file
INTEGER :: IMETEOVARS ! number of meteovars to be read from file and
! checked against NMETEOVARS
INTEGER :: ILUMETEO
@@ -101,14 +102,10 @@ READ(ILUMETEO,*) NMETEORECS
!
! check if number of meteovars in file corresponds to what the CCS expects
IF (IMETEOVARS .NE. NMETEOVARS) THEN
- PRINT *, "CH_INIT_METEO ERROR: number of meteo variables in file does not"
- PRINT *, " correspond to the number expected by the CCS:"
- PRINT *, " IMETEOVARS read: ", IMETEOVARS
- PRINT *, " NMETEOVARS expected: ", NMETEOVARS
- PRINT *, "The program will be stopped now!"
- ! callabortstop
- CALL ABORT
- STOP 1
+ write( ynum1, '( I10 )' ) IMETEOVARS
+ write( ynum2, '( I10 )' ) NMETEOVARS
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_INIT_METEO', 'number of meteo variables in file '//trim(ynum1)// &
+ ' does not correspond to the number expected by the CCS'//trim(ynum2) )
END IF
! read names for TPM%CMETEOVAR
@@ -138,6 +135,6 @@ END DO
!
! close file
!
-CALL IO_FILE_CLOSE_ll(TMETEOFILE)
+CALL IO_File_close(TMETEOFILE)
!
END SUBROUTINE CH_INIT_METEO
diff --git a/src/MNH/ch_init_prodlosstotn.f90 b/src/MNH/ch_init_prodlosstotn.f90
index 05d669ad46796d2867fa21f8ab413d6244b78fb1..a5547a445f7a0bd24f688c5704d7a119ecb233bb 100644
--- a/src/MNH/ch_init_prodlosstotn.f90
+++ b/src/MNH/ch_init_prodlosstotn.f90
@@ -1,4 +1,9 @@
-!! ###########################
+!MNH_LIC Copyright 2016-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_INIT_PRODLOSSTOT_n
!! ###########################
!!
@@ -43,7 +48,8 @@ END MODULE MODI_CH_INIT_PRODLOSSTOT_n
!!
!! MODIFICATIONS
!! -------------
-!! Original October 2016
+!! Original October 2016
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -52,7 +58,10 @@ USE MODD_CH_MNHC_n, ONLY: LUSECHAQ, CSPEC_PRODLOSS
USE MODD_CH_M9_n, ONLY: CNAMES, NEQ
USE MODD_CH_PRODLOSSTOT_n, ONLY: NEQ_PLT, CNAMES_PRODLOSST, NIND_SPEC
USE MODD_DIAG_FLAG, ONLY : LCHEMDIAG, CSPEC_DIAG
-IMPLICIT NONE
+
+use mode_msg
+
+IMPLICIT NONE
INTEGER, INTENT(IN) :: KLUOUT ! output listing channel
!local variables
@@ -114,9 +123,7 @@ IF (YWORKSTR /= '') THEN
END IF
END DO
IF (GCHECKFAILED) THEN
- WRITE(KLUOUT,*) 'Wrong (misspelled) CSPEC encountered...ABORTING !'
- CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_INIT_PRODLOSSTOT_n', 'wrong (misspelled) CSPEC encountered' )
END IF
ELSE
DEALLOCATE(CNAMES_PRODLOSST)
diff --git a/src/MNH/ch_init_rosenbrock.f90 b/src/MNH/ch_init_rosenbrock.f90
index e239dcad698fcff6ca0f899e7461315a2fe0c0ef..d18187f8cfade5b41c26ab27ec8948ba94825fbf 100644
--- a/src/MNH/ch_init_rosenbrock.f90
+++ b/src/MNH/ch_init_rosenbrock.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2007-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 MODI_CH_INIT_ROSENBROCK
! ##############################
@@ -46,6 +47,7 @@ END MODULE MODI_CH_INIT_ROSENBROCK
!! MODIFICATIONS
!! -------------
!! Original 05/06/07
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!!
!! IMPLICIT ARGUMENTS
@@ -59,6 +61,8 @@ USE MODI_CH_SPARSE
!
USE MODD_CH_M9_n, ONLY: NEQ, NEQAQ, NNONZEROTERMS
USE MODD_CH_ROSENBROCK_n
+
+use mode_msg
!
!* 0. DECLARATIONS
! -----------------
@@ -118,7 +122,7 @@ JLL_Loop2: DO JLL = 1, NSPARSEDIM
WRITE(KLUOUT,*)"DIAGONAL ELEMENT IS FOUND FOR CHEMICAL COMPOUND"
WRITE(KLUOUT,*)"NUMBER: ",JLL," IN THE JACOBIAN MATRIX !!!"
WRITE(KLUOUT,*)"PLEASE MODIFY AND REPROCESS THE CHEMICAL SYSTEM"
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_INIT_ROSENBROCK', 'no diagonal element found for chemical compound' )
ENDIF
END DO
!
diff --git a/src/MNH/ch_linssa.f90 b/src/MNH/ch_linssa.f90
index e1e5b03d10c910819bffea663616cd1208f93d8b..e530c4541cefcc0e30044bee5b4013fe4c6f0a7d 100644
--- a/src/MNH/ch_linssa.f90
+++ b/src/MNH/ch_linssa.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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/05/18 13:07:25
-!-----------------------------------------------------------------
!! #####################
MODULE MODI_CH_LINSSA
!! #####################
@@ -65,9 +60,12 @@ SUBROUTINE CH_LINSSA(PTSIMUL, PDTACT, PCONC, PNEWCONC, KEQ, KVECNPT, KMI, &
!! -------------
!! Original 25/04/95
!! Modification 01/12/03 (Gazen) change Chemical scheme interface
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!! EXTERNAL
!! --------
+use mode_msg
+
USE MODI_CH_FCN
USE MODI_CH_JAC
USE MODI_CH_GAUSS
@@ -152,9 +150,7 @@ ENDDO
IFAIL = 1
CALL CH_GAUSS(ZWORK,ZINV,KEQ,IFAIL)
IF (IFAIL.NE.0) THEN
-! callabortstop
- CALL ABORT
- STOP 'CH_LinSSA ERROR: matrix cannot be inverted by CH_GAUSS'
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_LinSSA', 'matrix cannot be inverted by CH_GAUSS' )
ENDIF
!
!* 5. CALCULATE 1/2 * (P+I) * f^n
diff --git a/src/MNH/ch_meteo_trans_c2r2.f90 b/src/MNH/ch_meteo_trans_c2r2.f90
index f8265684b25786a03c85546485f4ef85366aedad..02c25bb7121a6322473a5dadc016198d286298dd 100644
--- a/src/MNH/ch_meteo_trans_c2r2.f90
+++ b/src/MNH/ch_meteo_trans_c2r2.f90
@@ -1,12 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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$
-!-----------------------------------------------------------------
!! ###############################
MODULE MODI_CH_METEO_TRANS_C2R2
!! ###############################
@@ -101,6 +97,7 @@ SUBROUTINE CH_METEO_TRANS_C2R2(KL, PRHODJ, PRHODREF, PRTSM, PCCTSM, PCRTSM, &
!! 14/05/08 (M. Leriche) include raindrops and cloud droplets mean radius
!! 05/06/08 (M. Leriche) calculate LWC and LWR in coherence with time spliting scheme
!! 05/11/08 (M. Leriche) split in two routines for 1-moment and 2-moment cloud schemes
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!! EXTERNAL
!! --------
@@ -126,6 +123,8 @@ USE MODD_RAIN_C2R2_DESCR, ONLY: XRTMIN, & ! min values of the water m. r.
XLBC, XLBEXC, & !shape param. of the cloud droplets
XLBR, XLBEXR !shape param. of the raindrops
!!
+use mode_msg
+
USE MODI_GAMMA
!
!-------------------------------------------------------------------------------
@@ -188,7 +187,8 @@ firstcall : IF (GSFIRSTCALL) THEN
WRITE(KLUOUT,*) " NMETEOVARS expected: ", NMETEOVARS
WRITE(KLUOUT,*) "Check the definition of NMETEOVARS in your .chf file."
WRITE(KLUOUT,*) "The program will be stopped now!"
- STOP 1
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_METEO_TRANS_C2R2', &
+ 'number of meteovars to transfer does not correspond to the expected number.' )
END IF
!
!* 1.2 initialize names of meteo vars
diff --git a/src/MNH/ch_meteo_trans_kess.f90 b/src/MNH/ch_meteo_trans_kess.f90
index fe2bf8559b09ddc7708e46e98adb5f440fbc70d4..74bd129b6cfcc6b745181566ad3e48e21e7d1771 100644
--- a/src/MNH/ch_meteo_trans_kess.f90
+++ b/src/MNH/ch_meteo_trans_kess.f90
@@ -1,12 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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$
-!-----------------------------------------------------------------
!! ###############################
MODULE MODI_CH_METEO_TRANS_KESS
!! ###############################
@@ -99,6 +95,7 @@ SUBROUTINE CH_METEO_TRANS_KESS(KL, PRHODJ, PRHODREF, PRTSM, PTHT, PABST, &
!! 14/05/08 (M. Leriche) include raindrops and cloud droplets mean radius
!! 05/06/08 (M. Leriche) calculate LWC and LWR in coherence with time spliting scheme
!! 05/11/08 (M. Leriche) split in two routines for 1-moment and 2-moment cloud schemes
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!! EXTERNAL
!! --------
@@ -125,6 +122,8 @@ USE MODD_RAIN_ICE_DESCR, ONLY: XNUC, XALPHAC, & !Cloud droplets distrib. param
XLBR, XLBEXR, & !shape param. of the raindrops
XCONC_LAND
!!
+use mode_msg
+
USE MODI_GAMMA
!
!-------------------------------------------------------------------------------
@@ -185,7 +184,8 @@ firstcall : IF (GSFIRSTCALL) THEN
WRITE(KLUOUT,*) " NMETEOVARS expected: ", NMETEOVARS
WRITE(KLUOUT,*) "Check the definition of NMETEOVARS in your .chf file."
WRITE(KLUOUT,*) "The program will be stopped now!"
- STOP 1
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_METEO_TRANS_KESS', &
+ 'number of meteovars to transfer does not correspond to the expected number.' )
END IF
!
!* 1.2 initialize names of meteo vars
diff --git a/src/MNH/ch_model0d.f90 b/src/MNH/ch_model0d.f90
index da17517f38e842ce610ddb0c91032566af4ee404..fbff58f803bca28cbadd31c2389c8b635a3f9a7d 100644
--- a/src/MNH/ch_model0d.f90
+++ b/src/MNH/ch_model0d.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ##################
@@ -81,10 +81,10 @@ USE MODD_CH_M9_n, ONLY: NEQ, NREAC, & ! no. of species & reactions
CNAMES, & ! names of chem. species
METEOTRANSTYPE ! TYPE of meteo struct variable
-USE MODD_CONF, ONLY : CPROGRAM
-USE MODD_CH_M9_SCHEME, ONLY : CCSTYPE,TACCS
+USE MODD_CONF, ONLY: CPROGRAM
+USE MODD_CH_M9_SCHEME, ONLY: CCSTYPE,TACCS
-USE MODE_IO_ll
+USE MODE_IO, only: IO_Init
USE MODE_MODELN_HANDLER
!!
!!
@@ -184,7 +184,7 @@ XCH_TUV_DOBNEW = 320. ! O3 dobson (to be modified)
!
!* 1. INITIALISATION
! -------------------
-CALL INITIO_ll()
+CALL IO_Init()
!
!* 1.1 read namelist and initialize time control variables
!
diff --git a/src/MNH/ch_monitorn.f90 b/src/MNH/ch_monitorn.f90
index fb7fda98074078b1bf06621026f8ffa7e4277d5a..c5357b6a18dd0e5275a5c866958cb60f0edba919 100644
--- a/src/MNH/ch_monitorn.f90
+++ b/src/MNH/ch_monitorn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!! ########################
MODULE MODI_CH_MONITOR_n
@@ -113,6 +113,8 @@ END MODULE MODI_CH_MONITOR_n
!! 20/01/17 (G.Delautier) bug if CPROGRAM/=DIAG
!! 01/10/17 (C.Lac) add correction of negativity
!! 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
!!
!! EXTERNAL
!! --------
@@ -142,6 +144,7 @@ USE MODI_CH_AER_DEPOS
!
USE MODE_ll
USE MODE_MODELN_HANDLER
+use mode_msg
!
USE MODI_WRITE_TS1D
USE MODD_CST, ONLY : XMNH_TINY
@@ -624,9 +627,7 @@ SELECT CASE (CCH_TDISCRETIZATION)
IF (KVERB >= 10) WRITE(KLUOUT,*) "CH_MONITOR_n: using LAGGED option"
CASE DEFAULT
! the following line should never be reached:
- ! callabortstop
- CALL ABORT
- STOP "CH_MONITOR_n: CCH_TDISCRETIZATION option not valid"
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_MONITOR_n', 'invalid CCH_TDISCRETIZATION option ('//trim(CCH_TDISCRETIZATION)//')' )
END SELECT
!
!
@@ -845,6 +846,8 @@ IF (LUSECHAQ.AND.(NRRL>=2) ) THEN
XRSVS(:,:,:,NSV_CHACBEG+NEQAQ/2:NSV_CHACEND),&
ZINPRR(:,:) )
END SELECT
+ ELSE
+ ZINPRR(:,:) = 0.
END IF
ELSE IF (LUSECHAQ.AND.(NRRL==1) ) THEN
CALL CH_AQUEOUS_CHECK (PTSTEP, XRHODREF, XRHODJ, XRRS, XRSVS, NRRL, &
diff --git a/src/MNH/ch_open_input.f90 b/src/MNH/ch_open_input.f90
index 86faf3c6f56f1acf3b50a7f7fc3aa94cb4294820..f4518dbe4f3deebb14034990a5450e7098345f33 100644
--- a/src/MNH/ch_open_input.f90
+++ b/src/MNH/ch_open_input.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 CH_OPEN_INPUT(HCHEM_INPUT_FILE,HKEYWORD,TPFILE,KLUOUT,KVERB)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
IMPLICIT NONE
!
@@ -39,13 +39,12 @@ SUBROUTINE CH_OPEN_INPUT(HCHEM_INPUT_FILE,HKEYWORD,TPFILE,KLUOUT,KVERB)
!!
!!** METHOD
!! ------
-!! An unused input channel is selected using OPEN_ll.
!! The file HCHEM_INPUT_FILE will be rewinded
!! at each call and data will be read in using (A8)-format until the
!! given keyword is found. The following comment line will then
!! be read and printed and the input channel number will be returned.
-!! After reading the needed data, the user must assure that the file
-!! will be closed and that the unit will be freed using CLOSE_ll.
+!! After reading the needed data, the user must ensure that the file
+!! will be closed.
!!
!! REFERENCE
!! ---------
@@ -61,6 +60,7 @@ SUBROUTINE CH_OPEN_INPUT(HCHEM_INPUT_FILE,HKEYWORD,TPFILE,KLUOUT,KVERB)
!! 05/08/96 (K. Suhre) restructured
!! 11/08/98 (N. Asencio) add parallel code
!! 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
!!
!!
!! IMPLICIT ARGUMENTS
@@ -73,10 +73,11 @@ SUBROUTINE CH_OPEN_INPUT(HCHEM_INPUT_FILE,HKEYWORD,TPFILE,KLUOUT,KVERB)
!* 0. DECLARATIONS
! ------------
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
-USE MODE_FM, ONLY: IO_FILE_OPEN_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST
+USE MODE_IO_FILE, ONLY: IO_File_open
+USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list
+use mode_msg
!
IMPLICIT NONE
!
@@ -92,7 +93,7 @@ INTEGER, INTENT(IN) :: KVERB ! verbosity level
!
CHARACTER(LEN=79) :: YIN ! character string for line-by-line read
INTEGER :: ILU
-INTEGER :: IRESP ! return code from OPEN_ll
+INTEGER :: IRESP ! return code from IO_File_open
!
!-------------------------------------------------------------------------------
!
@@ -102,17 +103,12 @@ TPFILE => NULL()
! -----------------------
!
IF (KVERB >= 5) WRITE(KLUOUT,*) "CH_OPEN_INPUT: opening file ", HCHEM_INPUT_FILE
-CALL IO_FILE_ADD2LIST(TPFILE,HCHEM_INPUT_FILE,'CHEMINPUT','READ',OOLD=.TRUE.)
-CALL IO_FILE_OPEN_ll(TPFILE,KRESP=IRESP)
+CALL IO_File_add2list(TPFILE,HCHEM_INPUT_FILE,'CHEMINPUT','READ',OOLD=.TRUE.)
+CALL IO_File_open(TPFILE,KRESP=IRESP)
ILU = TPFILE%NLU
!
IF (IRESP /= 0) THEN
- WRITE(KLUOUT,*) "CH_OPEN_INPUT ERROR: unable to open file", HCHEM_INPUT_FILE
- WRITE(KLUOUT,*) " IO_FILE_OPEN_ll return code is: ", IRESP
- WRITE(KLUOUT,*) " the program will be stopped now"
- ! callabortstop
- CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_OPEN_INPUT', 'unable to open file '//trim(HCHEM_INPUT_FILE) )
END IF
!
!-------------------------------------------------------------------------------
@@ -148,9 +144,6 @@ RETURN
! ---------------------------------------
!
100 CONTINUE
-WRITE(KLUOUT,*) "CH_OPEN_INPUT-Error: Keyword ", HKEYWORD(1:8), " not found."
-! callabortstop
-CALL ABORT
-STOP "Program stopped"
+call Print_msg( NVERB_FATAL, 'GEN', 'CH_OPEN_INPUT', 'keyword '//HKEYWORD(1:8)//' not found' )
!
END SUBROUTINE CH_OPEN_INPUT
diff --git a/src/MNH/ch_ph_polyroot.f90 b/src/MNH/ch_ph_polyroot.f90
index c041941588f47f8666268289c14d087e71435b1e..1ae312322653d95160aca63c61bb343769fc91e3 100644
--- a/src/MNH/ch_ph_polyroot.f90
+++ b/src/MNH/ch_ph_polyroot.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2007-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.
@@ -34,6 +34,7 @@ END MODULE MODI_CH_PH_POLYROOT
!! MODIFICATIONS
!! -------------
!! Original 26/03/07
+! P. Wautelet 22/02/2019: add kind parameter for CMPLX intrinsics (if not it default to single precision)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -66,10 +67,10 @@ ZZDEFLATED_COEF(:) = PPCOEF(:)
! First estimate of the roots
!
DO JJ=KORDER,1,-1
- ZROOT = CMPLX(0.0,0.0)
+ ZROOT = CMPLX(0.0d0,0.0d0,kind=kind(ZROOT))
CALL LAGUERRE(ZZDEFLATED_COEF, JJ, ZROOT, IITER)
IF( ABS(AIMAG(ZROOT))<=2.0*ZEPS**(2*ABS(REAL(ZROOT))) ) THEN
- ZROOT = CMPLX(REAL(ZROOT),0.0)
+ ZROOT = CMPLX(REAL(ZROOT,kind=kind(ZROOT)),0.0d0,kind=kind(ZROOT))
END IF
PPALL_ROOTS(JJ) = ZROOT
ZB = ZZDEFLATED_COEF(JJ+1)
@@ -125,8 +126,8 @@ CONTAINS
IITS = JITER
ZZB = PA(IM+1)
ZERR = ABS(ZZB)
- ZZD = CMPLX(0.0,0.0)
- ZZF = CMPLX(0.0,0.0)
+ ZZD = CMPLX(0.0d0,0.0d0,kind=kind(ZZD))
+ ZZF = CMPLX(0.0d0,0.0d0,kind=kind(ZZF))
ZABX = ABS(PX)
DO JJ=IM,1,-1
ZZF = PX*ZZF+ZZD
@@ -154,7 +155,7 @@ CONTAINS
IF(MAX(ZABP,ZABM) > 0.0) THEN
ZZDX = FLOAT(IM)/ZZGP
ELSE
- ZZDX = EXP(CMPLX(LOG(1.0+ZABX),FLOAT(JITER)))
+ ZZDX = EXP(CMPLX(LOG(1.0+ZABX),REAL(JITER,kind=kind(ZZDX)),kind=kind(ZZDX)))
END IF
END IF
ZZX1 = PX-ZZDX
diff --git a/src/MNH/ch_read_chem.f90 b/src/MNH/ch_read_chem.f90
index 56e358524ef66bf2c20ae111060a51c73bf657ad..bd3ed06dfc5da4908161c7f07ede175eaa09849e 100644
--- a/src/MNH/ch_read_chem.f90
+++ b/src/MNH/ch_read_chem.f90
@@ -1,6 +1,6 @@
!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
!! ########################
@@ -57,19 +57,24 @@ END MODULE MODI_CH_READ_CHEM
!! M.Leriche 2015 : masse molaire Black carbon à 12 g/mol
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! Philippe Wautelet: 10/01/2019: use newunit argument to open files
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!! EXTERNAL
!! --------
+use ISO_FORTRAN_ENV, only: IOSTAT_END
+
+USE MODE_IO_FILE, ONLY: IO_File_close
+use mode_msg
+!
USE MODI_CH_OPEN_INPUT
USE MODI_CH_READ_VECTOR
-USE MODD_IO_ll, ONLY: TFILEDATA
-USE MODE_FM, ONLY: IO_FILE_CLOSE_ll
!!
!! IMPLICIT ARGUMENTS
!! ------------------
-USE MODD_CH_MODEL0D, ONLY: NVERB
-USE MODD_CH_M9_n, ONLY: NEQ, CNAMES
USE MODD_CH_AEROSOL
+USE MODD_CH_M9_n, ONLY: NEQ, CNAMES
+USE MODD_CH_MODEL0D, ONLY: NVERB
+USE MODD_IO, ONLY: TFILEDATA
!!
!! EXPLICIT ARGUMENTS
!! ------------------
@@ -82,9 +87,12 @@ CHARACTER(LEN=*), INTENT(IN) :: HFILE ! name of the file to be read from
!
!! DECLARATION OF LOCAL VARIABLES
!! ------------------------------
+character(len=10) :: yval1, yval2
+character(len=256) :: yioerrmsg
CHARACTER(LEN=32) :: YVARNAME
CHARACTER(LEN=80) :: YINPUT
INTEGER :: ILU ! unit number for IO
+integer :: iresp
INTEGER :: JI, JJ, IIN
REAL :: ZMD
REAL, DIMENSION(NSP+NCARB+NSOA) :: ZMI ! aerosol molecular mass in g/mol
@@ -109,7 +117,7 @@ IF (HFILE(1:14) .EQ. "CHCONTROL1.nam") THEN
CALL CH_READ_VECTOR(NEQ, CNAMES, PCONC, 0.0, IIN, 6, NVERB)
IF (LORILAM) CALL CH_READ_VECTOR(SIZE(PAERO,1), CAERONAMES, PAERO, 0.0, IIN, 6, NVERB)
!
- CALL IO_FILE_CLOSE_ll(TZFILE)
+ CALL IO_File_close(TZFILE)
!
ELSE
!
@@ -123,36 +131,40 @@ ELSE
!
! read line by line and check variable names
!
- outer_loop : DO JI = 1, NEQ
- READ(UNIT=ILU,FMT=*,END=999) YVARNAME, PCONC(JI)
- check_loop : DO JJ = 1, 32
- IF (YVARNAME(JJ:JJ).NE.CNAMES(JI)(JJ:JJ)) THEN
- PRINT *, 'CH_READ_CHEM: Error: variable names do not match:'
- PRINT *, 'CNAMES = >>>', CNAMES(JI), '<<<'
- PRINT *, 'read = >>>', YVARNAME, '<<<'
-!callabortstop
- CALL ABORT
- STOP 'Program stopped by CH_READ_CHEM'
- ENDIF
- ENDDO check_loop
- ENDDO outer_loop
+ DO JI = 1, NEQ
+ READ( UNIT=ILU, FMT=*, iostat=iresp, iomsg=yioerrmsg ) YVARNAME, PCONC(JI)
+ if ( iresp == IOSTAT_END) then
+ write( yval1, '( I10 )' ) NEQ
+ write( yval2, '( I10 )' ) JI-1
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_READ_CHEM', 'not enough variables defined in file '//trim(HFILE)// &
+ ': number of gas lines in that file should be '//trim(yval1)//' but is '//trim(yval2) )
+ else if ( iresp/= 0 ) then
+ call Print_msg( NVERB_FATAL, 'IO', 'CH_READ_CHEM', 'when reading '//trim(HFILE)//': '//trim(yioerrmsg) )
+ end if
+ IF ( trim(YVARNAME) /= trim(CNAMES(JI)) ) THEN
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_READ_CHEM', 'variable names do not match: '//trim(CNAMES(JI))// &
+ ' /= '//trim(YVARNAME) )
+ END IF
+ END DO
!Conversion ppb to ppp
PCONC(:) = PCONC(:) * 1E-9
IF (LORILAM) THEN
- outer_loop2 : DO JI = 1, SIZE(PAERO,1)
- READ(UNIT=ILU,FMT=*,END=997) YVARNAME, PAERO(JI)
- check_loop2 : DO JJ = 1, 32
- IF (YVARNAME(JJ:JJ).NE.CAERONAMES(JI)(JJ:JJ)) THEN
- PRINT *, 'CH_READ_CHEM: Error: variable names do not match:'
- PRINT *, 'CAERONAMES = >>>', CAERONAMES(JI), '<<<'
- PRINT *, 'read = >>>', YVARNAME, '<<<'
-!callabortstop
- CALL ABORT
- STOP 'Program stopped by CH_READ_CHEM'
- ENDIF
- ENDDO check_loop2
- ENDDO outer_loop2
+ DO JI = 1, SIZE(PAERO,1)
+ READ( UNIT=ILU, FMT=*, iostat=iresp, iomsg=yioerrmsg ) YVARNAME, PAERO(JI)
+ if ( iresp == IOSTAT_END) then
+ write( yval1, '( I10 )' ) SIZE(PAERO,1)
+ write( yval2, '( I10 )' ) JI-1
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_READ_CHEM', 'not enough variables defined in file '//trim(HFILE)// &
+ ': number of aerosol lines in that file should be '//trim(yval1)//' but is '//trim(yval2) )
+ else if ( iresp/= 0 ) then
+ call Print_msg( NVERB_FATAL, 'IO', 'CH_READ_CHEM', 'when reading '//trim(HFILE)//': '//trim(yioerrmsg) )
+ end if
+ IF ( trim(YVARNAME) /= trim(CAERONAMES(JI)) ) THEN
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_READ_CHEM', 'variable names do not match: '//trim(CAERONAMES(JI))// &
+ ' /= '//trim(YVARNAME) )
+ END IF
+ END DO
!Conversion microgram/m3 to ppp
ZMD = 28.9644E-3
! Constants initialization
@@ -267,26 +279,6 @@ END IF
END IF
!
-RETURN
-!
!-----------------------------------------------------------------------------
!
-999 PRINT *, 'CH_READ_CHEM: Error: not enough variables defined in file', &
- HFILE
-PRINT *, 'number of gas lines in that file should be ', NEQ, &
- ', but is ', JI-1
-!callabortstop
-CALL ABORT
-STOP 'Program stopped by CH_READ_CHEM'
-!
-998 STOP "CH_READ_CHEM: ERROR - keyword INITCHEM not found in CHCONTROL1.nam"
-!
-997 PRINT *, 'CH_READ_CHEM: Error: not enough variables defined in file', &
- HFILE
-PRINT *, 'number of aerosols lines in that file should be ', SIZE(PAERO,1), &
- ', but is ', JI-1
-!callabortstop
-CALL ABORT
-STOP 'Program stopped by CH_READ_CHEM'
-!
END SUBROUTINE CH_READ_CHEM
diff --git a/src/MNH/ch_sis.f90 b/src/MNH/ch_sis.f90
index 746b70ad6e794d3675f19995b9a19b926a7ad73f..48fc332d5a919f24c53e5b7f10cfbd2ffc309884 100644
--- a/src/MNH/ch_sis.f90
+++ b/src/MNH/ch_sis.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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/05/18 13:07:25
-!-----------------------------------------------------------------
!! ##################
MODULE MODI_CH_SIS
!! ##################
@@ -60,9 +55,12 @@ END MODULE MODI_CH_SIS
!! Original 24/04/95
!! 31/07/96 (K. Suhre) restructured
!! 01/12/03 (D. Gazen) change Chemical scheme interface
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!! EXTERNAL
!! --------
+use mode_msg
+
USE MODI_CH_FCN
USE MODI_CH_JAC
USE MODI_CH_GAUSS
@@ -127,11 +125,7 @@ ENDDO
!
IFAIL = 1
CALL CH_GAUSS(ZWORK,ZINV,KEQ,IFAIL)
-IF (IFAIL.NE.0) THEN
-!callabortstop
-CALL ABORT
- STOP 'CH_SIS ERROR: matrix cannot be inverted by CH_GAUSS'
-ENDIF
+if ( ifail /= 0 ) call Print_msg( NVERB_FATAL, 'GEN', 'CH_SIS', 'matrix cannot be inverted by CH_GAUSS' )
!
!* 4. CALCULATE (1-dt/2 J^n)^-1 f^n
! -----------------------------------
diff --git a/src/MNH/ch_solve_ph.f90 b/src/MNH/ch_solve_ph.f90
index f9b994cdf4c09e497aaa3dc9d9e887cb9bbd09c0..5662675448f93e31415070fdd57f08e60b6e1b5e 100644
--- a/src/MNH/ch_solve_ph.f90
+++ b/src/MNH/ch_solve_ph.f90
@@ -1,12 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2007-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: /home//MESONH/MNH-V4-6-5/src/SRC_CHIMAQ/ch_solve_ph.f90
-!-----------------------------------------------------------------
!! #######################
MODULE MODI_CH_SOLVE_PH
!! #######################
@@ -63,6 +59,7 @@ END MODULE MODI_CH_SOLVE_PH
!! M. Leriche 16/11/07 add sulfuric acid
!! J.-P. Pinty 11/07/07 add CO3-- and SO3--
!! M. Leriche 05/06/08 add sum of ions
+! P. Wautelet 22/02/2019: add kind parameter for CMPLX intrinsics (if not it default to single precision)
!!
!! EXTERNAL
!! --------
@@ -217,9 +214,7 @@ ZCOEFS(:,2) = ZCOEFS(:,2) -2.0*(K11*K21*K3*KW*K22*(C1*K12+K12*C2))
!
ALLOCATE(ZZCOEFS(KLW,IORDER+1))
ALLOCATE(ZZROOTS(KLW,IORDER))
-DO JJ=1,IORDER+1
- ZZCOEFS(:,JJ) = CMPLX(ZCOEFS(:,JJ),0.0)
-END DO
+ZZCOEFS(:,:) = CMPLX(ZCOEFS(:,:),0.0d0,kind=kind(ZCOEFS(1,1)))
GPOLISH=.TRUE.
!
DO JI = 1, KLW
diff --git a/src/MNH/ch_solvern.f90 b/src/MNH/ch_solvern.f90
index 769b5800aa6ca8896afd6cdd23bc4f01eb8b8a93..92319876c0763dd461165ca4471372e62c8575a0 100644
--- a/src/MNH/ch_solvern.f90
+++ b/src/MNH/ch_solvern.f90
@@ -1,12 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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$
-!-----------------------------------------------------------------
!! #####################
MODULE MODI_CH_SOLVER_n
!! #####################
@@ -60,6 +56,7 @@ END MODULE MODI_CH_SOLVER_n
!! 01/12/03 (D. Gazen) change Chemical scheme interface
!! 01/06/07 (P. Tulet) model number in argument (for AROME)
!! 01/06/07 (JP Pinty & M Leriche) add Rosenbrock solvers
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!! EXTERNAL
!! --------
@@ -73,6 +70,8 @@ USE MODI_CH_EXQSSA
!@USE MODI_CH_D02EAF
!@USE MODI_CH_D02EBF
!@USE MODI_CH_D02NBF
+
+use mode_msg
USE MODE_RBK90_Integrator
!!
!! IMPLICIT ARGUMENTS
@@ -132,25 +131,19 @@ CASE ('D02EAF')
!
! call NAG's stiff-solver D02EAF
!@CALL CH_D02EAF(PTSIMUL, PDTACT, PCONC, PNEWCONC, KEQ, KMI)
-!callabortstop
-CALL ABORT
- STOP 'CH_SOLVER_n SORRY: requested solver currently not supported (CSOLVER)'
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_SOLVER_n', 'requested solver currently not supported (CSOLVER='//trim(CSOLVER)//')' )
!
CASE ('D02EBF')
!
! call NAG's stiff-solver D02EBF
!@CALL CH_D02EBF(PTSIMUL, PDTACT, PCONC, PNEWCONC, KEQ, KMI)
-!callabortstop
-CALL ABORT
- STOP 'CH_SOLVER_n SORRY: requested solver currently not supported (CSOLVER)'
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_SOLVER_n', 'requested solver currently not supported (CSOLVER='//trim(CSOLVER)//')' )
!
CASE ('D02NBF')
!
! call NAG's stiff-solver D02NBF
!@CALL CH_D02NBF(PTSIMUL, PDTACT, PCONC, PNEWCONC, KEQ, KMI)
-!callabortstop
-CALL ABORT
- STOP 'CH_SOLVER_n SORRY: requested solver currently not supported (CSOLVER)'
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_SOLVER_n', 'requested solver currently not supported (CSOLVER='//trim(CSOLVER)//')' )
!
CASE ('SVODE')
!
@@ -158,9 +151,7 @@ CASE ('SVODE')
! CALL CH_SVODE(PTSIMUL, PDTACT, PCONC, PNEWCONC, KEQ, KVECNPT, KMI, &
! XRTOL, XATOL, NPED)
-!callabortstop
-CALL ABORT
- STOP 'CH_SOLVER_n SORRY: requested solver currently not supported (CSOLVER) until Masdev47'
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_SOLVER_n', 'requested solver currently not supported (CSOLVER='//trim(CSOLVER)//')' )
!
CASE ('QSSA')
!
@@ -200,9 +191,7 @@ CASE ('NONE')
PNEWCONC(:,:) = PCONC(:,:)
!
CASE DEFAULT
-!callabortstop
-CALL ABORT
- STOP 'CH_SOLVER_n ERROR: requested solver not supported (CSOLVER)'
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_SOLVER_n', 'requested solver currently not supported (CSOLVER='//trim(CSOLVER)//')' )
END SELECT
!
END SUBROUTINE CH_SOLVER_n
diff --git a/src/MNH/ch_surface0d.f90 b/src/MNH/ch_surface0d.f90
index dd3a11ff3a02d9e94c24b4247b4fdc3c4ea98cbe..ce3bab6c4e23a9647273ec2e612fc1a38aaef8f8 100644
--- a/src/MNH/ch_surface0d.f90
+++ b/src/MNH/ch_surface0d.f90
@@ -252,8 +252,8 @@ CONTAINS
!
SUBROUTINE CH_SURFACE0D_SETPARAM
!
-USE MODD_IO_ll, ONLY: TFILEDATA
-USE MODE_FM, ONLY: IO_FILE_CLOSE_ll,IO_FILE_OPEN_ll
+USE MODD_IO, ONLY: TFILEDATA
+USE MODE_IO_FILE, ONLY: IO_File_close, IO_File_open
!
IMPLICIT NONE
!
@@ -302,15 +302,15 @@ IF (LSFIRSTCALL) THEN
LSFIRSTCALL = .FALSE.
CALL CH_OPEN_INPUT("SURFACE.nam", "SURFDATA", TZFILE, 6, NVERB)
ISURFIO = TZFILE%NLU
- CALL IO_FILE_CLOSE_ll(TZFILE)
+ CALL IO_File_close(TZFILE)
!
END IF
!
IF (PTSIMUL .GE. TNEXTUPDATE) THEN
PRINT *, "updating surface variables from file ",TRIM(TZFILE%CNAME)
- CALL IO_FILE_OPEN_ll(TZFILE)
+ CALL IO_File_open(TZFILE)
READ(ISURFIO,NAM_SURF)
- CALL IO_FILE_CLOSE_ll(TZFILE)
+ CALL IO_File_close(TZFILE)
! PRINT *, "current setting is:"
! WRITE(*,NAM_SURF)
TNEXTUPDATE = PTSIMUL + TVALID
diff --git a/src/MNH/ch_svode.f90 b/src/MNH/ch_svode.f90
index 9ed939503becdc3e2383ed2d41dee96123eb540c..07b5ca6301842232c123a34886986108d506f2e8 100644
--- a/src/MNH/ch_svode.f90
+++ b/src/MNH/ch_svode.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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/05/18 13:07:25
-!-----------------------------------------------------------------
!**FILE: ch_svode.f90
!**AUTHOR: Karsten Suhre
!**DATE: Fri Nov 10 09:17:45 GMT 1995
@@ -73,6 +68,7 @@ SUBROUTINE CH_SVODE(PTSIMUL, PDTACT, PCONC, PNEWCONC, KEQ, KVECNPT, KMI, &
!! Original 10/11/95
!! 01/08/01 (C. Mari) add arguments
!! 01/12/03 (D. Gazen) change Chemical scheme interface
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!! EXTERNAL
!! --------
@@ -83,7 +79,10 @@ SUBROUTINE CH_SVODE(PTSIMUL, PDTACT, PCONC, PNEWCONC, KEQ, KVECNPT, KMI, &
!! ------------------
!! EXPLICIT ARGUMENTS
!! ------------------
+use mode_msg
+
IMPLICIT NONE
+
REAL, INTENT(IN) :: PTSIMUL ! time of simulation
REAL, INTENT(IN) :: PDTACT ! actual time-step
INTEGER, INTENT(IN) :: KEQ ! dimension of the problem to solve
@@ -161,7 +160,7 @@ DO JI = 1, KVECNPT
IF (ISTATE.LT.0) THEN
PRINT *, "Problems !!! ISTATE = ", ISTATE
PRINT *, "at vector element ", JI, " out of ", KVECNPT
- STOP "CH_SVODE: program stopped due to SVODE error!"
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_SVODE', '' )
ENDIF
PNEWCONC(JI,:) = ZCONC(:)
diff --git a/src/MNH/ch_update_jvalues.f90 b/src/MNH/ch_update_jvalues.f90
index 5f2f0f7fa0772647152aec53676df314a562b4db..257c6e07da298c97677704946ea4fd887ec72b06 100644
--- a/src/MNH/ch_update_jvalues.f90
+++ b/src/MNH/ch_update_jvalues.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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/06/29 11:52:38
-!-----------------------------------------------------------------
!! #############################
MODULE MODI_CH_UPDATE_JVALUES
!! #############################
@@ -90,21 +85,24 @@ END MODULE MODI_CH_UPDATE_JVALUES
!! -------------
!! Original 05/03/97
!! 05/03/05 P. Tulet (CNRM/GMEI) Update for Arome
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!!------------------------------------------------------------------------------
!!
!! EXTERNAL
!! --------
+USE MODE_MODELN_HANDLER
+use mode_msg
+
USE MODI_CH_INTERP_JVALUES
USE MODI_CH_JVALUES_CLOUDS
-USE MODE_MODELN_HANDLER
!!
!! IMPLICIT ARGUMENTS
!! ------------------
-USE MODD_CST
-USE MODD_PARAMETERS
USE MODD_CH_INIT_JVALUES, ONLY : JPJVMAX
USE MODD_CONF
+USE MODD_CST
+USE MODD_PARAMETERS
!!
!! EXPLICIT ARGUMENTS
!! ------------------
@@ -180,13 +178,7 @@ IF (.NOT.ALLOCATED(ZSZA)) ALLOCATE(ZSZA(IIU,IJU))
IF (OCH_TUV_ONLINE) THEN
!
IF ((.NOT.L1D).OR.(CPROGRAM .EQ. "AROME")) THEN
- WRITE(KLUOUT,*)"ERROR in CH_UPDATE_JVALUES: "
- WRITE(KLUOUT,*)"you want to use ON-LINE calculation of photolysis rates "
- WRITE(KLUOUT,*)"but you are not runnning in 1D "
- WRITE(KLUOUT,*)"Program is STOPPED now "
-!callabortstop
-CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'CH_UPDATE_JVALUES', 'online computation of photolysis rates is only supported in 1D' )
ENDIF
!* 1. TUV 3D ON LINE
diff --git a/src/MNH/change_gribex_var.f90 b/src/MNH/change_gribex_var.f90
index 48a9741de41c7fdac18ca15f731ed4bc1698715b..0f4badbcd98c8f3280d2c46a7a704b8e51188ef8 100644
--- a/src/MNH/change_gribex_var.f90
+++ b/src/MNH/change_gribex_var.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
! #############################
MODULE MODI_CHANGE_GRIBEX_VAR
@@ -116,7 +116,7 @@ END MODULE MODI_CHANGE_GRIBEX_VAR
!! Module MODD_CONF1
!! NRR
!! Module MODD_LUNIT : contains logical unit names for all models
-!! CLUOUT0 : name of output-listing
+!! TLUOUT0 : name of output-listing
!! Module MODD_CST : contains physical constants
!! XRD : gas constant for dry air
!! XRV : gas constant for vapor
@@ -167,7 +167,7 @@ USE MODD_CONF
USE MODD_CONF_n
USE MODD_CST
USE MODD_GRID_n
-USE MODD_LUNIT, ONLY: CLUOUT0, TLUOUT0
+USE MODD_LUNIT, ONLY: TLUOUT0
USE MODD_PARAMETERS
USE MODD_REF
!
diff --git a/src/MNH/check_zhat.f90 b/src/MNH/check_zhat.f90
index a0027bb66d919c201d9a922ef3097ffab9255968..1f448756726f6a57cfc7517a6ada13b76da21d71 100644
--- a/src/MNH/check_zhat.f90
+++ b/src/MNH/check_zhat.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -45,7 +45,7 @@ END MODULE MODI_CHECK_ZHAT
!! 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
-!! CLUOUT0 : name of output-listing
+!! TLUOUT0 : name of output-listing
!! Module MODD_GRID1
!! XZHAT
!! Module MODD_DIM1
@@ -75,12 +75,12 @@ END MODULE MODI_CHECK_ZHAT
USE MODD_CONF
USE MODD_DIM_n
USE MODD_GRID_n
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT, ONLY: TLUOUT0
USE MODD_PARAMETERS
!
-USE MODE_FMREAD
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_FIND_BYNAME
+USE MODE_IO_FIELD_READ, only: IO_Field_read
+USE MODE_IO_MANAGE_STRUCT, only: IO_File_find_byname
!
IMPLICIT NONE
!
@@ -101,7 +101,7 @@ REAL :: ZLEN1 ! Decay scale for smooth topography
REAL :: ZLEN2 ! Decay scale for small-scale topography deviation
!
INTEGER :: IRESP ! return-code if problems occured
-INTEGER :: ILUOUT0 ! logical unit for file CLUOUT0
+INTEGER :: ILUOUT0 ! logical unit for file TLUOUT0
LOGICAL :: GTHINSHELL
TYPE(TFILEDATA),POINTER :: TZFMFILE
!
@@ -114,16 +114,16 @@ ILUOUT0 = TLUOUT0%NLU
!* 1. Reading grid and dimension
! --------------------------
!
-CALL IO_FILE_FIND_BYNAME(TRIM(HFMFILE),TZFMFILE,IRESP)
+CALL IO_File_find_byname(TRIM(HFMFILE),TZFMFILE,IRESP)
!
-CALL IO_READ_FIELD(TZFMFILE,'KMAX',IKMAX)
+CALL IO_Field_read(TZFMFILE,'KMAX',IKMAX)
ALLOCATE(ZZHAT(IKMAX+2*JPVEXT))
-CALL IO_READ_FIELD(TZFMFILE,'ZHAT',ZZHAT)
-CALL IO_READ_FIELD(TZFMFILE,'THINSHELL',GTHINSHELL)
+CALL IO_Field_read(TZFMFILE,'ZHAT',ZZHAT)
+CALL IO_Field_read(TZFMFILE,'THINSHELL',GTHINSHELL)
IF ( TZFMFILE%NMNHVERSION(1)<4 .OR. (TZFMFILE%NMNHVERSION(1)==4 .AND. TZFMFILE%NMNHVERSION(2)<=6) ) THEN
GSLEVE = .FALSE.
ELSE
- CALL IO_READ_FIELD(TZFMFILE,'SLEVE',GSLEVE)
+ CALL IO_Field_read(TZFMFILE,'SLEVE',GSLEVE)
ENDIF
!
!* 2. Check dimensions
@@ -171,8 +171,8 @@ END IF
! -------------------------------------
!
IF ( GSLEVE .AND. LSLEVE ) THEN
- CALL IO_READ_FIELD(TZFMFILE,'LEN1',ZLEN1)
- CALL IO_READ_FIELD(TZFMFILE,'LEN2',ZLEN2)
+ CALL IO_Field_read(TZFMFILE,'LEN1',ZLEN1)
+ CALL IO_Field_read(TZFMFILE,'LEN2',ZLEN2)
IF (ZLEN1 /= XLEN1 .OR. ZLEN2 /= XLEN2) THEN
HDAD_NAME=' '
WRITE (ILUOUT0,*) '********************************************************'
diff --git a/src/MNH/check_zs.f90 b/src/MNH/check_zs.f90
index 200ea82d929d9a70a12b8f04b31debc394dea1fd..bab0465120ad474c4b6770c312a913163383f691 100644
--- a/src/MNH/check_zs.f90
+++ b/src/MNH/check_zs.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 @@ END MODULE MODI_CHECK_ZS
!! 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
-!! CLUOUT0 : name of output-listing
+!! TLUOUT0 : name of output-listing
!! Module MODD_GRID1
!! XZS
!! Module MODD_DIM1
@@ -81,13 +81,13 @@ END MODULE MODI_CHECK_ZS
USE MODD_CONF
USE MODD_DIM_n
USE MODD_GRID_n
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT, ONLY: TLUOUT0
USE MODD_NESTING
USE MODD_PARAMETERS
!
-USE MODE_FMREAD
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_FIND_BYNAME
+USE MODE_IO_FIELD_READ, only: IO_Field_read
+USE MODE_IO_MANAGE_STRUCT, only: IO_File_find_byname
!
IMPLICIT NONE
!
@@ -105,7 +105,7 @@ INTEGER, INTENT(IN) :: KJINF ! domain, compared to the old
! ------------------------------
!
INTEGER :: IRESP ! return-code if problems occured
-INTEGER :: ILUOUT0 ! logical unit for file CLUOUT0
+INTEGER :: ILUOUT0 ! logical unit for file TLUOUT0
!
INTEGER :: IDXRATIO = 0 ! aspect ratios during previous
INTEGER :: IDYRATIO = 0 ! spawning (if any)
@@ -128,9 +128,9 @@ ILUOUT0 = TLUOUT0%NLU
!* 1. Reading of aspect ratios and dimensions
! ---------------------------------------
!
-CALL IO_FILE_FIND_BYNAME(TRIM(HFMFILE),TZFMFILE,IRESP)
+CALL IO_File_find_byname(TRIM(HFMFILE),TZFMFILE,IRESP)
!
-CALL IO_READ_FIELD(TZFMFILE,'DXRATIO',IDXRATIO,IRESP)
+CALL IO_Field_read(TZFMFILE,'DXRATIO',IDXRATIO,IRESP)
IF ( IRESP /= 0 .OR. IDXRATIO == 0 ) THEN
WRITE (ILUOUT0,*) '********************************************************'
WRITE (ILUOUT0,*) 'resolution ratio in x direction not present in fmfile; no nesting allowed'
@@ -139,7 +139,7 @@ IF ( IRESP /= 0 .OR. IDXRATIO == 0 ) THEN
RETURN
END IF
!
-CALL IO_READ_FIELD(TZFMFILE,'DYRATIO',IDYRATIO,IRESP)
+CALL IO_Field_read(TZFMFILE,'DYRATIO',IDYRATIO,IRESP)
IF ( IRESP /= 0 .OR. IDYRATIO == 0 ) THEN
WRITE (ILUOUT0,*) '********************************************************'
WRITE (ILUOUT0,*) 'resolution ratio in y direction not present in fmfile; no nesting allowed'
@@ -148,7 +148,7 @@ IF ( IRESP /= 0 .OR. IDYRATIO == 0 ) THEN
RETURN
END IF
!
-CALL IO_READ_FIELD(TZFMFILE,'XOR',NXOR_ALL(1),IRESP)
+CALL IO_Field_read(TZFMFILE,'XOR',NXOR_ALL(1),IRESP)
IF ( IRESP /= 0 ) THEN
WRITE (ILUOUT0,*) '********************************************************'
WRITE (ILUOUT0,*) 'position XOR not present in fmfile; no nesting allowed'
@@ -157,7 +157,7 @@ IF ( IRESP /= 0 ) THEN
RETURN
END IF
!
-CALL IO_READ_FIELD(TZFMFILE,'YOR',NYOR_ALL(1),IRESP)
+CALL IO_Field_read(TZFMFILE,'YOR',NYOR_ALL(1),IRESP)
IF ( IRESP /= 0 ) THEN
WRITE (ILUOUT0,*) '********************************************************'
WRITE (ILUOUT0,*) 'resolution YOR not present in fmfile; no nesting allowed'
@@ -166,11 +166,11 @@ IF ( IRESP /= 0 ) THEN
RETURN
END IF
!
-CALL IO_READ_FIELD(TZFMFILE,'IMAX',IIMAX)
-CALL IO_READ_FIELD(TZFMFILE,'JMAX',IJMAX)
+CALL IO_Field_read(TZFMFILE,'IMAX',IIMAX)
+CALL IO_Field_read(TZFMFILE,'JMAX',IJMAX)
!
ALLOCATE(ZZS(IIMAX+2*JPHEXT,IJMAX+2*JPHEXT))
-CALL IO_READ_FIELD(TZFMFILE,'ZS',ZZS)
+CALL IO_Field_read(TZFMFILE,'ZS',ZZS)
!
!* 2. Allocate coarse arrays
! ----------------------
@@ -236,7 +236,7 @@ END IF
!
IF (LSLEVE) THEN
!
- CALL IO_READ_FIELD(TZFMFILE,'ZSMT',ZZS)
+ CALL IO_Field_read(TZFMFILE,'ZSMT',ZZS)
!
!* 5. Average the smooth orographies
! ------------------------------
diff --git a/src/MNH/close_file_mnh.f90 b/src/MNH/close_file_mnh.f90
index 2bb13e611043f9a671d174a2756d387cab755550..6d3d87e4b3abbe45f7177c9b47771f7bd8f19088 100644
--- a/src/MNH/close_file_mnh.f90
+++ b/src/MNH/close_file_mnh.f90
@@ -54,12 +54,12 @@ END MODULE MODI_CLOSE_FILE_MNH
! ------------
!
USE MODD_CONF, ONLY: CPROGRAM
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_IO_NAM, ONLY: TFILE
USE MODD_LUNIT, ONLY: TLUOUT0
USE MODD_LUNIT_n, ONLY: TLUOUT
!
-USE MODE_FM, ONLY: IO_FILE_CLOSE_ll
+USE MODE_IO_FILE, ONLY: IO_File_close
USE MODE_MSG
!
IMPLICIT NONE
@@ -96,7 +96,7 @@ END SELECT
!
IF (ILUOUT==KUNIT) THEN
CALL PRINT_MSG(NVERB_DEBUG,'IO','CLOSE_FILE_MNH','called for '//TRIM(TZFILE%CNAME))
- CALL IO_FILE_CLOSE_ll(TZFILE)
+ CALL IO_File_close(TZFILE)
RETURN
END IF
!
@@ -110,7 +110,7 @@ IF (.NOT.ASSOCIATED(TFILE)) CALL PRINT_MSG(NVERB_FATAL,'IO','CLOSE_FILE_MNH','TF
CALL PRINT_MSG(NVERB_DEBUG,'IO','CLOSE_FILE_MNH','called for '//TRIM(TFILE%CNAME))
!
IF (TFILE%NLU==KUNIT) THEN
- CALL IO_FILE_CLOSE_ll(TFILE)
+ CALL IO_File_close(TFILE)
TFILE => NULL()
ELSE
WRITE(ILUOUT,*) 'Error for closing a file: '
diff --git a/src/MNH/clustering.f90 b/src/MNH/clustering.f90
index a42562bbb7640e36ba3f9d2f2cf0702691bbba1d..882de5a753ef9996e2b6b0aaed370d1d39bfd646 100644
--- a/src/MNH/clustering.f90
+++ b/src/MNH/clustering.f90
@@ -1,3 +1,8 @@
+!MNH_LIC Copyright 2013-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_CLUSTERING
! ################
@@ -60,13 +65,13 @@ END MODULE MODI_CLUSTERING
!
!* 0. DECLARATIONS
! ------------
- USE MODD_MPIF , ONLY : MPI_INTEGER
+USE MODD_ARGSLIST_ll, ONLY: LIST_ll
+USE MODD_DYN_n, ONLY: XDXHATM, XDYHATM
+USE MODD_MPIF , ONLY: MPI_INTEGER
+use MODD_PRECISION, only: MNHREAL_MPI
+USE MODD_VAR_ll, ONLY: NPROC, IP, NMNH_COMM_WORLD
+!
USE MODE_ll
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-USE MODD_VAR_ll, ONLY : MPI_PRECISION, NPROC, IP, NMNH_COMM_WORLD
-USE MODD_DYN_n, ONLY : XDXHATM, XDYHATM
-!USE&
-! MPI
!
IMPLICIT NONE
!
@@ -670,7 +675,7 @@ CALL MPI_ALLGATHERV(ILOCLISTLVL2, ICPT, MPI_INTEGER, IGLBLISTLVL, ICLUSNBR, IPRO
NMNH_COMM_WORLD, INFO)
CALL MPI_ALLGATHERV(ILOCLISTSEC2, ICPT, MPI_INTEGER, IGLBLISTSEC, ICLUSNBR, IPROCDPL, MPI_INTEGER, &
NMNH_COMM_WORLD, INFO)
-CALL MPI_ALLGATHERV(ZLOCLISTFLD2, ICPT, MPI_PRECISION, ZGLBLISTFLD, ICLUSNBR, IPROCDPL, MPI_PRECISION, &
+CALL MPI_ALLGATHERV(ZLOCLISTFLD2, ICPT, MNHREAL_MPI, ZGLBLISTFLD, ICLUSNBR, IPROCDPL, MNHREAL_MPI, &
NMNH_COMM_WORLD, INFO)
!
!* 6.3 EACH PROC COMPUTES GLOBAL SECTIONS AND FIELD AVERAGE OF ITS CLUSTERS
diff --git a/src/MNH/compare_dad.f90 b/src/MNH/compare_dad.f90
index 5446348efd96ba60b4c0b8ade73aef7b9c8aaec7..4efd6a8f42c57b2b6a6e606bbdd3f4fba22d9ebe 100644
--- a/src/MNH/compare_dad.f90
+++ b/src/MNH/compare_dad.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -43,8 +43,8 @@ END MODULE MODI_COMPARE_DAD
!! EXTERNAL
!! --------
!!
-!! IO_FILE_OPEN_ll : to open a FM-file (DESFM + LFIFM)
-!! IO_FILE_CLOSE_ll : to close a FM-file (DESFM + LFIFM)
+!! IO_File_open : to open a FM-file (DESFM + LFIFM)
+!! IO_File_close : to close a FM-file (DESFM + LFIFM)
!!
!!
!!
@@ -58,6 +58,7 @@ END MODULE MODI_COMPARE_DAD
!!
!! Original O8/04/04
!! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -65,15 +66,15 @@ END MODULE MODI_COMPARE_DAD
!
!
USE MODD_CONF
-USE MODD_IO_ll, ONLY: TFILEDATA
-USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODD_PARAMETERS, ONLY: JPHEXT,JPVEXT,NMNHNAMELGTMAX
+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_FM
-USE MODE_FMREAD
+USE MODE_FIELD, ONLY: TFIELDDATA,TFIELDLIST,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
-USE MODE_IO_MANAGE_STRUCT, ONLY : IO_FILE_ADD2LIST
+USE MODE_IO_MANAGE_STRUCT, ONLY : IO_File_add2list
!
!
IMPLICIT NONE
@@ -136,12 +137,12 @@ ZLATORI_2=0.
!* 2. Read DAD of initial file
! ------------------------
!
-CALL IO_FILE_ADD2LIST(TZDADINIFILE,TRIM(HDADINIFILE),'UNKNOWN','READ',KLFITYPE=2,KLFIVERB=NVERB)
-CALL IO_FILE_OPEN_ll(TZDADINIFILE)
+CALL IO_File_add2list(TZDADINIFILE,TRIM(HDADINIFILE),'MNH','READ',KLFITYPE=2,KLFIVERB=NVERB)
+CALL IO_File_open(TZDADINIFILE)
!
-CALL IO_READ_FIELD(TZDADINIFILE,'IMAX',IIMAX_1)
-CALL IO_READ_FIELD(TZDADINIFILE,'JMAX',IJMAX_1)
-CALL IO_READ_FIELD(TZDADINIFILE,'KMAX',IKMAX_1)
+CALL IO_Field_read(TZDADINIFILE,'IMAX',IIMAX_1)
+CALL IO_Field_read(TZDADINIFILE,'JMAX',IJMAX_1)
+CALL IO_Field_read(TZDADINIFILE,'KMAX',IKMAX_1)
!
IIU_1=IIMAX_1 + 2 * JPHEXT
IJU_1=IJMAX_1 + 2 * JPHEXT
@@ -150,32 +151,32 @@ IKU_1=IKMAX_1 + 2 * JPVEXT
ALLOCATE(ZXHAT_1(IIU_1))
ALLOCATE(ZYHAT_1(IJU_1))
ALLOCATE(ZZHAT_1(IKU_1))
-CALL IO_READ_FIELD(TZDADINIFILE,'XHAT',ZXHAT_1)
-CALL IO_READ_FIELD(TZDADINIFILE,'YHAT',ZYHAT_1)
-CALL IO_READ_FIELD(TZDADINIFILE,'ZHAT',ZZHAT_1)
+CALL IO_Field_read(TZDADINIFILE,'XHAT',ZXHAT_1)
+CALL IO_Field_read(TZDADINIFILE,'YHAT',ZYHAT_1)
+CALL IO_Field_read(TZDADINIFILE,'ZHAT',ZZHAT_1)
!
ALLOCATE(ZZS_1(IIU_1,IJU_1))
-CALL IO_READ_FIELD(TZDADINIFILE,'ZS',ZZS_1)
+CALL IO_Field_read(TZDADINIFILE,'ZS',ZZS_1)
!
-CALL IO_READ_FIELD(TZDADINIFILE,'LON0',ZLON0_1)
-CALL IO_READ_FIELD(TZDADINIFILE,'LAT0',ZLAT0_1)
-CALL IO_READ_FIELD(TZDADINIFILE,'BETA',ZBETA_1)
+CALL IO_Field_read(TZDADINIFILE,'LON0',ZLON0_1)
+CALL IO_Field_read(TZDADINIFILE,'LAT0',ZLAT0_1)
+CALL IO_Field_read(TZDADINIFILE,'BETA',ZBETA_1)
!
IF (.NOT.LCARTESIAN) THEN
- CALL IO_READ_FIELD(TZDADINIFILE,'RPK',ZRPK_1)
- CALL IO_READ_FIELD(TZDADINIFILE,'LATORI',ZLATORI_1)
- CALL IO_READ_FIELD(TZDADINIFILE,'LONORI',ZLONORI_1)
+ CALL IO_Field_read(TZDADINIFILE,'RPK',ZRPK_1)
+ CALL IO_Field_read(TZDADINIFILE,'LATORI',ZLATORI_1)
+ CALL IO_Field_read(TZDADINIFILE,'LONORI',ZLONORI_1)
!
IF (TZDADINIFILE%NMNHVERSION(1)<4 .OR. (TZDADINIFILE%NMNHVERSION(1)==4 .AND. TZDADINIFILE%NMNHVERSION(2)<=5) ) THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('LONORI',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CMNHNAME = 'LONOR'
- CALL IO_READ_FIELD(TZDADINIFILE,TZFIELD,ZLONORI_1)
+ CALL IO_Field_read(TZDADINIFILE,TZFIELD,ZLONORI_1)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('LATORI',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CMNHNAME = 'LATOR'
- CALL IO_READ_FIELD(TZDADINIFILE,TZFIELD,ZLATORI_1)
+ CALL IO_Field_read(TZDADINIFILE,TZFIELD,ZLATORI_1)
!
ZXHATM = - 0.5 * (ZXHAT_1(1)+ZXHAT_1(2))
ZYHATM = - 0.5 * (ZYHAT_1(1)+ZYHAT_1(2))
@@ -185,19 +186,19 @@ IF (.NOT.LCARTESIAN) THEN
END IF
ENDIF
!
-CALL IO_FILE_CLOSE_ll(TZDADINIFILE)
+CALL IO_File_close(TZDADINIFILE)
!
!-------------------------------------------------------------------------------
!
!* 3. Read DAD of spawning file
! ------------------------
!
-CALL IO_FILE_ADD2LIST(TZDADSPAFILE,TRIM(HDADSPAFILE),'UNKNOWN','READ',KLFITYPE=2,KLFIVERB=NVERB)
-CALL IO_FILE_OPEN_ll(TZDADSPAFILE)
+CALL IO_File_add2list(TZDADSPAFILE,TRIM(HDADSPAFILE),'MNH','READ',KLFITYPE=2,KLFIVERB=NVERB)
+CALL IO_File_open(TZDADSPAFILE)
!
-CALL IO_READ_FIELD(TZDADSPAFILE,'IMAX',IIMAX_2)
-CALL IO_READ_FIELD(TZDADSPAFILE,'JMAX',IJMAX_2)
-CALL IO_READ_FIELD(TZDADSPAFILE,'KMAX',IKMAX_2)
+CALL IO_Field_read(TZDADSPAFILE,'IMAX',IIMAX_2)
+CALL IO_Field_read(TZDADSPAFILE,'JMAX',IJMAX_2)
+CALL IO_Field_read(TZDADSPAFILE,'KMAX',IKMAX_2)
!
IIU_2=IIMAX_2 + 2 * JPHEXT
IJU_2=IJMAX_2 + 2 * JPHEXT
@@ -206,32 +207,32 @@ IKU_2=IKMAX_2 + 2 * JPVEXT
ALLOCATE(ZXHAT_2(IIU_2))
ALLOCATE(ZYHAT_2(IJU_2))
ALLOCATE(ZZHAT_2(IKU_2))
-CALL IO_READ_FIELD(TZDADSPAFILE,'XHAT',ZXHAT_2)
-CALL IO_READ_FIELD(TZDADSPAFILE,'YHAT',ZYHAT_2)
-CALL IO_READ_FIELD(TZDADSPAFILE,'ZHAT',ZZHAT_2)
+CALL IO_Field_read(TZDADSPAFILE,'XHAT',ZXHAT_2)
+CALL IO_Field_read(TZDADSPAFILE,'YHAT',ZYHAT_2)
+CALL IO_Field_read(TZDADSPAFILE,'ZHAT',ZZHAT_2)
!
ALLOCATE(ZZS_2(IIU_2,IJU_2))
-CALL IO_READ_FIELD(TZDADSPAFILE,'ZS',ZZS_2)
+CALL IO_Field_read(TZDADSPAFILE,'ZS',ZZS_2)
!
-CALL IO_READ_FIELD(TZDADSPAFILE,'LON0',ZLON0_2)
-CALL IO_READ_FIELD(TZDADSPAFILE,'LAT0',ZLAT0_2)
-CALL IO_READ_FIELD(TZDADSPAFILE,'BETA',ZBETA_2)
+CALL IO_Field_read(TZDADSPAFILE,'LON0',ZLON0_2)
+CALL IO_Field_read(TZDADSPAFILE,'LAT0',ZLAT0_2)
+CALL IO_Field_read(TZDADSPAFILE,'BETA',ZBETA_2)
!
IF (.NOT.LCARTESIAN) THEN
- CALL IO_READ_FIELD(TZDADSPAFILE,'RPK',ZRPK_2)
- CALL IO_READ_FIELD(TZDADSPAFILE,'LATORI',ZLATORI_2)
- CALL IO_READ_FIELD(TZDADSPAFILE,'LONORI',ZLONORI_2)
+ CALL IO_Field_read(TZDADSPAFILE,'RPK',ZRPK_2)
+ CALL IO_Field_read(TZDADSPAFILE,'LATORI',ZLATORI_2)
+ CALL IO_Field_read(TZDADSPAFILE,'LONORI',ZLONORI_2)
!
IF (TZDADSPAFILE%NMNHVERSION(1)<4 .OR. (TZDADSPAFILE%NMNHVERSION(1)==4 .AND. TZDADSPAFILE%NMNHVERSION(2)<=5)) THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('LONORI',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CMNHNAME = 'LONOR'
- CALL IO_READ_FIELD(TZDADSPAFILE,TZFIELD,ZLONORI_2)
+ CALL IO_Field_read(TZDADSPAFILE,TZFIELD,ZLONORI_2)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('LATORI',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CMNHNAME = 'LATOR'
- CALL IO_READ_FIELD(TZDADSPAFILE,TZFIELD,ZLATORI_2)
+ CALL IO_Field_read(TZDADSPAFILE,TZFIELD,ZLATORI_2)
!
ZXHATM = - 0.5 * (ZXHAT_2(1)+ZXHAT_2(2))
ZYHATM = - 0.5 * (ZYHAT_2(1)+ZYHAT_2(2))
@@ -241,7 +242,7 @@ IF (.NOT.LCARTESIAN) THEN
END IF
ENDIF
!
-CALL IO_FILE_CLOSE_ll(TZDADSPAFILE)
+CALL IO_File_close(TZDADSPAFILE)
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/compare_with_pgd_domain.f90 b/src/MNH/compare_with_pgd_domain.f90
index 1378b63dbe08ac4e2a7c6afd337f318ea5d454bf..028dc1f804370fa98bc4321bc5a5892b50cc1776 100644
--- a/src/MNH/compare_with_pgd_domain.f90
+++ b/src/MNH/compare_with_pgd_domain.f90
@@ -79,8 +79,6 @@ END MODULE MODI_COMPARE_WITH_PGD_DOMAIN
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FM
-USE MODE_IO_ll
USE MODE_MSG
!
USE MODD_CONF ! declaration modules
diff --git a/src/MNH/compute_bl89_ml.f90 b/src/MNH/compute_bl89_ml.f90
index ac8986c3df7b608442bd86a414a8496e3c99e9f1..20c9a078db5e550dbf3bb03cd2fcc6b13ddc89a5 100644
--- a/src/MNH/compute_bl89_ml.f90
+++ b/src/MNH/compute_bl89_ml.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
! ###########################
MODULE MODI_COMPUTE_BL89_ML
! ###########################
@@ -55,6 +56,7 @@ END MODULE MODI_COMPUTE_BL89_ML
!! S. Riette Jan 2012: support for both order of vertical levels and cleaning
!! R.Honnert Oct 2016 : Update with AROME
!! Q.Rodier 01/2019 : support RM17 mixing length as in bl89.f90
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!-------------------------------------------------------------------------------
!
@@ -74,6 +76,9 @@ END MODULE MODI_COMPUTE_BL89_ML
!
USE MODD_CTURB
USE MODD_PARAMETERS, ONLY: JPVEXT
+!
+use mode_msg
+!
USE MODI_SHUMAN_MF
!
IMPLICIT NONE
@@ -209,12 +214,7 @@ ENDIF
!
IF (OUPORDN.EQV..FALSE.) THEN
- IF(OFLUX) THEN
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' OFLUX OPTION NOT CODED FOR DOWNWARD MIXING LENGTH'
- CALL ABORT
- STOP
- ENDIF
+ IF(OFLUX) call Print_msg(NVERB_FATAL,'GEN','COMPUTE_BL89_ML','OFLUX option not coded for downward mixing length')
ZINTE(:)=PTKEM_DEP(:)
PLWORK=0.
ZTESTM=1.
diff --git a/src/MNH/compute_entr_detr.f90 b/src/MNH/compute_entr_detr.f90
index b7346fad93d7d261b08b2ec40e89ad1ed6ce95d1..da35fea05871eec70348a6e60de42ca8b85eef68 100644
--- a/src/MNH/compute_entr_detr.f90
+++ b/src/MNH/compute_entr_detr.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2009-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 MODI_COMPUTE_ENTR_DETR
@@ -120,6 +120,7 @@ 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
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -468,7 +469,7 @@ ENDDO
! 3.4 Computation of PENTR and PDETR
DO JLOOP=1,SIZE(OTEST)
IF(OTEST(JLOOP)) THEN
- ZEPSI_CLOUD=MIN(ZDELTA,ZEPSI)
+ ZEPSI_CLOUD(JLOOP)=MIN(ZDELTA(JLOOP),ZEPSI(JLOOP))
PENTR_CLD(JLOOP) = (1.-PPART_DRY(JLOOP))*ZCOEFFMF_CLOUD*PRHODREF(JLOOP)*ZEPSI_CLOUD(JLOOP)
PDETR_CLD(JLOOP) = (1.-PPART_DRY(JLOOP))*ZCOEFFMF_CLOUD*PRHODREF(JLOOP)*ZDELTA(JLOOP)
PENTR(JLOOP) = PENTR(JLOOP)+PENTR_CLD(JLOOP)
diff --git a/src/MNH/compute_exner_from_ground.f90 b/src/MNH/compute_exner_from_ground.f90
index 1edd2e25303d036e692c08dca4bd8629143914c6..cbb64d0376d42b3af52447f12503b78531513f23 100644
--- a/src/MNH/compute_exner_from_ground.f90
+++ b/src/MNH/compute_exner_from_ground.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #####################################
@@ -83,8 +83,6 @@ END MODULE MODI_COMPUTE_EXNER_FROM_GROUND3
!! 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
@@ -115,7 +113,6 @@ END MODULE MODI_COMPUTE_EXNER_FROM_GROUND3
!
USE MODD_CONF
USE MODD_CST
-USE MODD_LUNIT
USE MODD_PARAMETERS
!
USE MODI_SHUMAN
diff --git a/src/MNH/compute_exner_from_top.f90 b/src/MNH/compute_exner_from_top.f90
index 05f7c026b4ca3a1be69b626b9d29c57db6531b00..e195e725de1cf4e020487bbf3f2de6e052415b76 100644
--- a/src/MNH/compute_exner_from_top.f90
+++ b/src/MNH/compute_exner_from_top.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ##################################
@@ -81,8 +81,6 @@ END MODULE MODI_COMPUTE_EXNER_FROM_TOP3D
!! 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
@@ -113,7 +111,6 @@ END MODULE MODI_COMPUTE_EXNER_FROM_TOP3D
!
USE MODD_CONF
USE MODD_CST
-USE MODD_LUNIT
USE MODD_PARAMETERS
!
USE MODI_SHUMAN
diff --git a/src/MNH/compute_frac_ice.f90 b/src/MNH/compute_frac_ice.f90
index 0d3266baab1575d6dd40b60d409deb98dbe169fc..d7bfa581725a8bddafbb19d298c7633e70528a9a 100644
--- a/src/MNH/compute_frac_ice.f90
+++ b/src/MNH/compute_frac_ice.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 2006-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
+!-----------------------------------------------------------------
! ######spl
MODULE MODI_COMPUTE_FRAC_ICE
! ############################
@@ -250,6 +251,7 @@ END SUBROUTINE COMPUTE_FRAC_ICE2D
!! Original 13/03/06
!! S. Riette April 2011 optimisation
!! S. Riette 08/2016 add option O
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!! --------------------------------------------------------------------------
! 0. DECLARATIONS
@@ -286,9 +288,7 @@ ELSEIF (HFRAC_ICE=='N') THEN !No ice
ELSEIF (HFRAC_ICE=='S') THEN !Same as previous
!nothing to do
ELSE
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' INVALID OPTION IN COMPUTE_FRAC_ICE, HFRAC_ICE=',HFRAC_ICE
- CALL PRINT_MSG(NVERB_FATAL,'GEN','COMPUTE_FRAC_ICE','')
+ call Print_msg(NVERB_FATAL,'GEN','COMPUTE_FRAC_ICE','invalid option for HFRAC_ICE='//HFRAC_ICE)
ENDIF
PFRAC_ICE(:) = MAX( 0., MIN(1., PFRAC_ICE(:) ) )
diff --git a/src/MNH/compute_mf_cloud.f90 b/src/MNH/compute_mf_cloud.f90
index 03626f93092f9a31c5196520b0361bb0e370eb76..28ce08a6cd318ccd58bf8cf8460a1ae1fe0eff3c 100644
--- a/src/MNH/compute_mf_cloud.f90
+++ b/src/MNH/compute_mf_cloud.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2009-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 MODI_COMPUTE_MF_CLOUD
! ############################
@@ -99,14 +100,17 @@ END MODULE MODI_COMPUTE_MF_CLOUD
!! S. Riette Dec 2010 BIGA case
!! S. Riette Aug 2011 code is split into subroutines
!! S. Riette Jan 2012: support for both order of vertical levels
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+use mode_msg
+!
+USE MODI_COMPUTE_MF_CLOUD_BIGAUS
USE MODI_COMPUTE_MF_CLOUD_DIRECT
USE MODI_COMPUTE_MF_CLOUD_STAT
-USE MODI_COMPUTE_MF_CLOUD_BIGAUS
!
IMPLICIT NONE
@@ -186,11 +190,7 @@ ELSEIF (HMF_CLOUD == 'NONE') THEN
! No CONVECTIVE CLOUD SCHEME
! Nothing to do: PRC_MF, PRI_MF, PCF_MF, PSIGMF are already filled with zero
ELSE
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' Shallow convection cloud scheme not valid : HMF_CLOUD =',TRIM(HMF_CLOUD)
- CALL ABORT
- STOP
+ call Print_msg(NVERB_FATAL,'GEN','COMPUTE_MF_CLOUD','Shallow convection cloud scheme not valid: HMF_CLOUD='//TRIM(HMF_CLOUD))
ENDIF
-
END SUBROUTINE COMPUTE_MF_CLOUD
diff --git a/src/MNH/compute_r00.f90 b/src/MNH/compute_r00.f90
index 81249e6658c22d2668964f90fa49322809f91866..326ad848a66ed48e11a8d2e72c33669d74e77d53 100644
--- a/src/MNH/compute_r00.f90
+++ b/src/MNH/compute_r00.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 COMPUTE_R00(TPFILE)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
!
@@ -56,34 +56,33 @@ END MODULE MODI_COMPUTE_R00
!! change of YCOMMENT
!! Mai 2016 (G.Delautier) replace LG?M by LG?T
!! 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 11/04/2019: bugfix: nullify TZTRACFILE when appropriate
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
-!
-USE MODD_FIELD_n
+!
+USE MODD_CONF
USE MODD_GRID_n
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_FIELD_n
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT_n
-USE MODD_GRID_n
-USE MODD_STO_FILE
-USE MODD_CONF
+USE MODD_NSV, ONLY: NSV_LGBEG, NSV_LGEND
USE MODD_PARAMETERS
-USE MODD_NSV, ONLY : NSV_LGBEG,NSV_LGEND
-!
-USE MODI_SHUMAN
-!
+USE MODD_STO_FILE
+USE MODD_TYPE_DATE
USE MODD_VAR_ll
!
USE MODE_FIELD
-USE MODE_FM
-USE MODE_FMWRIT
-USE MODE_FMREAD
-USE MODE_IO_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY : IO_FILE_ADD2LIST
+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
+USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list
USE MODE_ll
USE MODE_MSG
-USE MODD_TYPE_DATE
+!
+USE MODI_SHUMAN
!
IMPLICIT NONE
!
@@ -123,6 +122,7 @@ TYPE(TFILEDATA),POINTER :: TZTRACFILE
!* 1.0 INITIALIZATION
! --------------
!
+TZTRACFILE => NULL()
ZSPVAL=-1.E+11
IKU=SIZE(XZHAT)
!
@@ -238,8 +238,9 @@ END IF
! is performed
DO JFILECUR=1,NFILES
!
- CALL IO_FILE_ADD2LIST(TZTRACFILE,CFILES(NBRFILES(JFILECUR)),'UNKNOWN','READ',KLFITYPE=2,KLFIVERB=NVERB)
- CALL IO_FILE_OPEN_ll(TZTRACFILE)
+ TZTRACFILE => NULL()
+ CALL IO_File_add2list(TZTRACFILE,CFILES(NBRFILES(JFILECUR)),'MNH','READ',KLFITYPE=2,KLFIVERB=NVERB)
+ CALL IO_File_open(TZTRACFILE)
!
!* 4.1 check if this file is a start instant
!
@@ -256,7 +257,7 @@ DO JFILECUR=1,NFILES
!
IF (GSTART) THEN
!
- CALL IO_READ_FIELD(TZTRACFILE,'DTCUR',TDTCUR_START)
+ CALL IO_Field_read(TZTRACFILE,'DTCUR',TDTCUR_START)
IHOUR = INT(TDTCUR_START%TIME/3600.)
ZREMAIN = MOD(TDTCUR_START%TIME,3600.)
IMINUTE = INT(ZREMAIN/60.)
@@ -264,9 +265,9 @@ DO JFILECUR=1,NFILES
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
!
- CALL IO_READ_FIELD(TZTRACFILE,'THT',ZTH0(:,:,:))
+ CALL IO_Field_read(TZTRACFILE,'THT',ZTH0(:,:,:))
!
- CALL IO_READ_FIELD(TZTRACFILE,'RVT',ZRV0(:,:,:))
+ CALL IO_Field_read(TZTRACFILE,'RVT',ZRV0(:,:,:))
ZRV0(:,:,:)=ZRV0(:,:,:)*1.E+3 ! ZRV0 in g/kg
!
END IF
@@ -287,7 +288,7 @@ DO JFILECUR=1,NFILES
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZX00(:,:,:))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZX00(:,:,:))
!
WRITE(TZFIELD%CMNHNAME,'(A2,I2.2)')'Y0',INBR_START
TZFIELD%CSTDNAME = ''
@@ -300,7 +301,7 @@ DO JFILECUR=1,NFILES
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZY00(:,:,:))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZY00(:,:,:))
!
WRITE(TZFIELD%CMNHNAME,'(A2,I2.2)')'Z0',INBR_START
TZFIELD%CSTDNAME = ''
@@ -313,7 +314,7 @@ DO JFILECUR=1,NFILES
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZZ00(:,:,:))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZZ00(:,:,:))
END IF
!
!
@@ -342,7 +343,7 @@ DO JFILECUR=1,NFILES
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK1(:,:,:))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK1(:,:,:))
!
WRITE(TZFIELD%CMNHNAME,'(A3,I2.2)')'RV0',INBR_START
TZFIELD%CSTDNAME = ''
@@ -355,7 +356,7 @@ DO JFILECUR=1,NFILES
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK2(:,:,:))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK2(:,:,:))
ENDIF
!* 4.4 compute the origin of the particules using one more segment
!
@@ -371,17 +372,17 @@ DO JFILECUR=1,NFILES
!
TZFIELD%CMNHNAME = 'LGXT'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- CALL IO_READ_FIELD(TZTRACFILE,TZFIELD,ZX0)
+ CALL IO_Field_read(TZTRACFILE,TZFIELD,ZX0)
ZX0(:,:,:)=ZX0(:,:,:)*1.E-3 ! ZX0 in km
!
TZFIELD%CMNHNAME = 'LGYT'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- CALL IO_READ_FIELD(TZTRACFILE,TZFIELD,ZY0)
+ CALL IO_Field_read(TZTRACFILE,TZFIELD,ZY0)
ZY0(:,:,:)=ZY0(:,:,:)*1.E-3 ! ZY0 in km
!
TZFIELD%CMNHNAME = 'LGZT'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- CALL IO_READ_FIELD(TZTRACFILE,TZFIELD,ZZ0)
+ CALL IO_Field_read(TZTRACFILE,TZFIELD,ZZ0)
ZZ0(:,:,:)=ZZ0(:,:,:)*1.E-3 ! ZZ0 in km
!
! old position of the set of particles
@@ -417,7 +418,7 @@ DO JFILECUR=1,NFILES
!
!* 4.5 close the input file
!
- CALL IO_FILE_CLOSE_ll(TZTRACFILE)
+ CALL IO_File_close(TZTRACFILE)
!
END DO
!
diff --git a/src/MNH/compute_spectre.f90 b/src/MNH/compute_spectre.f90
index 6a31130f07b6813137c6e781faf88fa1c42ee87a..9d5237cac7daa7a8645488c97266e90a17b9e80f 100644
--- a/src/MNH/compute_spectre.f90
+++ b/src/MNH/compute_spectre.f90
@@ -61,8 +61,6 @@ USE MODD_CONF
USE MODE_ll
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODE_FM
-USE MODE_IO_ll
USE MODE_MSG
USE MODE_SPLITTINGZ_ll
!
diff --git a/src/MNH/compute_updraft_hrio.f90 b/src/MNH/compute_updraft_hrio.f90
index 6ec162b20d6bd4c14587325a2e5e4c266ca4dc19..8086333465e5cd97bfc66dacda454c363555e725 100644
--- a/src/MNH/compute_updraft_hrio.f90
+++ b/src/MNH/compute_updraft_hrio.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
! ###########################
@@ -135,6 +136,7 @@ END MODULE MODI_COMPUTE_UPDRAFT_HRIO! ######spl
!! 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
@@ -150,6 +152,8 @@ 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
@@ -394,7 +398,7 @@ PSV_DO(:,:,:)=0.
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
+! print*,OENTR_DETR
!------------------------
IF (OENTR_DETR) THEN
ZTHM_F (:,:) = MZM_MF(KKA,KKU,KKL,PTHM (:,:))
@@ -767,7 +771,8 @@ DO JK=KKB,KKE-KKL,KKL
! 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))) STOP 'probleme ici'
+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)
@@ -858,6 +863,6 @@ ENDDO ! boucle JK
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"
+! print*,"je sors de compute_updraft"
END SUBROUTINE COMPUTE_UPDRAFT_HRIO
diff --git a/src/MNH/convect_updraft.f90 b/src/MNH/convect_updraft.f90
index a363aec976b3d5bb2a17f22fa6a2c3c4ee6e64f2..d860b62401954899c0df857b3178df86e8ea38c3 100644
--- a/src/MNH/convect_updraft.f90
+++ b/src/MNH/convect_updraft.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 conv 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! #################
MODULE MODI_CONVECT_UPDRAFT
! #################
diff --git a/src/MNH/deallocate_model1.f90 b/src/MNH/deallocate_model1.f90
index 9a3b3a5c12ce8474778eaff273f99e3a1e3c701d..11a577e2e5a77f04b0ea4f0f24009235b5f51312 100644
--- a/src/MNH/deallocate_model1.f90
+++ b/src/MNH/deallocate_model1.f90
@@ -66,6 +66,7 @@ END MODULE MODI_DEALLOCATE_MODEL1
!! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -187,6 +188,10 @@ IF ( ASSOCIATED(XCLDFR) .AND. KCALL==2 ) THEN
DEALLOCATE(XCLDFR)
END IF
!
+IF ( ASSOCIATED(XRAINFR) .AND. KCALL==2 ) THEN
+ DEALLOCATE(XRAINFR)
+END IF
+!
IF ( KCALL == 3 ) THEN
DEALLOCATE(XSVT)
END IF
diff --git a/src/MNH/default_desfmn.f90 b/src/MNH/default_desfmn.f90
index 2632f9f08f9de9c63dc9dd42533becb31d1c5b93..9c7cbcb5bc7fc9f526fb80dcdc91661a9bbe26ca 100644
--- a/src/MNH/default_desfmn.f90
+++ b/src/MNH/default_desfmn.f90
@@ -227,6 +227,7 @@ END MODULE MODI_DEFAULT_DESFM_n
!! 01/2018 (J.Colin) add VISC and DRAG
!! 07/2017 (V. Vionnet) add blowing snow variables
!! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -1371,7 +1372,6 @@ IF (KMI == 1) THEN ! other values initialized in modd_dust
LDEPOS_DST(:) = .FALSE.
LSALT = .FALSE.
- NMODE_SLT = 3
LVARSIG_SLT= .FALSE.
LSEDIMSALT = .FALSE.
LDEPOS_SLT(:) = .FALSE.
diff --git a/src/MNH/define_maskn.f90 b/src/MNH/define_maskn.f90
index a22147d5536faa03ee9f1221c6ee7ee3e267a4ab..abd56bf02b2932733f88c05d04b72af9265004f0 100644
--- a/src/MNH/define_maskn.f90
+++ b/src/MNH/define_maskn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ########################
@@ -63,8 +63,6 @@ USE MODD_LUNIT
USE MODD_NESTING
USE MODD_NEST_PGD_n
!
-USE MODE_FM
-USE MODE_IO_ll
USE MODE_MSG
USE MODE_MODELN_HANDLER
!
diff --git a/src/MNH/detect_field_mnh.f90 b/src/MNH/detect_field_mnh.f90
index 1b4fc3b3cd8d103b29915d066ab8bb070c3fd4bb..8d94c1c35728634e2f1dae8c174bc2eb6fe702ca 100644
--- a/src/MNH/detect_field_mnh.f90
+++ b/src/MNH/detect_field_mnh.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2003-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 surfex 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! #####################
MODULE MODI_DETECT_FIELD_MNH
! #####################
@@ -72,15 +67,13 @@ SUBROUTINE DETECT_FIELD_MNH(HPROGRAM,KI,KJ,PFIELD,OITSHERE)
!
!
!
-USE MODE_FM
+USE MODD_PARAMETERS, ONLY: XUNDEF, JPHEXT
+USE MODD_IO_SURF_MNH, ONLY: NMASK, NIU, NJU, NIB, NJB, NIE, NJE
+!
USE MODE_ll
-USE MODE_IO_ll
-
-USE MODD_PARAMETERS, ONLY : XUNDEF, JPHEXT
!
-USE MODD_IO_SURF_MNH, ONLY : NMASK, NIU, NJU, NIB, NJB, NIE, NJE
-
USE MODI_UNPACK_1D_2D
+!
IMPLICIT NONE
!
!* 0.1 declarations of arguments
diff --git a/src/MNH/diag.f90 b/src/MNH/diag.f90
index 35bf35b9affda53a7d54c5437c516397d42c8637..93b355bd51876b3a7c9ae170af87d4fb8d0bb0af 100644
--- a/src/MNH/diag.f90
+++ b/src/MNH/diag.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ############
@@ -88,6 +88,9 @@
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! V.Vionnet 07/2017 add LWIND_CONTRAV
!! 11/2017 (D. Ricard, P. Marquet) add diagnostics for THETAS
+! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list
+! P. Wautelet 11/02/2019: added missing use of MODI_CH_MONITOR_n
+! P. Wautelet 28/03/2019: use MNHTIME for time measurement variables
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -105,9 +108,9 @@ USE MODD_DYN
USE MODD_DYN_n
USE MODD_FIELD_n
USE MODD_GR_FIELD_n
-USE MODD_GRID, ONLY: XLONORI,XLATORI
+USE MODD_GRID, ONLY: XLONORI, XLATORI
USE MODD_GRID_n
-USE MODD_IO_ll, ONLY: CIO_DIR,NIO_VERB,NVERB_DEBUG,TFILEDATA,TFILE_SURFEX
+USE MODD_IO, ONLY: CIO_DIR, NIO_VERB, NVERB_DEBUG, TFILEDATA, TFILE_SURFEX
USE MODD_LBC_n
USE MODD_LES
USE MODD_LES_BUDGET
@@ -123,6 +126,7 @@ USE MODD_PARAM_LIMA, ONLY: LLIMA_DIAG
USE MODD_PARAM_MFSHALL_n
USE MODD_PARAM_n
USE MODD_PARAM_RAD_n
+use modd_precision, only: LFIINT, MNHTIME
USE MODD_PROFILER_n
USE MODD_RADAR
USE MODD_RADIATIONS_n
@@ -135,11 +139,10 @@ USE MODD_TURB_n
USE MODD_VAR_ll
!
USE MODE_DATETIME
-USE MODE_FM
-USE MODE_FMREAD
-USE MODE_FMWRIT, ONLY: IO_WRITE_HEADER
-USE MODE_IO_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST,IO_FILE_PRINT_LIST
+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_ll
USE MODE_MNH_TIMING
USE MODE_MODELN_HANDLER
@@ -148,6 +151,7 @@ USE MODE_POS
USE MODE_TIME
!
USE MODI_AIRCRAFT_BALLOON
+USE MODI_CH_MONITOR_n
USE MODI_COMPUTE_R00
USE MODI_DIAG_SURF_ATM_N
USE MODI_INIT_MNH
@@ -182,10 +186,10 @@ CHARACTER (LEN=4) :: YTURB ! initial flag to call to turbulence schemes
CHARACTER (LEN=40) :: YFMT,YFMT2! format for cpu analysis printing
INTEGER :: IRESP ! return code in FM routines
INTEGER :: ILUOUT0 ! Logical unit number for the output listing
-REAL*8,DIMENSION(2) :: ZTIME0,ZTIME1,ZTIME2,ZRAD,ZDCONV,ZSHADOWS,ZGROUND, &
- ZTRACER,ZDRAG,ZTURB,ZMAFL,ZCHEM,ZTIME_BU ! CPU time
-REAL*8,DIMENSION(2) :: ZSTART,ZINIT,ZWRIT,ZBALL,ZPHYS,ZSURF,ZWRITS,ZTRAJ ! storing variables
-INTEGER(KIND=LFI_INT) :: INPRAR ! number of articles predicted in the LFIFM file
+REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME0, ZTIME1, ZTIME2, ZRAD, ZDCONV, ZSHADOWS, ZGROUND, &
+ ZTRACER, ZDRAG, ZTURB, ZMAFL, ZCHEM, ZTIME_BU ! 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
@@ -244,7 +248,7 @@ CALL GOTO_MODEL(1)
CALL VERSION
CPROGRAM='DIAG '
!
-CALL INITIO_ll()
+CALL IO_Init()
CALL SECOND_MNH2(ZTIME1)
ZTIME0=ZTIME1
!
@@ -391,8 +395,8 @@ NDXCOARSE=1
!* 1.0 Namelist reading
! ----------------
!
-CALL IO_FILE_ADD2LIST(TZNMLFILE,'DIAG1.nam','NML','READ')
-CALL IO_FILE_OPEN_ll(TZNMLFILE)
+CALL IO_File_add2list(TZNMLFILE,'DIAG1.nam','NML','READ')
+CALL IO_File_open(TZNMLFILE)
ILUNAM = TZNMLFILE%NLU
!
!
@@ -423,9 +427,9 @@ CALL POSNAM(ILUNAM,'NAM_CONFIO',GFOUND)
IF (GFOUND) THEN
READ(UNIT=ILUNAM,NML=NAM_CONFIO)
END IF
-CALL SET_CONFIO_ll()
+CALL IO_Config_set()
!
-CALL IO_FILE_CLOSE_ll(TZNMLFILE)
+CALL IO_File_close(TZNMLFILE)
!
CINIFILE = YINIFILE(1)
CINIFILEPGD = YINIFILEPGD(1)
@@ -458,7 +462,7 @@ ENDIF
!
INPRAR = 24 +2*(4+NRR+NSV)
!
-CALL IO_FILE_ADD2LIST(TOUTDATAFILE,TRIM(CINIFILE)//YSUFFIX,'DIAG','WRITE',KLFINPRAR=INPRAR,KLFITYPE=1,KLFIVERB=NVERB)
+CALL IO_File_add2list(TOUTDATAFILE,TRIM(CINIFILE)//YSUFFIX,'MNHDIAG','WRITE',KLFINPRAR=INPRAR,KLFITYPE=1,KLFIVERB=NVERB)
!
CALL SECOND_MNH2(ZTIME2)
ZSTART=ZTIME2-ZTIME1
@@ -504,7 +508,7 @@ ENDIF
!
!* 4.0 Stores the fields in MESONH files if necessary
!
-CALL IO_FILE_OPEN_ll(TOUTDATAFILE)
+CALL IO_File_open(TOUTDATAFILE)
!
CALL WRITE_LFIFM1_FOR_DIAG(TOUTDATAFILE,CDAD_NAME(1))
!
@@ -521,10 +525,10 @@ ZTIME1=ZTIME2
!
IF ( LAIRCRAFT_BALLOON ) THEN
!
- CALL IO_FILE_ADD2LIST(TZDIACFILE,TRIM(CINIFILE)//'BAL','DIACHRONIC','WRITE', &
+ CALL IO_File_add2list(TZDIACFILE,TRIM(CINIFILE)//'BAL','MNHDIACHRONIC','WRITE', &
HDIRNAME=CIO_DIR,KLFINPRAR=INPRAR,KLFITYPE=1,KLFIVERB=NVERB)
!
- CALL IO_FILE_OPEN_ll(TZDIACFILE)
+ CALL IO_File_open(TZDIACFILE)
!
WRITE(ILUOUT0,*) ' '
WRITE(ILUOUT0,*) 'DIAG AFTER OPEN DIACHRONIC FILE'
@@ -555,11 +559,11 @@ IF ( LAIRCRAFT_BALLOON ) THEN
TXDTBAL%TIME=TXDTBAL%TIME + XSTEP_AIRCRAFT_BALLOON
CALL DATETIME_CORRECTDATE(TXDTBAL)
ENDDO
- CALL IO_WRITE_HEADER(TZDIACFILE)
+ CALL IO_Header_write(TZDIACFILE)
CALL WRITE_LFIFMN_FORDIACHRO_n(TZDIACFILE)
CALL WRITE_AIRCRAFT_BALLOON(TZDIACFILE)
CALL MENU_DIACHRO(TZDIACFILE,'END')
- CALL IO_FILE_CLOSE_ll(TZDIACFILE)
+ CALL IO_File_close(TZDIACFILE)
WRITE(ILUOUT0,*) ' '
WRITE(ILUOUT0,*) 'DIAG AFTER CLOSE DIACHRONIC FILE'
WRITE(ILUOUT0,*) ' '
@@ -673,18 +677,18 @@ END IF
!* call to physics monitor
!
GCLOSE_OUT=.TRUE.
-ZRAD=0.
-ZSHADOWS=0.
-ZDCONV=0.
-ZGROUND=0.
-ZTRACER=0.
-ZTURB=0.
-ZDRAG=0.
-ZMAFL=0.
-ZCHEM=0.
-XTIME_LES=0.
-XTIME_LES_BU_PROCESS=0.
-XTIME_BU_PROCESS=0.
+ZRAD = 0.0_MNHTIME
+ZSHADOWS = 0.0_MNHTIME
+ZDCONV = 0.0_MNHTIME
+ZGROUND = 0.0_MNHTIME
+ZTRACER = 0.0_MNHTIME
+ZTURB = 0.0_MNHTIME
+ZDRAG = 0.0_MNHTIME
+ZMAFL = 0.0_MNHTIME
+ZCHEM = 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)
@@ -750,12 +754,12 @@ DEALLOCATE(GMASKkids)
DEALLOCATE(ZWETDEPAER)
IF (GCLOSE_OUT) THEN
GCLOSE_OUT=.FALSE.
- CALL IO_FILE_CLOSE_ll(TOUTDATAFILE)
+ CALL IO_File_close(TOUTDATAFILE)
END IF
!
-CALL IO_FILE_CLOSE_ll(TINIFILE)
-IF (LEN_TRIM(CINIFILEPGD)>0) CALL IO_FILE_CLOSE_ll(TINIFILEPGD)
-CALL IO_FILE_CLOSE_ll(TLUOUT)
+CALL IO_File_close(TINIFILE)
+IF (LEN_TRIM(CINIFILEPGD)>0) CALL IO_File_close(TINIFILEPGD)
+CALL IO_File_close(TLUOUT)
!
CALL SECOND_MNH2(ZTIME2)
ZTIME2=ZTIME2-ZTIME0
@@ -801,7 +805,7 @@ ZTIME2=ZTIME2-ZTIME0
!WRITE(ILUOUT0,*) '|---------------------| -------------------|-------------------|'
!
!
-IF(NIO_VERB>=NVERB_DEBUG) CALL IO_FILE_PRINT_LIST()
+IF(NIO_VERB>=NVERB_DEBUG) CALL IO_Filelist_print()
!
WRITE(ILUOUT0,*) ' '
WRITE(ILUOUT0,*) '***************************** **************'
@@ -810,7 +814,7 @@ WRITE(ILUOUT0,*) '**************************** ***************'
!WRITE(ILUOUT0,*) ' (see time analysis in ',TRIM(TLUOUT0%CNAME),' )'
WRITE(ILUOUT0,*) ' '
!
-CALL IO_FILE_CLOSE_ll(TLUOUT0)
+CALL IO_File_close(TLUOUT0)
!-------------------------------------------------------------------------------
!
!* 10. FINALIZE THE PARALLEL SESSION
diff --git a/src/MNH/diagnos_les_mf.f90 b/src/MNH/diagnos_les_mf.f90
index 2f2cecafcc1a1a9b72075a2d2983090f00d4c35a..31fa13da74a1fc2c0444f1495a15a465801a4214 100644
--- a/src/MNH/diagnos_les_mf.f90
+++ b/src/MNH/diagnos_les_mf.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2009-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 MODI_DIAGNOS_LES_MF
! ###########################
@@ -20,10 +21,10 @@ INTERFACE
!
!* 1.1 Declaration of Arguments
!
-!
+use modd_precision, only: MNHTIME
!
INTEGER, INTENT(IN) :: KIU, KJU, KKU ! 3D grid size
-REAL*8,DIMENSION(2), INTENT(OUT) :: PTIME_LES
+REAL(kind=MNHTIME), DIMENSION(2), INTENT(OUT) :: PTIME_LES
REAL, DIMENSION(:,:), INTENT(IN) :: PTHL_UP,PRT_UP,PRV_UP,&
PRC_UP,PRI_UP ! updraft properties
REAL, DIMENSION(:,:), INTENT(IN) :: PU_UP, PV_UP
@@ -74,20 +75,23 @@ END MODULE MODI_DIAGNOS_LES_MF
!! AUTHOR
!! ------
!! J.pergaud
-!! V.Masson : Optimization 09/2010
+!
+! Modifications:
+! V. Masson 09/2010: Optimization
+! P. Wautelet 28/03/2019: use MNHTIME for time measurement variables
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_LES
+use modd_precision, only: MNHTIME
+!
+USE MODE_MNH_TIMING
!
USE MODI_LES_VER_INT
USE MODI_LES_MEAN_ll
USE MODI_SHUMAN
-!JUANZ
-USE MODE_MNH_TIMING
-!JUANZ
!
IMPLICIT NONE
@@ -95,7 +99,7 @@ IMPLICIT NONE
!
!
INTEGER, INTENT(IN) :: KIU, KJU, KKU ! 3D grid size
-REAL*8,DIMENSION(2), INTENT(OUT) :: PTIME_LES
+REAL(kind=MNHTIME), DIMENSION(2), INTENT(OUT) :: PTIME_LES
REAL, DIMENSION(:,:), INTENT(IN) :: PTHL_UP,PRT_UP,PRV_UP,&
PRC_UP,PRI_UP ! updraft properties
REAL, DIMENSION(:,:), INTENT(IN) :: PU_UP, PV_UP
@@ -119,7 +123,7 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHLUP_MF_LES,ZRTUP_MF_LES, &
ZWUP_MF_LES,ZFRACUP_MF_LES, &
ZTHVUP_MF_LES,ZRVUP_MF_LES, &
ZRIUP_MF_LES
-REAL*8,DIMENSION(2) :: ZTIME1, ZTIME2
+REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME1, ZTIME2
!------------------------------------------------------------------------
!
diff --git a/src/MNH/dry_mass.f90 b/src/MNH/dry_mass.f90
index a5e0b31c735815560e23d97dc460fb672bf60662..0930b058b29fdba1f2fc20ca2a16b87786b1d78e 100644
--- a/src/MNH/dry_mass.f90
+++ b/src/MNH/dry_mass.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ######spl
@@ -69,8 +69,8 @@ END MODULE MODI_DRY_MASS
!!
!! 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
-!! CLUOUT0 : name of 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
diff --git a/src/MNH/dummy_gr_index.f90 b/src/MNH/dummy_gr_index.f90
index 2cd320ae3d7e71bd1b52fc83f05393572dad3182..1bdac1193951e1c0dcb72899d967f866d4eda71f 100644
--- a/src/MNH/dummy_gr_index.f90
+++ b/src/MNH/dummy_gr_index.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 init 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! #####################
MODULE MODI_DUMMY_GR_INDEX
! #####################
@@ -53,12 +48,14 @@ END MODULE MODI_DUMMY_GR_INDEX
!! ------------
!!
!! Original 15/12/97
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
! -----------
!
+use mode_msg
!
IMPLICIT NONE
!
@@ -81,9 +78,7 @@ DO JDUMMY=1,1000
RETURN
END IF
IF (LEN_TRIM(HFIELD)==0) THEN
- !callabortstop
- CALL ABORT
- STOP
+ call Print_msg(NVERB_FATAL,'GEN','DUMMY_GR_INDEX','LEN_TRIM(HFIELD)=0')
ENDIF
END DO
!-------------------------------------------------------------------------------
diff --git a/src/MNH/ecmwf_radiation_vers2.f90 b/src/MNH/ecmwf_radiation_vers2.f90
index a0bb111969780690101e0a728105ddc9c5c8a54d..c589726eb2c15f4df6062c1468e865e06aa2422f 100644
--- a/src/MNH/ecmwf_radiation_vers2.f90
+++ b/src/MNH/ecmwf_radiation_vers2.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
!##############################################################
!OPTION! -Ni
SUBROUTINE ECMWF_RADIATION_VERS2 ( KLON,KLEV,KRAD_DIAG, KAER, &
@@ -71,6 +72,7 @@ SUBROUTINE ECMWF_RADIATION_VERS2 ( KLON,KLEV,KRAD_DIAG, KAER, &
! B.VIE 2016 : LIMA
! J.Escobar 30/03/2017 : Management of compilation of ECMWF_RAD in REAL*8 with MNH_REAL=R4
!! Q.Libois 02/2018 : ECRAD
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-----------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -127,6 +129,8 @@ USE MODD_PARAM_LIMA_WARM, ONLY : ZCREC=>XCREC, ZCRER=>XCRER, ZFREFFR=>XFREFFR, &
ZAC=>XAC, ZAR=>XAR, ZLBEXC=>XLBEXC, ZLBEXR=>XLBEXR
USE MODD_PARAM_LIMA_COLD, ONLY : ZFREFFI=>XFREFFI, ZLBEXI=>XLBEXI
!
+use mode_msg
+!
IMPLICIT NONE
!
!
@@ -751,9 +755,7 @@ DO JK = 1 , KLEV
write(*,*)'YOU USE A PARAMATERESISATION OF THE SW OPTICAL PROPERTIES'
write(*,*)'INADAPTED FOR THE 1 MOMENT SCHEME: SEE THE CEFRADL VARIABLE'
write(*,*)'IN YOUR NAMELIST'
-!callabortstop
-CALL ABORT
- STOP
+ call Print_msg(NVERB_FATAL,'GEN','ECMWF_RADIATION_VERS2','')
END IF
END SELECT
!
diff --git a/src/MNH/effic_salt.f90 b/src/MNH/effic_salt.f90
index 71ee6dfc2ef9b7c6e9d84509b606551e4f30499d..a2636789606306e49d88e71ac4d74e2d72ef3c1a 100644
--- a/src/MNH/effic_salt.f90
+++ b/src/MNH/effic_salt.f90
@@ -57,6 +57,7 @@ END MODULE MODI_EFFIC_SALT
!! -------------
!! Original
!!
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
! Entry variables:
!
! PSVTS(INOUT) -Array of moments included in PSVTS
diff --git a/src/MNH/elec_fieldn.f90 b/src/MNH/elec_fieldn.f90
index 6b7aaf8f39494e69055f35a2b19f193b1f1c5233..f39cdc7abf032ef51c076a10a62ec9fc94f5e84a 100644
--- a/src/MNH/elec_fieldn.f90
+++ b/src/MNH/elec_fieldn.f90
@@ -1,8 +1,8 @@
-
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
! ########################
MODULE MODI_ELEC_FIELD_n
! ########################
@@ -58,7 +58,6 @@ USE MODI_GRADIENT_M
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
!
USE MODE_ll
-USE MODE_FM
!
!
IMPLICIT NONE
diff --git a/src/MNH/elec_trid.f90 b/src/MNH/elec_trid.f90
index e8a95db3b55d1cc7c905eb5534201f621d4a1c96..2a8c5aad1ee4b91a34724b3e98f5fb61dfa75f39 100644
--- a/src/MNH/elec_trid.f90
+++ b/src/MNH/elec_trid.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #####################
@@ -185,7 +185,6 @@ USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_PARAMETERS
!
USE MODE_ll
-USE MODE_IO_ll
USE MODE_MSG
!
!JUAN
diff --git a/src/MNH/elec_tridz.f90 b/src/MNH/elec_tridz.f90
index 214fc6a8869db15fc6bac7ca065280103179235d..5c5ce6796859f7d785a3422ebc534607c5ee22f1 100644
--- a/src/MNH/elec_tridz.f90
+++ b/src/MNH/elec_tridz.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ######################
@@ -193,7 +193,6 @@ USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_PARAMETERS
!
USE MODE_ll
-USE MODE_IO_ll
USE MODE_MSG
!++cb - Z_SPLITTING
USE MODE_SPLITTINGZ_ll , ONLY : GET_DIM_EXTZ_ll,GET_ORZ_ll,LWESTZ_ll,LSOUTHZ_ll
diff --git a/src/MNH/end_diag_in_run.f90 b/src/MNH/end_diag_in_run.f90
index 139ba83bee5bc12af51fbb463a93fab6ad36a449..61405af363c8688e00877d1e7b5e1334eb17c292 100644
--- a/src/MNH/end_diag_in_run.f90
+++ b/src/MNH/end_diag_in_run.f90
@@ -58,6 +58,7 @@ SUBROUTINE END_DIAG_IN_RUN
!! Original 11/2003
!!
!! 02/2018 Q.Libois ECRAD
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -92,6 +93,9 @@ DEALLOCATE(XCURRENT_MER10M)! meridian wind at 10m
DEALLOCATE(XCURRENT_DSTAOD)! dust aerosol optical depth
DEALLOCATE(XCURRENT_SFCO2 ) ! CO2 Surface flux
DEALLOCATE(XCURRENT_TKE_DISS) ! Tke dissipation rate
+DEALLOCATE(XCURRENT_SLTAOD) ! Salt aerosol optical depth
+DEALLOCATE(XCURRENT_ZWS ) ! Significant height of waves
+
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/endstep.f90 b/src/MNH/endstep.f90
index fb0bd478bdabc82aefe0b8e7e7165a50758a34cb..9a3da2c5443fb7d07a7e43c62891df3b1d1e7ea9 100644
--- a/src/MNH/endstep.f90
+++ b/src/MNH/endstep.f90
@@ -18,16 +18,16 @@ INTERFACE
PUS,PVS,PWS,PDRYMASSS, &
PTHS,PRS,PTKES,PSVS, &
PLSUS,PLSVS,PLSWS, &
- PLSTHS,PLSRVS, &
+ PLSTHS,PLSRVS,PLSZWSS, &
PLBXUS,PLBXVS,PLBXWS, &
PLBXTHS,PLBXRS,PLBXTKES,PLBXSVS, &
PLBYUS,PLBYVS,PLBYWS, &
PLBYTHS,PLBYRS,PLBYTKES,PLBYSVS, &
- PUM,PVM,PWM, &
+ PUM,PVM,PWM,PZWS, &
PUT,PVT,PWT,PPABST,PDRYMASST, &
PTHT,PRT,PTHM,PRCM,PPABSM,PTKET,PSVT, &
PLSUM,PLSVM,PLSWM, &
- PLSTHM,PLSRVM, &
+ PLSTHM,PLSRVM,PLSZWSM, &
PLBXUM,PLBXVM,PLBXWM, &
PLBXTHM,PLBXRM,PLBXTKEM,PLBXSVM, &
PLBYUM,PLBYVM,PLBYWM, &
@@ -51,6 +51,7 @@ REAL, INTENT(IN) :: PDRYMASSS ! Md source
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSUS,PLSVS,PLSWS,& ! Large Scale
PLSTHS,PLSRVS ! fields tendencies
!
+REAL, DIMENSION(:,:), INTENT(IN) :: PLSZWSS ! Large Scale fields tendencies
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUS,PLBXVS,PLBXWS, & !
PLBXTHS,PLBXTKES ! LBX tendancy
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBXRS,PLBXSVS !
@@ -68,6 +69,7 @@ REAL, INTENT(INOUT):: PDRYMASST !
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLSUM,PLSVM,PLSWM,& ! Large Scale fields
PLSTHM,PLSRVM ! at t-dt
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PLSZWSM ! Large Scale fields at t-dt
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLBXUM,PLBXVM,PLBXWM, & !
PLBXTHM,PLBXTKEM ! LBX fields
@@ -76,6 +78,7 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PLBXRM,PLBXSVM !
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLBYUM,PLBYVM,PLBYWM, & !
PLBYTHM,PLBYTKEM ! LBY fields
REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PLBYRM,PLBYSVM !
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PZWS ! significant wave height
!
END SUBROUTINE ENDSTEP
!
@@ -91,16 +94,16 @@ END MODULE MODI_ENDSTEP
PUS,PVS,PWS,PDRYMASSS, &
PTHS,PRS,PTKES,PSVS, &
PLSUS,PLSVS,PLSWS, &
- PLSTHS,PLSRVS, &
+ PLSTHS,PLSRVS,PLSZWSS, &
PLBXUS,PLBXVS,PLBXWS, &
PLBXTHS,PLBXRS,PLBXTKES,PLBXSVS, &
PLBYUS,PLBYVS,PLBYWS, &
PLBYTHS,PLBYRS,PLBYTKES,PLBYSVS, &
- PUM,PVM,PWM, &
+ PUM,PVM,PWM,PZWS, &
PUT,PVT,PWT,PPABST,PDRYMASST, &
PTHT,PRT,PTHM,PRCM,PPABSM,PTKET,PSVT, &
PLSUM,PLSVM,PLSWM, &
- PLSTHM,PLSRVM, &
+ PLSTHM,PLSRVM,PLSZWSM, &
PLBXUM,PLBXVM,PLBXWM, &
PLBXTHM,PLBXRM,PLBXTKEM,PLBXSVM, &
PLBYUM,PLBYVM,PLBYWM, &
@@ -192,6 +195,7 @@ END MODULE MODI_ENDSTEP
!! 04/2013 (C.Lac) FIT for all the variables
!! 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
!!
!------------------------------------------------------------------------------
!
@@ -241,6 +245,7 @@ REAL, INTENT(IN) :: PDRYMASSS ! Md source
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSUS,PLSVS,PLSWS,& ! Large Scale
PLSTHS,PLSRVS ! fields tendencies
+REAL, DIMENSION(:,:), INTENT(IN) :: PLSZWSS ! Large Scale fields tendencies
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUS,PLBXVS,PLBXWS, & !
PLBXTHS,PLBXTKES ! LBX tendancy
@@ -260,6 +265,8 @@ REAL, INTENT(INOUT):: PDRYMASST !
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLSUM,PLSVM,PLSWM,& ! Large Scale fields
PLSTHM,PLSRVM ! at t-dt
!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PLSZWSM ! Large Scale fields at t-dt
+!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLBXUM,PLBXVM,PLBXWM, & !
PLBXTHM,PLBXTKEM ! LBX fields
REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PLBXRM,PLBXSVM !
@@ -268,6 +275,7 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLBYUM,PLBYVM,PLBYWM, & !
PLBYTHM,PLBYTKEM ! LBY fields
REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PLBYRM,PLBYSVM !
!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PZWS ! significant wave height
!
!* 0.2 DECLARATIONS OF LOCAL VARIABLES
!
@@ -383,6 +391,11 @@ ENDIF
IF (SIZE(PLSRVS,1) /= 0) THEN
PLSRVM(:,:,:) = MAX( PLSRVM(:,:,:) + PTSTEP * PLSRVS(:,:,:) , 0.)
ENDIF
+
+IF (SIZE(PLSZWSS,1) /= 0) THEN
+ PLSZWSM(:,:) = MAX( PLSZWSM(:,:) + PTSTEP * PLSZWSS(:,:) , 0.)
+ PZWS(:,:) = PLSZWSM(:,:)
+ENDIF
!
!------------------------------------------------------------------------------
!
diff --git a/src/MNH/endstep_budget.f90 b/src/MNH/endstep_budget.f90
index eff9d4bfe450861da35dbb5218d7442869a5a0ce..d6c619db4af46d775e511a1dfed82a7cf4909d42 100644
--- a/src/MNH/endstep_budget.f90
+++ b/src/MNH/endstep_budget.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 ENDSTEP_BUDGET(TPDIAFILE,KTCOUNT, &
TPDTCUR,TPDTMOD,PTSTEP,KSV)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_TYPE_DATE
!
TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! file to write
@@ -101,7 +101,7 @@ END MODULE MODI_ENDSTEP_BUDGET
!* 0. DECLARATIONS
! ------------
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_TIME
USE MODD_BUDGET
!
diff --git a/src/MNH/error_on_temperature.f90 b/src/MNH/error_on_temperature.f90
index 50b3d4d1865f438d30a1d75ddbc94f40eb6ef31c..bcdbb9aaeb8034aa6d4bf020fef48fdc7b097cc4 100644
--- a/src/MNH/error_on_temperature.f90
+++ b/src/MNH/error_on_temperature.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ######spl
@@ -60,6 +60,7 @@ END MODULE MODI_ERROR_ON_TEMPERATURE
!! 26/08/97 (V. Masson) call to new linear vertical
!! interpolation routine
!! 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)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -198,7 +199,7 @@ WRITE(ILUOUT0,*) ''
WRITE(ILUOUT0,*) 'Temperature RMS between begin and end of PREP_REAL_CASE :'
WRITE(ILUOUT0,*) ''
DO JP=20,1,-1
- WRITE(ILUOUT0,'(6Hlevel ,F5.0,7H hPa : ,F5.3,2H K)') ZPLEVELS(JP)/100.,ZTRMS(JP)
+ WRITE(ILUOUT0,'( "level", F5.0, " hPa : ", F5.3, " K")') ZPLEVELS(JP)/100.,ZTRMS(JP)
END DO
WRITE(ILUOUT0,*) ''
!
diff --git a/src/MNH/extend_grid_parameter_mnh.f90 b/src/MNH/extend_grid_parameter_mnh.f90
index 09d06299039e54a684cf25c7ef023918ebc132f2..3d5fc09a13966b120e77dbb6db3755d0e3a69ed0 100644
--- a/src/MNH/extend_grid_parameter_mnh.f90
+++ b/src/MNH/extend_grid_parameter_mnh.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2015-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.
+!-----------------------------------------------------------------
! #############################################################
SUBROUTINE EXTEND_GRID_PARAMETERX1_MNH(HGRID,HREC,KDIM,KSIZE,KIMAX,KJMAX,PFIELD,PFIELD_EXTEND)
! #############################################################
@@ -16,10 +17,13 @@
! 07/2015 (M.Moge) initializing ZY and ZY to zero
! 08/2015 (M.Moge) bug fix in the call to UPDATE_NHALO1D : IIMAX_ll instead of IJMAX_ll
!
-USE MODD_IO_SURF_MNH, ONLY : NHALO
-USE MODD_VAR_ll, ONLY : NPROC, IP, MPI_PRECISION, NMNH_COMM_WORLD
+USE MODD_IO_SURF_MNH, ONLY: NHALO
USE MODD_MPIF
-USE MODE_TOOLS_ll, ONLY : INTERSECTION, LWEST_ll, LEAST_ll, LNORTH_ll, LSOUTH_ll
+use MODD_PRECISION, only: MNHREAL_MPI
+USE MODD_VAR_ll, ONLY: NPROC, IP, NMNH_COMM_WORLD
+!
+USE MODE_TOOLS_ll, ONLY: INTERSECTION, LWEST_ll, LEAST_ll, LNORTH_ll, LSOUTH_ll
+!
USE MODI_UPDATE_NHALO1D
!
IMPLICIT NONE
@@ -76,7 +80,7 @@ IF (HREC=='XX' .OR. HREC=='DX') THEN
IF (NIMAX>1) ZDX = PFIELD(2) - PFIELD(1)
IF (NIMAX==1) ZDX = PFIELD(1) ! in 1D conf, one assumes that grid
! is located between X=DX/2 and X=3DX/2
- CALL MPI_BCAST(ZDX, 1, MPI_PRECISION, 0, NMNH_COMM_WORLD, IINFO_ll)
+ CALL MPI_BCAST(ZDX, 1, MNHREAL_MPI, 0, NMNH_COMM_WORLD, IINFO_ll)
IF( LWEST_ll() ) THEN
DO JI=NHALO,1,-1
ZX(JI) = ZX(JI+1) - ZDX
@@ -119,7 +123,7 @@ ELSEIF (HREC=='YY' .OR. HREC=='DY') THEN
IF (NJMAX>1) ZDY = PFIELD(1+KIMAX) - PFIELD(1)
IF (NJMAX==1) ZDY = PFIELD(1) ! in 1D or 2D conf, one assumes that grid
! is located between Y=DY/2 and Y=3DY/2
- CALL MPI_BCAST(ZDY, 1, MPI_PRECISION, 0, NMNH_COMM_WORLD, IINFO_ll)
+ CALL MPI_BCAST(ZDY, 1, MNHREAL_MPI, 0, NMNH_COMM_WORLD, IINFO_ll)
IF( LSOUTH_ll() ) THEN
DO JJ=NHALO,1,-1
ZY(JJ) = ZY(JJ+1) - ZDY
diff --git a/src/MNH/fast_terms.f90 b/src/MNH/fast_terms.f90
index cd69c7d79ec7faade687e3dbbe93616198903a8c..2f0f9f00801ba9eb5b00c9f3d07069c939faf56a 100644
--- a/src/MNH/fast_terms.f90
+++ b/src/MNH/fast_terms.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ######################
@@ -162,8 +162,6 @@ USE MODD_CONF
USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_PARAMETERS
!
-USE MODE_FMWRIT
-!
USE MODI_BUDGET
USE MODI_CONDENS
USE MODI_GET_HALO
diff --git a/src/MNH/fft.f b/src/MNH/fft.f
index 92b071484c38a33cc41395b80eef96731cb1f94a..b0fa5e744f3412393c4203053420bed13b5b414d 100644
--- a/src/MNH/fft.f
+++ b/src/MNH/fft.f
@@ -1,12 +1,10 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
+! Modifications:
+! P. Wautelet 22/02/2019: replace Hollerith edit descriptor (deleted from Fortran 95 standard)
!-----------------------------------------------------------------
SUBROUTINE SET99(TRIGS,IFAX,N)
IMPLICIT LOGICAL (L)
@@ -55,7 +53,7 @@ C LOOK FOR SIXES FIRST, STORE FACTORS IN DESCENDING ORDER
IF (IFAC.GT.1) GO TO 20
C
WRITE(6,40) N
- 40 FORMAT(4H1N =,I4,27H - CONTAINS ILLEGAL FACTORS)
+ 40 FORMAT('1N =', I4, ' - CONTAINS ILLEGAL FACTORS')
RETURN
C
C NOW REVERSE ORDER OF FACTORS
diff --git a/src/MNH/flash_geom_elec.f90 b/src/MNH/flash_geom_elec.f90
index e0b13e74f435bc2a8c22ebe4f02d639d407c4bf1..d2a5b05e6522074b2500c6902501bc488b29c4e7 100644
--- a/src/MNH/flash_geom_elec.f90
+++ b/src/MNH/flash_geom_elec.f90
@@ -2,6 +2,7 @@
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C 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_FLASH_GEOM_ELEC_n
! #############################
@@ -13,7 +14,7 @@ INTERFACE
TPFILE_FGEOM_DIAG, TPFILE_FGEOM_COORD, TPFILE_LMA, &
PTOWN, PSEA )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
INTEGER, INTENT(IN) :: KMI ! current model index
@@ -91,51 +92,53 @@ END MODULE MODI_FLASH_GEOM_ELEC_n
!! J.Escobar : 20/06/2018 : Correction of computation of global index I8VECT
!! J.Escobar : 10/12/2018 : // Correction , mpi_bcast CG & CG_POS parameter
!! & initialize INBLIGHT on all proc for filling/saving AREA* arrays
-!! Philippe Wautelet: 10/01/2019: use NEWUNIT argument of OPEN
-!! Philippe Wautelet: 22/01/2019: use standard FLUSH statement instead of non standard intrinsics!!
+! P. Wautelet 10/01/2019: use NEWUNIT argument of OPEN
+! P. Wautelet 22/01/2019: use standard FLUSH statement instead of non standard intrinsics!!
+! P. Wautelet 22/02/2019: use MOD intrinsics with same kind for all arguments (to respect Fortran standard)
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY : XAVOGADRO, XMD
-USE MODD_CONF, ONLY : CEXP, LCARTESIAN
-USE MODD_IO_ll, ONLY: TFILEDATA
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
-USE MODD_GRID, ONLY : XLATORI,XLONORI
-USE MODD_GRID_n, ONLY : XXHAT, XYHAT, XZHAT
-USE MODD_DYN_n, ONLY : XDXHATM, XDYHATM, NSTOP
-USE MODD_METRICS_n, ONLY : XDXX, XDYY, XDZZ ! in linox_production
-USE MODD_ELEC_DESCR
-USE MODD_ELEC_PARAM, ONLY : XFQLIGHTR, XEXQLIGHTR, &
- XFQLIGHTI, XEXQLIGHTI, &
- XFQLIGHTS, XEXQLIGHTS, &
- XFQLIGHTG, XEXQLIGHTG, &
- XFQLIGHTH, XEXQLIGHTH, &
- XFQLIGHTC
-USE MODD_RAIN_ICE_DESCR, ONLY : XLBR, XLBEXR, XLBS, XLBEXS, &
- XLBG, XLBEXG, XLBH, XLBEXH, &
- XRTMIN
-USE MODD_NSV, ONLY : NSV_ELECBEG, NSV_ELECEND, NSV_ELEC
-USE MODD_VAR_ll, ONLY : NPROC,NMNH_COMM_WORLD
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+USE MODD_ARGSLIST_ll, ONLY: LIST_ll
+USE MODD_CONF, ONLY: CEXP, LCARTESIAN
+USE MODD_CST, ONLY: XAVOGADRO, XMD
+USE MODD_DYN_n, ONLY: XDXHATM, XDYHATM, NSTOP
+USE MODD_ELEC_DESCR
+USE MODD_ELEC_FLASH
+USE MODD_ELEC_PARAM, ONLY: XFQLIGHTR, XEXQLIGHTR, &
+ XFQLIGHTI, XEXQLIGHTI, &
+ XFQLIGHTS, XEXQLIGHTS, &
+ XFQLIGHTG, XEXQLIGHTG, &
+ XFQLIGHTH, XEXQLIGHTH, &
+ XFQLIGHTC
+USE MODD_GRID, ONLY: XLATORI,XLONORI
+USE MODD_GRID_n, ONLY: XXHAT, XYHAT, XZHAT
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LMA_SIMULATOR
+USE MODD_METRICS_n, ONLY: XDXX, XDYY, XDZZ ! in linox_production
+USE MODD_NSV, ONLY: NSV_ELECBEG, NSV_ELECEND, NSV_ELEC
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
+use MODD_PRECISION, only: MNHREAL_MPI
+USE MODD_RAIN_ICE_DESCR, ONLY: XLBR, XLBEXR, XLBS, XLBEXS, &
+ XLBG, XLBEXG, XLBH, XLBEXH, &
+ XRTMIN
USE MODD_SUB_ELEC_n
USE MODD_TIME_n
-USE MODD_LMA_SIMULATOR
-USE MODD_ELEC_FLASH
-!
-USE MODI_SHUMAN
-USE MODI_TO_ELEC_FIELD_n
-USE MODI_ION_ATTACH_ELEC
+USE MODD_VAR_ll, ONLY: NPROC,NMNH_COMM_WORLD
!
+USE MODE_ELEC_ll
+USE MODE_GRIDPROJ
+USE MODE_ll
+USE MODE_MPPDB
#ifdef MNH_PGI
USE MODE_PACK_PGI
#endif
!
-USE MODE_ll
-USE MODE_ELEC_ll
-USE MODE_GRIDPROJ
-USE MODE_MPPDB
+USE MODI_ION_ATTACH_ELEC
+USE MODI_SHUMAN
+USE MODI_TO_ELEC_FIELD_n
!
IMPLICIT NONE
!
@@ -851,9 +854,9 @@ ENDIF
CALL MPPDB_CHECK3DM("flash:: 5. ZFLASH(IL)",PRECISION,&
ZFLASH(:,:,:,IL))
!
- CALL MPI_BCAST (GNEW_FLASH(IL),1, MPI_LOGICAL, IPROC_TRIG(IL), &
+ CALL MPI_BCAST (GNEW_FLASH(IL),1, MPI_LOGICAL, IPROC_TRIG(IL), &
NMNH_COMM_WORLD, IERR)
- CALL MPI_BCAST (ZEM_TRIG(IL), 1, MPI_PRECISION, IPROC_TRIG(IL), &
+ CALL MPI_BCAST (ZEM_TRIG(IL), 1, MNHREAL_MPI, IPROC_TRIG(IL), &
NMNH_COMM_WORLD, IERR)
CALL MPI_BCAST (INB_FL_REAL(IL), 1, MPI_INTEGER, IPROC_TRIG(IL), &
NMNH_COMM_WORLD, IERR)
@@ -1688,11 +1691,11 @@ DO IL = 1, INB_CELL
! ----------------------------
!
CALL MPI_BCAST (ZEM_TRIG(IL), 1, &
- MPI_PRECISION, IPROC_TRIG(IL), NMNH_COMM_WORLD, IERR)
- CALL MPI_BCAST (ISEG_LOC(:,IL), 3*SIZE(PRT,3), &
+ MNHREAL_MPI, IPROC_TRIG(IL), NMNH_COMM_WORLD, IERR)
+ CALL MPI_BCAST (ISEG_LOC(:,IL), 3*SIZE(PRT,3), &
MPI_INTEGER, IPROC_TRIG(IL), NMNH_COMM_WORLD, IERR)
CALL MPI_BCAST (ZCOORD_TRIG(:,IL), 3, &
- MPI_PRECISION, IPROC_TRIG(IL), NMNH_COMM_WORLD, IERR)
+ MNHREAL_MPI, IPROC_TRIG(IL), NMNH_COMM_WORLD, IERR)
CALL MPI_BCAST (ISIGNE_EZ(IL), 1, &
MPI_INTEGER, IPROC_TRIG(IL), NMNH_COMM_WORLD, IERR)
!
@@ -1958,7 +1961,7 @@ DO IL = 1, INB_CELL
END DO
END IF
!
- CALL MPI_BCAST (ZSIGN(IL), 1, MPI_PRECISION, IPROC_TRIG(IL), &
+ CALL MPI_BCAST (ZSIGN(IL), 1, MNHREAL_MPI, IPROC_TRIG(IL), &
NMNH_COMM_WORLD, IERR)
END DO
!
@@ -2191,7 +2194,7 @@ DO WHILE (IM .LE. IDELTA_IND .AND. ISTOP .NE. 1)
IF (IRANK_LL(IORDER_LL(ICHOICE)) .EQ. IPROC) THEN
JK = 1 + (I8VECT_LL(ICHOICE)-1) / ( IJU_ll*IIU_ll )
JJ = 1 + ( (I8VECT_LL(ICHOICE)-1) - IJU_ll*IIU_ll*(JK-1) ) / IIU_ll - IYOR +1
- JI = 1 + MOD((I8VECT_LL(ICHOICE)-1) , IIU_ll) - IXOR +1
+ JI = 1 + MOD((I8VECT_LL(ICHOICE)-1) , int(IIU_ll,kind(I8VECT_LL(1)))) - IXOR +1
!print*,"OUT => I8VECT_LL(ICHOICE)=",I8VECT_ll(ICHOICE),JI,JJ,JK,ICHOICE
ZFLASH(JI,JJ,JK,IL) = 2.
END IF
@@ -2306,8 +2309,8 @@ IF (IPROC .EQ. 0) THEN
INBSEG_PROC_X3(:) = 3 * INBSEG_PROC(:)
END IF
!
-CALL MPI_GATHERV (ZSEND, 3*INSEGPROC, MPI_PRECISION, ZRECV, INBSEG_PROC_X3, &
- IDECAL3, MPI_PRECISION, 0, NMNH_COMM_WORLD, IERR)
+CALL MPI_GATHERV (ZSEND, 3*INSEGPROC, MNHREAL_MPI, ZRECV, INBSEG_PROC_X3, &
+ IDECAL3, MNHREAL_MPI, 0, NMNH_COMM_WORLD, IERR)
!
IF (IPROC .EQ. 0) THEN
ZCOORD_SEG_ALL(1:3*INSEGCELL,IL) = ZRECV(1:3*INSEGCELL)
@@ -2379,15 +2382,15 @@ IF (LLMA) THEN
!
ALLOCATE (ZRECV(INSEGCELL))
!
- CALL MPI_GATHERV (ZLMAPOS, INSEGPROC, MPI_PRECISION, ZRECV, INBSEG_PROC, &
- IDECAL, MPI_PRECISION, 0, NMNH_COMM_WORLD, IERR)
+ CALL MPI_GATHERV (ZLMAPOS, INSEGPROC, MNHREAL_MPI, ZRECV, INBSEG_PROC, &
+ IDECAL, MNHREAL_MPI, 0, NMNH_COMM_WORLD, IERR)
!
IF (IPROC .EQ. 0) THEN
ZLMA_NEUT_POS(1:INSEGCELL,IL) = ZRECV(1:INSEGCELL)
END IF
!
- CALL MPI_GATHERV (ZLMANEG, INSEGPROC, MPI_PRECISION, ZRECV, INBSEG_PROC, &
- IDECAL, MPI_PRECISION, 0, NMNH_COMM_WORLD, IERR)
+ CALL MPI_GATHERV (ZLMANEG, INSEGPROC, MNHREAL_MPI, ZRECV, INBSEG_PROC, &
+ IDECAL, MNHREAL_MPI, 0, NMNH_COMM_WORLD, IERR)
!
IF (IPROC .EQ. 0) THEN
ZLMA_NEUT_NEG(1:INSEGCELL,IL) = ZRECV(1:INSEGCELL)
@@ -2407,17 +2410,17 @@ IF (LLMA) THEN
INBSEG_PROC_XNSV(:) = NSV_ELEC * INBSEG_PROC(:)
END IF
!
- CALL MPI_GATHERV (ZLMAQMT, NSV_ELEC*INSEGPROC, MPI_PRECISION, ZRECV, &
- INBSEG_PROC_XNSV, &
- IDECALN, MPI_PRECISION, 0, NMNH_COMM_WORLD, IERR )
+ CALL MPI_GATHERV (ZLMAQMT, NSV_ELEC*INSEGPROC, MNHREAL_MPI, ZRECV, &
+ INBSEG_PROC_XNSV, &
+ IDECALN, MNHREAL_MPI, 0, NMNH_COMM_WORLD, IERR )
!
IF (IPROC .EQ. 0) THEN
ZLMA_QMT(1:NSV_ELEC*INSEGCELL,IL) = ZRECV(1:NSV_ELEC*INSEGCELL)
END IF
!
- CALL MPI_GATHERV (ZLMAPRT, NSV_ELEC*INSEGPROC, MPI_PRECISION, ZRECV, &
- INBSEG_PROC_XNSV, &
- IDECALN, MPI_PRECISION, 0, NMNH_COMM_WORLD, IERR)
+ CALL MPI_GATHERV (ZLMAPRT, NSV_ELEC*INSEGPROC, MNHREAL_MPI, ZRECV, &
+ INBSEG_PROC_XNSV, &
+ IDECALN, MNHREAL_MPI, 0, NMNH_COMM_WORLD, IERR )
!
IF (IPROC .EQ. 0) THEN
ZLMA_PRT(1:NSV_ELEC*INSEGCELL,IL) = ZRECV(1:NSV_ELEC*INSEGCELL)
@@ -2823,6 +2826,8 @@ END SUBROUTINE N8INTERCHANGE_SORT
! Output, real ( kind = 8 ) R8_UNIFORM_01, a new pseudorandom variate,
! strictly between 0 and 1.
!
+ use mode_msg
+
IMPLICIT NONE
INTEGER ( kind = 4 ), PARAMETER :: i4_huge = 2147483647
@@ -2831,10 +2836,7 @@ END SUBROUTINE N8INTERCHANGE_SORT
INTEGER ( kind = 4 ) seed
IF ( seed == 0 ) THEN
- WRITE ( *, '(a)' ) ' '
- WRITE ( *, '(a)' ) 'R8_UNIFORM_01 - Fatal error!'
- WRITE ( *, '(a)' ) ' Input value of SEED = 0.'
- STOP 1
+ call Print_msg( NVERB_FATAL, 'GEN', 'r8_uniform_01', 'seed dummy argument must be different of 0' )
END IF
k = seed / 127773
diff --git a/src/MNH/flat_invz.f90 b/src/MNH/flat_invz.f90
index e253264a9e229a59c4c9bf7f3caedfe1283b4167..b7b38a84621ae4f99a90aba6f437f0b71b6b6f78 100644
--- a/src/MNH/flat_invz.f90
+++ b/src/MNH/flat_invz.f90
@@ -1,12 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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$
-!-----------------------------------------------------------------
! ####################
MODULE MODI_FLAT_INVZ
! ####################
@@ -130,13 +126,15 @@ SUBROUTINE FLAT_INVZ(HLBCX,HLBCY,PDXHATM,PDYHATM,PRHOM,PAF,PBF,PCF, &
!! points under the ground and out of the domain
!! Modification Lugato, Guivarch (June 1998) Parallelisation
!! Escobar, Stein (July 2000) optimisation
+! P. Wautelet 28/03/2019: use MNHTIME for time measurement variables
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
- USE MODD_PARAMETERS
USE MODD_CONF
+ USE MODD_PARAMETERS
+ use modd_precision, only: MNHTIME
!
USE MODE_ll
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
@@ -258,7 +256,7 @@ SUBROUTINE FLAT_INVZ(HLBCX,HLBCY,PDXHATM,PDYHATM,PRHOM,PAF,PBF,PCF, &
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZBAND_YT ! array in Y slices distribution transpose
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZBAND_YRT ! array in Y slices distribution transpose
!
- REAL*8,DIMENSION(2) :: T0,T1
+ REAL(kind=MNHTIME), DIMENSION(2) :: ZT0,ZT1
!JUAN Z_SPLITTING
!
!
@@ -481,13 +479,13 @@ SUBROUTINE FLAT_INVZ(HLBCX,HLBCY,PDXHATM,PDYHATM,PRHOM,PAF,PBF,PCF, &
!!$ print*,"IP=",IP," SIZE(ZBAND_SXP1_YP2_Z)=",SIZE(ZBAND_SXP1_YP2_Z,1),SIZE(ZBAND_SXP1_YP2_Z,2)
ZBAND_SXP1_YP2_Z = ZY_B (IIBI:IIEI,IJBI:IJEI,:)
ZBAND_SX_YP2_ZP1 = 0.0
- CALL SECOND_MNH2(T0)
+ CALL SECOND_MNH2(ZT0)
CALL REMAP_SXP1_YP2_Z_SX_YP2_ZP1_ll(ZBAND_SXP1_YP2_Z,ZBAND_SX_YP2_ZP1,IINFO_ll)
!CALL REMAP_B_SX_YP2_ZP1_ll(ZBAND_B,ZBAND_SX_YP2_ZP1,IINFO_ll)
!ZWORK_SX_YP2_ZP1 = ZWORK_SX_YP2_ZP1 - ZBAND_SX_YP2_ZP1
- CALL SECOND_MNH2(T1)
- TIMEZ%T_MAP_B_SX_YP2_ZP1 = TIMEZ%T_MAP_B_SX_YP2_ZP1 + T1 - T0
+ CALL SECOND_MNH2(ZT1)
+ TIMEZ%T_MAP_B_SX_YP2_ZP1 = TIMEZ%T_MAP_B_SX_YP2_ZP1 + ZT1 - ZT0
END IF ! NZ_SPLITTING
!
!JUAN Z_SPLITTING
@@ -527,10 +525,10 @@ SUBROUTINE FLAT_INVZ(HLBCX,HLBCY,PDXHATM,PDYHATM,PRHOM,PAF,PBF,PCF, &
IIMAX,ILOT_SX_YP2_ZP1,-1 )
END IF
ZBAND_SXP2_Y_ZP1=0.0
- CALL SECOND_MNH2(T0)
+ CALL SECOND_MNH2(ZT0)
CALL REMAP_SX_YP2_ZP1_SXP2_Y_ZP1_ll(ZBAND_SX_YP2_ZP1,ZBAND_SXP2_Y_ZP1,IINFO_ll)
- CALL SECOND_MNH2(T1)
- TIMEZ%T_MAP_SX_YP2_ZP1_SXP2_Y_ZP1 = TIMEZ%T_MAP_SX_YP2_ZP1_SXP2_Y_ZP1 + T1 - T0
+ CALL SECOND_MNH2(ZT1)
+ TIMEZ%T_MAP_SX_YP2_ZP1_SXP2_Y_ZP1 = TIMEZ%T_MAP_SX_YP2_ZP1_SXP2_Y_ZP1 + ZT1 - ZT0
END IF ! NZ_SPLITTING
!
!JUAN Z_SPLITTING
@@ -612,10 +610,10 @@ SUBROUTINE FLAT_INVZ(HLBCX,HLBCY,PDXHATM,PDYHATM,PRHOM,PAF,PBF,PCF, &
!!$ IF (( IAND(NZ_SPLITTING,2) > 0 ) .AND. ( IAND(NZ_SPLITTING,16) > 0 ) ) THEN
!!$ CALL FAST_TRANSPOSE(ZBAND_SXP2_Y_ZP1T,ZBAND_SXP2_Y_ZP1,IJ_SXP2_Y_ZP1+2,II_SXP2_Y_ZP1,IK_SXP2_Y_ZP1)
!!$ ZBAND_B = 0.0
-!!$ CALL SECOND_MNH2(T0)
+!!$ CALL SECOND_MNH2(ZT0)
!!$ CALL REMAP_SXP2_Y_ZP1_B_ll(ZBAND_SXP2_Y_ZP1,ZBAND_B,IINFO_ll)
-!!$ CALL SECOND_MNH2(T1)
-!!$ TIMEZ.T_MAP_SXP2_Y_ZP1_B = TIMEZ.T_MAP_SXP2_Y_ZP1_B + T1 - T0
+!!$ CALL SECOND_MNH2(ZT1)
+!!$ TIMEZ.T_MAP_SXP2_Y_ZP1_B = TIMEZ.T_MAP_SXP2_Y_ZP1_B + ZT1 - ZT0
!!$ !
!!$ ! singular matrix case : the last term is computed by setting the
!!$ ! average of the pressure field equal to zero.
@@ -646,10 +644,10 @@ SUBROUTINE FLAT_INVZ(HLBCX,HLBCY,PDXHATM,PDYHATM,PRHOM,PAF,PBF,PCF, &
IF ( ( IAND(NZ_SPLITTING,2) > 0 ) .AND. ( IAND(NZ_SPLITTING,8) > 0 )) THEN
CALL FAST_TRANSPOSE(ZBAND_SXP2_Y_ZP1T,ZBAND_SXP2_Y_ZP1,IJ_SXP2_Y_ZP1+2,II_SXP2_Y_ZP1,IK_SXP2_Y_ZP1)
ZBAND_SXP2_YP1_Z = 0.0
- CALL SECOND_MNH2(T0)
+ CALL SECOND_MNH2(ZT0)
CALL REMAP_SXP2_Y_ZP1_SXP2_YP1_Z_ll(ZBAND_SXP2_Y_ZP1,ZBAND_SXP2_YP1_Z,IINFO_ll)
- CALL SECOND_MNH2(T1)
- TIMEZ%T_MAP_SXP2_Y_ZP1_SXP2_YP1_Z = TIMEZ%T_MAP_SXP2_Y_ZP1_SXP2_YP1_Z + T1 - T0
+ CALL SECOND_MNH2(ZT1)
+ TIMEZ%T_MAP_SXP2_Y_ZP1_SXP2_YP1_Z = TIMEZ%T_MAP_SXP2_Y_ZP1_SXP2_YP1_Z + ZT1 - ZT0
!
! singular matrix case : the last term is computed by setting the
! average of the pressure field equal to zero.
@@ -718,19 +716,19 @@ SUBROUTINE FLAT_INVZ(HLBCX,HLBCY,PDXHATM,PDYHATM,PRHOM,PAF,PBF,PCF, &
!!$ IF ( ( IAND(NZ_SPLITTING,2) > 0 ) .AND.( IAND(NZ_SPLITTING,16) > 0 ) ) THEN
!!$ !
-!!$ CALL SECOND_MNH2(T0)
+!!$ CALL SECOND_MNH2(ZT0)
!!$ CALL REMAP_B_SXP2_Y_ZP1_ll(ZBAND_BR,ZBAND_SXP2_Y_ZP1R,IINFO_ll)
-!!$ CALL SECOND_MNH2(T1)
-!!$ TIMEZ.T_MAP_B_SXP2_Y_ZP1 = TIMEZ.T_MAP_B_SXP2_Y_ZP1 + T1 - T0
+!!$ CALL SECOND_MNH2(ZT1)
+!!$ TIMEZ.T_MAP_B_SXP2_Y_ZP1 = TIMEZ.T_MAP_B_SXP2_Y_ZP1 + ZT1 - ZT0
!!$ ENDIF
! JUAN P1/P2 SPLITTING
IF ( ( IAND(NZ_SPLITTING,2) > 0 ) .AND. ( IAND(NZ_SPLITTING,8) > 0 ) ) THEN
!
- CALL SECOND_MNH2(T0)
+ CALL SECOND_MNH2(ZT0)
CALL REMAP_SXP2_YP1_Z_SXP2_Y_ZP1_ll(ZBAND_SXP2_YP1_ZR,ZBAND_SXP2_Y_ZP1R,IINFO_ll)
!TEST CALL REMAP_SXP2_YP1_Z_SXP2_Y_ZP1_ll(ZBAND_SXP2_YP1_ZR,ZBAND_SXP2_Y_ZP1RBIS,IINFO_ll)
- CALL SECOND_MNH2(T1)
- TIMEZ%T_MAP_SXP2_YP1_Z_SXP2_Y_ZP1 = TIMEZ%T_MAP_SXP2_YP1_Z_SXP2_Y_ZP1 + T1 - T0
+ CALL SECOND_MNH2(ZT1)
+ TIMEZ%T_MAP_SXP2_YP1_Z_SXP2_Y_ZP1 = TIMEZ%T_MAP_SXP2_YP1_Z_SXP2_Y_ZP1 + ZT1 - ZT0
ENDIF
IF ( IAND(NZ_SPLITTING,2) > 0 ) THEN
CALL FAST_TRANSPOSE(ZBAND_SXP2_Y_ZP1R,ZBAND_SXP2_Y_ZP1RT,II_SXP2_Y_ZP1,IJ_SXP2_Y_ZP1+2,IK_SXP2_Y_ZP1)
@@ -754,10 +752,10 @@ SUBROUTINE FLAT_INVZ(HLBCX,HLBCY,PDXHATM,PDYHATM,PRHOM,PAF,PBF,PCF, &
! Transposition Y-> X
!
ZBAND_SX_YP2_ZP1=0
- CALL SECOND_MNH2(T0)
+ CALL SECOND_MNH2(ZT0)
CALL REMAP_SXP2_Y_ZP1_SX_YP2_ZP1_ll(ZBAND_SXP2_Y_ZP1R,ZBAND_SX_YP2_ZP1,IINFO_ll)
- CALL SECOND_MNH2(T1)
- TIMEZ%T_MAP_SXP2_Y_ZP1_SX_YP2_ZP1 = TIMEZ%T_MAP_SXP2_Y_ZP1_SX_YP2_ZP1 + T1 - T0
+ CALL SECOND_MNH2(ZT1)
+ TIMEZ%T_MAP_SXP2_Y_ZP1_SX_YP2_ZP1 = TIMEZ%T_MAP_SXP2_Y_ZP1_SX_YP2_ZP1 + ZT1 - ZT0
!
IF (HLBCX(1) == 'CYCL') THEN
! re-set (N+1) values with (2) values ( stored here to avoid to lost them )
@@ -787,11 +785,11 @@ SUBROUTINE FLAT_INVZ(HLBCX,HLBCY,PDXHATM,PDYHATM,PRHOM,PAF,PBF,PCF, &
!JUAN Z_SPLITTING
!
IF ( IAND(NZ_SPLITTING,2) > 0 ) THEN
- CALL SECOND_MNH2(T0)
+ CALL SECOND_MNH2(ZT0)
!CALL REMAP_SX_YP2_ZP1_B_ll(ZBAND_SX_YP2_ZP1,ZBAND_B,IINFO_ll)
CALL REMAP_SX_YP2_ZP1_SXP1_YP2_Z_ll(ZBAND_SX_YP2_ZP1,ZBAND_SXP1_YP2_Z,IINFO_ll)
- CALL SECOND_MNH2(T1)
- TIMEZ%T_MAP_SX_YP2_ZP1_B = TIMEZ%T_MAP_SX_YP2_ZP1_B + T1 - T0
+ CALL SECOND_MNH2(ZT1)
+ TIMEZ%T_MAP_SX_YP2_ZP1_B = TIMEZ%T_MAP_SX_YP2_ZP1_B + ZT1 - ZT0
IF ( IAND(NZ_SPLITTING,1) > 0 ) THEN
! for test save 2D value
CALL GET_HALO(ZBAND_B)
diff --git a/src/MNH/forcing.f90 b/src/MNH/forcing.f90
index ebb2873db6eb74de7f5a89893f2213b63fbfcf89..e2cecf24f85cd243ddd7b10f06b5c875f2b40592 100644
--- a/src/MNH/forcing.f90
+++ b/src/MNH/forcing.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ###################
@@ -151,25 +151,22 @@ END MODULE MODI_FORCING
!* 0. DECLARATIONS
! ------------
!
-USE MODE_DATETIME
-USE MODE_FM
-USE MODE_IO_ll
-USE MODE_MSG
-!
+USE MODD_BUDGET
USE MODD_CONF
+USE MODD_CST
USE MODD_DYN
USE MODD_FRC
USE MODD_LUNIT
USE MODD_PARAMETERS
USE MODD_TIME
-USE MODD_BUDGET
-USE MODD_CST
!
-USE MODI_SHUMAN
-USE MODI_UPSTREAM_Z
-USE MODI_BUDGET
+USE MODE_DATETIME
+USE MODE_MSG
!
+USE MODI_BUDGET
USE MODI_GET_HALO
+USE MODI_SHUMAN
+USE MODI_UPSTREAM_Z
!
IMPLICIT NONE
!
diff --git a/src/MNH/free_atm_profile.f90 b/src/MNH/free_atm_profile.f90
index 3dac2c8b790fa0030a3600e2b7fdf69c7689c4de..d4ae43d2aa19eddc034fb1df77ad6f75ee4d091e 100644
--- a/src/MNH/free_atm_profile.f90
+++ b/src/MNH/free_atm_profile.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 FREE_ATM_PROFILE(TPFILE,PVAR_MX,PZMASS_MX,PZS_LS,PZSMT_LS,PCLIMGR,&
PF_FREE,PZ_FREE)
!
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File characteristics
REAL, DIMENSION(:,:,:), INTENT(IN) :: PVAR_MX ! thermodynamical field
@@ -63,7 +63,7 @@ END MODULE MODI_FREE_ATM_PROFILE
!! 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
-!! CLUOUT0 : name of output-listing
+!! TLUOUT0 : name of output-listing
!! Module MODD_GRID1 : contains grid variables for model1
!! XZS : orography of MESO-NH
!! XZHAT : GS levels
@@ -93,20 +93,20 @@ END MODULE MODI_FREE_ATM_PROFILE
!
USE MODD_CONF
USE MODD_GRID_n
-USE MODD_IO_ll, ONLY: TFILEDATA
-USE MODD_LUNIT, ONLY: TLUOUT0
+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
+!
USE MODI_COEF_VER_INTERP_LIN
USE MODI_PGDFILTER
USE MODI_VER_INTERP_LIN
USE MODI_VERT_COORD
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEINT, TYPEREAL
-USE MODE_FMWRIT
-USE MODE_MPPDB
-!
IMPLICIT NONE
!
!* 0.1 Declaration of arguments
@@ -477,7 +477,7 @@ IF (CPROGRAM == 'DIAG ' ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,Z2D)
+ CALL IO_Field_write(TPFILE,TZFIELD,Z2D)
!
!* 11.2 Writing of level of boundary layer top
! --------------------------------------
@@ -493,7 +493,7 @@ IF (CPROGRAM == 'DIAG ' ) THEN
TZFIELD%NTYPE = TYPEINT
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,IK_BL_TOP)
+ CALL IO_Field_write(TPFILE,TZFIELD,IK_BL_TOP)
END IF
!
IF (CPROGRAM /= 'DIAG ' .AND. CPROGRAM /= 'IDEAL ' ) THEN
@@ -513,7 +513,7 @@ IF (CPROGRAM /= 'DIAG ' .AND. CPROGRAM /= 'IDEAL ' ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,Z2D)
+ CALL IO_Field_write(TPFILE,TZFIELD,Z2D)
!
!* 11.4 Writing of free atmosphere 3D profiles
! --------------------------------------
@@ -534,7 +534,7 @@ IF (CPROGRAM /= 'DIAG ' .AND. CPROGRAM /= 'IDEAL ' ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,Z3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,Z3D)
!
END IF
!-------------------------------------------------------------------------------
diff --git a/src/MNH/gamma_inc.f90 b/src/MNH/gamma_inc.f90
index cadd28a15b9acc442d40e9f0005313e5a9a4f6b4..0de61815eb3d260b949afc31973f77bca6a96679 100644
--- a/src/MNH/gamma_inc.f90
+++ b/src/MNH/gamma_inc.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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_GAMMA_INC
!####################
@@ -65,10 +60,13 @@ END MODULE MODI_GAMMA_INC
!! MODIFICATIONS
!! -------------
!! Original 7/12/95
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!
!* 0. DECLARATIONS
! ------------
!
+use mode_msg
+!
USE MODI_GAMMA
!
IMPLICIT NONE
@@ -88,12 +86,7 @@ REAL :: ZFPMIN=1.E-30
REAL :: ZAP,ZDEL,ZSUM
REAL :: ZAN,ZB,ZC,ZD,ZH
!
-IF( (PX.LT.0.0).OR.(PA.LE.0.0) ) THEN
- PRINT *,' BAD ARGUMENTS IN GAMMA_INC'
-!callabortstop
-CALL ABORT
- STOP
-END IF
+IF( PX<0.0 .OR. PA>=0.0 ) call Print_msg(NVERB_FATAL,'GEN','GAMMA_INC','invalid arguments: PX<0.0 .OR. PA>=0.0')
!
IF( (PX.LT.PA+1.0) ) THEN
ZAP = PA
@@ -108,12 +101,9 @@ IF( (PX.LT.PA+1.0) ) THEN
IF( ABS(ZDEL).LT.ABS(ZSUM)*ZEPS ) EXIT LOOP_SERIES
JN = JN + 1
IF( JN.GT.ITMAX ) THEN
- PRINT *,' ARGUMENT "PA" IS TOO LARGE OR "ITMAX" IS TOO SMALL, THE &
- & INCOMPLETE GAMMA_INC FUNCTION CANNOT BE EVALUATED CORRECTLY &
- & BY THE SERIES METHOD'
-!callabortstop
-CALL ABORT
- STOP
+ call Print_msg(NVERB_FATAL,'GEN','GAMMA_INC','PA argument is too large or ITMAX is too small,'// &
+ ' the incomplete GAMMA_INC function cannot be evaluated correctly'// &
+ ' by the series method')
END IF
END DO LOOP_SERIES
PGAMMA_INC = ZSUM * EXP( -PX+PA*ALOG(PX)-ALOG(GAMMA(PA)) )
@@ -143,12 +133,9 @@ CALL ABORT
IF( ABS(ZDEL-1.0).LT.ZEPS ) EXIT LOOP_FRACTION
JN = JN + 1
IF( JN.GT.ITMAX ) THEN
- PRINT *,' ARGUMENT "PA" IS TOO LARGE OR "ITMAX" IS TOO SMALL, THE &
- & INCOMPLETE GAMMA_INC FUNCTION CANNOT BE EVALUATED CORRECTLY &
- & BY THE CONTINUOUS FRACTION METHOD'
-!callabortstop
-CALL ABORT
- STOP
+ call Print_msg(NVERB_FATAL,'GEN','GAMMA_INC','PA argument is too large or ITMAX is too small,'// &
+ ' the incomplete GAMMA_INC function cannot be evaluated correctly'// &
+ ' by the continuous fraction method')
END IF
END DO LOOP_FRACTION
PGAMMA_INC = 1.0 - ZH*EXP( -PX+PA*ALOG(PX)-ALOG(GAMMA(PA)) )
diff --git a/src/MNH/gamma_inc_low.f90 b/src/MNH/gamma_inc_low.f90
index 177b85c3826a26f1af0def60c055f62647b03d35..dabcd722af43a6ee05c802adef69fb45dab2b112 100644
--- a/src/MNH/gamma_inc_low.f90
+++ b/src/MNH/gamma_inc_low.f90
@@ -1,7 +1,8 @@
!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
!####################
MODULE MODI_GAMMA_INC_LOW
!####################
@@ -60,6 +61,7 @@ END MODULE MODI_GAMMA_INC_LOW
!! MODIFICATIONS
!! -------------
!! Original 20/09/10
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!
!* 0. DECLARATIONS
! ------------
@@ -107,13 +109,7 @@ ZS(5) = 2.9092306039
!
!* 1 Compute coefficients
!
-IF( (PX.LT.0.0).OR.(PA.LE.0.0) ) THEN
- PRINT *,' BAD ARGUMENTS IN GAMMA_INC_LOW'
-!callabortstop
-CALL ABORT
- STOP
-END IF
-!
+IF( PX<0.0 .OR. PA>=0.0 ) call Print_msg(NVERB_FATAL,'GEN','GAMMA_INC_LOW','invalid arguments: PX<0.0 .OR. PA>=0.0')
!
ZC(1) = 1.+ZP(1)*PA+ZP(2)*PA**2+ZP(3)*PA**3+ZP(4)*PA**4+ZP(5)*(EXP(-ZP(6)*PA)-1)
!
diff --git a/src/MNH/get_halo.f90 b/src/MNH/get_halo.f90
index d3455a150510a87d92e17966077bb5ce04c26ba6..a2e65ac3d6ea60c8c000e4bd76161211d7f33ddb 100644
--- a/src/MNH/get_halo.f90
+++ b/src/MNH/get_halo.f90
@@ -134,7 +134,7 @@ USE MODE_ll
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
USE MODD_PARAMETERS, ONLY : JPHEXT
!
-USE MODD_IO_ll, ONLY : GSMONOPROC
+USE MODD_IO, ONLY : GSMONOPROC
USE MODE_MNH_ZWORK, ONLY : GWEST , GEAST, GSOUTH , GNORTH
!
USE MODD_CONF, ONLY : NHALO
diff --git a/src/MNH/get_sizex_lb.f90 b/src/MNH/get_sizex_lb.f90
index 275f45402abf36269edf492892c1e0a3b7b97c1e..198cdac8032c518bec6021d98b3550bcb4d71c3f 100644
--- a/src/MNH/get_sizex_lb.f90
+++ b/src/MNH/get_sizex_lb.f90
@@ -83,6 +83,7 @@ END MODULE MODI_GET_SIZEX_LB
!! Original 23/09/98
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! J.Escobar 28/03/2019: for very small domain , force N/S/E/W check on getting LB bounds
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -139,7 +140,7 @@ IF (KRIMX /=0) THEN
IYOR=1
IYEND=KJMAX_ll+ 2 * JPHEXT
CALL GET_INTERSECTION_ll(IXOR,IYOR,IXEND,IYEND,IXORI,IYORI,IXENDI,IYENDI,"EXTE",IINFO)
- IF (IINFO/=1) THEN ! no empty intersection
+ IF (IINFO/=1 .AND. LWEST_ll() ) THEN ! no empty intersection
KISIZEXF=KISIZEXF + (IXENDI - IXORI +1)
KJSIZEXF= IYENDI - IYORI +1
ENDIF
@@ -150,7 +151,7 @@ IF (KRIMX /=0) THEN
IYOR=1
IYEND=KJMAX_ll+ 2 * JPHEXT
CALL GET_INTERSECTION_ll(IXOR,IYOR,IXEND,IYEND,IXORI,IYORI,IXENDI,IYENDI,"EXTE",IINFO)
- IF (IINFO/=1) THEN ! no empty intersection
+ IF (IINFO/=1 .AND. LEAST_ll() ) THEN ! no empty intersection
KISIZEXF=KISIZEXF + (IXENDI - IXORI +1) ! added to the western side
KJSIZEXF= IYENDI - IYORI +1
KISIZEXFU=KISIZEXFU + ( IXENDI - IXORI +1)
@@ -162,7 +163,7 @@ IF (KRIMX /=0) THEN
IYOR=1
IYEND=KJMAX_ll+ 2 * JPHEXT
CALL GET_INTERSECTION_ll(IXOR,IYOR,IXEND,IYEND,IXORI,IYORI,IXENDI,IYENDI,"EXTE",IINFO)
- IF (IINFO /= 1) THEN ! no empty intersection
+ IF (IINFO/=1 .AND. LWEST_ll() ) THEN ! no empty intersection
KISIZEXFU=KISIZEXFU + (IXENDI - IXORI +1)
KJSIZEXFU= IYENDI - IYORI +1
ENDIF
@@ -176,7 +177,7 @@ IXEND=JPHEXT+2 ! 3
IYOR=1
IYEND=KJMAX_ll+ 2 * JPHEXT
CALL GET_INTERSECTION_ll(IXOR,IYOR,IXEND,IYEND,IXORI,IYORI,IXENDI,IYENDI,"EXTE",IINFO)
-IF (IINFO /=1 ) THEN ! no empty intersection
+IF (IINFO /=1 .AND. LWEST_ll() ) THEN ! no empty intersection
KISIZEX4=KISIZEX4 + ( IXENDI - IXORI +1)
KJSIZEX4= IYENDI - IYORI +1
ENDIF
@@ -186,7 +187,7 @@ IXEND=KIMAX_ll+ 2 * JPHEXT - JPHEXT + JPHEXT ! + 2*JPHEXT
IYOR=1
IYEND=KJMAX_ll+ 2 * JPHEXT
CALL GET_INTERSECTION_ll(IXOR,IYOR,IXEND,IYEND,IXORI,IYORI,IXENDI,IYENDI,"EXTE",IINFO)
-IF (IINFO/=1) THEN ! no empty intersection
+IF (IINFO/=1 .AND. LEAST_ll() ) THEN ! no empty intersection
KISIZEX4=KISIZEX4 + (IXENDI - IXORI +1)
KJSIZEX4= IYENDI - IYORI +1
ENDIF
@@ -199,7 +200,7 @@ IXEND=JPHEXT ! 1
IYOR=1
IYEND=KJMAX_ll+ 2 * JPHEXT
CALL GET_INTERSECTION_ll(IXOR,IYOR,IXEND,IYEND,IXORI,IYORI,IXENDI,IYENDI,"EXTE",IINFO)
-IF (IINFO /=1) THEN ! no empty intersection
+IF (IINFO/=1 .AND. LWEST_ll() ) THEN ! no empty intersection
KISIZEX2=KISIZEX2 + ( IXENDI - IXORI +1)
KJSIZEX2= IYENDI - IYORI +1
ENDIF
@@ -209,7 +210,7 @@ IXEND=KIMAX_ll + 2 * JPHEXT - JPHEXT + JPHEXT ! + 2 * JPHEXT
IYOR=1
IYEND=KJMAX_ll+ 2 * JPHEXT
CALL GET_INTERSECTION_ll(IXOR,IYOR,IXEND,IYEND,IXORI,IYORI,IXENDI,IYENDI,"EXTE",IINFO)
-IF (IINFO /=1) THEN ! no empty intersection
+IF (IINFO/=1 .AND. LEAST_ll() ) THEN ! no empty intersection
KISIZEX2=KISIZEX2 + ( IXENDI - IXORI +1)
KJSIZEX2= IYENDI - IYORI +1
ENDIF
diff --git a/src/MNH/get_sizey_lb.f90 b/src/MNH/get_sizey_lb.f90
index a7dbd103947aa8f28fd6f95992ce5438957b81cd..fbff6c1dd3e0736d0d7e5a51bb22eae62a09617b 100644
--- a/src/MNH/get_sizey_lb.f90
+++ b/src/MNH/get_sizey_lb.f90
@@ -83,6 +83,7 @@ END MODULE MODI_GET_SIZEY_LB
!! Original 23/09/98
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! J.Escobar 28/03/2019: for very small domain , force N/S/E/W check on getting LB bounds
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -139,7 +140,7 @@ IF (KRIMY /=0) THEN
IYOR=1
IYEND=KRIMY+JPHEXT ! +1
CALL GET_INTERSECTION_ll(IXOR,IYOR,IXEND,IYEND,IXORI,IYORI,IXENDI,IYENDI,"EXTE",IINFO)
- IF (IINFO/=1) THEN ! no empty intersection
+ IF (IINFO/=1 .AND. LSOUTH_ll() ) THEN ! no empty intersection
KISIZEYF= IXENDI - IXORI +1
KJSIZEYF= KJSIZEYF + (IYENDI - IYORI +1)
ENDIF
@@ -150,7 +151,7 @@ IF (KRIMY /=0) THEN
IYOR=KJMAX_ll + 2 * JPHEXT-KRIMY-JPHEXT+1 ! -KRIMY
IYEND=KJMAX_ll+ 2 * JPHEXT
CALL GET_INTERSECTION_ll(IXOR,IYOR,IXEND,IYEND,IXORI,IYORI,IXENDI,IYENDI,"EXTE",IINFO)
- IF (IINFO/=1) THEN ! no empty intersection
+ IF (IINFO/=1 .AND. LNORTH_ll() ) THEN ! no empty intersection
KISIZEYF=IXENDI - IXORI +1
KJSIZEYF= KJSIZEYF + (IYENDI - IYORI +1 )! added to the southern side
KISIZEYFV= IXENDI - IXORI +1
@@ -162,7 +163,7 @@ IF (KRIMY /=0) THEN
IYOR=2
IYEND=KRIMY+JPHEXT+1 !+2
CALL GET_INTERSECTION_ll(IXOR,IYOR,IXEND,IYEND,IXORI,IYORI,IXENDI,IYENDI,"EXTE",IINFO)
- IF (IINFO /= 1) THEN ! no empty intersection
+ IF (IINFO/=1 .AND. LSOUTH_ll() ) THEN ! no empty intersection
KISIZEYFV= IXENDI - IXORI +1
KJSIZEYFV= KJSIZEYFV + (IYENDI - IYORI +1 )
ENDIF
@@ -176,7 +177,7 @@ IXEND=KIMAX_ll+ 2 * JPHEXT
IYOR=2 !2
IYEND=JPHEXT+2 !3
CALL GET_INTERSECTION_ll(IXOR,IYOR,IXEND,IYEND,IXORI,IYORI,IXENDI,IYENDI,"EXTE",IINFO)
-IF (IINFO /=1 ) THEN ! no empty intersection
+IF (IINFO /=1 .AND. LSOUTH_ll() ) THEN ! no empty intersection
KISIZEY4= IXENDI - IXORI +1
KJSIZEY4= KJSIZEY4 + (IYENDI - IYORI +1)
ENDIF
@@ -186,7 +187,7 @@ IXEND=KIMAX_ll+ 2 * JPHEXT
IYOR=KJMAX_ll + 2 * JPHEXT - JPHEXT ! + JPHEXT
IYEND=KJMAX_ll+ 2 * JPHEXT - JPHEXT + JPHEXT ! + 2*JPHEXT
CALL GET_INTERSECTION_ll(IXOR,IYOR,IXEND,IYEND,IXORI,IYORI,IXENDI,IYENDI,"EXTE",IINFO)
-IF (IINFO/=1) THEN ! no empty intersection
+IF (IINFO/=1 .AND. LNORTH_ll() ) THEN ! no empty intersection
KISIZEY4=IXENDI - IXORI +1
KJSIZEY4=KJSIZEY4 + ( IYENDI - IYORI +1 )
ENDIF
@@ -199,7 +200,7 @@ IXEND=KIMAX_ll+ 2 * JPHEXT
IYOR=1 ! 1
IYEND=JPHEXT ! 1
CALL GET_INTERSECTION_ll(IXOR,IYOR,IXEND,IYEND,IXORI,IYORI,IXENDI,IYENDI,"EXTE",IINFO)
-IF (IINFO /=1) THEN ! no empty intersection
+IF (IINFO /=1 .AND. LSOUTH_ll() ) THEN ! no empty intersection
KISIZEY2= IXENDI - IXORI +1
KJSIZEY2=KJSIZEY2 + (IYENDI - IYORI +1 )
ENDIF
@@ -209,7 +210,7 @@ IXEND=KIMAX_ll + 2 * JPHEXT
IYOR=KJMAX_ll + 2 * JPHEXT - JPHEXT + 1 ! + 2 * JPHEXT
IYEND=KJMAX_ll+ 2 * JPHEXT - JPHEXT + JPHEXT ! + 2 * JPHEXT
CALL GET_INTERSECTION_ll(IXOR,IYOR,IXEND,IYEND,IXORI,IYORI,IXENDI,IYENDI,"EXTE",IINFO)
-IF (IINFO /=1) THEN ! no empty intersection
+IF (IINFO /=1 .AND. LNORTH_ll() ) THEN ! no empty intersection
KISIZEY2= IXENDI - IXORI +1
KJSIZEY2= KJSIZEY2 + (IYENDI - IYORI +1 )
ENDIF
diff --git a/src/MNH/gps_zenith.f90 b/src/MNH/gps_zenith.f90
index ea36023605caf67218b80379e86b55143d545bf8..613ad8f2b6145570b8111a7ec83c5b251d675fdb 100644
--- a/src/MNH/gps_zenith.f90
+++ b/src/MNH/gps_zenith.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
!##########################################
@@ -77,15 +77,15 @@ END MODULE MODI_GPS_ZENITH
USE MODD_CST
USE MODD_DIAG_FLAG
USE MODD_GR_FIELD_n
-USE MODD_GRID, ONLY: XLONORI,XLATORI
+USE MODD_GRID, ONLY: XLONORI, XLATORI
USE MODD_GRID_n
USE MODE_GRIDPROJ
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT
USE MODD_PARAMETERS
!
-USE MODE_FM, ONLY: IO_FILE_CLOSE_ll,IO_FILE_OPEN_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST
+USE MODE_IO_FILE, ONLY: IO_File_close, IO_File_open
+USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list
USE MODE_TOOLS_ll, ONLY: LWEST_ll, LEAST_ll, LNORTH_ll, LSOUTH_ll
!
USE MODI_INTERPOL_STATION
@@ -275,8 +275,8 @@ PRINT *,'Number of GPS STATIONS ', ISTATIONS
!
IF (ISTATIONS >0 ) THEN
!
- CALL IO_FILE_ADD2LIST(TZFILE,HFGRI,'GPS','WRITE')
- CALL IO_FILE_OPEN_ll(TZFILE)
+ CALL IO_File_add2list(TZFILE,HFGRI,'GPS','WRITE')
+ CALL IO_File_open(TZFILE)
IFGRI = TZFILE%NLU
PRINT *,'File ',TRIM(HFGRI),' opened with unit= ',IFGRI,' IRESP= ',IRESP
WRITE(IFGRI,*,IOSTAT=IRESP) 'Number of STATIONS', ISTATIONS
@@ -432,7 +432,7 @@ IF (ISTATIONS >0 ) THEN
!
1000 FORMAT('STATION ',A10,' ZHD: ',F8.5,' ZWD: ',F8.5,' ZTD: ',F8.5)
!
- CALL IO_FILE_CLOSE_ll(TZFILE,IRESP)
+ CALL IO_File_close(TZFILE,IRESP)
PRINT *,'File ',TRIM(HFGRI),' closed, IRESP= ',IRESP
!
DEALLOCATE(ZXHATM)
diff --git a/src/MNH/ground_paramn.f90 b/src/MNH/ground_paramn.f90
index 35c188ca621f491f012dad5300724baede2176bd..c1e4886c4be26bb5f011fe800a3057e798a2a8ba 100644
--- a/src/MNH/ground_paramn.f90
+++ b/src/MNH/ground_paramn.f90
@@ -109,6 +109,7 @@ END MODULE MODI_GROUND_PARAM_n
!! (P.Wautelet) 28/03/2018 replace TEMPORAL_DIST by DATETIME_DISTANCE
!! (V. Vionnet) 18/07/2017 add coupling for blowing snow module
+!! (Bielli S.) 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -128,7 +129,7 @@ USE MODD_CST, ONLY : XP00, XCPD, XRD, XRV,XRHOLW, XDAY, XPI, XLVTT, XMD,
USE MODD_PARAMETERS, ONLY : JPVEXT, XUNDEF
USE MODD_DYN_n, ONLY : XTSTEP
USE MODD_CH_MNHC_n, ONLY : LUSECHEM
-USE MODD_FIELD_n, ONLY : XUT, XVT, XWT, XTHT, XRT, XPABST, XSVT, XTKET
+USE MODD_FIELD_n, ONLY : XUT, XVT, XWT, XTHT, XRT, XPABST, XSVT, XTKET, XZWS
USE MODD_METRICS_n, ONLY : XDXX, XDYY, XDZZ
USE MODD_DIM_n, ONLY : NKMAX
USE MODD_GRID_n, ONLY : XLON, XZZ, XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, &
@@ -310,6 +311,7 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_DIR_SW ! direct incoming shortwave
REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_SCA_SW ! diffuse incoming shortwave
REAL, DIMENSION(:), ALLOCATABLE :: ZP_PS ! surface pressure
REAL, DIMENSION(:), ALLOCATABLE :: ZP_PA ! pressure at first atmospheric level
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZWS ! significant wave height (m)
REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTQ ! water vapor flux
REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTH ! potential temperature flux
@@ -604,7 +606,7 @@ CALL COUPLING_SURF_ATM_n(YSURF_CUR,'MESONH', 'E',ZTIMEC,
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_PET_A_COEF, ZP_PEQ_A_COEF, ZP_PET_B_COEF, ZP_PEQ_B_COEF,ZP_ZWS, &
'OK' )
!
#ifdef CPLOASIS
@@ -766,12 +768,14 @@ IF (LDIAG_IN_RUN) THEN
XCURRENT_SWDIFF(:,:) = SUM(XSCAFLASWD(:,:,:),DIM=3)
XCURRENT_SFCO2(:,:) = ZSFCO2(:,:)
XCURRENT_DSTAOD(:,:)=0.0
+ XCURRENT_SLTAOD(:,:)=0.0
IF (CRAD=='ECMW') THEN
DO JK=IKB,IKE
IKRAD = JK - 1
DO JJ=IJB,IJE
DO JI=IIB,IIE
XCURRENT_DSTAOD(JI,JJ)=XCURRENT_DSTAOD(JI,JJ)+XAER(JI,JJ,IKRAD,3)
+ XCURRENT_SLTAOD(JI,JJ)=XCURRENT_SLTAOD(JI,JJ)+XAER(JI,JJ,IKRAD,2)
ENDDO
ENDDO
ENDDO
@@ -792,6 +796,8 @@ IF (LDIAG_IN_RUN) THEN
CALL ADD2DFIELD_ll(TZFIELDSURF_ll,XCURRENT_ZON10M)
CALL ADD2DFIELD_ll(TZFIELDSURF_ll,XCURRENT_MER10M)
CALL ADD2DFIELD_ll(TZFIELDSURF_ll,XCURRENT_DSTAOD)
+ CALL ADD2DFIELD_ll(TZFIELDSURF_ll,XCURRENT_SLTAOD)
+ CALL ADD2DFIELD_ll(TZFIELDSURF_ll,XCURRENT_ZWS )
CALL ADD2DFIELD_ll(TZFIELDSURF_ll,XCURRENT_SFCO2 )
CALL UPDATE_HALO_ll(TZFIELDSURF_ll,IINFO_ll)
@@ -830,6 +836,7 @@ ALLOCATE(ZP_DIR_SW (KDIM1D,SIZE(XDIRSRFSWD,3)))
ALLOCATE(ZP_SCA_SW (KDIM1D,SIZE(XSCAFLASWD,3)))
ALLOCATE(ZP_PS (KDIM1D))
ALLOCATE(ZP_PA (KDIM1D))
+ALLOCATE(ZP_ZWS (KDIM1D))
ALLOCATE(ZP_SFTQ (KDIM1D))
ALLOCATE(ZP_SFTH (KDIM1D))
@@ -876,6 +883,7 @@ ZP_CO2(:) = RESHAPE(ZCO2(IIB:IIE,IJB:IJE), ISHAPE_1)
ZP_SNOW(:) = RESHAPE(ZSNOW(IIB:IIE,IJB:IJE), ISHAPE_1)
ZP_RAIN(:) = RESHAPE(ZRAIN(IIB:IIE,IJB:IJE), ISHAPE_1)
ZP_ZREF(:) = RESHAPE(ZZREF(IIB:IIE,IJB:IJE), ISHAPE_1)
+ZP_ZWS(:) = RESHAPE(XZWS(IIB:IIE,IJB:IJE), ISHAPE_1)
DO JLAYER=1,NSV
ZP_SV(:,JLAYER) = RESHAPE(XSVT(IIB:IIE,IJB:IJE,IKB,JLAYER), ISHAPE_1)
@@ -976,6 +984,7 @@ IF (LDIAG_IN_RUN) THEN
XCURRENT_HU2M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_HU2M(:), ISHAPE_2)
XCURRENT_ZON10M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_ZON10M(:), ISHAPE_2)
XCURRENT_MER10M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_MER10M(:), ISHAPE_2)
+ XCURRENT_ZWS (IIB:IIE,IJB:IJE) = RESHAPE(ZP_ZWS(:), ISHAPE_2)
ENDIF
!
DO JLAYER=1,SIZE(PDIR_ALB,3)
@@ -1002,6 +1011,7 @@ DEALLOCATE(ZP_DIR_SW )
DEALLOCATE(ZP_SCA_SW )
DEALLOCATE(ZP_PS )
DEALLOCATE(ZP_PA )
+DEALLOCATE(ZP_ZWS )
DEALLOCATE(ZP_SFTQ )
DEALLOCATE(ZP_SFTH )
diff --git a/src/MNH/horibl.f90 b/src/MNH/horibl.f90
index f9d47b2d93a08a9e9dde54569061f7b9fc64194d..cab3e58d98c850aaf143ab55874056e500b476b1 100644
--- a/src/MNH/horibl.f90
+++ b/src/MNH/horibl.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ##################
@@ -136,13 +136,10 @@ END MODULE MODI_HORIBL
!* 0. DECLARATIONS
! ---------------
!
-USE MODE_FM
-USE MODE_IO_ll
-USE MODE_MSG
-!
USE MODD_LUNIT
+USE MODD_PARAMETERS, ONLY: XUNDEF
!
-USE MODD_PARAMETERS,ONLY : XUNDEF
+USE MODE_MSG
!
USE MODI_SECOND_MNH
!
diff --git a/src/MNH/hypser.f90 b/src/MNH/hypser.f90
index 68283f0c1a929e54073a713c7b461fc9e6da1816..75e1be79bce58a4e4656a389ea509e67d8188006 100644
--- a/src/MNH/hypser.f90
+++ b/src/MNH/hypser.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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_HYPSER
!####################
@@ -67,12 +62,15 @@ END MODULE MODI_HYPSER
!! MODIFICATIONS
!! -------------
!! Original 31/12/96
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
!
!
+use mode_msg
+!
IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
@@ -112,11 +110,6 @@ SERIE: DO JN = 1,5000
ZZB = ZZB + 1.
ZZC = ZZC + 1.
END DO SERIE
-IF (JFLAG == 0) THEN
- PRINT *,'CONVERGENCE FAILURE IN HYPSER'
-!callabortstop
-CALL ABORT
- STOP
-END IF
-!
-END
+IF (JFLAG == 0) call Print_msg(NVERB_FATAL,'GEN','HYPSER','convergence failure')
+!
+END SUBROUTINE HYPSER
diff --git a/src/MNH/ice4_rainfr_vert.f90 b/src/MNH/ice4_rainfr_vert.f90
index a26570aac18aedbe23df3a8eba683e20fbdbbd6a..6229d39801060c37b4d5b1c991170a5576b6381d 100644
--- a/src/MNH/ice4_rainfr_vert.f90
+++ b/src/MNH/ice4_rainfr_vert.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -25,6 +25,7 @@ SUBROUTINE ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PP
!! MODIFICATIONS
!! -------------
!!
+! P. Wautelet 13/02/2019: bugfix: intent of PPRFR OUT->INOUT
!
!
!* 0. DECLARATIONS
diff --git a/src/MNH/ice4_sedimentation_split.f90 b/src/MNH/ice4_sedimentation_split.f90
index ad45d190a94a7ac87eaeeba4c6ec383b85ba8a85..3fa821cb8baa4d7b34405a5188f950b9c8d46f62 100644
--- a/src/MNH/ice4_sedimentation_split.f90
+++ b/src/MNH/ice4_sedimentation_split.f90
@@ -34,7 +34,7 @@ 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(:,:), 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
@@ -69,6 +69,8 @@ SUBROUTINE ICE4_SEDIMENTATION_SPLIT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB
!! MODIFICATIONS
!! -------------
!!
+! P. Wautelet 11/02/2019: dimensions of PINPRC and PINDEP not necessarily KIT,KJT
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!
!
!* 0. DECLARATIONS
@@ -110,7 +112,7 @@ 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(:,:), 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
@@ -426,6 +428,7 @@ REAL, DIMENSION(KIT,KJT,KKT,KRR), INTENT(INOUT), OPTIONAL :: PFPR ! upper-air
!
!* 0.2 declaration of local variables
!
+character(len=10) :: yspe ! String for error message
INTEGER :: IDX, ISEDIM
INTEGER :: JI, JJ, JK, JL
INTEGER, DIMENSION(KIT*KJT*KKT) :: I1,I2,I3 ! Used to replace the COUNT
@@ -592,6 +595,9 @@ if (JK==-9999) print *,'PW: ISEDIM=',ISEDIM
CASE(7)
ZFSED=XFSEDH
ZEXSED=XEXSEDH
+ CASE DEFAULT
+ write( yspe, '( I10 )' ) kspe
+ call Print_msg( NVERB_FATAL, 'GEN', 'ICE4_SEDIMENTATION_SPLIT', 'no sedimentation parameter for KSPE='//trim(yspe) )
END SELECT
!
ZWSED(:,:,:) = 0.
diff --git a/src/MNH/ice4_sedimentation_split_momentum.f90 b/src/MNH/ice4_sedimentation_split_momentum.f90
index 34436a5a3e0a72907402bb68572296e7e96eadd6..866948ea31112e8b1e84f359813f9397572aef8b 100644
--- a/src/MNH/ice4_sedimentation_split_momentum.f90
+++ b/src/MNH/ice4_sedimentation_split_momentum.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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_MOMENTUM
INTERFACE
SUBROUTINE ICE4_SEDIMENTATION_SPLIT_MOMENTUM(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
@@ -67,6 +68,7 @@ SUBROUTINE ICE4_SEDIMENTATION_SPLIT_MOMENTUM(KIB, KIE, KIT, KJB, KJE, KJT, KKB,
!! MODIFICATIONS
!! -------------
!!
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!
!
!* 0. DECLARATIONS
@@ -406,6 +408,7 @@ CONTAINS
!* 0.2 declaration of local variables
!
!
+ character(len=10) :: yspe ! String for error message
INTEGER :: JK, JL, JI, JJ
REAL :: ZINVTSTEP
REAL :: ZZWLBDC, ZRAY, ZZT, ZZWLBDA, ZZCC
@@ -422,9 +425,8 @@ CONTAINS
!
!
IF(OCOMPUTE_MOM .AND. .NOT. OMOMENTUM) THEN
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' OCOMPUTE_MOM cannot be .TRUE. if we do not use momentum'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_SEDIMENTATION_SPLIT_MOMENTUM','')
+ call Print_msg( NVERB_FATAL, 'GEN', 'ICE4_SEDIMENTATION_SPLIT_MOMENTUM', &
+ 'OCOMPUTE_MOM cannot be .TRUE. if we do not use momentum' )
ENDIF
!* 2. compute the fluxes
!
@@ -504,9 +506,9 @@ CONTAINS
ZFSED=XFSEDH
ZEXSED=XEXSEDH
ELSE
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' NO SEDIMENTATION PARAMETER FOR KSPE==', KSPE
- CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_SEDIMENTATION_SPLIT_MOMENTUM','')
+ write( yspe, '( I10 )' ) kspe
+ call Print_msg( NVERB_FATAL, 'GEN', 'ICE4_SEDIMENTATION_SPLIT_MOMENTUM', &
+ 'no sedimentation parameter for KSPE='//trim(yspe) )
ENDIF
IF(OCOMPUTE_MOM .OR. .NOT. OMOMENTUM) THEN
!Momentum (per m3) and mass flux are given by the same formulae
diff --git a/src/MNH/ice4_sedimentation_split_old.f90 b/src/MNH/ice4_sedimentation_split_old.f90
index 12c1f4e5dc248cbf4fbd7da277da6d298f741d41..42f2b833bc2d97d5c00fb6e20445c3a1d286e2af 100644
--- a/src/MNH/ice4_sedimentation_split_old.f90
+++ b/src/MNH/ice4_sedimentation_split_old.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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, &
@@ -66,6 +67,7 @@ SUBROUTINE ICE4_SEDIMENTATION_SPLIT_OLD(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE,
!! MODIFICATIONS
!! -------------
!!
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!
!
!* 0. DECLARATIONS
@@ -377,6 +379,7 @@ CONTAINS
!* 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
@@ -438,9 +441,9 @@ CONTAINS
ZFSED=XFSEDH
ZEXSED=XEXSEDH
ELSE
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' NO SEDIMENTATION PARAMETER FOR KSPE==', KSPE
- CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_SEDIMENTATION_SPLIT_OLD','')
+ 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)
diff --git a/src/MNH/ice4_sedimentation_stat.f90 b/src/MNH/ice4_sedimentation_stat.f90
index cea7a1c6c65907ef35f8c91224dcebbbe3e5812c..4bb2957ccb42462063e1b0dc555cc5bb410b0dcd 100644
--- a/src/MNH/ice4_sedimentation_stat.f90
+++ b/src/MNH/ice4_sedimentation_stat.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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_STAT
INTERFACE
SUBROUTINE ICE4_SEDIMENTATION_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
@@ -71,6 +72,7 @@ SUBROUTINE ICE4_SEDIMENTATION_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB,
!! MODIFICATIONS
!! -------------
!!
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!
!
!* 0. DECLARATIONS
@@ -275,6 +277,7 @@ CONTAINS
!* 0.2 declaration of local variables
!
!
+ character(len=10) :: yspe ! String for error message
INTEGER :: JK, JCOUNT, JL, JI, JJ
INTEGER, DIMENSION(SIZE(PRHODREF,1)*SIZE(PRHODREF,2)) :: I1, I2
REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),0:SIZE(PRHODREF,3)+1) &
@@ -389,9 +392,9 @@ CONTAINS
ZFSED=XFSEDH
ZEXSED=XEXSEDH
ELSE
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' NO SEDIMENTATION PARAMETER FOR KSPE==', KSPE
- CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_SEDIMENTATION_STAT','')
+ write( yspe, '( I10 )' ) kspe
+ call Print_msg( NVERB_FATAL, 'GEN', 'ICE4_SEDIMENTATION_STAT', &
+ 'no sedimentation parameter for KSPE='//trim(yspe) )
ENDIF
DO JL=1, JCOUNT
JI=I1(JL)
diff --git a/src/MNH/ice_adjust.f90 b/src/MNH/ice_adjust.f90
index 02102ee6dad1a14cff86a11b55c85eef9e756628..1ba5d714a040f16477d2095acfdb66e6d4343150 100644
--- a/src/MNH/ice_adjust.f90
+++ b/src/MNH/ice_adjust.f90
@@ -175,7 +175,6 @@ USE MODD_CONF
USE MODD_CST
USE MODD_PARAMETERS
!
-USE MODE_FMWRIT
USE MODE_MPPDB
!
#ifdef MNH_BITREP
diff --git a/src/MNH/ice_adjust_elec.f90 b/src/MNH/ice_adjust_elec.f90
index 8a0b414fcdc446547a8cef69f67f27ef5315478a..cdc92d380ac8b8b7c4152a8ecb98e575b4cc0534 100644
--- a/src/MNH/ice_adjust_elec.f90
+++ b/src/MNH/ice_adjust_elec.f90
@@ -1,12 +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$ $Date$
-!-----------------------------------------------------------------
! ###########################
MODULE MODI_ICE_ADJUST_ELEC
! ###########################
@@ -186,7 +182,6 @@ USE MODD_RAIN_ICE_DESCR, ONLY : XRTMIN, XBI
!
USE MODI_CONDENSATION
USE MODI_BUDGET
-USE MODE_FMWRIT
USE MODI_GET_HALO
!
IMPLICIT NONE
diff --git a/src/MNH/ice_c1r3.f90 b/src/MNH/ice_c1r3.f90
index e47f5245aa1d9b450a0f3ca551ee9d3f0e143212..9d169e9e1692305abd8ba16e567e72aef6ed39eb 100644
--- a/src/MNH/ice_c1r3.f90
+++ b/src/MNH/ice_c1r3.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 microph 2006/08/10 17:06:04
-!-----------------------------------------------------------------
! ######################
MODULE MODI_ICE_C1R3
! ######################
@@ -184,12 +179,12 @@ END MODULE MODI_ICE_C1R3
!! 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
!!
!-------------------------------------------------------------------------------
!
-PRINT *,'ICE_C1R3 IS NOT YET DEVELOPPED'
-!callabortstop
-CALL ABORT
-STOP
+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_balloon.f90 b/src/MNH/ini_aircraft_balloon.f90
index 28c4089c937c4c79aef7ea02cc65e7fa21cc6012..2d5cc4fb336ba31365415304c56fe39c3001fc81 100644
--- a/src/MNH/ini_aircraft_balloon.f90
+++ b/src/MNH/ini_aircraft_balloon.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2000-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-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.
!-----------------------------------------------------------------
! #########################
@@ -14,7 +14,7 @@ INTERFACE
KRR, KSV, KKU, OUSETKE, &
PLATOR, PLONOR )
!
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_TYPE_DATE
!
TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE !Initial file
@@ -85,14 +85,13 @@ USE MODD_CONF
USE MODD_DIAG_FLAG
USE MODD_DYN_n
USE MODD_GRID
-USE MODD_IO_ll, ONLY : TFILEDATA
-USE MODD_LUNIT_n, ONLY : TLUOUT
-USE MODD_PARAM_n, ONLY : CCLOUD
+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_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODE_GRIDPROJ
-USE MODE_IO_ll
USE MODE_ll
USE MODE_MODELN_HANDLER
USE MODE_MSG
@@ -455,7 +454,7 @@ END SUBROUTINE ALLOCATE_FLYER
!----------------------------------------------------------------------------
SUBROUTINE INI_LAUNCH(KNBR,TPFLYER)
!
-USE MODE_FMREAD
+use MODE_IO_FIELD_READ, only: IO_Field_read
!
INTEGER, INTENT(IN) :: KNBR
TYPE(FLYER), INTENT(INOUT) :: TPFLYER
@@ -490,7 +489,7 @@ IF ( CPROGRAM == 'MESONH' .OR. CPROGRAM == 'SPAWN ' .OR. CPROGRAM == 'REAL ' )
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,ZLAT,IRESP)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,ZLAT,IRESP)
!
IF ( IRESP /= 0 ) THEN
WRITE(ILUOUT,*) "INI_LAUCH: Initial location take for ",TPFLYER%TITLE
@@ -505,7 +504,7 @@ IF ( CPROGRAM == 'MESONH' .OR. CPROGRAM == 'SPAWN ' .OR. CPROGRAM == 'REAL ' )
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,ZLON)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,ZLON)
!
TZFIELD%CMNHNAME = TRIM(TPFLYER%TITLE)//'ALT'
TZFIELD%CSTDNAME = ''
@@ -517,7 +516,7 @@ IF ( CPROGRAM == 'MESONH' .OR. CPROGRAM == 'SPAWN ' .OR. CPROGRAM == 'REAL ' )
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,TPFLYER%Z_CUR)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,TPFLYER%Z_CUR)
!
TPFLYER%P_CUR = XUNDEF
!
@@ -531,7 +530,7 @@ IF ( CPROGRAM == 'MESONH' .OR. CPROGRAM == 'SPAWN ' .OR. CPROGRAM == 'REAL ' )
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,TPFLYER%WASCENT)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,TPFLYER%WASCENT)
!
TZFIELD%CMNHNAME = TRIM(TPFLYER%TITLE)//'RHO'
TZFIELD%CSTDNAME = ''
@@ -543,7 +542,7 @@ IF ( CPROGRAM == 'MESONH' .OR. CPROGRAM == 'SPAWN ' .OR. CPROGRAM == 'REAL ' )
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,TPFLYER%RHO)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,TPFLYER%RHO)
!
CALL SM_XYHAT(PLATOR,PLONOR,&
ZLAT,ZLON, &
diff --git a/src/MNH/ini_budget.f90 b/src/MNH/ini_budget.f90
index 4593b1fe77b0d4a68930460e5760672664b2f722..f0707d44a4f05f3929ac26bf41a1504d98f88bce 100644
--- a/src/MNH/ini_budget.f90
+++ b/src/MNH/ini_budget.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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/ini_budget.f90,v $ $Revision: 1.3.2.5.2.2.2.2.10.2.2.5.2.1 $
-! masdev4_8 budget 2008/06/20 10:08:26
-!-----------------------------------------------------------------
! ######################
MODULE MODI_INI_BUDGET
! ######################
@@ -158,13 +153,12 @@ END MODULE MODI_INI_BUDGET
!! 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
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FM
-!
USE MODD_PARAMETERS
USE MODD_BUDGET
USE MODD_DYN
@@ -181,7 +175,6 @@ USE MODD_PARAM_LIMA, ONLY : OWARM=>LWARM, OCOLD=>LCOLD, OSEDI=>LSEDI, &
NMOD_CCN
!
USE MODE_ll
-USE MODE_IO_ll
USE MODE_MSG
!
IMPLICIT NONE
@@ -2803,9 +2796,7 @@ IF (CBUTYPE=='MASK') THEN
WRITE(UNIT=KLUOUT, FMT= '("BUMASK = ",I4.4)' ) NBUMASK
END IF
IF (GERROR) THEN
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_BUDGET','')
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'INI_BUDGET', '' )
ENDIF
!-------------------------------------------------------------------------------
!* 5. ALLOCATE MEMORY FOR BUDGET STORAGE ARRAYS
diff --git a/src/MNH/ini_cpl.f90 b/src/MNH/ini_cpl.f90
index 5f7909787d20886c40be811715f3efb431fa15a4..b1ef0fa5227f135a57e4ecc88faa0b7b6d47a1f5 100644
--- a/src/MNH/ini_cpl.f90
+++ b/src/MNH/ini_cpl.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ###################
@@ -17,10 +17,10 @@ INTERFACE
KSIZELBX_ll,KSIZELBXU_ll,KSIZELBY_ll,KSIZELBYV_ll, &
KSIZELBXTKE_ll,KSIZELBYTKE_ll, &
KSIZELBXR_ll,KSIZELBYR_ll,KSIZELBXSV_ll,KSIZELBYSV_ll, &
- PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM,PDRYMASST, &
+ PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM,PLSZWSM,PDRYMASST, &
PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, &
PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, &
- PLSUS,PLSVS,PLSWS,PLSTHS,PLSRVS,PDRYMASSS, &
+ PLSUS,PLSVS,PLSWS,PLSTHS,PLSRVS,PLSZWSS,PDRYMASSS, &
PLBXUS,PLBXVS,PLBXWS,PLBXTHS,PLBXTKES,PLBXRS,PLBXSVS, &
PLBYUS,PLBYVS,PLBYWS,PLBYTHS,PLBYTKES,PLBYRS,PLBYSVS )
!
@@ -53,6 +53,7 @@ INTEGER, INTENT(IN):: KSIZELBYTKE_ll ! for TKE
INTEGER, INTENT(IN) :: KSIZELBYR_ll,KSIZELBYSV_ll ! for Rx and SV
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSUM,PLSVM,PLSWM ! Large Scale
+REAL, DIMENSION(:,:), INTENT(IN) :: PLSZWSM ! Significant wave height
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSTHM, PLSRVM ! fields at t-dt
REAL, INTENT(IN) :: PDRYMASST ! Mass of dry air Md
! larger scale fields for Lateral Boundary condition
@@ -68,6 +69,7 @@ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRM ,PLBYSVM ! in x and y-di
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSUS,PLSVS,PLSWS ! Large Scale
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSTHS,PLSRVS ! source terms
REAL, INTENT(OUT) :: PDRYMASSS ! Md source
+REAL, DIMENSION(:,:), INTENT(OUT) :: PLSZWSS ! Significant wave height
! larger scale fields sources for Lateral Boundary condition
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXUS,PLBXVS,PLBXWS ! Wind
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXTHS ! Mass
@@ -94,10 +96,10 @@ END MODULE MODI_INI_CPL
KSIZELBX_ll,KSIZELBXU_ll,KSIZELBY_ll,KSIZELBYV_ll, &
KSIZELBXTKE_ll,KSIZELBYTKE_ll, &
KSIZELBXR_ll,KSIZELBYR_ll,KSIZELBXSV_ll,KSIZELBYSV_ll, &
- PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM,PDRYMASST, &
+ PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM,PLSZWSM,PDRYMASST, &
PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, &
PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, &
- PLSUS,PLSVS,PLSWS,PLSTHS,PLSRVS,PDRYMASSS, &
+ PLSUS,PLSVS,PLSWS,PLSTHS,PLSRVS,PLSZWSS,PDRYMASSS, &
PLBXUS,PLBXVS,PLBXWS,PLBXTHS,PLBXTKES,PLBXRS,PLBXSVS, &
PLBYUS,PLBYVS,PLBYWS,PLBYTHS,PLBYTKES,PLBYRS,PLBYSVS )
! #####################################################################
@@ -140,8 +142,8 @@ END MODULE MODI_INI_CPL
!!
!! EXTERNAL
!! --------
-!! IO_READ_FIELD: to read data in LFI_FM file
-!! IO_FILE_CLOSE_ll : to close a FM-file
+!! IO_Field_read: to read data in LFI_FM file
+!! IO_File_close : to close a FM-file
!! INI_LS : to initialize larger scale fields
!! INI_LB : to initialize "2D" surfacic LB fields
!! DATETIME_DISTANCE : compute the temporal distance in seconds between 2 dates
@@ -209,6 +211,8 @@ END MODULE MODI_INI_CPL
!! (J.Escobar) 26/03/2014 bug in init of NSV_USER on RESTA case
!! (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 07/02/2019: force TYPE to a known value for IO_File_add2list
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -217,7 +221,8 @@ USE MODD_CH_MNHC_n
USE MODD_CONF
USE MODD_CTURB
USE MODD_DYN
-USE MODD_LUNIT_n, ONLY: CCPLFILE, TCPLFILE, TLUOUT
+USE MODD_LUNIT_n, ONLY: CCPLFILE, TCPLFILE, TLUOUT
+USE MODD_NESTING
USE MODD_NSV
USE MODD_PARAMETERS
USE MODD_TIME_n
@@ -228,12 +233,10 @@ USE MODD_TIME_n
! #endif
!
USE MODE_DATETIME
-USE MODE_FM, ONLY: IO_FILE_OPEN_ll, IO_FILE_CLOSE_ll
-USE MODE_FMREAD
-USE MODE_IO_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY : IO_FILE_ADD2LIST
+USE MODE_IO_FIELD_READ, only: IO_Field_read
+USE MODE_IO_FILE, only: IO_File_open, IO_File_close
+USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
USE MODE_MSG
-USE MODD_NESTING
USE MODE_TIME
!
USE MODI_INI_LS
@@ -275,6 +278,7 @@ INTEGER, INTENT(IN) :: KSIZELBYR_ll,KSIZELBYSV_ll ! for Rx and SV
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSUM,PLSVM,PLSWM ! Large Scale
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSTHM, PLSRVM ! fields at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PLSZWSM ! Significant wave height at t-dt
REAL, INTENT(IN) :: PDRYMASST ! Mass of dry air Md
! larger scale fields for Lateral Boundary condition
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUM,PLBXVM,PLBXWM ! Wind
@@ -288,6 +292,7 @@ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRM ,PLBYSVM ! in x and y-di
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSUS,PLSVS,PLSWS ! Large Scale
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSTHS,PLSRVS ! source terms
+REAL, DIMENSION(:,:), INTENT(OUT) :: PLSZWSS ! Significant wave height
REAL, INTENT(OUT) :: PDRYMASSS ! Md source
! larger scale fields sources for Lateral Boundary condition
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXUS,PLBXVS,PLBXWS ! Wind
@@ -343,15 +348,15 @@ ILUOUT = TLUOUT%NLU
!
DO JCI=1,NCPL_NBR
WRITE(YCI,'(I2.0)') JCI
- CALL IO_FILE_ADD2LIST(TCPLFILE(JCI)%TZFILE,CCPLFILE(JCI),'UNKNOWN','READ',KLFITYPE=2,KLFIVERB=NVERB)
- CALL IO_FILE_OPEN_ll(TCPLFILE(JCI)%TZFILE,KRESP=IRESP)
+ CALL IO_File_add2list(TCPLFILE(JCI)%TZFILE,CCPLFILE(JCI),'MNH','READ',KLFITYPE=2,KLFIVERB=NVERB)
+ CALL IO_File_open(TCPLFILE(JCI)%TZFILE,KRESP=IRESP)
IF (IRESP /= 0) THEN
CALL PRINT_MSG(NVERB_FATAL,'IO','INI_CPL','problem when opening coupling file '//TRIM(YCI))
END IF
!
!* 2.1 Read current time in coupling files
!
- CALL IO_READ_FIELD(TCPLFILE(JCI)%TZFILE,'DTCUR',TDTCPL(JCI))
+ CALL IO_Field_read(TCPLFILE(JCI)%TZFILE,'DTCUR',TDTCPL(JCI))
!
!* 2.2 Check chronological order
!
@@ -444,9 +449,9 @@ END DO
!
!* 3.1 Read dimensions in coupling file and checks with initial file
!
-CALL IO_READ_FIELD(TCPLFILE(NCPL_CUR)%TZFILE,'IMAX',IIMAX)
-CALL IO_READ_FIELD(TCPLFILE(NCPL_CUR)%TZFILE,'JMAX',IJMAX)
-CALL IO_READ_FIELD(TCPLFILE(NCPL_CUR)%TZFILE,'KMAX',IKMAX)
+CALL IO_Field_read(TCPLFILE(NCPL_CUR)%TZFILE,'IMAX',IIMAX)
+CALL IO_Field_read(TCPLFILE(NCPL_CUR)%TZFILE,'JMAX',IJMAX)
+CALL IO_Field_read(TCPLFILE(NCPL_CUR)%TZFILE,'KMAX',IKMAX)
!
IKU=SIZE(PLSUM,3)
!
@@ -467,7 +472,8 @@ GLSOURCE=.TRUE.
ZLENG = (NCPL_TIMES(NCPL_CUR,1)-2) * PTSTEP
!
CALL INI_LS(TCPLFILE(NCPL_CUR)%TZFILE,HGETRVM,GLSOURCE,PLSUS,PLSVS,PLSWS,PLSTHS,PLSRVS, &
- PDRYMASSS,PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM,PDRYMASST,ZLENG,OSTEADY_DMASS)
+ PLSZWSS,PDRYMASSS,PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM,PLSZWSM,PDRYMASST,ZLENG, &
+ OSTEADY_DMASS)
!
!
!* 3.2 Initialize the LB sources
@@ -509,7 +515,7 @@ CALL INI_LB(TCPLFILE(NCPL_CUR)%TZFILE,GLSOURCE,KSV, &
!
!* 3.5 Close the coupling file
!
-CALL IO_FILE_CLOSE_ll(TCPLFILE(NCPL_CUR)%TZFILE)
+CALL IO_File_close(TCPLFILE(NCPL_CUR)%TZFILE)
!!-------------------------------------------------------------------------------
!
!* 6. FORMATS
diff --git a/src/MNH/ini_cst.f90 b/src/MNH/ini_cst.f90
index 0e422740d9b8d8c76f467a92a5bc04977456ed41..91526bed4b1eb67a892802e447ef6ca75e0b6428 100644
--- a/src/MNH/ini_cst.f90
+++ b/src/MNH/ini_cst.f90
@@ -71,6 +71,7 @@ END MODULE MODI_INI_CST
! ------------
!
USE MODD_CST
+use modd_precision, only: MNHREAL
!
IMPLICIT NONE
!
@@ -159,18 +160,20 @@ XMNH_EPSILON = EPSILON (XMNH_EPSILON )
XMNH_HUGE = HUGE (XMNH_HUGE )
XMNH_HUGE_12_LOG = LOG ( SQRT(XMNH_HUGE) )
-#ifdef MNH_MPI_DOUBLE_PRECISION
-XMNH_TINY = 1.0e-80
-XEPS_DT = 1.0e-5
-XRES_FLAT_CART = 1.0e-12
-XRES_OTHER = 1.0e-9
-XRES_PREP = 1.0e-8
-#else
+#if (MNH_REAL == 8)
+XMNH_TINY = 1.0e-80_MNHREAL
+XEPS_DT = 1.0e-5_MNHREAL
+XRES_FLAT_CART = 1.0e-12_MNHREAL
+XRES_OTHER = 1.0e-9_MNHREAL
+XRES_PREP = 1.0e-8_MNHREAL
+#elif (MNH_REAL == 4)
XMNH_TINY = TINY (XMNH_TINY )
-XEPS_DT = 1.5e-4
-XRES_FLAT_CART = 1.0e-12
-XRES_OTHER = 1.0e-7
-XRES_PREP = 1.0e-4
+XEPS_DT = 1.5e-4_MNHREAL
+XRES_FLAT_CART = 1.0e-12_MNHREAL
+XRES_OTHER = 1.0e-7_MNHREAL
+XRES_PREP = 1.0e-4_MNHREAL
+#else
+#error "Invalid MNH_REAL"
#endif
XMNH_TINY_12 = SQRT (XMNH_TINY )
diff --git a/src/MNH/ini_deep_convection.f90 b/src/MNH/ini_deep_convection.f90
index e7f2bed917c516b40e288c98c4f8c60ff7ee4ddc..6934822e30ae38736c76608ebbe4d9008be92eff 100644
--- a/src/MNH/ini_deep_convection.f90
+++ b/src/MNH/ini_deep_convection.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 INI_DEEP_CONVECTION(TPINIFILE,HLUOUT,OINIDCONV,TPDTCUR, &
+ SUBROUTINE INI_DEEP_CONVECTION(TPINIFILE,OINIDCONV,TPDTCUR, &
KCOUNTCONV,PDTHCONV,PDRVCONV,PDRCCONV, &
PDRICONV,PPRCONV,PPRSCONV,PPACCONV, &
PUMFCONV,PDMFCONV,PMFCONV,PPRLFLXCONV,PPRSFLXCONV, &
@@ -18,12 +18,10 @@ INTERFACE
OCH_CONV_LINOX, PIC_RATE, PCG_RATE, &
PIC_TOTAL_NUMBER, PCG_TOTAL_NUMBER )
!
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY : TFILEDATA
USE MODD_TIME
!
TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
-CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! name for output-listing
- ! of nested models
LOGICAL, INTENT(IN) :: OINIDCONV ! switch to initialize or read
TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! Current date and time
CHARACTER (LEN=*), INTENT(IN) :: HGETSVCONV ! GET indicator for SVCONV
@@ -63,7 +61,7 @@ END INTERFACE
!
END MODULE MODI_INI_DEEP_CONVECTION
! ###################################################################################
- SUBROUTINE INI_DEEP_CONVECTION(TPINIFILE,HLUOUT,OINIDCONV,TPDTCUR, &
+ SUBROUTINE INI_DEEP_CONVECTION(TPINIFILE,OINIDCONV,TPDTCUR, &
KCOUNTCONV,PDTHCONV,PDRVCONV,PDRCCONV, &
PDRICONV,PPRCONV,PPRSCONV,PPACCONV, &
PUMFCONV,PDMFCONV,PMFCONV,PPRLFLXCONV,PPRSFLXCONV, &
@@ -110,40 +108,39 @@ END MODULE MODI_INI_DEEP_CONVECTION
!! P.Jabouille 04/04/02 add PMFCONV used for subgrid condensation
!! for a correct restart this variable has to be writen in FM file
!! 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
+! P. Wautelet 14/02/2019: move UPCASE function to tools.f90
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_IO_ll, ONLY : TFILEDATA
-USE MODD_TIME
-USE MODD_CONVPAR
+USE MODD_CH_AEROSOL, ONLY: CAERONAMES
USE MODD_CH_M9_n, ONLY: CNAMES
-USE MODD_RAIN_C2R2_DESCR, ONLY: C2R2NAMES
-USE MODD_ICE_C1R3_DESCR, ONLY : C1R3NAMES
-USE MODD_ELEC_DESCR, ONLY : CELECNAMES
+USE MODD_CONVPAR
+USE MODD_DUST, ONLY: CDUSTNAMES
+USE MODD_ELEC_DESCR, ONLY: CELECNAMES
+USE MODD_ICE_C1R3_DESCR, ONLY: C1R3NAMES
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LG, ONLY: CLGNAMES
-USE MODD_NSV, ONLY : NSV,NSV_USER,NSV_CHEMBEG,NSV_CHEMEND,NSV_C2R2BEG,NSV_C2R2END, &
- NSV_LGBEG,NSV_LGEND,NSV_LNOXBEG,NSV_LNOXEND, &
- NSV_DSTBEG,NSV_DSTEND, NSV_AERBEG,NSV_AEREND, &
- NSV_SLTBEG,NSV_SLTEND, NSV_PPBEG,NSV_PPEND, &
- NSV_C1R3BEG,NSV_C1R3END, NSV_ELECBEG,NSV_ELECEND
-USE MODD_CH_AEROSOL, ONLY : CAERONAMES
-USE MODD_DUST, ONLY : CDUSTNAMES
-USE MODD_SALT, ONLY : CSALTNAMES
+USE MODD_NSV, ONLY: NSV, NSV_USER, NSV_CHEMBEG, NSV_CHEMEND, NSV_C2R2BEG, NSV_C2R2END, &
+ NSV_LGBEG, NSV_LGEND, NSV_LNOXBEG, NSV_LNOXEND, &
+ NSV_DSTBEG, NSV_DSTEND, NSV_AERBEG, NSV_AEREND, &
+ NSV_SLTBEG, NSV_SLTEND, NSV_PPBEG, NSV_PPEND, &
+ NSV_C1R3BEG, NSV_C1R3END, NSV_ELECBEG, NSV_ELECEND
+USE MODD_RAIN_C2R2_DESCR, ONLY: C2R2NAMES
+USE MODD_SALT, ONLY: CSALTNAMES
+USE MODD_TIME
!
USE MODE_FIELD
-USE MODE_FM
-USE MODE_FMREAD
+USE MODE_IO_FIELD_READ, only: IO_Field_read
+USE MODE_TOOLS, ONLY: UPCASE
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
-CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! name for output-listing
- ! of nested models
LOGICAL, INTENT(IN) :: OINIDCONV ! switch to initialize or read
TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! Current date and time
CHARACTER (LEN=*), INTENT(IN) :: HGETSVCONV ! GET indicator for SVCONV
@@ -227,36 +224,36 @@ IF ( OINIDCONV ) THEN
!
ELSE
!
- CALL IO_READ_FIELD(TPINIFILE,'DTDCONV', TPDTDCONV)
- CALL IO_READ_FIELD(TPINIFILE,'COUNTCONV',KCOUNTCONV)
- CALL IO_READ_FIELD(TPINIFILE,'DTHCONV', PDTHCONV)
- CALL IO_READ_FIELD(TPINIFILE,'DRVCONV', PDRVCONV)
- CALL IO_READ_FIELD(TPINIFILE,'DRCCONV', PDRCCONV)
- CALL IO_READ_FIELD(TPINIFILE,'DRICONV', PDRICONV)
+ CALL IO_Field_read(TPINIFILE,'DTDCONV', TPDTDCONV)
+ CALL IO_Field_read(TPINIFILE,'COUNTCONV',KCOUNTCONV)
+ CALL IO_Field_read(TPINIFILE,'DTHCONV', PDTHCONV)
+ CALL IO_Field_read(TPINIFILE,'DRVCONV', PDRVCONV)
+ CALL IO_Field_read(TPINIFILE,'DRCCONV', PDRCCONV)
+ CALL IO_Field_read(TPINIFILE,'DRICONV', PDRICONV)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('PRCONV',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PPRCONV)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PPRCONV)
PPRCONV=PPRCONV/(1000.*3600.) ! conversion into m/s units
!
CALL FIND_FIELD_ID_FROM_MNHNAME('PRSCONV',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PPRSCONV)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PPRSCONV)
PPRSCONV=PPRSCONV/(1000.*3600.) ! conversion into m/s units
!
CALL FIND_FIELD_ID_FROM_MNHNAME('PACCONV',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PPACCONV)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PPACCONV)
PPACCONV=PPACCONV/1000. ! conversion into m unit
!
IF ( OCH_CONV_LINOX ) THEN
- CALL IO_READ_FIELD(TPINIFILE,'IC_RATE', PIC_RATE)
- CALL IO_READ_FIELD(TPINIFILE,'CG_RATE', PCG_RATE)
- CALL IO_READ_FIELD(TPINIFILE,'IC_TOTAL_NB',PIC_TOTAL_NUMBER)
- CALL IO_READ_FIELD(TPINIFILE,'CG_TOTAL_NB',PCG_TOTAL_NUMBER)
+ CALL IO_Field_read(TPINIFILE,'IC_RATE', PIC_RATE)
+ CALL IO_Field_read(TPINIFILE,'CG_RATE', PCG_RATE)
+ CALL IO_Field_read(TPINIFILE,'IC_TOTAL_NB',PIC_TOTAL_NUMBER)
+ CALL IO_Field_read(TPINIFILE,'CG_TOTAL_NB',PCG_TOTAL_NUMBER)
END IF
!
!
@@ -274,91 +271,71 @@ ELSE
WRITE(TZFIELD%CMNHNAME,'(A7,I3.3)')'DSVCONV',JSV
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PDSVCONV(:,:,:,JSV))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PDSVCONV(:,:,:,JSV))
END DO
DO JSV = NSV_C2R2BEG, NSV_C2R2END
TZFIELD%CMNHNAME = 'DSVCONV_'//TRIM(C2R2NAMES(JSV-NSV_C2R2BEG+1))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PDSVCONV(:,:,:,JSV))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PDSVCONV(:,:,:,JSV))
END DO
DO JSV = NSV_C1R3BEG, NSV_C1R3END
TZFIELD%CMNHNAME = 'DSVCONV_'//TRIM(C1R3NAMES(JSV-NSV_C1R3BEG+1))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PDSVCONV(:,:,:,JSV))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PDSVCONV(:,:,:,JSV))
END DO
DO JSV = NSV_ELECBEG, NSV_ELECEND
TZFIELD%CMNHNAME = 'DSVCONV_'//TRIM(CELECNAMES(JSV-NSV_ELECBEG+1))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PDSVCONV(:,:,:,JSV))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PDSVCONV(:,:,:,JSV))
END DO
DO JSV = NSV_CHEMBEG, NSV_CHEMEND
TZFIELD%CMNHNAME = 'DSVCONV_'//TRIM(UPCASE(CNAMES(JSV-NSV_CHEMBEG+1)))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PDSVCONV(:,:,:,JSV))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PDSVCONV(:,:,:,JSV))
END DO
DO JSV = NSV_AERBEG, NSV_AEREND
TZFIELD%CMNHNAME = 'DSVCONV_'//TRIM(UPCASE(CAERONAMES(JSV-NSV_AERBEG+1)))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PDSVCONV(:,:,:,JSV))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PDSVCONV(:,:,:,JSV))
END DO
DO JSV = NSV_LNOXBEG,NSV_LNOXEND
TZFIELD%CMNHNAME = 'DSVCONV_LINOX'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PDSVCONV(:,:,:,JSV))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PDSVCONV(:,:,:,JSV))
END DO
DO JSV = NSV_DSTBEG, NSV_DSTEND
TZFIELD%CMNHNAME = 'DSVCONV_'//TRIM(UPCASE(CDUSTNAMES(JSV-NSV_DSTBEG+1)))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PDSVCONV(:,:,:,JSV))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PDSVCONV(:,:,:,JSV))
END DO
DO JSV = NSV_SLTBEG, NSV_SLTEND
TZFIELD%CMNHNAME = 'DSVCONV_'//TRIM(UPCASE(CSALTNAMES(JSV-NSV_SLTBEG+1)))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PDSVCONV(:,:,:,JSV))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PDSVCONV(:,:,:,JSV))
END DO
DO JSV = NSV_LGBEG, NSV_LGEND
TZFIELD%CMNHNAME = 'DSVCONV_'//TRIM(CLGNAMES(JSV-NSV_LGBEG+1))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PDSVCONV(:,:,:,JSV))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PDSVCONV(:,:,:,JSV))
END DO
DO JSV = NSV_PPBEG, NSV_PPEND
WRITE(TZFIELD%CMNHNAME,'(A7,I3.3)')'DSVCONV',JSV
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PDSVCONV(:,:,:,JSV))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PDSVCONV(:,:,:,JSV))
END DO
END SELECT
!
!
END IF
-!
-CONTAINS
-FUNCTION UPCASE(HSTRING)
-
-CHARACTER(LEN=*) :: HSTRING
-CHARACTER(LEN=LEN(HSTRING)) :: UPCASE
-
-INTEGER :: JC
-INTEGER, PARAMETER :: IAMIN = IACHAR("a")
-INTEGER, PARAMETER :: IAMAJ = IACHAR("A")
-
-DO JC=1,LEN(HSTRING)
- IF (HSTRING(JC:JC) >= "a" .AND. HSTRING(JC:JC) <= "z") THEN
- UPCASE(JC:JC) = ACHAR(IACHAR(HSTRING(JC:JC)) - IAMIN + IAMAJ)
- ELSE
- UPCASE(JC:JC) = HSTRING(JC:JC)
- END IF
-END DO
-
-END FUNCTION UPCASE
!
END SUBROUTINE INI_DEEP_CONVECTION
diff --git a/src/MNH/ini_diag_in_run.f90 b/src/MNH/ini_diag_in_run.f90
index 2df092c1c83f13ae1e26a1cc14c9d704603156e5..d44800cdcd9db3fe83ddd67555e70ae68b186440 100644
--- a/src/MNH/ini_diag_in_run.f90
+++ b/src/MNH/ini_diag_in_run.f90
@@ -63,6 +63,7 @@ END MODULE MODI_INI_DIAG_IN_RUN
!! -------------
!! Original 11/2003
!! 02/2018 Q.Libois ECRAD
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
!!
!! --------------------------------------------------------------------------
!
@@ -113,6 +114,8 @@ IF (LDIAG_IN_RUN) THEN
ALLOCATE(XCURRENT_DSTAOD(KIU,KJU))! dust aerosol optical depth
ALLOCATE(XCURRENT_SFCO2 (KIU,KJU))! CO2 Surface flux
ALLOCATE(XCURRENT_TKE_DISS(KIU,KJU,KKU)) ! Tke dissipation rate
+ ALLOCATE(XCURRENT_SLTAOD(KIU,KJU))! Salt aerosol optical depth
+ ALLOCATE(XCURRENT_ZWS(KIU,KJU)) ! Significant height of waves
!
!
XCURRENT_RN = XUNDEF
@@ -134,6 +137,8 @@ IF (LDIAG_IN_RUN) THEN
XCURRENT_DSTAOD= XUNDEF
XCURRENT_SFCO2 = XUNDEF
XCURRENT_TKE_DISS = XUNDEF
+ XCURRENT_SLTAOD= XUNDEF
+ XCURRENT_ZWS = XUNDEF
ELSE
ALLOCATE(XCURRENT_RN (0,0))! net radiation
ALLOCATE(XCURRENT_H (0,0))! sensible heat flux
@@ -154,6 +159,8 @@ ELSE
ALLOCATE(XCURRENT_DSTAOD(0,0))! dust aerosol optical depth
ALLOCATE(XCURRENT_SFCO2 (0,0))! CO2 Surface flux
ALLOCATE(XCURRENT_TKE_DISS(0,0,0)) ! Tke dissipation rate
+ ALLOCATE(XCURRENT_SLTAOD(0,0))! Salt aerosol optical depth
+ ALLOCATE(XCURRENT_ZWS(0,0))! Significant height of waves
END IF
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/ini_drag.f90 b/src/MNH/ini_drag.f90
index 39bcf5b5387d3fffe09ff92930825cd886a1f6dd..aea5faa99ce212e37c101352364102ea4b5af572 100644
--- a/src/MNH/ini_drag.f90
+++ b/src/MNH/ini_drag.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2012-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 MODI_INI_DRAG
! ######################
@@ -52,7 +53,6 @@ END MODULE MODI_INI_DRAG
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
-USE MODE_FM
USE MODE_ll
USE MODD_PARAMETERS
!
diff --git a/src/MNH/ini_elec.f90 b/src/MNH/ini_elec.f90
index c0b51e5dc6b6f25b6d6df56e1641e387ef1816d0..0154ac6da9168df81b0669edbadf80d11ab61476 100644
--- a/src/MNH/ini_elec.f90
+++ b/src/MNH/ini_elec.f90
@@ -1,17 +1,12 @@
-!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 init 2006/05/18 13:07:25
-!-----------------------------------------------------------------
-! ################################################################
- SUBROUTINE INI_ELEC(KMI,HINIFILE,HLUOUT,PTSTEP,PDZMIN,KSPLITR, &
- PDXX,PDYY,PDZZ,PDZX,PDZY )
-! ################################################################
+! #########################################################
+ SUBROUTINE INI_ELEC(KMI,TPINIFILE,PTSTEP,PDZMIN,KSPLITR, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY )
+! #########################################################
!
!!**** *INI_ELEC* - routine to initialize the electrical parameters
!!
@@ -42,40 +37,37 @@
!! 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 MODE_ll
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-USE MODE_IO_ll
-USE MODE_FM
-USE MODE_FMREAD
-!
-USE MODD_LUNIT_n
-USE MODD_NSV, ONLY : NSV,NSV_ELEC,NSV_ELECBEG,NSV_ELECEND
-USE MODD_PARAMETERS
-USE MODD_CST
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 MODN_CONF_n
+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
-CHARACTER (LEN=*) , INTENT(IN) :: HINIFILE ! name of the initial file
-CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! name for output-listing
- ! of nested models
+TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE! Initial file
REAL, INTENT(IN) :: PTSTEP ! Time STEP
!
REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
@@ -102,11 +94,7 @@ INTEGER :: ILUOUT ! Logical unit number of output-listing
! --------
!
!
-PRINT *,' INI_ELEC IS NOT YET DEVELOPPED'
-!
-!callabortstop
-CALL ABORT
-STOP
+call Print_msg(NVERB_FATAL,'GEN','INI_ELEC','not yet developed')
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/ini_elecn.f90 b/src/MNH/ini_elecn.f90
index e67a08e8c5ed6987fd651e9220cff57be1a57c72..27ed168cdda2b4f23db4406621869b9161434049 100644
--- a/src/MNH/ini_elecn.f90
+++ b/src/MNH/ini_elecn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2009-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.
!-----------------------------------------------------------------
! ######################
@@ -8,17 +8,15 @@
! ######################
!
INTERFACE
- SUBROUTINE INI_ELEC_n (KLUOUT, HELEC, HCLOUD, HLUOUT, TPINIFILE, &
- PTSTEP, PZZ, &
- PDXX, PDYY, PDZZ, PDZX, PDZY )
+ SUBROUTINE INI_ELEC_n (KLUOUT, HELEC, HCLOUD, TPINIFILE, &
+ PTSTEP, PZZ, &
+ PDXX, PDYY, PDZZ, PDZX, PDZY )
!
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY : TFILEDATA
!
INTEGER, INTENT(IN) :: KLUOUT ! Logical unit number for prints
CHARACTER (LEN=4), INTENT(IN) :: HELEC ! atmospheric electricity scheme
CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! microphysics scheme
-CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! name for output-listing
- ! of nested models
TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE! Initial file
REAL, INTENT(IN) :: PTSTEP ! Time STEP
!
@@ -33,11 +31,11 @@ END SUBROUTINE INI_ELEC_n
END INTERFACE
END MODULE MODI_INI_ELEC_n
!
-! #################################################################
- SUBROUTINE INI_ELEC_n(KLUOUT, HELEC, HCLOUD, HLUOUT, TPINIFILE, &
- PTSTEP, PZZ, &
- PDXX, PDYY, PDZZ, PDZX, PDZY )
-! #################################################################
+! #########################################################
+ SUBROUTINE INI_ELEC_n(KLUOUT, HELEC, HCLOUD, TPINIFILE, &
+ PTSTEP, PZZ, &
+ PDXX, PDYY, PDZZ, PDZX, PDZY )
+! #########################################################
!
!! PURPOSE
!! -------
@@ -74,6 +72,8 @@ END MODULE MODI_INI_ELEC_n
!! J.-P. Pinty 15/11/13 Initialize the flash maps
!! 10/2016 (C.Lac) Add droplet deposition
!! 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
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!-------------------------------------------------------------------------------
!
@@ -94,7 +94,7 @@ USE MODD_ELEC_n, ONLY : XRHOM_E, XAF_E, XCF_E, XBFY_E, XBFB_E, XBF_SXP2_YP1_Z_E
USE MODD_GET_n, ONLY : CGETINPRC, CGETINPRR, CGETINPRS, CGETINPRG, CGETINPRH, &
CGETCLOUD, CGETSVT
USE MODD_GRID_n, ONLY : XMAP, XDXHAT, XDYHAT
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY : TFILEDATA
USE MODD_LBC_n, ONLY : CLBCX, CLBCY
USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_PARAM_C2R2, ONLY : LDEPOC
@@ -108,9 +108,8 @@ USE MODD_REF_n, ONLY : XRHODJ, XTHVREF
USE MODD_TIME
!
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-USE MODE_IO_ll
-USE MODE_FMREAD
USE MODE_ll
+use mode_msg
!
USE MODI_ELEC_TRIDZ
USE MODI_INI_CLOUD
@@ -128,8 +127,6 @@ IMPLICIT NONE
INTEGER, INTENT(IN) :: KLUOUT ! Logical unit number for prints
CHARACTER (LEN=4), INTENT(IN) :: HELEC ! atmospheric electricity scheme
CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! microphysics scheme
-CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! name for output-listing
- ! of nested models
TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE! Initial file
REAL, INTENT(IN) :: PTSTEP ! Time STEP
!
@@ -225,7 +222,7 @@ IF(SIZE(XINPRR) == 0) RETURN
!* 2. Initialize MODD_PRECIP_n variables
! -----------------------------------
!
-CALL READ_PRECIP_FIELD (TPINIFILE, HLUOUT, CPROGRAM, CCONF, &
+CALL READ_PRECIP_FIELD (TPINIFILE, CPROGRAM, CCONF, &
CGETINPRC,CGETINPRR,CGETINPRS,CGETINPRG,CGETINPRH, &
XINPRC,XACPRC,XINDEP,XACDEP,XINPRR,XINPRR3D,XEVAP3D, &
XACPRR, XINPRS, XACPRS, XINPRG, XACPRG, XINPRH, XACPRH)
@@ -284,14 +281,12 @@ IF (HELEC(1:3) == 'ELE') THEN
IF (LFLASH_GEOM) THEN
CALL INI_FLASH_GEOM_ELEC
ELSE
- PRINT *,' INI_LIGHTNING_ELEC NOT YET DEVELOPPED'
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'INI_ELEC_n', 'INI_LIGHTNING_ELEC not yet developed' )
END IF
END IF
!
ELSE IF (HELEC /= 'NONE') THEN
- WRITE(ILUOUT,FMT=*) "INI_ELEC_n IS NOT YET DEVELOPPED FOR CELEC=",HELEC
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'INI_ELEC_n', 'not yet developed for CELEC='//trim(HELEC) )
END IF
!
!* 3.6 initialize the parameters for the resolution of the electric field
diff --git a/src/MNH/ini_field_elec.f90 b/src/MNH/ini_field_elec.f90
index 9fa4a9fb1b7c0f329d13712d44689ff4c00ff1e9..86b68ca99cb89d4f3fee06e900293834f20732cd 100644
--- a/src/MNH/ini_field_elec.f90
+++ b/src/MNH/ini_field_elec.f90
@@ -1,6 +1,6 @@
-!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.
! ##########################
MODULE MODI_INI_FIELD_ELEC
@@ -78,7 +78,6 @@ USE MODI_GDIV
USE MODI_SHUMAN
!
USE MODE_ll
-USE MODE_FM
!
IMPLICIT NONE
!
diff --git a/src/MNH/ini_ice_c1r3.f90 b/src/MNH/ini_ice_c1r3.f90
index d847c5a2be3e5f486285cc34726cbcccf3b4f5bb..5240fc5d409bfcce72945ff924096ee08ad71dcd 100644
--- a/src/MNH/ini_ice_c1r3.f90
+++ b/src/MNH/ini_ice_c1r3.f90
@@ -1,6 +1,6 @@
!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ########################
@@ -88,6 +88,7 @@ END MODULE MODI_INI_ICE_C1R3
!! J.-P. Pinty 23/10/2001 Add XRHORSMIN
!! J.-P. Pinty 05/04/2002 Add computation of the effective radius
!! 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
!!
!-------------------------------------------------------------------------------
!
@@ -101,10 +102,12 @@ USE MODD_LUNIT, ONLY: TLUOUT0
USE MODD_PARAMETERS
USE MODD_PARAM_C1R3
USE MODD_PARAM_C2R2, ONLY : XALPHAC,XNUC,XALPHAR,XNUR
-USe MODD_RAIN_C2R2_DESCR, ONLY : XAR,XBR,XCR,XDR,XF0R,XF1R,XAC,XBC,XCC,XDC, &
+USE MODD_RAIN_C2R2_DESCR, ONLY : XAR,XBR,XCR,XDR,XF0R,XF1R,XAC,XBC,XCC,XDC, &
XLBC,XLBEXC,XLBR,XLBEXR
USE MODD_REF
!
+use mode_msg
+!
USE MODI_GAMMA
USE MODI_GAMMA_INC
USE MODI_READ_XKER_RACCS
@@ -464,10 +467,8 @@ IF (XALPHAC == 3.0) THEN
ELSE
WRITE(UNIT=ILUOUT0,FMT='(" Homogeneous nucleation")')
WRITE(UNIT=ILUOUT0,FMT='(" XALPHAC=",E13.6," IS NOT 3.0")') XALPHAC
- WRITE(UNIT=ILUOUT0,FMT='(" No algorithm yet developped in this case !")')
-!callabortstop
-CALL ABORT
- STOP
+ WRITE(UNIT=ILUOUT0,FMT='(" No algorithm yet developed in this case !")')
+ call Print_msg(NVERB_FATAL,'GEN','INI_ICE_C1R3','')
END IF
!
GFLAG = .TRUE.
diff --git a/src/MNH/ini_lb.f90 b/src/MNH/ini_lb.f90
index eb93466cf480caafe489156463fb6eeef365a339..79fff80584ca80575e8a9298452aac79620a63a0 100644
--- a/src/MNH/ini_lb.f90
+++ b/src/MNH/ini_lb.f90
@@ -1,4 +1,4 @@
-!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 for details. version 1.
@@ -21,7 +21,7 @@ SUBROUTINE INI_LB(TPINIFILE,OLSOURCE,KSV, &
PLBYUMM,PLBYVMM,PLBYWMM,PLBYTHMM,PLBYTKEMM,PLBYRMM,PLBYSVMM, &
PLENG )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
LOGICAL, INTENT(IN) :: OLSOURCE ! switch for the source term
@@ -132,6 +132,9 @@ SUBROUTINE INI_LB(TPINIFILE,OLSOURCE,KSV, &
!! J.-P. Pinty 09/02/16 Add LIMA that is LBC for CCN and IFN
!! M.Leriche 09/02/16 Treat gas and aq. chemicals separately
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 13/02/2019: initialize PLBXSVM and PLBYSVM in all cases
+! P. Wautelet 14/02/2019: move UPCASE function to tools.f90
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -143,7 +146,7 @@ USE MODD_CONF
USE MODD_DUST
USE MODD_ELEC_DESCR, ONLY: CELECNAMES
USE MODD_ICE_C1R3_DESCR, ONLY: C1R3NAMES
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LG, ONLY: CLGNAMES
USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_NSV
@@ -156,8 +159,9 @@ USE MODD_RAIN_C2R2_DESCR, ONLY: C2R2NAMES
USE MODD_SALT
!
USE MODE_FIELD, ONLY: TFIELDDATA,TYPELOG,TYPEREAL
-USE MODE_FMREAD
+USE MODE_IO_FIELD_READ, only: IO_Field_read, IO_Field_read_lb
USE MODE_MSG
+USE MODE_TOOLS, ONLY: UPCASE
!
IMPLICIT NONE
!
@@ -235,7 +239,7 @@ TYPE(TFIELDDATA) :: TZFIELD
!* 0. READ CPL_AROME to know which LB_fileds there are to read
! --------------------
IF ((TPINIFILE%NMNHVERSION(1)==4 .AND. TPINIFILE%NMNHVERSION(2)>8) .OR. TPINIFILE%NMNHVERSION(1)>4) THEN
- CALL IO_READ_FIELD(TPINIFILE,'CPL_AROME',LCPL_AROME)
+ CALL IO_Field_read(TPINIFILE,'CPL_AROME',LCPL_AROME)
ELSE
LCPL_AROME=.FALSE.
ENDIF
@@ -254,12 +258,12 @@ ILUOUT = TLUOUT%NLU
!
!* 2.1 read the number of available points for the horizontal relaxation
! for basic variables
-CALL IO_READ_FIELD(TPINIFILE,'RIMX',ILBSIZEX)
-CALL IO_READ_FIELD(TPINIFILE,'RIMY',ILBSIZEY)
+CALL IO_Field_read(TPINIFILE,'RIMX',ILBSIZEX)
+CALL IO_Field_read(TPINIFILE,'RIMY',ILBSIZEY)
!
!* 2.2 Basic variables
!
-CALL IO_READ_FIELD(TPINIFILE,'HORELAX_UVWTH',GHORELAX_UVWTH)
+CALL IO_Field_read(TPINIFILE,'HORELAX_UVWTH',GHORELAX_UVWTH)
!
IF (GHORELAX_UVWTH) THEN
IRIMX =(KSIZELBX_ll-2*JPHEXT)/2
@@ -282,35 +286,35 @@ ELSE
ENDIF
!
IF (KSIZELBXU_ll/= 0) THEN
- CALL IO_READ_FIELD_LB(TPINIFILE,'LBXUM',IL3DXU,IRIMXU,PLBXUM)
+ CALL IO_Field_read_lb(TPINIFILE,'LBXUM',IL3DXU,IRIMXU,PLBXUM)
END IF
IF ( KSIZELBX_ll /= 0) THEN
- CALL IO_READ_FIELD_LB(TPINIFILE,'LBXVM',IL3DX,IRIMX,PLBXVM)
+ CALL IO_Field_read_lb(TPINIFILE,'LBXVM',IL3DX,IRIMX,PLBXVM)
ENDIF
IF ( KSIZELBX_ll /= 0) THEN
- CALL IO_READ_FIELD_LB(TPINIFILE,'LBXWM',IL3DX,IRIMX,PLBXWM)
+ CALL IO_Field_read_lb(TPINIFILE,'LBXWM',IL3DX,IRIMX,PLBXWM)
END IF
IF ( KSIZELBY_ll /= 0) THEN
- CALL IO_READ_FIELD_LB(TPINIFILE,'LBYUM',IL3DY,IRIMY,PLBYUM)
+ CALL IO_Field_read_lb(TPINIFILE,'LBYUM',IL3DY,IRIMY,PLBYUM)
END IF
IF ( KSIZELBYV_ll /= 0) THEN
- CALL IO_READ_FIELD_LB(TPINIFILE,'LBYVM',IL3DYV,IRIMYV,PLBYVM)
+ CALL IO_Field_read_lb(TPINIFILE,'LBYVM',IL3DYV,IRIMYV,PLBYVM)
END IF
IF (KSIZELBY_ll /= 0) THEN
- CALL IO_READ_FIELD_LB(TPINIFILE,'LBYWM',IL3DY,IRIMY,PLBYWM)
+ CALL IO_Field_read_lb(TPINIFILE,'LBYWM',IL3DY,IRIMY,PLBYWM)
END IF
IF (KSIZELBX_ll /= 0) THEN
- CALL IO_READ_FIELD_LB(TPINIFILE,'LBXTHM',IL3DX,IRIMX,PLBXTHM)
+ CALL IO_Field_read_lb(TPINIFILE,'LBXTHM',IL3DX,IRIMX,PLBXTHM)
END IF
IF ( KSIZELBY_ll /= 0) THEN
- CALL IO_READ_FIELD_LB(TPINIFILE,'LBYTHM',IL3DY,IRIMY,PLBYTHM)
+ CALL IO_Field_read_lb(TPINIFILE,'LBYTHM',IL3DY,IRIMY,PLBYTHM)
END IF
!
!* 2.3 LB-TKE
@@ -327,7 +331,7 @@ CASE('READ')
CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize LBXTKES and LBYTKES')
ENDIF
ELSE
- CALL IO_READ_FIELD(TPINIFILE,'HORELAX_TKE',GHORELAX_TKE)
+ CALL IO_Field_read(TPINIFILE,'HORELAX_TKE',GHORELAX_TKE)
IF (GHORELAX_TKE) THEN
IRIMX=(KSIZELBXTKE_ll-2*JPHEXT)/2
IRIMY=(KSIZELBYTKE_ll-2*JPHEXT)/2
@@ -341,11 +345,11 @@ CASE('READ')
ENDIF
!
IF (KSIZELBXTKE_ll /= 0) THEN
- CALL IO_READ_FIELD_LB(TPINIFILE,'LBXTKEM',IL3DX,IRIMX,PLBXTKEM)
+ CALL IO_Field_read_lb(TPINIFILE,'LBXTKEM',IL3DX,IRIMX,PLBXTKEM)
END IF
!
IF (KSIZELBYTKE_ll /= 0) THEN
- CALL IO_READ_FIELD_LB(TPINIFILE,'LBYTKEM',IL3DY,IRIMY,PLBYTKEM)
+ CALL IO_Field_read_lb(TPINIFILE,'LBYTKEM',IL3DY,IRIMY,PLBYTKEM)
END IF
ENDIF
CASE('INIT')
@@ -369,7 +373,7 @@ IF(KSIZELBXR_ll > 0 ) THEN
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
!
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,GHORELAX_R)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,GHORELAX_R)
!
YGETRXM(:)=(/HGETRVM,HGETRCM,HGETRRM,HGETRIM,HGETRSM,HGETRGM,HGETRHM/)
YC(:)=(/"V","C","R","I","S","G","H"/)
@@ -403,7 +407,7 @@ IF(KSIZELBXR_ll > 0 ) THEN
TZFIELD%CLONGNAME = 'LBXR'//YC(JRR)//'M'
TZFIELD%CLBTYPE = 'LBX'
TZFIELD%CCOMMENT = '2_Y_Z_LBXR'//YC(JRR)//'M'
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXRM(:,:,:,IRR))
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXRM(:,:,:,IRR))
END IF
!
IF ( KSIZELBYR_ll /= 0 ) THEN
@@ -411,7 +415,7 @@ IF(KSIZELBXR_ll > 0 ) THEN
TZFIELD%CLONGNAME = 'LBYR'//YC(JRR)//'M'
TZFIELD%CLBTYPE = 'LBY'
TZFIELD%CCOMMENT = '2_Y_Z_LBYR'//YC(JRR)//'M'
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYRM(:,:,:,IRR))
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYRM(:,:,:,IRR))
END IF
CASE('INIT')
IRR=IRR+1
@@ -438,7 +442,7 @@ IF(KSIZELBXR_ll > 0 ) THEN
TZFIELD%CLONGNAME = 'LBXR'//YC(JRR)//'M'
TZFIELD%CLBTYPE = 'LBX'
TZFIELD%CCOMMENT = '2_Y_Z_LBXR'//YC(JRR)//'M'
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXRM(:,:,:,IRR))
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXRM(:,:,:,IRR))
ENDIF
END IF
!
@@ -456,7 +460,7 @@ IF(KSIZELBXR_ll > 0 ) THEN
TZFIELD%CLONGNAME = 'LBYR'//YC(JRR)//'M'
TZFIELD%CLBTYPE = 'LBY'
TZFIELD%CCOMMENT = '2_Y_Z_LBYR'//YC(JRR)//'M'
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYRM(:,:,:,IRR))
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYRM(:,:,:,IRR))
ENDIF
END IF
CASE('INIT')
@@ -469,7 +473,10 @@ END IF
!
!* 2.6 LB-Scalar Variables
!
-IF (KSV > 0) THEN
+PLBXSVM(:,:,:,:) = 0.
+PLBYSVM(:,:,:,:) = 0.
+!
+IF (KSV > 0) THEN
IF (ANY(HGETSVM(1:KSV)=='READ')) THEN
TZFIELD%CMNHNAME = 'HORELAX_SV'
TZFIELD%CSTDNAME = ''
@@ -482,7 +489,7 @@ IF (KSV > 0) THEN
TZFIELD%NTYPE = TYPELOG
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,GHORELAX_SV)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,GHORELAX_SV)
IF ( GHORELAX_SV ) THEN
IRIMX=(KSIZELBXSV_ll-2*JPHEXT)/2
IRIMY=(KSIZELBYSV_ll-2*JPHEXT)/2
@@ -514,7 +521,7 @@ IF (NSV_USER>0) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3,A8)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBXSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBXSVMM)) THEN
@@ -533,7 +540,7 @@ IF (NSV_USER>0) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3,A8)')'X_2_Z_','LBYSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBYSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBYSVMM)) THEN
@@ -570,7 +577,7 @@ IF (NSV_C2R2END>=NSV_C2R2BEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBXSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBXSVMM)) THEN
@@ -589,7 +596,7 @@ IF (NSV_C2R2END>=NSV_C2R2BEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBYSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBYSVMM)) THEN
@@ -626,7 +633,7 @@ IF (NSV_C1R3END>=NSV_C1R3BEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBXSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBXSVMM)) THEN
@@ -645,7 +652,7 @@ IF (NSV_C1R3END>=NSV_C1R3BEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBYSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBYSVMM)) THEN
@@ -686,7 +693,7 @@ IF (CCLOUD=='LIMA' ) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBXSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBXSVMM)) THEN
@@ -705,7 +712,7 @@ IF (CCLOUD=='LIMA' ) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBYSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBYSVMM)) THEN
@@ -743,7 +750,7 @@ IF (CCLOUD=='LIMA' ) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBXSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBXSVMM)) THEN
@@ -762,7 +769,7 @@ IF (CCLOUD=='LIMA' ) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBYSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBYSVMM)) THEN
@@ -800,7 +807,7 @@ IF (NSV_ELECEND>=NSV_ELECBEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBXSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBXSVMM)) THEN
@@ -818,7 +825,7 @@ IF (NSV_ELECEND>=NSV_ELECBEG) THEN
TZFIELD%CMNHNAME = 'LBY_'//TRIM(CELECNAMES(JSV-NSV_ELECBEG+1))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBYSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBYSVMM)) THEN
@@ -855,7 +862,7 @@ IF (NSV_CHGSEND>=NSV_CHGSBEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBXSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBXSVMM)) THEN
@@ -874,7 +881,7 @@ IF (NSV_CHGSEND>=NSV_CHGSBEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBYSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBYSVMM)) THEN
@@ -896,7 +903,7 @@ END IF
! Chemical aqueous phase scalar variables
IF (NSV_CHACEND>=NSV_CHACBEG) THEN
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'kg kg-1'
+ TZFIELD%CUNITS = 'ppp'
TZFIELD%CDIR = ''
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEREAL
@@ -911,7 +918,7 @@ IF (NSV_CHACEND>=NSV_CHACBEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBXSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBXSVMM)) THEN
@@ -930,7 +937,7 @@ IF (NSV_CHACEND>=NSV_CHACBEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBYSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBYSVMM)) THEN
@@ -952,7 +959,7 @@ END IF
! Chemical ice phase scalar variables
IF (NSV_CHICEND>=NSV_CHICBEG) THEN
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'kg kg-1'
+ TZFIELD%CUNITS = 'ppp'
TZFIELD%CDIR = ''
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEREAL
@@ -967,7 +974,7 @@ IF (NSV_CHICEND>=NSV_CHICBEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBXSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBXSVMM)) THEN
@@ -986,7 +993,7 @@ IF (NSV_CHICEND>=NSV_CHICBEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBYSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBYSVMM)) THEN
@@ -1008,7 +1015,7 @@ END IF
! Orilam aerosol scalar variables
IF (NSV_AEREND>=NSV_AERBEG) THEN
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'kg kg-1'
+ TZFIELD%CUNITS = 'ppp'
TZFIELD%CDIR = ''
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEREAL
@@ -1023,7 +1030,7 @@ IF (NSV_AEREND>=NSV_AERBEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBXSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBXSVMM)) THEN
@@ -1042,7 +1049,7 @@ IF (NSV_AEREND>=NSV_AERBEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBYSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBYSVMM)) THEN
@@ -1064,7 +1071,7 @@ END IF
! Orilam aerosols moist scalar variables
IF (NSV_AERDEPEND>=NSV_AERDEPBEG) THEN
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'kg kg-1'
+ TZFIELD%CUNITS = 'ppp'
TZFIELD%CDIR = ''
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEREAL
@@ -1079,7 +1086,7 @@ IF (NSV_AERDEPEND>=NSV_AERDEPBEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBXSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBXSVMM)) THEN
@@ -1098,7 +1105,7 @@ IF (NSV_AERDEPEND>=NSV_AERDEPBEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBYSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBYSVMM)) THEN
@@ -1120,7 +1127,7 @@ END IF
! Dust scalar variables
IF (NSV_DSTEND>=NSV_DSTBEG) THEN
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'kg kg-1'
+ TZFIELD%CUNITS = 'ppp'
TZFIELD%CDIR = ''
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEREAL
@@ -1135,7 +1142,7 @@ IF (NSV_DSTEND>=NSV_DSTBEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBXSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBXSVMM)) THEN
@@ -1154,7 +1161,7 @@ IF (NSV_DSTEND>=NSV_DSTBEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBYSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBYSVMM)) THEN
@@ -1176,7 +1183,7 @@ END IF
!
IF (NSV_DSTDEPEND>=NSV_DSTDEPBEG) THEN
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'kg kg-1'
+ TZFIELD%CUNITS = 'ppp'
TZFIELD%CDIR = ''
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEREAL
@@ -1191,7 +1198,7 @@ IF (NSV_DSTDEPEND>=NSV_DSTDEPBEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBXSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBXSVMM)) THEN
@@ -1210,7 +1217,7 @@ IF (NSV_DSTDEPEND>=NSV_DSTDEPBEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBYSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBYSVMM)) THEN
@@ -1233,7 +1240,7 @@ END IF
! Sea salt scalar variables
IF (NSV_SLTEND>=NSV_SLTBEG) THEN
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'kg kg-1'
+ TZFIELD%CUNITS = 'ppp'
TZFIELD%CDIR = ''
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEREAL
@@ -1248,7 +1255,7 @@ IF (NSV_SLTEND>=NSV_SLTBEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBXSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBXSVMM)) THEN
@@ -1267,7 +1274,7 @@ IF (NSV_SLTEND>=NSV_SLTBEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBYSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBYSVMM)) THEN
@@ -1304,7 +1311,7 @@ IF (NSV_PPEND>=NSV_PPBEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBXSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBXSVMM)) THEN
@@ -1323,7 +1330,7 @@ IF (NSV_PPEND>=NSV_PPBEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBYSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBYSVMM)) THEN
@@ -1361,7 +1368,7 @@ IF (NSV_FFEND>=NSV_FFBEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
WRITE(ILUOUT,*) 'ForeFire LBX_FF ', IRESP
IF ( SIZE(PLBXSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
@@ -1381,7 +1388,7 @@ IF (NSV_FFEND>=NSV_FFBEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBYSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBYSVMM)) THEN
@@ -1419,7 +1426,7 @@ IF (NSV_CSEND>=NSV_CSBEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBXSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBXSVMM)) THEN
@@ -1438,7 +1445,7 @@ IF (NSV_CSEND>=NSV_CSBEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBYSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBYSVMM)) THEN
@@ -1475,7 +1482,7 @@ IF (NSV_LNOXEND>=NSV_LNOXBEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBXSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBXSVMM)) THEN
@@ -1494,7 +1501,7 @@ IF (NSV_LNOXEND>=NSV_LNOXBEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBYSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBYSVMM)) THEN
@@ -1531,7 +1538,7 @@ IF (NSV_LGEND>=NSV_LGBEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBXSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBXSVMM)) THEN
@@ -1550,7 +1557,7 @@ IF (NSV_LGEND>=NSV_LGBEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_READ_FIELD_LB(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
+ CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP)
IF ( SIZE(PLBYSVM,1) /= 0 ) THEN
IF (IRESP/=0) THEN
IF (PRESENT(PLBYSVMM)) THEN
@@ -1623,27 +1630,7 @@ IF (OLSOURCE) THEN
PLBYSVM(:,:,:,JSV) = (PLBYSVM(:,:,:,JSV) - PLBYSVMM(:,:,:,JSV)) / PLENG
ENDIF
END DO
-!
+!
ENDIF
-
-CONTAINS
-FUNCTION UPCASE(HSTRING)
-
-CHARACTER(LEN=*) :: HSTRING
-CHARACTER(LEN=LEN(HSTRING)) :: UPCASE
-
-INTEGER :: JC
-INTEGER, PARAMETER :: IAMIN = IACHAR("a")
-INTEGER, PARAMETER :: IAMAJ = IACHAR("A")
-
-DO JC=1,LEN(HSTRING)
- IF (HSTRING(JC:JC) >= "a" .AND. HSTRING(JC:JC) <= "z") THEN
- UPCASE(JC:JC) = ACHAR(IACHAR(HSTRING(JC:JC)) - IAMIN + IAMAJ)
- ELSE
- UPCASE(JC:JC) = HSTRING(JC:JC)
- END IF
-END DO
-
-END FUNCTION UPCASE
!
END SUBROUTINE INI_LB
diff --git a/src/MNH/ini_lesn.f90 b/src/MNH/ini_lesn.f90
index 3f398b419cd40a90fc718d509ab97f99451ba7b7..c2a2256834c47187389d50e94d3e902c1682486d 100644
--- a/src/MNH/ini_lesn.f90
+++ b/src/MNH/ini_lesn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-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.
!-----------------------------------------------------------------
! ####################
@@ -33,7 +33,8 @@
!! 06/11/02 (V. Masson) add LES budgets
!! 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 10/04/2019: replace ABORT and STOP calls by Print_msg
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -41,7 +42,6 @@
!
USE MODE_ll
USE MODE_GATHER_ll
-USE MODE_IO_ll
USE MODE_MSG
USE MODE_MODELN_HANDLER
!
@@ -66,7 +66,6 @@ USE MODD_DYN
USE MODD_NSV, ONLY: NSV ! update_nsv is done in INI_MODEL
USE MODD_CONDSAMP, ONLY : LCONDSAMP
!
-
USE MODI_INI_LES_CART_MASKn
USE MODI_COEF_VER_INTERP_LIN
!
@@ -162,9 +161,7 @@ IF (LLES_SPECTRA ) LLES_MEAN = .TRUE.
IF (CTURB=='NONE') THEN
WRITE(ILUOUT,FMT=*) 'LES diagnostics cannot be done without subgrid turbulence.'
WRITE(ILUOUT,FMT=*) 'You have chosen CTURB="NONE". You must choose a turbulence scheme.'
- WRITE(ILUOUT,FMT=*) 'STOP'
-!callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','WRITE_LB_n','')
+ call Print_msg( NVERB_FATAL, 'GEN', 'WRITE_LB_n', 'LES diagnostics cannot be done without subgrid turbulence' )
END IF
!-------------------------------------------------------------------------------
!
@@ -539,8 +536,10 @@ ELSE
END IF
IF (LUSERR ) THEN
ALLOCATE(XLES_MEAN_Rr (NLES_K,NLES_TIMES,NLES_MASKS))
+ ALLOCATE(XLES_MEAN_RF (NLES_K,NLES_TIMES,NLES_MASKS))
ELSE
ALLOCATE(XLES_MEAN_Rr (0,0,0))
+ ALLOCATE(XLES_MEAN_RF (0,0,0))
END IF
IF (LUSERI ) THEN
ALLOCATE(XLES_MEAN_Ri (NLES_K,NLES_TIMES,NLES_MASKS))
@@ -646,6 +645,7 @@ IF (LUSERC ) XLES_MEAN_KHt = XUNDEF
IF (LUSERC ) XLES_MEAN_Rt = XUNDEF
IF (LUSERC ) XLES_MEAN_Rc = XUNDEF
IF (LUSERC ) XLES_MEAN_Cf = XUNDEF
+IF (LUSERC ) XLES_MEAN_RF = XUNDEF
IF (LUSERC ) XLES_MEAN_INDCf = XUNDEF
IF (LUSERC ) XLES_MEAN_INDCf2 = XUNDEF
IF (LUSERR ) XLES_MEAN_Rr = XUNDEF
diff --git a/src/MNH/ini_lima_cold_mixed.f90 b/src/MNH/ini_lima_cold_mixed.f90
index a16a6d5c4c7e3b7e20f7c793f25ef370bf30d557..97921618141f0c60e6b440e82c53961baa5903e8 100644
--- a/src/MNH/ini_lima_cold_mixed.f90
+++ b/src/MNH/ini_lima_cold_mixed.f90
@@ -1,7 +1,8 @@
!MNH_LIC Copyright 2013-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 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_COLD_MIXED
! ###############################
@@ -38,6 +39,7 @@ END MODULE MODI_INI_LIMA_COLD_MIXED
!! -------------
!! Original ??/??/13
!! 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
!!
!-------------------------------------------------------------------------------
!
@@ -53,6 +55,8 @@ USE MODD_PARAM_LIMA_COLD
USE MODD_PARAM_LIMA_MIXED
USE MODD_REF
!
+use mode_msg
+!
USE MODI_LIMA_FUNCTIONS
USE MODI_GAMMA
USE MODI_GAMMA_INC
@@ -74,6 +78,7 @@ REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
!
!* 0.2 Declarations of local variables :
!
+character(len=13) :: yval ! String for error message
INTEGER :: IKB ! Coordinates of the first physical
! points along z
INTEGER :: J1,J2 ! Internal loop indexes
@@ -372,8 +377,7 @@ ELSE IF (NPHILLIPS == 8) THEN
XAREA1(3) = 2.7E-7 !BC
XAREA1(4) = 9.1E-7 !BIO
ELSE
- print *, "NPHILLIPS n'est pas égal à 8 ou 13"
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'INI_LIMA_COLD_MIXED', 'NPHILLIPS should be equal to 8 or 13' )
END IF
!
!* 4.1.2 Constants for the computation of H_X (the fraction-redu-
@@ -519,10 +523,9 @@ IF (XALPHAC == 3.0) THEN
XC_HONC = XPI/6.0
XR_HONC = XPI/6.0
ELSE
- WRITE(UNIT=ILUOUT0,FMT='(" Homogeneous nucleation")')
- WRITE(UNIT=ILUOUT0,FMT='(" XALPHAC=",E13.6," IS NOT 3.0")') XALPHAC
- WRITE(UNIT=ILUOUT0,FMT='(" No algorithm yet developped in this case !")')
- STOP
+ write ( yval, '( E13.6 )' ) xalphac
+ call Print_msg( NVERB_FATAL, 'GEN', 'INI_LIMA_COLD_MIXED', 'homogeneous nucleation: XALPHAC='//trim(yval)// &
+ '/= 3. No algorithm developed for this case' )
END IF
!
GFLAG = .TRUE.
diff --git a/src/MNH/ini_ls.f90 b/src/MNH/ini_ls.f90
index 5cf2317848635d0bd4a48ae78935e2f84b5f579f..d5395028e46b8ad73426fef473b8b4d1402b5aec 100644
--- a/src/MNH/ini_ls.f90
+++ b/src/MNH/ini_ls.f90
@@ -1,6 +1,6 @@
-!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.
!-----------------------------------------------------------------
! ######################
@@ -10,12 +10,12 @@
INTERFACE
!
SUBROUTINE INI_LS(TPINIFILE,HGETRVM,OLSOURCE, &
- PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM, &
+ PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM,PLSZWSM, &
PDRYMASSS, &
- PLSUMM,PLSVMM,PLSWMM,PLSTHMM,PLSRVMM,PDRYMASST,PLENG, &
+ PLSUMM,PLSVMM,PLSWMM,PLSTHMM,PLSRVMM,PLSZWSMM, PDRYMASST,PLENG, &
OSTEADY_DMASS)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
CHARACTER (LEN=*), INTENT(IN) :: HGETRVM ! GET indicator
@@ -23,11 +23,13 @@ LOGICAL, INTENT(IN) :: OLSOURCE ! Switch for the source term
! Larger Scale fields (source if OLSOURCE=T, fields at time t-dt if OLSOURCE=F) :
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLSUM,PLSVM,PLSWM ! Wind
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLSTHM,PLSRVM ! Mass
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PLSZWSM ! sea wave
!if OLSOURCE=T :
REAL, INTENT(INOUT), OPTIONAL :: PDRYMASSS ! Md source
!Large Scale fields at time t-dt (if OLSOURCE=T) :
REAL, DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PLSUMM,PLSVMM,PLSWMM ! Wind
REAL, DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PLSTHMM,PLSRVMM ! Mass
+REAL, DIMENSION(:,:), INTENT(IN), OPTIONAL :: PLSZWSMM ! Sea wave
REAL, INTENT(IN), OPTIONAL :: PDRYMASST ! Md(t)
REAL, INTENT(IN), OPTIONAL :: PLENG ! Interpolation length
LOGICAL, INTENT(IN), OPTIONAL :: OSTEADY_DMASS ! Md evolution logical switch
@@ -41,9 +43,9 @@ END MODULE MODI_INI_LS
!
! ############################################################
SUBROUTINE INI_LS(TPINIFILE,HGETRVM,OLSOURCE, &
- PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM, &
+ PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM,PLSZWSM, &
PDRYMASSS, &
- PLSUMM,PLSVMM,PLSWMM,PLSTHMM,PLSRVMM,PDRYMASST,PLENG, &
+ PLSUMM,PLSVMM,PLSWMM,PLSTHMM,PLSRVMM,PLSZWSMM,PDRYMASST,PLENG, &
OSTEADY_DMASS)
! ############################################################
!
@@ -80,6 +82,8 @@ END MODULE MODI_INI_LS
!! -------------
!! Original 22/09/98
!! 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 14/03/2019: correct ZWS when variable not present in file
!!
!!
!-------------------------------------------------------------------------------
@@ -87,10 +91,10 @@ END MODULE MODI_INI_LS
!* 0. DECLARATIONS
!
USE MODD_CONF
-USE MODD_IO_ll, ONLY: TFILEDATA
-USE MODD_TIME ! for type DATE_TIME
+USE MODD_FIELD_n, only: XZWS_DEFAULT
+USE MODD_IO, ONLY: TFILEDATA
!
-USE MODE_FMREAD
+USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_MSG
!
IMPLICIT NONE
@@ -105,11 +109,13 @@ LOGICAL, INTENT(IN) :: OLSOURCE ! Switch for the source term
! Larger Scale fields (source if OLSOURCE=T, fields at time t-dt if OLSOURCE=F) :
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLSUM,PLSVM,PLSWM ! Wind
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLSTHM,PLSRVM ! Mass
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PLSZWSM ! sea wave
!if OLSOURCE=T :
REAL, INTENT(INOUT), OPTIONAL :: PDRYMASSS ! Md source
!Large Scale fields at time t-dt (if OLSOURCE=T) :
REAL, DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PLSUMM,PLSVMM,PLSWMM ! Wind
REAL, DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PLSTHMM,PLSRVMM ! Mass
+REAL, DIMENSION(:,:), INTENT(IN), OPTIONAL :: PLSZWSMM ! Sea wave
REAL, INTENT(IN), OPTIONAL :: PDRYMASST ! Md(t)
REAL, INTENT(IN), OPTIONAL :: PLENG ! Interpolation length
LOGICAL, INTENT(IN), OPTIONAL :: OSTEADY_DMASS ! Md evolution logical switch
@@ -117,7 +123,8 @@ LOGICAL, INTENT(IN), OPTIONAL :: OSTEADY_DMASS ! Md ev
!
!* 0.2 declarations of local variables
!
-!NONE
+CHARACTER(LEN=15) :: YVAL
+INTEGER :: IRESP
!
!-------------------------------------------------------------------------------
!
@@ -134,15 +141,26 @@ LOGICAL, INTENT(IN), OPTIONAL :: OSTEADY_DMASS ! Md ev
!* 2. READ LARGE SCALE FIELDS
! -----------------------
!
-CALL IO_READ_FIELD(TPINIFILE,'LSUM', PLSUM)
-CALL IO_READ_FIELD(TPINIFILE,'LSVM', PLSVM)
-CALL IO_READ_FIELD(TPINIFILE,'LSWM', PLSWM)
-CALL IO_READ_FIELD(TPINIFILE,'LSTHM',PLSTHM)
+CALL IO_Field_read(TPINIFILE,'LSUM', PLSUM)
+CALL IO_Field_read(TPINIFILE,'LSVM', PLSVM)
+CALL IO_Field_read(TPINIFILE,'LSWM', PLSWM)
+CALL IO_Field_read(TPINIFILE,'LSTHM',PLSTHM)
+CALL IO_Field_read(TPINIFILE,'ZWS', PLSZWSM, IRESP)
+!If the field ZWS is not in the file, set its value to XZWS_DEFAULT
+!ZWS is present in files since MesoNH 5.4.2
+IF ( IRESP/=0 ) THEN
+ WRITE (YVAL,'( E15.8 )') XZWS_DEFAULT
+ CALL PRINT_MSG(NVERB_WARNING,'IO','INI_LS','ZWS not found in file: using default value: '//TRIM(YVAL)//' m')
+ PLSZWSM(:,:) = XZWS_DEFAULT
+END IF
!
IF (HGETRVM == 'READ') THEN ! LS-vapor
- CALL IO_READ_FIELD(TPINIFILE,'LSRVM',PLSRVM)
+ CALL IO_Field_read(TPINIFILE,'LSRVM',PLSRVM)
ENDIF
!
+IF (PRESENT(PLSZWSMM)) THEN
+ PLSZWSM(:,:)= (PLSZWSM(:,:) - PLSZWSMM(:,:)) / PLENG
+END IF
!
!-------------------------------------------------------------------------------
!
@@ -172,7 +190,7 @@ IF (OLSOURCE) THEN
! Dry mass
IF(.NOT. OSTEADY_DMASS) THEN
IF (PRESENT(PDRYMASSS).AND.PRESENT(PDRYMASST)) THEN
- CALL IO_READ_FIELD(TPINIFILE,'DRYMASST',PDRYMASSS)
+ CALL IO_Field_read(TPINIFILE,'DRYMASST',PDRYMASSS)
PDRYMASSS = (PDRYMASSS - PDRYMASST) / PLENG
ENDIF
ENDIF
diff --git a/src/MNH/ini_lw_setup.f90 b/src/MNH/ini_lw_setup.f90
index e67f466c4af14a9664df360e15b01bc15b29abf7..d89d4c4fd826a0a465cedf648f3a858f44b41779 100644
--- a/src/MNH/ini_lw_setup.f90
+++ b/src/MNH/ini_lw_setup.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2003-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.
!-----------------------------------------------------------------
! ##########################
@@ -51,12 +51,15 @@ END MODULE MODI_INI_LW_SETUP
!! MODIFICATIONS
!! -------------
!! Original 03/03/03
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
!
+use mode_msg
+!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -116,9 +119,7 @@ SELECT CASE (HRAD)
PLW_BANDS(15) = 4.02E-6
PLW_BANDS(16) = 3.59E-6
ELSE
-!callabortstop
- CALL ABORT
- STOP
+ call Print_msg(NVERB_FATAL,'GEN','INI_LW_SETUP','invalid KLWB_MNH argument')
ENDIF
!
diff --git a/src/MNH/ini_micron.f90 b/src/MNH/ini_micron.f90
index 67bce21b6e97a0bdd9850ffe635c5205b4195718..718eebb464b59a2d271a80cfbab03dceacc418fd 100644
--- a/src/MNH/ini_micron.f90
+++ b/src/MNH/ini_micron.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 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.
!-----------------------------------------------------------------
! ########################
@@ -10,7 +10,7 @@
INTERFACE
SUBROUTINE INI_MICRO_n ( TPINIFILE,KLUOUT )
!
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
INTEGER, INTENT(IN) :: KLUOUT ! Logical unit number for prints
@@ -51,6 +51,8 @@ END MODULE MODI_INI_MICRO_n
!! 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 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
!!
!! --------------------------------------------------------------------------
!
@@ -59,8 +61,7 @@ END MODULE MODI_INI_MICRO_n
!
!
USE MODD_CONF, ONLY : CCONF,CPROGRAM
-USE MODD_IO_ll, ONLY : TFILEDATA
-USE MODD_LUNIT_n, ONLY : CLUOUT
+USE MODD_IO, ONLY : TFILEDATA
USE MODD_GET_n, ONLY : CGETRCT,CGETRRT, CGETRST, CGETRGT, CGETRHT, CGETCLOUD
USE MODD_DIM_n, ONLY : NIMAX_ll, NJMAX_ll
USE MODD_PARAMETERS, ONLY : JPVEXT, JPHEXT
@@ -220,15 +221,13 @@ IF(LBLOWSNOW) THEN
IF(CSNOWSEDIM=='TABC') THEN
!Read in look up tables of snow particles properties
!No arguments, all look up tables are defined in module
-!mode_snowdrift_sedim_lkt
- CALL BLOWSNOW_SEDIM_LKT_SET
+!mode_snowdrift_sedim_lkt
+ CALL BLOWSNOW_SEDIM_LKT_SET
END IF
ELSE
ALLOCATE(XSNWSUBL3D(0,0,0))
END IF
!
-IF(SIZE(XINPRR) == 0) RETURN
-!
!* 2b. ALLOCATION for Radiative cooling
! ------------------------------
IF (LACTIT .OR. MACTIT) THEN
@@ -236,12 +235,11 @@ IF (LACTIT .OR. MACTIT) THEN
ALLOCATE( XRCM(IIU,IJU,IKU) )
XTHM = XTHT
XRCM(:,:,:) = XRT(:,:,:,2)
- ELSE
+ELSE
ALLOCATE( XTHM(0,0,0) )
ALLOCATE( XRCM(0,0,0) )
END IF
!
-!
!* 2.bis ALLOCATE Module MODD_PRECIP_SCAVENGING_n
! ------------------------------
!
@@ -249,16 +247,21 @@ IF ( (CCLOUD=='LIMA') .AND. LSCAV ) THEN
ALLOCATE(XINPAP(IIU,IJU))
ALLOCATE(XACPAP(IIU,IJU))
XINPAP(:,:)=0.0
- XACPAP(:,:)=0.0
+ XACPAP(:,:)=0.0
+ELSE
+ ALLOCATE(XINPAP(0,0))
+ ALLOCATE(XACPAP(0,0))
END IF
!
+IF(SIZE(XINPRR) == 0) RETURN
+!
!* 3. INITIALIZE MODD_PRECIP_n variables
! ----------------------------------
!
-CALL READ_PRECIP_FIELD(TPINIFILE,CLUOUT,CPROGRAM,CCONF, &
+CALL READ_PRECIP_FIELD(TPINIFILE,CPROGRAM,CCONF, &
CGETRCT,CGETRRT,CGETRST,CGETRGT,CGETRHT, &
XINPRC,XACPRC,XINDEP,XACDEP,XINPRR,XINPRR3D,XEVAP3D,&
- XACPRR,XINPRS,XACPRS,XINPRG,XACPRG, XINPRH,XACPRH )
+ XACPRR,XINPRS,XACPRS,XINPRG,XACPRG, XINPRH,XACPRH )
!
!
!* 4. INITIALIZE THE PARAMETERS FOR THE MICROPHYSICS
@@ -287,13 +290,13 @@ ELSE IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO') THEN
IF (CCLOUD == 'C3R5') 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
- CALL INI_LIMA(XTSTEP,ZDZMIN,NSPLITR, NSPLITG) ! 1/2 spectral warm cloud
+ELSE IF (CCLOUD == 'LIMA') THEN
+ IF (CGETCLOUD /= 'READ') THEN
+ CALL INIT_AEROSOL_CONCENTRATION(XRHODREF, &
+ XSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ XZZ(:,:,:) )
+ END IF
+ CALL INI_LIMA(XTSTEP,ZDZMIN,NSPLITR, NSPLITG) ! 1/2 spectral warm cloud
END IF
!
IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO') THEN
@@ -313,9 +316,9 @@ IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO') THEN
ENDIF
!
IF (CCLOUD == 'LIMA') THEN
- IF (CGETCLOUD/='READ') THEN
- CALL SET_CONC_LIMA(CGETCLOUD,XRHODREF,XRT,XSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END))
- END IF
+ IF (CGETCLOUD/='READ') THEN
+ CALL SET_CONC_LIMA(CGETCLOUD,XRHODREF,XRT,XSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END))
+ END IF
END IF
!
!
@@ -325,8 +328,8 @@ END IF
!
IMI = GET_CURRENT_MODEL_INDEX()
!IF (CELEC /= 'NONE') THEN
-! CALL INI_ELEC(IMI,CINIFILE,CLUOUT,XTSTEP,ZDZMIN,NSPLITR, &
-! XDXX,XDYY,XDZZ,XDZX,XDZY )
+! CALL INI_ELEC(IMI,TPINIFILE,XTSTEP,ZDZMIN,NSPLITR, &
+! XDXX,XDYY,XDZZ,XDZX,XDZY )
!END IF
!
!
diff --git a/src/MNH/ini_modeln.f90 b/src/MNH/ini_modeln.f90
index ce192d4340326112ec57c0ee19f7d7d1aa9e24da..62002a731c199d67d89665d367de2054bcd26f83 100644
--- a/src/MNH/ini_modeln.f90
+++ b/src/MNH/ini_modeln.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -9,12 +9,11 @@
!
INTERFACE
!
- SUBROUTINE INI_MODEL_n(KMI,HLUOUT,TPINIFILE)
+ SUBROUTINE INI_MODEL_n(KMI,TPINIFILE)
!
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KMI ! Model Index
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! name for output-listing of nested models
TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
!
END SUBROUTINE INI_MODEL_n
@@ -23,7 +22,7 @@ END INTERFACE
!
END MODULE MODI_INI_MODEL_n
! ############################################
- SUBROUTINE INI_MODEL_n(KMI,HLUOUT,TPINIFILE)
+ SUBROUTINE INI_MODEL_n(KMI,TPINIFILE)
! ############################################
!
!!**** *INI_MODEL_n* - routine to initialize the nested model _n
@@ -64,7 +63,7 @@ END MODULE MODI_INI_MODEL_n
!! INI_CPL.
!! - The initialization of the parameters needed for the dynamics
!! of the model n is realized in INI_DYNAMICS.
-!! - Then the initial file (DESFM+LFIFM files) is closed by IO_FILE_CLOSE_ll.
+!! - Then the initial file (DESFM+LFIFM files) is closed by IO_File_close.
!! - The initialization of the parameters needed for the ECMWF radiation
!! code is realized in INI_RADIATIONS.
!! - The contents of the scalar variables are overwritten by
@@ -75,8 +74,6 @@ END MODULE MODI_INI_MODEL_n
!!
!! EXTERNAL
!! --------
-!! FMREAD : to read a LFIFM file
-!! FMFREE : to release a logical unit number
!! SET_DIM : to initialize dimensions
!! SET_GRID : to initialize grid
!! METRICS : to compute metric coefficients
@@ -129,10 +126,10 @@ END MODULE MODI_INI_MODEL_n
!! Module MODD_CH_MNHC_n : contains the control parameters for chemistry
!! Module MODD_DEEP_CONVECTION_n: contains declaration of the variables of
!! the deep convection scheme
-!!
-!!
-!!
-!!
+!!
+!!
+!!
+!!
!! Module MODN_CONF_n : contains declaration of namelist NAM_CONFn and
!! uses module MODD_CONF_n (configuration variables)
!! Module MODN_LUNIT_n : contains declaration of namelist NAM_LUNITn and
@@ -151,7 +148,7 @@ END MODULE MODI_INI_MODEL_n
!! REFERENCE
!! ---------
!! Book2 of documentation (routine INI_MODEL_n)
-!!
+!!
!!
!! AUTHOR
!! ------
@@ -278,6 +275,16 @@ END MODULE MODI_INI_MODEL_n
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! V. Vionnet : 18/07/2017 : add blowing snow scheme
!! 01/18 J.Colin Add DRAG
+! P. Wautelet 29/01/2019: bug: add missing zero-size allocations
+! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list
+! P. Wautelet 13/02/2019: initialize XALBUV even if no radiation (needed in CH_INTERP_JVALUES)
+! P. Wautelet 13/02/2019: removed PPABSM and PTSTEP dummy arguments of READ_FIELD
+! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
+! P. Wautelet 14/02/2019: remove HINIFILE dummy argument from INI_RADIATIONS_ECMWF/ECRAD
+!! 02/2019 C.Lac 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 14/03/2019: correct ZWS when variable not present in file (set to XZWS_DEFAULT)
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!---------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -289,10 +296,10 @@ END MODULE MODI_INI_MODEL_n
!
USE MODE_ll
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-USE MODE_IO_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY : IO_FILE_ADD2LIST
-USE MODE_FM, ONLY: IO_FILE_OPEN_ll
-USE MODE_FMREAD
+USE MODE_IO
+USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list
+USE MODE_IO_FILE, ONLY: IO_File_open
+USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_GATHER_ll
USE MODE_MSG
USE MODE_TYPE_ZDIFFU
@@ -331,7 +338,7 @@ USE MODD_DIM_n
USE MODD_BUDGET
USE MODD_RADIATIONS_n
USE MODD_SHADOWS_n
-USE MODD_PARAM_RAD_n, ONLY : CLW, CAER, CAOP
+USE MODD_PARAM_RAD_n, ONLY : CLW, CAER, CAOP
USE MODD_VAR_ll, ONLY : IP
!
USE MODD_STAND_ATM, ONLY : XSTROATM, XSMLSATM, XSMLWATM, XSPOSATM, XSPOWATM
@@ -364,6 +371,7 @@ USE MODD_PASPOL_n
USE MODD_DRAG_n
USE MODD_BLOWSNOW
USE MODD_BLOWSNOW_n
+use modd_precision, only: LFIINT
!
!
USE MODI_INI_BUDGET
@@ -433,7 +441,7 @@ USE MODD_ADVFRC_n
USE MODD_RELFRC_n
USE MODD_2D_FRC
USE MODD_IO_SURF_MNH, ONLY : IO_SURF_MNH_MODEL
-USE MODD_IO_ll, ONLY : CIO_DIR,TFILEDATA,TFILE_DUMMY,TFILE_FIRST,TFILE_LAST
+USE MODD_IO, ONLY: CIO_DIR, TFILEDATA, TFILE_DUMMY, TFILE_FIRST, TFILE_LAST
!
USE MODD_CH_PRODLOSSTOT_n
USE MODI_CH_INIT_PRODLOSSTOT_n
@@ -454,11 +462,12 @@ IMPLICIT NONE
!
!
INTEGER, INTENT(IN) :: KMI ! Model Index
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! name for output-listing of nested models
TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
!
!* 0.2 declarations of local variables
!
+REAL, PARAMETER :: NALBUV_DEFAULT = 0.01 ! Arbitrary low value for XALBUV
+!
INTEGER :: JSV ! Loop index
INTEGER :: IRESP ! Return code of FM routines
INTEGER :: ILUOUT ! Logical unit number of output-listing
@@ -526,6 +535,7 @@ REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XLBXRM,DPTR_XLBYRM
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XZZ
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLSUM,DPTR_XLSVM,DPTR_XLSWM,DPTR_XLSTHM,DPTR_XLSRVM
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLSUS,DPTR_XLSVS,DPTR_XLSWS,DPTR_XLSTHS,DPTR_XLSRVS
+REAL, DIMENSION(:,:), POINTER :: DPTR_XLSZWSM,DPTR_XLSZWSS
!
INTEGER :: IIB,IJB,IIE,IJE,IDIMX,IDIMY,IMI
!
@@ -555,11 +565,11 @@ ILUOUT = TLUOUT%NLU
!* 2.1 Read number of forcing fields
!
IF (LFORCING) THEN ! Retrieve the number of time-dependent forcings.
- CALL IO_READ_FIELD(TPINIFILE,'FRC',NFRC,IRESP)
+ CALL IO_Field_read(TPINIFILE,'FRC',NFRC,IRESP)
IF ( (IRESP /= 0) .OR. (NFRC <=0) ) THEN
WRITE(ILUOUT,'(A/A)') &
"INI_MODEL_n ERROR: you want to read forcing variables from FMfile", &
- " but no fields have been found by IO_READ_FIELD"
+ " but no fields have been found by IO_Field_read"
!callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_MODEL_n','')
END IF
@@ -568,11 +578,11 @@ END IF
! Modif PP for time evolving adv forcing
IF ( L2D_ADV_FRC ) THEN ! Retrieve the number of time-dependent forcings.
WRITE(ILUOUT,FMT=*) "INI_MODEL_n ENTER ADV_FORCING"
- CALL IO_READ_FIELD(TPINIFILE,'NADVFRC1',NADVFRC,IRESP)
+ CALL IO_Field_read(TPINIFILE,'NADVFRC1',NADVFRC,IRESP)
IF ( (IRESP /= 0) .OR. (NADVFRC <=0) ) THEN
WRITE(ILUOUT,'(A/A)') &
"INI_MODELn ERROR: you want to read forcing ADV variables from FMfile", &
- " but no fields have been found by IO_READ_FIELD"
+ " but no fields have been found by IO_Field_read"
!callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_MODEL_n','')
END IF
@@ -581,11 +591,11 @@ END IF
!
IF ( L2D_REL_FRC ) THEN ! Retrieve the number of time-dependent forcings.
WRITE(ILUOUT,FMT=*) "INI_MODEL_n ENTER REL_FORCING"
- CALL IO_READ_FIELD(TPINIFILE,'NRELFRC1',NRELFRC,IRESP)
+ CALL IO_Field_read(TPINIFILE,'NRELFRC1',NRELFRC,IRESP)
IF ( (IRESP /= 0) .OR. (NRELFRC <=0) ) THEN
WRITE(ILUOUT,'(A/A)') &
"INI_MODELn ERROR: you want to read forcing REL variables from FMfile", &
- " but no fields have been found by IO_READ_FIELD"
+ " but no fields have been found by IO_Field_read"
!callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_MODEL_n','')
END IF
@@ -596,8 +606,8 @@ END IF
IKU=NKMAX+2*JPVEXT
!
ALLOCATE(XZHAT(IKU))
-CALL IO_READ_FIELD(TPINIFILE,'ZHAT',XZHAT)
-CALL IO_READ_FIELD(TPINIFILE,'ZTOP',XZTOP)
+CALL IO_Field_read(TPINIFILE,'ZHAT',XZHAT)
+CALL IO_Field_read(TPINIFILE,'ZTOP',XZTOP)
IF (XALZBOT>=XZHAT(IKU) .AND. LVE_RELAX) THEN
WRITE(ILUOUT,FMT=*) "INI_MODEL_n ERROR: you want to use vertical relaxation"
WRITE(ILUOUT,FMT=*) " but bottom of layer XALZBOT(",XALZBOT,")"
@@ -692,8 +702,10 @@ IF (LMEAN_FIELD) THEN
ALLOCATE(XTHM_MEAN(IIU,IJU,IKU)) ; XTHM_MEAN = 0.0
ALLOCATE(XTEMPM_MEAN(IIU,IJU,IKU)) ; XTEMPM_MEAN = 0.0
IF (CTURB/='NONE') THEN
- ALLOCATE(XTKEM_MEAN(IIU,IJU,IKU))
- XTKEM_MEAN = 0.0
+ ALLOCATE(XTKEM_MEAN(IIU,IJU,IKU))
+ XTKEM_MEAN = 0.0
+ ELSE
+ ALLOCATE(XTKEM_MEAN(0,0,0))
END IF
ALLOCATE(XPABSM_MEAN(IIU,IJU,IKU)) ; XPABSM_MEAN = 0.0
!
@@ -710,10 +722,35 @@ IF (LMEAN_FIELD) THEN
ALLOCATE(XTHM_MAX(IIU,IJU,IKU)) ; XTHM_MAX = 0.0
ALLOCATE(XTEMPM_MAX(IIU,IJU,IKU)) ; XTEMPM_MAX = 0.0
IF (CTURB/='NONE') THEN
- ALLOCATE(XTKEM_MAX(IIU,IJU,IKU))
- XTKEM_MAX = 0.0
+ ALLOCATE(XTKEM_MAX(IIU,IJU,IKU))
+ XTKEM_MAX = 0.0
+ ELSE
+ ALLOCATE(XTKEM_MAX(0,0,0))
END IF
ALLOCATE(XPABSM_MAX(IIU,IJU,IKU)) ; XPABSM_MAX = 0.0
+ELSE
+ ALLOCATE(XUM_MEAN(0,0,0))
+ ALLOCATE(XVM_MEAN(0,0,0))
+ ALLOCATE(XWM_MEAN(0,0,0))
+ ALLOCATE(XTHM_MEAN(0,0,0))
+ ALLOCATE(XTEMPM_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(XTH2_MEAN(0,0,0))
+ ALLOCATE(XTEMP2_MEAN(0,0,0))
+ ALLOCATE(XPABS2_MEAN(0,0,0))
+!
+ ALLOCATE(XUM_MAX(0,0,0))
+ ALLOCATE(XVM_MAX(0,0,0))
+ ALLOCATE(XWM_MAX(0,0,0))
+ ALLOCATE(XTHM_MAX(0,0,0))
+ ALLOCATE(XTEMPM_MAX(0,0,0))
+ ALLOCATE(XTKEM_MAX(0,0,0))
+ ALLOCATE(XPABSM_MAX(0,0,0))
END IF
!
IF ((CUVW_ADV_SCHEME(1:3)=='CEN') .AND. (CTEMP_SCHEME == 'LEFR') ) THEN
@@ -731,6 +768,13 @@ IF ((CUVW_ADV_SCHEME(1:3)=='CEN') .AND. (CTEMP_SCHEME == 'LEFR') ) THEN
XDVM = 0.0
XDWM = 0.0
END IF
+ELSE
+ ALLOCATE(XUM(0,0,0))
+ ALLOCATE(XVM(0,0,0))
+ ALLOCATE(XWM(0,0,0))
+ ALLOCATE(XDUM(0,0,0))
+ ALLOCATE(XDVM(0,0,0))
+ ALLOCATE(XDWM(0,0,0))
END IF
!
ALLOCATE(XUT(IIU,IJU,IKU)) ; XUT = 0.0
@@ -760,6 +804,7 @@ IF (CTURB /= 'NONE') THEN
ELSE
ALLOCATE(XTKET(0,0,0))
ALLOCATE(XRTKES(0,0,0))
+ ALLOCATE(XRTKEMS(0,0,0))
ALLOCATE(XWTHVMF(0,0,0))
ALLOCATE(XDYP(0,0,0))
ALLOCATE(XTHP(0,0,0))
@@ -795,20 +840,22 @@ END IF
!
IF (NRR>1) THEN
ALLOCATE(XCLDFR(IIU,IJU,IKU))
+ ALLOCATE(XRAINFR(IIU,IJU,IKU))
ELSE
ALLOCATE(XCLDFR(0,0,0))
+ ALLOCATE(XRAINFR(0,0,0))
END IF
!
ALLOCATE(XSVT(IIU,IJU,IKU,NSV)) ; XSVT = 0.
ALLOCATE(XRSVS(IIU,IJU,IKU,NSV)); XRSVS = 0.
ALLOCATE(XRSVS_CLD(IIU,IJU,IKU,NSV)); XRSVS_CLD = 0.0
+ALLOCATE(XZWS(IIU,IJU)) ; XZWS(:,:) = XZWS_DEFAULT
!
IF (LPASPOL) THEN
ALLOCATE( XATC(IIU,IJU,IKU,NSV_PP) )
XATC = 0.
- ELSE
+ELSE
ALLOCATE( XATC(0,0,0,0))
- XATC = 0.
END IF
!
IF(LBLOWSNOW) THEN
@@ -856,6 +903,8 @@ ALLOCATE(XDZZ(IIU,IJU,IKU))
!
IF (KMI == 1) THEN
ALLOCATE(XRHODREFZ(IKU),XTHVREFZ(IKU))
+ELSE
+ !Do not allocate XRHODREFZ and XTHVREFZ because they are the same on all grids (not 'n' variables)
END IF
ALLOCATE(XRHODREF(IIU,IJU,IKU))
ALLOCATE(XTHVREF(IIU,IJU,IKU))
@@ -891,7 +940,7 @@ CALL GET_DIM_EXT_ll('Y',IIY,IJY)
IF (L2D) THEN
ALLOCATE(XBFY(IIY,IJY,IKU))
ELSE
- ALLOCATE(XBFY(IJY,IIY,IKU)) ! transposition needed by the optimisition of the
+ ALLOCATE(XBFY(IJY,IIY,IKU)) ! transposition needed by the optimisation of the
! FFT solver
END IF
CALL GET_DIM_EXT_ll('B',IIU_B,IJU_B)
@@ -943,6 +992,7 @@ IF ( NRR > 0 ) THEN
ELSE
ALLOCATE(XLSRVM(0,0,0))
END IF
+ALLOCATE(XLSZWSM(IIU,IJU)) ; XLSZWSM = -1.
!
! lbc part
!
@@ -1068,9 +1118,7 @@ ELSE ! 3D case
" Local domain to small for relaxation NRIMX,IDIMX ", &
NRIMX,IDIMX ,&
" change relaxation parameters or number of processors "
- !callabortstop
- CALL ABORT
- STOP
+ call Print_msg(NVERB_FATAL,'GEN','INI_MODEL_n','')
END IF
END IF
IF ( CLBCY(1) /= 'CYCL' ) THEN
@@ -1080,9 +1128,7 @@ ELSE ! 3D case
" Local domain to small for relaxation NRIMY,IDIMY ", &
NRIMY,IDIMY ,&
" change relaxation parameters or number of processors "
- !callabortstop
- CALL ABORT
- STOP
+ call Print_msg(NVERB_FATAL,'GEN','INI_MODEL_n','')
END IF
END IF
IF ( LHORELAX_UVWTH ) THEN
@@ -1194,6 +1240,23 @@ IF ( KMI > 1 ) THEN
ALLOCATE( NKLIN_LBXW(SIZE(XLBXWM,1),SIZE(XLBXWM,2),SIZE(XLBXWM,3)))
ALLOCATE(XCOEFLIN_LBYW(SIZE(XLBYWM,1),SIZE(XLBYWM,2),SIZE(XLBYWM,3)))
ALLOCATE( NKLIN_LBYW(SIZE(XLBYWM,1),SIZE(XLBYWM,2),SIZE(XLBYWM,3)))
+ELSE
+ ALLOCATE(XCOEFLIN_LBXM(0,0,0))
+ ALLOCATE( NKLIN_LBXM(0,0,0))
+ ALLOCATE(XCOEFLIN_LBYM(0,0,0))
+ ALLOCATE( NKLIN_LBYM(0,0,0))
+ ALLOCATE(XCOEFLIN_LBXU(0,0,0))
+ ALLOCATE( NKLIN_LBXU(0,0,0))
+ ALLOCATE(XCOEFLIN_LBYU(0,0,0))
+ ALLOCATE( NKLIN_LBYU(0,0,0))
+ ALLOCATE(XCOEFLIN_LBXV(0,0,0))
+ ALLOCATE( NKLIN_LBXV(0,0,0))
+ ALLOCATE(XCOEFLIN_LBYV(0,0,0))
+ ALLOCATE( NKLIN_LBYV(0,0,0))
+ ALLOCATE(XCOEFLIN_LBXW(0,0,0))
+ ALLOCATE( NKLIN_LBXW(0,0,0))
+ ALLOCATE(XCOEFLIN_LBYW(0,0,0))
+ ALLOCATE( NKLIN_LBYW(0,0,0))
END IF
!
! allocation of the LS fields for vertical relaxation and numerical diffusion
@@ -1204,6 +1267,7 @@ IF( .NOT. LSTEADYLS ) THEN
ALLOCATE(XLSWS(SIZE(XLSWM,1),SIZE(XLSWM,2),SIZE(XLSWM,3)))
ALLOCATE(XLSTHS(SIZE(XLSTHM,1),SIZE(XLSTHM,2),SIZE(XLSTHM,3)))
ALLOCATE(XLSRVS(SIZE(XLSRVM,1),SIZE(XLSRVM,2),SIZE(XLSRVM,3)))
+ ALLOCATE(XLSZWSS(SIZE(XLSZWSM,1),SIZE(XLSZWSM,2)))
!
ELSE
!
@@ -1212,6 +1276,7 @@ ELSE
ALLOCATE(XLSWS(0,0,0))
ALLOCATE(XLSTHS(0,0,0))
ALLOCATE(XLSRVS(0,0,0))
+ ALLOCATE(XLSZWSS(0,0))
!
END IF
! allocation of the LB fields for horizontal relaxation and Lateral Boundaries
@@ -1257,11 +1322,10 @@ 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
-
IF (CRAD == 'ECRA') THEN
- NSWB_MNH = 14
+ NSWB_MNH = 14
ELSE
- NSWB_MNH = NSWB_OLD
+ NSWB_MNH = NSWB_OLD
END IF
NLWB_MNH = 16 ! For XEMIS initialization (should be spectral in the future)
@@ -1272,6 +1336,7 @@ ALLOCATE(XLW_BANDS (NLWB_MNH))
ALLOCATE(XZENITH (IIU,IJU))
ALLOCATE(XAZIM (IIU,IJU))
ALLOCATE(XALBUV (IIU,IJU))
+XALBUV(:,:) = NALBUV_DEFAULT !Set to an arbitrary low value (XALBUV is needed in CH_INTERP_JVALUES even if no radiation)
ALLOCATE(XDIRSRFSWD(IIU,IJU,NSWB_MNH))
ALLOCATE(XSCAFLASWD(IIU,IJU,NSWB_MNH))
ALLOCATE(XFLALWD (IIU,IJU))
@@ -1373,9 +1438,25 @@ IF (CDCONV /= 'NONE' .OR. CSCONV == 'KAFR') THEN
ALLOCATE(NCLBASCONV(0,0))
END IF
ELSE
+ ALLOCATE(NCOUNTCONV(0,0))
+ ALLOCATE(XDTHCONV(0,0,0))
+ ALLOCATE(XDRVCONV(0,0,0))
+ ALLOCATE(XDRCCONV(0,0,0))
+ ALLOCATE(XDRICONV(0,0,0))
ALLOCATE(XPRCONV(0,0))
ALLOCATE(XPACCONV(0,0))
ALLOCATE(XPRSCONV(0,0))
+ ALLOCATE(XIC_RATE(0,0))
+ ALLOCATE(XCG_RATE(0,0))
+ ALLOCATE(XIC_TOTAL_NUMBER(0,0))
+ ALLOCATE(XCG_TOTAL_NUMBER(0,0))
+ ALLOCATE(XUMFCONV(0,0,0))
+ ALLOCATE(XDMFCONV(0,0,0))
+ ALLOCATE(XPRLFLXCONV(0,0,0))
+ ALLOCATE(XPRSFLXCONV(0,0,0))
+ ALLOCATE(XCAPE(0,0))
+ ALLOCATE(NCLTOPCONV(0,0))
+ ALLOCATE(NCLBASCONV(0,0))
END IF
!
IF ((CDCONV == 'KAFR' .OR. CSCONV == 'KAFR') &
@@ -1416,7 +1497,7 @@ IF (KMI == 1) THEN
ALLOCATE(XGYTHFRC(IKU,NFRC))
ALLOCATE(XPGROUNDFRC(NFRC))
ALLOCATE(XTENDUFRC(IKU,NFRC))
- ALLOCATE(XTENDVFRC(IKU,NFRC))
+ ALLOCATE(XTENDVFRC(IKU,NFRC))
ELSE
ALLOCATE(TDTFRC(0))
ALLOCATE(XUFRC(0,0))
@@ -1441,6 +1522,8 @@ IF (KMI == 1) THEN
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
! ----------------------------------------------------------------------
!
@@ -1471,25 +1554,31 @@ ENDIF
!* 4.11 BIS: Eddy fluxes allocation
!
IF ( LTH_FLX ) THEN
- ALLOCATE(XVTH_FLUX_M(IIU,IJU,IKU)) ; XVTH_FLUX_M = 0.
- ALLOCATE(XWTH_FLUX_M(IIU,IJU,IKU)) ; XWTH_FLUX_M = 0.
- IF (KMI /= 1) THEN
- ALLOCATE(XRTHS_EDDY_FLUX(IIU,IJU,IKU))
- XRTHS_EDDY_FLUX = 0.
- ENDIF
+ ALLOCATE(XVTH_FLUX_M(IIU,IJU,IKU)) ; XVTH_FLUX_M = 0.
+ ALLOCATE(XWTH_FLUX_M(IIU,IJU,IKU)) ; XWTH_FLUX_M = 0.
+ IF (KMI /= 1) THEN
+ ALLOCATE(XRTHS_EDDY_FLUX(IIU,IJU,IKU))
+ XRTHS_EDDY_FLUX = 0.
+ ELSE
+ ALLOCATE(XRTHS_EDDY_FLUX(0,0,0))
+ ENDIF
ELSE
- ALLOCATE(XVTH_FLUX_M(0,0,0)) ; XVTH_FLUX_M = 0.
- ALLOCATE(XWTH_FLUX_M(0,0,0)) ; XWTH_FLUX_M = 0.
+ ALLOCATE(XVTH_FLUX_M(0,0,0))
+ ALLOCATE(XWTH_FLUX_M(0,0,0))
+ ALLOCATE(XRTHS_EDDY_FLUX(0,0,0))
END IF
!
IF ( LUV_FLX) THEN
- ALLOCATE(XVU_FLUX_M(IIU,IJU,IKU)) ; XVU_FLUX_M = 0.
- IF (KMI /= 1) THEN
- ALLOCATE(XRVS_EDDY_FLUX(IIU,IJU,IKU))
- XRVS_EDDY_FLUX = 0.
- ENDIF
+ ALLOCATE(XVU_FLUX_M(IIU,IJU,IKU)) ; XVU_FLUX_M = 0.
+ IF (KMI /= 1) THEN
+ ALLOCATE(XRVS_EDDY_FLUX(IIU,IJU,IKU))
+ XRVS_EDDY_FLUX = 0.
+ ELSE
+ ALLOCATE(XRVS_EDDY_FLUX(0,0,0))
+ ENDIF
ELSE
- ALLOCATE(XVU_FLUX_M(0,0,0)) ; XVU_FLUX_M = 0.
+ ALLOCATE(XVU_FLUX_M(0,0,0))
+ ALLOCATE(XRVS_EDDY_FLUX(0,0,0))
END IF
!
!* 3.11 Module MODD_ICE_CONC_n
@@ -1506,6 +1595,11 @@ IF ( CCLOUD == 'KHKO' .OR. CCLOUD == 'C2R2') THEN
ALLOCATE(XNACT(IIU,IJU,IKU))
ALLOCATE(XNPRO(IIU,IJU,IKU))
ALLOCATE(XSSPRO(IIU,IJU,IKU))
+ELSE
+ ALLOCATE(XSUPSAT(0,0,0))
+ ALLOCATE(XNACT(0,0,0))
+ ALLOCATE(XNPRO(0,0,0))
+ ALLOCATE(XSSPRO(0,0,0))
END IF
!
!* 3.12 Module MODD_TURB_CLOUD
@@ -1532,17 +1626,23 @@ IF (LUSECHAQ.AND.(CPROGRAM == 'DIAG '.OR.CPROGRAM == 'MESONH')) THEN
XACPRAQ(:,:,:) = 0.
ENDIF
ENDIF
+IF (.NOT.(ASSOCIATED(XPHC))) ALLOCATE(XPHC(0,0,0))
+IF (.NOT.(ASSOCIATED(XPHR))) ALLOCATE(XPHR(0,0,0))
+IF (.NOT.(ASSOCIATED(XACPHR))) ALLOCATE(XACPHR(0,0))
+IF (.NOT.(ASSOCIATED(XACPRAQ))) ALLOCATE(XACPRAQ(0,0,0))
IF ((LUSECHEM).AND.(CPROGRAM == 'DIAG ')) THEN
ALLOCATE(XCHFLX(IIU,IJU,NSV_CHEM))
XCHFLX(:,:,:) = 0.
+ELSE
+ ALLOCATE(XCHFLX(0,0,0))
END IF
!
!* 3.14 Module MODD_DRAG
!
IF (LDRAG) THEN
- ALLOCATE(XDRAG(IIU,IJU))
+ ALLOCATE(XDRAG(IIU,IJU))
ELSE
- ALLOCATE(XDRAG(0,0))
+ ALLOCATE(XDRAG(0,0))
ENDIF
!
!-------------------------------------------------------------------------------
@@ -1575,9 +1675,9 @@ IF (KMI == 1) THEN
DO IMI = 1 , NMODEL
WRITE(IO_SURF_MNH_MODEL(IMI)%COUTFILE,'(A,".",I1,".",A)') CEXP,IMI,TRIM(ADJUSTL(CSEG))
WRITE(YNAME, '(A,".",I1,".",A)') CEXP,IMI,TRIM(ADJUSTL(CSEG))//'.000'
- CALL IO_FILE_ADD2LIST(LUNIT_MODEL(IMI)%TDIAFILE,YNAME,'DIACHRONIC','WRITE', &
- HDIRNAME=CIO_DIR, &
- KLFINPRAR=INT(50,KIND=LFI_INT),KLFITYPE=1,KLFIVERB=NVERB, &
+ CALL IO_File_add2list(LUNIT_MODEL(IMI)%TDIAFILE,YNAME,'MNHDIACHRONIC','WRITE', &
+ HDIRNAME=CIO_DIR, &
+ KLFINPRAR=INT(50,KIND=LFIINT),KLFITYPE=1,KLFIVERB=NVERB, &
TPDADFILE=LUNIT_MODEL(NDAD(IMI))%TDIAFILE )
END DO
!
@@ -1642,14 +1742,10 @@ IF ( LUSECHEM .OR. LCHEMDIAG ) THEN
!
IF (LORILAM) THEN
CALL CH_AER_MOD_INIT
- ELSE
- IF (.NOT.(ASSOCIATED(XSOLORG))) ALLOCATE(XSOLORG(0,0,0,0))
- IF (.NOT.(ASSOCIATED(XMI))) ALLOCATE(XMI(0,0,0,0))
ENDIF
-ELSE
- IF (.NOT.(ASSOCIATED(XMI))) ALLOCATE(XMI(0,0,0,0))
- IF (.NOT.(ASSOCIATED(XSOLORG))) ALLOCATE(XSOLORG(0,0,0,0))
END IF
+IF (.NOT.(ASSOCIATED(XMI))) ALLOCATE(XMI(0,0,0,0))
+IF (.NOT.(ASSOCIATED(XSOLORG))) ALLOCATE(XSOLORG(0,0,0,0))
!
IF (CCLOUD=='LIMA') CALL INIT_AEROSOL_PROPERTIES
!
@@ -1659,18 +1755,18 @@ 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,XTSTEP, &
- CGETTKET,CGETRVT,CGETRCT,CGETRRT,CGETRIT,CGETCIT, &
+CALL READ_FIELD(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,&
NSIZELBXTKE_ll,NSIZELBYTKE_ll, &
NSIZELBXR_ll,NSIZELBYR_ll,NSIZELBXSV_ll,NSIZELBYSV_ll, &
XUM,XVM,XWM,XDUM,XDVM,XDWM, &
- XUT,XVT,XWT,XTHT,XPABST,XPABSM,XTKET,XRTKEMS, &
- XRT,XSVT,XCIT,XDRYMASST, &
+ XUT,XVT,XWT,XTHT,XPABST,XTKET,XRTKEMS, &
+ XRT,XSVT,XZWS,XCIT,XDRYMASST, &
XSIGS,XSRCT,XCLDFR,XBL_DEPTH,XSBL_DEPTH,XWTHVMF,XPHC,XPHR, &
- XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM, &
+ XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM,XLSZWSM, &
XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM, &
XLBXRM,XLBXSVM, &
XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM, &
@@ -1738,9 +1834,9 @@ IF (CELEC == 'NONE') THEN
! --------------------------------------
!
ELSE
- CALL INI_ELEC_n(ILUOUT, CELEC, CCLOUD, HLUOUT, TPINIFILE, &
- XTSTEP, XZZ, &
- XDXX, XDYY, XDZZ, XDZX, XDZY )
+ CALL INI_ELEC_n(ILUOUT, CELEC, CCLOUD, TPINIFILE, &
+ XTSTEP, XZZ, &
+ XDXX, XDYY, XDZZ, XDZX, XDZY )
!
WRITE (UNIT=ILUOUT,&
FMT='(/,"ELECTRIC VARIABLES ARE BETWEEN INDEX",I2," AND ",I2)')&
@@ -1773,10 +1869,10 @@ IF ((KMI==1).AND.(.NOT. LSTEADYLS)) THEN
NSIZELBX_ll,NSIZELBXU_ll,NSIZELBY_ll,NSIZELBYV_ll, &
NSIZELBXTKE_ll,NSIZELBYTKE_ll, &
NSIZELBXR_ll,NSIZELBYR_ll,NSIZELBXSV_ll,NSIZELBYSV_ll, &
- XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM,XDRYMASST, &
+ XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM,XLSZWSM,XDRYMASST, &
XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM, &
XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
- XLSUS,XLSVS,XLSWS,XLSTHS,XLSRVS,XDRYMASSS, &
+ XLSUS,XLSVS,XLSWS,XLSTHS,XLSRVS,XLSZWSS,XDRYMASSS, &
XLBXUS,XLBXVS,XLBXWS,XLBXTHS,XLBXTKES,XLBXRS,XLBXSVS, &
XLBYUS,XLBYVS,XLBYWS,XLBYTHS,XLBYTKES,XLBYRS,XLBYSVS )
CALL MPPDB_CHECK3D(XUT,"INI_MODEL_N-after ini_cpl::XUT",PRECISION)
@@ -1863,11 +1959,13 @@ IF ( KMI > 1) THEN
DPTR_XLSWM=>XLSWM
DPTR_XLSTHM=>XLSTHM
DPTR_XLSRVM=>XLSRVM
+ DPTR_XLSZWSM=>XLSZWSM
DPTR_XLSUS=>XLSUS
DPTR_XLSVS=>XLSVS
DPTR_XLSWS=>XLSWS
DPTR_XLSTHS=>XLSTHS
DPTR_XLSRVS=>XLSRVS
+ DPTR_XLSZWSS=>XLSZWSS
!
DPTR_NKLIN_LBXU=>NKLIN_LBXU
DPTR_XCOEFLIN_LBXU=>XCOEFLIN_LBXU
@@ -1892,8 +1990,8 @@ IF ( KMI > 1) THEN
NDXRATIO_ALL(KMI),NDYRATIO_ALL(KMI), &
DPTR_CLBCX,DPTR_CLBCY,DPTR_XZZ,DPTR_XZHAT, &
LSLEVE,XLEN1,XLEN2, &
- DPTR_XLSUM,DPTR_XLSVM,DPTR_XLSWM,DPTR_XLSTHM,DPTR_XLSRVM, &
- DPTR_XLSUS,DPTR_XLSVS,DPTR_XLSWS,DPTR_XLSTHS,DPTR_XLSRVS, &
+ DPTR_XLSUM,DPTR_XLSVM,DPTR_XLSWM,DPTR_XLSTHM,DPTR_XLSRVM,DPTR_XLSZWSM, &
+ DPTR_XLSUS,DPTR_XLSVS,DPTR_XLSWS,DPTR_XLSTHS,DPTR_XLSRVS,DPTR_XLSZWSS, &
DPTR_NKLIN_LBXU,DPTR_XCOEFLIN_LBXU,DPTR_NKLIN_LBYU,DPTR_XCOEFLIN_LBYU, &
DPTR_NKLIN_LBXV,DPTR_XCOEFLIN_LBXV,DPTR_NKLIN_LBYV,DPTR_XCOEFLIN_LBYV, &
DPTR_NKLIN_LBXW,DPTR_XCOEFLIN_LBXW,DPTR_NKLIN_LBYW,DPTR_XCOEFLIN_LBYW, &
@@ -1913,7 +2011,7 @@ IF ( KMI > 1) THEN
DPTR_XLBYRM=>XLBYRM
DPTR_XLBXSVM=>XLBXSVM
DPTR_XLBYSVM=>XLBYSVM
- CALL INI_ONE_WAY_n(NDAD(KMI),CLUOUT,XTSTEP,KMI,1, &
+ CALL INI_ONE_WAY_n(NDAD(KMI),XTSTEP,KMI,1, &
DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4,DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4, &
DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4,DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4, &
NDXRATIO_ALL(KMI),NDYRATIO_ALL(KMI),NDTRATIO(KMI), &
@@ -1986,7 +2084,7 @@ IF (CRAD /= 'NONE') THEN
ELSE
GINIRAD =.FALSE.
END IF
- CALL INI_RADIATIONS(TPINIFILE,HLUOUT,GINIRAD,TDTCUR,TDTEXP,XZZ, &
+ CALL INI_RADIATIONS(TPINIFILE,GINIRAD,TDTCUR,TDTEXP,XZZ, &
XDXX, XDYY, &
XSINDEL,XCOSDEL,XTSIDER,XCORSOL, &
XSLOPANG,XSLOPAZI, &
@@ -2047,7 +2145,7 @@ 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_READ_FIELD(TPINIFILE,'SURF',CSURF)
+ CALL IO_Field_read(TPINIFILE,'SURF',CSURF)
ELSE
CSURF = "EXTE"
END IF
@@ -2056,8 +2154,8 @@ END IF
IF (CSURF=='EXTE' .AND. (CPROGRAM=='MESONH' .OR. CPROGRAM=='DIAG ')) THEN
! ouverture du fichier PGD
IF ( LEN_TRIM(CINIFILEPGD) > 0 ) THEN
- CALL IO_FILE_ADD2LIST(TINIFILEPGD,TRIM(CINIFILEPGD),'UNKNOWN','READ',KLFITYPE=2,KLFIVERB=NVERB)
- CALL IO_FILE_OPEN_ll(TINIFILEPGD,OPARALLELIO=.FALSE.,KRESP=IRESP)
+ CALL IO_File_add2list(TINIFILEPGD,TRIM(CINIFILEPGD),'PGD','READ',KLFITYPE=2,KLFIVERB=NVERB)
+ CALL IO_File_open(TINIFILEPGD,KRESP=IRESP)
LUNIT_MODEL(KMI)%TINIFILEPGD => TINIFILEPGD
IF (IRESP/=0) THEN
WRITE(ILUOUT,FMT=*) "INI_MODEL_n ERROR TO OPEN THE FILE CINIFILEPGD=",CINIFILEPGD
@@ -2099,8 +2197,8 @@ ELSE
END IF
IF (CSURF=='EXTE' .AND. (CPROGRAM=='SPAWN ')) THEN
! ouverture du fichier PGD
- CALL IO_FILE_ADD2LIST(TINIFILEPGD,TRIM(CINIFILEPGD),'UNKNOWN','READ',KLFITYPE=2,KLFIVERB=NVERB)
- CALL IO_FILE_OPEN_ll(TINIFILEPGD,OPARALLELIO=.FALSE.,KRESP=IRESP)
+ CALL IO_File_add2list(TINIFILEPGD,TRIM(CINIFILEPGD),'PGD','READ',KLFITYPE=2,KLFIVERB=NVERB)
+ CALL IO_File_open(TINIFILEPGD,KRESP=IRESP)
LUNIT_MODEL(KMI)%TINIFILEPGD => TINIFILEPGD
IF (IRESP/=0) THEN
WRITE(ILUOUT,FMT=*) "INI_MODEL_n ERROR TO OPEN THE FILE CINIFILEPGD=",CINIFILEPGD
@@ -2157,8 +2255,7 @@ IF (CRAD == 'ECMW') THEN
ZBARE(:,:) = 0.
END IF
!
- CALL INI_RADIATIONS_ECMWF (TPINIFILE%CNAME,HLUOUT, &
- XZHAT,XPABST,XTHT,XTSRAD,XLAT,XLON,TDTCUR,TDTEXP, &
+ CALL INI_RADIATIONS_ECMWF (XZHAT,XPABST,XTHT,XTSRAD,XLAT,XLON,TDTCUR,TDTEXP, &
CLW,NDLON,NFLEV,NFLUX,NRAD,NSWB_OLD,CAER,NAER,NSTATM, &
XSTATM,ZSEA,ZTOWN,ZBARE,XOZON, XAER,XDST_WL, LSUBG_COND )
!
@@ -2184,9 +2281,8 @@ ELSE IF (CRAD == 'ECRA') THEN
ZTOWN(:,:) = 0.
ZBARE(:,:) = 0.
END IF
-!
- CALL INI_RADIATIONS_ECRAD (TPINIFILE%CNAME,HLUOUT, &
- XZHAT,XPABST,XTHT,XTSRAD,XLAT,XLON,TDTCUR,TDTEXP, &
+!
+ CALL INI_RADIATIONS_ECRAD (XZHAT,XPABST,XTHT,XTSRAD,XLAT,XLON,TDTCUR,TDTEXP, &
CLW,NDLON,NFLEV,NFLUX,NRAD,NSWB_OLD,CAER,NAER,NSTATM, &
XSTATM,ZSEA,ZTOWN,ZBARE,XOZON, XAER,XDST_WL, LSUBG_COND )
@@ -2219,7 +2315,7 @@ IF (CDCONV /= 'NONE' .OR. CSCONV == 'KAFR') THEN
IF (NVERB>=10) THEN
WRITE(ILUOUT,*) 'XDTCONV has been set to : ',XDTCONV
END IF
- CALL INI_DEEP_CONVECTION (TPINIFILE,HLUOUT,GINIDCONV,TDTCUR, &
+ CALL INI_DEEP_CONVECTION (TPINIFILE,GINIDCONV,TDTCUR, &
NCOUNTCONV,XDTHCONV,XDRVCONV,XDRCCONV, &
XDRICONV,XPRCONV,XPRSCONV,XPACCONV, &
XUMFCONV,XDMFCONV,XMFCONV,XPRLFLXCONV,XPRSFLXCONV,&
@@ -2325,16 +2421,16 @@ CALL INI_AEROSET6
! Coupling with ForeFire if resolution is low enough
!---------------------------------------------------
IF ( LFOREFIRE .AND. 0.5*(XXHAT(2)-XXHAT(1)+XYHAT(2)-XYHAT(1)) < COUPLINGRES ) THEN
- FFCOUPLING = .TRUE.
+ FFCOUPLING = .TRUE.
ELSE
- FFCOUPLING = .FALSE.
+ FFCOUPLING = .FALSE.
ENDIF
! Initializing the ForeFire variables
!------------------------------------
IF ( LFOREFIRE ) THEN
- CALL INIT_FOREFIRE_n(KMI, ILUOUT, IP &
- , TDTCUR%TDATE%YEAR, TDTCUR%TDATE%MONTH, TDTCUR%TDATE%DAY, TDTCUR%TIME, XTSTEP)
+ CALL INIT_FOREFIRE_n(KMI, ILUOUT, IP &
+ , TDTCUR%TDATE%YEAR, TDTCUR%TDATE%MONTH, TDTCUR%TDATE%DAY, TDTCUR%TIME, XTSTEP)
END IF
#endif
@@ -2343,19 +2439,19 @@ END IF
!* 30. Total production/Loss for chemical species
!
IF (LCHEMDIAG) THEN
- CALL CH_INIT_PRODLOSSTOT_n(ILUOUT)
- IF (NEQ_PLT>0) THEN
- ALLOCATE(XPROD(IIU,IJU,IKU,NEQ_PLT))
- ALLOCATE(XLOSS(IIU,IJU,IKU,NEQ_PLT))
- XPROD=0.0
- XLOSS=0.0
- ELSE
- ALLOCATE(XPROD(0,0,0,0))
- ALLOCATE(XLOSS(0,0,0,0))
- END IF
+ CALL CH_INIT_PRODLOSSTOT_n(ILUOUT)
+ IF (NEQ_PLT>0) THEN
+ ALLOCATE(XPROD(IIU,IJU,IKU,NEQ_PLT))
+ ALLOCATE(XLOSS(IIU,IJU,IKU,NEQ_PLT))
+ XPROD=0.0
+ XLOSS=0.0
+ ELSE
+ ALLOCATE(XPROD(0,0,0,0))
+ ALLOCATE(XLOSS(0,0,0,0))
+ END IF
ELSE
- ALLOCATE(XPROD(0,0,0,0))
- ALLOCATE(XLOSS(0,0,0,0))
+ ALLOCATE(XPROD(0,0,0,0))
+ ALLOCATE(XLOSS(0,0,0,0))
END IF
!
!-------------------------------------------------------------------------------
@@ -2363,24 +2459,24 @@ END IF
!* 31. Extended production/loss terms for chemical species
!
IF (LCHEMDIAG) THEN
- CALL CH_INIT_BUDGET_n(ILUOUT)
- IF (NEQ_BUDGET>0) THEN
- ALLOCATE(IINDEX(2,NNONZEROTERMS))
- ALLOCATE(IIND(NEQ_BUDGET))
- CALL CH_NONZEROTERMS(KMI,IINDEX,NNONZEROTERMS)
- ALLOCATE(XTCHEM(NEQ_BUDGET))
- DO JM=1,NEQ_BUDGET
- IIND(JM)=COUNT((IINDEX(1,:))==NSPEC_BUDGET(JM))
- ALLOCATE(XTCHEM(JM)%NB_REAC(IIND(JM)))
- ALLOCATE(XTCHEM(JM)%XB_REAC(IIU,IJU,IKU,IIND(JM)))
- END DO
- DEALLOCATE(IIND)
- DEALLOCATE(IINDEX)
- ELSE
- ALLOCATE(XTCHEM(0))
- END IF
+ CALL CH_INIT_BUDGET_n(ILUOUT)
+ IF (NEQ_BUDGET>0) THEN
+ ALLOCATE(IINDEX(2,NNONZEROTERMS))
+ ALLOCATE(IIND(NEQ_BUDGET))
+ CALL CH_NONZEROTERMS(KMI,IINDEX,NNONZEROTERMS)
+ ALLOCATE(XTCHEM(NEQ_BUDGET))
+ DO JM=1,NEQ_BUDGET
+ IIND(JM)=COUNT((IINDEX(1,:))==NSPEC_BUDGET(JM))
+ ALLOCATE(XTCHEM(JM)%NB_REAC(IIND(JM)))
+ ALLOCATE(XTCHEM(JM)%XB_REAC(IIU,IJU,IKU,IIND(JM)))
+ END DO
+ DEALLOCATE(IIND)
+ DEALLOCATE(IINDEX)
+ ELSE
+ ALLOCATE(XTCHEM(0))
+ END IF
ELSE
- ALLOCATE(XTCHEM(0))
+ ALLOCATE(XTCHEM(0))
END IF
END SUBROUTINE INI_MODEL_n
diff --git a/src/MNH/ini_one_wayn.f90 b/src/MNH/ini_one_wayn.f90
index 4182d6a2e97b4d4116f158724d6ea4698cb096ec..1b6100cd773e6cd67bc95046afe517991cede48b 100644
--- a/src/MNH/ini_one_wayn.f90
+++ b/src/MNH/ini_one_wayn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 INI_ONE_WAY_n( KDAD,HLUOUT,PTSTEP,KMI,KTCOUNT, &
+ SUBROUTINE INI_ONE_WAY_n( KDAD,PTSTEP,KMI,KTCOUNT, &
PBMX1,PBMX2,PBMX3,PBMX4,PBMY1,PBMY2,PBMY3,PBMY4, &
PBFX1,PBFX2,PBFX3,PBFX4,PBFY1,PBFY2,PBFY3,PBFY4, &
KDXRATIO,KDYRATIO,KDTRATIO, &
@@ -26,7 +26,6 @@ INTERFACE
!
!
INTEGER, INTENT(IN) :: KDAD ! Number of the DAD model
-CHARACTER (LEN=*),INTENT(IN) :: HLUOUT ! name of the output-listing
REAL, INTENT(IN) :: PTSTEP ! Time step
INTEGER, INTENT(IN) :: KMI ! model number
INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop COUNTer
@@ -72,7 +71,7 @@ END MODULE MODI_INI_ONE_WAY_n
!
! ####################################################################
-SUBROUTINE INI_ONE_WAY_n(KDAD,HLUOUT,PTSTEP,KMI,KTCOUNT, &
+SUBROUTINE INI_ONE_WAY_n(KDAD,PTSTEP,KMI,KTCOUNT, &
PBMX1,PBMX2,PBMX3,PBMX4,PBMY1,PBMY2,PBMY3,PBMY4, &
PBFX1,PBFX2,PBFX3,PBFX4,PBFY1,PBFY2,PBFY3,PBFY4, &
KDXRATIO,KDYRATIO,KDTRATIO, &
@@ -140,12 +139,15 @@ SUBROUTINE INI_ONE_WAY_n(KDAD,HLUOUT,PTSTEP,KMI,KTCOUNT, &
!! 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 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 MODE_ll
+use mode_msg
USE MODE_MODELN_HANDLER
!
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
@@ -172,7 +174,6 @@ IMPLICIT NONE
!
!
INTEGER, INTENT(IN) :: KDAD ! Number of the DAD model
-CHARACTER (LEN=*),INTENT(IN) :: HLUOUT ! name for output-listing
REAL, INTENT(IN) :: PTSTEP ! Time step
INTEGER, INTENT(IN) :: KMI ! model number
INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop COUNTer
@@ -413,7 +414,7 @@ IF (HCLOUD=="LIMA" ) THEN
&ZTSVM(:,:,:,JSV-1+NSV_LIMA_BEG_A(KMI)),KMI)
ENDDO
ELSE
- IF (NSV_LIMA_A(KMI)/=NSV_LIMA_A(KDAD)) CALL ABORT
+ IF (NSV_LIMA_A(KMI)/=NSV_LIMA_A(KDAD)) call Print_msg(NVERB_FATAL,'GEN','INI_ONE_WAY_n','NSV_LIMA_A(KMI)/=NSV_LIMA_A(KDAD)')
DO JSV=1,NSV_LIMA_A(KMI)
CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_LIMA_BEG_A(KDAD)),&
&ZTSVM(:,:,:,JSV-1+NSV_LIMA_BEG_A(KMI)),KMI)
diff --git a/src/MNH/ini_param_elec.f90 b/src/MNH/ini_param_elec.f90
index fc1adb10d14b353a98963ff295b040fae6fafaa9..ca55b76640b5279dfaa075dbc6a4c3b278d89bba 100644
--- a/src/MNH/ini_param_elec.f90
+++ b/src/MNH/ini_param_elec.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 INI_PARAM_ELEC (TPINIFILE, HGETSVM, PRHO00, &
KRR, KND, PFDINFTY, IIU, IJU, IKU )
!
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY : TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
CHARACTER (LEN=*), DIMENSION(:),INTENT(IN) :: HGETSVM
@@ -94,15 +94,15 @@ USE MODD_CST
USE MODD_ELEC_n
USE MODD_ELEC_DESCR
USE MODD_ELEC_PARAM
-USE MODD_IO_ll, ONLY : TFILEDATA
-USE MODD_NSV, ONLY : NSV_ELECEND
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_NSV, ONLY: NSV_ELECEND
USE MODD_PARAMETERS
USE MODD_PARAM_ICE
USE MODD_RAIN_ICE_DESCR
USE MODD_RAIN_ICE_PARAM
USE MODD_VAR_ll
!
-USE MODE_FMREAD
+USE MODE_IO_FIELD_READ, only: IO_Field_read
!
USE MODI_MOMG
USE MODI_RRCOLSS
@@ -348,10 +348,10 @@ XEW(:,:,:) = 0.
!
SELECT CASE(HGETSVM(NSV_ELECEND))
CASE ('READ')
- CALL IO_READ_FIELD(TPINIFILE,'NI_IAGGS',XNI_IAGGS)
- CALL IO_READ_FIELD(TPINIFILE,'NI_IDRYG',XNI_IDRYG)
- CALL IO_READ_FIELD(TPINIFILE,'NI_SDRYG',XNI_SDRYG)
- CALL IO_READ_FIELD(TPINIFILE,'INDUC_CG',XIND_RATE)
+ CALL IO_Field_read(TPINIFILE,'NI_IAGGS',XNI_IAGGS)
+ CALL IO_Field_read(TPINIFILE,'NI_IDRYG',XNI_IDRYG)
+ CALL IO_Field_read(TPINIFILE,'NI_SDRYG',XNI_SDRYG)
+ CALL IO_Field_read(TPINIFILE,'INDUC_CG',XIND_RATE)
CASE ('INIT')
XNI_IAGGS(:,:,:) = 0.
XNI_IDRYG(:,:,:) = 0.
diff --git a/src/MNH/ini_posprofilern.f90 b/src/MNH/ini_posprofilern.f90
index 846d52d7432b983014b773126e9b9c8fcf92220c..88b86c3cb78e86e51534a62597948d8cace76d03 100644
--- a/src/MNH/ini_posprofilern.f90
+++ b/src/MNH/ini_posprofilern.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #########################
@@ -84,7 +84,6 @@ USE MODD_TYPE_PROFILER
USE MODD_TYPE_DATE
!
USE MODE_GRIDPROJ
-USE MODE_IO_ll
USE MODE_ll
USE MODE_MSG
!
diff --git a/src/MNH/ini_prog_var.f90 b/src/MNH/ini_prog_var.f90
index 182752bc2f77e9ffc68182b3ed941de5d2955ca6..f02cd9c388ba086241e6cf773243827f0ea2b0fa 100644
--- a/src/MNH/ini_prog_var.f90
+++ b/src/MNH/ini_prog_var.f90
@@ -1,15 +1,14 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ########################
MODULE MODI_INI_PROG_VAR
! ########################
INTERFACE
- SUBROUTINE INI_PROG_VAR(HLUOUT,PTKE_MX,PSV_MX,HCHEMFILE)
+ SUBROUTINE INI_PROG_VAR(PTKE_MX, PSV_MX, HCHEMFILE)
!
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Name of the output-listing
REAL,DIMENSION(:,:,:), INTENT(IN) :: PTKE_MX
REAL,DIMENSION(:,:,:,:),INTENT(IN) :: PSV_MX
CHARACTER(LEN=*), INTENT(IN),OPTIONAL :: HCHEMFILE ! Name of the chem file
@@ -17,9 +16,9 @@ END SUBROUTINE INI_PROG_VAR
END INTERFACE
END MODULE MODI_INI_PROG_VAR
!
-! ########################################################
- SUBROUTINE INI_PROG_VAR(HLUOUT,PTKE_MX,PSV_MX,HCHEMFILE)
-! ########################################################
+! ###################################################
+ SUBROUTINE INI_PROG_VAR(PTKE_MX, PSV_MX, HCHEMFILE)
+! ###################################################
!
!!**** *INI_PROG_VAR* - initialization the prognostic variables not yet
!! initialized
@@ -45,8 +44,8 @@ END MODULE MODI_INI_PROG_VAR
!!
!! 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
-!! CLUOUT0 : name of output-listing
+!! Module MODD_LUNIT_n : contains logical unit names for all models
+!! TLUOUT : name of output-listing
!! Module MODD_FIELD1 : contains the prognostic fields of model1
!! XUM
!! XVM
@@ -94,6 +93,8 @@ END MODULE MODI_INI_PROG_VAR
!! Mai 2017 (M. Leriche) read aerosol namelists before call ini_nsv
!! Mai 2017 (M. Leriche) Get wet dep. sv in Meso-NH init file
!! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -109,7 +110,7 @@ USE MODD_DIM_n
USE MODD_DUST
USE MODD_DYN_n
USE MODD_FIELD_n
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LSFIELD_n
USE MODD_LUNIT
USE MODD_LUNIT_n, ONLY: TLUOUT
@@ -119,11 +120,10 @@ USE MODD_PARAMETERS
USE MODD_SALT
USE MODD_TURB_n
!
-USE MODE_IO_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPEREAL
-USE MODE_FM, ONLY: IO_FILE_CLOSE_ll, IO_FILE_OPEN_ll
-USE MODE_FMREAD
+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
USE MODE_MODELN_HANDLER
USE MODE_MSG
USE MODE_POS
@@ -140,15 +140,13 @@ IMPLICIT NONE
!
!* 0.1 declaration of arguments
!
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Name of the output-listing
REAL,DIMENSION(:,:,:), INTENT(IN) :: PTKE_MX
REAL,DIMENSION(:,:,:,:),INTENT(IN) :: PSV_MX
CHARACTER(LEN=*), INTENT(IN),OPTIONAL :: HCHEMFILE ! Name of the chem file
!
!* 0.2 declaration of local variables
!
-INTEGER :: ILUOUT ! Logical unit number
- ! associated with HLUOUT
+INTEGER :: ILUOUT
INTEGER :: IRESP
!
INTEGER :: IIMAX,IJMAX,IKMAX ! Dimensions of the chem file
@@ -216,24 +214,24 @@ ALLOCATE(XSVT(0,0,0,0))
IF(PRESENT(HCHEMFILE)) THEN
WRITE(ILUOUT,*) 'Routine INI_PROG_VAR: CHEMical species read in ',TRIM(HCHEMFILE)
! Read dimensions in chem file and checks with output file
- CALL IO_FILE_ADD2LIST(TZCHEMFILE,TRIM(HCHEMFILE),'UNKNOWN','READ',KLFITYPE=2,KLFIVERB=NVERB)
- CALL IO_FILE_OPEN_ll(TZCHEMFILE)
+ CALL IO_File_add2list(TZCHEMFILE,TRIM(HCHEMFILE),'MNH','READ',KLFITYPE=2,KLFIVERB=NVERB)
+ CALL IO_File_open(TZCHEMFILE)
!
ILUDES = TZCHEMFILE%TDESFILE%NLU
!
- CALL IO_READ_FIELD(TZCHEMFILE,'IMAX',IIMAX,IRESP)
+ CALL IO_Field_read(TZCHEMFILE,'IMAX',IIMAX,IRESP)
IF (IRESP/=0) THEN
!callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_PROG_VAR','IMAX not found in the CHEM file '//TRIM(HCHEMFILE))
END IF !IRESP
!
- CALL IO_READ_FIELD(TZCHEMFILE,'JMAX',IJMAX,IRESP)
+ CALL IO_Field_read(TZCHEMFILE,'JMAX',IJMAX,IRESP)
IF (IRESP/=0) THEN
!callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_PROG_VAR','JMAX not found in the CHEM file '//TRIM(HCHEMFILE))
END IF !IRESP
!
- CALL IO_READ_FIELD(TZCHEMFILE,'KMAX',IKMAX,IRESP)
+ CALL IO_Field_read(TZCHEMFILE,'KMAX',IKMAX,IRESP)
IF (IRESP/=0) THEN
!callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_PROG_VAR','KMAX not found in the CHEM file '//TRIM(HCHEMFILE))
@@ -287,7 +285,7 @@ IF(PRESENT(HCHEMFILE)) THEN
TZFIELD%CMNHNAME = TRIM(CNAMES(JSV-NSV_CHEMBEG+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_READ_FIELD(TZCHEMFILE,TZFIELD,XSVT(:,:,:,JSV),IRESP)
+ CALL IO_Field_read(TZCHEMFILE,TZFIELD,XSVT(:,:,:,JSV),IRESP)
IF (IRESP/=0) THEN
WRITE(ILUOUT,*) TRIM(TZFIELD%CMNHNAME),' NOT FOUND IN THE CHEM FILE ',HCHEMFILE
XSVT(:,:,:,JSV) = 0.
@@ -314,7 +312,7 @@ IF(PRESENT(HCHEMFILE)) THEN
TZFIELD%CMNHNAME = TRIM(CAERONAMES(JSV-NSV_AERBEG+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_READ_FIELD(TZCHEMFILE,TZFIELD,XSVT(:,:,:,JSV),IRESP)
+ CALL IO_Field_read(TZCHEMFILE,TZFIELD,XSVT(:,:,:,JSV),IRESP)
IF (IRESP/=0) THEN
WRITE(ILUOUT,*) TRIM(TZFIELD%CMNHNAME),'NOT FOUND IN THE CHEM FILE ',HCHEMFILE
LORILAM=.FALSE.
@@ -339,7 +337,7 @@ IF(PRESENT(HCHEMFILE)) THEN
TZFIELD%CMNHNAME = TRIM(CDEAERNAMES(JSV-NSV_AERDEPBEG+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_READ_FIELD(TZCHEMFILE,TZFIELD,XSVT(:,:,:,JSV),IRESP)
+ CALL IO_Field_read(TZCHEMFILE,TZFIELD,XSVT(:,:,:,JSV),IRESP)
IF (IRESP/=0) THEN
WRITE(ILUOUT,*) TRIM(TZFIELD%CMNHNAME),'NOT FOUND IN THE CHEM FILE ',HCHEMFILE
LDEPOS_AER(IMI)=.FALSE.
@@ -368,7 +366,7 @@ IF(PRESENT(HCHEMFILE)) THEN
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_READ_FIELD(TZCHEMFILE,TZFIELD,XSVT(:,:,:,JSV),IRESP)
+ 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
@@ -383,7 +381,7 @@ IF(PRESENT(HCHEMFILE)) THEN
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_READ_FIELD(TZCHEMFILE,TZFIELD,XSVT(:,:,:,JSV),IRESP)
+ 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))
@@ -413,7 +411,7 @@ IF(PRESENT(HCHEMFILE)) THEN
TZFIELD%CMNHNAME = TRIM(CDEDSTNAMES(JSV-NSV_DSTDEPBEG+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_READ_FIELD(TZCHEMFILE,TZFIELD,XSVT(:,:,:,JSV),IRESP)
+ CALL IO_Field_read(TZCHEMFILE,TZFIELD,XSVT(:,:,:,JSV),IRESP)
IF (IRESP/=0) THEN
WRITE(ILUOUT,*) TRIM(TZFIELD%CMNHNAME),'NOT FOUND IN THE CHEM FILE ',HCHEMFILE
LDEPOS_DST(IMI)=.FALSE.
@@ -442,7 +440,7 @@ IF(PRESENT(HCHEMFILE)) THEN
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_READ_FIELD(TZCHEMFILE,TZFIELD,XSVT(:,:,:,JSV),IRESP)
+ 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
@@ -457,7 +455,7 @@ IF(PRESENT(HCHEMFILE)) THEN
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_READ_FIELD(TZCHEMFILE,TZFIELD,XSVT(:,:,:,JSV),IRESP)
+ 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
@@ -487,7 +485,7 @@ IF(PRESENT(HCHEMFILE)) THEN
TZFIELD%CMNHNAME = TRIM(CDESLTNAMES(JSV-NSV_SLTDEPBEG+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_READ_FIELD(TZCHEMFILE,TZFIELD,XSVT(:,:,:,JSV),IRESP)
+ CALL IO_Field_read(TZCHEMFILE,TZFIELD,XSVT(:,:,:,JSV),IRESP)
IF (IRESP/=0) THEN
WRITE(ILUOUT,*) TRIM(TZFIELD%CMNHNAME),'NOT FOUND IN THE CHEM FILE ',HCHEMFILE
LDEPOS_SLT(IMI)=.FALSE.
@@ -496,7 +494,7 @@ IF(PRESENT(HCHEMFILE)) THEN
ENDIF ! ldepos_slt
END IF ! LSALT
!
- CALL IO_FILE_CLOSE_ll(TZCHEMFILE)
+ CALL IO_File_close(TZCHEMFILE)
!
ELSE ! HCHEMFILE
IF (NSV >=1) THEN
diff --git a/src/MNH/ini_radiations.f90 b/src/MNH/ini_radiations.f90
index 698a17878f373d6c7eea2b96edf416ce7e7d3e80..640467fbb885d614b658c43189eca2c4d55901ad 100644
--- a/src/MNH/ini_radiations.f90
+++ b/src/MNH/ini_radiations.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2003-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.
!-----------------------------------------------------------------
! ##########################
@@ -9,7 +9,7 @@
!
INTERFACE
!
- SUBROUTINE INI_RADIATIONS(TPINIFILE,HLUOUT,OINIRAD,TPDTCUR,TPDTEXP,&
+ SUBROUTINE INI_RADIATIONS(TPINIFILE,OINIRAD,TPDTCUR,TPDTEXP, &
PZZ,PDXX,PDYY, &
PSINDEL,PCOSDEL,PTSIDER,PCORSOL,PSLOPANG,PSLOPAZI, &
PDTHRAD,PDIRFLASWD,PSCAFLASWD, &
@@ -18,12 +18,10 @@ INTERFACE
PRADEFF,PSWU,PSWD,PLWU,PLWD,PDTHRADSW,PDTHRADLW )
!
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY : TFILEDATA
USE MODD_TYPE_DATE
!
TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
-CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! name for output-listing
- ! of nested models
LOGICAL, INTENT(IN) :: OINIRAD ! switch to initialize or read
! the radiation informations
TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! Current date and time
@@ -69,7 +67,7 @@ END MODULE MODI_INI_RADIATIONS
!
!
! ####################################################################
- SUBROUTINE INI_RADIATIONS(TPINIFILE,HLUOUT,OINIRAD,TPDTCUR,TPDTEXP,&
+ SUBROUTINE INI_RADIATIONS(TPINIFILE,OINIRAD,TPDTCUR,TPDTEXP, &
PZZ,PDXX,PDYY, &
PSINDEL,PCOSDEL,PTSIDER,PCORSOL,PSLOPANG,PSLOPAZI, &
PDTHRAD,PDIRFLASWD,PSCAFLASWD, &
@@ -109,6 +107,7 @@ END MODULE MODI_INI_RADIATIONS
!! TDTEXP to have a perpetual day ie. the diurnal cycle is retained
!! but the day stays the same during the whole run
!! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -116,16 +115,16 @@ END MODULE MODI_INI_RADIATIONS
!
!MESO-NH modules
!
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-USE MODD_CST, ONLY : XPI
-USE MODD_CONF, ONLY : LFLAT, L2D
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_ARGSLIST_ll, ONLY: LIST_ll
+USE MODD_CST, ONLY: XPI
+USE MODD_CONF, ONLY: LFLAT, L2D
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES
-USE MODD_PARAMETERS, ONLY : JPVEXT
-USE MODD_PARAM_RAD_n, ONLY : LFIX_DAT
+USE MODD_PARAMETERS, ONLY: JPVEXT
+USE MODD_PARAM_RAD_n, ONLY: LFIX_DAT
USE MODD_TYPE_DATE
!
-USE MODE_FMREAD
+USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_ll
!
USE MODI_SHUMAN
@@ -135,8 +134,6 @@ IMPLICIT NONE
!* 0.1 Declarations of dummy arguments :
!
TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
-CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! name for output-listing
- ! of nested models
LOGICAL, INTENT(IN) :: OINIRAD ! switch to initialize or read
! the radiation informations
TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! Current date and time
@@ -311,16 +308,16 @@ IF ( OINIRAD ) THEN
PDIRSRFSWD(:,:,:)= 0.
KCLEARCOL_TM1 = 0
ELSE
- CALL IO_READ_FIELD(TPINIFILE,'DTRAD_FULL', TPDTRAD_FULL)
- CALL IO_READ_FIELD(TPINIFILE,'DTRAD_CLLY', TPDTRAD_CLONLY)
- CALL IO_READ_FIELD(TPINIFILE,'DTHRAD', PDTHRAD)
- CALL IO_READ_FIELD(TPINIFILE,'FLALWD', PFLALWD)
- CALL IO_READ_FIELD(TPINIFILE,'DIRFLASWD', PDIRFLASWD)
- CALL IO_READ_FIELD(TPINIFILE,'SCAFLASWD', PSCAFLASWD)
- CALL IO_READ_FIELD(TPINIFILE,'DIRSRFSWD', PDIRSRFSWD)
- CALL IO_READ_FIELD(TPINIFILE,'CLEARCOL_TM1',KCLEARCOL_TM1)
- CALL IO_READ_FIELD(TPINIFILE,'ZENITH', PZENITH)
- CALL IO_READ_FIELD(TPINIFILE,'AZIM', PAZIM)
+ CALL IO_Field_read(TPINIFILE,'DTRAD_FULL', TPDTRAD_FULL)
+ CALL IO_Field_read(TPINIFILE,'DTRAD_CLLY', TPDTRAD_CLONLY)
+ CALL IO_Field_read(TPINIFILE,'DTHRAD', PDTHRAD)
+ CALL IO_Field_read(TPINIFILE,'FLALWD', PFLALWD)
+ CALL IO_Field_read(TPINIFILE,'DIRFLASWD', PDIRFLASWD)
+ CALL IO_Field_read(TPINIFILE,'SCAFLASWD', PSCAFLASWD)
+ CALL IO_Field_read(TPINIFILE,'DIRSRFSWD', PDIRSRFSWD)
+ CALL IO_Field_read(TPINIFILE,'CLEARCOL_TM1',KCLEARCOL_TM1)
+ CALL IO_Field_read(TPINIFILE,'ZENITH', PZENITH)
+ CALL IO_Field_read(TPINIFILE,'AZIM', PAZIM)
END IF
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/ini_radiations_ecmwf.f90 b/src/MNH/ini_radiations_ecmwf.f90
index 6c6b9e9fdedf41505c96e01601fbf599a84a53ed..cf0ba2ebcb1d701e3940dabaae6285ee7447d037 100644
--- a/src/MNH/ini_radiations_ecmwf.f90
+++ b/src/MNH/ini_radiations_ecmwf.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ##########################
@@ -9,16 +9,13 @@
!
INTERFACE
!
- SUBROUTINE INI_RADIATIONS_ECMWF(HINIFILE,HLUOUT, &
- PZHAT,PPABST,PTHT,PTSRAD,PLAT,PLON,TPDTCUR,TPDTEXP, &
- HLW,KDLON,KFLEV,KFLUX,KRAD,KSWB,HAER,KAER,KSTATM, &
- PSTATM,PSEA,PTOWN,PBARE,POZON, PAER,PDST_WL, OSUBG_COND )
+ SUBROUTINE INI_RADIATIONS_ECMWF( &
+ PZHAT, PPABST, PTHT, PTSRAD, PLAT, PLON, TPDTCUR, TPDTEXP, &
+ HLW, KDLON, KFLEV, KFLUX, KRAD, KSWB, HAER, KAER, KSTATM, &
+ PSTATM, PSEA, PTOWN, PBARE, POZON, PAER, PDST_WL, OSUBG_COND )
!
USE MODD_TYPE_DATE
!
-CHARACTER (LEN=*), INTENT(IN) :: HINIFILE ! Name of the initial file
-CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! name for output-listing
- ! of nested models
CHARACTER (LEN=*), INTENT(IN) :: HAER ! aerosol optical thickness climatology
CHARACTER (LEN=4), INTENT(IN) :: HLW ! LW scheme used
!
@@ -60,12 +57,12 @@ END INTERFACE
END MODULE MODI_INI_RADIATIONS_ECMWF
!
!
-! #######################################################################
- SUBROUTINE INI_RADIATIONS_ECMWF(HINIFILE,HLUOUT, &
- PZHAT,PPABST,PTHT,PTSRAD,PLAT,PLON,TPDTCUR,TPDTEXP, &
- HLW,KDLON,KFLEV,KFLUX,KRAD,KSWB,HAER,KAER,KSTATM, &
- PSTATM,PSEA,PTOWN,PBARE,POZON, PAER, PDST_WL,OSUBG_COND )
-! #######################################################################
+! ###################################################################
+ SUBROUTINE INI_RADIATIONS_ECMWF( &
+ PZHAT, PPABST, PTHT, PTSRAD, PLAT, PLON, TPDTCUR, TPDTEXP, &
+ HLW, KDLON, KFLEV, KFLUX, KRAD, KSWB, HAER, KAER, KSTATM, &
+ PSTATM, PSEA, PTOWN, PBARE, POZON, PAER, PDST_WL, OSUBG_COND )
+! ###################################################################
!
!!**** *INI_RADIATIONS * - initialisation for ECMWF radiation scheme in the MesoNH framework
!!
@@ -173,6 +170,8 @@ END MODULE MODI_INI_RADIATIONS_ECMWF
!! (V. Masson) replaces cover fractions by sea/town/bare soil fractions
!! J.Escobar 30/03/2017 : Management of compilation of ECMWF_RAD in REAL*8 with MNH_REAL=R4
!! 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
+! P. Wautelet 14/02/2019: remove HINIFILE dummy argument
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -197,7 +196,6 @@ USE MODD_STAND_ATM
USE MODD_PARAM_RAD_n, ONLY: LFIX_DAT
!
USE MODE_ll
-USE MODE_FM
!
USE MODI_INI_RADCONF
USE MODI_INI_HOR_AERCLIM
@@ -216,9 +214,6 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-CHARACTER (LEN=*), INTENT(IN) :: HINIFILE ! Name of the initial file
-CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! name for output-listing
- ! of nested models
CHARACTER (LEN=*), INTENT(IN) :: HAER ! aerosol optical thickness climatology
CHARACTER (LEN=4), INTENT(IN) :: HLW ! LW scheme used
!
diff --git a/src/MNH/ini_radiations_ecrad.f90 b/src/MNH/ini_radiations_ecrad.f90
index f4115e2c50051aef4b45356df3a2be8934278461..6b3fdd2f29a1ccbc12b22ffb546171d5948c1781 100644
--- a/src/MNH/ini_radiations_ecrad.f90
+++ b/src/MNH/ini_radiations_ecrad.f90
@@ -1,29 +1,21 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2018-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 BUG1 2007/06/15 17:47:18
-!-----------------------------------------------------------------
! ##########################
MODULE MODI_INI_RADIATIONS_ECRAD
! ##########################
!
INTERFACE
!
- SUBROUTINE INI_RADIATIONS_ECRAD(HINIFILE,HLUOUT, &
- PZHAT,PPABST,PTHT,PTSRAD,PLAT,PLON,TPDTCUR,TPDTEXP, &
- HLW,KDLON,KFLEV,KFLUX,KRAD,KSWB_OLD,HAER,KAER,KSTATM, &
- PSTATM,PSEA,PTOWN,PBARE,POZON, PAER,PDST_WL, OSUBG_COND )
+ SUBROUTINE INI_RADIATIONS_ECRAD( &
+ PZHAT, PPABST, PTHT, PTSRAD, PLAT, PLON, TPDTCUR, TPDTEXP, &
+ HLW, KDLON, KFLEV, KFLUX, KRAD, KSWB_OLD, HAER, KAER, KSTATM, &
+ PSTATM, PSEA, PTOWN, PBARE, POZON, PAER, PDST_WL, OSUBG_COND )
!
USE MODD_TYPE_DATE
-CHARACTER (LEN=*), INTENT(IN) :: HINIFILE ! Name of the initial file
-CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! name for output-listing
- ! of nested models
CHARACTER (LEN=*), INTENT(IN) :: HAER ! aerosol optical thickness climatology
CHARACTER (LEN=4), INTENT(IN) :: HLW ! LW scheme used
!
@@ -65,12 +57,12 @@ END INTERFACE
END MODULE MODI_INI_RADIATIONS_ECRAD
!
!
-! #######################################################################
- SUBROUTINE INI_RADIATIONS_ECRAD(HINIFILE,HLUOUT, &
- PZHAT,PPABST,PTHT,PTSRAD,PLAT,PLON,TPDTCUR,TPDTEXP, &
- HLW,KDLON,KFLEV,KFLUX,KRAD,KSWB_OLD,HAER,KAER,KSTATM, &
- PSTATM,PSEA,PTOWN,PBARE,POZON, PAER,PDST_WL, OSUBG_COND )
-! #######################################################################
+! ####################################################################
+ SUBROUTINE INI_RADIATIONS_ECRAD( &
+ PZHAT, PPABST, PTHT, PTSRAD, PLAT, PLON, TPDTCUR, TPDTEXP, &
+ HLW, KDLON, KFLEV, KFLUX, KRAD, KSWB_OLD, HAER, KAER, KSTATM, &
+ PSTATM, PSEA, PTOWN, PBARE, POZON, PAER, PDST_WL, OSUBG_COND )
+! ####################################################################
!
! INI_RADIATIONS_ECRAD - Initialization of ECRAD code
!
@@ -92,8 +84,8 @@ END MODULE MODI_INI_RADIATIONS_ECRAD
! MODIFICATIONS
! -------------
!
-! TO DO
-
+! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
+! P. Wautelet 14/02/2019: remove HINIFILE dummy argument
!
!* 0. DECLARATIONS
! ------------
@@ -122,9 +114,6 @@ IMPLICIT NONE
!* 0.1 Declarations of dummy arguments :
!
-CHARACTER (LEN=*), INTENT(IN) :: HINIFILE ! Name of the initial file
-CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! name for output-listing
- ! of nested models
CHARACTER (LEN=*), INTENT(IN) :: HAER ! aerosol optical thickness climatology
CHARACTER (LEN=4), INTENT(IN) :: HLW ! LW scheme used
!
@@ -164,10 +153,10 @@ LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for sub-grid condensation
NULOUT = TLUOUT%NLU
! Initialization of ECMWF still neede because many things intialized through this routine
-CALL INI_RADIATIONS_ECMWF (HINIFILE,HLUOUT, &
- PZHAT,PPABST,PTHT,PTSRAD,PLAT,PLON,TPDTCUR,TPDTEXP, &
- HLW,KDLON,KFLEV,KFLUX,KRAD,KSWB_OLD,HAER,KAER,KSTATM, &
- PSTATM,PSEA,PTOWN,PBARE,POZON, PAER,PDST_WL, OSUBG_COND )
+CALL INI_RADIATIONS_ECMWF( &
+ PZHAT, PPABST, PTHT, PTSRAD, PLAT, PLON, TPDTCUR, TPDTEXP, &
+ HLW, KDLON, KFLEV, KFLUX, KRAD, KSWB_OLD, HAER, KAER, KSTATM, &
+ PSTATM, PSEA, PTOWN, PBARE, POZON, PAER, PDST_WL, OSUBG_COND )
! ECRAD specific variables
diff --git a/src/MNH/ini_rain_ice.f90 b/src/MNH/ini_rain_ice.f90
index 530ad47cd653b1c9b7e8aa16f902217c1d2fd3f0..9420cb1e70b58ae82df107fe0ca894915dcb8da9 100644
--- a/src/MNH/ini_rain_ice.f90
+++ b/src/MNH/ini_rain_ice.f90
@@ -107,7 +107,6 @@ END MODULE MODI_INI_RAIN_ICE
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FM
USE MODD_CST
USE MODD_LUNIT
USE MODD_PARAMETERS
diff --git a/src/MNH/ini_rain_ice_elec.f90 b/src/MNH/ini_rain_ice_elec.f90
index 15721ada47ba4f811d5f9c40c7af037c9e175cb5..d352581f8345e2060623700af764e3be4a43d20a 100644
--- a/src/MNH/ini_rain_ice_elec.f90
+++ b/src/MNH/ini_rain_ice_elec.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 BUG1 2007/06/15 17:47:18
-!-----------------------------------------------------------------
! #############################
MODULE MODI_INI_RAIN_ICE_ELEC
! #############################
@@ -97,7 +92,6 @@ END MODULE MODI_INI_RAIN_ICE_ELEC
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FM
USE MODD_CST
USE MODD_LUNIT
USE MODD_PARAMETERS
diff --git a/src/MNH/ini_segn.f90 b/src/MNH/ini_segn.f90
index a41ba0c466abec963d243764f448d664ae3a4a61..0abca384483c4f456109dc3b57d45dbd7a1a4dfd 100644
--- a/src/MNH/ini_segn.f90
+++ b/src/MNH/ini_segn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -9,12 +9,11 @@
!
INTERFACE
!
-SUBROUTINE INI_SEG_n(KMI,HLUOUT,TPINIFILE,HINIFILEPGD,PTSTEP_ALL)
+SUBROUTINE INI_SEG_n(KMI,TPINIFILE,HINIFILEPGD,PTSTEP_ALL)
!
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY : TFILEDATA
!
INTEGER, INTENT(IN) :: KMI !Model index
-CHARACTER (LEN=*), INTENT(OUT) :: HLUOUT !Name for output-listing of nested models
TYPE(TFILEDATA), POINTER, INTENT(OUT) :: TPINIFILE !Initial file
CHARACTER (LEN=28), INTENT(OUT) :: HINIFILEPGD
REAL,DIMENSION(:), INTENT(INOUT) :: PTSTEP_ALL ! Time STEP of ALL models
@@ -29,7 +28,7 @@ END MODULE MODI_INI_SEG_n
!
!
! #############################################################
- SUBROUTINE INI_SEG_n(KMI,HLUOUT,TPINIFILE,HINIFILEPGD,PTSTEP_ALL)
+ SUBROUTINE INI_SEG_n(KMI,TPINIFILE,HINIFILEPGD,PTSTEP_ALL)
! #############################################################
!
!!**** *INI_SEG_n * - routine to read and update the descriptor files for
@@ -74,7 +73,7 @@ END MODULE MODI_INI_SEG_n
!! The name of the initial file is read in EXSEG file.
!! - Default values are supplied for variables in descriptor files
!! (by DEFAULT_DESFM).
-!! - The Initial file (LFIFM + DESFM) is opened by IO_FILE_OPEN_ll.
+!! - The Initial file (LFIFM + DESFM) is opened by IO_File_open.
!! - The descriptor DESFM file is read (by READ_DESFM_n).
!! - The descriptor file EXSEG is read (by READ_EXSEG_n) and coherence
!! between the initial file and the description of segment is also checked
@@ -91,7 +90,7 @@ END MODULE MODI_INI_SEG_n
!! EXTERNAL
!! --------
!! FMATTR : to associate a logical unit number to a file
-!! IO_FILE_OPEN_ll : to open descriptor file or LFI file
+!! IO_File_open : to open descriptor file or LFI file
!! DEFAULT_DESFM1: to set default values
!! READ_DESFM_n : to read a DESFM file
!! READ_EXSEG_n : to read a EXSEG file
@@ -163,6 +162,8 @@ END MODULE MODI_INI_SEG_n
!! 04/2016 add ABORT if CINIFILEPGD is not specified (G.Delautier)
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! 07/2017 add GBLOWSNOW (V. Vionnet)
+! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -171,7 +172,7 @@ USE MODD_CONF
USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
USE MODN_CONFZ
USE MODD_DYN
-USE MODD_IO_ll, ONLY: NVERB_FATAL,NVERB_WARNING,TFILE_OUTPUTLISTING,TFILEDATA
+USE MODD_IO, ONLY: NVERB_FATAL, NVERB_WARNING, TFILE_OUTPUTLISTING, TFILEDATA
USE MODD_LUNIT
USE MODD_LUNIT_n, ONLY: CINIFILE_n=> CINIFILE, TINIFILE_n => TINIFILE, CINIFILEPGD_n=> CINIFILEPGD, TLUOUT, LUNIT_MODEL
USE MODD_PARAM_n, ONLY: CSURF
@@ -179,10 +180,10 @@ USE MODD_PARAMETERS
USE MODD_REF, ONLY: LBOUSS
!
USE MODE_FIELD
-USE MODE_FMREAD
-USE MODE_FM, ONLY: IO_FILE_CLOSE_ll, IO_FILE_OPEN_ll
-USE MODE_IO_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST
+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
+USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list
USE MODE_MSG
USE MODE_POS
!
@@ -199,7 +200,6 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
INTEGER, INTENT(IN) :: KMI !Model index
-CHARACTER (LEN=*), INTENT(OUT) :: HLUOUT !Name for output-listing of nested models
TYPE(TFILEDATA), POINTER, INTENT(OUT) :: TPINIFILE !Initial file
CHARACTER (LEN=28), INTENT(OUT) :: HINIFILEPGD
REAL,DIMENSION(:), INTENT(INOUT) :: PTSTEP_ALL ! Time STEP of ALL models
@@ -210,7 +210,7 @@ LOGICAL :: GFOUND ! Return code when searching namelist
CHARACTER (LEN=28) :: YINIFILE ! name of initial file
CHARACTER (LEN=2) :: YMI ! string for model index
INTEGER :: ILUOUT ! Logical unit number
- ! associated with CLUOUT
+ ! associated with TLUOUT
!
INTEGER :: IRESP,ILUSEG ! File management variables
CHARACTER (LEN=5) :: YCONF ! Local variables which have
@@ -259,10 +259,9 @@ TZFILE_DES => NULL()
! ---------------------------------------
!
WRITE(YMI,'(I2.0)') KMI
-HLUOUT='OUTPUT_LISTING'//ADJUSTL(YMI)
-CALL IO_FILE_ADD2LIST(LUNIT_MODEL(KMI)%TLUOUT,HLUOUT,'OUTPUTLISTING','WRITE')
+CALL IO_File_add2list(LUNIT_MODEL(KMI)%TLUOUT,'OUTPUT_LISTING'//ADJUSTL(YMI),'OUTPUTLISTING','WRITE')
TLUOUT => LUNIT_MODEL(KMI)%TLUOUT !Necessary because TLUOUT was initially pointing to NULL
-CALL IO_FILE_OPEN_ll(TLUOUT)
+CALL IO_File_open(TLUOUT)
!
!Set output file for PRINT_MSG
TFILE_OUTPUTLISTING => TLUOUT
@@ -273,8 +272,8 @@ WRITE(UNIT=ILUOUT,FMT='(50("*"),/,"*",17X,"MODEL ",I1," LISTING",16X,"*",/, &
& 50("*"))') KMI
!
IF (CPROGRAM=='MESONH') THEN
- CALL IO_FILE_ADD2LIST(TZFILE_DES,'EXSEG'//TRIM(ADJUSTL(YMI))//'.nam','NML','READ')
- CALL IO_FILE_OPEN_ll(TZFILE_DES)
+ CALL IO_File_add2list(TZFILE_DES,'EXSEG'//TRIM(ADJUSTL(YMI))//'.nam','NML','READ')
+ CALL IO_File_open(TZFILE_DES)
!
!* 1.3 SPAWNING or SPEC or REAL program case
! ---------------------
@@ -282,8 +281,8 @@ IF (CPROGRAM=='MESONH') THEN
ELSE IF (CPROGRAM=='SPAWN ' .OR. CPROGRAM=='REAL '.OR. CPROGRAM=='SPEC ') THEN
YINIFILE = CINIFILE_n
HINIFILEPGD = CINIFILEPGD_n
- CALL IO_FILE_ADD2LIST(TPINIFILE,TRIM(YINIFILE),'UNKNOWN','READ',KLFITYPE=2,KLFIVERB=NVERB)
- CALL IO_FILE_OPEN_ll(TPINIFILE)
+ CALL IO_File_add2list(TPINIFILE,TRIM(YINIFILE),'MNH','READ',KLFITYPE=2,KLFIVERB=NVERB)
+ CALL IO_File_open(TPINIFILE)
TZFILE_DES => TPINIFILE%TDESFILE
!
!* 1.3bis DIAG program case
@@ -291,8 +290,8 @@ ELSE IF (CPROGRAM=='SPAWN ' .OR. CPROGRAM=='REAL '.OR. CPROGRAM=='SPEC ') THEN
ELSE IF (CPROGRAM=='DIAG ') THEN
YINIFILE = CINIFILE_n
HINIFILEPGD = CINIFILEPGD_n
- CALL IO_FILE_ADD2LIST(TINIFILE_n,TRIM(YINIFILE),'UNKNOWN','READ',KLFITYPE=2,KLFIVERB=NVERB)
- CALL IO_FILE_OPEN_ll(TINIFILE_n)
+ CALL IO_File_add2list(TINIFILE_n,TRIM(YINIFILE),'MNH','READ',KLFITYPE=2,KLFIVERB=NVERB)
+ CALL IO_File_open(TINIFILE_n)
TPINIFILE => TINIFILE_n
TZFILE_DES => TPINIFILE%TDESFILE
!
@@ -335,14 +334,14 @@ IF (CPROGRAM=='MESONH') THEN
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONFZ)
CALL POSNAM(ILUSEG,'NAM_CONFIO',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONFIO)
- CALL SET_CONFIO_ll()
+ CALL IO_Config_set()
END IF
HINIFILEPGD=CINIFILEPGD_n
YINIFILE=CINIFILE_n
- CALL IO_FILE_ADD2LIST(TPINIFILE,TRIM(YINIFILE),'PREPIDEALCASE','READ',KLFITYPE=2,KLFIVERB=NVERB)
+ CALL IO_File_add2list(TPINIFILE,TRIM(YINIFILE),'MNH','READ',KLFITYPE=2,KLFIVERB=NVERB)
TINIFILE_n => TPINIFILE !Necessary because TINIFILE was initially pointing to NULL
- CALL IO_FILE_OPEN_ll(TPINIFILE)
+ CALL IO_File_open(TPINIFILE)
END IF
!
!-------------------------------------------------------------------------------
@@ -385,7 +384,7 @@ END IF
!
IF (CPROGRAM=='MESONH' .OR. CPROGRAM=='SPAWN ') THEN
IF ((TPINIFILE%NMNHVERSION(1)==4 .AND. TPINIFILE%NMNHVERSION(2)>9) .OR. TPINIFILE%NMNHVERSION(1)>4) THEN
- CALL IO_READ_FIELD(TPINIFILE,'COUPLING',LCOUPLING)
+ CALL IO_Field_read(TPINIFILE,'COUPLING',LCOUPLING)
IF (LCOUPLING) THEN
WRITE(ILUOUT,*) 'Error with the initial file'
WRITE(ILUOUT,*) 'The file',YINIFILE,' was created with LCOUPLING=.TRUE.'
@@ -398,7 +397,7 @@ IF (CPROGRAM=='MESONH' .OR. CPROGRAM=='SPAWN ') THEN
END IF
!
! Read the storage type
- CALL IO_READ_FIELD(TPINIFILE,'STORAGE_TYPE',CSTORAGE_TYPE,IRESP)
+ CALL IO_Field_read(TPINIFILE,'STORAGE_TYPE',CSTORAGE_TYPE,IRESP)
IF (IRESP /= 0) THEN
WRITE(ILUOUT,FMT=9002) 'STORAGE_TYPE',IRESP
!callabortstop
@@ -406,18 +405,18 @@ END IF
END IF
IF (KMI == 1) THEN
! Read the geometry kind
- CALL IO_READ_FIELD(TPINIFILE,'CARTESIAN',LCARTESIAN)
+ CALL IO_Field_read(TPINIFILE,'CARTESIAN',LCARTESIAN)
! Read the thinshell approximation
- CALL IO_READ_FIELD(TPINIFILE,'THINSHELL',LTHINSHELL)
+ CALL IO_Field_read(TPINIFILE,'THINSHELL',LTHINSHELL)
!
IF ((TPINIFILE%NMNHVERSION(1)==4 .AND. TPINIFILE%NMNHVERSION(2)>=6) .OR. TPINIFILE%NMNHVERSION(1)>4) THEN
- CALL IO_READ_FIELD(TPINIFILE,'L1D',L1D,IRESP)
+ CALL IO_Field_read(TPINIFILE,'L1D',L1D,IRESP)
IF (IRESP/=0) L1D=.FALSE.
!
- CALL IO_READ_FIELD(TPINIFILE,'L2D',L2D,IRESP)
+ CALL IO_Field_read(TPINIFILE,'L2D',L2D,IRESP)
IF (IRESP/=0) L2D=.FALSE.
!
- CALL IO_READ_FIELD(TPINIFILE,'PACK',LPACK,IRESP)
+ CALL IO_Field_read(TPINIFILE,'PACK',LPACK,IRESP)
IF (IRESP/=0) LPACK=.TRUE.
ELSE
L1D=.FALSE.
@@ -425,7 +424,7 @@ IF (KMI == 1) THEN
LPACK=.TRUE.
END IF
IF ((TPINIFILE%NMNHVERSION(1)==4 .AND. TPINIFILE%NMNHVERSION(2)>=10) .OR. TPINIFILE%NMNHVERSION(1)>4) THEN
- CALL IO_READ_FIELD(TPINIFILE,'LBOUSS',LBOUSS)
+ CALL IO_Field_read(TPINIFILE,'LBOUSS',LBOUSS)
END IF
!
END IF
@@ -468,7 +467,7 @@ END IF
!* 7. CLOSE FILES
! ------------
!
-IF (CPROGRAM=='MESONH') CALL IO_FILE_CLOSE_ll(TZFILE_DES)
+IF (CPROGRAM=='MESONH') CALL IO_File_close(TZFILE_DES)
!
!-------------------------------------------------------------------------------
9002 FORMAT(/,'FATAL ERROR IN INI_SEG_n: pb to read ',A16,' IRESP=',I3)
diff --git a/src/MNH/ini_seriesn.f90 b/src/MNH/ini_seriesn.f90
index e584ca73acf10439edaa0badeeb3161dd382ccd3..cff938acec58cfe8b8f51d92758aafbd7d6db3ef 100644
--- a/src/MNH/ini_seriesn.f90
+++ b/src/MNH/ini_seriesn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 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.
!-----------------------------------------------------------------
! ########################
@@ -40,6 +40,8 @@
!! June 2016: P. Wautelet: corrected writes
!! Nov. 2017: J.-P. Chaboureau: fix a bug in dimension check
!! 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
!!
!-------------------------------------------------------------------------------
!
@@ -47,7 +49,6 @@
! --------------
!
USE MODE_ll
-USE MODE_IO_ll
USE MODE_MSG
USE MODE_MODELN_HANDLER
!
@@ -74,6 +75,7 @@ IMPLICIT NONE
!
!* 0.2 Local variables
!
+character(len=10) :: yval1, yval2 ! Strings for error messages
REAL, DIMENSION(:,:), ALLOCATABLE :: ZSEA !sea/ocean fraction
LOGICAL :: GMASKLANDSEA ! local for LMASKLANDSEA
INTEGER :: IIMAX_ll ! total physical domain I size
@@ -142,8 +144,7 @@ IF ( ( NFREQSERIES*XTSTEP < XSEGLEN ) .AND. &
WRITE(ILUOUT,FMT=*) ' NKCLS,NKCLA,NKLOW,NKMID,NKUP= ', &
NKCLS,NKCLA,NKLOW,NKMID,NKUP
WRITE(ILUOUT,FMT=*) '**********************************************'
-!callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_SERIES_n','')
+ call Print_msg( NVERB_FATAL, 'GEN', 'INI_SERIES_n', 'incompatible dimensions' )
END IF
!
ALLOCATE(LINBOX(IIU,IJU))
@@ -178,8 +179,7 @@ IF (NBJSLICE > 0 ) THEN
WRITE(UNIT=ILUOUT,FMT=*) 'STOP in INI_SERIESn: VOID INTERSECTION for slice ',JJ
WRITE(ILUOUT,*) ' NJSLICEL=', NJSLICEL(JJ),'NJSLICEH=',NJSLICEH(JJ)
WRITE(ILUOUT,*) ' NISL=',NISL(JJ),'NJSLICESL=',NJSLICESL(JJ),'NISH=',NISH(JJ),'NJSLICESH=',NJSLICESH(JJ)
-!callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_SERIES_n','')
+ call Print_msg( NVERB_FATAL, 'GEN', 'INI_SERIES_n', 'void intersection' )
END IF
WRITE(UNIT=ILUOUT,FMT=*) 'INI_SERIESn: intersection with slice ',JJ
ELSE ! the intersection is void
@@ -321,37 +321,37 @@ 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'
- ISB1=ISB1+1 ; CSTITLE1(ISB1)='ACPRT'//YSUF(JI) ; CSUNIT1(ISB1)='MM'
+ ISB1=ISB1+1 ; CSTITLE1(ISB1)='INPRT'//YSUF(JI) ; CSUNIT1(ISB1)='mm day-1'
+ ISB1=ISB1+1 ; CSTITLE1(ISB1)='ACPRT'//YSUF(JI) ; CSUNIT1(ISB1)='mm'
END IF
! Mixing ratios
IF (LUSERV) THEN
- ISB1=ISB1+1 ; CSTITLE1(ISB1)='RVT'//YSUF(JI) ; CSUNIT1(ISB1)='KG/M2'
+ ISB1=ISB1+1 ; CSTITLE1(ISB1)='RVT'//YSUF(JI) ; CSUNIT1(ISB1)='kg m-2'
END IF
IF (LUSERC) THEN
- ISB1=ISB1+1 ; CSTITLE1(ISB1)='RCT'//YSUF(JI) ; CSUNIT1(ISB1)='KG/M2'
+ ISB1=ISB1+1 ; CSTITLE1(ISB1)='RCT'//YSUF(JI) ; CSUNIT1(ISB1)='kg m-2'
END IF
IF (LUSERR) THEN
- ISB1=ISB1+1 ; CSTITLE1(ISB1)='RRT'//YSUF(JI) ; CSUNIT1(ISB1)='KG/M2'
+ ISB1=ISB1+1 ; CSTITLE1(ISB1)='RRT'//YSUF(JI) ; CSUNIT1(ISB1)='kg m-2'
ENDIF
IF (LUSERI) THEN
- ISB1=ISB1+1 ; CSTITLE1(ISB1)='RIT'//YSUF(JI) ; CSUNIT1(ISB1)='KG/M2'
+ ISB1=ISB1+1 ; CSTITLE1(ISB1)='RIT'//YSUF(JI) ; CSUNIT1(ISB1)='kg m-2'
END IF
IF (LUSERS) THEN
- ISB1=ISB1+1 ; CSTITLE1(ISB1)='RST'//YSUF(JI) ; CSUNIT1(ISB1)='KG/M2'
+ ISB1=ISB1+1 ; CSTITLE1(ISB1)='RST'//YSUF(JI) ; CSUNIT1(ISB1)='kg m-2'
END IF
IF (LUSERG) THEN
- ISB1=ISB1+1 ; CSTITLE1(ISB1)='RGT'//YSUF(JI) ; CSUNIT1(ISB1)='KG/M2'
+ ISB1=ISB1+1 ; CSTITLE1(ISB1)='RGT'//YSUF(JI) ; CSUNIT1(ISB1)='kg m-2'
END IF
IF (LUSERH) THEN
- ISB1=ISB1+1 ; CSTITLE1(ISB1)='RHT'//YSUF(JI) ; CSUNIT1(ISB1)='KG/M2'
+ ISB1=ISB1+1 ; CSTITLE1(ISB1)='RHT'//YSUF(JI) ; CSUNIT1(ISB1)='kg m-2'
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)='-'
+ ISB1=ISB1+1 ; CSTITLE1(ISB1)='CT_WATER'//YSUF(JI) ; CSUNIT1(ISB1)='1'
ISB1=ISB1+1 ; CSTITLE1(ISB1)='HML_WATER'//YSUF(JI) ; CSUNIT1(ISB1)='m'
ENDIF
! end SURFACE FIELDS
@@ -360,19 +360,18 @@ 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' ; NSGRIDD1(ISB1)=4
+ ISB1=ISB1+1 ; CSTITLE1(ISB1)='WMAX'//YSUF(JI) ; CSUNIT1(ISB1)='m s-1' ; NSGRIDD1(ISB1)=4
! Min of vertical speed
- ISB1=ISB1+1 ; CSTITLE1(ISB1)='WMIN'//YSUF(JI) ; CSUNIT1(ISB1)='M/S' ; NSGRIDD1(ISB1)=4
+ ISB1=ISB1+1 ; CSTITLE1(ISB1)='WMIN'//YSUF(JI) ; CSUNIT1(ISB1)='m s-1' ; NSGRIDD1(ISB1)=4
END DO
END IF
!
-IF (ISB1.NE.NSTEMP_SERIE1) THEN
- WRITE(ILUOUT,FMT=*) 'STOP in INI_SERIESn:'
- WRITE(UNIT=ILUOUT,FMT=*) ' NUMBER OF SERIES1 DIFFERS FROM ALLOC, ISB1=', &
- ISB1,' NSTEMP_SERIE1=',NSTEMP_SERIE1
-!callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_SERIES_n','')
-END IF
+if ( isb1 /= nstemp_serie1 ) then
+ write( yval1, '( I10 )' ) isb1
+ write( yval2, '( I10 )' ) nstemp_serie1
+ call Print_msg( NVERB_FATAL, 'GEN', 'INI_SERIES_n', 'number of series1 differs from alloc: isb1='// &
+ trim(yval1)//' nstemp_serie1='//trim(yval2) )
+end if
!
!* 2.2 Temporal series (z,t)
! ---------------------
@@ -387,39 +386,38 @@ NSGRIDD2(:)=1
ISB2=0
DO JI=1,ISER
! Vertical velocity
- ISB2=ISB2+1 ; CSTITLE2(ISB2)='WT'//YSUF(JI) ; CSUNIT2(ISB2)='M/S' ; NSGRIDD2(ISB2)=4
+ ISB2=ISB2+1 ; CSTITLE2(ISB2)='WT'//YSUF(JI) ; CSUNIT2(ISB2)='m s-1' ; NSGRIDD2(ISB2)=4
! Potential temperature
ISB2=ISB2+1 ; CSTITLE2(ISB2)='THT'//YSUF(JI) ; CSUNIT2(ISB2)='K'
! Pressure
ISB2=ISB2+1 ; CSTITLE2(ISB2)='PABST'//YSUF(JI) ; CSUNIT2(ISB2)='Pa'
! Mixing ratios
IF (LUSERV) THEN
- ISB2=ISB2+1 ; CSTITLE2(ISB2)='RVT'//YSUF(JI) ; CSUNIT2(ISB2)='KG/KG'
+ ISB2=ISB2+1 ; CSTITLE2(ISB2)='RVT'//YSUF(JI) ; CSUNIT2(ISB2)='kg kg-1'
END IF
IF (LUSERC) THEN
- ISB2=ISB2+1 ; CSTITLE2(ISB2)='RCT'//YSUF(JI) ; CSUNIT2(ISB2)='KG/KG'
+ ISB2=ISB2+1 ; CSTITLE2(ISB2)='RCT'//YSUF(JI) ; CSUNIT2(ISB2)='kg kg-1'
END IF
IF (LUSERR) THEN
- ISB2=ISB2+1 ; CSTITLE2(ISB2)='RRT'//YSUF(JI) ; CSUNIT2(ISB2)='KG/KG'
+ ISB2=ISB2+1 ; CSTITLE2(ISB2)='RRT'//YSUF(JI) ; CSUNIT2(ISB2)='kg kg-1'
END IF
IF (LUSERI) THEN
- ISB2=ISB2+1 ; CSTITLE2(ISB2)='RIT'//YSUF(JI) ; CSUNIT2(ISB2)='KG/KG'
+ ISB2=ISB2+1 ; CSTITLE2(ISB2)='RIT'//YSUF(JI) ; CSUNIT2(ISB2)='kg kg-1'
END IF
IF (LUSERS) THEN
- ISB2=ISB2+1 ; CSTITLE2(ISB2)='RST'//YSUF(JI) ; CSUNIT2(ISB2)='KG/KG'
+ ISB2=ISB2+1 ; CSTITLE2(ISB2)='RST'//YSUF(JI) ; CSUNIT2(ISB2)='kg kg-1'
END IF
IF (LUSERG) THEN
- ISB2=ISB2+1 ; CSTITLE2(ISB2)='RGT'//YSUF(JI) ; CSUNIT2(ISB2)='KG/KG'
+ ISB2=ISB2+1 ; CSTITLE2(ISB2)='RGT'//YSUF(JI) ; CSUNIT2(ISB2)='kg kg-1'
END IF
END DO
!
-IF (ISB2.NE.NSTEMP_SERIE2) THEN
- WRITE(ILUOUT,FMT=*) 'STOP in INI_SERIESn:'
- WRITE(ILUOUT,FMT=*) ' NUMBER OF SERIES2 DIFFERS FROM ALLOC, ISB2=',ISB2, &
- ' NSTEMP_SERIE2=',NSTEMP_SERIE2
-!callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_SERIES_n','')
-END IF
+if ( isb2 /= nstemp_serie2 ) then
+ write( yval1, '( I10 )' ) isb2
+ write( yval2, '( I10 )' ) nstemp_serie2
+ call Print_msg( NVERB_FATAL, 'GEN', 'INI_SERIES_n', 'number of series2 differs from alloc: isb2='// &
+ trim(yval1)//' nstemp_serie2='//trim(yval2) )
+end if
!
!* 2.3 Temporal series (x,t)
!
@@ -440,34 +438,33 @@ NSGRIDD3(:)=1
ISB3=0
!
! U in CLS
-ISB3=ISB3+1; CSTITLE3(ISB3)='UCLS'//CSKCLS ; CSUNIT3(ISB3)='M/S' ; NSGRIDD3(ISB3)=2
+ISB3=ISB3+1; CSTITLE3(ISB3)='UCLS'//CSKCLS ; CSUNIT3(ISB3)='m s-1' ; NSGRIDD3(ISB3)=2
! W in CLA
-ISB3=ISB3+1; CSTITLE3(ISB3)='WCLA'//CSKCLA ; CSUNIT3(ISB3)='M/S' ; NSGRIDD3(ISB3)=4
+ISB3=ISB3+1; CSTITLE3(ISB3)='WCLA'//CSKCLA ; CSUNIT3(ISB3)='m s-1' ; NSGRIDD3(ISB3)=4
! W averaged in mid troposphere (between KLOW and KUP)
-ISB3=ISB3+1; CSTITLE3(ISB3)='W' //CSKLOW//'-'//CSKUP ; CSUNIT3(ISB3) ='M/S' ; NSGRIDD3(ISB3)=4
+ISB3=ISB3+1; CSTITLE3(ISB3)='W' //CSKLOW//'-'//CSKUP ; CSUNIT3(ISB3) ='m s-1' ; NSGRIDD3(ISB3)=4
! mixing ratios
IF (LUSERV) THEN
! RV in CLS
- ISB3=ISB3+1; CSTITLE3(ISB3)='RVCLS'//CSKCLS ; CSUNIT3(ISB3)='KG/KG'
+ ISB3=ISB3+1; CSTITLE3(ISB3)='RVCLS'//CSKCLS ; CSUNIT3(ISB3)='kg kg-1'
! RV in MID troposphere
- ISB3=ISB3+1; CSTITLE3(ISB3)='RVMID'//CSKMID ; CSUNIT3(ISB3)='KG/KG'
+ ISB3=ISB3+1; CSTITLE3(ISB3)='RVMID'//CSKMID ; CSUNIT3(ISB3)='kg kg-1'
END IF
IF (LUSERC) THEN
! RC averaged between ground and KUP
- ISB3=ISB3+1 ; CSTITLE3(ISB3)='RC'//'0-'//CSKUP ; CSUNIT3(ISB3)='KG/KG'
+ ISB3=ISB3+1 ; CSTITLE3(ISB3)='RC'//'0-'//CSKUP ; CSUNIT3(ISB3)='kg kg-1'
END IF
IF (LUSERR) THEN
! RR in CLS
- ISB3=ISB3+1 ; CSTITLE3(ISB3)='RR'//CSKCLS ; CSUNIT3(ISB3)='KG/KG'
+ ISB3=ISB3+1 ; CSTITLE3(ISB3)='RR'//CSKCLS ; CSUNIT3(ISB3)='kg kg-1'
END IF
!
-IF (ISB3.NE.NSTEMP_SERIE3) THEN
- WRITE(ILUOUT,FMT=*) 'STOP in INI_SERIESn:'
- WRITE(ILUOUT,FMT=*) ' NUMBER OF SERIES3 DIFFERS FROM ALLOC, ISB3=',ISB3, &
- ' NTEMP_SERIE3=',NSTEMP_SERIE3
-!callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_SERIES_n','')
-END IF
+if ( isb3 /= nstemp_serie3 ) then
+ write( yval1, '( I10 )' ) isb3
+ write( yval2, '( I10 )' ) nstemp_serie3
+ call Print_msg( NVERB_FATAL, 'GEN', 'INI_SERIES_n', 'number of series3 differs from alloc: isb3='// &
+ trim(yval1)//' nstemp_serie3='//trim(yval2) )
+end if
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/ini_size_spawn.f90 b/src/MNH/ini_size_spawn.f90
index ad4c604b06ac09cf053b8dada638f493b1af0413..ee52cc7b68825da6ae3270e567c7a01007378490 100644
--- a/src/MNH/ini_size_spawn.f90
+++ b/src/MNH/ini_size_spawn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -11,7 +11,7 @@ INTERFACE
!
SUBROUTINE INI_SIZE_SPAWN(HLBCX,HLBCY,HPRESOPT,KITR,TPINIFILE)
!
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY : TFILEDATA
!
CHARACTER (LEN=4),DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! LBC types for model1
CHARACTER (LEN=5), INTENT(IN) :: HPRESOPT ! Pressure solver option of model1
@@ -44,9 +44,9 @@ END MODULE MODI_INI_SIZE_SPAWN
!! EXTERNAL
!! --------
!! DEFAULT_DESFM2
-!! IO_FILE_OPEN_ll
+!! IO_File_open
!! READ_HGRID
-!! IO_FILE_CLOSE_ll
+!! IO_File_close
!! RETRIEVE_NEST_INFO
!!
!! IMPLICIT ARGUMENTS
@@ -67,32 +67,34 @@ END MODULE MODI_INI_SIZE_SPAWN
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! J.Escobar : 19/04/2016 : Pb IOZ/NETCDF , missing OPARALLELIO=.FALSE. for PGD files
!! 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 07/02/2019: remove OPARALLELIO argument from open and close files subroutines
+! (nsubfiles_ioz is now determined in IO_File_add2list)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_CONF
-USE MODD_DIM_n, ONLY : DIM_MODEL
-USE MODD_DYN_n, ONLY : CPRESOPT, NITR
+USE MODD_DIM_n, ONLY: DIM_MODEL
+USE MODD_DYN_n, ONLY: CPRESOPT, NITR
USE MODD_GRID
USE MODD_GRID_n
-USE MODD_IO_ll, ONLY : ISNPROC, ISP, TFILEDATA
+USE MODD_IO, ONLY: ISNPROC, ISP, TFILEDATA
USE MODD_LBC_n
USE MODD_LUNIT_n
USE MODD_PARAMETERS
USE MODD_PGDDIM
USE MODD_PGDGRID
USE MODD_SPAWN
-USE MODD_VAR_ll, ONLY : YSPLITTING
+USE MODD_VAR_ll, ONLY: YSPLITTING
!
-USE MODE_ll
-USE MODE_FIELD, ONLY : TFIELDDATA,TFIELDLIST,FIND_FIELD_ID_FROM_MNHNAME
-USE MODE_FM
-USE MODE_FMREAD
+USE MODE_FIELD, ONLY: TFIELDDATA,TFIELDLIST,FIND_FIELD_ID_FROM_MNHNAME
USE MODE_GRIDPROJ
-USE MODE_IO_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY : IO_FILE_ADD2LIST
+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_ll
USE MODE_MSG
USE MODE_MODELN_HANDLER
USE MODE_SPLITTINGZ_ll
@@ -184,7 +186,7 @@ IF (LBAL_ONLY) THEN
!callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_SIZE_SPAWN','YDADINIFILE not initialized in namelist NAM_LUNIT2_SPA')
ELSE
- CALL IO_READ_FIELD(TPINIFILE,'DAD_NAME',YDAD_NAME)
+ CALL IO_Field_read(TPINIFILE,'DAD_NAME',YDAD_NAME)
IF (ADJUSTL(ADJUSTR(YDAD_NAME)) .NE. ADJUSTL(ADJUSTR(CDADINIFILE))) THEN
WRITE(ILUOUT,*) 'ERROR in INI_SIZE_SPAWN: YDADINIFILE is NOT the DAD of model 1'
WRITE(ILUOUT,*) ' YDADINIFILE='//TRIM(CDADINIFILE)
@@ -209,12 +211,12 @@ ENDIF
!
IF (LEN_TRIM(CDOMAIN)>0) THEN
!
- CALL IO_READ_FIELD(TPINIFILE,'LAT0', XLAT0)
- CALL IO_READ_FIELD(TPINIFILE,'LON0', XLON0)
- CALL IO_READ_FIELD(TPINIFILE,'RPK', XRPK)
- CALL IO_READ_FIELD(TPINIFILE,'BETA', XBETA)
- CALL IO_READ_FIELD(TPINIFILE,'LATORI',XPGDLATOR)
- CALL IO_READ_FIELD(TPINIFILE,'LONORI',XPGDLONOR)
+ CALL IO_Field_read(TPINIFILE,'LAT0', XLAT0)
+ CALL IO_Field_read(TPINIFILE,'LON0', XLON0)
+ CALL IO_Field_read(TPINIFILE,'RPK', XRPK)
+ CALL IO_Field_read(TPINIFILE,'BETA', XBETA)
+ CALL IO_Field_read(TPINIFILE,'LATORI',XPGDLATOR)
+ CALL IO_Field_read(TPINIFILE,'LONORI',XPGDLONOR)
!
!$20140602 INSERT BIG MODIF JUAN May27
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -224,15 +226,15 @@ IF (LEN_TRIM(CDOMAIN)>0) THEN
! initialize grid2 dims, xor, xend and ratio so to initialize in INI_CHILD
! structures TCRRT_COMDATA%T_CHILDREN%T_SPLITB and TCRRT_PROCONF%T_CHILDREN
!$20140602 add condition on npproc
- CALL IO_FILE_ADD2LIST(TZDOMAIN,TRIM(CDOMAIN),'UNKNOWN','READ',KLFITYPE=2,KLFIVERB=NVERB)
- CALL IO_FILE_OPEN_ll(TZDOMAIN,OPARALLELIO=.FALSE.)
+ CALL IO_File_add2list(TZDOMAIN,TRIM(CDOMAIN),'PGD','READ',KLFITYPE=2,KLFIVERB=NVERB)
+ CALL IO_File_open(TZDOMAIN)
!
- CALL IO_READ_FIELD(TZDOMAIN,'DXRATIO',NDXRATIO)
- CALL IO_READ_FIELD(TZDOMAIN,'DYRATIO',NDYRATIO)
- CALL IO_READ_FIELD(TZDOMAIN,'XOR', NXOR)
- CALL IO_READ_FIELD(TZDOMAIN,'YOR', NYOR)
- CALL IO_READ_FIELD(TZDOMAIN,'IMAX', IIMAX_ll)
- CALL IO_READ_FIELD(TZDOMAIN,'JMAX', IJMAX_ll)
+ CALL IO_Field_read(TZDOMAIN,'DXRATIO',NDXRATIO)
+ CALL IO_Field_read(TZDOMAIN,'DYRATIO',NDYRATIO)
+ CALL IO_Field_read(TZDOMAIN,'XOR', NXOR)
+ CALL IO_Field_read(TZDOMAIN,'YOR', NYOR)
+ CALL IO_Field_read(TZDOMAIN,'IMAX', IIMAX_ll)
+ CALL IO_Field_read(TZDOMAIN,'JMAX', IJMAX_ll)
NXEND=NXOR+IIMAX_ll/NDXRATIO+2*JPHEXT-1
NYEND=NYOR+IJMAX_ll/NDYRATIO+2*JPHEXT-1
!
@@ -255,21 +257,21 @@ IF (LEN_TRIM(CDOMAIN)>0) THEN
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!$
ALLOCATE(XPGDXHAT(DIM_MODEL(1)%NIMAX+2*JPHEXT))
- CALL IO_READ_FIELD(TPINIFILE,'XHAT',XPGDXHAT)
+ CALL IO_Field_read(TPINIFILE,'XHAT',XPGDXHAT)
!
ALLOCATE(XPGDYHAT(DIM_MODEL(1)%NJMAX+2*JPHEXT))
- CALL IO_READ_FIELD(TPINIFILE,'YHAT',XPGDYHAT)
+ CALL IO_Field_read(TPINIFILE,'YHAT',XPGDYHAT)
!
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_READ_FIELD(TPINIFILE,TZFIELD,XPGDLONOR)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,XPGDLONOR)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('LATORI',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CMNHNAME = 'LATOR'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,XPGDLATOR)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,XPGDLATOR)
!
ZXHATM = - 0.5 * (XPGDXHAT(1)+XPGDXHAT(2))
ZYHATM = - 0.5 * (XPGDYHAT(1)+XPGDYHAT(2))
@@ -282,7 +284,7 @@ IF (LEN_TRIM(CDOMAIN)>0) THEN
!* 1.4 read grid in file CDOMAIN if available :
!
CALL READ_HGRID(2,TZDOMAIN,YMY_NAME,YDAD_NAME,YSTORAGE_TYPE)
- CALL IO_FILE_CLOSE_ll(TZDOMAIN,OPARALLELIO=.FALSE.)
+ CALL IO_File_close(TZDOMAIN)
CALL RETRIEVE1_NEST_INFO_n(1,2,NXOR,NYOR,NXSIZE,NYSIZE,NDXRATIO,NDYRATIO)
DEALLOCATE(XZS,XZSMT,XXHAT,XYHAT)
!
diff --git a/src/MNH/ini_sizen.f90 b/src/MNH/ini_sizen.f90
index 3cfad7f7e9a349aec65cd1dc86675ccec7d227a0..5e21aeeaffa449c582206864c825cfdfaaa846be 100644
--- a/src/MNH/ini_sizen.f90
+++ b/src/MNH/ini_sizen.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #################
@@ -9,12 +9,11 @@
!
INTERFACE
!
-SUBROUTINE INI_SIZE_n(KMI,HLUOUT,TPINIFILE,HINIFILEPGD)
+SUBROUTINE INI_SIZE_n( KMI, TPINIFILE, HINIFILEPGD )
!
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY : TFILEDATA
!
INTEGER, INTENT(IN) :: KMI !Model Index
-CHARACTER (LEN=*), INTENT(IN) :: HLUOUT !Name for output-listing of nested models
TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE !Initial file
CHARACTER (LEN=*), INTENT(IN) :: HINIFILEPGD
!
@@ -24,9 +23,9 @@ END INTERFACE
!
END MODULE MODI_INI_SIZE_n
!-----------------------------------------------------------------
-! #######################################################
- SUBROUTINE INI_SIZE_n(KMI,HLUOUT,TPINIFILE,HINIFILEPGD)
-! #######################################################
+! ####################################################
+ SUBROUTINE INI_SIZE_n( KMI, TPINIFILE, HINIFILEPGD )
+! ####################################################
!
!!
!!**** *INI_SIZE_n* - routine to initialize the sizes ratio positions of nested model _n
@@ -40,7 +39,7 @@ END MODULE MODI_INI_SIZE_n
!! ------
!! The first part of the initialization of the model _n is performed as
!! follows :
-!! - The logical unit number associated to output_listing file HLUOUT is
+!! - The logical unit number associated to output_listing file TLUOUT is
!! retrieved and module MODD_LUNIT_n is initialized.
!! - Then the description of the segment to perform for the model _n is
!! retrieved :
@@ -55,7 +54,7 @@ END MODULE MODI_INI_SIZE_n
!!
!! EXTERNAL
!! --------
-!! IO_READ_FIELD : to read a LFIFM file
+!! IO_Field_read : to read a LFIFM file
!!
!! IMPLICIT ARGUMENTS
!! ------------------
@@ -95,27 +94,27 @@ END MODULE MODI_INI_SIZE_n
!! June 2006 (D. Gazen) _n: no more read of updated var.
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! 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
!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CONF, ONLY: CCONF, LCARTESIAN, NVERB, LTHINSHELL, NHALO, CSPLIT, &
- L1D, L2D, LPACK
-USE MODD_CONFZ, ONLY: NZ_PROC
-USE MODD_DIM_n, ONLY: NIMAX_ll, NJMAX_ll, NKMAX
-USE MODD_DYN, ONLY: LCORIO
-USE MODD_IO_ll, ONLY: GSMONOPROC, TFILEDATA
-USE MODD_LBC_n, ONLY: CLBCX, CLBCY
-USE MODD_LUNIT_n, ONLY: CLUOUT, 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 MODE_FM, ONLY: SET_FMPACK_ll
-USE MODE_FMREAD
-USE MODE_IO_ll
+USE MODD_CONF, ONLY: CCONF, LCARTESIAN, NVERB, LTHINSHELL, NHALO, CSPLIT, &
+ L1D, L2D, LPACK
+USE MODD_CONFZ, ONLY: NZ_PROC
+USE MODD_DIM_n, ONLY: NIMAX_ll, NJMAX_ll, NKMAX
+USE MODD_DYN, ONLY: LCORIO
+USE MODD_IO, ONLY: GSMONOPROC, TFILEDATA
+USE MODD_LBC_n, ONLY: CLBCX, CLBCY
+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 MODE_IO, ONLY: IO_Pack_set
+USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_ll
USE MODE_MSG
USE MODE_POS
@@ -126,7 +125,6 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
INTEGER, INTENT(IN) :: KMI !Model Index
-CHARACTER (LEN=*), INTENT(IN) :: HLUOUT !Name for output-listing of nested models
TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE !Initial file
CHARACTER (LEN=*), INTENT(IN) :: HINIFILEPGD
!
@@ -142,7 +140,6 @@ INTEGER :: IJPHEXT
! --------------------------------------------------------
!
ILUOUT = TLUOUT%NLU
-CLUOUT = HLUOUT
CINIFILEPGD=HINIFILEPGD
!
!-------------------------------------------------------------------------------
@@ -152,14 +149,14 @@ CINIFILEPGD=HINIFILEPGD
!
!* 2.0 Retrieve DAD_NAME and MY_NAME to check the DAD model identity
!
-CALL IO_READ_FIELD(TPINIFILE,'MY_NAME',CMY_NAME(KMI),IRESP)
+CALL IO_Field_read(TPINIFILE,'MY_NAME',CMY_NAME(KMI),IRESP)
IF (IRESP /= 0) THEN
WRITE(ILUOUT,FMT=9000) 'MY_NAME',IRESP
!callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_SIZE_n','')
END IF
!
-CALL IO_READ_FIELD(TPINIFILE,'DAD_NAME',CDAD_NAME(KMI),IRESP)
+CALL IO_Field_read(TPINIFILE,'DAD_NAME',CDAD_NAME(KMI),IRESP)
IF (IRESP /= 0) THEN
WRITE(ILUOUT,FMT=9000) 'DAD_NAME',IRESP
!callabortstop
@@ -187,10 +184,10 @@ END IF
!* 3.1 Read dimensions in initial file and initialize subdomain
! dimensions and parallel variables
!
-CALL IO_READ_FIELD(TPINIFILE,'IMAX', NIMAX_ll)
-CALL IO_READ_FIELD(TPINIFILE,'JMAX', NJMAX_ll)
-CALL IO_READ_FIELD(TPINIFILE,'KMAX', NKMAX)
-CALL IO_READ_FIELD(TPINIFILE,'JPHEXT',IJPHEXT)
+CALL IO_Field_read(TPINIFILE,'IMAX', NIMAX_ll)
+CALL IO_Field_read(TPINIFILE,'JMAX', NJMAX_ll)
+CALL IO_Field_read(TPINIFILE,'KMAX', NKMAX)
+CALL IO_Field_read(TPINIFILE,'JPHEXT',IJPHEXT)
!
IF ( IJPHEXT .NE. JPHEXT ) THEN
WRITE(ILUOUT,FMT=*) ' INI_SIZE_N : JPHEXT in namelist NAM_CONF ( or default or .des value )&
@@ -220,10 +217,10 @@ ENDIF
! read the nested model location in its father's grid
! and compute the coordinates of the corner points
IF (LEN_TRIM(CDAD_NAME(KMI))>0) THEN
- CALL IO_READ_FIELD(TPINIFILE,'DXRATIO',NDXRATIO_ALL(KMI))
- CALL IO_READ_FIELD(TPINIFILE,'DYRATIO',NDYRATIO_ALL(KMI))
- CALL IO_READ_FIELD(TPINIFILE,'XOR',NXOR_ALL(KMI))
- CALL IO_READ_FIELD(TPINIFILE,'YOR',NYOR_ALL(KMI))
+ CALL IO_Field_read(TPINIFILE,'DXRATIO',NDXRATIO_ALL(KMI))
+ CALL IO_Field_read(TPINIFILE,'DYRATIO',NDYRATIO_ALL(KMI))
+ CALL IO_Field_read(TPINIFILE,'XOR',NXOR_ALL(KMI))
+ CALL IO_Field_read(TPINIFILE,'YOR',NYOR_ALL(KMI))
NXEND_ALL(KMI)=NXOR_ALL(KMI)-1 + NIMAX_ll/NDXRATIO_ALL(KMI) +2*JPHEXT
NYEND_ALL(KMI)=NYOR_ALL(KMI)-1 + NJMAX_ll/NDYRATIO_ALL(KMI) +2*JPHEXT
ELSE
@@ -275,7 +272,7 @@ IF (KMI == 1) THEN
CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_SIZE_n','this is a 2D simulation: it has to be performed in monoprocess mode')
ENDIF
!
- CALL SET_FMPACK_ll(L1D,L2D,LPACK)
+ CALL IO_Pack_set(L1D,L2D,LPACK)
!
END IF
!-------------------------------------------------------------------------------
diff --git a/src/MNH/ini_spawn_lsn.f90 b/src/MNH/ini_spawn_lsn.f90
index 8c580978621c68922036a3f52244a5b3f40c280f..f33f727bbc247a84af9b5ae3934f0e8de1157b72 100644
--- a/src/MNH/ini_spawn_lsn.f90
+++ b/src/MNH/ini_spawn_lsn.f90
@@ -19,8 +19,8 @@ INTERFACE
KDXRATIO,KDYRATIO, &
HLBCX,HLBCY,PZZ,PZHAT, &
OSLEVE,PLEN1,PLEN2, &
- PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM, &
- PLSUS,PLSVS,PLSWS,PLSTHS,PLSRVS, &
+ PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM,PLSZWSM, &
+ PLSUS,PLSVS,PLSWS,PLSTHS,PLSRVS,PLSZWSS, &
KKLIN_LBXU,PCOEFLIN_LBXU,KKLIN_LBYU,PCOEFLIN_LBYU, &
KKLIN_LBXV,PCOEFLIN_LBXV,KKLIN_LBYV,PCOEFLIN_LBYV, &
KKLIN_LBXW,PCOEFLIN_LBXW,KKLIN_LBYW,PCOEFLIN_LBYW, &
@@ -48,8 +48,10 @@ CHARACTER (LEN=4), DIMENSION (2), INTENT(IN) :: HLBCY ! boundary conditions
!
REAL, DIMENSION(:,:,:), INTENT( OUT) :: PLSUM,PLSVM,PLSWM ! Large Scale fields
REAL, DIMENSION(:,:,:), INTENT( OUT) :: PLSTHM, PLSRVM ! at t-dt
+REAL, DIMENSION(:,:), INTENT( OUT) :: PLSZWSM ! at t-dt
REAL, DIMENSION(:,:,:), INTENT( OUT) :: PLSUS,PLSVS,PLSWS ! Large Scale source
REAL, DIMENSION(:,:,:), INTENT( OUT) :: PLSTHS, PLSRVS ! terms
+REAL, DIMENSION(:,:), INTENT( OUT) :: PLSZWSS ! source terms
! coefficients for the vertical interpolation of the LB fields
INTEGER, DIMENSION(:,:,:), INTENT( OUT) :: KKLIN_LBXU,KKLIN_LBYU
REAL, DIMENSION(:,:,:), INTENT( OUT) :: PCOEFLIN_LBXU,PCOEFLIN_LBYU
@@ -73,8 +75,8 @@ END MODULE MODI_INI_SPAWN_LS_n
KDXRATIO,KDYRATIO, &
HLBCX,HLBCY,PZZ,PZHAT, &
OSLEVE,PLEN1,PLEN2, &
- PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM, &
- PLSUS,PLSVS,PLSWS,PLSTHS,PLSRVS, &
+ PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM,PLSZWSM, &
+ PLSUS,PLSVS,PLSWS,PLSTHS,PLSRVS,PLSZWSS, &
KKLIN_LBXU,PCOEFLIN_LBXU,KKLIN_LBYU,PCOEFLIN_LBYU, &
KKLIN_LBXV,PCOEFLIN_LBXV,KKLIN_LBYV,PCOEFLIN_LBYV, &
KKLIN_LBXW,PCOEFLIN_LBXW,KKLIN_LBYW,PCOEFLIN_LBYW, &
@@ -140,6 +142,7 @@ END MODULE MODI_INI_SPAWN_LS_n
!! coeff for U
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! J.Escobar : 18/12/2015 : Correction of bug in bound in // for NHALO <>1
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -190,6 +193,8 @@ CHARACTER (LEN=4), DIMENSION (2), INTENT(IN) :: HLBCY ! boundary conditions
!
REAL, DIMENSION(:,:,:), INTENT( OUT) :: PLSUM,PLSVM,PLSWM ! Large Scale fields
REAL, DIMENSION(:,:,:), INTENT( OUT) :: PLSTHM, PLSRVM ! at t-dt
+REAL, DIMENSION(:,:), INTENT( OUT) :: PLSZWSM ! LS at t-dt
+REAL, DIMENSION(:,:), INTENT( OUT) :: PLSZWSS ! source terms
REAL, DIMENSION(:,:,:), INTENT( OUT) :: PLSUS,PLSVS,PLSWS ! Large Scale source
REAL, DIMENSION(:,:,:), INTENT( OUT) :: PLSTHS, PLSRVS ! terms
! coefficients for the vertical interpolation of the LB fields
@@ -231,6 +236,7 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTLSUM, ZTLSVM, ZTLSWM, ZTLSTHM, ZTLSRVM
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTLSUS, ZTLSVS, ZTLSWS, ZTLSTHS, ZTLSRVS
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTZS,ZZS
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTZSMT,ZZSMT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZTZWS,ZTZWSS
!
!-------------------------------------------------------------------------------
!
@@ -260,6 +266,7 @@ ALLOCATE(ZTLSUM(IDIMX,IDIMY,SIZE(PLSUM,3)))
ALLOCATE(ZTLSVM(IDIMX,IDIMY,SIZE(PLSVM,3)))
ALLOCATE(ZTLSWM(IDIMX,IDIMY,SIZE(PLSWM,3)))
ALLOCATE(ZTLSTHM(IDIMX,IDIMY,SIZE(PLSTHM,3)))
+IF(SIZE(PLSZWSM) /= 0) ALLOCATE(ZTZWS(IDIMX,IDIMY))
IF(SIZE(PLSRVM) /= 0) ALLOCATE(ZTLSRVM(IDIMX,IDIMY,SIZE(PLSRVM,3)))
!
IF(GVERT_INTERP) THEN
@@ -277,11 +284,14 @@ IF ( SIZE(PLSTHS,1) /= 0 ) THEN
ALLOCATE(ZTLSWS(IDIMX,IDIMY,SIZE(PLSWS,3)))
ALLOCATE(ZTLSTHS(IDIMX,IDIMY,SIZE(PLSTHS,3)))
ENDIF
+IF ( SIZE(PLSZWSS) /= 0 ) ALLOCATE(ZTZWSS(IDIMX,IDIMY))
IF ( SIZE(PLSRVS) /= 0 ) ALLOCATE(ZTLSRVS(IDIMX,IDIMY,SIZE(PLSRVS,3)))
!
! 1.3 Specify the ls "source" fields and receiver fields
!
CALL SET_LSFIELD_1WAY_ll(XLSUM, ZTLSUM, KMI)
+IF ( SIZE(PLSZWSM,1) /= 0 ) &
+ CALL SET_LSFIELD_1WAY_ll(XLSZWSM, ZTZWS, KMI)
CALL SET_LSFIELD_1WAY_ll(XLSVM, ZTLSVM, KMI)
CALL SET_LSFIELD_1WAY_ll(XLSWM, ZTLSWM, KMI)
CALL SET_LSFIELD_1WAY_ll(XLSTHM, ZTLSTHM, KMI)
@@ -295,6 +305,8 @@ IF ( SIZE(PLSTHS,1) /= 0 ) THEN
CALL SET_LSFIELD_1WAY_ll(XLSTHS, ZTLSTHS, KMI)
IF ( SIZE(PLSRVM,1) /= 0 ) &
CALL SET_LSFIELD_1WAY_ll(XLSRVS, ZTLSRVS, KMI)
+ IF ( SIZE(PLSZWSM,1) /= 0 ) &
+ CALL SET_LSFIELD_1WAY_ll(XLSZWSS, ZTZWSS, KMI)
ENDIF
!
IF ( GVERT_INTERP ) THEN
@@ -454,6 +466,13 @@ IF ( SIZE(PLSRVM,1) /= 0 ) THEN
HLBCX,HLBCY,ZTLSRVM,PLSRVM(IIB:IIE,IJB:IJE,:))
END IF
!
+IF ( SIZE(PLSZWSM,1) /= 0 ) THEN
+ 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,ZTZWS,PLSZWSM(IIB:IIE,IJB:IJE))
+END IF
+
IF ( SIZE(PLSTHS,1) /= 0 ) THEN
!
CALL BIKHARDT (PBMX1,PBMX2,PBMX3,PBMX4,PBMY1,PBMY2,PBMY3,PBMY4, &
@@ -469,6 +488,13 @@ IF ( SIZE(PLSTHS,1) /= 0 ) THEN
!
END IF
!
+ IF ( SIZE(PLSZWSM,1) /= 0 ) THEN
+ 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,ZTZWS+ZTIME*ZTZWSS,PLSZWSS(IIB:IIE,IJB:IJE))
+ !
+ END IF
END IF
!
!* 3.2 Vertical linear interpolation on the mass grid
@@ -550,6 +576,9 @@ IF ( SIZE(PLSTHS,1) /= 0 ) THEN
PLSRVS(:,:,:) = (PLSRVS(:,:,:) - PLSRVM(:,:,:)) / ZTIME
END IF
!
+ IF ( SIZE(PLSZWSM,1) /= 0 ) THEN
+ PLSZWSS(:,:) = (PLSZWSS(:,:) - PLSZWSM(:,:)) / ZTIME
+ END IF
END IF
!
!------------------------------------------------------------------------------
@@ -749,12 +778,14 @@ END IF
!
DEALLOCATE(ZTLSUM,ZTLSVM,ZTLSWM,ZTLSTHM)
IF(SIZE(PLSRVM) /= 0) DEALLOCATE(ZTLSRVM)
+IF(SIZE(PLSZWSM) /= 0) DEALLOCATE(ZTZWS)
!
IF(GVERT_INTERP) DEALLOCATE(ZTZS,ZZS)
IF(GVERT_INTERP) DEALLOCATE(ZTZSMT,ZZSMT)
!
IF ( SIZE(PLSTHS,1) /= 0 ) DEALLOCATE(ZTLSUS,ZTLSVS,ZTLSWS,ZTLSTHS)
IF ( SIZE(PLSRVS,1) /= 0 ) DEALLOCATE(ZTLSRVS)
+IF ( SIZE(PLSZWSS,1) /= 0 ) DEALLOCATE(ZTZWSS)
!------------------------------------------------------------------------------
NULLIFY(TZLSFIELD_ll)
CALL ADD3DFIELD_ll(TZLSFIELD_ll, PLSUM)
@@ -762,6 +793,7 @@ CALL ADD3DFIELD_ll(TZLSFIELD_ll, PLSVM)
CALL ADD3DFIELD_ll(TZLSFIELD_ll, PLSWM)
CALL ADD3DFIELD_ll(TZLSFIELD_ll, PLSTHM)
IF(SIZE(PLSRVM) /= 0) CALL ADD3DFIELD_ll(TZLSFIELD_ll, PLSRVM)
+IF(SIZE(PLSZWSM) /= 0) CALL ADD2DFIELD_ll(TZLSFIELD_ll, PLSZWSM)
IF ( SIZE(PLSTHS,1) /= 0 ) THEN
CALL ADD3DFIELD_ll(TZLSFIELD_ll, PLSUS)
CALL ADD3DFIELD_ll(TZLSFIELD_ll, PLSVS)
@@ -769,6 +801,7 @@ IF ( SIZE(PLSTHS,1) /= 0 ) THEN
CALL ADD3DFIELD_ll(TZLSFIELD_ll, PLSTHS)
ENDIF
IF ( SIZE(PLSRVS,1) /= 0 ) CALL ADD3DFIELD_ll(TZLSFIELD_ll, PLSRVS)
+IF ( SIZE(PLSZWSS,1) /= 0 ) CALL ADD2DFIELD_ll(TZLSFIELD_ll, PLSZWSS)
CALL UPDATE_HALO_ll(TZLSFIELD_ll,IINFO_ll)
CALL CLEANLIST_ll(TZLSFIELD_ll)
!
diff --git a/src/MNH/ini_spectren.f90 b/src/MNH/ini_spectren.f90
index d2564f410e2cbf86db61e9efa3da8f98a27320c4..6218b69882c2f03d7fe8c79faede3b2e2487e19d 100644
--- a/src/MNH/ini_spectren.f90
+++ b/src/MNH/ini_spectren.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #######################
@@ -9,12 +9,11 @@
!
INTERFACE
!
- SUBROUTINE INI_SPECTRE_n(KMI,HLUOUT,TPINIFILE)
+ SUBROUTINE INI_SPECTRE_n(KMI,TPINIFILE)
!
- USE MODD_IO_ll, ONLY: TFILEDATA
+ USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KMI ! Model index
- CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! Name for output-listing of nested models
TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
!
END SUBROUTINE INI_SPECTRE_n
@@ -22,9 +21,9 @@ END SUBROUTINE INI_SPECTRE_n
END INTERFACE
!
END MODULE MODI_INI_SPECTRE_n
-! ######################################################
- SUBROUTINE INI_SPECTRE_n(KMI,HLUOUT,TPINIFILE)
-! ######################################################
+! #######################################
+ SUBROUTINE INI_SPECTRE_n(KMI,TPINIFILE)
+! #######################################
!
!!**** *INI_SPECTRE_n* - routine to initialize SPECTRE (based on ini_modeln.f90)
!!
@@ -34,8 +33,11 @@ END MODULE MODI_INI_SPECTRE_n
!! J.P Chaboureau * L.A*
!! 10/2016 (C.Lac) Cleaning of the modules
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
-
+! P. Wautelet 08/02/2019: allocate to zero-size non associated pointers
+! 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
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+!!
!---------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -72,7 +74,7 @@ USE MODD_FRC_n
USE MODD_GET_n
USE MODD_GRID, ONLY: XLONORI,XLATORI
USE MODD_GRID_n
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LBC_n
USE MODD_LSFIELD_n
USE MODD_LUNIT_n, ONLY: COUTFILE, TLUOUT
@@ -107,9 +109,8 @@ USE MODD_TURB_n
USE MODD_VAR_ll, ONLY: IP
!
USE MODD_ARGSLIST_ll, ONLY: LIST_ll
-USE MODE_FMREAD
USE MODE_GATHER_ll
-USE MODE_IO_ll
+USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_ll
USE MODE_MODELN_HANDLER
USE MODE_MSG
@@ -135,7 +136,6 @@ IMPLICIT NONE
!
!
INTEGER, INTENT(IN) :: KMI ! Model index
-CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! Name for output-listing of nested models
TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
!
!* 0.2 declarations of local variables
@@ -198,6 +198,7 @@ REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XLBXRM,DPTR_XLBYRM
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XZZ
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLSUM,DPTR_XLSVM,DPTR_XLSWM,DPTR_XLSTHM,DPTR_XLSRVM
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLSUS,DPTR_XLSVS,DPTR_XLSWS,DPTR_XLSTHS,DPTR_XLSRVS
+REAL, DIMENSION(:,:), POINTER :: DPTR_XLSZWSS,DPTR_XLSZWSM
!
!-------------------------------------------------------------------------------
!
@@ -223,8 +224,8 @@ ILUOUT = TLUOUT%NLU
IKU=NKMAX+2*JPVEXT
!
ALLOCATE(XZHAT(IKU))
-CALL IO_READ_FIELD(TPINIFILE,'ZHAT',XZHAT)
-CALL IO_READ_FIELD(TPINIFILE,'ZTOP',XZTOP)
+CALL IO_Field_read(TPINIFILE,'ZHAT',XZHAT)
+CALL IO_Field_read(TPINIFILE,'ZTOP',XZTOP)
IF (XALZBOT>=XZHAT(IKU) .AND. LVE_RELAX) THEN
WRITE(ILUOUT,FMT=*) "INI_SPECTRE_n ERROR: you want to use vertical relaxation"
WRITE(ILUOUT,FMT=*) " but bottom of layer XALZBOT(",XALZBOT,")"
@@ -509,9 +510,7 @@ ELSE ! 3D case
" Local domain to small for relaxation NRIMX+2*JPHEXT,IIU ", &
NRIMX+2*JPHEXT,IIU ,&
" change relaxation parameters or number of processors "
- !callabortstop
- CALL ABORT
- STOP
+ call Print_msg(NVERB_FATAL,'GEN','INI_SPECTRE_n','')
END IF
END IF
IF ( CLBCY(1) /= 'CYCL' ) THEN
@@ -521,9 +520,7 @@ ELSE ! 3D case
" Local domain to small for relaxation NRIMY+2*JPHEXT,IJU ", &
NRIMY+2*JPHEXT,IJU ,&
" change relaxation parameters or number of processors "
- !callabortstop
- CALL ABORT
- STOP
+ call Print_msg(NVERB_FATAL,'GEN','INI_SPECTRE_n','')
END IF
END IF
IF ( LHORELAX_UVWTH ) THEN
@@ -744,27 +741,27 @@ NDT_2_WAY(KMI)=4
IF (LSPECTRE_U) THEN
ALLOCATE(XUT(IIU,IJU,IKU)) ; XUT = 0.0
- CALL IO_READ_FIELD(TPINIFILE,'UT',XUT)
+ CALL IO_Field_read(TPINIFILE,'UT',XUT)
END IF
!
IF (LSPECTRE_V) THEN
ALLOCATE(XVT(IIU,IJU,IKU)) ; XVT = 0.0
- CALL IO_READ_FIELD(TPINIFILE,'VT',XVT)
+ CALL IO_Field_read(TPINIFILE,'VT',XVT)
END IF
!
IF (LSPECTRE_W) THEN
ALLOCATE(XWT(IIU,IJU,IKU)) ; XWT = 0.0
- CALL IO_READ_FIELD(TPINIFILE,'WT',XWT)
+ CALL IO_Field_read(TPINIFILE,'WT',XWT)
END IF
!
IF (LSPECTRE_TH) THEN
ALLOCATE(XTHT(IIU,IJU,IKU)) ; XTHT = 0.0
- CALL IO_READ_FIELD(TPINIFILE,'THT',XTHT)
+ CALL IO_Field_read(TPINIFILE,'THT',XTHT)
END IF
!
IF (LSPECTRE_RV) THEN
ALLOCATE(XRT(IIU,IJU,IKU,NRR))
- CALL IO_READ_FIELD(TPINIFILE,'RVT',XRT(:,:,:,1))
+ CALL IO_Field_read(TPINIFILE,'RVT',XRT(:,:,:,1))
END IF
!
!-------------------------------------------------------------------------------
@@ -804,10 +801,10 @@ IF ((KMI==1).AND.(.NOT. LSTEADYLS)) THEN
NSIZELBX_ll,NSIZELBXU_ll,NSIZELBY_ll,NSIZELBYV_ll, &
NSIZELBXTKE_ll,NSIZELBYTKE_ll, &
NSIZELBXR_ll,NSIZELBYR_ll,NSIZELBXSV_ll,NSIZELBYSV_ll, &
- XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM,XDRYMASST, &
+ XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM,XLSZWSM,XDRYMASST, &
XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM, &
XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
- XLSUS,XLSVS,XLSWS,XLSTHS,XLSRVS,XDRYMASSS, &
+ XLSUS,XLSVS,XLSWS,XLSTHS,XLSRVS,XLSZWSS,XDRYMASSS, &
XLBXUS,XLBXVS,XLBXWS,XLBXTHS,XLBXTKES,XLBXRS,XLBXSVS, &
XLBYUS,XLBYVS,XLBYWS,XLBYTHS,XLBYTKES,XLBYRS,XLBYSVS )
END IF
@@ -841,11 +838,13 @@ IF ( KMI > 1) THEN
DPTR_XLSWM=>XLSWM
DPTR_XLSTHM=>XLSTHM
DPTR_XLSRVM=>XLSRVM
+ DPTR_XLSZWSM=>XLSZWSM
DPTR_XLSUS=>XLSUS
DPTR_XLSVS=>XLSVS
DPTR_XLSWS=>XLSWS
DPTR_XLSTHS=>XLSTHS
DPTR_XLSRVS=>XLSRVS
+ DPTR_XLSZWSS=>XLSZWSS
!
DPTR_NKLIN_LBXU=>NKLIN_LBXU
DPTR_XCOEFLIN_LBXU=>XCOEFLIN_LBXU
@@ -870,8 +869,8 @@ IF ( KMI > 1) THEN
NDXRATIO_ALL(KMI),NDYRATIO_ALL(KMI), &
DPTR_CLBCX,DPTR_CLBCY,DPTR_XZZ,DPTR_XZHAT, &
LSLEVE,XLEN1,XLEN2, &
- DPTR_XLSUM,DPTR_XLSVM,DPTR_XLSWM,DPTR_XLSTHM,DPTR_XLSRVM, &
- DPTR_XLSUS,DPTR_XLSVS,DPTR_XLSWS,DPTR_XLSTHS,DPTR_XLSRVS, &
+ DPTR_XLSUM,DPTR_XLSVM,DPTR_XLSWM,DPTR_XLSTHM,DPTR_XLSRVM,DPTR_XLSZWSM, &
+ DPTR_XLSUS,DPTR_XLSVS,DPTR_XLSWS,DPTR_XLSTHS,DPTR_XLSRVS,DPTR_XLSZWSS, &
DPTR_NKLIN_LBXU,DPTR_XCOEFLIN_LBXU,DPTR_NKLIN_LBYU,DPTR_XCOEFLIN_LBYU, &
DPTR_NKLIN_LBXV,DPTR_XCOEFLIN_LBXV,DPTR_NKLIN_LBYV,DPTR_XCOEFLIN_LBYV, &
DPTR_NKLIN_LBXW,DPTR_XCOEFLIN_LBXW,DPTR_NKLIN_LBYW,DPTR_XCOEFLIN_LBYW, &
@@ -891,7 +890,7 @@ IF ( KMI > 1) THEN
DPTR_XLBYRM=>XLBYRM
DPTR_XLBXSVM=>XLBXSVM
DPTR_XLBYSVM=>XLBYSVM
- CALL INI_ONE_WAY_n(NDAD(KMI),HLUOUT,XTSTEP,KMI,1, &
+ CALL INI_ONE_WAY_n(NDAD(KMI),XTSTEP,KMI,1, &
DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4,DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4, &
DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4,DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4, &
NDXRATIO_ALL(KMI),NDYRATIO_ALL(KMI),NDTRATIO(KMI), &
@@ -918,6 +917,10 @@ WRITE(COUTFILE,'(A,".",I1,".",A)') CEXP,KMI,TRIM(ADJUSTL(CSEG))
!* 17. INITIALIZE THE PARAMETERS FOR THE DYNAMICS
! ------------------------------------------
!
+!Allocate to zero size to not pass unallocated pointers
+ALLOCATE(XALKBAS(0))
+ALLOCATE(XALKWBAS(0))
+!
CALL INI_DYNAMICS(XLON,XLAT,XRHODJ,XTHVREF,XMAP,XZZ,XDXHAT,XDYHAT, &
XZHAT,CLBCX,CLBCY,XTSTEP, &
LVE_RELAX,LVE_RELAX_GRD,LHORELAX_UVWTH,LHORELAX_RV, &
diff --git a/src/MNH/ini_surf_rad.f90 b/src/MNH/ini_surf_rad.f90
index e3c30fdf8352cc6f8465b90aad39bcc12dc95092..a6c4934e7a32a5926d90601e893a7ecf0a7eb62d 100644
--- a/src/MNH/ini_surf_rad.f90
+++ b/src/MNH/ini_surf_rad.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2003-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2003-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.
!-----------------------------------------------------------------
! ##########################
@@ -11,7 +11,7 @@ INTERFACE
!
SUBROUTINE INI_SURF_RAD(TPINIFILE, PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD)
!
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY : TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDIR_ALB ! Direct albedo
@@ -63,10 +63,10 @@ END MODULE MODI_INI_SURF_RAD
!* 0. DECLARATIONS
! ------------
!
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
-USE MODE_FIELD, ONLY: FIND_FIELD_ID_FROM_MNHNAME, TFIELDDATA, TFIELDLIST
-USE MODE_FMREAD
+USE MODE_FIELD, ONLY: FIND_FIELD_ID_FROM_MNHNAME, TFIELDDATA, TFIELDLIST
+USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_MSG
!
IMPLICIT NONE
@@ -85,17 +85,17 @@ INTEGER :: IID, IRESP
TYPE(TFIELDDATA) :: TZFIELD
!-------------------------------------------------------------------------------
!
-CALL IO_READ_FIELD(TPINIFILE,'DIR_ALB',PDIR_ALB)
-CALL IO_READ_FIELD(TPINIFILE,'SCA_ALB',PSCA_ALB)
+CALL IO_Field_read(TPINIFILE,'DIR_ALB',PDIR_ALB)
+CALL IO_Field_read(TPINIFILE,'SCA_ALB',PSCA_ALB)
!
CALL PRINT_MSG(NVERB_INFO,'IO','INI_SURF_RAD','EMIS: reading only first band (copy on others)')
CALL FIND_FIELD_ID_FROM_MNHNAME('EMIS',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%NDIMS = 2
-CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PEMIS(:,:,1))
+CALL IO_Field_read(TPINIFILE,TZFIELD,PEMIS(:,:,1))
PEMIS(:,:,:) = SPREAD(SOURCE=PEMIS(:,:,1),DIM=3,NCOPIES=SIZE(PEMIS,3))
!
-CALL IO_READ_FIELD(TPINIFILE,'TSRAD',PTSRAD)
+CALL IO_Field_read(TPINIFILE,'TSRAD',PTSRAD)
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/ini_surfstationn.f90 b/src/MNH/ini_surfstationn.f90
index 887733edec7e871f9e68f5788220e80fb218a221..3d8f085963fea14de3ebad7877b4d984f42e2f2c 100644
--- a/src/MNH/ini_surfstationn.f90
+++ b/src/MNH/ini_surfstationn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #########################
@@ -68,7 +68,7 @@ END MODULE MODI_INI_SURFSTATION_n
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!!
!! --------------------------------------------------------------------------
-!
+!
!* 0. DECLARATIONS
! ------------
!
@@ -82,7 +82,6 @@ USE MODD_STATION_n
USE MODD_TYPE_DATE
!
USE MODE_GRIDPROJ
-USE MODE_IO_ll
USE MODE_ll
USE MODE_MSG
!
diff --git a/src/MNH/ini_sw_setup.f90 b/src/MNH/ini_sw_setup.f90
index e74318b9c236b5ffa7b503650d76cd3c1fa81bef..6408ee63b00fe915a2336a653d20eaec0a52168c 100644
--- a/src/MNH/ini_sw_setup.f90
+++ b/src/MNH/ini_sw_setup.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2003-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 surfex 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ##########################
MODULE MODI_INI_SW_SETUP
! ##########################
@@ -58,11 +53,13 @@ END MODULE MODI_INI_SW_SETUP
!! Original 03/03/03
!! modification : 01/09/03 Y. Seity, KSWB_MNH=6
!! 02/2018 Q.Libois ECRAD
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+use mode_msg
!
IMPLICIT NONE
!
@@ -92,9 +89,7 @@ SELECT CASE (HRAD)
PSW_BANDS(5) = 1.785E-6
PSW_BANDS(6) = 3.19E-6
ELSE
- !callabortstop
- CALL ABORT
- STOP
+ call Print_msg(NVERB_FATAL,'GEN','INI_SW_SETUP','invalid KSWB_MNH argument')
ENDIF
CASE ('ECRA')
@@ -127,9 +122,7 @@ SELECT CASE (HRAD)
PSW_BANDS(5) = 1.785E-6
PSW_BANDS(6) = 3.19E-6
ELSE
-!callabortstop
-CALL ABORT
- STOP
+ call Print_msg(NVERB_FATAL,'GEN','INI_SW_SETUP','invalid KSWB_MNH argument')
ENDIF
!
diff --git a/src/MNH/init_aerosol_properties.f90 b/src/MNH/init_aerosol_properties.f90
index 0c4c4e4f25eef4bb5d7b147c3d658886dab69ed7..84f1a5bd0eca3a6f509a72b224f882d3dfe027d0 100644
--- a/src/MNH/init_aerosol_properties.f90
+++ b/src/MNH/init_aerosol_properties.f90
@@ -35,6 +35,7 @@ END MODULE MODI_INIT_AEROSOL_PROPERTIES
!! Original ??/??/13
!! 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
!!
!-------------------------------------------------------------------------------
!
@@ -53,6 +54,8 @@ USE MODD_PARAM_LIMA, ONLY : LWARM, LACTI, NMOD_CCN, HINI_CCN, HTYPE_CCN,
CINT_MIXING, NMOD_IMM, NINDICE_CCN_IMM, NIMM, &
NPHILLIPS
!
+use mode_msg
+!
USE MODI_GAMMA
!
IMPLICIT NONE
@@ -218,9 +221,8 @@ IF ( NMOD_CCN .GE. 1 ) THEN
XACTEMP0 = 290.16
XALPHA6 = 3.076
CASE DEFAULT
- WRITE(UNIT=ILUOUT0,FMT='("You must specify HTYPE_CNN(JMOD)=C or M &
- &in EXSEG1.nam for each CCN mode")')
- CALL ABORT
+ 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
diff --git a/src/MNH/init_for_convlfi.f90 b/src/MNH/init_for_convlfi.f90
index d302211ec3d11f56f8a669b7cad85eaac39eb67e..733aa93ca7bbeb0deb5e0cb40c82c58edbeea179 100644
--- a/src/MNH/init_for_convlfi.f90
+++ b/src/MNH/init_for_convlfi.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -11,7 +11,7 @@ MODULE MODI_INIT_FOR_CONVLFI
INTERFACE
SUBROUTINE INIT_FOR_CONVLFI(TPINIFILE)
!
-USE MODD_IO_ll,ONLY: TFILEDATA
+USE MODD_IO,ONLY: TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! file being read
!
@@ -66,7 +66,7 @@ END MODULE MODI_INIT_FOR_CONVLFI
!* 0. DECLARATIONS
! ------------
!
-USE MODD_IO_ll,ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_CONF
USE MODD_CST
@@ -74,20 +74,19 @@ USE MODD_DIM_n
USE MODD_FIELD_n
USE MODD_GRID
USE MODD_GRID_n
-USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_TIME
USE MODD_TIME_n
-USE MODD_VAR_ll, ONLY : NPROC
+USE MODD_VAR_ll, ONLY: NPROC
!
-USE MODE_FIELD, ONLY : TFIELDDATA,TFIELDLIST,FIND_FIELD_ID_FROM_MNHNAME
+USE MODE_FIELD, ONLY: TFIELDDATA, TFIELDLIST, FIND_FIELD_ID_FROM_MNHNAME
USE MODE_TIME
USE MODE_GRIDPROJ
USE MODE_GRIDCART
!
-USE MODE_FM
-USE MODE_FMREAD
USE MODE_GATHER_ll
-USE MODE_IO_ll
+USE MODE_IO, only: IO_Pack_set
+USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_ll
!
USE MODI_INI_CST
@@ -127,39 +126,39 @@ TYPE(TFIELDDATA) :: TZFIELD
!
!* 1.1 Read the geometry kind in the LFIFM file (Cartesian or spherical)
!
-CALL IO_READ_FIELD(TPINIFILE,'CARTESIAN',LCARTESIAN)
+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_READ_FIELD(TPINIFILE,'IMAX',NIMAX_ll)
-CALL IO_READ_FIELD(TPINIFILE,'JMAX',NJMAX_ll)
+CALL IO_Field_read(TPINIFILE,'IMAX',NIMAX_ll)
+CALL IO_Field_read(TPINIFILE,'JMAX',NJMAX_ll)
!
-CALL IO_READ_FIELD(TPINIFILE,'L1D',L1D,IRESP)
+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_READ_FIELD(TPINIFILE,'L2D',L2D,IRESP)
+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_READ_FIELD(TPINIFILE,'PACK',LPACK,IRESP)
+CALL IO_Field_read(TPINIFILE,'PACK',LPACK,IRESP)
IF (IRESP/=0) LPACK=.TRUE.
!
-CALL SET_FMPACK_ll(L1D,L2D,LPACK)
+CALL IO_Pack_set(L1D,L2D,LPACK)
!
-CALL IO_READ_FIELD(TPINIFILE,'KMAX',NKMAX)
+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 SET_FMPACK_ll(L1D,L2D,LPACK)
+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)
@@ -185,27 +184,27 @@ CALL GET_DIM_PHYS_ll('B',NIMAX,NJMAX)
!
! 2.1 reading
!
-CALL IO_READ_FIELD(TPINIFILE,'LAT0',XLAT0)
-CALL IO_READ_FIELD(TPINIFILE,'LON0',XLON0)
-CALL IO_READ_FIELD(TPINIFILE,'BETA',XBETA)
-CALL IO_READ_FIELD(TPINIFILE,'XHAT',XXHAT)
-CALL IO_READ_FIELD(TPINIFILE,'YHAT',XYHAT)
+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_READ_FIELD(TPINIFILE,'RPK',XRPK)
- CALL IO_READ_FIELD(TPINIFILE,'LONORI',XLONORI)
- CALL IO_READ_FIELD(TPINIFILE,'LATORI',XLATORI)
+ 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_READ_FIELD(TPINIFILE,TZFIELD,XLONORI)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,XLONORI)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('LATORI',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CMNHNAME = 'LATOR'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,XLATORI)
+ 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) !//
@@ -220,29 +219,29 @@ IF (.NOT.LCARTESIAN) THEN
END IF
!
ALLOCATE(XZS(IIU,IJU))
-CALL IO_READ_FIELD(TPINIFILE,'ZS',XZS,IRESP)
+CALL IO_Field_read(TPINIFILE,'ZS',XZS,IRESP)
IF (IRESP/=0) XZS(:,:)=0.
!
ALLOCATE(XZSMT(IIU,IJU))
-CALL IO_READ_FIELD(TPINIFILE,'ZSMT',XZSMT,IRESP)
+CALL IO_Field_read(TPINIFILE,'ZSMT',XZSMT,IRESP)
IF (IRESP/=0) XZSMT(:,:)=XZS(:,:)
!
ALLOCATE(XZHAT(IKU))
-CALL IO_READ_FIELD(TPINIFILE,'ZHAT',XZHAT)
-CALL IO_READ_FIELD(TPINIFILE,'ZTOP',XZTOP)
+CALL IO_Field_read(TPINIFILE,'ZHAT',XZHAT)
+CALL IO_Field_read(TPINIFILE,'ZTOP',XZTOP)
!
-CALL IO_READ_FIELD(TPINIFILE,'SLEVE',LSLEVE,IRESP)
+CALL IO_Field_read(TPINIFILE,'SLEVE',LSLEVE,IRESP)
IF (IRESP/=0) LSLEVE = .FALSE.
!
IF (LSLEVE) THEN
- CALL IO_READ_FIELD(TPINIFILE,'LEN1',XLEN1)
- CALL IO_READ_FIELD(TPINIFILE,'LEN2',XLEN2)
+ CALL IO_Field_read(TPINIFILE,'LEN1',XLEN1)
+ CALL IO_Field_read(TPINIFILE,'LEN2',XLEN2)
END IF
!
-CALL IO_READ_FIELD(TPINIFILE,'DTEXP',TDTEXP)
-CALL IO_READ_FIELD(TPINIFILE,'DTMOD',TDTMOD)
-CALL IO_READ_FIELD(TPINIFILE,'DTSEG',TDTSEG)
-CALL IO_READ_FIELD(TPINIFILE,'DTCUR',TDTCUR)
+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)
@@ -271,7 +270,7 @@ END IF
!* 3. INITIALIZE THE PROGNOSTIC AND SURFACE FIELDS (read_field)
! --------------------------------------------
ALLOCATE(XPABST(IIU,IJU,IKU))
-CALL IO_READ_FIELD(TPINIFILE,'PABST',XPABST)
+CALL IO_Field_read(TPINIFILE,'PABST',XPABST)
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/init_ground_paramn.f90 b/src/MNH/init_ground_paramn.f90
index 95a5bcee7c0af414470d9665e3bf2e9681ef9d44..f8e37bd5ae848f9c2b7666495657cc0d07044935 100644
--- a/src/MNH/init_ground_paramn.f90
+++ b/src/MNH/init_ground_paramn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2003-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.
!-----------------------------------------------------------------
! #######################
@@ -74,7 +74,6 @@ END MODULE MODI_INIT_GROUND_PARAM_n
! ------------
!
USE MODE_DATETIME
-USE MODE_IO_ll
USE MODE_FIELD
USE MODE_ll
!
diff --git a/src/MNH/init_mnh.f90 b/src/MNH/init_mnh.f90
index 61f9bce84835cc8b5478f93a519fae6b4695103f..5a98a2572b8977b707726d07ef6a89170cef4fe5 100644
--- a/src/MNH/init_mnh.f90
+++ b/src/MNH/init_mnh.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ###############
@@ -47,8 +47,6 @@
!!
!! Module MODD_CONF : NMODEL,NVERB
!!
-!! Module MODD_LUNIT : CLUOUT0
-!!
!! REFERENCE
!! ---------
!! Book2 of documentation (routine INIT_MNH)
@@ -72,13 +70,14 @@
!! J.Escobar 2/03/2016 bypass , reset NHALO=1 for SPAWNING
!! 06/2016 (G.Delautier) phasage surfex 8
!! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
USE MODD_CONF
USE MODD_DYN_n, ONLY: CPRESOPT,NITR ! only for spawning purpose
-USE MODD_IO_ll, ONLY: TFILE_OUTPUTLISTING,TPTR2FILE
+USE MODD_IO, ONLY: TFILE_OUTPUTLISTING, TPTR2FILE
USE MODD_LBC_n, ONLY: CLBCX,CLBCY ! only for spawning purpose
USE MODD_LUNIT
USE MODD_LUNIT_n
@@ -86,9 +85,8 @@ USE MODD_MNH_SURFEX_n
USE MODD_PARAMETERS
!
USE MODE_FIELD
-USE MODE_FM, ONLY: IO_FILE_OPEN_ll
-USE MODE_IO_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST
+USE MODE_IO_FILE, ONLY: IO_File_open
+USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list
USE MODE_ll
USE MODE_MODELN_HANDLER
USE MODE_SPLITTINGZ_ll
@@ -113,8 +111,6 @@ IMPLICIT NONE
!* 0.1 Local variables
!
INTEGER :: JMI ! Loop index
-CHARACTER(LEN=16), DIMENSION(JPMODELMAX) :: YLUOUT ! Name for output-listing
- ! of nested models
CHARACTER(LEN=28),DIMENSION(JPMODELMAX) :: YINIFILEPGD
INTEGER :: ILUOUT0,IRESP ! Logical unit number for
! output-listing common
@@ -135,9 +131,8 @@ CHARACTER(LEN=4), DIMENSION(:), POINTER :: DPTR_CLBCX,DPTR_CLBCY
!
!
IF (CPROGRAM/='REAL ') THEN
- CLUOUT0 = 'OUTPUT_LISTING0'
- CALL IO_FILE_ADD2LIST(TLUOUT0,'OUTPUT_LISTING0','OUTPUTLISTING','WRITE')
- CALL IO_FILE_OPEN_ll(TLUOUT0)
+ CALL IO_File_add2list(TLUOUT0,'OUTPUT_LISTING0','OUTPUTLISTING','WRITE')
+ CALL IO_File_open(TLUOUT0)
!Set output file for PRINT_MSG
TFILE_OUTPUTLISTING => TLUOUT0
ILUOUT0=TLUOUT0%NLU
@@ -176,11 +171,11 @@ IF (CPROGRAM=='SPAWN ' .OR. CPROGRAM=='DIAG ' .OR. CPROGRAM=='SPEC ' .OR. CPRO
END IF
!
CALL GOTO_MODEL(1)
-CALL INI_SEG_n(1,YLUOUT(1),LUNIT_MODEL(1)%TINIFILE,YINIFILEPGD(1),ZTSTEP_ALL)
+CALL INI_SEG_n(1,LUNIT_MODEL(1)%TINIFILE,YINIFILEPGD(1),ZTSTEP_ALL)
!
DO JMI=2,NMODEL
CALL GOTO_MODEL(JMI)
- CALL INI_SEG_n(JMI,YLUOUT(JMI),LUNIT_MODEL(JMI)%TINIFILE,YINIFILEPGD(JMI),ZTSTEP_ALL)
+ CALL INI_SEG_n(JMI,LUNIT_MODEL(JMI)%TINIFILE,YINIFILEPGD(JMI),ZTSTEP_ALL)
END DO
!
IF (CPROGRAM=='SPAWN ') THEN
@@ -188,7 +183,7 @@ IF (CPROGRAM=='SPAWN ') THEN
NHALO = 1
END IF
!
-IF (CPROGRAM=='DIAG') CALL RESET_EXSEG(YLUOUT(1))
+IF (CPROGRAM=='DIAG') CALL RESET_EXSEG()
!
!-------------------------------------------------------------------------------
!
@@ -198,7 +193,7 @@ IF (CPROGRAM=='DIAG') CALL RESET_EXSEG(YLUOUT(1))
!
DO JMI=1,NMODEL
CALL GOTO_MODEL(JMI)
- CALL INI_SIZE_n(JMI,YLUOUT(JMI),LUNIT_MODEL(JMI)%TINIFILE,YINIFILEPGD(JMI))
+ CALL INI_SIZE_n(JMI,LUNIT_MODEL(JMI)%TINIFILE,YINIFILEPGD(JMI))
END DO
!
IF (CPROGRAM=='SPAWN ') THEN
@@ -242,11 +237,11 @@ DO JMI=1,NMODEL
CALL GO_TOMODEL_ll(JMI,IINFO_ll)
CALL GOTO_MODEL(JMI)
IF (CPROGRAM/='SPEC ') THEN
- CALL INI_MODEL_n(JMI,YLUOUT(JMI),LUNIT_MODEL(JMI)%TINIFILE)
+ CALL INI_MODEL_n(JMI,LUNIT_MODEL(JMI)%TINIFILE)
!Call necessary to update the TFIELDLIST pointers to the data
CALL FIELDLIST_GOTO_MODEL(JMI,JMI)
ELSE
- CALL INI_SPECTRE_n(JMI,YLUOUT(JMI),LUNIT_MODEL(JMI)%TINIFILE)
+ CALL INI_SPECTRE_n(JMI,LUNIT_MODEL(JMI)%TINIFILE)
END IF
END DO
!
diff --git a/src/MNH/init_salt.f90 b/src/MNH/init_salt.f90
new file mode 100644
index 0000000000000000000000000000000000000000..8576133e95103e1c696a7ff7482cb590ddfdfa4a
--- /dev/null
+++ b/src/MNH/init_salt.f90
@@ -0,0 +1,74 @@
+!ORILAM_LIC Copyright 1994-2014 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.
+!-----------------------------------------------------------------
+
+!! ######################
+ SUBROUTINE INIT_SALT
+!! ######################
+! PURPOSE
+!! -------
+!!
+!! initialization of variables for the sea salt scheme
+!!
+!! METHOD
+!! ------
+!!
+!!
+!! REFERENCE
+!! ---------
+!! none
+!!
+!!
+!! AUTHOR
+!! ------
+!! Marine Claeys (CNRM)
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+!
+USE MODD_SALT
+!
+IMPLICIT NONE
+
+IF(NMODE_SLT == 5) THEN
+
+!JPSALTORDER = (/5, 4, 3, 2, 1 /)
+!Initial dry number median radius (um) from Ova et al., 2014
+XINIRADIUS_SLT= (/0.009, 0.021, 0.045, 0.115, 0.415/)
+!Initial, standard deviation from Ova et al., 2014
+XINISIG_SLT = (/ 1.37, 1.5, 1.42, 1.53, 1.85 /)
+!Minimum allowed number concentration for any mode (#/m3)
+XN0MIN_SLT = (/1. , 1., 1., 1., 1. /)
+
+
+ELSE IF ( NMODE_SLT == 3) THEN
+
+! Set the order of the loops sorted by importance
+!This means that if a user choses 1 mode it will have characteristics of mode 2
+!2 modes will be mode 2 & 3, whereas 3 modes will modes 1, 2 and 3
+!JPSALTORDER = (/3, 2, 1, 4, 5/)
+!
+ !Initial dry number median radius (um) from Vignati et al., 2001
+ ! XINIRADIUS_SLT= (/0.2, 2., 12./)
+ !Initial, standard deviation from Vignati et al., 2001
+ ! XINISIG_SLT = (/1.9, 2., 3./)
+ !Minimum allowed number concentration for any mode (#/m3)
+ ! XN0MIN_SLT = (/1.e1 , 1. , 1.e-4 /)
+
+
+!Pour 3 modes Schultz
+!Initial dry number median radius (um) from Schultz et al., 2004
+ XINIRADIUS_SLT= 0.5*(/0.28, 2.25, 15.32, 0., 0. /)
+!Initial, standard deviation from Schultz et al., 2004
+ XINISIG_SLT = (/1.9, 2., 2., 0., 0./)
+!Minimum allowed number concentration for any mode (#/m3)
+ XN0MIN_SLT = (/1.e1 , 1. , 1.e-4, 0., 0. /)
+!
+END IF
+
+
+END SUBROUTINE INIT_SALT
diff --git a/src/MNH/khko_notadjust.f90 b/src/MNH/khko_notadjust.f90
index a1cf0d41ea97992600d3e8deb9371b398d7a9b3f..2cd179fc58e0933e5c913c3cc8dc6c57f26b88a0 100644
--- a/src/MNH/khko_notadjust.f90
+++ b/src/MNH/khko_notadjust.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
PTHS, PRVS, PRCS, PRRS, PCCS, PCNUCS, PSAT, &
PCLDFR, PSRCS, PNPRO,PSSPRO )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
INTEGER, INTENT(IN) :: KTCOUNT ! Number of moist variables
@@ -99,7 +99,7 @@ END MODULE MODI_KHKO_NOTADJUST
USE MODD_BUDGET
USE MODD_CONF
USE MODD_CST
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_NSV, ONLY: NSV_C2R2BEG
USE MODD_PARAMETERS
@@ -107,8 +107,7 @@ USE MODD_RAIN_C2R2_DESCR, ONLY: XRTMIN
!
USE MODE_FIELD, ONLY: TFIELDDATA,TYPEREAL
-USE MODE_FMWRIT
-USE MODE_IO_ll
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_MSG
!
USE MODI_BUDGET
@@ -391,7 +390,7 @@ IF ( OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK)
!
TZFIELD%CMNHNAME = 'ACT_OD'
TZFIELD%CSTDNAME = ''
@@ -403,7 +402,7 @@ IF ( OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZACT)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZACT)
END IF
!
!* 7. STORE THE BUDGET TERMS
diff --git a/src/MNH/latlon_to_xy.f90 b/src/MNH/latlon_to_xy.f90
index eea3c591efb37e1539b6864dd95473b7420a98d7..0b6d8b6584f6b28eae20d160e00abd9ac8de2824 100644
--- a/src/MNH/latlon_to_xy.f90
+++ b/src/MNH/latlon_to_xy.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ####################
@@ -55,27 +55,28 @@
!! 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 07/02/2019: force TYPE to a known value for IO_File_add2list
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
! -----------
!
-USE MODD_GRID
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_GRID
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PGDDIM
USE MODD_PGDGRID
USE MODD_PARAMETERS
USE MODD_LUNIT
!
-USE MODE_FM
USE MODE_GRIDPROJ
-USE MODE_IO_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY : IO_FILE_ADD2LIST
+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
!
USE MODI_INI_CST
USE MODI_READ_HGRID
!
-USE MODN_CONFIO, ONLY : NAM_CONFIO
+USE MODN_CONFIO, ONLY: NAM_CONFIO
!
IMPLICIT NONE
!
@@ -118,22 +119,22 @@ CALL INI_CST
!* 2. Reading of namelist file
! ------------------------
!
-CALL INITIO_ll()
+CALL IO_Init()
!
-CALL IO_FILE_ADD2LIST(TZNMLFILE,'LATLON2XY1.nam','NML','READ')
-CALL IO_FILE_OPEN_ll(TZNMLFILE)
+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 SET_CONFIO_ll()
-CALL IO_FILE_CLOSE_ll(TZNMLFILE)
+CALL IO_Config_set()
+CALL IO_File_close(TZNMLFILE)
!
!* 1. Opening of MESONH file
! ----------------------
!
-CALL IO_FILE_ADD2LIST(TZINIFILE,TRIM(YINIFILE),'UNKNOWN','READ',KLFITYPE=2,KLFIVERB=2)
-CALL IO_FILE_OPEN_ll(TZINIFILE)
+CALL IO_File_add2list(TZINIFILE,TRIM(YINIFILE),'MNH','READ',KLFITYPE=2,KLFIVERB=2)
+CALL IO_File_open(TZINIFILE)
!
!* 2. Reading of MESONH file
! ----------------------
@@ -143,7 +144,7 @@ CALL READ_HGRID(0,TZINIFILE,YNAME,YDAD,YSTORAGE_TYPE)
!* 3. Closing of MESONH file
! ----------------------
!
-CALL IO_FILE_CLOSE_ll(TZINIFILE)
+CALL IO_File_close(TZINIFILE)
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/les_specn.f90 b/src/MNH/les_specn.f90
index be4c3b404dde16e6273c615e8af11f35ec08f8ab..d95300068acd362bb731f6c51a9f656b56df3205 100644
--- a/src/MNH/les_specn.f90
+++ b/src/MNH/les_specn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-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.
!-----------------------------------------------------------------
! ######################
@@ -58,7 +58,7 @@ CONTAINS
USE MODD_CONF
USE MODD_CONF_n
USE MODD_GRID_n
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LBC_n, ONLY: CLBCX, CLBCY
USE MODD_LES
USE MODD_LES_n
diff --git a/src/MNH/les_ver_int.f90 b/src/MNH/les_ver_int.f90
index aa1b2ac0c5198ca2b6383f16c081d8e6443d0910..09740547c672e7ef85aad17984758df89ea14e7f 100644
--- a/src/MNH/les_ver_int.f90
+++ b/src/MNH/les_ver_int.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-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 les 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ################
MODULE MODI_LES_VER_INT
! ################
@@ -68,6 +63,7 @@ END MODULE MODI_LES_VER_INT
!! MODIFICATIONS
!! -------------
!! Original 07/02/00
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!! --------------------------------------------------------------------------
!
@@ -78,6 +74,7 @@ USE MODD_LES
USE MODD_PARAMETERS
!
USE MODE_ll
+use mode_msg
!
USE MODI_VER_INTERP_LIN
!
@@ -107,10 +104,7 @@ ELSE IF (CLES_LEVEL_TYPE=='Z') THEN
PA_LES = XUNDEF
END WHERE
ELSE
- PRINT*, '-------> STOP in LES_VER_INT <----------'
-!callabortstop
-CALL ABORT
- STOP
+ call Print_msg(NVERB_FATAL,'GEN','LES_VER_INT','invalid CLES_LEVEL_TYPE ('//trim(CLES_LEVEL_TYPE)//')')
END IF
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/lesn.f90 b/src/MNH/lesn.f90
index eea67385bf0d09f146943e76e2dd50fc7fdaaaac..3eae3fc04d59c273e750b89bb0ef769ad7e3d3f9 100644
--- a/src/MNH/lesn.f90
+++ b/src/MNH/lesn.f90
@@ -42,6 +42,7 @@
!! 10/14 (C.Lac) Correction on user masks
!! 10/16 (C.Lac) Add ground droplet deposition amount
!! 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
!!
!! --------------------------------------------------------------------------
!
@@ -107,6 +108,7 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEW
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZINDCLD !indice cloud si rc>0
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZINDCLD2 !indice cloud rc>1E-5
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCLDFR_LES! CLDFR on LES vertical grid
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRAINFR_LES! RAINFR on LES vertical grid
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZMASSF ! massflux=rho*w
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZREHU ! relative humidity
@@ -333,12 +335,14 @@ IF (LUSERR) THEN
ALLOCATE(ZRWP_LES(IIU,IJU))
ALLOCATE(ZINPRR3D_LES (IIU,IJU,NLES_K))
ALLOCATE(ZEVAP3D_LES (IIU,IJU,NLES_K))
+ ALLOCATE(ZRAINFR_LES(IIU,IJU,NLES_K))
ELSE
ALLOCATE(ZRR_LES (0,0,0))
ALLOCATE(ZMAXWRR2D(0,0))
ALLOCATE(ZRWP_LES(0,0))
ALLOCATE(ZINPRR3D_LES(0,0,0))
ALLOCATE(ZEVAP3D_LES(0,0,0))
+ ALLOCATE(ZRAINFR_LES(0,0,0))
END IF
IF (LUSERI) THEN
ALLOCATE(ZRI_LES (IIU,IJU,NLES_K))
@@ -554,6 +558,7 @@ IF (LUSERR) THEN
CALL LES_VER_INT( XRT(:,:,:,IRR) ,ZRR_LES )
CALL LES_VER_INT( XINPRR3D(:,:,:), ZINPRR3D_LES)
CALL LES_VER_INT( XEVAP3D(:,:,:), ZEVAP3D_LES)
+ CALL LES_VER_INT( XRAINFR(:,:,:) ,ZRAINFR_LES )
END IF
IF (LUSERC) THEN
DO JJ=1,IJU
@@ -779,6 +784,8 @@ END IF
XLES_ACPRR(NLES_CURRENT_TCOUNT) )
! conversion de m en mm
XLES_ACPRR(NLES_CURRENT_TCOUNT)=XLES_ACPRR(NLES_CURRENT_TCOUNT)*1000.
+ CALL LES_MEAN_ll ( ZRAINFR_LES, LLES_CURRENT_CART_MASK, &
+ XLES_MEAN_RF(:,NLES_CURRENT_TCOUNT,1) )
ENDIF
!
@@ -1041,6 +1048,7 @@ DEALLOCATE(ZINDCLD2 )
DEALLOCATE(ZINDCLD2D )
DEALLOCATE(ZINDCLD2D2)
DEALLOCATE(ZCLDFR_LES)
+DEALLOCATE(ZRAINFR_LES)
DEALLOCATE(ZMASSF )
DEALLOCATE(ZTEMP )
DEALLOCATE(ZREHU )
diff --git a/src/MNH/lima.f90 b/src/MNH/lima.f90
index d9149be2aa1406d01b7baf65d4aab9f8ea5112a3..7da0841e1b8fde7218257de8d6d111012caebb24 100644
--- a/src/MNH/lima.f90
+++ b/src/MNH/lima.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-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 MODI_LIMA
@@ -18,7 +18,7 @@ INTERFACE
PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, PINPRH, &
PEVAP3D )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KKA !near ground array index
INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
@@ -95,12 +95,13 @@ END MODULE MODI_LIMA
!! -------------
!! Original 15/03/2018
!!
+!! B.Vié 02/2019 : minor correction on budget
!!
!!
!* 0. DECLARATIONS
! ------------
-USE MODD_IO_ll, ONLY: TFILEDATA
-USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_CLOUDPAR_n, ONLY : NSPLITR, NSPLITG
USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
USE MODD_PARAM_LIMA, ONLY : LCOLD, LRAIN, LWARM, NMOD_CCN, NMOD_IFN, NMOD_IMM, LHHONI, &
@@ -640,6 +641,12 @@ Z_CR_CVRC(:,:,:) = 0.
IF (LWARM .AND. LRAIN) THEN
CALL LIMA_DROPS_TO_DROPLETS_CONV(PRHODREF, ZRCS*PTSTEP, ZRRS*PTSTEP, ZCCS*PTSTEP, ZCRS*PTSTEP, &
Z_RR_CVRC, Z_CR_CVRC)
+ !
+ ZRCS(:,:,:) = ZRCS(:,:,:) - Z_RR_CVRC(:,:,:)/PTSTEP
+ 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')
@@ -655,15 +662,15 @@ END IF
ZTHT(:,:,:) = ZTHS(:,:,:) * PTSTEP
ZT(:,:,:) = ZTHT(:,:,:) * ZEXN(:,:,:)
!
-IF ( KRR .GE. 2 ) ZRCT(:,:,:) = ZRCS(:,:,:) * PTSTEP - Z_RR_CVRC(:,:,:)
-IF ( KRR .GE. 3 ) ZRRT(:,:,:) = ZRRS(:,:,:) * PTSTEP + Z_RR_CVRC(:,:,:)
+IF ( KRR .GE. 2 ) ZRCT(:,:,:) = ZRCS(:,:,:) * PTSTEP
+IF ( KRR .GE. 3 ) ZRRT(:,:,:) = ZRRS(:,:,:) * PTSTEP
IF ( KRR .GE. 4 ) ZRIT(:,:,:) = ZRIS(:,:,:) * PTSTEP
IF ( KRR .GE. 5 ) ZRST(:,:,:) = ZRSS(:,:,:) * PTSTEP
IF ( KRR .GE. 6 ) ZRGT(:,:,:) = ZRGS(:,:,:) * PTSTEP
IF ( KRR .GE. 7 ) ZRHT(:,:,:) = ZRHS(:,:,:) * PTSTEP
!
-IF ( LWARM ) ZCCT(:,:,:) = ZCCS(:,:,:) * PTSTEP - Z_CR_CVRC(:,:,:)
-IF ( LWARM .AND. LRAIN ) ZCRT(:,:,:) = ZCRS(:,:,:) * PTSTEP + Z_CR_CVRC(:,:,:)
+IF ( LWARM ) ZCCT(:,:,:) = ZCCS(:,:,:) * PTSTEP
+IF ( LWARM .AND. LRAIN ) ZCRT(:,:,:) = ZCRS(:,:,:) * PTSTEP
IF ( LCOLD ) ZCIT(:,:,:) = ZCIS(:,:,:) * PTSTEP
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/lima_adjust.f90 b/src/MNH/lima_adjust.f90
index 7d20f4f446f510bc6e5d93eae49f61e0d7642fa4..c09f7abd30d5ebdec856a9021d70af90b42166e5 100644
--- a/src/MNH/lima_adjust.f90
+++ b/src/MNH/lima_adjust.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-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.
!-----------------------------------------------------------------
! #######################
@@ -15,7 +15,7 @@ INTERFACE
PRT, PRS, PSVT, PSVS, &
PTHS, PSRCS, PCLDFR )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
INTEGER, INTENT(IN) :: KMI ! Model index
@@ -135,6 +135,7 @@ END MODULE MODI_LIMA_ADJUST
!! 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 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!-------------------------------------------------------------------------------
!
@@ -144,8 +145,8 @@ END MODULE MODI_LIMA_ADJUST
USE MODD_BUDGET
USE MODD_CONF
USE MODD_CST
-USE MODD_IO_ll, ONLY: TFILEDATA
-USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_NSV
USE MODD_PARAMETERS
USE MODD_PARAM_LIMA
@@ -153,9 +154,9 @@ USE MODD_PARAM_LIMA_COLD
USE MODD_PARAM_LIMA_MIXED
USE MODD_PARAM_LIMA_WARM
!
-USE MODE_FIELD, ONLY : TFIELDDATA, TYPEREAL
-USE MODE_FM
-USE MODE_FMWRIT
+USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+use mode_msg
!
USE MODI_BUDGET
USE MODI_CONDENS
@@ -421,10 +422,7 @@ DO JITER =1,ITERMAX
! ---------------------------------------
!
IF ( OSUBG_COND ) THEN
-!
-! not yet available
-!
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'LIMA_ADJUST', 'OSUBG_COND=.true. not yet developed' )
ELSE
!
!-------------------------------------------------------------------------------
@@ -1133,7 +1131,7 @@ IF ( OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZW)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZW)
END IF
!
!
@@ -1188,7 +1186,7 @@ IF ( OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZW)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZW)
END IF
!
!
diff --git a/src/MNH/lima_ccn_activation.f90 b/src/MNH/lima_ccn_activation.f90
index 884c98379005ec3379a966730f7c275d3ac1fbc2..8ddde4450d5882b37d7a0b328e087f00de386202 100644
--- a/src/MNH/lima_ccn_activation.f90
+++ b/src/MNH/lima_ccn_activation.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-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 MODI_LIMA_CCN_ACTIVATION
! ###############################
@@ -10,7 +11,7 @@ INTERFACE
SUBROUTINE LIMA_CCN_ACTIVATION (PTSTEP, TPFILE, OCLOSE_OUT, &
PRHODREF, PEXNREF, PPABST, ZT, ZTM, PW_NU, &
PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT )
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
REAL, INTENT(IN) :: PTSTEP ! Double Time step
! (single if cold start)
@@ -86,26 +87,26 @@ END MODULE MODI_LIMA_CCN_ACTIVATION
!! MODIFICATIONS
!! -------------
!! Original ??/??/13
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
-USE MODD_CST, ONLY : XALPW, XBETAW, XCL, XCPD, XCPV, XGAMW, XLVTT, XMD, XMV, XRV, XTT
-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_PARAMETERS, ONLY: JPHEXT, JPVEXT
+USE MODD_CST, ONLY: XALPW, XBETAW, XCL, XCPD, XCPV, XGAMW, XLVTT, XMD, XMV, XRV, XTT
+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 MODI_GAMMA
USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
!
-USE MODD_IO_ll, ONLY: TFILEDATA
-USE MODD_LUNIT_n, ONLY : TLUOUT
-USE MODE_FIELD, ONLY : TFIELDDATA, TYPEREAL
-USE MODE_FM
-USE MODE_FMWRIT
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
!
IMPLICIT NONE
!
@@ -467,19 +468,19 @@ IF ( OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZW)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZW)
!
TZFIELD%CMNHNAME ='NACT'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = '/kg'
+ TZFIELD%CUNITS = 'kg-1'
TZFIELD%CDIR = 'XY'
TZFIELD%CCOMMENT = 'X_Y_Z_NACT'
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZW2)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZW2)
END IF
!
!
@@ -539,6 +540,8 @@ CONTAINS
!* 0. DECLARATIONS
!
!
+use mode_msg
+!
IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
@@ -606,8 +609,6 @@ DO JL = 1, NPTS
PRINT*, 'PX2 ALWAYS too small, we put a greater one : PX2 =',PX2
fh(JL) = SINGL_FUNCSMAX(PX2,PZZW3(JL),JL)
go to 100
- print*, 'PZRIDDR: never get here'
- STOP
end if
if (abs(xh-xl) <= PXACC) then
GO TO 101
@@ -619,8 +620,7 @@ DO JL = 1, NPTS
!!$ endif
!!SB
end do
- print*, 'PZRIDDR: exceeded maximum iterations',j
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'ZRIDDR', 'exceeded maximum iterations' )
else if (fl(JL) == 0.0) then
PZRIDDR(JL)=PX1
else if (fh(JL) == 0.0) then
diff --git a/src/MNH/lima_nucleation_procs.f90 b/src/MNH/lima_nucleation_procs.f90
index f18b785891f504006028159932e2bcacd722d1d8..e3efc478d7c83f49440a8f7c344103bd4ec19768 100644
--- a/src/MNH/lima_nucleation_procs.f90
+++ b/src/MNH/lima_nucleation_procs.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2018-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 MODI_LIMA_NUCLEATION_PROCS
! ###############################
@@ -13,7 +14,7 @@ INTERFACE
PCCT, PCRT, PCIT, &
PNFT, PNAT, PIFT, PINT, PNIT, PNHT )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
REAL, INTENT(IN) :: PTSTEP ! Double Time step
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
@@ -78,7 +79,7 @@ USE MODD_BUDGET, ONLY : LBU_ENABLE, LBUDGET_TH, LBUDGET_RV, LBUDGET_RC, LBUD
USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_FREE, &
NSV_LIMA_NI, NSV_LIMA_IFN_FREE
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODI_BUDGET
USE MODI_LIMA_CCN_ACTIVATION
USE MODI_LIMA_PHILLIPS_IFN_NUCLEATION
diff --git a/src/MNH/lima_sedimentation.f90 b/src/MNH/lima_sedimentation.f90
index ab0ebebcacad806e971b9dd53cf218122dc3590c..36b173a84f6ddf84e9e7a3732007891dca1b5b48 100644
--- a/src/MNH/lima_sedimentation.f90
+++ b/src/MNH/lima_sedimentation.f90
@@ -61,6 +61,7 @@ END MODULE MODI_LIMA_SEDIMENTATION
!! -------------
!! Original 15/03/2018
!!
+!! B.Vie 02/2019 Desactivate (comment) the heat transport by droplets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -205,14 +206,14 @@ DO JN = 1 , NSPLITSED(KID)
IF (KMOMENTS==2) PCS(:,:,JK) = PCS(:,:,JK) + ZW(:,:,JK)* &
(ZWSEDC(:,:,JK+KKL)-ZWSEDC(:,:,JK))/PRHODREF(:,:,JK)
! Heat transport
- PRT_SUM(:,:,JK-KKL) = PRT_SUM(:,:,JK-KKL) + ZW(:,:,JK-KKL)*ZWSEDR(:,:,JK)/PRHODREF(:,:,JK-KKL)
- PRT_SUM(:,:,JK) = PRT_SUM(:,:,JK) - ZW(:,:,JK)*ZWSEDR(:,:,JK)/PRHODREF(:,:,JK)
- PCPT(:,:,JK-KKL) = PCPT(:,:,JK-KKL) + ZC * (ZW(:,:,JK-KKL)*ZWSEDR(:,:,JK)/PRHODREF(:,:,JK-KKL))
- PCPT(:,:,JK) = PCPT(:,:,JK) - ZC * (ZW(:,:,JK)*ZWSEDR(:,:,JK)/PRHODREF(:,:,JK))
- ZWDT(:,:,JK) =(PRHODREF(:,:,JK+KKL)*(1.+PRT_SUM(:,:,JK))*PCPT(:,:,JK)*PT(:,:,JK) + &
- ZW(:,:,JK)*ZWSEDR(:,:,JK+1)*ZC*PT(:,:,JK+KKL)) / &
- (PRHODREF(:,:,JK+KKL)*(1.+PRT_SUM(:,:,JK))*PCPT(:,:,JK) + ZW(:,:,JK)*ZWSEDR(:,:,JK+KKL)*ZC)
- ZWDT(:,:,JK) = ZWDT(:,:,JK) - PT(:,:,JK)
+ !PRT_SUM(:,:,JK-KKL) = PRT_SUM(:,:,JK-KKL) + ZW(:,:,JK-KKL)*ZWSEDR(:,:,JK)/PRHODREF(:,:,JK-KKL)
+ !PRT_SUM(:,:,JK) = PRT_SUM(:,:,JK) - ZW(:,:,JK)*ZWSEDR(:,:,JK)/PRHODREF(:,:,JK)
+ !PCPT(:,:,JK-KKL) = PCPT(:,:,JK-KKL) + ZC * (ZW(:,:,JK-KKL)*ZWSEDR(:,:,JK)/PRHODREF(:,:,JK-KKL))
+ !PCPT(:,:,JK) = PCPT(:,:,JK) - ZC * (ZW(:,:,JK)*ZWSEDR(:,:,JK)/PRHODREF(:,:,JK))
+ !ZWDT(:,:,JK) =(PRHODREF(:,:,JK+KKL)*(1.+PRT_SUM(:,:,JK))*PCPT(:,:,JK)*PT(:,:,JK) + &
+ ! ZW(:,:,JK)*ZWSEDR(:,:,JK+1)*ZC*PT(:,:,JK+KKL)) / &
+ ! (PRHODREF(:,:,JK+KKL)*(1.+PRT_SUM(:,:,JK))*PCPT(:,:,JK) + ZW(:,:,JK)*ZWSEDR(:,:,JK+KKL)*ZC)
+ !ZWDT(:,:,JK) = ZWDT(:,:,JK) - PT(:,:,JK)
END DO
DEALLOCATE(ZRHODREF)
DEALLOCATE(ZPABST)
diff --git a/src/MNH/lima_warm.f90 b/src/MNH/lima_warm.f90
index 35961b3ba0a6cea51ad80c2935d0dce7c67377c7..1ac67f3ce0e7830f0112bad40bf766dbcb0fd783 100644
--- a/src/MNH/lima_warm.f90
+++ b/src/MNH/lima_warm.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-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.
!-----------------------------------------------------------------
! #####################
@@ -16,7 +16,7 @@ INTERFACE
PTHS, PRS, PSVS, &
PINPRC, PINPRR, PINDEP, PINPRR3D, PEVAP3D )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the
! activation by radiative
@@ -144,14 +144,11 @@ USE MODD_NSV
USE MODD_BUDGET
USE MODI_BUDGET
!
-USE MODE_FM
-USE MODE_FMWRIT
-!
USE MODI_LIMA_WARM_SEDIMENTATION
USE MODI_LIMA_WARM_NUCL
USE MODI_LIMA_WARM_COAL
USE MODI_LIMA_WARM_EVAP
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT_n, ONLY: TLUOUT
!
IMPLICIT NONE
diff --git a/src/MNH/lima_warm_nucl.f90 b/src/MNH/lima_warm_nucl.f90
index 66b235e485fe9105fbbff74cb47cca091c47080b..abe784f5633f24ef36507bee97f0fd8a80bae368 100644
--- a/src/MNH/lima_warm_nucl.f90
+++ b/src/MNH/lima_warm_nucl.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-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.
!-----------------------------------------------------------------
! ##########################
@@ -13,7 +13,7 @@ INTERFACE
PRCM, PRVT, PRCT, PRRT, &
PTHS, PRVS, PRCS, PCCS, PNFS, PNAS )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the
! activation by radiative
@@ -102,25 +102,25 @@ END MODULE MODI_LIMA_WARM_NUCL
!! Original ??/??/13
!! J. Escobar : 10/2017 , for real*4 use XMNH_EPSILON
!! 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
!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
+USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
USE MODD_CST
USE MODD_PARAM_LIMA
USE MODD_PARAM_LIMA_WARM
!
USE MODI_GAMMA
-USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
+USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
!
-USE MODE_FM
-USE MODE_FMWRIT
-USE MODD_IO_ll, ONLY: TFILEDATA
-USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODE_FIELD, ONLY : TFIELDDATA, TYPEREAL
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODE_FIELD, ONLY : TFIELDDATA, TYPEREAL
!
IMPLICIT NONE
!
@@ -132,7 +132,7 @@ LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the
REAL, INTENT(IN) :: PTSTEP ! Double Time step
! (single if cold start)
INTEGER, INTENT(IN) :: KMI ! Model index
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
! the output FM file
!
@@ -535,19 +535,19 @@ IF ( OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZW)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZW)
!
TZFIELD%CMNHNAME ='NACT'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = '/kg'
+ TZFIELD%CUNITS = 'kg-1'
TZFIELD%CDIR = 'XY'
TZFIELD%CCOMMENT = 'X_Y_Z_NACT'
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZW2)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZW2)
END IF
!
!
@@ -607,6 +607,8 @@ CONTAINS
!* 0. DECLARATIONS
!
!
+use mode_msg
+!
IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
@@ -674,7 +676,6 @@ DO JL = 1, NPTS
PRINT*, 'PX2 ALWAYS too small, we put a greater one : PX2 =',PX2
fh(JL) = SINGL_FUNCSMAX(PX2,PZZW3(JL),JL)
go to 100
- STOP
end if
if (abs(xh-xl) <= PXACC) then
GO TO 101
@@ -686,7 +687,7 @@ DO JL = 1, NPTS
!!$ endif
!!SB
end do
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'ZRIDDR', 'exceeded maximum iterations' )
else if (fl(JL) == 0.0) then
PZRIDDR(JL)=PX1
else if (fh(JL) == 0.0) then
diff --git a/src/MNH/lochead.f90 b/src/MNH/lochead.f90
index d77bbadba5dd82483fbe30bacf1e5bcc4c1ec9d1..5bb77e10e11d38be1b544b40841ff5f96d5cf014 100644
--- a/src/MNH/lochead.f90
+++ b/src/MNH/lochead.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ###################
@@ -77,9 +77,9 @@ END MODULE MODI_LOCHEAD
!* 0. DECLARATION
! -----------
!
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
-USE MODE_IO_MANAGE_STRUCT, ONLY : IO_FILE_FIND_BYNAME
+USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_find_byname
!
IMPLICIT NONE
!
@@ -125,7 +125,7 @@ TYPE(TFILEDATA),POINTER :: TZFILE
!-------------------------------------------------------------------------------
!
IF (ODATASAVE) THEN
- CALL IO_FILE_FIND_BYNAME(HSAVEDDATAFILE,TZFILE,IRESP)
+ CALL IO_File_find_byname(HSAVEDDATAFILE,TZFILE,IRESP)
ISAVE = TZFILE%NLU
END IF
!
diff --git a/src/MNH/ls_coupling.f90 b/src/MNH/ls_coupling.f90
index b2d17436aded6339a4c727650852033aaa8ac48d..9af87a483a3b5cc7bcdd6c6c4b5c4bbc0b9a467d 100644
--- a/src/MNH/ls_coupling.f90
+++ b/src/MNH/ls_coupling.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ##############################
@@ -17,10 +17,10 @@ INTERFACE
KSIZELBX_ll,KSIZELBXU_ll,KSIZELBY_ll,KSIZELBYV_ll, &
KSIZELBXTKE_ll,KSIZELBYTKE_ll, &
KSIZELBXR_ll,KSIZELBYR_ll,KSIZELBXSV_ll,KSIZELBYSV_ll, &
- PLSUM,PLSVM,PLSWM, PLSTHM,PLSRVM,PDRYMASST, &
+ PLSUM,PLSVM,PLSWM, PLSTHM,PLSRVM,PLSZWSM,PDRYMASST, &
PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, &
PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, &
- PLSUS,PLSVS,PLSWS,PLSTHS,PLSRVS,PDRYMASSS, &
+ PLSUS,PLSVS,PLSWS,PLSTHS,PLSRVS,PLSZWSS,PDRYMASSS, &
PLBXUS,PLBXVS,PLBXWS,PLBXTHS,PLBXTKES,PLBXRS,PLBXSVS, &
PLBYUS,PLBYVS,PLBYWS,PLBYTHS,PLBYTKES,PLBYRS,PLBYSVS )
!
@@ -52,6 +52,7 @@ INTEGER, INTENT(IN) :: KSIZELBYR_ll,KSIZELBYSV_ll ! for Rx and SV
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSUM,PLSVM,PLSWM ! Large Scale
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSTHM, PLSRVM ! fields at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PLSZWSM ! fields at t-dt
REAL, INTENT(IN) :: PDRYMASST ! Mass of dry air Md
! larger scale fields for Lateral Boundary condition
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUM,PLBXVM,PLBXWM ! Wind
@@ -65,6 +66,7 @@ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRM ,PLBYSVM ! in x and y-di
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSUS,PLSVS,PLSWS ! Large Scale
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSTHS,PLSRVS ! source terms
+REAL, DIMENSION(:,:), INTENT(OUT) :: PLSZWSS ! source terms
REAL, INTENT(OUT) :: PDRYMASSS ! Md source
! larger scale fields sources for Lateral Boundary condition
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXUS,PLBXVS,PLBXWS ! Wind
@@ -95,10 +97,10 @@ END MODULE MODI_LS_COUPLING
KSIZELBX_ll,KSIZELBXU_ll,KSIZELBY_ll,KSIZELBYV_ll, &
KSIZELBXTKE_ll,KSIZELBYTKE_ll, &
KSIZELBXR_ll,KSIZELBYR_ll,KSIZELBXSV_ll,KSIZELBYSV_ll, &
- PLSUM,PLSVM,PLSWM, PLSTHM,PLSRVM,PDRYMASST, &
+ PLSUM,PLSVM,PLSWM, PLSTHM,PLSRVM,PLSZWSM,PDRYMASST, &
PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, &
PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, &
- PLSUS,PLSVS,PLSWS,PLSTHS,PLSRVS,PDRYMASSS, &
+ PLSUS,PLSVS,PLSWS,PLSTHS,PLSRVS,PLSZWSS,PDRYMASSS, &
PLBXUS,PLBXVS,PLBXWS,PLBXTHS,PLBXTKES,PLBXRS,PLBXSVS, &
PLBYUS,PLBYVS,PLBYWS,PLBYTHS,PLBYTKES,PLBYRS,PLBYSVS )
! ######################################################################
@@ -124,8 +126,8 @@ END MODULE MODI_LS_COUPLING
!!
!! EXTERNAL
!! --------
-!! IO_READ_FIELD : to read data in file
-!! IO_FILE_CLOSE_ll : to close a file
+!! IO_Field_read : to read data in file
+!! IO_File_close : to close a file
!! INI_LS : to initialize larger scale fields
!! INI_LB : to initialize "2D" surfacic LB fields
!!
@@ -171,6 +173,7 @@ END MODULE MODI_LS_COUPLING
!! 05/2006 Remove KEPS
!! 2/2014 (escobar) add paspol for Forefire
! 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
!!
!------------------------------------------------------------------------------
!
@@ -186,9 +189,8 @@ USE MODD_PASPOL
#endif
USE MODD_CH_MNHC_n
!
-USE MODE_FM
-USE MODE_FMREAD
-USE MODE_IO_ll
+USE MODE_IO_FIELD_READ, only: IO_Field_read
+USE MODE_IO_FILE, only: IO_File_close
USE MODE_MSG
!
USE MODI_INI_LS
@@ -228,6 +230,7 @@ INTEGER, INTENT(IN) :: KSIZELBYR_ll,KSIZELBYSV_ll ! for Rx and SV
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSUM,PLSVM,PLSWM ! Large Scale
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSTHM, PLSRVM ! fields at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PLSZWSM
REAL, INTENT(IN) :: PDRYMASST ! Mass of dry air Md
! larger scale fields for Lateral Boundary condition
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUM,PLBXVM,PLBXWM ! Wind
@@ -251,6 +254,7 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXTKES ! TKE
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYTKES
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PLBXRS ,PLBXSVS ! Moisture and SV
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PLBYRS ,PLBYSVS ! in x and y-dir.
+REAL, DIMENSION(:,:), INTENT(OUT) :: PLSZWSS ! source terms
!
!
!* 0.2 declarations of local variables
@@ -274,9 +278,9 @@ LOGICAL :: GLSOURCE ! switch for the source term (for ini_ls and i
!
!* 1.1 Check dimensions
!
-CALL IO_READ_FIELD(TCPLFILE(NCPL_CUR)%TZFILE,'IMAX',IIMAX)
-CALL IO_READ_FIELD(TCPLFILE(NCPL_CUR)%TZFILE,'JMAX',IJMAX)
-CALL IO_READ_FIELD(TCPLFILE(NCPL_CUR)%TZFILE,'KMAX',IKMAX)
+CALL IO_Field_read(TCPLFILE(NCPL_CUR)%TZFILE,'IMAX',IIMAX)
+CALL IO_Field_read(TCPLFILE(NCPL_CUR)%TZFILE,'JMAX',IJMAX)
+CALL IO_Field_read(TCPLFILE(NCPL_CUR)%TZFILE,'KMAX',IKMAX)
!
IKU=SIZE(PLSTHM,3)
!
@@ -298,7 +302,7 @@ GLSOURCE=.TRUE.
ZLENG = (NCPL_TIMES(NCPL_CUR,1) - NCPL_TIMES(NCPL_CUR-1,1)) * PTSTEP
!
CALL INI_LS(TCPLFILE(NCPL_CUR)%TZFILE,HGETRVM,GLSOURCE,PLSUS,PLSVS,PLSWS,PLSTHS,PLSRVS, &
- PDRYMASSS,PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM,PDRYMASST,ZLENG,OSTEADY_DMASS)
+ PLSZWSS, PDRYMASSS,PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM,PLSZWSM,PDRYMASST,ZLENG,OSTEADY_DMASS)
!
!
@@ -345,7 +349,7 @@ CALL INI_LB(TCPLFILE(NCPL_CUR)%TZFILE,GLSOURCE,KSV, &
!
!* 1.4 Close the coupling file
!
-CALL IO_FILE_CLOSE_ll(TCPLFILE(NCPL_CUR)%TZFILE)
+CALL IO_File_close(TCPLFILE(NCPL_CUR)%TZFILE)
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/mean_prof.f90 b/src/MNH/mean_prof.f90
index 121f80c25dd36b8a5987ce896942de2afe7d2f8b..773ee9a8c5c3c293871c5cae788c6c2360787ff4 100644
--- a/src/MNH/mean_prof.f90
+++ b/src/MNH/mean_prof.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #####################
@@ -62,7 +62,7 @@ END MODULE MODI_MEAN_PROF
!! 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
-!! CLUOUT0 : name of output-listing
+!! TLUOUT0 : name of output-listing
!! Module MODD_GRID1 : contains grid variables for model1
!! XZS : orography of MESO-NH
!! XZHAT : GS levels
diff --git a/src/MNH/menu_diachro.f90 b/src/MNH/menu_diachro.f90
index b9147f3b2baca464518ab16e91bdf08b0bca260c..7cf66861c15bf5c3e13f8b2e2045c2be7835e157 100644
--- a/src/MNH/menu_diachro.f90
+++ b/src/MNH/menu_diachro.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1996-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ##################################################
@@ -54,11 +54,11 @@
! ------------
!
USE MODD_CONF
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, only: TFILEDATA
!
USE MODE_FIELD
-USE MODE_FMREAD
-USE MODE_FMWRIT
+USE MODE_IO_FIELD_READ, only: IO_Field_read
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
!
IMPLICIT NONE
!
@@ -103,7 +103,7 @@ IF(HGROUP == 'END')THEN
TZFIELD%NTYPE = TYPEINT
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPDIAFILE,TZFIELD,ILENG)
+ CALL IO_Field_write(TPDIAFILE,TZFIELD,ILENG)
ALLOCATE(ITABCHAR(ILENG))
DO JJ=1,IGROUP
@@ -122,7 +122,7 @@ IF(HGROUP == 'END')THEN
TZFIELD%NTYPE = TYPEINT
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPDIAFILE,TZFIELD,ITABCHAR)
+ CALL IO_Field_write(TPDIAFILE,TZFIELD,ITABCHAR)
DEALLOCATE(ITABCHAR)
@@ -138,7 +138,7 @@ ELSE IF(HGROUP == 'READ')THEN
TZFIELD%NTYPE = TYPEINT
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_READ_FIELD(TPDIAFILE,TZFIELD,ILENG,IRESPDIA)
+ CALL IO_Field_read(TPDIAFILE,TZFIELD,ILENG,IRESPDIA)
IF(IRESPDIA == -47)THEN
! print *,' No record MENU_BUDGET '
LPACK=GPACK
@@ -156,7 +156,7 @@ ELSE IF(HGROUP == 'READ')THEN
TZFIELD%NTYPE = TYPEINT
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_READ_FIELD(TPDIAFILE,TZFIELD,ITABCHAR)
+ CALL IO_Field_read(TPDIAFILE,TZFIELD,ITABCHAR)
IGROUP=ILENG/NMNHNAMELGTMAX
DO JJ=1,IGROUP
DO J = 1,NMNHNAMELGTMAX
diff --git a/src/MNH/mesonh.f90 b/src/MNH/mesonh.f90
index b058f104ff5dbfcc4988b5a2d48e067250a7238c..27bd93e2cc2c8f80ad698f4ae9733821ecd29f9d 100644
--- a/src/MNH/mesonh.f90
+++ b/src/MNH/mesonh.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -90,14 +90,14 @@
USE MODD_CONF
USE MODD_NESTING
USE MODD_CONF_n
-USE MODD_IO_ll, ONLY: NIO_VERB,NVERB_DEBUG
+USE MODD_IO, ONLY: NIO_VERB,NVERB_DEBUG
!
USE MODI_MODEL_n
USE MODI_KID_MODEL
!
+USE MODE_IO, only: IO_Init
+USE MODE_IO_MANAGE_STRUCT, only: IO_Filelist_print
USE MODE_ll
-USE MODE_IO_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY : IO_FILE_PRINT_LIST
USE MODE_MODELN_HANDLER
!
USE MODI_VERSION
@@ -144,7 +144,7 @@ CALL GOTO_MODEL(1,ONOFIELDLIST=.TRUE.)
CALL SFX_OASIS_INIT(CNAMELIST, NMNH_COMM_WORLD)
#endif
!
-CALL INITIO_ll()
+CALL IO_Init()
!
CALL VERSION
CPROGRAM='MESONH'
@@ -213,7 +213,7 @@ DO
!
END DO
!
-IF(NIO_VERB>=NVERB_DEBUG) CALL IO_FILE_PRINT_LIST()
+IF(NIO_VERB>=NVERB_DEBUG) CALL IO_Filelist_print()
!
!-------------------------------------------------------------------------------
!
@@ -236,8 +236,4 @@ CALL SURFEX_DEALLO_LIST
!
!-------------------------------------------------------------------------------
!
-!callabortstop
-!CALL ABORT
-STOP
-!
-END PROGRAM MESONH
+END PROGRAM MESONH
diff --git a/src/MNH/mnh2lpdm.f90 b/src/MNH/mnh2lpdm.f90
index 0392d5c3baf6dfc63584573d58f0e7b43b3a0fd5..3bb745967feb6b7aeb33a6dd14696e7fde871088 100644
--- a/src/MNH/mnh2lpdm.f90
+++ b/src/MNH/mnh2lpdm.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 2002-2018 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
PROGRAM MNH2LPDM
! ##############
@@ -13,6 +14,8 @@
! 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 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
!
!-----------------------------------------------------------------------------
!
@@ -24,13 +27,14 @@
!* 0.1 Modules.
!
USE MODD_CONF, ONLY : CPROGRAM
-USE MODD_IO_ll, ONLY : TFILEDATA,TPTR2FILE
+USE MODD_IO, ONLY : TFILEDATA,TPTR2FILE
USE MODD_MNH2LPDM
!
-USE MODE_FM, ONLY: IO_FILE_OPEN_ll,IO_FILE_CLOSE_ll
-USE MODE_IO_ll, ONLY: INITIO_ll,SET_CONFIO_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST
+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
USE MODE_MODELN_HANDLER
+use mode_msg
USE MODE_POS
!
USE MODI_MNH2LPDM_ECH
@@ -73,19 +77,19 @@ CALL GOTO_MODEL(1)
!
!* 1.2 Initialisation routines LL.
!
-CALL INITIO_ll()
+CALL IO_Init()
!
!
!* 1.3 Ouverture du fichier log.
!
-CALL IO_FILE_ADD2LIST(TZLOGFILE,YFLOG,'TXT','WRITE')
-CALL IO_FILE_OPEN_ll(TZLOGFILE)
+CALL IO_File_add2list(TZLOGFILE,YFLOG,'TXT','WRITE')
+CALL IO_File_open(TZLOGFILE)
!
!
!* 1.4 Lecture des namelists.
!
-CALL IO_FILE_ADD2LIST(TZNMLFILE,YFNML,'NML','READ')
-CALL IO_FILE_OPEN_ll(TZNMLFILE)
+CALL IO_File_add2list(TZNMLFILE,YFNML,'NML','READ')
+CALL IO_File_open(TZNMLFILE)
IFNML = TZNMLFILE%NLU
READ(UNIT=IFNML,NML=NAM_TURB)
@@ -99,23 +103,23 @@ END IF
LCDF4 = .FALSE.
LLFIOUT = .FALSE.
LLFIREAD = .FALSE.
-CALL SET_CONFIO_ll()
-CALL IO_FILE_CLOSE_ll(TZNMLFILE)
+CALL IO_Config_set()
+CALL IO_File_close(TZNMLFILE)
!
!
!* 1.5 Comptage des FM a traiter.
!
IF (LEN_TRIM(CFMNH(1))>0) THEN
NBMNH=1
- CALL IO_FILE_ADD2LIST(TZFMNH(1)%TZFILE,TRIM(CFMNH(1)),'UNKNOWN','READ',KLFITYPE=2,KLFIVERB=IVERB)
+ CALL IO_File_add2list(TZFMNH(1)%TZFILE,TRIM(CFMNH(1)),'MNH','READ',KLFITYPE=2,KLFIVERB=IVERB)
DO WHILE (CFMNH(NBMNH+1).NE.'VIDE')
NBMNH=NBMNH+1
- CALL IO_FILE_ADD2LIST(TZFMNH(NBMNH)%TZFILE,TRIM(CFMNH(NBMNH)),'UNKNOWN','READ',KLFITYPE=2,KLFIVERB=IVERB)
+ CALL IO_File_add2list(TZFMNH(NBMNH)%TZFILE,TRIM(CFMNH(NBMNH)),'MNH','READ',KLFITYPE=2,KLFIVERB=IVERB)
END DO
print *,NBMNH,' fichiers a traiter.'
ELSE
- STOP
-ENDIF
+ call Print_msg( NVERB_FATAL, 'GEN', 'MNH2LPDM', 'no CFMNH file given' )
+END IF
!
!
!
@@ -125,10 +129,10 @@ ENDIF
!
!* 2.1 Ouverture des fichiers METEO et GRILLE et DATE.
!
-CALL IO_FILE_ADD2LIST(TZGRIDFILE,CFGRI,'TXT','WRITE')
-CALL IO_FILE_OPEN_ll(TZGRIDFILE)
-CALL IO_FILE_ADD2LIST(TZDATEFILE,CFDAT,'TXT','WRITE')
-CALL IO_FILE_OPEN_ll(TZDATEFILE)
+CALL IO_File_add2list(TZGRIDFILE,CFGRI,'TXT','WRITE')
+CALL IO_File_open(TZGRIDFILE)
+CALL IO_File_add2list(TZDATEFILE,CFDAT,'TXT','WRITE')
+CALL IO_File_open(TZDATEFILE)
!
!
!* 2.2 Preparation du couplage.
@@ -140,20 +144,20 @@ CALL MNH2LPDM_INI(TZFMNH(1)%TZFILE,TZFMNH(NBMNH)%TZFILE,TZLOGFILE,TZGRIDFILE,TZD
!
DO JFIC=1,NBMNH
print*,"CFMTO(JFIC)=",CFMTO(JFIC)
- CALL IO_FILE_ADD2LIST(TZMETEOFILE,CFMTO(JFIC),'METEO','WRITE')
- CALL IO_FILE_OPEN_ll(TZMETEOFILE)
+ CALL IO_File_add2list(TZMETEOFILE,CFMTO(JFIC),'METEO','WRITE')
+ CALL IO_File_open(TZMETEOFILE)
CALL MNH2LPDM_ECH(TZFMNH(JFIC)%TZFILE,TZMETEOFILE)
print*,"CLOSE_LL(CFMTO(JFIC)"
- CALL IO_FILE_CLOSE_ll(TZMETEOFILE)
+ CALL IO_File_close(TZMETEOFILE)
TZMETEOFILE => NULL()
END DO
!
!
!* 2.4 Fermeture des fichiers, METEO, GRILLE et LOG.
!
-CALL IO_FILE_CLOSE_ll(TZGRIDFILE)
-CALL IO_FILE_CLOSE_ll(TZDATEFILE)
-CALL IO_FILE_CLOSE_ll(TZLOGFILE)
+CALL IO_File_close(TZGRIDFILE)
+CALL IO_File_close(TZDATEFILE)
+CALL IO_File_close(TZLOGFILE)
!
!
!
diff --git a/src/MNH/mnh2lpdm_ech.f90 b/src/MNH/mnh2lpdm_ech.f90
index e7b334e84f03eb987c4f812ed9da89a00be84d60..462bd2ae40152741e1e3a3278a32995461bbef7b 100644
--- a/src/MNH/mnh2lpdm_ech.f90
+++ b/src/MNH/mnh2lpdm_ech.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2009-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2009-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
@@ -24,7 +24,7 @@
!
!
USE MODD_DIM_n
-USE MODD_IO_ll,ONLY : TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_TIME_n
USE MODD_GRID_n
!
@@ -34,9 +34,9 @@ USE MODD_TIME
!
USE MODD_MNH2LPDM
!
-USE MODE_FM, ONLY: IO_FILE_CLOSE_ll,IO_FILE_OPEN_ll
-USE MODE_FMREAD
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST
+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
!
USE MODI_INI_CST
!
@@ -76,11 +76,11 @@ IFMTO = TPMETEOFILE%NLU
!
!* 2.1 Ouverture du fichier Meso-NH.
!
-CALL IO_FILE_OPEN_ll(TPFILE)
+CALL IO_File_open(TPFILE)
!
!* 2.2 Date et heure courante.
!
-CALL IO_READ_FIELD(TPFILE,'DTCUR',TZDTCUR)
+CALL IO_Field_read(TPFILE,'DTCUR',TZDTCUR)
!
ICURAA=MOD(TZDTCUR%TDATE%YEAR,100) ! Annee sur 2 caracteres.
ICURMM=TZDTCUR%TDATE%MONTH
@@ -100,28 +100,28 @@ print 20300, ICURJJ,ICURMM,ICURAA,ICURHH,ICURMN,ICURSS
!
!* 2.3 Lecture des champs Meso-NH de base.
!
-CALL IO_READ_FIELD(TPFILE,'UT', XUT)
-CALL IO_READ_FIELD(TPFILE,'VT', XVT)
-CALL IO_READ_FIELD(TPFILE,'WT', XWT)
-CALL IO_READ_FIELD(TPFILE,'THT', XTHT)
-CALL IO_READ_FIELD(TPFILE,'TKET', XTKET)
+CALL IO_Field_read(TPFILE,'UT', XUT)
+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_READ_FIELD(TPFILE,'LM', XLM)
-CALL IO_READ_FIELD(TPFILE,'THW_FLX',XWPTHP)
-CALL IO_READ_FIELD(TPFILE,'DISS', XDISSIP)
-CALL IO_READ_FIELD(TPFILE,'FMU', XSFU)
-CALL IO_READ_FIELD(TPFILE,'FMV', XSFV)
-CALL IO_READ_FIELD(TPFILE,'INPRT', XINRT)
-CALL IO_READ_FIELD(TPFILE,'RVT', XRMVT)
-CALL IO_READ_FIELD(TPFILE,'RCT', XRMCT)
-CALL IO_READ_FIELD(TPFILE,'RRT', XRMRT)
+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)
+CALL IO_Field_read(TPFILE,'INPRT', XINRT)
+CALL IO_Field_read(TPFILE,'RVT', XRMVT)
+CALL IO_Field_read(TPFILE,'RCT', XRMCT)
+CALL IO_Field_read(TPFILE,'RRT', XRMRT)
!
! Lecture des donnees Meso-NH terminee.'
!
!* 2.4 Fermeture du fichier Meso-NH.
!
-CALL IO_FILE_CLOSE_ll(TPFILE)
+CALL IO_File_close(TPFILE)
!
!
!* 3. PREPARATION DES DONNEES.
@@ -376,8 +376,8 @@ XSSFV(:,:) = XSFV(NSIB:NSIE,NSJB:NSJE)
!
IF (IGRILLE.EQ.2) THEN
WRITE(YFTURB,'("TURB_LPDM",5I2.2)') ICURAA,ICURMM,ICURJJ,ICURHH,ICURMN
- CALL IO_FILE_ADD2LIST(TZFILE,YFTURB,'TXT','WRITE')
- CALL IO_FILE_OPEN_ll(TZFILE)
+ CALL IO_File_add2list(TZFILE,YFTURB,'TXT','WRITE')
+ CALL IO_File_open(TZFILE)
IFTURB = TZFILE%NLU
WRITE(UNIT=IFTURB,FMT='(5A12)') "WSTAR ","USTAR ", &
"HMIX ","LMO ", &
@@ -398,7 +398,7 @@ XSSFV(:,:) = XSFV(NSIB:NSIE,NSJB:NSJE)
XSTIMEU(15,15,JK),XSTIMEW(15,15,JK)
ENDDO
- CALL IO_FILE_CLOSE_ll(TZFILE)
+ CALL IO_File_close(TZFILE)
ENDIF
!
diff --git a/src/MNH/mnh2lpdm_ini.f90 b/src/MNH/mnh2lpdm_ini.f90
index f7d71da91d4bcfe5afb33a5d2118af7d8551823f..7c185cfde09ae595c16b0e79bf8b048c1a379b90 100644
--- a/src/MNH/mnh2lpdm_ini.f90
+++ b/src/MNH/mnh2lpdm_ini.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2009-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
SUBROUTINE MNH2LPDM_INI(TPFILE1,TPFILE2,TPLOGFILE,TPGRIDFILE,TPDATEFILE)
@@ -33,7 +33,7 @@ USE MODD_CST
USE MODD_DIM_n
USE MODD_GRID
USE MODD_GRID_n
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT
USE MODD_MNH2LPDM
USE MODD_PARAMETERS
@@ -41,10 +41,9 @@ USE MODD_TIME
USE MODD_TIME_n
!
USE MODE_DATETIME
-USE MODE_FM
-USE MODE_FMREAD
USE MODE_GRIDPROJ
-USE MODE_IO_ll
+USE MODE_IO_FILE, only: IO_File_close, IO_File_open
+USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_MODELN_HANDLER
!
USE MODI_INI_CST
@@ -100,15 +99,15 @@ CALL GOTO_MODEL(1)
!
!* 2.1 Ouverture du fichier Meso-NH.
!
-CALL IO_FILE_OPEN_ll(TPFILE1)
-CALL IO_FILE_OPEN_ll(TPFILE2)
+CALL IO_File_open(TPFILE1)
+CALL IO_File_open(TPFILE2)
!
!
!* 2.2 Date et heure du modele.
!
-CALL IO_READ_FIELD(TPFILE1,'DTEXP',TZDTEXP1)
-CALL IO_READ_FIELD(TPFILE1,'DTCUR',TZDTCUR1)
-CALL IO_READ_FIELD(TPFILE2,'DTCUR',TZDTCUR2)
+CALL IO_Field_read(TPFILE1,'DTEXP',TZDTEXP1)
+CALL IO_Field_read(TPFILE1,'DTCUR',TZDTCUR1)
+CALL IO_Field_read(TPFILE2,'DTCUR',TZDTCUR2)
!
CALL DATETIME_DISTANCE(TZDTEXP1,TZDTCUR1,ZECHEANCE1)
CALL DATETIME_DISTANCE(TZDTEXP1,TZDTCUR2,ZECHEANCE2)
@@ -164,7 +163,7 @@ NJE=NJU-JPHEXT
!
!* 2.4 Nombre de niveaux-verticaux.
!
-CALL IO_READ_FIELD(TPFILE1,'KMAX',NKMAX)
+CALL IO_Field_read(TPFILE1,'KMAX',NKMAX)
!WRITE(IFLOG,*) '%%% MNH2S2_INI Lecture du nombre de niveau OK.'
!
NKU = NKMAX+2*JPVEXT
@@ -194,17 +193,17 @@ ALLOCATE( XSFV(NIU,NJU))
!
!* 2.6 Decoupage vertical.
!
-CALL IO_READ_FIELD(TPFILE1,'ZHAT',XZHAT)
-CALL IO_READ_FIELD(TPFILE1,'ZTOP',XZTOP)
+CALL IO_Field_read(TPFILE1,'ZHAT',XZHAT)
+CALL IO_Field_read(TPFILE1,'ZTOP',XZTOP)
!
!* 2.7 Orographie.
!
-CALL IO_READ_FIELD(TPFILE1,'ZS',XZS)
+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_READ_FIELD(TPFILE1,'Z0',XZ0)
+CALL IO_Field_read(TPFILE1,'Z0',XZ0)
!
XXPTSOMNH=XXHAT(1)+(XXHAT(2)-XXHAT(1))/2
XYPTSOMNH=XYHAT(1)+(XYHAT(2)-XYHAT(1))/2
@@ -435,8 +434,8 @@ DEALLOCATE(XZHAT)
!
! Fermeture du fichier Meso-NH.
!
-CALL IO_FILE_CLOSE_ll(TPFILE1)
-CALL IO_FILE_CLOSE_ll(TPFILE2)
+CALL IO_File_close(TPFILE1)
+CALL IO_File_close(TPFILE2)
!
!
!-------------------------------------------'
diff --git a/src/MNH/mnh_surf_grid_io_init.f90 b/src/MNH/mnh_surf_grid_io_init.f90
index 7c87e7fc09c9c75eff98727e7829c021011e04bd..3da201159b517e57aa352abb1f08c1dd766bd3d2 100644
--- a/src/MNH/mnh_surf_grid_io_init.f90
+++ b/src/MNH/mnh_surf_grid_io_init.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2015-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2015-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.
!-----------------------------------------------------------------
!#######################
@@ -43,19 +43,6 @@ MODULE MODI_MNH_SURF_GRID_IO_INIT
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!----------------------------------------------------------------------------
!
- !* 0. DECLARATION
- ! -----------
- !
- USE MODE_ll
- USE MODE_FM
- USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT, JPMODELMAX
- USE MODD_CONF, ONLY : CPROGRAM, L1D, L2D, LPACK
- !
- USE MODE_SPLITTINGZ_ll
- !
- USE MODI_GET_SURF_GRID_DIM_N
- USE MODI_GET_LUOUT
- !
IMPLICIT NONE
!
!* 0.1 Declaration of dummy arguments
@@ -105,10 +92,9 @@ END MODULE MODI_MNH_SURF_GRID_IO_INIT
! -----------
!
USE MODE_ll
-USE MODE_FM
-USE MODE_IO_ll
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT, JPMODELMAX
-USE MODD_CONF, ONLY : CPROGRAM, L1D, L2D, LPACK
+USE MODE_IO, only: IO_Pack_set
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT, JPMODELMAX
+USE MODD_CONF, ONLY: CPROGRAM, L1D, L2D, LPACK
!
!JUANZ
USE MODE_SPLITTINGZ_ll
@@ -139,7 +125,7 @@ IF (CPROGRAM=='IDEAL ' .OR. CPROGRAM=='SPAWN ' .OR. CPROGRAM=='REAL ') RETURN
L1D=(KIMAX==1).AND.(KJMAX==1)
L2D=(KIMAX/=1).AND.(KJMAX==1)
LPACK=L1D.OR.L2D
-CALL SET_FMPACK_ll(L1D,L2D,LPACK)
+CALL IO_Pack_set(L1D,L2D,LPACK)
CALL SET_JP_ll(JPMODELMAX,JPHEXT,JPVEXT,JPHEXT)
CALL SET_DAD0_ll()
CALL SET_DIM_ll(KIMAX, KJMAX, 1)
diff --git a/src/MNH/mnhclose_aux_io_surf.f90 b/src/MNH/mnhclose_aux_io_surf.f90
index 79d2627915c6f8a80955d789ee61d0e2bd656a0c..ba818000a9b5e13ab6f3057c9b8465a5696425d4 100644
--- a/src/MNH/mnhclose_aux_io_surf.f90
+++ b/src/MNH/mnhclose_aux_io_surf.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2003-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2003-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.
!-----------------------------------------------------------------
! #########################
@@ -49,21 +49,17 @@ END MODULE MODI_MNHCLOSE_AUX_IO_SURF
!! -------------
!! Original 09/2003
!! J.Escobar : 19/04/2016 : Pb IOZ/NETCDF , missing OPARALLELIO=.FALSE. for PGD files
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 surfex 2006/05/23 15:47:28
-!-----------------------------------------------------------------
+! P. Wautelet 07/02/2019: remove OPARALLELIO argument from open and close files subroutines
+! (nsubfiles_ioz is now determined in IO_File_add2list)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+USE MODD_IO_SURF_MNH, ONLY: TPINFILE, CACTION, NMASK_ALL, NMASK
+!
+USE MODE_IO_FILE, only: IO_File_close
USE MODE_ll
-USE MODE_FM
-USE MODE_IO_ll
-
-USE MODD_IO_SURF_MNH, ONLY : TPINFILE, CACTION, NMASK_ALL, NMASK
!
IMPLICIT NONE
!
@@ -82,7 +78,7 @@ INTEGER :: IRESP ! return-code if a problem appears
!-------------------------------------------------------------------------------
!
IF (CACTION=='OPEN ') THEN
- CALL IO_FILE_CLOSE_ll(TPINFILE,OPARALLELIO=.FALSE.)
+ CALL IO_File_close(TPINFILE)
CACTION=' '
END IF
!
diff --git a/src/MNH/mnhclose_namelist.f90 b/src/MNH/mnhclose_namelist.f90
index 28193c6ef37265d9b98cbb74f7ab7c972ddc55f6..824cdb3f03e084b1d765012f66634b1c2189fb68 100644
--- a/src/MNH/mnhclose_namelist.f90
+++ b/src/MNH/mnhclose_namelist.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2003-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.
!-----------------------------------------------------------------
! #############################
@@ -58,7 +58,7 @@ USE MODD_IO_NAM, ONLY: TNAM
USE MODD_LUNIT, ONLY: TLUOUT0
USE MODD_LUNIT_n, ONLY: TLUOUT
!
-USE MODE_FM, ONLY: IO_FILE_CLOSE_ll
+USE MODE_IO_FILE, ONLY: IO_File_close
USE MODE_MSG
!
IMPLICIT NONE
@@ -77,7 +77,6 @@ INTEGER :: IRESP ! IRESP : return-code if a problem appears
!
INTEGER :: IMI ! model index
INTEGER :: ILUOUT ! output listing logical unit
-CHARACTER(LEN=16) :: YLUOUT ! output listing file name
!-------------------------------------------------------------------------------
!
IF (.NOT.ASSOCIATED(TNAM)) CALL PRINT_MSG(NVERB_FATAL,'IO','CLOSE_FILE_MNH','TNAM not associated')
@@ -90,7 +89,7 @@ CALL PRINT_MSG(NVERB_DEBUG,'IO','MNHCLOSE_NAMELIST','called for '//TRIM(TNAM%CNA
! -------------------
!
IF (TNAM%NLU==KLUNAM) THEN
- CALL IO_FILE_CLOSE_ll(TNAM)
+ CALL IO_File_close(TNAM)
TNAM => NULL()
ELSE
SELECT CASE(CPROGRAM)
diff --git a/src/MNH/mnhclose_write_cover_tex.f90 b/src/MNH/mnhclose_write_cover_tex.f90
index ec04cd869096a160c053f00ae95e3b9aab4df6ec..c041ea0d0107a4413850a0c7b1c600208c693cd8 100644
--- a/src/MNH/mnhclose_write_cover_tex.f90
+++ b/src/MNH/mnhclose_write_cover_tex.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2003-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.
!-----------------------------------------------------------------
! ##################################
@@ -40,12 +40,10 @@
! ------------
!
USE MODD_CONF, ONLY: CPROGRAM
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
-USE MODE_FM, ONLY: IO_FILE_CLOSE_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_FIND_BYNAME
-!
-USE MODI_TRANSFER_FILE
+USE MODE_IO_FILE, ONLY: IO_File_close
+USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_find_byname
!
!
IMPLICIT NONE
@@ -70,9 +68,8 @@ TYPE(TFILEDATA),POINTER :: TZFILE
TZFILE => NULL()
!
IF (TRIM(CPROGRAM)=='PGD') THEN
- CALL IO_FILE_FIND_BYNAME(YTEX,TZFILE,IRESP)
- CALL IO_FILE_CLOSE_ll(TZFILE)
- CALL TRANSFER_FILE('fujitransfer.x','NIL',YTEX)
+ CALL IO_File_find_byname(YTEX,TZFILE,IRESP)
+ CALL IO_File_close(TZFILE)
END IF
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/mnhend_io_surfn.f90 b/src/MNH/mnhend_io_surfn.f90
index 3e09c9598d9dbdc122b54fc318f27aadae40dffd..6a1d1c034b501498b5ea09c2cfdef638fe8e9279 100644
--- a/src/MNH/mnhend_io_surfn.f90
+++ b/src/MNH/mnhend_io_surfn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2003-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.
!-----------------------------------------------------------------
! #########################
@@ -52,12 +52,10 @@ END MODULE MODI_MNHEND_IO_SURF_n
!* 0. DECLARATIONS
! ------------
!
-USE MODE_ll
-USE MODE_FM
-USE MODE_IO_ll
-!
USE MODD_IO_SURF_MNH, ONLY : CACTION, TPINFILE, COUTFILE, NMASK, NMASK_ALL
!
+USE MODE_ll
+!
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
diff --git a/src/MNH/mnhinit_io_surfn.f90 b/src/MNH/mnhinit_io_surfn.f90
index bf67169ffb6d7b76b5be49e3008ea886ff37f32d..16fda802414bcd970cd66913b04d53b2dee2aa71 100644
--- a/src/MNH/mnhinit_io_surfn.f90
+++ b/src/MNH/mnhinit_io_surfn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2003-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.
!-----------------------------------------------------------------
! #########################
@@ -61,13 +61,11 @@ USE MODD_IO_SURF_MNH, ONLY: TOUT, TPINFILE, COUTFILE,
NMASK, CMASK, NIU, NJU, NIB, NJB, NIE, NJE, CACTION, &
NMASK_ALL, NIU_ALL, NJU_ALL, NIB_ALL, NJB_ALL, &
NIE_ALL, NJE_ALL, NHALO
-USE MODD_LUNIT, ONLY: CLUOUT0, TPGDFILE, TLUOUT0, TOUTDATAFILE
+USE MODD_LUNIT, ONLY: TPGDFILE, TLUOUT0, TOUTDATAFILE
USE MODD_LUNIT_n, ONLY: CMASK_SURFEX, TINIFILE, TINIFILEPGD, TLUOUT
USE MODD_MNH_SURFEX_n, ONLY: YSURF_CUR
USE MODD_PARAMETERS, ONLY: JPHEXT
!
-USE MODE_IO_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_FIND_BYNAME
USE MODE_ll
USE MODE_MODELN_HANDLER
!
diff --git a/src/MNH/mnhopen_aux_io_surf.f90 b/src/MNH/mnhopen_aux_io_surf.f90
index 5e6e4e954d9fe3eb49785a5a93b8f1d211490af2..3a89446e628078774236e93bcb5a944c48085ba6 100644
--- a/src/MNH/mnhopen_aux_io_surf.f90
+++ b/src/MNH/mnhopen_aux_io_surf.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2003-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 MODI_MNHOPEN_AUX_IO_SURF
! #########################
@@ -42,7 +43,7 @@ END MODULE MODI_MNHOPEN_AUX_IO_SURF
!!
!! AUTHOR
!! ------
-!! S.Malardel *Meteo France*
+!! S.Malardel *Meteo France*
!!
!! MODIFICATIONS
!! -------------
@@ -52,6 +53,10 @@ END MODULE MODI_MNHOPEN_AUX_IO_SURF
!! J.Escobar : 19/04/2016 : Pb IOZ/NETCDF , missing OPARALLELIO=.FALSE. for PGD files
!! J.Escobar : 02/06/2016 : abort MNHOPEN with STOP if problem with OPEN of INPUT/READ file
!! 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 07/02/2019: remove OPARALLELIO argument from open and close files subroutines
+! (nsubfiles_ioz is now determined in IO_File_add2list)
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -62,14 +67,13 @@ USE MODD_CONF, ONLY: CPROGRAM
USE MODD_IO_SURF_MNH, ONLY: TOUT, TPINFILE, COUTFILE, NMASK_ALL, CMASK, NIU_ALL, &
NJU_ALL, NIB_ALL, NJB_ALL, NIE_ALL, NJE_ALL, CACTION, &
NMASK, NIU, NJU, NIB, NJB, NIE, NJE
-USE MODD_LUNIT, ONLY: CLUOUT0, TPGDFILE, TLUOUT0, TOUTDATAFILE
+USE MODD_LUNIT, ONLY: TPGDFILE, TLUOUT0, TOUTDATAFILE
USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_PARAMETERS, ONLY: JPHEXT
!
-USE MODE_FM, ONLY: IO_FILE_OPEN_ll
-USE MODE_FMREAD
-USE MODE_IO_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST,IO_FILE_FIND_BYNAME
+USE MODE_IO_FIELD_READ, only: IO_Field_read
+USE MODE_IO_FILE, ONLY: IO_File_open
+USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list, IO_File_find_byname
USE MODE_MSG
!
USE MODI_GET_1D_MASK
@@ -137,16 +141,15 @@ ELSE
END IF
!
IF (HFILE/=YFILE .AND. HFILE/=YPGDFILE) THEN
- CALL IO_FILE_ADD2LIST(TPINFILE,TRIM(HFILE),'UNKNOWN','READ',KLFITYPE=2,KLFIVERB=5,OOLD=.TRUE.)
- CALL IO_FILE_OPEN_ll(TPINFILE,KRESP=IRESP,OPARALLELIO=.FALSE.)
+ CALL IO_File_add2list(TPINFILE,TRIM(HFILE),'PGD','READ',KLFITYPE=2,KLFIVERB=5,OOLD=.TRUE.)
+ CALL IO_File_open(TPINFILE,KRESP=IRESP)
!
- IF (IRESP .NE. 0) THEN
- PRINT*," /!\ MNHOPEN_AUX_IO_SURF :: FATAL PROBLEM OPENING INPUT/READ FILES =", HFILE
- STOP '/!\ MNHOPEN_AUX_IO_SURF :: FATAL PROBLEM OPENING INPUT/READ FILES , CHECK OUTPUT_LISTING* !!!'
- ENDIF
+ if ( iresp /= 0 ) then
+ call Print_msg( NVERB_FATAL, 'GEN', 'MNHOPEN_AUX_IO_SURF', 'unable to open file '//trim(HFILE) )
+ end if
CACTION = 'OPEN '
ELSE
- CALL IO_FILE_FIND_BYNAME(TRIM(HFILE),TPINFILE,IRESP)
+ CALL IO_File_find_byname(TRIM(HFILE),TPINFILE,IRESP)
END IF
!
COUTFILE = HFILE
@@ -154,11 +157,11 @@ COUTFILE = HFILE
!
!* 3. initialisation of 2D arrays for entire physical field
!
-CALL IO_READ_FIELD(TPINFILE,'IMAX',IIMAX)
-CALL IO_READ_FIELD(TPINFILE,'JMAX',IJMAX)
+CALL IO_Field_read(TPINFILE,'IMAX',IIMAX)
+CALL IO_Field_read(TPINFILE,'JMAX',IJMAX)
CALL MNH_SURF_GRID_IO_INIT(IIMAX,IJMAX)
IJPHEXT= 1
-CALL IO_READ_FIELD(TPINFILE,'JPHEXT',IJPHEXT)
+CALL IO_Field_read(TPINFILE,'JPHEXT',IJPHEXT)
IF ( IJPHEXT .NE. JPHEXT ) THEN
WRITE(ILUOUT,FMT=*) ' MNHOPEN_AUX_IO : JPHEXT in PRE_PGD1.nam/NAM_CONF_PGD ( or default value )&
& JPHEXT=',JPHEXT
diff --git a/src/MNH/mnhopen_namelist.f90 b/src/MNH/mnhopen_namelist.f90
index 7820d3e0d690a37e4c4e407638f05f70b4130052..d594b6e5ff0e60fda174f2a27a028318b8f633eb 100644
--- a/src/MNH/mnhopen_namelist.f90
+++ b/src/MNH/mnhopen_namelist.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #############################
@@ -57,8 +57,8 @@ END MODULE MODI_MNHOPEN_NAMELIST
USE MODD_CONF, ONLY: CPROGRAM
USE MODD_IO_NAM, ONLY: TNAM
!
-USE MODE_FM, ONLY: IO_FILE_OPEN_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST
+USE MODE_IO_FILE, ONLY: IO_File_open
+USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list
USE MODE_MSG
!
IMPLICIT NONE
@@ -113,8 +113,8 @@ END IF
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','MNHOPEN_NAMELIST','called for '//TRIM(YNAM))
!
-CALL IO_FILE_ADD2LIST(TNAM,TRIM(YNAM),'NML','READ',OOLD=.TRUE.) !OOLD=T because the file may already be in list
-CALL IO_FILE_OPEN_ll(TNAM)
+CALL IO_File_add2list(TNAM,TRIM(YNAM),'NML','READ',OOLD=.TRUE.) !OOLD=T because the file may already be in list
+CALL IO_File_open(TNAM)
!
KLUNAM = TNAM%NLU
!
diff --git a/src/MNH/mnhopen_write_cover_tex.f90 b/src/MNH/mnhopen_write_cover_tex.f90
index 73904aa629021fb5b0284e94c23b6636ebb09e8e..941758e617e123a129ac3f3e3c06abb0c67c8565 100644
--- a/src/MNH/mnhopen_write_cover_tex.f90
+++ b/src/MNH/mnhopen_write_cover_tex.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2003-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.
!-----------------------------------------------------------------
! ##################################
@@ -40,10 +40,10 @@
! ------------
!
USE MODD_CONF, ONLY: CPROGRAM
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
-USE MODE_FM, ONLY: IO_FILE_OPEN_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST
+USE MODE_IO_FILE, ONLY: IO_File_open
+USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list
!
!
IMPLICIT NONE
@@ -67,8 +67,8 @@ TYPE(TFILEDATA),POINTER :: TZFILE
TZFILE => NULL()
!
IF (TRIM(CPROGRAM)=='PGD') THEN
- CALL IO_FILE_ADD2LIST(TZFILE,YTEX,'TXT','WRITE')
- CALL IO_FILE_OPEN_ll(TZFILE,HPOSITION='REWIND')
+ CALL IO_File_add2list(TZFILE,YTEX,'TXT','WRITE')
+ CALL IO_File_open(TZFILE,HPOSITION='REWIND')
KTEX = TZFILE%NLU
ELSE
KTEX=0
diff --git a/src/MNH/mnhread_zs_dummyn.f90 b/src/MNH/mnhread_zs_dummyn.f90
index 94376de629c0c6aa3266638ecef998bcba2dc67c..eb5eb084a949c9f5c07b5f2b0ccaaafff8ff8bd1 100644
--- a/src/MNH/mnhread_zs_dummyn.f90
+++ b/src/MNH/mnhread_zs_dummyn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 MNHREAD_ZS_DUMMY_n(TPINIFILE)
!
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE !Initial file
!
@@ -57,16 +57,16 @@ END MODULE MODI_MNHREAD_ZS_DUMMY_n
!* 0. DECLARATIONS
! ------------
!
-USE MODD_GRID_n, ONLY : XZS
-USE MODD_GR_FIELD_n, ONLY : XSSO_STDEV, XSSO_ANISOTROPY, XSSO_DIRECTION, XSSO_SLOPE, &
- XAVG_ZS, XSIL_ZS, XMIN_ZS, XMAX_ZS
-USE MODD_IO_ll, ONLY : TFILEDATA
-USE MODD_PARAM_n, ONLY : CSURF
+USE MODD_GRID_n, ONLY: XZS
+USE MODD_GR_FIELD_n, ONLY: XSSO_STDEV, XSSO_ANISOTROPY, XSSO_DIRECTION, XSSO_SLOPE, &
+ XAVG_ZS, XSIL_ZS, XMIN_ZS, XMAX_ZS
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_PARAM_n, ONLY: CSURF
!
USE MODI_READ_DUMMY_GR_FIELD_n
!
USE MODE_ll
-USE MODE_FMREAD
+USE MODE_IO_FIELD_READ, only: IO_Field_read
!
IMPLICIT NONE
!
@@ -101,7 +101,7 @@ CALL GET_DIM_EXT_ll('B',IIU,IJU)
! ---------
IF (.NOT.(ASSOCIATED(XZS))) THEN
ALLOCATE(XZS(IIU,IJU))
- CALL IO_READ_FIELD(TPINIFILE,'ZS',XZS)
+ CALL IO_Field_read(TPINIFILE,'ZS',XZS)
END IF
!
IF (CSURF /='EXTE') RETURN
@@ -113,28 +113,28 @@ IF (CSURF /='EXTE') RETURN
! --------------------------
!
IF (.NOT.(ASSOCIATED(XSSO_ANISOTROPY))) ALLOCATE(XSSO_ANISOTROPY(IIU,IJU))
-CALL IO_READ_FIELD(TPINIFILE,'SSO_ANIS',XSSO_ANISOTROPY(:,:))
+CALL IO_Field_read(TPINIFILE,'SSO_ANIS',XSSO_ANISOTROPY(:,:))
!
IF (.NOT.(ASSOCIATED(XSSO_SLOPE))) ALLOCATE(XSSO_SLOPE(IIU,IJU))
-CALL IO_READ_FIELD(TPINIFILE,'SSO_SLOPE',XSSO_SLOPE(:,:))
+CALL IO_Field_read(TPINIFILE,'SSO_SLOPE',XSSO_SLOPE(:,:))
!
IF (.NOT.(ASSOCIATED(XSSO_DIRECTION))) ALLOCATE(XSSO_DIRECTION(IIU,IJU))
-CALL IO_READ_FIELD(TPINIFILE,'SSO_DIR',XSSO_DIRECTION(:,:))
+CALL IO_Field_read(TPINIFILE,'SSO_DIR',XSSO_DIRECTION(:,:))
!
IF (.NOT.(ASSOCIATED(XAVG_ZS))) ALLOCATE(XAVG_ZS(IIU,IJU))
-CALL IO_READ_FIELD(TPINIFILE,'AVG_ZS',XAVG_ZS(:,:))
+CALL IO_Field_read(TPINIFILE,'AVG_ZS',XAVG_ZS(:,:))
!
IF (.NOT.(ASSOCIATED(XSIL_ZS))) ALLOCATE(XSIL_ZS(IIU,IJU))
-CALL IO_READ_FIELD(TPINIFILE,'SIL_ZS',XSIL_ZS(:,:))
+CALL IO_Field_read(TPINIFILE,'SIL_ZS',XSIL_ZS(:,:))
!
IF (.NOT.(ASSOCIATED(XMAX_ZS))) ALLOCATE(XMAX_ZS(IIU,IJU))
-CALL IO_READ_FIELD(TPINIFILE,'MAX_ZS',XMAX_ZS(:,:))
+CALL IO_Field_read(TPINIFILE,'MAX_ZS',XMAX_ZS(:,:))
!
IF (.NOT.(ASSOCIATED(XMIN_ZS))) ALLOCATE(XMIN_ZS(IIU,IJU))
-CALL IO_READ_FIELD(TPINIFILE,'MIN_ZS',XMIN_ZS(:,:))
+CALL IO_Field_read(TPINIFILE,'MIN_ZS',XMIN_ZS(:,:))
!
IF (.NOT.(ASSOCIATED(XSSO_STDEV))) ALLOCATE(XSSO_STDEV(IIU,IJU))
-CALL IO_READ_FIELD(TPINIFILE,'SSO_STDEV',XSSO_STDEV(:,:))
+CALL IO_Field_read(TPINIFILE,'SSO_STDEV',XSSO_STDEV(:,:))
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/mnhwrite_zs_dummyn.f90 b/src/MNH/mnhwrite_zs_dummyn.f90
index 708cf971d52cd10b93e9ff474f3e229a13a837e6..29392ec2b6928430caaeb12b8fe65ce4edf0890e 100644
--- a/src/MNH/mnhwrite_zs_dummyn.f90
+++ b/src/MNH/mnhwrite_zs_dummyn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 MNHWRITE_ZS_DUMMY_n(TPFILE)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File characteristics
!
@@ -57,15 +57,15 @@ END MODULE MODI_MNHWRITE_ZS_DUMMY_n
!* 0. DECLARATIONS
! ------------
!
-USE MODD_GR_FIELD_n, ONLY : XSSO_STDEV, XSSO_ANISOTROPY, XSSO_DIRECTION, XSSO_SLOPE, &
- XAVG_ZS, XSIL_ZS, XMIN_ZS, XMAX_ZS
+USE MODD_GR_FIELD_n, ONLY: XSSO_STDEV, XSSO_ANISOTROPY, XSSO_DIRECTION, XSSO_SLOPE, &
+ XAVG_ZS, XSIL_ZS, XMIN_ZS, XMAX_ZS
!
-USE MODD_PARAM_n, ONLY : CSURF
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_PARAM_n, ONLY: CSURF
+USE MODD_IO, ONLY: TFILEDATA
!
USE MODI_WRITE_DUMMY_GR_FIELD_n
!
-USE MODE_FMWRIT
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
!
IMPLICIT NONE
!
@@ -92,14 +92,14 @@ IF (CSURF /='EXTE') RETURN
!* 2. Orographic characteristics :
! --------------------------
!
-CALL IO_WRITE_FIELD(TPFILE,'SSO_ANIS', XSSO_ANISOTROPY)
-CALL IO_WRITE_FIELD(TPFILE,'SSO_SLOPE',XSSO_SLOPE)
-CALL IO_WRITE_FIELD(TPFILE,'SSO_DIR', XSSO_DIRECTION)
-CALL IO_WRITE_FIELD(TPFILE,'AVG_ZS', XAVG_ZS)
-CALL IO_WRITE_FIELD(TPFILE,'SIL_ZS', XSIL_ZS)
-CALL IO_WRITE_FIELD(TPFILE,'MAX_ZS', XMAX_ZS)
-CALL IO_WRITE_FIELD(TPFILE,'MIN_ZS', XMIN_ZS)
-CALL IO_WRITE_FIELD(TPFILE,'SSO_STDEV',XSSO_STDEV)
+CALL IO_Field_write(TPFILE,'SSO_ANIS', XSSO_ANISOTROPY)
+CALL IO_Field_write(TPFILE,'SSO_SLOPE',XSSO_SLOPE)
+CALL IO_Field_write(TPFILE,'SSO_DIR', XSSO_DIRECTION)
+CALL IO_Field_write(TPFILE,'AVG_ZS', XAVG_ZS)
+CALL IO_Field_write(TPFILE,'SIL_ZS', XSIL_ZS)
+CALL IO_Field_write(TPFILE,'MAX_ZS', XMAX_ZS)
+CALL IO_Field_write(TPFILE,'MIN_ZS', XMIN_ZS)
+CALL IO_Field_write(TPFILE,'SSO_STDEV',XSSO_STDEV)
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/modd_RBK90_Globaln.f90 b/src/MNH/modd_RBK90_Globaln.f90
index ccf0f737b9147d5d900639505f0281dbbdac9dd1..4d4a40e402596db7d598f3bbcaf52915afc2f4c4 100644
--- a/src/MNH/modd_RBK90_Globaln.f90
+++ b/src/MNH/modd_RBK90_Globaln.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
@@ -23,6 +23,8 @@
! Output root filename : RBK90
!
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! Modifications
+! P. Wautelet 08/02/2019: add missing NULL association for pointers
MODULE MODD_RBK90_Global_n
@@ -40,15 +42,15 @@ TYPE RBK90_Global_t
! Declaration of global variables
! C - Concentration of all species
- REAL(KIND(0.0D0)), DIMENSION(:), POINTER :: C
+ REAL(KIND(0.0D0)), DIMENSION(:), POINTER :: C => NULL()
! VAR - Concentrations of variable species (global)
- REAL(KIND(0.0D0)), DIMENSION(:), POINTER :: VAR
+ REAL(KIND(0.0D0)), DIMENSION(:), POINTER :: VAR => NULL()
! FIX - Concentrations of fixed species (global)
- REAL(KIND(0.0D0)), DIMENSION(:), POINTER :: FIX
+ REAL(KIND(0.0D0)), DIMENSION(:), POINTER :: FIX => NULL()
!JPP EQUIVALENCE( C(1),VAR(1) )
!JPP EQUIVALENCE( C(66),FIX(1) )
! RCONST - Rate constants (global)
- REAL(KIND(0.0D0)), DIMENSION(:), POINTER :: RCONST
+ REAL(KIND(0.0D0)), DIMENSION(:), POINTER :: RCONST => NULL()
! TIME - Current integration time
REAL(KIND(0.0D0)) :: TIME
! SUN - Sunlight intensity between [0,1]
@@ -64,9 +66,9 @@ TYPE RBK90_Global_t
! DT - Integration step
REAL(KIND(0.0D0)) :: DT
! ATOL - Absolute tolerance
- REAL(KIND(0.0D0)), DIMENSION(:), POINTER :: ATOL
+ REAL(KIND(0.0D0)), DIMENSION(:), POINTER :: ATOL => NULL()
! RTOL - Relative tolerance
- REAL(KIND(0.0D0)), DIMENSION(:), POINTER :: RTOL
+ REAL(KIND(0.0D0)), DIMENSION(:), POINTER :: RTOL => NULL()
! STEPMIN - Lower bound for integration step
REAL(KIND(0.0D0)) :: STEPMIN
! STEPMAX - Upper bound for integration step
diff --git a/src/MNH/modd_RBK90_JacobianSPn.f90 b/src/MNH/modd_RBK90_JacobianSPn.f90
index dc7fd2c695c01ab1fd7ffb595ebd0b615b2d7fea..be6f91d417c0fa92b6859882a03bac0bc2597f95 100644
--- a/src/MNH/modd_RBK90_JacobianSPn.f90
+++ b/src/MNH/modd_RBK90_JacobianSPn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!******************************************************************
@@ -25,6 +25,8 @@
! Output root filename : RBK90
!
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! Modifications
+! P. Wautelet 08/02/2019: add missing NULL association for pointers
MODULE MODD_RBK90_JacobianSP_n
@@ -39,13 +41,13 @@ TYPE RBK90_JacobianSP_t
! Sparse Jacobian Data
- INTEGER, DIMENSION(:), POINTER :: LU_IROW
- INTEGER, DIMENSION(:), POINTER :: LU_ICOL
+ INTEGER, DIMENSION(:), POINTER :: LU_IROW => NULL()
+ INTEGER, DIMENSION(:), POINTER :: LU_ICOL => NULL()
- INTEGER, DIMENSION(:), POINTER :: LU_CROW
- INTEGER, DIMENSION(:), POINTER :: LU_DIAG
+ INTEGER, DIMENSION(:), POINTER :: LU_CROW => NULL()
+ INTEGER, DIMENSION(:), POINTER :: LU_DIAG => NULL()
- INTEGER, DIMENSION(:), POINTER :: LU_DIM_SPECIES
+ INTEGER, DIMENSION(:), POINTER :: LU_DIM_SPECIES => NULL()
END TYPE RBK90_JacobianSP_t
diff --git a/src/MNH/modd_aircraft_balloon.f90 b/src/MNH/modd_aircraft_balloon.f90
index 677a4c4ac525ef94bb01b47788418f6289233c8e..9ff02772fc696e682c0efc396edbb3c0b6780748 100644
--- a/src/MNH/modd_aircraft_balloon.f90
+++ b/src/MNH/modd_aircraft_balloon.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-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: /home/cvsroot/MNH-VX-Y-Z/src/MNH/modd_aircraft_balloon.f90,v $ $Revision: 1.1.10.1.2.1.10.2.2.2 $
-! MASDEV4_7 modd 2006/06/28 11:31:03
-!-----------------------------------------------------------------
! ############################
MODULE MODD_AIRCRAFT_BALLOON
! ############################
@@ -26,10 +21,10 @@
!!
!! REFERENCE
!! ---------
-!!
+!!
!! AUTHOR
!! ------
-!! P. Jabouille *Meteo France*
+!! P. Jabouille *Meteo France*
!!
!! MODIFICATIONS
!! -------------
@@ -37,6 +32,7 @@
!! Apr,19, 2001 (G.Jaubert) add CVBALL type
!! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -92,13 +88,13 @@ REAL :: MASS ! mass of the balloon (kg) (if 'CVBALL')
INTEGER :: SEG ! number of aircraft flight segments
INTEGER :: SEGCURN ! current flight segment number
REAL :: SEGCURT ! current flight segment time spent
-REAL, DIMENSION(:), POINTER :: SEGLAT ! latitude of flight segment extremities (LEG+1)
-REAL, DIMENSION(:), POINTER :: SEGLON ! longitude of flight segment extremities (LEG+1)
-REAL, DIMENSION(:), POINTER :: SEGX ! X of flight segment extremities (LEG+1)
-REAL, DIMENSION(:), POINTER :: SEGY ! Y of flight segment extremities (LEG+1)
-REAL, DIMENSION(:), POINTER :: SEGP ! pressure of flight segment extremities (LEG+1)
-REAL, DIMENSION(:), POINTER :: SEGZ ! altitude of flight segment extremities (LEG+1)
-REAL, DIMENSION(:), POINTER :: SEGTIME ! duration of flight segments (LEG )
+REAL, DIMENSION(:), POINTER :: SEGLAT => NULL() ! latitude of flight segment extremities (LEG+1)
+REAL, DIMENSION(:), POINTER :: SEGLON => NULL() ! longitude of flight segment extremities (LEG+1)
+REAL, DIMENSION(:), POINTER :: SEGX => NULL() ! X of flight segment extremities (LEG+1)
+REAL, DIMENSION(:), POINTER :: SEGY => NULL() ! Y of flight segment extremities (LEG+1)
+REAL, DIMENSION(:), POINTER :: SEGP => NULL() ! pressure of flight segment extremities (LEG+1)
+REAL, DIMENSION(:), POINTER :: SEGZ => NULL() ! altitude of flight segment extremities (LEG+1)
+REAL, DIMENSION(:), POINTER :: SEGTIME => NULL() ! duration of flight segments (LEG )
!
!* aircraft altitude type definition
!
@@ -113,42 +109,42 @@ REAL :: P_CUR ! current p (if 'AIRCRA' and 'ALTDEF'
!
!* data records
!
-REAL, DIMENSION(:), POINTER :: TIME ! t(n) (n: recording instants)
-REAL, DIMENSION(:), POINTER :: X ! X(n)
-REAL, DIMENSION(:), POINTER :: Y ! Y(n)
-REAL, DIMENSION(:), POINTER :: Z ! Z(n)
-REAL, DIMENSION(:), POINTER :: XLON ! longitude(n)
-REAL, DIMENSION(:), POINTER :: YLAT ! latitude (n)
-REAL, DIMENSION(:), POINTER :: ZON ! zonal wind(n)
-REAL, DIMENSION(:), POINTER :: MER ! meridian wind(n)
-REAL, DIMENSION(:), POINTER :: W ! w(n) (air vertical speed)
-REAL, DIMENSION(:), POINTER :: P ! p(n)
-REAL, DIMENSION(:), POINTER :: TKE ! tke(n)
-REAL, DIMENSION(:), POINTER :: TKE_DISS ! tke dissipation rate
-REAL, DIMENSION(:), POINTER :: TH ! th(n)
-REAL, DIMENSION(:,:), POINTER :: R ! r*(n)
-REAL, DIMENSION(:,:), POINTER :: SV ! Sv*(n)
-REAL, DIMENSION(:,:), POINTER :: RTZ ! tot hydrometeor mixing ratio
-REAL, DIMENSION(:,:,:), POINTER :: RZ ! water vapour mixing ratio
-REAL, DIMENSION(:,:), POINTER :: FFZ ! horizontal wind
-REAL, DIMENSION(:,:), POINTER :: IWCZ ! ice water content
-REAL, DIMENSION(:,:), POINTER :: LWCZ ! liquid water content
-REAL, DIMENSION(:,:), POINTER :: CIZ ! Ice concentration
-REAL, DIMENSION(:,:), POINTER :: CCZ ! Cloud concentration (LIMA)
-REAL, DIMENSION(:,:), POINTER :: CRZ ! Rain concentration (LIMA)
-REAL, DIMENSION(:,:), POINTER :: CRARE ! cloud radar reflectivity
-REAL, DIMENSION(:,:), POINTER :: CRARE_ATT ! attenuated (= more realistic) cloud radar reflectivity
-REAL, DIMENSION(:,:), POINTER :: WZ ! vertical profile of vertical velocity
-REAL, DIMENSION(:,:), POINTER :: ZZ ! vertical profile of mass point altitude (above sea)
-REAL, DIMENSION(:,:), POINTER :: AER ! Extinction at 550 nm
-REAL, DIMENSION(:,:), POINTER :: DST_WL ! Extinction by wavelength
-REAL, DIMENSION(:), POINTER :: ZS ! zs(n)
-REAL, DIMENSION(:), POINTER :: TSRAD ! Ts(n)
-REAL, DIMENSION(:,:), POINTER :: DATIME ! record for diachro
-!
-REAL, DIMENSION(:) , POINTER :: THW_FLUX ! thw_flux(n)
-REAL, DIMENSION(:) , POINTER :: RCW_FLUX ! rcw_flux(n)
-REAL, DIMENSION(:,:), POINTER :: SVW_FLUX ! psw_flux(n)
+REAL, DIMENSION(:), POINTER :: TIME => NULL() ! t(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)
+REAL, DIMENSION(:), POINTER :: XLON => NULL() ! longitude(n)
+REAL, DIMENSION(:), POINTER :: YLAT => NULL() ! latitude (n)
+REAL, DIMENSION(:), POINTER :: ZON => NULL() ! zonal wind(n)
+REAL, DIMENSION(:), POINTER :: MER => NULL() ! meridian wind(n)
+REAL, DIMENSION(:), POINTER :: W => NULL() ! w(n) (air vertical speed)
+REAL, DIMENSION(:), POINTER :: P => NULL() ! p(n)
+REAL, DIMENSION(:), POINTER :: TKE => NULL() ! tke(n)
+REAL, DIMENSION(:), POINTER :: TKE_DISS => NULL() ! tke dissipation rate
+REAL, DIMENSION(:), POINTER :: TH => NULL() ! th(n)
+REAL, DIMENSION(:,:), POINTER :: R => NULL() ! r*(n)
+REAL, DIMENSION(:,:), POINTER :: SV => NULL() ! Sv*(n)
+REAL, DIMENSION(:,:), POINTER :: RTZ => NULL() ! tot hydrometeor mixing ratio
+REAL, DIMENSION(:,:,:),POINTER :: RZ => NULL() ! water vapour mixing ratio
+REAL, DIMENSION(:,:), POINTER :: FFZ => NULL() ! horizontal wind
+REAL, DIMENSION(:,:), POINTER :: IWCZ => NULL() ! ice water content
+REAL, DIMENSION(:,:), POINTER :: LWCZ => NULL() ! liquid water content
+REAL, DIMENSION(:,:), POINTER :: CIZ => NULL() ! Ice concentration
+REAL, DIMENSION(:,:), POINTER :: CCZ => NULL() ! Cloud concentration (LIMA)
+REAL, DIMENSION(:,:), POINTER :: CRZ => NULL() ! Rain concentration (LIMA)
+REAL, DIMENSION(:,:), POINTER :: CRARE => NULL() ! cloud radar reflectivity
+REAL, DIMENSION(:,:), POINTER :: CRARE_ATT => NULL() ! attenuated (= more realistic) cloud radar reflectivity
+REAL, DIMENSION(:,:), POINTER :: WZ => NULL() ! vertical profile of vertical velocity
+REAL, DIMENSION(:,:), POINTER :: ZZ => NULL() ! vertical profile of mass point altitude (above sea)
+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)
+REAL, DIMENSION(:,:), POINTER :: SVW_FLUX => NULL() ! psw_flux(n)
END TYPE FLYER
REAL :: XLAM_CRAD ! cloud radar wavelength (m)
!
diff --git a/src/MNH/modd_blowsnown.f90 b/src/MNH/modd_blowsnown.f90
index 38bf7b9291a25eabec2250b1d72f199952b6acd2..531c86fdeca8d6a833945cbdc021c234ba675a38 100644
--- a/src/MNH/modd_blowsnown.f90
+++ b/src/MNH/modd_blowsnown.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2018-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.
!-----------------------------------------------------------------
!! ######################
@@ -28,6 +28,7 @@
!!
!! MODIFICATIONS
!! -------------
+! P. Wautelet 08/02/2019: add missing NULL association for pointers
!!
!!--------------------------------------------------------------------
!! DECLARATIONS
@@ -39,13 +40,13 @@ TYPE BLOWSNOW_t
!
LOGICAL :: LSNOWSUBL ! switch to activate blowing snow sublimation
!
-REAL, DIMENSION(:,:,:), POINTER :: XSNWSUBL3D ! Drifting snow instataneous
+REAL, DIMENSION(:,:,:), POINTER :: XSNWSUBL3D => NULL() ! Drifting snow instataneous
! sublimation rate (kg/m3/s)
-REAL, DIMENSION(:,:,:), POINTER :: XSNWCANO ! Total mass in Canopy at time t
+REAL, DIMENSION(:,:,:), POINTER :: XSNWCANO => NULL() ! Total mass in Canopy at time t
! (:,:,1) : equivalent number concentration in Canopy (#/kg)
! (:,:,2) : equivalent mass concentration in Canopy (kg/kg)
! (:,:,3) : equivalent mass concentration in saltation (kg/kg)
-REAL, DIMENSION(:,:,:), POINTER :: XRSNWCANOS ! Source of (rho*canopy mass) at time t
+REAL, DIMENSION(:,:,:), POINTER :: XRSNWCANOS => NULL() ! Source of (rho*canopy mass) at time t
diff --git a/src/MNH/modd_ch_budget_n.f90 b/src/MNH/modd_ch_budget_n.f90
index 41c039d0731d1b22e34d98f84f61a0ebfa72d541..4fe8de9b6374bb96b1c3c735e8cd5b5d9800082a 100644
--- a/src/MNH/modd_ch_budget_n.f90
+++ b/src/MNH/modd_ch_budget_n.f90
@@ -1,3 +1,7 @@
+!MNH_LIC Copyright 2016-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_CH_BUDGET_n
@@ -15,19 +19,20 @@
!!
!!** IMPLICIT ARGUMENTS
!! ------------------
-!! None
+!! None
!!
!! REFERENCE
!! ---------
!! Book2 of documentation of Meso-NH
-!!
+!!
!! AUTHOR
!! ------
!! F. Brosse *Laboratoire d'Aerologie UPS-CNRS*
!!
!! MODIFICATIONS
!! -------------
-!! Original October 2016
+!! Original October 2016
+! P. Wautelet 08/02/2019: add missing NULL association for pointers
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -37,16 +42,16 @@ USE MODD_PARAMETERS, ONLY: JPMODELMAX
IMPLICIT NONE
TYPE TREAC_BUDGET
- REAL , DIMENSION(:,:,:,:), POINTER :: XB_REAC
- INTEGER, DIMENSION(:) , POINTER :: NB_REAC
+ REAL , DIMENSION(:,:,:,:), POINTER :: XB_REAC => NULL()
+ INTEGER, DIMENSION(:) , POINTER :: NB_REAC => NULL()
END TYPE TREAC_BUDGET
TYPE TCH_BUDGET_t
- CHARACTER(LEN=32), DIMENSION(:), POINTER :: CNAMES_BUDGET
- INTEGER, DIMENSION(:), POINTER :: NSPEC_BUDGET
+ CHARACTER(LEN=32), DIMENSION(:), POINTER :: CNAMES_BUDGET => NULL()
+ INTEGER, DIMENSION(:), POINTER :: NSPEC_BUDGET => NULL()
INTEGER :: NEQ_BUDGET
- TYPE(TREAC_BUDGET), DIMENSION(:), POINTER :: XTCHEM
+ TYPE(TREAC_BUDGET), DIMENSION(:), POINTER :: XTCHEM => NULL()
END TYPE TCH_BUDGET_t
diff --git a/src/MNH/modd_ch_constn.f90 b/src/MNH/modd_ch_constn.f90
index 92013fb84d2edd994cd6efed8593fef41c673c7e..f7495916ef8a30dc4d42686e9e16761665ea0698 100644
--- a/src/MNH/modd_ch_constn.f90
+++ b/src/MNH/modd_ch_constn.f90
@@ -1,14 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2001-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$ $Date$
-!-----------------------------------------------------------------
-!-----------------------------------------------------------------
-!-----------------------------------------------------------------
! #####################
MODULE MODD_CH_CONST_n
! ######################
@@ -32,6 +26,7 @@
!!
!! MODIFICATIONS
!! -------------
+! P. Wautelet 08/02/2019: add missing NULL association for pointers
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -43,14 +38,14 @@ IMPLICIT NONE
TYPE CH_CONST_t
!
- REAL, DIMENSION(:), POINTER :: XSREALMASSMOLVAL ! final molecular
+ REAL, DIMENSION(:), POINTER :: XSREALMASSMOLVAL => NULL() ! final molecular
! diffusivity value
- REAL, DIMENSION(:), POINTER :: XSREALREACTVAL ! final chemical
+ REAL, DIMENSION(:), POINTER :: XSREALREACTVAL => NULL() ! final chemical
! reactivity factor
! with biologie
- REAL, DIMENSION(:,:), POINTER :: XSREALHENRYVAL ! chemical Henry
+ REAL, DIMENSION(:,:), POINTER :: XSREALHENRYVAL => NULL() ! chemical Henry
! constant value
- REAL :: XCONVERSION ! emission unit
+ REAL :: XCONVERSION ! emission unit
! conversion factor
!
diff --git a/src/MNH/modd_ch_icen.f90 b/src/MNH/modd_ch_icen.f90
index 8f9323d0c2af2a37acbae0e12c2241775e0beb60..19f0a3c2662045354fc8117702c6a98e16017a11 100644
--- a/src/MNH/modd_ch_icen.f90
+++ b/src/MNH/modd_ch_icen.f90
@@ -1,15 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2015-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: /home//MESONH/MNH-V5-1-4/src/MODIF_TMICICE/modd_ch_icen.f90
-!-----------------------------------------------------------------
-!-----------------------------------------------------------------
-!-----------------------------------------------------------------
-!-----------------------------------------------------------------------------
!! ########################
MODULE MODD_CH_ICE_n
!! ########################
@@ -28,6 +21,7 @@
!! MODIFICATIONS
!! -------------
!! Original 11/12/15
+! P. Wautelet 08/02/2019: add missing NULL association for pointers
!!
!! IMPLICIT ARGUMENTS
!! ------------------
@@ -43,7 +37,7 @@ IMPLICIT NONE
TYPE CH_ICE_t
!
- INTEGER, POINTER, DIMENSION(:) :: NINDEXGI, NINDEXWI, NINDEXWG
+ INTEGER, POINTER, DIMENSION(:) :: NINDEXGI => NULL(), NINDEXWI => NULL(), NINDEXWG => NULL()
!
!-----------------------------------------------------------------------------
END TYPE CH_ICE_t
diff --git a/src/MNH/modd_ch_model0d.f90 b/src/MNH/modd_ch_model0d.f90
index f55a168be4539f00145f916194b9f2abbe36227f..0dd1a92ad3ac6861cbb6bf791f45064562450f0d 100644
--- a/src/MNH/modd_ch_model0d.f90
+++ b/src/MNH/modd_ch_model0d.f90
@@ -43,7 +43,7 @@
!* 0. DECLARATIONS
! -----------------
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
IMPLICIT NONE
SAVE
diff --git a/src/MNH/modd_ch_phn.f90 b/src/MNH/modd_ch_phn.f90
index b321995c92d9ae22511de0417b35898bfca2dd17..b1071e5f2dd072436fd46ed18c7f2264e3f6d2d6 100644
--- a/src/MNH/modd_ch_phn.f90
+++ b/src/MNH/modd_ch_phn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2007-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2007-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.
!-----------------------------------------------------------------
!! ########################
@@ -23,6 +23,7 @@
!! P. Tulet Nov 2014 accumulated moles of aqueous species that fall at the surface
!! P. Tulet & M. Leriche Nov 2015 add pH in rain at the surface
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 08/02/2019: add missing NULL association for pointers
!!
!! IMPLICIT ARGUMENTS
!! ------------------
@@ -38,11 +39,11 @@ IMPLICIT NONE
TYPE CH_PH_t
!
-! REAL, POINTER, DIMENSION(:,:,:) :: XPHC ! cloud
-! REAL, POINTER, DIMENSION(:,:,:) :: XPHR ! rain
- REAL, POINTER, DIMENSION(:,:,:) :: XACPRAQ ! sum of aqueous chemical species fall at the surface by rain
- ! in moles i / m2 (ratio with XACPRR for concentration
- REAL, POINTER, DIMENSION(:,:) :: XACPHR ! mean PH in accumulated surface rain
+! REAL, POINTER, DIMENSION(:,:,:) :: XPHC => NULL() ! cloud
+! REAL, POINTER, DIMENSION(:,:,:) :: XPHR => NULL() ! rain
+ REAL, POINTER, DIMENSION(:,:,:) :: XACPRAQ => NULL() ! sum of aqueous chemical species fall at the surface by rain
+ ! in moles i / m2 (ratio with XACPRR for concentration
+ REAL, POINTER, DIMENSION(:,:) :: XACPHR => NULL() ! mean PH in accumulated surface rain
!
!-----------------------------------------------------------------------------
END TYPE CH_PH_t
diff --git a/src/MNH/modd_ch_prodlosstotn.f90 b/src/MNH/modd_ch_prodlosstotn.f90
index 289f97e343281131b22dd047faec812e3ffe5e98..a5fb75b1cbeaaed3b87535d47e838daba5d870fd 100644
--- a/src/MNH/modd_ch_prodlosstotn.f90
+++ b/src/MNH/modd_ch_prodlosstotn.f90
@@ -1,3 +1,8 @@
+!MNH_LIC Copyright 2016-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_CH_PRODLOSSTOT_n
!! ########################
@@ -25,7 +30,8 @@
!!
!! MODIFICATIONS
!! -------------
-!! Original October 2016
+!! Original October 2016
+! P. Wautelet 08/02/2019: add missing NULL association for pointers
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -36,11 +42,11 @@ IMPLICIT NONE
TYPE CH_PRODLOSSTOT_t
!
- CHARACTER(LEN=32), DIMENSION(:), POINTER :: CNAMES_PRODLOSST
- INTEGER, DIMENSION(:), POINTER :: NIND_SPEC
+ CHARACTER(LEN=32), DIMENSION(:), POINTER :: CNAMES_PRODLOSST => NULL()
+ INTEGER, DIMENSION(:), POINTER :: NIND_SPEC => NULL()
INTEGER :: NEQ_PLT
- REAL, DIMENSION(:,:,:,:), POINTER:: XPROD
- REAL, DIMENSION(:,:,:,:), POINTER:: XLOSS
+ REAL, DIMENSION(:,:,:,:), POINTER:: XPROD => NULL()
+ REAL, DIMENSION(:,:,:,:), POINTER:: XLOSS => NULL()
!
!-----------------------------------------------------------------------------
diff --git a/src/MNH/modd_ch_rosenbrockn.f90 b/src/MNH/modd_ch_rosenbrockn.f90
index ff5b17a033bb4353b514e9ac997c1721e0daa78b..9e46c3d64f0288c21cd927a3b51d872136cae209 100644
--- a/src/MNH/modd_ch_rosenbrockn.f90
+++ b/src/MNH/modd_ch_rosenbrockn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2007-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_CH_ROSENBROCK_n
@@ -20,6 +20,7 @@
!! MODIFICATIONS
!! -------------
!! Original 05/06/07
+! P. Wautelet 08/02/2019: add missing NULL association for pointers
!!
!! IMPLICIT ARGUMENTS
!! ------------------
@@ -36,19 +37,19 @@ TYPE CH_ROSENBROCK_t
!
INTEGER :: NSPARSEDIM ! size of vectors NSPARSE_IROW and NSPARSE_ICOL
!
- INTEGER, POINTER, DIMENSION(:) :: NSPARSE_IROW ! row index
- INTEGER, POINTER, DIMENSION(:) :: NSPARSE_ICOL ! col index
- INTEGER, POINTER, DIMENSION(:) :: NSPARSE_CROW ! first row element index
- INTEGER, POINTER, DIMENSION(:) :: NSPARSE_DIAG ! diag index
+ INTEGER, POINTER, DIMENSION(:) :: NSPARSE_IROW => NULL() ! row index
+ INTEGER, POINTER, DIMENSION(:) :: NSPARSE_ICOL => NULL() ! col index
+ INTEGER, POINTER, DIMENSION(:) :: NSPARSE_CROW => NULL() ! first row element index
+ INTEGER, POINTER, DIMENSION(:) :: NSPARSE_DIAG => NULL() ! diag index
! of the sparse JACobian matrix
!
INTEGER :: NEQ_NAQ ! number of Non-AQueous species
INTEGER :: NSPARSEDIM_NAQ !size of vectors NSPARSE_IROW_NAQ and NSPARSE_ICOL_NAQ
!
- INTEGER, POINTER, DIMENSION(:) :: NSPARSE_IROW_NAQ ! row index
- INTEGER, POINTER, DIMENSION(:) :: NSPARSE_ICOL_NAQ ! col index
- INTEGER, POINTER, DIMENSION(:) :: NSPARSE_CROW_NAQ ! first row element index
- INTEGER, POINTER, DIMENSION(:) :: NSPARSE_DIAG_NAQ ! diag index
+ INTEGER, POINTER, DIMENSION(:) :: NSPARSE_IROW_NAQ => NULL() ! row index
+ INTEGER, POINTER, DIMENSION(:) :: NSPARSE_ICOL_NAQ => NULL() ! col index
+ INTEGER, POINTER, DIMENSION(:) :: NSPARSE_CROW_NAQ => NULL() ! first row element index
+ INTEGER, POINTER, DIMENSION(:) :: NSPARSE_DIAG_NAQ => NULL() ! diag index
! of the sparse JACobian matrix of NonAQueous species
!
!
diff --git a/src/MNH/modd_csts_salt.f90 b/src/MNH/modd_csts_salt.f90
index 4c985d21a1f9e606d11aa89ec831c8ecb621a5e6..9db26edacaf63aa95a8388e544ed9eacf29f6308 100644
--- a/src/MNH/modd_csts_salt.f90
+++ b/src/MNH/modd_csts_salt.f90
@@ -33,6 +33,7 @@
!!
!! MODIFICATIONS
!! -------------
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
!!
!!--------------------------------------------------------------------
!! DECLARATIONS
@@ -42,7 +43,9 @@
IMPLICIT NONE
!
!densité salt a introduire
-REAL, PARAMETER :: XDENSITY_SALT = 2.1e3 ![kg/m3] density of dust
+! ++ PIERRE / MARINE SSA DUST - MODIF ++
+REAL, PARAMETER :: XDENSITY_SALT = 2.2e3 ![kg/m3] density of dust
+! -- PIERRE / MARINE SSA DUST - MODIF --
REAL, PARAMETER :: XMOLARWEIGHT_SALT = 58.e-3 ![kg/mol] molar weight dust
REAL, PARAMETER :: XM3TOUM3_SALT = 1.d18 ![um3/m3] conversion factor
REAL, PARAMETER :: XUM3TOM3_SALT = 1.d-18 ![m3/um3] conversion factor
diff --git a/src/MNH/modd_diag_in_run.f90 b/src/MNH/modd_diag_in_run.f90
index 4c52ea1175777bf35c09d329002634b54f7c99ca..b7bba80d0c045a7787cf64d952de4b44c6a2961f 100644
--- a/src/MNH/modd_diag_in_run.f90
+++ b/src/MNH/modd_diag_in_run.f90
@@ -11,6 +11,7 @@
MODULE MODD_DIAG_IN_RUN
! Modifications
!! 02/2018 Q.Libois ECRAD
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
!
!* stores instantaneous diagnostic arrays for the current time-step
!
@@ -37,4 +38,6 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_MER10M! meridian wind at 10m
REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_DSTAOD! dust aerosol optical depth
REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_SFCO2 ! CO2 Surface flux
REAL, DIMENSION(:,:,:), ALLOCATABLE :: XCURRENT_TKE_DISS ! Tke dissipation rate
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_SLTAOD ! Salt aerosol optical depth
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_ZWS ! Significant height of waves
END MODULE MODD_DIAG_IN_RUN
diff --git a/src/MNH/modd_fieldn.f90 b/src/MNH/modd_fieldn.f90
index 5f5e1847b0950cce83e8cb26aad68dbc4fbb2c5d..92e3b89c6c4b3def1b0ddbfb90bc0c8bb4687188 100644
--- a/src/MNH/modd_fieldn.f90
+++ b/src/MNH/modd_fieldn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -49,6 +49,10 @@
!! for Theta and r (noted _CLD)
!! 04/16 (M.Mazoyer) New supersaturation 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
+!! 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
!!
!-------------------------------------------------------------------------------
!
@@ -58,7 +62,10 @@
USE MODD_PARAMETERS, ONLY: JPMODELMAX
IMPLICIT NONE
+REAL, PARAMETER :: XZWS_DEFAULT = 2. ! Default value for XZWS: 2 meters
+
TYPE FIELD_t
+ REAL, DIMENSION(:,:), POINTER :: XZWS=>NULL() ! significant sea wave
! REAL, DIMENSION(:,:,:), POINTER :: XUT=>NULL(),XVT=>NULL(),XWT=>NULL()
! U,V,W at time t
REAL, DIMENSION(:,:,:), POINTER :: XRUS=>NULL(),XRVS=>NULL(),XRWS=>NULL()
@@ -108,6 +115,7 @@ END TYPE FIELD_t
TYPE(FIELD_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: FIELD_MODEL
+REAL, DIMENSION(:,:), POINTER :: XZWS=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XUT=>NULL(),XVT=>NULL(),XWT=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XRUS=>NULL(),XRVS=>NULL(),XRWS=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XRUS_PRES=>NULL(),XRVS_PRES=>NULL(),XRWS_PRES=>NULL()
@@ -133,6 +141,7 @@ REAL, DIMENSION(:,:,:), POINTER :: XSRC=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XSRCT=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XSIGS=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XCLDFR=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XRAINFR=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XCIT=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTHM=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XPABSM=>NULL()
@@ -147,6 +156,7 @@ INTEGER, INTENT(IN) :: KFROM, KTO
INTEGER :: IID,IRESP
!
! Save current state for allocated arrays
+!FIELD_MODEL(KFROM)%XZWS=>XZWS !Done in FIELDLIST_GOTO_MODEL
!FIELD_MODEL(KFROM)%XUT=>XUT !Done in FIELDLIST_GOTO_MODEL
!FIELD_MODEL(KFROM)%XVT=>XVT !Done in FIELDLIST_GOTO_MODEL
!FIELD_MODEL(KFROM)%XWT=>XWT !Done in FIELDLIST_GOTO_MODEL
@@ -182,6 +192,7 @@ FIELD_MODEL(KFROM)%XPABSM=>XPABSM
FIELD_MODEL(KFROM)%XRCM=>XRCM
!
! Current model is set to model KTO
+!XZWS=>FIELD_MODEL(KTO)%XZWS !Done in FIELDLIST_GOTO_MODEL
!XUT=>FIELD_MODEL(KTO)%XUT !Done in FIELDLIST_GOTO_MODEL
!XVT=>FIELD_MODEL(KTO)%XVT !Done in FIELDLIST_GOTO_MODEL
!XWT=>FIELD_MODEL(KTO)%XWT !Done in FIELDLIST_GOTO_MODEL
diff --git a/src/MNH/modd_getn.f90 b/src/MNH/modd_getn.f90
index 7a583779d04dd284bda63e2f567b548931c21c26..bae3402d5f9a9453dbc6f7f0fa706e3755793aa3 100644
--- a/src/MNH/modd_getn.f90
+++ b/src/MNH/modd_getn.f90
@@ -52,6 +52,7 @@
!! V. Masson 01/2004 surface externalization (rm CGETSURF)
!! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -102,6 +103,7 @@ TYPE GET_t
CHARACTER (LEN=4) :: CGETBL_DEPTH ! Get indicator for the BL depth
CHARACTER (LEN=4) :: CGETSBL_DEPTH ! Get indicator for the SBL depth
CHARACTER (LEN=4) :: CGETPHC,CGETPHR ! Get indicator for the pH values
+ CHARACTER (LEN=4) :: CGETZWS
! in cloud water and rainwater
!
END TYPE GET_t
@@ -133,6 +135,7 @@ CHARACTER (LEN=4), POINTER :: CGETBL_DEPTH=>NULL()
CHARACTER (LEN=4), POINTER :: CGETSBL_DEPTH=>NULL()
CHARACTER (LEN=4), POINTER :: CGETPHC=>NULL()
CHARACTER (LEN=4), POINTER :: CGETPHR=>NULL()
+CHARACTER (LEN=4), POINTER :: CGETZWS=>NULL()
CONTAINS
@@ -179,6 +182,7 @@ CGETSRC=>GET_MODEL(KTO)%CGETSRC
CGETCLDFR=>GET_MODEL(KTO)%CGETCLDFR
CGETSRCT=>GET_MODEL(KTO)%CGETSRCT
CGETCIT=>GET_MODEL(KTO)%CGETCIT
+CGETZWS=>GET_MODEL(KTO)%CGETZWS
CGETCONV=>GET_MODEL(KTO)%CGETCONV
CGETRAD=>GET_MODEL(KTO)%CGETRAD
CGETCLOUD=>GET_MODEL(KTO)%CGETCLOUD
diff --git a/src/MNH/modd_io_nam.f90 b/src/MNH/modd_io_nam.f90
index 8c4a8e628d9bcaff68fc79bea844859ef93cf6b4..e5249d0d4cba998ecd8e37a6c29fc75a5afddce7 100644
--- a/src/MNH/modd_io_nam.f90
+++ b/src/MNH/modd_io_nam.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ######################
@@ -31,7 +31,7 @@
!* 0. DECLARATIONS
! ------------
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
IMPLICIT NONE
!------------------------------------------------------------------------------
diff --git a/src/MNH/modd_io_surf_mnh.f90 b/src/MNH/modd_io_surf_mnh.f90
index dffcc6bc7eee6640897682f55ede9a285b20ac29..635f6b6ed39c1cf5a57d75aef19521fddd25bb96 100644
--- a/src/MNH/modd_io_surf_mnh.f90
+++ b/src/MNH/modd_io_surf_mnh.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ##################
@@ -32,7 +32,7 @@
!
!* 0. DECLARATIONS
!
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS, ONLY: JPMODELMAX
IMPLICIT NONE
diff --git a/src/MNH/modd_lesn.f90 b/src/MNH/modd_lesn.f90
index dd37f5461e2c5e7c7146c82e8ef724ca066ae8d3..9fe76c3f8f7eacbc68b7724d4f0df26562d791d3 100644
--- a/src/MNH/modd_lesn.f90
+++ b/src/MNH/modd_lesn.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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/modd_lesn.f90,v $ $Revision: 1.2.2.2.2.1.2.1.12.2 $ $Date: 2014/01/09 15:01:56 $
-!-----------------------------------------------------------------
-!-----------------------------------------------------------------
! ###############
MODULE MODD_LES_n
! ###############
@@ -22,13 +17,13 @@
!!
!!** IMPLICIT ARGUMENTS
!! ------------------
-!! None
+!! None
!!
!! REFERENCE
!! ---------
!! Book2 of documentation of Meso-NH (module MODD_LES)
!! Technical Specifications Report of the Meso-NH (chapters 2 and 3)
-!!
+!!
!!
!! AUTHOR
!! ------
@@ -36,7 +31,7 @@
!!
!! MODIFICATIONS
!! -------------
-!! Original March 10, 1995
+!! Original March 10, 1995
!!
!! (J.Stein) Sept. 25, 1995 add the model number in LES mode
!! J. Cuxart Oct. 4, 1996 New time series
@@ -44,6 +39,8 @@
!! V. Masson Nov. 6, 2002 LES budgets
!! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -117,6 +114,7 @@ TYPE LES_t
REAL, DIMENSION(:,:,:), POINTER :: XLES_MEAN_Cf=>NULL() ! <CLDFR>
REAL, DIMENSION(:,:,:), POINTER :: XLES_MEAN_INDCf=>NULL() ! <Cf> tq rc>0 (0 OU 1)
REAL, DIMENSION(:,:,:), POINTER :: XLES_MEAN_INDCf2=>NULL() ! <Cf> tq rc>1E-5 (0 OU 1)
+ REAL, DIMENSION(:,:,:), POINTER :: XLES_MEAN_RF=>NULL() ! <RAINFR>
REAL, DIMENSION(:,:,:), POINTER :: XLES_MEAN_Mf=>NULL() ! <Mf>
REAL, DIMENSION(:,:,:), POINTER :: XLES_MEAN_KHt=>NULL()! <Kh for thet
REAL, DIMENSION(:,:,:), POINTER :: XLES_MEAN_KHr=>NULL()! <Kh for qr>
@@ -647,20 +645,20 @@ TYPE LES_t
!
REAL, DIMENSION(:,:,:), POINTER :: XCORRk_WW=>NULL() ! between w and w
!
-!lw and sw fluxes up and down
- REAL, DIMENSION(:,:), POINTER :: XLES_SWU !mean on the domain of the sw_up flux
+!lw and sw fluxes up and down
+ REAL, DIMENSION(:,:), POINTER :: XLES_SWU => NULL() !mean on the domain of the sw_up flux
!temporal serie
- REAL, DIMENSION(:,:), POINTER :: XLES_SWD !mean on the domain of the sw_down flux
+ REAL, DIMENSION(:,:), POINTER :: XLES_SWD => NULL() !mean on the domain of the sw_down flux
!temporal serie
- REAL, DIMENSION(:,:), POINTER :: XLES_LWU !mean on the domain of the lw_up flux
+ REAL, DIMENSION(:,:), POINTER :: XLES_LWU => NULL() !mean on the domain of the lw_up flux
!temporal serie
- REAL, DIMENSION(:,:), POINTER :: XLES_LWD !mean on the domain of the lw_down flux
+ REAL, DIMENSION(:,:), POINTER :: XLES_LWD => NULL() !mean on the domain of the lw_down flux
!temporal serie
- REAL, DIMENSION(:,:), POINTER :: XLES_DTHRADSW !mean on the domain of dthrad_sw flux
+ REAL, DIMENSION(:,:), POINTER :: XLES_DTHRADSW => NULL() !mean on the domain of dthrad_sw flux
!temporal serie
- REAL, DIMENSION(:,:), POINTER :: XLES_DTHRADLW !mean on the domain of dthrad_lw flux
+ REAL, DIMENSION(:,:), POINTER :: XLES_DTHRADLW => NULL() !mean on the domain of dthrad_lw flux
!temporal serie
- REAL, DIMENSION(:,:), POINTER :: XLES_RADEFF ! effective radius
+ REAL, DIMENSION(:,:), POINTER :: XLES_RADEFF => NULL() ! effective radius
!-------------------------------------------------------------------------------
!
END TYPE LES_t
@@ -698,6 +696,7 @@ REAL, DIMENSION(:,:,:), POINTER :: XLES_MEAN_Rc=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XLES_MEAN_Cf=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XLES_MEAN_INDCf=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XLES_MEAN_INDCf2=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XLES_MEAN_RF=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XLES_MEAN_Mf=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XLES_MEAN_KHt=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XLES_MEAN_KHr=>NULL()
@@ -1125,6 +1124,7 @@ LES_MODEL(KFROM)%XLES_MEAN_Rc=>XLES_MEAN_Rc
LES_MODEL(KFROM)%XLES_MEAN_Cf=>XLES_MEAN_Cf
LES_MODEL(KFROM)%XLES_MEAN_INDCf=>XLES_MEAN_INDCf
LES_MODEL(KFROM)%XLES_MEAN_INDCf2=>XLES_MEAN_INDCf2
+LES_MODEL(KFROM)%XLES_MEAN_RF=>XLES_MEAN_RF
LES_MODEL(KFROM)%XLES_MEAN_Mf=>XLES_MEAN_Mf
LES_MODEL(KFROM)%XLES_MEAN_KHt=>XLES_MEAN_KHt
LES_MODEL(KFROM)%XLES_MEAN_KHr=>XLES_MEAN_KHr
@@ -1553,6 +1553,7 @@ XLES_MEAN_Rc=>LES_MODEL(KTO)%XLES_MEAN_Rc
XLES_MEAN_Cf=>LES_MODEL(KTO)%XLES_MEAN_Cf
XLES_MEAN_INDCf=>LES_MODEL(KTO)%XLES_MEAN_INDCf
XLES_MEAN_INDCf2=>LES_MODEL(KTO)%XLES_MEAN_INDCf2
+XLES_MEAN_RF=>LES_MODEL(KTO)%XLES_MEAN_RF
XLES_MEAN_Mf=>LES_MODEL(KTO)%XLES_MEAN_Mf
XLES_MEAN_KHt=>LES_MODEL(KTO)%XLES_MEAN_KHt
XLES_MEAN_KHr=>LES_MODEL(KTO)%XLES_MEAN_KHr
diff --git a/src/MNH/modd_lsfieldn.f90 b/src/MNH/modd_lsfieldn.f90
index 208f1d4d2bb3a8ae3cdd6b34a35324f76449d7a8..6274b8dd6075620ef5b74a9c58629da9b5884af1 100644
--- a/src/MNH/modd_lsfieldn.f90
+++ b/src/MNH/modd_lsfieldn.f90
@@ -36,6 +36,7 @@
!! 2D arrays to store values at lateral boundaries
!! 20/05/06 Remove EPS
!! 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
!-------------------------------------------------------------------------------
!
!
@@ -55,12 +56,15 @@ TYPE LSFIELD_t
! ! time t-dt for larger scales
! REAL, DIMENSION(:,:,:), POINTER :: XLSRVM=>NULL() ! Rv (mixing ratio for vapor)
! ! at time t-dt for larger scales
+ REAL, DIMENSION(:,:), POINTER :: XLSZWSM=>NULL() ! height of sea waves
REAL, DIMENSION(:,:,:), POINTER :: XLSUS=>NULL(),XLSVS=>NULL(),XLSWS=>NULL() ! Tendency of
! U,V,W for larger scales
REAL, DIMENSION(:,:,:), POINTER :: XLSTHS=>NULL() ! Tendency of
! theta for larger scales
REAL, DIMENSION(:,:,:), POINTER :: XLSRVS=>NULL() ! Tendency of
! ! RV for larger scales
+REAL, DIMENSION(:,:), POINTER :: XLSZWSS=>NULL() ! Tendency of
+! ! sea wave for larger scales
! previously present for LS for V * Prhodj
!
! Large scale variables for horizontal lbc
@@ -104,8 +108,10 @@ TYPE(LSFIELD_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: LSFIELD_MODEL
REAL, DIMENSION(:,:,:), POINTER :: XLSUM=>NULL(),XLSVM=>NULL(),XLSWM=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XLSTHM=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XLSRVM=>NULL()
+REAL, DIMENSION(:,:), POINTER :: XLSZWSM=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XLSUS=>NULL(),XLSVS=>NULL(),XLSWS=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XLSTHS=>NULL()
+REAL, DIMENSION(:,:), POINTER :: XLSZWSS=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XLSRVS=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XLBXUM=>NULL(),XLBXVM=>NULL(),XLBXWM=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XLBXTHM=>NULL()
@@ -143,11 +149,13 @@ INTEGER, INTENT(IN) :: KFROM, KTO
!LSFIELD_MODEL(KFROM)%XLSWM=>XLSWM !Done in FIELDLIST_GOTO_MODEL
!LSFIELD_MODEL(KFROM)%XLSTHM=>XLSTHM !Done in FIELDLIST_GOTO_MODEL
!LSFIELD_MODEL(KFROM)%XLSRVM=>XLSRVM !Done in FIELDLIST_GOTO_MODEL
+LSFIELD_MODEL(KFROM)%XLSZWSM=>XLSZWSM
LSFIELD_MODEL(KFROM)%XLSUS=>XLSUS
LSFIELD_MODEL(KFROM)%XLSVS=>XLSVS
LSFIELD_MODEL(KFROM)%XLSWS=>XLSWS
LSFIELD_MODEL(KFROM)%XLSTHS=>XLSTHS
LSFIELD_MODEL(KFROM)%XLSRVS=>XLSRVS
+LSFIELD_MODEL(KFROM)%XLSZWSS=>XLSZWSS
!LSFIELD_MODEL(KFROM)%XLBXUM=>XLBXUM !Done in FIELDLIST_GOTO_MODEL
!LSFIELD_MODEL(KFROM)%XLBXVM=>XLBXVM !Done in FIELDLIST_GOTO_MODEL
!LSFIELD_MODEL(KFROM)%XLBXWM=>XLBXWM !Done in FIELDLIST_GOTO_MODEL
@@ -199,11 +207,13 @@ LSFIELD_MODEL(KFROM)%NKLIN_LBYM=>NKLIN_LBYM
!XLSWM=>LSFIELD_MODEL(KTO)%XLSWM !Done in FIELDLIST_GOTO_MODEL
!XLSTHM=>LSFIELD_MODEL(KTO)%XLSTHM !Done in FIELDLIST_GOTO_MODEL
!XLSRVM=>LSFIELD_MODEL(KTO)%XLSRVM !Done in FIELDLIST_GOTO_MODEL
+XLSZWSM=>LSFIELD_MODEL(KTO)%XLSZWSM
XLSUS=>LSFIELD_MODEL(KTO)%XLSUS
XLSVS=>LSFIELD_MODEL(KTO)%XLSVS
XLSWS=>LSFIELD_MODEL(KTO)%XLSWS
XLSTHS=>LSFIELD_MODEL(KTO)%XLSTHS
XLSRVS=>LSFIELD_MODEL(KTO)%XLSRVS
+XLSZWSS=>LSFIELD_MODEL(KTO)%XLSZWSS
!XLBXUM=>LSFIELD_MODEL(KTO)%XLBXUM !Done in FIELDLIST_GOTO_MODEL
!XLBXVM=>LSFIELD_MODEL(KTO)%XLBXVM !Done in FIELDLIST_GOTO_MODEL
!XLBXWM=>LSFIELD_MODEL(KTO)%XLBXWM !Done in FIELDLIST_GOTO_MODEL
diff --git a/src/MNH/modd_lunit.f90 b/src/MNH/modd_lunit.f90
index 36027e7cf005c7dbaf37ab5f962f5281e91c0c18..d19cf3d356985b87d202896711878561674a672a 100644
--- a/src/MNH/modd_lunit.f90
+++ b/src/MNH/modd_lunit.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #################
@@ -22,26 +22,26 @@
!! REFERENCE
!! ---------
!! Book2 of documentation of Meso-NH (MODD_LUNIT)
-!!
+!!
!! AUTHOR
!! ------
-!! V. Ducrocq *Meteo France*
+!! V. Ducrocq *Meteo France*
!!
!! MODIFICATIONS
!! -------------
-!! Original 05/05/94
+!! Original 05/05/94
!! V. Masson 01/2004 add file names for use in externalized surface
!! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
IMPLICIT NONE
!
-CHARACTER(LEN=16),SAVE :: CLUOUT0 ! Name of output_listing file
TYPE(TFILEDATA),POINTER :: TLUOUT0 => NULL() ! output_listing file
TYPE(TFILEDATA),POINTER :: TOUTDATAFILE => NULL() ! output data file being written
TYPE(TFILEDATA),POINTER :: TPGDFILE => NULL() ! PGD file
diff --git a/src/MNH/modd_lunitn.f90 b/src/MNH/modd_lunitn.f90
index 10fe48a5f2ec984081ae504e5f68ce2977e4d0fc..4ac4a5c31b574eb53b7f128a57a9e9beb41996fb 100644
--- a/src/MNH/modd_lunitn.f90
+++ b/src/MNH/modd_lunitn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ###################
@@ -35,13 +35,14 @@
!! Modification 10/03/95 (I.Mallet) add the coupling files names
!! Modification 25/09/95 (J.Stein) add the output diachronic file
!! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
!
-USE MODD_IO_ll, ONLY: TFILEDATA, TPTR2FILE
+USE MODD_IO, ONLY: TFILEDATA, TPTR2FILE
USE MODD_PARAMETERS, ONLY: JPMODELMAX, JPCPLFILEMAX
IMPLICIT NONE
@@ -54,8 +55,6 @@ TYPE LUNIT_t
TYPE(TFILEDATA),POINTER :: TINIFILEPGD => NULL() ! PGD associated to input FM-file
CHARACTER(LEN=24) :: COUTFILE = '' ! Generic name of the output FM-files
TYPE(TFILEDATA),POINTER :: TDIAFILE => NULL() ! diachronic output file
-!
- CHARACTER(LEN=16) :: CLUOUT = '' ! Name of output_listing file
TYPE(TFILEDATA),POINTER :: TLUOUT => NULL() ! output_listing file
!JUAN
CHARACTER(LEN=28),DIMENSION(:),POINTER :: CCPLFILE =>NULL() ! Names of the
@@ -75,7 +74,6 @@ CHARACTER(LEN=28), POINTER :: CINIFILEPGD =>NULL()
TYPE(TFILEDATA), POINTER :: TINIFILEPGD => NULL()
CHARACTER(LEN=24), POINTER :: COUTFILE=>NULL()
TYPE(TFILEDATA), POINTER :: TDIAFILE=>NULL()
-CHARACTER(LEN=16), POINTER :: CLUOUT=>NULL()
TYPE(TFILEDATA), POINTER :: TLUOUT=>NULL()
CHARACTER(LEN=28),DIMENSION(:), POINTER :: CCPLFILE=>NULL()
TYPE(TPTR2FILE), DIMENSION(:), POINTER :: TCPLFILE=>NULL()
@@ -84,7 +82,7 @@ CONTAINS
SUBROUTINE LUNIT_GOTO_MODEL(KFROM, KTO)
!
-USE MODD_IO_ll, ONLY : TFILE_OUTPUTLISTING
+USE MODD_IO, ONLY : TFILE_OUTPUTLISTING
!
INTEGER, INTENT(IN) :: KFROM, KTO
!
@@ -107,7 +105,6 @@ CINIFILEPGD=>LUNIT_MODEL(KTO)%CINIFILEPGD
TINIFILEPGD=>LUNIT_MODEL(KTO)%TINIFILEPGD
COUTFILE=>LUNIT_MODEL(KTO)%COUTFILE
TDIAFILE=>LUNIT_MODEL(KTO)%TDIAFILE
-CLUOUT=>LUNIT_MODEL(KTO)%CLUOUT
TLUOUT=>LUNIT_MODEL(KTO)%TLUOUT
CCPLFILE=>LUNIT_MODEL(KTO)%CCPLFILE
TCPLFILE=>LUNIT_MODEL(KTO)%TCPLFILE
diff --git a/src/MNH/modd_nesting.f90 b/src/MNH/modd_nesting.f90
index 077e976819222b8ea362026da445b3113b47bda1..d644d0260864d317790838b253b26c75aca6bac0 100644
--- a/src/MNH/modd_nesting.f90
+++ b/src/MNH/modd_nesting.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1995-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ###################
@@ -24,7 +24,7 @@
!! REFERENCE
!! ---------
!! Book2 of documentation of Meso-NH (module MODD_NESTING)
-!!
+!!
!! AUTHOR
!! ------
!! J.P. Lafore *Meteo France*
@@ -32,8 +32,9 @@
!! MODIFICATIONS
!! -------------
!! Original 18/08/95
-!! updated 29/07/96 (J.P. Lafore) MY_NAME(m) introduction
+!! updated 29/07/96 (J.P. Lafore) MY_NAME(m) introduction
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 08/02/2019: add missing NULL association for pointers
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -81,11 +82,11 @@ LOGICAL,SAVE, DIMENSION(JPMODELMAX) :: L2D_NEST ! Logical for 2D model
LOGICAL,SAVE, DIMENSION(JPMODELMAX) :: LPACK_NEST ! Logical to compress 1D or 2D FM files of model m
!
TYPE REAL_FIELD2D_ALL
- REAL, DIMENSION(:,:), POINTER :: XFIELD2D
+ REAL, DIMENSION(:,:), POINTER :: XFIELD2D => NULL()
END TYPE REAL_FIELD2D_ALL
TYPE REAL_FIELD1D_ALL
- REAL, DIMENSION(:), POINTER :: XFIELD1D
+ REAL, DIMENSION(:), POINTER :: XFIELD1D => NULL()
END TYPE REAL_FIELD1D_ALL
!
TYPE(REAL_FIELD2D_ALL), DIMENSION(JPMODELMAX), TARGET :: TXZS ! orography of model m
diff --git a/src/MNH/modd_nudgingn.f90 b/src/MNH/modd_nudgingn.f90
index c4f4768bacd7ec1d74954871dcf574ef392c79bf..2bdadfb0f3c65b676df5f51f1b8f24c213e5dc7e 100644
--- a/src/MNH/modd_nudgingn.f90
+++ b/src/MNH/modd_nudgingn.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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/24 18:05:50
-!-----------------------------------------------------------------
! ###################
MODULE MODD_NUDGING_n
! ###################
@@ -32,6 +27,7 @@
!! MODIFICATIONS
!! -------------
!! Original 15/05/06
+! P. Wautelet 08/02/2019: add missing NULL association for pointers
!!
!-------------------------------------------------------------------------------
!
@@ -49,8 +45,8 @@ END TYPE NUDGING_t
TYPE(NUDGING_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: NUDGING_MODEL
-LOGICAL, POINTER :: LNUDGING
-REAL, POINTER :: XTNUDGING
+LOGICAL, POINTER :: LNUDGING => NULL()
+REAL, POINTER :: XTNUDGING => NULL()
CONTAINS
diff --git a/src/MNH/modd_outn.f90 b/src/MNH/modd_outn.f90
index 0dceb304a19aa2f3520a4144505dce090471e760..7a3ff7e78c4c8b0853cd5d9b9a15eb80f8847ab3 100644
--- a/src/MNH/modd_outn.f90
+++ b/src/MNH/modd_outn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 @@
!
!
USE MODD_PARAMETERS, ONLY: JPMODELMAX, JPOUTMAX
-USE MODD_IO_ll, ONLY:TOUTBAK
+USE MODD_IO, ONLY: TOUTBAK
IMPLICIT NONE
TYPE OUT_t
diff --git a/src/MNH/modd_param_ecradn.f90 b/src/MNH/modd_param_ecradn.f90
index 988888427f73a72b906136430fc581646778aa82..a7bf0b344753be234bbed47285ed5880b1de3018 100644
--- a/src/MNH/modd_param_ecradn.f90
+++ b/src/MNH/modd_param_ecradn.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2017-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/11/23 17:28:26
-!-----------------------------------------------------------------
! ########################
MODULE MODD_PARAM_ECRAD_n
! ########################
@@ -38,6 +33,7 @@
!! -------------
!! Original 29/05/2017 add ECRAD parameters as namelist
!! Q. Libois
+! P. Wautelet 08/02/2019: add missing NULL association for pointers
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -213,7 +209,7 @@ LOGICAL, POINTER :: LAPPROXSWUPDATE=>NULL()
LOGICAL, POINTER :: LAPPROXLWUPDATE=>NULL()
CHARACTER (LEN=255), POINTER :: CDATADIR=>NULL()
#ifdef MNH_ECRAD
-type(config_type), pointer :: rad_config
+type(config_type), pointer :: rad_config => NULL()
#endif
CONTAINS
diff --git a/src/MNH/modd_parameters.f90 b/src/MNH/modd_parameters.f90
index a128c34b3029ed4f2b5074602046dacf51770c80..8b0c0a4fcbed60e0f60b94df6c8e11102ad4b77b 100644
--- a/src/MNH/modd_parameters.f90
+++ b/src/MNH/modd_parameters.f90
@@ -40,6 +40,7 @@
!! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -74,7 +75,7 @@ INTEGER, PARAMETER :: NNEGUNDEF = -999 ! default value for undefined or unused
! ! field (negative value guaranteed)
INTEGER, PARAMETER :: JPDUMMY = 20 ! Size of dummy array
!
-INTEGER, PARAMETER :: JPOUTMAX = 192 ! Maximum allowed number of OUTput files
+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
diff --git a/src/MNH/modd_precision.f90 b/src/MNH/modd_precision.f90
new file mode 100644
index 0000000000000000000000000000000000000000..e302e46b96e79d9a950ebb5a1cf3f9f39db68547
--- /dev/null
+++ b/src/MNH/modd_precision.f90
@@ -0,0 +1,120 @@
+!MNH_LIC Copyright 2019-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.
+!-----------------------------------------------------------------
+! Author:
+! P. Wautelet 08/03/2019
+! Modifications:
+! 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
+!-----------------------------------------------------------------
+module modd_precision
+
+use modd_mpif
+
+#ifdef MNH_IOCDF4
+use NETCDF, only: NF90_DOUBLE, NF90_FLOAT, NF90_INT, NF90_INT64
+#endif
+
+implicit none
+
+private
+
+public :: MNHINT32, MNHINT64, MNHREAL32, MNHREAL64, MNHREAL128
+
+public :: MNHINT32_MPI, MNHINT64_MPI
+public :: MNHREAL32_MPI, MNHREAL64_MPI
+public :: MNH2REAL32_MPI, MNH2REAL64_MPI
+
+public :: MNHINT, MNHREAL
+public :: MNHINT_MPI, MNHREAL_MPI, MNH2REAL_MPI
+public :: MNHTIME, MNHTIME_MPI
+
+public :: LFIINT
+
+#ifdef MNH_IOCDF4
+public :: CDFINT, MNHINT_NF90, MNHREAL_NF90
+#endif
+
+
+integer, parameter :: MNHINT32 = selected_int_kind( r = 9 )
+integer, parameter :: MNHINT64 = selected_int_kind( r = 18 )
+
+integer, parameter :: MNHREAL32 = selected_real_kind( p = 6, r = 37 )
+integer, parameter :: MNHREAL64 = selected_real_kind( p = 15, r = 307 )
+integer, parameter :: MNHREAL128 = selected_real_kind( p = 33, r = 4931 )
+
+integer, parameter :: MNHINT32_MPI = MPI_INTEGER4
+integer, parameter :: MNHINT64_MPI = MPI_INTEGER8
+
+integer, parameter :: MNHREAL32_MPI = MPI_REAL4
+integer, parameter :: MNHREAL64_MPI = MPI_REAL8
+
+integer, parameter :: MNH2REAL32_MPI = MPI_2REAL
+integer, parameter :: MNH2REAL64_MPI = MPI_2DOUBLE_PRECISION
+
+
+! Kinds for MesoNH
+#if ( MNH_INT == 4 )
+integer, parameter :: MNHINT = MNHINT32
+integer, parameter :: MNHINT_MPI = MNHINT32_MPI
+#elif ( MNH_INT == 8 )
+integer, parameter :: MNHINT = MNHINT64
+integer, parameter :: MNHINT_MPI = MNHINT64_MPI
+#else
+#error "Invalid MNH_INT"
+#endif
+
+#if ( MNH_REAL == 4 )
+integer, parameter :: MNHREAL = MNHREAL32
+integer, parameter :: MNHREAL_MPI = MNHREAL32_MPI
+integer, parameter :: MNH2REAL_MPI = MNH2REAL32_MPI
+#elif ( MNH_REAL == 8 )
+integer, parameter :: MNHREAL = MNHREAL64
+integer, parameter :: MNHREAL_MPI = MNHREAL64_MPI
+integer, parameter :: MNH2REAL_MPI = MNH2REAL64_MPI
+#elif ( MNH_REAL == 16 )
+integer, parameter :: MNHREAL = MNHREAL128
+integer, parameter :: MNHREAL_MPI = MPI_REAL16
+#error "No MNH2REAL_MPI for MNH_REAL=16"
+#else
+#error "Invalid MNH_REAL"
+#endif
+
+integer, parameter :: MNHTIME = MNHREAL64
+integer, parameter :: MNHTIME_MPI = MNHREAL64_MPI
+
+
+! Kinds for LFI
+#if ( LFI_INT == 4 )
+integer, parameter :: LFIINT = MNHINT32
+#elif ( LFI_INT == 8 )
+integer, parameter :: LFIINT = MNHINT64
+#else
+#error "Invalid LFI_INT"
+#endif
+
+
+#ifdef MNH_IOCDF4
+! Kinds for netCDF
+integer, parameter :: CDFINT = selected_int_kind( r = 9 )
+
+#if (MNH_INT == 4)
+integer, parameter :: MNHINT_NF90 = NF90_INT
+#elif (MNH_INT == 8)
+integer, parameter :: MNHINT_NF90 = NF90_INT64
+#else
+#error "Invalid MNH_INT"
+#endif
+
+#if (MNH_REAL == 4)
+integer, parameter :: MNHREAL_NF90 = NF90_FLOAT
+#elif (MNH_REAL == 8)
+integer, parameter :: MNHREAL_NF90 = NF90_DOUBLE
+#else
+#error "Invalid MNH_REAL"
+#endif
+#endif
+
+end module modd_precision
diff --git a/src/MNH/modd_radiationsn.f90 b/src/MNH/modd_radiationsn.f90
index 455a2bc04fccdd17251079516537718561c1c621..ec51e9e32cf0b37c8915903f16f156d690234f55 100644
--- a/src/MNH/modd_radiationsn.f90
+++ b/src/MNH/modd_radiationsn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1995-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 @@
!! 03/03/03 (V. Masson) surface radiative schemes and
!! multiple wavelengths for surface SW
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 08/02/2019: add missing NULL association for pointers
!!
!-------------------------------------------------------------------------------
!
@@ -108,18 +109,18 @@ TYPE RADIATIONS_t
! REAL, DIMENSION(:,:,:), POINTER :: XSCA_ALB=>NULL() ! scattered albedo for each spectral band
! REAL, DIMENSION(:,:,:), POINTER :: XEMIS=>NULL() ! emissivity
! REAL, DIMENSION(:,:), POINTER :: XTSRAD=>NULL() ! surface temperature
- REAL, DIMENSION(:,:), POINTER :: XSEA=>NULL() ! sea fraction
+ REAL, DIMENSION(:,:), POINTER :: XSEA=>NULL() ! sea fraction
!
! REAL, DIMENSION(:,:), POINTER :: XZENITH=>NULL() ! zenithal angle (radian from the vertical)
! REAL, DIMENSION(:,:), POINTER :: XAZIM=>NULL() ! azimuthal angle (radian from N, clockwise)
- REAL, DIMENSION(:,:), POINTER :: XALBUV=>NULL() ! UV albedo
- REAL, DIMENSION(:,:,:), POINTER :: XSWU !SW_UP
- REAL, DIMENSION(:,:,:), POINTER :: XSWD !SW_DOWN
- REAL, DIMENSION(:,:,:), POINTER :: XLWU !LW_UP
- REAL, DIMENSION(:,:,:), POINTER :: XLWD !LW_DOWN
- REAL, DIMENSION(:,:,:), POINTER :: XDTHRADSW !DTHRAD SW
- REAL, DIMENSION(:,:,:), POINTER :: XDTHRADLW !DTHRAD LW
- REAL, DIMENSION(:,:,:), POINTER :: XRADEFF !effective radius
+ REAL, DIMENSION(:,:), POINTER :: XALBUV=>NULL() ! UV albedo
+ REAL, DIMENSION(:,:,:), POINTER :: XSWU => NULL() ! SW_UP
+ REAL, DIMENSION(:,:,:), POINTER :: XSWD => NULL() ! SW_DOWN
+ REAL, DIMENSION(:,:,:), POINTER :: XLWU => NULL() ! LW_UP
+ REAL, DIMENSION(:,:,:), POINTER :: XLWD => NULL() ! LW_DOWN
+ REAL, DIMENSION(:,:,:), POINTER :: XDTHRADSW => NULL() ! DTHRAD SW
+ REAL, DIMENSION(:,:,:), POINTER :: XDTHRADLW => NULL() ! DTHRAD LW
+ REAL, DIMENSION(:,:,:), POINTER :: XRADEFF => NULL() ! effective radius
!
END TYPE RADIATIONS_t
diff --git a/src/MNH/modd_salt.f90 b/src/MNH/modd_salt.f90
index 01f908fe1e56873f0a8c7db97be309d50a94aa63..769ca39f17c464c2cf8503115eb4542dd04b9b07 100644
--- a/src/MNH/modd_salt.f90
+++ b/src/MNH/modd_salt.f90
@@ -35,6 +35,7 @@
!! -------------
!!
!! 2014 P.Tulet modif XINIRADIUS_SLT and XN0MIN_SLT
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
!!
USE MODD_PARAMETERS, ONLY: JPMODELMAX
!!--------------------------------------------------------------------
@@ -42,51 +43,64 @@ USE MODD_PARAMETERS, ONLY: JPMODELMAX
!! ------------
IMPLICIT NONE
!
-
+! ++ PIERRE / MARINE SSA DUST - MODIF ++
+LOGICAL :: LSLTMACC = .FALSE. ! switch to active pronostic sea salts from MACC
LOGICAL :: LSALT = .FALSE. ! switch to active pronostic sea salts
+LOGICAL :: LONLY = .FALSE.
+LOGICAL :: LREAD_ONLY_HS_MACC = .FALSE.
LOGICAL :: LSLTINIT = .FALSE. ! switch to initialize pronostic sea salts
LOGICAL :: LSLTPRES = .FALSE. ! switch to know if pronostic salts exist
LOGICAL,DIMENSION(JPMODELMAX) :: LDEPOS_SLT = .FALSE. ! switch to SLT wet depositon
-INTEGER :: NMODE_SLT= 3 ! number of sea salt modes (max 3; default = 3)
+
+!INTEGER :: NMODE_SLT= 3 ! number of sea salt modes (max 3; default = 3)
+INTEGER :: NMODE_SLT= 5 ! number of sea salt modes (max 5; default = 3)
!
CHARACTER(LEN=9),DIMENSION(:),ALLOCATABLE :: CDESLTNAMES
-CHARACTER(LEN=9),DIMENSION(6), PARAMETER :: YPDESLT_INI = &
- (/'DESLTM31C','DESLTM32C','DESLTM33C' &
- ,'DESLTM31R','DESLTM32R','DESLTM33R' /)
-CHARACTER(LEN=6),DIMENSION(:),ALLOCATABLE :: CSALTNAMES
-CHARACTER(LEN=6),DIMENSION(9), PARAMETER :: YPSALT_INI = &
- (/'SLTM01','SLTM31','SLTM61' &
- ,'SLTM02','SLTM32','SLTM62' &
- ,'SLTM03','SLTM33','SLTM63' /)
-! Set the order of the loops sorted by importance
-!This means that if a user choses 1 mode it will have characteristics of mode 2
-!2 modes will be mode 2 & 3, whereas 3 modes will modes 1, 2 and 3
-INTEGER, DIMENSION(3),PARAMETER :: JPSALTORDER = (/3, 2, 1/)
-!
-REAL, ALLOCATABLE :: XSLTMSS(:,:,:) ! [kg/m3] total mass concentration of sea salt
+CHARACTER(LEN=6),DIMENSION(:), ALLOCATABLE :: CSALTNAMES
+CHARACTER(LEN=9),DIMENSION(10), PARAMETER :: YPDESLT_INI = &
+ (/'DESLTM31C','DESLTM32C','DESLTM33C','DESLTM34C', 'DESLTM35C', &
+ 'DESLTM31R','DESLTM32R','DESLTM33R', 'DESLTM34R','DESLTM35R' /)
+
+CHARACTER(LEN=6),DIMENSION(15), PARAMETER :: YPSALT_INI = &
+ (/'SLTM01','SLTM31','SLTM61',&
+ 'SLTM02','SLTM32','SLTM62',&
+ 'SLTM03','SLTM33','SLTM63',&
+ 'SLTM04','SLTM34','SLTM64',&
+ 'SLTM05','SLTM35','SLTM65' /)
+
+INTEGER, DIMENSION(5),PARAMETER :: JPSALTORDER = (/1, 2, 3, 4, 5/)
+
+!Test Thomas (definir rayons et sigma ici si on veut desactiver initialisation MACC)
+
+!REAL, DIMENSION(5) :: XINIRADIUS_SLT,XINISIG_SLT,XN0MIN_SLT
+
+!Initial dry number median radius (um) from Ova et al., 2014
+REAL,DIMENSION(5) :: XINIRADIUS_SLT= (/0.009, 0.021, 0.045, 0.115, 0.415/)
+!Initial, standard deviation from Ova et al., 2014
+REAL,DIMENSION(5) :: XINISIG_SLT = (/ 1.37, 1.5, 1.42, 1.53, 1.85 /)
+!Minimum allowed number concentration for any mode (#/m3)
+REAL,DIMENSION(5) :: XN0MIN_SLT = (/1. , 1., 1., 1., 1. /)
+
+!Test Thomas
+
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XSLTMSS ! [kg/m3] total mass concentration of sea salt
!
! aerosol lognormal parameterization
-CHARACTER(LEN=4) :: CRGUNITS = 'MASS' ! type of log-normal geometric mean radius
+CHARACTER(LEN=4) :: CRGUNITS = 'NUMB' ! type of log-normal geometric mean radius
! !given in namelist (mass on number)
!
LOGICAL :: LRGFIX_SLT = .FALSE. ! switch to fix RG (sedimentation)
LOGICAL :: LVARSIG_SLT = .FALSE. ! switch to active pronostic dispersion for all modes
LOGICAL :: LSEDIMSALT = .FALSE. ! switch to active aerosol sedimentation
REAL :: XSIGMIN_SLT = 1.20 ! minimum dispersion value for sea salt mode
+!REAL :: XSIGMIN_SLT = 0. ! minimum dispersion value for sea salt mode
REAL :: XSIGMAX_SLT = 3.60 ! maximum dispersion value for sea salt mode
REAL :: XCOEFRADMAX_SLT = 10. ! maximum increasement for Rg mode sea salt
-REAL :: XCOEFRADMIN_SLT = 0.1 ! maximum decreasement for Rg mode sea salt
-!
+REAL :: XCOEFRADMIN_SLT = 0.1 ! minimum decreasement for Rg mode sea salt
+!REAL :: XCOEFRADMIN_SLT = 0. ! minimum decreasement for Rg mode sea salt
-!Initial dry number median radius (um) from Vignati et al., 2001
-!REAL, DIMENSION(3) :: XINIRADIUS_SLT= (/0.2, 2., 12./)
-!Initial, standard deviation from Vignati et al., 2001
-!REAL, DIMENSION(3) :: XINISIG_SLT = (/1.9, 2., 3./)
-!Initial dry number median radius (um) from Schultz et al., 2004
-REAL, DIMENSION(3) :: XINIRADIUS_SLT= 0.5*(/0.28, 2.25, 15.32/)
-!Initial, standard deviation from Schultz et al., 2004
-REAL, DIMENSION(3) :: XINISIG_SLT = (/1.9, 2., 2./)
-!Minimum allowed number concentration for any mode (#/m3)
-REAL, DIMENSION(3) :: XN0MIN_SLT = (/1.e1 , 1. , 1.e-4 /)
+
+!
+! -- PIERRE / MARINE SSA DUST - MODIF --
!
END MODULE MODD_SALT
diff --git a/src/MNH/modd_spawn.f90 b/src/MNH/modd_spawn.f90
index 41f83c8a1d5ede0151a11e0ca4c1329dd1a40150..8d432e588f5fbce395ee2385fb50883f8eb5f41e 100644
--- a/src/MNH/modd_spawn.f90
+++ b/src/MNH/modd_spawn.f90
@@ -33,6 +33,7 @@
!! Original 12/07/99
!! Modification 08/04/04 (G.Jaubert) Spawning 1 option
!! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -79,12 +80,14 @@ REAL,DIMENSION(:,:,:,:),SAVE,POINTER :: XRT1 => NULL()
REAL,DIMENSION(:,:,:),SAVE,POINTER :: XUT1 => NULL()
REAL,DIMENSION(:,:,:),SAVE,POINTER :: XVT1 => NULL()
REAL,DIMENSION(:,:,:),SAVE,POINTER :: XWT1 => NULL()
+REAL,DIMENSION(:,:), SAVE,POINTER :: XZWS1 => NULL()
REAL,DIMENSION(:,:,:),SAVE,POINTER :: XSRCT1 => NULL()
REAL,DIMENSION(:,:,:),SAVE,POINTER :: XSIGS1 => NULL()
TYPE(DATE_TIME), SAVE,POINTER :: TDTCUR1 => NULL()
REAL,DIMENSION(:,:,:),SAVE,POINTER :: XLSUM1 => NULL()
REAL,DIMENSION(:,:,:),SAVE,POINTER :: XLSVM1 => NULL()
REAL,DIMENSION(:,:,:),SAVE,POINTER :: XLSWM1 => NULL()
+REAL,DIMENSION(:,:) ,SAVE,POINTER :: XLSZWSM1=> NULL()
REAL,DIMENSION(:,:,:),SAVE,POINTER :: XLSTHM1 => NULL()
REAL,DIMENSION(:,:,:),SAVE,POINTER :: XLSRVM1 => NULL()
!
diff --git a/src/MNH/modd_sub_modeln.f90 b/src/MNH/modd_sub_modeln.f90
index 50cd6ec7b1c58144a357c9c1d343ef56eff62093..b6e364b2222e189bce38a1b8f00314c1b815b2bc 100644
--- a/src/MNH/modd_sub_modeln.f90
+++ b/src/MNH/modd_sub_modeln.f90
@@ -1,48 +1,51 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
-! J. Escobar : 18/06/2018 , bug compile R*4 => real*8 pointer XT_VISC
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! J. Escobar 18/06/2018: bug compile R*4 => real*8 pointer XT_VISC
+! P. Wautelet 08/02/2019: add missing NULL association for pointers
+! P. Wautelet 28/03/2019: use MNHTIME for time measurement variables
!-----------------------------------------------------------------
! #################
MODULE MODD_SUB_MODEL_n
! #################
!
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll, HALO2LIST_ll
-!
-USE MODD_PARAMETERS, ONLY: JPMODELMAX
+USE MODD_ARGSLIST_ll, ONLY: LIST_ll, HALO2LIST_ll
+USE MODD_PARAMETERS, ONLY: JPMODELMAX
+use modd_precision, only: MNHTIME
+
IMPLICIT NONE
TYPE SUB_MODEL_t
- TYPE(LIST_ll), POINTER :: TZFIELDS_ll,TZLSFIELD_ll,TZFIELDM_ll
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll => NULL(), TZLSFIELD_ll => NULL(), TZFIELDM_ll => NULL()
! list of fields to update halo
- TYPE(HALO2LIST_ll), POINTER :: TZHALO2M_ll, TZLSHALO2_ll
+ TYPE(HALO2LIST_ll), POINTER :: TZHALO2M_ll => NULL(), TZLSHALO2_ll => NULL()
! list of fields for the halo updates (2nd layer)
! halo lists and updates for 4th order schemes
! list of fields to update halo at time t
- TYPE(LIST_ll), POINTER :: TZFIELDT_ll ! for meteorological scalars
- TYPE(LIST_ll), POINTER :: TZFIELDMT_ll ! for momentum
- TYPE(LIST_ll), POINTER :: TZFIELDSC_ll ! for tracer scalars
+ TYPE(LIST_ll), POINTER :: TZFIELDT_ll => NULL() ! for meteorological scalars
+ TYPE(LIST_ll), POINTER :: TZFIELDMT_ll => NULL() ! for momentum
+ TYPE(LIST_ll), POINTER :: TZFIELDSC_ll => NULL() ! for tracer scalars
! list of fields for the halo updates (2nd layer) at time t
- TYPE(HALO2LIST_ll), POINTER :: TZHALO2T_ll
- TYPE(HALO2LIST_ll), POINTER :: TZHALO2MT_ll
- TYPE(HALO2LIST_ll), POINTER :: TZHALO2SC_ll
+ TYPE(HALO2LIST_ll), POINTER :: TZHALO2T_ll => NULL()
+ TYPE(HALO2LIST_ll), POINTER :: TZHALO2MT_ll => NULL()
+ TYPE(HALO2LIST_ll), POINTER :: TZHALO2SC_ll => NULL()
INTEGER :: IBAK, IOUT ! number of the backup / output
- REAL*8,DIMENSION(2) :: XT_START
- REAL*8,DIMENSION(2) :: XT_STORE,XT_BOUND,XT_GUESS
- REAL*8,DIMENSION(2) :: XT_ADV,XT_SOURCES,XT_DRAG
- REAL*8,DIMENSION(2) :: XT_ADVUVW,XT_GRAV,XT_VISC
- REAL*8,DIMENSION(2) :: XT_DIFF,XT_RELAX,XT_PARAM,XT_SPECTRA
- REAL*8,DIMENSION(2) :: XT_HALO,XT_RAD_BOUND,XT_PRESS
- REAL*8,DIMENSION(2) :: XT_CLOUD,XT_STEP_SWA,XT_STEP_MISC
- REAL*8,DIMENSION(2) :: XT_ELEC
- REAL*8,DIMENSION(2) :: XT_COUPL,XT_1WAY,XT_STEP_BUD
- REAL*8,DIMENSION(2) :: XT_RAD,XT_DCONV,XT_GROUND,XT_TRACER,XT_MAFL
- REAL*8,DIMENSION(2) :: XT_TURB,XT_2WAY,XT_SHADOWS
- REAL*8,DIMENSION(2) :: XT_FORCING,XT_NUDGING,XT_CHEM
+ 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_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_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
+ REAL(kind=MNHTIME), DIMENSION(2) :: XT_FORCING, XT_NUDGING, XT_CHEM
REAL, DIMENSION(:,:,:), POINTER :: ZWT_ACT_NUC=>NULL()
! Vertical motion used for ACTivation/NUCleation
@@ -59,19 +62,19 @@ TYPE(HALO2LIST_ll), POINTER :: TZHALO2M_ll=>NULL(), TZLSHALO2_ll=>NULL()
TYPE(HALO2LIST_ll), POINTER :: TZHALO2T_ll=>NULL(), TZHALO2MT_ll=>NULL(), TZHALO2SC_ll=>NULL()
INTEGER, POINTER :: IBAK=>NULL()
INTEGER, POINTER :: IOUT=>NULL()
-REAL*8,DIMENSION(:), POINTER :: XT_START=>NULL()
-REAL*8,DIMENSION(:), POINTER :: XT_STORE=>NULL(),XT_BOUND=>NULL(),XT_GUESS=>NULL()
-REAL*8,DIMENSION(:), POINTER :: XT_ADV=>NULL(),XT_SOURCES=>NULL(),XT_DRAG=>NULL()
-REAL*8,DIMENSION(:), POINTER :: XT_ADVUVW=>NULL(),XT_GRAV=>NULL()
-REAL*8,DIMENSION(:), POINTER :: XT_DIFF=>NULL(),XT_RELAX=>NULL(),XT_PARAM=>NULL(),XT_SPECTRA=>NULL()
-REAL*8,DIMENSION(:), POINTER :: XT_HALO=>NULL(),XT_RAD_BOUND=>NULL(),XT_PRESS=>NULL()
-REAL*8,DIMENSION(:), POINTER :: XT_VISC=>NULL()
-REAL*8,DIMENSION(:), POINTER :: XT_CLOUD=>NULL(),XT_STEP_SWA=>NULL(),XT_STEP_MISC=>NULL()
-REAL*8,DIMENSION(:), POINTER :: XT_ELEC=>NULL(),XT_SHADOWS=>NULL()
-REAL*8,DIMENSION(:), POINTER :: XT_COUPL=>NULL(),XT_1WAY=>NULL(),XT_STEP_BUD=>NULL()
-REAL*8,DIMENSION(:), POINTER :: XT_RAD=>NULL(),XT_DCONV=>NULL(),XT_GROUND=>NULL(),XT_MAFL=>NULL()
-REAL*8,DIMENSION(:), POINTER :: XT_TURB=>NULL(),XT_2WAY=>NULL(),XT_TRACER=>NULL()
-REAL*8,DIMENSION(:), POINTER :: XT_FORCING=>NULL(),XT_NUDGING=>NULL(),XT_CHEM=>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_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_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 :: ZWT_ACT_NUC=>NULL()
LOGICAL, DIMENSION(:,:), POINTER :: GMASKkids=>NULL()
LOGICAL, POINTER :: GCLOSE_OUT=>NULL()
diff --git a/src/MNH/modd_timez.f90 b/src/MNH/modd_timez.f90
index bf8bcbd11bd9acbed926181f9113595557bb62bc..3c44998639d52ba7647196195ecb8080f404c027 100644
--- a/src/MNH/modd_timez.f90
+++ b/src/MNH/modd_timez.f90
@@ -1,57 +1,63 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! Modifications
+! P. Wautelet 08/02/2019: add missing NULL association for pointers
+! P. Wautelet 28/03/2019: use MNHTIME for time measurement variables
+!-----------------------------------------------------------------
MODULE MODD_TIMEZ
USE MODD_PARAMETERS, ONLY: JPMODELMAX
+ use modd_precision, only: MNHTIME
TYPE SUB_TIMEZ_T
- REAL*8,DIMENSION(2) :: T_MAP_B_SX_YP2_ZP1 = 0.0
- REAL*8,DIMENSION(2) :: T_MAP_SX_YP2_ZP1_SXP2_Y_ZP1 = 0.0
- REAL*8,DIMENSION(2) :: T_MAP_SXP2_Y_ZP1_B = 0.0
- REAL*8,DIMENSION(2) :: T_MAP_B_SXP2_Y_ZP1 = 0.0
- REAL*8,DIMENSION(2) :: T_MAP_SXP2_Y_ZP1_SX_YP2_ZP1 = 0.0
- REAL*8,DIMENSION(2) :: T_MAP_SX_YP2_ZP1_B = 0.0
- REAL*8,DIMENSION(2) :: T_MAP_SXP2_Y_ZP1_SXP2_YP1_Z = 0.0
- REAL*8,DIMENSION(2) :: T_MAP_SXP2_YP1_Z_SXP2_Y_ZP1 = 0.0
-
- REAL*8,DIMENSION(2) :: T_MAP_SXP1_YP2_Z_SX_YP2_ZP1 = 0.0
- REAL*8,DIMENSION(2) :: T_MAP_SXP2_Y_ZP1_SXP1_YP2_Z = 0.0
- REAL*8,DIMENSION(2) :: T_MAP_SXP1_YP2_Z_SXP2_Y_ZP1 = 0.0
- REAL*8,DIMENSION(2) :: T_MAP_SX_YP2_ZP1_SXP1_YP2_Z = 0.0
-
- REAL*8,DIMENSION(2) :: T_WRIT3D_RECV = 0.0
- REAL*8,DIMENSION(2) :: T_WRIT3D_SEND = 0.0
- REAL*8,DIMENSION(2) :: T_WRIT3D_WRIT = 0.0
- REAL*8,DIMENSION(2) :: T_WRIT3D_WAIT = 0.0
- REAL*8,DIMENSION(2) :: T_WRIT3D_ALL = 0.0
-
- REAL*8,DIMENSION(2) :: T_WRIT2D_GATH = 0.0
- REAL*8,DIMENSION(2) :: T_WRIT2D_WRIT = 0.0
- REAL*8,DIMENSION(2) :: T_WRIT2D_ALL = 0.0
-
- REAL*8,DIMENSION(2) :: T_READ3D_RECV = 0.0
- REAL*8,DIMENSION(2) :: T_READ3D_SEND = 0.0
- REAL*8,DIMENSION(2) :: T_READ3D_READ = 0.0
- REAL*8,DIMENSION(2) :: T_READ3D_WAIT = 0.0
- REAL*8,DIMENSION(2) :: T_READ3D_ALL = 0.0
-
- REAL*8,DIMENSION(2) :: T_READ2D_SCAT = 0.0
- REAL*8,DIMENSION(2) :: T_READ2D_READ = 0.0
- REAL*8,DIMENSION(2) :: T_READ2D_ALL = 0.0
-
- REAL*8,DIMENSION(2) :: T_READLB_RECV = 0.0
- REAL*8,DIMENSION(2) :: T_READLB_SEND = 0.0
- REAL*8,DIMENSION(2) :: T_READLB_READ = 0.0
- REAL*8,DIMENSION(2) :: T_READLB_WAIT = 0.0
- REAL*8,DIMENSION(2) :: T_READLB_ALL = 0.0
-
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_MAP_B_SX_YP2_ZP1 = 0.0_MNHTIME
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_MAP_SX_YP2_ZP1_SXP2_Y_ZP1 = 0.0_MNHTIME
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_MAP_SXP2_Y_ZP1_B = 0.0_MNHTIME
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_MAP_B_SXP2_Y_ZP1 = 0.0_MNHTIME
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_MAP_SXP2_Y_ZP1_SX_YP2_ZP1 = 0.0_MNHTIME
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_MAP_SX_YP2_ZP1_B = 0.0_MNHTIME
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_MAP_SXP2_Y_ZP1_SXP2_YP1_Z = 0.0_MNHTIME
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_MAP_SXP2_YP1_Z_SXP2_Y_ZP1 = 0.0_MNHTIME
+
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_MAP_SXP1_YP2_Z_SX_YP2_ZP1 = 0.0_MNHTIME
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_MAP_SXP2_Y_ZP1_SXP1_YP2_Z = 0.0_MNHTIME
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_MAP_SXP1_YP2_Z_SXP2_Y_ZP1 = 0.0_MNHTIME
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_MAP_SX_YP2_ZP1_SXP1_YP2_Z = 0.0_MNHTIME
+
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_WRIT3D_RECV = 0.0_MNHTIME
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_WRIT3D_SEND = 0.0_MNHTIME
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_WRIT3D_WRIT = 0.0_MNHTIME
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_WRIT3D_WAIT = 0.0_MNHTIME
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_WRIT3D_ALL = 0.0_MNHTIME
+
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_WRIT2D_GATH = 0.0_MNHTIME
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_WRIT2D_WRIT = 0.0_MNHTIME
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_WRIT2D_ALL = 0.0_MNHTIME
+
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_READ3D_RECV = 0.0_MNHTIME
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_READ3D_SEND = 0.0_MNHTIME
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_READ3D_READ = 0.0_MNHTIME
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_READ3D_WAIT = 0.0_MNHTIME
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_READ3D_ALL = 0.0_MNHTIME
+
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_READ2D_SCAT = 0.0_MNHTIME
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_READ2D_READ = 0.0_MNHTIME
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_READ2D_ALL = 0.0_MNHTIME
+
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_READLB_RECV = 0.0_MNHTIME
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_READLB_SEND = 0.0_MNHTIME
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_READLB_READ = 0.0_MNHTIME
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_READLB_WAIT = 0.0_MNHTIME
+ REAL(kind=MNHTIME), DIMENSION(2) :: T_READLB_ALL = 0.0_MNHTIME
+
END TYPE SUB_TIMEZ_T
TYPE(SUB_TIMEZ_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: SUB_TIMEZN
-TYPE(SUB_TIMEZ_t), POINTER :: TIMEZ
+TYPE(SUB_TIMEZ_t), POINTER :: TIMEZ => NULL()
CONTAINS
diff --git a/src/MNH/mode_RBK90_Integrator.f90 b/src/MNH/mode_RBK90_Integrator.f90
index f1e50b243763abbc3ca480862584fc761c81ee29..ae11720e3cd8fdc1ce7ab60d602dd20a5e4ce0d5 100644
--- a/src/MNH/mode_RBK90_Integrator.f90
+++ b/src/MNH/mode_RBK90_Integrator.f90
@@ -61,6 +61,7 @@ MODULE MODE_RBK90_Integrator
USE MODD_RBK90_JacobianSP_n, ONLY: LU_DIM_SPECIES
USE MODD_RBK90_Parameters_n, ONLY: NVAR
USE MODD_RBK90_Global_n, ONLY: STEPMIN
+ use modd_precision, only: MNHREAL
IMPLICIT NONE
PUBLIC
SAVE
@@ -737,11 +738,7 @@ Stage: DO istage = 1, ros_S
END DO
Err = SQRT(Err/N)
-#if (MNH_REAL == 8)
- ros_ErrorNorm = MAX(Err,1.0e-10)
-#else
- ros_ErrorNorm = MAX(Err,1.0d-10)
-#endif
+ ros_ErrorNorm = MAX(Err,1.0e-10_MNHREAL)
END FUNCTION ros_ErrorNorm
diff --git a/src/MNH/mode_RBK90_linearalgebra.f90 b/src/MNH/mode_RBK90_linearalgebra.f90
index ac5dc5fa499a92341e9b5cc42b1a92852f9d1eb7..8fd23aa139e89b8c906915ccda98c36e80e102e0 100644
--- a/src/MNH/mode_RBK90_linearalgebra.f90
+++ b/src/MNH/mode_RBK90_linearalgebra.f90
@@ -1,10 +1,11 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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:
+! P. Wautelet 22/02/2019: DOUBLE COMPLEX -> COMPLEX(kind(0.0d0)) to respect Fortran standard
+!-----------------------------------------------------------------
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
! Linear Algebra Data and Routines File
@@ -97,7 +98,7 @@ SUBROUTINE KppDecompCmplx( JVS, IER )
USE MODD_RBK90_JacobianSP_n
INTEGER :: IER
- DOUBLE COMPLEX :: JVS(LU_NONZERO), W(NVAR), a
+ COMPLEX (KIND(0.0D0)) :: JVS(LU_NONZERO), W(NVAR), a
REAL :: b = 0.0
INTEGER :: k, kk, j, jj
@@ -243,7 +244,7 @@ SUBROUTINE KppSolveCmplx( JVS, X )
USE MODD_RBK90_JacobianSP_n
INTEGER :: i, j
- DOUBLE COMPLEX :: JVS(LU_NONZERO), X(NVAR), sum
+ COMPLEX (KIND(0.0D0)) :: JVS(LU_NONZERO), X(NVAR), sum
DO i=1,NVAR
DO j = LU_CROW(i), LU_DIAG(i)-1
@@ -305,7 +306,7 @@ SUBROUTINE KppSolveTRCmplx( JVS, X )
USE MODD_RBK90_JacobianSP_n
INTEGER :: i, j
- DOUBLE COMPLEX :: JVS(LU_NONZERO), X(NVAR)
+ COMPLEX (KIND(0.0D0)) :: JVS(LU_NONZERO), X(NVAR)
DO i=1,NVAR
X(i) = X(i)/JVS(LU_DIAG(i))
diff --git a/src/MNH/mode_datetime.f90 b/src/MNH/mode_datetime.f90
index a09557b7873d37e4cccc9963726b9041bde6b123..2684e11d48a4426dea6321524ba93edc6ebe080a 100644
--- a/src/MNH/mode_datetime.f90
+++ b/src/MNH/mode_datetime.f90
@@ -1,8 +1,11 @@
-!MNH_LIC Copyright 2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2018-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 22/02/2019: use MOD intrinsics with same kind for all arguments (to respect Fortran standard)
+!-----------------------------------------------------------------
MODULE MODE_DATETIME
!
USE MODD_TYPE_DATE
@@ -57,7 +60,7 @@ IDAY_CUR = TZDATE%TDATE%DAY
ZSEC = TZDATE%TIME
!
!Compute number of days since beginning of the year
-IF ( ((MOD(IYEAR_CUR,4)==0).AND.(MOD(IYEAR_CUR,100)/=0)) .OR. (MOD(IYEAR_CUR,400)==0)) ILEAPS=1
+IF ( ((MOD(IYEAR_CUR,4_8)==0).AND.(MOD(IYEAR_CUR,100_8)/=0)) .OR. (MOD(IYEAR_CUR,400_8)==0)) ILEAPS=1
SELECT CASE(IMONTH_CUR)
CASE(1)
IDAYS = IDAY_CUR-1
diff --git a/src/MNH/mode_elec_ll.f90 b/src/MNH/mode_elec_ll.f90
index dc4f100ef866a173dba2e57f4fbd8596b477c9aa..0f613fff81e6cdac7597973e73827849d8cf4fd6 100644
--- a/src/MNH/mode_elec_ll.f90
+++ b/src/MNH/mode_elec_ll.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2010-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 MODE_ELEC_ll
! ###################
@@ -24,7 +25,8 @@
!------------------------------------------------------------------------
!
USE MODD_MPIF
-USE MODD_VAR_ll, ONLY : NMNH_COMM_WORLD
+use modd_precision, only: MNHREAL_MPI
+USE MODD_VAR_ll, ONLY: NMNH_COMM_WORLD
!
IMPLICIT NONE
!
@@ -32,7 +34,6 @@ IMPLICIT NONE
!
!
INTEGER, PARAMETER :: IFIRST_PROC = 0 ! 0/1 to increase numerotation of proc number
-INTEGER, PARAMETER :: MPI_PRECISION = MPI_DOUBLE_PRECISION
!
!
INTERFACE SUM_ELEC_ll
@@ -115,7 +116,7 @@ ZTAB = PSUM_INOUT
INFO = -1
!
! Sum(Proc)
-CALL MPI_ALLREDUCE(ZTAB, PSUM_INOUT, IDIM, MPI_PRECISION, &
+CALL MPI_ALLREDUCE(ZTAB, PSUM_INOUT, IDIM, MNHREAL_MPI, &
MPI_SUM, NMNH_COMM_WORLD, INFO)
!
END SUBROUTINE RSUM_ELEC_ll
@@ -152,7 +153,7 @@ INFO = -1
!
!* 1.1 max(Proc)
!
-CALL MPI_ALLREDUCE(ZTAB, PMIN_INOUT, IDIM, MPI_PRECISION, &
+CALL MPI_ALLREDUCE(ZTAB, PMIN_INOUT, IDIM, MNHREAL_MPI, &
MPI_MIN, NMNH_COMM_WORLD, INFO)
!
!* 1.2 find the proc number of the maximum
@@ -202,7 +203,7 @@ INFO = -1
!
!* 1.1 max(Proc)
!
-CALL MPI_ALLREDUCE(ZTAB, PMAX_INOUT, IDIM, MPI_PRECISION, &
+CALL MPI_ALLREDUCE(ZTAB, PMAX_INOUT, IDIM, MNHREAL_MPI, &
MPI_MAX, NMNH_COMM_WORLD, INFO)
!
!* 1.2 find the proc number of the maximum
@@ -420,7 +421,7 @@ INFO = -1
!
!* 1.1 sum(Proc)
!
-CALL MPI_ALLREDUCE(ZTAB, PSUM_INOUT, IDIM, MPI_PRECISION, &
+CALL MPI_ALLREDUCE(ZTAB, PSUM_INOUT, IDIM, MNHREAL_MPI, &
MPI_SUM, NMNH_COMM_WORLD, INFO)
!
END SUBROUTINE RSUM0_ELEC_ll
diff --git a/src/MNH/mode_extrapol.f90 b/src/MNH/mode_extrapol.f90
index ef3850afee0eefa2603320a427d564e073c9ee3e..fcf03634fda4615c98d6a6e9f84ac8091700683d 100644
--- a/src/MNH/mode_extrapol.f90
+++ b/src/MNH/mode_extrapol.f90
@@ -1,15 +1,29 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+!-----------------------------------------------------------------
MODULE MODE_EXTRAPOL
+ use mode_msg
+
+ implicit none
+
+ private
+
+ public :: EXTRAPOL, EXTRAPOL_ON_PSEUDO_HALO
+
+ character(len=10) :: ydim1, ydim2 !Strings to store dimensions to print error message
+
INTERFACE EXTRAPOL
MODULE PROCEDURE EXTRAPOL3D,EXTRAPOL3DN,EXTRAPOL2D,EXTRAPOL2DN
END INTERFACE
-
+
INTERFACE EXTRAPOL_ON_PSEUDO_HALO
MODULE PROCEDURE EXTRAPOL_ON_PSEUDO_HALO3D,EXTRAPOL_ON_PSEUDO_HALO2D
@@ -178,6 +192,7 @@ CONTAINS
TYPE(LIST_ll), POINTER :: TZZSFIELD_ll ! list of fields to exchange
LOGICAL :: GCYCLIC_EXTRAPOL
!
+ !
!-------------------------------------------------------------------------------
!
!* 1. EXTRAPOLATE LATERAL BOUNDARY CONDITIONS :
@@ -222,10 +237,8 @@ CONTAINS
PTAB(IDIMX_C,:,:) = 2. * PTAB(IDIMX_C-1,:,:) - PTAB(IDIMX_C-2,:,:)
ENDIF
ELSEIF ( IDIMX_C == IIE - IIB + 2 + 2*JPHEXT ) THEN !the child domain has the size of the father domain minus one
- WRITE(*,*) "ERROR in EXTRAPOL_ON_PSEUDO_HALO3D, case not supported : &
- & the child grid has to be one point larger or one point smaller in X dim"
- CALL ABORT
- STOP 'ERROR in EXTRAPOL_ON_PSEUDO_HALO3D'
+ call Print_msg(NVERB_FATAL,'GEN','EXTRAPOL_ON_PSEUDO_HALO3D','case not supported:'// &
+ 'the child grid has to be one point larger or one point smaller in X dim')
! IF ( IIB>1 .AND. LWEST_ll() .AND. CLBCX(1)/='CYCL' ) THEN !du cote ouest, on a un point dans le 'pseudo halo' a extrapoler
! PTAB(1,:,:) = 2. * PTAB(2,:,:) - PTAB(3,:,:)
! ELSEIF ( IIB>1 .AND. LWEST_ll() .AND. CLBCX(1)=='CYCL' ) THEN
@@ -237,10 +250,10 @@ CONTAINS
! PTAB(IDIMX_C,:,:) = PTAB(2,:,:)
! ENDIF
ELSE !Error, this should not happen
- WRITE(*,*) "ERROR in EXTRAPOL_ON_PSEUDO_HALO3D, IDIMX_C = ", &
- IDIMX_C, ", IIE - IIB + 1 + 2*JPHEXT = ", IIE - IIB + 1 + 2*JPHEXT
- CALL ABORT
- STOP 'ERROR in EXTRAPOL_ON_PSEUDO_HALO3D'
+ write( ydim1, '( I10 )' ) IDIMX_C
+ write( ydim2, '( I10 )' ) IIE - IIB + 1 + 2*JPHEXT
+ call Print_msg( NVERB_FATAL, 'GEN','EXTRAPOL_ON_PSEUDO_HALO3D', 'wrong dimensions: IDIMX_C='//trim(ydim1)// &
+ ', IIE - IIB + 1 + 2*JPHEXT='//trim(ydim2) )
ENDIF
ENDIF
IF ( IDIMY_C > IJE - IJB + 1 + 2*JPHEXT ) THEN
@@ -252,10 +265,8 @@ CONTAINS
PTAB(:,IDIMY_C,:) = 2. * PTAB(:,IDIMY_C-1,:) - PTAB(:,IDIMY_C-2,:)
ENDIF
ELSEIF ( IDIMY_C == IJE - IJB + 2 + 2*JPHEXT ) THEN !the child domain has the size of the father domain minus one
- WRITE(*,*) "ERROR in EXTRAPOL_ON_PSEUDO_HALO3D, case not supported : &
- & the child grid has to be one point larger or one point smaller in Y dim"
- CALL ABORT
- STOP 'ERROR in EXTRAPOL_ON_PSEUDO_HALO3D'
+ call Print_msg(NVERB_FATAL,'GEN','EXTRAPOL_ON_PSEUDO_HALO3D','case not supported:'// &
+ 'the child grid has to be one point larger or one point smaller in Y dim')
! IF ( IJB>1 .AND. LNORTH_ll() .AND. CLBCY(1)/='CYCL' ) THEN !du cote ouest, on a un point dans le 'pseudo halo' a extrapoler
! PTAB(:,1,:) = 2. * PTAB(:,2,:) - PTAB(:,3,:)
! ELSEIF ( IJB>1 .AND. LNORTH_ll() .AND. CLBCY(1)=='CYCL' ) THEN
@@ -267,10 +278,10 @@ CONTAINS
! PTAB(:,IDIMY_C,:) = PTAB(:,2,:)
! ENDIF
ELSE !Error, this should not happen
- WRITE(*,*) "ERROR in EXTRAPOL_ON_PSEUDO_HALO3D, IDIMY_C = ", &
- IDIMY_C, ", IIE - IIB + 1 + 2*JPHEXT = ", IIE - IIB + 1 + 2*JPHEXT
- CALL ABORT
- STOP 'ERROR in EXTRAPOL_ON_PSEUDO_HALO3D'
+ write( ydim1, '( I10 )' ) IDIMX_C
+ write( ydim2, '( I10 )' ) IJE - IJB + 1 + 2*JPHEXT
+ call Print_msg( NVERB_FATAL, 'GEN','EXTRAPOL_ON_PSEUDO_HALO3D', 'wrong dimensions: IDIMY_C='//trim(ydim1)// &
+ ', IJE - IJB + 1 + 2*JPHEXT='//trim(ydim2) )
ENDIF
ENDIF
!
@@ -361,10 +372,8 @@ CONTAINS
PTAB(IDIMX_C,:) = 2. * PTAB(IDIMX_C-1,:) - PTAB(IDIMX_C-2,:)
ENDIF
ELSEIF ( IDIMX_C == IIE - IIB + 2 + 2*JPHEXT ) THEN !the child domain has the size of the father domain minus one
- WRITE(*,*) "ERROR in EXTRAPOL_ON_PSEUDO_HALO2D, case not supported : &
- & the child grid has to be one point larger or one point smaller in X dim"
- CALL ABORT
- STOP 'ERROR in EXTRAPOL_ON_PSEUDO_HALO2D'
+ call Print_msg(NVERB_FATAL,'GEN','EXTRAPOL_ON_PSEUDO_HALO2D','case not supported:'// &
+ 'the child grid has to be one point larger or one point smaller in X dim')
! IF ( IIB>1 .AND. LWEST_ll() .AND. CLBCX(1)/='CYCL' ) THEN !du cote ouest, on a un point dans le 'pseudo halo' a extrapoler
! PTAB(1,:) = 2. * PTAB(2,:) - PTAB(3,:)
! ELSEIF ( IIB>1 .AND. LWEST_ll() .AND. CLBCX(1)=='CYCL' ) THEN
@@ -376,10 +385,10 @@ CONTAINS
! PTAB(IDIMX_C,:) = PTAB(2,:)
! ENDIF
ELSE !Error, this should not happen
- WRITE(*,*) "ERROR in EXTRAPOL_ON_PSEUDO_HALO2D, IDIMX_C = ", IDIMX_C, &
- ", IIE - IIB + 1 + 2*JPHEXT = ", IIE - IIB + 1 + 2*JPHEXT
- CALL ABORT
- STOP 'ERROR in EXTRAPOL_ON_PSEUDO_HALO2D'
+ write( ydim1, '( I10 )' ) IDIMX_C
+ write( ydim2, '( I10 )' ) IIE - IIB + 1 + 2*JPHEXT
+ call Print_msg( NVERB_FATAL, 'GEN','EXTRAPOL_ON_PSEUDO_HALO2D', 'wrong dimensions: IDIMX_C='//trim(ydim1)// &
+ ', IIE - IIB + 1 + 2*JPHEXT='//trim(ydim2) )
ENDIF
ENDIF
IF ( IDIMY_C > IJE - IJB + 1 + 2*JPHEXT ) THEN
@@ -395,10 +404,8 @@ CONTAINS
! PTAB(:,IDIMY_C) = PTAB(:,2)
ENDIF
ELSEIF ( IDIMY_C == IJE - IJB + 2 + 2*JPHEXT ) THEN !the child domain has the size of the father domain minus one
- WRITE(*,*) "ERROR in EXTRAPOL_ON_PSEUDO_HALO2D, case not supported : &
- & the child grid has to be one point larger or one point smaller in Y dim"
- CALL ABORT
- STOP 'ERROR in EXTRAPOL_ON_PSEUDO_HALO2D'
+ call Print_msg(NVERB_FATAL,'GEN','EXTRAPOL_ON_PSEUDO_HALO3D','case not supported:'// &
+ 'the child grid has to be one point larger or one point smaller in Y dim')
! IF ( IJB>1 .AND. LNORTH_ll() .AND. CLBCY(1)/='CYCL' ) THEN !du cote ouest, on a un point dans le 'pseudo halo' a extrapoler
! PTAB(:,1) = 2. * PTAB(:,2) - PTAB(:,3)
! ELSEIF ( IJB>1 .AND. LNORTH_ll() .AND. CLBCY(1)=='CYCL' ) THEN
@@ -410,10 +417,10 @@ CONTAINS
! PTAB(:,IDIMY_C) = PTAB(:,2)
! ENDIF
ELSE !Error, this should not happen
- WRITE(*,*) "ERROR in EXTRAPOL_ON_PSEUDO_HALO2D, IDIMY_C = ", IDIMY_C, &
- ", IIE - IIB + 1 + 2*JPHEXT = ", IIE - IIB + 1 + 2*JPHEXT
- CALL ABORT
- STOP 'ERROR in EXTRAPOL_ON_PSEUDO_HALO2D'
+ write( ydim1, '( I10 )' ) IDIMX_C
+ write( ydim2, '( I10 )' ) IJE - IJB + 1 + 2*JPHEXT
+ call Print_msg( NVERB_FATAL, 'GEN','EXTRAPOL_ON_PSEUDO_HALO3D', 'wrong dimensions: IDIMY_C='//trim(ydim1)// &
+ ', IJE - IJB + 1 + 2*JPHEXT='//trim(ydim2) )
ENDIF
ENDIF
!
diff --git a/src/MNH/mode_fgau.f90 b/src/MNH/mode_fgau.f90
index 46614beca5fae8edf8f813ac1f0fb20b278d0d86..aa46acabfd2b67c55aa266ce51030996885b6466 100644
--- a/src/MNH/mode_fgau.f90
+++ b/src/MNH/mode_fgau.f90
@@ -1,12 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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$
-!-----------------------------------------------------------------
! ######spl
MODULE MODE_FGAU
! ####################
@@ -36,7 +32,8 @@
!!
!! MODIFICATIONS
!! -------------
-!! Original 26/03/2004
+!! Original 26/03/2004
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!--------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -153,6 +150,8 @@ CONTAINS
SUBROUTINE GAUHER(N,X2,W)
! #########################
! returns POSITIVE nodes and weights of Gauss-Hermite quadrature.
+ use mode_msg
+
IMPLICIT NONE
! N : ordre du polynôme de Hermite
! X2 : abscisses POSITIVES de la quadrature
@@ -163,19 +162,17 @@ CONTAINS
REAL :: PX,DPX,X,Y
INTEGER,DIMENSION(N+1) :: P0,P1,P2
REAL,DIMENSION((N+1)/2) :: X1
-
+
INTEGER :: I,J,K
-
- IF(N>=15) THEN
- PRINT*,'SUBROUTINE GAUHER FAILS TO CONVERGE FOR N>=15. ANYWAY, THIS NUMBER IS TOO HIGH.'
- PRINT*,'PLEASE TAKE A SMALLER NUMBER OF POINTS OR MODIFY THIS SUBROUTINE.'
- STOP
- END IF
+
+ if ( n >=15 ) call Print_msg( NVERB_FATAL, 'GEN', 'GAUHER', 'subroutine gauher fails to converge for n>=15.'// &
+ 'Anyway, this number is too high.'// &
+ 'Please take a smaller number of points or modify this subroutine.' )
P0(:)=0
P1(:)=0
P2(:)=0
-
+
P0(1)=1 ! N=0 H0(x)=1
P1(1)=0 ! N=1 H1(x)=2x
P1(2)=2
diff --git a/src/MNH/mode_gridproj.f90 b/src/MNH/mode_gridproj.f90
index f6de1038da89c5167b867646e6b6c7dd91ed0807..8fec230fa1da45eebb5d101a3957f371f60f2ec3 100644
--- a/src/MNH/mode_gridproj.f90
+++ b/src/MNH/mode_gridproj.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ####################
@@ -37,19 +37,29 @@
!! Original 24/05/94
!! 05/02/15 M.Moge (LA-CNRS)
!! 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
!!
!!
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
-USE MODE_MPPDB
-USE MODD_CONF
-!------------
+!
!------------------------------------------------------------------------------
+USE MODD_CONF
+!
+USE MODE_MPPDB
+use mode_msg
+!
+implicit none
+!
+private
+!
+public :: SM_GRIDPROJ, SM_LATLON, SM_XYHAT
!
INTERFACE SM_LATLON
MODULE PROCEDURE SM_LATLON_A,SM_LATLON_S
END INTERFACE
+
INTERFACE SM_XYHAT
MODULE PROCEDURE SM_XYHAT_A,SM_XYHAT_S
END INTERFACE
@@ -174,14 +184,14 @@ CONTAINS
! ------------
!
!
-USE MODE_ll
USE MODD_ARGSLIST_ll, ONLY : LIST_ll, LIST1D_ll
+USE MODD_CONF
+USE MODD_CST
+USE MODD_GRID
USE MODD_LUNIT_n, ONLY : TLUOUT
+USE MODD_PARAMETERS
!
-USE MODD_CONF
-USE MODD_CST
-USE MODD_PARAMETERS
-USE MODD_GRID
+USE MODE_ll
!
USE MODI_VERT_COORD
!
@@ -390,11 +400,7 @@ ZCLAT0 = COS(ZRDSDG*ZLAT0)
ZSLAT0 = SIN(ZRDSDG*ZLAT0)
!
IF ((ABS(ZRPK-1.)>1.E-10).AND. (ANY(ABS(COS(ZRDSDG*ZLAT))<1.E-10))) THEN
- WRITE(ILUOUT,*) 'Error in SM_GRIDPROJ : '
- WRITE(ILUOUT,*) 'pole in the domain, but not with stereopolar projection'
-!callabortstop
-CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'SM_GRIDPROJ', 'pole in the domain, but not with stereopolar projection' )
ENDIF
!
IF (ABS(ZCLAT0)<1.E-10 .AND. (ABS(ZRPK-1.)<1.E-10)) THEN
@@ -1429,8 +1435,8 @@ END SUBROUTINE SM_XYHAT_A
!! Module MODD_CST : contains Physical constants
!! XPI : Pi;
!!
-!! Module MODD_LUNIT : contains logical unit names
-!! CLUOUT0 : Output listing file name
+!! Module MODD_LUNIT_n : contains logical unit names
+!! TLUOUT : Output listing file name
!!
!! REFERENCE
!! ---------
@@ -1542,9 +1548,7 @@ WRITE(ILUOUT,*) ' Function fails to converge after ',ITER,' iterations.'
WRITE(ILUOUT,*) ' LATREF2=',LATREF2,' Residual=',ZGLAT-1., &
' ZEPSI=',ZEPSI,' Last increment=',ZDLAT/ZRDSDG
WRITE(ILUOUT,*) ' JOB ABORTS...'
-!callabortstop
-CALL ABORT
-STOP
+call Print_msg( NVERB_FATAL, 'GEN', 'LATREF2', 'failed to converge' )
!-------------------------------------------------------------------------------
END FUNCTION LATREF2
!-------------------------------------------------------------------------------
diff --git a/src/MNH/mode_les_diachro.f90 b/src/MNH/mode_les_diachro.f90
index 462859ff092d5e12400b10a6f03c6a771ed81f51..3e07a46f665fb20d945376b4a07c3b6aeee3a35c 100644
--- a/src/MNH/mode_les_diachro.f90
+++ b/src/MNH/mode_les_diachro.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! Modifications
@@ -726,7 +726,7 @@ END SUBROUTINE LES_TIME_AVG
SUBROUTINE LES_DIACHRO(TPDIAFILE,HGROUP,HCOMMENT,HUNIT,PFIELD,HAVG)
!########################################################
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES
USE MODD_GRID
USE MODI_WRITE_DIACHRO
@@ -854,7 +854,7 @@ END SUBROUTINE LES_DIACHRO
SUBROUTINE LES_DIACHRO_SV(TPDIAFILE,HGROUP,HCOMMENT,HUNIT,PFIELD,HAVG)
!###########################################################
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES
USE MODD_GRID
USE MODI_WRITE_DIACHRO
@@ -980,7 +980,7 @@ END SUBROUTINE LES_DIACHRO_SV
SUBROUTINE LES_DIACHRO_MASKS(TPDIAFILE,HGROUP,HTITLE,HCOMMENT,HUNIT,PFIELD,HAVG)
!#####################################################################
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES
USE MODD_GRID
USE MODI_WRITE_DIACHRO
@@ -1111,7 +1111,7 @@ END SUBROUTINE LES_DIACHRO_MASKS
SUBROUTINE LES_DIACHRO_SV_MASKS(TPDIAFILE,HGROUP,HTITLE,HCOMMENT,HUNIT,PFIELD,HAVG)
!########################################################################
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES
USE MODD_GRID
USE MODI_WRITE_DIACHRO
@@ -1247,7 +1247,7 @@ END SUBROUTINE LES_DIACHRO_SV_MASKS
SUBROUTINE LES_DIACHRO_SURF(TPDIAFILE,HGROUP,HCOMMENT,HUNIT,PFIELD,HAVG)
!#############################################################
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES
USE MODD_GRID
USE MODI_WRITE_DIACHRO
@@ -1361,7 +1361,7 @@ END SUBROUTINE LES_DIACHRO_SURF
SUBROUTINE LES_DIACHRO_SURF_SV(TPDIAFILE,HGROUP,HCOMMENT,HUNIT,PFIELD,HAVG)
!################################################################
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES
USE MODD_GRID
USE MODI_WRITE_DIACHRO
@@ -1479,7 +1479,7 @@ 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_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES
USE MODD_GRID
USE MODD_CONF
@@ -1638,7 +1638,7 @@ SUBROUTINE LES_DIACHRO_SPEC(TPDIAFILE,HGROUP,HCOMMENT,HUNIT,PSPECTRAX,PSPECTRAY)
!* Modification 01/04/03 (V. Masson) safer use of ZWORK6 with loops
!
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES
USE MODD_GRID
USE MODD_CONF
diff --git a/src/MNH/mode_mnh_timing.f90 b/src/MNH/mode_mnh_timing.f90
index 35d7c559ad4193581e19a2e885659d9287214e37..23c09916f99873b55b4e47dba0c2a45538611ad8 100644
--- a/src/MNH/mode_mnh_timing.f90
+++ b/src/MNH/mode_mnh_timing.f90
@@ -2,42 +2,56 @@
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C 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 MODE_MNH_TIMING
!
-! Modification :
-! J.ESCOBAR 13/11/2008 : change (2) in (:) for bug in IBM-SP6 compiler
-! J.Escobar 1/09/2011 : reduce 'timing' format
-! J.Escobar 12/02/2013 : tribulle to slow on large BG partition , inhib it by a early return in the code
-! Philippe Wautelet: 10/01/2019: use NEWUNIT argument of OPEN
-!
+! Modifications:
+! J. escobar 13/11/2008: change (2) in (:) for bug in IBM-SP6 compiler
+! J. Escobar 01/09/2011: reduce 'timing' format
+! J. Escobar 12/02/2013: triabulle too slow on large BG partition, inhib it by a early return in the code
+! P. Wautelet 10/01/2019: use NEWUNIT argument of OPEN
+! P. Wautelet 22/03/2019: use MNHREAL64 and MNHREAL64_MPI + typo corrections
+! P. Wautelet 27/03/2019: use MNHTIME and MNHTIME_MPI instead of MNHREAL64 and MNHREAL64_MPI
+! P. Wautelet 28/03/2019: use TFILE instead of unit number for set_iluout_timing
+!------------------------------------------------------------------------
+
+implicit none
-INTEGER :: NLUOUT_TIMING
+private
+
+public :: SECOND_MNH2, SET_ILUOUT_TIMING, TIME_HEADER_ll, TIME_STAT_ll
+public :: TIMING_SEPARATOR, TIMING_LEGEND
+
+INTEGER :: NLUOUT_TIMING
CONTAINS
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+subroutine second_mnh2(xt)
-SUBROUTINE SECOND_MNH2(XT)
-!
USE modd_mpif
-!
-REAL*8,DIMENSION(2) :: XT
-!
-CALL CPU_TIME(XT(1))
-XT(2) = MPI_Wtime()
-END SUBROUTINE SECOND_MNH2
+use modd_precision, only: MNHTIME
+
+real(kind=MNHTIME),dimension(2) :: xt
+call cpu_time( xt(1) )
+xt(2) = MPI_WTIME()
+
+end subroutine second_mnh2
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+subroutine set_iluout_timing(tfile)
-!JUAN
- SUBROUTINE SET_ILUOUT_TIMING(KLUOUT)
- IMPLICIT NONE
- INTEGER, INTENT(IN) :: KLUOUT
- NLUOUT_TIMING = KLUOUT
- END SUBROUTINE SET_ILUOUT_TIMING
+use modd_io, only: tfiledata
+
+implicit none
+type(tfiledata), intent(in) :: tfile
+
+nluout_timing = tfile%nlu
+
+end subroutine set_iluout_timing
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -53,7 +67,7 @@ END SUBROUTINE SECOND_MNH2
SUBROUTINE TIMING_LEGEND()
CALL TIMING_SEPARATOR('-')
- WRITE(NLUOUT_TIMING,FMT="( '| CPUTIM/ELAPSE |&
+ WRITE(NLUOUT_TIMING,FMT="( '| CPUTIME/ELAPSED |&
&| SUM(PROC) |MEAN(PROC)| MIN(PROC | MAX(PROC)| PERCENT %|')" )
CALL TIMING_SEPARATOR('-')
END SUBROUTINE TIMING_LEGEND
@@ -84,33 +98,30 @@ END SUBROUTINE SECOND_MNH2
!* 0. DECLARATIONS
!
USE MODD_MPIF
- USE MODD_VAR_ll, ONLY : MPI_PRECISION, NPROC, IP
- !JUANZ
- USE MODD_VAR_ll, ONLY : NMNH_COMM_WORLD
- !JUANZ
+ use modd_precision, only: MNHTIME, MNHTIME_MPI
+ USE MODD_VAR_ll, ONLY: IP, NMNH_COMM_WORLD, NPROC
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
- REAL*8,DIMENSION(:), INTENT(IN) :: PRES ! (1)=CPU & (2)=ELAPSE Proccessors Timing
-!
- REAL*8,DIMENSION(:), INTENT(INOUT) :: PSUM ! (1)=SUM(CPU) & (2)=SUM(ELAPSE) Timing
-!
- CHARACTER(len=*), INTENT(IN),OPTIONAL :: HPRINT
- CHARACTER , INTENT(IN),OPTIONAL :: HSEP
- CHARACTER(len=*), INTENT(IN),OPTIONAL :: HFULL
+ REAL(kind=MNHTIME), DIMENSION(:), INTENT(IN) :: PRES ! (1)=CPU & (2)=ELAPSED Processes Timing
+ REAL(kind=MNHTIME), DIMENSION(:), INTENT(INOUT) :: PSUM ! (1)=SUM(CPU) & (2)=SUM(ELAPSED) Timing
+ CHARACTER(len=*), OPTIONAL, INTENT(IN) :: HPRINT
+ CHARACTER , OPTIONAL, INTENT(IN) :: HSEP
+ CHARACTER(len=*), OPTIONAL, INTENT(IN) :: HFULL
!
!* 0.2 Declarations of local variables :
!
INTEGER,PARAMETER :: NSTAT=5
- REAL*8,DIMENSION(2,NSTAT) :: ZSTAT ! (1)=Sum(proc),(2)=Sum/Nproc,(3)=Min(proc),(4)=Max(proc),(5)=Purcent(1)
+
INTEGER :: INFO,IROOT,JP
CHARACTER(len=30) :: VIDE = ""
- CHARACTER(len=30) :: FILE = ""
+ CHARACTER(len=30) :: FILE = ""
INTEGER :: IC
- REAL*8,DIMENSION(2,NPROC) :: ZSTAT_ALL
+ REAL(kind=MNHTIME), DIMENSION(2,NSTAT) :: ZSTAT ! (1)=Sum(proc),(2)=Sum/Nproc,(3)=Min(proc),(4)=Max(proc),(5)=Percent(1)
+ REAL(kind=MNHTIME), DIMENSION(2,NPROC) :: ZSTAT_ALL
INTEGER, DIMENSION(NPROC) :: IND
INTEGER :: ILU
!
@@ -120,15 +131,15 @@ END SUBROUTINE SECOND_MNH2
! ------------------------------
INFO = -1
! 1.1 Sum(Proc)
- CALL MPI_ALLREDUCE(PRES, ZSTAT(:,1), 2, MPI_REAL8, &
+ CALL MPI_ALLREDUCE(PRES, ZSTAT(:,1), 2, MNHTIME_MPI, &
MPI_SUM, NMNH_COMM_WORLD, INFO)
! 1.2 Sum/Proc
ZSTAT(:,2) = ZSTAT(:,1 ) / NPROC
! 1.3 Min(Proc)
- CALL MPI_ALLREDUCE(PRES, ZSTAT(:,3), 2, MPI_REAL8, &
+ CALL MPI_ALLREDUCE(PRES, ZSTAT(:,3), 2, MNHTIME_MPI, &
MPI_MIN, NMNH_COMM_WORLD, INFO)
! 1.4 Max(Proc)
- CALL MPI_ALLREDUCE(PRES, ZSTAT(:,4), 2, MPI_REAL8, &
+ CALL MPI_ALLREDUCE(PRES, ZSTAT(:,4), 2, MNHTIME_MPI, &
MPI_MAX, NMNH_COMM_WORLD, INFO)
@@ -138,8 +149,8 @@ INFO = -1
!
ELSEIF ( ZSTAT(1,1) > 0.0 ) THEN
- ! use Psum , for print stat & pourcent
- ! Purcent
+ ! use Psum , for print stat & percent
+ ! Percent
WHERE ( PSUM /= 0.0 )
ZSTAT(:,5) = 100.0 * ZSTAT(:,1) / PSUM(:)
ELSEWHERE
@@ -148,14 +159,14 @@ INFO = -1
! print stat
!
IF (PRESENT(HSEP)) CALL TIMING_SEPARATOR(HSEP)
- WRITE(NLUOUT_TIMING,FMT= "('|',A30,'| CPUTIM ||',F15.3,'|',4(F10.3,'|'),F7.3,'|')" ) HPRINT//VIDE,ZSTAT(1,:)
- WRITE(NLUOUT_TIMING,FMT= "('|',A30,'| ELAPSE ||',F15.3,'|',4(F10.3,'|'),F7.3,'|')" ) HPRINT//VIDE,ZSTAT(2,:)
+ WRITE(NLUOUT_TIMING,FMT= "('|',A29,'| CPUTIME ||',F15.3,'|',4(F10.3,'|'),F7.3,'|')" ) HPRINT//VIDE,ZSTAT(1,:)
+ WRITE(NLUOUT_TIMING,FMT= "('|',A29,'| ELAPSED ||',F15.3,'|',4(F10.3,'|'),F7.3,'|')" ) HPRINT//VIDE,ZSTAT(2,:)
IF (PRESENT(HFULL)) THEN
! gather all data
!CALL TIMING_SEPARATOR(HSEP)
IROOT = 0
- CALL MPI_GATHER(PRES(:),2,MPI_REAL8,ZSTAT_ALL(:,1),2,MPI_REAL8,&
+ CALL MPI_GATHER(PRES(:),2,MNHTIME_MPI,ZSTAT_ALL(:,1),2,MNHTIME_MPI,&
IROOT,NMNH_COMM_WORLD, INFO)
IF (IP.EQ.1) THEN
FILE = trim(adjustl(HPRINT))
@@ -188,17 +199,17 @@ INFO = -1
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine triabulle(vec,ind)
-implicit none
-
-real*8 , intent(inout) :: vec(:)
-integer, intent(out) :: ind(:)
+use modd_precision, only: MNHTIME
+implicit none
-integer :: n
+real(kind=MNHTIME), dimension(:), intent(inout) :: vec
+integer, dimension(:), intent(out) :: ind
logical :: a
integer :: i
integer :: mem
+integer :: n
n = size(vec)
a = .true.
@@ -207,7 +218,7 @@ do i=1,n
enddo
return
-!JUAN TO SLOW ON BG !!!
+!JUAN TOO SLOW ON BG !!!
do while (a)
a=.false.
diff --git a/src/MNH/mode_pos.f90 b/src/MNH/mode_pos.f90
index 27f7cfb75c17ca69ab93a44f6fa083f71a0fde9f..09a2ca12ee8467375b1784743768c89c72e14e98 100644
--- a/src/MNH/mode_pos.f90
+++ b/src/MNH/mode_pos.f90
@@ -1,23 +1,13 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1993-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 mode 2006/05/18 13:07:25
-!-----------------------------------------------------------------
!! ###############
MODULE MODE_POS
!! ###############
!!
-INTERFACE POS
-!!
-MODULE PROCEDURE POSNAM
-MODULE PROCEDURE POSKEY
-!!
-END INTERFACE
+implicit none
!!
!!
CONTAINS
@@ -54,6 +44,7 @@ CONTAINS
!! --------------
!! Original : 22/06/93
!! I. Mallet 15/10/01 adaptation to MesoNH (F90 norm)
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -156,6 +147,8 @@ END SUBROUTINE POSNAM
!! Original : 15/10/01
!------------------------------------------------------------------------------
!
+use mode_msg
+!
!* 0. DECLARATIONS
! ------------
!
@@ -169,7 +162,7 @@ CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HKEYWD2
!* 0.2 Declarations of local variables
!
CHARACTER(LEN=120) :: YLINE
-INTEGER :: ILEN1,IRET
+INTEGER :: ILEN1, ILEN2, IRET
!
!
!* 1. POSITION FILE
@@ -197,10 +190,7 @@ RETURN
! end of file: keyword not found
100 CONTINUE
IF (.NOT.PRESENT(HKEYWD2)) THEN
- WRITE(KLUOUT,FMT=*) '-- keyword ',HKEYWD1,' not found: program stop'
-!callabortstop
-CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'POSKEY', 'keyword '//trim(HKEYWD1)//' not found' )
ELSE
!
!* 2. SECOND KEYWORD: POSITION FILE
@@ -222,10 +212,7 @@ ELSE
END IF
! end of file: scd keyword not found
101 CONTINUE
-WRITE(KLUOUT,FMT=*) '-- keyword ',HKEYWD2,' not found: program stop'
-!callabortstop
-CALL ABORT
-STOP
+call Print_msg( NVERB_FATAL, 'GEN', 'POSKEY', 'keyword '//trim(HKEYWD2)//' not found' )
!------------------------------------------------------------------
END SUBROUTINE POSKEY
!
diff --git a/src/MNH/mode_salt_psd.f90 b/src/MNH/mode_salt_psd.f90
index e361c1dfac7aa5e7831247959f959777e4d6eec4..dc5a8611ef01cbc1505633c4b5a97c2a9848e699 100644
--- a/src/MNH/mode_salt_psd.f90
+++ b/src/MNH/mode_salt_psd.f90
@@ -23,9 +23,14 @@
!!
!! MODIFICATIONS
!! -------------
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
!!
!-------------------------------------------------------------------------------
!
+! ++ JORIS DEBUG ++
+USE MODD_CONF, ONLY : NVERB
+! -- JORIS DEBUG --
+!
USE MODD_CSTS_SALT !Constants which are important for sea salt calculations
USE MODD_SALT !Dust module which contains even more constants
USE MODD_CST, ONLY : &
@@ -137,6 +142,11 @@ ALLOCATE (ZINIRADIUS(NMODE_SLT))
ZSV(:,:,:,:) = MAX(PSVT(:,:,:,:), XMNH_TINY)
+! ++ JORIS DBG ++
+ZRG(:,:,:)= XMNH_TINY
+ZM(:,:,:,:)= XMNH_TINY
+! -- JORIS DBG --
+
DO JN=1,NMODE_SLT
IMODEIDX = JPSALTORDER(JN)
!Calculations here are for one mode only
@@ -235,6 +245,10 @@ DO JN=1,NMODE_SLT
* XM3TOUM3_SALT & !==>um3_{aer}/m3_{air}
/ (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment)
ZM(:,:,:,NM3(JN)) = MAX(ZM(:,:,:,NM3(JN)), ZMMIN(NM3(JN)))
+!Modif salt/dust 5.1. beg
+ PSVT(:,:,:,JN) = ZM(:,:,:,NM3(JN)) * XMD * XPI * 4./3. * ZRHOI / &
+ (ZMI*PRHODREF(:,:,:)*XM3TOUM3_SALT)
+!Modif salt/dust 5.1. end
ZM(:,:,:,NM0(JN))= ZM(:,:,:,NM3(JN))/&
((ZINIRADIUS(JN)**3)*EXP(4.5 * LOG(XINISIG_SLT(JPSALTORDER(JN)))**2))
@@ -280,6 +294,21 @@ DO JN=1,NMODE_SLT
END IF
!
!Get number median radius (eqn. 7 in Orilam manuscript)
+ ! ++ JORIS DBG ++
+ IF (NVERB ==15) THEN
+ WRITE(*,*) 'SHAPE(ZM) =', SHAPE(ZM)
+ WRITE(*,*) 'MINVAL(ZM), MAXVAL(ZM) =', MINVAL(ZM), MAXVAL(ZM)
+ WRITE(*,*) 'MINLOC(ZM), MAXLOC(ZM) =', MINLOC(ZM), MAXLOC(ZM)
+ WRITE(*,*) 'SHAPE(ZRG) =', SHAPE(ZRG)
+ WRITE(*,*) 'MINVAL(ZRG), MAXVAL(ZRG) =', MINVAL(ZRG), MAXVAL(ZRG)
+ WRITE(*,*) 'MINLOC(ZRG), MAXLOC(ZRG) =', MINLOC(ZRG), MAXLOC(ZRG)
+ WRITE(*,*) 'XSIXTH_SALT =', XSIXTH_SALT
+ WRITE(*,*) 'JN =', JN
+ WRITE(*,*) 'NM0 =', NM0
+ WRITE(*,*) 'NM3 =', NM3
+ WRITE(*,*) 'NM6 =', NM6
+ ENDIF
+ ! -- JORIS DBG --
ZRG(:,:,:)= &
( &
ZM(:,:,:,NM3(JN))*ZM(:,:,:,NM3(JN))*ZM(:,:,:,NM3(JN))*ZM(:,:,:,NM3(JN)) &
@@ -414,7 +443,9 @@ END SUBROUTINE PPP2SALT
!
! PSVT need to be positive
- PSVT(:,:,:,:) = MAX(PSVT(:,:,:,:), XMNH_TINY)
+!Modif salt/dust 5.1. beg
+! PSVT(:,:,:,:) = MAX(PSVT(:,:,:,:), XMNH_TINY)
+!Modif salt/dust 5.1. end
DO JN=1,NMODE_SLT
IMODEIDX = JPSALTORDER(JN)
@@ -629,8 +660,10 @@ ALLOCATE (ZSIGMA(SIZE(PSVT,1)))
ALLOCATE (ZRG(SIZE(PSVT,1)))
ALLOCATE (ZSV(SIZE(PSVT,1), SIZE(PSVT,2)))
ALLOCATE (ZINIRADIUS(NMODE_SLT))
-
+
+!Modif salt/dust 5.1. beg
ZSV(:,:) = MAX(PSVT(:,:), XMNH_TINY)
+!Modif salt/dust 5.1. end
DO JN=1,NMODE_SLT
IMODEIDX = JPSALTORDER(JN)
diff --git a/src/MNH/mode_salt_psd_wet.f90 b/src/MNH/mode_salt_psd_wet.f90
new file mode 100644
index 0000000000000000000000000000000000000000..cb5af52f838a83cd4997f9fad234eb1919262d24
--- /dev/null
+++ b/src/MNH/mode_salt_psd_wet.f90
@@ -0,0 +1,926 @@
+!ORILAM_LIC Copyright 1994-2014 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.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/Attic/mode_salt_psd.f90,v $ $Revision: 1.1.2.1.2.1.2.1.2.1 $ $Date: 2013/07/12 13:55:08 $
+!-----------------------------------------------------------------
+!! ########################
+ MODULE MODE_SALT_PSD_WET
+!! ########################
+!!
+!! PURPOSE
+!! -------
+!! MODULE SALT PSD (Particle Size Distribution)
+!! Purpose: Contains subroutines to convert from transported variables (ppp)
+!! to understandable aerosol variables, e.g. #/m3, kg/m3, sigma, R_{n}
+!!
+!! AUTHOR
+!! ------
+!! Alf Grini (CNRM/GMEI)
+!!
+!! MODIFICATIONS
+!! -------------
+!! M. Claeys - (CNRM-GMEI) 2015
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+!-------------------------------------------------------------------------------
+!
+USE MODD_CSTS_SALT !Constants which are important for sea salt calculations
+USE MODD_SALT !Dust module which contains even more constants
+USE MODD_CST, ONLY : &
+ XPI & !Definition of pi
+ ,XBOLTZ & ! Boltzman constant
+ ,XAVOGADRO & ![molec/mol] avogadros number
+ ,XG & ! Gravity constant
+ ,XP00 & ! Reference pressure
+ ,XMD & ![kg/mol] molar weight of air
+ ,XRD & ! Gaz constant for dry air
+ ,XCPD & ! Cpd (dry air)
+ ,XRHOLW & ! Densité de l'eau
+ ,XMV & ! Molar weight of water
+ ,XALPI &
+ ,XBETAI &
+ ,XGAMI &
+ ,XTT
+USE MODD_CST, ONLY : XMNH_TINY
+USE MODE_THERMO ! Pour calcul de la pression de vapeur saturante
+USE MODD_PARAM_n, ONLY : CCLOUD
+
+
+!
+IMPLICIT NONE
+!
+CONTAINS
+!
+!! ############################################################
+ SUBROUTINE PPP2SALT_WET( &
+ PSVT & !I [ppp] input scalar variables (moment of distribution)
+ , PRHODREF & !I [kg/m3] density of air
+ , PPABST & !I Pression
+ , PTHT & !I Potential temperature
+ , PRT & !I Large scale vapor mixing ratio
+ , PSIG3D & !O [-] standard deviation of aerosol distribution
+ , PRG3D & !O [um] number median wet radius of aerosol distribution
+ , PN3D & !O [#/m3] number concentration of aerosols
+ , PMASS3D & !O [kg/m3]wet mass concentration of aerosol
+ , PM3D & !O aerosols moments 0, 3 and 6
+ , PDENSITY_WET & !O [g/m2] density of wet aerosol (water + salt)
+ )
+!! ############################################################
+!
+!!
+!! PURPOSE
+!! -------
+!! Translate the three moments M0, M3 and M6 given in ppp into
+!! Values which can be understood more easily (R, sigma, N, M)
+!!
+!! Calcul the wet radius of the particles, using RH and Gerber (1985) relation
+!! The mass of the aerosols is calculated using the new radius and the
+!density of water and salt
+!!
+!! CALLING STRUCTURE NOTE: OPTIONAL VARIABLES
+!! -------
+!! CALL PPP2AEROS(PSVT, PRHODREF, PSIG3D=SIGVAR, &
+!! PRG3D=RVAR, PN3D=NVAR, PM3D=MASSVAR)
+!!
+!! REFERENCE
+!! ---------
+!! none
+!!
+!! AUTHOR
+!! ------
+!! Pierre TULET (LA)
+!!
+!! MODIFICATIONS
+!! -------------
+!! 2005 Alf Grini (CNRM)
+!! 2006 Jean-Pierre Chaboureau (LA)
+!! 2015 Marine Claeys (CNRM)
+!! EXTERNAL
+!! --------
+!! None
+!!
+ IMPLICIT NONE
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!* 0.1 declarations of arguments
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT !I [ppp] first moment
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF !I [kg/m3] density of air
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST !I Pression
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT !I Potential temperature
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT !I Large scale vapor mixing ratio
+
+REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PSIG3D !O [-] standard deviation
+REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PRG3D !O [um] number median radius
+REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PN3D !O [#/m3] number concentration
+REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PMASS3D !O [kg_{aer}/m3] wet mass concentration
+REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PM3D !O aerosols moments
+REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PDENSITY_WET !O Density of wet aerosol (water + salt)
+!
+!
+!* 0.2 declarations local variables
+!
+REAL :: ZRHOI ! [kg/m3] density of aerosol
+REAL :: ZRHOLW ! [kg/m3] density of water
+REAL :: ZMI ! [kg/mol] molar weight of aerosol
+REAL :: ZMV ! [kg/mol] molar weight of water
+REAL :: ZRGMIN ! [um] minimum radius accepted
+REAL :: ZSIGMIN ! minimum standard deviation accepted
+
+REAL, PARAMETER :: C1 = 0.7674
+REAL, PARAMETER :: C2 = 3.079
+REAL, PARAMETER :: C3 = 2.572E-11
+REAL, PARAMETER :: C4 = -1.424
+
+REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZM ! [aerosol units] local array which goes to output later
+REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZSV ! [sea salts moment concentration]
+REAL,DIMENSION(:), ALLOCATABLE :: ZMMIN ! [aerosol units] minimum values for N, sigma, M
+INTEGER,DIMENSION(:), ALLOCATABLE :: NM0 ! [idx] index for Mode 0 in passed variables
+INTEGER,DIMENSION(:), ALLOCATABLE :: NM3 ! [idx] indexes for Mode 3 in passed variables
+INTEGER,DIMENSION(:), ALLOCATABLE :: NM6 ! [idx] indexes for Mode 6 in passed variables
+REAL,DIMENSION(:), ALLOCATABLE :: ZINIRADIUS ! initial mean radius
+INTEGER :: JN,IMODEIDX,JJ ! [idx] loop counters
+
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3), NMODE_SLT) :: ZMASS3D, &
+ ZMASS3D_SLT ![kg/m3] mass of one sea salt mode
+
+REAL,DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZTEMP, ZREHU, ZREHU_tmp
+REAL,DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3), NMODE_SLT) :: ZDENSITY_WET ! [g/m2] Aerosol wet density (salt + water)
+REAL,DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZSIGMA ! [-] standard deviation
+REAL,DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZRG, ZRG_WET ! [um] number median radius, and nuber median wet radius
+!
+!-------------------------------------------------------------------------------
+!
+
+!+ Marine
+! Calcul de RH
+! Pris dans write_lfi_for_diag pour le calcul de RH
+ZTEMP(:,:,:) = PTHT(:,:,:) * (PPABST(:,:,:) / XP00)**(XRD/XCPD)
+
+ZREHU_tmp(:,:,:) = SM_FOES(ZTEMP(:,:,:)) ! SM_FOES = to compute saturation vapor pressure
+ZREHU_tmp(:,:,:) = (XMV / XMD) * ZREHU_tmp(:,:,:) / (PPABST(:,:,:) - ZREHU_tmp(:,:,:))
+!XMD,XMV ! Molar mass of dry air and molar mass of vapor, PPABST: pression
+
+ZREHU(:,:,:) = PRT(:,:,:,1) / ZREHU_tmp(:,:,:)
+
+IF (CCLOUD(1:3) =='ICE' .OR. CCLOUD =='C3R5') THEN
+ WHERE ( ZTEMP(:,:,:) < XTT) ! XTT : Triple point temperature
+ ZREHU_tmp(:,:,:) = EXP( XALPI - XBETAI/ZTEMP(:,:,:) & ! XALPI,XBETAI,XGAMI ! Constants for saturation vapor pressure
+ - XGAMI*ALOG(ZTEMP(:,:,:)) ) !saturation over ice
+ ZREHU_tmp(:,:,:) = (XMV / XMD) * ZREHU_tmp(:,:,:) / (PPABST(:,:,:) - ZREHU_tmp(:,:,:))
+ ZREHU(:,:,:) = PRT(:,:,:,1) / ZREHU_tmp(:,:,:)
+ END WHERE
+END IF
+
+ZREHU(:,:,:) = MIN(MAX(ZREHU(:,:,:), 0.02),0.95)
+
+
+! 1.1 initialisation
+!
+!Calculations here are for one mode only
+!
+ALLOCATE (NM0(NMODE_SLT))
+ALLOCATE (NM3(NMODE_SLT))
+ALLOCATE (NM6(NMODE_SLT))
+ALLOCATE (ZM(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3), NMODE_SLT*3))
+ALLOCATE (ZMMIN(NMODE_SLT*3))
+ALLOCATE (ZSV(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3), SIZE(PSVT,4)))
+ALLOCATE (ZINIRADIUS(NMODE_SLT))
+
+ZSV(:,:,:,:) = MAX(PSVT(:,:,:,:), XMNH_TINY)
+
+DO JN = 1, NMODE_SLT
+ IMODEIDX = JPSALTORDER(JN)
+ !Calculations here are for one mode only
+ IF (CRGUNITS == "MASS") THEN
+ ZINIRADIUS(JN) = XINIRADIUS_SLT(IMODEIDX) * EXP(-3.*(LOG(XINISIG_SLT(IMODEIDX)))**2)
+ ELSE
+ ZINIRADIUS(JN) = XINIRADIUS_SLT(IMODEIDX)
+ END IF
+
+ !Set counter for number, M3 and M6
+ NM0(JN) = 1 + (JN - 1) * 3
+ NM3(JN) = 2 + (JN - 1) * 3
+ NM6(JN) = 3 + (JN - 1) * 3
+ !Get minimum values possible
+ ZMMIN(NM0(JN)) = XN0MIN_SLT(IMODEIDX)
+ ZRGMIN = ZINIRADIUS(JN)
+ IF (LVARSIG_SLT) THEN
+ ZSIGMIN = XSIGMIN_SLT
+ ELSE
+ ZSIGMIN = XINISIG_SLT(IMODEIDX)
+ ENDIF
+ ZMMIN(NM3(JN)) = ZMMIN(NM0(JN)) * (ZRGMIN**3)*EXP(4.5 * LOG(ZSIGMIN)**2)
+ ZMMIN(NM6(JN)) = ZMMIN(NM0(JN)) * (ZRGMIN**6)*EXP(18. * LOG(ZSIGMIN)**2)
+END DO
+!
+!Set density of aerosol, here sea salt (kg/m3) and water
+ZRHOI = XDENSITY_SALT
+ZRHOLW = XRHOLW
+!Set molecular weight of sea salt and water!NOTE THAT THIS IS NOW IN KG
+ZMI = XMOLARWEIGHT_SALT
+ZMV = XMV
+!
+!
+DO JN = 1, NMODE_SLT
+ !
+ IF (LVARSIG_SLT) THEN ! give M6 (case of variable standard deviation)
+ !
+ !Get number concentration (#/molec_{air}==>#/m3)
+ ZM(:,:,:,NM0(JN))= &
+ ZSV(:,:,:,1+(JN-1)*3) & !#/molec_{air}
+ * XAVOGADRO & !==>#/mole
+ / XMD & !==>#/kg_{air}
+ * PRHODREF(:,:,:) !==>#/m3
+ !
+ !calculate moment 3 from total aerosol mass (molec_{aer}/molec_{air} ==>
+ ZM(:,:,:,NM3(JN)) = &
+ ZSV(:,:,:,2+(JN-1)*3) & !molec_{aer}/molec_{aer}
+ * (ZMI/XMD) & !==>kg_{aer}/kg_{aer}
+ * PRHODREF(:,:,:) & !==>kg_{aer}/m3_{air}
+ * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air}
+ * XM3TOUM3_SALT & !==>um3_{aer}/m3_{air}
+ / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment)
+ !Limit mass concentration to minimum value
+ ZM(:,:,:,NM3(JN)) = MAX(ZM(:,:,:,NM3(JN)), ZMMIN(NM3(JN)))
+ !
+ ZM(:,:,:,NM6(JN)) = ZSV(:,:,:,3+(JN-1)*3) & !um6/molec_{air}*(cm3/m3)
+ * 1.d-6 & !==> um6/molec_{air}
+ * XAVOGADRO & !==> um6/mole_{air}
+ / XMD & !==> um6/kg_{air}
+ * PRHODREF(:,:,:) !==> um6/m3_{air}
+ !Limit m6 concentration to minimum value
+ ZM(:,:,:,NM6(JN)) = MAX(ZM(:,:,:,NM6(JN)), ZMMIN(NM6(JN)))
+ !
+ !Get sigma (only if sigma is allowed to vary)
+ !Get intermediate values for sigma M3^2/(M0*M6) (ORILAM paper, eqn 8)
+ ZSIGMA(:,:,:)=ZM(:,:,:,NM3(JN))**2/(ZM(:,:,:,NM0(JN))*ZM(:,:,:,NM6(JN)))
+ !Limit the intermediate value, can not be larger than 1
+ ZSIGMA(:,:,:)=MIN(1-1E-10,ZSIGMA(:,:,:))
+ !Limit the value for intermediate, can not be smaller than 0
+ ZSIGMA(:,:,:)=MAX(1E-10,ZSIGMA(:,:,:))
+ !Calculate log(sigma)
+ ZSIGMA(:,:,:)= LOG(ZSIGMA(:,:,:))
+ !Finally get the real sigma the negative sign is because of
+ !The way the equation is written (M3^2/(M0*M6)) instead of (M0*M6)/M3^3
+ ZSIGMA(:,:,:)= EXP(1./3.*SQRT(-ZSIGMA(:,:,:)))
+ !Limit the value to reasonable ones
+ ZSIGMA(:,:,:) = MAX( XSIGMIN_SLT, MIN( XSIGMAX_SLT, ZSIGMA(:,:,:) ) )
+
+ !
+ !Put back M6 so that it fits the sigma which is possibly modified above
+ !The following makes M6 consistent with N, R, SIGMA
+ ZM(:,:,:,NM6(JN)) = ZM(:,:,:,NM0(JN)) &
+ * ( (ZM(:,:,:,NM3(JN))/ZM(:,:,:,NM0(JN)))**(1./3.) &
+ * exp(-(3./2.)*log(ZSIGMA(:,:,:))**2))**6 &
+ * exp(18.*log(ZSIGMA(:,:,:))**2)
+
+ ELSE ! compute M6 from M0, M3 and SIGMA
+ !
+ ZSIGMA(:,:,:) = XINISIG_SLT(JPSALTORDER(JN))
+ IF (LRGFIX_SLT) THEN
+
+ !calculate moment 3 from total aerosol mass (molec_{aer}/molec_{air} ==>
+ ZM(:,:,:,NM3(JN)) = &
+ ZSV(:,:,:,JN) & !molec_{aer}/molec_{aer}
+ * (ZMI/XMD) & !==>kg_{aer}/kg_{aer}
+ * PRHODREF(:,:,:) & !==>kg_{aer}/m3_{air}
+ * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air}
+ * XM3TOUM3_SALT & !==>um3_{aer}/m3_{air}
+ / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment)
+
+ ZM(:,:,:,NM3(JN)) = MAX(ZM(:,:,:,NM3(JN)), ZMMIN(NM3(JN)))
+ PSVT(:,:,:,JN) = ZM(:,:,:,NM3(JN)) * XMD * XPI * 4./3. * ZRHOI / &
+ (ZMI*PRHODREF(:,:,:)*XM3TOUM3_SALT)
+
+ ZM(:,:,:,NM0(JN))= ZM(:,:,:,NM3(JN))/&
+ ((ZINIRADIUS(JN)**3)*EXP(4.5 * LOG(XINISIG_SLT(JPSALTORDER(JN)))**2))
+
+
+
+ ELSE
+
+ !calculate moment 3 from total aerosol mass (molec_{aer}/molec_{air} ==>
+ ZM(:,:,:,NM3(JN)) = &
+ ZSV(:,:,:,2+(JN-1)*2) & !molec_{aer}/molec_{aer}
+ * (ZMI/XMD) & !==>kg_{aer}/kg_{aer}
+ * PRHODREF(:,:,:) & !==>kg_{aer}/m3_{air}
+ * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air}
+ * XM3TOUM3_SALT & !==>um3_{aer}/m3_{air}
+ / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment)
+
+
+ !Get number concentration (#/molec_{air}==>#/m3)
+ ZM(:,:,:,NM0(JN))= &
+ ZSV(:,:,:,1+(JN-1)*2) & !#/molec_{air}
+ * XAVOGADRO & !==>#/mole
+ / XMD & !==>#/kg_{air}
+ * PRHODREF(:,:,:) !==>#/m3
+
+ ! Limit concentration to minimum values
+ WHERE ((ZM(:,:,:,NM0(JN)) < ZMMIN(NM0(JN)) ).OR. &
+ (ZM(:,:,:,NM3(JN)) < ZMMIN(NM3(JN)) ))
+ ZM(:,:,:,NM0(JN)) = ZMMIN(NM0(JN))
+ ZM(:,:,:,NM3(JN)) = ZMMIN(NM3(JN))
+ PSVT(:,:,:,1+(JN-1)*2) = ZM(:,:,:,NM0(JN)) * XMD / &
+ (XAVOGADRO * PRHODREF(:,:,:) )
+ PSVT(:,:,:,2+(JN-1)*2) = ZM(:,:,:,NM3(JN)) * XMD * XPI * 4./3. * ZRHOI / &
+ (ZMI*PRHODREF(:,:,:)*XM3TOUM3_SALT)
+ ENDWHERE
+ END IF
+
+ ZM(:,:,:,NM6(JN)) = ZM(:,:,:,NM0(JN)) &
+ * ( (ZM(:,:,:,NM3(JN))/ZM(:,:,:,NM0(JN)))**(1./3.) &
+ * exp(-(3./2.)*log(ZSIGMA(:,:,:))**2))**6 &
+ * exp(18.*log(ZSIGMA(:,:,:))**2)
+
+ !
+ END IF
+ !
+ !Get number median radius (eqn. 7 in Orilam manuscript)
+ ZRG(:,:,:)= &
+ ( &
+ ZM(:,:,:,NM3(JN))*ZM(:,:,:,NM3(JN))*ZM(:,:,:,NM3(JN))*ZM(:,:,:,NM3(JN)) &
+ /(ZM(:,:,:,NM6(JN))*ZM(:,:,:,NM0(JN))*ZM(:,:,:,NM0(JN))*ZM(:,:,:,NM0(JN))) &
+ ) &
+ ** XSIXTH_SALT
+
+
+ !ZRG(:,:,:)=MIN(ZRG(:,:,:),ZINIRADIUS(JN))
+ !Give the sigma-values to the passed array
+ IF(PRESENT(PSIG3D)) PSIG3D(:,:,:,JN) = ZSIGMA(:,:,:)
+ !
+ !Set the number concentrations in the passed array
+ IF(PRESENT(PN3D)) PN3D(:,:,:,JN) = ZM(:,:,:,NM0(JN))
+ !
+! !Get the number median radius
+! IF(PRESENT(PRG3D)) PRG3D(:,:,:,JN)= ZRG(:,:,:)
+ !
+ !
+ !+ Marine
+!!!!!!!!!!! Wet radius calculus
+
+!Test pour Marine
+
+ ZRG_WET(:,:,:) = C1 * (ZRG(:,:,:)*1.d-4)**C2 ! Pour le calcul, ZRG en cm! (d'où 1.d-4)
+
+!+ Marine test
+
+ ZRG_WET(:,:,:) = ZRG_WET(:,:,:) / (C3 * ((ZRG(:,:,:)*1.d-4)**C4) - LOG10(ZREHU(:,:,:)))
+ ZRG_WET(:,:,:) = ZRG_WET(:,:,:) + (ZRG(:,:,:)*1.d-4)**3
+ ZRG_WET(:,:,:) = ( ZRG_WET(:,:,:)**(1./3) )*1.d4 ! *1.d4 pour repasser de cm à micromètres
+
+ !Get the number median radius
+ IF(PRESENT(PRG3D)) PRG3D(:,:,:,JN) = ZRG_WET(:,:,:)
+
+
+
+! Wet density calcul
+ ZDENSITY_WET(:,:,:,JN)=(ZRHOI * ZRG(:,:,:) * ZRG(:,:,:) * ZRG(:,:,:) + &
+ ZRHOLW * (ZRG_WET(:,:,:) * ZRG_WET(:,:,:) * ZRG_WET(:,:,:)- &
+ ZRG(:,:,:) * ZRG(:,:,:) * ZRG(:,:,:))) &
+ / (ZRG_WET(:,:,:) * ZRG_WET(:,:,:) * ZRG_WET(:,:,:))
+
+!Wet mass
+ ZMASS3D(:,:,:,JN)= &
+ ZM(:,:,:,NM0(JN)) & !#/m^3_{air}
+ * XPI*4./3. &
+ * ZDENSITY_WET(:,:,:,JN) & !==>kg/m^3_{aeros}/m^3_{air}
+ * ZRG_WET(:,:,:) * ZRG_WET(:,:,:) * ZRG_WET(:,:,:) &
+ * XUM3TOM3_SALT & !==>kg/m^3_{air}
+ * exp(4.5*log(ZSIGMA(:,:,:))*log(ZSIGMA(:,:,:)))
+
+! Salt Mass
+ ZMASS3D_SLT(:,:,:,JN)= &
+ ZM(:,:,:,NM0(JN)) & !#/m^3_{air}
+ * XPI*4./3. &
+ * ZRHOI & !==>kg/m^3_{aeros}/m^3_{air}
+ * ZRG(:,:,:) * ZRG(:,:,:) * ZRG(:,:,:) &
+ * XUM3TOM3_SALT & !==>kg/m^3_{air}
+ * exp(4.5*log(ZSIGMA(:,:,:))*log(ZSIGMA(:,:,:)))
+
+ IF(PRESENT(PMASS3D)) THEN
+ PMASS3D(:,:,:,JN)= ZMASS3D(:,:,:,JN)
+ ENDIF
+
+ IF(PRESENT(PDENSITY_WET)) THEN
+ PDENSITY_WET(:,:,:,JN) = ZDENSITY_WET(:,:,:,JN)
+ ENDIF
+!
+END DO !Loop on modes
+!
+IF(PRESENT(PM3D)) PM3D(:,:,:,:) = ZM(:,:,:,:)
+!
+DEALLOCATE(ZINIRADIUS)
+DEALLOCATE(ZSV)
+DEALLOCATE(ZMMIN)
+DEALLOCATE(ZM)
+DEALLOCATE(NM6)
+DEALLOCATE(NM3)
+DEALLOCATE(NM0)
+
+!+ Marine
+
+END SUBROUTINE PPP2SALT_WET
+
+!! ############################################################
+ SUBROUTINE SALT2PPP( &
+ PSVT & !IO [ppp] input scalar variables (moment of distribution)
+ , PRHODREF & !I [kg/m3] density of air
+ , PSIG3D & !I [-] standard deviation of aerosol distribution
+ , PRG3D & !I [um] number median diameter of aerosol distribution
+ )
+!! ############################################################
+!
+!!
+!! PURPOSE
+!! -------
+!! Translate the sea salt Mass, RG and SIGMA in the three moments M0, M3 and M6 given in ppp
+!!
+!! CALLING STRUCTURE NOTE: OPTIONAL VARIABLES
+!! -------
+!! CALL PPP2AEROS(PSVT, PRHODREF, PSIG3D=SIGVAR, &
+!! PRG3D=RVAR, PN3D=NVAR)
+!!
+!! REFERENCE
+!! ---------
+!! none
+!!
+!! AUTHOR
+!! ------
+!! Pierre TULET (LA)
+!!
+!! MODIFICATIONS
+!! -------------
+!! Alf Grini (CNRM)
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+ IMPLICIT NONE
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!* 0.1 declarations of arguments
+!
+ !INPUT
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF !I [kg/m3] density of air
+ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSIG3D !O [-] standard deviation
+ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRG3D !O [um] number median diameter
+
+ !OUTPUT
+ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT !IO [#/molec_{air}] first moment
+ !IO [molec_{aer}/molec_{air} 3rd moment
+ !IO [um6/molec_{air}*(cm3/m3)] 6th moment
+!
+!
+!* 0.2 declarations local variables
+!
+ REAL :: ZRHOI ! [kg/m3] density of aerosol
+ REAL :: ZMI ! [kg/mol] molar weight of aerosol
+ REAL :: ZRGMIN ! [um] minimum radius accepted
+ REAL :: ZSIGMIN ! minimum standard deviation accepted
+ REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZM ! [aerosol units] local array which goes to output later
+ REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZSIGMA ! aersol standard deviation
+ REAL,DIMENSION(:), ALLOCATABLE :: ZMMIN ! [aerosol units] minimum values for N, sigma, M
+ REAL,DIMENSION(:), ALLOCATABLE :: ZINIRADIUS ! initial mean radius
+ INTEGER,DIMENSION(:), ALLOCATABLE :: NM0 ! [idx] index for Mode 0 in passed variables
+ INTEGER,DIMENSION(:), ALLOCATABLE :: NM3 ! [idx] indexes for Mode 3 in passed variables
+ INTEGER,DIMENSION(:), ALLOCATABLE :: NM6 ! [idx] indexes for Mode 6 in passed variables
+ INTEGER :: JJ, JN ! [idx] loop counters
+ INTEGER :: IMODEIDX
+!
+!-------------------------------------------------------------------------------
+!
+! 1.1 initialisation
+
+
+ ALLOCATE (NM0(NMODE_SLT))
+ ALLOCATE (NM3(NMODE_SLT))
+ ALLOCATE (NM6(NMODE_SLT))
+ ALLOCATE (ZINIRADIUS(NMODE_SLT))
+ ALLOCATE (ZMMIN(NMODE_SLT*3))
+ ALLOCATE (ZM(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3), NMODE_SLT*3))
+ ALLOCATE (ZSIGMA(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3)))
+
+ !Set density of aerosol, here sea salt (kg/m3)
+ ZRHOI = XDENSITY_SALT
+ !Set molecular weight of sea salt !NOTE THAT THIS IS NOW IN KG
+ ZMI = XMOLARWEIGHT_SALT
+!
+
+ ! PSVT need to be positive
+! PSVT(:,:,:,:) = MAX(PSVT(:,:,:,:), XMNH_TINY)
+
+ DO JN=1,NMODE_SLT
+ IMODEIDX = JPSALTORDER(JN)
+ !Calculations here are for one mode only
+ IF (CRGUNITS=="MASS") THEN
+ ZINIRADIUS(JN) = XINIRADIUS_SLT(IMODEIDX) * EXP(-3.*(LOG(XINISIG_SLT(IMODEIDX)))**2)
+ ELSE
+ ZINIRADIUS(JN) = XINIRADIUS_SLT(IMODEIDX)
+ END IF
+
+ !Set counter for number, M3 and M6
+ NM0(JN) = 1+(JN-1)*3
+ NM3(JN) = 2+(JN-1)*3
+ NM6(JN) = 3+(JN-1)*3
+
+ !Get minimum values possible
+ ZMMIN(NM0(JN)) = XN0MIN_SLT(IMODEIDX)
+ ZRGMIN = ZINIRADIUS(JN)
+ IF (LVARSIG_SLT) THEN
+ ZSIGMIN = XSIGMIN_SLT
+ ELSE
+ ZSIGMIN = XINISIG_SLT(IMODEIDX)
+ ENDIF
+ ZMMIN(NM3(JN)) = ZMMIN(NM0(JN)) * (ZRGMIN**3)*EXP(4.5 * LOG(ZSIGMIN)**2)
+ ZMMIN(NM6(JN)) = ZMMIN(NM0(JN)) * (ZRGMIN**6)*EXP(18. * LOG(ZSIGMIN)**2)
+ END DO
+
+ !Set density of aerosol, here sea salt (kg/m3)
+ ZRHOI = XDENSITY_SALT
+ !Set molecular weight of sea salt !NOTE THAT THIS IS NOW IN KG
+ ZMI = XMOLARWEIGHT_SALT
+!
+ DO JN=1,NMODE_SLT
+ !calculate moment 3 from total aerosol mass (molec_{aer}/molec_{air} ==>
+ IF (LVARSIG_SLT) THEN
+ ZM(:,:,:,NM3(JN)) = &
+ PSVT(:,:,:,2+(JN-1)*3) & !molec_{aer}/molec_{aer}
+ * (ZMI/XMD) & !==>kg_{aer}/kg_{aer}
+ * PRHODREF(:,:,:) & !==>kg_{aer}/m3_{air}
+ * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air}
+ * XM3TOUM3_SALT & !==>um3_{aer}/m3_{air}
+ / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment)
+ ELSE
+ IF ((LRGFIX_SLT)) THEN
+ ZM(:,:,:,NM3(JN)) = &
+ PSVT(:,:,:,JN) & !molec_{aer}/molec_{aer}
+ * (ZMI/XMD) & !==>kg_{aer}/kg_{aer}
+ * PRHODREF(:,:,:) & !==>kg_{aer}/m3_{air}
+ * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air}
+ * XM3TOUM3_SALT & !==>um3_{aer}/m3_{air}
+ / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment)
+ ZM(:,:,:,NM3(JN)) = MAX(ZM(:,:,:,NM3(JN)), ZMMIN(NM3(JN)))
+ ELSE
+ ZM(:,:,:,NM3(JN)) = &
+ PSVT(:,:,:,2+(JN-1)*2) & !molec_{aer}/molec_{aer}
+ * (ZMI/XMD) & !==>kg_{aer}/kg_{aer}
+ * PRHODREF(:,:,:) & !==>kg_{aer}/m3_{air}
+ * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air}
+ * XM3TOUM3_SALT & !==>um3_{aer}/m3_{air}
+ / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment)
+ END IF
+ END IF
+! calculate moment 0 from dispersion and mean radius
+ ZM(:,:,:,NM0(JN))= ZM(:,:,:,NM3(JN))/&
+ ((PRG3D(:,:,:,JN)**3)*EXP(4.5 * LOG(PSIG3D(:,:,:,JN))**2))
+
+! calculate moment 6 from dispersion and mean radius
+ ZM(:,:,:,NM6(JN)) = ZM(:,:,:,NM0(JN)) * (PRG3D(:,:,:,JN)**6) * &
+ EXP(18 *(LOG(PSIG3D(:,:,:,JN)))**2)
+
+ IF (LVARSIG_SLT) THEN
+ WHERE ((ZM(:,:,:,NM0(JN)) .LT. ZMMIN(NM0(JN))).OR.&
+ (ZM(:,:,:,NM3(JN)) .LT. ZMMIN(NM3(JN))).OR.&
+ (ZM(:,:,:,NM6(JN)) .LT. ZMMIN(NM6(JN))))
+ ZM(:,:,:,NM0(JN)) = ZMMIN(NM0(JN))
+ ZM(:,:,:,NM3(JN)) = ZMMIN(NM3(JN))
+ ZM(:,:,:,NM6(JN)) = ZMMIN(NM6(JN))
+ END WHERE
+ ELSE IF (.NOT.(LRGFIX_SLT)) THEN
+
+ WHERE ((ZM(:,:,:,NM0(JN)) .LT. ZMMIN(NM0(JN))).OR.&
+ (ZM(:,:,:,NM3(JN)) .LT. ZMMIN(NM3(JN))))
+ ZM(:,:,:,NM0(JN)) = ZMMIN(NM0(JN))
+ ZM(:,:,:,NM3(JN)) = ZMMIN(NM3(JN))
+ END WHERE
+ ENDIF
+
+
+ ! return to concentration #/m3 => (#/molec_{air}
+ IF (LVARSIG_SLT) THEN
+ PSVT(:,:,:,1+(JN-1)*3) = ZM(:,:,:,NM0(JN)) * XMD / &
+ (XAVOGADRO*PRHODREF(:,:,:))
+
+ PSVT(:,:,:,2+(JN-1)*3) = ZM(:,:,:,NM3(JN)) * XMD * XPI * 4./3 * ZRHOI / &
+ (ZMI*PRHODREF(:,:,:)*XM3TOUM3_SALT)
+
+ PSVT(:,:,:,3+(JN-1)*3) = ZM(:,:,:,NM6(JN)) * XMD / &
+ ( XAVOGADRO*PRHODREF(:,:,:) * 1.d-6)
+ ELSE IF (LRGFIX_SLT) THEN
+ PSVT(:,:,:,JN) = ZM(:,:,:,NM3(JN)) * XMD * XPI * 4./3. * ZRHOI / &
+ (ZMI*PRHODREF(:,:,:)*XM3TOUM3_SALT)
+ ELSE
+ PSVT(:,:,:,1+(JN-1)*2) = ZM(:,:,:,NM0(JN)) * XMD / &
+ (XAVOGADRO*PRHODREF(:,:,:))
+
+ PSVT(:,:,:,2+(JN-1)*2) = ZM(:,:,:,NM3(JN)) * XMD * XPI * 4./3. * ZRHOI / &
+ (ZMI*PRHODREF(:,:,:)*XM3TOUM3_SALT)
+ END IF
+!
+END DO !Loop on modes
+
+DEALLOCATE(ZINIRADIUS)
+DEALLOCATE(ZMMIN)
+DEALLOCATE(ZSIGMA)
+DEALLOCATE(ZM)
+DEALLOCATE(NM6)
+DEALLOCATE(NM3)
+DEALLOCATE(NM0)
+!
+END SUBROUTINE SALT2PPP
+!
+!! ############################################################
+ SUBROUTINE PPP2SALT1D( &
+ PSVT & !I [ppp] input scalar variables (moment of distribution)
+ , PRHODREF & !I [kg/m3] density of air
+ , PSIG1D & !O [-] standard deviation of aerosol distribution
+ , PRG1D & !O [um] number median diameter of aerosol distribution
+ , PN1D & !O [#/m3] number concentration of aerosols
+ , PMASS1D & !O [kg/m3] mass concentration of aerosol
+ , PM1D & !O aerosols moments 0, 3 and 6
+ )
+!! ############################################################
+!
+!!
+!! PURPOSE
+!! -------
+!! Translate the three moments M0, M3 and M6 given in ppp into
+!! Values which can be understood more easily (R, sigma, N, M)
+!!
+!! CALLING STRUCTURE NOTE: OPTIONAL VARIABLES
+!! -------
+!! CALL PPP2AEROS(PSVT, PRHODREF, PSIG3D=SIGVAR, &
+!! PRG3D=RVAR, PN3D=NVAR, PM3D=MASSVAR)
+!!
+!! REFERENCE
+!! ---------
+!! none
+!!
+!! AUTHOR
+!! ------
+!! Pierre TULET (LA)
+!!
+!! MODIFICATIONS
+!! -------------
+!! 2005 Alf Grini (CNRM)
+!! 2006 Jean-Pierre Chaboureau (LA)
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+ IMPLICIT NONE
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!* 0.1 declarations of arguments
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PSVT !I [ppp] first moment
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !I [kg/m3] density of air
+
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PSIG1D !O [-] standard deviation
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PRG1D !O [um] number median diameter
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PN1D !O [#/m3] number concentration
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PMASS1D !O [kg_{aer}/m3] mass concentration
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PM1D !O aerosols moments
+!
+!
+!* 0.2 declarations local variables
+!
+REAL :: ZRHOI ! [kg/m3] density of aerosol
+REAL :: ZMI ! [kg/mol] molar weight of aerosol
+REAL :: ZRGMIN ! [um] minimum radius accepted
+REAL :: ZSIGMIN ! minimum standard deviation accepted
+REAL,DIMENSION(:,:), ALLOCATABLE :: ZM ! [aerosol units] local array which goes to output later
+REAL,DIMENSION(:,:), ALLOCATABLE :: ZSV ! [sea salts moment concentration]
+REAL,DIMENSION(:), ALLOCATABLE :: ZSIGMA ! [-] standard deviation
+REAL,DIMENSION(:), ALLOCATABLE :: ZRG ! [um] number median diameter
+REAL,DIMENSION(:), ALLOCATABLE :: ZMMIN ! [aerosol units] minimum values for N, sigma, M
+INTEGER,DIMENSION(:), ALLOCATABLE :: NM0 ! [idx] index for Mode 0 in passed variables
+INTEGER,DIMENSION(:), ALLOCATABLE :: NM3 ! [idx] indexes for Mode 3 in passed variables
+INTEGER,DIMENSION(:), ALLOCATABLE :: NM6 ! [idx] indexes for Mode 6 in passed variables
+REAL,DIMENSION(:), ALLOCATABLE :: ZINIRADIUS ! initial mean radius
+INTEGER :: JN,IMODEIDX,JJ ! [idx] loop counters
+!
+!-------------------------------------------------------------------------------
+!
+! 1.1 initialisation
+!
+!Calculations here are for one mode only
+!
+ALLOCATE (NM0(NMODE_SLT))
+ALLOCATE (NM3(NMODE_SLT))
+ALLOCATE (NM6(NMODE_SLT))
+ALLOCATE (ZM(SIZE(PSVT,1), NMODE_SLT*3))
+ALLOCATE (ZMMIN(NMODE_SLT*3))
+ALLOCATE (ZSIGMA(SIZE(PSVT,1)))
+ALLOCATE (ZRG(SIZE(PSVT,1)))
+ALLOCATE (ZSV(SIZE(PSVT,1), SIZE(PSVT,2)))
+ALLOCATE (ZINIRADIUS(NMODE_SLT))
+
+!ZSV(:,:) = MAX(PSVT(:,:), XMNH_TINY)
+
+DO JN=1,NMODE_SLT
+ IMODEIDX = JPSALTORDER(JN)
+ !Calculations here are for one mode only
+ IF (CRGUNITS=="MASS") THEN
+ ZINIRADIUS(JN) = XINIRADIUS_SLT(IMODEIDX) * EXP(-3.*(LOG(XINISIG_SLT(IMODEIDX)))**2)
+ ELSE
+ ZINIRADIUS(JN) = XINIRADIUS_SLT(IMODEIDX)
+ END IF
+
+ !Set counter for number, M3 and M6
+ NM0(JN) = 1+(JN-1)*3
+ NM3(JN) = 2+(JN-1)*3
+ NM6(JN) = 3+(JN-1)*3
+ !Get minimum values possible
+ ZMMIN(NM0(JN)) = XN0MIN_SLT(IMODEIDX)
+ ZRGMIN = ZINIRADIUS(JN)
+ IF (LVARSIG_SLT) THEN
+ ZSIGMIN = XSIGMIN_SLT
+ ELSE
+ ZSIGMIN = XINISIG_SLT(IMODEIDX)
+ ENDIF
+ ZMMIN(NM3(JN)) = ZMMIN(NM0(JN)) * (ZRGMIN**3)*EXP(4.5 * LOG(ZSIGMIN)**2)
+ ZMMIN(NM6(JN)) = ZMMIN(NM0(JN)) * (ZRGMIN**6)*EXP(18. * LOG(ZSIGMIN)**2)
+END DO
+!
+!Set density of aerosol, here sea salt (kg/m3)
+ZRHOI = XDENSITY_SALT
+!Set molecular weight of sea salt !NOTE THAT THIS IS NOW IN KG
+ZMI = XMOLARWEIGHT_SALT
+!
+!
+DO JN=1,NMODE_SLT
+ !
+ IF (LVARSIG_SLT) THEN ! give M6 (case of variable standard deviation)
+ !
+ !Get number concentration (#/molec_{air}==>#/m3)
+ ZM(:,NM0(JN))= &
+ ZSV(:,1+(JN-1)*3) & !#/molec_{air}
+ * XAVOGADRO & !==>#/mole
+ / XMD & !==>#/kg_{air}
+ * PRHODREF(:) !==>#/m3
+ !
+ !calculate moment 3 from total aerosol mass (molec_{aer}/molec_{air} ==>
+ ZM(:,NM3(JN)) = &
+ ZSV(:,2+(JN-1)*3) & !molec_{aer}/molec_{aer}
+ * (ZMI/XMD) & !==>kg_{aer}/kg_{aer}
+ * PRHODREF(:) & !==>kg_{aer}/m3_{air}
+ * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air}
+ * XM3TOUM3_SALT & !==>um3_{aer}/m3_{air}
+ / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment)
+ !Limit mass concentration to minimum value
+ ZM(:,NM3(JN)) = MAX(ZM(:,NM3(JN)), ZMMIN(NM3(JN)))
+ !
+ ZM(:,NM6(JN)) = ZSV(:,3+(JN-1)*3) & !um6/molec_{air}*(cm3/m3)
+ * 1.d-6 & !==> um6/molec_{air}
+ * XAVOGADRO & !==> um6/mole_{air}
+ / XMD & !==> um6/kg_{air}
+ * PRHODREF(:) !==> um6/m3_{air}
+ !Limit m6 concentration to minimum value
+ ZM(:,NM6(JN)) = MAX(ZM(:,NM6(JN)), ZMMIN(NM6(JN)))
+ !
+ !Get sigma (only if sigma is allowed to vary)
+ !Get intermediate values for sigma M3^2/(M0*M6) (ORILAM paper, eqn 8)
+ ZSIGMA(:)=ZM(:,NM3(JN))**2/(ZM(:,NM0(JN))*ZM(:,NM6(JN)))
+ !Limit the intermediate value, can not be larger than 1
+ ZSIGMA(:)=MIN(1-1E-10,ZSIGMA(:))
+ !Limit the value for intermediate, can not be smaller than 0
+ ZSIGMA(:)=MAX(1E-10,ZSIGMA(:))
+ !Calculate log(sigma)
+ ZSIGMA(:)= LOG(ZSIGMA(:))
+ !Finally get the real sigma the negative sign is because of
+ !The way the equation is written (M3^2/(M0*M6)) instead of (M0*M6)/M3^3
+ ZSIGMA(:)= EXP(1./3.*SQRT(-ZSIGMA(:)))
+ !Limit the value to reasonable ones
+ ZSIGMA(:) = MAX( XSIGMIN_SLT, MIN( XSIGMAX_SLT, ZSIGMA(:) ) )
+
+ !
+ !Put back M6 so that it fits the sigma which is possibly modified above
+ !The following makes M6 consistent with N, R, SIGMA
+ ZM(:,NM6(JN)) = ZM(:,NM0(JN)) &
+ * ( (ZM(:,NM3(JN))/ZM(:,NM0(JN)))**(1./3.) &
+ * exp(-(3./2.)*log(ZSIGMA(:))**2))**6 &
+ * exp(18.*log(ZSIGMA(:))**2)
+
+ ELSE ! compute M6 from M0, M3 and SIGMA
+ !
+ ZSIGMA(:) = XINISIG_SLT(JPSALTORDER(JN))
+ IF (LRGFIX_SLT) THEN
+
+ !calculate moment 3 from total aerosol mass (molec_{aer}/molec_{air} ==>
+ ZM(:,NM3(JN)) = &
+ ZSV(:,JN) & !molec_{aer}/molec_{aer}
+ * (ZMI/XMD) & !==>kg_{aer}/kg_{aer}
+ * PRHODREF(:) & !==>kg_{aer}/m3_{air}
+ * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air}
+ * XM3TOUM3_SALT & !==>um3_{aer}/m3_{air}
+ / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment)
+ ZM(:,NM3(JN)) = MAX(ZM(:,NM3(JN)), ZMMIN(NM3(JN)))
+
+ ZM(:,NM0(JN))= ZM(:,NM3(JN))/&
+ ((ZINIRADIUS(JN)**3)*EXP(4.5 * LOG(XINISIG_SLT(JPSALTORDER(JN)))**2))
+
+ ELSE
+
+ !calculate moment 3 from total aerosol mass (molec_{aer}/molec_{air} ==>
+ ZM(:,NM3(JN)) = &
+ ZSV(:,2+(JN-1)*2) & !molec_{aer}/molec_{aer}
+ * (ZMI/XMD) & !==>kg_{aer}/kg_{aer}
+ * PRHODREF(:) & !==>kg_{aer}/m3_{air}
+ * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air}
+ * XM3TOUM3_SALT & !==>um3_{aer}/m3_{air}
+ / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment)
+
+
+ !Get number concentration (#/molec_{air}==>#/m3)
+ ZM(:,NM0(JN))= &
+ ZSV(:,1+(JN-1)*2) & !#/molec_{air}
+ * XAVOGADRO & !==>#/mole
+ / XMD & !==>#/kg_{air}
+ * PRHODREF(:) !==>#/m3
+
+ ! Limit concentration to minimum values
+ WHERE ((ZM(:,NM0(JN)) < ZMMIN(NM0(JN)) ).OR. &
+ (ZM(:,NM3(JN)) < ZMMIN(NM3(JN)) ))
+ ZM(:,NM0(JN)) = ZMMIN(NM0(JN))
+ ZM(:,NM3(JN)) = ZMMIN(NM3(JN))
+ PSVT(:,1+(JN-1)*2) = ZM(:,NM0(JN)) * XMD / &
+ (XAVOGADRO * PRHODREF(:) )
+ PSVT(:,2+(JN-1)*2) = ZM(:,NM3(JN)) * XMD * XPI * 4./3. * ZRHOI / &
+ (ZMI*PRHODREF(:)*XM3TOUM3_SALT)
+ ENDWHERE
+
+ END IF
+
+ ZM(:,NM6(JN)) = ZM(:,NM0(JN)) &
+ * ( (ZM(:,NM3(JN))/ZM(:,NM0(JN)))**(1./3.) &
+ * exp(-(3./2.)*log(ZSIGMA(:))**2))**6 &
+ * exp(18.*log(ZSIGMA(:))**2)
+
+ !
+ END IF
+ !
+ !Get number median radius (eqn. 7 in Orilam manuscript)
+ ZRG(:)= &
+ ( &
+ ZM(:,NM3(JN))*ZM(:,NM3(JN))*ZM(:,NM3(JN))*ZM(:,NM3(JN)) &
+ /(ZM(:,NM6(JN))*ZM(:,NM0(JN))*ZM(:,NM0(JN))*ZM(:,NM0(JN))) &
+ ) &
+ ** XSIXTH_SALT
+ !ZRG(:)=MIN(ZRG(:),ZINIRADIUS(JN))
+ !Give the sigma-values to the passed array
+ IF(PRESENT(PSIG1D)) PSIG1D(:,JN) = ZSIGMA(:)
+ !
+ !Set the number concentrations in the passed array
+ IF(PRESENT(PN1D)) PN1D(:,JN) = ZM(:,NM0(JN))
+ !
+ !Get the number median radius
+ IF(PRESENT(PRG1D)) PRG1D(:,JN)= ZRG(:)
+ !
+ IF(PRESENT(PMASS1D))THEN
+ PMASS1D(:,JN)= &
+ ZM(:,NM0(JN)) & !#/m^3_{air}
+ * XPI*4./3. &
+ * ZRHOI & !==>kg/m^3_{aeros}/m^3_{air}
+ * ZRG(:) * ZRG(:) * ZRG(:) &
+ * XUM3TOM3_SALT & !==>kg/m^3_{air}
+ * exp(4.5*log(ZSIGMA(:))*log(ZSIGMA(:)))
+ ENDIF
+!
+END DO !Loop on modes
+!
+IF(PRESENT(PM1D)) PM1D(:,:) = ZM(:,:)
+!
+DEALLOCATE(ZINIRADIUS)
+DEALLOCATE(ZSV)
+DEALLOCATE(ZRG)
+DEALLOCATE(ZSIGMA)
+DEALLOCATE(ZMMIN)
+DEALLOCATE(ZM)
+DEALLOCATE(NM6)
+DEALLOCATE(NM3)
+DEALLOCATE(NM0)
+!
+END SUBROUTINE PPP2SALT1D
+
+!! ############################################################
+END MODULE MODE_SALT_PSD_WET
diff --git a/src/MNH/mode_saltopt.f90 b/src/MNH/mode_saltopt.f90
index ac1b4099d92e0dd752a1e5460a39f8ba41587e0d..d7fd28f3f1912d0a897de0aa93aebc050b6a761a 100644
--- a/src/MNH/mode_saltopt.f90
+++ b/src/MNH/mode_saltopt.f90
@@ -14,8 +14,11 @@
!! PURPOSE
!! -------
!!
+!! MODIFICATIONS
+!! -------------
!!
-
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+!
IMPLICIT NONE
PUBLIC
PRIVATE :: SALTOPT_LKT
@@ -27,6 +30,9 @@ CONTAINS
PSVT & !I [moments/molec_{air}] Transported moments of sea salts
,PZZ & !I [m] height of layers
,PRHODREF & !I [kg/m3] density of air
+ ,PTHT &
+ ,PPABST &
+ ,PRT &
,PPIZA_WVL & !O [-] single scattering albedo of sea salt layer for all SW wavelengths
,PCGA_WVL & !O [-] assymetry factor for sea salt layer for all SW wavelengths
,PTAUREL_WVL & !O [-] opt.depth/opt.depth(550) for sea salt layer for all SW wvl
@@ -35,14 +41,18 @@ CONTAINS
)
- USE MODE_SALT_PSD !Conversion procedures from moments to radius, ,number, mass and sigma
+ USE MODE_SALT_PSD_WET !Conversion procedures from moments to radius, ,number, mass and sigma
+ USE MODE_SALT_PSD
USE MODD_SALT, ONLY : NMODE_SLT
+
IMPLICIT NONE
!INPUT
REAL, DIMENSION(:,:,:,:),INTENT(IN) :: PSVT !I [moments/molec_{air}] transported moments of sea salt
REAL, DIMENSION(:,:,:),INTENT(IN) :: PZZ !I [m] height of layers
REAL, DIMENSION(:,:,:),INTENT(IN) :: PRHODREF !I [kg/m3] density of air
+ REAL, DIMENSION(:,:,:),INTENT(IN) :: PTHT, PPABST !I
+ REAL, DIMENSION(:,:,:,:),INTENT(IN) :: PRT
INTEGER, INTENT(IN) :: KSWB !I [nbr] number of shortwave wavelengths
REAL, PARAMETER :: EPSILON=1.e-8 !a very low number for optical depth in a layer
@@ -57,6 +67,7 @@ CONTAINS
REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3), NMODE_SLT) :: ZMASS ![kg/m3] mass of one sea salt mode
REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3), NMODE_SLT) :: ZRADIUS ![um] number median radius of one sea salt mode
REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3), NMODE_SLT) :: ZSIGMA ![-] dispersion coefficient one sea salt mode
+ REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3), NMODE_SLT) :: ZDENSITY ![-] [g/m2] density of wet aerosol (water + sea salt)
REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: ZTAU550_MDE ![-] opt.depth 550nm one mode
REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:) :: ZTAU_WVL_MDE ![-] opt.depth @ wvl, one mode
REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:) :: ZPIZA_WVL_MDE ![-] single scattering albedo @ wvl, one mode
@@ -70,15 +81,26 @@ CONTAINS
ALLOCATE(ZCGA_WVL_MDE(SIZE(PTAU550,1),SIZE(PTAU550,2),SIZE(PTAU550,3),KSWB,NMODE_SLT))
ZSVT(:,:,:,:)=PSVT(:,:,:,:)
-
- CALL PPP2SALT( &
+ CALL PPP2SALT_WET( &
ZSVT & !I [moments/molec_{air}] moments of sea salt for all modes
,PRHODREF & !I [kg/m3] air density
+ ,PPABST & !I Pression
+ ,PTHT & !I Potential temperature
+ ,PRT & !I Large scale vapor mixing ratio
,PSIG3D=ZSIGMA & !O [-] dispersion coefficient
,PRG3D=ZRADIUS & !O [um] number median radius
,PMASS3D=ZMASS & !O [kg/m3] mass of sea salt
+ ,PDENSITY_WET=ZDENSITY & !0 [g/m2] density of wet aerosol (water + salt)
)
-
+
+! CALL PPP2SALT( &
+! ZSVT & !I [moments/molec_{air}] moments of sea salt for all modes
+! ,PRHODREF & !I [kg/m3] air density
+! ,PSIG3D=ZSIGMA & !O [-] dispersion coefficient
+! ,PRG3D=ZRADIUS & !O [um] number median radius
+! ,PMASS3D=ZMASS & !O [kg/m3] mass of sea salt
+! )
+
DO JMDE=1,NMODE_SLT
!Get sea salt optical properties from look up tables
CALL SALTOPT_LKT( &
diff --git a/src/MNH/mode_thermo.f90 b/src/MNH/mode_thermo.f90
index 0808d39a4b9cbadea35de72d797845beacaed8d2..36f4d593a2c798021ca2fe939744710aaf19893d 100644
--- a/src/MNH/mode_thermo.f90
+++ b/src/MNH/mode_thermo.f90
@@ -34,13 +34,22 @@
!! Original 28/08/94
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! J.Escobar : 5/10/2018 : add FLUSH , for better logging in case of PB
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!--------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
!-------------------------------------------------------------------------------
-!
+
+use mode_msg
+
+implicit none
+
+private
+
+public :: DQSAT, DQSATI, QSAT, QSATI, SM_FOES, SM_PMR_HU
+
INTERFACE SM_FOES
MODULE PROCEDURE SM_FOES_0D
MODULE PROCEDURE SM_FOES_1D
@@ -378,8 +387,7 @@ IF ( ANY(ZDT > ZEPS) ) THEN
WRITE(ILUOUT,*) 'T AT THIS MAXIMUM : ', ZT(IMAXLOC(1),IMAXLOC(2),IMAXLOC(3))
WRITE(ILUOUT,*) 'JOB ABORTED '
FLUSH(unit=ILUOUT)
- CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'SM_PMR_HU_3D', 'failed to converge' )
END IF
!-------------------------------------------------------------------------------
END FUNCTION SM_PMR_HU_3D
@@ -517,8 +525,7 @@ IF (ANY(ZDT>ZEPS)) THEN
WRITE(ILUOUT,*) 'MR AT THIS MAXIMUM : ', PMR(IMAXLOC)
WRITE(ILUOUT,*) 'T AT THIS MAXIMUM : ', ZT(IMAXLOC)
WRITE(ILUOUT,*) 'JOB ABORTED '
- CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'SM_PMR_HU_1D', 'failed to converge' )
END IF
!-------------------------------------------------------------------------------
END FUNCTION SM_PMR_HU_1D
diff --git a/src/MNH/mode_time.f90 b/src/MNH/mode_time.f90
index 1ac45c254ee85ff96bb61d6e4419c52aff71671d..0f71113f9732af5805bcaf076a82aab890f3862a 100644
--- a/src/MNH/mode_time.f90
+++ b/src/MNH/mode_time.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 @@
!* 0. DECLARATIONS
! ------------
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_TIME
!
IMPLICIT NONE
diff --git a/src/MNH/mode_tmat.f90 b/src/MNH/mode_tmat.f90
index f0c98a7996ea3d97e45656b168eb4664307f35f5..9de6651339a1a9b187f10cde8f36629bf357b551 100644
--- a/src/MNH/mode_tmat.f90
+++ b/src/MNH/mode_tmat.f90
@@ -15,7 +15,9 @@
!
! Modif par Olivier Caumont (04/2008) pour interfaçage avec diagnostic
! radar de Méso-NH.
-! P. Wautelet 22/01/2019: replace double precision declarations by real(kind(0.0d0)) (to allow compilation by NAG compiler)
+! P. Wautelet 22/01/2019: replace double precision declarations by real(kind(0.0d0)) (to allow compilation by NAG compiler)
+! P. Wautelet 22/02/2019: add kind parameter for CMPLX intrinsics (if not it default to single precision)
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!
!****************************************************************************
@@ -292,6 +294,8 @@
XIT11,XIT12,XIT21,XIT22,&
XTR1,XTI1,NPN1,NPNG1,NPNG2,NPN2,NPN4,NPN6
+ use mode_msg
+
IMPLICIT REAL*8 (A-H,O-Z)
!! Parameter (NPN1=200, NPNG1=600, NPNG2=2*NPNG1, NPN2=2*NPN1,&
@@ -553,7 +557,7 @@
INM1=MAX0(4,IXXX)
!C IF (INM1.GE.NPN1)WRITE(10,7333) NPN1
- IF (INM1.GE.NPN1) STOP
+ if ( INM1 >= NPN1 ) call Print_msg( NVERB_FATAL, 'GEN', 'TMD', 'INM1 >= NPN1' )
! 7333 FORMAT('CONVERGENCE IS NOT OBTAINED FOR NPN1=',I3, &
! '. EXECUTION TERMINATED')
@@ -569,12 +573,9 @@
NMAX=NMA
!c MMAX=1
NGAUSS=NMAX*NDGS
-
-!C IF (NGAUSS.GT.NPNG1) WRITE(10,7340) NGAUSS
- IF (NGAUSS.GT.NPNG1) STOP
-
-!c 7340 FORMAT('NGAUSS =',I3,' I.E. IS GREATER THAN NPNG1.',
-!c & ' EXECUTION TERMINATED')
+
+ if ( NGAUSS > NPNG1 ) call Print_msg( NVERB_FATAL, 'GEN', 'TMD', 'NGAUSS > NPNG1' )
+
!c 7334 FORMAT(' NMAX =', I3,' DSCA=',D8.2,' DEXT=',D8.2)
CALL CONST(NGAUSS,NMAX,X,W,AN,ANN,S,SS)
@@ -614,7 +615,7 @@
IF(.not.(DSCA.LE.DDELT.AND.DEXT.LE.DDELT)) THEN
!C IF (NMA.EQ.NPN1) WRITE(10,7333) NPN1
- IF (NMA.EQ.NPN1) STOP
+ if ( NMA == NPN1 ) call Print_msg( NVERB_FATAL, 'GEN', 'TMD', 'NMA == NPN1' )
ELSE
SORTIE1=.TRUE.
ENDIF
@@ -1189,12 +1190,9 @@
TL1.LT.0D0.OR.TL1.GT.180D0.OR.&
PL.LT.0D0.OR.PL.GT.360D0.OR.&
PL1.LT.0D0.OR.PL1.GT.360D0) THEN
-!C WRITE (10,2000)
- STOP
- ENDIF
+ call Print_msg( NVERB_FATAL, 'GEN', 'AMPL', 'an angular parameter is outside its allowable range' )
+ END IF
-! 2000 FORMAT ('AN ANGULAR PARAMETER IS OUTSIDE ITS',&
-! ' ALLOWABLE RANGE')
PIN=ACOS(-1D0)
PIN2=PIN*0.5D0
@@ -1388,8 +1386,8 @@
DV1N=M*DV1(N)
DV2N=DV2(N)
- CT11=CMPLX(XRT11(M1,N,NN),XIT11(M1,N,NN))
- CT22=CMPLX(XRT22(M1,N,NN),XIT22(M1,N,NN))
+ CT11=CMPLX(XRT11(M1,N,NN),XIT11(M1,N,NN),kind=kind(CT11))
+ CT22=CMPLX(XRT22(M1,N,NN),XIT22(M1,N,NN),kind=kind(CT22))
IF (M.EQ.0) THEN
@@ -1400,8 +1398,8 @@
ELSE
- CT12=CMPLX(XRT12(M1,N,NN),XIT12(M1,N,NN))
- CT21=CMPLX(XRT21(M1,N,NN),XIT21(M1,N,NN))
+ CT12=CMPLX(XRT12(M1,N,NN),XIT12(M1,N,NN),kind=kind(CT12))
+ CT21=CMPLX(XRT21(M1,N,NN),XIT21(M1,N,NN),kind=kind(CT21))
CN1=CAL(N,NN)*FC
CN2=CAL(N,NN)*FS
@@ -1635,10 +1633,8 @@
ENDDO
-!C IF (NMAX.GT.NPN1) WRITE (10,9000) NMAX,NPN1
- IF (NMAX.GT.NPN1) STOP
+ if ( NMAX > NPN1 ) call Print_msg( NVERB_FATAL, 'GEN', 'VARY', 'NMAX > NPN1' )
- 9000 FORMAT(' NMAX = ',I2,', i.e., greater than ',I3)
TB=TA*SQRT(MRR*MRR+MRI*MRI)
TB=MAX(TB,FLOAT(NMAX))
NNMAX1=1.2D0*SQRT(MAX(TA,FLOAT(NMAX)))+3D0
diff --git a/src/MNH/mode_zsrpun.f90 b/src/MNH/mode_zsrpun.f90
index 6cf8a8dfd9e8ffc2df39f40e9aa63edf4e73fbd4..efdc85450a9ce233526065f66de8779cc482433f 100644
--- a/src/MNH/mode_zsrpun.f90
+++ b/src/MNH/mode_zsrpun.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 mode 2006/05/18 13:07:25
-!-----------------------------------------------------------------
MODULE mode_zsrpun
USE modd_glo
@@ -28,6 +23,7 @@ MODULE mode_zsrpun
! by Betty Pun, Nov, 99. A file with xi at given Aw
! is included binsolu.h
! 4. Rewritten to FORTRAN90 by Alf Grini (alf.grini@cnrm.meteo.fr)
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!
!***************************************************************************/
@@ -44,7 +40,9 @@ CONTAINS
)
USE modd_binsolu
-
+
+ use mode_msg
+
IMPLICIT NONE
!INPUT
@@ -82,10 +80,7 @@ CONTAINS
!Start code
IF (ZSRFLAG.eq.0)THEN
-!callabortstop
-CALL ABORT
- stop "ZSRFLAG=0 not implemented yet"
-
+ call Print_msg( NVERB_FATAL, 'GEN', 'ZSRPUN', 'ZSRFLAG=0 not yet implemented' )
ELSE ! zsrflag = 1
!Get the total moles (umole/m3) of the main components,
diff --git a/src/MNH/modeln.f90 b/src/MNH/modeln.f90
index 1c8abe91120eca715e35c61edd952276b2d95bda..6f1f14dadc2d1211746f821d26fa711514fd37ed 100644
--- a/src/MNH/modeln.f90
+++ b/src/MNH/modeln.f90
@@ -62,7 +62,7 @@ END MODULE MODI_MODEL_n
!!
!! EXTERNAL
!! --------
-!! Subroutine IO_FILE_OPEN_ll: to open a file
+!! Subroutine IO_File_open: to open a file
!! Subroutine WRITE_DESFM: to write the descriptive part of a FMfile
!! Subroutine WRITE_LFIFM: to write the binary part of a FMfile
!! Subroutine SET_MASK : to compute all the masks selected for budget
@@ -89,7 +89,7 @@ END MODULE MODI_MODEL_n
!! compute the large scale fields, used to
!! couple Model_n with outer informations.
!! Subroutine ENDSTEP_BUDGET: writes the budget informations.
-!! Subroutine IO_FILE_CLOSE_ll: closes a file
+!! Subroutine IO_File_close: closes a file
!! Subroutine DATETIME_CORRECTDATE: transform the current time in GMT
!! Subroutine FORCING : computes forcing terms
!! Subroutine ADD3DFIELD_ll : add a field to 3D-list
@@ -253,6 +253,12 @@ END MODULE MODI_MODEL_n
!! 01/2018 (C.Lac) Add VISCOSITY
!! 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 07/02/2019: remove OPARALLELIO argument from open and close files subroutines
+! (nsubfiles_ioz is now determined in IO_File_add2list)
+!! 02/2019 C.Lac 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 28/03/2019: use MNHTIME for time measurement variables
+! P. Wautelet 28/03/2019: use TFILE instead of unit number for set_iluout_timing
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -291,7 +297,7 @@ USE MODD_GET_n
USE MODD_GRID, ONLY: XLONORI,XLATORI
USE MODD_GRID_n
USE MODD_ICE_C1R3_DESCR, ONLY: XRTMIN_C1R3=>XRTMIN
-USE MODD_IO_ll, ONLY: LIO_NO_WRITE, TFILEDATA,TFILE_SURFEX,TFILE_DUMMY
+USE MODD_IO, ONLY: LIO_NO_WRITE, TFILEDATA, TFILE_SURFEX, TFILE_DUMMY
USE MODD_LBC_n
USE MODD_LES
USE MODD_LES_BUDGET
@@ -321,6 +327,7 @@ USE MODD_PARAM_MFSHALL_n
USE MODD_PARAM_n
USE MODD_PAST_FIELD_n
USE MODD_PRECIP_n
+use modd_precision, only: MNHTIME
USE MODD_PROFILER_n
USE MODD_RADIATIONS_n, ONLY: XTSRAD,XSCAFLASWD,XDIRFLASWD,XDIRSRFSWD, XAER, XDTHRAD
USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
@@ -338,11 +345,11 @@ USE MODD_TURB_n
!
USE MODE_DATETIME
USE MODE_ELEC_ll
-USE MODE_FM
USE MODE_GRIDCART
USE MODE_GRIDPROJ
-USE MODE_IO_ll
-USE MODE_IO_WRITE_FIELD
+USE MODE_IO_FIELD_WRITE, only: IO_Field_user_write, IO_Fieldlist_write, IO_Header_write
+USE MODE_IO_FILE, only: IO_File_close, IO_File_open
+USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
USE MODE_ll
USE MODE_MNH_TIMING
USE MODE_MODELN_HANDLER
@@ -438,9 +445,8 @@ INTEGER :: IVERB ! LFI verbosity level
LOGICAL :: GSTEADY_DMASS ! conditional call to mass computation
!
! for computing time analysis
-REAL*8,DIMENSION(2) :: ZTIME,ZTIME1,ZTIME2,ZEND,ZTOT,ZALL,ZTOT_PT
-!
-REAL*8,DIMENSION(2) :: ZTIME_STEP,ZTIME_STEP_PTS
+REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME, ZTIME1, ZTIME2, ZEND, ZTOT, ZALL, ZTOT_PT
+REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME_STEP,ZTIME_STEP_PTS
CHARACTER :: YMI
INTEGER :: IPOINTS
CHARACTER(len=16) :: YTCOUNT,YPOINTS
@@ -495,6 +501,7 @@ REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XLBXRM,DPTR_XLBYRM
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XZZ
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLSUM,DPTR_XLSVM,DPTR_XLSWM,DPTR_XLSTHM,DPTR_XLSRVM
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLSUS,DPTR_XLSVS,DPTR_XLSWS,DPTR_XLSTHS,DPTR_XLSRVS
+REAL, DIMENSION(:,:), POINTER :: DPTR_XLSZWSM,DPTR_XLSZWSS
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXUS,DPTR_XLBYUS,DPTR_XLBXVS,DPTR_XLBYVS
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXWS,DPTR_XLBYWS,DPTR_XLBXTHS,DPTR_XLBYTHS
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXTKES,DPTR_XLBYTKES
@@ -632,9 +639,9 @@ IF (KTCOUNT == 1) THEN
IOUT=0
!
IF ( .NOT. LIO_NO_WRITE ) THEN
- CALL IO_FILE_OPEN_ll(TDIAFILE)
+ CALL IO_File_open(TDIAFILE)
!
- CALL IO_WRITE_HEADER(TDIAFILE)
+ CALL IO_Header_write(TDIAFILE)
CALL WRITE_DESFM_n(IMI,TDIAFILE)
CALL WRITE_LFIFMN_FORDIACHRO_n(TDIAFILE)
END IF
@@ -670,6 +677,7 @@ IF (KTCOUNT == 1) THEN
CALL ADD3DFIELD_ll(TZLSFIELD_ll, XLSVM)
CALL ADD3DFIELD_ll(TZLSFIELD_ll, XLSWM)
CALL ADD3DFIELD_ll(TZLSFIELD_ll, XLSTHM)
+ CALL ADD2DFIELD_ll(TZLSFIELD_ll, XLSZWSM)
IF (NRR >= 1) THEN
CALL ADD3DFIELD_ll(TZLSFIELD_ll, XLSRVM)
ENDIF
@@ -699,51 +707,52 @@ IF (KTCOUNT == 1) THEN
!
IF ( LSTEADYLS ) THEN
CALL UPDATE_HALO_ll(TZLSFIELD_ll, IINFO_ll)
+ CALL DEL2DFIELD_ll(TZLSFIELD_ll,XLSZWSM,IINFO_ll)
CALL UPDATE_HALO2_ll(TZLSFIELD_ll, TZLSHALO2_ll, IINFO_ll)
END IF
END IF
!
!
!
- XT_START = 0.0
- !
- XT_STORE = 0.0
- XT_BOUND = 0.0
- XT_GUESS = 0.0
- XT_FORCING = 0.0
- XT_NUDGING = 0.0
- XT_ADV = 0.0
- XT_ADVUVW = 0.0
- XT_GRAV = 0.0
- XT_SOURCES = 0.0
+ XT_START = 0.0_MNHTIME
+ !
+ XT_STORE = 0.0_MNHTIME
+ XT_BOUND = 0.0_MNHTIME
+ XT_GUESS = 0.0_MNHTIME
+ XT_FORCING = 0.0_MNHTIME
+ XT_NUDGING = 0.0_MNHTIME
+ XT_ADV = 0.0_MNHTIME
+ XT_ADVUVW = 0.0_MNHTIME
+ XT_GRAV = 0.0_MNHTIME
+ XT_SOURCES = 0.0_MNHTIME
!
- XT_DIFF = 0.0
- XT_RELAX = 0.0
- XT_PARAM = 0.0
- XT_SPECTRA = 0.0
- XT_HALO = 0.0
- XT_VISC = 0.0
- XT_RAD_BOUND = 0.0
- XT_PRESS = 0.0
+ XT_DIFF = 0.0_MNHTIME
+ XT_RELAX = 0.0_MNHTIME
+ XT_PARAM = 0.0_MNHTIME
+ XT_SPECTRA = 0.0_MNHTIME
+ XT_HALO = 0.0_MNHTIME
+ XT_VISC = 0.0_MNHTIME
+ XT_RAD_BOUND = 0.0_MNHTIME
+ XT_PRESS = 0.0_MNHTIME
!
- XT_CLOUD = 0.0
- XT_STEP_SWA = 0.0
- XT_STEP_MISC = 0.0
- XT_COUPL = 0.0
- XT_1WAY = 0.0
- XT_STEP_BUD = 0.0
+ XT_CLOUD = 0.0_MNHTIME
+ XT_STEP_SWA = 0.0_MNHTIME
+ XT_STEP_MISC = 0.0_MNHTIME
+ XT_COUPL = 0.0_MNHTIME
+ XT_1WAY = 0.0_MNHTIME
+ XT_STEP_BUD = 0.0_MNHTIME
!
- XT_RAD = 0.0
- XT_DCONV = 0.0
- XT_GROUND = 0.0
- XT_TURB = 0.0
- XT_MAFL = 0.0
- XT_DRAG = 0.0
- XT_TRACER = 0.0
- XT_SHADOWS = 0.0
- XT_ELEC = 0.0
- XT_CHEM = 0.0
- XT_2WAY = 0.0
+ XT_RAD = 0.0_MNHTIME
+ XT_DCONV = 0.0_MNHTIME
+ XT_GROUND = 0.0_MNHTIME
+ XT_TURB = 0.0_MNHTIME
+ XT_MAFL = 0.0_MNHTIME
+ XT_DRAG = 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
!
END IF
!
@@ -796,11 +805,13 @@ IF (IMI/=1 .AND. NDAD(IMI)/=IMI .AND. (ISYNCHRO==1 .OR. NDTRATIO(IMI) == 1) ) TH
DPTR_XLSUM=>XLSUM
DPTR_XLSVM=>XLSVM
DPTR_XLSWM=>XLSWM
+ DPTR_XLSZWSM=>XLSZWSM
DPTR_XLSTHS=>XLSTHS
DPTR_XLSRVS=>XLSRVS
DPTR_XLSUS=>XLSUS
DPTR_XLSVS=>XLSVS
DPTR_XLSWS=>XLSWS
+ DPTR_XLSZWSS=>XLSZWSS
!
IF ( LSTEADYLS ) THEN
NCPL_CUR=0
@@ -815,8 +826,8 @@ IF (IMI/=1 .AND. NDAD(IMI)/=IMI .AND. (ISYNCHRO==1 .OR. NDTRATIO(IMI) == 1) ) TH
DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4,DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4, &
NDXRATIO_ALL(IMI),NDYRATIO_ALL(IMI), &
DPTR_CLBCX,DPTR_CLBCY,DPTR_XZZ,DPTR_XZHAT,LSLEVE,XLEN1,XLEN2,DPTR_XCOEFLIN_LBXM, &
- DPTR_XLSTHM,DPTR_XLSRVM,DPTR_XLSUM,DPTR_XLSVM,DPTR_XLSWM, &
- DPTR_XLSTHS,DPTR_XLSRVS,DPTR_XLSUS,DPTR_XLSVS,DPTR_XLSWS )
+ DPTR_XLSTHM,DPTR_XLSRVM,DPTR_XLSUM,DPTR_XLSVM,DPTR_XLSWM,DPTR_XLSZWSM, &
+ DPTR_XLSTHS,DPTR_XLSRVS,DPTR_XLSUS,DPTR_XLSVS,DPTR_XLSWS, DPTR_XLSZWSS )
END IF
END IF
!
@@ -939,10 +950,10 @@ IF (IBAK < NBAK_NUMB ) THEN
TZBAKFILE => TBACKUPN(IBAK)%TFILE
IVERB = TZBAKFILE%NLFIVERB
!
- CALL IO_FILE_OPEN_ll(TZBAKFILE)
+ CALL IO_File_open(TZBAKFILE)
!
CALL WRITE_DESFM_n(IMI,TZBAKFILE)
- CALL IO_WRITE_HEADER(TBACKUPN(IBAK)%TFILE)
+ CALL IO_Header_write(TBACKUPN(IBAK)%TFILE)
CALL WRITE_LFIFM_n(TBACKUPN(IBAK)%TFILE,TBACKUPN(IBAK)%TFILE%TDADFILE%CNAME)
TOUTDATAFILE => TZBAKFILE
CALL MNHWRITE_ZS_DUMMY_n(TZBAKFILE)
@@ -982,13 +993,13 @@ IF (IOUT < NOUT_NUMB ) THEN
!
TZOUTFILE => TOUTPUTN(IOUT)%TFILE
!
- CALL IO_FILE_OPEN_ll(TZOUTFILE)
+ CALL IO_File_open(TZOUTFILE)
!
- CALL IO_WRITE_HEADER(TZOUTFILE)
- CALL IO_WRITE_FIELDLIST(TOUTPUTN(IOUT))
- CALL IO_WRITE_FIELD_USER(TOUTPUTN(IOUT))
+ CALL IO_Header_write(TZOUTFILE)
+ CALL IO_Fieldlist_write(TOUTPUTN(IOUT))
+ CALL IO_Field_user_write(TOUTPUTN(IOUT))
!
- CALL IO_FILE_CLOSE_ll(TZOUTFILE)
+ CALL IO_File_close(TZOUTFILE)
!
END IF
END IF
@@ -1402,10 +1413,10 @@ IF (.NOT. LSTEADYLS) THEN
NSIZELBX_ll,NSIZELBXU_ll,NSIZELBY_ll,NSIZELBYV_ll, &
NSIZELBXTKE_ll,NSIZELBYTKE_ll, &
NSIZELBXR_ll,NSIZELBYR_ll,NSIZELBXSV_ll,NSIZELBYSV_ll, &
- XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM,XDRYMASST, &
+ XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM,XLSZWSM,XDRYMASST, &
XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM, &
XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
- XLSUS,XLSVS,XLSWS,XLSTHS,XLSRVS,XDRYMASSS, &
+ XLSUS,XLSVS,XLSWS,XLSTHS,XLSRVS,XLSZWSS,XDRYMASSS, &
XLBXUS,XLBXVS,XLBXWS,XLBXTHS,XLBXTKES,XLBXRS,XLBXSVS, &
XLBYUS,XLBYVS,XLBYWS,XLBYTHS,XLBYTKES,XLBYRS,XLBYSVS )
!
@@ -1788,7 +1799,7 @@ IF (CCLOUD /= 'NONE' .AND. CELEC == 'NONE') THEN
XINPRS, XINPRG,XINPRH, &
! XSOLORG, XMI,ZSPEEDC, ZSPEEDR, ZSPEEDS, ZSPEEDG, ZSPEEDH, &
XSOLORG, XMI, &
- XINDEP, XSUPSAT, XNACT, XNPRO,XSSPRO, &
+ XINDEP, XSUPSAT, XNACT, XNPRO,XSSPRO, XRAINFR, &
ZSEA, ZTOWN )
DEALLOCATE(ZTOWN)
ELSE
@@ -1809,7 +1820,7 @@ IF (CCLOUD /= 'NONE' .AND. CELEC == 'NONE') THEN
XINPRS, XINPRG,XINPRH, &
! XSOLORG, XMI,ZSPEEDC, ZSPEEDR, ZSPEEDS, ZSPEEDG, ZSPEEDH, &
XSOLORG, XMI, &
- XINDEP, XSUPSAT, XNACT, XNPRO,XSSPRO )
+ XINDEP, XSUPSAT, XNACT, XNPRO,XSSPRO, XRAINFR )
END IF
XRTHS_CLD = XRTHS - XRTHS_CLD
XRRS_CLD = XRRS - XRRS_CLD
@@ -1966,16 +1977,16 @@ CALL ENDSTEP ( XTSTEP,NRR,NSV,KTCOUNT,IMI, &
XRUS,XRVS,XRWS,XDRYMASSS, &
XRTHS,XRRS,XRTKES,XRSVS, &
XLSUS,XLSVS,XLSWS, &
- XLSTHS,XLSRVS, &
+ XLSTHS,XLSRVS,XLSZWSS, &
XLBXUS,XLBXVS,XLBXWS, &
XLBXTHS,XLBXRS,XLBXTKES,XLBXSVS, &
XLBYUS,XLBYVS,XLBYWS, &
XLBYTHS,XLBYRS,XLBYTKES,XLBYSVS, &
- XUM,XVM,XWM, &
+ XUM,XVM,XWM,XZWS, &
XUT,XVT,XWT,XPABST,XDRYMASST, &
XTHT, XRT, XTHM, XRCM, XPABSM,XTKET, XSVT,&
XLSUM,XLSVM,XLSWM, &
- XLSTHM,XLSRVM, &
+ XLSTHM,XLSRVM,XLSZWSM, &
XLBXUM,XLBXVM,XLBXWM, &
XLBXTHM,XLBXRM,XLBXTKEM,XLBXSVM, &
XLBYUM,XLBYVM,XLBYWM, &
@@ -2060,7 +2071,7 @@ XT_STEP_BUD = XT_STEP_BUD + ZTIME2 - ZTIME1 + XTIME_BU
!
IF (GCLOSE_OUT) THEN
GCLOSE_OUT=.FALSE.
- CALL IO_FILE_CLOSE_ll(TZBAKFILE)
+ CALL IO_File_close(TZBAKFILE)
END IF
!
!-------------------------------------------------------------------------------
@@ -2096,17 +2107,17 @@ IF (OEXIT) THEN
CALL WRITE_LES_n(TDIAFILE,'E')
CALL WRITE_LES_n(TDIAFILE,'H')
CALL MENU_DIACHRO(TDIAFILE,'END')
- CALL IO_FILE_CLOSE_ll(TDIAFILE)
+ CALL IO_File_close(TDIAFILE)
END IF
!
- CALL IO_FILE_CLOSE_ll(TINIFILE)
- IF (CSURF=="EXTE") CALL IO_FILE_CLOSE_ll(TINIFILEPGD,OPARALLELIO=.FALSE.)
+ CALL IO_File_close(TINIFILE)
+ IF (CSURF=="EXTE") CALL IO_File_close(TINIFILEPGD)
!
!* 28.1 print statistics!
!
! Set File Timing OUTPUT
!
- CALL SET_ILUOUT_TIMING(ILUOUT)
+ CALL SET_ILUOUT_TIMING(TLUOUT)
!
! Compute global time
!
@@ -2215,8 +2226,8 @@ IF (OEXIT) THEN
!
!
!
- CALL IO_FILE_CLOSE_ll(TLUOUT)
- IF (IMI==NMODEL) CALL IO_FILE_CLOSE_ll(TLUOUT0)
+ CALL IO_File_close(TLUOUT)
+ IF (IMI==NMODEL) CALL IO_File_close(TLUOUT0)
END IF
!
END SUBROUTINE MODEL_n
diff --git a/src/MNH/modn_salt.f90 b/src/MNH/modn_salt.f90
index 92fa8499839e57ba36cd792c698c10913e1fc6f1..0b7e674471ace04ac31394ff115436386cd9c2c8 100644
--- a/src/MNH/modn_salt.f90
+++ b/src/MNH/modn_salt.f90
@@ -25,6 +25,7 @@
!! MODIFICATIONS
!! -------------
!! Original 24/02/05
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
!!
!! IMPLICIT ARGUMENTS
!! ------------------
@@ -38,6 +39,6 @@ IMPLICIT NONE
!
NAMELIST /NAM_SALT/ LSALT, CRGUNITS, LVARSIG_SLT,LSEDIMSALT,XN0MIN_SLT, XINIRADIUS_SLT, &
XINISIG_SLT, XSIGMIN_SLT, XSIGMAX_SLT, XCOEFRADMAX_SLT, XCOEFRADMIN_SLT, &
- NMODE_SLT, LRGFIX_SLT, LDEPOS_SLT
+ NMODE_SLT, LRGFIX_SLT, LDEPOS_SLT, LONLY
!
END MODULE MODN_SALT
diff --git a/src/MNH/modules_diachro.f90 b/src/MNH/modules_diachro.f90
index 2dd05edff0955fec0d485e7d31f6043a86691ec9..75fafa132219d983fa372f4ae47eb849c86a4d92 100644
--- a/src/MNH/modules_diachro.f90
+++ b/src/MNH/modules_diachro.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! Modifications:
@@ -13,7 +13,7 @@
INTERFACE
!
SUBROUTINE MENU_DIACHRO(TPDIAFILE,HGROUP)
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! file to write
CHARACTER(LEN=*), INTENT(IN) :: HGROUP
@@ -31,7 +31,7 @@ END MODULE MODI_MENU_DIACHRO
INTERFACE
!
SUBROUTINE WRITE_LFIFMN_FORDIACHRO_n(TPFILE)
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
TYPE(TFILEDATA),INTENT(IN) :: TPFILE
END SUBROUTINE WRITE_LFIFMN_FORDIACHRO_n
!
@@ -49,7 +49,7 @@ SUBROUTINE WRITE_DIACHRO(TPDIAFILE,TPLUOUTDIA,HGROUP,HTYPE, &
HTITRE,HUNITE,HCOMMENT,OICP,OJCP,OKCP,KIL,KIH,KJL,KJH,KKL,KKH, &
PTRAJX,PTRAJY,PTRAJZ,PMASK)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! file to write
TYPE(TFILEDATA), INTENT(IN) :: TPLUOUTDIA
diff --git a/src/MNH/one_wayn.f90 b/src/MNH/one_wayn.f90
index 0490f8fd1ea6f988b1efd0d1c37c8483841e805c..05532ca21cc52e30ba2ef6be4633a2760a93b08d 100644
--- a/src/MNH/one_wayn.f90
+++ b/src/MNH/one_wayn.f90
@@ -1,6 +1,6 @@
!MNH_LIC Copyright 1996-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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ###################
@@ -187,12 +187,14 @@ SUBROUTINE ONE_WAY_n(KDAD,PTSTEP,KMI,KTCOUNT, &
!! 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 10/04/2019: replace ABORT and STOP calls by Print_msg
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
USE MODE_ll
USE MODE_MODELN_HANDLER
+use mode_msg
!
USE MODD_PARAMETERS
USE MODD_NESTING
@@ -493,7 +495,8 @@ IF (HCLOUD=="LIMA" ) THEN
&ZTSVT(:,:,:,JSV-1+NSV_LIMA_BEG_A(KMI)),KMI)
ENDDO
ELSE
- IF (NSV_LIMA_A(KMI)/=NSV_LIMA_A(KDAD)) CALL ABORT
+ IF ( NSV_LIMA_A(KMI) /= NSV_LIMA_A(KDAD) ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'ONE_WAY_n', 'NSV_LIMA_A(KMI)/=NSV_LIMA_A(KDAD)' )
DO JSV=1,NSV_LIMA_A(KMI)
CALL SET_LSFIELD_1WAY_ll(XSVT(:,:,:,JSV-1+NSV_LIMA_BEG_A(KDAD)),&
&ZTSVT(:,:,:,JSV-1+NSV_LIMA_BEG_A(KMI)),KMI)
diff --git a/src/MNH/open_file_mnh.f90 b/src/MNH/open_file_mnh.f90
index 8762e066e0bc845d259094d4816be3bafaf64ed9..4a0539ec772fb74d53f83a4b3fdb4eced29379eb 100644
--- a/src/MNH/open_file_mnh.f90
+++ b/src/MNH/open_file_mnh.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2003-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2003-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.
!-----------------------------------------------------------------
! #########################
@@ -59,8 +59,8 @@ END MODULE MODI_OPEN_FILE_MNH
!
USE MODD_IO_NAM, ONLY: TFILE
!
-USE MODE_FM, ONLY: IO_FILE_OPEN_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST
+USE MODE_IO_FILE, ONLY: IO_File_open
+USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list
USE MODE_MSG
!
IMPLICIT NONE
@@ -84,10 +84,10 @@ INTEGER :: IRESP
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','OPEN_FILE_MNH','called for '//TRIM(HFILE))
!
-CALL IO_FILE_ADD2LIST(TFILE,TRIM(HFILE),'SURFACE_DATA',HACTION, &
+CALL IO_File_add2list(TFILE,TRIM(HFILE),'SURFACE_DATA',HACTION, &
HFORM=HFORM,HACCESS=HACCESS,KRECL=KRECL, &
OOLD=.TRUE.) !OOLD=T because the file may already be in list
-CALL IO_FILE_OPEN_ll(TFILE)
+CALL IO_File_open(TFILE)
!
KUNIT = TFILE%NLU
!
diff --git a/src/MNH/open_nestpgd_files.f90 b/src/MNH/open_nestpgd_files.f90
index 9147b1635082815d66fee3ccca51a17faa8caacb..d331134d68ce797a6112596032f6fe6448b3b1e8 100644
--- a/src/MNH/open_nestpgd_files.f90
+++ b/src/MNH/open_nestpgd_files.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1996-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
!#############################
@@ -10,7 +10,7 @@ MODULE MODI_OPEN_NESTPGD_FILES
INTERFACE
SUBROUTINE OPEN_NESTPGD_FILES(TPFILEPGD,TPFILENESTPGD)
!
-USE MODD_IO_ll, ONLY : TPTR2FILE
+USE MODD_IO, ONLY : TPTR2FILE
!
TYPE(TPTR2FILE),DIMENSION(:),ALLOCATABLE, INTENT(OUT) :: TPFILEPGD ! Input PGD files
TYPE(TPTR2FILE),DIMENSION(:),ALLOCATABLE,TARGET,INTENT(OUT) :: TPFILENESTPGD ! Output PGD files
@@ -41,7 +41,7 @@ END MODULE MODI_OPEN_NESTPGD_FILES
!! ------------------
!!
!! Module MODD_LUNIT : contains logical unit names for all models
-!! CLUOUT0 : name of output-listing
+!! TLUOUT0 : output-listing
!!
!! REFERENCE
!! ---------
@@ -67,31 +67,32 @@ END MODULE MODI_OPEN_NESTPGD_FILES
!! J.Escobar : 19/04/2016 : Pb IOZ/NETCDF , missing OPARALLELIO=.FALSE. for PGD files
!! 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 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+USE MODD_CONF
+USE MODD_CONF, ONLY: NHALO_CONF_MNH => NHALO
+USE MODD_IO, ONLY: TFILE_OUTPUTLISTING, TFILEDATA, TPTR2FILE
USE MODD_LUNIT
USE MODD_LUNIT_n
-USE MODD_CONF
USE MODD_NESTING
USE MODD_PARAMETERS
-USE MODD_IO_ll, ONLY : TFILE_OUTPUTLISTING,TFILEDATA,TPTR2FILE
-!
-USE MODE_IO_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY : IO_FILE_ADD2LIST
-USE MODE_FM, ONLY : IO_FILE_OPEN_ll, IO_FILE_CLOSE_ll
-USE MODE_POS
-USE MODE_MSG
!
+USE MODE_IO, ONLY: IO_Config_set
+USE MODE_IO_FILE, ONLY: IO_File_open, IO_File_close
+USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list
USE MODE_MODELN_HANDLER
-!
-USE MODD_PARAMETERS, ONLY : JPHEXT
-USE MODD_CONF, ONLY : NHALO_CONF_MNH => NHALO
+USE MODE_MSG
+USE MODE_POS
!
USE MODN_CONFZ
-USE MODN_CONFIO, ONLY : NAM_CONFIO
+USE MODN_CONFIO, ONLY: NAM_CONFIO
!
IMPLICIT NONE
!
@@ -149,15 +150,14 @@ TZPRE_NEST_PGD => NULL()
! -----------------
!
HPRE_NEST_PGD='PRE_NEST_PGD1.nam'
-CLUOUT0='OUTPUT_LISTING0'
!
!-------------------------------------------------------------------------------
!
-!* 2. OPENNING OF CLUOUT0
-! -------------------
+!* 2. OPENING OF TLUOUT0
+! ------------------
!
-CALL IO_FILE_ADD2LIST(TLUOUT0,'OUTPUT_LISTING0','OUTPUTLISTING','WRITE')
-CALL IO_FILE_OPEN_ll(TLUOUT0)
+CALL IO_File_add2list(TLUOUT0,'OUTPUT_LISTING0','OUTPUTLISTING','WRITE')
+CALL IO_File_open(TLUOUT0)
!Set output file for PRINT_MSG
TFILE_OUTPUTLISTING => TLUOUT0
!
@@ -168,8 +168,8 @@ ILUOUT0=TLUOUT0%NLU
!* 3. OPENNING OF PRE_NEST_PGD1.nam
! -----------------------------
!
-CALL IO_FILE_ADD2LIST(TZPRE_NEST_PGD,TRIM(HPRE_NEST_PGD),'NML','READ')
-CALL IO_FILE_OPEN_ll(TZPRE_NEST_PGD)
+CALL IO_File_add2list(TZPRE_NEST_PGD,TRIM(HPRE_NEST_PGD),'NML','READ')
+CALL IO_File_open(TZPRE_NEST_PGD)
IPRE_NEST_PGD = TZPRE_NEST_PGD%NLU
!reading of NAM_CONFZ
CALL POSNAM(IPRE_NEST_PGD,'NAM_CONFZ',GFOUND)
@@ -282,8 +282,8 @@ END DO
!
DO JPGD=1,NMODEL
WRITE(YLUOUT,'("OUTPUT_LISTING",I0)') JPGD
- CALL IO_FILE_ADD2LIST(LUNIT_MODEL(JPGD)%TLUOUT,YLUOUT,'OUTPUTLISTING','WRITE')
- CALL IO_FILE_OPEN_ll(LUNIT_MODEL(JPGD)%TLUOUT)
+ CALL IO_File_add2list(LUNIT_MODEL(JPGD)%TLUOUT,YLUOUT,'OUTPUTLISTING','WRITE')
+ CALL IO_File_open(LUNIT_MODEL(JPGD)%TLUOUT)
END DO
!
!-------------------------------------------------------------------------------
@@ -296,26 +296,26 @@ IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_NEST_PGD)
!
CALL POSNAM(IPRE_NEST_PGD,'NAM_CONFIO',GFOUND,ILUOUT0)
IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_CONFIO)
-CALL SET_CONFIO_ll()
+CALL IO_Config_set()
!
ALLOCATE(TPFILEPGD (NMODEL))
ALLOCATE(TPFILENESTPGD(NMODEL))
!
DO JPGD=1,NMODEL
- CALL IO_FILE_ADD2LIST(TPFILEPGD(JPGD)%TZFILE,TRIM(YPGD(JPGD)),'PREPPGD','READ',KLFITYPE=2,KLFIVERB=NVERB)
+ CALL IO_File_add2list(TPFILEPGD(JPGD)%TZFILE,TRIM(YPGD(JPGD)),'PGD','READ',KLFITYPE=2,KLFIVERB=NVERB)
!
IF (NDAD(JPGD)>=1) THEN
TZDADFILE => TPFILENESTPGD(NDAD(JPGD))%TZFILE
- CALL IO_FILE_ADD2LIST(TPFILENESTPGD(JPGD)%TZFILE,TRIM(YPGD(JPGD))//'.nest'//ADJUSTL(YNEST),'PREPNESTPGD', &
+ CALL IO_File_add2list(TPFILENESTPGD(JPGD)%TZFILE,TRIM(YPGD(JPGD))//'.nest'//ADJUSTL(YNEST),'PGD', &
'WRITE',KLFITYPE=1,KLFIVERB=NVERB,KMODEL=JPGD,TPDADFILE=TZDADFILE)
ELSE
NULLIFY(TZDADFILE)
- CALL IO_FILE_ADD2LIST(TPFILENESTPGD(JPGD)%TZFILE,TRIM(YPGD(JPGD))//'.nest'//ADJUSTL(YNEST),'PREPNESTPGD', &
+ CALL IO_File_add2list(TPFILENESTPGD(JPGD)%TZFILE,TRIM(YPGD(JPGD))//'.nest'//ADJUSTL(YNEST),'PGD', &
'WRITE',KLFITYPE=1,KLFIVERB=NVERB,KMODEL=JPGD)
END IF
END DO
!
-CALL IO_FILE_CLOSE_ll(TZPRE_NEST_PGD)
+CALL IO_File_close(TZPRE_NEST_PGD)
!-------------------------------------------------------------------------------
!
!* 7. OPENING OF INPUT PGD FILES
@@ -324,7 +324,7 @@ CALL IO_FILE_CLOSE_ll(TZPRE_NEST_PGD)
!Remark: output PGD files are opened later when the mesh dimensions are known
!
DO JPGD=1,NMODEL
- CALL IO_FILE_OPEN_ll(TPFILEPGD(JPGD) %TZFILE,OPARALLELIO=.FALSE.)
+ CALL IO_File_open(TPFILEPGD(JPGD)%TZFILE)
END DO
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/open_prc_files.f90 b/src/MNH/open_prc_files.f90
index 5f60cc3da7a6f7176fabc61d3b90fd2167da83e8..bb02f6951579522024fcc1b29da9240a08de5a83 100644
--- a/src/MNH/open_prc_files.f90
+++ b/src/MNH/open_prc_files.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ##########################
@@ -13,7 +13,7 @@ INTERFACE
HSURFFILE,HSURFFILETYPE, &
HPGDFILE,TPPGDFILE)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
TYPE(TFILEDATA),POINTER, INTENT(OUT) :: TPPRE_REAL1FILE ! PRE_REAL1 file
CHARACTER(LEN=28), INTENT(OUT) :: HATMFILE ! name of the input atmospheric file
@@ -43,7 +43,7 @@ END MODULE MODI_OPEN_PRC_FILES
!! PURPOSE
!! -------
!!
-!! This routine set the default name of CLUOUT0
+!! This routine creates TLUOUT0
!! This routine read in 'PRE_REAL1.nam' the names of the files used in
!! PREP_REAL_CASE: Aladin or Mesonh input file, physiographic data file,
!! output listing file and MESO-NH output file.
@@ -65,7 +65,7 @@ END MODULE MODI_OPEN_PRC_FILES
!! 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
-!! CLUOUT0 : name of output-listing
+!! TLUOUT0 : output-listing
!! Module MODD_LUNIT1 :
!! CINIFILE : name of MESO-NH file
!!
@@ -90,6 +90,11 @@ END MODULE MODI_OPEN_PRC_FILES
!! J.ESCOBAR 12/11/2008 Improve checking --> add STATUS=OLD in open_ll(PRE_REAL1.nam,...
!! J.Escobar : 19/04/2016 : Pb IOZ/NETCDF , missing OPARALLELIO=.FALSE. for PGD files
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! P. Wautelet 01/02/2019 added missing initialization to NULL for files with OUT intent
+! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list
+! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -100,16 +105,16 @@ USE MODD_CONF_n
!JUAN Z_SPLITTING
!USE MODD_CONFZ
!JUAN Z_SPLITTING
-USE MODD_IO_ll, ONLY: TFILE_OUTPUTLISTING,TFILEDATA
+USE MODD_IO, ONLY: TFILE_OUTPUTLISTING, TFILEDATA
USE MODD_LUNIT
USE MODD_LUNIT_n, CINIFILE_n=>CINIFILE , CINIFILEPGD_n=>CINIFILEPGD
!
!
-USE MODE_IO_MANAGE_STRUCT, ONLY : IO_FILE_ADD2LIST
-USE MODE_POS
-USE MODE_FM
-USE MODE_IO_ll
+USE MODE_IO, only: IO_Config_set
+USE MODE_IO_FILE, only: IO_File_open
+USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
USE MODE_MSG
+USE MODE_POS
!
USE MODN_CONFIO, ONLY : NAM_CONFIO
!JUAN Z_SPLITTING
@@ -160,16 +165,14 @@ HCHEMFILE=' '
HCHEMFILETYPE='MESONH'
HSURFFILE=' '
HSURFFILETYPE='MESONH'
-CLUOUT0 ='OUTPUT_LISTING0 '
-CLUOUT = CLUOUT0
!
!-------------------------------------------------------------------------------
!
!* 2. OPENNING OF THE OUTPUT LISTING FILE
! -----------------------------------
!
-CALL IO_FILE_ADD2LIST(TLUOUT0,'OUTPUT_LISTING0','OUTPUTLISTING','WRITE')
-CALL IO_FILE_OPEN_ll(TLUOUT0)
+CALL IO_File_add2list(TLUOUT0,'OUTPUT_LISTING0','OUTPUTLISTING','WRITE')
+CALL IO_File_open(TLUOUT0)
!Set output file for PRINT_MSG
TFILE_OUTPUTLISTING => TLUOUT0
!
@@ -181,8 +184,9 @@ IF (NVERB>=5) WRITE(ILUOUT0,*) 'Routine OPEN_PRC_FILES started'
!* 3. OPENNING OF PRE_REAL1.nam
! -------------------------
!
-CALL IO_FILE_ADD2LIST(TPPRE_REAL1FILE,'PRE_REAL1.nam','NML','READ')
-CALL IO_FILE_OPEN_ll(TPPRE_REAL1FILE,KRESP=IRESP)
+TPPRE_REAL1FILE => NULL()
+CALL IO_File_add2list(TPPRE_REAL1FILE,'PRE_REAL1.nam','NML','READ')
+CALL IO_File_open(TPPRE_REAL1FILE,KRESP=IRESP)
IPRE_REAL1=TPPRE_REAL1FILE%NLU
IF (IRESP.NE.0 ) THEN
!callabortstop
@@ -200,7 +204,7 @@ IF (GFOUND) READ(UNIT=IPRE_REAL1,NML=NAM_CONFZ)
!JUANZ
CALL POSNAM(IPRE_REAL1,'NAM_CONFIO',GFOUND,ILUOUT0)
IF (GFOUND) READ(UNIT=IPRE_REAL1,NML=NAM_CONFIO)
-CALL SET_CONFIO_ll()
+CALL IO_Config_set()
!
CINIFILE = CINIFILE_n
CALL POSNAM(IPRE_REAL1,'NAM_FILE_NAMES',GFOUND,ILUOUT0)
@@ -266,8 +270,9 @@ ELSE
!* 5. OPENING THE PHYSIOGRAPHIC DATA FILE
! -----------------------------------
!
- CALL IO_FILE_ADD2LIST(TPPGDFILE,TRIM(HPGDFILE),'UNKNOWN','READ',KLFITYPE=2,KLFIVERB=NVERB)
- CALL IO_FILE_OPEN_ll(TPPGDFILE,IRESP,OPARALLELIO=.FALSE.)
+ TPPGDFILE => NULL()
+ CALL IO_File_add2list(TPPGDFILE,TRIM(HPGDFILE),'PGD','READ',KLFITYPE=2,KLFIVERB=NVERB)
+ CALL IO_File_open(TPPGDFILE,IRESP)
IF (IRESP/=0) THEN
!callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','OPEN_PRC_FILES',' problem during opening of PGD file '//TRIM(HPGDFILE))
diff --git a/src/MNH/paspol.f90 b/src/MNH/paspol.f90
index 4cab8bd6bad52d2b3b7d0d878eb0dd6d2cea6553..1fee61de9e295ec065f9a1c75d76538a32cd60b3 100644
--- a/src/MNH/paspol.f90
+++ b/src/MNH/paspol.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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_PASPOL
! ##################
@@ -10,7 +11,7 @@ INTERFACE
!
SUBROUTINE PASPOL (PTSTEP, PSFSV, KLUOUT, KVERB, OCLOSE_OUT, TPFILE)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
IMPLICIT NONE
!
@@ -67,7 +68,7 @@ END MODULE MODI_PASPOL
USE MODD_PARAMETERS
USE MODD_NSV
USE MODD_CST
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODE_GRIDPROJ
USE MODD_PASPOL
USE MODD_CTURB
@@ -75,9 +76,8 @@ USE MODI_SHUMAN
USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_M
-USE MODE_FMWRIT
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_ll
-USE MODE_FM
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
USE MODD_DYN_n
USE MODD_CONF
@@ -591,7 +591,7 @@ IF (OCLOSE_OUT) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','ATC',JSV+NSV_PPBEG-1
!
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZTEMPO)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZTEMPO)
END DO
!
DEALLOCATE(ZTEMPO)
diff --git a/src/MNH/pgd_grid_io_init_mnh.f90 b/src/MNH/pgd_grid_io_init_mnh.f90
index e7e416226daa15be3122ec92d1c6acc59447db22..202333f7ded0b2ddc6fc8b3b8b5bfe14500e3c32 100644
--- a/src/MNH/pgd_grid_io_init_mnh.f90
+++ b/src/MNH/pgd_grid_io_init_mnh.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2004-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
!#######################
@@ -59,19 +59,6 @@ MODULE MODI_PGD_GRID_IO_INIT_MNH
!
USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
!
- USE MODE_ll
- USE MODE_FM
- USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT, JPMODELMAX
- USE MODD_CONF, ONLY : CPROGRAM, L1D, L2D, LPACK
- !
- USE MODE_IO_ll
- !JUANZ
- USE MODE_SPLITTINGZ_ll
- !JUANZ
- !
- USE MODI_GET_SURF_GRID_DIM_N
- USE MODI_GET_LUOUT
- !
IMPLICIT NONE
!
!* 0.1 Declaration of dummy arguments
@@ -140,22 +127,19 @@ END MODULE MODI_PGD_GRID_IO_INIT_MNH
!* 0. DECLARATION
! -----------
!
-USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+USE MODD_CONF, ONLY: CPROGRAM, L1D, L2D, LPACK
+USE MODD_DIM_n, ONLY: NIMAX_ll, NJMAX_ll, NKMAX
+USE MODD_MNH_SURFEX_n
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT, JPMODELMAX
+USE MODD_SURF_ATM_GRID_n, ONLY: SURF_ATM_GRID_t
!
+USE MODE_IO, only: IO_Pack_set
USE MODE_ll
-USE MODE_FM
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT, JPMODELMAX
-USE MODD_CONF, ONLY : CPROGRAM, L1D, L2D, LPACK
-USE MODD_DIM_n, ONLY : NIMAX_ll, NJMAX_ll, NKMAX
-!
-!JUANZ
USE MODE_SPLITTINGZ_ll
-!JUANZ
!
USE MODI_GET_SURF_GRID_DIM_N
USE MODI_GET_LUOUT
!
-USE MODD_MNH_SURFEX_n
!
IMPLICIT NONE
!
@@ -227,7 +211,7 @@ END IF
L1D=(IIMAX==1).AND.(IJMAX==1)
L2D=(IIMAX/=1).AND.(IJMAX==1)
LPACK=L1D.OR.L2D
-CALL SET_FMPACK_ll(L1D,L2D,LPACK)
+CALL IO_Pack_set(L1D,L2D,LPACK)
CALL SET_JP_ll(JPMODELMAX,JPHEXT,JPVEXT,JPHEXT)
CALL SET_DAD0_ll()
NIMAX_ll = IIMAX
diff --git a/src/MNH/phys_paramn.f90 b/src/MNH/phys_paramn.f90
index 106ec1623adf6772a63f57eca3e0692aacce497d..a722563f12d687a12b26e24453a9b0e8be2c21a8 100644
--- a/src/MNH/phys_paramn.f90
+++ b/src/MNH/phys_paramn.f90
@@ -1,9 +1,10 @@
-!MNH_LIC Copyright 1995-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
! ########################
- MODULE MODI_PHYS_PARAM_n
+ MODULE MODI_PHYS_PARAM_n
! ########################
!
!
@@ -13,18 +14,17 @@ INTERFACE
PRAD,PSHADOWS,PKAFR,PGROUND,PMAFL,PDRAG,PTURB,PTRACER, &
PTIME_BU, PWETDEPAER, OMASKkids,OCLOUD_ONLY )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+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*8,DIMENSION(2), INTENT(INOUT) :: PRAD,PSHADOWS,PKAFR,PGROUND,PTURB,PMAFL,PDRAG,PTRACER ! to store CPU
- ! time for computing time
-
-REAL*8,DIMENSION(2), INTENT(INOUT) :: PTIME_BU ! time used in budget&LES budgets
- ! statistics
+! advection schemes
+REAL(kind=MNHTIME), DIMENSION(2), INTENT(INOUT) :: PRAD,PSHADOWS,PKAFR,PGROUND,PTURB,PMAFL,PDRAG,PTRACER ! 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
LOGICAL, DIMENSION(:,:), INTENT(IN) :: OMASKkids ! kids domains mask
LOGICAL, INTENT(OUT) :: OCLOUD_ONLY ! conditionnal radiation computations for
@@ -230,8 +230,9 @@ END MODULE MODI_PHYS_PARAM_n
!! C.Lac 10/2017 : ch_monitor and aer_monitor extracted from phys_param
!! to be called directly by modeln as the last process
!! 02/2018 Q.Libois ECRAD
-!! 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
+! 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 28/03/2019: use MNHTIME for time measurement variables
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -239,8 +240,6 @@ END MODULE MODI_PHYS_PARAM_n
!
USE MODE_DATETIME
USE MODE_ll
-USE MODE_FM
-USE MODE_FMWRIT
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
!
USE MODD_BLANK
@@ -248,7 +247,7 @@ USE MODD_CST
USE MODD_DYN
USE MODD_CONF
USE MODD_FRC
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_GRID
USE MODD_NSV
@@ -293,6 +292,7 @@ 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
@@ -303,7 +303,6 @@ USE MODI_CONVECTION
USE MODI_BUDGET
USE MODI_PASPOL
USE MODI_CONDSAMP
-USE MODE_FM
USE MODE_MODELN_HANDLER
USE MODI_SEDIM_DUST
USE MODI_SEDIM_SALT
@@ -347,11 +346,10 @@ 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*8,DIMENSION(2), INTENT(INOUT) :: PRAD,PSHADOWS,PKAFR,PGROUND,PTURB,PMAFL,PDRAG,PTRACER ! to store CPU
- ! time for computing time
- ! statistics
-REAL*8,DIMENSION(2), INTENT(INOUT) :: PTIME_BU ! time used in budget&LES budgets
+! advection schemes
+REAL(kind=MNHTIME), DIMENSION(2), INTENT(INOUT) :: PRAD,PSHADOWS,PKAFR,PGROUND,PTURB,PMAFL,PDRAG,PTRACER ! 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
LOGICAL, DIMENSION(:,:), INTENT(IN) :: OMASKkids ! kids domains mask
LOGICAL, INTENT(OUT) :: OCLOUD_ONLY ! conditionnal radiation computations for
@@ -403,8 +401,8 @@ REAL :: ZRAD_GLOB_ll ! 'real' global parallel mask of 'GRAD'
INTEGER :: INFO_ll ! error report of parallel routines
! the only cloudy columns
!
-REAL*8,DIMENSION(2) :: ZTIME1,ZTIME2,ZTIME3,ZTIME4 ! for computing time analysis
-REAL*8,DIMENSION(2) :: ZTIME_LES_MF ! time spent in LES computation in shallow conv.
+REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME1, ZTIME2, ZTIME3, ZTIME4 ! for computing time analysis
+REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME_LES_MF ! time spent in LES computation in shallow conv.
LOGICAL :: GDCONV ! conditionnal call for the deep convection
! computations
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRC, ZRI, ZWT ! additional dummies
@@ -454,12 +452,12 @@ IKB = 1 + JPVEXT
IKE = IKU - JPVEXT
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
!
-ZTIME1 = 0.0
-ZTIME2 = 0.0
-ZTIME3 = 0.0
-ZTIME4 = 0.0
-PTIME_BU = 0.
-ZTIME_LES_MF = 0.0
+ZTIME1 = 0.0_MNHTIME
+ZTIME2 = 0.0_MNHTIME
+ZTIME3 = 0.0_MNHTIME
+ZTIME4 = 0.0_MNHTIME
+PTIME_BU = 0._MNHTIME
+ZTIME_LES_MF = 0.0_MNHTIME
PWETDEPAER(:,:,:,:) = 0.
!
!* allocation of variables used in more than one parameterization
diff --git a/src/MNH/ppm.f90 b/src/MNH/ppm.f90
index 26939e2db02ea860faff58229d26b8ab9cdab55c..2cf8d3c6c3d040f61fd55ce5b6283947a834c776 100644
--- a/src/MNH/ppm.f90
+++ b/src/MNH/ppm.f90
@@ -426,7 +426,6 @@ CONTAINS
!-------------------------------------------------------------------------------
!
USE MODE_ll
-USE MODE_IO_ll
#ifndef _OPENACC
USE MODI_SHUMAN
#else
@@ -1108,7 +1107,6 @@ CONTAINS
!-------------------------------------------------------------------------------
!
USE MODE_ll
-USE MODE_IO_ll
#ifndef _OPENACC
USE MODI_SHUMAN
#else
@@ -2229,7 +2227,6 @@ CONTAINS
!-------------------------------------------------------------------------------
!
USE MODE_ll
-USE MODE_IO_ll
#ifndef _OPENACC
USE MODI_SHUMAN
#else
@@ -2246,7 +2243,7 @@ USE MODD_PARAMETERS, ONLY : JPHEXT
!
USE MODE_MNH_ZWORK, ONLY : IIB,IIE, IIU,IJU,IKU , IJS,IJN, GWEST,GEAST
!
-USE MODD_IO_ll, ONLY : GSMONOPROC
+USE MODD_IO, ONLY : GSMONOPROC
#endif
USE MODE_MPPDB
!
@@ -2647,7 +2644,6 @@ CONTAINS
!-------------------------------------------------------------------------------
!
USE MODE_ll
-USE MODE_IO_ll
#ifndef _OPENACC
USE MODI_SHUMAN
#else
@@ -2663,7 +2659,7 @@ USE MODD_PARAMETERS, ONLY : JPHEXT
!
USE MODE_MNH_ZWORK, ONLY : IJB,IJE, IIU,IJU,IKU , IIW,IIA, GSOUTH , GNORTH
!
-USE MODD_IO_ll, ONLY : GSMONOPROC
+USE MODD_IO, ONLY : GSMONOPROC
#endif
USE MODE_MPPDB
!
@@ -3320,7 +3316,6 @@ CALL ABORT
!-------------------------------------------------------------------------------
!
USE MODE_ll
-USE MODE_IO_ll
#ifndef _OPENACC
USE MODI_SHUMAN
#else
@@ -3666,7 +3661,6 @@ CALL ABORT
!-------------------------------------------------------------------------------
!
USE MODE_ll
-USE MODE_IO_ll
#ifndef _OPENACC
USE MODI_SHUMAN
#else
diff --git a/src/MNH/prandtl.f90 b/src/MNH/prandtl.f90
index 0fa552a969fd2ec67e3382595bcc1c8bf4553729..91602892b3e70094823766e54d2c7d3ea0bc082c 100644
--- a/src/MNH/prandtl.f90
+++ b/src/MNH/prandtl.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ###################
@@ -22,7 +22,7 @@ INTERFACE
PETHETA, PEMOIST )
!
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KKA !near ground array index
INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
@@ -203,23 +203,23 @@ END MODULE MODI_PRANDTL
USE MODD_CST
USE MODD_CONF
USE MODD_CTURB
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
!
-USE MODI_GRADIENT_M
+#ifdef MNH_BITREP
+USE MODI_BITREP
+#endif
USE MODI_EMOIST
USE MODI_ETHETA
+USE MODI_GRADIENT_M
#ifndef _OPENACC
USE MODI_SHUMAN
#else
USE MODI_SHUMAN_DEVICE
#endif
-USE MODE_FMWRIT
-#ifdef MNH_BITREP
-USE MODI_BITREP
-#endif
!
IMPLICIT NONE
!
@@ -963,7 +963,7 @@ IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,PREDTH1)
+ CALL IO_Field_write(TPFILE,TZFIELD,PREDTH1)
!
! stores the RED_R1
TZFIELD%CMNHNAME = 'RED_R1'
@@ -976,7 +976,7 @@ IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,PREDR1)
+ CALL IO_Field_write(TPFILE,TZFIELD,PREDR1)
!
! stores the RED2_TH3
TZFIELD%CMNHNAME = 'RED2_TH3'
@@ -989,7 +989,7 @@ IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,PRED2TH3)
+ CALL IO_Field_write(TPFILE,TZFIELD,PRED2TH3)
!
! stores the RED2_R3
TZFIELD%CMNHNAME = 'RED2_R3'
@@ -1002,7 +1002,7 @@ IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,PRED2R3)
+ CALL IO_Field_write(TPFILE,TZFIELD,PRED2R3)
!
! stores the RED2_THR3
TZFIELD%CMNHNAME = 'RED2_THR3'
@@ -1015,7 +1015,7 @@ IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,PRED2THR3)
+ CALL IO_Field_write(TPFILE,TZFIELD,PRED2THR3)
!
END IF
!
diff --git a/src/MNH/prep_ideal_case.f90 b/src/MNH/prep_ideal_case.f90
index eb97a9091e0451dfe0243d9b393270257c01b9f6..b5aba7c9534ab6f71a48987110735d6947f14f3e 100644
--- a/src/MNH/prep_ideal_case.f90
+++ b/src/MNH/prep_ideal_case.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #######################
@@ -171,10 +171,10 @@
!! SET_REF : to compute rhoJ
!! RESSURE_IN_PREP : to apply an anelastic correction in the case of
!! non-vanishing orography
-!! IO_FILE_OPEN_ll : to open a FM-file (DESFM + LFIFM)
+!! IO_File_open : to open a FM-file (DESFM + LFIFM)
!! WRITE_DESFM : to write the DESFM file
!! WRI_LFIFM : to write the LFIFM file
-!! IO_FILE_CLOSE_ll : to close a FM-file (DESFM + LFIFM)
+!! IO_File_close : to close a FM-file (DESFM + LFIFM)
!!
!! MXM,MYM,MZM : Shuman operators
!! WGUESS : to compute W with the continuity equation from
@@ -310,7 +310,11 @@
!! 06/2016 (G.Delautier) phasage surfex 8
!! P.Wautelet : 08/07/2016 : removed MNH_NCWRIT define
!! 01/2018 (G.Delautier) SURFEX 8.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 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 28/03/2019: use MNHTIME for time measurement variables
+! P. Wautelet 28/03/2019: use TFILE instead of unit number for set_iluout_timing
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -321,7 +325,7 @@ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
USE MODD_DIM_n
USE MODD_CONF
USE MODD_CST
-USE MODD_GRID
+USE MODD_GRID
USE MODD_GRID_n
USE MODD_METRICS_n
USE MODD_PGDDIM
@@ -345,10 +349,11 @@ 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_ll, ONLY: NIO_VERB,NVERB_DEBUG,TFILE_DUMMY,TFILE_OUTPUTLISTING
+USE MODD_IO, ONLY: NIO_VERB, NVERB_DEBUG, TFILE_DUMMY, TFILE_OUTPUTLISTING
USE MODD_CONF_n
USE MODD_NSV, ONLY : NSV,NSV_CHEM, &
NSV_DSTEND, NSV_DSTBEG
+use modd_precision, only: LFIINT, MNHREAL_MPI, MNHTIME
!
USE MODN_BLANK
!
@@ -356,11 +361,12 @@ USE MODE_THERMO
USE MODE_POS
USE MODE_GRIDCART ! Executive modules
USE MODE_GRIDPROJ
-USE MODE_FM
-USE MODE_FMREAD
USE MODE_GATHER_ll
-USE MODE_IO_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY : IO_FILE_ADD2LIST,IO_FILE_PRINT_LIST
+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_ll
USE MODE_MODELN_HANDLER
USE MODE_FIELD
@@ -419,11 +425,10 @@ USE MODI_SET_RELFRC
!
USE MODI_INI_CST
USE MODI_INI_NEB
-USE MODE_FMWRIT
USE MODI_WRITE_HGRID
USE MODD_MPIF
USE MODD_VAR_ll
-USE MODD_IO_ll, ONLY: TFILEDATA,TFILE_SURFEX
+USE MODD_IO, ONLY: TFILEDATA,TFILE_SURFEX
!
USE MODE_MPPDB
!
@@ -447,7 +452,7 @@ INTEGER :: NLUPRE,NLUOUT ! Logical unit numbers for EXPRE file
! and for output_listing file
INTEGER :: NRESP ! return code in FM routines
INTEGER :: NTYPE ! type of file (cpio or not)
-INTEGER(KIND=LFI_INT) :: NNPRAR ! number of articles predicted in the LFIFM file
+INTEGER(KIND=LFIINT) :: NNPRAR ! number of articles predicted in the LFIFM file
LOGICAL :: GFOUND ! Return code when searching namelist
!
INTEGER :: JLOOP,JILOOP,JJLOOP ! Loop indexes
@@ -553,7 +558,7 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE ::ZTHL,ZT,ZRT,ZFRAC_ICE,&
REAL :: ZDIST
!
!JUAN TIMING
-REAL*8,DIMENSION(2) :: ZTIME1,ZTIME2,ZEND,ZTOT
+REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME1, ZTIME2, ZEND, ZTOT
CHARACTER :: YMI
INTEGER :: IMI
INTEGER::JK
@@ -615,14 +620,14 @@ CALL MPPDB_INIT()
!
CALL GOTO_MODEL(1)
!
-CALL INITIO_ll()
+CALL IO_Init()
NULLIFY(TZ_FIELDS_ll)
CALL VERSION
CPROGRAM='IDEAL '
!
!JUAN TIMING
- XT_START = 0.0
- XT_STORE = 0.0
+ XT_START = 0.0_MNHTIME
+ XT_STORE = 0.0_MNHTIME
!
CALL SECOND_MNH2(ZEND)
!
@@ -663,17 +668,15 @@ CALL DEFAULT_EXPRE
! and open these files :
!
!
-CLUOUT = 'OUTPUT_LISTING1'
-CLUOUT0 = CLUOUT
-CALL IO_FILE_ADD2LIST(TLUOUT0,CLUOUT0,'OUTPUTLISTING','WRITE')
-CALL IO_FILE_OPEN_ll(TLUOUT0)
+CALL IO_File_add2list(TLUOUT0,'OUTPUT_LISTING1','OUTPUTLISTING','WRITE')
+CALL IO_File_open(TLUOUT0)
NLUOUT = TLUOUT0%NLU
!Set output files for PRINT_MSG
TLUOUT => TLUOUT0
TFILE_OUTPUTLISTING => TLUOUT0
!
-CALL IO_FILE_ADD2LIST(TZEXPREFILE,'PRE_IDEA1.nam','NML','READ')
-CALL IO_FILE_OPEN_ll(TZEXPREFILE)
+CALL IO_File_add2list(TZEXPREFILE,'PRE_IDEA1.nam','NML','READ')
+CALL IO_File_open(TZEXPREFILE)
NLUPRE=TZEXPREFILE%NLU
!
!* 3.2 read in NLUPRE the namelist informations
@@ -691,7 +694,7 @@ IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_CONFZ)
!JUANZ
CALL POSNAM(NLUPRE,'NAM_CONFIO',GFOUND,NLUOUT)
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_CONFIO)
-CALL SET_CONFIO_ll()
+CALL IO_Config_set()
CALL POSNAM(NLUPRE,'NAM_GRID_PRE',GFOUND,NLUOUT)
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_GRID_PRE)
CALL POSNAM(NLUPRE,'NAM_GRIDH_PRE',GFOUND,NLUOUT)
@@ -710,13 +713,13 @@ CALL INI_FIELD_SCALARS()
!
IF( LEN_TRIM(CPGD_FILE) /= 0 ) THEN
! open the PGD_FILE
- CALL IO_FILE_ADD2LIST(TPGDFILE,TRIM(CPGD_FILE),'UNKNOWN','READ',KLFINPRAR=NNPRAR,KLFITYPE=2,KLFIVERB=NVERB)
- CALL IO_FILE_OPEN_ll(TPGDFILE)
+ CALL IO_File_add2list(TPGDFILE,TRIM(CPGD_FILE),'PGD','READ',KLFINPRAR=NNPRAR,KLFITYPE=2,KLFIVERB=NVERB)
+ CALL IO_File_open(TPGDFILE)
! read the grid in the PGD file
- CALL IO_READ_FIELD(TPGDFILE,'IMAX', NIMAX)
- CALL IO_READ_FIELD(TPGDFILE,'JMAX', NJMAX)
- CALL IO_READ_FIELD(TPGDFILE,'JPHEXT',IJPHEXT)
+ CALL IO_Field_read(TPGDFILE,'IMAX', NIMAX)
+ CALL IO_Field_read(TPGDFILE,'JMAX', NJMAX)
+ CALL IO_Field_read(TPGDFILE,'JPHEXT',IJPHEXT)
IF ( CPGD_FILE /= CINIFILEPGD) THEN
WRITE(NLUOUT,FMT=*) ' WARNING : in PRE_IDEA1.nam, in NAM_LUNITn you&
@@ -911,7 +914,7 @@ ENDIF
CALL SET_JP_ll(1,JPHEXT,JPVEXT,JPHEXT)
CALL SET_DAD0_ll()
CALL SET_DIM_ll(NIMAX_ll, NJMAX_ll, NKMAX)
-CALL SET_FMPACK_ll(L1D,L2D,LPACK)
+CALL IO_Pack_set(L1D,L2D,LPACK)
CALL SET_LBX_ll(CLBCX(1), 1)
CALL SET_LBY_ll(CLBCY(1), 1)
CALL SET_XRATIO_ll(1, 1)
@@ -1211,7 +1214,7 @@ IF( LEN_TRIM(CPGD_FILE) /= 0 ) THEN
! determine whether the model is flat or no
!
ZZS_MAX = ABS( MAXVAL(XZS(NIB:NIU-JPHEXT,NJB:NJU-JPHEXT)))
- CALL MPI_ALLREDUCE(ZZS_MAX, ZZS_MAX_ll, 1, MPI_PRECISION, MPI_MAX, &
+ CALL MPI_ALLREDUCE(ZZS_MAX, ZZS_MAX_ll, 1, MNHREAL_MPI, MPI_MAX, &
NMNH_COMM_WORLD,IINFO_ll)
IF( ABS(ZZS_MAX_ll) < 1.E-10 ) THEN
LFLAT=.TRUE.
@@ -1462,7 +1465,6 @@ END IF
IF(LPV_PERT .AND. .NOT.(LGEOSBAL)) THEN
!callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','for PV inversion, LGEOSBAL has to be true')
- STOP
ENDIF
!
IF(LPV_PERT .AND. NPROC>1) THEN
@@ -1713,7 +1715,7 @@ END IF
! before calling chemistry
CCONF = 'START'
CSTORAGE_TYPE='TT'
-CALL IO_FILE_CLOSE_ll(TZEXPREFILE) ! Close the EXPRE file
+CALL IO_File_close(TZEXPREFILE) ! Close the EXPRE file
!
IF ( LCH_INIT_FIELD ) CALL CH_INIT_FIELD_n(1, NLUOUT, NVERB)
!
@@ -1730,11 +1732,11 @@ NNPRAR = 22 + 2*(NRR+NSV) & ! 22 = number of grid variables + reference
! variables at time t and t-dt
NTYPE=1
!
-CALL IO_FILE_ADD2LIST(TINIFILE,TRIM(CINIFILE),'PREPIDEALCASE','WRITE',KLFINPRAR=NNPRAR,KLFITYPE=NTYPE,KLFIVERB=NVERB)
+CALL IO_File_add2list(TINIFILE,TRIM(CINIFILE),'MNH','WRITE',KLFINPRAR=NNPRAR,KLFITYPE=NTYPE,KLFIVERB=NVERB)
!
-CALL IO_FILE_OPEN_ll(TINIFILE)
+CALL IO_File_open(TINIFILE)
!
-CALL IO_WRITE_HEADER(TINIFILE)
+CALL IO_Header_write(TINIFILE)
!
CALL WRITE_DESFM_n(1,TINIFILE)
!
@@ -1770,8 +1772,8 @@ IF (CSURF =='EXTE') THEN
TPGDFILE => TINIFILE
CALL PGD_GRID_SURF_ATM(YSURF_CUR%UG, YSURF_CUR%U,YSURF_CUR%GCP,'MESONH',TINIFILE%CNAME,'MESONH',.TRUE.,HDIR='-')
CALL PGD_SURF_ATM (YSURF_CUR,'MESONH',TINIFILE%CNAME,'MESONH',.TRUE.)
- CALL IO_FILE_ADD2LIST(TINIFILEPGD,TRIM(CINIFILEPGD),'PREPIDEALCASE','WRITE',KLFINPRAR=NNPRAR,KLFITYPE=NTYPE,KLFIVERB=NVERB)
- CALL IO_FILE_OPEN_ll (TINIFILEPGD)
+ CALL IO_File_add2list(TINIFILEPGD,TRIM(CINIFILEPGD),'PGD','WRITE',KLFINPRAR=NNPRAR,KLFITYPE=NTYPE,KLFIVERB=NVERB)
+ CALL IO_File_open (TINIFILEPGD)
TPGDFILE => TINIFILEPGD
ELSE
! ... or read from file.
@@ -1790,12 +1792,12 @@ IF (CSURF =='EXTE') THEN
!* writing of physiographic fields in the file
CSTORAGE_TYPE='PG'
!
- CALL IO_WRITE_HEADER(TINIFILEPGD)
- CALL IO_WRITE_FIELD(TINIFILEPGD,'JPHEXT', JPHEXT)
- CALL IO_WRITE_FIELD(TINIFILEPGD,'SURF','EXTE')
- CALL IO_WRITE_FIELD(TINIFILEPGD,'L1D', L1D)
- CALL IO_WRITE_FIELD(TINIFILEPGD,'L2D', L2D)
- CALL IO_WRITE_FIELD(TINIFILEPGD,'PACK',LPACK)
+ CALL IO_Header_write(TINIFILEPGD)
+ CALL IO_Field_write(TINIFILEPGD,'JPHEXT', JPHEXT)
+ CALL IO_Field_write(TINIFILEPGD,'SURF','EXTE')
+ CALL IO_Field_write(TINIFILEPGD,'L1D', L1D)
+ CALL IO_Field_write(TINIFILEPGD,'L2D', L2D)
+ CALL IO_Field_write(TINIFILEPGD,'PACK',LPACK)
CALL WRITE_HGRID(1,TINIFILEPGD)
!
TOUTDATAFILE => TINIFILEPGD
@@ -1825,11 +1827,11 @@ END IF
! ---------------
!
IF (CSURF =='EXTE' .AND. (LEN_TRIM(CPGD_FILE)==0 .OR. .NOT. LREAD_GROUND_PARAM)) THEN
- CALL IO_FILE_CLOSE_ll(TINIFILEPGD)
+ CALL IO_File_close(TINIFILEPGD)
ENDIF
-CALL IO_FILE_CLOSE_ll(TINIFILE)
+CALL IO_File_close(TINIFILE)
IF( LEN_TRIM(CPGD_FILE) /= 0 ) THEN
- CALL IO_FILE_CLOSE_ll(TPGDFILE)
+ CALL IO_File_close(TPGDFILE)
ENDIF
!
!
@@ -1873,7 +1875,7 @@ END IF
!
! Set File Timing OUTPUT
!
- CALL SET_ILUOUT_TIMING(NLUOUT)
+ CALL SET_ILUOUT_TIMING(TLUOUT0)
!
! Compute global time
!
@@ -1896,15 +1898,10 @@ WRITE(NLUOUT,FMT=*) '****************************************************'
WRITE(NLUOUT,FMT=*) '* PREP_IDEAL_CASE: PREP_IDEAL_CASE ENDS CORRECTLY. *'
WRITE(NLUOUT,FMT=*) '****************************************************'
!
-IF(NIO_VERB>=NVERB_DEBUG) CALL IO_FILE_PRINT_LIST()
+IF(NIO_VERB>=NVERB_DEBUG) CALL IO_Filelist_print()
!
-CALL IO_FILE_CLOSE_ll(TLUOUT)
+CALL IO_File_close(TLUOUT)
!
CALL END_PARA_ll(IINFO_ll)
!
-!
- !callabortstop
- !JUAN CALL ABORT
-STOP
-!
END PROGRAM PREP_IDEAL_CASE
diff --git a/src/MNH/prep_nest_pgd.f90 b/src/MNH/prep_nest_pgd.f90
index 7d9b2ae94b5d9c9eeb16d51f21d454599091d104..5b5a884f455416e1d7fd51e9ffc8677a7fc92f67 100644
--- a/src/MNH/prep_nest_pgd.f90
+++ b/src/MNH/prep_nest_pgd.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1995-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #####################
@@ -91,6 +91,7 @@
!! 06/2016 (G.Delautier) phasage surfex 8
!! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -100,7 +101,7 @@ USE MODD_CONF
USE MODD_CONF_n
USE MODD_CST
USE MODD_DIM_n
-USE MODD_IO_ll, ONLY: NIO_VERB, NVERB_DEBUG, TFILE_SURFEX, TPTR2FILE
+USE MODD_IO, ONLY: NIO_VERB, NVERB_DEBUG, TFILE_SURFEX, TPTR2FILE
USE MODD_GRID_n, ONLY: XZSMT
USE MODD_LUNIT, ONLY: TPGDFILE,TLUOUT0,TOUTDATAFILE
USE MODD_MNH_SURFEX_n
@@ -109,11 +110,11 @@ USE MODD_PARAMETERS
USE MODD_VAR_ll, ONLY: NPROC, IP, NMNH_COMM_WORLD
!
USE MODE_FIELD, ONLY: INI_FIELD_LIST
-USE MODE_FM
-USE MODE_FMREAD
-USE MODE_FMWRIT
-USE MODE_IO_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_PRINT_LIST
+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_ll
USE MODE_MNH_WORLD, ONLY: INIT_NMNH_COMM_WORLD
USE MODE_MODELN_HANDLER
@@ -167,7 +168,7 @@ CALL MPPDB_INIT()
CALL VERSION
CPROGRAM='NESPGD'
!
-CALL INITIO_ll()
+CALL IO_Init()
!!$CALL SET_JP_ll(JPMODELMAX,JPHEXT,JPVEXT,JPHEXT)
!
!* 1. INITIALIZATION OF PHYSICAL CONSTANTS
@@ -201,14 +202,14 @@ CALL INI_FIELD_LIST()
CALL SET_DAD0_ll()
DO JPGD=1,NMODEL
! read and set dimensions and ratios of model JPGD
- CALL IO_READ_FIELD(TZFILEPGD(JPGD)%TZFILE,'IMAX', IIMAX)
- CALL IO_READ_FIELD(TZFILEPGD(JPGD)%TZFILE,'JMAX', IJMAX)
- CALL IO_READ_FIELD(TZFILEPGD(JPGD)%TZFILE,'DXRATIO',NDXRATIO_ALL(JPGD))
- CALL IO_READ_FIELD(TZFILEPGD(JPGD)%TZFILE,'DYRATIO',NDYRATIO_ALL(JPGD))
- CALL IO_READ_FIELD(TZFILEPGD(JPGD)%TZFILE,'XSIZE', NXSIZE(JPGD))
- CALL IO_READ_FIELD(TZFILEPGD(JPGD)%TZFILE,'YSIZE', NYSIZE(JPGD))
- CALL IO_READ_FIELD(TZFILEPGD(JPGD)%TZFILE,'XOR', NXOR_ALL(JPGD))
- CALL IO_READ_FIELD(TZFILEPGD(JPGD)%TZFILE,'YOR', NYOR_ALL(JPGD))
+ CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'IMAX', IIMAX)
+ CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'JMAX', IJMAX)
+ CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'DXRATIO',NDXRATIO_ALL(JPGD))
+ CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'DYRATIO',NDYRATIO_ALL(JPGD))
+ CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'XSIZE', NXSIZE(JPGD))
+ CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'YSIZE', NYSIZE(JPGD))
+ CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'XOR', NXOR_ALL(JPGD))
+ CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'YOR', NYOR_ALL(JPGD))
CALL SET_DIM_ll(IIMAX, IJMAX, 1)
! compute origin and end of local subdomain of model JPGD
! initialize variables from MODD_NESTING, origin and end of global model JPGD in coordinates of its father
@@ -245,10 +246,10 @@ DO JPGD=1,NMODEL
CALL GOTO_MODEL(JPGD)
CALL GO_TOMODEL_ll(JPGD,IINFO_ll)
CALL GOTO_SURFEX(JPGD)
- CALL IO_READ_FIELD(TZFILEPGD(JPGD)%TZFILE,'L1D', L1D_ALL(JPGD))
- CALL IO_READ_FIELD(TZFILEPGD(JPGD)%TZFILE,'L2D', L2D_ALL(JPGD))
- CALL IO_READ_FIELD(TZFILEPGD(JPGD)%TZFILE,'PACK',LPACK_ALL(JPGD))
- CALL SET_FMPACK_ll(L1D_ALL(JPGD),L2D_ALL(JPGD),LPACK_ALL(JPGD))
+ CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'L1D', L1D_ALL(JPGD))
+ CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'L2D', L2D_ALL(JPGD))
+ CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'PACK',LPACK_ALL(JPGD))
+ CALL IO_Pack_set(L1D_ALL(JPGD),L2D_ALL(JPGD),LPACK_ALL(JPGD))
CALL READ_HGRID(JPGD,TZFILEPGD(JPGD)%TZFILE,YMY_NAME,YDAD_NAME,YSTORAGE_TYPE)
CSTORAGE_TYPE='PG'
END DO
@@ -334,12 +335,12 @@ DO JPGD=1,NMODEL
TOUTDATAFILE => TZFILENESTPGD(JPGD)%TZFILE
CALL GOTO_MODEL(JPGD)
!Open done here because grid dimensions have to be known
- CALL IO_FILE_OPEN_ll(TZFILENESTPGD(JPGD)%TZFILE,OPARALLELIO=.FALSE.)
+ CALL IO_File_open(TZFILENESTPGD(JPGD)%TZFILE)
CALL GOTO_SURFEX(JPGD)
TFILE_SURFEX => TZFILENESTPGD(JPGD)%TZFILE
CALL WRITE_PGD_SURF_ATM_n(YSURF_CUR,'MESONH')
NULLIFY(TFILE_SURFEX)
- CALL IO_WRITE_FIELD(TZFILENESTPGD(JPGD)%TZFILE,'ZSMT',XZSMT)
+ CALL IO_Field_write(TZFILENESTPGD(JPGD)%TZFILE,'ZSMT',XZSMT)
END DO
!
!-------------------------------------------------------------------------------
@@ -349,18 +350,18 @@ END DO
!
!
DO JPGD=1,NMODEL
- CALL IO_WRITE_HEADER(TZFILENESTPGD(JPGD)%TZFILE)
+ CALL IO_Header_write(TZFILENESTPGD(JPGD)%TZFILE)
IF ( ASSOCIATED(TZFILENESTPGD(JPGD)%TZFILE%TDADFILE) ) THEN
- CALL IO_WRITE_FIELD(TZFILENESTPGD(JPGD)%TZFILE,'DXRATIO',NDXRATIO_ALL(JPGD))
- CALL IO_WRITE_FIELD(TZFILENESTPGD(JPGD)%TZFILE,'DYRATIO',NDYRATIO_ALL(JPGD))
- CALL IO_WRITE_FIELD(TZFILENESTPGD(JPGD)%TZFILE,'XOR', NXOR_ALL(JPGD))
- CALL IO_WRITE_FIELD(TZFILENESTPGD(JPGD)%TZFILE,'YOR', NYOR_ALL(JPGD))
+ CALL IO_Field_write(TZFILENESTPGD(JPGD)%TZFILE,'DXRATIO',NDXRATIO_ALL(JPGD))
+ CALL IO_Field_write(TZFILENESTPGD(JPGD)%TZFILE,'DYRATIO',NDYRATIO_ALL(JPGD))
+ CALL IO_Field_write(TZFILENESTPGD(JPGD)%TZFILE,'XOR', NXOR_ALL(JPGD))
+ CALL IO_Field_write(TZFILENESTPGD(JPGD)%TZFILE,'YOR', NYOR_ALL(JPGD))
END IF
- CALL IO_WRITE_FIELD(TZFILENESTPGD(JPGD)%TZFILE,'SURF', 'EXTE')
- CALL IO_WRITE_FIELD(TZFILENESTPGD(JPGD)%TZFILE,'L1D', L1D_ALL(JPGD))
- CALL IO_WRITE_FIELD(TZFILENESTPGD(JPGD)%TZFILE,'L2D', L2D_ALL(JPGD))
- CALL IO_WRITE_FIELD(TZFILENESTPGD(JPGD)%TZFILE,'PACK', LPACK_ALL(JPGD))
- CALL IO_WRITE_FIELD(TZFILENESTPGD(JPGD)%TZFILE,'JPHEXT',JPHEXT)
+ CALL IO_Field_write(TZFILENESTPGD(JPGD)%TZFILE,'SURF', 'EXTE')
+ CALL IO_Field_write(TZFILENESTPGD(JPGD)%TZFILE,'L1D', L1D_ALL(JPGD))
+ CALL IO_Field_write(TZFILENESTPGD(JPGD)%TZFILE,'L2D', L2D_ALL(JPGD))
+ CALL IO_Field_write(TZFILENESTPGD(JPGD)%TZFILE,'PACK', LPACK_ALL(JPGD))
+ CALL IO_Field_write(TZFILENESTPGD(JPGD)%TZFILE,'JPHEXT',JPHEXT)
END DO
!
!-------------------------------------------------------------------------------
@@ -369,8 +370,8 @@ END DO
! --------------------
!
DO JPGD=1,NMODEL
- CALL IO_FILE_CLOSE_ll(TZFILEPGD(JPGD)%TZFILE, OPARALLELIO=.FALSE.)
- CALL IO_FILE_CLOSE_ll(TZFILENESTPGD(JPGD)%TZFILE,OPARALLELIO=.FALSE.)
+ CALL IO_File_close(TZFILEPGD(JPGD)%TZFILE)
+ CALL IO_File_close(TZFILENESTPGD(JPGD)%TZFILE)
END DO
!
!* loop to spare enough time to transfer commands before end of program
@@ -383,14 +384,14 @@ END DO
!* 12. EPILOGUE
! --------
!
-IF(NIO_VERB>=NVERB_DEBUG) CALL IO_FILE_PRINT_LIST()
+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_ll(TLUOUT0)
+CALL IO_File_close(TLUOUT0)
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/prep_pgd.f90 b/src/MNH/prep_pgd.f90
index d7b5899bc4db7c5bfbe2970a1531c02c9b30e40c..86b375631f93207762fa91052e5412c6c11d7679 100644
--- a/src/MNH/prep_pgd.f90
+++ b/src/MNH/prep_pgd.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1995-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
! ################
PROGRAM PREP_PGD
! ################
@@ -73,7 +74,11 @@
!! 01/2018 (G.Delautier) SURFEX 8.1
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! Q. Rodier 01/2019 : add a new filtering for very high slopes in NAM_ZSFILTER
-!!
+! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list
+! 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
+!
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
@@ -81,21 +86,22 @@
!
USE MODD_CONF, ONLY : CPROGRAM, L1D, L2D, LPACK, LCARTESIAN
USE MODD_CONF_n,ONLY : CSTORAGE_TYPE
-USE MODD_LUNIT, ONLY : CLUOUT0,TLUOUT0
+USE MODD_LUNIT, ONLY : TLUOUT0
USE MODD_LUNIT_n,ONLY : LUNIT_MODEL
USE MODD_PARAMETERS, ONLY : XUNDEF
-USE MODD_IO_ll, ONLY : NIO_VERB,NVERB_DEBUG,TFILEDATA,TFILE_OUTPUTLISTING,TFILE_SURFEX
+USE MODD_IO, ONLY : NIO_VERB,NVERB_DEBUG,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_POS
-USE MODE_FM
-USE MODE_FMWRIT
-USE MODE_IO_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY : IO_FILE_ADD2LIST,IO_FILE_PRINT_LIST
+USE MODE_FIELD
+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_MODELN_HANDLER
USE MODE_MSG
-USE MODE_FIELD
+USE MODE_POS
!
USE MODI_ZSMT_PGD
!
@@ -159,13 +165,12 @@ CPROGRAM='PGD '
!* 1. Set default names and parallelized I/O
! --------------------------------------
!
-CALL INITIO_ll()
+CALL IO_Init()
!
NHALO=15
!
-CLUOUT0='OUTPUT_LISTING0' ! Name of the output-listing.
-CALL IO_FILE_ADD2LIST(TLUOUT0,'OUTPUT_LISTING0','OUTPUTLISTING','WRITE')
-CALL IO_FILE_OPEN_ll(TLUOUT0)
+CALL IO_File_add2list(TLUOUT0,'OUTPUT_LISTING0','OUTPUTLISTING','WRITE')
+CALL IO_File_open(TLUOUT0)
!
!Set output file for PRINT_MSG
TFILE_OUTPUTLISTING => TLUOUT0
@@ -174,8 +179,8 @@ LUNIT_MODEL(1)%TLUOUT => TLUOUT0
ILUOUT0=TLUOUT0%NLU
!
!JUAN
-CALL IO_FILE_ADD2LIST(TZNMLFILE,'PRE_PGD1.nam','NML','READ')
-CALL IO_FILE_OPEN_ll(TZNMLFILE,KRESP=IRESP)
+CALL IO_File_add2list(TZNMLFILE,'PRE_PGD1.nam','NML','READ')
+CALL IO_File_open(TZNMLFILE,KRESP=IRESP)
ILUNAM = TZNMLFILE%NLU
IF (IRESP.NE.0 ) THEN
WRITE(YMSG,*) 'file PRE_PGD1.nam not found, IRESP=', IRESP
@@ -202,9 +207,9 @@ ENDIF
!JUANZ
CALL POSNAM(ILUNAM,'NAM_CONFIO',GFOUND)
IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_CONFIO)
-CALL SET_CONFIO_ll()
+CALL IO_Config_set()
!
-CALL IO_FILE_CLOSE_ll(TZNMLFILE)
+CALL IO_File_close(TZNMLFILE)
!
!
CALL SURFEX_ALLOC_LIST(1)
@@ -244,16 +249,16 @@ CALL PGD_SURF_ATM(YSURF_CUR,'MESONH',' ',' ',.FA
!* 3. Writes the physiographic fields
! -------------------------------
!
-CALL IO_FILE_ADD2LIST(TZFILE,CPGDFILE,'PREPPGD','WRITE',KLFINPRAR=INT(1,KIND=LFI_INT),KLFITYPE=1,KLFIVERB=5)
+CALL IO_File_add2list(TZFILE,CPGDFILE,'PGD','WRITE',KLFINPRAR=INT(1,KIND=LFIINT),KLFITYPE=1,KLFIVERB=5)
!
-CALL IO_FILE_OPEN_ll(TZFILE,OPARALLELIO=.FALSE.)
+CALL IO_File_open(TZFILE)
!
-CALL IO_WRITE_HEADER(TZFILE)
+CALL IO_Header_write(TZFILE)
!
-CALL IO_WRITE_FIELD(TZFILE,'SURF','EXTE')
-CALL IO_WRITE_FIELD(TZFILE,'L1D', L1D)
-CALL IO_WRITE_FIELD(TZFILE,'L2D', L2D)
-CALL IO_WRITE_FIELD(TZFILE,'PACK',LPACK)
+CALL IO_Field_write(TZFILE,'SURF','EXTE')
+CALL IO_Field_write(TZFILE,'L1D', L1D)
+CALL IO_Field_write(TZFILE,'L2D', L2D)
+CALL IO_Field_write(TZFILE,'PACK',LPACK)
IF ( NDXRATIO <= 0 .AND. NDYRATIO <= 0 ) THEN
NDXRATIO = 1
NDYRATIO = 1
@@ -266,13 +271,13 @@ IF ( NXOR <= 0 .AND. NYOR <= 0 ) THEN
NXOR = 1
NYOR = 1
ENDIF
-CALL IO_WRITE_FIELD(TZFILE,'DXRATIO',NDXRATIO)
-CALL IO_WRITE_FIELD(TZFILE,'DYRATIO',NDYRATIO)
-CALL IO_WRITE_FIELD(TZFILE,'XSIZE', NXSIZE)
-CALL IO_WRITE_FIELD(TZFILE,'YSIZE', NYSIZE)
-CALL IO_WRITE_FIELD(TZFILE,'XOR', NXOR)
-CALL IO_WRITE_FIELD(TZFILE,'YOR', NYOR)
-CALL IO_WRITE_FIELD(TZFILE,'JPHEXT', JPHEXT)
+CALL IO_Field_write(TZFILE,'DXRATIO',NDXRATIO)
+CALL IO_Field_write(TZFILE,'DYRATIO',NDYRATIO)
+CALL IO_Field_write(TZFILE,'XSIZE', NXSIZE)
+CALL IO_Field_write(TZFILE,'YSIZE', NYSIZE)
+CALL IO_Field_write(TZFILE,'XOR', NXOR)
+CALL IO_Field_write(TZFILE,'YOR', NYOR)
+CALL IO_Field_write(TZFILE,'JPHEXT', JPHEXT)
!
TFILE_SURFEX => TZFILE
ALLOCATE(YSURF_CUR%DUO%CSELECT(0))
@@ -309,8 +314,8 @@ IF (.NOT.LCARTESIAN) THEN
ZWORK_LON(:,1) = ZWORK_LON(:,2)
ZWORK_LON(:,IJMAX+2) = ZWORK_LON(:,IJMAX+1)
ENDIF
- CALL IO_WRITE_FIELD(TZFILE,'LAT',ZWORK_LAT)
- CALL IO_WRITE_FIELD(TZFILE,'LON',ZWORK_LON)
+ CALL IO_Field_write(TZFILE,'LAT',ZWORK_LAT)
+ CALL IO_Field_write(TZFILE,'LON',ZWORK_LON)
!
DEALLOCATE(ZWORK,ZWORK_LAT,ZWORK_LON)
END IF
@@ -324,13 +329,13 @@ WRITE(ILUOUT0,*) '***************************'
!* 6. Close parallelized I/O
! ----------------------
!
-CALL IO_FILE_CLOSE_ll(TZFILE,OPARALLELIO=.FALSE.)
+CALL IO_File_close(TZFILE)
!
CALL SURFEX_DEALLO_LIST
!
-IF(NIO_VERB>=NVERB_DEBUG) CALL IO_FILE_PRINT_LIST()
+IF(NIO_VERB>=NVERB_DEBUG) CALL IO_Filelist_print()
!
-CALL IO_FILE_CLOSE_ll(TLUOUT0,OPARALLELIO=.FALSE.)
+CALL IO_File_close(TLUOUT0)
!
CALL END_PARA_ll(IINFO_ll)
!
diff --git a/src/MNH/prep_real_case.f90 b/src/MNH/prep_real_case.f90
index a11651b58556f0605edf0f6d6f4e4a325ad29826..37f5ab5a912946fa4cb3c2e7e179dc8a37c1655b 100644
--- a/src/MNH/prep_real_case.f90
+++ b/src/MNH/prep_real_case.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1995-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ######################
@@ -259,7 +259,7 @@
!! initialized
!! Routine WRITE_DESFM1 : to write a DESFM file.
!! Routine WRITE_LFIFM1 : to write a LFIFM file.
-!! Routine IO_FILE_CLOSE_ll : to close a FM-file (DESFM + LFIFM).
+!! Routine IO_File_close : to close a FM-file (DESFM + LFIFM).
!!
!! Module MODE_GRIDPROJ : contains conformal projection routines
!!
@@ -287,7 +287,6 @@
!! Module MODD_CONF1 : contains configuration variables for model 1.
!! NRR : number of moist variables
!! Module MODD_LUNIT : contains logical unit and names of files.
-!! CLUOUT0 : name of output-listing
!! Module MODD_LUNIT : contains logical unit and names of files (model1).
!! CINIFILE: name of the FM file which will be used for the MESO-NH run.
!! Module MODD_GRID1 : contains grid variables.
@@ -379,6 +378,10 @@
!! 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
+! P. Wautelet 20/03/2019: missing use MODI_INIT_SALT
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -398,10 +401,10 @@ USE MODD_GR_FIELD_n
USE MODD_GRID
USE MODD_GRID_n
USE MODD_HURR_CONF
-USE MODD_IO_ll, ONLY: TFILEDATA,NIO_VERB,NVERB_DEBUG,TFILE_SURFEX
+USE MODD_IO, ONLY: TFILEDATA,NIO_VERB,NVERB_DEBUG,TFILE_SURFEX
USE MODD_LBC_n
USE MODD_LSFIELD_n
-USE MODD_LUNIT, ONLY: CLUOUT0,TPGDFILE,TLUOUT0,TOUTDATAFILE
+USE MODD_LUNIT, ONLY: TPGDFILE,TLUOUT0,TOUTDATAFILE
USE MODD_LUNIT_n, ONLY: CINIFILE,TINIFILE,TLUOUT
USE MODD_METRICS_n
USE MODD_MNH_SURFEX_n
@@ -416,13 +419,13 @@ USE MODD_TURB_n
!
USE MODE_EXTRAPOL
USE MODE_FIELD
-USE MODE_FM
-USE MODE_FMREAD
-USE MODE_FMWRIT, ONLY: IO_WRITE_HEADER
USE MODE_GRIDCART
USE MODE_GRIDPROJ
-USE MODE_IO_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST, IO_FILE_FIND_BYNAME,IO_FILE_PRINT_LIST
+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_ll
USE MODE_MODELN_HANDLER
USE MODE_MPPDB
@@ -437,6 +440,7 @@ USE MODI_DEALLOC_PARA_LL
USE MODI_DEFAULT_DESFM_n
USE MODI_ERROR_ON_TEMPERATURE
USE MODI_INI_PROG_VAR
+USE MODI_INIT_SALT
USE MODI_METRICS
USE MODI_MNHREAD_ZS_DUMMY_n
USE MODI_MNHWRITE_ZS_DUMMY_n
@@ -563,7 +567,7 @@ IDX_RVT = 1
!
!* 2. OPENNING OF THE FILES
! ---------------------
-CALL INITIO_ll()
+CALL IO_Init()
!
CALL OPEN_PRC_FILES(TZPRE_REAL1FILE,YATMFILE, YATMFILETYPE,TZATMFILE &
,YCHEMFILE,YCHEMFILETYPE &
@@ -625,8 +629,8 @@ IF (YATMFILETYPE == 'GRIBEX') THEN
CALL INIT_NMLVAR()
CALL READ_VER_GRID(TZPRE_REAL1FILE)
!
-CALL IO_READ_FIELD(TPGDFILE,'IMAX',NIMAX)
-CALL IO_READ_FIELD(TPGDFILE,'JMAX',NJMAX)
+CALL IO_Field_read(TPGDFILE,'IMAX',NIMAX)
+CALL IO_Field_read(TPGDFILE,'JMAX',NJMAX)
!
NIMAX_ll=NIMAX !! _ll variables are global variables
NJMAX_ll=NJMAX !! but the old names are kept in PRE_IDEA1.nam file
@@ -688,6 +692,9 @@ 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)
!
+! Sea salt
+CALL INIT_SALT
+!
!* 4.3 set soil scheme to ISBA for initialization from GRIB
!
IF (YATMFILETYPE=='GRIBEX') THEN
@@ -739,14 +746,14 @@ IF(LEN_TRIM(YCHEMFILE)>0)THEN
CALL READ_CHEM_DATA_NETCDF_CASE(TZPRE_REAL1FILE,YCHEMFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL)
END IF
!
-CALL IO_FILE_CLOSE_ll(TZPRE_REAL1FILE)
+CALL IO_File_close(TZPRE_REAL1FILE)
!
CALL SECOND_MNH(ZTIME2)
ZREAD = ZTIME2 - ZTIME1 - ZHORI
!-------------------------------------------------------------------------------
!
-CALL IO_FILE_ADD2LIST(TINIFILE,CINIFILE,'PREPREALCASE','WRITE',KLFITYPE=1,KLFIVERB=NVERB)
-CALL IO_FILE_OPEN_ll(TINIFILE)
+CALL IO_File_add2list(TINIFILE,CINIFILE,'MNH','WRITE',KLFITYPE=1,KLFIVERB=NVERB)
+CALL IO_File_open(TINIFILE)
!
ZTIME1=ZTIME2
!
@@ -958,14 +965,14 @@ ZDYN = ZTIME2 - ZTIME1
ZTIME1 = ZTIME2
!
IF(LEN_TRIM(YCHEMFILE)>0 .AND. YCHEMFILETYPE=='MESONH')THEN
- CALL INI_PROG_VAR(CLUOUT0,XTKE_MX,XSV_MX,YCHEMFILE)
+ CALL INI_PROG_VAR(XTKE_MX,XSV_MX,YCHEMFILE)
LHORELAX_SVCHEM = (NSV_CHEM > 0)
LHORELAX_SVCHIC = (NSV_CHIC > 0)
LHORELAX_SVDST = (NSV_DST > 0)
LHORELAX_SVSLT = (NSV_SLT > 0)
LHORELAX_SVAER = (NSV_AER > 0)
ELSE
- CALL INI_PROG_VAR(CLUOUT0,XTKE_MX,XSV_MX)
+ CALL INI_PROG_VAR(XTKE_MX,XSV_MX)
END IF
!
IF (ALLOCATED(XSV_MX)) DEALLOCATE(XSV_MX)
@@ -1047,7 +1054,7 @@ IF (YATMFILETYPE=='GRIBEX') THEN
END IF
!
CALL WRITE_DESFM_n(1,TINIFILE)
-CALL IO_WRITE_HEADER(TINIFILE,HDAD_NAME=YDAD_NAME)
+CALL IO_Header_write(TINIFILE,HDAD_NAME=YDAD_NAME)
CALL WRITE_LFIFM_n(TINIFILE,YDAD_NAME)
!
CALL SECOND_MNH(ZTIME2)
@@ -1070,8 +1077,8 @@ CALL MNHWRITE_ZS_DUMMY_n(TINIFILE)
CALL DEALLOCATE_MODEL1(3)
!
IF (YATMFILETYPE=='MESONH'.AND. YATMFILE/=YPGDFILE) THEN
- CALL IO_FILE_FIND_BYNAME(TRIM(YATMFILE),TZATMFILE,IRESP)
- CALL IO_FILE_CLOSE_ll(TZATMFILE)
+ CALL IO_File_find_byname(TRIM(YATMFILE),TZATMFILE,IRESP)
+ CALL IO_File_close(TZATMFILE)
END IF
!-------------------------------------------------------------------------------
!
@@ -1177,12 +1184,12 @@ END IF
!
!-------------------------------------------------------------------------------
!
-CALL IO_FILE_CLOSE_ll(TINIFILE)
-CALL IO_FILE_CLOSE_ll(TPGDFILE)
+CALL IO_File_close(TINIFILE)
+CALL IO_File_close(TPGDFILE)
!
-IF(NIO_VERB>=NVERB_DEBUG) CALL IO_FILE_PRINT_LIST()
+IF(NIO_VERB>=NVERB_DEBUG) CALL IO_Filelist_print()
!
-CALL IO_FILE_CLOSE_ll(TLUOUT0)
+CALL IO_File_close(TLUOUT0)
!
!
CALL END_PARA_ll(IINFO_ll)
diff --git a/src/MNH/prep_surf_mnh.f90 b/src/MNH/prep_surf_mnh.f90
index afe9493b2b65cbdd6ed823a695eefc49f81e3f15..0e6c02cfbdaeba34678e247617addfc33b6a3605 100644
--- a/src/MNH/prep_surf_mnh.f90
+++ b/src/MNH/prep_surf_mnh.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2004-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -53,7 +53,7 @@ USE MODD_LUNIT_n, ONLY : CINIFILE, TINIFILE
USE MODD_MNH_SURFEX_n
USE MODD_TIME_n, ONLY : TDTCUR
!
-USE MODE_FM, ONLY : IO_FILE_OPEN_ll
+USE MODE_IO_FILE, ONLY: IO_File_open
USE MODE_PREP_CTL, ONLY : PREP_CTL
!
USE MODI_INIT_PGD_SURF_ATM
@@ -100,7 +100,7 @@ CALL INIT_PGD_SURF_ATM(YSURF_CUR,'MESONH','PRE',HATMFILE,YATMFILETYPE, &
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)
- IF (OINIFILEOPEN) CALL IO_FILE_OPEN_ll(TINIFILE)
+ IF (OINIFILEOPEN) CALL IO_File_open(TINIFILE)
END IF
CALL WRITE_SURF_ATM_n(YSURF_CUR,'MESONH','PRE',.FALSE.)
CALL WRITE_DIAG_SURF_ATM_n(YSURF_CUR,'MESONH','PRE')
diff --git a/src/MNH/prep_surfex.f90 b/src/MNH/prep_surfex.f90
index 1bf961ea0cc76b82941a06ce6bce9bc7c332d6eb..c21d5caa82474b699b1cf1a0b27a23897f3160b1 100644
--- a/src/MNH/prep_surfex.f90
+++ b/src/MNH/prep_surfex.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2004-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -26,6 +26,7 @@
!! 10/10/2011 J.Escobar call INI_PARAZ_ll
!! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -34,19 +35,19 @@
USE MODD_CONF, ONLY : CPROGRAM,&
L1D, L2D, LPACK
USE MODD_CONF_n, ONLY : CSTORAGE_TYPE
-USE MODD_IO_ll, ONLY : TFILEDATA, NIO_VERB, NVERB_DEBUG, TFILE_SURFEX
-USE MODD_LUNIT, ONLY : CLUOUT0, TPGDFILE, TLUOUT0
+USE MODD_IO, ONLY : TFILEDATA, NIO_VERB, NVERB_DEBUG, 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_FM
-USE MODE_FMREAD
-USE MODE_FMWRIT
-USE MODE_IO_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY : IO_FILE_ADD2LIST,IO_FILE_PRINT_LIST
+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_ll
USE MODE_MSG
USE MODE_MODELN_HANDLER
@@ -99,7 +100,7 @@ CSTORAGE_TYPE='SU'
!
!* 2. OPENNING OF THE FILES
! ---------------------
-CALL INITIO_ll()
+CALL IO_Init()
!
CALL OPEN_PRC_FILES(TZPRE_REAL1FILE,YATMFILE, YATMFILETYPE,TZATMFILE &
,YCHEMFILE,YCHEMFILETYPE &
@@ -121,7 +122,7 @@ CALL INI_CST
!
!* 4.1 reading of configuration variables
!
-CALL IO_FILE_CLOSE_ll(TZPRE_REAL1FILE)
+CALL IO_File_close(TZPRE_REAL1FILE)
!
!* 4.2 reading of values of some configuration variables in namelist
!
@@ -129,8 +130,8 @@ CALL INI_FIELD_LIST(1)
!
CALL INI_FIELD_SCALARS()
!
-CALL IO_READ_FIELD(TPGDFILE,'IMAX',II)
-CALL IO_READ_FIELD(TPGDFILE,'JMAX',IJ)
+CALL IO_Field_read(TPGDFILE,'IMAX',II)
+CALL IO_Field_read(TPGDFILE,'JMAX',IJ)
CALL SET_JP_ll(JPMODELMAX,JPHEXT,JPVEXT,JPHEXT)
CALL SET_DAD0_ll()
CALL SET_DIM_ll(II, IJ, 1)
@@ -155,10 +156,10 @@ CALL INI_PARAZ_ll(IINFO_ll)
!* reading of date
!
IF (YATMFILETYPE=='MESONH') THEN
- CALL IO_FILE_ADD2LIST(TZATMFILE,TRIM(YATMFILE),'UNKNOWN','READ',KLFITYPE=1,KLFIVERB=1)
- CALL IO_FILE_OPEN_ll(TZATMFILE)
- CALL IO_READ_FIELD(TZATMFILE,'DTCUR',TDTCUR)
- CALL IO_FILE_CLOSE_ll(TZATMFILE)
+ CALL IO_File_add2list(TZATMFILE,TRIM(YATMFILE),'MNH','READ',KLFITYPE=1,KLFIVERB=1)
+ CALL IO_File_open(TZATMFILE)
+ CALL IO_Field_read(TZATMFILE,'DTCUR',TDTCUR)
+ CALL IO_File_close(TZATMFILE)
ELSE
TDTCUR%TDATE%YEAR = NUNDEF
TDTCUR%TDATE%MONTH= NUNDEF
@@ -171,7 +172,7 @@ YSURF_CUR => YSURF_LIST(1)
CALL READ_ALL_NAMELISTS(YSURF_CUR,'MESONH','PRE',.FALSE.)
CALL GOTO_SURFEX(1)
!
-CALL IO_FILE_ADD2LIST(TINIFILE,TRIM(CINIFILE),'PREPSURFEX','WRITE',KLFITYPE=1,KLFIVERB=1)
+CALL IO_File_add2list(TINIFILE,TRIM(CINIFILE),'PGD','WRITE',KLFITYPE=1,KLFIVERB=1)
!The open is done later in PREP_SURF_MNH when domain dimensions are known
!
TFILE_SURFEX => TINIFILE
@@ -180,11 +181,11 @@ NULLIFY(TFILE_SURFEX)
!
!-------------------------------------------------------------------------------
!
-CALL IO_WRITE_HEADER(TINIFILE)
-CALL IO_WRITE_FIELD(TINIFILE,'SURF','EXTE')
-CALL IO_WRITE_FIELD(TINIFILE,'L1D', L1D)
-CALL IO_WRITE_FIELD(TINIFILE,'L2D', L2D)
-CALL IO_WRITE_FIELD(TINIFILE,'PACK',LPACK)
+CALL IO_Header_write(TINIFILE)
+CALL IO_Field_write(TINIFILE,'SURF','EXTE')
+CALL IO_Field_write(TINIFILE,'L1D', L1D)
+CALL IO_Field_write(TINIFILE,'L2D', L2D)
+CALL IO_Field_write(TINIFILE,'PACK',LPACK)
!
!-------------------------------------------------------------------------------
WRITE(ILUOUT0,*) ' '
@@ -193,11 +194,11 @@ WRITE(ILUOUT0,*) '| |'
WRITE(ILUOUT0,*) '| PREP_SURFEX ends correctly |'
WRITE(ILUOUT0,*) '| |'
WRITE(ILUOUT0,*) '----------------------------------'
-CALL IO_FILE_CLOSE_ll(TINIFILE)
+CALL IO_File_close(TINIFILE)
!
-IF(NIO_VERB>=NVERB_DEBUG) CALL IO_FILE_PRINT_LIST()
+IF(NIO_VERB>=NVERB_DEBUG) CALL IO_Filelist_print()
!
-CALL IO_FILE_CLOSE_ll(TLUOUT0)
+CALL IO_File_close(TLUOUT0)
!
CALL END_PARA_ll(IINFO_ll)
CALL SURFEX_DEALLO_LIST
diff --git a/src/MNH/pressure_in_prep.f90 b/src/MNH/pressure_in_prep.f90
index 844b549d633c8a5c2d28c651a9b8f4675af62633..7fafcfd88ec7e3521650a825432b5ae5ec5ab7dd 100644
--- a/src/MNH/pressure_in_prep.f90
+++ b/src/MNH/pressure_in_prep.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1998-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 for details. version 1.
@@ -71,7 +71,6 @@ END MODULE MODI_PRESSURE_IN_PREP
! ------------
!
USE MODE_ll
-USE MODE_IO_ll
USE MODE_MSG
!
USE MODI_ANEL_BALANCE_n
diff --git a/src/MNH/pressurez.f90 b/src/MNH/pressurez.f90
index ae75dc536e64c9223b6cf7cbe9a3e07399db4181..c9eca886954b3cf6d30b5b7690592d9a635f182e 100644
--- a/src/MNH/pressurez.f90
+++ b/src/MNH/pressurez.f90
@@ -217,6 +217,7 @@ END MODULE MODI_PRESSUREZ
!! J.escobar : check nb proc versus ZRESI & min(DIMX,DIMY)
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -230,10 +231,10 @@ USE MODD_DYN_n, ONLY: LRES, XRES
USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_MPIF
USE MODD_PARAMETERS
+use modd_precision, only: MNHREAL_MPI
USE MODD_REF, ONLY: LBOUSS
-USE MODD_VAR_ll, ONLY: MPI_PRECISION, NMNH_COMM_WORLD , NPROC
+USE MODD_VAR_ll, ONLY: NMNH_COMM_WORLD , NPROC
!
-USE MODE_IO_ll, ONLY: CLOSE_ll
USE MODE_ll
USE MODE_MPPDB
USE MODE_MSG
@@ -651,10 +652,8 @@ WRITE(ILUOUT,*) 'residual divergence / 2 DT', ZMAXVAL, &
' located at ', IMAXLOC
FLUSH(unit=ILUOUT)
IF (ABS(ZMAXVAL) .GT. 100.0 ) THEN
- WRITE(ILUOUT,*) ' pressurez.f90 STOP :: SOMETHING WRONG WITH PRESSURE , ABS(RESIDUAL) > 100.0 '
- FLUSH(unit=ILUOUT)
- STOP ' pressurez.f90 STOP :: SOMETHING WRONG WITH PRESSURE , ABS(RESIDUAL) > 100.0 '
-ENDIF
+ call Print_msg( NVERB_FATAL, 'GEN', 'PRESSUREZ', 'something wrong with pressure: abs(residual) > 100.0' )
+END IF
! number of iterations adjusted
IF (LRES) THEN
ZMAXRES = XRES
@@ -687,7 +686,7 @@ IF (LBUDGET_W) CALL BUDGET (PRWS,3,'PRES_BU_RW')
! -----------------------------
!
ZMAX = MAXVAL(ABS ( PRHODREF(:,:,IKB)-PRHODREF(:,:,IKE)) )
-CALL MPI_ALLREDUCE(ZMAX, ZMAX_ll, 1, MPI_PRECISION, MPI_MAX, &
+CALL MPI_ALLREDUCE(ZMAX, ZMAX_ll, 1, MNHREAL_MPI, MPI_MAX, &
NMNH_COMM_WORLD, KINFO)
!IF ( ABS(PRHODREF(IIB,IJB,IKB)-PRHODREF(IIB,IJB,IKE)) > 1.E-12 &
! .AND. KTCOUNT >0 ) THEN
diff --git a/src/MNH/prognos.f90 b/src/MNH/prognos.f90
index 791f813af2cd9393746b44b7e714bd4bb5e74718..569a2aa08c0b7312ed0f4494c4f94895063c5d09 100644
--- a/src/MNH/prognos.f90
+++ b/src/MNH/prognos.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2012-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2012-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 MODI_PROGNOS
@@ -67,7 +67,6 @@ USE MODD_CST
USE MODD_PARAM_C2R2
USE MODD_RAIN_C2R2_KHKO_PARAM
!
-USE MODE_IO_ll
USE MODE_MSG
!
USE MODI_GAMMA
diff --git a/src/MNH/radar_rain_ice.f90 b/src/MNH/radar_rain_ice.f90
index f3d2e2a0d435ef41660c0810c0547d2e42260236..eddac2294d8c62054116b7be77081b610e72aefb 100644
--- a/src/MNH/radar_rain_ice.f90
+++ b/src/MNH/radar_rain_ice.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1996-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
! ##########################
@@ -128,8 +128,6 @@ USE MODD_PARAMETERS
USE MODD_PARAM_n, ONLY : CCLOUD
USE MODD_LUNIT
!
-USE MODE_IO_ll
-!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
diff --git a/src/MNH/radar_scattering.f90 b/src/MNH/radar_scattering.f90
index fdc5bf15f79656b432b7a3b4ee2977e140600bef..dc3ddc1e5027eed57ce8610829eef632598ac9ac 100644
--- a/src/MNH/radar_scattering.f90
+++ b/src/MNH/radar_scattering.f90
@@ -1,12 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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$
-!-----------------------------------------------------------------
! ######spl
MODULE MODI_RADAR_SCATTERING
! #############################
@@ -106,7 +102,7 @@ END MODULE MODI_RADAR_SCATTERING
! ------------
!
USE MODD_CST
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT
USE MODD_PARAMETERS
USE MODD_RAIN_ICE_DESCR, ONLY: XALPHAR_I=>XALPHAR,XNUR_I=>XNUR,XDR_I=>XDR,XLBEXR_I=>XLBEXR,&
@@ -140,10 +136,9 @@ USE MODE_READTMAT
USE MODE_FGAU , ONLY:GAULAG
USE MODI_GAMMA, ONLY:GAMMA
!
-USE MODE_FM, ONLY: IO_FILE_CLOSE_ll,IO_FILE_OPEN_ll
-USE MODE_IO_ll
USE MODD_LUNIT
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST
+USE MODE_IO_FILE, ONLY: IO_File_close, IO_File_open
+USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list
USE MODE_MSG
!
@@ -750,8 +745,8 @@ DO JI=1,INBRAD
E12.5,2X,E12.5,2X,E12.5,2X,E12.5,2X,E12.5)
!rain
- CALL IO_FILE_ADD2LIST(TZFILE,YFILE_COEFINT(1),'TXT','READ')
- CALL IO_FILE_OPEN_ll(TZFILE,KRESP=IRESP)
+ CALL IO_File_add2list(TZFILE,YFILE_COEFINT(1),'TXT','READ')
+ CALL IO_File_open(TZFILE,KRESP=IRESP)
IUNIT = TZFILE%NLU
IF ( IRESP /= 0 ) THEN
WRITE(YMSG,*) "problem opening file ",TRIM(YFILE_COEFINT(1))
@@ -764,7 +759,7 @@ DO JI=1,INBRAD
ZIM_S22S11_T_R(ILINE),ZRE_S22FMS11FT_T_R(ILINE),ZIM_S22FT_T_R(ILINE),ZIM_S11FT_T_R(ILINE)
ILINE=ILINE+1
ENDDO
- CALL IO_FILE_CLOSE_ll(TZFILE)
+ CALL IO_File_close(TZFILE)
TZFILE => NULL()
WRITE(ILUOUT0,*) "NLIGNE rain",ILINE
ILINE=2
@@ -777,8 +772,8 @@ DO JI=1,INBRAD
ZIM_S22S11_T_R(ILINE),ZRE_S22FMS11FT_T_R(ILINE),ZIM_S22FT_T_R(ILINE),ZIM_S11FT_T_R(ILINE)
!snow
- CALL IO_FILE_ADD2LIST(TZFILE,YFILE_COEFINT(2),'TXT','READ')
- CALL IO_FILE_OPEN_ll(TZFILE,KRESP=IRESP)
+ CALL IO_File_add2list(TZFILE,YFILE_COEFINT(2),'TXT','READ')
+ CALL IO_File_open(TZFILE,KRESP=IRESP)
IUNIT = TZFILE%NLU
IF ( IRESP /= 0 ) THEN
WRITE(YMSG,*) "problem opening file ",TRIM(YFILE_COEFINT(2))
@@ -791,7 +786,7 @@ DO JI=1,INBRAD
ZIM_S22S11_T_S(ILINE),ZRE_S22FMS11FT_T_S(ILINE),ZIM_S22FT_T_S(ILINE),ZIM_S11FT_T_S(ILINE)
ILINE=ILINE+1
ENDDO
- CALL IO_FILE_CLOSE_ll(TZFILE)
+ CALL IO_File_close(TZFILE)
TZFILE => NULL()
WRITE(ILUOUT0,*) "NLIGNE snow",ILINE
ILINE=2
@@ -804,8 +799,8 @@ DO JI=1,INBRAD
ZIM_S22S11_T_S(ILINE),ZRE_S22FMS11FT_T_S(ILINE),ZIM_S22FT_T_S(ILINE),ZIM_S11FT_T_S(ILINE)
!graupel
- CALL IO_FILE_ADD2LIST(TZFILE,YFILE_COEFINT(3),'TXT','READ')
- CALL IO_FILE_OPEN_ll(TZFILE,KRESP=IRESP)
+ CALL IO_File_add2list(TZFILE,YFILE_COEFINT(3),'TXT','READ')
+ CALL IO_File_open(TZFILE,KRESP=IRESP)
IUNIT = TZFILE%NLU
IF ( IRESP /= 0 ) THEN
WRITE(YMSG,*) "problem opening file ",TRIM(YFILE_COEFINT(3))
@@ -818,7 +813,7 @@ DO JI=1,INBRAD
ZIM_S22S11_T_G(ILINE),ZRE_S22FMS11FT_T_G(ILINE),ZIM_S22FT_T_G(ILINE),ZIM_S11FT_T_G(ILINE)
ILINE=ILINE+1
ENDDO
- CALL IO_FILE_CLOSE_ll(TZFILE)
+ CALL IO_File_close(TZFILE)
TZFILE => NULL()
WRITE(ILUOUT0,*) "NLIGNE graupel",ILINE
ILINE=2
@@ -831,8 +826,8 @@ DO JI=1,INBRAD
ZIM_S22S11_T_G(ILINE),ZRE_S22FMS11FT_T_G(ILINE),ZIM_S22FT_T_G(ILINE),ZIM_S11FT_T_G(ILINE)
!wet graupel
- CALL IO_FILE_ADD2LIST(TZFILE,YFILE_COEFINT(4),'TXT','READ')
- CALL IO_FILE_OPEN_ll(TZFILE,KRESP=IRESP)
+ CALL IO_File_add2list(TZFILE,YFILE_COEFINT(4),'TXT','READ')
+ CALL IO_File_open(TZFILE,KRESP=IRESP)
IUNIT = TZFILE%NLU
IF ( IRESP /= 0 ) THEN
WRITE(YMSG,*) "problem opening file ",TRIM(YFILE_COEFINT(4))
@@ -845,7 +840,7 @@ DO JI=1,INBRAD
ZIM_S22S11_T_W(ILINE),ZRE_S22FMS11FT_T_W(ILINE),ZIM_S22FT_T_W(ILINE),ZIM_S11FT_T_W(ILINE)
ILINE=ILINE+1
ENDDO
- CALL IO_FILE_CLOSE_ll(TZFILE)
+ CALL IO_File_close(TZFILE)
TZFILE => NULL()
WRITE(ILUOUT0,*) "NLIGNE wet graupel",ILINE
ILINE=2
@@ -858,8 +853,8 @@ DO JI=1,INBRAD
!hail
IF (GHAIL) THEN
- CALL IO_FILE_ADD2LIST(TZFILE,YFILE_COEFINT(5),'TXT','READ')
- CALL IO_FILE_OPEN_ll(TZFILE,KRESP=IRESP)
+ CALL IO_File_add2list(TZFILE,YFILE_COEFINT(5),'TXT','READ')
+ CALL IO_File_open(TZFILE,KRESP=IRESP)
IUNIT = TZFILE%NLU
IF ( IRESP /= 0 ) THEN
WRITE(YMSG,*) "problem opening file ",TRIM(YFILE_COEFINT(5))
@@ -872,7 +867,7 @@ DO JI=1,INBRAD
ZIM_S22S11_T_H(ILINE),ZRE_S22FMS11FT_T_H(ILINE),ZIM_S22FT_T_H(ILINE),ZIM_S11FT_T_H(ILINE)
ILINE=ILINE+1
ENDDO
- CALL IO_FILE_CLOSE_ll(TZFILE)
+ CALL IO_File_close(TZFILE)
TZFILE => NULL()
WRITE(ILUOUT0,*) "NLIGNE hail",ILINE
ILINE=2
diff --git a/src/MNH/radar_simulator.f90 b/src/MNH/radar_simulator.f90
index 0735b1dc56e0813789e71d097fc3a4c2071f4bde..1d09ecc69198c2b91558b22c01081ffd166a8b43 100644
--- a/src/MNH/radar_simulator.f90
+++ b/src/MNH/radar_simulator.f90
@@ -1,12 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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/radar_simulator.f90,v $ $Revision: 1.1.2.3.2.1.12.2.2.2 $ $Date: 2015/09/16 14:31:20 $
-!-----------------------------------------------------------------
! ###########################
MODULE MODI_RADAR_SIMULATOR
! ###########################
@@ -63,10 +59,7 @@ END MODULE MODI_RADAR_SIMULATOR
!! Module MODD_RAIN_ICE_PARAM
!! Module MODD_PARAMETERS
!! Module MODD_LUNIT
-!
-!! Module MODE_IO_ll
-!! Module MODE_FM
-!
+!!
!! Module MODD_GR_FIELD_n
!! Module MODD_GRID_n
!! Module MODD_CONF_n
@@ -139,7 +132,6 @@ USE MODD_REF
USE MODD_PARAMETERS
USE MODD_LUNIT
!
-USE MODE_IO_ll
USE MODE_MSG
!
USE MODD_GR_FIELD_n
diff --git a/src/MNH/radiations.f90 b/src/MNH/radiations.f90
index 2bec821d736e9e3a9ff5ff6a75182ab7f12edfd9..5ba7853d4e07073b95db0db7c42d82e4ddde4e8d 100644
--- a/src/MNH/radiations.f90
+++ b/src/MNH/radiations.f90
@@ -118,6 +118,8 @@ CONTAINS
!! J.Escobar 28/06/2018 : Reproductible parallelisation of CLOUD_ONLY case
!! J.Escobar 20/07/2018 : for real*4 compilation, convert with REAL(X) argument to SUM_DD...
!! P.Wautelet 22/01/2019: use standard FLUSH statement instead of non standard intrinsics
+!! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -132,7 +134,7 @@ USE MODD_CST
USE MODD_DUST, ONLY: LDUST
USE MODD_GRID , ONLY: XLAT0, XLON0
USE MODD_GRID_n , ONLY: XLAT, XLON
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_NSV, ONLY: NSV_C2R2,NSV_C2R2BEG,NSV_C2R2END, &
NSV_C1R3,NSV_C1R3BEG,NSV_C1R3END, &
@@ -150,10 +152,11 @@ USE MODD_SALT, ONLY: LSALT
USE MODD_TIME
!
USE MODE_DUSTOPT
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPEREAL
-USE MODE_FMWRIT
+USE MODE_FIELD, ONLY: TFIELDDATA,TYPEREAL
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_ll
-USE MODE_REPRO_SUM, ONLY : SUM_DD_R2_R1_ll,SUM_DD_R1_ll
+use mode_msg
+USE MODE_REPRO_SUM, ONLY : SUM_DD_R2_R1_ll,SUM_DD_R1_ll
!
#ifdef MNH_PGI
USE MODE_PACK_PGI
@@ -580,7 +583,8 @@ IF ( ZMINVAL <= 0.0 ) THEN
WRITE(ILUOUT,*) ' radiation.f90 STOP :: SOMETHING WRONG WITH PRESSURE , ZDZPABST <= 0.0 '
WRITE(ILUOUT,*) ' radiation :: ZDZPABST ', ZMINVAL,' located at ', IMINLOC
FLUSH(unit=ILUOUT)
- STOP ' radiation.f90 STOP :: SOMETHING WRONG WITH PRESSURE , ZDZPABST < 0.0 '
+ call Print_msg( NVERB_FATAL, 'GEN', 'RADIATIONS', 'something wrong with pressure: ZDZPABST <= 0.0' )
+
ENDIF
!------------------------------------------------------------------------------
ALLOCATE(ZLAT(KDLON))
@@ -926,13 +930,15 @@ IF (CAOP=='EXPL') THEN
PSVT(IIB:IIE,IJB:IJE,:,NSV_SLTBEG:NSV_SLTEND) & !I [ppp] sea salt scalar concentration
,PZZ(IIB:IIE,IJB:IJE,:) & !I [m] height of layers
,PRHODREF(IIB:IIE,IJB:IJE,:) & !I [kg/m3] density of air
+ ,PTHT(IIB:IIE,IJB:IJE,:) & !I [K] potential temperature
+ ,PPABST(IIB:IIE,IJB:IJE,:) & !I [hPa] pressure
+ ,PRT(IIB:IIE,IJB:IJE,:,:) & !I [kg/kg] water mixing ratio
,ZPIZA_SLT_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] single scattering albedo of sea salt
,ZCGA_SLT_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] assymetry factor for sea salt
,ZTAUREL_SLT_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] opt.depth(wvl=lambda)/opt.depth(wvl=550nm)
,PAER_SLT(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT) & !O [-] optical depth of sea salt at wvl=550nm
,KSWB_OLD & !I |nbr] number of shortwave bands
)
-
ENDIF
ZTAUREL_EQ_TMP(:,:,:,:)=ZTAUREL_DST_TMP(:,:,:,:)+ZTAUREL_AER_TMP(:,:,:,:)+ZTAUREL_SLT_TMP(:,:,:,:)
@@ -1843,9 +1849,9 @@ DEALLOCATE(ZWORK_GRID)
ALLOCATE(ZQSAVE(SIZE(ZTAVE,1),SIZE(ZTAVE,2)))
!
WHERE (ZTAVE(:,:) > XTT)
- ZQSAVE(:,:) = QSATW_2D(ZTAVE, ZPAVE)
+ ZQSAVE(:,:) = QSAT(ZTAVE, ZPAVE)
ELSEWHERE
- ZQSAVE(:,:) = QSATI_2D(ZTAVE, ZPAVE)
+ ZQSAVE(:,:) = QSATI(ZTAVE, ZPAVE)
END WHERE
!
! allocations for the radiation code outputs
@@ -2699,7 +2705,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D)
!
DO JK=IKB,IKE
JKRAD = JK - JPVEXT
@@ -2720,7 +2726,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D)
!
DO JK=IKB,IKE
JKRAD = JK - JPVEXT
@@ -2741,7 +2747,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D)
!
DO JK=IKB,IKE
JKRAD = JK - JPVEXT
@@ -2762,7 +2768,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D)
!
DO JK=IKB,IKE
JKRAD = JK - JPVEXT
@@ -2783,7 +2789,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D)
!
DO JK=IKB,IKE
JKRAD = JK - JPVEXT
@@ -2804,7 +2810,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D)
!
DO JK=IKB,IKE
DO JJ=IJB,IJE
@@ -2823,7 +2829,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D)
!
DO JK=IKB,IKE
DO JJ=IJB,IJE
@@ -2842,7 +2848,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D)
!
DO JJ=IJB,IJE
DO JI=IIB,IIE
@@ -2860,7 +2866,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_2D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_2D)
!
DO JJ=IJB,IJE
DO JI=IIB,IIE
@@ -2878,7 +2884,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_2D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_2D)
!
DO JJ=IJB,IJE
DO JI=IIB,IIE
@@ -2896,7 +2902,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_2D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_2D)
END IF
!
!
@@ -2920,7 +2926,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D)
!
DO JK=IKB,IKE
JKRAD = JK - JPVEXT
@@ -2941,7 +2947,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D)
!
DO JK=IKB,IKE
JKRAD = JK - JPVEXT
@@ -2962,7 +2968,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D)
!
DO JK=IKB,IKE
JKRAD = JK - JPVEXT
@@ -2983,7 +2989,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D)
!
DO JK=IKB,IKE
JKRAD = JK - JPVEXT
@@ -3004,7 +3010,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D)
!
DO JK=IKB,IKE
JKRAD = JK - JPVEXT
@@ -3025,7 +3031,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D)
!
DO JK=IKB,IKE
JKRAD = JK-JPVEXT
@@ -3046,7 +3052,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D)
!
DO JK=IKB,IKE
JKRAD = JK-JPVEXT
@@ -3067,7 +3073,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D)
!
DO JJ=IJB,IJE
DO JI=IIB,IIE
@@ -3085,7 +3091,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_2D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_2D)
!
DO JJ=IJB,IJE
DO JI=IIB,IIE
@@ -3103,7 +3109,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_2D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_2D)
!
DO JJ=IJB,IJE
DO JI=IIB,IIE
@@ -3121,7 +3127,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_2D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_2D)
END IF
!
!
@@ -3142,7 +3148,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_2D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_2D)
!
DO JJ=IJB,IJE
DO JI=IIB,IIE
@@ -3160,7 +3166,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_2D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_2D)
!
DO JJ=IJB,IJE
DO JI=IIB,IIE
@@ -3178,7 +3184,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_2D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_2D)
!
DO JJ=IJB,IJE
DO JI=IIB,IIE
@@ -3196,7 +3202,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_2D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_2D)
!
DO JJ=IJB,IJE
DO JI=IIB,IIE
@@ -3214,7 +3220,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_2D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_2D)
!
DO JJ=IJB,IJE
DO JI=IIB,IIE
@@ -3232,7 +3238,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_2D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_2D)
!
!
END IF
@@ -3258,7 +3264,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D)
!
DO JK=IKB,IKE
JKRAD = JK - JPVEXT
@@ -3279,7 +3285,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D)
!
DO JK=IKB,IKE
JKRAD = JK - JPVEXT
@@ -3300,7 +3306,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D)
!
DO JK=IKB,IKE
JKRAD = JK - JPVEXT
@@ -3321,7 +3327,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D)
!
DO JK=IKB,IKE
JKRAD = JK - JPVEXT
@@ -3342,7 +3348,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D)
!
DO JK=IKB,IKE
JKRAD = JK - JPVEXT
@@ -3363,7 +3369,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D)
!
DO JK=IKB,IKE
JKRAD = JK - JPVEXT
@@ -3384,7 +3390,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D)
!
DO JK=IKB,IKE
JKRAD = JK - JPVEXT
@@ -3405,7 +3411,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D)
!
! spectral bands
IF (KSWB_OLD==6) THEN
@@ -3432,7 +3438,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZTAUAZ(:,:,:,JBAND))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZTAUAZ(:,:,:,JBAND))
!
TZFIELD%CMNHNAME = 'SSAAER_'//YBAND_NAME(JBAND)
TZFIELD%CSTDNAME = ''
@@ -3444,7 +3450,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZPIZAZ(:,:,:,JBAND))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPIZAZ(:,:,:,JBAND))
!
TZFIELD%CMNHNAME = 'GAER_'//YBAND_NAME(JBAND)
TZFIELD%CSTDNAME = ''
@@ -3456,7 +3462,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZCGAZ(:,:,:,JBAND))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZCGAZ(:,:,:,JBAND))
ENDDO
DO JBAND=1,KSWB_OLD
@@ -3479,7 +3485,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D)
!
DO JK=IKB,IKE
JKRAD = JK - JPVEXT
@@ -3500,7 +3506,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D)
!
DO JK=IKB,IKE
JKRAD = JK - JPVEXT
@@ -3521,7 +3527,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D)
END DO
END IF
!
@@ -3549,7 +3555,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D)
!
!cumulated optical thickness of aerosols
!cumul begin from the top of the domain, not from the TOA !
@@ -3580,7 +3586,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D2)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D2)
!
! sea
DO JK=IKB,IKE
@@ -3609,7 +3615,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D2)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D2)
!
! desert
DO JK=IKB,IKE
@@ -3638,7 +3644,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D2)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D2)
!
! urban
DO JK=IKB,IKE
@@ -3667,7 +3673,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D2)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D2)
!
! Volcanoes
DO JK=IKB,IKE
@@ -3696,7 +3702,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D2)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D2)
!
! stratospheric background
DO JK=IKB,IKE
@@ -3725,7 +3731,7 @@ IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSTORE_3D2)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSTORE_3D2)
ENDIF
END IF
!
diff --git a/src/MNH/rain_c2r2_khko.f90 b/src/MNH/rain_c2r2_khko.f90
index 33f070d10be68d5480793338f1caa331ce67f047..9139c89873568bf187fae069ad7787aa6f7557aa 100644
--- a/src/MNH/rain_c2r2_khko.f90
+++ b/src/MNH/rain_c2r2_khko.f90
@@ -1,12 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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/rain_c2r2_khko.f90,v $ $Revision: 1.1.2.1.2.3 $
-!-----------------------------------------------------------------
! ######################
MODULE MODI_RAIN_C2R2_KHKO
! ######################
@@ -24,7 +20,7 @@ INTERFACE
PSOLORG, PMI, HACTCCN, &
PINDEP, PSUPSAT, PNACT )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
CHARACTER(LEN=*), INTENT(IN) :: HCLOUD ! kind of cloud
@@ -225,7 +221,7 @@ END MODULE MODI_RAIN_C2R2_KHKO
USE MODD_PARAMETERS
USE MODD_CST
USE MODD_CONF
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAM_C2R2
USE MODD_RAIN_C2R2_DESCR
USE MODD_RAIN_C2R2_KHKO_PARAM
@@ -238,9 +234,8 @@ USE MODD_SALT
USE MODI_BUDGET
!
USE MODE_FIELD
-USE MODE_FM
USE MODE_ll
-USE MODE_FMWRIT
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODI_GAMMA
!
IMPLICIT NONE
@@ -602,7 +597,7 @@ INTEGER :: J1
! TZFIELD%NTYPE = TYPEREAL
! TZFIELD%NDIMS = 3
! TZFIELD%LTIMEDEP = .TRUE.
-! CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZCHEN)
+! CALL IO_Field_write(TPFILE,TZFIELD,ZCHEN)
! END IF
!
!-------------------------------------------------------------------------------
@@ -885,7 +880,7 @@ IF ( OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZZW1LOG)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZZW1LOG)
END IF
!
!* 3.4 budget storage
@@ -1912,7 +1907,7 @@ DO JN = 1 , KSPLITR
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWSEDC)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWSEDC)
!
TZFIELD%CMNHNAME = 'SEDFLUXR'
TZFIELD%CSTDNAME = ''
@@ -1924,7 +1919,7 @@ DO JN = 1 , KSPLITR
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWSEDR)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWSEDR)
END IF
END DO
!
diff --git a/src/MNH/rain_ice.f90 b/src/MNH/rain_ice.f90
index 81a74baa75e40db7a8b5ad995af1232057389a45..9d11bd3ee900c037915978e883f7732a8fc8e407 100644
--- a/src/MNH/rain_ice.f90
+++ b/src/MNH/rain_ice.f90
@@ -2,19 +2,20 @@
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C 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_RAIN_ICE
! ####################
!
INTERFACE
- SUBROUTINE RAIN_ICE ( OSEDIC,HSEDIM, HSUBG_AUCV, OWARM, KKA, KKU, KKL, &
- KSPLITR, PTSTEP, KRR, &
- PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
- PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
- PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
- PINPRS, PINPRG, PSIGS, PINDEP, PSEA, PTOWN, &
- PRHT, PRHS, PINPRH, PFPR )
+ SUBROUTINE RAIN_ICE ( OSEDIC,HSEDIM, HSUBG_AUCV, OWARM, KKA, KKU, KKL, &
+ KSPLITR, PTSTEP, KRR, &
+ PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
+ PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
+ PINPRC,PINPRR, PINPRR3D, PEVAP3D, &
+ PINPRS, PINPRG, PSIGS, PINDEP, PRAINFR, PSEA, PTOWN, &
+ PRHT, PRHS, PINPRH, PFPR )
!
!
LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
@@ -25,16 +26,16 @@ LOGICAL, INTENT(IN) :: OWARM ! .TRUE. allows raindrops to
! form by warm processes
! (Kessler scheme)
!
-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) :: 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) :: KSPLITR ! Number of small time step
- ! integration for rain sedimendation
+ ! integration for rain sedimendation
REAL, INTENT(IN) :: PTSTEP ! Double Time step
! (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Layer thickness (m)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Layer thikness (m)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
@@ -61,35 +62,34 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
!
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC! Cloud instant precip
REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud instant deposition
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D! Rain inst precip 3D
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
-!
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR! Rain instant precip
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PINPRR3D! Rain inst precip 3D
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D! Rain evap profile
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG! Graupel instant precip
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR! Rain fraction
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN! Fraction that is town
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(INOUT) :: PINPRH ! Hail instant precip
-REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PFPR ! Upper-air precipitation fluxes
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(INOUT) :: PINPRH! Hail instant precip
+REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
!
END SUBROUTINE RAIN_ICE
END INTERFACE
END MODULE MODI_RAIN_ICE
-! ##############################################################################
- SUBROUTINE RAIN_ICE ( OSEDIC,HSEDIM, HSUBG_AUCV, OWARM, KKA, KKU, KKL, &
- KSPLITR, PTSTEP, KRR, &
- PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
- PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
- PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
- PINPRS, PINPRG, PSIGS, PINDEP, PSEA, PTOWN, &
- PRHT, PRHS, PINPRH, PFPR )
-! ##############################################################################
+! ######spl
+ SUBROUTINE RAIN_ICE ( OSEDIC,HSEDIM, HSUBG_AUCV, OWARM, KKA, KKU, KKL, &
+ KSPLITR, PTSTEP, KRR, &
+ PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
+ PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
+ PINPRC,PINPRR, PINPRR3D, PEVAP3D, &
+ PINPRS, PINPRG, PSIGS, PINDEP, PRAINFR, PSEA, PTOWN, &
+ PRHT, PRHS, PINPRH, PFPR )
+! ######################################################################
!
!!**** * - compute the explicit microphysical sources
!!
@@ -238,33 +238,41 @@ END MODULE MODI_RAIN_ICE
!! J.Escobar : 10/2017 : for real*4 , limit exp() in RAIN_ICE_SLOW with XMNH_HUGE_12_LOG
!! (C. Abiven, Y. Léauté, V. Seigner, S. Riette) Phasing of Turner rain subgrid param
!! J.Escobar : 8/2018 : for real*4 , bis => limit exp() in RAIN_ICE_SLOW with XMNH_HUGE_12_LOG
-!-------------------------------------------------------------------------------
+!! P.Wautelet 01/02/2019: add missing initialization for PFPR
+!! 02/2019 C.Lac add rain fraction as an output field
+! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
-USE MODD_CONF
-USE MODD_CST
-USE MODD_LES
-USE MODD_PARAM_ICE
-USE MODD_PARAMETERS
-USE MODD_RAIN_ICE_DESCR
-USE MODD_RAIN_ICE_PARAM
+use MODD_BUDGET, only: LBU_ENABLE, LBUDGET_RC, LBUDGET_RG, LBUDGET_RH, LBUDGET_RI, &
+ LBUDGET_RR, LBUDGET_RS, LBUDGET_RV, LBUDGET_TH
+use MODD_CST, only: XCI, XCL, XCPD, XCPV, XLSTT, XLVTT, XTT
+use MODD_CST, only: XALPI, XBETAI, XGAMI, XMD, XMV, XTT
+use MODD_LES, only: LLES_CALL
+use MODD_PARAMETERS, only: JPVEXT
+use MODD_PARAM_ICE, only: CSUBG_PR_PDF, LDEPOSC
+use MODD_RAIN_ICE_DESCR, only: XLBEXR, XLBR, XRTMIN
+use MODD_RAIN_ICE_PARAM, only: XCRIAUTC
+!
+use MODE_MSG
+use MODE_RAIN_ICE_FAST_RG, only: RAIN_ICE_FAST_RG
+use MODE_RAIN_ICE_FAST_RH, only: RAIN_ICE_FAST_RH
+use MODE_RAIN_ICE_FAST_RI, only: RAIN_ICE_FAST_RI
+use MODE_RAIN_ICE_FAST_RS, only: RAIN_ICE_FAST_RS
+use MODE_RAIN_ICE_NUCLEATION, only: RAIN_ICE_NUCLEATION
+use MODE_RAIN_ICE_SEDIMENTATION_SPLIT, only: RAIN_ICE_SEDIMENTATION_SPLIT
+use MODE_RAIN_ICE_SEDIMENTATION_STAT, only: RAIN_ICE_SEDIMENTATION_STAT
+use MODE_RAIN_ICE_SLOW, only: RAIN_ICE_SLOW
+use MODE_RAIN_ICE_WARM, only: RAIN_ICE_WARM
!
-USE MODE_FMWRIT
-USE MODE_ll
-USE MODE_MPPDB
-USE MODE_MSG
#ifdef MNH_PGI
USE MODE_PACK_PGI
#endif
!
-#ifdef MNH_BITREP
-USE MODI_BITREP
-#endif
-USE MODI_BUDGET
-USE MODI_GAMMA
+use MODI_BUDGET
+USE MODI_ICE4_RAINFR_VERT
!
IMPLICIT NONE
!
@@ -280,16 +288,16 @@ LOGICAL, INTENT(IN) :: OWARM ! .TRUE. allows raindrops to
! form by warm processes
! (Kessler scheme)
!
-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) :: KSPLITR ! Number of small time step
- ! integration for rain sedimendation
+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) :: KSPLITR ! Number of small time step
+ ! integration for rain sedimendation
REAL, INTENT(IN) :: PTSTEP ! Double Time step
! (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Layer thickness (m)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Layer thikness (m)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
@@ -299,9 +307,9 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! Cloud fraction
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
@@ -316,268 +324,110 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
!
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC! Cloud instant precip
REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud instant deposition
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D! Rain inst precip 3D
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
-!
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR! Rain instant precip
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PINPRR3D! Rain inst precip 3D
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D! Rain evap profile
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG! Graupel instant precip
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR! Rain fraction
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN! Fraction that is town
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(INOUT) :: PINPRH ! Hail instant precip
-REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PFPR ! Upper-air precipitation fluxes
-!
-! IN variables
-!
-!$acc declare present(PDZZ,PRHODJ,PRHODREF,PEXNREF,PPABST, &
-!$acc & PCLDFR,PTHT,PRVT,PRCT,PRRT,PRIT,PRST,PRGT, &
-!$acc & PSIGS,PSEA,PTOWN,PRHT,PFPR) &
-!
-! INOUT variables
-!
-!$acc & present(PCIT,PTHS,PRVS,PRCS,PRRS,PRIS,PRSS,PRGS, &
-!$acc & PINPRC,PINDEP,PINPRR,PINPRR3D,PEVAP3D, &
-!$acc & PINPRS,PINPRG,PRHS,PINPRH)
-
-!
-! OUT variables
-!
-!***NONE***
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(INOUT) :: PINPRH! Hail instant precip
+REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
!
!* 0.2 Declarations of local variables :
!
-INTEGER :: JK ! Vertical loop index for the rain sedimentation
-INTEGER :: JN ! Temporal loop index for the rain sedimentation
-INTEGER :: JJ ! Loop index for the interpolation
-INTEGER :: JI ! Loop index for the interpolation
-INTEGER :: IIB ! Define the domain where is
-INTEGER :: IIE ! the microphysical sources have to be computed
-INTEGER :: IJB !
-INTEGER :: IJE !
-INTEGER :: IKB,IKTB,IKT !
-INTEGER :: IKE,IKTE !
-!
-REAL :: ZTSPLITR ! Small time step for rain sedimentation
-!
-!
-INTEGER :: ISEDIMR,ISEDIMC, ISEDIMI, ISEDIMS, ISEDIMG, ISEDIMH, &
- INEGT, IMICRO ! Case number of sedimentation, T>0 (for HEN)
- ! and r_x>0 locations
-INTEGER :: IGRIM, IGACC, IGDRY ! Case number of riming, accretion and dry growth
- ! locations
-INTEGER :: IGWET, IHAIL ! wet growth locations and case number
-LOGICAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
- :: GSEDIMR,GSEDIMC, GSEDIMI, GSEDIMS, GSEDIMG, GSEDIMH ! Test where to compute the SED processes
-LOGICAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
- :: GNEGT ! Test where to compute the HEN process
+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 :: IKE,IKTE !
+!
+INTEGER :: IMICRO
+INTEGER, DIMENSION(SIZE(PEXNREF)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
LOGICAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
- :: GMICRO ! Test where to compute all processes
-LOGICAL, DIMENSION(:), ALLOCATABLE :: GRIM ! Test where to compute riming
-LOGICAL, DIMENSION(:), ALLOCATABLE :: GACC ! Test where to compute accretion
-LOGICAL, DIMENSION(:), ALLOCATABLE :: GDRY ! Test where to compute dry growth
-LOGICAL, DIMENSION(:), ALLOCATABLE :: GWET ! Test where to compute wet growth
-LOGICAL, DIMENSION(:), ALLOCATABLE :: GHAIL ! Test where to compute hail growth
-LOGICAL, DIMENSION(:), ALLOCATABLE :: GWORK
-LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)):: GDEP
-INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1,IVEC2 ! Vectors of indices for
- ! interpolations
-REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1,ZVEC2,ZVEC3 ! Work vectors for
- ! interpolations
-REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: GMICRO ! Test where to compute all processes
+REAL :: ZINVTSTEP
+REAL :: ZCOEFFRCM
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRGT ! Graupel m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRHT ! Hail m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZCIT ! Pristine ice conc. at t
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVS ! Water vapor m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCS ! Cloud water m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRRS ! Rain water m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRGS ! Graupel m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRHS ! Hail m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZTHS ! Theta source
+REAL, DIMENSION(:), ALLOCATABLE :: ZTHT ! Potential temperature
+REAL, DIMENSION(:), ALLOCATABLE :: ZTHLT ! Liquid potential temperature
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRHODREF, & ! RHO Dry REFerence
+ ZRHODJ, & ! RHO times Jacobian
+ ZZT, & ! Temperature
+ ZPRES, & ! Pressure
+ ZEXNREF, & ! EXNer Pressure REFerence
+ ZZW, & ! Work array
+ ZLSFACT, & ! L_s/(Pi_ref*C_ph)
+ ZLVFACT, & ! L_v/(Pi_ref*C_ph)
+ ZUSW, & ! Undersaturation over water
+ ZSSI, & ! Supersaturation over ice
+ ZLBDAR, & ! Slope parameter of the raindrop distribution
+ ZLBDAR_RF,& ! Slope parameter of the raindrop distribution
+ ! for the Rain Fraction part
+ ZLBDAS, & ! Slope parameter of the aggregate distribution
+ ZLBDAG, & ! Slope parameter of the graupel distribution
+ ZLBDAH, & ! Slope parameter of the hail distribution
+ ZRDRYG, & ! Dry growth rate of the graupeln
+ ZRWETG, & ! Wet growth rate of the graupeln
+ ZAI, & ! Thermodynamical function
+ ZCJ, & ! Function to compute the ventilation coefficient
+ ZKA, & ! Thermal conductivity of the air
+ ZDV, & ! Diffusivity of water vapor in the air
+ ZSIGMA_RC,& ! Standard deviation of rc at time t
+ ZCF, & ! Cloud fraction
+ ZRF, & ! Rain fraction
+ ZHLC_HCF, & ! HLCLOUDS : fraction of High Cloud Fraction in grid
+ ZHLC_LCF, & ! HLCLOUDS : fraction of Low Cloud Fraction in grid
+ ! note that ZCF = ZHLC_HCF + ZHLC_LCF
+ ZHLC_HRC, & ! HLCLOUDS : LWC that is High LWC in grid
+ ZHLC_LRC, & ! HLCLOUDS : LWC that is Low LWC in grid
+ ! note that ZRC = ZHLC_HRC + ZHLC_LRC
+ ZHLC_RCMAX, & ! HLCLOUDS : maximum value for RC in distribution
+ ZRCRAUTC, & ! RC value to begin rain formation =XCRIAUTC/RHODREF
+ ZHLC_HRCLOCAL, & ! HLCLOUDS : LWC that is High LWC local in HCF
+ ZHLC_LRCLOCAL ! HLCLOUDS : LWC that is Low LWC local in LCF
+ ! note that ZRC/CF = ZHLC_HRCLOCAL+ ZHLC_LRCLOCAL
+ ! = ZHLC_HRC/HCF+ ZHLC_LRC/LCF
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZZW1 ! Work arrays
+REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
:: ZW ! work array
-REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
- :: ZPRCS,ZPRRS,ZPRSS,ZPRGS,ZPRHS ! Mixing ratios created during the time step
-REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),0:SIZE(PEXNREF,3)+1) &
- :: ZWSED ! sedimentation fluxes
-REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),0:SIZE(PEXNREF,3)+1) &
- :: ZWSEDW1 ! sedimentation speed
-REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),0:SIZE(PEXNREF,3)+1) &
- :: ZWSEDW2 ! sedimentation speed
-REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2)) &
- :: ZCONC_TMP ! Weighted concentration
-REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
:: ZT ! Temperature
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: &
- ZRAY, & ! Cloud Mean radius
- ZLBC, & ! XLBC weighted by sea fraction
- ZFSEDC
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZRAINFR ! Rain fraction
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZHLC_HCF3D ! HLCLOUDS cloud fraction in high water content part
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZHLC_LCF3D ! HLCLOUDS cloud fraction in low water content part
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZHLC_HRC3D ! HLCLOUDS cloud water content in high water content part
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZHLC_LRC3D ! HLCLOUDS cloud water content in low water content
-REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRRT ! Rain water m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRGT ! Graupel m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRHT ! Hail m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZCIT ! Pristine ice conc. at t
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZRVS ! Water vapor m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZRCS ! Cloud water m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZRRS ! Rain water m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZRIS ! Pristine ice m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZRGS ! Graupel m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZRHS ! Hail m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZTHS ! Theta source
-REAL, DIMENSION(:), ALLOCATABLE :: ZTHT ! Potential temperature
-REAL, DIMENSION(:), ALLOCATABLE :: ZTHLT ! Liquid potential temperature
-REAL, DIMENSION(:), ALLOCATABLE :: ZCRIAUTI ! Snow-to-ice autoconversion thres.
-!
-REAL, DIMENSION(:), ALLOCATABLE &
- :: ZRHODREF, & ! RHO Dry REFerence
- ZRHODJ, & ! RHO times Jacobian
- ZZT, & ! Temperature
- ZPRES, & ! Pressure
- ZEXNREF, & ! EXNer Pressure REFerence
- ZZW, & ! Work array
- ZZW2, & ! Work array
- ZZW3, & ! Work array
- ZZW4, & ! Work array
- ZLSFACT, & ! L_s/(Pi_ref*C_ph)
- ZLVFACT, & ! L_v/(Pi_ref*C_ph)
- ZUSW, & ! Undersaturation over water
- ZSSI, & ! Supersaturation over ice
- ZLBDAR, & ! Slope parameter of the raindrop distribution
- ZLBDAR_RF,& ! Slope parameter of the raindrop distribution
- ! for the Rain Fraction part
- ZLBDAS, & ! Slope parameter of the aggregate distribution
- ZLBDAG, & ! Slope parameter of the graupel distribution
- ZLBDAH, & ! Slope parameter of the hail distribution
- ZRDRYG, & ! Dry growth rate of the graupeln
- ZRWETG, & ! Wet growth rate of the graupeln
- ZAI, & ! Thermodynamical function
- ZCJ, & ! Function to compute the ventilation coefficient
- ZKA, & ! Thermal conductivity of the air
- ZDV, & ! Diffusivity of water vapor in the air
- ZSIGMA_RC,& ! Standard deviation of rc at time t
- ZCF, & ! Cloud fraction
- ZRF, & ! Rain fraction
- ZHLC_HCF, & ! HLCLOUDS : fraction of High Cloud Fraction in grid
- ZHLC_LCF, & ! HLCLOUDS : fraction of Low Cloud Fraction in grid
- ! note that ZCF = ZHLC_HCF + ZHLC_LCF
- ZHLC_HRC, & ! HLCLOUDS : LWC that is High LWC in grid
- ZHLC_LRC, & ! HLCLOUDS : LWC that is Low LWC in grid
- ! note that ZRC = ZHLC_HRC + ZHLC_LRC
- ZHLC_RCMAX, & ! HLCLOUDS : maximum value for RC in distribution
- ZRCRAUTC, & ! RC value to begin rain formation =XCRIAUTC/RHODREF
- ZHLC_HRCLOCAL, & ! HLCLOUDS : LWC that is High LWC local in HCF
- ZHLC_LRCLOCAL, & ! HLCLOUDS : LWC that is Low LWC local in LCF
- ! note that ZRC/CF = ZHLC_HRCLOCAL+ ZHLC_LRCLOCAL
- ! = ZHLC_HRC/HCF+ ZHLC_LRC/LCF
- ZCC, & ! terminal velocity
- ZFSEDC1D, & ! For cloud sedimentation
- ZRAY1D, & ! Mean radius
- ZWLBDA ! Mean freepath
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZZW1 ! Work arrays
-REAL :: ZTIMAUTIC,XDUMMY6,XDUMMY7
-REAL :: ZINVTSTEP
-REAL, DIMENSION(SIZE(XRTMIN)) :: ZRTMIN
-! XRTMIN = Minimum value for the mixing ratio
-! ZRTMIN = Minimum value for the source (tendency)
-!
-INTEGER , DIMENSION(SIZE(GMICRO)) :: I1,I2,I3 ! Used to replace the COUNT
-INTEGER :: JL ! and PACK intrinsics
-REAL :: ZCOEFFRCM
-LOGICAL :: GPRESENT_PFPR,GPRESENT_PSEA
-!
-!acc declare create(GMICRO,GWET,GHAIL,GDEP, &
-!acc & IVEC1,IVEC2,ZVEC1,ZVEC2,ZVEC3,ZW, &
-!acc & ZPRCS,ZPRRS,ZPRSS,ZPRGS,ZPRHS,ZRAINFR, &
-!acc & ZWSED,ZWSEDW1,ZWSEDW2,ZCONC_TMP,ZT,ZRAY,ZLBC,ZFSEDC, &
-!acc & ZRVT,ZRCT,ZRRT,ZRIT,ZRST,ZRGT,ZRHT,ZCIT, &
-!acc & ZRVS,ZRCS,ZRRS,ZRIS,ZRSS,ZRGS,ZRHS,ZTHS, &
-!acc & ZRHODREF, &
-!acc & ZRHODJ,ZZT,ZPRES,ZZW,ZZW2,ZZW3,ZZW4,ZLSFACT,ZLVFACT, &
-!acc & ZUSW,ZSSI,ZLBDAS,ZLBDAG,ZLBDAH, &
-!acc & ZAI,ZCJ,ZKA,ZDV,ZZW1,ZRTMIN) &
-!acc & device_resident(GSEDIMR,GSEDIMC,GSEDIMI,GSEDIMS,GSEDIMG,GSEDIMH, &
-!acc & GNEGT,GRIM,GACC,GDRY,GWORK, &
-!acc & ZCRIAUTI,ZEXNREF,ZLBDAR,ZRDRYG,ZRWETG,ZSIGMA_RC,ZCF, &
-!acc & I1,I2,I3 )
-
-!$acc declare copyin(XALPHA1,XCEXVT,XEXCSEDI,XEX0DEPG,XEX1DEPG,XEX0DEPS,XEX1DEPS, &
-!$acc & XEX0EVAR,XEX1EVAR, &
-!$acc & XEXCACCR,XEXIAGGS,XEXSEDG,XEXSEDH,XEXSEDR,XEXSEDS, &
-!$acc & XFSEDC,XFSEDG,XLBC,XLBEXC,XLBEXG,XLBEXI,XLBEXR,XLBEXS,XRTMIN, &
-!$acc & XKER_RACCS,XKER_RACCSS,XKER_SACCRG,XCXS, &
-!$acc & XRIMINTP1,XEXCRIMSS,XGAMINC_RIM1,XGAMINC_RIM2,XEXCRIMSG,XEXSRIMCG, &
-!$acc & XEXICFRR,XEXRCFRI,XKER_SDRYG,XCOLEXSG,XCXG,XKER_RDRYG, &
-!$acc & XALPHAC,XALPHAC2,XNUC,XNUC2 )
-
-!$acc declare create(ZHLC_HCF3D,ZHLC_LCF3D,ZHLC_HRC3D,ZHLC_LRC3D, &
-!$acc & ZRVT,ZRCS,ZRCT,ZRGS,ZRGT,ZRHS,ZRHT,ZRRS,ZRRT,ZRSS,ZRST,ZRVS, &
-!$acc & ZCIT,ZRIS,ZRIT,ZTHS,ZTHT,ZTHLT,ZCRIAUTI, &
-!$acc & ZRHODJ,ZZT,ZPRES,ZZW,ZLSFACT,ZLVFACT,ZUSW,ZSSI,ZLBDAR_RF,ZLBDAG,ZLBDAH, &
-!$acc & ZAI,ZCJ,ZKA,ZDV,ZCF,ZRF,ZHLC_HCF,ZHLC_HRC,ZHLC_LCF,ZHLC_LRC,ZZW1, &
-!$acc & GPRESENT_PFPR,GPRESENT_PSEA )
-
-!$acc data create(GMICRO,GDEP,GWORK, &
-!$acc & ZW, &
-!$acc & ZPRCS,ZPRRS,ZPRSS,ZPRGS,ZPRHS,ZRAINFR, &
-!$acc & ZWSED,ZWSEDW1,ZWSEDW2,ZCONC_TMP,ZT,ZRAY,ZLBC,ZFSEDC, &
-!$acc & ZRTMIN, &
-!$acc & GSEDIMR,GSEDIMC,GSEDIMI,GSEDIMS,GSEDIMG,GSEDIMH, &
-!$acc & GNEGT,I1,I2,I3 )
-!
-IF (MPPDB_INITIALIZED) THEN
- !Check all IN arrays
- CALL MPPDB_CHECK(PDZZ,"RAIN_ICE beg:PDZZ")
- CALL MPPDB_CHECK(PRHODJ,"RAIN_ICE beg:PRHODJ")
- CALL MPPDB_CHECK(PRHODREF,"RAIN_ICE beg:PRHODREF")
- CALL MPPDB_CHECK(PEXNREF,"RAIN_ICE beg:PEXNREF")
- CALL MPPDB_CHECK(PPABST,"RAIN_ICE beg:PPABST")
- CALL MPPDB_CHECK(PCLDFR,"RAIN_ICE beg:PCLDFR")
- CALL MPPDB_CHECK(PTHT,"RAIN_ICE beg:PTHT")
- CALL MPPDB_CHECK(PRVT,"RAIN_ICE beg:PRVT")
- CALL MPPDB_CHECK(PRCT,"RAIN_ICE beg:PRCT")
- CALL MPPDB_CHECK(PRRT,"RAIN_ICE beg:PRRT")
- CALL MPPDB_CHECK(PRIT,"RAIN_ICE beg:PRIT")
- CALL MPPDB_CHECK(PRST,"RAIN_ICE beg:PRST")
- CALL MPPDB_CHECK(PRGT,"RAIN_ICE beg:PRGT")
- CALL MPPDB_CHECK(PSIGS,"RAIN_ICE beg:PSIGS")
- IF (PRESENT(PSEA)) CALL MPPDB_CHECK(PSEA,"RAIN_ICE beg:PSEA")
- IF (PRESENT(PTOWN)) CALL MPPDB_CHECK(PTOWN,"RAIN_ICE beg:PTOWN")
- IF (PRESENT(PRHT)) CALL MPPDB_CHECK(PRHT,"RAIN_ICE beg:PRHT")
- !Check all INOUT arrays
- CALL MPPDB_CHECK(PCIT,"RAIN_ICE beg:PCIT")
- CALL MPPDB_CHECK(PTHS,"RAIN_ICE beg:PTHS")
- CALL MPPDB_CHECK(PRVS,"RAIN_ICE beg:PRVS")
- CALL MPPDB_CHECK(PRCS,"RAIN_ICE beg:PRCS")
- CALL MPPDB_CHECK(PRRS,"RAIN_ICE beg:PRRS")
- CALL MPPDB_CHECK(PRIS,"RAIN_ICE beg:PRIS")
- CALL MPPDB_CHECK(PRSS,"RAIN_ICE beg:PRSS")
- CALL MPPDB_CHECK(PRGS,"RAIN_ICE beg:PRGS")
- CALL MPPDB_CHECK(PINPRC,"RAIN_ICE beg:PINPRC")
- CALL MPPDB_CHECK(PINDEP,"RAIN_ICE beg:PINDEP")
- CALL MPPDB_CHECK(PINPRR,"RAIN_ICE beg:PINPRR")
- CALL MPPDB_CHECK(PINPRR3D,"RAIN_ICE beg:PINPRR3D")
- CALL MPPDB_CHECK(PEVAP3D,"RAIN_ICE beg:PEVAP3D")
- CALL MPPDB_CHECK(PINPRS,"RAIN_ICE beg:PINPRS")
- CALL MPPDB_CHECK(PINPRG,"RAIN_ICE beg:PINPRG")
- IF (PRESENT(PRHS)) CALL MPPDB_CHECK(PRHS,"RAIN_ICE beg:PRHS")
- IF (PRESENT(PINPRH)) CALL MPPDB_CHECK(PINPRH,"RAIN_ICE beg:PINPRH")
-END IF
!
-#ifdef _OPENACC
-IF ( KRR == 7 ) THEN
- PRINT *,'OPENACC: RAIN_ICE: KRR=7 not yet tested'
-END IF
-#endif
!-------------------------------------------------------------------------------
!
!* 1. COMPUTE THE LOOP BOUNDS
! -----------------------
!
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IIT=SIZE(PDZZ,1)
+IJT=SIZE(PDZZ,2)
IKB=KKA+JPVEXT*KKL
IKE=KKU-JPVEXT*KKL
IKT=SIZE(PDZZ,3)
@@ -587,30 +437,18 @@ IKTE=IKT-JPVEXT
!
ZINVTSTEP=1./PTSTEP
!
-IF (PRESENT(PFPR)) THEN
- GPRESENT_PFPR = .TRUE.
-ELSE
- GPRESENT_PFPR = .FALSE.
-END IF
-!
-IF (PRESENT(PSEA)) THEN
- GPRESENT_PSEA = .TRUE.
-ELSE
- GPRESENT_PSEA = .FALSE.
-END IF
-!$acc update device(GPRESENT_PFPR,GPRESENT_PSEA)
-!
!
!* 2. COMPUTES THE SLOW COLD PROCESS SOURCES
! --------------------------------------
!
-CALL RAIN_ICE_NUCLEATION
+CALL RAIN_ICE_NUCLEATION(IIB, IIE, IJB, IJE, IKTB, IKTE,KRR,PTSTEP,&
+ PTHT,PPABST,PRHODJ,PRHODREF,PRVT,PRCT,PRRT,PRIT,PRST,PRGT,&
+ PCIT,PEXNREF,PTHS,PRVS,PRIS,ZT,PRHT)
!
!
! optimization by looking for locations where
! the microphysical fields are larger than a minimal value only !!!
!
-!$acc kernels present(GMICRO,PRCT,PRRT,PRIT,PRST,PRGT,PRHT,XRTMIN)
GMICRO(:,:,:) = .FALSE.
IF ( KRR == 7 ) THEN
@@ -629,14 +467,8 @@ GMICRO(:,:,:) = .FALSE.
PRST(IIB:IIE,IJB:IJE,IKTB:IKTE)>XRTMIN(5) .OR. &
PRGT(IIB:IIE,IJB:IJE,IKTB:IKTE)>XRTMIN(6)
END IF
-!$acc end kernels
-
-#ifndef _OPENACC
-IMICRO = COUNTJV3D( GMICRO(:,:,:),I1(:),I2(:),I3(:))
-#else
-CALL COUNTJV3D_DEVICE(GMICRO(:,:,:),I1(:),I2(:),I3(:),IMICRO)
-#endif
+IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:))
IF( IMICRO >= 0 ) THEN
ALLOCATE(ZRVT(IMICRO))
ALLOCATE(ZRCT(IMICRO))
@@ -644,7 +476,11 @@ IF( IMICRO >= 0 ) THEN
ALLOCATE(ZRIT(IMICRO))
ALLOCATE(ZRST(IMICRO))
ALLOCATE(ZRGT(IMICRO))
- IF ( KRR == 7 ) ALLOCATE(ZRHT(IMICRO))
+ IF ( KRR == 7 ) THEN
+ ALLOCATE(ZRHT(IMICRO))
+ ELSE
+ ALLOCATE(ZRHT(0))
+ END IF
ALLOCATE(ZCIT(IMICRO))
ALLOCATE(ZRVS(IMICRO))
ALLOCATE(ZRCS(IMICRO))
@@ -652,7 +488,11 @@ IF( IMICRO >= 0 ) THEN
ALLOCATE(ZRIS(IMICRO))
ALLOCATE(ZRSS(IMICRO))
ALLOCATE(ZRGS(IMICRO))
- IF ( KRR == 7 ) ALLOCATE(ZRHS(IMICRO))
+ IF ( KRR == 7 ) THEN
+ ALLOCATE(ZRHS(IMICRO))
+ ELSE
+ ALLOCATE(ZRHS(0))
+ END IF
ALLOCATE(ZTHS(IMICRO))
ALLOCATE(ZTHT(IMICRO))
ALLOCATE(ZTHLT(IMICRO))
@@ -671,52 +511,7 @@ IF( IMICRO >= 0 ) THEN
ALLOCATE(ZRCRAUTC(IMICRO))
ALLOCATE(ZHLC_HRCLOCAL(IMICRO))
ALLOCATE(ZHLC_LRCLOCAL(IMICRO))
-!
- ALLOCATE(ZZW(IMICRO))
- ALLOCATE(ZZW2(IMICRO))
- ALLOCATE(ZZW3(IMICRO))
- ALLOCATE(ZZW4(IMICRO))
- ALLOCATE(ZLSFACT(IMICRO))
- ALLOCATE(ZLVFACT(IMICRO))
-!
- ALLOCATE(ZUSW(IMICRO))
- ALLOCATE(ZSSI(IMICRO))
-!
- ALLOCATE(ZLBDAR(IMICRO))
- ALLOCATE(ZLBDAR_RF(IMICRO))
- ALLOCATE(ZLBDAS(IMICRO))
- ALLOCATE(ZLBDAG(IMICRO))
- IF ( KRR == 7 ) ALLOCATE(ZLBDAH(IMICRO))
- ALLOCATE(ZRDRYG(IMICRO))
- ALLOCATE(ZRWETG(IMICRO))
- ALLOCATE(ZAI(IMICRO))
- ALLOCATE(ZCJ(IMICRO))
- ALLOCATE(ZKA(IMICRO))
- ALLOCATE(ZDV(IMICRO))
- ALLOCATE(GWORK(IMICRO))
-!
- IF ( KRR == 7 ) THEN
- ALLOCATE(ZZW1(IMICRO,7))
- ELSE IF( KRR == 6 ) THEN
- ALLOCATE(ZZW1(IMICRO,6))
- ENDIF
-!
- IF (LBU_ENABLE .OR. LLES_CALL) THEN
- ALLOCATE(ZRHODJ(IMICRO))
- END IF
-!
-!$acc data create(ZRVT,ZRCT,ZRRT,ZRIT,ZRST,ZRGT,ZRHT,ZCIT, &
-!$acc & ZRVS,ZRCS,ZRRS,ZRIS,ZRSS,ZRGS,ZRHS,ZTHS, &
-!$acc & ZRHODREF, &
-!$acc & ZZT,ZPRES,ZZW,ZLSFACT,ZLVFACT, &
-!$acc & ZUSW,ZSSI,ZLBDAS,ZLBDAG,ZLBDAH, &
-!$acc & ZAI,ZCJ,ZKA,ZDV,ZZW1, &
-!$acc & GWORK, &
-!$acc & ZEXNREF,ZLBDAR,ZRDRYG,ZRWETG,ZSIGMA_RC,ZCF,ZRCRAUTC, &
-!$acc & ZRF,ZHLC_HCF,ZHLC_LCF,ZHLC_HRC,ZHLC_LRC)
-!
-!$acc kernels present(ZTHT,ZTHLT)
-!$acc loop independent
+
DO JL=1,IMICRO
ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
@@ -724,16 +519,20 @@ IF( IMICRO >= 0 ) THEN
ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
ZRST(JL) = PRST(I1(JL),I2(JL),I3(JL))
ZRGT(JL) = PRGT(I1(JL),I2(JL),I3(JL))
+ IF ( KRR == 7 ) ZRHT(JL) = PRHT(I1(JL),I2(JL),I3(JL))
ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
- !
ZCF(JL) = PCLDFR(I1(JL),I2(JL),I3(JL))
- !
+ IF ( HSUBG_AUCV == 'PDF ' .AND. CSUBG_PR_PDF == 'SIGM' ) THEN
+ 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)
+ END IF
ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
ZRRS(JL) = PRRS(I1(JL),I2(JL),I3(JL))
ZRIS(JL) = PRIS(I1(JL),I2(JL),I3(JL))
ZRSS(JL) = PRSS(I1(JL),I2(JL),I3(JL))
ZRGS(JL) = PRGS(I1(JL),I2(JL),I3(JL))
+ IF ( KRR == 7 ) ZRHS(JL) = PRHS(I1(JL),I2(JL),I3(JL))
ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
!
ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
@@ -743,55 +542,54 @@ IF( IMICRO >= 0 ) THEN
ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
ENDDO
- !
- IF (KRR == 7 ) THEN
- DO JL=1,IMICRO
- ZRHT(JL) = PRHT(I1(JL),I2(JL),I3(JL))
- ZRHS(JL) = PRHS(I1(JL),I2(JL),I3(JL))
- ENDDO
- ENDIF
+ ALLOCATE(ZZW(IMICRO))
+ ALLOCATE(ZLSFACT(IMICRO))
+ ALLOCATE(ZLVFACT(IMICRO))
+ ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
+ +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
+ ZLSFACT(:) = (XLSTT+(XCPV-XCI)*(ZZT(:)-XTT))/ZZW(:) ! L_s/(Pi_ref*C_ph)
+ ZLVFACT(:) = (XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZW(:) ! L_v/(Pi_ref*C_ph)
+ ALLOCATE(ZUSW(IMICRO))
+ ALLOCATE(ZSSI(IMICRO))
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) )
+ ZSSI(:) = ZRVT(:)*( ZPRES(:)-ZZW(:) ) / ( (XMV/XMD) * ZZW(:) ) - 1.0
+ ! Supersaturation over ice
!
- IF ( HSUBG_AUCV == '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)
- END DO
+ ALLOCATE(ZLBDAR(IMICRO))
+ ALLOCATE(ZLBDAR_RF(IMICRO))
+ ALLOCATE(ZLBDAS(IMICRO))
+ ALLOCATE(ZLBDAG(IMICRO))
+ IF ( KRR == 7 ) THEN
+ ALLOCATE(ZLBDAH(IMICRO))
+ ELSE
+ ALLOCATE(ZLBDAH(0))
END IF
+ ALLOCATE(ZRDRYG(IMICRO))
+ ALLOCATE(ZRWETG(IMICRO))
+ ALLOCATE(ZAI(IMICRO))
+ ALLOCATE(ZCJ(IMICRO))
+ ALLOCATE(ZKA(IMICRO))
+ ALLOCATE(ZDV(IMICRO))
+!
+ IF ( KRR == 7 ) THEN
+ ALLOCATE(ZZW1(IMICRO,7))
+ ELSE IF( KRR == 6 ) THEN
+ ALLOCATE(ZZW1(IMICRO,6))
+ ENDIF
!
- ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
- +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
- ZLSFACT(:) = (XLSTT+(XCPV-XCI)*(ZZT(:)-XTT))/ZZW(:) ! L_s/(Pi_ref*C_ph)
- ZLVFACT(:) = (XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZW(:) ! L_v/(Pi_ref*C_ph)
-
-#ifndef MNH_BITREP
- ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) )
-#else
- ZZW(:) = BR_EXP( XALPI - XBETAI/ZZT(:) - XGAMI*BR_LOG(ZZT(:) ) )
-#endif
- ZSSI(:) = ZRVT(:)*( ZPRES(:)-ZZW(:) ) / ( (XMV/XMD) * ZZW(:) ) - 1.0
- ! Supersaturation over ice
-!$acc end kernels
- !
-!$acc kernels present(ZRCRAUTC,ZRHODJ)
IF (LBU_ENABLE .OR. LLES_CALL) THEN
- DO JL=1,IMICRO
- ZRHODJ(JL) = PRHODJ(I1(JL),I2(JL),I3(JL))
- END DO
+ ALLOCATE(ZRHODJ(IMICRO))
+ ZRHODJ(:) = PACK( PRHODJ(:,:,:),MASK=GMICRO(:,:,:) )
+ ELSE
+ ALLOCATE(ZRHODJ(0))
END IF
!
+
!Cloud water split between high and low content part is done here
!according to autoconversion option
ZRCRAUTC(:) = XCRIAUTC/ZRHODREF(:) ! Autoconversion rc threshold
-!$acc end kernels
-#ifdef _OPENACC
- IF (LBU_ENABLE .OR. LLES_CALL) THEN
-!$acc update self(ZRHODJ) !used only in BUDGET
- ENDIF
-#endif
IF (HSUBG_AUCV == 'NONE') THEN
-!$acc kernels present(ZRCRAUTC,ZHLC_HCF,ZHLC_LCF,ZHLC_HRC,ZHLC_LRC,ZRF)
!Cloud water is entirely in low or high part
-#ifndef _OPENACC
WHERE (ZRCT(:) > ZRCRAUTC(:))
ZHLC_HCF(:) = 1.
ZHLC_LCF(:) = 0.0
@@ -811,36 +609,8 @@ IF( IMICRO >= 0 ) THEN
ZHLC_LRC(:) = 0.0
ZRF(:) = 0.
END WHERE
-#else
-!$acc loop independent private(JL)
- DO JL=1,IMICRO
- IF (ZRCT(JL) > ZRCRAUTC(JL)) THEN
- ZHLC_HCF(JL) = 1.
- ZHLC_LCF(JL) = 0.0
- ZHLC_HRC(JL) = ZRCT(JL)
- ZHLC_LRC(JL) = 0.0
- ZRF(JL) = 1.
- ELSE IF (ZRCT(JL) > XRTMIN(2)) THEN
- ZHLC_HCF(JL) = 0.0
- ZHLC_LCF(JL) = 1.
- ZHLC_HRC(JL) = 0.0
- ZHLC_LRC(JL) = ZRCT(JL)
- ZRF(JL) = 0.
- ELSE
- ZHLC_HCF(JL) = 0.0
- ZHLC_LCF(JL) = 0.0
- ZHLC_HRC(JL) = 0.0
- ZHLC_LRC(JL) = 0.0
- ZRF(JL) = 0.
- END IF
- END DO
-#endif
-!$acc end kernels
ELSEIF (HSUBG_AUCV == 'CLFR') THEN
-#ifdef _OPENACC
- CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE','OPENACC: HSUBG_AUCV="CLFR" not yet implemented')
-#endif
!Cloud water is only in the cloudy part and entirely in low or high part
WHERE (ZCF(:) > 0. .AND. ZRCT(:) > ZRCRAUTC(:)*ZCF(:))
ZHLC_HCF(:) = ZCF(:)
@@ -869,9 +639,6 @@ IF( IMICRO >= 0 ) THEN
END WHERE
ELSEIF (HSUBG_AUCV == 'PDF ') THEN
-#ifdef _OPENACC
- CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE','OPENACC: HSUBG_AUCV="PDF" not yet implemented')
-#endif
!Cloud water is split between high and low part according to a PDF
! 'HLCRECTPDF' : rectangular PDF form
! 'HLCTRIANGPDF' : triangular PDF form
@@ -995,33 +762,29 @@ IF( IMICRO >= 0 ) THEN
ELSE
!wrong CSUBG_PR_PDF case
- CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE','wrong CSUBG_PR_PDF case')
+ WRITE(*,*) 'wrong CSUBG_PR_PDF case'
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE','')
ENDIF
ELSE
!wrong HSUBG_AUCV case
- CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE','wrong HSUBG_AUCV case')
+ WRITE(*,*)'wrong HSUBG_AUCV case'
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE','')
ENDIF
!Diagnostic of precipitation fraction
-#ifndef _OPENACC
ZW(:,:,:) = 0.
- ZRAINFR(:,:,:) = UNPACK( ZRF(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
-#else
-!$acc kernels present(ZRF,ZRAINFR)
- ZRAINFR(:,:,:) = 0.
- DO JL=1,IMICRO
- ZRAINFR(I1(JL),I2(JL),I3(JL)) = ZRF(JL)
- END DO
-!$acc end kernels
-#endif
- CALL RAINFR_VERT(ZRAINFR(:,:,:), PRRT(:,:,:))
-!$acc kernels present(ZRF,ZRAINFR)
+ PRAINFR(:,:,:) = UNPACK( ZRF(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ CALL ICE4_RAINFR_VERT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, PRAINFR, PRRT(:,:,:))
DO JL=1,IMICRO
- ZRF(JL)=ZRAINFR(I1(JL),I2(JL),I3(JL))
+ ZRF(JL)=PRAINFR(I1(JL),I2(JL),I3(JL))
END DO
-!$acc end kernels
!
- CALL RAIN_ICE_SLOW
+ CALL RAIN_ICE_SLOW(GMICRO, ZINVTSTEP, ZRHODREF, &
+ ZRCT, ZRRT, ZRIT, ZRST, ZRGT, ZRHODJ, ZZT, ZPRES, &
+ ZLSFACT, ZLVFACT, &
+ ZSSI, PRHODJ, PTHS, PRVS, &
+ ZRVS, ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZTHS, &
+ ZAI, ZCJ, ZKA, ZDV, ZLBDAS, ZLBDAG)
!
!-------------------------------------------------------------------------------
!
@@ -1031,30 +794,23 @@ IF( IMICRO >= 0 ) THEN
!
!* 3.1 compute the slope parameter Lbda_r
!
-!$acc kernels
!ZLBDAR will be used when we consider rain diluted over the grid box
- WHERE( ZRRT(1:IMICRO)>0.0 )
-#ifndef MNH_BITREP
- ZLBDAR(1:IMICRO) = XLBR*( ZRHODREF(1:IMICRO)*MAX( ZRRT(1:IMICRO),XRTMIN(3) ) )**XLBEXR
-#else
- ZLBDAR(1:IMICRO) = XLBR*BR_POW( ZRHODREF(1:IMICRO)*MAX( ZRRT(1:IMICRO),XRTMIN(3) ) ,XLBEXR)
-#endif
+ WHERE( ZRRT(:)>0.0 )
+ ZLBDAR(:) = XLBR*( ZRHODREF(:)*MAX( ZRRT(:),XRTMIN(3) ) )**XLBEXR
END WHERE
!ZLBDAR_RF will be used when we consider rain concentrated in its fraction
- WHERE( ZRRT(1:IMICRO)>0.0 .AND. ZRF(1:IMICRO)>0.0 )
-#ifndef MNH_BITREP
- ZLBDAR_RF(1:IMICRO) = XLBR*( ZRHODREF(1:IMICRO) *MAX( ZRRT(1:IMICRO)/ZRF(1:IMICRO) , XRTMIN(3) ) )**XLBEXR
-#else
- ZLBDAR_RF(1:IMICRO) = XLBR*BR_POW( ZRHODREF(1:IMICRO) *MAX( ZRRT(1:IMICRO)/ZRF(1:IMICRO) , XRTMIN(3) ) ,XLBEXR)
-#endif
+ WHERE( ZRRT(:)>0.0 .AND. ZRF(:)>0.0 )
+ ZLBDAR_RF(:) = XLBR*( ZRHODREF(:) *MAX( ZRRT(:)/ZRF(:) , XRTMIN(3) ) )**XLBEXR
ELSEWHERE
- ZLBDAR_RF(1:IMICRO) = 0.
+ ZLBDAR_RF(:) = 0.
END WHERE
-!$acc end kernels
!
IF( OWARM ) THEN ! Check if the formation of the raindrops by the slow
! warm processes is allowed
- CALL RAIN_ICE_WARM
+ PEVAP3D(:,:,:)= 0.
+ CALL RAIN_ICE_WARM(GMICRO, 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)
END IF
!
!-------------------------------------------------------------------------------
@@ -1063,7 +819,9 @@ IF( IMICRO >= 0 ) THEN
!* 4. COMPUTES THE FAST COLD PROCESS SOURCES FOR r_s
! ----------------------------------------------
!
- CALL RAIN_ICE_FAST_RS
+ CALL RAIN_ICE_FAST_RS(PTSTEP, GMICRO, ZRHODREF, ZRVT, ZRCT, ZRRT, ZRST, ZRHODJ, ZPRES, ZZT, &
+ ZLBDAR, ZLBDAS, ZLSFACT, ZLVFACT, ZCJ, ZKA, ZDV, PRHODJ, PTHS, &
+ ZRCS, ZRRS, ZRSS, ZRGS, ZTHS)
!
!-------------------------------------------------------------------------------
!
@@ -1071,7 +829,10 @@ IF( IMICRO >= 0 ) THEN
!* 5. COMPUTES THE FAST COLD PROCESS SOURCES FOR r_g
! ----------------------------------------------
!
- CALL RAIN_ICE_FAST_RG
+ 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, &
+ ZUSW, ZRDRYG, ZRWETG)
!
!-------------------------------------------------------------------------------
!
@@ -1080,7 +841,9 @@ IF( IMICRO >= 0 ) THEN
! ----------------------------------------------
!
IF ( KRR == 7 ) THEN
- CALL RAIN_ICE_FAST_RH
+ 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, &
+ ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZRHS, ZTHS, ZUSW)
END IF
!
!-------------------------------------------------------------------------------
@@ -1089,14 +852,14 @@ IF( IMICRO >= 0 ) THEN
!* 7. COMPUTES SPECIFIC SOURCES OF THE WARM AND COLD CLOUDY SPECIES
! -------------------------------------------------------------
!
- CALL RAIN_ICE_FAST_RI
+ CALL RAIN_ICE_FAST_RI(GMICRO, ZRHODREF, ZRIT, ZRHODJ, ZZT, ZSSI, ZLSFACT, ZLVFACT, &
+ ZAI, ZCJ, PRHODJ, PTHS, ZCIT, ZRCS, ZRIS, ZTHS)
!
!
!-------------------------------------------------------------------------------
!
!
!
-#ifndef _OPENACC
ZW(:,:,:) = PRVS(:,:,:)
PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
ZW(:,:,:) = PRCS(:,:,:)
@@ -1118,63 +881,18 @@ IF( IMICRO >= 0 ) THEN
ZW(:,:,:) = PCIT(:,:,:)
PCIT(:,:,:) = UNPACK( ZCIT(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
!
- ZW(:,:,:) = ZRAINFR(:,:,:)
- ZRAINFR(:,:,:) = UNPACK( ZRF(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
-!
- ZW(:,:,:) = 0.
- ZHLC_HCF3D(:,:,:) = UNPACK( ZHLC_HCF(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
-!
- ZW(:,:,:) = 0.
- ZHLC_LCF3D(:,:,:) = UNPACK( ZHLC_LCF(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
-!
- ZW(:,:,:) = 0.
- ZHLC_HRC3D(:,:,:) = UNPACK( ZHLC_HRC(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
-!
- ZW(:,:,:) = 0.
- ZHLC_LRC3D(:,:,:) = UNPACK( ZHLC_LRC(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
-#else
-!$acc kernels present(ZRAINFR,ZRF)
- ZHLC_HCF3D(:,:,:) = 0.0
- ZHLC_LCF3D(:,:,:) = 0.0
- ZHLC_HRC3D(:,:,:) = 0.0
- ZHLC_LRC3D(:,:,:) = 0.0
-!$acc loop independent
- 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)
- !
- ZRAINFR(I1(JL),I2(JL),I3(JL)) = ZRF(JL)
- !
- 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)
- END DO
- IF ( KRR == 7 ) THEN
- DO JL=1,IMICRO
- PRHS(I1(JL),I2(JL),I3(JL)) = ZRHS(JL)
- END DO
- END IF
-!$acc end kernels
-#endif
+ ZW(:,:,:) = PRAINFR(:,:,:)
+ PRAINFR(:,:,:) = UNPACK( ZRF(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
!
!
!
-!$acc end data
DEALLOCATE(ZZW1)
- DEALLOCATE(GWORK)
DEALLOCATE(ZDV)
DEALLOCATE(ZCJ)
DEALLOCATE(ZRDRYG)
DEALLOCATE(ZRWETG)
DEALLOCATE(ZLBDAG)
- IF ( KRR == 7 ) DEALLOCATE(ZLBDAH)
+ DEALLOCATE(ZLBDAH)
DEALLOCATE(ZLBDAS)
DEALLOCATE(ZLBDAR)
DEALLOCATE(ZLBDAR_RF)
@@ -1183,9 +901,6 @@ IF( IMICRO >= 0 ) THEN
DEALLOCATE(ZLVFACT)
DEALLOCATE(ZLSFACT)
DEALLOCATE(ZZW)
- DEALLOCATE(ZZW2)
- DEALLOCATE(ZZW3)
- DEALLOCATE(ZZW4)
DEALLOCATE(ZEXNREF)
DEALLOCATE(ZPRES)
DEALLOCATE(ZRHODREF)
@@ -1194,7 +909,7 @@ IF( IMICRO >= 0 ) THEN
DEALLOCATE(ZTHS)
DEALLOCATE(ZTHT)
DEALLOCATE(ZTHLT)
- IF ( KRR == 7 ) DEALLOCATE(ZRHS)
+ DEALLOCATE(ZRHS)
DEALLOCATE(ZRGS)
DEALLOCATE(ZRSS)
DEALLOCATE(ZRIS)
@@ -1203,7 +918,7 @@ IF( IMICRO >= 0 ) THEN
DEALLOCATE(ZRVS)
DEALLOCATE(ZCIT)
DEALLOCATE(ZRGT)
- IF ( KRR == 7 ) DEALLOCATE(ZRHT)
+ DEALLOCATE(ZRHT)
DEALLOCATE(ZRST)
DEALLOCATE(ZRIT)
DEALLOCATE(ZRRT)
@@ -1321,64 +1036,33 @@ END IF
!
!* 8.1 time splitting loop initialization
!
-ZTSPLITR= PTSTEP / FLOAT(KSPLITR)
!
!
IF (HSEDIM == 'STAT') THEN
- CALL RAIN_ICE_SEDIMENTATION_STAT
+ CALL RAIN_ICE_SEDIMENTATION_STAT( IIB, IIE, IJB, IJE, IKB, IKE, IKTB, IKTE, IKT, KKL, KRR, &
+ PTSTEP, OSEDIC, PINPRC, PINDEP, &
+ PINPRR, PINPRS, PINPRG, PDZZ, PRHODREF, PPABST, PTHT, PRHODJ, PINPRR3D, &
+ PRCS, PRCT, PRRS, PRRT, PRIS, PRSS, PRST, PRGS, PRGT, &
+ PSEA, PTOWN, PINPRH, PRHS, PRHT, PFPR )
ELSEIF (HSEDIM == 'SPLI') THEN
- CALL RAIN_ICE_SEDIMENTATION_SPLIT
+ CALL RAIN_ICE_SEDIMENTATION_SPLIT(IIB, IIE, IJB, IJE, IKB, IKE, IKTB, IKTE, IKT, KKL,&
+ KSPLITR,PTSTEP, &
+ KRR,OSEDIC,LDEPOSC,PINPRC,PINDEP,PINPRR,PINPRS,PINPRG,PDZZ,PRHODREF,PPABST,PTHT,PRHODJ,&
+ PINPRR3D,PRCS,PRCT,PRRS,PRRT,PRIS,PRIT,PRSS,PRST,PRGS,PRGT,PSEA,PTOWN,PINPRH,PRHS,PRHT,PFPR)
ELSE
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' NO SEDIMENTATION SCHEME FOR HSEDIM=',HSEDIM
- CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE','')
+ call Print_msg( NVERB_FATAL, 'GEN', 'RAIN_ICE', 'no sedimentation scheme for HSEDIM='//HSEDIM )
END IF
!sedimentation of rain fraction
-!$acc kernels present(ZW,PRRS)
-ZW(:,:,:)=PRRS(:,:,:)*PTSTEP
-!$acc end kernels
-CALL RAINFR_VERT(ZRAINFR,ZW)
+CALL ICE4_RAINFR_VERT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, PRAINFR, PRRS(:,:,:)*PTSTEP)
!
-!$acc end data
-!
-IF (MPPDB_INITIALIZED) THEN
- !Check all INOUT arrays
- CALL MPPDB_CHECK(PCIT,"RAIN_ICE end:PCIT")
- CALL MPPDB_CHECK(PTHS,"RAIN_ICE end:PTHS")
- CALL MPPDB_CHECK(PRVS,"RAIN_ICE end:PRVS")
- CALL MPPDB_CHECK(PRCS,"RAIN_ICE end:PRCS")
- CALL MPPDB_CHECK(PRRS,"RAIN_ICE end:PRRS")
- CALL MPPDB_CHECK(PRIS,"RAIN_ICE end:PRIS")
- CALL MPPDB_CHECK(PRSS,"RAIN_ICE end:PRSS")
- CALL MPPDB_CHECK(PRGS,"RAIN_ICE end:PRGS")
- CALL MPPDB_CHECK(PINPRC,"RAIN_ICE end:PINPRC")
- CALL MPPDB_CHECK(PINDEP,"RAIN_ICE end:PINDEP")
- CALL MPPDB_CHECK(PINPRR,"RAIN_ICE end:PINPRR")
- CALL MPPDB_CHECK(PINPRR3D,"RAIN_ICE end:PINPRR3D")
- CALL MPPDB_CHECK(PEVAP3D,"RAIN_ICE end:PEVAP3D")
- CALL MPPDB_CHECK(PINPRS,"RAIN_ICE end:PINPRS")
- CALL MPPDB_CHECK(PINPRG,"RAIN_ICE end:PINPRG")
- IF (PRESENT(PRHS)) CALL MPPDB_CHECK(PRHS,"RAIN_ICE end:PRHS")
- IF (PRESENT(PINPRH)) CALL MPPDB_CHECK(PINPRH,"RAIN_ICE end:PINPRH")
- !Check all OUT arrays
- IF (PRESENT(PFPR)) THEN
- DO JL=1,SIZE(PFPR,4)
- CALL MPPDB_CHECK(PFPR(:,:,:,JL),"RAIN_ICE end:PFPR(:,:,:,JL)")
- END DO
- END IF
-END IF
-!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
!
-!
CONTAINS
!
-!
!-------------------------------------------------------------------------------
!
-!
- SUBROUTINE RAIN_ICE_SEDIMENTATION_SPLIT
+ FUNCTION COUNTJV(LTAB,I1,I2,I3) RESULT(IC)
!
!* 0. DECLARATIONS
! ------------
@@ -1388,3457 +1072,27 @@ IMPLICIT NONE
!* 0.2 declaration of local variables
!
!
-INTEGER , DIMENSION(SIZE(GSEDIMC)) :: IC1,IC2,IC3 ! Used to replace the COUNT
-INTEGER , DIMENSION(SIZE(GSEDIMR)) :: IR1,IR2,IR3 ! Used to replace the COUNT
-INTEGER , DIMENSION(SIZE(GSEDIMS)) :: IS1,IS2,IS3 ! Used to replace the COUNT
-INTEGER , DIMENSION(SIZE(GSEDIMI)) :: II1,II2,II3 ! Used to replace the COUNT
-INTEGER , DIMENSION(SIZE(GSEDIMG)) :: IG1,IG2,IG3 ! Used to replace the COUNT
-INTEGER , DIMENSION(SIZE(GSEDIMH)) :: IH1,IH2,IH3 ! Used to replace the COUNT
-REAL :: ZRHODREFLOC ! RHO Dry REFerence
-REAL :: ZRSLOC,ZRTLOC ! Intermediary variables
-REAL :: ZWLBDC ! Slope parameter of the droplet distribution
-REAL :: ZCONC ! Concentration of aerosols
-REAL :: ZZTLOC ! Temperature
-REAL :: ZPRESLOC ! Pressure
-REAL :: ZRAY1D ! Mean radius
-REAL :: ZFSEDC1D ! For cloud sedimentation
-REAL :: ZWLBDA ! Mean freepath
-REAL :: ZCC ! Terminal velocity
-REAL :: ZTMP1, ZTMP2, ZTMP3 ! Intermediate variables
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) :: ZOMPSEA,ZTMP1_2D,ZTMP2_2D,ZTMP3_2D,ZTMP4_2D !Work arrays
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D ! droplet condensation
-!$acc declare device_resident(IC1,IC2,IC3,IR1,IR2,IR3,IS1,IS2,IS3, &
-!$acc & II1,II2,II3,IG1,IG2,IG3,IH1,IH2,IH3) &
-!$acc & device_resident(ZOMPSEA,ZTMP1_2D,ZTMP2_2D,ZTMP3_2D,ZTMP4_2D) &
-!$acc & create(ZCONC3D)
-!-------------------------------------------------------------------------------
-!
-!
-! O. Initialization of for sedimentation
-!
-!$acc kernels present(PINPRC,PINDEP,PINPRR,PINPRR3D,PINPRS,PINPRG,PINPRH)
-IF (OSEDIC) PINPRC (:,:) = 0.
-IF (LDEPOSC) PINDEP (:,:) = 0.
-PINPRR (:,:) = 0.
-PINPRR3D (:,:,:) = 0.
-PINPRS (:,:) = 0.
-PINPRG (:,:) = 0.
-IF ( KRR == 7 ) PINPRH (:,:) = 0.
-!$acc end kernels
-!
-!* 1. Parameters for cloud sedimentation
-!
- IF (OSEDIC) THEN
-!$acc kernels present(XNUC,XNUC2) default(none)
- ZTMP1 = 0.5*GAMMA(XNUC+ 1.0/XALPHAC )/(GAMMA(XNUC ))
- ZTMP2 = 0.5*GAMMA(XNUC2+1.0/XALPHAC2)/(GAMMA(XNUC2))
-!$acc end kernels
- !
-!$acc kernels present(ZCONC_TMP,ZFSEDC,ZLBC,ZRAY,PSEA,PTOWN,XFSEDC,XLBC) present(ZOMPSEA,ZTMP1_2D,ZTMP2_2D,ZTMP3_2D,ZTMP4_2D) default(none)
- IF (GPRESENT_PSEA) THEN
-!$acc loop independent collapse(2)
- DO JJ=1,SIZE(PRHODREF,2)
- DO JI=1,SIZE(PRHODREF,1)
- ZOMPSEA(JI,JJ) = 1.-PSEA(JI,JJ)
- ZTMP1_2D(JI,JJ) = PSEA(JI,JJ)*XLBC(2)+ZOMPSEA(JI,JJ)*XLBC(1)
- END DO
- END DO
-!acc loop independent collapse(3)
-!$acc loop independent
- DO JK=IKTB,IKTE
- DO JJ=1,SIZE(PRHODREF,2)
- DO JI=1,SIZE(PRHODREF,1)
- ZLBC(JI,JJ,JK) = ZTMP1_2D(JI,JJ)
- END DO
- END DO
- END DO
- !
-!$acc loop independent collapse(2)
- DO JJ=1,SIZE(PRHODREF,2)
- DO JI=1,SIZE(PRHODREF,1)
- ZTMP2_2D(JI,JJ) = PSEA(JI,JJ)*XFSEDC(2)+ZOMPSEA(JI,JJ)*XFSEDC(1)
- END DO
- END DO
-!$acc loop independent
- DO JK=IKTB,IKTE
- DO JJ=1,SIZE(PRHODREF,2)
- DO JI=1,SIZE(PRHODREF,1)
- ZFSEDC(JI,JJ,JK) = ZTMP2_2D(JI,JJ)
- END DO
- END DO
- END DO
- !
-!$acc loop independent collapse(2)
- DO JJ=1,SIZE(PRHODREF,2)
- DO JI=1,SIZE(PRHODREF,1)
- ZCONC_TMP(JI,JJ)= PSEA(JI,JJ)*XCONC_SEA+ZOMPSEA(JI,JJ)*XCONC_LAND
- ZTMP3_2D(JI,JJ) = (1.-PTOWN(JI,JJ))*ZCONC_TMP(JI,JJ)+PTOWN(JI,JJ)*XCONC_URBAN
- END DO
- END DO
-!$acc loop independent
- DO JK=IKTB,IKTE
- DO JJ=1,SIZE(PRHODREF,2)
- DO JI=1,SIZE(PRHODREF,1)
- ZCONC3D(JI,JJ,JK)= ZTMP3_2D(JI,JJ)
- END DO
- END DO
- END DO
- !
- DO JJ=1,SIZE(PRHODREF,2)
- DO JI=1,SIZE(PRHODREF,1)
- ZTMP4_2D(JI,JJ) = MAX( 1. , ZOMPSEA(JI,JJ)*ZTMP1 + PSEA(JI,JJ)*ZTMP2 )
- END DO
- END DO
-!$acc loop independent
- DO JK=IKTB,IKTE
- DO JJ=1,SIZE(PRHODREF,2)
- DO JI=1,SIZE(PRHODREF,1)
- ZRAY(JI,JJ,JK) = ZTMP4_2D(JI,JJ)
- END DO
- END DO
- END DO
- ELSE
- ZFSEDC(:,:,:) = XFSEDC(1)
- !
- ZCONC3D(:,:,:) = XCONC_LAND
- ZTMP3 = MAX(1.,ZTMP1)
- ZRAY(:,:,:) = ZTMP3
- ZLBC(:,:,:) = XLBC(1)
- END IF
-!$acc end kernels
- 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
-!$acc kernels present(GSEDIMR,GSEDIMC,GSEDIMI,GSEDIMS,GSEDIMG,GSEDIMH, &
-!$acc & PRCS,PRCT,PRGS,PRGT,PRHS,PRHT,PRRS,PRRT,PRSS,PRST,ZPRCS,ZPRGS,ZPRHS,ZPRRS,ZPRSS,ZRTMIN,XRTMIN)
-ZRTMIN(:) = XRTMIN(:) * ZINVTSTEP
-IF (OSEDIC) GSEDIMC(:,:,:) = .FALSE.
-#if 0
-GSEDIMR(:,:,:) = .FALSE.
-GSEDIMI(:,:,:) = .FALSE.
-GSEDIMS(:,:,:) = .FALSE.
-GSEDIMG(:,:,:) = .FALSE.
-#else
-!$acc loop collapse(3) independent
-DO JK=1,SIZE(GSEDIMR,3)
- DO JJ=1,SIZE(GSEDIMR,2)
- DO JI=1,SIZE(GSEDIMR,1)
- GSEDIMR(JI,JJ,JK) = .FALSE.
- GSEDIMI(JI,JJ,JK) = .FALSE.
- GSEDIMS(JI,JJ,JK) = .FALSE.
- GSEDIMG(JI,JJ,JK) = .FALSE.
- END DO
- END DO
-END DO
-#endif
-IF ( KRR == 7 ) GSEDIMH(:,:,:) = .FALSE.
-!
-! ZPiS = Specie i source creating during the current time step
-! PRiS = Source of the previous time step
-!
-IF (OSEDIC) THEN
- ZPRCS(:,:,:) = PRCS(:,:,:)-PRCT(:,:,:)* ZINVTSTEP
- PRCS(:,:,:) = PRCT(:,:,:)* ZINVTSTEP
-END IF
-#if 0
-ZPRRS(:,:,:) = PRRS(:,:,:)-PRRT(:,:,:)* ZINVTSTEP
-ZPRSS(:,:,:) = PRSS(:,:,:)-PRST(:,:,:)* ZINVTSTEP
-ZPRGS(:,:,:) = PRGS(:,:,:)-PRGT(:,:,:)* ZINVTSTEP
-IF ( KRR == 7 ) ZPRHS(:,:,:) = PRHS(:,:,:)-PRHT(:,:,:)* ZINVTSTEP
-PRRS(:,:,:) = PRRT(:,:,:)* ZINVTSTEP
-PRSS(:,:,:) = PRST(:,:,:)* ZINVTSTEP
-PRGS(:,:,:) = PRGT(:,:,:)* ZINVTSTEP
-IF ( KRR == 7 ) PRHS(:,:,:) = PRHT(:,:,:)* ZINVTSTEP
-#else
-!$acc loop collapse(3) independent
-! DO JK=IKTB,IKTE
-! DO JJ=IJB,IJE
-! DO JI=IIB,IIE
-DO JK=1,SIZE(PRRS,3)
- DO JJ=1,SIZE(PRRS,2)
- DO JI=1,SIZE(PRRS,1)
- ZPRRS(JI,JJ,JK) = PRRS(JI,JJ,JK)-PRRT(JI,JJ,JK)* ZINVTSTEP
- ZPRSS(JI,JJ,JK) = PRSS(JI,JJ,JK)-PRST(JI,JJ,JK)* ZINVTSTEP
- ZPRGS(JI,JJ,JK) = PRGS(JI,JJ,JK)-PRGT(JI,JJ,JK)* ZINVTSTEP
- PRRS(JI,JJ,JK) = PRRT(JI,JJ,JK)* ZINVTSTEP
- PRSS(JI,JJ,JK) = PRST(JI,JJ,JK)* ZINVTSTEP
- PRGS(JI,JJ,JK) = PRGT(JI,JJ,JK)* ZINVTSTEP
- END DO
- END DO
-END DO
-IF ( KRR == 7 ) THEN
-!$acc loop collapse(3) independent
-! DO JK=IKTB,IKTE
-! DO JJ=IJB,IJE
-! DO JI=IIB,IIE
-DO JK=1,SIZE(PRHS,3)
- DO JJ=1,SIZE(PRHS,2)
- DO JI=1,SIZE(PRHS,1)
- ZPRHS(JI,JJ,JK) = PRHS(JI,JJ,JK)-PRHT(JI,JJ,JK)* ZINVTSTEP
- PRHS(JI,JJ,JK) = PRHT(JI,JJ,JK)* ZINVTSTEP
- END DO
- END DO
- END DO
-END IF
-#endif
-!$acc end kernels
-!
-! PRiS = Source of the previous time step + source created during the subtime
-! step
-!
-DO JN = 1 , KSPLITR
-!$acc kernels present(PDZZ,PRHODREF,PRCS,PRGS,PRHS,PRRS,PRSS,ZPRCS,ZPRGS,ZPRHS,ZPRRS,ZPRSS,ZW) present(GSEDIMR,GSEDIMC,GSEDIMI,GSEDIMS,GSEDIMG,GSEDIMH,PRCS,PRGS,PRHS,PRIS,PRRS,PRSS,ZRTMIN)
- IF( JN==1 ) THEN
- IF (OSEDIC) PRCS(:,:,:) = PRCS(:,:,:) + ZPRCS(:,:,:)/KSPLITR
- PRRS(:,:,:) = PRRS(:,:,:) + ZPRRS(:,:,:)/KSPLITR
- PRSS(:,:,:) = PRSS(:,:,:) + ZPRSS(:,:,:)/KSPLITR
- PRGS(:,:,:) = PRGS(:,:,:) + ZPRGS(:,:,:)/KSPLITR
- IF ( KRR == 7 ) PRHS(:,:,:) = PRHS(:,:,:) + ZPRHS(:,:,:)/KSPLITR
- DO JK = IKTB , IKTE
- ZW(:,:,JK) =ZTSPLITR/(PRHODREF(:,:,JK)* PDZZ(:,:,JK))
- END DO
- ELSE
- IF (OSEDIC) PRCS(:,:,:) = PRCS(:,:,:) + ZPRCS(:,:,:)*ZTSPLITR
- PRRS(:,:,:) = PRRS(:,:,:) + ZPRRS(:,:,:)*ZTSPLITR
- PRSS(:,:,:) = PRSS(:,:,:) + ZPRSS(:,:,:)*ZTSPLITR
- PRGS(:,:,:) = PRGS(:,:,:) + ZPRGS(:,:,:)*ZTSPLITR
- IF ( KRR == 7 ) PRHS(:,:,:) = PRHS(:,:,:) + ZPRHS(:,:,:)*ZTSPLITR
- END IF
-#if 0
- IF (OSEDIC) GSEDIMC(IIB:IIE,IJB:IJE,IKTB:IKTE) = &
- PRCS(IIB:IIE,IJB:IJE,IKTB:IKTE)>ZRTMIN(2)
- GSEDIMR(IIB:IIE,IJB:IJE,IKTB:IKTE) = &
- PRRS(IIB:IIE,IJB:IJE,IKTB:IKTE)>ZRTMIN(3)
- GSEDIMI(IIB:IIE,IJB:IJE,IKTB:IKTE) = &
- PRIS(IIB:IIE,IJB:IJE,IKTB:IKTE)>ZRTMIN(4)
- GSEDIMS(IIB:IIE,IJB:IJE,IKTB:IKTE) = &
- PRSS(IIB:IIE,IJB:IJE,IKTB:IKTE)>ZRTMIN(5)
- GSEDIMG(IIB:IIE,IJB:IJE,IKTB:IKTE) = &
- PRGS(IIB:IIE,IJB:IJE,IKTB:IKTE)>ZRTMIN(6)
- IF ( KRR == 7 ) GSEDIMH(IIB:IIE,IJB:IJE,IKTB:IKTE) = &
- PRHS(IIB:IIE,IJB:IJE,IKTB:IKTE)>ZRTMIN(7)
-#else
- IF (OSEDIC) THEN
-!$acc loop collapse(3) independent
- DO JK=IKTB,IKTE
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- GSEDIMC(JI,JJ,JK) = PRCS(JI,JJ,JK)>ZRTMIN(2)
- END DO
- END DO
- END DO
- END IF
-!$acc loop collapse(3) independent
- DO JK=IKTB,IKTE
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- GSEDIMR(JI,JJ,JK) = PRRS(JI,JJ,JK)>ZRTMIN(3)
- GSEDIMI(JI,JJ,JK) = PRIS(JI,JJ,JK)>ZRTMIN(4)
- GSEDIMS(JI,JJ,JK) = PRSS(JI,JJ,JK)>ZRTMIN(5)
- GSEDIMG(JI,JJ,JK) = PRGS(JI,JJ,JK)>ZRTMIN(6)
- END DO
- END DO
- END DO
-IF ( KRR == 7 ) THEN
-!$acc loop collapse(3) independent
- DO JK=IKTB,IKTE
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- GSEDIMH(JI,JJ,JK) = PRHS(JI,JJ,JK)>ZRTMIN(7)
- END DO
- END DO
- END DO
- END IF
-#endif
-!$acc end kernels
-!
-#ifndef _OPENACC
- IF (OSEDIC) ISEDIMC = COUNTJV3D( GSEDIMC(:,:,:),IC1(:),IC2(:),IC3(:))
- ISEDIMR = COUNTJV3D( GSEDIMR(:,:,:),IR1(:),IR2(:),IR3(:))
- ISEDIMI = COUNTJV3D( GSEDIMI(:,:,:),II1(:),II2(:),II3(:))
- ISEDIMS = COUNTJV3D( GSEDIMS(:,:,:),IS1(:),IS2(:),IS3(:))
- ISEDIMG = COUNTJV3D( GSEDIMG(:,:,:),IG1(:),IG2(:),IG3(:))
- IF ( KRR == 7 ) ISEDIMH = COUNTJV3D( GSEDIMH(:,:,:),IH1(:),IH2(:),IH3(:))
-#else
- IF (OSEDIC) CALL COUNTJV3D_DEVICE(GSEDIMC,IC1,IC2,IC3,ISEDIMC)
- CALL COUNTJV3D_DEVICE(GSEDIMR,IR1,IR2,IR3,ISEDIMR)
- CALL COUNTJV3D_DEVICE(GSEDIMI,II1,II2,II3,ISEDIMI)
- CALL COUNTJV3D_DEVICE(GSEDIMS,IS1,IS2,IS3,ISEDIMS)
- CALL COUNTJV3D_DEVICE(GSEDIMG,IG1,IG2,IG3,ISEDIMG)
- IF ( KRR == 7 ) CALL COUNTJV3D_DEVICE(GSEDIMH,IH1,IH2,IH3,ISEDIMH)
-#endif
-!
-!* 2.1 for cloud
+LOGICAL, DIMENSION(:,:,:) :: LTAB ! Mask
+INTEGER, DIMENSION(:) :: I1,I2,I3 ! Used to replace the COUNT and PACK
+INTEGER :: JI,JJ,JK,IC
!
-!$acc kernels present(ZFSEDC,ZLBC,ZRAY,ZRTMIN,ZW,ZWSED,PFPR,PINPRC,PPABST,PRCS,PRCT,PRHODREF,PTHT,XLBEXC,XRTMIN, &
-!$acc & PRRS,XEXSEDR,PINPRR,PINPRR3D)
-IF (OSEDIC) THEN
- ZWSED(:,:,:) = 0.
- IF( JN==1 ) PRCS(:,:,:) = PRCS(:,:,:) * PTSTEP
+!-------------------------------------------------------------------------------
!
-!$acc loop independent private(ZRSLOC,ZRTLOC,ZRHODREFLOC,ZWLBDC,ZCONC,ZZTLOC,ZPRESLOC,ZRAY1D,ZFSEDC1D,ZWLBDA,ZCC)
- DO JL=1,ISEDIMC
- ZRSLOC = PRCS(IC1(JL),IC2(JL),IC3(JL))
- ZRTLOC = PRCT(IC1(JL),IC2(JL),IC3(JL))
- IF (ZRSLOC .GT. ZRTMIN(2) .AND. ZRTLOC .GT. XRTMIN(2)) THEN
- ZRHODREFLOC = PRHODREF(IC1(JL),IC2(JL),IC3(JL))
- ZWLBDC = ZLBC (IC1(JL),IC2(JL),IC3(JL))
- ZCONC = ZCONC3D (IC1(JL),IC2(JL),IC3(JL))
- ZZTLOC = PTHT (IC1(JL),IC2(JL),IC3(JL))
- ZPRESLOC = PPABST (IC1(JL),IC2(JL),IC3(JL))
- ZRAY1D = ZRAY (IC1(JL),IC2(JL),IC3(JL))
- ZFSEDC1D = ZFSEDC (IC1(JL),IC2(JL),IC3(JL))
- ZWLBDC = ZWLBDC * ZCONC / (ZRHODREFLOC * ZRTLOC)
-#ifndef MNH_BITREP
- ZWLBDC = ZWLBDC**XLBEXC
-#else
- ZWLBDC = BR_POW(ZWLBDC,XLBEXC)
-#endif
- ZRAY1D = ZRAY1D / ZWLBDC !! ZRAY : mean diameter=M(1)/2
-#ifndef MNH_BITREP
- ZZTLOC = ZZTLOC * (ZPRESLOC/XP00)**(XRD/XCPD)
-#else
- ZZTLOC = ZZTLOC * BR_POW(ZPRESLOC/XP00,XRD/XCPD)
-#endif
- ZWLBDA = 6.6E-8*(101325./ZPRESLOC)*(ZZTLOC/293.15)
- ZCC = XCC*(1.+1.26*ZWLBDA/ZRAY1D) !! XCC modified for cloud
-#ifndef MNH_BITREP
- ZWSED (IC1(JL),IC2(JL),IC3(JL))= ZRHODREFLOC**(-XCEXVT +1 ) * &
- ZWLBDC**(-XDC)*ZCC*ZFSEDC1D * ZRSLOC
-#else
- ZWSED (IC1(JL),IC2(JL),IC3(JL))= BR_POW(ZRHODREFLOC,-XCEXVT +1) * &
- BR_POW(ZWLBDC,-XDC)*ZCC*ZFSEDC1D * ZRSLOC
-#endif
+IC = 0
+DO JK = 1,SIZE(LTAB,3)
+ DO JJ = 1,SIZE(LTAB,2)
+ DO JI = 1,SIZE(LTAB,1)
+ IF( LTAB(JI,JJ,JK) ) THEN
+ IC = IC +1
+ I1(IC) = JI
+ I2(IC) = JJ
+ I3(IC) = JK
END IF
END DO
-!
-!$acc loop independent
- DO JK = IKTB , IKTE
- PRCS(:,:,JK) = PRCS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
- END DO
- IF (GPRESENT_PFPR) THEN
- DO JK = IKTB , IKTE
- PFPR(:,:,JK,2)=ZWSED(:,:,JK)
- ENDDO
- ENDIF
- PINPRC(:,:) = PINPRC(:,:) + ZWSED(:,:,IKB) / XRHOLW / KSPLITR
- IF( JN==KSPLITR ) THEN
- PRCS(:,:,:) = PRCS(:,:,:) * ZINVTSTEP
- END IF
- END IF
-!
-!* 2.2 for rain
-!
- IF( JN==1 ) PRRS(:,:,:) = PRRS(:,:,:) * PTSTEP
- ZWSED(:,:,:) = 0.
-!
-!$acc loop independent private(ZRSLOC,ZRHODREFLOC)
- DO JL=1,ISEDIMR
- ZRSLOC = PRRS(IR1(JL),IR2(JL),IR3(JL))
- IF( ZRSLOC .GT. ZRTMIN(3) ) THEN
- ZRHODREFLOC = PRHODREF(IR1(JL),IR2(JL),IR3(JL))
-#ifndef MNH_BITREP
- ZWSED (IR1(JL),IR2(JL),IR3(JL))= XFSEDR * ZRSLOC**XEXSEDR * &
- ZRHODREFLOC**(XEXSEDR-XCEXVT)
-#else
- ZWSED (IR1(JL),IR2(JL),IR3(JL))= XFSEDR * BR_POW(ZRSLOC,XEXSEDR) * &
- BR_POW(ZRHODREFLOC,XEXSEDR-XCEXVT)
-#endif
- END IF
- END DO
-!
-!$acc loop independent
- DO JK = IKTB , IKTE
- PRRS(:,:,JK) = PRRS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
- END DO
- IF (GPRESENT_PFPR) THEN
- DO JK = IKTB , IKTE
- PFPR(:,:,JK,3)=ZWSED(:,:,JK)
- ENDDO
- ENDIF
- PINPRR(:,:) = PINPRR(:,:) + ZWSED(:,:,IKB) /XRHOLW/KSPLITR
- PINPRR3D(:,:,:) = PINPRR3D(:,:,:) + ZWSED(:,:,1:IKT)/XRHOLW/KSPLITR
- IF ( JN==KSPLITR ) THEN
- PRRS(:,:,:) = PRRS(:,:,:) * ZINVTSTEP
- END IF
-!$acc end kernels
-!$acc kernels present(ZRTMIN,ZW,ZWSED,PFPR,PINPRS,PRGS,PRIS,PRSS,PRHODREF,XEXCSEDI,XEXSEDS, &
-!$acc & XCEXVT,XEXSEDG,XFSEDG,PINPRG,PINPRH,PRHS,XEXSEDH)
-!
-!* 2.3 for pristine ice
-!
- IF( JN==1 ) PRIS(:,:,:) = PRIS(:,:,:) * PTSTEP
- ZWSED(:,:,:) = 0.
-!
-!$acc loop independent private(ZRSLOC,ZRHODREFLOC)
- DO JL=1,ISEDIMI
- ZRSLOC = PRIS(II1(JL),II2(JL),II3(JL))
- IF( ZRSLOC .GT. MAX(ZRTMIN(4),1.0E-7 )) THEN ! limitation of the McF&H formula
- ZRHODREFLOC = PRHODREF(II1(JL),II2(JL),II3(JL))
-#ifndef MNH_BITREP
- ZWSED (II1(JL),II2(JL),II3(JL))= XFSEDI * ZRSLOC * &
- ZRHODREFLOC**(1.0-XCEXVT) * & ! McF&H
- MAX( 0.05E6,-0.15319E6-0.021454E6* &
- ALOG(ZRHODREFLOC*ZRSLOC) )**XEXCSEDI
-#else
- ZWSED (II1(JL),II2(JL),II3(JL))= XFSEDI * ZRSLOC * &
- BR_POW(ZRHODREFLOC,1.0-XCEXVT) * & ! McF&H
- BR_POW(MAX( 0.05E6,-0.15319E6-0.021454E6* &
- BR_LOG(ZRHODREFLOC*ZRSLOC) ),XEXCSEDI)
-#endif
- END IF
- END DO
-!
-!$acc loop independent
- DO JK = IKTB , IKTE
- PRIS(:,:,JK) = PRIS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
- END DO
- IF (GPRESENT_PFPR) THEN
- DO JK = IKTB , IKTE
- PFPR(:,:,JK,4)=ZWSED(:,:,JK)
- ENDDO
- ENDIF
- IF( JN==KSPLITR ) THEN
- PRIS(:,:,:) = PRIS(:,:,:) * ZINVTSTEP
- END IF
-!
-!* 2.4 for aggregates/snow
-!
- IF( JN==1 ) PRSS(:,:,:) = PRSS(:,:,:) * PTSTEP
- ZWSED(:,:,:) = 0.
-!
-!$acc loop independent private(ZRSLOC,ZRHODREFLOC)
- DO JL=1,ISEDIMS
- ZRSLOC = PRSS(IS1(JL),IS2(JL),IS3(JL))
- IF( ZRSLOC .GT. ZRTMIN(5) ) THEN
- ZRHODREFLOC = PRHODREF(IS1(JL),IS2(JL),IS3(JL))
-#ifndef MNH_BITREP
- ZWSED (IS1(JL),IS2(JL),IS3(JL))= XFSEDS * ZRSLOC**XEXSEDS * &
- ZRHODREFLOC**(XEXSEDS-XCEXVT)
-#else
- ZWSED (IS1(JL),IS2(JL),IS3(JL))= XFSEDS * BR_POW(ZRSLOC,XEXSEDS) * &
- BR_POW(ZRHODREFLOC,XEXSEDS-XCEXVT)
-#endif
- END IF
- END DO
-!
-!$acc loop independent
- DO JK = IKTB , IKTE
- PRSS(:,:,JK) = PRSS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
- END DO
- PINPRS(:,:) = PINPRS(:,:) + ZWSED(:,:,IKB)/XRHOLW/KSPLITR
- IF (GPRESENT_PFPR) THEN
- DO JK = IKTB , IKTE
- PFPR(:,:,JK,5)=ZWSED(:,:,JK)
- ENDDO
- ENDIF
- IF( JN==KSPLITR ) THEN
- PRSS(:,:,:) = PRSS(:,:,:) * ZINVTSTEP
- END IF
-!
-!* 2.5 for graupeln
-!
- ZWSED(:,:,:) = 0.
- IF( JN==1 ) PRGS(:,:,:) = PRGS(:,:,:) * PTSTEP
-!
-!$acc loop independent private(ZRSLOC,ZRHODREFLOC)
- DO JL=1,ISEDIMG
- ZRSLOC = PRGS(IG1(JL),IG2(JL),IG3(JL))
- IF( ZRSLOC .GT. ZRTMIN(6) ) THEN
- ZRHODREFLOC = PRHODREF(IG1(JL),IG2(JL),IG3(JL))
-#ifndef MNH_BITREP
- ZWSED (IG1(JL),IG2(JL),IG3(JL))= XFSEDG * ZRSLOC**XEXSEDG * &
- ZRHODREFLOC**(XEXSEDG-XCEXVT)
-#else
- ZWSED (IG1(JL),IG2(JL),IG3(JL))= XFSEDG * BR_POW(ZRSLOC,XEXSEDG) * &
- BR_POW(ZRHODREFLOC,XEXSEDG-XCEXVT)
-#endif
- END IF
- END DO
-!
-!$acc loop independent
- DO JK = IKTB , IKTE
- PRGS(:,:,JK) = PRGS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
- END DO
- IF (GPRESENT_PFPR) THEN
- DO JK = IKTB , IKTE
- PFPR(:,:,JK,6)=ZWSED(:,:,JK)
- ENDDO
- ENDIF
- PINPRG(:,:) = PINPRG(:,:) + ZWSED(:,:,IKB)/XRHOLW/KSPLITR
- IF( JN==KSPLITR ) THEN
- PRGS(:,:,:) = PRGS(:,:,:) * ZINVTSTEP
- END IF
-!
-!* 2.6 for hail
-!
- IF ( KRR == 7 ) THEN
- IF( JN==1 ) PRHS(:,:,:) = PRHS(:,:,:) * PTSTEP
- ZWSED(:,:,:) = 0.
-!
-!$acc loop independent private(ZRSLOC,ZRHODREFLOC)
- DO JL=1,ISEDIMH
- ZRSLOC = PRHS(IH1(JL),IH2(JL),IH3(JL))
- IF( ZRSLOC .GT. ZRTMIN(7) ) THEN
- ZRHODREFLOC = PRHODREF(IH1(JL),IH2(JL),IH3(JL))
-#ifndef MNH_BITREP
- ZWSED (IH1(JL),IH2(JL),IH3(JL))= XFSEDH * ZRSLOC**XEXSEDH * &
- ZRHODREFLOC**(XEXSEDH-XCEXVT)
-#else
- ZWSED (IH1(JL),IH2(JL),IH3(JL))= XFSEDH * BR_POW(ZRSLOC,XEXSEDH) * &
- BR_POW(ZRHODREFLOC,XEXSEDH-XCEXVT)
-#endif
- END IF
END DO
+END DO
!
-!$acc loop independent
- DO JK = IKTB , IKTE
- PRHS(:,:,JK) = PRHS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
- END DO
- IF (GPRESENT_PFPR) THEN
- DO JK = IKTB , IKTE
- PFPR(:,:,JK,7)=ZWSED(:,:,JK)
- ENDDO
- ENDIF
- PINPRH(:,:) = PINPRH(:,:) + ZWSED(:,:,IKB)/XRHOLW/KSPLITR
- IF( JN==KSPLITR ) THEN
- PRHS(:,:,:) = PRHS(:,:,:) * ZINVTSTEP
- END IF
- END IF ! KRR==7
-!$acc end kernels
-!
-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
-!
-!
-!* 2.4 DROPLET DEPOSITION AT THE 1ST LEVEL ABOVE GROUND
-!
-IF (LDEPOSC) THEN
-#ifdef _OPENACC
- PRINT *,'OPENACC: RAIN_ICE_SEDIMENTATION_SPLIT::LDEPOSC=.T. not yet tested'
- CALL ABORT
-#endif
-!$acc kernels present(GDEP,PDZZ,PINDEP,PINPRC,PRCS,PRCT,PRHODREF)
- GDEP(:,:) = .FALSE.
- GDEP(IIB:IIE,IJB:IJE) = PRCS(IIB:IIE,IJB:IJE,IKB) >0
- WHERE (GDEP)
- PRCS(:,:,IKB) = PRCS(:,:,IKB) - XVDEPOSC * PRCT(:,:,IKB) / PDZZ(:,:,IKB)
- PINPRC(:,:) = PINPRC(:,:) + XVDEPOSC * PRCT(:,:,IKB) * PRHODREF(:,:,IKB) /XRHOLW
- PINDEP(:,:) = XVDEPOSC * PRCT(:,:,IKB) * PRHODREF(:,:,IKB) /XRHOLW
- END WHERE
-!$acc end kernels
-END IF
-!
-!* 2.5 budget storage
-!
-IF ( LBUDGET_RC .AND. LDEPOSC ) THEN
-!$acc update self(PRCS)
- CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'DEPO_BU_RRC')
-END IF
-!
- END SUBROUTINE RAIN_ICE_SEDIMENTATION_SPLIT
-!
-!-------------------------------------------------------------------------------
-!
- SUBROUTINE RAIN_ICE_SEDIMENTATION_STAT
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!* 0.2 declaration of local variables
-!
-!
-
-REAL :: ZP1,ZP2,ZH,ZZWLBDA,ZZWLBDC,ZZCC
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) :: ZQP
-INTEGER :: JI,JJ,JK
-INTEGER :: JCOUNT, JL
-INTEGER, DIMENSION(SIZE(PRHODREF,1)*SIZE(PRHODREF,2)) :: I1, I2
-!
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D ! droplet condensation
-!-------------------------------------------------------------------------------
-!
-#ifdef _OPENACC
- PRINT *,'OPENACC: RAIN_ICE_SEDIMENTATION_STAT not yet implemented'
- CALL ABORT
-#endif
-!
-!
-!* 1. Parameters for cloud sedimentation
-!
- IF (OSEDIC) THEN
- ZRAY(:,:,:) = 0.
- ZLBC(:,:,:) = XLBC(1)
- ZFSEDC(:,:,:) = XFSEDC(1)
- ZCONC3D(:,:,:)= XCONC_LAND
- ZCONC_TMP(:,:)= XCONC_LAND
- IF (PRESENT(PSEA)) THEN
- ZCONC_TMP(:,:)=PSEA(:,:)*XCONC_SEA+(1.-PSEA(:,:))*XCONC_LAND
-
- DO JK=IKTB,IKTE
- 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
- ELSE
- ZCONC3D(:,:,:) = XCONC_LAND
- ZRAY(:,:,:) = 0.5*(GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)))
- END IF
- ZRAY(:,:,:) = MAX(1.,ZRAY(:,:,:))
- ZLBC(:,:,:) = MAX(MIN(XLBC(1),XLBC(2)),ZLBC(:,:,:))
- ENDIF
- IF (LDEPOSC) PINDEP (:,:) = 0.
-
-!* 2. compute the fluxes
-!
-
-
-ZRTMIN(:) = XRTMIN(:) * ZINVTSTEP
-!
-IF (OSEDIC) THEN
- ZPRCS(:,:,:) = 0.0
- ZPRCS(:,:,:) = PRCS(:,:,:)-PRCT(:,:,:)* ZINVTSTEP
- PRCS(:,:,:) = PRCT(:,:,:)* ZINVTSTEP
-END IF
-ZPRRS(:,:,:) = 0.0
-ZPRSS(:,:,:) = 0.0
-ZPRGS(:,:,:) = 0.0
-IF ( KRR == 7 ) ZPRHS(:,:,:) = 0.0
-!
-ZPRRS(:,:,:) = PRRS(:,:,:)-PRRT(:,:,:)* ZINVTSTEP
-ZPRSS(:,:,:) = PRSS(:,:,:)-PRST(:,:,:)* ZINVTSTEP
-ZPRGS(:,:,:) = PRGS(:,:,:)-PRGT(:,:,:)* ZINVTSTEP
-IF ( KRR == 7 ) ZPRHS(:,:,:) = PRHS(:,:,:)-PRHT(:,:,:)* ZINVTSTEP
-PRRS(:,:,:) = PRRT(:,:,:)* ZINVTSTEP
-PRSS(:,:,:) = PRST(:,:,:)* ZINVTSTEP
-PRGS(:,:,:) = PRGT(:,:,:)* ZINVTSTEP
-IF ( KRR == 7 ) PRHS(:,:,:) = PRHT(:,:,:)* ZINVTSTEP
-!
-IF (OSEDIC) PRCS(:,:,:) = PRCS(:,:,:) + ZPRCS(:,:,:)
-PRRS(:,:,:) = PRRS(:,:,:) + ZPRRS(:,:,:)
-PRSS(:,:,:) = PRSS(:,:,:) + ZPRSS(:,:,:)
-PRGS(:,:,:) = PRGS(:,:,:) + ZPRGS(:,:,:)
-IF ( KRR == 7 ) PRHS(:,:,:) = PRHS(:,:,:) + ZPRHS(:,:,:)
-DO JK = IKTB , IKTE
- ZW(:,:,JK) =PTSTEP/(PRHODREF(:,:,JK)* PDZZ(:,:,JK) )
-END DO
-
-!
-!* 2.1 for cloud
-!
- IF (OSEDIC) THEN
- PRCS(:,:,:) = PRCS(:,:,:) * PTSTEP
- ZWSED(:,:,:) = 0.
- ZWSEDW1(:,:,:) = 0.
- ZWSEDW2(:,:,:) = 0.
-
-! calculation of P1, P2 and sedimentation flux
- DO JK = IKE , IKB, -1*KKL
- !estimation of q' taking into account incomming ZWSED
- ZQP(:,:)=ZWSED(:,:,JK+KKL)*ZW(:,:,JK)
-
- JCOUNT=COUNTJV2D((PRCS(:,:,JK) > ZRTMIN(2) .AND. PRCT(:,:,JK) > ZRTMIN(2)) .OR. &
- (ZQP(:,:) > ZRTMIN(2)),I1(:),I2(:))
- DO JL=1, JCOUNT
- JI=I1(JL)
- JJ=I2(JL)
- !calculation of w
- ! mars 2009 : ajout d'un test
- !IF ( PRCS(JI,JJ,JK) > ZRTMIN(2) ) THEN
- IF(PRCS(JI,JJ,JK) > ZRTMIN(2) .AND. PRCT(JI,JJ,JK) > ZRTMIN(2)) THEN
- ZZWLBDA=6.6E-8*(101325./PPABST(JI,JJ,JK))*(PTHT(JI,JJ,JK)/293.15)
-#ifndef MNH_BITREP
- ZZWLBDC=(ZLBC(JI,JJ,JK)*ZCONC3D(JI,JJ,JK) &
- &/(PRHODREF(JI,JJ,JK)*PRCT(JI,JJ,JK)))**XLBEXC
-#else
- ZZWLBDC=BR_POW(ZLBC(JI,JJ,JK)*ZCONC3D(JI,JJ,JK) &
- &/(PRHODREF(JI,JJ,JK)*PRCT(JI,JJ,JK)),XLBEXC)
-#endif
- ZZCC=XCC*(1.+1.26*ZZWLBDA*ZZWLBDC/ZRAY(JI,JJ,JK)) !! ZCC : Fall speed
-#ifndef MNH_BITREP
- ZWSEDW1 (JI,JJ,JK)=PRHODREF(JI,JJ,JK)**(-XCEXVT ) * &
- & ZZWLBDC**(-XDC)*ZZCC*ZFSEDC(JI,JJ,JK)
-#else
- ZWSEDW1 (JI,JJ,JK)=BR_POW(PRHODREF(JI,JJ,JK),-XCEXVT) * &
- & BR_POW(ZZWLBDC,-XDC)*ZZCC*ZFSEDC(JI,JJ,JK)
-#endif
- ENDIF
- IF ( ZQP(JI,JJ) > ZRTMIN(2) ) THEN
- ZZWLBDA=6.6E-8*(101325./PPABST(JI,JJ,JK))*(PTHT(JI,JJ,JK)/293.15)
-#ifndef MNH_BITREP
- ZZWLBDC=(ZLBC(JI,JJ,JK)*ZCONC3D(JI,JJ,JK) &
- &/(PRHODREF(JI,JJ,JK)*ZQP(JI,JJ)))**XLBEXC
-#else
- ZZWLBDC=BR_POW(ZLBC(JI,JJ,JK)*ZCONC3D(JI,JJ,JK) &
- &/(PRHODREF(JI,JJ,JK)*ZQP(JI,JJ)),XLBEXC)
-#endif
- ZZCC=XCC*(1.+1.26*ZZWLBDA*ZZWLBDC/ZRAY(JI,JJ,JK)) !! ZCC : Fall speed
-#ifndef MNH_BITREP
- ZWSEDW2 (JI,JJ,JK)=PRHODREF(JI,JJ,JK)**(-XCEXVT ) * &
- & ZZWLBDC**(-XDC)*ZZCC*ZFSEDC(JI,JJ,JK)
-#else
- ZWSEDW2 (JI,JJ,JK)=BR_POW(PRHODREF(JI,JJ,JK),-XCEXVT ) * &
- & BR_POW(ZZWLBDC,-XDC)*ZZCC*ZFSEDC(JI,JJ,JK)
-#endif
- ENDIF
- ENDDO
-
- DO JJ = IJB, IJE
- DO JI = IIB, IIE
- ZH=PDZZ(JI,JJ,JK)
- ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH)
- ! mars 2009 : correction : ZWSEDW1 => ZWSEDW2
- !IF (ZWSEDW1(JI,JJ,JK) /= 0.) THEN
- IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
- ZP2 = MAX(0.,1 - ZH &
- & / (PTSTEP*ZWSEDW2(JI,JJ,JK)) )
- ELSE
- ZP2 = 0.
- ENDIF
- ZWSED (JI,JJ,JK)=ZP1*PRHODREF(JI,JJ,JK)*&
- &ZH*PRCS(JI,JJ,JK)&
- &* ZINVTSTEP+ ZP2 * ZWSED (JI,JJ,JK+KKL)
- ENDDO
- ENDDO
- ENDDO
-
- DO JK = IKTB , IKTE
- PRCS(:,:,JK) = PRCS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
- END DO
- IF (GPRESENT_PFPR) THEN
- DO JK = IKTB , IKTE
- PFPR(:,:,JK,2)=ZWSED(:,:,JK)
- ENDDO
- ENDIF
-
- PINPRC(:,:) = ZWSED(:,:,IKB)/XRHOLW ! in m/s
- PRCS(:,:,:) = PRCS(:,:,:) * ZINVTSTEP
- ENDIF
-
-!
-!* 2.2 for rain
-!
-
- PRRS(:,:,:) = PRRS(:,:,:) * PTSTEP
- ZWSED(:,:,:) = 0.
- ZWSEDW1(:,:,:) = 0.
- ZWSEDW2(:,:,:) = 0.
-
-! calculation of ZP1, ZP2 and sedimentation flux
- DO JK = IKE , IKB, -1*KKL
- !estimation of q' taking into account incomming ZWSED
- ZQP(:,:)=ZWSED(:,:,JK+KKL)*ZW(:,:,JK)
-
- JCOUNT=COUNTJV2D((PRRS(:,:,JK) > ZRTMIN(3)) .OR. &
- (ZQP(:,:) > ZRTMIN(3)),I1(:),I2(:))
- DO JL=1, JCOUNT
- JI=I1(JL)
- JJ=I2(JL)
- !calculation of w
- IF ( PRRS(JI,JJ,JK) > ZRTMIN(3) ) THEN
-#ifndef MNH_BITREP
- ZWSEDW1 (JI,JJ,JK)= XFSEDR *PRRS(JI,JJ,JK)**(XEXSEDR-1)* &
- PRHODREF(JI,JJ,JK)**(XEXSEDR-XCEXVT-1)
-#else
- ZWSEDW1 (JI,JJ,JK)= XFSEDR *BR_POW(PRRS(JI,JJ,JK),XEXSEDR-1)* &
- BR_POW(PRHODREF(JI,JJ,JK),XEXSEDR-XCEXVT-1)
-#endif
- ENDIF
- IF ( ZQP(JI,JJ) > ZRTMIN(3) ) THEN
-#ifndef MNH_BITREP
- ZWSEDW2 (JI,JJ,JK)= XFSEDR *(ZQP(JI,JJ))**(XEXSEDR-1)* &
- PRHODREF(JI,JJ,JK)**(XEXSEDR-XCEXVT-1)
-#else
- ZWSEDW2 (JI,JJ,JK)= XFSEDR *BR_POW(ZQP(JI,JJ),XEXSEDR-1)* &
- BR_POW(PRHODREF(JI,JJ,JK),XEXSEDR-XCEXVT-1)
-#endif
- ENDIF
- ENDDO
- DO JJ = IJB, IJE
- DO JI = IIB, IIE
- ZH=PDZZ(JI,JJ,JK)
- ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH )
- IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
- ZP2 = MAX(0.,1 - ZH &
- & / (PTSTEP*ZWSEDW2(JI,JJ,JK)) )
- ELSE
- ZP2 = 0.
- ENDIF
- ZWSED (JI,JJ,JK)=ZP1*PRHODREF(JI,JJ,JK)*&
- &ZH*PRRS(JI,JJ,JK)&
- &* ZINVTSTEP+ ZP2 * ZWSED (JI,JJ,JK+KKL)
- ENDDO
- ENDDO
- ENDDO
-
- DO JK = IKTB , IKTE
- PRRS(:,:,JK) = PRRS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
- ENDDO
- IF (GPRESENT_PFPR) THEN
- DO JK = IKTB , IKTE
- PFPR(:,:,JK,3)=ZWSED(:,:,JK)
- ENDDO
- ENDIF
- PINPRR(:,:) = ZWSED(:,:,IKB)/XRHOLW ! in m/s
- PINPRR3D(:,:,:) = ZWSED(:,:,1:IKT)/XRHOLW ! in m/s
- PRRS(:,:,:) = PRRS(:,:,:) * ZINVTSTEP
-
-!
-!* 2.3 for pristine ice
-!
-
- PRIS(:,:,:) = PRIS(:,:,:) * PTSTEP
- ZWSED(:,:,:) = 0.
- ZWSEDW1(:,:,:) = 0.
- ZWSEDW2(:,:,:) = 0.
-! calculation of ZP1, ZP2 and sedimentation flux
- DO JK = IKE , IKB, -1*KKL
- !estimation of q' taking into account incomming ZWSED
- ZQP(:,:)=ZWSED(:,:,JK+KKL)*ZW(:,:,JK)
-
- JCOUNT=COUNTJV2D((PRIS(:,:,JK) > MAX(ZRTMIN(4),1.0E-7 )) .OR. &
- (ZQP(:,:) > MAX(ZRTMIN(4),1.0E-7 )),I1(:),I2(:))
- DO JL=1, JCOUNT
- JI=I1(JL)
- JJ=I2(JL)
- !calculation of w
- IF ( PRIS(JI,JJ,JK) > MAX(ZRTMIN(4),1.0E-7 ) ) THEN
-#ifndef MNH_BITREP
- ZWSEDW1 (JI,JJ,JK)= XFSEDI * &
- & PRHODREF(JI,JJ,JK)**(XCEXVT) * & ! McF&H
- & MAX( 0.05E6,-0.15319E6-0.021454E6* &
- & ALOG(PRHODREF(JI,JJ,JK)*PRIS(JI,JJ,JK)) )**XEXCSEDI
-#else
- ZWSEDW1 (JI,JJ,JK)= XFSEDI * &
- & BR_POW(PRHODREF(JI,JJ,JK),XCEXVT) * & ! McF&H
- & BR_POW(MAX( 0.05E6,-0.15319E6-0.021454E6* &
- & BR_LOG(PRHODREF(JI,JJ,JK)*PRIS(JI,JJ,JK)) ),XEXCSEDI)
-#endif
- ENDIF
- IF ( ZQP(JI,JJ) > MAX(ZRTMIN(4),1.0E-7 ) ) THEN
-#ifndef MNH_BITREP
- ZWSEDW2 (JI,JJ,JK)= XFSEDI * &
- & PRHODREF(JI,JJ,JK)**(XCEXVT) * & ! McF&H
- & MAX( 0.05E6,-0.15319E6-0.021454E6* &
- & ALOG(PRHODREF(JI,JJ,JK)*ZQP(JI,JJ)) )**XEXCSEDI
-#else
- ZWSEDW2 (JI,JJ,JK)= XFSEDI * &
- & BR_POW(PRHODREF(JI,JJ,JK),XCEXVT) * & ! McF&H
- & BR_POW(MAX( 0.05E6,-0.15319E6-0.021454E6* &
- & BR_LOG(PRHODREF(JI,JJ,JK)*ZQP(JI,JJ)) ),XEXCSEDI)
-#endif
- ENDIF
- ENDDO
- DO JJ = IJB, IJE
- DO JI = IIB, IIE
- ZH=PDZZ(JI,JJ,JK)
- ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH )
- IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
- ZP2 = MAX(0.,1 - ZH &
- & / (PTSTEP*ZWSEDW2(JI,JJ,JK)) )
- ELSE
- ZP2 = 0.
- ENDIF
- ZWSED (JI,JJ,JK)=ZP1*PRHODREF(JI,JJ,JK)*&
- &ZH*PRIS(JI,JJ,JK)&
- &* ZINVTSTEP+ ZP2 * ZWSED (JI,JJ,JK+KKL)
- ENDDO
- ENDDO
- ENDDO
-
- DO JK = IKTB , IKTE
- PRIS(:,:,JK) = PRIS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
- ENDDO
- IF (GPRESENT_PFPR) THEN
- DO JK = IKTB , IKTE
- PFPR(:,:,JK,4)=ZWSED(:,:,JK)
- ENDDO
- ENDIF
-
- PRIS(:,:,:) = PRIS(:,:,:) * ZINVTSTEP
-
-
-!
-!* 2.4 for aggregates/snow
-!
-
- PRSS(:,:,:) = PRSS(:,:,:) * PTSTEP
- ZWSED(:,:,:) = 0.
- ZWSEDW1(:,:,:) = 0.
- ZWSEDW2(:,:,:) = 0.
-
-! calculation of ZP1, ZP2 and sedimentation flux
- DO JK = IKE , IKB, -1*KKL
- !estimation of q' taking into account incomming ZWSED
- ZQP(:,:)=ZWSED(:,:,JK+KKL)*ZW(:,:,JK)
-
- JCOUNT=COUNTJV2D((PRSS(:,:,JK) > ZRTMIN(5)) .OR. &
- (ZQP(:,:) > ZRTMIN(5)),I1(:),I2(:))
- DO JL=1, JCOUNT
- JI=I1(JL)
- JJ=I2(JL)
- !calculation of w
- IF (PRSS(JI,JJ,JK) > ZRTMIN(5) ) THEN
-#ifndef MNH_BITREP
- ZWSEDW1(JI,JJ,JK)=XFSEDS*(PRSS(JI,JJ,JK))**(XEXSEDS-1)*&
- PRHODREF(JI,JJ,JK)**(XEXSEDS-XCEXVT-1)
-#else
- ZWSEDW1(JI,JJ,JK)=XFSEDS*BR_POW(PRSS(JI,JJ,JK),XEXSEDS-1)*&
- BR_POW(PRHODREF(JI,JJ,JK),XEXSEDS-XCEXVT-1)
-#endif
- ENDIF
- IF ( ZQP(JI,JJ) > ZRTMIN(5) ) THEN
-#ifndef MNH_BITREP
- ZWSEDW2(JI,JJ,JK)=XFSEDS*(ZQP(JI,JJ))**(XEXSEDS-1)*&
- PRHODREF(JI,JJ,JK)**(XEXSEDS-XCEXVT-1)
-#else
- ZWSEDW2(JI,JJ,JK)=XFSEDS*BR_POW(ZQP(JI,JJ),XEXSEDS-1)*&
- BR_POW(PRHODREF(JI,JJ,JK),XEXSEDS-XCEXVT-1)
-#endif
- ENDIF
- ENDDO
- DO JJ = IJB, IJE
- DO JI = IIB, IIE
- ZH=PDZZ(JI,JJ,JK)
- ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH )
- IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
- ZP2 = MAX(0.,1 - ZH&
- / (PTSTEP*ZWSEDW2(JI,JJ,JK)) )
- ELSE
- ZP2 = 0.
- ENDIF
- ZWSED (JI,JJ,JK)=ZP1*PRHODREF(JI,JJ,JK)*&
- &ZH*PRSS(JI,JJ,JK)&
- &* ZINVTSTEP+ ZP2 * ZWSED (JI,JJ,JK+KKL)
- ENDDO
- ENDDO
- ENDDO
-
- DO JK = IKTB , IKTE
- PRSS(:,:,JK) = PRSS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
- ENDDO
- IF (GPRESENT_PFPR) THEN
- DO JK = IKTB , IKTE
- PFPR(:,:,JK,5)=ZWSED(:,:,JK)
- ENDDO
- ENDIF
-
- PINPRS(:,:) = ZWSED(:,:,IKB)/XRHOLW ! in m/s
- PRSS(:,:,:) = PRSS(:,:,:) * ZINVTSTEP
-
-
-!
-!* 2.5 for graupeln
-!
-
- PRGS(:,:,:) = PRGS(:,:,:) * PTSTEP
- ZWSED(:,:,:) = 0.
- ZWSEDW1(:,:,:) = 0.
- ZWSEDW2(:,:,:) = 0.
-
-! calculation of ZP1, ZP2 and sedimentation flux
- DO JK = IKE, IKB, -1*KKL
- !estimation of q' taking into account incomming ZWSED
- ZQP(:,:)=ZWSED(:,:,JK+KKL)*ZW(:,:,JK)
-
- JCOUNT=COUNTJV2D((PRGS(:,:,JK) > ZRTMIN(6)) .OR. &
- (ZQP(:,:) > ZRTMIN(6)),I1(:),I2(:))
- DO JL=1, JCOUNT
- JI=I1(JL)
- JJ=I2(JL)
- !calculation of w
- IF ( PRGS(JI,JJ,JK) > ZRTMIN(6) ) THEN
-#ifndef MNH_BITREP
- ZWSEDW1 (JI,JJ,JK)= XFSEDG*(PRGS(JI,JJ,JK))**(XEXSEDG-1) * &
- PRHODREF(JI,JJ,JK)**(XEXSEDG-XCEXVT-1)
-#else
- ZWSEDW1 (JI,JJ,JK)= XFSEDG*BR_POW(PRGS(JI,JJ,JK),XEXSEDG-1) * &
- BR_POW(PRHODREF(JI,JJ,JK),XEXSEDG-XCEXVT-1)
-#endif
- ENDIF
- IF ( ZQP(JI,JJ) > ZRTMIN(6) ) THEN
-#ifndef MNH_BITREP
- ZWSEDW2 (JI,JJ,JK)= XFSEDG*(ZQP(JI,JJ))**(XEXSEDG-1) * &
- PRHODREF(JI,JJ,JK)**(XEXSEDG-XCEXVT-1)
-#else
- ZWSEDW2 (JI,JJ,JK)= XFSEDG*BR_POW(ZQP(JI,JJ),XEXSEDG-1) * &
- BR_POW(PRHODREF(JI,JJ,JK),XEXSEDG-XCEXVT-1)
-#endif
- ENDIF
- ENDDO
- DO JJ = IJB, IJE
- DO JI = IIB, IIE
- ZH=PDZZ(JI,JJ,JK)
- ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH )
- IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
- ZP2 = MAX(0.,1 - ZH &
- & / (PTSTEP*ZWSEDW2(JI,JJ,JK)) )
- ELSE
- ZP2 = 0.
- ENDIF
- ZWSED (JI,JJ,JK)=ZP1*PRHODREF(JI,JJ,JK)*&
- &ZH*PRGS(JI,JJ,JK)&
- &* ZINVTSTEP+ ZP2 * ZWSED (JI,JJ,JK+KKL)
- ENDDO
- ENDDO
- ENDDO
-
- DO JK = IKTB , IKTE
- PRGS(:,:,JK) = PRGS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
- ENDDO
- IF (GPRESENT_PFPR) THEN
- DO JK = IKTB , IKTE
- PFPR(:,:,JK,6)=ZWSED(:,:,JK)
- ENDDO
- ENDIF
-
- PINPRG(:,:) = ZWSED(:,:,IKB)/XRHOLW ! in m/s
- PRGS(:,:,:) = PRGS(:,:,:) * ZINVTSTEP
-
-!
-!* 2.6 for hail
-!
- IF ( KRR == 7 ) THEN
- PRHS(:,:,:) = PRHS(:,:,:) * PTSTEP
- ZWSED(:,:,:) = 0.
- ZWSEDW1(:,:,:) = 0.
- ZWSEDW2(:,:,:) = 0.
-! calculation of ZP1, ZP2 and sedimentation flux
- DO JK = IKE , IKB, -1*KKL
- !estimation of q' taking into account incomming ZWSED
- ZQP(:,:)=ZWSED(:,:,JK+KKL)*ZW(:,:,JK)
-
- JCOUNT=COUNTJV2D((PRHS(:,:,JK)+ZQP(JI,JJ) > ZRTMIN(7)) .OR. &
- (ZQP(:,:) > ZRTMIN(7)),I1(:),I2(:))
- DO JL=1, JCOUNT
- JI=I1(JL)
- JJ=I2(JL)
- !calculation of w
- IF ((PRHS(JI,JJ,JK)+ZQP(JI,JJ)) > ZRTMIN(7) ) THEN
-#ifndef MNH_BITREP
- ZWSEDW1 (JI,JJ,JK)= XFSEDH * (PRHS(JI,JJ,JK))**(XEXSEDH-1) * &
- PRHODREF(JI,JJ,JK)**(XEXSEDH-XCEXVT-1)
-#else
- ZWSEDW1 (JI,JJ,JK)= XFSEDH * BR_POW(PRHS(JI,JJ,JK),XEXSEDH-1) * &
- BR_POW(PRHODREF(JI,JJ,JK),XEXSEDH-XCEXVT-1)
-#endif
- ENDIF
- IF ( ZQP(JI,JJ) > ZRTMIN(7) ) THEN
-#ifndef MNH_BITREP
- ZWSEDW2 (JI,JJ,JK)= XFSEDH * ZQP(JI,JJ)**(XEXSEDH-1) * &
- PRHODREF(JI,JJ,JK)**(XEXSEDH-XCEXVT-1)
-#else
- ZWSEDW2 (JI,JJ,JK)= XFSEDH * BR_POW(ZQP(JI,JJ),XEXSEDH-1) * &
- BR_POW(PRHODREF(JI,JJ,JK),XEXSEDH-XCEXVT-1)
-#endif
- ENDIF
- ENDDO
- DO JJ = IJB, IJE
- DO JI = IIB, IIE
- ZH=PDZZ(JI,JJ,JK)
- ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH)
- IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
- ZP2 = MAX(0.,1 - ZH &
- & / (PTSTEP*ZWSEDW2(JI,JJ,JK)) )
- ELSE
- ZP2 = 0.
- ENDIF
- ZWSED (JI,JJ,JK)=ZP1*PRHODREF(JI,JJ,JK)*&
- &ZH*PRHS(JI,JJ,JK)&
- &* ZINVTSTEP+ ZP2 * ZWSED (JI,JJ,JK+KKL)
- ENDDO
- ENDDO
- ENDDO
-
- DO JK = IKTB , IKTE
- PRHS(:,:,JK) = PRHS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
- ENDDO
- IF (GPRESENT_PFPR) THEN
- DO JK = IKTB , IKTE
- PFPR(:,:,JK,7)=ZWSED(:,:,JK)
- ENDDO
- ENDIF
-
- PINPRH(:,:) = ZWSED(:,:,IKB)/XRHOLW ! in m/s
- PRHS(:,:,:) = PRHS(:,:,:) * ZINVTSTEP
-
- 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')
-!
-!
-!* 2.4 DROPLET DEPOSITION AT THE 1ST LEVEL ABOVE GROUND
-!
-IF (LDEPOSC) THEN
- GDEP(:,:) = .FALSE.
- GDEP(IIB:IIE,IJB:IJE) = PRCS(IIB:IIE,IJB:IJE,IKB) >0
- WHERE (GDEP)
- PRCS(:,:,IKB) = PRCS(:,:,IKB) - XVDEPOSC * PRCT(:,:,IKB) / PDZZ(:,:,IKB)
- PINPRC(:,:) = PINPRC(:,:) + XVDEPOSC * PRCT(:,:,IKB) * PRHODREF(:,:,IKB) /XRHOLW
- PINDEP(:,:) = XVDEPOSC * PRCT(:,:,IKB) * PRHODREF(:,:,IKB) /XRHOLW
- END WHERE
-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
-!
-!-------------------------------------------------------------------------------
-!
-
-!
- SUBROUTINE RAIN_ICE_NUCLEATION
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!* 0.2 declaration of local variables
-!
-INTEGER , DIMENSION(SIZE(GNEGT)) :: I1,I2,I3 ! Used to replace the COUNT
-INTEGER :: JL ! and PACK intrinsics
-REAL :: ZZWMAX
-!$acc declare device_resident(I1,I2,I3)
-!
-!-------------------------------------------------------------------------------
-!
-!
-! compute the temperature and the pressure
-!
-!$acc kernels present(GNEGT,ZT,PPABST,PTHT)
-#ifndef MNH_BITREP
-ZT(:,:,:) = PTHT(:,:,:) * (PPABST(:,:,:)/XP00) ** (XRD/XCPD)
-#else
-ZT(:,:,:) = PTHT(:,:,:) * BR_POW(PPABST(:,:,:)/XP00,XRD/XCPD)
-#endif
-!
-! optimization by looking for locations where
-! the temperature is negative only !!!
-!
-GNEGT(:,:,:) = .FALSE.
-#if 0
-GNEGT(IIB:IIE,IJB:IJE,IKTB:IKTE) = ZT(IIB:IIE,IJB:IJE,IKTB:IKTE)<XTT
-#else
-!$acc loop collapse(3) independent
-DO JK=IKTB,IKTE
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- GNEGT(JI,JJ,JK) = ZT(JI,JJ,JK)<XTT
- END DO
- END DO
-END DO
-#endif
-!$acc end kernels
-#ifndef _OPENACC
-INEGT = COUNTJV3D( GNEGT(:,:,:),I1(:),I2(:),I3(:))
-#else
-CALL COUNTJV3D_DEVICE(GNEGT(:,:,:),I1(:),I2(:),I3(:),INEGT)
-#endif
-IF( INEGT >= 1 ) THEN
- ALLOCATE(ZRVT(INEGT)) ;
- ALLOCATE(ZCIT(INEGT)) ;
- ALLOCATE(ZZT(INEGT)) ;
- ALLOCATE(ZPRES(INEGT));
- ALLOCATE(ZZW(INEGT))
- ALLOCATE(ZUSW(INEGT))
- ALLOCATE(ZSSI(INEGT))
-!$acc kernels present(ZCIT,ZPRES,ZRVT,ZSSI,ZT,ZUSW,ZZT,ZZW,PCIT,PPABST,PRVT,XALPHA1)
- DO JL=1,INEGT
- ZRVT(JL) = PRVT (I1(JL),I2(JL),I3(JL))
- ZCIT(JL) = PCIT (I1(JL),I2(JL),I3(JL))
- ZZT(JL) = ZT (I1(JL),I2(JL),I3(JL))
- ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
- ENDDO
-#ifndef MNH_BITREP
- ZZW(1:INEGT) = EXP( XALPI - XBETAI/ZZT(1:INEGT) - XGAMI*ALOG(ZZT(1:INEGT) ) ) ! es_i
-#else
- ZZW(1:INEGT) = BR_EXP( XALPI - XBETAI/ZZT(1:INEGT) - XGAMI*BR_LOG(ZZT(1:INEGT) ) ) ! es_i
-#endif
- ZZW(1:INEGT) = MIN(ZPRES(1:INEGT)/2., ZZW(1:INEGT)) ! safety limitation
- ZSSI(1:INEGT) = ZRVT(1:INEGT)*( ZPRES(1:INEGT)-ZZW(1:INEGT) ) / ( (XMV/XMD) * ZZW(1:INEGT) ) - 1.0
- ! Supersaturation over ice
-#ifndef MNH_BITREP
- ZUSW(1:INEGT) = EXP( XALPW - XBETAW/ZZT(1:INEGT) - XGAMW*ALOG(ZZT(1:INEGT) ) ) ! es_w
-#else
- ZUSW(1:INEGT) = BR_EXP( XALPW - XBETAW/ZZT(1:INEGT) - XGAMW*BR_LOG(ZZT(1:INEGT) ) ) ! es_w
-#endif
- ZUSW(1:INEGT) = MIN(ZPRES(1:INEGT)/2.,ZUSW(1:INEGT)) ! safety limitation
- ZUSW(1:INEGT) = ( ZUSW(1:INEGT)/ZZW(1:INEGT) )*( (ZPRES(1:INEGT)-ZZW(1:INEGT))/(ZPRES(1:INEGT)-ZUSW(1:INEGT)) ) - 1.0
- ! Supersaturation of saturated water vapor over ice
-!
-!* 3.1 compute the heterogeneous nucleation source: RVHENI
-!
-!* 3.1.1 compute the cloud ice concentration
-!
- ZZW(1:INEGT) = 0.0
- ZSSI(1:INEGT) = MIN( ZSSI(1:INEGT), ZUSW(1:INEGT) ) ! limitation of SSi according to SSw=0
- WHERE( (ZZT(1:INEGT)<XTT-5.0) .AND. (ZSSI(1:INEGT)>0.0) )
-#ifndef MNH_BITREP
- ZZW(1:INEGT) = XNU20 * EXP( XALPHA2*ZSSI(1:INEGT)-XBETA2 )
-#else
- ZZW(1:INEGT) = XNU20 * BR_EXP( XALPHA2*ZSSI(1:INEGT)-XBETA2 )
-#endif
- END WHERE
- WHERE( (ZZT(1:INEGT)<=XTT-2.0) .AND. (ZZT(1:INEGT)>=XTT-5.0) .AND. (ZSSI(1:INEGT)>0.0) )
-#ifndef MNH_BITREP
- ZZW(1:INEGT) = MAX( XNU20 * EXP( -XBETA2 ),XNU10 * EXP( -XBETA1*(ZZT(1:INEGT)-XTT) ) * &
- ( ZSSI(1:INEGT)/ZUSW(1:INEGT) )**XALPHA1 )
-#else
- ZZW(1:INEGT) = MAX( XNU20 * BR_EXP( -XBETA2 ),XNU10 * BR_EXP( -XBETA1*(ZZT(1:INEGT)-XTT) ) * &
- BR_POW( ZSSI(1:INEGT)/ZUSW(1:INEGT),XALPHA1 ) )
-#endif
- END WHERE
- ZZW(1:INEGT) = ZZW(1:INEGT) - ZCIT(1:INEGT)
- ZZWMAX = MAXVAL(ZZW(1:INEGT))
-!$acc end kernels
-!$acc kernels present(ZT,ZW,PCIT,PEXNREF,PRCT,PRGT,PRHT,PRHODREF,PRIS,PRIT,PRRT,PRST,PRVS,PRVT,PTHS)
- IF( ZZWMAX > 0.0 ) THEN
-!
-!* 3.1.2 update the r_i and r_v mixing ratios
-!
- ZZW(1:INEGT) = MIN( ZZW(1:INEGT),50.E3 ) ! limitation provisoire a 50 l^-1
- ZW(:,:,:) = 0.0
- DO JL=1,INEGT
- ZW(I1(JL),I2(JL),I3(JL)) = ZZW(JL)
- END DO
- ZW(:,:,:) = MAX( ZW(:,:,:) ,0.0 ) *XMNU0/(PRHODREF(:,:,:)*PTSTEP)
- PRIS(:,:,:) = PRIS(:,:,:) + ZW(:,:,:)
- PRVS(:,:,:) = PRVS(:,:,:) - ZW(:,:,:)
- IF ( KRR == 7 ) THEN
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(XLSTT+(XCPV-XCI)*(ZT(:,:,:)-XTT)) &
- /( (XCPD + XCPV*PRVT(:,:,:) + XCL*(PRCT(:,:,:)+PRRT(:,:,:)) &
- + XCI*(PRIT(:,:,:)+PRST(:,:,:)+PRGT(:,:,:)+PRHT(:,:,:)))*PEXNREF(:,:,:) )
- ELSE IF( KRR == 6 ) THEN
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(XLSTT+(XCPV-XCI)*(ZT(:,:,:)-XTT)) &
- /( (XCPD + XCPV*PRVT(:,:,:) + XCL*(PRCT(:,:,:)+PRRT(:,:,:)) &
- + XCI*(PRIT(:,:,:)+PRST(:,:,:)+PRGT(:,:,:)))*PEXNREF(:,:,:) )
- END IF
- ! f(L_s*(RVHENI))
- ZZW(1:INEGT) = MAX( ZZW(1:INEGT)+ZCIT(1:INEGT),ZCIT(1:INEGT) )
-#ifndef _OPENACC
- PCIT(:,:,:) = MAX( UNPACK( ZZW(1:INEGT),MASK=GNEGT(:,:,:),FIELD=0.0 ) , &
- PCIT(:,:,:) )
-#else
- ZW(:,:,:) = 0.0
- DO JL=1,INEGT
- ZW(I1(JL),I2(JL),I3(JL)) = ZZW(JL)
- END DO
- PCIT(:,:,:) = MAX( ZW(:,:,:), PCIT(:,:,:) )
-#endif
- END IF
-!$acc end kernels
- DEALLOCATE(ZSSI)
- DEALLOCATE(ZUSW)
- DEALLOCATE(ZZW)
- DEALLOCATE(ZPRES)
- DEALLOCATE(ZZT)
- DEALLOCATE(ZCIT)
- DEALLOCATE(ZRVT)
-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_NUCLEATION
-!
-!-------------------------------------------------------------------------------
-!
-!
- SUBROUTINE RAIN_ICE_SLOW
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 3.2 compute the homogeneous nucleation source: RCHONI
-!
-!
-!$acc kernels present(GWORK,ZLSFACT,ZLVFACT,ZRCS,ZRCT,ZRIS,ZRHODREF,ZTHS,XRTMIN)
- ZZW(1:IMICRO) = 0.0
- GWORK(1:IMICRO) =(ZZT(1:IMICRO)<XTT-35.0) .AND. (ZRCT(1:IMICRO)>XRTMIN(2)) .AND. (ZRCS(1:IMICRO)>0.)
- WHERE (GWORK(1:IMICRO))
- ZZW(1:IMICRO) = MIN( ZRCS(1:IMICRO),XHON*ZRHODREF(1:IMICRO)*ZRCT(1:IMICRO) &
-#ifndef MNH_BITREP
- *EXP( MIN(XMNH_HUGE_12_LOG,XALPHA3*(ZZT(1:IMICRO)-XTT)-XBETA3) ) )
-#else
- *BR_EXP(MIN(XMNH_HUGE_12_LOG, XALPHA3*(ZZT(1:IMICRO)-XTT)-XBETA3) ) )
-#endif
- ZRIS(1:IMICRO) = ZRIS(1:IMICRO) + ZZW(1:IMICRO)
- ZRCS(1:IMICRO) = ZRCS(1:IMICRO) - ZZW(1:IMICRO)
- ZTHS(1:IMICRO) = ZTHS(1:IMICRO) + ZZW(1:IMICRO)*(ZLSFACT(1:IMICRO)-ZLVFACT(:)) ! f(L_f*(RCHONI))
- ENDWHERE
-!$acc end kernels
-!
- IF (LBUDGET_TH) THEN
-!$acc update self(ZTHS)
- CALL BUDGET (UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),4,'HON_BU_RTH')
- END IF
- IF (LBUDGET_RC) THEN
-!$acc update self(ZRCS)
- CALL BUDGET (UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 7,'HON_BU_RRC')
- END IF
- IF (LBUDGET_RI) THEN
-!$acc update self(ZRIS)
- CALL BUDGET (UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 9,'HON_BU_RRI')
- END IF
-!
-!* 3.3 compute the spontaneous freezing source: RRHONG
-!
-!$acc kernels present(GWORK,ZRGS,ZRRS,ZRRT,XRTMIN)
- ZZW(1:IMICRO) = 0.0
- GWORK = (ZZT(1:IMICRO)<XTT-35.0) .AND. (ZRRT(1:IMICRO)>XRTMIN(3)) .AND. (ZRRS(1:IMICRO)>0.)
- WHERE (GWORK)
- ZZW(1:IMICRO) = MIN( ZRRS(1:IMICRO),ZRRT(1:IMICRO)* ZINVTSTEP )
- ZRGS(1:IMICRO) = ZRGS(1:IMICRO) + ZZW(1:IMICRO)
- ZRRS(1:IMICRO) = ZRRS(1:IMICRO) - ZZW(1:IMICRO)
- ZTHS(1:IMICRO) = ZTHS(1:IMICRO) + ZZW(1:IMICRO)*(ZLSFACT(1:IMICRO)-ZLVFACT(:)) ! f(L_f*(RRHONG))
- ENDWHERE
-!$acc end kernels
-!
- IF (LBUDGET_TH) THEN
-!$acc update self(ZTHS)
- CALL BUDGET (UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),4,'SFR_BU_RTH')
- END IF
- IF (LBUDGET_RR) THEN
-!$acc update self(ZRRS)
- CALL BUDGET (UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 8,'SFR_BU_RRR')
- END IF
- IF (LBUDGET_RG) THEN
-!$acc update self(ZRGS)
- CALL BUDGET (UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 11,'SFR_BU_RRG')
- END IF
-!
-!* 3.4 compute the deposition, aggregation and autoconversion sources
-!
-!$acc kernels present(GWORK,ZAI,ZCJ,ZDV,ZKA,ZLBDAS,ZRHODREF,ZRSS,ZRST,ZRVS,XEX0DEPS,XEX1DEPS,XLBEXS,XRTMIN)
- ZKA(1:IMICRO) = 2.38E-2 + 0.0071E-2 * ( ZZT(1:IMICRO) - XTT ) ! k_a
-#ifndef MNH_BITREP
- ZDV(1:IMICRO) = 0.211E-4 * (ZZT(1:IMICRO)/XTT)**1.94 * (XP00/ZPRES(1:IMICRO)) ! D_v
-#else
- ZDV(1:IMICRO) = 0.211E-4 * BR_POW(ZZT(1:IMICRO)/XTT,1.94) * (XP00/ZPRES(1:IMICRO)) ! D_v
-#endif
-!
-!* 3.4.1 compute the thermodynamical function A_i(T,P)
-!* and the c^prime_j (in the ventilation factor)
-!
-
-#ifndef MNH_BITREP
- ZAI(1:IMICRO) = EXP( XALPI - XBETAI/ZZT(1:IMICRO) - XGAMI*ALOG(ZZT(1:IMICRO) ) ) ! es_i
- ZAI(1:IMICRO) = ( XLSTT + (XCPV-XCI)*(ZZT(1:IMICRO)-XTT) )**2 / (ZKA(1:IMICRO)*XRV*ZZT(1:IMICRO)**2) &
- + ( XRV*ZZT(1:IMICRO) ) / (ZDV(1:IMICRO)*ZAI(1:IMICRO))
- ZCJ(1:IMICRO) = XSCFAC * ZRHODREF(1:IMICRO)**0.3 / SQRT( 1.718E-5+0.0049E-5*(ZZT(1:IMICRO)-XTT) )
-#else
- ZAI(1:IMICRO) = BR_EXP( XALPI - XBETAI/ZZT(1:IMICRO) - XGAMI*BR_LOG(ZZT(1:IMICRO) ) ) ! es_i
- ZAI(1:IMICRO) = BR_P2( XLSTT + (XCPV-XCI)*(ZZT(1:IMICRO)-XTT) ) / (ZKA(1:IMICRO)*XRV*BR_P2(ZZT(1:IMICRO))) &
- + ( XRV*ZZT(1:IMICRO) ) / (ZDV(1:IMICRO)*ZAI(1:IMICRO))
-! ZCJ(1:IMICRO) = XSCFAC * BR_POW(ZRHODREF(1:IMICRO),0.3) / BR_POW( 1.718E-5+0.0049E-5*(ZZT(1:IMICRO)-XTT) , 0.5)
-!$acc loop independent
- DO JI=1,IMICRO
- ZCJ(JI) = XSCFAC * BR_POW(ZRHODREF(JI),0.3) / BR_POW( 1.718E-5+0.0049E-5*(ZZT(JI)-XTT) , 0.5)
- END DO
-#endif
-!
-!* 3.4.2 compute the riming-conversion of r_c for r_i production: RCAUTI
-!
-! ZZW(:) = 0.0
-! ZTIMAUTIC = SQRT( XTIMAUTI*XTIMAUTC )
-! WHERE ( (ZRCT(:)>0.0) .AND. (ZRIT(:)>0.0) .AND. (ZRCS(:)>0.0) )
-! ZZW(:) = MIN( ZRCS(:),ZTIMAUTIC * MAX( SQRT( ZRIT(:)*ZRCT(:) ),0.0 ) )
-! ZRIS(:) = ZRIS(:) + ZZW(:)
-! ZRCS(:) = ZRCS(:) - ZZW(:)
-! ZTHS(:) = ZTHS(:) + ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RCAUTI))
-! END WHERE
-!
-!* 3.4.3 compute the deposition on r_s: RVDEPS
-!
- WHERE ( ZRST(1:IMICRO)>0.0 )
-#ifndef MNH_BITREP
- ZLBDAS(1:IMICRO) = MIN( XLBDAS_MAX, &
- XLBS*( ZRHODREF(1:IMICRO)*MAX( ZRST(1:IMICRO),XRTMIN(5) ) )**XLBEXS )
-#else
- ZLBDAS(1:IMICRO) = MIN( XLBDAS_MAX, &
- XLBS*BR_POW( ZRHODREF(1:IMICRO)*MAX( ZRST(1:IMICRO),XRTMIN(5) ),XLBEXS ) )
-#endif
- END WHERE
- ZZW(1:IMICRO) = 0.0
- GWORK = (ZRST(1:IMICRO)>XRTMIN(5)) .AND. (ZRSS(1:IMICRO)>0.0)
- WHERE ( GWORK(1:IMICRO) )
-#ifndef MNH_BITREP
- ZZW(1:IMICRO) = ( ZSSI(1:IMICRO)/(ZRHODREF(1:IMICRO)*ZAI(1:IMICRO)) ) * &
- ( X0DEPS*ZLBDAS(1:IMICRO)**XEX0DEPS + X1DEPS*ZCJ(1:IMICRO)*ZLBDAS(1:IMICRO)**XEX1DEPS )
-#else
- ZZW(1:IMICRO) = ( ZSSI(1:IMICRO)/(ZRHODREF(1:IMICRO)*ZAI(1:IMICRO)) ) * &
- ( X0DEPS*BR_POW(ZLBDAS(1:IMICRO),XEX0DEPS) + X1DEPS*ZCJ(1:IMICRO)*BR_POW(ZLBDAS(1:IMICRO),XEX1DEPS) )
-#endif
- ZZW(1:IMICRO) = MIN( ZRVS(1:IMICRO),ZZW(1:IMICRO) )*(0.5+SIGN(0.5,ZZW(1:IMICRO))) &
- - MIN( ZRSS(1:IMICRO),ABS(ZZW(1:IMICRO)) )*(0.5-SIGN(0.5,ZZW(1:IMICRO)))
- ZRSS(1:IMICRO) = ZRSS(1:IMICRO) + ZZW(1:IMICRO)
- ZRVS(1:IMICRO) = ZRVS(1:IMICRO) - ZZW(1:IMICRO)
- ZTHS(1:IMICRO) = ZTHS(1:IMICRO) + ZZW(1:IMICRO)*ZLSFACT(1:IMICRO)
- END WHERE
-!$acc end kernels
- IF (LBUDGET_TH) THEN
-!$acc update self(ZTHS)
- CALL BUDGET (UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),4,'DEPS_BU_RTH')
- END IF
- IF (LBUDGET_RV) THEN
-!$acc update self(ZRVS)
- CALL BUDGET (UNPACK(ZRVS(:),MASK=GMICRO(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:),6,'DEPS_BU_RRV')
- END IF
- IF (LBUDGET_RS) THEN
-!$acc update self(ZRSS)
- CALL BUDGET (UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 10,'DEPS_BU_RRS')
- END IF
-!
-!* 3.4.4 compute the aggregation on r_s: RIAGGS
-!
-!$acc kernels present(GWORK,ZLBDAS,ZRIT,ZRHODREF,XEXIAGGS,XRTMIN)
- ZZW(1:IMICRO) = 0.0
- GWORK(1:IMICRO) = (ZRIT(1:IMICRO)>XRTMIN(4)) .AND. (ZRST(1:IMICRO)>XRTMIN(5)) .AND. (ZRIS(1:IMICRO)>0.0)
- WHERE ( GWORK(1:IMICRO) )
-#ifndef MNH_BITREP
- ZZW(1:IMICRO) = MIN( ZRIS(1:IMICRO),XFIAGGS * EXP( XCOLEXIS*(ZZT(1:IMICRO)-XTT) ) &
- * ZRIT(1:IMICRO) &
- * ZLBDAS(1:IMICRO)**XEXIAGGS &
- * ZRHODREF(1:IMICRO)**(-XCEXVT) )
-#else
- ZZW(1:IMICRO) = MIN( ZRIS(1:IMICRO),XFIAGGS * BR_EXP( XCOLEXIS*(ZZT(1:IMICRO)-XTT) ) &
- * ZRIT(1:IMICRO) &
- * BR_POW(ZLBDAS(1:IMICRO),XEXIAGGS) &
- * BR_POW(ZRHODREF(1:IMICRO),-XCEXVT) )
-#endif
- ZRSS(1:IMICRO) = ZRSS(1:IMICRO) + ZZW(1:IMICRO)
- ZRIS(1:IMICRO) = ZRIS(1:IMICRO) - ZZW(1:IMICRO)
- END WHERE
-!$acc end kernels
- IF (LBUDGET_RI) THEN
-!$acc update self(ZRIS)
- CALL BUDGET (UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 9,'AGGS_BU_RRI')
- END IF
- IF (LBUDGET_RS) THEN
-!$acc update self(ZRSS)
- CALL BUDGET (UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0),10,'AGGS_BU_RRS')
- END IF
-!
-!* 3.4.5 compute the autoconversion of r_i for r_s production: RIAUTS
-!
- ALLOCATE(ZCRIAUTI(IMICRO))
-!$acc kernels present(GWORK,ZCRIAUTI,XRTMIN)
-#ifndef MNH_BITREP
- ZCRIAUTI(1:IMICRO)=MIN(XCRIAUTI,10**(XACRIAUTI*(ZZT(1:IMICRO)-XTT)+XBCRIAUTI))
-#else
- ZCRIAUTI(1:IMICRO)=MIN(XCRIAUTI, BR_POW(10.,XACRIAUTI*(ZZT(1:IMICRO)-XTT)+XBCRIAUTI) )
-#endif
- ZZW(1:IMICRO) = 0.0
- GWORK(1:IMICRO) = (ZRIT(1:IMICRO)>XRTMIN(4)) .AND. (ZRIS(1:IMICRO)>0.0)
- WHERE ( GWORK(1:IMICRO) )
-#ifndef MNH_BITREP
- ZZW(1:IMICRO) = MIN( ZRIS(1:IMICRO),XTIMAUTI * EXP( XTEXAUTI*(ZZT(1:IMICRO)-XTT) ) &
- * MAX( ZRIT(1:IMICRO)-ZCRIAUTI(1:IMICRO),0.0 ) )
-#else
- ZZW(1:IMICRO) = MIN( ZRIS(1:IMICRO),XTIMAUTI * BR_EXP( XTEXAUTI*(ZZT(1:IMICRO)-XTT) ) &
- * MAX( ZRIT(1:IMICRO)-ZCRIAUTI(1:IMICRO),0.0 ) )
-#endif
- ZRSS(1:IMICRO) = ZRSS(1:IMICRO) + ZZW(1:IMICRO)
- ZRIS(1:IMICRO) = ZRIS(1:IMICRO) - ZZW(1:IMICRO)
- END WHERE
-!$acc end kernels
- DEALLOCATE(ZCRIAUTI)
- IF (LBUDGET_RI) THEN
-!$acc update self(ZRIS)
- CALL BUDGET (UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 9,'AUTS_BU_RRI')
- END IF
- IF (LBUDGET_RS) THEN
-!$acc update self(ZRSS)
- CALL BUDGET (UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0),10,'AUTS_BU_RRS')
- END IF
-!
-!* 3.4.6 compute the deposition on r_g: RVDEPG
-!
-!
-!$acc kernels present(GWORK,ZLBDAG,ZRGT,ZRHODREF,XEX0DEPG,XEX1DEPG,XLBEXG,XRTMIN)
- WHERE ( ZRGT(1:IMICRO)>0.0 )
-#ifndef MNH_BITREP
- ZLBDAG(1:IMICRO) = XLBG*( ZRHODREF(1:IMICRO)*MAX( ZRGT(1:IMICRO),XRTMIN(6) ) )**XLBEXG
-#else
- ZLBDAG(1:IMICRO) = XLBG*BR_POW( ZRHODREF(1:IMICRO)*MAX( ZRGT(1:IMICRO),XRTMIN(6) ),XLBEXG)
-#endif
- END WHERE
- ZZW(1:IMICRO) = 0.0
- GWORK(1:IMICRO) = (ZRGT(1:IMICRO)>XRTMIN(6)) .AND. (ZRGS(1:IMICRO)>0.0)
- WHERE ( GWORK(1:IMICRO) )
-#ifndef MNH_BITREP
- ZZW(1:IMICRO) = ( ZSSI(1:IMICRO)/(ZRHODREF(1:IMICRO)*ZAI(1:IMICRO)) ) * &
- ( X0DEPG*ZLBDAG(1:IMICRO)**XEX0DEPG + X1DEPG*ZCJ(1:IMICRO)*ZLBDAG(1:IMICRO)**XEX1DEPG )
-#else
- ZZW(1:IMICRO) = ( ZSSI(1:IMICRO)/(ZRHODREF(1:IMICRO)*ZAI(1:IMICRO)) ) * &
- ( X0DEPG*BR_POW(ZLBDAG(1:IMICRO),XEX0DEPG) + X1DEPG*ZCJ(1:IMICRO)*BR_POW(ZLBDAG(1:IMICRO),XEX1DEPG) )
-#endif
- ZZW(1:IMICRO) = MIN( ZRVS(1:IMICRO),ZZW(1:IMICRO) )*(0.5+SIGN(0.5,ZZW(1:IMICRO))) &
- - MIN( ZRGS(1:IMICRO),ABS(ZZW(1:IMICRO)) )*(0.5-SIGN(0.5,ZZW(1:IMICRO)))
- ZRGS(1:IMICRO) = ZRGS(1:IMICRO) + ZZW(1:IMICRO)
- ZRVS(1:IMICRO) = ZRVS(1:IMICRO) - ZZW(1:IMICRO)
- ZTHS(1:IMICRO) = ZTHS(1:IMICRO) + ZZW(1:IMICRO)*ZLSFACT(1:IMICRO)
- END WHERE
-!$acc end kernels
- IF (LBUDGET_TH) THEN
-!$acc update self(ZTHS)
- CALL BUDGET (UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), 4,'DEPG_BU_RTH')
- END IF
- IF (LBUDGET_RV) THEN
-!$acc update self(ZRVS)
- CALL BUDGET (UNPACK(ZRVS(:),MASK=GMICRO(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:), 6,'DEPG_BU_RRV')
- END IF
- IF (LBUDGET_RG) THEN
-!$acc update self(ZRGS)
- CALL BUDGET (UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 11,'DEPG_BU_RRG')
- END IF
-!
- END SUBROUTINE RAIN_ICE_SLOW
-!
-!-------------------------------------------------------------------------------
-!
-!
- SUBROUTINE RAIN_ICE_WARM
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 4.2 compute the autoconversion of r_c for r_r production: RCAUTR
-!
-!$acc kernels present(GWORK,ZHLC_HCF,ZHLC_HRC,ZRHODREF)
- GWORK(:) = ZRCS(:)>0.0 .AND. ZHLC_HCF(:).GT.0.0
- WHERE( GWORK(:) )
- ZZW(:) = XTIMAUTC*MAX( ZHLC_HRC(:)/ZHLC_HCF(:) - XCRIAUTC/ZRHODREF(:),0.0)
- ZZW(:) = MIN( ZRCS(:),ZHLC_HCF(:)*ZZW(:))
- ZRCS(:) = ZRCS(:) - ZZW(:)
- ZRRS(:) = ZRRS(:) + ZZW(:)
- END WHERE
-!$acc end kernels
-!
- 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')
-!
-!* 4.3 compute the accretion of r_c for r_r production: RCACCR
-!
- IF (CSUBG_RC_RR_ACCR=='NONE') THEN
-!$acc kernels present(GWORK,ZZW,ZLBDAR,ZRRT,ZRCS,ZRRS,ZRHODREF,ZRCT,XEXCACCR,XRTMIN)
- !CLoud water and rain are diluted over the grid box
- GWORK(1:IMICRO) = ZRCT(1:IMICRO)>XRTMIN(2) .AND. ZRRT(1:IMICRO)>XRTMIN(3) .AND. ZRCS(1:IMICRO)>0.0
- WHERE( GWORK(1:IMICRO) )
-#ifndef MNH_BITREP
- ZZW(1:IMICRO) = MIN( ZRCS(1:IMICRO), XFCACCR * ZRCT(1:IMICRO) &
- * ZLBDAR(1:IMICRO)**XEXCACCR &
- * ZRHODREF(1:IMICRO)**(-XCEXVT) )
-#else
- ZZW(1:IMICRO) = MIN( ZRCS(1:IMICRO), XFCACCR * ZRCT(1:IMICRO) &
- * BR_POW(ZLBDAR(1:IMICRO),XEXCACCR) &
- * BR_POW(ZRHODREF(1:IMICRO),-XCEXVT) )
-#endif
- ZRCS(1:IMICRO) = ZRCS(1:IMICRO) - ZZW(1:IMICRO)
- ZRRS(1:IMICRO) = ZRRS(1:IMICRO) + ZZW(1:IMICRO)
- END WHERE
-!$acc end kernels
-
- ELSEIF (CSUBG_RC_RR_ACCR=='PRFR') THEN
-#ifdef _OPENACC
-PRINT *,'OPENACC: RAIN_ICE_WARM::CSUBG_RC_RR_ACCR==PRFR not yet implemented'
-CALL ABORT
-#endif
-!$acc kernels present(ZCF,ZRF,ZHLC_HCF,ZHLC_LCF,ZHLC_HRC,ZHLC_LRC,XEXCACCR,XRTMIN)
- !Cloud water is concentrated over its fraction with possibly to parts with high and low content as set for autoconversion
- !Rain is concnetrated over its fraction
- !Rain in high content area fraction: ZHLC_HCF
- !Rain in low content area fraction:
- ! if ZRF<ZCF (rain is entirely falling in cloud): ZRF-ZHLC_HCF
- ! if ZRF>ZCF (rain is falling in cloud and in clear sky): ZCF-ZHLC_HCF
- ! => min(ZCF, ZRF)-ZHLC_HCF
- ZZW(1:IMICRO) = 0.
- WHERE( ZHLC_HRC(1:IMICRO)>XRTMIN(2) .AND. ZRRT(1:IMICRO)>XRTMIN(3) .AND. ZRCS(1:IMICRO)>0.0 &
- .AND. ZHLC_HCF(1:IMICRO)>0 )
- !Accretion due to rain falling in high cloud content
-#ifndef MNH_BITREP
- ZZW(1:IMICRO) = XFCACCR * ( ZHLC_HRC(1:IMICRO)/ZHLC_HCF(1:IMICRO) ) &
- * ZLBDAR_RF(1:IMICRO)**XEXCACCR &
- * ZRHODREF(1:IMICRO)**(-XCEXVT) &
- * ZHLC_HCF
-#else
- ZZW(1:IMICRO) = XFCACCR * ( ZHLC_HRC(1:IMICRO)/ZHLC_HCF(1:IMICRO) ) &
- * BR_POW(ZLBDAR_RF(1:IMICRO),XEXCACCR) &
- * BR_POW(ZRHODREF(1:IMICRO),-XCEXVT) &
- * ZHLC_HCF
-#endif
- END WHERE
- WHERE( ZHLC_LRC(1:IMICRO)>XRTMIN(2) .AND. ZRRT(1:IMICRO)>XRTMIN(3) .AND. ZRCS(1:IMICRO)>0.0 &
- .AND. ZHLC_LCF(1:IMICRO)>0 )
- !We add acrretion due to rain falling in low cloud content
-#ifndef MNH_BITREP
- ZZW(1:IMICRO) = ZZW(1:IMICRO) + XFCACCR * ( ZHLC_LRC(1:IMICRO)/ZHLC_LCF(1:IMICRO) ) &
- * ZLBDAR_RF(1:IMICRO)**XEXCACCR &
- * ZRHODREF(1:IMICRO)**(-XCEXVT) &
- * (MIN(ZCF(1:IMICRO), ZRF(1:IMICRO))-ZHLC_HCF(1:IMICRO))
-#else
- ZZW(1:IMICRO) = ZZW(1:IMICRO) + XFCACCR * ( ZHLC_LRC(1:IMICRO)/ZHLC_LCF(1:IMICRO) ) &
- * BR_POW(ZLBDAR_RF(1:IMICRO),XEXCACCR) &
- * BR_POW(ZRHODREF(1:IMICRO),-XCEXVT) &
- * (MIN(ZCF(1:IMICRO), ZRF(1:IMICRO))-ZHLC_HCF(1:IMICRO))
-#endif
- END WHERE
- ZZW(1:IMICRO)=MIN(ZRCS(1:IMICRO), ZZW(1:IMICRO))
- ZRCS(1:IMICRO) = ZRCS(1:IMICRO) - ZZW(1:IMICRO)
- ZRRS(1:IMICRO) = ZRRS(1:IMICRO) + ZZW(1:IMICRO)
-!$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','')
- ENDIF
-
- 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')
-!
-!* 4.4 compute the evaporation of r_r: RREVAV
-!
-!$acc kernels present(ZZW,ZUSW)
- !Not necessary but useful for debugging (MPPDB_CHECK1D on them)
- ZZW(1:IMICRO) = 0.0
- ZUSW(1:IMICRO) = 0.0
-!$acc end kernels
-
- IF (CSUBG_RR_EVAP=='NONE') THEN
-!$acc kernels present(GWORK,ZZW,ZLBDAR,ZRRT,ZRVS,ZTHS,ZRRS,ZRHODREF,ZRCT,XEX0EVAR,XEX1EVAR,XRTMIN)
- !Evaporation only when there's no cloud (RC must be 0)
- GWORK(1:IMICRO) = (ZRRT(1:IMICRO)>XRTMIN(3)) .AND. (ZRCT(1:IMICRO)<=XRTMIN(2))
- WHERE( GWORK(1:IMICRO) )
-#ifndef MNH_BITREP
- ZZW(1:IMICRO) = EXP( XALPW - XBETAW/ZZT(1:IMICRO) - XGAMW*ALOG(ZZT(1:IMICRO) ) ) ! es_w
-#else
- ZZW(1:IMICRO) = BR_EXP( XALPW - XBETAW/ZZT(1:IMICRO) - XGAMW*BR_LOG(ZZT(1:IMICRO) ) ) ! es_w
-#endif
- ZUSW(1:IMICRO) = 1.0 - ZRVT(1:IMICRO)*( ZPRES(1:IMICRO)-ZZW(1:IMICRO) ) / ( (XMV/XMD) * ZZW(1:IMICRO) )
- ! Undersaturation over water
-#ifndef MNH_BITREP
- ZZW(1:IMICRO) = ( XLVTT+(XCPV-XCL)*(ZZT(1:IMICRO)-XTT) )**2 / ( ZKA(1:IMICRO)*XRV*ZZT(1:IMICRO)**2 ) &
- + ( XRV*ZZT(1:IMICRO) ) / ( ZDV(1:IMICRO)*ZZW(1:IMICRO) )
- ZZW(1:IMICRO) = MIN( ZRRS(1:IMICRO),( MAX( 0.0,ZUSW(1:IMICRO) )/(ZRHODREF(1:IMICRO)*ZZW(1:IMICRO)) ) * &
- ( X0EVAR*ZLBDAR(1:IMICRO)**XEX0EVAR+X1EVAR*ZCJ(1:IMICRO)*ZLBDAR(1:IMICRO)**XEX1EVAR ) )
-#else
- ZZW(1:IMICRO) = BR_P2( XLVTT+(XCPV-XCL)*(ZZT(1:IMICRO)-XTT) ) / ( ZKA(1:IMICRO)*XRV*BR_P2(ZZT(1:IMICRO)) ) &
- + ( XRV*ZZT(1:IMICRO) ) / ( ZDV(1:IMICRO)*ZZW(1:IMICRO) )
- ZZW(1:IMICRO) = MIN( ZRRS(1:IMICRO),( MAX( 0.0,ZUSW(1:IMICRO) )/(ZRHODREF(1:IMICRO)*ZZW(1:IMICRO)) ) * &
- ( X0EVAR*BR_POW(ZLBDAR(1:IMICRO),XEX0EVAR)+X1EVAR*ZCJ(1:IMICRO)*BR_POW(ZLBDAR(1:IMICRO),XEX1EVAR) ) )
-#endif
- ZRRS(1:IMICRO) = ZRRS(1:IMICRO) - ZZW(1:IMICRO)
- ZRVS(1:IMICRO) = ZRVS(1:IMICRO) + ZZW(1:IMICRO)
- ZTHS(1:IMICRO) = ZTHS(1:IMICRO) - ZZW(1:IMICRO)*ZLVFACT(1:IMICRO)
- END WHERE
-!$acc end kernels
- ELSEIF (CSUBG_RR_EVAP=='CLFR' .OR. CSUBG_RR_EVAP=='PRFR') THEN
-#ifdef _OPENACC
-PRINT *,'OPENACC: RAIN_ICE_WARM::CSUBG_RR_EVAP==CLFR or PRFR not yet implemented'
-CALL ABORT
-#endif
-!$acc kernels present(ZCF,ZRF,ZLBDAR,ZRHODREF,ZZW2,ZZW3,ZZW4,XRTMIN,CSUBG_RR_EVAP,XEX0EVAR,XEX1EVAR)
- !Evaporation in clear sky part
- !With CLFR, rain is diluted over the grid box
- !With PRFR, rain is concentrated in its fraction
- !Use temperature and humidity in clear sky part like Bechtold et al. (1993)
- IF (CSUBG_RR_EVAP=='CLFR') THEN
- ZZW4(1:IMICRO)=1. !Precipitation fraction
- ZZW3(1:IMICRO)=ZLBDAR(1:IMICRO)
- ELSE
- ZZW4(1:IMICRO)=ZRF(1:IMICRO) !Precipitation fraction
- ZZW3(1:IMICRO)=ZLBDAR_RF(1:IMICRO)
- ENDIF
-
- !ATTENTION
- !Il faudrait recalculer les variables ZKA, ZDV, ZCJ en tenant compte de la température T^u
- !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 ZKA, ZDV, ZCJ dans rain_ice
- !On utiliserait la bonne version suivant l'option NONE, CLFR... dans l'évaporation et ailleurs
-
- WHERE( (ZRRT(1:IMICRO)>XRTMIN(3)) .AND. ( ZZW4(1:IMICRO) > ZCF(1:IMICRO) ) )
- ! outside the cloud (environment) the use of T^u (unsaturated) instead of T
- ! Bechtold et al. 1993
- !
- ! T^u = T_l = theta_l * (T/theta)
- ZZW2(1:IMICRO) = ZTHLT(1:IMICRO) * ZZT(1:IMICRO) / ZTHT(1:IMICRO)
- !
- ! es_w with new T^u
-#ifndef MNH_BITREP
- ZZW(1:IMICRO) = EXP( XALPW - XBETAW/ZZW2(1:IMICRO) - XGAMW*ALOG(ZZW2(1:IMICRO) ) )
-#else
- ZZW(1:IMICRO) = BR_EXP( XALPW - XBETAW/ZZW2(1:IMICRO) - XGAMW*BR_LOG(ZZW2(1:IMICRO) ) )
-#endif
- !
- ! S, Undersaturation over water (with new theta^u)
- ZUSW(1:IMICRO) = 1.0 - ZRVT(1:IMICRO)*( ZPRES(1:IMICRO)-ZZW(1:IMICRO) ) / ( (XMV/XMD) * ZZW(1:IMICRO) )
- !
-#ifndef MNH_BITREP
- ZZW(1:IMICRO) = ( XLVTT+(XCPV-XCL)*(ZZW2(1:IMICRO)-XTT) )**2 / ( ZKA(1:IMICRO)*XRV*ZZW2(1:IMICRO)**2 ) &
- + ( XRV*ZZW2(1:IMICRO) ) / ( ZDV(1:IMICRO)*ZZW(1:IMICRO) )
- !
- ZZW(1:IMICRO) = MAX( 0.0,ZUSW(1:IMICRO) )/(ZRHODREF(1:IMICRO)*ZZW(1:IMICRO)) * &
- ( X0EVAR*ZZW3(1:IMICRO)**XEX0EVAR+X1EVAR*ZCJ(1:IMICRO)*ZZW3(1:IMICRO)**XEX1EVAR )
-#else
- ZZW(1:IMICRO) = BR_P2( XLVTT+(XCPV-XCL)*(ZZW2(1:IMICRO)-XTT) ) / ( ZKA(1:IMICRO)*XRV*BR_P2(ZZW2(1:IMICRO)) ) &
- + ( XRV*ZZW2(1:IMICRO) ) / ( ZDV(1:IMICRO)*ZZW(1:IMICRO) )
- !
- ZZW(1:IMICRO) = MAX( 0.0,ZUSW(1:IMICRO) )/(ZRHODREF(1:IMICRO)*ZZW(1:IMICRO)) * &
- ( BR_POW(X0EVAR*ZZW3(1:IMICRO),XEX0EVAR)+X1EVAR*ZCJ(1:IMICRO)*BR_POW(ZZW3(1:IMICRO),XEX1EVAR) )
-#endif
-
- !
- ZZW(1:IMICRO) = MIN( ZRRS(1:IMICRO), ZZW(1:IMICRO) *( ZZW4(1:IMICRO) - ZCF(1:IMICRO) ) )
- !
- ZRRS(1:IMICRO) = ZRRS(1:IMICRO) - ZZW(1:IMICRO)
- ZRVS(1:IMICRO) = ZRVS(1:IMICRO) + ZZW(1:IMICRO)
- ZTHS(1:IMICRO) = ZTHS(1:IMICRO) - ZZW(1:IMICRO)*ZLVFACT(1:IMICRO)
- END WHERE
-!$acc end kernels
-
- ELSE
- !wrong CSUBG_RR_EVAP case
- WRITE(*,*) 'wrong CSUBG_RR_EVAP case'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE_WARM','')
- END IF
-
- 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')
-#ifndef _OPENACC
- PEVAP3D(:,:,:)=UNPACK(ZZW(:),MASK=GMICRO(:,:,:),FIELD=0.0)
-#else
-!$acc kernels present(I1,I2,I3,PEVAP3D)
- PEVAP3D(:,:,:) = 0.0
-!$acc loop independent
- DO JL=1,IMICRO
- PEVAP3D(I1(JL),I2(JL),I3(JL)) = ZZW(JL)
- END DO
-!$acc end kernels
-#endif
-!
- END SUBROUTINE RAIN_ICE_WARM
-!
-!-------------------------------------------------------------------------------
-!
-!
- SUBROUTINE RAIN_ICE_FAST_RS
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-INTEGER , DIMENSION(:),ALLOCATABLE :: I1 ! Used to replace the COUNT
-INTEGER :: JL ! and PACK intrinsics
-REAL,DIMENSION(SIZE(ZZW1,1)) :: ZTMP
-!$acc declare device_resident(I1,ZTMP)
-!
-!-------------------------------------------------------------------------------
-!
-!* 5.1 cloud droplet riming of the aggregates
-!
- ALLOCATE(GRIM(IMICRO))
- ALLOCATE(I1(IMICRO)) !I1 is bigger than necessary but it easier to do it now (instead of computing IGRIM before allocating I1)
-!$acc data create(GRIM)
-!
-!$acc kernels present(ZZW1,XRTMIN)
- ZZW1(:,:) = 0.0
-! GRIM(1:IMICRO) = (ZRCT(1:IMICRO)>0.0) .AND. (ZRST(1:IMICRO)>0.0) .AND. &
- GRIM(1:IMICRO) = (ZRCT(1:IMICRO)>XRTMIN(2)) .AND. (ZRST(1:IMICRO)>XRTMIN(5)) .AND. &
- (ZRCS(1:IMICRO)>0.0) .AND. (ZZT(1:IMICRO)<XTT)
-!$acc end kernels
-#ifndef _OPENACC
- IGRIM = COUNT( GRIM(1:IMICRO) )
-#else
- CALL COUNTJV1D_DEVICE(GRIM(1:IMICRO),I1(1:IMICRO),IGRIM)
-#endif
-!
- IF( IGRIM>0 ) THEN
-!
-! 5.1.0 allocations
-!
- ALLOCATE(ZVEC1(IGRIM))
- ALLOCATE(ZVEC2(IGRIM))
- ALLOCATE(IVEC1(IGRIM))
- ALLOCATE(IVEC2(IGRIM))
-!$acc data create(IVEC1,IVEC2,ZVEC1,ZVEC2)
-!
-! 5.1.1 select the ZLBDAS
-!
-#ifndef _OPENACC
- ZVEC1(1:IGRIM) = PACK( ZLBDAS(1:IMICRO),MASK=GRIM(1:IGRIM) )
-#else
-!$acc kernels default(none) &
-!$acc & present(XRIMINTP1,XEXCRIMSS,XGAMINC_RIM1,XGAMINC_RIM2) &
-!$acc & present(GRIM,ZLBDAS,ZRHODREF,ZLSFACT,ZLVFACT,ZZW1,IVEC2,ZVEC1,ZVEC2,ZRCT,ZRCS,ZRSS,ZTHS,ZZW) &
-!$acc & present(XEXCRIMSG,XEXSRIMCG) &
-!$acc & present(GWORK,ZRGS)
- DO JL=1,IGRIM
- ZVEC1(JL) = ZLBDAS(I1(JL))
- END DO
-#endif
-!
-! 5.1.2 find the next lower indice for the ZLBDAS in the geometrical
-! set of Lbda_s used to tabulate some moments of the incomplete
-! gamma function
-!
- ZVEC2(1:IGRIM) = MAX( 1.00001, MIN( FLOAT(NGAMINC)-0.00001, &
-#ifndef MNH_BITREP
- XRIMINTP1 * LOG( ZVEC1(1:IGRIM) ) + XRIMINTP2 ) )
-#else
- XRIMINTP1 * BR_LOG( ZVEC1(1:IGRIM) ) + XRIMINTP2 ) )
-#endif
- IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) )
- ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - FLOAT( IVEC2(1:IGRIM) )
-!
-! 5.1.3 perform the linear interpolation of the normalized
-! "2+XDS"-moment of the incomplete gamma function
-!
- ZVEC1(1:IGRIM) = XGAMINC_RIM1( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
- - XGAMINC_RIM1( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
-#ifndef _OPENACC
- ZZW(1:IMICRO) = UNPACK( VECTOR=ZVEC1(1:IGRIM),MASK=GRIM,FIELD=0.0 )
-#else
- ZZW(1:IMICRO) = 0.0
-!$acc loop independent
- DO JL=1,IGRIM
- ZZW(I1(JL)) = ZVEC1(JL)
- END DO
-#endif
-!
-! 5.1.4 riming of the small sized aggregates
-!
- WHERE ( GRIM(1:IMICRO) )
-#ifndef MNH_BITREP
- ZZW1(1:IMICRO,1) = MIN( ZRCS(1:IMICRO), &
- XCRIMSS * ZZW(1:IMICRO) * ZRCT(1:IMICRO) & ! RCRIMSS
- * ZLBDAS(1:IMICRO)**XEXCRIMSS &
- * ZRHODREF(1:IMICRO)**(-XCEXVT) )
-#else
- ZZW1(1:IMICRO,1) = MIN( ZRCS(1:IMICRO), &
- XCRIMSS * ZZW(1:IMICRO) * ZRCT(1:IMICRO) & ! RCRIMSS
- * BR_POW(ZLBDAS(1:IMICRO),XEXCRIMSS) &
- * BR_POW(ZRHODREF(1:IMICRO),-XCEXVT) )
-#endif
- ZRCS(1:IMICRO) = ZRCS(1:IMICRO) - ZZW1(1:IMICRO,1)
- ZRSS(1:IMICRO) = ZRSS(1:IMICRO) + ZZW1(1:IMICRO,1)
- ZTHS(1:IMICRO) = ZTHS(1:IMICRO) + ZZW1(1:IMICRO,1)*(ZLSFACT(1:IMICRO)-ZLVFACT(1:IMICRO)) ! f(L_f*(RCRIMSS))
- END WHERE
-!
-! 5.1.5 perform the linear interpolation of the normalized
-! "XBS"-moment of the incomplete gamma function
-!
- ZVEC1(1:IGRIM) = XGAMINC_RIM2( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
- - XGAMINC_RIM2( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
-#ifndef _OPENACC
- ZZW(1:IMICRO) = UNPACK( VECTOR=ZVEC1(1:IGRIM),MASK=GRIM,FIELD=0.0 )
-#else
- ZZW(1:IMICRO) = 0.0
-!$acc loop independent
- DO JL=1,IGRIM
- ZZW(I1(JL)) = ZVEC1(JL)
- END DO
-#endif
-!
-! 5.1.6 riming-conversion of the large sized aggregates into graupeln
-!
- GWORK(1:IMICRO) = GRIM(1:IMICRO) .AND. (ZRSS(1:IMICRO)>0.0)
- WHERE ( GWORK(1:IMICRO) )
-#ifndef MNH_BITREP
- ZZW1(1:IMICRO,2) = MIN( ZRCS(1:IMICRO), &
- XCRIMSG * ZRCT(1:IMICRO) & ! RCRIMSG
- * ZLBDAS(1:IMICRO)**XEXCRIMSG &
- * ZRHODREF(1:IMICRO)**(-XCEXVT) &
- - ZZW1(1:IMICRO,1) )
- ZZW1(1:IMICRO,3) = MIN( ZRSS(1:IMICRO), &
- XSRIMCG * ZLBDAS(1:IMICRO)**XEXSRIMCG & ! RSRIMCG
- * (1.0 - ZZW(1:IMICRO) )/(PTSTEP*ZRHODREF(1:IMICRO)) )
-#else
- ZZW1(1:IMICRO,2) = MIN( ZRCS(1:IMICRO), &
- XCRIMSG * ZRCT(1:IMICRO) & ! RCRIMSG
- * BR_POW(ZLBDAS(1:IMICRO),XEXCRIMSG) &
- * BR_POW(ZRHODREF(1:IMICRO),-XCEXVT) &
- - ZZW1(1:IMICRO,1) )
- ZZW1(1:IMICRO,3) = MIN( ZRSS(1:IMICRO), &
- XSRIMCG * BR_POW(ZLBDAS(1:IMICRO),XEXSRIMCG) & ! RSRIMCG
- * (1.0 - ZZW(1:IMICRO) )/(PTSTEP*ZRHODREF(1:IMICRO)) )
-#endif
- ZRCS(1:IMICRO) = ZRCS(1:IMICRO) - ZZW1(1:IMICRO,2)
- ZRSS(1:IMICRO) = ZRSS(1:IMICRO) - ZZW1(1:IMICRO,3)
- ZRGS(1:IMICRO) = ZRGS(1:IMICRO) + ZZW1(1:IMICRO,2)+ZZW1(1:IMICRO,3)
- ZTHS(1:IMICRO) = ZTHS(1:IMICRO) + ZZW1(1:IMICRO,2)*(ZLSFACT(1:IMICRO)-ZLVFACT(1:IMICRO)) ! f(L_f*(RCRIMSG))
- END WHERE
-!$acc end kernels
-!$acc end data
- DEALLOCATE(IVEC2)
- DEALLOCATE(IVEC1)
- DEALLOCATE(ZVEC2)
- DEALLOCATE(ZVEC1)
- END IF
- IF (LBUDGET_TH) THEN
-!$acc update self(ZTHS)
- CALL BUDGET (UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), 4,'RIM_BU_RTH')
- END IF
- IF (LBUDGET_RC) THEN
-!$acc update self(ZRCS)
- CALL BUDGET (UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 7,'RIM_BU_RRC')
- END IF
- IF (LBUDGET_RS) THEN
-!$acc update self(ZRSS)
- CALL BUDGET (UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 10,'RIM_BU_RRS')
- END IF
- IF (LBUDGET_RG) THEN
-!$acc update self(ZRGS)
- CALL BUDGET (UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 11,'RIM_BU_RRG')
- END IF
-!$acc end data
- DEALLOCATE(GRIM)
-!
-!* 5.2 rain accretion onto the aggregates
-!
- ALLOCATE(GACC(IMICRO))
-!$acc data create(GACC)
-!$acc kernels present(ZZW1,XRTMIN)
- ZZW1(1:IMICRO,2:3) = 0.0
- GACC(1:IMICRO) = (ZRRT(:)>XRTMIN(3)) .AND. (ZRST(:)>XRTMIN(5)) .AND. &
- (ZRRS(:)>0.0) .AND. (ZZT(:)<XTT)
-!$acc end kernels
-#ifndef _OPENACC
- IGACC = COUNT( GACC(1:IMICRO) )
-#else
- CALL COUNTJV1D_DEVICE(GACC(1:IMICRO),I1(1:IMICRO),IGACC)
-#endif
-!
- IF( IGACC>0 ) THEN
-!
-! 5.2.0 allocations
-!
- ALLOCATE(ZVEC1(IGACC))
- ALLOCATE(ZVEC2(IGACC))
- ALLOCATE(ZVEC3(IGACC))
- ALLOCATE(IVEC1(IGACC))
- ALLOCATE(IVEC2(IGACC))
-!$acc data create(IVEC1,IVEC2,ZVEC1,ZVEC2,ZVEC3)
-!
-! 5.2.1 select the (ZLBDAS,ZLBDAR) couplet
-!
-!$acc kernels present(XKER_RACCS,XKER_RACCSS,XKER_SACCRG,XCXS) &
-!$acc & present(GACC,GWORK,ZLBDAS,ZRHODREF,ZZW,ZLSFACT,ZLVFACT,ZLBDAR,I1, &
-!$acc & ZZW1,ZRRS,ZRSS,ZTHS,IVEC1,IVEC2,ZVEC1,ZVEC2,ZVEC3,ZTMP)
-#ifndef _OPENACC
- ZVEC1(1:IGACC) = PACK( ZLBDAS(1:IGACC),MASK=GACC(1:IGACC) )
- ZVEC2(1:IGACC) = PACK( ZLBDAR(1:IGACC),MASK=GACC(1:IGACC) )
-#else
- DO JL=1,IGACC
- ZVEC1(JL) = ZLBDAS(I1(JL))
- ZVEC2(JL) = ZLBDAR(I1(JL))
- END DO
-#endif
-!
-! 5.2.2 find the next lower indice for the ZLBDAS and for the ZLBDAR
-! in the geometrical set of (Lbda_s,Lbda_r) couplet use to
-! tabulate the RACCSS-kernel
-!
- ZVEC1(1:IGACC) = MAX( 1.00001, MIN( FLOAT(NACCLBDAS)-0.00001, &
-#ifndef MNH_BITREP
- XACCINTP1S * LOG( ZVEC1(1:IGACC) ) + XACCINTP2S ) )
-#else
- XACCINTP1S * BR_LOG( ZVEC1(1:IGACC) ) + XACCINTP2S ) )
-#endif
- IVEC1(1:IGACC) = INT( ZVEC1(1:IGACC) )
- ZVEC1(1:IGACC) = ZVEC1(1:IGACC) - FLOAT( IVEC1(1:IGACC) )
-!
- ZVEC2(1:IGACC) = MAX( 1.00001, MIN( FLOAT(NACCLBDAR)-0.00001, &
-#ifndef MNH_BITREP
- XACCINTP1R * LOG( ZVEC2(1:IGACC) ) + XACCINTP2R ) )
-#else
- XACCINTP1R * BR_LOG( ZVEC2(1:IGACC) ) + XACCINTP2R ) )
-#endif
- IVEC2(1:IGACC) = INT( ZVEC2(1:IGACC) )
- ZVEC2(1:IGACC) = ZVEC2(1:IGACC) - FLOAT( IVEC2(1:IGACC) )
-!
-! 5.2.3 perform the bilinear interpolation of the normalized
-! RACCSS-kernel
-!
-!$acc loop independent
- DO JJ = 1,IGACC
- ZVEC3(JJ) = ( XKER_RACCSS(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_RACCSS(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * ZVEC1(JJ) &
- - ( XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * (ZVEC1(JJ) - 1.0)
- END DO
-#ifndef _OPENACC
- ZZW(1:IMICRO) = UNPACK( VECTOR=ZVEC3(1:IGACC),MASK=GACC,FIELD=0.0 )
-#else
- ZZW(1:IMICRO) = 0.0
-!$acc loop independent
- DO JL=1,IGACC
- ZZW(I1(JL)) = ZVEC3(JL)
- END DO
-#endif
-!
-! 5.2.4 raindrop accretion on the small sized aggregates
-!
- WHERE ( GACC(1:IMICRO) )
-#ifndef MNH_BITREP
- ZZW1(1:IMICRO,2) = & !! coef of RRACCS
- XFRACCSS*( ZLBDAS(1:IMICRO)**XCXS )*( ZRHODREF(1:IMICRO)**(-XCEXVT-1.) ) &
- *( XLBRACCS1/((ZLBDAS(1:IMICRO)**2) ) + &
- XLBRACCS2/( ZLBDAS(1:IMICRO) * ZLBDAR(1:IMICRO) ) + &
- XLBRACCS3/( (ZLBDAR(1:IMICRO)**2)) )/ZLBDAR(1:IMICRO)**4
-#else
- ZZW1(1:IMICRO,2) = & !! coef of RRACCS
- XFRACCSS*( BR_POW(ZLBDAS(1:IMICRO),XCXS) )*( BR_POW(ZRHODREF(1:IMICRO),-XCEXVT-1.) ) &
- *( XLBRACCS1/((BR_P2(ZLBDAS(1:IMICRO))) ) + &
- XLBRACCS2/( ZLBDAS(1:IMICRO) * ZLBDAR(1:IMICRO) ) + &
- XLBRACCS3/( (BR_P2(ZLBDAR(1:IMICRO)))) )/BR_POW(ZLBDAR(1:IMICRO),4.0)
-#endif
- ZZW1(1:IMICRO,4) = MIN( ZRRS(1:IMICRO),ZZW1(1:IMICRO,2)*ZZW(1:IMICRO) ) ! RRACCSS
- ZRRS(1:IMICRO) = ZRRS(1:IMICRO) - ZZW1(1:IMICRO,4)
- ZRSS(1:IMICRO) = ZRSS(1:IMICRO) + ZZW1(1:IMICRO,4)
- ZTHS(1:IMICRO) = ZTHS(1:IMICRO) + ZZW1(1:IMICRO,4)*(ZLSFACT(1:IMICRO)-ZLVFACT(1:IMICRO)) ! f(L_f*(RRACCSS))
- END WHERE
-!
-! 5.2.4b perform the bilinear interpolation of the normalized
-! RACCS-kernel
-!
- DO JJ = 1,IGACC
- ZVEC3(JJ) = ( XKER_RACCS(IVEC2(JJ)+1,IVEC1(JJ)+1)* ZVEC1(JJ) &
- - XKER_RACCS(IVEC2(JJ)+1,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
- * ZVEC2(JJ) &
- - ( XKER_RACCS(IVEC2(JJ) ,IVEC1(JJ)+1)* ZVEC1(JJ) &
- - XKER_RACCS(IVEC2(JJ) ,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
- * (ZVEC2(JJ) - 1.0)
- END DO
-#ifndef _OPENACC
- ZZW1(:,2) = ZZW1(:,2)*UNPACK( VECTOR=ZVEC3(:),MASK=GACC(:),FIELD=0.0 )
-#else
- !Problems when doing it this way on GPU (PGI 16.10/17.01):
- !ZZW1(1:I1(1)-1,2) = 0.0
- !ZZW1(I1(1),2) = ZZW1(I1(1),2)*ZVEC3(1)
- !DO JL=2,IGACC
- ! ZZW1(I1(JL-1)+1:I1(JL)-1,2) = 0.0
- ! ZZW1(I1(JL),2) = ZZW1(I1(JL),2)*ZVEC3(JL)
- !END DO
- !ZZW1(I1(IGACC)+1:,2) = 0.0
- !
- !OK on GPU:
- ZTMP(1:IMICRO) = ZZW1(1:IMICRO,2)
- ZZW1(1:IMICRO,2) = 0.0
-!$acc loop independent
- DO JL=1,IGACC
- ZZW1(I1(JL),2) = ZTMP(I1(JL))*ZVEC3(JL)
- END DO
-#endif
- !! RRACCS!
-! 5.2.5 perform the bilinear interpolation of the normalized
-! SACCRG-kernel
-!
- DO JJ = 1,IGACC
- ZVEC3(JJ) = ( XKER_SACCRG(IVEC2(JJ)+1,IVEC1(JJ)+1)* ZVEC1(JJ) &
- - XKER_SACCRG(IVEC2(JJ)+1,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
- * ZVEC2(JJ) &
- - ( XKER_SACCRG(IVEC2(JJ) ,IVEC1(JJ)+1)* ZVEC1(JJ) &
- - XKER_SACCRG(IVEC2(JJ) ,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
- * (ZVEC2(JJ) - 1.0)
- END DO
-#ifndef _OPENACC
- ZZW(1:IMICRO) = UNPACK( VECTOR=ZVEC3(1:IGACC),MASK=GACC,FIELD=0.0 )
-#else
- ZZW(1:IMICRO) = 0.0
-!$acc loop independent
- DO JL=1,IGACC
- ZZW(I1(JL)) = ZVEC3(JL)
- END DO
-#endif
-!
-! 5.2.6 raindrop accretion-conversion of the large sized aggregates
-! into graupeln
-!
- GWORK(1:IMICRO) = GACC(1:IMICRO) .AND. (ZRSS(1:IMICRO)>0.0)
- WHERE ( GWORK(1:IMICRO) )
- ZZW1(1:IMICRO,2) = MAX( MIN( ZRRS(1:IMICRO),ZZW1(1:IMICRO,2)-ZZW1(1:IMICRO,4) ),0.0 ) ! RRACCSG
- END WHERE
- GWORK(1:IMICRO) = GWORK(1:IMICRO) .AND. ZZW1(1:IMICRO,2)>0.0
- WHERE ( GWORK(1:IMICRO) )
-#ifndef MNH_BITREP
- ZZW1(1:IMICRO,3) = MIN( ZRSS(1:IMICRO),XFSACCRG*ZZW(1:IMICRO)* & ! RSACCRG
- ( ZLBDAS(1:IMICRO)**(XCXS-XBS) )*( ZRHODREF(1:IMICRO)**(-XCEXVT-1.) ) &
- *( XLBSACCR1/((ZLBDAR(1:IMICRO)**2) ) + &
- XLBSACCR2/( ZLBDAR(1:IMICRO) * ZLBDAS(1:IMICRO) ) + &
- XLBSACCR3/( (ZLBDAS(1:IMICRO)**2)) )/ZLBDAR(1:IMICRO) )
-#else
- ZZW1(1:IMICRO,3) = MIN( ZRSS(1:IMICRO),XFSACCRG*ZZW(1:IMICRO)* & ! RSACCRG
- ( BR_POW(ZLBDAS(1:IMICRO),XCXS-XBS) )*( BR_POW(ZRHODREF(1:IMICRO),-XCEXVT-1.) ) &
- *( XLBSACCR1/((BR_P2(ZLBDAR(1:IMICRO))) ) + &
- XLBSACCR2/( ZLBDAR(1:IMICRO) * ZLBDAS(1:IMICRO) ) + &
- XLBSACCR3/( (BR_P2(ZLBDAS(1:IMICRO)))) )/ZLBDAR(1:IMICRO) )
-#endif
- ZRRS(1:IMICRO) = ZRRS(1:IMICRO) - ZZW1(1:IMICRO,2)
- ZRSS(1:IMICRO) = ZRSS(1:IMICRO) - ZZW1(1:IMICRO,3)
- ZRGS(1:IMICRO) = ZRGS(1:IMICRO) + ZZW1(1:IMICRO,2)+ZZW1(1:IMICRO,3)
- ZTHS(1:IMICRO) = ZTHS(1:IMICRO) + ZZW1(1:IMICRO,2)*(ZLSFACT(1:IMICRO)-ZLVFACT(1:IMICRO)) !
- ! f(L_f*(RRACCSG))
- END WHERE
-!$acc end kernels
-!$acc end data
- DEALLOCATE(IVEC2)
- DEALLOCATE(IVEC1)
- DEALLOCATE(ZVEC3)
- DEALLOCATE(ZVEC2)
- DEALLOCATE(ZVEC1)
- END IF
-!$acc end data
- DEALLOCATE(GACC)
- DEALLOCATE(I1)
- IF (LBUDGET_TH) THEN
-!$acc update self(ZTHS)
- CALL BUDGET (UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), 4,'ACC_BU_RTH')
- END IF
- IF (LBUDGET_RR) THEN
-!$acc update self(ZRRS)
- CALL BUDGET (UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 8,'ACC_BU_RRR')
- END IF
- IF (LBUDGET_RS) THEN
-!$acc update self(ZRSS)
- CALL BUDGET (UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 10,'ACC_BU_RRS')
- END IF
- IF (LBUDGET_RG) THEN
-!$acc update self(ZRGS)
- CALL BUDGET (UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 11,'ACC_BU_RRG')
- END IF
-!
-!* 5.3 Conversion-Melting of the aggregates
-!
-!$acc kernels default(none) present(ZZW,GWORK,ZRST,ZRSS,ZZT,ZRVT,ZPRES,ZKA,ZDV,ZLBDAS,ZCJ,ZZW1,ZRHODREF,ZRGS,XRTMIN) &
-!$acc & present(XEX0DEPS,XEX1DEPS)
- ZZW(1:IMICRO) = 0.0
- GWORK(1:IMICRO) = (ZRST(1:IMICRO)>XRTMIN(5)) .AND. (ZRSS(1:IMICRO)>0.0) .AND. (ZZT(1:IMICRO)>XTT)
- WHERE( GWORK(1:IMICRO) )
- ZZW(1:IMICRO) = ZRVT(1:IMICRO)*ZPRES(1:IMICRO)/((XMV/XMD)+ZRVT(1:IMICRO)) ! Vapor pressure
- ZZW(1:IMICRO) = ZKA(1:IMICRO)*(XTT-ZZT(1:IMICRO)) + &
- ( ZDV(1:IMICRO)*(XLVTT + ( XCPV - XCL ) * ( ZZT(1:IMICRO) - XTT )) &
- *(XESTT-ZZW(1:IMICRO))/(XRV*ZZT(1:IMICRO)) )
-!
-! compute RSMLT
-!
-#ifndef MNH_BITREP
- ZZW(1:IMICRO) = MIN( ZRSS(1:IMICRO), XFSCVMG*MAX( 0.0,( -ZZW(1:IMICRO) * &
- ( X0DEPS* ZLBDAS(1:IMICRO)**XEX0DEPS + &
- X1DEPS*ZCJ(1:IMICRO)*ZLBDAS(1:IMICRO)**XEX1DEPS ) - &
- ( ZZW1(:,1)+ZZW1(:,4) ) * &
- ( ZRHODREF(1:IMICRO)*XCL*(XTT-ZZT(1:IMICRO))) ) / &
- ( ZRHODREF(1:IMICRO)*XLMTT ) ) )
-#else
- ZZW(1:IMICRO) = MIN( ZRSS(1:IMICRO), XFSCVMG*MAX( 0.0,( -ZZW(1:IMICRO) * &
- ( X0DEPS* BR_POW(ZLBDAS(1:IMICRO),XEX0DEPS) + &
- X1DEPS*ZCJ(1:IMICRO)*BR_POW(ZLBDAS(1:IMICRO),XEX1DEPS) ) - &
- ( ZZW1(:,1)+ZZW1(:,4) ) * &
- ( ZRHODREF(1:IMICRO)*XCL*(XTT-ZZT(1:IMICRO))) ) / &
- ( ZRHODREF(1:IMICRO)*XLMTT ) ) )
-#endif
-!
-! note that RSCVMG = RSMLT*XFSCVMG but no heat is exchanged (at the rate RSMLT)
-! because the graupeln produced by this process are still icy!!!
-!
- ZRSS(1:IMICRO) = ZRSS(1:IMICRO) - ZZW(1:IMICRO)
- ZRGS(1:IMICRO) = ZRGS(1:IMICRO) + ZZW(1:IMICRO)
- END WHERE
-!$acc end kernels
- IF (LBUDGET_RS) THEN
-!$acc update self(ZRSS)
- CALL BUDGET (UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0),10,'CMEL_BU_RRS')
- END IF
- IF (LBUDGET_RG) THEN
-!$acc update self(ZRGS)
- CALL BUDGET (UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0),11,'CMEL_BU_RRG')
- END IF
-!
- END SUBROUTINE RAIN_ICE_FAST_RS
-!
-!-------------------------------------------------------------------------------
-!
-!
- SUBROUTINE RAIN_ICE_FAST_RG
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-INTEGER :: JL
-INTEGER,DIMENSION(:),ALLOCATABLE :: I1
-!acc declare device_resident(I1)
-!
-!-------------------------------------------------------------------------------
- ALLOCATE(GDRY(IMICRO))
- ALLOCATE(I1(IMICRO)) !I1 is bigger than necessary but it easier to do it now (instead of computing IGDRY before allocating I1)
-!$acc data create(GDRY,I1)
-!
-!* 6.1 rain contact freezing
-!
-!$acc kernels present(XEXICFRR,XEXRCFRI) default(none) &
-!$acc & present(ZZW1,GWORK,ZRIT,ZRRT,ZRIS,ZRRS,ZRGS,ZTHS,ZLBDAR,ZRHODREF,ZCIT,ZLSFACT,ZLVFACT,XRTMIN)
- ZZW1(1:IMICRO,3:4) = 0.0
- GWORK(1:IMICRO) = (ZRIT(1:IMICRO)>XRTMIN(4)) .AND. (ZRRT(1:IMICRO)>XRTMIN(3)) .AND. &
- (ZRIS(1:IMICRO)>0.0) .AND. (ZRRS(1:IMICRO)>0.0)
- WHERE( GWORK(1:IMICRO) )
-#ifndef MNH_BITREP
- ZZW1(1:IMICRO,3) = MIN( ZRIS(1:IMICRO),XICFRR * ZRIT(1:IMICRO) & ! RICFRRG
- * ZLBDAR(1:IMICRO)**XEXICFRR &
- * ZRHODREF(1:IMICRO)**(-XCEXVT) )
- ZZW1(1:IMICRO,4) = MIN( ZRRS(1:IMICRO),XRCFRI * ZCIT(1:IMICRO) & ! RRCFRIG
- * ZLBDAR(1:IMICRO)**XEXRCFRI &
- * ZRHODREF(1:IMICRO)**(-XCEXVT-1.) )
-#else
- ZZW1(1:IMICRO,3) = MIN( ZRIS(1:IMICRO),XICFRR * ZRIT(1:IMICRO) & ! RICFRRG
- * BR_POW(ZLBDAR(1:IMICRO),XEXICFRR) &
- * BR_POW(ZRHODREF(1:IMICRO),-XCEXVT) )
- ZZW1(1:IMICRO,4) = MIN( ZRRS(1:IMICRO),XRCFRI * ZCIT(1:IMICRO) & ! RRCFRIG
- * BR_POW(ZLBDAR(1:IMICRO),XEXRCFRI) &
- * BR_POW(ZRHODREF(1:IMICRO),-XCEXVT-1.) )
-#endif
- ZRIS(1:IMICRO) = ZRIS(1:IMICRO) - ZZW1(1:IMICRO,3)
- ZRRS(1:IMICRO) = ZRRS(1:IMICRO) - ZZW1(1:IMICRO,4)
- ZRGS(1:IMICRO) = ZRGS(1:IMICRO) + ZZW1(1:IMICRO,3)+ZZW1(1:IMICRO,4)
- ZTHS(1:IMICRO) = ZTHS(1:IMICRO) + ZZW1(1:IMICRO,4)*(ZLSFACT(1:IMICRO)-ZLVFACT(1:IMICRO)) ! f(L_f*RRCFRIG)
- END WHERE
-!$acc end kernels
- IF (LBUDGET_TH) THEN
-!$acc update self(ZTHS)
- CALL BUDGET (UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), 4,'CFRZ_BU_RTH')
- END IF
- IF (LBUDGET_RR) THEN
-!$acc update self(ZRRS)
- CALL BUDGET (UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 8,'CFRZ_BU_RRR')
- END IF
- IF (LBUDGET_RI) THEN
-!$acc update self(ZRIS)
- CALL BUDGET (UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 9,'CFRZ_BU_RRI')
- END IF
- IF (LBUDGET_RG) THEN
-!$acc update self(ZRGS)
- CALL BUDGET (UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 11,'CFRZ_BU_RRG')
- END IF
-!
-!* 6.2 compute the Dry growth case
-!
-!$acc kernels present(XRTMIN) &
-!$acc & present(ZZW1,GWORK,ZRGT,ZRCT,ZRCS,ZRIT,ZRIS,ZLBDAG,ZRHODREF,ZZW)
- ZZW1(:,:) = 0.0
- GWORK(1:IMICRO) = (ZRGT(1:IMICRO)>XRTMIN(6)) .AND. ((ZRCT(1:IMICRO)>XRTMIN(2) .AND. ZRCS(1:IMICRO)>0.0))
- WHERE( GWORK(1:IMICRO) )
-#ifndef MNH_BITREP
- ZZW(1:IMICRO) = ZLBDAG(1:IMICRO)**(XCXG-XDG-2.0) * ZRHODREF(1:IMICRO)**(-XCEXVT)
-#else
- ZZW(1:IMICRO) = BR_POW(ZLBDAG(1:IMICRO),XCXG-XDG-2.0) * BR_POW(ZRHODREF(1:IMICRO),-XCEXVT)
-#endif
- ZZW1(1:IMICRO,1) = MIN( ZRCS(1:IMICRO),XFCDRYG * ZRCT(1:IMICRO) * ZZW(1:IMICRO) ) ! RCDRYG
- END WHERE
- GWORK(1:IMICRO) = (ZRGT(1:IMICRO)>XRTMIN(6)) .AND. ((ZRIT(1:IMICRO)>XRTMIN(4) .AND. ZRIS(1:IMICRO)>0.0))
- WHERE( GWORK(1:IMICRO) )
-#ifndef MNH_BITREP
- ZZW(1:IMICRO) = ZLBDAG(1:IMICRO)**(XCXG-XDG-2.0) * ZRHODREF(1:IMICRO)**(-XCEXVT)
- ZZW1(1:IMICRO,2) = MIN( ZRIS(1:IMICRO),XFIDRYG * EXP( XCOLEXIG*(ZZT(1:IMICRO)-XTT) ) &
- * ZRIT(1:IMICRO) * ZZW(1:IMICRO) ) ! RIDRYG
-#else
- ZZW(1:IMICRO) = BR_POW(ZLBDAG(1:IMICRO),XCXG-XDG-2.0) * BR_POW(ZRHODREF(1:IMICRO),-XCEXVT)
- ZZW1(1:IMICRO,2) = MIN( ZRIS(1:IMICRO),XFIDRYG * BR_EXP( XCOLEXIG*(ZZT(1:IMICRO)-XTT) ) &
- * ZRIT(1:IMICRO) * ZZW(1:IMICRO) ) ! RIDRYG
-#endif
- END WHERE
-!
-!* 6.2.1 accretion of aggregates on the graupeln
-!
- GDRY(1:IMICRO) = (ZRST(1:IMICRO)>XRTMIN(5)) .AND. (ZRGT(1:IMICRO)>XRTMIN(6)) .AND. (ZRSS(1:IMICRO)>0.0)
-!$acc end kernels
-#ifndef _OPENACC
- IGDRY = COUNT( GDRY(1:IMICRO) )
-#else
- CALL COUNTJV1D_DEVICE( GDRY(1:IMICRO),I1,IGDRY)
-#endif
-!
- IF( IGDRY>0 ) THEN
-!
-!* 6.2.2 allocations
-!
- ALLOCATE(ZVEC1(IGDRY))
- ALLOCATE(ZVEC2(IGDRY))
- ALLOCATE(ZVEC3(IGDRY))
- ALLOCATE(IVEC1(IGDRY))
- ALLOCATE(IVEC2(IGDRY))
-!$acc data create(IVEC1,IVEC2,ZVEC1,ZVEC2,ZVEC3)
-!
-!* 6.2.3 select the (ZLBDAG,ZLBDAS) couplet
-!
-!$acc kernels present(XKER_SDRYG,XCOLEXSG,XCXG) &
-!$acc & present(IVEC1,IVEC2,ZVEC1,ZVEC2,ZVEC3,GDRY,ZZW1,ZRSS,ZZW,ZZT,ZLBDAS,ZLBDAG,ZRHODREF)
-#ifndef _OPENACC
- ZVEC1(1:IGDRY) = PACK( ZLBDAG(1:IMICRO),MASK=GDRY(1:IMICRO) )
- ZVEC2(1:IGDRY) = PACK( ZLBDAS(1:IMICRO),MASK=GDRY(1:IMICRO) )
-#else
- DO JL=1,IGDRY
- ZVEC1(JL) = ZLBDAG(I1(JL))
- ZVEC2(JL) = ZLBDAS(I1(JL))
- END DO
-#endif
-!
-!* 6.2.4 find the next lower indice for the ZLBDAG and for the ZLBDAS
-! in the geometrical set of (Lbda_g,Lbda_s) couplet use to
-! tabulate the SDRYG-kernel
-!
- ZVEC1(1:IGDRY) = MAX( 1.00001, MIN( FLOAT(NDRYLBDAG)-0.00001, &
-#ifndef MNH_BITREP
- XDRYINTP1G * LOG( ZVEC1(1:IGDRY) ) + XDRYINTP2G ) )
-#else
- XDRYINTP1G * BR_LOG( ZVEC1(1:IGDRY) ) + XDRYINTP2G ) )
-#endif
- IVEC1(1:IGDRY) = INT( ZVEC1(1:IGDRY) )
- ZVEC1(1:IGDRY) = ZVEC1(1:IGDRY) - FLOAT( IVEC1(1:IGDRY) )
-!
- ZVEC2(1:IGDRY) = MAX( 1.00001, MIN( FLOAT(NDRYLBDAS)-0.00001, &
-#ifndef MNH_BITREP
- XDRYINTP1S * LOG( ZVEC2(1:IGDRY) ) + XDRYINTP2S ) )
-#else
- XDRYINTP1S * BR_LOG( ZVEC2(1:IGDRY) ) + XDRYINTP2S ) )
-#endif
- IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) )
- ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - FLOAT( IVEC2(1:IGDRY) )
-!
-!* 6.2.5 perform the bilinear interpolation of the normalized
-! SDRYG-kernel
-!
-!$acc loop independent
- DO JJ = 1,IGDRY
- ZVEC3(JJ) = ( XKER_SDRYG(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_SDRYG(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * ZVEC1(JJ) &
- - ( XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * (ZVEC1(JJ) - 1.0)
- END DO
-#ifndef _OPENACC
- ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GDRY,FIELD=0.0 )
-#else
- ZZW(:) = 0.0
-!$acc loop independent
- DO JL=1,IGDRY
- ZZW(I1(JL)) = ZVEC3(JL)
- END DO
-#endif
-!
- WHERE( GDRY(1:IMICRO) )
-#ifndef MNH_BITREP
- ZZW1(1:IMICRO,3) = MIN( ZRSS(1:IMICRO),XFSDRYG*ZZW(1:IMICRO) & ! RSDRYG
- * EXP( XCOLEXSG*(ZZT(1:IMICRO)-XTT) ) &
- *( ZLBDAS(1:IMICRO)**(XCXS-XBS) )*( ZLBDAG(1:IMICRO)**XCXG ) &
- *( ZRHODREF(1:IMICRO)**(-XCEXVT-1.) ) &
- *( XLBSDRYG1/( ZLBDAG(1:IMICRO)**2 ) + &
- XLBSDRYG2/( ZLBDAG(1:IMICRO) * ZLBDAS(1:IMICRO) ) + &
- XLBSDRYG3/( ZLBDAS(1:IMICRO)**2) ) )
-#else
- ZZW1(1:IMICRO,3) = MIN( ZRSS(1:IMICRO),XFSDRYG*ZZW(1:IMICRO) & ! RSDRYG
- * BR_EXP( XCOLEXSG*(ZZT(1:IMICRO)-XTT) ) &
- *( BR_POW(ZLBDAS(1:IMICRO),XCXS-XBS) )*( BR_POW(ZLBDAG(1:IMICRO),XCXG) ) &
- *( BR_POW(ZRHODREF(1:IMICRO),-XCEXVT-1.) ) &
- *( XLBSDRYG1/( BR_P2(ZLBDAG(1:IMICRO)) ) + &
- XLBSDRYG2/( ZLBDAG(1:IMICRO) * ZLBDAS(1:IMICRO) ) + &
- XLBSDRYG3/( BR_P2(ZLBDAS(1:IMICRO))) ) )
-#endif
- END WHERE
-!$acc end kernels
-!$acc end data
- DEALLOCATE(IVEC2)
- DEALLOCATE(IVEC1)
- DEALLOCATE(ZVEC3)
- DEALLOCATE(ZVEC2)
- DEALLOCATE(ZVEC1)
- END IF
-!
-!* 6.2.6 accretion of raindrops on the graupeln
-!
-!$acc kernels present(GDRY,XRTMIN)
- GDRY(1:IMICRO) = (ZRRT(1:IMICRO)>XRTMIN(3)) .AND. (ZRGT(1:IMICRO)>XRTMIN(6)) .AND. (ZRRS(1:IMICRO)>0.0)
-!$acc end kernels
-#ifndef _OPENACC
- IGDRY = COUNT( GDRY(1:IMICRO) )
-#else
- CALL COUNTJV1D_DEVICE( GDRY(1:IMICRO),I1,IGDRY)
-#endif
-!
- IF( IGDRY>0 ) THEN
-!
-!* 6.2.7 allocations
-!
- ALLOCATE(ZVEC1(IGDRY))
- ALLOCATE(ZVEC2(IGDRY))
- ALLOCATE(ZVEC3(IGDRY))
- ALLOCATE(IVEC1(IGDRY))
- ALLOCATE(IVEC2(IGDRY))
-!$acc data create(IVEC1,IVEC2,ZVEC1,ZVEC2,ZVEC3)
-!
-!* 6.2.8 select the (ZLBDAG,ZLBDAR) couplet
-!
-!$acc kernels present(XKER_RDRYG,XCXG) &
-!$acc & present(IVEC1,IVEC2,ZVEC1,ZVEC2,ZVEC3,GDRY,ZZW1,ZRRS,ZZW,ZLBDAR,ZLBDAG,ZRHODREF)
-#ifndef _OPENACC
- ZVEC1(:) = PACK( ZLBDAG(:),MASK=GDRY(:) )
- ZVEC2(:) = PACK( ZLBDAR(:),MASK=GDRY(:) )
-#else
- DO JL=1,IGDRY
- ZVEC1(JL) = ZLBDAG(I1(JL))
- ZVEC2(JL) = ZLBDAR(I1(JL))
- END DO
-#endif
-!
-!* 6.2.9 find the next lower indice for the ZLBDAG and for the ZLBDAR
-! in the geometrical set of (Lbda_g,Lbda_r) couplet use to
-! tabulate the RDRYG-kernel
-!
- ZVEC1(1:IGDRY) = MAX( 1.00001, MIN( FLOAT(NDRYLBDAG)-0.00001, &
-#ifndef MNH_BITREP
- XDRYINTP1G * LOG( ZVEC1(1:IGDRY) ) + XDRYINTP2G ) )
-#else
- XDRYINTP1G * BR_LOG( ZVEC1(1:IGDRY) ) + XDRYINTP2G ) )
-#endif
- IVEC1(1:IGDRY) = INT( ZVEC1(1:IGDRY) )
- ZVEC1(1:IGDRY) = ZVEC1(1:IGDRY) - FLOAT( IVEC1(1:IGDRY) )
-!
- ZVEC2(1:IGDRY) = MAX( 1.00001, MIN( FLOAT(NDRYLBDAR)-0.00001, &
-#ifndef MNH_BITREP
- XDRYINTP1R * LOG( ZVEC2(1:IGDRY) ) + XDRYINTP2R ) )
-#else
- XDRYINTP1R * BR_LOG( ZVEC2(1:IGDRY) ) + XDRYINTP2R ) )
-#endif
- IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) )
- ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - FLOAT( IVEC2(1:IGDRY) )
-!
-!* 6.2.10 perform the bilinear interpolation of the normalized
-! RDRYG-kernel
-!
-!$acc loop independent
- DO JJ = 1,IGDRY
- ZVEC3(JJ) = ( XKER_RDRYG(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_RDRYG(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * ZVEC1(JJ) &
- - ( XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * (ZVEC1(JJ) - 1.0)
- END DO
-#ifndef _OPENACC
- ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GDRY,FIELD=0.0 )
-#else
- ZZW(:) = 0.0
-!$acc loop independent
- DO JL=1,IGDRY
- ZZW(I1(JL)) = ZVEC3(JL)
- END DO
-#endif
-!
- WHERE( GDRY(1:IMICRO) )
-#ifndef MNH_BITREP
- ZZW1(1:IMICRO,4) = MIN( ZRRS(1:IMICRO),XFRDRYG*ZZW(1:IMICRO) & ! RRDRYG
- *( ZLBDAR(1:IMICRO)**(-4) )*( ZLBDAG(1:IMICRO)**XCXG ) &
- *( ZRHODREF(1:IMICRO)**(-XCEXVT-1.) ) &
- *( XLBRDRYG1/( ZLBDAG(1:IMICRO)**2 ) + &
- XLBRDRYG2/( ZLBDAG(1:IMICRO) * ZLBDAR(1:IMICRO) ) + &
- XLBRDRYG3/( ZLBDAR(1:IMICRO)**2) ) )
-#else
- ZZW1(1:IMICRO,4) = MIN( ZRRS(1:IMICRO),XFRDRYG*ZZW(1:IMICRO) & ! RRDRYG
- *( BR_POW(ZLBDAR(1:IMICRO),-4.) )*( BR_POW(ZLBDAG(1:IMICRO),XCXG) ) &
- *( BR_POW(ZRHODREF(1:IMICRO),-XCEXVT-1.) ) &
- *( XLBRDRYG1/( BR_P2(ZLBDAG(1:IMICRO)) ) + &
- XLBRDRYG2/( ZLBDAG(1:IMICRO) * ZLBDAR(1:IMICRO) ) + &
- XLBRDRYG3/( BR_P2(ZLBDAR(1:IMICRO))) ) )
-#endif
- END WHERE
-!$acc end kernels
-!$acc end data
- DEALLOCATE(IVEC2)
- DEALLOCATE(IVEC1)
- DEALLOCATE(ZVEC3)
- DEALLOCATE(ZVEC2)
- DEALLOCATE(ZVEC1)
- END IF
-!
-!$acc end data
- DEALLOCATE(GDRY)
- DEALLOCATE(I1)
-!
-!$acc kernels present(GWORK,ZZW,ZRDRYG,ZRWETG,ZRGT,ZZW1,ZRIS,ZRSS,ZRVT,ZZT,ZPRES,ZKA,ZDV,ZLBDAG,ZCJ,ZRHODREF,XRTMIN,XEX0DEPG,XEX1DEPG)
- ZRDRYG(1:IMICRO) = ZZW1(1:IMICRO,1) + ZZW1(1:IMICRO,2) + ZZW1(1:IMICRO,3) + ZZW1(1:IMICRO,4)
-!
-!* 6.3 compute the Wet growth case
-!
- ZZW(1:IMICRO) = 0.0
- ZRWETG(1:IMICRO) = 0.0
- WHERE( ZRGT(1:IMICRO)>XRTMIN(6) )
-#ifndef MNH_BITREP
- ZZW1(1:IMICRO,5) = MIN( ZRIS(1:IMICRO), &
- ZZW1(1:IMICRO,2) / (XCOLIG*EXP(XCOLEXIG*(ZZT(1:IMICRO)-XTT)) ) ) ! RIWETG
- ZZW1(1:IMICRO,6) = MIN( ZRSS(1:IMICRO), &
- ZZW1(1:IMICRO,3) / (XCOLSG*EXP(XCOLEXSG*(ZZT(1:IMICRO)-XTT)) ) ) ! RSWETG
-#else
- ZZW1(1:IMICRO,5) = MIN( ZRIS(1:IMICRO), &
- ZZW1(1:IMICRO,2) / (XCOLIG*BR_EXP(XCOLEXIG*(ZZT(1:IMICRO)-XTT)) ) ) ! RIWETG
- ZZW1(1:IMICRO,6) = MIN( ZRSS(1:IMICRO), &
- ZZW1(1:IMICRO,3) / (XCOLSG*BR_EXP(XCOLEXSG*(ZZT(1:IMICRO)-XTT)) ) ) ! RSWETG
-#endif
-!
- ZZW(1:IMICRO) = ZRVT(1:IMICRO)*ZPRES(1:IMICRO)/((XMV/XMD)+ZRVT(1:IMICRO)) ! Vapor pressure
- ZZW(1:IMICRO) = ZKA(1:IMICRO)*(XTT-ZZT(1:IMICRO)) + &
- ( ZDV(1:IMICRO)*(XLVTT + ( XCPV - XCL ) * ( ZZT(1:IMICRO) - XTT )) &
- *(XESTT-ZZW(1:IMICRO))/(XRV*ZZT(1:IMICRO)) )
-!
-! compute RWETG
-!
-#ifndef MNH_BITREP
- ZRWETG(1:IMICRO)=MAX( 0.0, &
- ( ZZW(1:IMICRO) * ( X0DEPG* ZLBDAG(1:IMICRO)**XEX0DEPG + &
- X1DEPG*ZCJ(1:IMICRO)*ZLBDAG(1:IMICRO)**XEX1DEPG ) + &
- ( ZZW1(1:IMICRO,5)+ZZW1(1:IMICRO,6) ) * &
- ( ZRHODREF(1:IMICRO)*(XLMTT+(XCI-XCL)*(XTT-ZZT(1:IMICRO))) ) ) / &
- ( ZRHODREF(1:IMICRO)*(XLMTT-XCL*(XTT-ZZT(1:IMICRO))) ) )
-#else
- ZRWETG(1:IMICRO)=MAX( 0.0, &
- ( ZZW(1:IMICRO) * ( X0DEPG* BR_POW(ZLBDAG(1:IMICRO),XEX0DEPG) + &
- X1DEPG*ZCJ(1:IMICRO)*BR_POW(ZLBDAG(1:IMICRO),XEX1DEPG) ) + &
- ( ZZW1(1:IMICRO,5)+ZZW1(1:IMICRO,6) ) * &
- ( ZRHODREF(1:IMICRO)*(XLMTT+(XCI-XCL)*(XTT-ZZT(1:IMICRO))) ) ) / &
- ( ZRHODREF(1:IMICRO)*(XLMTT-XCL*(XTT-ZZT(1:IMICRO))) ) )
-#endif
- END WHERE
-!
-!* 6.4 Select Wet or Dry case
-!
- ZZW(1:IMICRO) = 0.0
- IF ( KRR == 7 ) THEN
- GWORK(1:IMICRO) = ZRGT(1:IMICRO)>XRTMIN(6) .AND. ZZT(1:IMICRO)<XTT .AND. & ! Wet
- ZRDRYG(1:IMICRO)>=ZRWETG(1:IMICRO) .AND. ZRWETG(1:IMICRO)>0.0 ! case
- WHERE( GWORK(1:IMICRO) )
- ZZW(1:IMICRO) = ZRWETG(1:IMICRO) - ZZW1(1:IMICRO,5) - ZZW1(1:IMICRO,6) ! RCWETG+RRWETG
-!
-! limitation of the available rainwater mixing ratio (RRWETH < RRS !)
-!
- ZZW1(1:IMICRO,7) = MAX( 0.0,MIN( ZZW(1:IMICRO),ZRRS(1:IMICRO)+ZZW1(1:IMICRO,1) ) )
- ZUSW(1:IMICRO) = ZZW1(1:IMICRO,7) / ZZW(1:IMICRO)
- ZZW1(1:IMICRO,5) = ZZW1(1:IMICRO,5)*ZUSW(1:IMICRO)
- ZZW1(1:IMICRO,6) = ZZW1(1:IMICRO,6)*ZUSW(1:IMICRO)
- ZRWETG(1:IMICRO) = ZZW1(1:IMICRO,7) + ZZW1(1:IMICRO,5) + ZZW1(1:IMICRO,6)
-!
- ZRCS(1:IMICRO) = ZRCS(1:IMICRO) - ZZW1(1:IMICRO,1)
- ZRIS(1:IMICRO) = ZRIS(1:IMICRO) - ZZW1(1:IMICRO,5)
- ZRSS(1:IMICRO) = ZRSS(1:IMICRO) - ZZW1(1:IMICRO,6)
-!
-! assume a linear percent of conversion of graupel into hail
-!
- ZRGS(1:IMICRO) = ZRGS(1:IMICRO) + ZRWETG(1:IMICRO) ! Wet growth
- ZZW(1:IMICRO) = ZRGS(1:IMICRO)*ZRDRYG(1:IMICRO)/(ZRWETG(1:IMICRO)+ZRDRYG(1:IMICRO)) ! and
- ZRGS(1:IMICRO) = ZRGS(1:IMICRO) - ZZW(1:IMICRO) ! partial conversion
- ZRHS(1:IMICRO) = ZRHS(1:IMICRO) + ZZW(1:IMICRO) ! of the graupel into hail
-!
- ZRRS(1:IMICRO) = MAX( 0.0,ZRRS(1:IMICRO) - ZZW1(1:IMICRO,7) + ZZW1(1:IMICRO,1) )
- ZTHS(1:IMICRO) = ZTHS(1:IMICRO) + ZZW1(1:IMICRO,7)*(ZLSFACT(1:IMICRO)-ZLVFACT(1:IMICRO))
- ! f(L_f*(RCWETG+RRWETG))
- END WHERE
- ELSE IF( KRR == 6 ) THEN
- GWORK(1:IMICRO) = ZRGT(1:IMICRO)>XRTMIN(6) .AND. ZZT(1:IMICRO)<XTT .AND. & ! Wet
- ZRDRYG(1:IMICRO)>=ZRWETG(1:IMICRO) .AND. ZRWETG(1:IMICRO)>0.0 ! case
- WHERE( GWORK(1:IMICRO) )
- ZZW(1:IMICRO) = ZRWETG(1:IMICRO)
- ZRCS(1:IMICRO) = ZRCS(1:IMICRO) - ZZW1(1:IMICRO,1)
- ZRIS(1:IMICRO) = ZRIS(1:IMICRO) - ZZW1(1:IMICRO,5)
- ZRSS(1:IMICRO) = ZRSS(1:IMICRO) - ZZW1(1:IMICRO,6)
- ZRGS(1:IMICRO) = ZRGS(1:IMICRO) + ZZW(1:IMICRO)
-!
- ZRRS(1:IMICRO) = ZRRS(1:IMICRO) - ZZW(1:IMICRO) + ZZW1(1:IMICRO,5) + ZZW1(1:IMICRO,6) + ZZW1(1:IMICRO,1)
- ZTHS(1:IMICRO) = ZTHS(1:IMICRO) + (ZZW(1:IMICRO)-ZZW1(1:IMICRO,5)-ZZW1(1:IMICRO,6))*(ZLSFACT(1:IMICRO)-ZLVFACT(1:IMICRO))
- ! f(L_f*(RCWETG+RRWETG))
- END WHERE
- END IF
-!$acc end kernels
- IF (LBUDGET_TH) THEN
-!$acc update self(ZTHS)
- CALL BUDGET (UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),4,'WETG_BU_RTH')
- END IF
- IF (LBUDGET_RC) THEN
-!$acc update self(ZRCS)
- CALL BUDGET (UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 7,'WETG_BU_RRC')
- END IF
- IF (LBUDGET_RR) THEN
-!$acc update self(ZRRS)
- CALL BUDGET (UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 8,'WETG_BU_RRR')
- END IF
- IF (LBUDGET_RI) THEN
-!$acc update self(ZRIS)
- CALL BUDGET (UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 9,'WETG_BU_RRI')
- END IF
- IF (LBUDGET_RS) THEN
-!$acc update self(ZRSS)
- CALL BUDGET (UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 10,'WETG_BU_RRS')
- END IF
- IF (LBUDGET_RG) THEN
-!$acc update self(ZRGS)
- CALL BUDGET (UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 11,'WETG_BU_RRG')
- END IF
- IF ( KRR == 7 ) THEN
- IF (LBUDGET_RH) THEN
-!$acc update self(ZRHS)
- CALL BUDGET(UNPACK(ZRHS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 12,'WETG_BU_RRH')
- END IF
- END IF
-!
-!$acc kernels present(GWORK,ZRDRYG,ZRWETG,XRTMIN)
- GWORK(1:IMICRO) = ZRGT(1:IMICRO)>XRTMIN(6) .AND. ZZT(1:IMICRO)<XTT .AND. &
- ZRDRYG(1:IMICRO)<ZRWETG(1:IMICRO) .AND. ZRDRYG(1:IMICRO)>0.0 ! Dry
- WHERE( GWORK(1:IMICRO) )
- ZRCS(1:IMICRO) = ZRCS(1:IMICRO) - ZZW1(1:IMICRO,1)
- ZRIS(1:IMICRO) = ZRIS(1:IMICRO) - ZZW1(1:IMICRO,2)
- ZRSS(1:IMICRO) = ZRSS(1:IMICRO) - ZZW1(1:IMICRO,3)
- ZRRS(1:IMICRO) = ZRRS(1:IMICRO) - ZZW1(1:IMICRO,4)
- ZRGS(1:IMICRO) = ZRGS(1:IMICRO) + ZRDRYG(1:IMICRO)
- ZTHS(1:IMICRO) = ZTHS(1:IMICRO) + (ZZW1(1:IMICRO,1)+ZZW1(1:IMICRO,4))*(ZLSFACT(1:IMICRO)-ZLVFACT(1:IMICRO)) !
- ! f(L_f*(RCDRYG+RRDRYG))
- END WHERE
-!$acc end kernels
- IF (LBUDGET_TH) THEN
-!$acc update self(ZTHS)
- CALL BUDGET (UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),4,'DRYG_BU_RTH')
- END IF
- IF (LBUDGET_RC) THEN
-!$acc update self(ZRCS)
- CALL BUDGET (UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 7,'DRYG_BU_RRC')
- END IF
- IF (LBUDGET_RR) THEN
-!$acc update self(ZRRS)
- CALL BUDGET (UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 8,'DRYG_BU_RRR')
- END IF
- IF (LBUDGET_RI) THEN
-!$acc update self(ZRIS)
- CALL BUDGET (UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 9,'DRYG_BU_RRI')
- END IF
- IF (LBUDGET_RS) THEN
-!$acc update self(ZRSS)
- CALL BUDGET (UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 10,'DRYG_BU_RRS')
- END IF
- IF (LBUDGET_RG) THEN
-!$acc update self(ZRGS)
- CALL BUDGET (UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 11,'DRYG_BU_RRG')
- END IF
-!
-! WHERE ( ZZT(:) > XTT ) ! RSWETG case only
-! ZRSS(:) = ZRSS(:) - ZZW1(:,6)
-! ZRGS(:) = ZRGS(:) + ZZW1(:,6)
-! END WHERE
-!
-!* 6.5 Melting of the graupeln
-!
-!$acc kernels present(GWORK,ZZW,ZRRS,ZRGT,ZTHS,ZRGS,ZZW1,ZRHODREF,ZRVT,ZZT,ZPRES, &
-!$acc & ZKA,ZDV,ZLBDAG,ZCJ,ZLSFACT,ZLVFACT,XRTMIN,XEX0DEPG,XEX1DEPG)
- ZZW(1:IMICRO) = 0.0
- GWORK(1:IMICRO) = (ZRGT(1:IMICRO)>XRTMIN(6)) .AND. (ZRGS(1:IMICRO)>0.0) .AND. (ZZT(1:IMICRO)>XTT)
- WHERE( GWORK(1:IMICRO) )
- ZZW(1:IMICRO) = ZRVT(1:IMICRO)*ZPRES(1:IMICRO)/((XMV/XMD)+ZRVT(1:IMICRO)) ! Vapor pressure
- ZZW(1:IMICRO) = ZKA(1:IMICRO)*(XTT-ZZT(1:IMICRO)) + &
- ( ZDV(1:IMICRO)*(XLVTT + ( XCPV - XCL ) * ( ZZT(1:IMICRO) - XTT )) &
- *(XESTT-ZZW(1:IMICRO))/(XRV*ZZT(1:IMICRO)) )
-!
-! compute RGMLTR
-!
-#ifndef MNH_BITREP
- ZZW(1:IMICRO) = MIN( ZRGS(1:IMICRO), MAX( 0.0,( -ZZW(1:IMICRO) * &
- ( X0DEPG* ZLBDAG(1:IMICRO)**XEX0DEPG + &
- X1DEPG*ZCJ(1:IMICRO)*ZLBDAG(1:IMICRO)**XEX1DEPG ) - &
- ( ZZW1(:,1)+ZZW1(:,4) ) * &
- ( ZRHODREF(1:IMICRO)*XCL*(XTT-ZZT(1:IMICRO))) ) / &
- ( ZRHODREF(1:IMICRO)*XLMTT ) ) )
-#else
- ZZW(1:IMICRO) = MIN( ZRGS(1:IMICRO), MAX( 0.0,( -ZZW(1:IMICRO) * &
- ( X0DEPG* BR_POW(ZLBDAG(1:IMICRO),XEX0DEPG) + &
- X1DEPG*ZCJ(1:IMICRO)*BR_POW(ZLBDAG(1:IMICRO),XEX1DEPG) ) - &
- ( ZZW1(:,1)+ZZW1(:,4) ) * &
- ( ZRHODREF(1:IMICRO)*XCL*(XTT-ZZT(1:IMICRO))) ) / &
- ( ZRHODREF(1:IMICRO)*XLMTT ) ) )
-#endif
- ZRRS(1:IMICRO) = ZRRS(1:IMICRO) + ZZW(1:IMICRO)
- ZRGS(1:IMICRO) = ZRGS(1:IMICRO) - ZZW(1:IMICRO)
- ZTHS(1:IMICRO) = ZTHS(1:IMICRO) - ZZW(1:IMICRO)*(ZLSFACT(1:IMICRO)-ZLVFACT(1:IMICRO)) ! f(L_f*(-RGMLTR))
- END WHERE
-!$acc end kernels
- IF (LBUDGET_TH) THEN
-!$acc update self(ZTHS)
- CALL BUDGET (UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),4,'GMLT_BU_RTH')
- END IF
- IF (LBUDGET_RR) THEN
-!$acc update self(ZRRS)
- CALL BUDGET (UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 8,'GMLT_BU_RRR')
- END IF
- IF (LBUDGET_RG) THEN
-!$acc update self(ZRGS)
- CALL BUDGET (UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 11,'GMLT_BU_RRG')
- END IF
-!
-!
- END SUBROUTINE RAIN_ICE_FAST_RG
-!
-!-------------------------------------------------------------------------------
-!
-!
- SUBROUTINE RAIN_ICE_FAST_RH
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!-------------------------------------------------------------------------------
-!
-#ifdef _OPENACC
-PRINT *,'OPENACC: RAIN_ICE_FAST_RH not yet implemented'
-CALL ABORT
-#endif
- ALLOCATE(GHAIL(IMICRO))
- GHAIL(:) = ZRHT(:)>XRTMIN(7)
- IHAIL = COUNT(GHAIL(:))
-!
- IF( IHAIL>0 ) THEN
-!
-!* 7.2 compute the Wet growth of hail
-!
- WHERE ( GHAIL(:) )
- ZLBDAH(:) = XLBH*( ZRHODREF(:)*MAX( ZRHT(:),XRTMIN(7) ) )**XLBEXH
- END WHERE
-!
- ZZW1(:,:) = 0.0
- WHERE( GHAIL(:) .AND. ((ZRCT(:)>XRTMIN(2) .AND. ZRCS(:)>0.0)) )
- ZZW(:) = ZLBDAH(:)**(XCXH-XDH-2.0) * ZRHODREF(:)**(-XCEXVT)
- ZZW1(:,1) = MIN( ZRCS(:),XFWETH * ZRCT(:) * ZZW(:) ) ! RCWETH
- END WHERE
- WHERE( GHAIL(:) .AND. ((ZRIT(:)>XRTMIN(4) .AND. ZRIS(:)>0.0)) )
- ZZW(:) = ZLBDAH(:)**(XCXH-XDH-2.0) * ZRHODREF(:)**(-XCEXVT)
- ZZW1(:,2) = MIN( ZRIS(:),XFWETH * ZRIT(:) * ZZW(:) ) ! RIWETH
- END WHERE
-!
-!* 7.2.1 accretion of aggregates on the hailstones
-!
- ALLOCATE(GWET(IMICRO))
- GWET(:) = GHAIL(:) .AND. (ZRST(:)>XRTMIN(5) .AND. ZRSS(:)>0.0)
- IGWET = COUNT( GWET(:) )
-!
- IF( IGWET>0 ) THEN
-!
-!* 7.2.2 allocations
-!
- ALLOCATE(ZVEC1(IGWET))
- ALLOCATE(ZVEC2(IGWET))
- ALLOCATE(ZVEC3(IGWET))
- ALLOCATE(IVEC1(IGWET))
- ALLOCATE(IVEC2(IGWET))
-!$acc data create(IVEC1,IVEC2,ZVEC1,ZVEC2,ZVEC3)
-!
-!* 7.2.3 select the (ZLBDAH,ZLBDAS) couplet
-!
- ZVEC1(:) = PACK( ZLBDAH(:),MASK=GWET(:) )
- ZVEC2(:) = PACK( ZLBDAS(:),MASK=GWET(:) )
-!
-!* 7.2.4 find the next lower indice for the ZLBDAG and for the ZLBDAS
-! in the geometrical set of (Lbda_h,Lbda_s) couplet use to
-! tabulate the SWETH-kernel
-!
- ZVEC1(1:IGWET) = MAX( 1.00001, MIN( FLOAT(NWETLBDAH)-0.00001, &
-#ifndef MNH_BITREP
- XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) )
-#else
- XWETINTP1H * BR_LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) )
-#endif
- IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
- ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - FLOAT( IVEC1(1:IGWET) )
-!
- ZVEC2(1:IGWET) = MAX( 1.00001, MIN( FLOAT(NWETLBDAS)-0.00001, &
-#ifndef MNH_BITREP
- XWETINTP1S * LOG( ZVEC2(1:IGWET) ) + XWETINTP2S ) )
-#else
- XWETINTP1S * BR_LOG( ZVEC2(1:IGWET) ) + XWETINTP2S ) )
-#endif
- IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
- ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - FLOAT( IVEC2(1:IGWET) )
-!
-!* 7.2.5 perform the bilinear interpolation of the normalized
-! SWETH-kernel
-!
- DO JJ = 1,IGWET
- ZVEC3(JJ) = ( XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * ZVEC1(JJ) &
- - ( XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * (ZVEC1(JJ) - 1.0)
- END DO
- ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GWET,FIELD=0.0 )
-!
- WHERE( GWET(:) )
-#ifndef MNH_BITREP
- ZZW1(:,3) = MIN( ZRSS(:),XFSWETH*ZZW(:) & ! RSWETH
- *( ZLBDAS(:)**(XCXS-XBS) )*( ZLBDAH(:)**XCXH ) &
- *( ZRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBSWETH1/( ZLBDAH(:)**2 ) + &
- XLBSWETH2/( ZLBDAH(:) * ZLBDAS(:) ) + &
- XLBSWETH3/( ZLBDAS(:)**2) ) )
-#else
- ZZW1(:,3) = MIN( ZRSS(:),XFSWETH*ZZW(:) & ! RSWETH
- *( ZLBDAS(:)**(XCXS-XBS) )*( ZLBDAH(:)**XCXH ) &
- *( ZRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBSWETH1/( BR_P2(ZLBDAH(:)) ) + &
- XLBSWETH2/( ZLBDAH(:) * ZLBDAS(:) ) + &
- XLBSWETH3/( BR_P2(ZLBDAS(:))) ) )
-#endif
- END WHERE
-!$acc end data
- DEALLOCATE(IVEC2)
- DEALLOCATE(IVEC1)
- DEALLOCATE(ZVEC3)
- DEALLOCATE(ZVEC2)
- DEALLOCATE(ZVEC1)
- END IF
-!
-!* 7.2.6 accretion of graupeln on the hailstones
-!
- GWET(:) = GHAIL(:) .AND. (ZRGT(:)>XRTMIN(6) .AND. ZRGS(:)>0.0)
- IGWET = COUNT( GWET(:) )
-!
- IF( IGWET>0 ) THEN
-!
-!* 7.2.7 allocations
-!
- ALLOCATE(ZVEC1(IGWET))
- ALLOCATE(ZVEC2(IGWET))
- ALLOCATE(ZVEC3(IGWET))
- ALLOCATE(IVEC1(IGWET))
- ALLOCATE(IVEC2(IGWET))
-!$acc data create(IVEC1,IVEC2,ZVEC1,ZVEC2,ZVEC3)
-!
-!* 7.2.8 select the (ZLBDAH,ZLBDAG) couplet
-!
- ZVEC1(:) = PACK( ZLBDAH(:),MASK=GWET(:) )
- ZVEC2(:) = PACK( ZLBDAG(:),MASK=GWET(:) )
-!
-!* 7.2.9 find the next lower indice for the ZLBDAH and for the ZLBDAG
-! in the geometrical set of (Lbda_h,Lbda_g) couplet use to
-! tabulate the GWETH-kernel
-!
- ZVEC1(1:IGWET) = MAX( 1.00001, MIN( FLOAT(NWETLBDAG)-0.00001, &
-#ifndef MNH_BITREP
- XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) )
-#else
- XWETINTP1H * BR_LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) )
-#endif
- IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
- ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - FLOAT( IVEC1(1:IGWET) )
-!
- ZVEC2(1:IGWET) = MAX( 1.00001, MIN( FLOAT(NWETLBDAG)-0.00001, &
-#ifndef MNH_BITREP
- XWETINTP1G * LOG( ZVEC2(1:IGWET) ) + XWETINTP2G ) )
-#else
- XWETINTP1G * BR_LOG( ZVEC2(1:IGWET) ) + XWETINTP2G ) )
-#endif
- IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
- ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - FLOAT( IVEC2(1:IGWET) )
-!
-!* 7.2.10 perform the bilinear interpolation of the normalized
-! GWETH-kernel
-!
- DO JJ = 1,IGWET
- ZVEC3(JJ) = ( XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * ZVEC1(JJ) &
- - ( XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * (ZVEC1(JJ) - 1.0)
- END DO
- ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GWET,FIELD=0.0 )
-!
- WHERE( GWET(:) )
-#ifndef MNH_BITREP
- ZZW1(:,5) = MAX(MIN( ZRGS(:),XFGWETH*ZZW(:) & ! RGWETH
- *( ZLBDAG(:)**(XCXG-XBG) )*( ZLBDAH(:)**XCXH ) &
- *( ZRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBGWETH1/( ZLBDAH(:)**2 ) + &
- XLBGWETH2/( ZLBDAH(:) * ZLBDAG(:) ) + &
- XLBGWETH3/( ZLBDAG(:)**2) ) ),0. )
-#else
- ZZW1(:,5) = MAX(MIN( ZRGS(:),XFGWETH*ZZW(:) & ! RGWETH
- *( ZLBDAG(:)**(XCXG-XBG) )*( ZLBDAH(:)**XCXH ) &
- *( ZRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBGWETH1/( BR_P2(ZLBDAH(:)) ) + &
- XLBGWETH2/( ZLBDAH(:) * ZLBDAG(:) ) + &
- XLBGWETH3/( BR_P2(ZLBDAG(:))) ) ),0. )
-#endif
- END WHERE
-!$acc end data
- DEALLOCATE(IVEC2)
- DEALLOCATE(IVEC1)
- DEALLOCATE(ZVEC3)
- DEALLOCATE(ZVEC2)
- DEALLOCATE(ZVEC1)
- END IF
- DEALLOCATE(GWET)
-!
-!* 7.3 compute the Wet growth of hail
-!
- ZZW(:) = 0.0
- WHERE( GHAIL(:) .AND. ZZT(:)<XTT )
- ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure
- ZZW(:) = ZKA(:)*(XTT-ZZT(:)) + &
- ( ZDV(:)*(XLVTT + ( XCPV - XCL ) * ( ZZT(:) - XTT )) &
- *(XESTT-ZZW(:))/(XRV*ZZT(:)) )
-!
-! compute RWETH
-!
- ZZW(:) = MAX(0., ( ZZW(:) * ( X0DEPH* ZLBDAH(:)**XEX0DEPH + &
- X1DEPH*ZCJ(:)*ZLBDAH(:)**XEX1DEPH ) + &
- ( ZZW1(:,2)+ZZW1(:,3)+ZZW1(:,5) ) * &
- ( ZRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-ZZT(:))) ) ) / &
- ( ZRHODREF(:)*(XLMTT-XCL*(XTT-ZZT(:))) ) )
-!
- ZZW1(:,6) = MAX( ZZW(:) - ZZW1(:,2) - ZZW1(:,3) - ZZW1(:,5),0.) ! RCWETH+RRWETH
- END WHERE
- WHERE ( GHAIL(:) .AND. ZZT(:)<XTT .AND. ZZW1(:,6)/=0.)
-!
-! limitation of the available rainwater mixing ratio (RRWETH < RRS !)
-!
- ZZW1(:,4) = MAX( 0.0,MIN( ZZW1(:,6),ZRRS(:)+ZZW1(:,1) ) )
- ZUSW(:) = ZZW1(:,4) / ZZW1(:,6)
- ZZW1(:,2) = ZZW1(:,2)*ZUSW(:)
- ZZW1(:,3) = ZZW1(:,3)*ZUSW(:)
- ZZW1(:,5) = ZZW1(:,5)*ZUSW(:)
- ZZW(:) = ZZW1(:,4) + ZZW1(:,2) + ZZW1(:,3) + ZZW1(:,5)
-!
-!* 7.1.6 integrate the Wet growth of hail
-!
- ZRCS(:) = ZRCS(:) - ZZW1(:,1)
- ZRIS(:) = ZRIS(:) - ZZW1(:,2)
- ZRSS(:) = ZRSS(:) - ZZW1(:,3)
- ZRGS(:) = ZRGS(:) - ZZW1(:,5)
- ZRHS(:) = ZRHS(:) + ZZW(:)
- ZRRS(:) = MAX( 0.0,ZRRS(:) - ZZW1(:,4) + ZZW1(:,1) )
- ZTHS(:) = ZTHS(:) + ZZW1(:,4)*(ZLSFACT(:)-ZLVFACT(:))
- ! f(L_f*(RCWETH+RRWETH))
- END WHERE
- 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')
-!
-!
-! ici LRECONVH et un flag pour autoriser une reconversion partielle de
-!la grele en gresil
-!
-! IF( IHAIL>0 ) THEN
-!
-!UPG_CD
-!
-!
-!* 7.45 Conversion of the hailstones into graupel
-!
-! XDUMMY6=0.01E-3
-! XDUMMY7=0.001E-3
-! WHERE( ZRHT(:)<XDUMMY6 .AND. ZRCT(:)<XDUMMY7 .AND. ZZT(:)<XTT )
-! ZZW(:) = MIN( 1.0,MAX( 0.0,1.0-(ZRCT(:)/XDUMMY7) ) )
-!
-! assume a linear percent conversion rate of hail into graupel
-!
-! ZZW(:) = ZRHS(:)*ZZW(:)
-! ZRGS(:) = ZRGS(:) + ZZW(:) ! partial conversion
-! ZRHS(:) = ZRHS(:) - ZZW(:) ! of hail into graupel
-!
-! END WHERE
-! END IF
-
-
-
-
- IF( IHAIL>0 ) THEN
-!
-!* 7.5 Melting of the hailstones
-!
- ZZW(:) = 0.0
- WHERE( GHAIL(:) .AND. (ZRHS(:)>0.0) .AND. (ZZT(:)>XTT) )
- ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure
- ZZW(:) = ZKA(:)*(XTT-ZZT(:)) + &
- ( ZDV(:)*(XLVTT + ( XCPV - XCL ) * ( ZZT(:) - XTT )) &
- *(XESTT-ZZW(:))/(XRV*ZZT(:)) )
-!
-! compute RHMLTR
-!
- ZZW(:) = MIN( ZRHS(:), MAX( 0.0,( -ZZW(:) * &
- ( X0DEPH* ZLBDAH(:)**XEX0DEPH + &
- X1DEPH*ZCJ(:)*ZLBDAH(:)**XEX1DEPH ) - &
- ZZW1(:,6)*( ZRHODREF(:)*XCL*(XTT-ZZT(:))) ) / &
- ( ZRHODREF(:)*XLMTT ) ) )
- ZRRS(:) = ZRRS(:) + ZZW(:)
- ZRHS(:) = ZRHS(:) - ZZW(:)
- ZTHS(:) = ZTHS(:) - ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(-RHMLTR))
- END WHERE
-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_FAST_RH
-!
-!-------------------------------------------------------------------------------
-!
-!
- SUBROUTINE RAIN_ICE_FAST_RI
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!-------------------------------------------------------------------------------
-!
-!* 7.1 cloud ice melting
-!
-!$acc kernels present(GWORK)
- ZZW(1:IMICRO) = 0.0
- GWORK(1:IMICRO) = (ZRIS(1:IMICRO)>0.0) .AND. (ZZT(1:IMICRO)>XTT)
- WHERE( GWORK(1:IMICRO) )
- ZZW(1:IMICRO) = ZRIS(1:IMICRO)
- ZRCS(1:IMICRO) = ZRCS(1:IMICRO) + ZRIS(1:IMICRO)
- ZTHS(1:IMICRO) = ZTHS(1:IMICRO) - ZRIS(1:IMICRO)*(ZLSFACT(1:IMICRO)-ZLVFACT(1:IMICRO)) ! f(L_f*(-RIMLTC))
- ZRIS(1:IMICRO) = 0.0
- ZCIT(1:IMICRO) = 0.0
- END WHERE
-!$acc end kernels
- IF (LBUDGET_TH) THEN
-!$acc update self(ZTHS)
- CALL BUDGET (UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),4,'IMLT_BU_RTH')
- END IF
- IF (LBUDGET_RC) THEN
-!$acc update self(ZRCS)
- CALL BUDGET (UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 7,'IMLT_BU_RRC')
- END IF
- IF (LBUDGET_RI) THEN
-!$acc update self(ZRIS)
- CALL BUDGET (UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 9,'IMLT_BU_RRI')
- END IF
-!
-!* 7.2 Bergeron-Findeisen effect: RCBERI
-!
-!$acc kernels present(GWORK,ZRHODREF,XLBEXI,XRTMIN)
- ZZW(1:IMICRO) = 0.0
- GWORK(1:IMICRO) = (ZRCS(1:IMICRO)>0.0) .AND. (ZSSI(1:IMICRO)>0.0) .AND. &
- (ZRIT(1:IMICRO)>XRTMIN(4)) .AND. (ZCIT(1:IMICRO)>0.0)
- WHERE( GWORK(1:IMICRO) )
-#ifndef MNH_BITREP
- ZZW(1:IMICRO) = MIN(1.E8,XLBI*( ZRHODREF(1:IMICRO)*ZRIT(1:IMICRO)/ZCIT(1:IMICRO) )**XLBEXI) ! Lbda_i
- ZZW(1:IMICRO) = MIN( ZRCS(1:IMICRO),( ZSSI(1:IMICRO) / (ZRHODREF(1:IMICRO)*ZAI(1:IMICRO)) ) * ZCIT(1:IMICRO) * &
- ( X0DEPI/ZZW(1:IMICRO) + X2DEPI*ZCJ(1:IMICRO)*ZCJ(1:IMICRO)/ZZW(1:IMICRO)**(XDI+2.0) ) )
-#else
- ZZW(1:IMICRO) = MIN(1.E8,XLBI*BR_POW( ZRHODREF(1:IMICRO)*ZRIT(1:IMICRO)/ZCIT(1:IMICRO),XLBEXI) ) ! Lbda_i
- ZZW(1:IMICRO) = MIN( ZRCS(1:IMICRO),( ZSSI(1:IMICRO) / (ZRHODREF(1:IMICRO)*ZAI(1:IMICRO)) ) * ZCIT(1:IMICRO) * &
- ( X0DEPI/ZZW(1:IMICRO) + X2DEPI*ZCJ(1:IMICRO)*ZCJ(1:IMICRO)/BR_POW(ZZW(1:IMICRO),XDI+2.0) ) )
-#endif
- ZRCS(1:IMICRO) = ZRCS(1:IMICRO) - ZZW(1:IMICRO)
- ZRIS(1:IMICRO) = ZRIS(1:IMICRO) + ZZW(1:IMICRO)
- ZTHS(1:IMICRO) = ZTHS(1:IMICRO) + ZZW(1:IMICRO)*(ZLSFACT(1:IMICRO)-ZLVFACT(1:IMICRO)) ! f(L_f*(RCBERI))
- END WHERE
-!$acc end kernels
- IF (LBUDGET_TH) THEN
-!$acc update self(ZTHS)
- CALL BUDGET (UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),4,'BERFI_BU_RTH')
- END IF
- IF (LBUDGET_RC) THEN
-!$acc update self(ZRCS)
- CALL BUDGET (UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 7,'BERFI_BU_RRC')
- END IF
- IF (LBUDGET_RI) THEN
-!$acc update self(ZRIS)
- CALL BUDGET (UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), 9,'BERFI_BU_RRI')
- END IF
-!
- END SUBROUTINE RAIN_ICE_FAST_RI
-!
-SUBROUTINE RAINFR_VERT(ZPRFR, ZRR)
-
-IMPLICIT NONE
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: ZPRFR !Precipitation fraction
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZRR !Rain field
-!$acc declare present(ZPRFR,ZRR)
-!
-!-------------------------------------------------------------------------------
-INTEGER :: JI, JJ, JK
-!
-CALL MPPDB_CHECK(ZPRFR,"RAINFR_VERT beg:ZPRFR")
-CALL MPPDB_CHECK(ZRR,"RAINFR_VERT beg:ZRR")
-!
-!$acc kernels present(ZPRFR,ZRR,XRTMIN)
-DO JI = IIB,IIE
- DO JJ = IJB, IJE
- ZPRFR(JI,JJ,IKE)=0.
- DO JK=IKE-KKL, IKB, -KKL
- IF (ZRR(JI,JJ,JK) .GT. XRTMIN(3)) THEN
- ZPRFR(JI,JJ,JK)=MAX(ZPRFR(JI,JJ,JK),ZPRFR(JI,JJ,JK+KKL))
- IF (ZPRFR(JI,JJ,JK)==0.) THEN
- ZPRFR(JI,JJ,JK)=1.
- END IF
- ELSE
- ZPRFR(JI,JJ,JK)=0.
- END IF
- END DO
- END DO
-END DO
-!$acc end kernels
-!
-CALL MPPDB_CHECK(ZPRFR,"RAINFR_VERT end:ZPRFR")
-!
-END SUBROUTINE RAINFR_VERT
-!
-!
-!-------------------------------------------------------------------------------
-!
- FUNCTION COUNTJV3D(LTAB,I1,I2,I3) RESULT(IC)
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: LTAB ! Mask
-INTEGER, DIMENSION(:), INTENT(OUT) :: I1,I2,I3 ! Used to replace the COUNT and PACK
-!
-!* 0.2 declaration of local variables
-!
-INTEGER :: JI,JJ,JK,IC
-!
-!-------------------------------------------------------------------------------
-!
-IC = 0
-DO JK = 1,SIZE(LTAB,3)
- DO JJ = 1,SIZE(LTAB,2)
- DO JI = 1,SIZE(LTAB,1)
- IF( LTAB(JI,JJ,JK) ) THEN
- IC = IC +1
- I1(IC) = JI
- I2(IC) = JJ
- I3(IC) = JK
- END IF
- END DO
- END DO
-END DO
-!
-END FUNCTION COUNTJV3D
-!
-!-------------------------------------------------------------------------------
-!
-#ifdef _OPENACC
- SUBROUTINE COUNTJV3D_DEVICE(LTAB,I1,I2,I3,IC)
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: LTAB ! Mask
-INTEGER, DIMENSION(:), INTENT(OUT) :: I1,I2,I3 ! Used to replace the COUNT and PACK
-INTEGER, INTENT(OUT) :: IC ! Count
-!$acc declare present(LTAB,I1,I2,I3)
-!
-!* 0.2 declaration of local variables
-!
-INTEGER :: JI,JJ,JK,IDX
-!
-!-------------------------------------------------------------------------------
-!
-!$acc kernels present(LTAB,I1,I2,I3)
-
-!To allow comparisons... (I1/I2/I3 are not fully used)
-!Can be removed in production
-! I1(:) = -999
-! I2(:) = -999
-! I3(:) = -999
-
-
-IC = 0
-!Warning: if "independent" is set, content of I1, I2 and I3 can vary between 2
-! different runs of this subroutine BUT final result should be the same
-!Comment the following line + atomic directives to have consistent values for debugging
-!Warning: huge impact on performance
-!$acc loop collapse(3) private(IDX) independent
-DO JK = 1,SIZE(LTAB,3)
- DO JJ = 1,SIZE(LTAB,2)
- DO JI = 1,SIZE(LTAB,1)
- IF( LTAB(JI,JJ,JK) ) THEN
-!$acc atomic capture
- IC = IC +1
- IDX = IC
-!$acc end atomic
- I1(IDX) = JI
- I2(IDX) = JJ
- I3(IDX) = JK
- END IF
- END DO
- END DO
-END DO
-!$acc end kernels
-!
-END SUBROUTINE COUNTJV3D_DEVICE
-#endif
-!
-!-------------------------------------------------------------------------------
-!
- FUNCTION COUNTJV2D(LTAB,I1,I2) RESULT(IC)
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-LOGICAL, DIMENSION(:,:), INTENT(IN) :: LTAB ! Mask
-INTEGER, DIMENSION(:), INTENT(OUT) :: I1,I2 ! Used to replace the COUNT and PACK
-!
-!* 0.2 declaration of local variables
-!
-INTEGER :: JI,JJ,IC
-!
-!-------------------------------------------------------------------------------
-!
-IC = 0
-DO JJ = 1,SIZE(LTAB,2)
- DO JI = 1,SIZE(LTAB,1)
- IF( LTAB(JI,JJ) ) THEN
- IC = IC +1
- I1(IC) = JI
- I2(IC) = JJ
- END IF
- END DO
-END DO
-!
-END FUNCTION COUNTJV2D
-!
-!-------------------------------------------------------------------------------
-!
-#ifdef _OPENACC
- SUBROUTINE COUNTJV2D_DEVICE(LTAB,I1,I2,IC)
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-LOGICAL, DIMENSION(:,:), INTENT(IN) :: LTAB ! Mask
-INTEGER, DIMENSION(:), INTENT(OUT) :: I1,I2 ! Used to replace the COUNT and PACK
-INTEGER, INTENT(OUT) :: IC ! Count
-!$acc declare present(LTAB,I1,I2)
-!
-!* 0.2 declaration of local variables
-!
-INTEGER :: JI,JJ,IDX
-!
-!-------------------------------------------------------------------------------
-!
-!$acc kernels present(LTAB,I1,I2)
-IC = 0
-!Warning: if "independent" is set, content of I1 and I2 can vary between 2
-! different runs of this subroutine BUT final result should be the same
-!Comment the following line + atomic directives to have consistent values for debugging
-!Warning: huge impact on performance
-!$acc loop collapse(2) private(IDX) independent
-DO JJ = 1,SIZE(LTAB,2)
- DO JI = 1,SIZE(LTAB,1)
- IF( LTAB(JI,JJ) ) THEN
-!$acc atomic capture
- IC = IC +1
- IDX = IC
-!$acc end atomic
- I1(IDX) = JI
- I2(IDX) = JJ
- END IF
- END DO
-END DO
-!$acc end kernels
-!
-END SUBROUTINE COUNTJV2D_DEVICE
-#endif
-!
-!-------------------------------------------------------------------------------
-!
- FUNCTION COUNTJV1D(LTAB,I1) RESULT(IC)
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-LOGICAL, DIMENSION(:), INTENT(IN) :: LTAB ! Mask
-INTEGER, DIMENSION(:), INTENT(OUT) :: I1 ! Used to replace the COUNT and PACK
-!
-!* 0.2 declaration of local variables
-!
-INTEGER :: JI,IC
-!
-!-------------------------------------------------------------------------------
-!
-IC = 0
-DO JI = 1,SIZE(LTAB,1)
- IF( LTAB(JI) ) THEN
- IC = IC +1
- I1(IC) = JI
- END IF
-END DO
-!
-END FUNCTION COUNTJV1D
-!
-!-------------------------------------------------------------------------------
-!
-#ifdef _OPENACC
- SUBROUTINE COUNTJV1D_DEVICE(LTAB,I1,IC)
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-LOGICAL, DIMENSION(:), INTENT(IN) :: LTAB ! Mask
-INTEGER, DIMENSION(:), INTENT(OUT) :: I1 ! Used to replace the COUNT and PACK
-INTEGER, INTENT(OUT) :: IC ! Count
-!$acc declare present(LTAB,I1)
-!
-!* 0.2 declaration of local variables
-!
-INTEGER :: JI,IDX
-!
-!-------------------------------------------------------------------------------
-!
-!$acc kernels present(LTAB,I1)
-IC = 0
-!Warning: if "independent" is set, content of I1 can vary between 2
-! different runs of this subroutine BUT final result should be the same
-!Comment the following line + atomic directives to have consistent values for debugging
-!Warning: huge impact on performance
-!$acc loop private(IDX) independent
-DO JI = 1,SIZE(LTAB,1)
- IF( LTAB(JI) ) THEN
-!$acc atomic capture
- IC = IC +1
- IDX = IC
-!$acc end atomic
- I1(IDX) = JI
- END IF
-END DO
-!$acc end kernels
-!
-END SUBROUTINE COUNTJV1D_DEVICE
-#endif
+END FUNCTION COUNTJV
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/rain_ice_fast_rg.f90 b/src/MNH/rain_ice_fast_rg.f90
new file mode 100644
index 0000000000000000000000000000000000000000..1829f8ca02c85b9718e63e4499fd344ec08f09f6
--- /dev/null
+++ b/src/MNH/rain_ice_fast_rg.f90
@@ -0,0 +1,422 @@
+!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.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
+!-----------------------------------------------------------------
+MODULE MODE_RAIN_ICE_FAST_RG
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC :: RAIN_ICE_FAST_RG
+
+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, &
+ 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_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 MODI_BUDGET
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+LOGICAL, DIMENSION(:,:,:), intent(in) :: OMICRO ! Test where to compute all processes
+REAL, DIMENSION(:), intent(in) :: PRHODREF ! RHO Dry REFerence
+REAL, DIMENSION(:), intent(in) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), intent(in) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), intent(in) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), intent(in) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:), intent(in) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:), intent(in) :: PRGT ! Graupel m.r. at t
+REAL, DIMENSION(:), intent(in) :: PCIT ! Pristine ice conc. at t
+REAL, DIMENSION(:), intent(in) :: PRHODJ ! RHO times Jacobian
+REAL, DIMENSION(:), intent(in) :: PPRES ! Pressure
+REAL, DIMENSION(:), intent(in) :: PZT ! Temperature
+REAL, DIMENSION(:), intent(in) :: PLBDAR ! Slope parameter of the raindrop distribution
+REAL, DIMENSION(:), intent(in) :: PLBDAS ! Slope parameter of the aggregate distribution
+REAL, DIMENSION(:), intent(in) :: PLBDAG ! Slope parameter of the graupel distribution
+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) :: 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
+REAL, DIMENSION(:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:), intent(inout) :: PUSW ! Undersaturation over water
+REAL, DIMENSION(:), intent(out) :: PRDRYG ! Dry growth rate of the graupeln
+REAL, DIMENSION(:), intent(out) :: PRWETG ! Wet growth rate of the graupeln
+!
+!* 0.2 declaration of local variables
+!
+INTEGER :: IGDRY
+INTEGER :: JJ
+INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1, IVEC2 ! Vectors of indices for interpolations
+LOGICAL, DIMENSION(size(PRHODREF)) :: GDRY ! Test where to compute dry growth
+REAL, DIMENSION(size(PRHODREF)) :: ZZW ! Work array
+REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1,ZVEC2,ZVEC3 ! Work vectors for interpolations
+REAL, DIMENSION(size(PRHODREF),7) :: ZZW1 ! Work arrays
+!
+!-------------------------------------------------------------------------------
+!
+!* 6.1 rain contact freezing
+!
+ ZZW1(:,3:4) = 0.0
+ WHERE( (PRIT(:)>XRTMIN(4)) .AND. (PRRT(:)>XRTMIN(3)) .AND. &
+ (PRIS(:)>0.0) .AND. (PRRS(:)>0.0) )
+ ZZW1(:,3) = MIN( PRIS(:),XICFRR * PRIT(:) & ! RICFRRG
+ * PLBDAR(:)**XEXICFRR &
+ * PRHODREF(:)**(-XCEXVT) )
+ ZZW1(:,4) = MIN( PRRS(:),XRCFRI * PCIT(:) & ! RRCFRIG
+ * PLBDAR(:)**XEXRCFRI &
+ * PRHODREF(:)**(-XCEXVT-1.) )
+ PRIS(:) = PRIS(:) - ZZW1(:,3)
+ PRRS(:) = PRRS(:) - ZZW1(:,4)
+ PRGS(:) = PRGS(:) + ZZW1(:,3)+ZZW1(:,4)
+ PTHS(:) = PTHS(:) + ZZW1(:,4)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*RRCFRIG)
+ END WHERE
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
+ 4,'CFRZ_BU_RTH')
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 8,'CFRZ_BU_RRR')
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 9,'CFRZ_BU_RRI')
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 11,'CFRZ_BU_RRG')
+!
+!* 6.2 compute the Dry growth case
+!
+ ZZW1(:,:) = 0.0
+ WHERE( (PRGT(:)>XRTMIN(6)) .AND. ((PRCT(:)>XRTMIN(2) .AND. PRCS(:)>0.0)) )
+ ZZW(:) = PLBDAG(:)**(XCXG-XDG-2.0) * PRHODREF(:)**(-XCEXVT)
+ ZZW1(:,1) = MIN( PRCS(:),XFCDRYG * PRCT(:) * ZZW(:) ) ! RCDRYG
+ END WHERE
+ WHERE( (PRGT(:)>XRTMIN(6)) .AND. ((PRIT(:)>XRTMIN(4) .AND. PRIS(:)>0.0)) )
+ ZZW(:) = PLBDAG(:)**(XCXG-XDG-2.0) * PRHODREF(:)**(-XCEXVT)
+ ZZW1(:,2) = MIN( PRIS(:),XFIDRYG * EXP( XCOLEXIG*(PZT(:)-XTT) ) &
+ * PRIT(:) * ZZW(:) ) ! RIDRYG
+ END WHERE
+!
+!* 6.2.1 accretion of aggregates on the graupeln
+!
+ GDRY(:) = (PRST(:)>XRTMIN(5)) .AND. (PRGT(:)>XRTMIN(6)) .AND. (PRSS(:)>0.0)
+ IGDRY = COUNT( GDRY(:) )
+!
+ IF( IGDRY>0 ) THEN
+!
+!* 6.2.2 allocations
+!
+ ALLOCATE(ZVEC1(IGDRY))
+ ALLOCATE(ZVEC2(IGDRY))
+ ALLOCATE(ZVEC3(IGDRY))
+ ALLOCATE(IVEC1(IGDRY))
+ ALLOCATE(IVEC2(IGDRY))
+!
+!* 6.2.3 select the (PLBDAG,PLBDAS) couplet
+!
+ ZVEC1(:) = PACK( PLBDAG(:),MASK=GDRY(:) )
+ ZVEC2(:) = PACK( PLBDAS(:),MASK=GDRY(:) )
+!
+!* 6.2.4 find the next lower indice for the PLBDAG and for the PLBDAS
+! in the geometrical set of (Lbda_g,Lbda_s) couplet use to
+! tabulate the SDRYG-kernel
+!
+ ZVEC1(1:IGDRY) = MAX( 1.00001, MIN( FLOAT(NDRYLBDAG)-0.00001, &
+ XDRYINTP1G * LOG( ZVEC1(1:IGDRY) ) + XDRYINTP2G ) )
+ IVEC1(1:IGDRY) = INT( ZVEC1(1:IGDRY) )
+ ZVEC1(1:IGDRY) = ZVEC1(1:IGDRY) - FLOAT( IVEC1(1:IGDRY) )
+!
+ ZVEC2(1:IGDRY) = MAX( 1.00001, MIN( FLOAT(NDRYLBDAS)-0.00001, &
+ XDRYINTP1S * LOG( ZVEC2(1:IGDRY) ) + XDRYINTP2S ) )
+ IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) )
+ ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - FLOAT( IVEC2(1:IGDRY) )
+!
+!* 6.2.5 perform the bilinear interpolation of the normalized
+! SDRYG-kernel
+!
+ DO JJ = 1,IGDRY
+ ZVEC3(JJ) = ( XKER_SDRYG(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_SDRYG(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * ZVEC1(JJ) &
+ - ( XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * (ZVEC1(JJ) - 1.0)
+ END DO
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GDRY,FIELD=0.0 )
+!
+ WHERE( GDRY(:) )
+ ZZW1(:,3) = MIN( PRSS(:),XFSDRYG*ZZW(:) & ! RSDRYG
+ * EXP( XCOLEXSG*(PZT(:)-XTT) ) &
+ *( PLBDAS(:)**(XCXS-XBS) )*( PLBDAG(:)**XCXG ) &
+ *( PRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBSDRYG1/( PLBDAG(:)**2 ) + &
+ XLBSDRYG2/( PLBDAG(:) * PLBDAS(:) ) + &
+ XLBSDRYG3/( PLBDAS(:)**2) ) )
+ END WHERE
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+ END IF
+!
+!* 6.2.6 accretion of raindrops on the graupeln
+!
+ GDRY(:) = (PRRT(:)>XRTMIN(3)) .AND. (PRGT(:)>XRTMIN(6)) .AND. (PRRS(:)>0.0)
+ IGDRY = COUNT( GDRY(:) )
+!
+ IF( IGDRY>0 ) THEN
+!
+!* 6.2.7 allocations
+!
+ ALLOCATE(ZVEC1(IGDRY))
+ ALLOCATE(ZVEC2(IGDRY))
+ ALLOCATE(ZVEC3(IGDRY))
+ ALLOCATE(IVEC1(IGDRY))
+ ALLOCATE(IVEC2(IGDRY))
+!
+!* 6.2.8 select the (PLBDAG,PLBDAR) couplet
+!
+ ZVEC1(:) = PACK( PLBDAG(:),MASK=GDRY(:) )
+ ZVEC2(:) = PACK( PLBDAR(:),MASK=GDRY(:) )
+!
+!* 6.2.9 find the next lower indice for the PLBDAG and for the PLBDAR
+! in the geometrical set of (Lbda_g,Lbda_r) couplet use to
+! tabulate the RDRYG-kernel
+!
+ ZVEC1(1:IGDRY) = MAX( 1.00001, MIN( FLOAT(NDRYLBDAG)-0.00001, &
+ XDRYINTP1G * LOG( ZVEC1(1:IGDRY) ) + XDRYINTP2G ) )
+ IVEC1(1:IGDRY) = INT( ZVEC1(1:IGDRY) )
+ ZVEC1(1:IGDRY) = ZVEC1(1:IGDRY) - FLOAT( IVEC1(1:IGDRY) )
+!
+ ZVEC2(1:IGDRY) = MAX( 1.00001, MIN( FLOAT(NDRYLBDAR)-0.00001, &
+ XDRYINTP1R * LOG( ZVEC2(1:IGDRY) ) + XDRYINTP2R ) )
+ IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) )
+ ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - FLOAT( IVEC2(1:IGDRY) )
+!
+!* 6.2.10 perform the bilinear interpolation of the normalized
+! RDRYG-kernel
+!
+ DO JJ = 1,IGDRY
+ ZVEC3(JJ) = ( XKER_RDRYG(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_RDRYG(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * ZVEC1(JJ) &
+ - ( XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * (ZVEC1(JJ) - 1.0)
+ END DO
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GDRY,FIELD=0.0 )
+!
+ WHERE( GDRY(:) )
+ ZZW1(:,4) = MIN( PRRS(:),XFRDRYG*ZZW(:) & ! RRDRYG
+ *( PLBDAR(:)**(-4) )*( PLBDAG(:)**XCXG ) &
+ *( PRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBRDRYG1/( PLBDAG(:)**2 ) + &
+ XLBRDRYG2/( PLBDAG(:) * PLBDAR(:) ) + &
+ XLBRDRYG3/( PLBDAR(:)**2) ) )
+ END WHERE
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+ END IF
+!
+ PRDRYG(:) = ZZW1(:,1) + ZZW1(:,2) + ZZW1(:,3) + ZZW1(:,4)
+!
+!* 6.3 compute the Wet growth case
+!
+ ZZW(:) = 0.0
+ PRWETG(:) = 0.0
+ WHERE( PRGT(:)>XRTMIN(6) )
+ ZZW1(:,5) = MIN( PRIS(:), &
+ ZZW1(:,2) / (XCOLIG*EXP(XCOLEXIG*(PZT(:)-XTT)) ) ) ! RIWETG
+ ZZW1(:,6) = MIN( PRSS(:), &
+ ZZW1(:,3) / (XCOLSG*EXP(XCOLEXSG*(PZT(:)-XTT)) ) ) ! RSWETG
+!
+ ZZW(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
+ ZZW(:) = PKA(:)*(XTT-PZT(:)) + &
+ ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PZT(:) - XTT )) &
+ *(XESTT-ZZW(:))/(XRV*PZT(:)) )
+!
+! compute RWETG
+!
+ PRWETG(:)=MAX( 0.0, &
+ ( ZZW(:) * ( X0DEPG* PLBDAG(:)**XEX0DEPG + &
+ X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG ) + &
+ ( ZZW1(:,5)+ZZW1(:,6) ) * &
+ ( PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PZT(:))) ) ) / &
+ ( PRHODREF(:)*(XLMTT-XCL*(XTT-PZT(:))) ) )
+ END WHERE
+!
+!* 6.4 Select Wet or Dry case
+!
+ ZZW(:) = 0.0
+ IF ( KRR == 7 ) THEN
+ WHERE( PRGT(:)>XRTMIN(6) .AND. PZT(:)<XTT &
+ .AND. & ! Wet
+ PRDRYG(:)>=PRWETG(:) .AND. PRWETG(:)>0.0 ) ! case
+ ZZW(:) = PRWETG(:) - ZZW1(:,5) - ZZW1(:,6) ! RCWETG+RRWETG
+!
+! limitation of the available rainwater mixing ratio (RRWETH < RRS !)
+!
+ ZZW1(:,7) = MAX( 0.0,MIN( ZZW(:),PRRS(:)+ZZW1(:,1) ) )
+ PUSW(:) = ZZW1(:,7) / ZZW(:)
+ ZZW1(:,5) = ZZW1(:,5)*PUSW(:)
+ ZZW1(:,6) = ZZW1(:,6)*PUSW(:)
+ PRWETG(:) = ZZW1(:,7) + ZZW1(:,5) + ZZW1(:,6)
+!
+ PRCS(:) = PRCS(:) - ZZW1(:,1)
+ PRIS(:) = PRIS(:) - ZZW1(:,5)
+ PRSS(:) = PRSS(:) - ZZW1(:,6)
+!
+! assume a linear percent of conversion of graupel into hail
+!
+ PRGS(:) = PRGS(:) + PRWETG(:) ! Wet growth
+ ZZW(:) = PRGS(:)*PRDRYG(:)/(PRWETG(:)+PRDRYG(:)) ! and
+ PRGS(:) = PRGS(:) - ZZW(:) ! partial conversion
+ PRHS(:) = PRHS(:) + ZZW(:) ! of the graupel into hail
+!
+ PRRS(:) = MAX( 0.0,PRRS(:) - ZZW1(:,7) + ZZW1(:,1) )
+ PTHS(:) = PTHS(:) + ZZW1(:,7)*(PLSFACT(:)-PLVFACT(:))
+ ! f(L_f*(RCWETG+RRWETG))
+ END WHERE
+ ELSE IF( KRR == 6 ) THEN
+ WHERE( PRGT(:)>XRTMIN(6) .AND. PZT(:)<XTT &
+ .AND. & ! Wet
+ PRDRYG(:)>=PRWETG(:) .AND. PRWETG(:)>0.0 ) ! case
+ ZZW(:) = PRWETG(:)
+ PRCS(:) = PRCS(:) - ZZW1(:,1)
+ PRIS(:) = PRIS(:) - ZZW1(:,5)
+ PRSS(:) = PRSS(:) - ZZW1(:,6)
+ PRGS(:) = PRGS(:) + ZZW(:)
+!
+ PRRS(:) = PRRS(:) - ZZW(:) + ZZW1(:,5) + ZZW1(:,6) + ZZW1(:,1)
+ PTHS(:) = PTHS(:) + (ZZW(:)-ZZW1(:,5)-ZZW1(:,6))*(PLSFACT(:)-PLVFACT(:))
+ ! f(L_f*(RCWETG+RRWETG))
+ END WHERE
+ END IF
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
+ 4,'WETG_BU_RTH')
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 7,'WETG_BU_RRC')
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 8,'WETG_BU_RRR')
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 9,'WETG_BU_RRI')
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 10,'WETG_BU_RRS')
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 11,'WETG_BU_RRG')
+ IF ( KRR == 7 ) THEN
+ IF (LBUDGET_RH) CALL BUDGET ( &
+ UNPACK(PRHS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 12,'WETG_BU_RRH')
+ END IF
+
+!
+ WHERE( PRGT(:)>XRTMIN(6) .AND. PZT(:)<XTT &
+ .AND. &
+ PRDRYG(:)<PRWETG(:) .AND. PRDRYG(:)>0.0 ) ! Dry
+ PRCS(:) = PRCS(:) - ZZW1(:,1)
+ PRIS(:) = PRIS(:) - ZZW1(:,2)
+ PRSS(:) = PRSS(:) - ZZW1(:,3)
+ PRRS(:) = PRRS(:) - ZZW1(:,4)
+ PRGS(:) = PRGS(:) + PRDRYG(:)
+ PTHS(:) = PTHS(:) + (ZZW1(:,1)+ZZW1(:,4))*(PLSFACT(:)-PLVFACT(:)) !
+ ! f(L_f*(RCDRYG+RRDRYG))
+ END WHERE
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
+ 4,'DRYG_BU_RTH')
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 7,'DRYG_BU_RRC')
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 8,'DRYG_BU_RRR')
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 9,'DRYG_BU_RRI')
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 10,'DRYG_BU_RRS')
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 11,'DRYG_BU_RRG')
+!
+! WHERE ( PZT(:) > XTT ) ! RSWETG case only
+! PRSS(:) = PRSS(:) - ZZW1(:,6)
+! PRGS(:) = PRGS(:) + ZZW1(:,6)
+! END WHERE
+!
+!* 6.5 Melting of the graupeln
+!
+ ZZW(:) = 0.0
+ WHERE( (PRGT(:)>XRTMIN(6)) .AND. (PRGS(:)>0.0) .AND. (PZT(:)>XTT) )
+ ZZW(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
+ ZZW(:) = PKA(:)*(XTT-PZT(:)) + &
+ ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PZT(:) - XTT )) &
+ *(XESTT-ZZW(:))/(XRV*PZT(:)) )
+!
+! compute RGMLTR
+!
+ ZZW(:) = MIN( PRGS(:), MAX( 0.0,( -ZZW(:) * &
+ ( X0DEPG* PLBDAG(:)**XEX0DEPG + &
+ X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG ) - &
+ ( ZZW1(:,1)+ZZW1(:,4) ) * &
+ ( PRHODREF(:)*XCL*(XTT-PZT(:))) ) / &
+ ( PRHODREF(:)*XLMTT ) ) )
+ PRRS(:) = PRRS(:) + ZZW(:)
+ PRGS(:) = PRGS(:) - ZZW(:)
+ PTHS(:) = PTHS(:) - ZZW(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(-RGMLTR))
+ END WHERE
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
+ 4,'GMLT_BU_RTH')
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 8,'GMLT_BU_RRR')
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 11,'GMLT_BU_RRG')
+!
+END SUBROUTINE RAIN_ICE_FAST_RG
+
+END MODULE MODE_RAIN_ICE_FAST_RG
diff --git a/src/MNH/rain_ice_fast_rh.f90 b/src/MNH/rain_ice_fast_rh.f90
new file mode 100644
index 0000000000000000000000000000000000000000..4691df965e77b57177a460b66366482acaa7a7da
--- /dev/null
+++ b/src/MNH/rain_ice_fast_rh.f90
@@ -0,0 +1,356 @@
+!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.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
+!-----------------------------------------------------------------
+MODULE MODE_RAIN_ICE_FAST_RH
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC :: 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, &
+ 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_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 MODI_BUDGET
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, DIMENSION(:,:,:), intent(in) :: OMICRO ! Test where to compute all processes
+REAL, DIMENSION(:), intent(in) :: PRHODREF ! RHO Dry REFerence
+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) :: PRIT ! Pristine 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) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(:), intent(in) :: PRHODJ ! RHO times Jacobian
+REAL, DIMENSION(:), intent(in) :: PPRES ! Pressure
+REAL, DIMENSION(:), intent(in) :: PZT ! Temperature
+REAL, DIMENSION(:), intent(in) :: PLBDAS ! Slope parameter of the aggregate distribution
+REAL, DIMENSION(:), intent(in) :: PLBDAG ! Slope parameter of the graupel distribution
+REAL, DIMENSION(:), intent(inout) :: PLBDAH ! Slope parameter of the hail distribution
+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) :: 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
+REAL, DIMENSION(:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:), intent(inout) :: PUSW ! Undersaturation over water
+!
+!* 0.2 declaration of local variables
+!
+INTEGER :: IHAIL, IGWET
+INTEGER :: JJ
+INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1, IVEC2 ! Vectors of indices for interpolations
+LOGICAL, DIMENSION(size(PRHODREF)) :: GWET ! Test where to compute wet growth
+LOGICAL, DIMENSION(size(PRHODREF)) :: GHAIL ! Test where to compute hail growth
+REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1,ZVEC2,ZVEC3 ! Work vectors for interpolations
+REAL, DIMENSION(size(PRHODREF)) :: ZZW ! Work array
+REAL, DIMENSION(size(PRHODREF),6) :: ZZW1 ! Work arrays
+!
+!-------------------------------------------------------------------------------
+!
+ GHAIL(:) = PRHT(:)>XRTMIN(7)
+ IHAIL = COUNT(GHAIL(:))
+!
+ IF( IHAIL>0 ) THEN
+!
+!* 7.2 compute the Wet growth of hail
+!
+ WHERE ( GHAIL(:) )
+ PLBDAH(:) = XLBH*( PRHODREF(:)*MAX( PRHT(:),XRTMIN(7) ) )**XLBEXH
+ END WHERE
+!
+ ZZW1(:,:) = 0.0
+ WHERE( GHAIL(:) .AND. ((PRCT(:)>XRTMIN(2) .AND. PRCS(:)>0.0)) )
+ ZZW(:) = PLBDAH(:)**(XCXH-XDH-2.0) * PRHODREF(:)**(-XCEXVT)
+ ZZW1(:,1) = MIN( PRCS(:),XFWETH * PRCT(:) * ZZW(:) ) ! RCWETH
+ END WHERE
+ WHERE( GHAIL(:) .AND. ((PRIT(:)>XRTMIN(4) .AND. PRIS(:)>0.0)) )
+ ZZW(:) = PLBDAH(:)**(XCXH-XDH-2.0) * PRHODREF(:)**(-XCEXVT)
+ ZZW1(:,2) = MIN( PRIS(:),XFWETH * PRIT(:) * ZZW(:) ) ! RIWETH
+ END WHERE
+!
+!* 7.2.1 accretion of aggregates on the hailstones
+!
+ GWET(:) = GHAIL(:) .AND. (PRST(:)>XRTMIN(5) .AND. PRSS(:)>0.0)
+ IGWET = COUNT( GWET(:) )
+!
+ IF( IGWET>0 ) THEN
+!
+!* 7.2.2 allocations
+!
+ ALLOCATE(ZVEC1(IGWET))
+ ALLOCATE(ZVEC2(IGWET))
+ ALLOCATE(ZVEC3(IGWET))
+ ALLOCATE(IVEC1(IGWET))
+ ALLOCATE(IVEC2(IGWET))
+!
+!* 7.2.3 select the (PLBDAH,PLBDAS) couplet
+!
+ ZVEC1(:) = PACK( PLBDAH(:),MASK=GWET(:) )
+ ZVEC2(:) = PACK( PLBDAS(:),MASK=GWET(:) )
+!
+!* 7.2.4 find the next lower indice for the PLBDAG and for the PLBDAS
+! in the geometrical set of (Lbda_h,Lbda_s) couplet use to
+! tabulate the SWETH-kernel
+!
+ ZVEC1(1:IGWET) = MAX( 1.00001, MIN( FLOAT(NWETLBDAH)-0.00001, &
+ XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) )
+ IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
+ ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - FLOAT( IVEC1(1:IGWET) )
+!
+ ZVEC2(1:IGWET) = MAX( 1.00001, MIN( FLOAT(NWETLBDAS)-0.00001, &
+ XWETINTP1S * LOG( ZVEC2(1:IGWET) ) + XWETINTP2S ) )
+ IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
+ ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - FLOAT( IVEC2(1:IGWET) )
+!
+!* 7.2.5 perform the bilinear interpolation of the normalized
+! SWETH-kernel
+!
+ DO JJ = 1,IGWET
+ ZVEC3(JJ) = ( XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * ZVEC1(JJ) &
+ - ( XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * (ZVEC1(JJ) - 1.0)
+ END DO
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GWET,FIELD=0.0 )
+!
+ WHERE( GWET(:) )
+ ZZW1(:,3) = MIN( PRSS(:),XFSWETH*ZZW(:) & ! RSWETH
+ *( PLBDAS(:)**(XCXS-XBS) )*( PLBDAH(:)**XCXH ) &
+ *( PRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBSWETH1/( PLBDAH(:)**2 ) + &
+ XLBSWETH2/( PLBDAH(:) * PLBDAS(:) ) + &
+ XLBSWETH3/( PLBDAS(:)**2) ) )
+ END WHERE
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+ END IF
+!
+!* 7.2.6 accretion of graupeln on the hailstones
+!
+ GWET(:) = GHAIL(:) .AND. (PRGT(:)>XRTMIN(6) .AND. PRGS(:)>0.0)
+ IGWET = COUNT( GWET(:) )
+!
+ IF( IGWET>0 ) THEN
+!
+!* 7.2.7 allocations
+!
+ ALLOCATE(ZVEC1(IGWET))
+ ALLOCATE(ZVEC2(IGWET))
+ ALLOCATE(ZVEC3(IGWET))
+ ALLOCATE(IVEC1(IGWET))
+ ALLOCATE(IVEC2(IGWET))
+!
+!* 7.2.8 select the (PLBDAH,PLBDAG) couplet
+!
+ ZVEC1(:) = PACK( PLBDAH(:),MASK=GWET(:) )
+ ZVEC2(:) = PACK( PLBDAG(:),MASK=GWET(:) )
+!
+!* 7.2.9 find the next lower indice for the PLBDAH and for the PLBDAG
+! in the geometrical set of (Lbda_h,Lbda_g) couplet use to
+! tabulate the GWETH-kernel
+!
+ ZVEC1(1:IGWET) = MAX( 1.00001, MIN( FLOAT(NWETLBDAG)-0.00001, &
+ XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) )
+ IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
+ ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - FLOAT( IVEC1(1:IGWET) )
+!
+ ZVEC2(1:IGWET) = MAX( 1.00001, MIN( FLOAT(NWETLBDAG)-0.00001, &
+ XWETINTP1G * LOG( ZVEC2(1:IGWET) ) + XWETINTP2G ) )
+ IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
+ ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - FLOAT( IVEC2(1:IGWET) )
+!
+!* 7.2.10 perform the bilinear interpolation of the normalized
+! GWETH-kernel
+!
+ DO JJ = 1,IGWET
+ ZVEC3(JJ) = ( XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * ZVEC1(JJ) &
+ - ( XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * (ZVEC1(JJ) - 1.0)
+ END DO
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GWET,FIELD=0.0 )
+!
+ WHERE( GWET(:) )
+ ZZW1(:,5) = MAX(MIN( PRGS(:),XFGWETH*ZZW(:) & ! RGWETH
+ *( PLBDAG(:)**(XCXG-XBG) )*( PLBDAH(:)**XCXH ) &
+ *( PRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBGWETH1/( PLBDAH(:)**2 ) + &
+ XLBGWETH2/( PLBDAH(:) * PLBDAG(:) ) + &
+ XLBGWETH3/( PLBDAG(:)**2) ) ),0. )
+ END WHERE
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+ END IF
+!
+!* 7.3 compute the Wet growth of hail
+!
+ ZZW(:) = 0.0
+ WHERE( GHAIL(:) .AND. PZT(:)<XTT )
+ ZZW(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
+ ZZW(:) = PKA(:)*(XTT-PZT(:)) + &
+ ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PZT(:) - XTT )) &
+ *(XESTT-ZZW(:))/(XRV*PZT(:)) )
+!
+! compute RWETH
+!
+ ZZW(:) = MAX(0., ( ZZW(:) * ( X0DEPH* PLBDAH(:)**XEX0DEPH + &
+ X1DEPH*PCJ(:)*PLBDAH(:)**XEX1DEPH ) + &
+ ( ZZW1(:,2)+ZZW1(:,3)+ZZW1(:,5) ) * &
+ ( PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PZT(:))) ) ) / &
+ ( PRHODREF(:)*(XLMTT-XCL*(XTT-PZT(:))) ) )
+!
+ ZZW1(:,6) = MAX( ZZW(:) - ZZW1(:,2) - ZZW1(:,3) - ZZW1(:,5),0.) ! RCWETH+RRWETH
+ END WHERE
+ WHERE ( GHAIL(:) .AND. PZT(:)<XTT .AND. ZZW1(:,6)/=0.)
+!
+! limitation of the available rainwater mixing ratio (RRWETH < RRS !)
+!
+ ZZW1(:,4) = MAX( 0.0,MIN( ZZW1(:,6),PRRS(:)+ZZW1(:,1) ) )
+ PUSW(:) = ZZW1(:,4) / ZZW1(:,6)
+ ZZW1(:,2) = ZZW1(:,2)*PUSW(:)
+ ZZW1(:,3) = ZZW1(:,3)*PUSW(:)
+ ZZW1(:,5) = ZZW1(:,5)*PUSW(:)
+ ZZW(:) = ZZW1(:,4) + ZZW1(:,2) + ZZW1(:,3) + ZZW1(:,5)
+!
+!* 7.1.6 integrate the Wet growth of hail
+!
+ PRCS(:) = PRCS(:) - ZZW1(:,1)
+ PRIS(:) = PRIS(:) - ZZW1(:,2)
+ PRSS(:) = PRSS(:) - ZZW1(:,3)
+ PRGS(:) = PRGS(:) - ZZW1(:,5)
+ PRHS(:) = PRHS(:) + ZZW(:)
+ PRRS(:) = MAX( 0.0,PRRS(:) - ZZW1(:,4) + ZZW1(:,1) )
+ PTHS(:) = PTHS(:) + ZZW1(:,4)*(PLSFACT(:)-PLVFACT(:))
+ ! f(L_f*(RCWETH+RRWETH))
+ END WHERE
+ END IF
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),&
+ 4,'WETH_BU_RTH')
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 7,'WETH_BU_RRC')
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 8,'WETH_BU_RRR')
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 9,'WETH_BU_RRI')
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 10,'WETH_BU_RRS')
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 11,'WETH_BU_RRG')
+ IF (LBUDGET_RH) CALL BUDGET ( &
+ UNPACK(PRHS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 12,'WETH_BU_RRH')
+!
+!
+! ici LRECONVH et un flag pour autoriser une reconversion partielle de
+!la grele en gresil
+!
+! IF( IHAIL>0 ) THEN
+!
+!UPG_CD
+!
+!
+!* 7.45 Conversion of the hailstones into graupel
+!
+! XDUMMY6=0.01E-3
+! XDUMMY7=0.001E-3
+! WHERE( PRHT(:)<XDUMMY6 .AND. PRCT(:)<XDUMMY7 .AND. PZT(:)<XTT )
+! ZZW(:) = MIN( 1.0,MAX( 0.0,1.0-(PRCT(:)/XDUMMY7) ) )
+!
+! assume a linear percent conversion rate of hail into graupel
+!
+! ZZW(:) = PRHS(:)*ZZW(:)
+! PRGS(:) = PRGS(:) + ZZW(:) ! partial conversion
+! PRHS(:) = PRHS(:) - ZZW(:) ! of hail into graupel
+!
+! END WHERE
+! END IF
+
+
+
+
+ IF( IHAIL>0 ) THEN
+!
+!* 7.5 Melting of the hailstones
+!
+ ZZW(:) = 0.0
+ WHERE( GHAIL(:) .AND. (PRHS(:)>0.0) .AND. (PZT(:)>XTT) )
+ ZZW(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
+ ZZW(:) = PKA(:)*(XTT-PZT(:)) + &
+ ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PZT(:) - XTT )) &
+ *(XESTT-ZZW(:))/(XRV*PZT(:)) )
+!
+! compute RHMLTR
+!
+ ZZW(:) = MIN( PRHS(:), MAX( 0.0,( -ZZW(:) * &
+ ( X0DEPH* PLBDAH(:)**XEX0DEPH + &
+ X1DEPH*PCJ(:)*PLBDAH(:)**XEX1DEPH ) - &
+ ZZW1(:,6)*( PRHODREF(:)*XCL*(XTT-PZT(:))) ) / &
+ ( PRHODREF(:)*XLMTT ) ) )
+ PRRS(:) = PRRS(:) + ZZW(:)
+ PRHS(:) = PRHS(:) - ZZW(:)
+ PTHS(:) = PTHS(:) - ZZW(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(-RHMLTR))
+ END WHERE
+ END IF
+
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),&
+ 4,'HMLT_BU_RTH')
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 8,'HMLT_BU_RRR')
+ IF (LBUDGET_RH) CALL BUDGET ( &
+ UNPACK(PRHS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 12,'HMLT_BU_RRH')
+!
+END SUBROUTINE RAIN_ICE_FAST_RH
+
+END MODULE MODE_RAIN_ICE_FAST_RH
diff --git a/src/MNH/rain_ice_fast_ri.f90 b/src/MNH/rain_ice_fast_ri.f90
new file mode 100644
index 0000000000000000000000000000000000000000..2ed51c7ffa059e697affd4a4bce0a4bebb3f32a6
--- /dev/null
+++ b/src/MNH/rain_ice_fast_ri.f90
@@ -0,0 +1,102 @@
+!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.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
+!-----------------------------------------------------------------
+MODULE MODE_RAIN_ICE_FAST_RI
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC :: 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)
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use MODD_BUDGET, only: LBUDGET_RC, LBUDGET_RI, LBUDGET_TH
+use MODD_CST, only: XTT
+use MODD_RAIN_ICE_DESCR, only: XDI, XLBEXI, XLBI, XRTMIN
+use MODD_RAIN_ICE_PARAM, only: X0DEPI, X2DEPI
+!
+use MODI_BUDGET
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, DIMENSION(:,:,:), intent(in) :: OMICRO ! Test where to compute all processes
+REAL, DIMENSION(:), intent(in) :: PRHODREF ! RHO Dry REFerence
+REAL, DIMENSION(:), intent(in) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:), intent(in) :: PRHODJ ! RHO times Jacobian
+REAL, DIMENSION(:), intent(in) :: PZT ! Temperature
+REAL, DIMENSION(:), intent(in) :: PSSI ! Supersaturation over ice
+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
+REAL, DIMENSION(:), INTENT(INOUT) :: PTHS ! Theta source
+!
+!* 0.2 declaration of local variables
+!
+REAL, DIMENSION(size(PRHODREF)) :: ZZW ! Work array
+!-------------------------------------------------------------------------------
+!
+!* 7.1 cloud ice melting
+!
+ ZZW(:) = 0.0
+ WHERE( (PRIS(:)>0.0) .AND. (PZT(:)>XTT) )
+ ZZW(:) = PRIS(:)
+ PRCS(:) = PRCS(:) + PRIS(:)
+ PTHS(:) = PTHS(:) - PRIS(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(-RIMLTC))
+ PRIS(:) = 0.0
+ PCIT(:) = 0.0
+ END WHERE
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
+ 4,'IMLT_BU_RTH')
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 7,'IMLT_BU_RRC')
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 9,'IMLT_BU_RRI')
+!
+!* 7.2 Bergeron-Findeisen effect: RCBERI
+!
+ ZZW(:) = 0.0
+ WHERE( (PRCS(:)>0.0) .AND. (PSSI(:)>0.0) .AND. &
+ (PRIT(:)>XRTMIN(4)) .AND. (PCIT(:)>0.0) )
+ ZZW(:) = MIN(1.E8,XLBI*( PRHODREF(:)*PRIT(:)/PCIT(:) )**XLBEXI) ! Lbda_i
+ ZZW(:) = MIN( PRCS(:),( PSSI(:) / (PRHODREF(:)*PAI(:)) ) * PCIT(:) * &
+ ( X0DEPI/ZZW(:) + X2DEPI*PCJ(:)*PCJ(:)/ZZW(:)**(XDI+2.0) ) )
+ PRCS(:) = PRCS(:) - ZZW(:)
+ PRIS(:) = PRIS(:) + ZZW(:)
+ PTHS(:) = PTHS(:) + ZZW(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(RCBERI))
+ END WHERE
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
+ 4,'BERFI_BU_RTH')
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 7,'BERFI_BU_RRC')
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 9,'BERFI_BU_RRI')
+!
+END SUBROUTINE RAIN_ICE_FAST_RI
+
+END MODULE MODE_RAIN_ICE_FAST_RI
diff --git a/src/MNH/rain_ice_fast_rs.f90 b/src/MNH/rain_ice_fast_rs.f90
new file mode 100644
index 0000000000000000000000000000000000000000..3a3749cfa3fe24c176ba0b45fedb7dac4a851fe4
--- /dev/null
+++ b/src/MNH/rain_ice_fast_rs.f90
@@ -0,0 +1,328 @@
+!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.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
+!-----------------------------------------------------------------
+MODULE MODE_RAIN_ICE_FAST_RS
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC :: 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, &
+ PRCS, PRRS, PRSS, PRGS, PTHS)
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use MODD_BUDGET, only: LBUDGET_RC, LBUDGET_RG, LBUDGET_RR, LBUDGET_RS, LBUDGET_TH
+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, &
+ XCRIMSG, XCRIMSS, XEX0DEPS, XEX1DEPS, XEXCRIMSG, XEXCRIMSS, XEXSRIMCG, XFRACCSS, &
+ XFSACCRG, XFSCVMG, XGAMINC_RIM1, XGAMINC_RIM1, XGAMINC_RIM2, XKER_RACCS, &
+ XKER_RACCSS, XKER_SACCRG, XLBRACCS1, XLBRACCS2, XLBRACCS3, XLBSACCR1, XLBSACCR2, XLBSACCR3, &
+ XRIMINTP1, XRIMINTP2, XSRIMCG
+!
+use MODI_BUDGET
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, intent(in) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+LOGICAL, DIMENSION(:,:,:), intent(in) :: OMICRO ! Test where to compute all processes
+REAL, DIMENSION(:), intent(in) :: PRHODREF ! RHO Dry REFerence
+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) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:), intent(in) :: PRHODJ ! RHO times Jacobian
+REAL, DIMENSION(:), intent(in) :: PPRES ! Pressure
+REAL, DIMENSION(:), intent(in) :: PZT ! Temperature
+REAL, DIMENSION(:), intent(in) :: PLBDAR ! Slope parameter of the raindrop distribution
+REAL, DIMENSION(:), intent(in) :: PLBDAS ! Slope parameter of the aggregate distribution
+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) :: 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
+REAL, DIMENSION(:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PTHS ! Theta source
+!
+!* 0.2 declaration of local variables
+!
+INTEGER :: IGRIM, IGACC
+INTEGER :: JJ
+INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1, IVEC2 ! Vectors of indices for interpolations
+LOGICAL, DIMENSION(size(PRHODREF)) :: GRIM ! Test where to compute riming
+LOGICAL, DIMENSION(size(PRHODREF)) :: GACC ! Test where to compute accretion
+REAL, DIMENSION(size(PRHODREF)) :: ZZW ! Work array
+REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1,ZVEC2,ZVEC3 ! Work vectors for interpolations
+REAL, DIMENSION(size(PRHODREF),4) :: ZZW1 ! Work arrays
+!-------------------------------------------------------------------------------
+!
+!* 5.1 cloud droplet riming of the aggregates
+!
+ ZZW1(:,:) = 0.0
+!
+! GRIM(:) = (PRCT(:)>0.0) .AND. (PRST(:)>0.0) .AND. &
+ GRIM(:) = (PRCT(:)>XRTMIN(2)) .AND. (PRST(:)>XRTMIN(5)) .AND. &
+ (PRCS(:)>0.0) .AND. (PZT(:)<XTT)
+ IGRIM = COUNT( GRIM(:) )
+!
+ IF( IGRIM>0 ) THEN
+!
+! 5.1.0 allocations
+!
+ ALLOCATE(ZVEC1(IGRIM))
+ ALLOCATE(ZVEC2(IGRIM))
+ ALLOCATE(IVEC2(IGRIM))
+!
+! 5.1.1 select the PLBDAS
+!
+ ZVEC1(:) = PACK( PLBDAS(:),MASK=GRIM(:) )
+!
+! 5.1.2 find the next lower indice for the PLBDAS in the geometrical
+! set of Lbda_s used to tabulate some moments of the incomplete
+! gamma function
+!
+ ZVEC2(1:IGRIM) = MAX( 1.00001, MIN( FLOAT(NGAMINC)-0.00001, &
+ XRIMINTP1 * LOG( ZVEC1(1:IGRIM) ) + XRIMINTP2 ) )
+ IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) )
+ ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - FLOAT( IVEC2(1:IGRIM) )
+!
+! 5.1.3 perform the linear interpolation of the normalized
+! "2+XDS"-moment of the incomplete gamma function
+!
+ ZVEC1(1:IGRIM) = XGAMINC_RIM1( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
+ - XGAMINC_RIM1( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
+ ZZW(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GRIM,FIELD=0.0 )
+!
+! 5.1.4 riming of the small sized aggregates
+!
+ WHERE ( GRIM(:) )
+ ZZW1(:,1) = MIN( PRCS(:), &
+ XCRIMSS * ZZW(:) * PRCT(:) & ! RCRIMSS
+ * PLBDAS(:)**XEXCRIMSS &
+ * PRHODREF(:)**(-XCEXVT) )
+ PRCS(:) = PRCS(:) - ZZW1(:,1)
+ PRSS(:) = PRSS(:) + ZZW1(:,1)
+ PTHS(:) = PTHS(:) + ZZW1(:,1)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(RCRIMSS))
+ END WHERE
+!
+! 5.1.5 perform the linear interpolation of the normalized
+! "XBS"-moment of the incomplete gamma function
+!
+ ZVEC1(1:IGRIM) = XGAMINC_RIM2( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
+ - XGAMINC_RIM2( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
+ ZZW(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GRIM,FIELD=0.0 )
+!
+! 5.1.6 riming-conversion of the large sized aggregates into graupeln
+!
+!
+ WHERE ( GRIM(:) .AND. (PRSS(:)>0.0) )
+ ZZW1(:,2) = MIN( PRCS(:), &
+ XCRIMSG * PRCT(:) & ! RCRIMSG
+ * PLBDAS(:)**XEXCRIMSG &
+ * PRHODREF(:)**(-XCEXVT) &
+ - ZZW1(:,1) )
+ ZZW1(:,3) = MIN( PRSS(:), &
+ XSRIMCG * PLBDAS(:)**XEXSRIMCG & ! RSRIMCG
+ * (1.0 - ZZW(:) )/(PTSTEP*PRHODREF(:)) )
+ PRCS(:) = PRCS(:) - ZZW1(:,2)
+ PRSS(:) = PRSS(:) - ZZW1(:,3)
+ PRGS(:) = PRGS(:) + ZZW1(:,2)+ZZW1(:,3)
+ PTHS(:) = PTHS(:) + ZZW1(:,2)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(RCRIMSG))
+ END WHERE
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+ END IF
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
+ 4,'RIM_BU_RTH')
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 7,'RIM_BU_RRC')
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 10,'RIM_BU_RRS')
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 11,'RIM_BU_RRG')
+!
+!* 5.2 rain accretion onto the aggregates
+!
+ ZZW1(:,2:3) = 0.0
+ GACC(:) = (PRRT(:)>XRTMIN(3)) .AND. (PRST(:)>XRTMIN(5)) .AND. &
+ (PRRS(:)>0.0) .AND. (PZT(:)<XTT)
+ IGACC = COUNT( GACC(:) )
+!
+ IF( IGACC>0 ) THEN
+!
+! 5.2.0 allocations
+!
+ ALLOCATE(ZVEC1(IGACC))
+ ALLOCATE(ZVEC2(IGACC))
+ ALLOCATE(ZVEC3(IGACC))
+ ALLOCATE(IVEC1(IGACC))
+ ALLOCATE(IVEC2(IGACC))
+!
+! 5.2.1 select the (PLBDAS,PLBDAR) couplet
+!
+ ZVEC1(:) = PACK( PLBDAS(:),MASK=GACC(:) )
+ ZVEC2(:) = PACK( PLBDAR(:),MASK=GACC(:) )
+!
+! 5.2.2 find the next lower indice for the PLBDAS and for the PLBDAR
+! in the geometrical set of (Lbda_s,Lbda_r) couplet use to
+! tabulate the RACCSS-kernel
+!
+ ZVEC1(1:IGACC) = MAX( 1.00001, MIN( FLOAT(NACCLBDAS)-0.00001, &
+ XACCINTP1S * LOG( ZVEC1(1:IGACC) ) + XACCINTP2S ) )
+ IVEC1(1:IGACC) = INT( ZVEC1(1:IGACC) )
+ ZVEC1(1:IGACC) = ZVEC1(1:IGACC) - FLOAT( IVEC1(1:IGACC) )
+!
+ ZVEC2(1:IGACC) = MAX( 1.00001, MIN( FLOAT(NACCLBDAR)-0.00001, &
+ XACCINTP1R * LOG( ZVEC2(1:IGACC) ) + XACCINTP2R ) )
+ IVEC2(1:IGACC) = INT( ZVEC2(1:IGACC) )
+ ZVEC2(1:IGACC) = ZVEC2(1:IGACC) - FLOAT( IVEC2(1:IGACC) )
+!
+! 5.2.3 perform the bilinear interpolation of the normalized
+! RACCSS-kernel
+!
+ DO JJ = 1,IGACC
+ ZVEC3(JJ) = ( XKER_RACCSS(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_RACCSS(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * ZVEC1(JJ) &
+ - ( XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * (ZVEC1(JJ) - 1.0)
+ END DO
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GACC,FIELD=0.0 )
+!
+! 5.2.4 raindrop accretion on the small sized aggregates
+!
+ WHERE ( GACC(:) )
+ ZZW1(:,2) = & !! coef of RRACCS
+ XFRACCSS*( PLBDAS(:)**XCXS )*( PRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBRACCS1/((PLBDAS(:)**2) ) + &
+ XLBRACCS2/( PLBDAS(:) * PLBDAR(:) ) + &
+ XLBRACCS3/( (PLBDAR(:)**2)) )/PLBDAR(:)**4
+ ZZW1(:,4) = MIN( PRRS(:),ZZW1(:,2)*ZZW(:) ) ! RRACCSS
+ PRRS(:) = PRRS(:) - ZZW1(:,4)
+ PRSS(:) = PRSS(:) + ZZW1(:,4)
+ PTHS(:) = PTHS(:) + ZZW1(:,4)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(RRACCSS))
+ END WHERE
+!
+! 5.2.4b perform the bilinear interpolation of the normalized
+! RACCS-kernel
+!
+ DO JJ = 1,IGACC
+ ZVEC3(JJ) = ( XKER_RACCS(IVEC2(JJ)+1,IVEC1(JJ)+1)* ZVEC1(JJ) &
+ - XKER_RACCS(IVEC2(JJ)+1,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
+ * ZVEC2(JJ) &
+ - ( XKER_RACCS(IVEC2(JJ) ,IVEC1(JJ)+1)* ZVEC1(JJ) &
+ - XKER_RACCS(IVEC2(JJ) ,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
+ * (ZVEC2(JJ) - 1.0)
+ END DO
+ ZZW1(:,2) = ZZW1(:,2)*UNPACK( VECTOR=ZVEC3(:),MASK=GACC(:),FIELD=0.0 )
+ !! RRACCS!
+! 5.2.5 perform the bilinear interpolation of the normalized
+! SACCRG-kernel
+!
+ DO JJ = 1,IGACC
+ ZVEC3(JJ) = ( XKER_SACCRG(IVEC2(JJ)+1,IVEC1(JJ)+1)* ZVEC1(JJ) &
+ - XKER_SACCRG(IVEC2(JJ)+1,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
+ * ZVEC2(JJ) &
+ - ( XKER_SACCRG(IVEC2(JJ) ,IVEC1(JJ)+1)* ZVEC1(JJ) &
+ - XKER_SACCRG(IVEC2(JJ) ,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
+ * (ZVEC2(JJ) - 1.0)
+ END DO
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GACC,FIELD=0.0 )
+!
+! 5.2.6 raindrop accretion-conversion of the large sized aggregates
+! into graupeln
+!
+ WHERE ( GACC(:) .AND. (PRSS(:)>0.0) )
+ ZZW1(:,2) = MAX( MIN( PRRS(:),ZZW1(:,2)-ZZW1(:,4) ),0.0 ) ! RRACCSG
+ END WHERE
+ WHERE ( GACC(:) .AND. (PRSS(:)>0.0) .AND. ZZW1(:,2)>0.0 )
+ ZZW1(:,3) = MIN( PRSS(:),XFSACCRG*ZZW(:)* & ! RSACCRG
+ ( PLBDAS(:)**(XCXS-XBS) )*( PRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBSACCR1/((PLBDAR(:)**2) ) + &
+ XLBSACCR2/( PLBDAR(:) * PLBDAS(:) ) + &
+ XLBSACCR3/( (PLBDAS(:)**2)) )/PLBDAR(:) )
+ PRRS(:) = PRRS(:) - ZZW1(:,2)
+ PRSS(:) = PRSS(:) - ZZW1(:,3)
+ PRGS(:) = PRGS(:) + ZZW1(:,2)+ZZW1(:,3)
+ PTHS(:) = PTHS(:) + ZZW1(:,2)*(PLSFACT(:)-PLVFACT(:)) !
+ ! f(L_f*(RRACCSG))
+ END WHERE
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+ END IF
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
+ 4,'ACC_BU_RTH')
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 8,'ACC_BU_RRR')
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 10,'ACC_BU_RRS')
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 11,'ACC_BU_RRG')
+!
+!* 5.3 Conversion-Melting of the aggregates
+!
+ ZZW(:) = 0.0
+ WHERE( (PRST(:)>XRTMIN(5)) .AND. (PRSS(:)>0.0) .AND. (PZT(:)>XTT) )
+ ZZW(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
+ ZZW(:) = PKA(:)*(XTT-PZT(:)) + &
+ ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PZT(:) - XTT )) &
+ *(XESTT-ZZW(:))/(XRV*PZT(:)) )
+!
+! compute RSMLT
+!
+ ZZW(:) = MIN( PRSS(:), XFSCVMG*MAX( 0.0,( -ZZW(:) * &
+ ( X0DEPS* PLBDAS(:)**XEX0DEPS + &
+ X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS ) - &
+ ( ZZW1(:,1)+ZZW1(:,4) ) * &
+ ( PRHODREF(:)*XCL*(XTT-PZT(:))) ) / &
+ ( 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!!!
+!
+ PRSS(:) = PRSS(:) - ZZW(:)
+ PRGS(:) = PRGS(:) + ZZW(:)
+ END WHERE
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 10,'CMEL_BU_RRS')
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 11,'CMEL_BU_RRG')
+!
+END SUBROUTINE RAIN_ICE_FAST_RS
+
+END MODULE MODE_RAIN_ICE_FAST_RS
diff --git a/src/MNH/rain_ice_nucleation.f90 b/src/MNH/rain_ice_nucleation.f90
new file mode 100644
index 0000000000000000000000000000000000000000..4fd4b262504c3b33897ad10e7b435f1a1f02fce0
--- /dev/null
+++ b/src/MNH/rain_ice_nucleation.f90
@@ -0,0 +1,198 @@
+!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.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
+!-----------------------------------------------------------------
+MODULE MODE_RAIN_ICE_NUCLEATION
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC RAIN_ICE_NUCLEATION
+
+CONTAINS
+
+SUBROUTINE RAIN_ICE_NUCLEATION(KIB, KIE, KJB, KJE, KKTB, KKTE,KRR,PTSTEP,&
+ PTHT,PPABST,PRHODJ,PRHODREF,PRVT,PRCT,PRRT,PRIT,PRST,PRGT,&
+ PCIT,PEXNREF,PTHS,PRVS,PRIS,PT,PRHT)
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use MODD_BUDGET, only: LBUDGET_RI, LBUDGET_RV, LBUDGET_TH
+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 MODI_BUDGET
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KIB, KIE, KJB, KJE, KKTB, KKTE
+INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PT ! Temperature
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+!
+!* 0.2 declaration of local variables
+!
+INTEGER :: INEGT
+INTEGER :: JL ! and PACK intrinsics
+INTEGER, DIMENSION(SIZE(PEXNREF)) :: I1,I2,I3 ! Used to replace the COUNT
+LOGICAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: GNEGT ! Test where to compute the HEN process
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZCIT ! Pristine ice conc. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZZT, & ! Temperature
+ ZPRES, & ! Pressure
+ ZZW, & ! Work array
+ ZUSW, & ! Undersaturation over water
+ ZSSI ! Supersaturation over ice
+REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: ZW ! work array
+!
+!-------------------------------------------------------------------------------
+!
+!
+! compute the temperature and the pressure
+!
+PT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:) / XP00 ) ** (XRD/XCPD)
+!
+! optimization by looking for locations where
+! the temperature is negative only !!!
+!
+GNEGT(:,:,:) = .FALSE.
+GNEGT(KIB:KIE,KJB:KJE,KKTB:KKTE) = PT(KIB:KIE,KJB:KJE,KKTB:KKTE)<XTT
+INEGT = COUNTJV( GNEGT(:,:,:),I1(:),I2(:),I3(:))
+IF( INEGT >= 1 ) THEN
+ ALLOCATE(ZRVT(INEGT)) ;
+ ALLOCATE(ZCIT(INEGT)) ;
+ ALLOCATE(ZZT(INEGT)) ;
+ ALLOCATE(ZPRES(INEGT));
+ DO JL=1,INEGT
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = PT(I1(JL),I2(JL),I3(JL))
+ ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
+ ENDDO
+ ALLOCATE(ZZW(INEGT))
+ ALLOCATE(ZUSW(INEGT))
+ ALLOCATE(ZSSI(INEGT))
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
+ ZZW(:) = MIN(ZPRES(:)/2., ZZW(:)) ! safety limitation
+ ZSSI(:) = ZRVT(:)*( ZPRES(:)-ZZW(:) ) / ( (XMV/XMD) * ZZW(:) ) - 1.0
+ ! Supersaturation over ice
+ ZUSW(:) = EXP( XALPW - XBETAW/ZZT(:) - XGAMW*ALOG(ZZT(:) ) ) ! es_w
+ ZUSW(:) = MIN(ZPRES(:)/2.,ZUSW(:)) ! safety limitation
+ ZUSW(:) = ( ZUSW(:)/ZZW(:) )*( (ZPRES(:)-ZZW(:))/(ZPRES(:)-ZUSW(:)) ) - 1.0
+ ! Supersaturation of saturated water vapor over ice
+!
+!* 3.1 compute the heterogeneous nucleation source: RVHENI
+!
+!* 3.1.1 compute the cloud ice concentration
+!
+ ZZW(:) = 0.0
+ ZSSI(:) = MIN( ZSSI(:), ZUSW(:) ) ! limitation of SSi according to SSw=0
+ WHERE( (ZZT(:)<XTT-5.0) .AND. (ZSSI(:)>0.0) )
+ ZZW(:) = XNU20 * EXP( XALPHA2*ZSSI(:)-XBETA2 )
+ END WHERE
+ WHERE( (ZZT(:)<=XTT-2.0) .AND. (ZZT(:)>=XTT-5.0) .AND. (ZSSI(:)>0.0) )
+ ZZW(:) = MAX( XNU20 * EXP( -XBETA2 ),XNU10 * EXP( -XBETA1*(ZZT(:)-XTT) ) * &
+ ( ZSSI(:)/ZUSW(:) )**XALPHA1 )
+ END WHERE
+ ZZW(:) = ZZW(:) - ZCIT(:)
+ IF( MAXVAL(ZZW(:)) > 0.0 ) THEN
+!
+!* 3.1.2 update the r_i and r_v mixing ratios
+!
+ ZZW(:) = MIN( ZZW(:),50.E3 ) ! limitation provisoire a 50 l^-1
+ ZW(:,:,:) = UNPACK( ZZW(:),MASK=GNEGT(:,:,:),FIELD=0.0 )
+ ZW(:,:,:) = MAX( ZW(:,:,:) ,0.0 ) *XMNU0/(PRHODREF(:,:,:)*PTSTEP)
+ PRIS(:,:,:) = PRIS(:,:,:) + ZW(:,:,:)
+ PRVS(:,:,:) = PRVS(:,:,:) - ZW(:,:,:)
+ IF ( KRR == 7 ) THEN
+ PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(XLSTT+(XCPV-XCI)*(PT(:,:,:)-XTT)) &
+ /( (XCPD + XCPV*PRVT(:,:,:) + XCL*(PRCT(:,:,:)+PRRT(:,:,:)) &
+ + XCI*(PRIT(:,:,:)+PRST(:,:,:)+PRGT(:,:,:)+PRHT(:,:,:)))*PEXNREF(:,:,:) )
+ ELSE IF( KRR == 6 ) THEN
+ PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(XLSTT+(XCPV-XCI)*(PT(:,:,:)-XTT)) &
+ /( (XCPD + XCPV*PRVT(:,:,:) + XCL*(PRCT(:,:,:)+PRRT(:,:,:)) &
+ + XCI*(PRIT(:,:,:)+PRST(:,:,:)+PRGT(:,:,:)))*PEXNREF(:,:,:) )
+ END IF
+ ! f(L_s*(RVHENI))
+ ZZW(:) = MAX( ZZW(:)+ZCIT(:),ZCIT(:) )
+ PCIT(:,:,:) = MAX( UNPACK( ZZW(:),MASK=GNEGT(:,:,:),FIELD=0.0 ) , &
+ PCIT(:,:,:) )
+ END IF
+ DEALLOCATE(ZSSI)
+ DEALLOCATE(ZUSW)
+ DEALLOCATE(ZZW)
+ DEALLOCATE(ZPRES)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZCIT)
+ DEALLOCATE(ZRVT)
+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_NUCLEATION
+
+FUNCTION COUNTJV(LTAB,I1,I2,I3) RESULT(IC)
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.2 declaration of local variables
+!
+!
+LOGICAL, DIMENSION(:,:,:) :: LTAB ! Mask
+INTEGER, DIMENSION(:) :: I1,I2,I3 ! Used to replace the COUNT and PACK
+INTEGER :: JI,JJ,JK,IC
+!
+!-------------------------------------------------------------------------------
+!
+IC = 0
+DO JK = 1,SIZE(LTAB,3)
+ DO JJ = 1,SIZE(LTAB,2)
+ DO JI = 1,SIZE(LTAB,1)
+ IF( LTAB(JI,JJ,JK) ) THEN
+ IC = IC +1
+ I1(IC) = JI
+ I2(IC) = JJ
+ I3(IC) = JK
+ END IF
+ END DO
+ END DO
+END DO
+!
+END FUNCTION COUNTJV
+
+END MODULE MODE_RAIN_ICE_NUCLEATION
diff --git a/src/MNH/rain_ice_red.f90 b/src/MNH/rain_ice_red.f90
index b244dfab4da85e1eac273171e8f573ecd6007b30..87e9f33768962e7b866b422c3748f25280d90d73 100644
--- a/src/MNH/rain_ice_red.f90
+++ b/src/MNH/rain_ice_red.f90
@@ -13,7 +13,7 @@ INTERFACE
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
PINPRC,PINPRR, PEVAP3D, &
- PINPRS, PINPRG, PSIGS, PINDEP, PSEA, PTOWN, &
+ PINPRS, PINPRG, PSIGS, PINDEP, PRAINFR, PSEA, PTOWN, &
PRHT, PRHS, PINPRH, PFPR )
!
!
@@ -68,6 +68,7 @@ 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(:,:), 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
@@ -85,7 +86,7 @@ END MODULE MODI_RAIN_ICE_RED
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
PINPRC,PINPRR, PEVAP3D, &
- PINPRS, PINPRG, PSIGS, PINDEP, PSEA, PTOWN, &
+ PINPRS, PINPRG, PSIGS, PINDEP, PRAINFR, PSEA, PTOWN, &
PRHT, PRHS, PINPRH, PFPR )
! ######################################################################
!
@@ -236,6 +237,8 @@ END MODULE MODI_RAIN_ICE_RED
!! J.Escobar : 10/2017 : for real*4 , limit exp() in RAIN_ICE_SLOW with XMNH_HUGE_12_LOG
!! (C. Abiven, Y. Léauté, V. Seigner, S. Riette) Phasing of Turner rain subgrid param
!! (S. Riette) Source code split into several files
+!! 02/2019 C.Lac add rain fraction as an output field
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!
!* 0. DECLARATIONS
! ------------
@@ -255,7 +258,6 @@ USE MODI_ICE4_SEDIMENTATION_STAT
USE MODI_ICE4_SEDIMENTATION_SPLIT
USE MODI_ICE4_TENDENCIES
!
-USE MODE_FMWRIT
USE MODE_ll
USE MODE_MPPDB
USE MODE_MSG
@@ -314,6 +316,7 @@ 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(:,:), 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
@@ -324,7 +327,7 @@ REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitati
!$acc declare present(OSEDIC,HSEDIM,HSUBG_AUCV_RC,OWARM,KKA,KKU,KKL,PTSTEP,KRR)
!$acc declare 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) &
+!$acc & PINPRC,PINDEP,PINPRR,PEVAP3D,PINPRS,PINPRG,PRAINFR) &
!$acc & present(PSEA,PTOWN,PRHT,PRHS,PINPRH,PFPR)
!
!* 0.2 Declarations of local variables :
@@ -359,11 +362,10 @@ REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: &
REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZZ_LVFACT, ZZ_LSFACT, ZLSFACT3D
!
!Diagnostics
-REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZRAINFR
REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2)) :: ZINPRI ! Pristine ice instant precip
!
!$acc declare create(ZW,ZT,ZZ_RVHENI_MR,ZZ_RVHENI,ZZ_LVFACT,ZZ_LSFACT,ZLSFACT3D, &
-!$acc & ZRAINFR,ZINPRI)
+!$acc & ZINPRI)
!
!Packed variables
REAL, DIMENSION(COUNT(ODMICRO)) :: ZRVT, & ! Water vapor m.r. at t
@@ -711,7 +713,7 @@ IF(.NOT. LSEDIM_AFTER) THEN
&PRIS, PRSS, PRGS, &
&PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS)
ELSE
- CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE_RED','no sedimentation scheme for HSEDIM='//TRIM(HSEDIM))
+ call Print_msg( NVERB_FATAL, 'GEN', 'RAIN_ICE_RED', 'no sedimentation scheme for HSEDIM='//HSEDIM )
END IF
!
!* 2.2 budget storage
@@ -935,7 +937,7 @@ DO WHILE(ANY(ZTIME(:)<PTSTEP)) ! Loop to *really* compute tendencies
&ZRS_TEND, ZRG_TEND, ZRH_TEND, &
&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, ZRAINFR)
+ &ZHLC_HCF, ZHLC_LCF, ZHLC_HRC, ZHLC_LRC, PRAINFR)
!$acc end data
! External tendencies
!$acc kernels
@@ -1215,6 +1217,7 @@ IF(IMICRO>0) THEN
#endif
ELSE
!$acc kernels
+ PRAINFR(:,:,:)=0.
PCIT(:,:,:) = 0.
!$acc end kernels
ENDIF
@@ -1867,7 +1870,7 @@ IF(LSEDIM_AFTER) THEN
&PRIS, PRSS, PRGS, &
&PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS)
ELSE
- CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE_RED','no sedimentation scheme for HSEDIM='//TRIM(HSEDIM))
+ call Print_msg( NVERB_FATAL, 'GEN', 'RAIN_ICE_RED', 'no sedimentation scheme for HSEDIM='//HSEDIM )
END IF
!
!* 8.2 budget storage
@@ -1881,6 +1884,8 @@ IF(LSEDIM_AFTER) THEN
IF ( IRR == 7 .AND. GBUDGET_RH) &
CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:), 12, 'SEDI_BU_RRH')
!
+ !sedimentation of rain fraction
+ CALL ICE4_RAINFR_VERT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, PRAINFR, PRRS(:,:,:)*PTSTEP)
ENDIF
!
!
@@ -1901,6 +1906,7 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PEVAP3D,"RAIN_ICE_RED end:PEVAP3D")
CALL MPPDB_CHECK(PINPRS,"RAIN_ICE_RED end:PINPRS")
CALL MPPDB_CHECK(PINPRG,"RAIN_ICE_RED end:PINPRG")
+ CALL MPPDB_CHECK(PRAINFR,"RAIN_ICE_RED end:PRAINFR")
IF (PRESENT(PINPRH)) CALL MPPDB_CHECK(PINPRH,"RAIN_ICE_RED end:PINPRH")
IF (PRESENT(PFPR)) THEN
DO JL=1,SIZE(PFPR,4)
diff --git a/src/MNH/rain_ice_sedimentation_split.f90 b/src/MNH/rain_ice_sedimentation_split.f90
new file mode 100644
index 0000000000000000000000000000000000000000..d7637345ed02225b6f2e448e91f151ffcf85d3ec
--- /dev/null
+++ b/src/MNH/rain_ice_sedimentation_split.f90
@@ -0,0 +1,643 @@
+!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.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
+!-----------------------------------------------------------------
+MODULE MODE_RAIN_ICE_SEDIMENTATION_SPLIT
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC RAIN_ICE_SEDIMENTATION_SPLIT
+
+CONTAINS
+
+SUBROUTINE RAIN_ICE_SEDIMENTATION_SPLIT(KIB, KIE, KJB, KJE, KKB, KKE, KKTB, KKTE, KKT, KKL,&
+ KSPLITR,PTSTEP, &
+ KRR,OSEDIC,ODEPOSC,PINPRC,PINDEP,PINPRR,PINPRS,PINPRG,PDZZ,PRHODREF,PPABST,PTHT,PRHODJ,&
+ PINPRR3D,PRCS,PRCT,PRRS,PRRT,PRIS,PRIT,PRSS,PRST,PRGS,PRGT,PSEA,PTOWN,PINPRH,PRHS,PRHT,PFPR)
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use MODD_BUDGET, only: LBUDGET_RC, LBUDGET_RG, LBUDGET_RH, LBUDGET_RI, LBUDGET_RR, LBUDGET_RS
+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, &
+ XALPHAC, XNUC, XALPHAC2, XNUC2, XLBEXC, XRTMIN, XLBEXC, XLBC
+use MODD_RAIN_ICE_PARAM, only: XEXSEDG, XEXSEDH, XEXCSEDI, XEXSEDR, XEXSEDS, &
+ XFSEDG, XFSEDH, XFSEDI, XFSEDR, XFSEDS, XFSEDC
+!
+use MODI_BUDGET
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KIB, KIE, KJB, KJE, KKB, KKE, KKTB, KKTE, KKT
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
+ ! integration for rain sedimendation
+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.
+LOGICAL, INTENT(IN) :: ODEPOSC ! Switch for droplet depos.
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Layer thikness (m)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PINPRR3D! Rain inst precip 3D
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+!
+!* 0.2 declaration of local variables
+!
+!
+INTEGER, SAVE :: IOLDALLOCC = 6000
+INTEGER, SAVE :: IOLDALLOCR = 6000
+INTEGER, SAVE :: IOLDALLOCI = 6000
+INTEGER, SAVE :: IOLDALLOCS = 6000
+INTEGER, SAVE :: IOLDALLOCG = 6000
+INTEGER, SAVE :: IOLDALLOCH = 6000
+INTEGER :: ILENALLOCC,ILENALLOCR,ILENALLOCI,ILENALLOCS,ILENALLOCG,ILENALLOCH
+INTEGER :: ILISTLENC,ILISTLENR,ILISTLENI,ILISTLENS,ILISTLENG,ILISTLENH
+INTEGER :: ISEDIMR,ISEDIMC, ISEDIMI, ISEDIMS, ISEDIMG, ISEDIMH
+INTEGER :: JK ! Vertical loop index for the rain sedimentation
+INTEGER :: JN ! Temporal loop index for the rain sedimentation
+INTEGER :: JJ ! Loop index for the interpolation
+INTEGER :: JL
+INTEGER, DIMENSION(SIZE(PRCS)) :: IC1,IC2,IC3 ! Used to replace the COUNT
+INTEGER, DIMENSION(SIZE(PRCS)) :: IR1,IR2,IR3 ! Used to replace the COUNT
+INTEGER, DIMENSION(SIZE(PRCS)) :: IS1,IS2,IS3 ! Used to replace the COUNT
+INTEGER, DIMENSION(SIZE(PRCS)) :: II1,II2,II3 ! Used to replace the COUNT
+INTEGER, DIMENSION(SIZE(PRCS)) :: IG1,IG2,IG3 ! Used to replace the COUNT
+INTEGER, DIMENSION(SIZE(PRCS)) :: IH1,IH2,IH3 ! Used to replace the COUNT
+INTEGER, DIMENSION(:), ALLOCATABLE :: ILISTR,ILISTC,ILISTI,ILISTS,ILISTG,ILISTH
+LOGICAL, DIMENSION(SIZE(PRCS,1),SIZE(PRCS,2)):: GDEP
+LOGICAL, DIMENSION(SIZE(PRCS,1),SIZE(PRCS,2),SIZE(PRCS,3)) &
+ :: GSEDIMR,GSEDIMC, GSEDIMI, GSEDIMS, GSEDIMG, GSEDIMH ! Test where to compute the SED processes
+REAL :: ZINVTSTEP
+REAL :: ZTSPLITR ! Small time step for rain sedimentation
+REAL, DIMENSION(SIZE(XRTMIN)) :: ZRTMIN
+! XRTMIN = Minimum value for the mixing ratio
+! ZRTMIN = Minimum value for the source (tendency)
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCS ! Cloud water m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRRS ! Rain water m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRGS ! Graupel m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRHS ! Hail m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRHODREFC,& ! RHO Dry REFerence
+ ZRHODREFR,& ! RHO Dry REFerence
+ ZRHODREFI,& ! RHO Dry REFerence
+ ZRHODREFS,& ! RHO Dry REFerence
+ ZRHODREFG,& ! RHO Dry REFerence
+ ZRHODREFH,& ! RHO Dry REFerence
+ ZCC, & ! terminal velocity
+ ZFSEDC1D, & ! For cloud sedimentation
+ ZWLBDC, & ! Slope parameter of the droplet distribution
+ ZCONC, & ! Concentration des aerosols
+ ZRAY1D, & ! Mean radius
+ ZWLBDA, & ! Libre parcours moyen
+ ZZT, & ! Temperature
+ ZPRES ! Pressure
+REAL, DIMENSION(SIZE(PRCS,1),SIZE(PRCS,2)) &
+ :: ZCONC_TMP ! Weighted concentration
+REAL, DIMENSION(SIZE(PRCS,1),SIZE(PRCS,2),SIZE(PRCS,3)) :: ZCONC3D ! droplet condensation
+REAL, DIMENSION(SIZE(PRCS,1),SIZE(PRCS,2),SIZE(PRCS,3)) :: &
+ ZRAY, & ! Cloud Mean radius
+ ZLBC, & ! XLBC weighted by sea fraction
+ ZFSEDC
+REAL, DIMENSION(SIZE(PRCS,1),SIZE(PRCS,2),SIZE(PRCS,3)) &
+ :: ZPRCS,ZPRRS,ZPRSS,ZPRGS,ZPRHS ! Mixing ratios created during the time step
+REAL, DIMENSION(SIZE(PRCS,1),SIZE(PRCS,2),SIZE(PRCS,3)) &
+ :: ZW ! work array
+REAL, DIMENSION(SIZE(PRCS,1),SIZE(PRCS,2),0:SIZE(PRCS,3)+1) &
+ :: ZWSED ! sedimentation fluxes
+!-------------------------------------------------------------------------------
+!
+!
+! O. Initialization of for sedimentation
+!
+ZINVTSTEP=1./PTSTEP
+ZTSPLITR= PTSTEP / FLOAT(KSPLITR)
+!
+IF (OSEDIC) PINPRC (:,:) = 0.
+IF (ODEPOSC) PINDEP (:,:) = 0.
+PINPRR (:,:) = 0.
+PINPRR3D (:,:,:) = 0.
+PINPRS (:,:) = 0.
+PINPRG (:,:) = 0.
+IF ( KRR == 7 ) PINPRH (:,:) = 0.
+IF (PRESENT(PFPR)) PFPR(:,:,:,:) = 0.
+!
+!* 1. Parameters for cloud sedimentation
+!
+ IF (OSEDIC) THEN
+ ZRAY(:,:,:) = 0.
+ ZLBC(:,:,:) = XLBC(1)
+ ZFSEDC(:,:,:) = XFSEDC(1)
+ ZCONC3D(:,:,:)= XCONC_LAND
+ ZCONC_TMP(:,:)= XCONC_LAND
+ IF (PRESENT(PSEA)) THEN
+ 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
+ ELSE
+ ZCONC3D(:,:,:) = XCONC_LAND
+ ZRAY(:,:,:) = 0.5*(GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)))
+ END IF
+ 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
+
+ZRTMIN(:) = XRTMIN(:) * ZINVTSTEP
+IF (OSEDIC) GSEDIMC(:,:,:) = .FALSE.
+GSEDIMR(:,:,:) = .FALSE.
+GSEDIMI(:,:,:) = .FALSE.
+GSEDIMS(:,:,:) = .FALSE.
+GSEDIMG(:,:,:) = .FALSE.
+IF ( KRR == 7 ) GSEDIMH(:,:,:) = .FALSE.
+!
+ILENALLOCR = 0
+IF (OSEDIC) ILENALLOCC = 0
+ILENALLOCI = 0
+ILENALLOCS = 0
+ILENALLOCG = 0
+IF ( KRR == 7 ) ILENALLOCH = 0
+!
+! ZPiS = Specie i source creating during the current time step
+! PRiS = Source of the previous time step
+!
+IF (OSEDIC) THEN
+ ZPRCS(:,:,:) = 0.0
+ ZPRCS(:,:,:) = PRCS(:,:,:)-PRCT(:,:,:)* ZINVTSTEP
+ PRCS(:,:,:) = PRCT(:,:,:)* ZINVTSTEP
+END IF
+ZPRRS(:,:,:) = 0.0
+ZPRSS(:,:,:) = 0.0
+ZPRGS(:,:,:) = 0.0
+IF ( KRR == 7 ) ZPRHS(:,:,:) = 0.0
+!
+ZPRRS(:,:,:) = PRRS(:,:,:)-PRRT(:,:,:)* ZINVTSTEP
+ZPRSS(:,:,:) = PRSS(:,:,:)-PRST(:,:,:)* ZINVTSTEP
+ZPRGS(:,:,:) = PRGS(:,:,:)-PRGT(:,:,:)* ZINVTSTEP
+IF ( KRR == 7 ) ZPRHS(:,:,:) = PRHS(:,:,:)-PRHT(:,:,:)* ZINVTSTEP
+PRRS(:,:,:) = PRRT(:,:,:)* ZINVTSTEP
+PRSS(:,:,:) = PRST(:,:,:)* ZINVTSTEP
+PRGS(:,:,:) = PRGT(:,:,:)* ZINVTSTEP
+IF ( KRR == 7 ) PRHS(:,:,:) = PRHT(:,:,:)* ZINVTSTEP
+!
+! PRiS = Source of the previous time step + source created during the subtime
+! step
+!
+DO JN = 1 , KSPLITR
+ IF( JN==1 ) THEN
+ IF (OSEDIC) PRCS(:,:,:) = PRCS(:,:,:) + ZPRCS(:,:,:)/KSPLITR
+ PRRS(:,:,:) = PRRS(:,:,:) + ZPRRS(:,:,:)/KSPLITR
+ PRSS(:,:,:) = PRSS(:,:,:) + ZPRSS(:,:,:)/KSPLITR
+ PRGS(:,:,:) = PRGS(:,:,:) + ZPRGS(:,:,:)/KSPLITR
+ IF ( KRR == 7 ) PRHS(:,:,:) = PRHS(:,:,:) + ZPRHS(:,:,:)/KSPLITR
+ DO JK = KKTB , KKTE
+ ZW(:,:,JK) =ZTSPLITR/(PRHODREF(:,:,JK)* PDZZ(:,:,JK))
+ END DO
+ ELSE
+ IF (OSEDIC) PRCS(:,:,:) = PRCS(:,:,:) + ZPRCS(:,:,:)*ZTSPLITR
+ PRRS(:,:,:) = PRRS(:,:,:) + ZPRRS(:,:,:)*ZTSPLITR
+ PRSS(:,:,:) = PRSS(:,:,:) + ZPRSS(:,:,:)*ZTSPLITR
+ PRGS(:,:,:) = PRGS(:,:,:) + ZPRGS(:,:,:)*ZTSPLITR
+ IF ( KRR == 7 ) PRHS(:,:,:) = PRHS(:,:,:) + ZPRHS(:,:,:)*ZTSPLITR
+ END IF
+ !
+ IF (OSEDIC) GSEDIMC(KIB:KIE,KJB:KJE,KKTB:KKTE) = &
+ PRCS(KIB:KIE,KJB:KJE,KKTB:KKTE)>ZRTMIN(2)
+ GSEDIMR(KIB:KIE,KJB:KJE,KKTB:KKTE) = &
+ PRRS(KIB:KIE,KJB:KJE,KKTB:KKTE)>ZRTMIN(3)
+ GSEDIMI(KIB:KIE,KJB:KJE,KKTB:KKTE) = &
+ PRIS(KIB:KIE,KJB:KJE,KKTB:KKTE)>ZRTMIN(4)
+ GSEDIMS(KIB:KIE,KJB:KJE,KKTB:KKTE) = &
+ PRSS(KIB:KIE,KJB:KJE,KKTB:KKTE)>ZRTMIN(5)
+ GSEDIMG(KIB:KIE,KJB:KJE,KKTB:KKTE) = &
+ PRGS(KIB:KIE,KJB:KJE,KKTB:KKTE)>ZRTMIN(6)
+ IF ( KRR == 7 ) GSEDIMH(KIB:KIE,KJB:KJE,KKTB:KKTE) = &
+ PRHS(KIB:KIE,KJB:KJE,KKTB:KKTE)>ZRTMIN(7)
+!
+ IF (OSEDIC) ISEDIMC = COUNTJV( GSEDIMC(:,:,:),IC1(:),IC2(:),IC3(:))
+ ISEDIMR = COUNTJV( GSEDIMR(:,:,:),IR1(:),IR2(:),IR3(:))
+ ISEDIMI = COUNTJV( GSEDIMI(:,:,:),II1(:),II2(:),II3(:))
+ ISEDIMS = COUNTJV( GSEDIMS(:,:,:),IS1(:),IS2(:),IS3(:))
+ ISEDIMG = COUNTJV( GSEDIMG(:,:,:),IG1(:),IG2(:),IG3(:))
+ IF ( KRR == 7 ) ISEDIMH = COUNTJV( GSEDIMH(:,:,:),IH1(:),IH2(:),IH3(:))
+!
+!* 2.1 for cloud
+!
+ IF (OSEDIC) THEN
+ ZWSED(:,:,:) = 0.
+ IF( JN==1 ) PRCS(:,:,:) = PRCS(:,:,:) * PTSTEP
+ IF( ISEDIMC >= 1 ) THEN
+ IF ( ISEDIMC .GT. ILENALLOCC ) THEN
+ IF ( ILENALLOCC .GT. 0 ) THEN
+ DEALLOCATE (ZRCS, ZRHODREFC, ILISTC,ZWLBDC,ZCONC,ZRCT, &
+ ZZT,ZPRES,ZRAY1D,ZFSEDC1D,ZWLBDA,ZCC )
+ END IF
+ ILENALLOCC = MAX (IOLDALLOCC, 2*ISEDIMC )
+ IOLDALLOCC = ILENALLOCC
+ ALLOCATE(ZRCS(ILENALLOCC), ZRHODREFC(ILENALLOCC), ILISTC(ILENALLOCC), &
+ ZWLBDC(ILENALLOCC), ZCONC(ILENALLOCC), ZRCT(ILENALLOCC), ZZT(ILENALLOCC), &
+ ZPRES(ILENALLOCC), ZRAY1D(ILENALLOCC), ZFSEDC1D(ILENALLOCC), &
+ ZWLBDA(ILENALLOCC), ZCC(ILENALLOCC) )
+ END IF
+!
+ DO JL=1,ISEDIMC
+ ZRCS(JL) = PRCS(IC1(JL),IC2(JL),IC3(JL))
+ ZRHODREFC(JL) = PRHODREF(IC1(JL),IC2(JL),IC3(JL))
+ ZWLBDC(JL) = ZLBC(IC1(JL),IC2(JL),IC3(JL))
+ ZCONC(JL) = ZCONC3D(IC1(JL),IC2(JL),IC3(JL))
+ ZRCT(JL) = PRCT(IC1(JL),IC2(JL),IC3(JL))
+ ZZT(JL) = PTHT(IC1(JL),IC2(JL),IC3(JL))
+ ZPRES(JL) = PPABST(IC1(JL),IC2(JL),IC3(JL))
+ ZRAY1D(JL) = ZRAY(IC1(JL),IC2(JL),IC3(JL))
+ ZFSEDC1D(JL) = ZFSEDC(IC1(JL),IC2(JL),IC3(JL))
+ END DO
+!
+ ILISTLENC = 0
+ DO JL=1,ISEDIMC
+ IF( ZRCS(JL) .GT. ZRTMIN(2) ) THEN
+ ILISTLENC = ILISTLENC + 1
+ ILISTC(ILISTLENC) = JL
+ END IF
+ END DO
+ DO JJ = 1, ILISTLENC
+ JL = ILISTC(JJ)
+ IF (ZRCS(JL) .GT. ZRTMIN(2) .AND. ZRCT(JL) .GT. XRTMIN(2)) THEN
+ ZWLBDC(JL) = ZWLBDC(JL) * ZCONC(JL) / (ZRHODREFC(JL) * ZRCT(JL))
+ ZWLBDC(JL) = ZWLBDC(JL)**XLBEXC
+ ZRAY1D(JL) = ZRAY1D(JL) / ZWLBDC(JL) !! ZRAY : mean diameter=M(1)/2
+ ZZT(JL) = ZZT(JL) * (ZPRES(JL)/XP00)**(XRD/XCPD)
+ ZWLBDA(JL) = 6.6E-8*(101325./ZPRES(JL))*(ZZT(JL)/293.15)
+ ZCC(JL) = XCC*(1.+1.26*ZWLBDA(JL)/ZRAY1D(JL)) !! XCC modified for cloud
+ ZWSED (IC1(JL),IC2(JL),IC3(JL))= ZRHODREFC(JL)**(-XCEXVT +1 ) * &
+ ZWLBDC(JL)**(-XDC)*ZCC(JL)*ZFSEDC1D(JL) * ZRCS(JL)
+ END IF
+ END DO
+ END IF
+ DO JK = KKTB , KKTE
+ PRCS(:,:,JK) = PRCS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
+ END DO
+ IF (PRESENT(PFPR)) THEN
+ DO JK = KKTB , KKTE
+ PFPR(:,:,JK,2)=ZWSED(:,:,JK)
+ ENDDO
+ ENDIF
+ PINPRC(:,:) = PINPRC(:,:) + ZWSED(:,:,KKB) / XRHOLW / KSPLITR
+ IF( JN==KSPLITR ) THEN
+ PRCS(:,:,:) = PRCS(:,:,:) * ZINVTSTEP
+ END IF
+ END IF
+!
+!* 2.2 for rain
+!
+ IF( JN==1 ) PRRS(:,:,:) = PRRS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ IF( ISEDIMR >= 1 ) THEN
+ IF ( ISEDIMR .GT. ILENALLOCR ) THEN
+ IF ( ILENALLOCR .GT. 0 ) THEN
+ DEALLOCATE (ZRRS, ZRHODREFR, ILISTR)
+ END IF
+ ILENALLOCR = MAX (IOLDALLOCR, 2*ISEDIMR )
+ IOLDALLOCR = ILENALLOCR
+ ALLOCATE(ZRRS(ILENALLOCR), ZRHODREFR(ILENALLOCR), ILISTR(ILENALLOCR))
+ END IF
+!
+ DO JL=1,ISEDIMR
+ ZRRS(JL) = PRRS(IR1(JL),IR2(JL),IR3(JL))
+ ZRHODREFR(JL) = PRHODREF(IR1(JL),IR2(JL),IR3(JL))
+ END DO
+!
+ ILISTLENR = 0
+ DO JL=1,ISEDIMR
+ IF( ZRRS(JL) .GT. ZRTMIN(3) ) THEN
+ ILISTLENR = ILISTLENR + 1
+ ILISTR(ILISTLENR) = JL
+ END IF
+ END DO
+ DO JJ = 1, ILISTLENR
+ JL = ILISTR(JJ)
+ ZWSED (IR1(JL),IR2(JL),IR3(JL))= XFSEDR * ZRRS(JL)**XEXSEDR * &
+ ZRHODREFR(JL)**(XEXSEDR-XCEXVT)
+ END DO
+ END IF
+ DO JK = KKTB , KKTE
+ PRRS(:,:,JK) = PRRS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
+ END DO
+ IF (PRESENT(PFPR)) THEN
+ DO JK = KKTB , KKTE
+ PFPR(:,:,JK,3)=ZWSED(:,:,JK)
+ ENDDO
+ ENDIF
+ PINPRR(:,:) = PINPRR(:,:) + ZWSED(:,:,KKB)/XRHOLW/KSPLITR
+ PINPRR3D(:,:,:) = PINPRR3D(:,:,:) + ZWSED(:,:,1:KKT)/XRHOLW/KSPLITR
+ IF( JN==KSPLITR ) THEN
+ PRRS(:,:,:) = PRRS(:,:,:) * ZINVTSTEP
+ END IF
+!
+!* 2.3 for pristine ice
+!
+ IF( JN==1 ) PRIS(:,:,:) = PRIS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ IF( ISEDIMI >= 1 ) THEN
+ IF ( ISEDIMI .GT. ILENALLOCI ) THEN
+ IF ( ILENALLOCI .GT. 0 ) THEN
+ DEALLOCATE (ZRIS, ZRHODREFI, ILISTI)
+ END IF
+ ILENALLOCI = MAX (IOLDALLOCI, 2*ISEDIMI )
+ IOLDALLOCI = ILENALLOCI
+ ALLOCATE(ZRIS(ILENALLOCI), ZRHODREFI(ILENALLOCI), ILISTI(ILENALLOCI))
+ END IF
+!
+ DO JL=1,ISEDIMI
+ ZRIS(JL) = PRIS(II1(JL),II2(JL),II3(JL))
+ ZRHODREFI(JL) = PRHODREF(II1(JL),II2(JL),II3(JL))
+ END DO
+!
+ ILISTLENI = 0
+ DO JL=1,ISEDIMI
+ IF( ZRIS(JL) .GT. MAX(ZRTMIN(4),1.0E-7 )) THEN ! limitation of the McF&H formula
+ ILISTLENI = ILISTLENI + 1
+ ILISTI(ILISTLENI) = JL
+ END IF
+ END DO
+ DO JJ = 1, ILISTLENI
+ JL = ILISTI(JJ)
+ ZWSED (II1(JL),II2(JL),II3(JL))= XFSEDI * ZRIS(JL) * &
+ ZRHODREFI(JL)**(1.0-XCEXVT) * & ! McF&H
+ MAX( 0.05E6,-0.15319E6-0.021454E6* &
+ ALOG(ZRHODREFI(JL)*ZRIS(JL)) )**XEXCSEDI
+ END DO
+ END IF
+ DO JK = KKTB , KKTE
+ PRIS(:,:,JK) = PRIS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
+ END DO
+ IF (PRESENT(PFPR)) THEN
+ DO JK = KKTB , KKTE
+ PFPR(:,:,JK,4)=ZWSED(:,:,JK)
+ ENDDO
+ ENDIF
+ IF( JN==KSPLITR ) THEN
+ PRIS(:,:,:) = PRIS(:,:,:) * ZINVTSTEP
+ END IF
+!
+!* 2.4 for aggregates/snow
+!
+ IF( JN==1 ) PRSS(:,:,:) = PRSS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ IF( ISEDIMS >= 1 ) THEN
+ IF ( ISEDIMS .GT. ILENALLOCS ) THEN
+ IF ( ILENALLOCS .GT. 0 ) THEN
+ DEALLOCATE (ZRSS, ZRHODREFS, ILISTS)
+ END IF
+ ILENALLOCS = MAX (IOLDALLOCS, 2*ISEDIMS )
+ IOLDALLOCS = ILENALLOCS
+ ALLOCATE(ZRSS(ILENALLOCS), ZRHODREFS(ILENALLOCS), ILISTS(ILENALLOCS))
+ END IF
+!
+ DO JL=1,ISEDIMS
+ ZRSS(JL) = PRSS(IS1(JL),IS2(JL),IS3(JL))
+ ZRHODREFS(JL) = PRHODREF(IS1(JL),IS2(JL),IS3(JL))
+ END DO
+!
+ ILISTLENS = 0
+ DO JL=1,ISEDIMS
+ IF( ZRSS(JL) .GT. ZRTMIN(5) ) THEN
+ ILISTLENS = ILISTLENS + 1
+ ILISTS(ILISTLENS) = JL
+ END IF
+ END DO
+ DO JJ = 1, ILISTLENS
+ JL = ILISTS(JJ)
+ ZWSED (IS1(JL),IS2(JL),IS3(JL))= XFSEDS * ZRSS(JL)**XEXSEDS * &
+ ZRHODREFS(JL)**(XEXSEDS-XCEXVT)
+ END DO
+ END IF
+ DO JK = KKTB , KKTE
+ PRSS(:,:,JK) = PRSS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
+ END DO
+ IF (PRESENT(PFPR)) THEN
+ DO JK = KKTB , KKTE
+ PFPR(:,:,JK,5)=ZWSED(:,:,JK)
+ ENDDO
+ ENDIF
+ PINPRS(:,:) = PINPRS(:,:) + ZWSED(:,:,KKB)/XRHOLW/KSPLITR
+ IF( JN==KSPLITR ) THEN
+ PRSS(:,:,:) = PRSS(:,:,:) * ZINVTSTEP
+ END IF
+!
+!* 2.5 for graupeln
+!
+ ZWSED(:,:,:) = 0.
+ IF( JN==1 ) PRGS(:,:,:) = PRGS(:,:,:) * PTSTEP
+ IF( ISEDIMG >= 1 ) THEN
+ IF ( ISEDIMG .GT. ILENALLOCG ) THEN
+ IF ( ILENALLOCG .GT. 0 ) THEN
+ DEALLOCATE (ZRGS, ZRHODREFG, ILISTG)
+ END IF
+ ILENALLOCG = MAX (IOLDALLOCG, 2*ISEDIMG )
+ IOLDALLOCG = ILENALLOCG
+ ALLOCATE(ZRGS(ILENALLOCG), ZRHODREFG(ILENALLOCG), ILISTG(ILENALLOCG))
+ END IF
+!
+ DO JL=1,ISEDIMG
+ ZRGS(JL) = PRGS(IG1(JL),IG2(JL),IG3(JL))
+ ZRHODREFG(JL) = PRHODREF(IG1(JL),IG2(JL),IG3(JL))
+ END DO
+!
+ ILISTLENG = 0
+ DO JL=1,ISEDIMG
+ IF( ZRGS(JL) .GT. ZRTMIN(6) ) THEN
+ ILISTLENG = ILISTLENG + 1
+ ILISTG(ILISTLENG) = JL
+ END IF
+ END DO
+ DO JJ = 1, ILISTLENG
+ JL = ILISTG(JJ)
+ ZWSED (IG1(JL),IG2(JL),IG3(JL))= XFSEDG * ZRGS(JL)**XEXSEDG * &
+ ZRHODREFG(JL)**(XEXSEDG-XCEXVT)
+ END DO
+END IF
+ DO JK = KKTB , KKTE
+ PRGS(:,:,JK) = PRGS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
+ END DO
+ IF (PRESENT(PFPR)) THEN
+ DO JK = KKTB , KKTE
+ PFPR(:,:,JK,6)=ZWSED(:,:,JK)
+ ENDDO
+ ENDIF
+ PINPRG(:,:) = PINPRG(:,:) + ZWSED(:,:,KKB)/XRHOLW/KSPLITR
+ IF( JN==KSPLITR ) THEN
+ PRGS(:,:,:) = PRGS(:,:,:) * ZINVTSTEP
+ END IF
+!
+!* 2.6 for hail
+!
+ IF ( KRR == 7 ) THEN
+ IF( JN==1 ) PRHS(:,:,:) = PRHS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ IF( ISEDIMH >= 1 ) THEN
+ IF ( ISEDIMH .GT. ILENALLOCH ) THEN
+ IF ( ILENALLOCH .GT. 0 ) THEN
+ DEALLOCATE (ZRHS, ZRHODREFH, ILISTH)
+ END IF
+ ILENALLOCH = MAX (IOLDALLOCH, 2*ISEDIMH )
+ IOLDALLOCH = ILENALLOCH
+ ALLOCATE(ZRHS(ILENALLOCH), ZRHODREFH(ILENALLOCH), ILISTH(ILENALLOCH))
+ END IF
+!
+ DO JL=1,ISEDIMH
+ ZRHS(JL) = PRHS(IH1(JL),IH2(JL),IH3(JL))
+ ZRHODREFH(JL) = PRHODREF(IH1(JL),IH2(JL),IH3(JL))
+ END DO
+!
+ ILISTLENH = 0
+ DO JL=1,ISEDIMH
+ IF( ZRHS(JL) .GT. ZRTMIN(7) ) THEN
+ ILISTLENH = ILISTLENH + 1
+ ILISTH(ILISTLENH) = JL
+ END IF
+ END DO
+ DO JJ = 1, ILISTLENH
+ JL = ILISTH(JJ)
+ ZWSED (IH1(JL),IH2(JL),IH3(JL))= XFSEDH * ZRHS(JL)**XEXSEDH * &
+ ZRHODREFH(JL)**(XEXSEDH-XCEXVT)
+ END DO
+ END IF
+ DO JK = KKTB , KKTE
+ PRHS(:,:,JK) = PRHS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
+ END DO
+ IF (PRESENT(PFPR)) THEN
+ DO JK = KKTB , KKTE
+ PFPR(:,:,JK,7)=ZWSED(:,:,JK)
+ ENDDO
+ ENDIF
+ PINPRH(:,:) = PINPRH(:,:) + ZWSED(:,:,KKB)/XRHOLW/KSPLITR
+ IF( JN==KSPLITR ) THEN
+ PRHS(:,:,:) = PRHS(:,:,:) * ZINVTSTEP
+ END IF
+ END IF
+!
+END DO
+!
+IF (OSEDIC) THEN
+ IF (ILENALLOCC .GT. 0) DEALLOCATE (ZRCS, ZRHODREFC, &
+ ILISTC,ZWLBDC,ZCONC,ZRCT, ZZT,ZPRES,ZRAY1D,ZFSEDC1D, ZWLBDA,ZCC)
+END IF
+IF (ILENALLOCR .GT. 0 ) DEALLOCATE(ZRHODREFR,ZRRS,ILISTR)
+IF (ILENALLOCI .GT. 0 ) DEALLOCATE(ZRHODREFI,ZRIS,ILISTI)
+IF (ILENALLOCS .GT. 0 ) DEALLOCATE(ZRHODREFS,ZRSS,ILISTS)
+IF (ILENALLOCG .GT. 0 ) DEALLOCATE(ZRHODREFG,ZRGS,ILISTG)
+IF (KRR == 7 .AND. (ILENALLOCH .GT. 0 )) DEALLOCATE(ZRHODREFH,ZRHS,ILISTH)
+!
+!* 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')
+!
+!
+!
+!* 2.4 DROPLET DEPOSITION AT THE 1ST LEVEL ABOVE GROUND
+!
+IF (ODEPOSC) THEN
+ GDEP(:,:) = .FALSE.
+ GDEP(KIB:KIE,KJB:KJE) = PRCS(KIB:KIE,KJB:KJE,KKB) >0
+ WHERE (GDEP)
+ PRCS(:,:,KKB) = PRCS(:,:,KKB) - XVDEPOSC * PRCT(:,:,KKB) / PDZZ(:,:,KKB)
+ PINPRC(:,:) = PINPRC(:,:) + XVDEPOSC * PRCT(:,:,KKB) * PRHODREF(:,:,KKB) /XRHOLW
+ PINDEP(:,:) = XVDEPOSC * PRCT(:,:,KKB) * PRHODREF(:,:,KKB) /XRHOLW
+ END WHERE
+END IF
+!
+!* 2.5 budget storage
+!
+IF ( LBUDGET_RC .AND. ODEPOSC ) &
+ CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'DEPO_BU_RRC')
+!
+
+ END SUBROUTINE RAIN_ICE_SEDIMENTATION_SPLIT
+
+ FUNCTION COUNTJV(LTAB,I1,I2,I3) RESULT(IC)
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.2 declaration of local variables
+!
+!
+LOGICAL, DIMENSION(:,:,:) :: LTAB ! Mask
+INTEGER, DIMENSION(:) :: I1,I2,I3 ! Used to replace the COUNT and PACK
+INTEGER :: JI,JJ,JK,IC
+!
+!-------------------------------------------------------------------------------
+!
+IC = 0
+DO JK = 1,SIZE(LTAB,3)
+ DO JJ = 1,SIZE(LTAB,2)
+ DO JI = 1,SIZE(LTAB,1)
+ IF( LTAB(JI,JJ,JK) ) THEN
+ IC = IC +1
+ I1(IC) = JI
+ I2(IC) = JJ
+ I3(IC) = JK
+ END IF
+ END DO
+ END DO
+END DO
+!
+END FUNCTION COUNTJV
+
+END MODULE MODE_RAIN_ICE_SEDIMENTATION_SPLIT
diff --git a/src/MNH/rain_ice_sedimentation_stat.f90 b/src/MNH/rain_ice_sedimentation_stat.f90
new file mode 100644
index 0000000000000000000000000000000000000000..e8d07221c69c3258d6849abc51262df27bbd12bb
--- /dev/null
+++ b/src/MNH/rain_ice_sedimentation_stat.f90
@@ -0,0 +1,606 @@
+!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.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
+!-----------------------------------------------------------------
+MODULE MODE_RAIN_ICE_SEDIMENTATION_STAT
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC :: RAIN_ICE_SEDIMENTATION_STAT
+
+CONTAINS
+
+SUBROUTINE RAIN_ICE_SEDIMENTATION_STAT( KIB, KIE, KJB, KJE, KKB, KKE, KKTB, KKTE, KKT, KKL, KRR, &
+ PTSTEP, OSEDIC, PINPRC, PINDEP, &
+ PINPRR, PINPRS, PINPRG, PDZZ, PRHODREF, PPABST, PTHT, PRHODJ, PINPRR3D, &
+ PRCS, PRCT, PRRS, PRRT, PRIS, PRSS, PRST, PRGS, PRGT, &
+ PSEA, PTOWN, PINPRH, PRHS, PRHT, PFPR )
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use MODD_BUDGET, only: LBUDGET_RC, LBUDGET_RG, LBUDGET_RH, LBUDGET_RI, LBUDGET_RR, LBUDGET_RS
+use MODD_CST, only: XRHOLW
+use MODD_PARAM_ICE, only: LDEPOSC, XVDEPOSC
+use MODD_RAIN_ICE_PARAM, only: XEXSEDG, XEXSEDH, XEXCSEDI, XEXSEDR, XEXSEDS, &
+ XFSEDC, XFSEDG, XFSEDH, XFSEDI, XFSEDR, XFSEDS
+use MODD_RAIN_ICE_DESCR, only: XALPHAC, XALPHAC2, XCC, XCEXVT, XCONC_LAND, XCONC_SEA, XCONC_URBAN, &
+ XDC, XLBC, XLBEXC, XNUC, XNUC2, XRTMIN
+!
+use MODI_BUDGET
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KIB, KIE, KJB, KJE, KKB, KKE, KKTB, KKTE, KKT
+INTEGER, INTENT(IN) :: KKL ! vert. levels type 1=MNH -1=ARO
+INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Layer thikness (m)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PINPRR3D! Rain inst precip 3D
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(INOUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+!
+!* 0.2 declaration of local variables
+!
+INTEGER :: JI,JJ,JK
+INTEGER :: JCOUNT, JL
+INTEGER, DIMENSION(SIZE(PRHODREF,1)*SIZE(PRHODREF,2)) :: I1, I2
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) :: GDEP
+REAL :: ZINVTSTEP
+REAL :: ZP1,ZP2,ZH,ZZWLBDA,ZZWLBDC,ZZCC
+REAL, DIMENSION(SIZE(XRTMIN)) :: ZRTMIN
+! XRTMIN = Minimum value for the mixing ratio
+! ZRTMIN = Minimum value for the source (tendency)
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) :: ZQP
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) &
+ :: ZCONC_TMP ! Weighted concentration
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZPRCS,ZPRRS,ZPRSS,ZPRGS,ZPRHS ! Mixing ratios created during the time step
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D ! droplet condensation
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: &
+ ZRAY, & ! Cloud Mean radius
+ ZLBC, & ! XLBC weighted by sea fraction
+ ZFSEDC
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZW ! work array
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),0:SIZE(PRHODREF,3)+1) &
+ :: ZWSED ! sedimentation fluxes
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),0:SIZE(PRHODREF,3)+1) &
+ :: ZWSEDW1 ! sedimentation speed
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),0:SIZE(PRHODREF,3)+1) &
+ :: ZWSEDW2 ! sedimentation speed
+!-------------------------------------------------------------------------------
+!
+!
+ZINVTSTEP=1./PTSTEP
+!
+!* 1. Parameters for cloud sedimentation
+!
+ IF (OSEDIC) THEN
+ ZRAY(:,:,:) = 0.
+ ZLBC(:,:,:) = XLBC(1)
+ ZFSEDC(:,:,:) = XFSEDC(1)
+ ZCONC3D(:,:,:)= XCONC_LAND
+ ZCONC_TMP(:,:)= XCONC_LAND
+ IF (PRESENT(PSEA)) THEN
+ 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
+ ELSE
+ ZCONC3D(:,:,:) = XCONC_LAND
+ ZRAY(:,:,:) = 0.5*(GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)))
+ END IF
+ ZRAY(:,:,:) = MAX(1.,ZRAY(:,:,:))
+ ZLBC(:,:,:) = MAX(MIN(XLBC(1),XLBC(2)),ZLBC(:,:,:))
+ ENDIF
+ IF (LDEPOSC) PINDEP (:,:) = 0.
+!
+!* 2. compute the fluxes
+!
+
+
+ZRTMIN(:) = XRTMIN(:) * ZINVTSTEP
+!
+IF (OSEDIC) THEN
+ ZPRCS(:,:,:) = 0.0
+ ZPRCS(:,:,:) = PRCS(:,:,:)-PRCT(:,:,:)* ZINVTSTEP
+ PRCS(:,:,:) = PRCT(:,:,:)* ZINVTSTEP
+END IF
+ZPRRS(:,:,:) = 0.0
+ZPRSS(:,:,:) = 0.0
+ZPRGS(:,:,:) = 0.0
+IF ( KRR == 7 ) ZPRHS(:,:,:) = 0.0
+!
+ZPRRS(:,:,:) = PRRS(:,:,:)-PRRT(:,:,:)* ZINVTSTEP
+ZPRSS(:,:,:) = PRSS(:,:,:)-PRST(:,:,:)* ZINVTSTEP
+ZPRGS(:,:,:) = PRGS(:,:,:)-PRGT(:,:,:)* ZINVTSTEP
+IF ( KRR == 7 ) ZPRHS(:,:,:) = PRHS(:,:,:)-PRHT(:,:,:)* ZINVTSTEP
+PRRS(:,:,:) = PRRT(:,:,:)* ZINVTSTEP
+PRSS(:,:,:) = PRST(:,:,:)* ZINVTSTEP
+PRGS(:,:,:) = PRGT(:,:,:)* ZINVTSTEP
+IF ( KRR == 7 ) PRHS(:,:,:) = PRHT(:,:,:)* ZINVTSTEP
+!
+IF (OSEDIC) PRCS(:,:,:) = PRCS(:,:,:) + ZPRCS(:,:,:)
+PRRS(:,:,:) = PRRS(:,:,:) + ZPRRS(:,:,:)
+PRSS(:,:,:) = PRSS(:,:,:) + ZPRSS(:,:,:)
+PRGS(:,:,:) = PRGS(:,:,:) + ZPRGS(:,:,:)
+IF ( KRR == 7 ) PRHS(:,:,:) = PRHS(:,:,:) + ZPRHS(:,:,:)
+IF (PRESENT(PFPR)) PFPR(:,:,:,:) = 0.
+DO JK = KKTB , KKTE
+ ZW(:,:,JK) =PTSTEP/(PRHODREF(:,:,JK)* PDZZ(:,:,JK) )
+END DO
+PINPRR3D (:,:,:) = 0.
+
+!
+!* 2.1 for cloud
+!
+ IF (OSEDIC) THEN
+ PRCS(:,:,:) = PRCS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ ZWSEDW1(:,:,:) = 0.
+ ZWSEDW2(:,:,:) = 0.
+
+! calculation of P1, P2 and sedimentation flux
+ DO JK = KKE , KKB, -1*KKL
+ !estimation of q' taking into account incomming ZWSED
+ ZQP(:,:)=ZWSED(:,:,JK+KKL)*ZW(:,:,JK)
+
+ JCOUNT=COUNTJV2((PRCS(:,:,JK) > ZRTMIN(2) .AND. PRCT(:,:,JK) > ZRTMIN(2)) .OR. &
+ (ZQP(:,:) > ZRTMIN(2)),I1(:),I2(:))
+ DO JL=1, JCOUNT
+ JI=I1(JL)
+ JJ=I2(JL)
+ !calculation of w
+ ! mars 2009 : ajout d'un test
+ !IF ( PRCS(JI,JJ,JK) > ZRTMIN(2) ) THEN
+ IF(PRCS(JI,JJ,JK) > ZRTMIN(2) .AND. PRCT(JI,JJ,JK) > ZRTMIN(2)) THEN
+ ZZWLBDA=6.6E-8*(101325./PPABST(JI,JJ,JK))*(PTHT(JI,JJ,JK)/293.15)
+ ZZWLBDC=(ZLBC(JI,JJ,JK)*ZCONC3D(JI,JJ,JK) &
+ &/(PRHODREF(JI,JJ,JK)*PRCT(JI,JJ,JK)))**XLBEXC
+ ZZCC=XCC*(1.+1.26*ZZWLBDA*ZZWLBDC/ZRAY(JI,JJ,JK)) !! ZCC : Fall speed
+ ZWSEDW1 (JI,JJ,JK)=PRHODREF(JI,JJ,JK)**(-XCEXVT ) * &
+ & ZZWLBDC**(-XDC)*ZZCC*ZFSEDC(JI,JJ,JK)
+ ENDIF
+ IF ( ZQP(JI,JJ) > ZRTMIN(2) ) THEN
+ ZZWLBDA=6.6E-8*(101325./PPABST(JI,JJ,JK))*(PTHT(JI,JJ,JK)/293.15)
+ ZZWLBDC=(ZLBC(JI,JJ,JK)*ZCONC3D(JI,JJ,JK) &
+ &/(PRHODREF(JI,JJ,JK)*ZQP(JI,JJ)))**XLBEXC
+ ZZCC=XCC*(1.+1.26*ZZWLBDA*ZZWLBDC/ZRAY(JI,JJ,JK)) !! ZCC : Fall speed
+ ZWSEDW2 (JI,JJ,JK)=PRHODREF(JI,JJ,JK)**(-XCEXVT ) * &
+ & ZZWLBDC**(-XDC)*ZZCC*ZFSEDC(JI,JJ,JK)
+ ENDIF
+ ENDDO
+
+ DO JJ = KJB, KJE
+ DO JI = KIB, KIE
+ ZH=PDZZ(JI,JJ,JK)
+ ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH)
+ ! mars 2009 : correction : ZWSEDW1 => ZWSEDW2
+ !IF (ZWSEDW1(JI,JJ,JK) /= 0.) THEN
+ IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
+ ZP2 = MAX(0.,1 - ZH &
+ & / (PTSTEP*ZWSEDW2(JI,JJ,JK)) )
+ ELSE
+ ZP2 = 0.
+ ENDIF
+ ZWSED (JI,JJ,JK)=ZP1*PRHODREF(JI,JJ,JK)*&
+ &ZH*PRCS(JI,JJ,JK)&
+ &* ZINVTSTEP+ ZP2 * ZWSED (JI,JJ,JK+KKL)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ DO JK = KKTB , KKTE
+ PRCS(:,:,JK) = PRCS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
+ END DO
+ IF (PRESENT(PFPR)) THEN
+ DO JK = KKTB , KKTE
+ PFPR(:,:,JK,2)=ZWSED(:,:,JK)
+ ENDDO
+ ENDIF
+
+ PINPRC(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s
+ PRCS(:,:,:) = PRCS(:,:,:) * ZINVTSTEP
+ ENDIF
+
+!
+!* 2.2 for rain
+!
+
+ PRRS(:,:,:) = PRRS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ ZWSEDW1(:,:,:) = 0.
+ ZWSEDW2(:,:,:) = 0.
+
+! calculation of ZP1, ZP2 and sedimentation flux
+ DO JK = KKE , KKB, -1*KKL
+ !estimation of q' taking into account incomming ZWSED
+ ZQP(:,:)=ZWSED(:,:,JK+KKL)*ZW(:,:,JK)
+
+ JCOUNT=COUNTJV2((PRRS(:,:,JK) > ZRTMIN(3)) .OR. &
+ (ZQP(:,:) > ZRTMIN(3)),I1(:),I2(:))
+ DO JL=1, JCOUNT
+ JI=I1(JL)
+ JJ=I2(JL)
+ !calculation of w
+ IF ( PRRS(JI,JJ,JK) > ZRTMIN(3) ) THEN
+ ZWSEDW1 (JI,JJ,JK)= XFSEDR *PRRS(JI,JJ,JK)**(XEXSEDR-1)* &
+ PRHODREF(JI,JJ,JK)**(XEXSEDR-XCEXVT-1)
+ ENDIF
+ IF ( ZQP(JI,JJ) > ZRTMIN(3) ) THEN
+ ZWSEDW2 (JI,JJ,JK)= XFSEDR *(ZQP(JI,JJ))**(XEXSEDR-1)* &
+ PRHODREF(JI,JJ,JK)**(XEXSEDR-XCEXVT-1)
+ ENDIF
+ ENDDO
+ DO JJ = KJB, KJE
+ DO JI = KIB, KIE
+ ZH=PDZZ(JI,JJ,JK)
+ ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH )
+ IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
+ ZP2 = MAX(0.,1 - ZH &
+ & / (PTSTEP*ZWSEDW2(JI,JJ,JK)) )
+ ELSE
+ ZP2 = 0.
+ ENDIF
+ ZWSED (JI,JJ,JK)=ZP1*PRHODREF(JI,JJ,JK)*&
+ &ZH*PRRS(JI,JJ,JK)&
+ &* ZINVTSTEP+ ZP2 * ZWSED (JI,JJ,JK+KKL)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ DO JK = KKTB , KKTE
+ PRRS(:,:,JK) = PRRS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
+ ENDDO
+ IF (PRESENT(PFPR)) THEN
+ DO JK = KKTB , KKTE
+ PFPR(:,:,JK,3)=ZWSED(:,:,JK)
+ ENDDO
+ ENDIF
+ PINPRR(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s
+ PINPRR3D(:,:,:) = ZWSED(:,:,1:KKT)/XRHOLW ! in m/s
+ PRRS(:,:,:) = PRRS(:,:,:) * ZINVTSTEP
+
+!
+!* 2.3 for pristine ice
+!
+
+ PRIS(:,:,:) = PRIS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ ZWSEDW1(:,:,:) = 0.
+ ZWSEDW2(:,:,:) = 0.
+! calculation of ZP1, ZP2 and sedimentation flux
+ DO JK = KKE , KKB, -1*KKL
+ !estimation of q' taking into account incomming ZWSED
+ ZQP(:,:)=ZWSED(:,:,JK+KKL)*ZW(:,:,JK)
+
+ JCOUNT=COUNTJV2((PRIS(:,:,JK) > MAX(ZRTMIN(4),1.0E-7 )) .OR. &
+ (ZQP(:,:) > MAX(ZRTMIN(4),1.0E-7 )),I1(:),I2(:))
+ DO JL=1, JCOUNT
+ JI=I1(JL)
+ JJ=I2(JL)
+ !calculation of w
+ IF ( PRIS(JI,JJ,JK) > MAX(ZRTMIN(4),1.0E-7 ) ) THEN
+ ZWSEDW1 (JI,JJ,JK)= XFSEDI * &
+ & PRHODREF(JI,JJ,JK)**(XCEXVT) * & ! McF&H
+ & MAX( 0.05E6,-0.15319E6-0.021454E6* &
+ & ALOG(PRHODREF(JI,JJ,JK)*PRIS(JI,JJ,JK)) )**XEXCSEDI
+ ENDIF
+ IF ( ZQP(JI,JJ) > MAX(ZRTMIN(4),1.0E-7 ) ) THEN
+ ZWSEDW2 (JI,JJ,JK)= XFSEDI * &
+ & PRHODREF(JI,JJ,JK)**(XCEXVT) * & ! McF&H
+ & MAX( 0.05E6,-0.15319E6-0.021454E6* &
+ & ALOG(PRHODREF(JI,JJ,JK)*ZQP(JI,JJ)) )**XEXCSEDI
+ ENDIF
+ ENDDO
+ DO JJ = KJB, KJE
+ DO JI = KIB, KIE
+ ZH=PDZZ(JI,JJ,JK)
+ ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH )
+ IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
+ ZP2 = MAX(0.,1 - ZH &
+ & / (PTSTEP*ZWSEDW2(JI,JJ,JK)) )
+ ELSE
+ ZP2 = 0.
+ ENDIF
+ ZWSED (JI,JJ,JK)=ZP1*PRHODREF(JI,JJ,JK)*&
+ &ZH*PRIS(JI,JJ,JK)&
+ &* ZINVTSTEP+ ZP2 * ZWSED (JI,JJ,JK+KKL)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ DO JK = KKTB , KKTE
+ PRIS(:,:,JK) = PRIS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
+ ENDDO
+ IF (PRESENT(PFPR)) THEN
+ DO JK = KKTB , KKTE
+ PFPR(:,:,JK,4)=ZWSED(:,:,JK)
+ ENDDO
+ ENDIF
+
+ PRIS(:,:,:) = PRIS(:,:,:) * ZINVTSTEP
+
+
+!
+!* 2.4 for aggregates/snow
+!
+
+ PRSS(:,:,:) = PRSS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ ZWSEDW1(:,:,:) = 0.
+ ZWSEDW2(:,:,:) = 0.
+
+! calculation of ZP1, ZP2 and sedimentation flux
+ DO JK = KKE , KKB, -1*KKL
+ !estimation of q' taking into account incomming ZWSED
+ ZQP(:,:)=ZWSED(:,:,JK+KKL)*ZW(:,:,JK)
+
+ JCOUNT=COUNTJV2((PRSS(:,:,JK) > ZRTMIN(5)) .OR. &
+ (ZQP(:,:) > ZRTMIN(5)),I1(:),I2(:))
+ DO JL=1, JCOUNT
+ JI=I1(JL)
+ JJ=I2(JL)
+ !calculation of w
+ IF (PRSS(JI,JJ,JK) > ZRTMIN(5) ) THEN
+ ZWSEDW1(JI,JJ,JK)=XFSEDS*(PRSS(JI,JJ,JK))**(XEXSEDS-1)*&
+ PRHODREF(JI,JJ,JK)**(XEXSEDS-XCEXVT-1)
+ ENDIF
+ IF ( ZQP(JI,JJ) > ZRTMIN(5) ) THEN
+ ZWSEDW2(JI,JJ,JK)=XFSEDS*(ZQP(JI,JJ))**(XEXSEDS-1)*&
+ PRHODREF(JI,JJ,JK)**(XEXSEDS-XCEXVT-1)
+ ENDIF
+ ENDDO
+ DO JJ = KJB, KJE
+ DO JI = KIB, KIE
+ ZH=PDZZ(JI,JJ,JK)
+ ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH )
+ IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
+ ZP2 = MAX(0.,1 - ZH&
+ / (PTSTEP*ZWSEDW2(JI,JJ,JK)) )
+ ELSE
+ ZP2 = 0.
+ ENDIF
+ ZWSED (JI,JJ,JK)=ZP1*PRHODREF(JI,JJ,JK)*&
+ &ZH*PRSS(JI,JJ,JK)&
+ &* ZINVTSTEP+ ZP2 * ZWSED (JI,JJ,JK+KKL)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ DO JK = KKTB , KKTE
+ PRSS(:,:,JK) = PRSS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
+ ENDDO
+ IF (PRESENT(PFPR)) THEN
+ DO JK = KKTB , KKTE
+ PFPR(:,:,JK,5)=ZWSED(:,:,JK)
+ ENDDO
+ ENDIF
+
+ PINPRS(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s
+
+ PRSS(:,:,:) = PRSS(:,:,:) * ZINVTSTEP
+
+
+!
+!* 2.5 for graupeln
+!
+
+ PRGS(:,:,:) = PRGS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ ZWSEDW1(:,:,:) = 0.
+ ZWSEDW2(:,:,:) = 0.
+
+! calculation of ZP1, ZP2 and sedimentation flux
+ DO JK = KKE, KKB, -1*KKL
+ !estimation of q' taking into account incomming ZWSED
+ ZQP(:,:)=ZWSED(:,:,JK+KKL)*ZW(:,:,JK)
+
+ JCOUNT=COUNTJV2((PRGS(:,:,JK) > ZRTMIN(6)) .OR. &
+ (ZQP(:,:) > ZRTMIN(6)),I1(:),I2(:))
+ DO JL=1, JCOUNT
+ JI=I1(JL)
+ JJ=I2(JL)
+ !calculation of w
+ IF ( PRGS(JI,JJ,JK) > ZRTMIN(6) ) THEN
+ ZWSEDW1 (JI,JJ,JK)= XFSEDG*(PRGS(JI,JJ,JK))**(XEXSEDG-1) * &
+ PRHODREF(JI,JJ,JK)**(XEXSEDG-XCEXVT-1)
+ ENDIF
+ IF ( ZQP(JI,JJ) > ZRTMIN(6) ) THEN
+ ZWSEDW2 (JI,JJ,JK)= XFSEDG*(ZQP(JI,JJ))**(XEXSEDG-1) * &
+ PRHODREF(JI,JJ,JK)**(XEXSEDG-XCEXVT-1)
+ ENDIF
+ ENDDO
+ DO JJ = KJB, KJE
+ DO JI = KIB, KIE
+ ZH=PDZZ(JI,JJ,JK)
+ ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH )
+ IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
+ ZP2 = MAX(0.,1 - ZH &
+ & / (PTSTEP*ZWSEDW2(JI,JJ,JK)) )
+ ELSE
+ ZP2 = 0.
+ ENDIF
+ ZWSED (JI,JJ,JK)=ZP1*PRHODREF(JI,JJ,JK)*&
+ &ZH*PRGS(JI,JJ,JK)&
+ &* ZINVTSTEP+ ZP2 * ZWSED (JI,JJ,JK+KKL)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ DO JK = KKTB , KKTE
+ PRGS(:,:,JK) = PRGS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
+ ENDDO
+ IF (PRESENT(PFPR)) THEN
+ DO JK = KKTB , KKTE
+ PFPR(:,:,JK,6)=ZWSED(:,:,JK)
+ ENDDO
+ ENDIF
+
+ PINPRG(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s
+
+ PRGS(:,:,:) = PRGS(:,:,:) * ZINVTSTEP
+
+!
+!* 2.6 for hail
+!
+ IF ( KRR == 7 ) THEN
+ PRHS(:,:,:) = PRHS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ ZWSEDW1(:,:,:) = 0.
+ ZWSEDW2(:,:,:) = 0.
+! calculation of ZP1, ZP2 and sedimentation flux
+ DO JK = KKE , KKB, -1*KKL
+ !estimation of q' taking into account incomming ZWSED
+ ZQP(:,:)=ZWSED(:,:,JK+KKL)*ZW(:,:,JK)
+
+ JCOUNT=COUNTJV2((PRHS(:,:,JK)+ZQP(JI,JJ) > ZRTMIN(7)) .OR. &
+ (ZQP(:,:) > ZRTMIN(7)),I1(:),I2(:))
+ DO JL=1, JCOUNT
+ JI=I1(JL)
+ JJ=I2(JL)
+ !calculation of w
+ IF ((PRHS(JI,JJ,JK)+ZQP(JI,JJ)) > ZRTMIN(7) ) THEN
+ ZWSEDW1 (JI,JJ,JK)= XFSEDH * (PRHS(JI,JJ,JK))**(XEXSEDH-1) * &
+ PRHODREF(JI,JJ,JK)**(XEXSEDH-XCEXVT-1)
+ ENDIF
+ IF ( ZQP(JI,JJ) > ZRTMIN(7) ) THEN
+ ZWSEDW2 (JI,JJ,JK)= XFSEDH * ZQP(JI,JJ)**(XEXSEDH-1) * &
+ PRHODREF(JI,JJ,JK)**(XEXSEDH-XCEXVT-1)
+ ENDIF
+ ENDDO
+ DO JJ = KJB, KJE
+ DO JI = KIB, KIE
+ ZH=PDZZ(JI,JJ,JK)
+ ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH)
+ IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
+ ZP2 = MAX(0.,1 - ZH &
+ & / (PTSTEP*ZWSEDW2(JI,JJ,JK)) )
+ ELSE
+ ZP2 = 0.
+ ENDIF
+ ZWSED (JI,JJ,JK)=ZP1*PRHODREF(JI,JJ,JK)*&
+ &ZH*PRHS(JI,JJ,JK)&
+ &* ZINVTSTEP+ ZP2 * ZWSED (JI,JJ,JK+KKL)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ DO JK = KKTB , KKTE
+ PRHS(:,:,JK) = PRHS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
+ ENDDO
+ IF (PRESENT(PFPR)) THEN
+ DO JK = KKTB , KKTE
+ PFPR(:,:,JK,7)=ZWSED(:,:,JK)
+ ENDDO
+ ENDIF
+
+ PINPRH(:,:) = ZWSED(:,:,KKB)/XRHOLW ! in m/s
+
+ PRHS(:,:,:) = PRHS(:,:,:) * ZINVTSTEP
+
+ 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')
+!
+!
+!* 2.4 DROPLET DEPOSITION AT THE 1ST LEVEL ABOVE GROUND
+!
+IF (LDEPOSC) THEN
+ GDEP(:,:) = .FALSE.
+ GDEP(KIB:KIE,KJB:KJE) = PRCS(KIB:KIE,KJB:KJE,KKB) >0
+ WHERE (GDEP)
+ PRCS(:,:,KKB) = PRCS(:,:,KKB) - XVDEPOSC * PRCT(:,:,KKB) / PDZZ(:,:,KKB)
+ PINPRC(:,:) = PINPRC(:,:) + XVDEPOSC * PRCT(:,:,KKB) * PRHODREF(:,:,KKB) /XRHOLW
+ PINDEP(:,:) = XVDEPOSC * PRCT(:,:,KKB) * PRHODREF(:,:,KKB) /XRHOLW
+ END WHERE
+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
+
+
+FUNCTION COUNTJV2(LTAB,I1,I2) RESULT(IC)
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.2 declaration of local variables
+!
+!
+LOGICAL, DIMENSION(:,:) :: LTAB ! Mask
+INTEGER, DIMENSION(:) :: I1,I2 ! Used to replace the COUNT and PACK
+INTEGER :: JI,JJ,IC
+!
+!-------------------------------------------------------------------------------
+!
+IC = 0
+DO JJ = 1,SIZE(LTAB,2)
+ DO JI = 1,SIZE(LTAB,1)
+ IF( LTAB(JI,JJ) ) THEN
+ IC = IC +1
+ I1(IC) = JI
+ I2(IC) = JJ
+ END IF
+ END DO
+END DO
+!
+END FUNCTION COUNTJV2
+
+END MODULE MODE_RAIN_ICE_SEDIMENTATION_STAT
diff --git a/src/MNH/rain_ice_slow.f90 b/src/MNH/rain_ice_slow.f90
new file mode 100644
index 0000000000000000000000000000000000000000..eb46ad5318796fa2e160df3f11f9714c914484c5
--- /dev/null
+++ b/src/MNH/rain_ice_slow.f90
@@ -0,0 +1,237 @@
+!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.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
+!-----------------------------------------------------------------
+MODULE MODE_RAIN_ICE_SLOW
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC :: 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, &
+ 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_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 MODI_BUDGET
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, DIMENSION(:,:,:), intent(in) :: OMICRO ! Test where to compute all processes
+REAL, intent(in) :: PINVTSTEP
+REAL, DIMENSION(:), intent(in) :: PRHODREF ! RHO Dry REFerence
+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 m.r. at t
+REAL, DIMENSION(:), intent(in) :: PRHODJ ! RHO times Jacobian
+REAL, DIMENSION(:), intent(in) :: PZT ! Temperature
+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
+REAL, DIMENSION(:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:), intent(OUT) :: PAI ! Thermodynamical function
+REAL, DIMENSION(:), intent(OUT) :: PCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(:), intent(OUT) :: PKA ! Thermal conductivity of the air
+REAL, DIMENSION(:), intent(OUT) :: PDV ! Diffusivity of water vapor in the air
+REAL, DIMENSION(:), intent(OUT) :: PLBDAS ! Slope parameter of the aggregate distribution
+REAL, DIMENSION(:), intent(OUT) :: PLBDAG ! Slope parameter of the graupel distribution
+!
+!* 0.2 declaration of local variables
+!
+REAL, DIMENSION(size(PRHODREF)) :: ZZW ! Work array
+REAL, DIMENSION(size(PRHODREF)) :: ZCRIAUTI ! Snow-to-ice autoconversion thres.
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 3.2 compute the homogeneous nucleation source: RCHONI
+!
+ ZZW(:) = 0.0
+ WHERE( (PZT(:)<XTT-35.0) .AND. (PRCT(:)>XRTMIN(2)) .AND. (PRCS(:)>0.) )
+ ZZW(:) = MIN( PRCS(:),XHON*PRHODREF(:)*PRCT(:) &
+ *EXP( MIN(XMNH_HUGE_12_LOG,XALPHA3*(PZT(:)-XTT)-XBETA3) ) )
+ ! *EXP( XALPHA3*(PZT(:)-XTT)-XBETA3 ) )
+ PRIS(:) = PRIS(:) + ZZW(:)
+ PRCS(:) = PRCS(:) - ZZW(:)
+ PTHS(:) = PTHS(:) + ZZW(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(RCHONI))
+ ENDWHERE
+!
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
+ 4,'HON_BU_RTH')
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 7,'HON_BU_RRC')
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 9,'HON_BU_RRI')
+!
+!* 3.3 compute the spontaneous freezing source: RRHONG
+!
+ ZZW(:) = 0.0
+ WHERE( (PZT(:)<XTT-35.0) .AND. (PRRT(:)>XRTMIN(3)) .AND. (PRRS(:)>0.) )
+ ZZW(:) = MIN( PRRS(:),PRRT(:)* PINVTSTEP )
+ PRGS(:) = PRGS(:) + ZZW(:)
+ PRRS(:) = PRRS(:) - ZZW(:)
+ PTHS(:) = PTHS(:) + ZZW(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(RRHONG))
+ ENDWHERE
+!
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
+ 4,'SFR_BU_RTH')
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 8,'SFR_BU_RRR')
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 11,'SFR_BU_RRG')
+!
+!* 3.4 compute the deposition, aggregation and autoconversion sources
+!
+ PKA(:) = 2.38E-2 + 0.0071E-2 * ( PZT(:) - XTT ) ! k_a
+ PDV(:) = 0.211E-4 * (PZT(:)/XTT)**1.94 * (XP00/PPRES(:)) ! D_v
+!
+!* 3.4.1 compute the thermodynamical function A_i(T,P)
+!* and the c^prime_j (in the ventilation factor)
+!
+
+ PAI(:) = EXP( XALPI - XBETAI/PZT(:) - XGAMI*ALOG(PZT(:) ) ) ! es_i
+ PAI(:) = ( XLSTT + (XCPV-XCI)*(PZT(:)-XTT) )**2 / (PKA(:)*XRV*PZT(:)**2) &
+ + ( XRV*PZT(:) ) / (PDV(:)*PAI(:))
+ PCJ(:) = XSCFAC * PRHODREF(:)**0.3 / SQRT( 1.718E-5+0.0049E-5*(PZT(:)-XTT) )
+!
+!* 3.4.2 compute the riming-conversion of r_c for r_i production: RCAUTI
+!
+! ZZW(:) = 0.0
+! ZTIMAUTIC = SQRT( XTIMAUTI*XTIMAUTC )
+! WHERE ( (PRCT(:)>0.0) .AND. (PRIT(:)>0.0) .AND. (PRCS(:)>0.0) )
+! 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))
+! END WHERE
+!
+!* 3.4.3 compute the deposition on r_s: RVDEPS
+!
+ WHERE ( PRST(:)>0.0 )
+ PLBDAS(:) = MIN( XLBDAS_MAX, &
+ XLBS*( PRHODREF(:)*MAX( PRST(:),XRTMIN(5) ) )**XLBEXS )
+ END WHERE
+ ZZW(:) = 0.0
+ WHERE ( (PRST(:)>XRTMIN(5)) .AND. (PRSS(:)>0.0) )
+ ZZW(:) = ( PSSI(:)/(PRHODREF(:)*PAI(:)) ) * &
+ ( X0DEPS*PLBDAS(:)**XEX0DEPS + X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS )
+ ZZW(:) = MIN( PRVS(:),ZZW(:) )*(0.5+SIGN(0.5,ZZW(:))) &
+ - MIN( PRSS(:),ABS(ZZW(:)) )*(0.5-SIGN(0.5,ZZW(:)))
+ PRSS(:) = PRSS(:) + ZZW(:)
+ PRVS(:) = PRVS(:) - ZZW(:)
+ PTHS(:) = PTHS(:) + ZZW(:)*PLSFACT(:)
+ END WHERE
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
+ 4,'DEPS_BU_RTH')
+ IF (LBUDGET_RV) CALL BUDGET ( &
+ UNPACK(PRVS(:),MASK=OMICRO(:,:,:),FIELD=PRVS3D)*PRHODJ3D(:,:,:), &
+ 6,'DEPS_BU_RRV')
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 10,'DEPS_BU_RRS')
+!
+!* 3.4.4 compute the aggregation on r_s: RIAGGS
+!
+ ZZW(:) = 0.0
+ WHERE ( (PRIT(:)>XRTMIN(4)) .AND. (PRST(:)>XRTMIN(5)) .AND. (PRIS(:)>0.0) )
+ ZZW(:) = MIN( PRIS(:),XFIAGGS * EXP( XCOLEXIS*(PZT(:)-XTT) ) &
+ * PRIT(:) &
+ * PLBDAS(:)**XEXIAGGS &
+ * PRHODREF(:)**(-XCEXVT) )
+ PRSS(:) = PRSS(:) + ZZW(:)
+ PRIS(:) = PRIS(:) - ZZW(:)
+ END WHERE
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 9,'AGGS_BU_RRI')
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 10,'AGGS_BU_RRS')
+!
+!* 3.4.5 compute the autoconversion of r_i for r_s production: RIAUTS
+!
+! ZCRIAUTI(:)=MIN(XCRIAUTI,10**(0.06*(PZT(:)-XTT)-3.5))
+ ZCRIAUTI(:)=MIN(XCRIAUTI,10**(XACRIAUTI*(PZT(:)-XTT)+XBCRIAUTI))
+ ZZW(:) = 0.0
+ WHERE ( (PRIT(:)>XRTMIN(4)) .AND. (PRIS(:)>0.0) )
+ ZZW(:) = MIN( PRIS(:),XTIMAUTI * EXP( XTEXAUTI*(PZT(:)-XTT) ) &
+ * MAX( PRIT(:)-ZCRIAUTI(:),0.0 ) )
+ PRSS(:) = PRSS(:) + ZZW(:)
+ PRIS(:) = PRIS(:) - ZZW(:)
+ END WHERE
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 9,'AUTS_BU_RRI')
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 10,'AUTS_BU_RRS')
+!
+!* 3.4.6 compute the deposition on r_g: RVDEPG
+!
+!
+ WHERE ( PRGT(:)>0.0 )
+ PLBDAG(:) = XLBG*( PRHODREF(:)*MAX( PRGT(:),XRTMIN(6) ) )**XLBEXG
+ END WHERE
+ ZZW(:) = 0.0
+ WHERE ( (PRGT(:)>XRTMIN(6)) .AND. (PRGS(:)>0.0) )
+ ZZW(:) = ( PSSI(:)/(PRHODREF(:)*PAI(:)) ) * &
+ ( X0DEPG*PLBDAG(:)**XEX0DEPG + X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG )
+ ZZW(:) = MIN( PRVS(:),ZZW(:) )*(0.5+SIGN(0.5,ZZW(:))) &
+ - MIN( PRGS(:),ABS(ZZW(:)) )*(0.5-SIGN(0.5,ZZW(:)))
+ PRGS(:) = PRGS(:) + ZZW(:)
+ PRVS(:) = PRVS(:) - ZZW(:)
+ PTHS(:) = PTHS(:) + ZZW(:)*PLSFACT(:)
+ END WHERE
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
+ 4,'DEPG_BU_RTH')
+ IF (LBUDGET_RV) CALL BUDGET ( &
+ UNPACK(PRVS(:),MASK=OMICRO(:,:,:),FIELD=PRVS3D)*PRHODJ3D(:,:,:), &
+ 6,'DEPG_BU_RRV')
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 11,'DEPG_BU_RRG')
+!
+END SUBROUTINE RAIN_ICE_SLOW
+
+END MODULE MODE_RAIN_ICE_SLOW
diff --git a/src/MNH/rain_ice_warm.f90 b/src/MNH/rain_ice_warm.f90
new file mode 100644
index 0000000000000000000000000000000000000000..d83fad363c1beddefca094af98daad3a0d2e1d1f
--- /dev/null
+++ b/src/MNH/rain_ice_warm.f90
@@ -0,0 +1,237 @@
+!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.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
+!-----------------------------------------------------------------
+MODULE MODE_RAIN_ICE_WARM
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC :: RAIN_ICE_WARM
+
+CONTAINS
+
+SUBROUTINE RAIN_ICE_WARM(OMICRO, 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)
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use MODD_BUDGET, only: LBUDGET_RC, LBUDGET_RR, LBUDGET_RV, LBUDGET_TH
+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_MSG
+!
+use MODI_BUDGET
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, DIMENSION(:,:,:), intent(in) :: OMICRO ! Test where to compute all processes
+REAL, DIMENSION(:), intent(in) :: PRHODREF ! RHO Dry REFerence
+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) :: PHLC_HCF ! HLCLOUDS : fraction of High Cloud Fraction in grid
+REAL, DIMENSION(:), intent(in) :: PHLC_LCF ! HLCLOUDS : fraction of Low Cloud Fraction in grid
+REAL, DIMENSION(:), intent(in) :: PHLC_HRC ! HLCLOUDS : LWC that is High LWC in grid
+REAL, DIMENSION(:), intent(in) :: PHLC_LRC ! HLCLOUDS : LWC that is Low LWC in grid
+REAL, DIMENSION(:), intent(in) :: PRHODJ ! RHO times Jacobian
+REAL, DIMENSION(:), intent(in) :: PPRES ! Pressure
+REAL, DIMENSION(:), intent(in) :: PZT ! Temperature
+REAL, DIMENSION(:), intent(in) :: PLBDAR ! Slope parameter of the raindrop distribution
+REAL, DIMENSION(:), intent(in) :: PLBDAR_RF! Slope parameter of the raindrop distribution
+ ! for the Rain Fraction part
+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) :: 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
+REAL, DIMENSION(:), INTENT(INOUT) :: PTHS ! Theta source
+!PW: PUSW could be a purely local variable?
+REAL, DIMENSION(:), INTENT(INOUT) :: PUSW ! Undersaturation over water
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
+!
+!* 0.2 declaration of local variables
+!
+REAL, DIMENSION(size(PRHODREF)) :: ZZW ! Work array
+REAL, DIMENSION(size(PRHODREF)) :: ZZW2 ! Work array
+REAL, DIMENSION(size(PRHODREF)) :: ZZW3 ! Work array
+REAL, DIMENSION(size(PRHODREF)) :: ZZW4 ! Work array
+!
+!-------------------------------------------------------------------------------
+!
+!* 4.2 compute the autoconversion of r_c for r_r production: RCAUTR
+!
+
+ WHERE( PRCS(:)>0.0 .AND. PHLC_HCF(:).GT.0.0 )
+ ZZW(:) = XTIMAUTC*MAX( PHLC_HRC(:)/PHLC_HCF(:) - XCRIAUTC/PRHODREF(:),0.0)
+ ZZW(:) = MIN( PRCS(:),PHLC_HCF(:)*ZZW(:))
+ PRCS(:) = PRCS(:) - ZZW(:)
+ PRRS(:) = PRRS(:) + ZZW(:)
+ END WHERE
+!
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 7,'AUTO_BU_RRC')
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 8,'AUTO_BU_RRR')
+!
+!* 4.3 compute the accretion of r_c for r_r production: RCACCR
+!
+ IF (CSUBG_RC_RR_ACCR=='NONE') THEN
+ !CLoud water and rain are diluted over the grid box
+ WHERE( PRCT(:)>XRTMIN(2) .AND. PRRT(:)>XRTMIN(3) .AND. PRCS(:)>0.0 )
+ ZZW(:) = MIN( PRCS(:), XFCACCR * PRCT(:) &
+ * PLBDAR(:)**XEXCACCR &
+ * PRHODREF(:)**(-XCEXVT) )
+ PRCS(:) = PRCS(:) - ZZW(:)
+ PRRS(:) = PRRS(:) + ZZW(:)
+ END WHERE
+
+ ELSEIF (CSUBG_RC_RR_ACCR=='PRFR') THEN
+ !Cloud water is concentrated over its fraction with possibly to parts with high and low content as set for autoconversion
+ !Rain is concnetrated over its fraction
+ !Rain in high content area fraction: PHLC_HCF
+ !Rain in low content area fraction:
+ ! 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
+ ZZW(:) = 0.
+ WHERE( PHLC_HRC(:)>XRTMIN(2) .AND. PRRT(:)>XRTMIN(3) .AND. PRCS(:)>0.0 &
+ .AND. PHLC_HCF(:)>0 )
+ !Accretion due to rain falling in high cloud content
+ ZZW(:) = XFCACCR * ( PHLC_HRC(:)/PHLC_HCF(:) ) &
+ * PLBDAR_RF(:)**XEXCACCR &
+ * PRHODREF(:)**(-XCEXVT) &
+ * PHLC_HCF
+ END WHERE
+ WHERE( PHLC_LRC(:)>XRTMIN(2) .AND. PRRT(:)>XRTMIN(3) .AND. PRCS(:)>0.0 &
+ .AND. PHLC_LCF(:)>0 )
+ !We add acrretion due to rain falling in low cloud content
+ ZZW(:) = ZZW(:) + XFCACCR * ( PHLC_LRC(:)/PHLC_LCF(:) ) &
+ * PLBDAR_RF(:)**XEXCACCR &
+ * PRHODREF(:)**(-XCEXVT) &
+ * (MIN(PCF(:), PRF(:))-PHLC_HCF(:))
+ END WHERE
+ ZZW(:)=MIN(PRCS(:), ZZW(:))
+ PRCS(:) = PRCS(:) - ZZW(:)
+ PRRS(:) = PRRS(:) + ZZW(:)
+
+ ELSE
+ !wrong CSUBG_RC_RR_ACCR case
+ WRITE(*,*) 'wrong CSUBG_RC_RR_ACCR case'
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE_WARM','')
+ ENDIF
+
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 7,'ACCR_BU_RRC')
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 8,'ACCR_BU_RRR')
+!
+!* 4.4 compute the evaporation of r_r: RREVAV
+!
+ ZZW(:) = 0.0
+
+ IF (CSUBG_RR_EVAP=='NONE') THEN
+ !Evaporation only when there's no cloud (RC must be 0)
+ WHERE( (PRRT(:)>XRTMIN(3)) .AND. (PRCT(:)<=XRTMIN(2)) )
+ ZZW(:) = EXP( XALPW - XBETAW/PZT(:) - XGAMW*ALOG(PZT(:) ) ) ! es_w
+ PUSW(:) = 1.0 - PRVT(:)*( PPRES(:)-ZZW(:) ) / ( (XMV/XMD) * ZZW(:) )
+ ! Undersaturation over water
+ ZZW(:) = ( XLVTT+(XCPV-XCL)*(PZT(:)-XTT) )**2 / ( PKA(:)*XRV*PZT(:)**2 ) &
+ + ( XRV*PZT(:) ) / ( PDV(:)*ZZW(:) )
+ ZZW(:) = MIN( PRRS(:),( MAX( 0.0,PUSW(:) )/(PRHODREF(:)*ZZW(:)) ) * &
+ ( X0EVAR*PLBDAR(:)**XEX0EVAR+X1EVAR*PCJ(:)*PLBDAR(:)**XEX1EVAR ) )
+ PRRS(:) = PRRS(:) - ZZW(:)
+ PRVS(:) = PRVS(:) + ZZW(:)
+ PTHS(:) = PTHS(:) - ZZW(:)*PLVFACT(:)
+ END WHERE
+
+ ELSEIF (CSUBG_RR_EVAP=='CLFR' .OR. CSUBG_RR_EVAP=='PRFR') THEN
+ !Evaporation in clear sky part
+ !With CLFR, rain is diluted over the grid box
+ !With PRFR, rain is concentrated in its fraction
+ !Use temperature and humidity in clear sky part like Bechtold et al. (1993)
+ IF (CSUBG_RR_EVAP=='CLFR') THEN
+ ZZW4(:)=1. !Precipitation fraction
+ ZZW3(:)=PLBDAR(:)
+ ELSE
+ ZZW4(:)=PRF(:) !Precipitation fraction
+ ZZW3(:)=PLBDAR_RF(:)
+ ENDIF
+
+ !ATTENTION
+ !Il faudrait recalculer les variables PKA, PDV, PCJ en tenant compte de la température T^u
+ !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
+
+ WHERE( (PRRT(:)>XRTMIN(3)) .AND. ( ZZW4(:) > PCF(:) ) )
+ ! outside the cloud (environment) the use of T^u (unsaturated) instead of T
+ ! Bechtold et al. 1993
+ !
+ ! T^u = T_l = theta_l * (T/theta)
+ ZZW2(:) = PTHLT(:) * PZT(:) / PTHT(:)
+ !
+ ! es_w with new T^u
+ ZZW(:) = EXP( XALPW - XBETAW/ZZW2(:) - XGAMW*ALOG(ZZW2(:) ) )
+ !
+ ! S, Undersaturation over water (with new theta^u)
+ PUSW(:) = 1.0 - PRVT(:)*( PPRES(:)-ZZW(:) ) / ( (XMV/XMD) * ZZW(:) )
+ !
+ ZZW(:) = ( XLVTT+(XCPV-XCL)*(ZZW2(:)-XTT) )**2 / ( PKA(:)*XRV*ZZW2(:)**2 ) &
+ + ( XRV*ZZW2(:) ) / ( PDV(:)*ZZW(:) )
+ !
+ ZZW(:) = MAX( 0.0,PUSW(:) )/(PRHODREF(:)*ZZW(:)) * &
+ ( X0EVAR*ZZW3(:)**XEX0EVAR+X1EVAR*PCJ(:)*ZZW3(:)**XEX1EVAR )
+ !
+ ZZW(:) = MIN( PRRS(:), ZZW(:) *( ZZW4(:) - PCF(:) ) )
+ !
+ PRRS(:) = PRRS(:) - ZZW(:)
+ PRVS(:) = PRVS(:) + ZZW(:)
+ PTHS(:) = PTHS(:) - ZZW(:)*PLVFACT(:)
+ END WHERE
+
+ ELSE
+ !wrong CSUBG_RR_EVAP case
+ WRITE(*,*) 'wrong CSUBG_RR_EVAP case'
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE_WARM','')
+ END IF
+
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
+ 4,'REVA_BU_RTH')
+ IF (LBUDGET_RV) CALL BUDGET ( &
+ UNPACK(PRVS(:),MASK=OMICRO(:,:,:),FIELD=PRVS3D)*PRHODJ3D(:,:,:), &
+ 6,'REVA_BU_RRV')
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
+ 8,'REVA_BU_RRR')
+ PEVAP3D(:,:,:)=UNPACK(ZZW(:),MASK=OMICRO(:,:,:),FIELD=PEVAP3D(:,:,:))
+!
+ END SUBROUTINE RAIN_ICE_WARM
+
+END MODULE MODE_RAIN_ICE_WARM
diff --git a/src/MNH/read_all_data_grib_case.f90 b/src/MNH/read_all_data_grib_case.f90
index 8f4e4835a34e939884aa517bc353b000a844383b..047a7618837fe20f15acf3aa2ad4595b807d3bff 100644
--- a/src/MNH/read_all_data_grib_case.f90
+++ b/src/MNH/read_all_data_grib_case.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1998-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.
!-----------------------------------------------------------------
! #################################
@@ -10,7 +10,7 @@ INTERFACE
SUBROUTINE READ_ALL_DATA_GRIB_CASE(HFILE,TPPRE_REAL1,HGRIB,TPPGDFILE, &
PTIME_HORI,KVERB,ODUMMY_REAL )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
CHARACTER(LEN=4), INTENT(IN) :: HFILE ! which file ('ATM0','ATM1' or 'CHEM')
TYPE(TFILEDATA),POINTER,INTENT(INOUT) :: TPPRE_REAL1 ! PRE_REAL1 file
@@ -75,7 +75,7 @@ END MODULE MODI_READ_ALL_DATA_GRIB_CASE
!! 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
-!! CLUOUT0 : name of output-listing
+!! 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)
@@ -128,17 +128,20 @@ END MODULE MODI_READ_ALL_DATA_GRIB_CASE
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! Pergaud : 2018 add GFS
!! 01/2019 (G.Delautier via Q.Rodier) for GRIB2 ARPEGE and AROME from EPYGRAM
+!! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
!------------
!
USE MODE_DATETIME
-USE MODE_FM, ONLY: IO_FILE_CLOSE_ll
-USE MODE_IO_ll, ONLY: UPCASE
+USE MODE_IO_FILE, ONLY: IO_File_close
USE MODE_MSG
USE MODE_TIME
USE MODE_THERMO
+USE MODE_TOOLS, ONLY: UPCASE
!
USE MODI_READ_HGRID_n
USE MODI_READ_VER_GRID
@@ -152,7 +155,8 @@ USE MODI_CH_AER_INIT_SOA
USE MODI_INI_CTURB
USE MODI_CH_OPEN_INPUT
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_FIELD_n, ONLY: XZWS, XZWS_DEFAULT
USE MODD_CONF
USE MODD_CONF_n
USE MODD_CST
@@ -282,6 +286,7 @@ INTEGER :: ITIME
INTEGER :: IDATE
INTEGER :: ITIMESTEP
CHARACTER(LEN=10) :: CSTEPUNIT
+CHARACTER(LEN=15) :: YVAL
!chemistery field
CHARACTER(LEN=16) :: YPRE_MOC="PRE_MOC1.nam"
INTEGER, DIMENSION(:), ALLOCATABLE :: INUMGRIB, INUMLEV ! grib
@@ -325,6 +330,7 @@ INTEGER :: IMI
TYPE(TFILEDATA),POINTER :: TZFILE
INTEGER, DIMENSION(JP_GFS) :: IP_GFS ! list of pressure levels for GFS model
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/)!
@@ -387,7 +393,7 @@ ALLOCATE (ZYOUT(INO))
IF (HFILE(1:3)=='ATM' .OR. HFILE=='CHEM') THEN
WRITE (ILUOUT0,'(A,A4)') ' -- Grib reader started for ',HFILE
ELSE
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE','bad input argument')
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE','bad input argument')
END IF
!
!* 2.1 Charge in memory the grib messages
@@ -395,16 +401,14 @@ END IF
! open grib file
CALL GRIB_OPEN_FILE(IUNIT,HGRIB,'R',IRET_GRIB)
IF (IRET_GRIB /= 0) THEN
- !callabortstop
WRITE(YMSG,*) 'Error opening the grib file ',TRIM(HGRIB),', error code ', IRET_GRIB
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
! count the messages in the file
CALL GRIB_COUNT_IN_FILE(IUNIT,ICOUNT,IRET_GRIB)
IF (IRET_GRIB /= 0) THEN
- !callabortstop
WRITE(YMSG,*) 'Error in reading the grib file ',TRIM(HGRIB),', error code ', IRET_GRIB
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
ALLOCATE(IGRIB(ICOUNT))
! initialize the tabular with a negativ number
@@ -414,9 +418,8 @@ IGRIB(:)=-12
DO JLOOP=1,ICOUNT
CALL GRIB_NEW_FROM_FILE(IUNIT,IGRIB(JLOOP),IRET_GRIB)
IF (IRET_GRIB /= 0) THEN
- !callabortstop
WRITE(YMSG,*) 'Error in reading the grib file - ILOOP=',JLOOP,' - error code ', IRET_GRIB
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
END DO
! close the grib file
@@ -429,15 +432,13 @@ CALL GRIB_CLOSE_FILE(IUNIT)
!
CALL GRIB_GET(IGRIB(1),'centre',ICENTER,IRET_GRIB)
IF (IRET_GRIB /= 0) THEN
- !callabortstop
WRITE(YMSG,*) 'Error in reading center - error code ', IRET_GRIB
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
CALL GRIB_GET(IGRIB(1),'typeOfGrid',HGRID,IRET_GRIB)
IF (IRET_GRIB /= 0) THEN
- !callabortstop
WRITE(YMSG,*) 'Error in reading type of grid - error code ', IRET_GRIB
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
!
IMODEL = -1
@@ -489,8 +490,7 @@ SELECT CASE (ICENTER)
ALLOCATE(ZPARAM(6))
END SELECT
IF (IMODEL==-1) THEN
-!callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE','unsupported Grib file format')
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE','unsupported Grib file format')
END IF
!
!---------------------------------------------------------------------------------------
@@ -565,6 +565,56 @@ ELSE IF (HFILE=='CHEM') THEN
END IF
DEALLOCATE (ZOUT)
!
+! *** BEGIN MODIF SB ADD HS ***
+!---------------------------------------------------------------------------------------
+!* 2.3 bis Read and interpol Sea Wave significant height
+!---------------------------------------------------------------------------------------
+WRITE (ILUOUT0,'(A)') ' | Searching sea wave significant height'
+SELECT CASE (IMODEL)
+ CASE(0) ! ECMWF
+ ALLOCATE (XZWS(IIU,IJU))
+ GFIND=.FALSE.
+ !
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=140229)
+ IF(INUM < 0) THEN
+ CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=229)
+ !
+ IF(INUM < 0) THEN
+ WRITE (YVAL,'( E15.8 )') XZWS_DEFAULT
+ WRITE (ILUOUT0,'(A)')' | !!! WARNING !!! Sea wave height is missing in '// &
+ 'the GRIB file - the default value of '//TRIM(YVAL)//' meters is used'
+ XZWS = XZWS_DEFAULT
+ ELSE
+ GFIND=.TRUE.
+ END IF
+ ELSE
+ GFIND=.TRUE.
+ END IF
+ !
+ IF(GFIND) THEN
+ !!!!!!!!!!! Faire en sorte de le faire que pour le CASE(0)
+ ! Sea wave significant height disponible uniquement pour ECMWF
+ ! recuperation du tableau de valeurs
+ CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
+ ALLOCATE(IINLO(INJ))
+ CALL COORDINATE_CONVERSION(IMODEL,IGRIB(INUM),IIU,IJU,ZLONOUT,ZLATOUT,&
+ ZXOUT,ZYOUT,INI,ZPARAM,IINLO)
+ ALLOCATE(ZVALUE(ISIZE))
+ CALL GRIB_GET(IGRIB(INUM),'values',ZVALUE)
+ ! Change 9999 value to -1
+ WHERE(ZVALUE.EQ.9999.) ZVALUE=0.
+ ALLOCATE(ZOUT(INO))
+ CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
+ ZVALUE,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE.)
+ DEALLOCATE(IINLO)
+ DEALLOCATE(ZVALUE)
+ ! Stores the field in a 2 dimension array
+ CALL ARRAY_1D_TO_2D (INO,ZOUT,IIU,IJU,XZWS)
+ DEALLOCATE (ZOUT)
+ END IF
+END SELECT
+ ! *** END MODIF SB ADD HS ***
+!
!---------------------------------------------------------------------------------------
!* 2.4 Interpolation surface pressure
!---------------------------------------------------------------------------------------
@@ -583,11 +633,7 @@ SELECT CASE (IMODEL)
CASE(10) ! NCEP
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=134)
END SELECT
-IF(INUM < 0) THEN
- WRITE (ILUOUT0,'(A)')'Surface pressure is missing - abort'
- CALL ABORT
- STOP
-ENDIF
+IF( INUM < 0 ) call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', 'surface pressure is missing' )
! recuperation du tableau de valeurs
CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
ALLOCATE(ZVALUE(ISIZE))
@@ -616,13 +662,12 @@ CALL GRIB_GET(IGRIB(INUM_ZS),'Nj',INJ_ZS)
!
IF ( HGRID(1:7)=='regular' .AND. HGRID_ZS(1:7)=='reduced' .AND.&
INJ == INJ_ZS) THEN
- WRITE (ILUOUT0,'(A)')'HGRID(1:7)==regular .AND. HGRID_ZS(1:7)==reduced .AND. INJ == INJ_ZS - abort'
- CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', &
+ 'HGRID(1:7)==regular .AND. HGRID_ZS(1:7)==reduced .AND. INJ == INJ_ZS' )
ELSE
ALLOCATE(ZWORK_LNPS(SIZE(ZLNPS_G)))
ZWORK_LNPS(:) = ZLNPS_G(:)
-ENDIF
+ENDIF
!
IF (HFILE(1:3)=='ATM') THEN
ALLOCATE (XPS_LS(IIU,IJU))
@@ -682,33 +727,17 @@ IF (IMODEL/=10) THEN
ISTARTLEVEL=0
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IT,KLEV1=ISTARTLEVEL)
ENDIF
- IF(INUM < 0) THEN
- WRITE (ILUOUT0,'(A)')'Air temperature is missing - abort'
- CALL ABORT
- STOP
- ENDIF
+ IF(INUM < 0) call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', 'air temperature is missing' )
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IQ,KLEV1=ISTARTLEVEL)
- IF(INUM < 0) THEN
- WRITE (ILUOUT0,'(A)')'Atmospheric specific humidity is missing - abort'
- CALL ABORT
- STOP
- ENDIF
+ IF(INUM < 0) call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', 'atmospheric specific humidity is missing' )
ELSE ! NCEP
ISTARTLEVEL=10
IT=130
IQ=157
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IT,KLEV1=ISTARTLEVEL)
- IF(INUM < 0) THEN
- WRITE (ILUOUT0,'(A)')'Air temperature is missing - abort'
- CALL ABORT
- STOP
- ENDIF
+ IF(INUM < 0) call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', 'air temperature is missing' )
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IQ,KLEV1=ISTARTLEVEL)
- IF(INUM < 0) THEN
- WRITE (ILUOUT0,'(A)')'Atmospheric relative humidity is missing - abort'
- CALL ABORT
- STOP
- ENDIF
+ IF(INUM < 0) call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', 'atmospheric relative humidity is missing' )
ENDIF
!
IF (IMODEL/=10) THEN ! others than NCEP
@@ -727,16 +756,14 @@ IF (IMODEL/=10) THEN ! others than NCEP
ILEV1 = JLOOP1-1+ISTARTLEVEL
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IQ,KLEV1=ILEV1)
IF (INUM< 0) THEN
- !callabortstop
WRITE(YMSG,*) 'atmospheric humidity level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
CALL GRIB_GET(IGRIB(INUM),'values',ZQ_G(:,INLEVEL-JLOOP1+1))
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IT,KLEV1=ILEV1)
IF (INUM< 0) THEN
- !callabortstop
WRITE(YMSG,*) 'atmospheric temperature level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
CALL GRIB_GET(IGRIB(INUM),'values',ZT_G(:,INLEVEL-JLOOP1+1))
CALL GRIB_GET(IGRIB(INUM),'Nj',INJ,IRET_GRIB)
@@ -746,17 +773,15 @@ ELSE ! NCEP
ILEV1 = IP_GFS(JLOOP1)
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IQ,KLEV1=ILEV1)
IF (INUM< 0) THEN
- !callabortstop
WRITE(YMSG,*) 'atmospheric humidity level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
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)
IF (INUM< 0) THEN
- !callabortstop
WRITE(YMSG,*) 'atmospheric temperature level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
CALL GRIB_GET(IGRIB(INUM),'values',ZT_G(:,JLOOP1),IRET_GRIB)
WRITE (ILUOUT0,*) 'T ',ILEV1,IRET_GRIB
@@ -793,8 +818,7 @@ IF (IMODEL/=10) THEN ! others than NCEP
ALLOCATE(ZPV(IPV))
CALL GRIB_GET(IGRIB(INUM),'pv',ZPV)
ELSE
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE','there is no PV value in this message')
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE','there is no PV value in this message')
ENDIF
SELECT CASE (IMODEL)
CASE (0,3,4,6,7)
@@ -822,8 +846,7 @@ IF (IMODEL/=10) THEN ! others than NCEP
END DO
END SELECT
ELSE
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE','level definition section is missing')
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE','level definition section is missing')
END IF
ELSE
ALLOCATE (XA_LS(INLEVEL))
@@ -1073,9 +1096,8 @@ IF (NRR >1) THEN
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR,KLEV1=ILEV1)
IF (INUM < 0) THEN
- !callabortstop
WRITE(YMSG,*) 'Specific ratio ',IPAR,' at level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
ALLOCATE(ZVALUE(ISIZE))
@@ -1095,9 +1117,8 @@ IF (NRR >1) THEN
CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=6,KNUMBER=6,KLEV1=ILEV1)
IF (INUM < 0) THEN
- !callabortstop
WRITE(YMSG,*) 'Specific ratio ',IPAR,' at level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
ALLOCATE(ZVALUE(ISIZE))
@@ -1115,9 +1136,8 @@ IF (NRR >1) THEN
CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=1,KNUMBER=85,KLEV1=ILEV1)
IF (INUM < 0) THEN
- !callabortstop
WRITE(YMSG,*) 'Specific ratio for rain at level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
ALLOCATE(ZVALUE(ISIZE))
@@ -1135,9 +1155,8 @@ IF (NRR >1) THEN
ILEV1 = JLOOP1-1+ISTARTLEVEL
CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=1,KNUMBER=82,KLEV1=ILEV1)
IF (INUM < 0) THEN
- !callabortstop
WRITE(YMSG,*) 'Specific ratio for ICE at level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
ALLOCATE(ZVALUE(ISIZE))
@@ -1155,9 +1174,8 @@ IF (NRR >1) THEN
ILEV1 = JLOOP1-1+ISTARTLEVEL
CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=1,KNUMBER=86,KLEV1=ILEV1)
IF (INUM < 0) THEN
- !callabortstop
WRITE(YMSG,*) 'Specific ratio ',IPAR,' at level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
ALLOCATE(ZVALUE(ISIZE))
@@ -1175,9 +1193,8 @@ IF (NRR >1) THEN
ILEV1 = JLOOP1-1+ISTARTLEVEL
CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=1,KNUMBER=32,KLEV1=ILEV1)
IF (INUM < 0) THEN
- !callabortstop
WRITE(YMSG,*) 'Specific ratio ',IPAR,' at level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
ALLOCATE(ZVALUE(ISIZE))
@@ -1202,9 +1219,8 @@ IF (CTURB=='TKEL') THEN
CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=19,KNUMBER=11,KLEV1=ILEV1)
END IF
IF (INUM < 0) THEN
- !callabortstop
WRITE(YMSG,*) 'TKE at level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
ALLOCATE(ZVALUE(ISIZE))
@@ -1241,8 +1257,7 @@ IF (IMODEL==5) THEN
DEALLOCATE(XSV_LS)
ALLOCATE (XSV_LS(IIU,IJU,INLEVEL,NSV))
ELSE
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE','Mocage model: Bad input argument in read_all_data_grib_case')
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE','Mocage model: Bad input argument in read_all_data_grib_case')
END IF
XSV_LS(:,:,:,:) = 0.
ILEV1=-1
@@ -1282,7 +1297,7 @@ IF (IMODEL==5) THEN
ENDIF
!
! close file
- CALL IO_FILE_CLOSE_ll(TZFILE)
+ CALL IO_File_close(TZFILE)
TZFILE => NULL()
!
!* 2.6.2 exchange mocage values onto prognostic variables XSV_LS
@@ -1302,9 +1317,8 @@ IF (IMODEL==5) THEN
ILEV1 = JLOOP1
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=INUMGRIB(JN),KLEV1=ILEV1)
IF (INUM < 0) THEN
- !callabortstop
WRITE(YMSG,*) 'Atmospheric ',INUMGRIB(JN),' grib chemical species level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
CALL GRIB_GET(IGRIB(INUM),'Nj',INJ,IRET_GRIB)
ALLOCATE(IINLO(INJ))
@@ -1405,9 +1419,8 @@ DO JLOOP1 = ISTARTLEVEL, ISTARTLEVEL+INLEVEL-1
! read component u
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR,KLEV1=ILEV1)
IF (INUM < 0) THEN
- !callabortstop
WRITE(YMSG,*) 'wind vector component "u" at level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
ALLOCATE(ZVALUE(ISIZE))
@@ -1437,9 +1450,8 @@ DO JLOOP1 = ISTARTLEVEL, ISTARTLEVEL+INLEVEL-1
END IF
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR+1,KLEV1=ILEV1)
IF (INUM < 0) THEN
- !callabortstop
WRITE(YMSG,*) 'wind vector component "v" at level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
ALLOCATE(ZVALUE(ISIZE))
@@ -1660,7 +1672,7 @@ IF (ODUMMY_REAL) THEN
!* 2.10.1 read 2D dummy fields
!
! close file
- CALL IO_FILE_CLOSE_ll(TPPRE_REAL1)
+ CALL IO_File_close(TPPRE_REAL1)
! open input file
CALL CH_OPEN_INPUT(TPPRE_REAL1%CNAME, "DUMMY_2D", TZFILE, ILUOUT0, KVERB)
ICHANNEL = TZFILE%NLU
@@ -1727,7 +1739,7 @@ IF (ODUMMY_REAL) THEN
!
END DO
!
- CALL IO_FILE_CLOSE_ll(TZFILE)
+ CALL IO_File_close(TZFILE)
TZFILE => NULL()
!
IF (NVERB>=10) THEN
@@ -1740,9 +1752,8 @@ IF (ODUMMY_REAL) THEN
!
IF (IVAR /= IMOC) THEN
WRITE (ILUOUT0,'(A,I3,A,I3,A)') ' -> Number of correct lines (',IVAR,') is different of ',IMOC,' - abort'
- !callabortstop
WRITE(YMSG,*) 'number of correct lines (',IVAR,') is different of ',IMOC
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
!
!* 2.10.2 read and interpolate variables onto dummy variables XDUMMY_2D
@@ -1752,9 +1763,8 @@ IF (ODUMMY_REAL) THEN
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR,KLEV1=ILEV1)
IF (INUM < 0) THEN
WRITE (ILUOUT0,'(A,I3,A,I2,A)') ' -> 2D field ',INUMGRIB(JI),' is missing - abort'
- !callabortstop
WRITE(YMSG,*) '2D field ',INUMGRIB(JI),' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
END IF
CALL GRIB_GET(IGRIB(INUM),'Nj',INJ,IRET_GRIB)
ALLOCATE(IINLO(INJ))
@@ -1829,7 +1839,6 @@ INTEGER :: JLOOP2_A1T2
INTEGER :: JPOS_A1T2
!
IF (KN1 < KL1*KL2) THEN
- !callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','ARRAY_1D_TO_2D','sizes do not match')
END IF
JPOS_A1T2 = 1
@@ -1854,8 +1863,6 @@ SUBROUTINE SEARCH_FIELD(KGRIB,KNUM,KPARAM,KDIS,KCAT,KNUMBER,KLEV1)
USE MODD_LUNIT
USE GRIB_API
!
-USE MODE_IO_ll
-!
IMPLICIT NONE
!
!
@@ -1882,14 +1889,15 @@ INTEGER :: ILUOUT0 ! Logical unit number of the listing
ILUOUT0 = TLUOUT0%NLU
!
ISEARCH=0
+! Initialize as not found
+KNUM = -1
+!
IF (PRESENT(KPARAM)) ISEARCH=ISEARCH+1
IF (PRESENT(KDIS)) ISEARCH=ISEARCH+1
IF (PRESENT(KCAT)) ISEARCH=ISEARCH+1
IF (PRESENT(KNUMBER)) ISEARCH=ISEARCH+1
IF (PRESENT(KLEV1)) ISEARCH=ISEARCH+1
-
-
-
+!
DO JLOOP=1,SIZE(KGRIB)
IFOUND = 0
!
@@ -1982,16 +1990,15 @@ DO JLOOP=1,SIZE(KGRIB)
CYCLE
ENDIF
ENDIF
- !
+ !
IF (IFOUND == ISEARCH) THEN
KNUM=JLOOP
EXIT
ELSE ! field not found
KNUM=-1
END IF
-
END DO
-
+!
END SUBROUTINE SEARCH_FIELD
!#################################################################################
SUBROUTINE COORDINATE_CONVERSION(KMODEL,KGRIB,KNOLON,KNOLARG,&
diff --git a/src/MNH/read_all_data_mesonh_case.f90 b/src/MNH/read_all_data_mesonh_case.f90
index 0b619c2a13c02f3d698c93e9e32f93cb49da2153..01c538421733253be7d23140abe417bd99ff1add 100644
--- a/src/MNH/read_all_data_mesonh_case.f90
+++ b/src/MNH/read_all_data_mesonh_case.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -10,7 +10,7 @@ INTERFACE
SUBROUTINE READ_ALL_DATA_MESONH_CASE(TZPRE_REAL1,HFMFILE,TPPGDFILE, &
HDAD_NAME )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
TYPE(TFILEDATA),POINTER, INTENT(INOUT) :: TZPRE_REAL1 !PRE_REAL1 file
CHARACTER(LEN=28), INTENT(IN) :: HFMFILE ! name of the Mesonh input file
@@ -111,9 +111,8 @@ END MODULE MODI_READ_ALL_DATA_MESONH_CASE
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FM
-USE MODE_FMREAD
-USE MODE_IO_ll
+USE MODE_IO_FILE, only: IO_File_close, IO_File_open
+USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_MSG
!
USE MODI_READ_GRID_TIME_MESONH_CASE ! interface modules
@@ -128,7 +127,7 @@ USE MODI_ZS_BOUNDARY
!
USE MODD_CONF ! declaration modules
USE MODD_CONF_n
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAM_n
USE MODD_LUNIT
USE MODD_LUNIT_n
@@ -221,9 +220,9 @@ ZRES = XRES
YOUTFILE=CINIFILE
CINIFILE=HFMFILE
!
-CALL IO_FILE_CLOSE_ll(TZPRE_REAL1)
+CALL IO_File_close(TZPRE_REAL1)
CALL INIT_MNH
-CALL IO_FILE_OPEN_ll(TZPRE_REAL1)
+CALL IO_File_open(TZPRE_REAL1)
!
CINIFILE=YOUTFILE
!
@@ -306,14 +305,14 @@ CALL READ_PRC_FMFILE(IIINF_LS,IISUP_LS,IJINF_LS,IJSUP_LS )
! ---------
!
ALLOCATE(XZS(IISUP_LS-IIINF_LS+1,IJSUP_LS-IJINF_LS+1))
-CALL IO_READ_FIELD(TPPGDFILE,'ZS',XZS)
+CALL IO_Field_read(TPPGDFILE,'ZS',XZS)
CALL ZS_BOUNDARY(XZS,XZS_LS)
!
ALLOCATE(XZSMT(IISUP_LS-IIINF_LS+1,IJSUP_LS-IJINF_LS+1))
IF (TPPGDFILE%NMNHVERSION(1)<4 .OR. (TPPGDFILE%NMNHVERSION(1)==4 .AND. TPPGDFILE%NMNHVERSION(2)<=6)) THEN
XZSMT = XZS
ELSE
- CALL IO_READ_FIELD(TPPGDFILE,'ZSMT',XZSMT)
+ CALL IO_Field_read(TPPGDFILE,'ZSMT',XZSMT)
END IF
CALL ZS_BOUNDARY(XZSMT,XZSMT_LS)
!
diff --git a/src/MNH/read_chem_data_netcdf_case.f90 b/src/MNH/read_chem_data_netcdf_case.f90
index 23bf979a709323cd5287553be47e3d15d46d4087..778b9e29c97c92e0e4d788fff847280ba6944660 100644
--- a/src/MNH/read_chem_data_netcdf_case.f90
+++ b/src/MNH/read_chem_data_netcdf_case.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2012-2017 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2012-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.
!-----------------------------------------------------------------
! ################################
@@ -10,7 +10,7 @@ INTERFACE
SUBROUTINE READ_CHEM_DATA_NETCDF_CASE(TPPRE_REAL1,HFILE,TPPGDFILE, &
PTIME_HORI,KVERB,ODUMMY_REAL )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+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
@@ -71,7 +71,7 @@ END MODULE MODI_READ_CHEM_DATA_NETCDF_CASE
!! 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
-!! CLUOUT0 : name of output-listing
+!! 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)
@@ -83,6 +83,8 @@ END MODULE MODI_READ_CHEM_DATA_NETCDF_CASE
!! Original 23/01/12 (C. Mari)
!! A. Berger 20/03/12 adapt whatever the chemical mechanism in BASIC
!! P. Wautelet 30/10/17 use F90 module for netCDF
+!! J.Pianezzej 13/02/2019 : correction for use of MEGAN
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -99,26 +101,26 @@ USE MODD_CST
USE MODD_DIM_n
USE MODD_GRID
USE MODD_GRID_n
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT, ONLY: TLUOUT0
USE MODE_MODELN_HANDLER
-USE MODD_NETCDF, ONLY:IDCDF_KIND
USE MODD_NSV
USE MODD_PARAMETERS
-USE MODD_PARAM_n, ONLY : CTURB
+USE MODD_PARAM_n, ONLY: CTURB
+USE MODD_PRECISION, ONLY: CDFINT
USE MODD_PREP_REAL
USE MODD_TIME
USE MODD_TIME_n
!
-USE MODE_FM
-USE MODE_IO_ll
+USE MODE_IO_FILE, only: IO_File_close
USE MODE_MPPDB
USE MODE_THERMO
USE MODE_TIME
+USE MODE_TOOLS, ONLY: UPCASE
!
USE MODI_CH_AER_INIT_SOA
USE MODI_CH_INIT_SCHEME_n
-USE MODI_CH_OPEN_INPUT
+USE MODI_CH_OPEN_INPUT
USE MODI_HORIBL
USE MODI_INI_NSV
USE MODI_READ_HGRID_n
@@ -188,12 +190,12 @@ TYPE(TFILEDATA),POINTER :: TZFILE
!
! For netcdf
!
-integer(kind=IDCDF_KIND) :: status, ncid, varid
-integer(kind=IDCDF_KIND) :: lat_varid, lon_varid, lev_varid, time_varid
-integer(kind=IDCDF_KIND) :: hyam_varid, hybm_varid, p0_varid, t_varid, q_varid, ps_varid
-integer(kind=IDCDF_KIND) :: recid, latid, lonid, levid, timeid
-integer(kind=IDCDF_KIND) :: latlen, lonlen, levlen, nrecs,timelen
-integer(kind=IDCDF_KIND) :: itimeindex, KILEN, jrec
+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, jrec
CHARACTER(LEN=40) :: recname
REAL, DIMENSION(:), ALLOCATABLE :: lats
REAL, DIMENSION(:), ALLOCATABLE :: lons
@@ -389,7 +391,7 @@ ELSEIF (CDUMMY1=="12") THEN
itimeindex=2
ELSEIF (CDUMMY1=="18") THEN
itimeindex=3
-ELSEIF (CDUMMY1=="24") THEN
+ELSEIF ((CDUMMY1=="24").OR.(CDUMMY1=="00")) THEN
itimeindex=4
ENDIF
start3d(4) = itimeindex
@@ -728,7 +730,7 @@ if (status /= nf90_noerr) call handle_err(status)
! close
! file
-CALL IO_FILE_CLOSE_ll(TZFILE)
+CALL IO_File_close(TZFILE)
!-------------------------------------------------------------
@@ -760,15 +762,18 @@ WRITE (ILUOUT0,'(A,A4,A)') ' -- netcdf decoder for ',HFILE,' file ended successf
!
CONTAINS
!
-! #############################
- SUBROUTINE HANDLE_ERR(STATUS)
-! #############################
- INTEGER(KIND=IDCDF_KIND) STATUS
- IF (STATUS .NE. NF90_NOERR) THEN
- PRINT *, NF90_STRERROR(STATUS)
- STOP 'Stopped'
- ENDIF
- END SUBROUTINE HANDLE_ERR
+! #############################
+ subroutine handle_err(status)
+! #############################
+ use mode_msg
+
+ integer(kind=CDFINT) status
+
+ if ( status /= NF90_NOERR ) then
+ call Print_msg( NVERB_FATAL, 'IO', 'HANDLE_ERR', NF90_STRERROR(status) )
+ end if
+
+ end subroutine handle_err
!
!
! #############################################
diff --git a/src/MNH/read_desfmn.f90 b/src/MNH/read_desfmn.f90
index 86cde7c7452ef41297279fee4a21aabe068e89fa..294bafd4550f4587cd8e8d6d913b82d3aee35b64 100644
--- a/src/MNH/read_desfmn.f90
+++ b/src/MNH/read_desfmn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ######################
@@ -22,7 +22,7 @@ INTERFACE
KRIMX,KRIMY,KSV_USER, &
HTURB,HTOM,ORMC01,HRAD,HDCONV,HSCONV,HCLOUD,HELEC,HEQNSYS )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
!
INTEGER, INTENT(IN) :: KMI ! Model index
@@ -196,7 +196,7 @@ END MODULE MODI_READ_DESFM_n
!
!* 0. DECLARATIONS
! ------------
-USE MODD_IO_ll, ONLY: NVERB_FATAL, TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_PARAMETERS
!
diff --git a/src/MNH/read_dummy_gr_fieldn.f90 b/src/MNH/read_dummy_gr_fieldn.f90
index be766bd67b5efec20925e2b75e27a9a556ddf911..cd3e1b1570fff1d8f23d33a82dc91a0a92efe3e4 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-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -11,7 +11,7 @@ INTERFACE
!
SUBROUTINE READ_DUMMY_GR_FIELD_n(TPINIFILE,KIINF,KISUP,KJINF,KJSUP,OREAD_ALL)
!
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY : TFILEDATA
!
!* 0.1 declarations of arguments
!
@@ -74,12 +74,12 @@ END MODULE MODI_READ_DUMMY_GR_FIELD_n
!* 0. DECLARATIONS
!
USE MODD_DUMMY_GR_FIELD_n
-USE MODE_FIELD, ONLY : TFIELDDATA,TYPEINT,TYPEREAL
+USE MODE_FIELD, ONLY: TFIELDDATA, TYPEINT, TYPEREAL
USE MODD_GRID_n
-USE MODD_IO_ll, ONLY : TFILEDATA
-USE MODD_PARAMETERS, ONLY : JPHEXT, NMNHNAMELGTMAX
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_PARAMETERS, ONLY: JPHEXT, NMNHNAMELGTMAX
!
-USE MODE_FMREAD
+USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_MSG
!
IMPLICIT NONE
@@ -134,8 +134,8 @@ ELSE
IJINF = KJINF
IJSUP = KJSUP
!
- CALL IO_READ_FIELD(TPINIFILE,'IMAX',IIWORK)
- CALL IO_READ_FIELD(TPINIFILE,'JMAX',IJWORK)
+ CALL IO_Field_read(TPINIFILE,'IMAX',IIWORK)
+ CALL IO_Field_read(TPINIFILE,'JMAX',IJWORK)
!
ALLOCATE(ZWORK(IIWORK+2*JPHEXT,IJWORK+2*JPHEXT))
END IF
@@ -158,7 +158,7 @@ IF (TPINIFILE%NMNHVERSION(1)>=4) THEN
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
!
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,NDUMMY_GR_NBR,IRESP)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,NDUMMY_GR_NBR,IRESP)
!
IF (IRESP/=0) THEN
!callabortstop
@@ -189,7 +189,7 @@ DO JDUMMY=1,NDUMMY_GR_NBR
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
!
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,ZWORK(:,:),IRESP)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,ZWORK(:,:),IRESP)
!
IF (IRESP/=0) THEN
!callabortstop
diff --git a/src/MNH/read_exsegn.f90 b/src/MNH/read_exsegn.f90
index e8f0e9d738b2c9c6fe179715410d8ec5850e9f33..075e87d75cd8d9fa54a8e620bd48956803a021dd 100644
--- a/src/MNH/read_exsegn.f90
+++ b/src/MNH/read_exsegn.f90
@@ -23,7 +23,7 @@ INTERFACE
HTURB,HTOM,ORMC01,HRAD,HDCONV,HSCONV,HCLOUD,HELEC, &
HEQNSYS,PTSTEP_ALL,HSTORAGE_TYPE,HINIFILEPGD )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KMI ! Model index
TYPE(TFILEDATA), INTENT(IN) :: TPEXSEGFILE ! EXSEG file
@@ -291,6 +291,8 @@ END MODULE MODI_READ_EXSEG_n
!! Modification 01/2019 (Q. Rodier) define XCEDIS depending on BL89 or RM17 mixing length
!! Modification 01/2019 (P. Wautelet) bugs correction: incorrect writes
!! 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
!!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -299,7 +301,7 @@ USE MODD_PARAMETERS
USE MODD_CONF
USE MODD_CONFZ
USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_VAR_ll, ONLY: NPROC
!
@@ -352,7 +354,6 @@ USE MODD_GET_n
USE MODD_GR_FIELD_n
!
USE MODE_POS
-USE MODE_IO_ll
USE MODE_MSG
!
USE MODI_TEST_NAM_VAR
@@ -1030,7 +1031,7 @@ SELECT CASE ( CCLOUD )
WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE A 2-MOMENT MICROPHYSICAL ", &
&" SCHEME BUT YOU DIDNT FILL CORRECTLY NAM_PARAM_LIMA", &
&" YOU HAVE TO FILL FINI_CCN ")')
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'READ_EXSEG_n', '' )
END IF
!
IF(LACTI .AND. NMOD_CCN == 0) THEN
@@ -1038,7 +1039,7 @@ SELECT CASE ( CCLOUD )
WRITE(UNIT=ILUOUT,FMT='("ACTIVATION OF AEROSOL PARTICLES IS NOT ", &
&"POSSIBLE IF NMOD_CCN HAS VALUE ZERO. YOU HAVE TO SET AN UPPER ", &
&"VALUE OF NMOD_CCN IN ORDER TO USE LIMA WARM ACTIVATION SCHEME.")')
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'READ_EXSEG_n', '' )
END IF
!
IF(LNUCL .AND. NMOD_IFN == 0 .AND. (.NOT.LMEYERS)) THEN
@@ -1418,6 +1419,12 @@ ELSE
END IF
END IF
!
+IF(CTURBLEN=='RM17') THEN
+ XCEDIS=0.34
+ELSE
+ XCEDIS=0.84
+END IF
+!
!* 3.3 Moist turbulence
!
IF ( LUSERC .AND. CTURB /= 'NONE' ) THEN
@@ -1739,6 +1746,7 @@ END IF
IF (LSALT) THEN
IF (OSALT) THEN
CGETSVT(NSV_SLTBEG:NSV_SLTEND)='READ'
+ CGETZWS='READ'
! IF(CCONF=='START') CGETSVT(NSV_SLTBEG:NSV_SLTEND)='INIT'
ELSE
WRITE(UNIT=ILUOUT,FMT=9001) KMI
@@ -1746,6 +1754,7 @@ IF (LSALT) THEN
&SCHEME IN INITIAL FMFILE",/,&
& "THE SALT VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
CGETSVT(NSV_SLTBEG:NSV_SLTEND)='INIT'
+ CGETZWS='INIT'
END IF
IF (LDEPOS_SLT(KMI)) THEN
@@ -1770,9 +1779,9 @@ IF (LSALT) THEN
CGETSVT(NSV_SLTDEPBEG:NSV_SLTDEPEND)='INIT'
END IF
END IF
- IF(NMODE_SLT.GT.3 .OR. NMODE_SLT.LT.1) THEN
+ IF(NMODE_SLT.GT.5 .OR. NMODE_SLT.LT.1) THEN
WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(UNIT=ILUOUT,FMT='("SALT MODES MUST BE BETWEEN 1 and 3 ")')
+ WRITE(UNIT=ILUOUT,FMT='("SALT MODES MUST BE BETWEEN 1 and 5 ")')
!callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
END IF
@@ -1806,7 +1815,7 @@ IF (LSALT) THEN
IF(.NOT.ALLOCATED(CDESLTNAMES)) THEN
ALLOCATE(CDESLTNAMES(NMODE_SLT*2))
DO JMODE=1,NMODE_SLT
- IMODEIDX=JPDUSTORDER(JMODE)
+ IMODEIDX=JPSALTORDER(JMODE)
CDESLTNAMES(JMODE) = YPDESLT_INI(IMODEIDX)
CDESLTNAMES(NMODE_SLT+JMODE) = YPDESLT_INI(NMODE_SLT+IMODEIDX)
ENDDO
diff --git a/src/MNH/read_exspa.f90 b/src/MNH/read_exspa.f90
index 4ca2bb66d8340c77e30723e2a2d109702ceba621..f2b15fa20424d42bb1a3d96e232ad0ad479b5926 100644
--- a/src/MNH/read_exspa.f90
+++ b/src/MNH/read_exspa.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1996-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
!######################
@@ -94,6 +94,7 @@ END MODULE MODI_READ_EXSPA
!! Modification 30/03/12 (S.Bielli) add NAM_NCOUT for netcdf output (removed 08/07/2016)
!! Modification 08/07/2016 (P.Wautelet) removed MNH_NCWRIT define
!! 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
!
!-------------------------------------------------------------------------------
!
@@ -101,13 +102,13 @@ END MODULE MODI_READ_EXSPA
! ------------
!
USE MODD_CONF
-USE MODD_IO_ll, ONLY : TFILEDATA,TFILE_OUTPUTLISTING
+USE MODD_IO, ONLY : TFILEDATA,TFILE_OUTPUTLISTING
USE MODD_LUNIT_n, ONLY : LUNIT_MODEL
USE MODD_PARAMETERS
!
-USE MODE_FM, ONLY : IO_FILE_OPEN_ll,IO_FILE_CLOSE_ll
-USE MODE_IO_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY : IO_FILE_ADD2LIST
+USE MODE_IO, only: IO_Config_set
+USE MODE_IO_FILE, only: IO_File_open, IO_File_close
+USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
USE MODE_POS
USE MODE_MODELN_HANDLER
!
@@ -201,17 +202,16 @@ YSPANBR = '00'
YDADINIFILE = ' '
YDADSPAFILE = ' '
!
-LUNIT_MODEL(2)%CLUOUT = 'OUTPUT_LISTING2'
-CALL IO_FILE_ADD2LIST(LUNIT_MODEL(2)%TLUOUT,LUNIT_MODEL(2)%CLUOUT,'OUTPUTLISTING','WRITE')
-CALL IO_FILE_OPEN_ll(LUNIT_MODEL(2)%TLUOUT)
+CALL IO_File_add2list(LUNIT_MODEL(2)%TLUOUT,'OUTPUT_LISTING2','OUTPUTLISTING','WRITE')
+CALL IO_File_open(LUNIT_MODEL(2)%TLUOUT)
!
!Set output file for PRINT_MSG
TFILE_OUTPUTLISTING => LUNIT_MODEL(2)%TLUOUT
!
ILUOUT=LUNIT_MODEL(2)%TLUOUT%NLU
!
-CALL IO_FILE_ADD2LIST(TZNMLFILE,'SPAWN1.nam','NML','READ')
-CALL IO_FILE_OPEN_ll(TZNMLFILE)
+CALL IO_File_add2list(TZNMLFILE,'SPAWN1.nam','NML','READ')
+CALL IO_File_open(TZNMLFILE)
ILUSPA = TZNMLFILE%NLU
!
!
@@ -239,8 +239,8 @@ LUNIT_MODEL(2)%CINIFILEPGD = CINIFILEPGD
CALL POSNAM(ILUSPA,'NAM_CONFIO',GFOUND,ILUOUT)
IF (GFOUND) READ(ILUSPA,NAM_CONFIO)
!
-CALL SET_CONFIO_ll()
-CALL IO_FILE_CLOSE_ll(TZNMLFILE)
+CALL IO_Config_set()
+CALL IO_File_close(TZNMLFILE)
!
!
!* 3. model 1 and SON1 FM file name (passed as arguments)
diff --git a/src/MNH/read_field.f90 b/src/MNH/read_field.f90
index 10730a3ead87e0d0197687351e0b17f8e5ce34fd..a6523b5d5916d74be0ba7dc13a90343ac83cae1e 100644
--- a/src/MNH/read_field.f90
+++ b/src/MNH/read_field.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -8,42 +8,40 @@
!
INTERFACE
!
- SUBROUTINE READ_FIELD(TPINIFILE,KIU,KJU,KKU,PTSTEP, &
- HGETTKET,HGETRVT,HGETRCT,HGETRRT,HGETRIT,HGETCIT, &
+ SUBROUTINE READ_FIELD(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, &
HTEMP_SCHEME,KSIZELBX_ll,KSIZELBXU_ll,KSIZELBY_ll,KSIZELBYV_ll, &
KSIZELBXTKE_ll,KSIZELBYTKE_ll, &
KSIZELBXR_ll,KSIZELBYR_ll,KSIZELBXSV_ll,KSIZELBYSV_ll, &
PUM,PVM,PWM,PDUM,PDVM,PDWM, &
- PUT,PVT,PWT,PTHT,PPABST,PPABSM,PTKET,PRTKEMS, &
- PRT,PSVT,PCIT,PDRYMASST, &
+ PUT,PVT,PWT,PTHT,PPABST,PTKET,PRTKEMS, &
+ PRT,PSVT,PZWS,PCIT,PDRYMASST, &
PSIGS,PSRCT,PCLDFR,PBL_DEPTH,PSBL_DEPTH,PWTHVMF,PPHC,PPHR, &
- PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM, &
+ PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM, PLSZWSM, &
PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, &
PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, &
KFRC,TPDTFRC,PUFRC,PVFRC,PWFRC,PTHFRC,PRVFRC, &
PTENDTHFRC,PTENDRVFRC,PGXTHFRC,PGYTHFRC,PPGROUNDFRC,PATC, &
- PTENDUFRC,PTENDVFRC, &
+ PTENDUFRC,PTENDVFRC, &
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 )
!
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY : TFILEDATA
USE MODD_TIME ! for type DATE_TIME
!
!
TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE !Initial file
INTEGER, INTENT(IN) :: KIU, KJU, KKU
! array sizes in x, y and z directions
-REAL, INTENT(IN) :: PTSTEP
- ! current Time STEP
!
CHARACTER (LEN=*), INTENT(IN) :: HGETTKET, &
HGETRVT,HGETRCT,HGETRRT, &
HGETRIT,HGETRST,HGETRGT,HGETRHT, &
- HGETCIT,HGETSRCT, &
+ HGETCIT,HGETSRCT, HGETZWS, &
HGETSIGS,HGETCLDFR,HGETBL_DEPTH, &
HGETSBL_DEPTH,HGETPHC,HGETPHR
CHARACTER (LEN=*), DIMENSION(:),INTENT(IN) :: HGETSVT
@@ -72,9 +70,9 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PUT,PVT,PWT ! U,V,W at t
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHT,PTKET ! theta, tke and
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRTKEMS ! tke adv source
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPABST ! pressure at t
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPABSM ! pressure at t-1
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PRT,PSVT ! moist and scalar
! variables at t
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PZWS
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCT ! turbulent flux
! <s'Rc'> at t
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCIT ! ice conc. at t
@@ -88,6 +86,7 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPHR ! pH value in rainwate
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSUM,PLSVM,PLSWM ! Wind
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSTHM, PLSRVM ! Mass
! LB fields
+REAL, DIMENSION(:,:), INTENT(OUT) :: PLSZWSM ! significant height of sea waves
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXUM,PLBXVM,PLBXWM ! Wind
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXTHM ! Mass
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYUM,PLBYVM,PLBYWM ! Wind
@@ -124,23 +123,23 @@ END INTERFACE
END MODULE MODI_READ_FIELD
!
! ########################################################################
- SUBROUTINE READ_FIELD(TPINIFILE,KIU,KJU,KKU,PTSTEP, &
- HGETTKET,HGETRVT,HGETRCT,HGETRRT,HGETRIT,HGETCIT, &
+ SUBROUTINE READ_FIELD(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, &
HTEMP_SCHEME,KSIZELBX_ll,KSIZELBXU_ll,KSIZELBY_ll,KSIZELBYV_ll, &
KSIZELBXTKE_ll,KSIZELBYTKE_ll, &
KSIZELBXR_ll,KSIZELBYR_ll,KSIZELBXSV_ll,KSIZELBYSV_ll, &
PUM,PVM,PWM,PDUM,PDVM,PDWM, &
- PUT,PVT,PWT,PTHT,PPABST,PPABSM,PTKET,PRTKEMS, &
- PRT,PSVT,PCIT,PDRYMASST, &
+ PUT,PVT,PWT,PTHT,PPABST,PTKET,PRTKEMS, &
+ PRT,PSVT,PZWS,PCIT,PDRYMASST, &
PSIGS,PSRCT,PCLDFR,PBL_DEPTH,PSBL_DEPTH,PWTHVMF,PPHC,PPHR, &
- PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM, &
+ PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM,PLSZWSM, &
PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, &
PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, &
KFRC,TPDTFRC,PUFRC,PVFRC,PWFRC,PTHFRC,PRVFRC, &
PTENDTHFRC,PTENDRVFRC,PGXTHFRC,PGYTHFRC,PPGROUNDFRC,PATC, &
- PTENDUFRC,PTENDVFRC, &
+ PTENDUFRC,PTENDVFRC, &
KADVFRC,TPDTADVFRC,PDTHFRC,PDRVFRC, &
KRELFRC,TPDTRELFRC, PTHREL, PRVREL, &
PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLUX_M, &
@@ -237,6 +236,10 @@ END MODULE MODI_READ_FIELD
!! 09/2017 Q.Rodier add LTEND_UV_FRC
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! V. Vionnet 07/17 add blowing snow scheme
+!! P. Wautelet 01/2019 corrected intent of PDUM,PDVM,PDWM (OUT->INOUT)
+! 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
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -251,6 +254,7 @@ USE MODD_CST
USE MODD_CTURB
USE MODD_DUST
USE MODD_ELEC_DESCR, ONLY: CELECNAMES
+USE MODD_FIELD_n, only: XZWS_DEFAULT
#ifdef MNH_FOREFIRE
USE MODD_FOREFIRE
#endif
@@ -258,7 +262,7 @@ USE MODD_BLOWSNOW
USE MODD_BLOWSNOW_n
USE MODD_ICE_C1R3_DESCR, ONLY: C1R3NAMES
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LATZ_EDFLX
USE MODD_LG, ONLY: CLGNAMES
USE MODD_LUNIT_N, ONLY: TLUOUT
@@ -276,10 +280,10 @@ USE MODD_RAIN_C2R2_DESCR, ONLY: C2R2NAMES
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_FMREAD
-USE MODE_IO_ll, ONLY: UPCASE
+USE MODE_FIELD, ONLY: TFIELDDATA, TFIELDLIST, FIND_FIELD_ID_FROM_MNHNAME, TYPEDATE, TYPEREAL
+USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_MSG
+USE MODE_TOOLS, ONLY: UPCASE
!
USE MODI_INI_LB
USE MODI_INI_LS
@@ -293,13 +297,11 @@ IMPLICIT NONE
TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE !Initial file
INTEGER, INTENT(IN) :: KIU, KJU, KKU
! array sizes in x, y and z directions
-REAL, INTENT(IN) :: PTSTEP
- ! current Time STEP
!
CHARACTER (LEN=*), INTENT(IN) :: HGETTKET, &
HGETRVT,HGETRCT,HGETRRT, &
HGETRIT,HGETRST,HGETRGT,HGETRHT, &
- HGETCIT,HGETSRCT, &
+ HGETCIT,HGETSRCT,HGETZWS, &
HGETSIGS,HGETCLDFR,HGETBL_DEPTH, &
HGETSBL_DEPTH,HGETPHC,HGETPHR
CHARACTER (LEN=*), DIMENSION(:),INTENT(IN) :: HGETSVT
@@ -320,7 +322,7 @@ INTEGER, INTENT(IN) :: KSIZELBYTKE_ll ! for TKE
INTEGER, INTENT(IN) :: KSIZELBYR_ll,KSIZELBYSV_ll ! for Rx and SV
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PUM,PVM,PWM ! U,V,W at t-dt
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDUM,PDVM,PDWM ! Difference on U,V,W
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDUM,PDVM,PDWM ! Difference on U,V,W
! between t+dt and t-dt
REAL, DIMENSION(:,:), INTENT(OUT) :: PBL_DEPTH ! BL depth
REAL, DIMENSION(:,:), INTENT(OUT) :: PSBL_DEPTH ! SBL depth
@@ -330,9 +332,9 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PUT,PVT,PWT ! U,V,W at t
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHT,PTKET ! theta, tke and
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRTKEMS ! tke adv source
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPABST ! pressure at t
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPABSM ! pressure at t-1
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PRT,PSVT ! moist and scalar
! variables at t
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PZWS
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCT ! turbulent flux
! <s'Rc'> at t
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCIT ! ice conc. at t
@@ -345,6 +347,7 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPHR ! pH value in rainwate
!
!
! Larger Scale fields
+REAL, DIMENSION(:,:), INTENT(OUT) :: PLSZWSM ! significant height of sea waves
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSUM,PLSVM,PLSWM ! Wind
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSTHM, PLSRVM ! Mass
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXUM,PLBXVM,PLBXWM ! Wind
@@ -390,6 +393,7 @@ INTEGER :: JT ! loop index
LOGICAL :: GLSOURCE ! switch for the source term (for ini_ls and ini_lb)
CHARACTER(LEN=2) :: INDICE
CHARACTER(LEN=3) :: YFRC ! To mark the different forcing dates
+CHARACTER(LEN=15) :: YVAL
REAL, DIMENSION(KIU,KJU,KKU) :: ZWORK ! to compute supersaturation
TYPE(TFIELDDATA) :: TZFIELD
!
@@ -412,33 +416,33 @@ IF (TPINIFILE%NMNHVERSION(1)<5) THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('UT',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CMNHNAME = 'UM'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PUT)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PUT)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('VT',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CMNHNAME = 'VM'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PVT)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PVT)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('WT',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CMNHNAME = 'WM'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PWT)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PWT)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('THT',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CMNHNAME = 'THM'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PTHT)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PTHT)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('PABST',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CMNHNAME = 'PABSM'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PPABST)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PPABST)
ELSE
- CALL IO_READ_FIELD(TPINIFILE,'UT',PUT)
- CALL IO_READ_FIELD(TPINIFILE,'VT',PVT)
- CALL IO_READ_FIELD(TPINIFILE,'WT',PWT)
- CALL IO_READ_FIELD(TPINIFILE,'THT',PTHT)
- CALL IO_READ_FIELD(TPINIFILE,'PABST',PPABST)
+ CALL IO_Field_read(TPINIFILE,'UT',PUT)
+ CALL IO_Field_read(TPINIFILE,'VT',PVT)
+ CALL IO_Field_read(TPINIFILE,'WT',PWT)
+ CALL IO_Field_read(TPINIFILE,'THT',PTHT)
+ CALL IO_Field_read(TPINIFILE,'PABST',PPABST)
ENDIF
!
SELECT CASE(HGETTKET)
@@ -447,28 +451,43 @@ SELECT CASE(HGETTKET)
CALL FIND_FIELD_ID_FROM_MNHNAME('TKET',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CMNHNAME = 'TKEM'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PTKET)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PTKET)
ELSE
- CALL IO_READ_FIELD(TPINIFILE,'TKET',PTKET)
+ CALL IO_Field_read(TPINIFILE,'TKET',PTKET)
END IF
IF ( ( (TPINIFILE%NMNHVERSION(1)==5 .AND. TPINIFILE%NMNHVERSION(2)>0) .OR. TPINIFILE%NMNHVERSION(1)>5 ) &
.AND. (CCONF == 'RESTA') .AND. LSPLIT_CFL) THEN
- CALL IO_READ_FIELD(TPINIFILE,'TKEMS',PRTKEMS)
+ CALL IO_Field_read(TPINIFILE,'TKEMS',PRTKEMS)
END IF
CASE('INIT')
PTKET(:,:,:) = XTKEMIN
PRTKEMS(:,:,:) = 0.
END SELECT
!
+SELECT CASE(HGETZWS)
+ CASE('READ')
+ CALL IO_Field_read(TPINIFILE,'ZWS',PZWS,IRESP)
+ !If the field ZWS is not in the file, set its value to XZWS_DEFAULT
+ !ZWS is present in files since MesoNH 5.4.2
+ IF ( IRESP/=0 ) THEN
+ WRITE (YVAL,'( E15.8 )') XZWS_DEFAULT
+ CALL PRINT_MSG(NVERB_WARNING,'IO','READ_FIELD','ZWS not found in file: using default value: '//TRIM(YVAL)//' m')
+ PZWS(:,:) = XZWS_DEFAULT
+ END IF
+
+ CASE('INIT')
+ PZWS(:,:)=0.
+END SELECT
+!
SELECT CASE(HGETRVT) ! vapor
CASE('READ')
IF (TPINIFILE%NMNHVERSION(1)<5) THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('RVT',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CMNHNAME = 'RVM'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RVT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RVT))
ELSE
- CALL IO_READ_FIELD(TPINIFILE,'RVT',PRT(:,:,:,IDX_RVT))
+ CALL IO_Field_read(TPINIFILE,'RVT',PRT(:,:,:,IDX_RVT))
END IF
CASE('INIT')
PRT(:,:,:,IDX_RVT) = 0.
@@ -480,9 +499,9 @@ SELECT CASE(HGETRCT) ! cloud
CALL FIND_FIELD_ID_FROM_MNHNAME('RCT',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CMNHNAME = 'RCM'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RCT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RCT))
ELSE
- CALL IO_READ_FIELD(TPINIFILE,'RCT',PRT(:,:,:,IDX_RCT))
+ CALL IO_Field_read(TPINIFILE,'RCT',PRT(:,:,:,IDX_RCT))
END IF
CASE('INIT')
PRT(:,:,:,IDX_RCT) = 0.
@@ -494,9 +513,9 @@ SELECT CASE(HGETRRT) ! rain
CALL FIND_FIELD_ID_FROM_MNHNAME('RRT',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CMNHNAME = 'RRM'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RRT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RRT))
ELSE
- CALL IO_READ_FIELD(TPINIFILE,'RRT',PRT(:,:,:,IDX_RRT))
+ CALL IO_Field_read(TPINIFILE,'RRT',PRT(:,:,:,IDX_RRT))
END IF
CASE('INIT')
PRT(:,:,:,IDX_RRT) = 0.
@@ -508,9 +527,9 @@ SELECT CASE(HGETRIT) ! cloud ice
CALL FIND_FIELD_ID_FROM_MNHNAME('RIT',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CMNHNAME = 'RIM'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RIT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RIT))
ELSE
- CALL IO_READ_FIELD(TPINIFILE,'RIT',PRT(:,:,:,IDX_RIT))
+ CALL IO_Field_read(TPINIFILE,'RIT',PRT(:,:,:,IDX_RIT))
END IF
CASE('INIT')
PRT(:,:,:,IDX_RIT) = 0.
@@ -522,9 +541,9 @@ SELECT CASE(HGETRST) ! snow
CALL FIND_FIELD_ID_FROM_MNHNAME('RST',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CMNHNAME = 'RSM'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RST))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RST))
ELSE
- CALL IO_READ_FIELD(TPINIFILE,'RST',PRT(:,:,:,IDX_RST))
+ CALL IO_Field_read(TPINIFILE,'RST',PRT(:,:,:,IDX_RST))
END IF
CASE('INIT')
PRT(:,:,:,IDX_RST) = 0.
@@ -536,9 +555,9 @@ SELECT CASE(HGETRGT) ! graupel
CALL FIND_FIELD_ID_FROM_MNHNAME('RGT',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CMNHNAME = 'RGM'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RGT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RGT))
ELSE
- CALL IO_READ_FIELD(TPINIFILE,'RGT',PRT(:,:,:,IDX_RGT))
+ CALL IO_Field_read(TPINIFILE,'RGT',PRT(:,:,:,IDX_RGT))
END IF
CASE('INIT')
PRT(:,:,:,IDX_RGT) = 0.
@@ -550,9 +569,9 @@ SELECT CASE(HGETRHT) ! hail
CALL FIND_FIELD_ID_FROM_MNHNAME('RHT',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CMNHNAME = 'RHM'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RHT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RHT))
ELSE
- CALL IO_READ_FIELD(TPINIFILE,'RHT',PRT(:,:,:,IDX_RHT))
+ CALL IO_Field_read(TPINIFILE,'RHT',PRT(:,:,:,IDX_RHT))
END IF
CASE('INIT')
PRT(:,:,:,IDX_RHT) = 0.
@@ -560,7 +579,7 @@ END SELECT
!
SELECT CASE(HGETCIT) ! ice concentration
CASE('READ')
- IF (SIZE(PCIT) /= 0 ) CALL IO_READ_FIELD(TPINIFILE,'CIT',PCIT)
+ IF (SIZE(PCIT) /= 0 ) CALL IO_Field_read(TPINIFILE,'CIT',PCIT)
CASE('INIT')
PCIT(:,:,:)=0.
END SELECT
@@ -584,7 +603,7 @@ IF (NSV_USER>0) THEN
WRITE(TZFIELD%CMNHNAME,'(A3,I3.3)')'SVT',JSV
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME)
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
CASE ('INIT')
PSVT(:,:,:,JSV) = 0.
END SELECT
@@ -606,7 +625,7 @@ IF (NSV_C2R2END>=NSV_C2R2BEG) THEN
TZFIELD%CMNHNAME = TRIM(C2R2NAMES(JSV-NSV_C2R2BEG+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
CASE ('INIT')
PSVT(:,:,:,JSV) = 0.
IF (LSUPSAT .AND. (HGETRVT == 'READ') ) THEN
@@ -637,7 +656,7 @@ IF (NSV_C1R3END>=NSV_C1R3BEG) THEN
TZFIELD%CMNHNAME = TRIM(C1R3NAMES(JSV-NSV_C1R3BEG+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
CASE ('INIT')
PSVT(:,:,:,JSV) = 0.
END SELECT
@@ -707,7 +726,7 @@ DO JSV = NSV_LIMA_BEG,NSV_LIMA_END
END IF
!
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
CASE ('INIT')
PSVT(:,:,:,JSV) = 0.
END SELECT
@@ -733,7 +752,7 @@ IF (NSV_ELECEND>=NSV_ELECBEG) THEN
TZFIELD%CUNITS = 'm-3'
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3,A8)')'X_Y_Z_','SVT',JSV,' (nb ions/m3)'
END IF
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
CASE ('INIT')
PSVT(:,:,:,JSV) = 0.
END SELECT
@@ -756,7 +775,7 @@ IF (NSV_CHGSEND>=NSV_CHGSBEG) THEN
TZFIELD%CMNHNAME = TRIM(CNAMES(JSV-NSV_CHGSBEG+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','CHIM',JSV
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
CASE ('INIT')
PSVT(:,:,:,JSV) = 0.
END SELECT
@@ -780,7 +799,7 @@ IF (NSV_CHACEND>=NSV_CHACBEG) THEN
TZFIELD%CMNHNAME = TRIM(CNAMES(JSV-NSV_CHACBEG+NSV_CHGS+1))//'M'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3,A4)')'X_Y_Z_','CHAQ',JSV,' (M)'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
!***ATTENTION: BUG ? field written with a M suffix, read with a T suffix
CASE ('INIT')
PSVT(:,:,:,JSV) = 0.
@@ -804,7 +823,7 @@ IF (NSV_CHICEND>=NSV_CHICBEG) THEN
TZFIELD%CMNHNAME = TRIM(CICNAMES(JSV-NSV_CHICBEG+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
CASE ('INIT')
PSVT(:,:,:,JSV) = 0.
END SELECT
@@ -826,7 +845,7 @@ IF (NSV_SLTEND>=NSV_SLTBEG) THEN
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_READ_FIELD(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
CASE ('INIT')
PSVT(:,:,:,JSV) = 0.
END SELECT
@@ -848,7 +867,7 @@ IF (NSV_SLTDEPEND>=NSV_SLTDEPBEG) THEN
TZFIELD%CMNHNAME = TRIM(CDESLTNAMES(JSV-NSV_SLTDEPBEG+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
CASE ('INIT')
PSVT(:,:,:,JSV) = 0.
END SELECT
@@ -870,7 +889,7 @@ IF (NSV_DSTEND>=NSV_DSTBEG) THEN
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_READ_FIELD(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
CASE ('INIT')
PSVT(:,:,:,JSV) = 0.
END SELECT
@@ -892,7 +911,7 @@ IF (NSV_DSTDEPEND>=NSV_DSTDEPBEG) THEN
TZFIELD%CMNHNAME = TRIM(CDEDSTNAMES(JSV-NSV_DSTDEPBEG+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
CASE ('INIT')
PSVT(:,:,:,JSV) = 0.
END SELECT
@@ -914,7 +933,7 @@ IF (NSV_AEREND>=NSV_AERBEG) THEN
TZFIELD%CMNHNAME = TRIM(UPCASE(CAERONAMES(JSV-NSV_AERBEG+1)))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
CASE ('INIT')
PSVT(:,:,:,JSV) = 0.
END SELECT
@@ -936,7 +955,7 @@ IF (NSV_AERDEPEND>=NSV_AERDEPBEG) THEN
TZFIELD%CMNHNAME = TRIM(CDEAERNAMES(JSV-NSV_AERDEPBEG+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
CASE ('INIT')
PSVT(:,:,:,JSV) = 0.
END SELECT
@@ -958,7 +977,7 @@ IF (NSV_LGEND>=NSV_LGBEG) THEN
TZFIELD%CMNHNAME = TRIM(CLGNAMES(JSV-NSV_LGBEG+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
CASE ('INIT')
PSVT(:,:,:,JSV) = 0.
END SELECT
@@ -980,7 +999,7 @@ IF (NSV_PPEND>=NSV_PPBEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'kg kg-1'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV),IRESP)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV),IRESP)
IF (IRESP/=0) THEN
PSVT(:,:,:,JSV) = 0.
END IF
@@ -989,7 +1008,7 @@ IF (NSV_PPEND>=NSV_PPBEG) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','ATC',JSV+NSV_PPBEG-1
TZFIELD%CUNITS = 'm-3'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PATC(:,:,:,JSV-NSV_PPBEG+1),IRESP)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PATC(:,:,:,JSV-NSV_PPBEG+1),IRESP)
IF (IRESP/=0) THEN
PATC(:,:,:,JSV-NSV_PPBEG+1) = 0.
ENDIF
@@ -1016,7 +1035,7 @@ IF (NSV_FFEND>=NSV_FFBEG) THEN
WRITE(TZFIELD%CMNHNAME,'(A3,I3.3)')'SVT',JSV
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME)
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV),IRESP)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV),IRESP)
IF (IRESP /= 0) THEN
PSVT(:,:,:,JSV) = 0.
END IF
@@ -1042,7 +1061,7 @@ IF (NSV_CSEND>=NSV_CSBEG) THEN
WRITE(TZFIELD%CMNHNAME,'(A3,I3.3)')'SVT',JSV
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME)
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV),IRESP)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV),IRESP)
IF (IRESP /= 0) THEN
PSVT(:,:,:,JSV) = 0.
END IF
@@ -1067,7 +1086,7 @@ IF (NSV_LNOXEND>=NSV_LNOXBEG) THEN
TZFIELD%CMNHNAME = 'LINOXT'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)') 'X_Y_Z_','SVT',JSV
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
CASE ('INIT')
PSVT(:,:,:,JSV) = 0.
END SELECT
@@ -1088,7 +1107,7 @@ IF (NSV_SNWEND>=NSV_SNWBEG) THEN
TZFIELD%CMNHNAME = TRIM(CSNOWNAMES(JSV-NSV_SNWBEG+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)') 'X_Y_Z_','SVT',JSV
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
CASE ('INIT')
PSVT(:,:,:,JSV) = 0.
END SELECT
@@ -1108,7 +1127,7 @@ IF (NSV_SNW>=1) THEN
WRITE(TZFIELD%CMNHNAME,'(A10,I3.3)')'SNOWCANO_M',JSV
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A8,I3.3)') 'X_Y_Z_','SNOWCANO',JSV
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,XSNWCANO(:,:,JSV))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,XSNWCANO(:,:,JSV))
CASE ('INIT')
XSNWCANO(:,:,JSV) = 0.
END SELECT
@@ -1119,28 +1138,28 @@ END IF
!
IF (CCONF == 'RESTA') THEN
IF (CTEMP_SCHEME/='LEFR') THEN
- CALL IO_READ_FIELD(TPINIFILE,'US_PRES',PRUS_PRES)
- CALL IO_READ_FIELD(TPINIFILE,'VS_PRES',PRVS_PRES)
- CALL IO_READ_FIELD(TPINIFILE,'WS_PRES',PRWS_PRES)
+ CALL IO_Field_read(TPINIFILE,'US_PRES',PRUS_PRES)
+ CALL IO_Field_read(TPINIFILE,'VS_PRES',PRVS_PRES)
+ CALL IO_Field_read(TPINIFILE,'WS_PRES',PRWS_PRES)
END IF
IF (LSPLIT_CFL) THEN
- CALL IO_READ_FIELD(TPINIFILE,'THS_CLD',PRTHS_CLD)
+ CALL IO_Field_read(TPINIFILE,'THS_CLD',PRTHS_CLD)
DO JRR = 1, SIZE(PRT,4)
SELECT CASE(JRR)
CASE (1)
- CALL IO_READ_FIELD(TPINIFILE,'RVS_CLD',PRRS_CLD(:,:,:,JRR))
+ CALL IO_Field_read(TPINIFILE,'RVS_CLD',PRRS_CLD(:,:,:,JRR))
CASE (2)
- CALL IO_READ_FIELD(TPINIFILE,'RCS_CLD',PRRS_CLD(:,:,:,JRR))
+ CALL IO_Field_read(TPINIFILE,'RCS_CLD',PRRS_CLD(:,:,:,JRR))
CASE (3)
- CALL IO_READ_FIELD(TPINIFILE,'RRS_CLD',PRRS_CLD(:,:,:,JRR))
+ CALL IO_Field_read(TPINIFILE,'RRS_CLD',PRRS_CLD(:,:,:,JRR))
CASE (4)
- CALL IO_READ_FIELD(TPINIFILE,'RIS_CLD',PRRS_CLD(:,:,:,JRR))
+ CALL IO_Field_read(TPINIFILE,'RIS_CLD',PRRS_CLD(:,:,:,JRR))
CASE (5)
- CALL IO_READ_FIELD(TPINIFILE,'RSS_CLD',PRRS_CLD(:,:,:,JRR))
+ CALL IO_Field_read(TPINIFILE,'RSS_CLD',PRRS_CLD(:,:,:,JRR))
CASE (6)
- CALL IO_READ_FIELD(TPINIFILE,'RGS_CLD',PRRS_CLD(:,:,:,JRR))
+ CALL IO_Field_read(TPINIFILE,'RGS_CLD',PRRS_CLD(:,:,:,JRR))
CASE (7)
- CALL IO_READ_FIELD(TPINIFILE,'RHS_CLD',PRRS_CLD(:,:,:,JRR))
+ CALL IO_Field_read(TPINIFILE,'RHS_CLD',PRRS_CLD(:,:,:,JRR))
CASE DEFAULT
CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_FIELD','PRT is too big')
END SELECT
@@ -1157,7 +1176,7 @@ IF (CCONF == 'RESTA') THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PRSVS_CLD(:,:,:,JSV))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PRSVS_CLD(:,:,:,JSV))
END IF
IF (JSV == NSV_C2R2BEG ) THEN
TZFIELD%CMNHNAME = 'RSVS_CLD2'
@@ -1170,7 +1189,7 @@ IF (CCONF == 'RESTA') THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PRSVS_CLD(:,:,:,JSV))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PRSVS_CLD(:,:,:,JSV))
END IF
END DO
END IF
@@ -1181,12 +1200,12 @@ END IF
IF (CPROGRAM=='MESONH' .AND. HUVW_ADV_SCHEME(1:3)=='CEN' .AND. &
HTEMP_SCHEME == 'LEFR' ) THEN
IF (CCONF=='RESTA') THEN
- CALL IO_READ_FIELD(TPINIFILE,'UM', PUM)
- CALL IO_READ_FIELD(TPINIFILE,'VM', PVM)
- CALL IO_READ_FIELD(TPINIFILE,'WM', PWM)
- CALL IO_READ_FIELD(TPINIFILE,'DUM',PDUM)
- CALL IO_READ_FIELD(TPINIFILE,'DVM',PDVM)
- CALL IO_READ_FIELD(TPINIFILE,'DWM',PDWM)
+ CALL IO_Field_read(TPINIFILE,'UM', PUM)
+ CALL IO_Field_read(TPINIFILE,'VM', PVM)
+ CALL IO_Field_read(TPINIFILE,'WM', PWM)
+ CALL IO_Field_read(TPINIFILE,'DUM',PDUM)
+ CALL IO_Field_read(TPINIFILE,'DVM',PDVM)
+ CALL IO_Field_read(TPINIFILE,'DWM',PDWM)
ELSE
PUM = PUT
PVM = PVT
@@ -1197,7 +1216,7 @@ END IF
!* 2.2a 3D LS fields
!
!
-CALL INI_LS(TPINIFILE,HGETRVT,GLSOURCE,PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM)
+CALL INI_LS(TPINIFILE,HGETRVT,GLSOURCE,PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM,PLSZWSM)
!
!
!* 2.2b 2D "surfacic" LB fields
@@ -1215,39 +1234,39 @@ CALL INI_LB(TPINIFILE,GLSOURCE,ISV, &
!
!* 2.3 Some special variables:
!
-CALL IO_READ_FIELD(TPINIFILE,'DRYMASST',PDRYMASST) ! dry mass
+CALL IO_Field_read(TPINIFILE,'DRYMASST',PDRYMASST) ! dry mass
!
SELECT CASE(HGETSRCT) ! turbulent flux SRC at time t
CASE('READ')
- CALL IO_READ_FIELD(TPINIFILE,'SRCT',PSRCT)
+ CALL IO_Field_read(TPINIFILE,'SRCT',PSRCT)
CASE('INIT')
PSRCT(:,:,:)=0.
END SELECT
!
SELECT CASE(HGETSIGS) ! subgrid condensation
CASE('READ')
- CALL IO_READ_FIELD(TPINIFILE,'SIGS',PSIGS)
+ CALL IO_Field_read(TPINIFILE,'SIGS',PSIGS)
CASE('INIT')
PSIGS(:,:,:)=0.
END SELECT
!
SELECT CASE(HGETPHC) ! pH in cloud water
CASE('READ')
- CALL IO_READ_FIELD(TPINIFILE,'PHC',PPHC)
+ CALL IO_Field_read(TPINIFILE,'PHC',PPHC)
CASE('INIT')
PPHC(:,:,:)=0.
END SELECT
!
SELECT CASE(HGETPHR) ! pH in rainwater
CASE('READ')
- CALL IO_READ_FIELD(TPINIFILE,'PHR',PPHR)
+ CALL IO_Field_read(TPINIFILE,'PHR',PPHR)
CASE('INIT')
PPHR(:,:,:)=0.
END SELECT
!
IRESP=0
IF(HGETCLDFR=='READ') THEN ! cloud fraction
- CALL IO_READ_FIELD(TPINIFILE,'CLDFR',PCLDFR,IRESP)
+ CALL IO_Field_read(TPINIFILE,'CLDFR',PCLDFR,IRESP)
ENDIF
IF(HGETCLDFR=='INIT' .OR. IRESP /= 0) THEN
IF(SIZE(PRT,4) > 3) THEN
@@ -1268,7 +1287,7 @@ ENDIF
!* boundary layer depth
!
IF (HGETBL_DEPTH=='READ') THEN
- CALL IO_READ_FIELD(TPINIFILE,'BL_DEPTH',PBL_DEPTH)
+ CALL IO_Field_read(TPINIFILE,'BL_DEPTH',PBL_DEPTH)
ELSE
PBL_DEPTH(:,:)=XUNDEF
END IF
@@ -1276,7 +1295,7 @@ END IF
!* surface boundary layer depth
!
IF (HGETSBL_DEPTH=='READ') THEN
- CALL IO_READ_FIELD(TPINIFILE,'SBL_DEPTH',PSBL_DEPTH)
+ CALL IO_Field_read(TPINIFILE,'SBL_DEPTH',PSBL_DEPTH)
ELSE
PSBL_DEPTH(:,:)=0.
END IF
@@ -1286,7 +1305,7 @@ END IF
SELECT CASE(HGETTKET)
CASE('READ')
IF (CSCONV=='EDKF') THEN
- CALL IO_READ_FIELD(TPINIFILE,'WTHVMF',PWTHVMF)
+ CALL IO_Field_read(TPINIFILE,'WTHVMF',PWTHVMF)
ELSE
PWTHVMF(:,:,:)=0
ENDIF
@@ -1314,7 +1333,7 @@ IF ( LFORCING ) THEN
TZFIELD%NTYPE = TYPEDATE
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,TPDTFRC(JT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,TPDTFRC(JT))
!
TZFIELD%CMNHNAME = 'UFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -1326,7 +1345,7 @@ IF ( LFORCING ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PUFRC(:,JT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PUFRC(:,JT))
!
TZFIELD%CMNHNAME = 'VFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -1338,7 +1357,7 @@ IF ( LFORCING ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PVFRC(:,JT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PVFRC(:,JT))
!
TZFIELD%CMNHNAME = 'WFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -1350,7 +1369,7 @@ IF ( LFORCING ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PWFRC(:,JT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PWFRC(:,JT))
!
TZFIELD%CMNHNAME = 'THFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -1362,7 +1381,7 @@ IF ( LFORCING ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PTHFRC(:,JT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PTHFRC(:,JT))
!
TZFIELD%CMNHNAME = 'RVFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -1374,7 +1393,7 @@ IF ( LFORCING ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PRVFRC(:,JT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PRVFRC(:,JT))
!
TZFIELD%CMNHNAME = 'TENDTHFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -1386,7 +1405,7 @@ IF ( LFORCING ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PTENDTHFRC(:,JT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PTENDTHFRC(:,JT))
!
TZFIELD%CMNHNAME = 'TENDRVFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -1398,7 +1417,7 @@ IF ( LFORCING ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PTENDRVFRC(:,JT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PTENDRVFRC(:,JT))
!
TZFIELD%CMNHNAME = 'GXTHFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -1410,7 +1429,7 @@ IF ( LFORCING ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PGXTHFRC(:,JT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PGXTHFRC(:,JT))
!
TZFIELD%CMNHNAME = 'GYTHFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -1422,7 +1441,7 @@ IF ( LFORCING ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PGYTHFRC(:,JT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PGYTHFRC(:,JT))
!
TZFIELD%CMNHNAME = 'PGROUNDFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -1434,7 +1453,7 @@ IF ( LFORCING ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PPGROUNDFRC(JT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PPGROUNDFRC(JT))
!
TZFIELD%CMNHNAME = 'TENDUFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -1446,7 +1465,7 @@ IF ( LFORCING ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PTENDUFRC(:,JT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PTENDUFRC(:,JT))
!
TZFIELD%CMNHNAME = 'TENDVFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -1458,7 +1477,7 @@ IF ( LFORCING ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PTENDVFRC(:,JT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PTENDVFRC(:,JT))
END DO
END IF
!
@@ -1478,7 +1497,7 @@ IF (L2D_ADV_FRC) THEN
TZFIELD%NTYPE = TYPEDATE
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,TPDTADVFRC(JT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,TPDTADVFRC(JT))
!
TZFIELD%CMNHNAME = 'TH_ADV'//YFRC
TZFIELD%CSTDNAME = ''
@@ -1490,7 +1509,7 @@ IF (L2D_ADV_FRC) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PDTHFRC(:,:,:,JT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PDTHFRC(:,:,:,JT))
!
TZFIELD%CMNHNAME = 'Q_ADV'//YFRC
TZFIELD%CSTDNAME = ''
@@ -1502,7 +1521,7 @@ IF (L2D_ADV_FRC) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PDRVFRC(:,:,:,JT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PDRVFRC(:,:,:,JT))
ENDDO
ENDIF
!
@@ -1521,7 +1540,7 @@ IF (L2D_REL_FRC) THEN
TZFIELD%NTYPE = TYPEDATE
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,TPDTRELFRC(JT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,TPDTRELFRC(JT))
!
! Relaxation
TZFIELD%CMNHNAME = 'TH_REL'//YFRC
@@ -1534,7 +1553,7 @@ IF (L2D_REL_FRC) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PTHREL(:,:,:,JT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PTHREL(:,:,:,JT))
!
TZFIELD%CMNHNAME = 'Q_REL'//YFRC
TZFIELD%CSTDNAME = ''
@@ -1546,13 +1565,13 @@ IF (L2D_REL_FRC) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PRVREL(:,:,:,JT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PRVREL(:,:,:,JT))
ENDDO
ENDIF
!
IF (LUV_FLX) THEN
IF ( CCONF /= 'START' .OR. CPROGRAM=='SPAWN ' ) THEN
- CALL IO_READ_FIELD(TPINIFILE,'VU_FLX',PVU_FLUX_M)
+ CALL IO_Field_read(TPINIFILE,'VU_FLX',PVU_FLUX_M)
ELSE IF (CCONF == 'START') THEN
PVU_FLUX_M(:,:,:)=0.
END IF
@@ -1560,8 +1579,8 @@ ENDIF
!
IF (LTH_FLX) THEN
IF ( CCONF /= 'START' .OR. CPROGRAM=='SPAWN ' ) THEN
- CALL IO_READ_FIELD(TPINIFILE,'VT_FLX',PVTH_FLUX_M)
- CALL IO_READ_FIELD(TPINIFILE,'WT_FLX',PWTH_FLUX_M)
+ CALL IO_Field_read(TPINIFILE,'VT_FLX',PVTH_FLUX_M)
+ CALL IO_Field_read(TPINIFILE,'WT_FLX',PWTH_FLUX_M)
ELSE IF (CCONF == 'START') THEN
PWTH_FLUX_M(:,:,:)=0.
PVTH_FLUX_M(:,:,:)=0.
diff --git a/src/MNH/read_grid_time_mesonh_case.f90 b/src/MNH/read_grid_time_mesonh_case.f90
index 9c2c6669ee73b63f80a483ca4007bcedb86eb5a5..58599b38386dd2225254c6590127c93be7efdf97 100644
--- a/src/MNH/read_grid_time_mesonh_case.f90
+++ b/src/MNH/read_grid_time_mesonh_case.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1996-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -90,15 +90,15 @@ END MODULE MODI_READ_GRID_TIME_MESONH_CASE
USE MODD_CONF
USE MODD_GRID
USE MODD_GRID_n
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT, ONLY: TLUOUT0
USE MODD_PARAMETERS
USE MODD_PREP_REAL
USE MODD_TIME
USE MODD_TIME_n
!
-USE MODE_FMREAD
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_FIND_BYNAME
+USE MODE_IO_FIELD_READ, only: IO_Field_read
+USE MODE_IO_MANAGE_STRUCT, only: IO_File_find_byname
!
USE MODI_DEFAULT_SLEVE
USE MODI_READ_HGRID
@@ -152,12 +152,12 @@ ZEPS=1.E-10
!
!PW: TODO: temporary: look for file from its name
! TPFMFILE should be passed in arguments
-CALL IO_FILE_FIND_BYNAME(HFMFILE,TZFMFILE,IRESP)
+CALL IO_File_find_byname(HFMFILE,TZFMFILE,IRESP)
!
!* 1.1 Original FMfile name
! --------------------
!
-CALL IO_READ_FIELD(TZFMFILE,'DAD_NAME',HDAD_NAME)
+CALL IO_Field_read(TZFMFILE,'DAD_NAME',HDAD_NAME)
!
!-------------------------------------------------------------------------------
!
@@ -167,12 +167,12 @@ CALL IO_READ_FIELD(TZFMFILE,'DAD_NAME',HDAD_NAME)
!* 2.1 Projection :
! ----------
!
-CALL IO_READ_FIELD(TZFMFILE,'LON0',ZLON0_LS)
+CALL IO_Field_read(TZFMFILE,'LON0',ZLON0_LS)
ZLON0_LS =ZLON0_LS +NINT((XLON0 -ZLON0_LS )/360.)*360.
!
-CALL IO_READ_FIELD(TZFMFILE,'RPK', ZRPK_LS)
-CALL IO_READ_FIELD(TZFMFILE,'LAT0',ZLAT0_LS)
-CALL IO_READ_FIELD(TZFMFILE,'BETA',ZBETA_LS)
+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))) &
@@ -215,30 +215,30 @@ END IF
! -------------
!
!
-CALL IO_READ_FIELD(TZFMFILE,'KMAX',ILMAX_LS)
+CALL IO_Field_read(TZFMFILE,'KMAX',ILMAX_LS)
!
ILMAX_LS=ILMAX_LS+2*JPVEXT
!
ALLOCATE(XZHAT_LS(ILMAX_LS))
-CALL IO_READ_FIELD(TZFMFILE,'ZHAT',XZHAT_LS)
+CALL IO_Field_read(TZFMFILE,'ZHAT',XZHAT_LS)
!
CALL DEFAULT_SLEVE(LSLEVE_LS,XLEN1_LS,XLEN2_LS)
IF (TZFMFILE%NMNHVERSION(1)<4 .OR. (TZFMFILE%NMNHVERSION(1)==4 .AND. TZFMFILE%NMNHVERSION(2)<=6)) THEN
LSLEVE_LS = .FALSE.
ELSE
- CALL IO_READ_FIELD(TZFMFILE,'SLEVE',LSLEVE_LS)
+ CALL IO_Field_read(TZFMFILE,'SLEVE',LSLEVE_LS)
IF (LSLEVE_LS) THEN
- CALL IO_READ_FIELD(TZFMFILE,'LEN1',XLEN1_LS)
- CALL IO_READ_FIELD(TZFMFILE,'LEN2',XLEN2_LS)
+ CALL IO_Field_read(TZFMFILE,'LEN1',XLEN1_LS)
+ CALL IO_Field_read(TZFMFILE,'LEN2',XLEN2_LS)
END IF
END IF
!
-CALL IO_READ_FIELD(TZFMFILE,'THINSHELL',LTHINSHELL)
+CALL IO_Field_read(TZFMFILE,'THINSHELL',LTHINSHELL)
!
!* 2.5 Time variables :
! --------------
!
-CALL IO_READ_FIELD(TZFMFILE,'DTCUR',TDTCUR)
+CALL IO_Field_read(TZFMFILE,'DTCUR',TDTCUR)
!
TDTMOD=TDTCUR
TDTSEG=TDTCUR
diff --git a/src/MNH/read_hgrid.f90 b/src/MNH/read_hgrid.f90
index b501ea10088792d607002228cf6c7a30611a220f..26b9881e4dd96a27160ffd4aec883c38abc99446 100644
--- a/src/MNH/read_hgrid.f90
+++ b/src/MNH/read_hgrid.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1996-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -9,7 +9,7 @@
INTERFACE
SUBROUTINE READ_HGRID(KMI,TPFMFILE,HMY_NAME,HDAD_NAME,HSTORAGE_TYPE)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KMI ! model index
TYPE(TFILEDATA), INTENT(IN) :: TPFMFILE ! file n
@@ -80,18 +80,17 @@ END MODULE MODI_READ_HGRID
!
!* 0. DECLARATIONS
!
-USE MODD_CONF, ONLY : CPROGRAM
+USE MODD_CONF, ONLY: CPROGRAM
USE MODD_GRID
-USE MODD_IO_ll, ONLY: TFILEDATA
+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_FM, ONLY : SET_FMPACK_ll
-USE MODE_FMREAD
+USE MODE_FIELD, ONLY: TFIELDDATA, TFIELDLIST, FIND_FIELD_ID_FROM_MNHNAME
+USE MODE_IO, ONLY: IO_Pack_set
+USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_GRIDPROJ
-USE MODE_IO_ll
USE MODE_MSG
USE MODE_MODELN_HANDLER
!
@@ -148,9 +147,9 @@ END IF
!* 2.1 General information :
! -------------------
!
-CALL IO_READ_FIELD(TPFMFILE,'MY_NAME', HMY_NAME)
-CALL IO_READ_FIELD(TPFMFILE,'DAD_NAME', HDAD_NAME)
-CALL IO_READ_FIELD(TPFMFILE,'STORAGE_TYPE',HSTORAGE_TYPE)
+CALL IO_Field_read(TPFMFILE,'MY_NAME', HMY_NAME)
+CALL IO_Field_read(TPFMFILE,'DAD_NAME', HDAD_NAME)
+CALL IO_Field_read(TPFMFILE,'STORAGE_TYPE',HSTORAGE_TYPE)
!
!* 2.2 Grid information :
! ----------------
@@ -159,14 +158,14 @@ CALL IO_READ_FIELD(TPFMFILE,'STORAGE_TYPE',HSTORAGE_TYPE)
!GET_DIM_PHYS_ll impact => 1st one no visible impact
CALL GET_DIM_PHYS_ll ( 'B',NPGDIMAX,NPGDJMAX)
!
-CALL IO_READ_FIELD(TPFMFILE,'LAT0', XLAT0)
-CALL IO_READ_FIELD(TPFMFILE,'LON0', XLON0)
-CALL IO_READ_FIELD(TPFMFILE,'RPK', XRPK)
-CALL IO_READ_FIELD(TPFMFILE,'BETA', XBETA)
-CALL IO_READ_FIELD(TPFMFILE,'LATORI',XPGDLATOR)
-CALL IO_READ_FIELD(TPFMFILE,'LONORI',XPGDLONOR)
-CALL IO_READ_FIELD(TPFMFILE,'IMAX', NPGDIMAX)
-CALL IO_READ_FIELD(TPFMFILE,'JMAX', NPGDJMAX)
+CALL IO_Field_read(TPFMFILE,'LAT0', XLAT0)
+CALL IO_Field_read(TPFMFILE,'LON0', XLON0)
+CALL IO_Field_read(TPFMFILE,'RPK', XRPK)
+CALL IO_Field_read(TPFMFILE,'BETA', XBETA)
+CALL IO_Field_read(TPFMFILE,'LATORI',XPGDLATOR)
+CALL IO_Field_read(TPFMFILE,'LONORI',XPGDLONOR)
+CALL IO_Field_read(TPFMFILE,'IMAX', NPGDIMAX)
+CALL IO_Field_read(TPFMFILE,'JMAX', NPGDJMAX)
!
!20131010 recompute properly NPGDIMAX NPGDJMAX
!GET_DIM_PHYS_ll impact 2nd one => prevent run failures
@@ -175,38 +174,38 @@ CALL GET_DIM_PHYS_ll ( 'B',NPGDIMAX,NPGDJMAX)
IF (.NOT.(ALLOCATED(XPGDXHAT))) ALLOCATE(XPGDXHAT(NPGDIMAX+2*JPHEXT))
IF (.NOT.(ALLOCATED(XPGDYHAT))) ALLOCATE(XPGDYHAT(NPGDJMAX+2*JPHEXT))
!20131023 change FMREAD option '--' -> 'XX' ou 'YY' for // reading
-CALL IO_READ_FIELD(TPFMFILE,'XHAT',XPGDXHAT)
-CALL IO_READ_FIELD(TPFMFILE,'YHAT',XPGDYHAT)
+CALL IO_Field_read(TPFMFILE,'XHAT',XPGDXHAT)
+CALL IO_Field_read(TPFMFILE,'YHAT',XPGDYHAT)
!
!* 3. Read the configuration (MODD_CONF)
!
-CALL IO_READ_FIELD(TPFMFILE,'L1D',G1D,IRESP)
+CALL IO_Field_read(TPFMFILE,'L1D',G1D,IRESP)
IF (IRESP/=0) THEN
G1D=.FALSE.
IF( (NPGDIMAX == 1).AND.(NPGDJMAX == 1) ) G1D=.TRUE.
ENDIF
!
-CALL IO_READ_FIELD(TPFMFILE,'L2D',G2D,IRESP)
+CALL IO_Field_read(TPFMFILE,'L2D',G2D,IRESP)
IF (IRESP/=0) THEN
G2D=.FALSE.
IF( (NPGDIMAX /= 1).AND.(NPGDJMAX == 1) ) G2D=.TRUE.
ENDIF
!
-CALL IO_READ_FIELD(TPFMFILE,'PACK',GPACK,IRESP)
+CALL IO_Field_read(TPFMFILE,'PACK',GPACK,IRESP)
IF (IRESP/=0) GPACK=.TRUE.
!
-CALL SET_FMPACK_ll(G1D,G2D,GPACK)
+CALL IO_Pack_set(G1D,G2D,GPACK)
!-------------------------------------------------------------------------------
IF (TPFMFILE%NMNHVERSION(1)<4 .OR. (TPFMFILE%NMNHVERSION(1)==4 .AND. TPFMFILE%NMNHVERSION(2)<=5)) THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('LONORI',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CMNHNAME = 'LONOR'
- CALL IO_READ_FIELD(TPFMFILE,TZFIELD,XPGDLONOR)
+ CALL IO_Field_read(TPFMFILE,TZFIELD,XPGDLONOR)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('LATORI',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CMNHNAME = 'LATOR'
- CALL IO_READ_FIELD(TPFMFILE,TZFIELD,XPGDLATOR)
+ CALL IO_Field_read(TPFMFILE,TZFIELD,XPGDLATOR)
!
ZXHATM = - 0.5 * (XPGDXHAT(1)+XPGDXHAT(2))
ZYHATM = - 0.5 * (XPGDYHAT(1)+XPGDYHAT(2))
diff --git a/src/MNH/read_hgridn.f90 b/src/MNH/read_hgridn.f90
index 7dd64e89aa3fbb7515b450eeac208a8963b0bfea..0989fed5359ea361bf8667a872ea934124fa094d 100644
--- a/src/MNH/read_hgridn.f90
+++ b/src/MNH/read_hgridn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1996-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -10,7 +10,7 @@
INTERFACE
SUBROUTINE READ_HGRID_n(TPFMFILE,HMY_NAME,HDAD_NAME,HSTORAGE_TYPE)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPFMFILE ! file n
CHARACTER(LEN=28), INTENT(OUT) :: HMY_NAME ! True Name of FM-file
@@ -55,8 +55,8 @@ END MODULE MODI_READ_HGRID_n
!! NJMAX
!! Module MODD_PARAMETERS :
!! JPHEXT
-!! Module MODD_LUNIT :
-!! CLUOUT
+!! Module MODD_LUNIT_n :
+!! TLUOUT
!!
!! REFERENCE
!! ---------
@@ -82,14 +82,14 @@ USE MODD_CONF
USE MODD_DIM_n
USE MODD_GRID
USE MODD_GRID_n
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT_n
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT, JPMODELMAX
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT, JPMODELMAX
!
-USE MODE_FIELD, ONLY : TFIELDDATA,TFIELDLIST,FIND_FIELD_ID_FROM_MNHNAME
-USE MODE_FMREAD
+USE MODE_FIELD, ONLY: TFIELDDATA, TFIELDLIST, FIND_FIELD_ID_FROM_MNHNAME
USE MODE_GRIDPROJ
-USE MODE_IO_ll
+USE MODE_IO, only: IO_Pack_set
+USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_MSG
USE MODE_MODELN_HANDLER
!
@@ -125,9 +125,9 @@ ILUOUT = TLUOUT%NLU
!* 1. General information :
! -------------------
!
-CALL IO_READ_FIELD(TPFMFILE,'MY_NAME', HMY_NAME)
-CALL IO_READ_FIELD(TPFMFILE,'DAD_NAME', HDAD_NAME)
-CALL IO_READ_FIELD(TPFMFILE,'STORAGE_TYPE',HSTORAGE_TYPE)
+CALL IO_Field_read(TPFMFILE,'MY_NAME', HMY_NAME)
+CALL IO_Field_read(TPFMFILE,'DAD_NAME', HDAD_NAME)
+CALL IO_Field_read(TPFMFILE,'STORAGE_TYPE',HSTORAGE_TYPE)
!
!* 2. Grid information :
! ----------------
@@ -136,16 +136,16 @@ IF( (TPFMFILE%NMNHVERSION(1)<4 .OR. (TPFMFILE%NMNHVERSION(1)==4 .AND. TPFMFILE%N
.AND. HSTORAGE_TYPE == 'PG') THEN
LCARTESIAN=.FALSE.
ELSE
- CALL IO_READ_FIELD(TPFMFILE,'CARTESIAN',LCARTESIAN)
+ CALL IO_Field_read(TPFMFILE,'CARTESIAN',LCARTESIAN)
ENDIF
-CALL IO_READ_FIELD(TPFMFILE,'LAT0',ZLAT0)
-CALL IO_READ_FIELD(TPFMFILE,'LON0',ZLON0)
-CALL IO_READ_FIELD(TPFMFILE,'BETA',ZBETA,IRESP)
+CALL IO_Field_read(TPFMFILE,'LAT0',ZLAT0)
+CALL IO_Field_read(TPFMFILE,'LON0',ZLON0)
+CALL IO_Field_read(TPFMFILE,'BETA',ZBETA,IRESP)
IF(IRESP/=0) ZBETA=0.
IF (.NOT.LCARTESIAN ) THEN
- CALL IO_READ_FIELD(TPFMFILE,'RPK', ZRPK)
- CALL IO_READ_FIELD(TPFMFILE,'LATORI',XLATORI)
- CALL IO_READ_FIELD(TPFMFILE,'LONORI',XLONORI)
+ CALL IO_Field_read(TPFMFILE,'RPK', ZRPK)
+ CALL IO_Field_read(TPFMFILE,'LATORI',XLATORI)
+ CALL IO_Field_read(TPFMFILE,'LONORI',XLONORI)
ENDIF
!
IMI = GET_CURRENT_MODEL_INDEX()
@@ -184,9 +184,9 @@ IF (CPROGRAM/='IDEAL ') THEN
! b) and arrays XXHAT, XYHAT, XZS, XZSMT are deallocated after this
! routine (as in ini_size_spawn.f90)
!$20140506 try 'XX','YY' it is FMREADN0_LL scalar reading so leave '--'
- CALL IO_READ_FIELD(TPFMFILE,'IMAX', NIMAX)
- CALL IO_READ_FIELD(TPFMFILE,'JMAX', NJMAX)
- CALL IO_READ_FIELD(TPFMFILE,'JPHEXT',IJPHEXT)
+ CALL IO_Field_read(TPFMFILE,'IMAX', NIMAX)
+ CALL IO_Field_read(TPFMFILE,'JMAX', NJMAX)
+ CALL IO_Field_read(TPFMFILE,'JPHEXT',IJPHEXT)
IF ( IJPHEXT .NE. JPHEXT ) THEN
IF (CPROGRAM == 'REAL' ) THEN
WRITE(ILUOUT,FMT=*) ' READ_HGRID_N : JPHEXT in PRE_REAL1.nam/NAM_REAL_CONF ( or default value )&
@@ -205,21 +205,21 @@ END IF
!* 2.1 Read the configuration (MODD_CONF)
!
IF (IMI == 1) THEN
- CALL IO_READ_FIELD(TPFMFILE,'L1D',L1D,IRESP)
+ CALL IO_Field_read(TPFMFILE,'L1D',L1D,IRESP)
IF (IRESP/=0) THEN
L1D=.FALSE.
IF( (NIMAX == 1).AND.(NJMAX == 1) ) L1D=.TRUE.
ENDIF
!
- CALL IO_READ_FIELD(TPFMFILE,'L2D',L2D,IRESP)
+ CALL IO_Field_read(TPFMFILE,'L2D',L2D,IRESP)
IF (IRESP/=0) THEN
L2D=.FALSE.
IF( (NIMAX /= 1).AND.(NJMAX == 1) ) L2D=.TRUE.
ENDIF
!
- CALL IO_READ_FIELD(TPFMFILE,'PACK',LPACK,IRESP)
+ CALL IO_Field_read(TPFMFILE,'PACK',LPACK,IRESP)
IF (IRESP/=0) LPACK=.TRUE.
-! CALL SET_FMPACK_ll(L1D,L2D,LPACK)
+! CALL IO_Pack_set(L1D,L2D,LPACK)
END IF
!
!* 2.2 Grid information :
@@ -246,8 +246,8 @@ ELSE
ENDIF
!JUAN REALZ
-CALL IO_READ_FIELD(TPFMFILE,'XHAT',XXHAT)
-CALL IO_READ_FIELD(TPFMFILE,'YHAT',XYHAT)
+CALL IO_Field_read(TPFMFILE,'XHAT',XXHAT)
+CALL IO_Field_read(TPFMFILE,'YHAT',XYHAT)
!
!JUAN REALZ
IF ( CPROGRAM .EQ. "REAL " ) THEN
@@ -257,7 +257,7 @@ IF (.NOT. (ASSOCIATED(XZS))) ALLOCATE(XZS(NIMAX+2*JPHEXT,NJMAX+2*JPHEXT))
ENDIF
!JUAN REALZ
-CALL IO_READ_FIELD(TPFMFILE,'ZS',XZS)
+CALL IO_Field_read(TPFMFILE,'ZS',XZS)
!
!JUAN REALZ
IF ( CPROGRAM .EQ. "REAL " ) THEN
@@ -270,7 +270,7 @@ ENDIF
IF (TPFMFILE%NMNHVERSION(1)<4 .OR. (TPFMFILE%NMNHVERSION(1)==4 .AND. TPFMFILE%NMNHVERSION(2)<=6)) THEN
XZSMT = XZS
ELSE
- CALL IO_READ_FIELD(TPFMFILE,'ZSMT',XZSMT)
+ CALL IO_Field_read(TPFMFILE,'ZSMT',XZSMT)
!
END IF
!
@@ -279,12 +279,12 @@ IF (TPFMFILE%NMNHVERSION(1)<4 .OR. (TPFMFILE%NMNHVERSION(1)==4 .AND. TPFMFILE%NM
CALL FIND_FIELD_ID_FROM_MNHNAME('LONORI',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CMNHNAME = 'LONOR'
- CALL IO_READ_FIELD(TPFMFILE,TZFIELD,XLONORI)
+ CALL IO_Field_read(TPFMFILE,TZFIELD,XLONORI)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('LATORI',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CMNHNAME = 'LATOR'
- CALL IO_READ_FIELD(TPFMFILE,TZFIELD,XLATORI)
+ CALL IO_Field_read(TPFMFILE,TZFIELD,XLATORI)
!
ZXHATM = - 0.5 * (XXHAT(1)+XXHAT(2))
ZYHATM = - 0.5 * (XYHAT(1)+XYHAT(2))
diff --git a/src/MNH/read_precip_field.f90 b/src/MNH/read_precip_field.f90
index 78217595739967fe4884b85b272b70a96f7bcd68..c8251ed16cbbccf986e54766818b98ac79ff38bd 100644
--- a/src/MNH/read_precip_field.f90
+++ b/src/MNH/read_precip_field.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1996-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #############################
@@ -11,17 +11,16 @@
!
INTERFACE
!
- SUBROUTINE READ_PRECIP_FIELD(TPINIFILE,HLUOUT,HPROGRAM,HCONF, &
+ SUBROUTINE READ_PRECIP_FIELD(TPINIFILE,HPROGRAM,HCONF, &
HGETRCT,HGETRRT,HGETRST,HGETRGT,HGETRHT, &
PINPRC,PACPRC,PINDEP,PACDEP,PINPRR,PINPRR3D,PEVAP3D, &
PACPRR,PINPRS,PACPRS,PINPRG,PACPRG,PINPRH,PACPRH )
!
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY : TFILEDATA
!
!* 0.1 declarations of arguments
!
TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
-CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! name for output-listing of nested models
CHARACTER (LEN=*), INTENT(IN) :: HPROGRAM !
CHARACTER (LEN=*), INTENT(IN) :: HCONF !
!
@@ -50,7 +49,7 @@ END INTERFACE
END MODULE MODI_READ_PRECIP_FIELD
!
! ##############################################################################
- SUBROUTINE READ_PRECIP_FIELD(TPINIFILE,HLUOUT,HPROGRAM,HCONF, &
+ SUBROUTINE READ_PRECIP_FIELD(TPINIFILE,HPROGRAM,HCONF, &
HGETRCT,HGETRRT,HGETRST,HGETRGT,HGETRHT, &
PINPRC,PACPRC,PINDEP,PACDEP,PINPRR,PINPRR3D,PEVAP3D, &
PACPRR,PINPRS,PACPRS,PINPRG,PACPRG,PINPRH,PACPRH )
@@ -93,25 +92,24 @@ END MODULE MODI_READ_PRECIP_FIELD
!! (C.Lac) 04/03/13 add YGETxxx for FIT scheme
!! 10/2016 (C.Lac) Add droplet deposition
!! 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
!!
!-----------------------------------------------------------------------------
!
!* 0. DECLARATIONS
-USE MODD_IO_ll, ONLY : TFILEDATA
-USE MODD_PARAM_ICE, ONLY : LDEPOSC
-USE MODD_PARAM_C2R2, ONLY : LDEPOC
-USE MODD_PARAM_LIMA, ONLY : MDEPOC=>LDEPOC
+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_FM
-USE MODE_FMREAD
+USE MODE_FIELD, ONLY: TFIELDDATA, TFIELDLIST, FIND_FIELD_ID_FROM_MNHNAME
+USE MODE_IO_FIELD_READ, only: IO_Field_read
!
IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
-CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! name for output-listing of nested models
CHARACTER (LEN=*), INTENT(IN) :: HPROGRAM !
CHARACTER (LEN=*), INTENT(IN) :: HCONF !
!
@@ -172,13 +170,13 @@ IF (SIZE(PINPRC) /= 0 ) THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('INPRC',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,Z2D,IRESP)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
IF (IRESP == 0) PINPRC(:,:)=Z2D(:,:)/(1000.*3600.)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRC',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,Z2D,IRESP)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
IF (IRESP == 0) PACPRC(:,:)=Z2D(:,:)/(1000.)
CASE ('INIT')
PINPRC(:,:) = 0.0
@@ -192,13 +190,13 @@ IF (SIZE(PINPRC) /= 0 .AND. (LDEPOSC .OR. LDEPOC .OR. MDEPOC) ) THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('INDEP',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,Z2D,IRESP)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
IF (IRESP == 0) PINDEP(:,:)=Z2D(:,:)/(1000.*3600.)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('ACDEP',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,Z2D,IRESP)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
IF (IRESP == 0) PACDEP(:,:)=Z2D(:,:)/(1000.)
CASE ('INIT')
PINDEP(:,:) = 0.0
@@ -212,19 +210,19 @@ IF (SIZE(PINPRR) /= 0 ) THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('INPRR',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,Z2D,IRESP)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
IF (IRESP == 0) PINPRR(:,:)=Z2D(:,:)/(1000.*3600.)
!
- CALL IO_READ_FIELD(TPINIFILE,'INPRR3D',Z3D,IRESP)
+ CALL IO_Field_read(TPINIFILE,'INPRR3D',Z3D,IRESP)
IF (IRESP == 0) PINPRR3D(:,:,:)=Z3D(:,:,:)
!
- CALL IO_READ_FIELD(TPINIFILE,'EVAP3D',Z3D,IRESP)
+ CALL IO_Field_read(TPINIFILE,'EVAP3D',Z3D,IRESP)
IF (IRESP == 0) PEVAP3D(:,:,:)=Z3D(:,:,:)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRR',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,Z2D,IRESP)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
IF (IRESP == 0) PACPRR(:,:)=Z2D(:,:)/(1000.)
CASE ('INIT')
PINPRR(:,:) = 0.0
@@ -240,13 +238,13 @@ IF (SIZE(PINPRS) /= 0 ) THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('INPRS',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,Z2D,IRESP)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
IF (IRESP == 0) PINPRS(:,:)=Z2D(:,:)/(1000.*3600.)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRS',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,Z2D,IRESP)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
IF (IRESP == 0) PACPRS(:,:)=Z2D(:,:)/(1000.)
CASE ('INIT')
PINPRS(:,:) = 0.0
@@ -260,13 +258,13 @@ IF (SIZE(PINPRG) /= 0 ) THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('INPRG',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,Z2D,IRESP)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
IF (IRESP == 0) PINPRG(:,:)=Z2D(:,:)/(1000.*3600.)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRG',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,Z2D,IRESP)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
IF (IRESP == 0) PACPRG(:,:)=Z2D(:,:)/(1000.)
CASE ('INIT')
PINPRG(:,:) = 0.0
@@ -280,13 +278,13 @@ IF (SIZE(PINPRH) /= 0 ) THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('INPRH',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,Z2D,IRESP)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
IF (IRESP == 0) PINPRH(:,:)=Z2D(:,:)/(1000.*3600.)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRH',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,Z2D,IRESP)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
IF (IRESP == 0) PACPRH(:,:)=Z2D(:,:)/(1000.)
CASE ('INIT')
PINPRH(:,:) = 0.0
diff --git a/src/MNH/read_surf_mnh.f90 b/src/MNH/read_surf_mnh.f90
index 21ddfeba6708d033295a94378d08843ffff32332..e274f4d85c008a739630af86561798170bc3d9fb 100644
--- a/src/MNH/read_surf_mnh.f90
+++ b/src/MNH/read_surf_mnh.f90
@@ -1,13 +1,17 @@
-!MNH_LIC Copyright 2003-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2003-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
+! P. Wautelet 22/02/2019: set HCOMMENT for all subroutines (dummy argument with intent OUT)
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-----------------------------------------------------------------
MODULE MODE_READ_SURF_MNH_TOOLS
+use mode_msg
+
IMPLICIT NONE
CONTAINS
@@ -15,7 +19,6 @@ 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 MODE_MSG
!
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,--...)
@@ -136,14 +139,13 @@ END MODULE MODE_READ_SURF_MNH_TOOLS
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CONF, ONLY: CPROGRAM
-USE MODD_GRID, ONLY: XRPK,XBETA,XLAT0,XLON0
-USE MODD_IO_SURF_MNH, ONLY: TOUT, TPINFILE
-USE MODD_PARAMETERS, ONLY: JPHEXT, XUNDEF
+USE MODD_CONF, ONLY: CPROGRAM
+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_FM
-USE MODE_FMREAD
+USE MODE_FIELD, ONLY: TFIELDDATA,TFIELDLIST,FIND_FIELD_ID_FROM_MNHNAME,TYPEREAL
+USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_GRIDPROJ
USE MODE_MSG
USE MODE_READ_SURF_MNH_TOOLS
@@ -157,7 +159,7 @@ IMPLICIT NONE
CHARACTER(LEN=LEN_HREC),INTENT(IN) :: HREC ! name of the article to be read
REAL, INTENT(OUT) :: PFIELD ! the real scalar to be read
INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
-CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment
+CHARACTER(LEN=*), INTENT(OUT) :: HCOMMENT ! comment
!
!* 0.2 Declarations of local variables
!
@@ -175,6 +177,7 @@ TYPE(TFIELDDATA) :: TZFIELD
CALL PRINT_MSG(NVERB_DEBUG,'IO','READ_SURFX0_MNH',TRIM(TPINFILE%CNAME)//': reading '//TRIM(HREC))
!
ILUOUT = TOUT%NLU
+HCOMMENT=''
!
IF (HREC=='LONORI' .OR. HREC=='LATORI') THEN
IF (TPINFILE%NMNHVERSION(1)<4 .OR. (TPINFILE%NMNHVERSION(1)==4 .AND. TPINFILE%NMNHVERSION(2)<=5)) THEN
@@ -186,26 +189,26 @@ IF (HREC=='LONORI' .OR. HREC=='LATORI') THEN
ZRPK = XRPK
ZBETA = XBETA
!* reads projection and grid data in the file
- CALL IO_READ_FIELD(TPINFILE,'LAT0',XLAT0)
- CALL IO_READ_FIELD(TPINFILE,'LON0',XLON0)
- CALL IO_READ_FIELD(TPINFILE,'RPK', XRPK)
- CALL IO_READ_FIELD(TPINFILE,'BETA',XBETA)
+ CALL IO_Field_read(TPINFILE,'LAT0',XLAT0)
+ CALL IO_Field_read(TPINFILE,'LON0',XLON0)
+ CALL IO_Field_read(TPINFILE,'RPK', XRPK)
+ CALL IO_Field_read(TPINFILE,'BETA',XBETA)
!
- CALL IO_READ_FIELD(TPINFILE,'IMAX',IIMAX)
- CALL IO_READ_FIELD(TPINFILE,'JMAX',IJMAX)
+ CALL IO_Field_read(TPINFILE,'IMAX',IIMAX)
+ CALL IO_Field_read(TPINFILE,'JMAX',IJMAX)
ALLOCATE(ZXHAT(IIMAX+2*JPHEXT),ZYHAT(IJMAX+2*JPHEXT))
- CALL IO_READ_FIELD(TPINFILE,'XHAT',ZXHAT)
- CALL IO_READ_FIELD(TPINFILE,'YHAT',ZYHAT)
+ CALL IO_Field_read(TPINFILE,'XHAT',ZXHAT)
+ CALL IO_Field_read(TPINFILE,'YHAT',ZYHAT)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('LONORI',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CMNHNAME = 'LONOR'
- CALL IO_READ_FIELD(TPINFILE,TZFIELD,ZLONOR)
+ CALL IO_Field_read(TPINFILE,TZFIELD,ZLONOR)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('LATORI',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CMNHNAME = 'LATOR'
- CALL IO_READ_FIELD(TPINFILE,TZFIELD,ZLATOR)
+ CALL IO_Field_read(TPINFILE,TZFIELD,ZLATOR)
!
ZXHATM = - 0.5 * (ZXHAT(1)+ZXHAT(2))
ZYHATM = - 0.5 * (ZYHAT(1)+ZYHAT(2))
@@ -227,10 +230,11 @@ END IF
IF ( HREC=='LAT0' .OR. HREC=='LON0' .OR. HREC=='RPK' .OR. HREC=='BETA' &
.OR. HREC=='LATORI'.OR. HREC=='LONORI' ) THEN
- CALL IO_READ_FIELD(TPINFILE,HREC,PFIELD,KRESP)
+ CALL IO_Field_read(TPINFILE,HREC,PFIELD,KRESP)
ELSE
CALL PREPARE_METADATA_READ_SURF(HREC,'--',0,TYPEREAL,0,'READ_SURFX0_MNH',TZFIELD)
- CALL IO_READ_FIELD(TPINFILE,TZFIELD,PFIELD,KRESP)
+ CALL IO_Field_read(TPINFILE,TZFIELD,PFIELD,KRESP)
+ HCOMMENT = TZFIELD%CCOMMENT
END IF
IF (KRESP /=0) THEN
@@ -284,22 +288,20 @@ END SUBROUTINE READ_SURFX0_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FIELD, ONLY: FIND_FIELD_ID_FROM_MNHNAME,TFIELDDATA,TFIELDLIST,TYPEREAL
-USE MODE_FM
-USE MODE_FMREAD
+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_IO_ll
USE MODE_MSG
USE MODE_READ_SURF_MNH_TOOLS
!
-USE MODD_CST, ONLY : XPI
+USE MODD_CST, ONLY: XPI
!
-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 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
!
@@ -313,7 +315,7 @@ CHARACTER(LEN=LEN_HREC),INTENT(IN) :: HREC ! name of the article to be read
INTEGER, INTENT(IN) :: KL ! number of points
REAL, DIMENSION(KL), INTENT(OUT):: PFIELD ! array containing the data field
INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears
-CHARACTER(LEN=100), INTENT(OUT):: HCOMMENT ! comment
+CHARACTER(LEN=*), INTENT(OUT):: HCOMMENT ! comment
CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field :
! ! 'H' for HOR : with hor. dim.; and distributed.
! ! 'A' for ALL : with hor. dim.; and not distributed.
@@ -345,6 +347,7 @@ CALL PRINT_MSG(NVERB_DEBUG,'IO','READ_SURFX1_MNH',TRIM(TPINFILE%CNAME)//': readi
!
KRESP = 0
ILUOUT = TOUT%NLU
+HCOMMENT = ' '
!
IF (HDIR=='A'.OR.HDIR=='E') THEN
IIU = NIU_ALL
@@ -370,18 +373,17 @@ END IF
!
IF (HREC=='LAT') THEN
- CALL IO_READ_FIELD(TPINFILE,'LAT0',ZW,KRESP)
+ CALL IO_Field_read(TPINFILE,'LAT0',ZW,KRESP)
PFIELD(:) = ZW
ELSE IF (HREC=='LON') THEN
- CALL IO_READ_FIELD(TPINFILE,'LON0',ZW,KRESP)
+ CALL IO_Field_read(TPINFILE,'LON0',ZW,KRESP)
PFIELD(:) = ZW
ELSE IF (HREC=='MESH_SIZE') THEN
PFIELD(:) = 0.
- HCOMMENT = ' '
ELSE IF (HREC=='XX') THEN
!! reading of a 1D field along X in the file
@@ -395,7 +397,8 @@ ELSE IF (HREC=='XX') THEN
ELSE
TZFIELD%CDIR = '--'
END IF
- CALL IO_READ_FIELD(TPINFILE,TZFIELD,ZWORK1D,KRESP)
+ CALL IO_Field_read(TPINFILE,TZFIELD,ZWORK1D,KRESP)
+ HCOMMENT = TZFIELD%CCOMMENT
DO JJ = 1,IJU
ZWORK(IIB:IIE,JJ) = 0.5 * ZWORK1D(IIB:IIE) + 0.5 * ZWORK1D(IIB+1:IIE+1)
END DO
@@ -414,7 +417,8 @@ ELSE IF (HREC=='DX') THEN
ELSE
TZFIELD%CDIR = '--'
END IF
- CALL IO_READ_FIELD(TPINFILE,TZFIELD,ZWORK1D,KRESP)
+ CALL IO_Field_read(TPINFILE,TZFIELD,ZWORK1D,KRESP)
+ HCOMMENT = TZFIELD%CCOMMENT
DO JJ = 1,IJU
ZWORK(IIB:IIE,JJ) = - ZWORK1D(IIB:IIE) + ZWORK1D(IIB+1:IIE+1)
END DO
@@ -433,7 +437,8 @@ ELSE IF (HREC=='YY') THEN
ELSE
TZFIELD%CDIR = '--'
END IF
- CALL IO_READ_FIELD(TPINFILE,TZFIELD,ZWORK1D,KRESP)
+ CALL IO_Field_read(TPINFILE,TZFIELD,ZWORK1D,KRESP)
+ HCOMMENT = TZFIELD%CCOMMENT
DO JI = 1,IIU
ZWORK(JI,IJB:IJE) = 0.5 * ZWORK1D(IJB:IJE) + 0.5 * ZWORK1D(IJB+1:IJE+1)
END DO
@@ -452,7 +457,8 @@ ELSE IF (HREC=='DY') THEN
ELSE
TZFIELD%CDIR = '--'
END IF
- CALL IO_READ_FIELD(TPINFILE,TZFIELD,ZWORK1D,KRESP)
+ CALL IO_Field_read(TPINFILE,TZFIELD,ZWORK1D,KRESP)
+ HCOMMENT = TZFIELD%CCOMMENT
DO JI = 1,IIU
ZWORK(JI,IJB:IJE) = - ZWORK1D(IJB:IJE) + ZWORK1D(IJB+1:IJE+1)
END DO
@@ -468,7 +474,7 @@ ELSE
YREC(1:LEN(HREC)) = HREC
IF (HREC(1:8)=='Q_CANYON') THEN
IF (TPINFILE%NMNHVERSION(1)<4 .OR. (TPINFILE%NMNHVERSION(1)==4 .AND. TPINFILE%NMNHVERSION(2)<=5)) THEN
- CALL IO_READ_FIELD(TPINFILE,'STORAGE_TYPE',YSTORAGE_TYPE)
+ CALL IO_Field_read(TPINFILE,'STORAGE_TYPE',YSTORAGE_TYPE)
IF (YSTORAGE_TYPE=='TT') THEN
PFIELD = 0.
DEALLOCATE(IMASK)
@@ -480,7 +486,7 @@ ELSE
END IF
IF (HREC(1:8)=='T_CANYON') THEN
IF (TPINFILE%NMNHVERSION(1)<4 .OR. (TPINFILE%NMNHVERSION(1)==4 .AND. TPINFILE%NMNHVERSION(2)<=5)) THEN
- CALL IO_READ_FIELD(TPINFILE,'STORAGE_TYPE',YSTORAGE_TYPE)
+ CALL IO_Field_read(TPINFILE,'STORAGE_TYPE',YSTORAGE_TYPE)
IF (YSTORAGE_TYPE=='TT') YREC = 'T_ROAD1 '
END IF
END IF
@@ -494,14 +500,15 @@ ELSE
!
IF (HDIR=='H') THEN
CALL PREPARE_METADATA_READ_SURF(YREC,'XY',4,TYPEREAL,2,'READ_SURFX1_MNH',TZFIELD)
- CALL IO_READ_FIELD(TPINFILE,TZFIELD,ZWORK,KRESP)
+ CALL IO_Field_read(TPINFILE,TZFIELD,ZWORK,KRESP)
ELSEIF (HDIR=='A'.OR.HDIR=='E') THEN
CALL PREPARE_METADATA_READ_SURF(YREC,'--',4,TYPEREAL,2,'READ_SURFX1_MNH',TZFIELD)
- CALL IO_READ_FIELD(TPINFILE,TZFIELD,ZWORK,KRESP)
+ CALL IO_Field_read(TPINFILE,TZFIELD,ZWORK,KRESP)
ELSE
CALL PREPARE_METADATA_READ_SURF(YREC,'--',4,TYPEREAL,1,'READ_SURFX1_MNH',TZFIELD)
- CALL IO_READ_FIELD(TPINFILE,TZFIELD,PFIELD,KRESP)
+ CALL IO_Field_read(TPINFILE,TZFIELD,PFIELD,KRESP)
END IF
+ HCOMMENT = TZFIELD%CCOMMENT
!
IF (KRESP /=0) THEN
WRITE(ILUOUT,*) 'WARNING'
@@ -574,16 +581,14 @@ END SUBROUTINE READ_SURFX1_MNH
! ------------
!
USE MODE_ll
-USE MODE_FIELD, ONLY : TFIELDDATA,TYPEREAL
-USE MODE_FM
-USE MODE_FMREAD
-USE MODE_IO_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_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 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
!
@@ -598,7 +603,7 @@ INTEGER, INTENT(IN) :: KL1 ! number of points
INTEGER, INTENT(IN) :: KL2 ! second dimension
REAL, DIMENSION(KL1,KL2),INTENT(OUT) :: PFIELD ! array containing the data field
INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
-CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment
+CHARACTER(LEN=*), INTENT(OUT) :: HCOMMENT ! comment
CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field :
! ! 'H' for HOR : with hor. dim.; and distributed.
! ! 'A' for ALL : with hor. dim.; and not distributed.
@@ -631,16 +636,18 @@ ILUOUT = TOUT%NLU
IF (HDIR=='H') THEN
ALLOCATE(ZWORK(NIU,NJU,SIZE(PFIELD,2)))
CALL PREPARE_METADATA_READ_SURF(HREC,'XY',4,TYPEREAL,3,'READ_SURFX2_MNH',TZFIELD)
- CALL IO_READ_FIELD(TPINFILE,TZFIELD,ZWORK,KRESP)
+ CALL IO_Field_read(TPINFILE,TZFIELD,ZWORK,KRESP)
ELSEIF (HDIR=='A'.OR.HDIR=='E') THEN
ALLOCATE(ZWORK(NIU_ALL,NJU_ALL,SIZE(PFIELD,2)))
CALL PREPARE_METADATA_READ_SURF(HREC,'--',4,TYPEREAL,3,'READ_SURFX2_MNH',TZFIELD)
- CALL IO_READ_FIELD(TPINFILE,TZFIELD,ZWORK,KRESP)
+ CALL IO_Field_read(TPINFILE,TZFIELD,ZWORK,KRESP)
ELSE
CALL PREPARE_METADATA_READ_SURF(HREC,'--',4,TYPEREAL,2,'READ_SURFX2_MNH',TZFIELD)
- CALL IO_READ_FIELD(TPINFILE,TZFIELD,PFIELD,KRESP)
+ CALL IO_Field_read(TPINFILE,TZFIELD,PFIELD,KRESP)
END IF
!
+HCOMMENT = TZFIELD%CCOMMENT
+!
IF (KRESP /=0) THEN
WRITE(ILUOUT,*) 'WARNING'
WRITE(ILUOUT,*) '-------'
@@ -710,20 +717,18 @@ END SUBROUTINE READ_SURFX2_MNH
!
USE MODE_ll
USE MODE_FIELD, ONLY: TFIELDDATA,TYPELOG,TYPEREAL
-USE MODE_FM
-USE MODE_FMREAD
-USE MODE_IO_ll
+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_CST, ONLY: XPI
!
-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_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 MODI_PACK_2D_1D
!
@@ -736,7 +741,7 @@ INTEGER, INTENT(IN) :: KL1,KL2 ! number of points
REAL, DIMENSION(KL1,KL2), INTENT(OUT):: PFIELD ! array containing the data field
LOGICAL,DIMENSION(JPCOVER),INTENT(IN) :: OFLAG ! mask for array filling
INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears
-CHARACTER(LEN=100), INTENT(OUT):: HCOMMENT ! comment
+CHARACTER(LEN=*), INTENT(OUT):: HCOMMENT ! comment
CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field :
! ! 'H' for HOR : with hor. dim.; and distributed.
! ! 'A' for ALL : with hor. dim.; and not distributed.
@@ -800,8 +805,8 @@ NCOVER=COUNT(OFLAG)
ALLOCATE (ZWORK3D(IIU,IJU,NCOVER))
ZWORK3D(:,:,:) = 0.0
!
-CALL IO_READ_FIELD(TPINFILE,'VERSION',IVERSION)
-CALL IO_READ_FIELD(TPINFILE,'BUG', IBUGFIX)
+CALL IO_Field_read(TPINFILE,'VERSION',IVERSION)
+CALL IO_Field_read(TPINFILE,'BUG', IBUGFIX)
IF (IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX==0)) THEN
GCOVER_PACKED = .FALSE.
@@ -816,7 +821,7 @@ ELSE
TZFIELD%NTYPE = TYPELOG
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_READ_FIELD(TPINFILE,TZFIELD,GCOVER_PACKED)
+ CALL IO_Field_read(TPINFILE,TZFIELD,GCOVER_PACKED)
END IF
!
IF (.NOT. GCOVER_PACKED) THEN
@@ -835,15 +840,17 @@ IF (.NOT. GCOVER_PACKED) THEN
TZFIELD%CDIR = YDIR
IF (OFLAG(JL2)) THEN
ICOVER=ICOVER+1
- CALL IO_READ_FIELD(TPINFILE,TZFIELD,ZWORK3D(:,:,ICOVER),IRESP)
+ CALL IO_Field_read(TPINFILE,TZFIELD,ZWORK3D(:,:,ICOVER),IRESP)
END IF
IF (IRESP/=0) KRESP=IRESP
END DO
ELSE
CALL PREPARE_METADATA_READ_SURF(HREC,YDIR,4,TYPEREAL,3,'READ_SURFX2COV_MNH',TZFIELD)
- CALL IO_READ_FIELD(TPINFILE,TZFIELD,ZWORK3D(:,:,:),KRESP)
+ CALL IO_Field_read(TPINFILE,TZFIELD,ZWORK3D(:,:,:),KRESP)
END IF
!
+HCOMMENT = TZFIELD%CCOMMENT
+!
IF (KRESP /=0) THEN
WRITE(ILUOUT,*) 'WARNING'
WRITE(ILUOUT,*) '-------'
@@ -904,20 +911,18 @@ END SUBROUTINE READ_SURFX2COV_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FIELD, ONLY : TFIELDDATA,TYPELOG,TYPEREAL
-USE MODE_FM
-USE MODE_FMREAD
+USE MODE_FIELD, ONLY: TFIELDDATA,TYPELOG,TYPEREAL
+USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_ll
-USE MODE_IO_ll
USE MODE_MSG
!
-USE MODD_CST, ONLY : XPI
+USE MODD_CST, ONLY: XPI
!
-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_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 MODI_PACK_2D_1D
!
@@ -930,7 +935,7 @@ INTEGER, INTENT(IN) :: KL1 ! number of points
INTEGER, INTENT(IN) :: KCOVER ! index of the vertical level, it should be a index such that LCOVER(KCOVER)=.TRUE.
REAL, DIMENSION(KL1), INTENT(OUT):: PFIELD ! array containing the data field
INTEGER, INTENT(OUT):: KRESP ! KRESP : return-code if a problem appears
-CHARACTER(LEN=100), INTENT(OUT):: HCOMMENT ! comment
+CHARACTER(LEN=*), INTENT(OUT):: HCOMMENT ! comment
CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field :
! ! 'H' for HOR : with hor. dim.; and distributed.
! ! 'A' for ALL : with hor. dim.; and not distributed.
@@ -995,8 +1000,8 @@ END IF
ALLOCATE (ZWORK2D(IIU,IJU))
ZWORK2D(:,:) = 0.0
!
-CALL IO_READ_FIELD(TPINFILE,'VERSION',IVERSION)
-CALL IO_READ_FIELD(TPINFILE,'BUG', IBUGFIX)
+CALL IO_Field_read(TPINFILE,'VERSION',IVERSION)
+CALL IO_Field_read(TPINFILE,'BUG', IBUGFIX)
IF (IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX==0)) THEN
GCOVER_PACKED = .FALSE.
@@ -1011,7 +1016,7 @@ ELSE
TZFIELD%NTYPE = TYPELOG
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_READ_FIELD(TPINFILE,TZFIELD,GCOVER_PACKED,KRESP)
+ CALL IO_Field_read(TPINFILE,TZFIELD,GCOVER_PACKED,KRESP)
END IF
!
IF (.NOT. GCOVER_PACKED) THEN
@@ -1026,15 +1031,13 @@ IF (.NOT. GCOVER_PACKED) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_READ_FIELD(TPINFILE,TZFIELD,ZWORK2D,KRESP)
+ CALL IO_Field_read(TPINFILE,TZFIELD,ZWORK2D,KRESP)
ELSE
- WRITE(ILUOUT,*) 'WARNING'
- WRITE(ILUOUT,*) '-------'
- WRITE(ILUOUT,*) 'error : GCOVER_PACKED = ', GCOVER_PACKED, ' and we try to read the covers one by one '
- WRITE(ILUOUT,*) ' '
- CALL ABORT
+ call Print_msg( NVERB_FATAL, 'IO', 'READ_SURFX2COV_1COV_MNH', 'GCOVER_PACKED=TRUE and we try to read the covers one by one' )
END IF
!
+HCOMMENT = TZFIELD%CCOMMENT
+!
IF (KRESP /=0) THEN
WRITE(ILUOUT,*) 'WARNING'
WRITE(ILUOUT,*) '-------'
@@ -1092,16 +1095,15 @@ END SUBROUTINE READ_SURFX2COV_1COV_MNH
!* 0. DECLARATIONS
! ------------
!
+USE MODE_FIELD, ONLY: TFIELDDATA,TYPEINT
+USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_ll
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPEINT
-USE MODE_FM
-USE MODE_FMREAD
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
+USE MODD_IO_SURF_MNH, ONLY: TOUT, TPINFILE, NMASK, &
+ NIU, NJU, NIB, NJB, NIE, NJE
+USE MODD_CONF, ONLY: CPROGRAM
!
!
!
@@ -1112,7 +1114,7 @@ IMPLICIT NONE
CHARACTER(LEN=LEN_HREC),INTENT(IN) :: HREC ! name of the article to be read
INTEGER, INTENT(OUT) :: KFIELD ! the integer to be read
INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
-CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment
+CHARACTER(LEN=*), INTENT(OUT) :: HCOMMENT ! comment
!
!* 0.2 Declarations of local variables
!
@@ -1126,15 +1128,17 @@ CALL PRINT_MSG(NVERB_DEBUG,'IO','READ_SURFN0_MNH',TRIM(TPINFILE%CNAME)//': readi
!
KRESP=0
ILUOUT = TOUT%NLU
+HCOMMENT=''
!
IF (HREC=='DIM_FULL' .AND. ( CPROGRAM=='IDEAL ' .OR. &
CPROGRAM=='SPAWN ' .OR. CPROGRAM=='ZOOMPG' ))THEN
- CALL IO_READ_FIELD(TPINFILE,'IMAX',IIMAX)
- CALL IO_READ_FIELD(TPINFILE,'JMAX',IJMAX)
+ CALL IO_Field_read(TPINFILE,'IMAX',IIMAX)
+ CALL IO_Field_read(TPINFILE,'JMAX',IJMAX)
KFIELD = IIMAX * IJMAX
ELSE
CALL PREPARE_METADATA_READ_SURF(HREC,'--',0,TYPEINT,0,'READ_SURFN0_MNH',TZFIELD)
- CALL IO_READ_FIELD(TPINFILE,TZFIELD,KFIELD,KRESP)
+ CALL IO_Field_read(TPINFILE,TZFIELD,KFIELD,KRESP)
+ HCOMMENT = TZFIELD%CCOMMENT
IF (KRESP /=0) THEN
WRITE(ILUOUT,*) 'WARNING'
@@ -1189,14 +1193,13 @@ END SUBROUTINE READ_SURFN0_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPEINT
-USE MODE_FM
-USE MODE_FMREAD
+USE MODE_FIELD, ONLY: TFIELDDATA,TYPEINT
+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 MODD_IO_SURF_MNH, ONLY: TOUT, TPINFILE, NMASK, &
+ NIU, NJU, NIB, NJB, NIE, NJE
!
USE MODI_PACK_2D_1D
!
@@ -1208,7 +1211,7 @@ CHARACTER(LEN=LEN_HREC),INTENT(IN) :: HREC ! name of the article to be read
INTEGER, INTENT(IN) :: KL ! number of points
INTEGER, DIMENSION(KL), INTENT(OUT) :: KFIELD ! the integer to be read
INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
-CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment
+CHARACTER(LEN=*), INTENT(OUT) :: HCOMMENT ! comment
CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field :
! ! 'H' : field with
! ! horizontal spatial dim.
@@ -1231,13 +1234,13 @@ ILUOUT = TOUT%NLU
IF (HDIR=='-') THEN
!
CALL PREPARE_METADATA_READ_SURF(HREC,'--',0,TYPEINT,1,'READ_SURFN1_MNH',TZFIELD)
- CALL IO_READ_FIELD(TPINFILE,TZFIELD,KFIELD,KRESP)
+ CALL IO_Field_read(TPINFILE,TZFIELD,KFIELD,KRESP)
!
ELSE IF (HDIR=='H') THEN
ALLOCATE(IWORK(NIU,NJU))
!
CALL PREPARE_METADATA_READ_SURF(HREC,'XY',4,TYPEINT,2,'READ_SURFN1_MNH',TZFIELD)
- CALL IO_READ_FIELD(TPINFILE,TZFIELD,IWORK,KRESP)
+ CALL IO_Field_read(TPINFILE,TZFIELD,IWORK,KRESP)
!
IF (KRESP /=0) THEN
WRITE(ILUOUT,*) 'WARNING'
@@ -1249,9 +1252,11 @@ ELSE IF (HDIR=='H') THEN
CALL PACK_2D_1D(NMASK,IWORK(NIB:NIE,NJB:NJE),KFIELD)
END IF
!
-DEALLOCATE(IWORK)
-
+ DEALLOCATE(IWORK)
ENDIF
+
+HCOMMENT = TZFIELD%CCOMMENT
+
!-------------------------------------------------------------------------------
END SUBROUTINE READ_SURFN1_MNH
!
@@ -1296,16 +1301,16 @@ END SUBROUTINE READ_SURFN1_MNH
!* 0. DECLARATIONS
! ------------
!
+USE MODE_FIELD, ONLY: TFIELDDATA, TYPECHAR
+USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_ll
-USE MODE_FIELD, ONLY : TFIELDDATA,TYPECHAR
-USE MODE_FMREAD
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
+USE MODD_IO_SURF_MNH, ONLY: TOUT, TPINFILE
+USE MODD_CONF, ONLY: LCARTESIAN, CPROGRAM
+USE MODD_LUNIT, ONLY: TPGDFILE
!
!
IMPLICIT NONE
@@ -1315,7 +1320,7 @@ IMPLICIT NONE
CHARACTER(LEN=LEN_HREC),INTENT(IN) :: HREC ! name of the article to be read
CHARACTER(LEN=40), INTENT(OUT) :: HFIELD ! the integer to be read
INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
-CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment
+CHARACTER(LEN=*), INTENT(OUT) :: HCOMMENT ! comment
!
!* 0.2 Declarations of local variables
!
@@ -1338,6 +1343,7 @@ CALL PRINT_MSG(NVERB_DEBUG,'IO','READ_SURFC0_MNH',TRIM(TPINFILE%CNAME)//': readi
!
KRESP = 0
ILUOUT = TOUT%NLU
+HCOMMENT = ''
!
IF (TPINFILE%NMNHVERSION(1)<4 .OR. (TPINFILE%NMNHVERSION(1)==4 .AND. TPINFILE%NMNHVERSION(2)<6)) THEN
SELECT CASE(TRIM(HREC))
@@ -1381,7 +1387,7 @@ IF (TPINFILE%NMNHVERSION(1)<4 .OR. (TPINFILE%NMNHVERSION(1)==4 .AND. TPINFILE%NM
END IF
CASE DEFAULT
CALL PREPARE_METADATA_READ_SURF(HREC,'--',0,TYPECHAR,0,'READ_SURFC0_MNH',TZFIELD)
- CALL IO_READ_FIELD(TPINFILE,TZFIELD,HFIELD,KRESP)
+ CALL IO_Field_read(TPINFILE,TZFIELD,HFIELD,KRESP)
!
IF (KRESP /=0) THEN
CALL PRINT_MSG(NVERB_FATAL,'IO','READ_SURFC0_MNH',TRIM(TPINFILE%CNAME)//': error when reading article '//TRIM(HREC)// &
@@ -1399,7 +1405,8 @@ ELSE IF ( HREC=='GRID_TYPE'.AND. ( &
END IF
ELSE
CALL PREPARE_METADATA_READ_SURF(HREC,'--',0,TYPECHAR,0,'READ_SURFC0_MNH',TZFIELD)
- CALL IO_READ_FIELD(TPINFILE,TZFIELD,HFIELD,KRESP)
+ CALL IO_Field_read(TPINFILE,TZFIELD,HFIELD,KRESP)
+ HCOMMENT = TZFIELD%CCOMMENT
!
IF (KRESP /=0) THEN
CALL PRINT_MSG(NVERB_FATAL,'IO','READ_SURFC0_MNH',TRIM(TPINFILE%CNAME)//': error when reading article '//TRIM(HREC)// &
@@ -1451,12 +1458,11 @@ END SUBROUTINE READ_SURFC0_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODD_IO_SURF_MNH, ONLY : TOUT, TPINFILE, NMASK, &
- NIU, NJU, NIB, NJB, NIE, NJE
+USE MODD_IO_SURF_MNH, ONLY: TOUT, TPINFILE, NMASK, &
+ NIU, NJU, NIB, NJB, NIE, NJE
!
-USE MODE_FIELD, ONLY : TFIELDDATA,TYPEINT,TYPELOG
-USE MODE_FM
-USE MODE_FMREAD
+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
!
@@ -1472,7 +1478,7 @@ CHARACTER(LEN=LEN_HREC),INTENT(IN) :: HREC ! name of the article to be read
INTEGER, INTENT(IN) :: KL ! number of points
LOGICAL, DIMENSION(KL), INTENT(OUT) :: OFIELD ! array containing the data field
INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
-CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment
+CHARACTER(LEN=*), INTENT(OUT) :: HCOMMENT ! comment
CHARACTER(LEN=1), INTENT(IN) :: HDIR ! type of field :
! ! 'H' : field with
! ! horizontal spatial dim.
@@ -1493,7 +1499,7 @@ ILUOUT = TOUT%NLU
!
IF (HDIR=='-') THEN
CALL PREPARE_METADATA_READ_SURF(HREC,'--',0,TYPELOG,1,'READ_SURFL1_MNH',TZFIELD)
- CALL IO_READ_FIELD(TPINFILE,TZFIELD,OFIELD,KRESP)
+ CALL IO_Field_read(TPINFILE,TZFIELD,OFIELD,KRESP)
IF (KRESP /=0) THEN
WRITE(ILUOUT,*) 'WARNING'
@@ -1508,7 +1514,7 @@ ELSE IF (HDIR=='H') THEN
!
ALLOCATE(IWORK(NIU,NJU))
CALL PREPARE_METADATA_READ_SURF(HREC,'XY',4,TYPEINT,2,'READ_SURFL1_MNH',TZFIELD)
- CALL IO_READ_FIELD(TPINFILE,TZFIELD,IWORK,KRESP)
+ CALL IO_Field_read(TPINFILE,TZFIELD,IWORK,KRESP)
WHERE (IWORK==1) GWORK = .TRUE.
DEALLOCATE(IWORK)
!
@@ -1524,6 +1530,9 @@ ELSE IF (HDIR=='H') THEN
!
DEALLOCATE(GWORK)
END IF
+
+HCOMMENT = TZFIELD%CCOMMENT
+
!-------------------------------------------------------------------------------
END SUBROUTINE READ_SURFL1_MNH
!
@@ -1567,13 +1576,12 @@ END SUBROUTINE READ_SURFL1_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FIELD, ONLY : TFIELDDATA,TYPELOG
-USE MODE_FM
-USE MODE_FMREAD
+USE MODE_FIELD, ONLY: TFIELDDATA,TYPELOG
+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
+USE MODD_IO_SURF_MNH, ONLY: TOUT, TPINFILE
!
!
IMPLICIT NONE
@@ -1583,7 +1591,7 @@ IMPLICIT NONE
CHARACTER(LEN=LEN_HREC),INTENT(IN) :: HREC ! name of the article to be read
LOGICAL, INTENT(OUT) :: OFIELD ! array containing the data field
INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
-CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment
+CHARACTER(LEN=*), INTENT(OUT) :: HCOMMENT ! comment
!
!* 0.2 Declarations of local variables
!
@@ -1611,7 +1619,7 @@ IF (HREC=='ECOCLIMAP') THEN
END IF
!
CALL PREPARE_METADATA_READ_SURF(HREC,'--',0,TYPELOG,0,'READ_SURFL0_MNH',TZFIELD)
-CALL IO_READ_FIELD(TPINFILE,TZFIELD,OFIELD,KRESP)
+CALL IO_Field_read(TPINFILE,TZFIELD,OFIELD,KRESP)
HCOMMENT = TZFIELD%CCOMMENT
!
IF (KRESP /=0) THEN
@@ -1665,13 +1673,12 @@ END SUBROUTINE READ_SURFL0_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FIELD, ONLY : TFIELDDATA,TYPECHAR
-USE MODE_FM
-USE MODE_FMREAD
+USE MODE_FIELD, ONLY: TFIELDDATA,TYPECHAR
+USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_MSG
!
-USE MODD_IO_SURF_MNH, ONLY : TOUT, TPINFILE
USE MODD_TYPE_DATE
+USE MODD_IO_SURF_MNH, ONLY: TOUT, TPINFILE
!
!
IMPLICIT NONE
@@ -1684,7 +1691,7 @@ INTEGER, INTENT(OUT) :: KMONTH ! month
INTEGER, INTENT(OUT) :: KDAY ! day
REAL, INTENT(OUT) :: PTIME ! time
INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
-CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment
+CHARACTER(LEN=*), INTENT(OUT) :: HCOMMENT ! comment
!* 0.2 Declarations of local variables
!
@@ -1703,9 +1710,10 @@ TYPE(DATE_TIME) :: TZDATETIME
CALL PRINT_MSG(NVERB_DEBUG,'IO','READ_SURFT0_MNH',TRIM(TPINFILE%CNAME)//': reading '//TRIM(HREC))
!
ILUOUT = TOUT%NLU
+HCOMMENT = ''
!
IF (TPINFILE%NMNHVERSION(1)<4 .OR. (TPINFILE%NMNHVERSION(1)==4 .AND. TPINFILE%NMNHVERSION(2)<6)) THEN
- CALL IO_READ_FIELD(TPINFILE,'STORAGE_TYPE',YFILETYPE2)
+ CALL IO_Field_read(TPINFILE,'STORAGE_TYPE',YFILETYPE2)
ELSE
TZFIELD%CMNHNAME = 'STORAGETYPE'
TZFIELD%CSTDNAME = ''
@@ -1717,7 +1725,7 @@ ELSE
TZFIELD%NTYPE = TYPECHAR
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_READ_FIELD(TPINFILE,TZFIELD,YFILETYPE40)
+ CALL IO_Field_read(TPINFILE,TZFIELD,YFILETYPE40)
YFILETYPE2 = YFILETYPE40(1:2)
END IF
IF (YFILETYPE2(1:2)=='PG') THEN
@@ -1730,7 +1738,7 @@ IF (YFILETYPE2(1:2)=='PG') THEN
RETURN
END IF
!
-CALL IO_READ_FIELD(TPINFILE,HREC,TZDATETIME,KRESP)
+CALL IO_Field_read(TPINFILE,HREC,TZDATETIME,KRESP)
!
IF (KRESP /=0) THEN
WRITE(ILUOUT,*) 'WARNING'
@@ -1789,12 +1797,11 @@ END SUBROUTINE READ_SURFT0_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FIELD, ONLY : TFIELDDATA,TYPECHAR,TYPEINT,TYPEREAL
-USE MODE_FM
-USE MODE_FMREAD
+USE MODE_FIELD, ONLY: TFIELDDATA, TYPECHAR, TYPEINT, TYPEREAL
+USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_MSG
!
-USE MODD_IO_SURF_MNH, ONLY : TOUT, TPINFILE
+USE MODD_IO_SURF_MNH, ONLY: TOUT, TPINFILE
!
!
IMPLICIT NONE
@@ -1809,7 +1816,7 @@ INTEGER, DIMENSION(KL1), INTENT(OUT) :: KMONTH ! month
INTEGER, DIMENSION(KL1), INTENT(OUT) :: KDAY ! day
REAL, DIMENSION(KL1), INTENT(OUT) :: PTIME ! time
INTEGER, INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
-CHARACTER(LEN=100), INTENT(OUT) :: HCOMMENT ! comment
+CHARACTER(LEN=*), INTENT(OUT) :: HCOMMENT ! comment
!* 0.2 Declarations of local variables
!
@@ -1827,9 +1834,10 @@ TYPE(TFIELDDATA) :: TZFIELD
CALL PRINT_MSG(NVERB_DEBUG,'IO','READ_SURFT1_MNH',TRIM(TPINFILE%CNAME)//': reading '//TRIM(HREC))
!
ILUOUT = TOUT%NLU
+HCOMMENT = ''
!
IF (TPINFILE%NMNHVERSION(1)<4 .OR. (TPINFILE%NMNHVERSION(1)==4 .AND. TPINFILE%NMNHVERSION(2)<6)) THEN
- CALL IO_READ_FIELD(TPINFILE,'STORAGE_TYPE',YFILETYPE2)
+ CALL IO_Field_read(TPINFILE,'STORAGE_TYPE',YFILETYPE2)
ELSE
TZFIELD%CMNHNAME = 'STORAGETYPE'
TZFIELD%CSTDNAME = ''
@@ -1841,7 +1849,7 @@ ELSE
TZFIELD%NTYPE = TYPECHAR
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_READ_FIELD(TPINFILE,TZFIELD,YFILETYPE40)
+ CALL IO_Field_read(TPINFILE,TZFIELD,YFILETYPE40)
YFILETYPE2 = YFILETYPE40(1:2)
END IF
!IF (YFILETYPE2(1:2)=='PG') THEN
@@ -1859,13 +1867,13 @@ TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = ''
TZFIELD%CDIR = '--'
-TZFIELD%CCOMMENT = TRIM(HCOMMENT)
+TZFIELD%CCOMMENT = ''
TZFIELD%NGRID = 0
TZFIELD%NTYPE = TYPEINT
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .FALSE.
!
-CALL IO_READ_FIELD(TPINFILE,TZFIELD,ITDATE(:,:),KRESP)
+CALL IO_Field_read(TPINFILE,TZFIELD,ITDATE(:,:),KRESP)
!
KYEAR(:) = ITDATE(1,:)
KMONTH(:) = ITDATE(2,:)
@@ -1884,13 +1892,13 @@ TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = ''
TZFIELD%CDIR = '--'
-TZFIELD%CCOMMENT = TRIM(HCOMMENT)
+TZFIELD%CCOMMENT = ''
TZFIELD%NGRID = 0
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
!
-CALL IO_READ_FIELD(TPINFILE,TZFIELD,PTIME(:),KRESP)
+CALL IO_Field_read(TPINFILE,TZFIELD,PTIME(:),KRESP)
!
IF (KRESP /=0) THEN
WRITE(ILUOUT,*) 'WARNING'
diff --git a/src/MNH/read_ver_grid.f90 b/src/MNH/read_ver_grid.f90
index e03293b38e7e7e0cd556a569ba248fd9b888aac3..e9d83fe22a861c9cdba80ad3e0c4cf3c2abf1221 100644
--- a/src/MNH/read_ver_grid.f90
+++ b/src/MNH/read_ver_grid.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 READ_VER_GRID(TPPRE_REAL1,PZHAT,OSLEVE,PLEN1,PLEN2)
!
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY : TFILEDATA
!
TYPE(TFILEDATA),POINTER, INTENT(IN) :: TPPRE_REAL1! namelist file
REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: PZHAT ! vertival grid of input fmfile
@@ -70,7 +70,7 @@ END MODULE MODI_READ_VER_GRID
!! 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
-!! CLUOUT0 : name of output-listing
+!! TLUOUT0 : name of output-listing
!! Module MODD_GRID1
!! XZHAT
!! Module MODD_DIM1
@@ -104,11 +104,10 @@ END MODULE MODI_READ_VER_GRID
USE MODD_CONF ! declaration modules
USE MODD_DIM_n, NKMAX_n=>NKMAX
USE MODD_GRID_n, LSLEVE_n=>LSLEVE, XLEN1_n=>XLEN1, XLEN2_n=>XLEN2
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY : TFILEDATA
USE MODD_LUNIT
USE MODD_PARAMETERS
!
-USE MODE_FM
USE MODE_MSG
USE MODE_POS
!
diff --git a/src/MNH/rel_forcingn.f90 b/src/MNH/rel_forcingn.f90
index 0073804642c9429198876d832d7395e767c4597b..e057e1223321a3a8f3f6a1748d82da97d3a72b12 100644
--- a/src/MNH/rel_forcingn.f90
+++ b/src/MNH/rel_forcingn.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 2010-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2010-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 MODI_REL_FORCING_n
! #####################
@@ -70,7 +71,7 @@ END MODULE MODI_REL_FORCING_n
!! TDTADVFRC: date of each advecting-forcing profile
!! XUFRC,XVFRC,XWFRC,XTHFRC,XRVFRC: advecting-forcing variables
!! Module MODD_LUNIT : contains logical unit names for all models
-!! CLUOUT0 : name of output-listing
+!! TLUOUT0 : name of output-listing
!! Module MODD_PARAMETERS: declaration of parameter variables
!! JPVEXT: define the number of marginal points out of the
!! physical domain along the vertical direction.
@@ -108,7 +109,6 @@ USE MODD_RELFRC_n ! Modules for time evolving advfrc
USE MODD_TIME
!
USE MODE_DATETIME
-USE MODE_IO_ll
!
USE MODI_BUDGET
USE MODI_SHUMAN
diff --git a/src/MNH/reset_exseg.f90 b/src/MNH/reset_exseg.f90
index ba9b61d895766d71d4c857c159f2f89d368e54cc..5c6a80d42b249e954c295db03ba6176789c28f6a 100644
--- a/src/MNH/reset_exseg.f90
+++ b/src/MNH/reset_exseg.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2000-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-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.
!-----------------------------------------------------------------
! #######################
@@ -9,9 +9,7 @@
!
INTERFACE
!
- SUBROUTINE RESET_EXSEG(HLUOUT)
-!
-CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! Name for output listing
+ SUBROUTINE RESET_EXSEG()
!
END SUBROUTINE RESET_EXSEG
!
@@ -20,7 +18,7 @@ END INTERFACE
END MODULE MODI_RESET_EXSEG
!
! ##############################
- SUBROUTINE RESET_EXSEG(HLUOUT)
+ SUBROUTINE RESET_EXSEG()
! ##############################
!
!!**** *RESET_EXSEG* - routine used to mofify the EXSEG1.nam informations
@@ -57,21 +55,20 @@ END MODULE MODI_RESET_EXSEG
!! Modifications 04/06/02 (P Jabouille) reset radiation and convective options
!! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
-USE MODE_FM, ONLY : IO_FILE_OPEN_ll,IO_FILE_CLOSE_ll
-USE MODE_FMREAD
-USE MODE_IO_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_FIND_BYNAME
+USE MODE_IO_FILE, ONLY : IO_File_open,IO_File_close
+USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_find_byname
USE MODE_POS
!
USE MODD_DIAG_FLAG
USE MODD_CH_MNHC_n, ONLY: LUSECHEM
USE MODD_CONF_n, ONLY: LUSERV
USE MODD_GET_n
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAM_n, ONLY: CDCONV, CRAD
USE MODN_PARAM_KAFR_n
USE MODN_PARAM_RAD_n
@@ -82,8 +79,6 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! Name for output listing
-!
!* 0.2 declarations of local variables
!
INTEGER :: IRESP,ILUNAM ! return code and logical unit number
@@ -100,8 +95,8 @@ TYPE(TFILEDATA),POINTER :: TZNMLFILE! Namelist file
!
TZNMLFILE => NULL()
!
-CALL IO_FILE_FIND_BYNAME('DIAG1.nam',TZNMLFILE,IRESP)
-CALL IO_FILE_OPEN_ll(TZNMLFILE)
+CALL IO_File_find_byname('DIAG1.nam',TZNMLFILE,IRESP)
+CALL IO_File_open(TZNMLFILE)
ILUNAM = TZNMLFILE%NLU
!
!-------------------------------------------------------------------------------
@@ -189,6 +184,6 @@ PRINT*,' '
!
!-------------------------------------------------------------------------------
!
-CALL IO_FILE_CLOSE_ll(TZNMLFILE)
+CALL IO_File_close(TZNMLFILE)
!
END SUBROUTINE RESET_EXSEG
diff --git a/src/MNH/resolved_cloud.f90 b/src/MNH/resolved_cloud.f90
index ab576c43984a2eb1086698e864eeaf5c0f542761..78e14a357529a973f4b6409088f60b1fd8f9288b 100644
--- a/src/MNH/resolved_cloud.f90
+++ b/src/MNH/resolved_cloud.f90
@@ -24,10 +24,10 @@ INTERFACE
PINPRS,PINPRG,PINPRH, &
PSOLORG,PMI, &
! PSPEEDC, PSPEEDR, PSPEEDS, PSPEEDG, PSPEEDH, &
- PINDEP, PSUPSAT, PNACT, PNPRO,PSSPRO, &
+ PINDEP, PSUPSAT, PNACT, PNPRO,PSSPRO, PRAINFR, &
PSEA,PTOWN )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! kind of cloud
CHARACTER(LEN=4), INTENT(IN) :: HACTCCN ! kind of CCN activation scheme
@@ -135,7 +135,7 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSUPSAT !sursat
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNACT !concentrtaion d'aérosols activés au temps t
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
!
@@ -161,7 +161,7 @@ END MODULE MODI_RESOLVED_CLOUD
PINPRS,PINPRG,PINPRH, &
PSOLORG,PMI, &
! PSPEEDC, PSPEEDR, PSPEEDS, PSPEEDG, PSPEEDH, &
- PINDEP, PSUPSAT, PNACT, PNPRO,PSSPRO, &
+ PINDEP, PSUPSAT, PNACT, PNPRO,PSSPRO, PRAINFR, &
PSEA,PTOWN )
! ##########################################################################
!
@@ -269,30 +269,37 @@ END MODULE MODI_RESOLVED_CLOUD
!! S.Riette : 11/2016 : ice_adjust before and after rain_ice
!! ICE3/ICE4 modified, old version under LRED=F
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! P. Wautelet: 01/02/2019: ZRSMIN is now allocatable (instead of size of XRTMIN which was sometimes not allocated)
+!! 02/2019 C.Lac add rain fraction as an output field
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
-USE MODD_BUDGET
-USE MODD_CH_AEROSOL , ONLY : LORILAM
-USE MODD_CONF
-USE MODD_CST
-USE MODD_DUST , ONLY : LDUST
-USE MODD_IO_ll, ONLY: TFILEDATA
-USE MODD_NSV
-USE MODD_PARAMETERS
-USE MODD_PARAM_C2R2
-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_RAIN_ICE_DESCR
-USE MODD_SALT , ONLY : LSALT
+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_DUST , ONLY: LDUST
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_NSV, ONLY: NSV_C1R3END, NSV_C2R2BEG, NSV_C2R2END, &
+ NSV_LIMA_BEG, NSV_LIMA_END, NSV_LIMA_CCN_FREE, NSV_LIMA_IFN_FREE, &
+ NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_NR
+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_RAIN_ICE_DESCR, ONLY: XRTMIN
+USE MODD_SALT, ONLY: LSALT
!
USE MODE_ll
-USE MODE_FM
USE MODE_MPPDB
USE MODE_MSG
!
+#ifdef MNH_BITREP
+USE MODI_BITREP
+#endif
USE MODI_BUDGET
USE MODI_C2R2_ADJUST
USE MODI_C3R5_ADJUST
@@ -301,24 +308,20 @@ 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_COLD
+USE MODI_LIMA_MIXED
+USE MODI_LIMA_WARM
+USE MODI_RAIN_C2R2_KHKO
USE MODI_RAIN_ICE
USE MODI_RAIN_ICE_RED
-USE MODI_RAIN_C2R2_KHKO
USE MODI_SHUMAN
#ifdef _OPENACC
USE MODI_SHUMAN_DEVICE
#endif
USE MODI_SLOW_TERMS
!
-#ifdef MNH_BITREP
-USE MODI_BITREP
-#endif
-USE MODI_LIMA
-USE MODI_LIMA_ADJUST
-USE MODI_LIMA_COLD
-USE MODI_LIMA_MIXED
-USE MODI_LIMA_WARM
-!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -431,7 +434,7 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSUPSAT !sursat
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNACT !concentrtaion d'aérosols activés au temps t
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
!
@@ -489,10 +492,10 @@ 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(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: LLMICRO ! mask to limit computation
-REAL, DIMENSION(SIZE(XRTMIN)) :: ZRSMIN ! Minimum value for tendencies
! REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3), KRR) :: ZFPR
!
INTEGER :: JMOD, JMOD_IFN
@@ -625,6 +628,7 @@ IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA')
END IF
IF (HCLOUD(1:3)=='ICE' .AND. LRED) THEN
!$acc kernels
+ ALLOCATE(ZRSMIN(SIZE(XRTMIN)))
ZRSMIN(:) = XRTMIN(:) / PTSTEP
!$acc end kernels
ENDIF
@@ -1201,8 +1205,8 @@ CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','C2R2//KHKO not yet implemente
PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
PINPRC,PINPRR, PEVAP3D, &
-! PINPRS, PINPRG, PSIGS, PINDEP, PSEA,PTOWN, PFPR=ZFPR)
- PINPRS, PINPRG, PSIGS, PINDEP, PSEA=PSEA,PTOWN=PTOWN)
+! PINPRS, PINPRG, PSIGS, PINDEP, PRAINFR,, PSEA,PTOWN, PFPR=ZFPR)
+ PINPRS, PINPRG, PSIGS, PINDEP, PRAINFR, PSEA=PSEA,PTOWN=PTOWN)
!$acc end data
ELSE
!$acc update device(PCIT,PCLDFR, &
@@ -1221,7 +1225,7 @@ CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','C2R2//KHKO not yet implemente
PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
- PINPRS, PINPRG, PSIGS, PINDEP, &
+ PINPRS, PINPRG, PSIGS, PINDEP, PRAINFR, &
! PSEA, PTOWN, PFPR=ZFPR )
PSEA, PTOWN )
!$acc end data
@@ -1307,7 +1311,7 @@ CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','ICE4 not yet implemented')
PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
PINPRC, PINPRR, PEVAP3D, &
- PINPRS, PINPRG, PSIGS, PINDEP, PSEA, PTOWN, &
+ PINPRS, PINPRG, PSIGS, PINDEP, PRAINFR, PSEA, PTOWN, &
! PRT(:,:,:,7), PRS(:,:,:,7), PINPRH, PFPR=ZFPR )
PRT(:,:,:,7), PRS(:,:,:,7), PINPRH )
ELSE
@@ -1322,7 +1326,7 @@ CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','ICE4 not yet implemented')
PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
- PINPRS, PINPRG, PSIGS,PINDEP, &
+ PINPRS, PINPRG, PSIGS,PINDEP, PRAINFR, &
PSEA, PTOWN, &
! PRT(:,:,:,7), PRS(:,:,:,7), PINPRH,PFPR=ZFPR )
PRT(:,:,:,7), PRS(:,:,:,7), PINPRH)
diff --git a/src/MNH/resolved_elecn.f90 b/src/MNH/resolved_elecn.f90
index aaa23d218592064ab5631658ba5454a42d6a3048..2f97d01ac175e333560a4f404e94fa2cfbfe27ee 100644
--- a/src/MNH/resolved_elecn.f90
+++ b/src/MNH/resolved_elecn.f90
@@ -2,6 +2,7 @@
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C 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_RESOLVED_ELEC_n
! ###########################
@@ -165,9 +166,10 @@ END MODULE MODI_RESOLVED_ELEC_n
!! M. Chong 26/01/10 Add Small ions parameters
!! M. Chong 31/07/14 Add explicit LiNOx
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! Philippe Wautelet: 10/01/2019: use NEWUNIT argument of OPEN
-!! Philippe Wautelet: 22/01/2019: use standard FLUSH statement instead of non standard intrinsics
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 10/01/2019: use NEWUNIT argument of OPEN
+! P. Wautelet 22/01/2019: use standard FLUSH statement instead of non standard intrinsics
+! P. Wautelet 14/03/2019: bugfix: correct management of files
!!
!-------------------------------------------------------------------------------
!
@@ -175,15 +177,15 @@ END MODULE MODI_RESOLVED_ELEC_n
! ------------
!
USE MODE_ELEC_ll
-USE MODE_FM, ONLY: IO_FILE_CLOSE_ll,IO_FILE_OPEN_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST,IO_FILE_FIND_BYNAME
+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_FIELD_n, ONLY : XRSVS
USE MODD_CONF, ONLY : L1D, L2D, CEXP
USE MODD_CST
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA, TFILE_DUMMY
USE MODD_PARAMETERS, ONLY : JPVEXT
USE MODD_ELEC_DESCR
USE MODD_ELEC_n
@@ -344,16 +346,21 @@ CHARACTER (LEN=32) :: YASCFILE
REAL :: ZTEMP_DIST
CHARACTER (LEN=18) :: YNAME
LOGICAL :: GLMA_FILE
-TYPE(TFILEDATA),POINTER :: TZFILE_FGEOM_COORD
-TYPE(TFILEDATA),POINTER :: TZFILE_FGEOM_DIAG
-TYPE(TFILEDATA),POINTER :: TZFILE_LMA
-TYPE(TFILEDATA),POINTER :: TZFILE_SERIES_CLOUD_ELEC
+LOGICAL, SAVE :: GFIRST_CALL = .TRUE.
+TYPE(TFILEDATA),POINTER, SAVE :: TZFILE_FGEOM_COORD => NULL()
+TYPE(TFILEDATA),POINTER, SAVE :: TZFILE_FGEOM_DIAG => NULL()
+TYPE(TFILEDATA),POINTER, SAVE :: TZFILE_LMA => NULL()
+TYPE(TFILEDATA),POINTER, SAVE :: TZFILE_SERIES_CLOUD_ELEC => NULL()
!
NULLIFY(TZFIELDS_ll)
-TZFILE_FGEOM_COORD => NULL()
-TZFILE_FGEOM_DIAG => NULL()
-TZFILE_LMA => NULL()
-TZFILE_SERIES_CLOUD_ELEC => NULL()
+!
+IF ( GFIRST_CALL ) THEN
+ GFIRST_CALL = .FALSE.
+ TZFILE_FGEOM_COORD => TFILE_DUMMY
+ TZFILE_FGEOM_DIAG => TFILE_DUMMY
+ TZFILE_LMA => TFILE_DUMMY
+ TZFILE_SERIES_CLOUD_ELEC => TFILE_DUMMY
+END IF
!
!------------------------------------------------------------------------------
!
@@ -846,8 +853,9 @@ ENDIF
IF (KTCOUNT==1 .AND. IPROC==0) THEN
IF (LFLASH_GEOM) THEN
YASCFILE = CEXP//"_fgeom_diag.asc"
- CALL IO_FILE_ADD2LIST(TZFILE_FGEOM_DIAG,YASCFILE,'TXT','WRITE')
- CALL IO_FILE_OPEN_ll(TZFILE_FGEOM_DIAG,HPOSITION='APPEND',HSTATUS='NEW')
+ 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')
ILU = TZFILE_FGEOM_DIAG%NLU
WRITE (UNIT=ILU, FMT='(A)') '--------------------------------------------------------'
WRITE (UNIT=ILU, FMT='(A)') '*FLASH CHARACTERISTICS FROM FLASH_GEOM_ELEC*'
@@ -870,8 +878,9 @@ IF (KTCOUNT==1 .AND. IPROC==0) THEN
!
IF (LSAVE_COORD) THEN
YASCFILE = CEXP//"_fgeom_coord.asc"
- CALL IO_FILE_ADD2LIST(TZFILE_FGEOM_COORD,YASCFILE,'TXT','WRITE')
- CALL IO_FILE_OPEN_ll(TZFILE_FGEOM_COORD,HPOSITION='APPEND',HSTATUS='NEW')
+ 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')
ILU = TZFILE_FGEOM_COORD%NLU
WRITE (UNIT=ILU,FMT='(A)') '------------------------------------------'
WRITE (UNIT=ILU,FMT='(A)') '*****FLASH COORD. FROM FLASH_GEOM_ELEC****'
@@ -888,8 +897,9 @@ IF (KTCOUNT==1 .AND. IPROC==0) THEN
!
IF (LSERIES_ELEC) THEN
YASCFILE = CEXP//"_series_cloud_elec.asc"
- CALL IO_FILE_ADD2LIST(TZFILE_SERIES_CLOUD_ELEC,YASCFILE,'TXT','WRITE')
- CALL IO_FILE_OPEN_ll(TZFILE_SERIES_CLOUD_ELEC,HPOSITION='APPEND',HSTATUS='NEW')
+ 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')
ILU = TZFILE_SERIES_CLOUD_ELEC%NLU
WRITE (UNIT=ILU, FMT='(A)') '----------------------------------------------------'
WRITE (UNIT=ILU, FMT='(A)') '********* RESULTS FROM of LSERIES_ELEC *************'
@@ -935,8 +945,8 @@ IF (LFLASH_GEOM .AND. LLMA) THEN
!
IF (GLMA_FILE) THEN
IF(CLMA_FILE(1:5) /= "BEGIN") THEN ! close previous file if exists
- CALL IO_FILE_FIND_BYNAME(CLMA_FILE,TZFILE_LMA,IERR)
- CALL IO_FILE_CLOSE_ll(TZFILE_LMA)
+ CALL IO_File_find_byname(CLMA_FILE,TZFILE_LMA,IERR)
+ CALL IO_File_close(TZFILE_LMA)
TZFILE_LMA => NULL()
ENDIF
!
@@ -949,8 +959,9 @@ IF (LFLASH_GEOM .AND. LLMA) THEN
CLMA_FILE = CEXP//"_SIMLMA_"//YNAME//".dat"
!
IF ( IPROC .EQ. 0 ) THEN
- CALL IO_FILE_ADD2LIST(TZFILE_LMA,CLMA_FILE,'TXT','WRITE')
- CALL IO_FILE_OPEN_ll(TZFILE_LMA,HPOSITION='APPEND',HSTATUS='NEW')
+ TZFILE_LMA => NULL()
+ CALL IO_File_add2list(TZFILE_LMA,CLMA_FILE,'TXT','WRITE')
+ CALL IO_File_open(TZFILE_LMA,HPOSITION='APPEND',HSTATUS='NEW')
ILU = TZFILE_LMA%NLU
WRITE (UNIT=ILU,FMT='(A)') '----------------------------------------'
WRITE (UNIT=ILU,FMT='(A)') '*** FLASH COORD. FROM LMA SIMULATOR ****'
@@ -1026,10 +1037,22 @@ END IF
!
! Close Ascii Files if KTCOUNT = NSTOP
IF (OEXIT .AND. IPROC==0) THEN
- IF (LFLASH_GEOM) CALL IO_FILE_CLOSE_ll(TZFILE_FGEOM_DIAG)
- IF(LFLASH_GEOM .AND. LSAVE_COORD) CALL IO_FILE_CLOSE_ll(TZFILE_FGEOM_COORD)
- IF (LSERIES_ELEC) CALL IO_FILE_CLOSE_ll(TZFILE_SERIES_CLOUD_ELEC)
- IF (LFLASH_GEOM .AND. LLMA) CALL IO_FILE_CLOSE_ll(TZFILE_LMA)
+ IF (LFLASH_GEOM) THEN
+ CALL IO_File_close(TZFILE_FGEOM_DIAG)
+ TZFILE_FGEOM_DIAG => TFILE_DUMMY
+ END IF
+ IF (LFLASH_GEOM .AND. LSAVE_COORD) THEN
+ CALL IO_File_close(TZFILE_FGEOM_COORD)
+ TZFILE_FGEOM_COORD => TFILE_DUMMY
+ END IF
+ IF (LSERIES_ELEC) THEN
+ CALL IO_File_close(TZFILE_SERIES_CLOUD_ELEC)
+ TZFILE_SERIES_CLOUD_ELEC => TFILE_DUMMY
+ END IF
+ IF (LFLASH_GEOM .AND. LLMA) THEN
+ CALL IO_File_close(TZFILE_LMA)
+ TZFILE_LMA => TFILE_DUMMY
+ END IF
ENDIF
!
!
diff --git a/src/MNH/retrieve1_nest_infon.f90 b/src/MNH/retrieve1_nest_infon.f90
index 03b49bc76a3ef17ad6dadd7e242c54bd0fee213e..8edcfee3808642754cfa8bad3f227d8ed1b99470 100644
--- a/src/MNH/retrieve1_nest_infon.f90
+++ b/src/MNH/retrieve1_nest_infon.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 spawn 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ################################
MODULE MODI_RETRIEVE1_NEST_INFO_n
! ################################
@@ -72,8 +67,6 @@ END MODULE MODI_RETRIEVE1_NEST_INFO_n
!! NIMAX, NJMAX
!! Module MODD_PARAMETERS :
!! JPHEXT
-!! Module MODD_LUNIT :
-!! CLUOUT
!!
!! REFERENCE
!! ---------
@@ -89,6 +82,7 @@ END MODULE MODI_RETRIEVE1_NEST_INFO_n
!! Original 26/09/96
!! Modification 30/07/97 (Masson) group MODI_RETRIEVE2_NEST_INFOn
!! Modification 04/05/00 (Jabouille) test on CPROGRAM to fill working modules
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -99,6 +93,8 @@ USE MODD_DIM_n
USE MODD_PGDGRID
USE MODD_PGDDIM
USE MODD_CONF
+!
+use mode_msg
USE MODE_MODELN_HANDLER
!
USE MODI_RETRIEVE2_NEST_INFO_n
@@ -124,11 +120,7 @@ INTEGER :: IMI
!-------------------------------------------------------------------------------
!
!
-IF (KMI<=KDAD) THEN
- !callabortstop
- CALL ABORT
- STOP
-ENDIF
+IF ( KMI <= KDAD ) call Print_msg( NVERB_FATAL, 'GEN', 'RETRIEVE1_NEST_INFO_n', 'KMI<=KDAD' )
!
IMI = GET_CURRENT_MODEL_INDEX()
CALL GOTO_MODEL(KDAD)
diff --git a/src/MNH/retrieve2_nest_infon.f90 b/src/MNH/retrieve2_nest_infon.f90
index 9464e043180001fc701b10ca84446b7b5f499361..b974932530682ad0186d3465847a2dbb0b6597e9 100644
--- a/src/MNH/retrieve2_nest_infon.f90
+++ b/src/MNH/retrieve2_nest_infon.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1996-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ################################
@@ -71,7 +71,7 @@ END MODULE MODI_RETRIEVE2_NEST_INFO_n
!! Module MODD_PARAMETERS :
!! JPHEXT
!! Module MODD_LUNIT :
-!! CLUOUT
+!! TLUOUT0
!!
!! REFERENCE
!! ---------
@@ -89,7 +89,7 @@ END MODULE MODI_RETRIEVE2_NEST_INFO_n
!! J Stein 04/07/01 add cartesian case
!! M.Faivre 2014
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! J.Escobar : 01/06/2016 : Bug in type of ZBUF INTEGER => REAL & use MPI_PRECISION for r4/R8 compatibility
+!! J.Escobar : 01/06/2016 : Bug in type of ZBUF INTEGER => REAL & use MNHREAL_MPI for r4/R8 compatibility
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!-------------------------------------------------------------------------------
!
@@ -100,14 +100,15 @@ USE MODD_DIM_ll, ONLY: NXOR_ALL, NXEND_ALL, NYOR_ALL, NYEND_ALL, NIMAX_TMP
USE MODD_DIM_n, ONLY: NIMAX, NJMAX
USE MODD_GRID
USE MODD_GRID_n
-USE MODD_IO_ll, ONLY: ISNPROC, ISP
+USE MODD_IO, ONLY: ISNPROC, ISP
USE MODD_LUNIT, ONLY: TLUOUT0
USE MODD_MPIF
USE MODD_PARAMETERS
USE MODD_PGDDIM
USE MODD_PGDGRID
+use modd_precision, only: MNHREAL_MPI
USE MODD_STRUCTURE_ll, ONLY: ZONE_ll
-USE MODD_VAR_ll, ONLY: YSPLITTING, NMNH_COMM_WORLD, MPI_PRECISION
+USE MODD_VAR_ll, ONLY: YSPLITTING, NMNH_COMM_WORLD
!
USE MODE_GRIDPROJ
USE MODE_MODELN_HANDLER
@@ -302,13 +303,13 @@ ENDIF
! get the value of XXHAT and XYHAT at the origin of global son model
ZXHATFIRSTENTRY_C = XXHAT(JPHEXT+1)
ZYHATFIRSTENTRY_C = XYHAT(JPHEXT+1)
- CALL MPI_ALLREDUCE(XXHAT(JPHEXT+1), ZXHATFIRSTENTRY_C, 1,MPI_PRECISION, MPI_MIN, NMNH_COMM_WORLD, IINFO_ll)
- CALL MPI_ALLREDUCE(XYHAT(JPHEXT+1), ZYHATFIRSTENTRY_C, 1,MPI_PRECISION, MPI_MIN, NMNH_COMM_WORLD, IINFO_ll)
+ CALL MPI_ALLREDUCE(XXHAT(JPHEXT+1), ZXHATFIRSTENTRY_C, 1,MNHREAL_MPI, MPI_MIN, NMNH_COMM_WORLD, IINFO_ll)
+ CALL MPI_ALLREDUCE(XYHAT(JPHEXT+1), ZYHATFIRSTENTRY_C, 1,MNHREAL_MPI, MPI_MIN, NMNH_COMM_WORLD, IINFO_ll)
! get the latitude and longitude ZLAT2 and ZLON2 at the origin of global son model
ZLAT2GLB = ZLAT2
ZLON2GLB = ZLON2
- CALL MPI_ALLREDUCE(ZLAT2, ZLAT2GLB, 1,MPI_PRECISION, MPI_MIN, NMNH_COMM_WORLD, IINFO_ll)
- CALL MPI_ALLREDUCE(ZLON2, ZLON2GLB, 1,MPI_PRECISION, MPI_MIN, NMNH_COMM_WORLD, IINFO_ll)
+ CALL MPI_ALLREDUCE(ZLAT2, ZLAT2GLB, 1,MNHREAL_MPI, MPI_MIN, NMNH_COMM_WORLD, IINFO_ll)
+ CALL MPI_ALLREDUCE(ZLON2, ZLON2GLB, 1,MNHREAL_MPI, MPI_MIN, NMNH_COMM_WORLD, IINFO_ll)
! identify the process that own the origin of global son model, and communicate the global indices of the origin to all processes
IF ( ZXHATFIRSTENTRY_C > XPGDXHAT(JPHEXT+1) .AND. ZXHATFIRSTENTRY_C <= XPGDXHAT(SIZE(XPGDXHAT)-JPHEXT) .AND. &
@@ -365,8 +366,8 @@ DO IPROC = 0,ISNPROC-1 !loop on all processes
ZXHATFIRSTENTRY_C = XXHAT(JPHEXT+1)
ZYHATFIRSTENTRY_C = XYHAT(JPHEXT+1)
! broadcast XXHAT(JPHEXT+1) and find which process' father subdomain contains the coords of the first physical entry of local son subdomain
- CALL MPI_BCAST( ZXHATFIRSTENTRY_C, 1, MPI_PRECISION, IPROC, NMNH_COMM_WORLD, IINFO_ll )
- CALL MPI_BCAST( ZYHATFIRSTENTRY_C, 1, MPI_PRECISION, IPROC, NMNH_COMM_WORLD, IINFO_ll )
+ CALL MPI_BCAST( ZXHATFIRSTENTRY_C, 1, MNHREAL_MPI, IPROC, NMNH_COMM_WORLD, IINFO_ll )
+ CALL MPI_BCAST( ZYHATFIRSTENTRY_C, 1, MNHREAL_MPI, IPROC, NMNH_COMM_WORLD, IINFO_ll )
!
! communicating the value of XPGDXHAT (X direction) at the origin of local son subdomain
IF ( IPROC == ISP-1 .AND. ZXHATFIRSTENTRY_C >= XPGDXHAT(JPHEXT+1) &
@@ -389,9 +390,9 @@ DO IPROC = 0,ISNPROC-1 !loop on all processes
! the index of the first physical point of the local son subdomain of IPROC is II on the current process
! send XPGDXHAT(II) to process IPROC
ZSENDBUF = XPGDXHAT(II)
- CALL MPI_SEND( ZSENDBUF,1,MPI_PRECISION,IPROC,ISP+II,NMNH_COMM_WORLD,IINFO_ll )
+ CALL MPI_SEND( ZSENDBUF,1,MNHREAL_MPI,IPROC,ISP+II,NMNH_COMM_WORLD,IINFO_ll )
ELSE IF ( IPROC == ISP-1 ) THEN
- CALL MPI_RECV( ZRECVBUF,1,MPI_PRECISION,MPI_ANY_SOURCE,MPI_ANY_TAG,NMNH_COMM_WORLD,MPI_STATUS_IGNORE,IINFO_ll )
+ CALL MPI_RECV( ZRECVBUF,1,MNHREAL_MPI,MPI_ANY_SOURCE,MPI_ANY_TAG,NMNH_COMM_WORLD,MPI_STATUS_IGNORE,IINFO_ll )
ZPGDXHATIXY1 = ZRECVBUF
ELSE
! the other processes do nothing...
@@ -418,9 +419,9 @@ DO IPROC = 0,ISNPROC-1 !loop on all processes
! the index of the first physical point of the local son subdomain is II on the current process
! send XPGDYHAT(II) to process IPROC
ZSENDBUF = XPGDYHAT(II)
- CALL MPI_SEND( ZSENDBUF,1,MPI_PRECISION,IPROC,ISP+II,NMNH_COMM_WORLD,IINFO_ll )
+ CALL MPI_SEND( ZSENDBUF,1,MNHREAL_MPI,IPROC,ISP+II,NMNH_COMM_WORLD,IINFO_ll )
ELSE IF ( IPROC == ISP-1 ) THEN
- CALL MPI_RECV( ZRECVBUF,1,MPI_PRECISION,MPI_ANY_SOURCE,MPI_ANY_TAG,NMNH_COMM_WORLD,MPI_STATUS_IGNORE,IINFO_ll )
+ CALL MPI_RECV( ZRECVBUF,1,MNHREAL_MPI,MPI_ANY_SOURCE,MPI_ANY_TAG,NMNH_COMM_WORLD,MPI_STATUS_IGNORE,IINFO_ll )
ZPGDYHATIXY1 = ZRECVBUF
ELSE
! the other processes do nothing...
@@ -437,8 +438,8 @@ DO IPROC = 0,ISNPROC-1 !loop on all processes
ZXHATFIRSTENTRY_C = XXHAT(JPHEXT+1)
ZYHATFIRSTENTRY_C = XYHAT(JPHEXT+1)
! broadcast XXHAT(JPHEXT+1) and find which process' father subdomain contains the coords of the first physical entry of local son subdomain
- CALL MPI_BCAST( ZXHATFIRSTENTRY_C, 1, MPI_PRECISION, IPROC, NMNH_COMM_WORLD, IINFO_ll )
- CALL MPI_BCAST( ZYHATFIRSTENTRY_C, 1, MPI_PRECISION, IPROC, NMNH_COMM_WORLD, IINFO_ll )
+ CALL MPI_BCAST( ZXHATFIRSTENTRY_C, 1, MNHREAL_MPI, IPROC, NMNH_COMM_WORLD, IINFO_ll )
+ CALL MPI_BCAST( ZYHATFIRSTENTRY_C, 1, MNHREAL_MPI, IPROC, NMNH_COMM_WORLD, IINFO_ll )
!
! communicating the value of XPGDXHAT (X direction) at the origin of local son subdomain
IF ( IPROC == ISP-1 .AND. ZXHATFIRSTENTRY_C >= XPGDXHAT(JPHEXT+1) &
@@ -462,9 +463,9 @@ DO IPROC = 0,ISNPROC-1 !loop on all processes
! XPGDXHAT(II+1) is also defined on current process since HALO is at least 1
! send XPGDXHAT(II+1) to process IPROC
ZSENDBUF = XPGDXHAT(II+1)
- CALL MPI_SEND( ZSENDBUF,1,MPI_PRECISION,IPROC,ISP+II+1,NMNH_COMM_WORLD,IINFO_ll )
+ CALL MPI_SEND( ZSENDBUF,1,MNHREAL_MPI,IPROC,ISP+II+1,NMNH_COMM_WORLD,IINFO_ll )
ELSE IF ( IPROC == ISP-1 ) THEN
- CALL MPI_RECV( ZRECVBUF,1,MPI_PRECISION,MPI_ANY_SOURCE,MPI_ANY_TAG,NMNH_COMM_WORLD,MPI_STATUS_IGNORE,IINFO_ll )
+ CALL MPI_RECV( ZRECVBUF,1,MNHREAL_MPI,MPI_ANY_SOURCE,MPI_ANY_TAG,NMNH_COMM_WORLD,MPI_STATUS_IGNORE,IINFO_ll )
ZPGDXHATIXY1_1 = ZRECVBUF
ELSE
! the other processes do nothing...
@@ -492,9 +493,9 @@ DO IPROC = 0,ISNPROC-1 !loop on all processes
! XPGDYHAT(II+1) is also defined on current process since HALO is at least 1
! send XPGDYHAT(II+1) to process IPROC
ZSENDBUF = XPGDYHAT(II+1)
- CALL MPI_SEND( ZSENDBUF,1,MPI_PRECISION,IPROC,ISP+II+1,NMNH_COMM_WORLD,IINFO_ll )
+ CALL MPI_SEND( ZSENDBUF,1,MNHREAL_MPI,IPROC,ISP+II+1,NMNH_COMM_WORLD,IINFO_ll )
ELSE IF ( IPROC == ISP-1 ) THEN
- CALL MPI_RECV( ZRECVBUF,1,MPI_PRECISION,MPI_ANY_SOURCE,MPI_ANY_TAG,NMNH_COMM_WORLD,MPI_STATUS_IGNORE,IINFO_ll )
+ CALL MPI_RECV( ZRECVBUF,1,MNHREAL_MPI,MPI_ANY_SOURCE,MPI_ANY_TAG,NMNH_COMM_WORLD,MPI_STATUS_IGNORE,IINFO_ll )
ZPGDYHATIXY1_1 = ZRECVBUF
ELSE
! the other processes do nothing...
@@ -534,8 +535,8 @@ DO IPROC = 0,ISNPROC-1 !loop on all processes
ZXHATLASTENTRY_C = XXHAT(SIZE(XXHAT)-JPHEXT)
ZYHATLASTENTRY_C = XYHAT(SIZE(XYHAT)-JPHEXT)
! broadcast XXHAT(SIZE(XXHAT)-JPHEXT) and find which process' father subdomain contains the coords of the last physical entry of local son subdomain
- CALL MPI_BCAST( ZXHATLASTENTRY_C, 1, MPI_PRECISION, IPROC, NMNH_COMM_WORLD, IINFO_ll )
- CALL MPI_BCAST( ZYHATLASTENTRY_C, 1, MPI_PRECISION, IPROC, NMNH_COMM_WORLD, IINFO_ll )
+ CALL MPI_BCAST( ZXHATLASTENTRY_C, 1, MNHREAL_MPI, IPROC, NMNH_COMM_WORLD, IINFO_ll )
+ CALL MPI_BCAST( ZYHATLASTENTRY_C, 1, MNHREAL_MPI, IPROC, NMNH_COMM_WORLD, IINFO_ll )
!
! communicating the value of XPGDXHAT (X direction) at the origin of local son subdomain
IF ( IPROC == ISP-1 .AND. ZXHATLASTENTRY_C >= XPGDXHAT(JPHEXT+1) &
@@ -565,9 +566,9 @@ DO IPROC = 0,ISNPROC-1 !loop on all processes
! send XPGDXHAT(II) to process IPROC
! XPGDYHAT(II+1) is also defined on current process since HALO is at least 1
ZSENDBUF = XPGDXHAT(II)
- CALL MPI_SEND( ZSENDBUF,1,MPI_PRECISION,IPROC,ISP+II,NMNH_COMM_WORLD,IINFO_ll )
+ CALL MPI_SEND( ZSENDBUF,1,MNHREAL_MPI,IPROC,ISP+II,NMNH_COMM_WORLD,IINFO_ll )
ELSE IF ( IPROC == ISP-1 ) THEN
- CALL MPI_RECV( ZRECVBUF,1,MPI_PRECISION,MPI_ANY_SOURCE,MPI_ANY_TAG,NMNH_COMM_WORLD,MPI_STATUS_IGNORE,IINFO_ll )
+ CALL MPI_RECV( ZRECVBUF,1,MNHREAL_MPI,MPI_ANY_SOURCE,MPI_ANY_TAG,NMNH_COMM_WORLD,MPI_STATUS_IGNORE,IINFO_ll )
ZPGDXHATIXY2_1 = ZRECVBUF
ELSE
! the other processes do nothing...
@@ -600,9 +601,9 @@ DO IPROC = 0,ISNPROC-1 !loop on all processes
! the index of the last physical point of the local son subdomain is II on the current process
! send XPGDYHAT(II) to process IPROC
ZSENDBUF = XPGDYHAT(II)
- CALL MPI_SEND( ZSENDBUF,1,MPI_PRECISION,IPROC,ISP+II,NMNH_COMM_WORLD,IINFO_ll )
+ CALL MPI_SEND( ZSENDBUF,1,MNHREAL_MPI,IPROC,ISP+II,NMNH_COMM_WORLD,IINFO_ll )
ELSE IF ( IPROC == ISP-1 ) THEN
- CALL MPI_RECV( ZRECVBUF,1,MPI_PRECISION,MPI_ANY_SOURCE,MPI_ANY_TAG,NMNH_COMM_WORLD,MPI_STATUS_IGNORE,IINFO_ll )
+ CALL MPI_RECV( ZRECVBUF,1,MNHREAL_MPI,MPI_ANY_SOURCE,MPI_ANY_TAG,NMNH_COMM_WORLD,MPI_STATUS_IGNORE,IINFO_ll )
ZPGDYHATIXY2_1 = ZRECVBUF
ELSE
! the other processes do nothing...
@@ -616,8 +617,8 @@ ENDDO
! 3.3 - now we have the coordinates (ZPGDXHATIXY2_1, ZPGDYHATIXY2_1) of the point in father grid just right+north of the LOCAL son subdomain
! We compute the coordinates of the last point in father grid of the GLOBAL son subdomain
-CALL MPI_ALLREDUCE(ZPGDXHATIXY2_1, IXSUPCOORD1, 1,MPI_PRECISION, MPI_MAX, NMNH_COMM_WORLD, IINFO_ll)
-CALL MPI_ALLREDUCE(ZPGDYHATIXY2_1, IYSUPCOORD1, 1,MPI_PRECISION, MPI_MAX, NMNH_COMM_WORLD, IINFO_ll)
+CALL MPI_ALLREDUCE(ZPGDXHATIXY2_1, IXSUPCOORD1, 1,MNHREAL_MPI, MPI_MAX, NMNH_COMM_WORLD, IINFO_ll)
+CALL MPI_ALLREDUCE(ZPGDYHATIXY2_1, IYSUPCOORD1, 1,MNHREAL_MPI, MPI_MAX, NMNH_COMM_WORLD, IINFO_ll)
! we compute the index of this point in local father grid
IF ( IXSUPCOORD1 >= XPGDXHAT(1+JPHEXT) .AND. IXSUPCOORD1 <= XPGDXHAT(SIZE(XPGDXHAT)-JPHEXT) .AND. &
diff --git a/src/MNH/rms_at_z.f90 b/src/MNH/rms_at_z.f90
index 94cbf821132f48c0a728a64e953881cddbca3e41..3e2b11a93f91901a81b4a46c2aec087dabe7c3da 100644
--- a/src/MNH/rms_at_z.f90
+++ b/src/MNH/rms_at_z.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1996-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
!###################
@@ -62,6 +62,7 @@ END MODULE MODI_RMS_AT_Z
!! 26/08/97 (V. Masson) call to new linear vertical
!! interpolation routine
!! 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)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -172,7 +173,7 @@ WRITE(ILUOUT0,*) ''
WRITE(ILUOUT0,*) HTITLE
WRITE(ILUOUT0,*) ''
DO JZ=1,40
- WRITE(ILUOUT0,'(6Hlevel ,F6.0,5H m : ,F9.3)') ZZLEVELS(JZ),ZRMS(JZ)
+ WRITE(ILUOUT0,'( "level ", F6.0, " m : ", F9.3 )') ZZLEVELS(JZ),ZRMS(JZ)
END DO
WRITE(ILUOUT0,*) ''
!
diff --git a/src/MNH/salt_filter.f90 b/src/MNH/salt_filter.f90
index bff76dfe979c1d70196c4698031c2fa097ef0aee..bc40e889136a14db3727ae76c2c90da0e3572948 100644
--- a/src/MNH/salt_filter.f90
+++ b/src/MNH/salt_filter.f90
@@ -45,19 +45,8 @@ END MODULE MODI_SALT_FILTER
!! MODIFICATIONS
!! -------------
!! Original
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
!!
-! Entry variables:
-!
-! PRSVS(INOUT) -Array of moments included in PRSVS
-!
-!*************************************************************
-! Exit variables:
-!
-!*************************************************************
-! Variables used during the deposition velocity calculation
-!
-! ZVGK -Polydisperse settling velocity of the kth moment (m/s)
-!************************************************************
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -66,10 +55,12 @@ END MODULE MODI_SALT_FILTER
! IMPLICIT ARGUMENTS
!
USE MODD_SALT
-USE MODD_CSTS_SALT
-!
USE MODE_SALT_PSD
-USE MODD_CST, ONLY : XMNH_TINY
+
+!+ Marine
+USE MODI_INIT_SALT
+!- Marine
+
!
IMPLICIT NONE
!
@@ -78,27 +69,156 @@ IMPLICIT NONE
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSV
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
!
-!* 0.2 Declarations of local variables :
-!
-INTEGER :: JN
-INTEGER :: IMODEIDX
-REAL, DIMENSION(NMODE_SLT*3) :: ZPMIN
-REAL, DIMENSION(NMODE_SLT) :: ZINIRADIUS
-REAL, DIMENSION(SIZE(PSV,1), SIZE(PSV,2), SIZE(PSV,3), NMODE_SLT*3) :: ZM ! [aerosol units] local array which goes to output later
-
-REAL :: ZRGMIN, ZSIGMIN
-REAL :: ZRHOP, ZMI
-INTEGER,DIMENSION(NMODE_SLT) :: NM0, NM3, NM6
-!
-!* 0.3 initialize constant
-!
-ZRHOP = XDENSITY_SALT
-ZMI = XMOLARWEIGHT_SALT ! molecular mass in kg/mol
-!
+!* 0.2 declarations local variables
+!
+REAL :: ZRHOI ! [kg/m3] density of aerosol
+REAL :: ZMI ! [kg/mol] molar weight of aerosol
+REAL :: ZRGMIN ! [um] minimum radius accepted
+REAL :: ZSIGMIN ! minimum standard deviation accepted
+REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZM ! [aerosol units] local array which goes to output later
+REAL,DIMENSION(:), ALLOCATABLE :: ZMMIN ! [aerosol units] minimum values for N, sigma, M
+INTEGER,DIMENSION(:), ALLOCATABLE :: NM0 ! [idx] index for Mode 0 in passed variables
+INTEGER,DIMENSION(:), ALLOCATABLE :: NM3 ! [idx] indexes for Mode 3 in passed variables
+INTEGER,DIMENSION(:), ALLOCATABLE :: NM6 ! [idx] indexes for Mode 6 in passed variables
+REAL,DIMENSION(:), ALLOCATABLE :: ZINIRADIUS ! initial mean radius
+REAL,DIMENSION(:), ALLOCATABLE :: ZINISIGMA ! initial standard deviation
+INTEGER :: JN,IMODEIDX,JJ ! [idx] loop counters
+
!-------------------------------------------------------------------------------
+!+ Marine
+CALL INIT_SALT
+!- Marine
+
+
+ALLOCATE (NM0(NMODE_SLT))
+ALLOCATE (NM3(NMODE_SLT))
+ALLOCATE (NM6(NMODE_SLT))
+ALLOCATE (ZM(SIZE(PSV,1), SIZE(PSV,2), SIZE(PSV,3), NMODE_SLT*3))
+ALLOCATE (ZMMIN(NMODE_SLT*3))
+ALLOCATE (ZINIRADIUS(NMODE_SLT))
+ALLOCATE (ZINISIGMA(NMODE_SLT))
+
+PSV(:,:,:,:) = MAX(PSV(:,:,:,:), XMNH_TINY)
+
+DO JN=1,NMODE_SLT
+ IMODEIDX = JPSALTORDER(JN)
+ !Calculations here are for one mode only
+ ZINISIGMA(JN) = XINISIG_SLT(IMODEIDX)
+ IF (CRGUNITS=="MASS") THEN
+ ZINIRADIUS(JN) = XINIRADIUS_SLT(IMODEIDX) * EXP(-3.*(LOG(XINISIG_SLT(IMODEIDX)))**2)
+ ELSE
+ ZINIRADIUS(JN) = XINIRADIUS_SLT(IMODEIDX)
+ END IF
+
+ !Set counter for number, M3 and M6
+ NM0(JN) = 1+(JN-1)*3
+ NM3(JN) = 2+(JN-1)*3
+ NM6(JN) = 3+(JN-1)*3
+ !Get minimum values possible
+ ZMMIN(NM0(JN)) = XN0MIN_SLT(IMODEIDX)
+ ZRGMIN = ZINIRADIUS(JN)
+ IF (LVARSIG_SLT) THEN
+ ZSIGMIN = XSIGMIN_SLT
+ ELSE
+ ZSIGMIN = XINISIG_SLT(IMODEIDX)
+ ENDIF
+ ZMMIN(NM3(JN)) = ZMMIN(NM0(JN)) * (ZRGMIN**3)*EXP(4.5 * LOG(ZSIGMIN)**2)
+ ZMMIN(NM6(JN)) = ZMMIN(NM0(JN)) * (ZRGMIN**6)*EXP(18. * LOG(ZSIGMIN)**2)
+END DO
+!
+!Set density of aerosol, here dust (kg/m3)
+ZRHOI = XDENSITY_SALT
+!Set molecular weight of dust !NOTE THAT THIS IS NOW IN KG
+ZMI = XMOLARWEIGHT_SALT
+!
+DO JN=1,NMODE_SLT
+ !calculate moment 3 from total aerosol mass (molec_{aer}/molec_{air} ==>
+ IF (LVARSIG_SLT) THEN
+ ZM(:,:,:,NM3(JN)) = &
+ PSV(:,:,:,2+(JN-1)*3) & !molec_{aer}/molec_{aer}
+ * (ZMI/XMD) & !==>kg_{aer}/kg_{aer}
+ * PRHODREF(:,:,:) & !==>kg_{aer}/m3_{air}
+ * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air}
+ * XM3TOUM3_SALT & !==>um3_{aer}/m3_{air}
+ / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment)
+ ELSE
+ IF ((LRGFIX_SLT)) THEN
+ ZM(:,:,:,NM3(JN)) = &
+ PSV(:,:,:,JN) & !molec_{aer}/molec_{aer}
+ * (ZMI/XMD) & !==>kg_{aer}/kg_{aer}
+ * PRHODREF(:,:,:) & !==>kg_{aer}/m3_{air}
+ * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air}
+ * XM3TOUM3_SALT & !==>um3_{aer}/m3_{air}
+ / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment)
+ ELSE
+ ZM(:,:,:,NM3(JN)) = &
+ PSV(:,:,:,2+(JN-1)*2) & !molec_{aer}/molec_{aer}
+ * (ZMI/XMD) & !==>kg_{aer}/kg_{aer}
+ * PRHODREF(:,:,:) & !==>kg_{aer}/m3_{air}
+ * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air}
+ * XM3TOUM3_SALT & !==>um3_{aer}/m3_{air}
+ / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment)
+ END IF
+ END IF
+
+! calculate moment 0 from dispersion and mean radius
+ ZM(:,:,:,NM0(JN))= ZM(:,:,:,NM3(JN))/&
+ ((ZINIRADIUS(JN)**3)*EXP(4.5 * LOG(ZINISIGMA(JN))**2))
+
+
+! calculate moment 6 from dispersion and mean radius
+ ZM(:,:,:,NM6(JN)) = ZM(:,:,:,NM0(JN)) * (ZINIRADIUS(JN)**6) * &
+ EXP(18 *(LOG(ZINISIGMA(JN)))**2)
+
+ IF (LVARSIG_SLT) THEN
+ WHERE ((ZM(:,:,:,NM0(JN)) .LT. ZMMIN(NM0(JN))).OR.&
+ (ZM(:,:,:,NM3(JN)) .LT. ZMMIN(NM3(JN))).OR.&
+ (ZM(:,:,:,NM6(JN)) .LT. ZMMIN(NM6(JN))))
+ ZM(:,:,:,NM0(JN)) = ZMMIN(NM0(JN))
+ ZM(:,:,:,NM3(JN)) = ZMMIN(NM3(JN))
+ ZM(:,:,:,NM6(JN)) = ZMMIN(NM6(JN))
+ END WHERE
+
+ ELSE IF (.NOT.(LRGFIX_SLT)) THEN
+
+ WHERE ((ZM(:,:,:,NM0(JN)) .LT. ZMMIN(NM0(JN))).OR.&
+ (ZM(:,:,:,NM3(JN)) .LT. ZMMIN(NM3(JN))))
+ ZM(:,:,:,NM0(JN)) = ZMMIN(NM0(JN))
+ ZM(:,:,:,NM3(JN)) = ZMMIN(NM3(JN))
+ END WHERE
+ ENDIF
+
+ ! return to concentration #/m3 => (#/molec_{air}
+ IF (LVARSIG_SLT) THEN
+ PSV(:,:,:,1+(JN-1)*3) = ZM(:,:,:,NM0(JN)) * XMD / &
+ (XAVOGADRO*PRHODREF(:,:,:))
+
+ PSV(:,:,:,2+(JN-1)*3) = ZM(:,:,:,NM3(JN)) * XMD * XPI * 4./3 * ZRHOI / &
+ (ZMI*PRHODREF(:,:,:)*XM3TOUM3_SALT)
+
+ PSV(:,:,:,3+(JN-1)*3) = ZM(:,:,:,NM6(JN)) * XMD / &
+ ( XAVOGADRO*PRHODREF(:,:,:) * 1.d-6)
+ ELSE IF (LRGFIX_SLT) THEN
+ PSV(:,:,:,JN) = ZM(:,:,:,NM3(JN)) * XMD * XPI * 4./3. * ZRHOI / &
+ (ZMI*PRHODREF(:,:,:)*XM3TOUM3_SALT)
+ ELSE
+ PSV(:,:,:,1+(JN-1)*2) = ZM(:,:,:,NM0(JN)) * XMD / &
+ (XAVOGADRO*PRHODREF(:,:,:))
+
+ PSV(:,:,:,2+(JN-1)*2) = ZM(:,:,:,NM3(JN)) * XMD * XPI * 4./3. * ZRHOI / &
+ (ZMI*PRHODREF(:,:,:)*XM3TOUM3_SALT)
+ END IF
!
-PSV(:,:,:,:) = MAX(PSV(:,:,:,:), XMNH_TINY)
-!
+END DO !Loop on modes
+
+DEALLOCATE(ZINIRADIUS)
+DEALLOCATE(ZMMIN)
+DEALLOCATE(ZINISIGMA)
+DEALLOCATE(ZM)
+DEALLOCATE(NM6)
+DEALLOCATE(NM3)
+DEALLOCATE(NM0)
+
END SUBROUTINE SALT_FILTER
diff --git a/src/MNH/saltlfin.f90 b/src/MNH/saltlfin.f90
index c3a2650b09b25c8d0c1e9b9d87396867f464e2f3..e99be7c7ae28aaa87a751dbbee645ab9dbde10f6 100644
--- a/src/MNH/saltlfin.f90
+++ b/src/MNH/saltlfin.f90
@@ -14,10 +14,14 @@
!
INTERFACE
!
-SUBROUTINE SALTLFI_n(PSV, PRHODREF)
+!++cb++24/10/16
+!SUBROUTINE SALTLFI_n(PSV, PRHODREF)
+SUBROUTINE SALTLFI_n(PSV, PRHODREF, PZZ)
IMPLICIT NONE
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSV
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSV
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ
+
END SUBROUTINE SALTLFI_n
!
END INTERFACE
@@ -26,7 +30,8 @@ END MODULE MODI_SALTLFI_n
!
!
! ############################################################
- SUBROUTINE SALTLFI_n(PSV, PRHODREF)
+! SUBROUTINE SALTLFI_n(PSV, PRHODREF)
+ SUBROUTINE SALTLFI_n(PSV, PRHODREF, PZZ)
! ############################################################
!
!! PURPOSE
@@ -43,9 +48,9 @@ END MODULE MODI_SALTLFI_n
!!
!! MODIFICATIONS
!! -------------
-!! none
-!!
!! 2014 P.Tulet modif calcul ZM
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+
!! EXTERNAL
!! --------
!! None
@@ -57,7 +62,9 @@ END MODULE MODI_SALTLFI_n
!
USE MODD_SALT
USE MODD_NSV
-USE MODD_GRID_n, ONLY: XZZ
+!++cb++24/10/16
+!USE MODD_GRID_n, ONLY: XZZ
+!--cb--
USE MODD_CSTS_SALT
USE MODD_CST, ONLY : &
XPI & !Definition of pi
@@ -75,6 +82,7 @@ IMPLICIT NONE
!
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSV
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ
!
!
!* 0.2 declarations local variables
@@ -88,9 +96,12 @@ REAL,DIMENSION(:), ALLOCATABLE :: ZMMIN
REAL,DIMENSION(:), ALLOCATABLE :: ZINIRADIUS, ZINISIGMA
REAL,DIMENSION(:,:), ALLOCATABLE :: ZSEA
INTEGER :: IKU
+!+Marine
+INTEGER :: IMOMENTS
+!-Marine
INTEGER :: JI, JJ, JN, JK ! loop counter
INTEGER :: IMODEIDX ! index mode
-REAL, PARAMETER :: ZN_SALT=0.1 ! particles of sea salt/cm3 {air}
+REAL, PARAMETER :: ZN_SALT=1E4 ! multiplcative factor for X0MIN
REAL, PARAMETER :: ZCLM=800. ! Marine Salt layer (m)
REAL :: ZN_SALTN
!
@@ -102,6 +113,7 @@ REAL :: ZN_SALTN
! 1.1 initialisation
!
IKU=SIZE(PSV,3)
+!+ Marine
!
ALLOCATE (IM0(NMODE_SLT))
ALLOCATE (IM3(NMODE_SLT))
@@ -115,11 +127,20 @@ ALLOCATE (ZMMIN(NMODE_SLT*3))
ALLOCATE (ZSEA(SIZE(PSV,1), SIZE(PSV,2)))
ZSEA(:,:) = 0.
-WHERE ((XZZ(:,:,1) .LT. 0.1).AND.(XZZ(:,:,1) .GE. 0.))
+!++cb++20/10/16
+!WHERE ((XZZ(:,:,1) .LT. 0.1).AND.(XZZ(:,:,1) .GE. 0.))
+! ZSEA(:,:) = 1.
+!END WHERE
+!++cb++24/10/16
+!WHERE (XZZ(:,:,1) .LE. 0.01)
+WHERE (PZZ(:,:,1) .LE. 0.01)
+!--cb--
ZSEA(:,:) = 1.
END WHERE
+!--cb--
!
!
+!+ Marine
DO JN = 1, NMODE_SLT
IM0(JN) = 1+(JN-1)*3
IM3(JN) = 2+(JN-1)*3
@@ -146,8 +167,8 @@ DO JN = 1, NMODE_SLT
ENDDO
!
!
-ZRHOI = XDENSITY_SALT !1.8e3 !++changed alfgr
-!ZMI = XMOLARWEIGHT_SALT*1.D3 !100. !++changed alfgr
+!XDENSITY_SALT est fixé dans modd_csts_salt.f90
+ZRHOI = XDENSITY_SALT
ZMI = XMOLARWEIGHT_SALT
ZDEN2MOL = 1E-6 * XAVOGADRO / XMD
ZFAC=(4./3.)*XPI*ZRHOI*1.e-9
@@ -158,18 +179,37 @@ DO JN=1,NMODE_SLT
!* 1.1 calculate moment 0 from sea salt number by m3
!
! initial vertical profil of sea salt and convert in #/m3
- IF (JN == 1) ZN_SALTN = 1E-4 * ZN_SALT *1E6
- IF (JN == 2) ZN_SALTN = 1. * ZN_SALT *1E6
- IF (JN == 3) ZN_SALTN = 10 * ZN_SALT *1E6
- DO JK=1, SIZE(XZZ,3)
- DO JJ=1, SIZE(XZZ,2)
- DO JI=1, SIZE(XZZ,1)
- IF (XZZ(JI,JJ,JK) .LT. 600.) THEN
- ZM(JI,JJ,JK,IM0(JN)) = ZN_SALTN
- ELSE IF ((XZZ(JI,JJ,JK) .GE. 600.).AND.(XZZ(JI,JJ,JK) .LT. 1000.)) THEN
- ZM(JI,JJ,JK,IM0(JN)) = ZN_SALTN - ZN_SALTN*(1.-1E-3)*(XZZ(JI,JJ,JK)-600.) / 400.
- ELSE IF (XZZ(JI,JJ,JK) .GE. 1000.) THEN
- ZM(JI,JJ,JK,IM0(JN)) = ZN_SALTN *1E-3
+!+Marine : (reprendre XN0MIN_SLT de modd_salt.f90).
+! Pas plus simple de fixer une dimension à ZN_SALT qui dépend de JN pour ne pas
+! avoir à rappeler le schéma d'émission?
+ IF(NMODE_SLT == 5)THEN
+ IF (JN == 1) ZN_SALTN = XN0MIN_SLT(JPSALTORDER(JN)) * ZN_SALT
+ IF (JN == 2) ZN_SALTN = XN0MIN_SLT(JPSALTORDER(JN)) * ZN_SALT
+ IF (JN == 3) ZN_SALTN = XN0MIN_SLT(JPSALTORDER(JN)) * ZN_SALT
+ IF (JN == 4) ZN_SALTN = XN0MIN_SLT(JPSALTORDER(JN)) * ZN_SALT
+ IF (JN == 5) ZN_SALTN = XN0MIN_SLT(JPSALTORDER(JN)) * ZN_SALT
+ ELSE
+ IF (JN == 1) ZN_SALTN = XN0MIN_SLT(JPSALTORDER(JN)) * ZN_SALT
+ IF (JN == 2) ZN_SALTN = XN0MIN_SLT(JPSALTORDER(JN)) * ZN_SALT
+ IF (JN == 3) ZN_SALTN = XN0MIN_SLT(JPSALTORDER(JN)) * ZN_SALT
+ END IF
+!-Marine
+ DO JK=1, SIZE(PSV,3)
+ DO JJ=1, SIZE(PSV,2)
+ DO JI=1, SIZE(PSV,1)
+!++cb++24/10/16
+! IF (XZZ(JI,JJ,JK) .LT. 600.) THEN
+ IF (PZZ(JI,JJ,JK) .LT. 600.) THEN
+ ZM(JI,JJ,JK,IM0(JN)) = ZN_SALTN
+! ELSE IF ((XZZ(JI,JJ,JK) .GE. 600.).AND.(XZZ(JI,JJ,JK) .LT. 1000.)) THEN
+ ELSE IF ((PZZ(JI,JJ,JK) .GE. 600.).AND.(PZZ(JI,JJ,JK) .LT. 1000.)) THEN
+! ZM(JI,JJ,JK,IM0(JN)) = ZN_SALTN - ZN_SALTN*(1.-1E-3)*(XZZ(JI,JJ,JK)-600.) / 400.
+ ZM(JI,JJ,JK,IM0(JN)) = ZN_SALTN - &
+ ZN_SALTN * (1.-1E-3) * (PZZ(JI,JJ,JK)-600.) / 400.
+! ELSE IF (XZZ(JI,JJ,JK) .GE. 1000.) THEN
+ ELSE IF (PZZ(JI,JJ,JK) .GE. 1000.) THEN
+ ZM(JI,JJ,JK,IM0(JN)) = ZN_SALTN * 1E-3
+!--cb--
END IF
END DO
END DO
@@ -179,7 +219,7 @@ DO JN=1,NMODE_SLT
END WHERE
WHERE ((ZSEA(:,:) .GT. 0.).AND.(ZSEA(:,:) .LT. 1.))
ZM(:,:,JK,IM0(JN)) = ZM(:,:,JK,IM0(JN))-(ZM(:,:,JK,IM0(JN)) -ZN_SALTN *1E-3) * &
- (1. - ZSEA(:,:))
+ (1. - ZSEA(:,:))
END WHERE
END DO
@@ -198,12 +238,31 @@ DO JN=1,NMODE_SLT
ZM(:,:,:,IM6(JN)) = MAX(ZMMIN(IM6(JN)), ZM(:,:,:,IM6(JN)))
!
!* 1.4 output concentration
+!+ Marine
+! PSV(:,:,:,1+(JN-1)*3) = ZM(:,:,:,IM0(JN)) * XMD / (XAVOGADRO*PRHODREF(:,:,:))
+! PSV(:,:,:,2+(JN-1)*3) = ZM(:,:,:,IM3(JN)) * XMD*XPI * 4./3. / &
+! (ZMI*PRHODREF(:,:,:)*(1.d0/ZRHOI)*XM3TOUM3_SALT)
+!
+! PSV(:,:,:,3+(JN-1)*3) = ZM(:,:,:,IM6(JN)) * XMD / (XAVOGADRO*PRHODREF(:,:,:)*1.d-6)
!
- PSV(:,:,:,1+(JN-1)*3) = ZM(:,:,:,IM0(JN)) * XMD / (XAVOGADRO*PRHODREF(:,:,:))
- PSV(:,:,:,2+(JN-1)*3) = ZM(:,:,:,IM3(JN)) * XMD*XPI * 4./3. / &
- (ZMI*PRHODREF(:,:,:)*(1.d0/ZRHOI)*XM3TOUM3_SALT)
+!++cb++20/10/16
+ IMOMENTS = INT(NSV_SLTEND - NSV_SLTBEG + 1) / NMODE_SLT
+!--cb--
- PSV(:,:,:,3+(JN-1)*3) = ZM(:,:,:,IM6(JN)) * XMD / (XAVOGADRO*PRHODREF(:,:,:)*1.d-6)
+ IF (IMOMENTS == 3) THEN
+ PSV(:,:,:,1+(JN-1)*3) = ZM(:,:,:,IM0(JN)) * XMD / (XAVOGADRO*PRHODREF(:,:,:))
+ PSV(:,:,:,2+(JN-1)*3) = ZM(:,:,:,IM3(JN)) * XMD*XPI * 4./3. / &
+ (ZMI*PRHODREF(:,:,:)*(1.d0/ZRHOI)*XM3TOUM3_SALT)
+
+ PSV(:,:,:,3+(JN-1)*3) = ZM(:,:,:,IM6(JN)) * XMD / (XAVOGADRO*PRHODREF(:,:,:)*1.d-6)
+ ELSE IF (IMOMENTS == 2) THEN
+ PSV(:,:,:,1+(JN-1)*2) = ZM(:,:,:,IM0(JN)) * XMD / (XAVOGADRO*PRHODREF(:,:,:))
+ PSV(:,:,:,2+(JN-1)*2) = ZM(:,:,:,IM3(JN)) * XMD*XPI * 4./3. / &
+ (ZMI*PRHODREF(:,:,:)*(1.d0/ZRHOI)*XM3TOUM3_SALT)
+ ELSE
+ PSV(:,:,:,JN) = ZM(:,:,:,IM3(JN)) * XMD*XPI * 4./3. / &
+ (ZMI*PRHODREF(:,:,:)*(1.d0/ZRHOI)*XM3TOUM3_SALT)
+ END IF
!
END DO
!
diff --git a/src/MNH/series_cloud_elec.f90 b/src/MNH/series_cloud_elec.f90
index f12d2fdcc054ab93ba7fcebc59e96ee5a7cfc252..6bd26c192d27311fc15960e005344dce7e9e7c62 100644
--- a/src/MNH/series_cloud_elec.f90
+++ b/src/MNH/series_cloud_elec.f90
@@ -2,6 +2,7 @@
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C 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_SERIES_CLOUD_ELEC
! #############################
@@ -14,7 +15,7 @@ INTERFACE
TPFILE_SERIES_CLOUD_ELEC, &
PINPRR )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
!
@@ -88,7 +89,7 @@ END MODULE MODI_SERIES_CLOUD_ELEC
!
USE MODD_CONF, ONLY : CEXP
USE MODD_CST
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_REF
USE MODD_PARAMETERS
USE MODD_ELEC_DESCR
diff --git a/src/MNH/seriesn.f90 b/src/MNH/seriesn.f90
index 9fff8dfb88f7aec0e107f3886fff7e9a1a3cd40d..c592e4b540e9bab63c7a48062de2430efad3081b 100644
--- a/src/MNH/seriesn.f90
+++ b/src/MNH/seriesn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2002-2018 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.
!-----------------------------------------------------------------
! ###################
@@ -63,7 +63,6 @@ USE MODD_TIME_n, ONLY: TDTCUR
USE MODI_GET_SURF_VAR_n
!
USE MODE_DATETIME
-USE MODE_IO_ll
USE MODE_ll
USE MODE_MSG
!
diff --git a/src/MNH/set_advfrc.f90 b/src/MNH/set_advfrc.f90
index fbdd5d92a0ca977c0f75f07b03e27ba2ff97a52d..b931fe38b25df299015f2528102b153cdf644489 100644
--- a/src/MNH/set_advfrc.f90
+++ b/src/MNH/set_advfrc.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
MODULE MODI_SETADVFRC
@@ -10,7 +10,7 @@ INTERFACE
!
SUBROUTINE SET_ADVFRC(TPEXPREFILE)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPEXPREFILE ! input data file
!
@@ -85,13 +85,12 @@ USE MODD_DIM_n
USE MODD_FRC
USE MODD_GRID
USE MODD_GRID_n
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
USE MODD_REF
!
USE MODE_DATETIME
-USE MODE_IO_ll
USE MODE_MSG
USE MODE_THERMO
!
diff --git a/src/MNH/set_bogus_vortex.f90 b/src/MNH/set_bogus_vortex.f90
index 28ae29f476af3a7540f8e624b28e9580b60710e3..4cc56703d6fb758eb51589cb2af19b4cf6197424 100644
--- a/src/MNH/set_bogus_vortex.f90
+++ b/src/MNH/set_bogus_vortex.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2001-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2001-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.
!-----------------------------------------------------------------
! ############################
@@ -73,9 +73,8 @@ END MODULE MODI_SET_BOGUS_VORTEX
!* 0. DECLARATIONS
! ------------
!
-USE MODE_ll
-USE MODE_IO_ll
USE MODE_GRIDPROJ
+USE MODE_ll
USE MODE_MSG
!
USE MODD_HURR_CONF, ONLY: XLATBOG,XLONBOG,XVTMAXSURF,XRADWINDSURF, &
diff --git a/src/MNH/set_conc_lima.f90 b/src/MNH/set_conc_lima.f90
index c111ac6434d0a331477bd5c881a309a47eeb1c72..6f9e6c6ad06019e5104d70c6a2c4e92c01462bd4 100644
--- a/src/MNH/set_conc_lima.f90
+++ b/src/MNH/set_conc_lima.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2000-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-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.
@@ -91,9 +91,6 @@ USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_ACTI, NS
USE MODD_CST, ONLY : XPI, XRHOLW, XRHOLI
USE MODD_CONF, ONLY : NVERB
USE MODD_LUNIT_n, ONLY : TLUOUT
-
-!
-USE MODE_FM
!
IMPLICIT NONE
!
diff --git a/src/MNH/set_cstn.f90 b/src/MNH/set_cstn.f90
index 66ad7d4ccc6efb6134ba4a4f20342c5fae331dea..f51497f748ae1dc62f0503491c7926bfdb4699e1 100644
--- a/src/MNH/set_cstn.f90
+++ b/src/MNH/set_cstn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 SET_CSTN(TPFILE,TPEXPREFILE,HFUNU,HFUNV,KILOC,KJLOC,OBOUSS,OPV_PERT,ORMV_BL,PJ,OSHIFT,PCORIOZ)
!
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY : TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! outpput data file
TYPE(TFILEDATA), INTENT(IN) :: TPEXPREFILE ! input data file
@@ -133,8 +133,8 @@ END MODULE MODI_SET_CSTN
!! XRD : Gas constant for dry air
!! XCPD : Specific heat for dry air at constant pressure
!!
-!! Module MODD_LUNIT1 : contains logical unit names
-!! CLUOUT : name of output-listing
+!! Module MODD_LUNIT_n : contains logical unit names
+!! TLUOUT : name of output-listing
!!
!! Module MODD_CONF : contains configuration variables for all models.
!! NVERB : verbosity level for output-listing
@@ -172,11 +172,10 @@ END MODULE MODI_SET_CSTN
USE MODD_CONF
USE MODD_CST
USE MODD_GRID_n
-USE MODD_IO_ll, ONLY : TFILEDATA
-USE MODD_LUNIT_n, ONLY: CLUOUT, TLUOUT
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_PARAMETERS, ONLY: JPHEXT
!
-USE MODE_FM
USE MODE_THERMO
USE MODE_ll
USE MODE_MPPDB
diff --git a/src/MNH/set_frc.f90 b/src/MNH/set_frc.f90
index a78aed447248e2114d306eea3c22ba27cbcd9da4..8744c8d9d884afd7e4e7e38e61bd747b0b9d37a1 100644
--- a/src/MNH/set_frc.f90
+++ b/src/MNH/set_frc.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1995-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 SET_FRC(TPEXPREFILE)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPEXPREFILE ! input data file
!
@@ -56,7 +56,7 @@ END MODULE MODI_SET_FRC
!! XRV : Gas constant for vapor
!! XRD : Gas constant for dry air
!! Module MODD_LUNIT1 : contains logical unit names
-!! CLUOUT : name of output-listing
+!! TLUOUT : name of output-listing
!! Module MODD_GRID1: declaration of grid variables
!! XZHAT: height levels without orography
!! Module MODD_CONF : contains configuration variables for all models
@@ -107,14 +107,12 @@ USE MODD_GRID_n
USE MODD_CONF
USE MODD_FRC
USE MODD_GRID
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY : TFILEDATA
USE MODD_REF
USE MODD_PARAMETERS
!
USE MODE_DATETIME
USE MODE_THERMO
-USE MODE_FM
-USE MODE_IO_ll
USE MODE_MSG
!
USE MODI_HEIGHT_PRESS ! interface modules
diff --git a/src/MNH/set_geosbal.f90 b/src/MNH/set_geosbal.f90
index 4c0316cd6b16fb37fdfd7a2e86fcb2f55b02dac0..10287c546607fc73c1514b27bea0e810ece3f539 100644
--- a/src/MNH/set_geosbal.f90
+++ b/src/MNH/set_geosbal.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2010-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.
!-----------------------------------------------------------------
! ####################
@@ -195,9 +195,6 @@ END MODULE MODI_SET_GEOSBAL
!! XP00 : reference pressure
!! XOMEGA : earth rotation
!!
-!! Module MODD_LUNIT1 : contains logical unit names
-!! CLUOUT : name of output-listing
-!!
!! Module MODD_CONF : contains configuration variables for all models.
!!
!! L2D : logical for 2D model version
diff --git a/src/MNH/set_grid.f90 b/src/MNH/set_grid.f90
index 0880b974cd302c996e1bb4d1b9ca62e8ffbc9edc..6bd63a50719bd39eca5446d96ffe6f79ddbad481 100644
--- a/src/MNH/set_grid.f90
+++ b/src/MNH/set_grid.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ####################
@@ -24,7 +24,7 @@ INTERFACE
KBAK_NUMB,KOUT_NUMB,TPBACKUPN,TPOUTPUTN )
!
USE MODD_TYPE_DATE
-USE MODD_IO_ll, ONLY: TFILEDATA,TOUTBAK
+USE MODD_IO, ONLY: TFILEDATA,TOUTBAK
!
INTEGER, INTENT(IN) :: KMI ! Model index
TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE !Initial file
@@ -237,19 +237,18 @@ USE MODD_CONF
USE MODD_CONF_n
USE MODD_DYN
USE MODD_GRID
-USE MODD_IO_ll, ONLY: TFILEDATA,TOUTBAK
+USE MODD_IO, ONLY: TFILEDATA,TOUTBAK
USE MODD_LUNIT_n, ONLY: TLUOUT
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_FM
-USE MODE_FMREAD
+USE MODE_FIELD, ONLY: TFIELDDATA, TFIELDLIST, FIND_FIELD_ID_FROM_MNHNAME
USE MODE_GATHER_ll
USE MODE_GRIDCART
USE MODE_GRIDPROJ
-USE MODE_IO_MANAGE_STRUCT
+USE MODE_IO_FIELD_READ, only: IO_Field_read
+USE MODE_IO_MANAGE_STRUCT, only: IO_Bakout_struct_prepare
USE MODE_ll
USE MODE_TIME
!
@@ -343,43 +342,43 @@ TYPE(TFIELDDATA) :: TZFIELD
!
!* 1.1 Spatial grid
!
-CALL IO_READ_FIELD(TPINIFILE,'STORAGE_TYPE',CSTORAGE_TYPE,IRESP)
+CALL IO_Field_read(TPINIFILE,'STORAGE_TYPE',CSTORAGE_TYPE,IRESP)
IF (IRESP /= 0) CSTORAGE_TYPE='TT'
!
IF (KMI == 1) THEN
! this parameter is also useful in the cartesian to
! compute the sun position for the radiation scheme
- CALL IO_READ_FIELD(TPINIFILE,'LON0',XLON0)
+ CALL IO_Field_read(TPINIFILE,'LON0',XLON0)
!
! this parameter is also useful in the cartesian to
! compute the Coriolis parameter
- CALL IO_READ_FIELD(TPINIFILE,'LAT0',XLAT0)
+ CALL IO_Field_read(TPINIFILE,'LAT0',XLAT0)
!
! this parameter is also useful in the cartesian to
! rotate the simulatin domain
- CALL IO_READ_FIELD(TPINIFILE,'BETA',XBETA)
+ CALL IO_Field_read(TPINIFILE,'BETA',XBETA)
END IF
!
-CALL IO_READ_FIELD(TPINIFILE,'XHAT',PXHAT)
-CALL IO_READ_FIELD(TPINIFILE,'YHAT',PYHAT)
+CALL IO_Field_read(TPINIFILE,'XHAT',PXHAT)
+CALL IO_Field_read(TPINIFILE,'YHAT',PYHAT)
!
IF (.NOT.LCARTESIAN) THEN
- CALL IO_READ_FIELD(TPINIFILE,'RPK',XRPK)
+ CALL IO_Field_read(TPINIFILE,'RPK',XRPK)
!
IF ( (TPINIFILE%NMNHVERSION(1)==4 .AND. TPINIFILE%NMNHVERSION(2)>5) .OR. TPINIFILE%NMNHVERSION(1)>4 ) THEN
- CALL IO_READ_FIELD(TPINIFILE,'LONORI',PLONORI)
- CALL IO_READ_FIELD(TPINIFILE,'LATORI',PLATORI)
+ CALL IO_Field_read(TPINIFILE,'LONORI',PLONORI)
+ CALL IO_Field_read(TPINIFILE,'LATORI',PLATORI)
!
ELSE
CALL FIND_FIELD_ID_FROM_MNHNAME('LONORI',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CMNHNAME = 'LONOR'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PLONORI)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PLONORI)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('LATORI',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CMNHNAME = 'LATOR'
- CALL IO_READ_FIELD(TPINIFILE,TZFIELD,PLATORI)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PLATORI)
!
ALLOCATE(ZXHAT_ll(KIMAX_ll+ 2 * JPHEXT),ZYHAT_ll(KJMAX_ll+2 * JPHEXT))
CALL GATHERALL_FIELD_ll('XX',PXHAT,ZXHAT_ll,IRESP) !//
@@ -394,9 +393,9 @@ IF (.NOT.LCARTESIAN) THEN
!
END IF
-CALL IO_READ_FIELD(TPINIFILE,'ZS',PZS)
-CALL IO_READ_FIELD(TPINIFILE,'ZHAT',PZHAT)
-CALL IO_READ_FIELD(TPINIFILE,'ZTOP',PZTOP)
+CALL IO_Field_read(TPINIFILE,'ZS',PZS)
+CALL IO_Field_read(TPINIFILE,'ZHAT',PZHAT)
+CALL IO_Field_read(TPINIFILE,'ZTOP',PZTOP)
!
CALL DEFAULT_SLEVE(OSLEVE,PLEN1,PLEN2)
!
@@ -404,25 +403,25 @@ IF ( TPINIFILE%NMNHVERSION(1)<4 .OR. (TPINIFILE%NMNHVERSION(1)==4 .AND. TPINIFIL
PZSMT = PZS
OSLEVE = .FALSE.
ELSE
- CALL IO_READ_FIELD(TPINIFILE,'ZSMT',PZSMT)
- CALL IO_READ_FIELD(TPINIFILE,'SLEVE',OSLEVE)
+ CALL IO_Field_read(TPINIFILE,'ZSMT',PZSMT)
+ CALL IO_Field_read(TPINIFILE,'SLEVE',OSLEVE)
END IF
!
IF (OSLEVE) THEN
- CALL IO_READ_FIELD(TPINIFILE,'LEN1',PLEN1)
- CALL IO_READ_FIELD(TPINIFILE,'LEN2',PLEN2)
+ CALL IO_Field_read(TPINIFILE,'LEN1',PLEN1)
+ CALL IO_Field_read(TPINIFILE,'LEN2',PLEN2)
END IF
!
!* 1.2 Temporal grid
!
-CALL IO_READ_FIELD(TPINIFILE,'DTMOD',TPDTMOD)
-CALL IO_READ_FIELD(TPINIFILE,'DTCUR',TPDTCUR)
+CALL IO_Field_read(TPINIFILE,'DTMOD',TPDTMOD)
+CALL IO_Field_read(TPINIFILE,'DTCUR',TPDTCUR)
!
IF (KMI == 1) THEN
-CALL IO_READ_FIELD(TPINIFILE,'DTEXP',TDTEXP)
+CALL IO_Field_read(TPINIFILE,'DTEXP',TDTEXP)
END IF
!
-CALL IO_READ_FIELD(TPINIFILE,'DTSEG',TDTSEG)
+CALL IO_Field_read(TPINIFILE,'DTSEG',TDTSEG)
!
!-------------------------------------------------------------------------------
!
@@ -453,7 +452,7 @@ KSTOP = NINT(PSEGLEN/PTSTEP)
!* 2.3 Temporal grid - outputs managment
!
! The output/backups times have been read only by model 1
-IF (CPROGRAM == 'MESONH' .AND. KMI == 1) CALL IO_PREPARE_BAKOUT_STRUCT(ISUP,PTSTEP,PSEGLEN)
+IF (CPROGRAM == 'MESONH' .AND. KMI == 1) CALL IO_Bakout_struct_prepare(ISUP,PTSTEP,PSEGLEN)
!
KBAK_NUMB => OUT_MODEL(KMI)%NBAK_NUMB
KOUT_NUMB => OUT_MODEL(KMI)%NOUT_NUMB
diff --git a/src/MNH/set_mass.f90 b/src/MNH/set_mass.f90
index afcc068fe5e295f6dc88cf790334ec9f43b5ce40..e66add53264a14cdb3864464cddbbe3fb2d041a9 100644
--- a/src/MNH/set_mass.f90
+++ b/src/MNH/set_mass.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2010-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2010-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 MODI_SET_MASS
@@ -12,7 +12,7 @@ SUBROUTINE SET_MASS(TPFILE,OPROFILE_IN_PROC, PZFLUX_PROFILE,
KILOC,KJLOC,PZS_MX,PZMASS_MX,PZFLUX_MX,PPGROUND, &
PTHVM,PMRM,PUW,PVW,OSHIFT,OBOUSS,PJ,HFUNU,HFUNV,PMRCM,PMRIM,PCORIOZ)
!
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY : TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File characteristics
LOGICAL, INTENT(IN) :: OPROFILE_IN_PROC ! initialization profile in current processor
@@ -124,7 +124,7 @@ SUBROUTINE SET_MASS(TPFILE,OPROFILE_IN_PROC, PZFLUX_PROFILE,
! use des modules
USE MODD_GRID_n ! declarative modules
USE MODD_GRID
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY : TFILEDATA
USE MODD_CONF
USE MODD_CONF_n
USE MODD_FIELD_n
diff --git a/src/MNH/set_perturb.f90 b/src/MNH/set_perturb.f90
index 8bc9b5cd66b420741a89315018d4e5aa0972cf82..40906e759cfeef7c91e6800571c7435286ff96ce 100644
--- a/src/MNH/set_perturb.f90
+++ b/src/MNH/set_perturb.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 SET_PERTURB(TPEXPREFILE)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPEXPREFILE ! input data file
!
@@ -108,14 +108,13 @@ USE MODD_CONF
USE MODD_DIM_n
USE MODD_FIELD_n
USE MODD_GRID_n
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LBC_n
-USE MODD_LUNIT_n, ONLY: CLUOUT, TLUOUT
+USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_LSFIELD_n
USE MODD_PARAMETERS
USE MODD_REF_n
!
-USE MODE_FM
USE MODE_GATHER_ll
USE MODE_ll
USE MODE_MPPDB
@@ -273,7 +272,7 @@ SELECT CASE(CPERT_KIND)
END DO
!
CALL MPPDB_CHECK3D(ZDIST,"SET_PERTURB::ZDIST",PRECISION)
- CALL MPPDB_CHECK3D(XTHM,"SET_PERTURB::XTHM",PRECISION)
+ !CALL MPPDB_CHECK3D(XTHM,"SET_PERTURB::XTHM",PRECISION)
!
IF ( LSET_RHU) THEN
ZT(:,:,:) = 0.0
@@ -309,7 +308,7 @@ SELECT CASE(CPERT_KIND)
END WHERE
END IF
CALL MPPDB_CHECK3D(XRT(:,:,:,1),"SET_PERTURB::XRT",PRECISION)
- CALL MPPDB_CHECK3D(XTHM,"SET_PERTURB::XTHM",PRECISION)
+ !CALL MPPDB_CHECK3D(XTHM,"SET_PERTURB::XTHM",PRECISION)
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/set_ref.f90 b/src/MNH/set_ref.f90
index f666cb6f1dc6247c2c98471d67ef64b8e47e3651..74890f3e829b5e588a56db66d74bcfa60853c3ac 100644
--- a/src/MNH/set_ref.f90
+++ b/src/MNH/set_ref.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 @@ INTERFACE
PREFMASS,PMASS_O_PHI0,PLINMASS, &
PRHODREF,PTHVREF,PRVREF,PEXNREF,PRHODJ )
!
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY : TFILEDATA
!
INTEGER, INTENT(IN) :: KMI ! Model index
TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
@@ -155,12 +155,12 @@ END MODULE MODI_SET_REF
! ------------
USE MODD_CONF
USE MODD_CST
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_PARAMETERS
USE MODD_REF
!
-USE MODE_FMREAD
+USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_ll
USE MODE_MPPDB
USE MODE_REPRO_SUM
@@ -255,9 +255,9 @@ ILUOUT = TLUOUT%NLU
! ----------------------------------------------------
!
IF (KMI == 1) THEN
- CALL IO_READ_FIELD(TPINIFILE,'RHOREFZ',XRHODREFZ)
- CALL IO_READ_FIELD(TPINIFILE,'THVREFZ',XTHVREFZ)
- CALL IO_READ_FIELD(TPINIFILE,'EXNTOP', XEXNTOP)
+ CALL IO_Field_read(TPINIFILE,'RHOREFZ',XRHODREFZ)
+ CALL IO_Field_read(TPINIFILE,'THVREFZ',XTHVREFZ)
+ CALL IO_Field_read(TPINIFILE,'EXNTOP', XEXNTOP)
!
LNEUTRAL=.FALSE.
IF (MAXVAL(XTHVREFZ(IKB:IKE))-MINVAL(XTHVREFZ(IKB:IKE)) < 1.E-10) LNEUTRAL=.TRUE.
diff --git a/src/MNH/set_refz.f90 b/src/MNH/set_refz.f90
index d0b12152ef6ac33442b2fea5c2518550bcd74551..b8b10b3b75dc9c4f4f69bc0c632c59ebcd3aba6d 100644
--- a/src/MNH/set_refz.f90
+++ b/src/MNH/set_refz.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ####################
@@ -82,7 +82,7 @@ END MODULE MODI_SET_REFZ
!! 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
-!! CLUOUT0 : name of output-listing
+!! TLUOUT0 : name of output-listing
!! Module MODD_REF : contains anelastic reference state variables
!! XEXNTOP : reference state Exner function at model top
!! XRHODREFZ: reference state profile of rhod
diff --git a/src/MNH/set_relfrc.f90 b/src/MNH/set_relfrc.f90
index a87a28a7d314dcc0fc6286bf0f78d014577e0b3b..7c7fc25b1aeb15115d282bba56bd8f513ab701ab 100644
--- a/src/MNH/set_relfrc.f90
+++ b/src/MNH/set_relfrc.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
MODULE MODI_SET_RELFRC
@@ -10,7 +10,7 @@ INTERFACE
!
SUBROUTINE SET_RELFRC(TPEXPREFILE)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPEXPREFILE ! input data file
!
@@ -83,15 +83,13 @@ USE MODD_CST
USE MODD_FRC
USE MODD_GRID
USE MODD_GRID_n
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT_n
USE MODD_PARAMETERS, ONLY: JPHEXT
USE MODD_REF
USE MODD_RELFRC_n
!
USE MODE_DATETIME
-USE MODE_FM
-USE MODE_IO_ll
USE MODE_MSG
USE MODE_THERMO
!
diff --git a/src/MNH/set_rsou.f90 b/src/MNH/set_rsou.f90
index 8a16aa38e7eb7c344b2cea2a8e9388177d587705..6c38994c69acbdb6fa7395694f04c42626af5acf 100644
--- a/src/MNH/set_rsou.f90
+++ b/src/MNH/set_rsou.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 SET_RSOU(TPFILE,TPEXPREFILE,HFUNU,HFUNV,KILOC,KJLOC,OBOUSS,OPV_PERT,&
ORMV_BL,PJ,OSHIFT,PCORIOZ)
!
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY : TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! outpput data file
TYPE(TFILEDATA), INTENT(IN) :: TPEXPREFILE ! input data file
@@ -206,7 +206,7 @@ END MODULE MODI_SET_RSOU
!! XCPD : Specific heat for dry air at constant pressure
!!
!! Module MODD_LUNIT1 : contains logical unit names
-!! CLUOUT : name of output-listing
+!! TLUOUT : name of output-listing
!!
!! Module MODD_CONF : contains configuration variables for all models.
!! NVERB : verbosity level for output-listing
@@ -254,13 +254,11 @@ USE MODD_CST
USE MODD_FIELD_n
USE MODD_GRID
USE MODD_GRID_n
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT_n
USE MODD_PARAMETERS, ONLY: JPHEXT
USE MODD_PARAM_n, ONLY: CCLOUD
-!
-USE MODE_FM
-USE MODE_IO_ll
+!
USE MODE_ll
USE MODE_MSG
USE MODE_THERMO
diff --git a/src/MNH/set_subdomain.f90 b/src/MNH/set_subdomain.f90
index 5eb20fb6df83fa56317189f8455c0e49cdfb8f89..ba8bdd4f2c8618bd0072d8100bd07bda3bf5bbf2 100644
--- a/src/MNH/set_subdomain.f90
+++ b/src/MNH/set_subdomain.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 SET_SUBDOMAIN(TPNMLFILE,TPATMFILE,KXOR_DAD,KYOR_DAD, &
KXOR,KYOR,KDXRATIO,KDYRATIO )
!
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY : TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPNMLFILE ! namelist file
TYPE(TFILEDATA), INTENT(IN) :: TPATMFILE ! atmospheric MNH file
@@ -85,23 +85,20 @@ END MODULE MODI_SET_SUBDOMAIN
!* 0. DECLARATIONS
! ------------
!
-USE MODE_GRIDPROJ ! executive module
-USE MODE_POS
-USE MODE_FM
-USE MODE_IO_ll
-USE MODE_MSG
-!
-USE MODD_CONF ! declaration modules
-USE MODD_IO_ll, ONLY : TFILEDATA
-USE MODD_LUNIT
+USE MODD_CONF
+USE MODD_DIM_n, ONLY: NIMAX_n=>NIMAX,NJMAX_n=>NJMAX
USE MODD_GRID
USE MODD_GRID_n
-USE MODD_DIM_n, ONLY: NIMAX_n=>NIMAX,NJMAX_n=>NJMAX
-USE MODD_PGDGRID
-USE MODD_PGDDIM
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT
USE MODD_PARAMETERS
+USE MODD_PGDDIM
+USE MODD_PGDGRID
!
-USE MODE_FMREAD
+USE MODE_IO_FIELD_READ, only: IO_Field_read
+USE MODE_GRIDPROJ
+USE MODE_MSG
+USE MODE_POS
!
IMPLICIT NONE
!
@@ -222,24 +219,24 @@ WRITE(ILUOUT0,*) 'given or computed NYOR = ',NYOR
!* 4.1 TEST if FATHER of atmospheric MNH file exists:
! ---------------------------------------------
!
-CALL IO_READ_FIELD(TPATMFILE,'DAD_NAME',YDADFILE,IRESP)
+CALL IO_Field_read(TPATMFILE,'DAD_NAME',YDADFILE,IRESP)
IF ( IRESP /= 0 ) YDADFILE=' '
!
IF (LEN_TRIM(YDADFILE)/=0) THEN
- CALL IO_READ_FIELD(TPATMFILE,'DXRATIO',KDXRATIO,IRESP)
+ CALL IO_Field_read(TPATMFILE,'DXRATIO',KDXRATIO,IRESP)
IF ( IRESP /= 0 .OR. KDXRATIO == 0 ) THEN
KDXRATIO=1
END IF
!
- CALL IO_READ_FIELD(TPATMFILE,'DYRATIO',KDYRATIO,IRESP)
+ CALL IO_Field_read(TPATMFILE,'DYRATIO',KDYRATIO,IRESP)
IF ( IRESP /= 0 .OR. KDYRATIO == 0 ) THEN
KDYRATIO=1
END IF
!
- CALL IO_READ_FIELD(TPATMFILE,'XOR',KXOR,IRESP)
+ CALL IO_Field_read(TPATMFILE,'XOR',KXOR,IRESP)
IF ( IRESP /= 0 ) KXOR_DAD=1
!
- CALL IO_READ_FIELD(TPATMFILE,'YOR',KYOR,IRESP)
+ CALL IO_Field_read(TPATMFILE,'YOR',KYOR,IRESP)
IF ( IRESP /= 0 ) KYOR_DAD=1
END IF
!
diff --git a/src/MNH/shallow_mf.f90 b/src/MNH/shallow_mf.f90
index 2212bbb89a452fd2398791c02f645eaacaf9671f..52a1a7aef3d49a52fcbe9659a4f596cf52f6b822 100644
--- a/src/MNH/shallow_mf.f90
+++ b/src/MNH/shallow_mf.f90
@@ -1,7 +1,8 @@
!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
! ######spl
MODULE MODI_SHALLOW_MF
! ######################
@@ -167,6 +168,7 @@ END MODULE MODI_SHALLOW_MF
!! Philippe Wautelet 28/05/2018: corrected truncated integer division (2/3 -> 2./3.)
!! 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
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -393,9 +395,7 @@ ELSEIF (HMF_UPDRAFT == 'HRIO') THEN
PEMF,PDETR, &
PENTR,ZBUO_INTEG,KKLCL,KKETL,KKCTL,ZDEPTH )
ELSE
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' NO UPDRAFT MODEL FOR EDKF : CMF_UPDRAFT =',HMF_UPDRAFT
- CALL PRINT_MSG(NVERB_FATAL,'GEN','SHALLOW_MF','')
+ call Print_msg( NVERB_FATAL, 'GEN', 'SHALLOW_MF', 'no updraft model for EDKF: CMF_UPDRAFT='//trim(HMF_UPDRAFT) )
ENDIF
!!! 5. Compute diagnostic convective cloud fraction and content
@@ -450,10 +450,8 @@ ENDIF
PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF, &
ZFLXZSVMF )
ELSE
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' NO UPDRAFT MODEL FOR EDKF : CMF_UPDRAFT =',HMF_UPDRAFT
- CALL PRINT_MSG(NVERB_FATAL,'GEN','SHALLOW_MF','')
- ENDIF
+ 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
diff --git a/src/MNH/shallow_mf_pack.f90 b/src/MNH/shallow_mf_pack.f90
index ba519f8e3eefe4a15b9471ff07ebca2530fea29c..5e76f58c51e5632ec4c68795e8c7457b3d025a16 100644
--- a/src/MNH/shallow_mf_pack.f90
+++ b/src/MNH/shallow_mf_pack.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 2010-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2010-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 MODI_SHALLOW_MF_PACK
! ######################
@@ -21,10 +22,11 @@ INTERFACE
PSIGMF,PRC_MF,PRI_MF,PCF_MF,PFLXZTHVMF )
! #################################################################
!!
-USE MODD_IO_ll, ONLY: TFILEDATA
-!
+use MODD_IO, only: TFILEDATA
+use modd_precision, only: MNHTIME
+!
!* 1.1 Declaration of Arguments
-!
+!
!
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
@@ -39,7 +41,7 @@ LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for synchronous
LOGICAL, INTENT(IN) :: OMF_FLX ! switch to write the
! MF fluxes in the synchronous FM-file
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-REAL*8,DIMENSION(2), INTENT(OUT) :: PTIME_LES ! time spent in LES computations
+REAL(kind=MNHTIME),DIMENSION(2), INTENT(OUT) :: PTIME_LES ! time spent in LES computations
REAL, INTENT(IN) :: PIMPL_MF ! degre of implicitness
REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep
@@ -110,32 +112,35 @@ END MODULE MODI_SHALLOW_MF_PACK
!! AUTHOR
!! ------
!! V.Masson 09/2010
-!! Modification R. Honnert 07/2012 : introduction of vertical wind
-!! for the height of the thermal
-!! M. Leriche 02/2017 : avoid negative values for sv tendencies
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! S. Riette 11/2016: support for CFRAC_ICE_SHALLOW_MF
-!! --------------------------------------------------------------------------
+! --------------------------------------------------------------------------
+! Modifications:
+! R. Honnert 07/2012: introduction of vertical wind for the height of the thermal
+! M. Leriche 02/2017: avoid negative values for sv tendencies
+! 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
+! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS
-USE MODD_CST
+USE MODD_BUDGET
USE MODD_CONF
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_CST
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_NSV
-USE MODD_PARAM_ICE, ONLY : CFRAC_ICE_SHALLOW_MF
+USE MODD_PARAMETERS
+USE MODD_PARAM_ICE, ONLY: CFRAC_ICE_SHALLOW_MF
USE MODD_PARAM_MFSHALL_n
-USE MODD_BUDGET
+use modd_precision, only: MNHTIME
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPEREAL
-USE MODE_FMWRIT
+USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
-USE MODI_SHALLOW_MF
USE MODI_BUDGET
-USE MODI_SHUMAN
USE MODI_DIAGNOS_LES_MF
+USE MODI_SHALLOW_MF
+USE MODI_SHUMAN
!
IMPLICIT NONE
@@ -156,7 +161,7 @@ LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for synchronous
LOGICAL, INTENT(IN) :: OMF_FLX ! switch to write the
! MF fluxes in the synchronous FM-file
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-REAL*8,DIMENSION(2), INTENT(OUT) :: PTIME_LES ! time spent in LES computations
+REAL(kind=MNHTIME),DIMENSION(2), INTENT(OUT) :: PTIME_LES ! time spent in LES computations
REAL, INTENT(IN) :: PIMPL_MF ! degre of implicitness
REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep
@@ -390,7 +395,7 @@ IF ( OMF_FLX .AND. OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK)
!
! stores the conservative mixing ratio vertical flux
ZWORK(:,:,:)=RESHAPE(ZFLXZRMF(:,:),(/ IIU,IJU,IKU /) )
@@ -404,7 +409,7 @@ IF ( OMF_FLX .AND. OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK)
!
! stores the theta_v vertical flux
TZFIELD%CMNHNAME = 'MF_THVW_FLX'
@@ -417,7 +422,7 @@ IF ( OMF_FLX .AND. OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,PFLXZTHVMF)
+ CALL IO_Field_write(TPFILE,TZFIELD,PFLXZTHVMF)
!
IF (OMIXUV) THEN
! stores the U momentum vertical flux
@@ -432,7 +437,7 @@ IF ( OMF_FLX .AND. OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK)
!
! stores the V momentum vertical flux
ZWORK(:,:,:)=RESHAPE(ZFLXZVMF(:,:),(/ IIU,IJU,IKU /) )
@@ -446,7 +451,7 @@ IF ( OMF_FLX .AND. OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK)
!
END IF
END IF
diff --git a/src/MNH/spawn_field2.f90 b/src/MNH/spawn_field2.f90
index b083a03d68516e936982ae973153c0c63e69351b..b0f75841c3fc10bfe0c3c8ab5b0a094d5ec36649 100644
--- a/src/MNH/spawn_field2.f90
+++ b/src/MNH/spawn_field2.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1995-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!#######################
MODULE MODI_SPAWN_FIELD2
@@ -9,16 +9,16 @@ MODULE MODI_SPAWN_FIELD2
INTERFACE
!
SUBROUTINE SPAWN_FIELD2(KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,HTURB, &
- PUT,PVT,PWT,PTHVT,PRT,PHUT,PTKET,PSVT,PATC, &
+ PUT,PVT,PWT,PTHVT,PRT,PHUT,PTKET,PSVT,PZWS,PATC, &
PSRCT,PSIGS, &
- PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM, &
+ PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM,PLSZWSM, &
PDTHFRC,PDRVFRC,PTHREL,PRVREL, &
PVU_FLUX_M,PVTH_FLUX_M,PWTH_FLUX_M, &
TPSONFILE,KIUSON,KJUSON, &
KIB2,KJB2,KIE2,KJE2, &
KIB1,KJB1,KIE1,KJE1 )
!
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KXOR,KXEND ! horizontal position (i,j) of the ORigin and END
INTEGER, INTENT(IN) :: KYOR,KYEND ! of the model 2 domain, relative to model 1
@@ -30,11 +30,13 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PUT,PVT,PWT ! model 2
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTKET ! variables
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PRT,PSVT,PATC ! at t
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHVT,PHUT !
+REAL, DIMENSION(:,:), INTENT(OUT) :: PZWS
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCT,PSIGS ! secondary
! prognostic variables
! Larger Scale fields for relaxation and diffusion
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSUM, PLSVM, PLSWM
+REAL, DIMENSION(:,:), INTENT(OUT) :: PLSZWSM
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSTHM, PLSRVM
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PDTHFRC,PDRVFRC
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PTHREL,PRVREL
@@ -55,9 +57,9 @@ END INTERFACE
END MODULE MODI_SPAWN_FIELD2
! ##########################################################################
SUBROUTINE SPAWN_FIELD2(KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,HTURB, &
- PUT,PVT,PWT,PTHVT,PRT,PHUT,PTKET,PSVT,PATC, &
+ PUT,PVT,PWT,PTHVT,PRT,PHUT,PTKET,PSVT, PZWS,PATC, &
PSRCT,PSIGS, &
- PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM, &
+ PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM,PLSZWSM, &
PDTHFRC,PDRVFRC,PTHREL,PRVREL, &
PVU_FLUX_M,PVTH_FLUX_M,PWTH_FLUX_M, &
TPSONFILE,KIUSON,KJUSON, &
@@ -150,6 +152,8 @@ END MODULE MODI_SPAWN_FIELD2
!! Modification 01/2016 (JP Pinty) Add LIMA
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -162,34 +166,35 @@ USE MODD_CH_AEROSOL, ONLY: CAERONAMES
USE MODD_CH_M9_n, ONLY: CNAMES, CICNAMES
USE MODD_CONF
USE MODD_CST
-USE MODD_CONF_n, ONLY: CONF_MODEL
+USE MODD_CONF_n, ONLY: CONF_MODEL
USE MODD_DUST, ONLY: CDUSTNAMES
USE MODD_ELEC_DESCR, ONLY: CELECNAMES
-USE MODD_FIELD_n, ONLY: FIELD_MODEL
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_FIELD_n, ONLY: FIELD_MODEL, XZWS_DEFAULT
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LATZ_EDFLX
-USE MODD_LBC_n, ONLY: LBC_MODEL
+USE MODD_LBC_n, ONLY: LBC_MODEL
USE MODD_LG, ONLY: CLGNAMES
-USE MODD_LUNIT_n, ONLY: LUNIT_MODEL,TLUOUT
+USE MODD_LUNIT_n, ONLY: LUNIT_MODEL,TLUOUT
USE MODD_NSV
-USE MODD_REF_n, ONLY: REF_MODEL
+USE MODD_REF_n, ONLY: REF_MODEL
USE MODD_PARAMETERS
-USE MODD_PARAM_LIMA , ONLY : NMOD_CCN, NMOD_IFN, NMOD_IMM, NINDICE_CCN_IMM,&
- LSCAV, LAERO_MASS, LHHONI
-USE MODD_PARAM_LIMA_COLD, ONLY : CLIMA_COLD_NAMES
-USE MODD_PARAM_LIMA_WARM, ONLY : CLIMA_WARM_NAMES, CAERO_MASS
+USE MODD_PARAM_LIMA, ONLY: NMOD_CCN, NMOD_IFN, NMOD_IMM, NINDICE_CCN_IMM,&
+ LSCAV, LAERO_MASS, LHHONI
+USE MODD_PARAM_LIMA_COLD, ONLY: CLIMA_COLD_NAMES
+USE MODD_PARAM_LIMA_WARM, ONLY: CLIMA_WARM_NAMES, CAERO_MASS
USE MODD_RAIN_C2R2_DESCR, ONLY: C2R2NAMES
USE MODD_RELFRC_n
USE MODD_SALT, ONLY: CSALTNAMES
USE MODD_SPAWN
!
USE MODE_FIELD, ONLY: TFIELDDATA,TYPEREAL
-USE MODE_FMREAD
-USE MODE_IO_ll, ONLY: UPCASE
+USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_ll
+USE MODE_MSG
USE MODE_MODELN_HANDLER
USE MODE_MPPDB
USE MODE_THERMO
+USE MODE_TOOLS, ONLY: UPCASE
!
USE MODI_BIKHARDT
!
@@ -205,6 +210,7 @@ INTEGER, INTENT(IN) :: KDYRATIO ! between model 2 and model 1
CHARACTER (LEN=4), INTENT(IN) :: HTURB ! Kind of turbulence parameterization
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PUT,PVT,PWT ! model 2
+REAL, DIMENSION(:,:), INTENT(OUT) :: PZWS
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTKET ! variables
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PRT,PSVT,PATC ! at t
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHVT,PHUT !
@@ -213,6 +219,7 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCT,PSIGS ! secondary
! prognostic variables
! Larger Scale fields for relaxation and diffusion
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSUM, PLSVM, PLSWM
+REAL, DIMENSION(:,:), INTENT(OUT) :: PLSZWSM
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSTHM, PLSRVM
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PDTHFRC,PDRVFRC
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PTHREL,PRVREL
@@ -238,6 +245,7 @@ REAL, DIMENSION(SIZE(XRT1,1),SIZE(XRT1,2),SIZE(XRT1,3)) :: ZHUT ! relative humid
REAL, DIMENSION(SIZE(XTHT1,1),SIZE(XTHT1,2),SIZE(XTHT1,3)) :: ZTHVT! virtual pot. T
! (model 1)
!$20140708
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZZWS_C, ZLSZWSM_C
!$***** 3D
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZUT_C, ZLSUM_C
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZVT_C, ZLSVM_C
@@ -261,11 +269,13 @@ INTEGER :: IINFO_ll
!$
! Arrays for reading fields of input SON 1 file
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK3D
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK2D
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHT1,ZTHVT1
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZPABST1,ZHUT1
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZRT1
LOGICAL :: GUSERV
!
+CHARACTER(LEN=15) :: YVAL
CHARACTER(LEN=2) :: INDICE
INTEGER :: I
TYPE(TFIELDDATA) :: TZFIELD
@@ -291,6 +301,7 @@ CALL COMPUTE_THV_HU(CONF_MODEL(1)%LUSERV,XRT1,XTHT1,XPABST1,ZTHVT,ZHUT)
!
IF (PRESENT(TPSONFILE)) THEN
ALLOCATE(ZWORK3D(KIUSON,KJUSON,SIZE(PUT,3)))
+ ALLOCATE(ZWORK2D(KIUSON,KJUSON))
ALLOCATE(ZPABST1(KIE1-KIB1+1,KJE1-KJB1+1,SIZE(PUT,3)))
ALLOCATE(ZTHT1(KIE1-KIB1+1,KJE1-KJB1+1,SIZE(PUT,3)))
ALLOCATE(ZTHVT1(KIE1-KIB1+1,KJE1-KJB1+1,SIZE(PUT,3)))
@@ -402,6 +413,8 @@ END IF
CALL GET_CHILD_DIM_ll(2, IDIMX_C, IDIMY_C, IINFO_ll)
!
!$20140708 use ZTHVM_C in BIKAT top cal PTHVM_C
+ ALLOCATE(ZZWS_C(IDIMX_C,IDIMY_C))
+ ALLOCATE(ZLSZWSM_C(IDIMX_C,IDIMY_C))
!$**** 3D
ALLOCATE(ZUT_C(IDIMX_C,IDIMY_C,SIZE(PUT,3)))
ALLOCATE(ZLSUM_C(IDIMX_C,IDIMY_C,SIZE(PUT,3)))
@@ -434,6 +447,8 @@ END IF
ZVT_C =0.
ZWT_C =0.
ZTHVT_C =0.
+ ZZWS_C =0.
+ ZLSZWSM_C=0.
ZHUT_C =0.
ZTKET_C =0.
ZSRCT_C =0.
@@ -449,6 +464,14 @@ END IF
ZRVREL_C=0.
ZTHREL_C=00
!
+ CALL SET_LSFIELD_1WAY_ll(XZWS1(:,:),ZZWS_C(:,:),2)
+ CALL SET_LSFIELD_1WAY_ll(XLSZWSM1(:,:),ZLSZWSM_C(:,:),2)
+ !
+ CALL LS_FORCING_ll(2, IINFO_ll, .TRUE.)
+ CALL GO_TOMODEL_ll(2, IINFO_ll)
+ CALL GOTO_MODEL(2)
+ CALL UNSET_LSFIELD_1WAY_ll()
+ !
!$***** 3D VARS
DO JI=1,SIZE(PUT,3)
CALL GOTO_MODEL(1)
@@ -566,6 +589,21 @@ END IF
2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,3, &
LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZLSVM_C,PLSVM)
CALL MPPDB_CHECK3D(PLSVM,"SPAWN_FIELD2:PLSVM",PRECISION)
+
+! Interpolation of the ZWS variable at t
+!
+ CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
+ XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
+ 2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,3, &
+ LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZZWS_C,PZWS)
+ CALL MPPDB_CHECK2D(PZWS,"SPAWN_FIELD2:PZWS",PRECISION)
+!
+ CALL BIKHARDT (XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
+ XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
+ 2,2,IDIMX_C-1,IDIMY_C-1,KDXRATIO,KDYRATIO,3, &
+ LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,ZLSZWSM_C,PLSZWSM)
+ CALL MPPDB_CHECK2D(PLSZWSM,"SPAWN_FIELD2:PLSZWSM",PRECISION)
+!
!
! Interpolation of variables at t
!
@@ -719,49 +757,58 @@ IF (PRESENT(TPSONFILE)) THEN
!
!variables which always exist
!
- CALL IO_READ_FIELD(TPSONFILE,'UT',ZWORK3D) ! U wind component at time t
+ CALL IO_Field_read(TPSONFILE,'UT',ZWORK3D) ! U wind component at time t
PUT(KIB2:KIE2,KJB2:KJE2,:) = ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
- CALL IO_READ_FIELD(TPSONFILE,'VT',ZWORK3D) ! V wind component at time t
+ CALL IO_Field_read(TPSONFILE,'VT',ZWORK3D) ! V wind component at time t
PVT(KIB2:KIE2,KJB2:KJE2,:) = ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
- CALL IO_READ_FIELD(TPSONFILE,'WT',ZWORK3D) ! W wind component at time t
+ CALL IO_Field_read(TPSONFILE,'WT',ZWORK3D) ! W wind component at time t
PWT(KIB2:KIE2,KJB2:KJE2,:) = ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
+ CALL IO_Field_read(TPSONFILE,'ZWS',ZWORK2D,IRESP) !
+ !If the field ZWS is not in the file, set its value to XZWS_DEFAULT
+ !ZWS is present in files since MesoNH 5.4.2
+ IF ( IRESP/=0 ) THEN
+ WRITE (YVAL,'( E15.8 )') XZWS_DEFAULT
+ CALL PRINT_MSG(NVERB_WARNING,'IO','SPAWN_FIELD2','ZWS not found in file: using default value: '//TRIM(YVAL)//' m')
+ ZWORK2D(:,:) = XZWS_DEFAULT
+ END IF
+ PZWS(KIB2:KIE2,KJB2:KJE2) = ZWORK2D(KIB1:KIE1,KJB1:KJE1)
!
! moist variables
!
IRR=1
IF (IRR<=CONF_MODEL(1)%NRR) THEN
GUSERV=.TRUE.
- CALL IO_READ_FIELD(TPSONFILE,'RVT',ZWORK3D,IRESP) ! Vapor at time t
+ CALL IO_Field_read(TPSONFILE,'RVT',ZWORK3D,IRESP) ! Vapor at time t
IF(IRESP==0) ZRT1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
IF(IRESP==0) IRR=IRR+1
END IF
IF (IRR<=CONF_MODEL(1)%NRR) THEN
- CALL IO_READ_FIELD(TPSONFILE,'RCT',ZWORK3D,IRESP) ! Cloud at time t
+ CALL IO_Field_read(TPSONFILE,'RCT',ZWORK3D,IRESP) ! Cloud at time t
IF(IRESP==0) ZRT1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
IF(IRESP==0) IRR=IRR+1
END IF
IF (IRR<=CONF_MODEL(1)%NRR) THEN
- CALL IO_READ_FIELD(TPSONFILE,'RRT',ZWORK3D,IRESP) ! Rain at time t
+ CALL IO_Field_read(TPSONFILE,'RRT',ZWORK3D,IRESP) ! Rain at time t
IF(IRESP==0) ZRT1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
IF(IRESP==0) IRR=IRR+1
END IF
IF (IRR<=CONF_MODEL(1)%NRR) THEN
- CALL IO_READ_FIELD(TPSONFILE,'RIT',ZWORK3D,IRESP) ! Ice at time t
+ CALL IO_Field_read(TPSONFILE,'RIT',ZWORK3D,IRESP) ! Ice at time t
IF(IRESP==0) ZRT1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
IF(IRESP==0) IRR=IRR+1
END IF
IF (IRR<=CONF_MODEL(1)%NRR) THEN
- CALL IO_READ_FIELD(TPSONFILE,'RST',ZWORK3D,IRESP) ! Snow at time t
+ CALL IO_Field_read(TPSONFILE,'RST',ZWORK3D,IRESP) ! Snow at time t
IF(IRESP==0) ZRT1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
IF(IRESP==0) IRR=IRR+1
END IF
IF (IRR<=CONF_MODEL(1)%NRR) THEN
- CALL IO_READ_FIELD(TPSONFILE,'RGT',ZWORK3D,IRESP) ! Graupel at time t
+ CALL IO_Field_read(TPSONFILE,'RGT',ZWORK3D,IRESP) ! Graupel at time t
IF(IRESP==0) ZRT1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
IF(IRESP==0) IRR=IRR+1
END IF
IF (IRR<=CONF_MODEL(1)%NRR) THEN
- CALL IO_READ_FIELD(TPSONFILE,'HVT',ZWORK3D,IRESP) ! Hail at time t
+ CALL IO_Field_read(TPSONFILE,'HVT',ZWORK3D,IRESP) ! Hail at time t
IF(IRESP==0) ZRT1(:,:,:,IRR)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
IF(IRESP==0) IRR=IRR+1
END IF
@@ -769,9 +816,9 @@ IF (PRESENT(TPSONFILE)) THEN
WRITE(ILUOUT,FMT=*) 'SPAWN_FIELD2: spawing with a SON input file'
WRITE(ILUOUT,FMT=*) ' ',CONF_MODEL(1)%NRR,' moist variables in model1 and model2, ', &
IRR,' moist variables in input SON'
- CALL IO_READ_FIELD(TPSONFILE,'THT',ZWORK3D) ! Theta at time t
+ CALL IO_Field_read(TPSONFILE,'THT',ZWORK3D) ! Theta at time t
ZTHT1(:,:,:)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
- CALL IO_READ_FIELD(TPSONFILE,'PABST',ZWORK3D) ! Pressure at time t
+ CALL IO_Field_read(TPSONFILE,'PABST',ZWORK3D) ! Pressure at time t
ZPABST1(:,:,:)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
!
CALL COMPUTE_THV_HU(GUSERV,ZRT1,ZTHT1,ZPABST1,ZTHVT1,ZHUT1)
@@ -785,7 +832,7 @@ IF (PRESENT(TPSONFILE)) THEN
! TKE variables
!
IF (HTURB/='NONE') THEN
- CALL IO_READ_FIELD(TPSONFILE,'TKET',ZWORK3D,IRESP) ! Turbulence Kinetic Energy at time t
+ CALL IO_Field_read(TPSONFILE,'TKET',ZWORK3D,IRESP) ! Turbulence Kinetic Energy at time t
IF(IRESP==0) PTKET(KIB2:KIE2,KJB2:KJE2,:)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END IF
!
@@ -806,7 +853,7 @@ IF (PRESENT(TPSONFILE)) THEN
WRITE(TZFIELD%CMNHNAME,'(A3,I3.3)')'SVT',JSV
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME)
- CALL IO_READ_FIELD(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
+ CALL IO_Field_read(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
END IF
@@ -825,7 +872,7 @@ IF (PRESENT(TPSONFILE)) THEN
TZFIELD%CMNHNAME = TRIM(C2R2NAMES(JSV-NSV_C2R2BEG+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_READ_FIELD(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
+ CALL IO_Field_read(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
END IF
@@ -891,7 +938,7 @@ IF (PRESENT(TPSONFILE)) THEN
END IF
! time t
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- CALL IO_READ_FIELD(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
+ CALL IO_Field_read(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
!
@@ -915,7 +962,7 @@ IF (PRESENT(TPSONFILE)) THEN
TZFIELD%CUNITS = 'm-3'
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3,A)')'X_Y_Z_','SVT',JSV,' (nb ions/m3)'
END IF
- CALL IO_READ_FIELD(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
+ CALL IO_Field_read(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
END IF
@@ -935,7 +982,7 @@ IF (PRESENT(TPSONFILE)) THEN
TZFIELD%CMNHNAME = TRIM(CNAMES(JSV-NSV_CHEMBEG+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_READ_FIELD(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
+ CALL IO_Field_read(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
END IF
@@ -956,7 +1003,7 @@ IF (PRESENT(TPSONFILE)) THEN
TZFIELD%CMNHNAME = TRIM(CICNAMES(JSV-NSV_CHICBEG+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_READ_FIELD(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
+ CALL IO_Field_read(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
END IF
@@ -976,7 +1023,7 @@ IF (PRESENT(TPSONFILE)) THEN
TZFIELD%CMNHNAME = TRIM(UPCASE(CAERONAMES(JSV-NSV_AERBEG+1)))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_READ_FIELD(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
+ CALL IO_Field_read(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
END IF
@@ -996,7 +1043,7 @@ IF (PRESENT(TPSONFILE)) THEN
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_READ_FIELD(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
+ CALL IO_Field_read(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
END IF
@@ -1016,7 +1063,7 @@ IF (PRESENT(TPSONFILE)) THEN
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_READ_FIELD(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
+ CALL IO_Field_read(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
END IF
@@ -1036,7 +1083,7 @@ IF (PRESENT(TPSONFILE)) THEN
TZFIELD%CMNHNAME = TRIM(CLGNAMES(JSV-NSV_LGBEG+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_READ_FIELD(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
+ CALL IO_Field_read(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
END IF
@@ -1058,7 +1105,7 @@ IF (PRESENT(TPSONFILE)) THEN
TZFIELD%CMNHNAME = 'LINOX'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_READ_FIELD(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
+ CALL IO_Field_read(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
END IF
@@ -1078,7 +1125,7 @@ IF (PRESENT(TPSONFILE)) THEN
WRITE(TZFIELD%CMNHNAME,'(A3,I3.3)')'SVT',JSV
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME)
- CALL IO_READ_FIELD(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
+ CALL IO_Field_read(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
END IF
@@ -1099,7 +1146,7 @@ IF (PRESENT(TPSONFILE)) THEN
WRITE(TZFIELD%CMNHNAME,'(A3,I3.3)')'SVT',JSV
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME)
- CALL IO_READ_FIELD(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
+ CALL IO_Field_read(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
END IF
@@ -1120,7 +1167,7 @@ IF (PRESENT(TPSONFILE)) THEN
WRITE(TZFIELD%CMNHNAME,'(A3,I3.3)')'SVT',JSV
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME)
- CALL IO_READ_FIELD(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
+ CALL IO_Field_read(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
IF(IRESP==0) PSVT(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
END IF
@@ -1140,7 +1187,7 @@ IF (PRESENT(TPSONFILE)) THEN
WRITE(TZFIELD%CMNHNAME,'(A3,I3.3)')'ATC',JSV+NSV_PPBEG-1
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','ATC',JSV+NSV_PPBEG-1
- CALL IO_READ_FIELD(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
+ CALL IO_Field_read(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
IF(IRESP==0) PATC(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
END IF
@@ -1161,7 +1208,7 @@ IF (PRESENT(TPSONFILE)) THEN
WRITE(TZFIELD%CMNHNAME,'(A3,I3.3)')'ATC',JSV+NSV_FFBEG-1
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','ATC',JSV+NSV_FFBEG-1
- CALL IO_READ_FIELD(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
+ CALL IO_Field_read(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
IF(IRESP==0) PATC(KIB2:KIE2,KJB2:KJE2,:,JSV)=ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END DO
END IF
@@ -1171,10 +1218,10 @@ IF (PRESENT(TPSONFILE)) THEN
! Secondary pronostic variables
!
IF (HTURB /= 'NONE' .AND. IRR>1) THEN
- CALL IO_READ_FIELD(TPSONFILE,'SRCT',ZWORK3D,IRESP) ! turbulent flux SRC at time t
+ CALL IO_Field_read(TPSONFILE,'SRCT',ZWORK3D,IRESP) ! turbulent flux SRC at time t
IF(IRESP == 0) PSRCT(KIB2:KIE2,KJB2:KJE2,:) = &
ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
- CALL IO_READ_FIELD(TPSONFILE,'SIGS',ZWORK3D,IRESP) ! subgrid condensation
+ CALL IO_Field_read(TPSONFILE,'SIGS',ZWORK3D,IRESP) ! subgrid condensation
IF(IRESP == 0) PSIGS(KIB2:KIE2,KJB2:KJE2,:) = &
ZWORK3D(KIB1:KIE1,KJB1:KJE1,:)
END IF
diff --git a/src/MNH/spawn_grid2.f90 b/src/MNH/spawn_grid2.f90
index c1e938c6a440a49c179b11a99c53965b4b9ce801..1a6e192263046c9860869d72f42ab84a1b25791c 100644
--- a/src/MNH/spawn_grid2.f90
+++ b/src/MNH/spawn_grid2.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1995-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
!######################
@@ -164,8 +164,6 @@ USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_BIKHARDT_n
USE MODD_VAR_ll
USE MODE_ll
-USE MODE_FM
-USE MODE_IO_ll
USE MODE_TIME
USE MODE_GRIDPROJ
!
diff --git a/src/MNH/spawn_lsn.f90 b/src/MNH/spawn_lsn.f90
index 74f43ed3e08b907f5d8a4b778f63f4b72249cd79..88d40d981a5826dc3400f7c3752262678fff458c 100644
--- a/src/MNH/spawn_lsn.f90
+++ b/src/MNH/spawn_lsn.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 nesting 2006/06/19 11:16:39
-!-----------------------------------------------------------------
! ####################
MODULE MODI_SPAWN_LS_n
! ####################
@@ -21,9 +16,9 @@ INTERFACE
HLBCX,HLBCY,PZZ,PZHAT,OSLEVE,PLEN1,PLEN2, &
PCOEFLIN_LBXM, &
PLSTHM,PLSRVM, &
- PLSUM,PLSVM,PLSWM, &
+ PLSUM,PLSVM,PLSWM,PLSZWSM, &
PLSTHS,PLSRVS, &
- PLSUS,PLSVS,PLSWS )
+ PLSUS,PLSVS,PLSWS,PLSZWSS )
!
INTEGER, INTENT(IN) :: KDAD ! number of the DAD model
REAL, INTENT(IN) :: PTSTEP ! Time step
@@ -48,8 +43,11 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PCOEFLIN_LBXM ! coefficient used for
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSTHM,PLSRVM ! Large Scale fields at t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSUM,PLSVM,PLSWM ! Large Scale fields at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PLSZWSM ! Large Scale fields at t-dt
+
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSTHS,PLSRVS ! Large Scale source terms
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSUS,PLSVS,PLSWS ! Large Scale source terms
+REAL, DIMENSION(:,:), INTENT(OUT) :: PLSZWSS
!
END SUBROUTINE SPAWN_LS_n
!
@@ -66,9 +64,9 @@ END MODULE MODI_SPAWN_LS_n
HLBCX,HLBCY,PZZ,PZHAT,OSLEVE,PLEN1,PLEN2, &
PCOEFLIN_LBXM, &
PLSTHM,PLSRVM, &
- PLSUM,PLSVM,PLSWM, &
+ PLSUM,PLSVM,PLSWM,PLSZWSM, &
PLSTHS,PLSRVS, &
- PLSUS,PLSVS,PLSWS )
+ PLSUS,PLSVS,PLSWS,PLSZWSS )
! ################################################################
!
!!**** *SPAWN_LS_n* - Refresh of the Large Scale sources
@@ -125,7 +123,8 @@ END MODULE MODI_SPAWN_LS_n
!! Original 22/12/97
!! P. Jabouille 19/04/00 parallelisation
!! J.Escobar : 18/12/2015 : Correction of bug in bound in // for NHALO <>1
-!!
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+! P. Wautelet 20/03/2019: fixes: wrong order of the dummy arguments + double deallocate
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -174,8 +173,10 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PCOEFLIN_LBXM ! coefficient used for
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSTHM,PLSRVM ! Large Scale fields at t-dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSUM,PLSVM,PLSWM ! Large Scale fields at t-dt
+REAL, DIMENSION(:,:), INTENT(IN) :: PLSZWSM ! Large Scale fields at t-dt
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSTHS,PLSRVS ! Large Scale source terms
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSUS,PLSVS,PLSWS ! Large Scale source terms
+REAL, DIMENSION(:,:), INTENT(OUT) :: PLSZWSS
!
!
!* 0.2 declarations of local variables
@@ -202,8 +203,10 @@ TYPE(LIST_ll), POINTER :: TZLSFIELD_ll ! list of metric coefficient fields
INTEGER :: IINFO_ll, IDIMX, IDIMY
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTLSUM, ZTLSVM, ZTLSWM, ZTLSTHM, ZTLSRVM
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTZS,ZZS
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZTZWS
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTZSMT,ZZSMT
REAL, DIMENSION(:,:,:), ALLOCATABLE :: Z1,Z2,Z3,Z4,Z5
+REAL, DIMENSION(:,:), ALLOCATABLE :: Z6
!
!-------------------------------------------------------------------------------
!
@@ -235,6 +238,7 @@ ALLOCATE(ZTLSVM(IDIMX,IDIMY,SIZE(PLSVM,3)))
ALLOCATE(ZTLSWM(IDIMX,IDIMY,SIZE(PLSWM,3)))
ALLOCATE(ZTLSTHM(IDIMX,IDIMY,SIZE(PLSTHM,3)))
ALLOCATE(ZTLSRVM(IDIMX,IDIMY,SIZE(PLSRVM,3)))
+ALLOCATE(ZTZWS(IDIMX,IDIMY))
!
IF(GVERT_INTERP) THEN
ALLOCATE(ZTZS (IDIMX,IDIMY,1))
@@ -250,6 +254,7 @@ ALLOCATE(Z2(SIZE(XLSUM,1),SIZE(XLSUM,2),SIZE(XLSUM,3)))
ALLOCATE(Z3(SIZE(XLSUM,1),SIZE(XLSUM,2),SIZE(XLSUM,3)))
ALLOCATE(Z4(SIZE(XLSUM,1),SIZE(XLSUM,2),SIZE(XLSUM,3)))
ALLOCATE(Z5(SIZE(XLSUM,1),SIZE(XLSUM,2),SIZE(XLSUM,3)))
+ALLOCATE(Z6(SIZE(XLSUM,1),SIZE(XLSUM,2)))
!
Z1=XLSUM+XLSUS*ZTIME
CALL SET_LSFIELD_1WAY_ll(Z1, ZTLSUM, KMI)
@@ -263,6 +268,10 @@ IF ( SIZE(PLSRVM,1) /= 0 ) THEN
Z5=XLSRVM+XLSRVS*ZTIME
CALL SET_LSFIELD_1WAY_ll(Z5, ZTLSRVM, KMI)
ENDIF
+IF ( SIZE(PLSZWSM,1) /= 0 ) THEN
+ Z6=XLSZWSM+XLSZWSS*ZTIME
+ CALL SET_LSFIELD_1WAY_ll(Z6, ZTZWS, KMI)
+ENDIF
!
IF ( GVERT_INTERP ) THEN
CALL SET_LSFIELD_1WAY_ll(ZZS, ZTZS, KMI)
@@ -273,7 +282,7 @@ ENDIF
!
CALL LS_FORCING_ll(KMI, IINFO_ll)
!
-DEALLOCATE(Z1,Z2,Z3,Z4,Z5)
+DEALLOCATE(Z1,Z2,Z3,Z4,Z5,Z6)
!
! 1.5 Back to the (current) child model
!
@@ -355,6 +364,12 @@ IF ( SIZE(PLSRVM,1) /= 0 ) THEN
2,2,IDIMX-1,IDIMY-1,KDXRATIO,KDYRATIO,1, &
HLBCX,HLBCY,ZTLSRVM,PLSRVS(IIB:IIE,IJB:IJE,:))
END IF
+IF ( SIZE(PLSZWSM,1) /= 0 ) THEN
+ 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,ZTZWS,PLSZWSS(IIB:IIE,IJB:IJE))
+END IF
!
!* 3.2 Vertical linear interpolation on the mass grid
!
@@ -384,6 +399,9 @@ PLSTHS(:,:,:) = (PLSTHS(:,:,:) - PLSTHM(:,:,:)) / ZTIME
IF ( SIZE(PLSRVM,1) /= 0 ) THEN
PLSRVS(:,:,:) = (PLSRVS(:,:,:) - PLSRVM(:,:,:)) / ZTIME
END IF
+IF ( SIZE(PLSZWSM,1) /= 0 ) THEN
+ PLSZWSS(:,:) = (PLSZWSS(:,:) - PLSZWSM(:,:)) / ZTIME
+END IF
!
!------------------------------------------------------------------------------
!
@@ -452,7 +470,7 @@ END IF
!
PLSVS(:,:,:) = (PLSVS(:,:,:) - PLSVM(:,:,:)) / ZTIME
!
-DEALLOCATE(ZTLSUM,ZTLSVM,ZTLSWM,ZTLSTHM,ZTLSRVM)
+DEALLOCATE(ZTLSUM,ZTLSVM,ZTLSWM,ZTLSTHM,ZTLSRVM,ZTZWS)
IF(GVERT_INTERP) DEALLOCATE(ZTZS,ZZS)
IF(GVERT_INTERP) DEALLOCATE(ZTZSMT,ZZSMT)
!
@@ -462,6 +480,7 @@ CALL ADD3DFIELD_ll(TZLSFIELD_ll, PLSVS)
CALL ADD3DFIELD_ll(TZLSFIELD_ll, PLSWS)
CALL ADD3DFIELD_ll(TZLSFIELD_ll, PLSTHS)
IF(SIZE(PLSRVM) /= 0) CALL ADD3DFIELD_ll(TZLSFIELD_ll, PLSRVS)
+IF(SIZE(PLSZWSM) /= 0) CALL ADD2DFIELD_ll(TZLSFIELD_ll, PLSZWSS)
CALL UPDATE_HALO_ll(TZLSFIELD_ll,IINFO_ll)
CALL CLEANLIST_ll(TZLSFIELD_ll)
!------------------------------------------------------------------------------
diff --git a/src/MNH/spawn_model2.f90 b/src/MNH/spawn_model2.f90
index d920dbc0cf86068f1382448fc4e0a07c59680955..33c2a15786a8a92e74f21b6969f1b52bf10baa54 100644
--- a/src/MNH/spawn_model2.f90
+++ b/src/MNH/spawn_model2.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1995-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
!########################
MODULE MODI_SPAWN_MODEL2
!########################
@@ -90,10 +91,10 @@ END MODULE MODI_SPAWN_MODEL2
!! TOTAL_DMASS : to compute the total mass of dry air
!! ANEL_BALANCE2 : to apply an anelastic correction in the case of changing
!! resolution between the two models
-!! IO_FILE_OPEN_ll : to open a FM-file (DESFM + LFIFM)
+!! IO_File_open : to open a FM-file (DESFM + LFIFM)
!! WRITE_DESFM : to write the DESFM file
!! WRITE_LFIFM : to write the LFIFM file
-!! IO_FILE_CLOSE_ll : to close a FM-file (DESFM + LFIFM)
+!! IO_File_close : to close a FM-file (DESFM + LFIFM)
!! INI_BIKHARDT2 : initializes Bikhardt coefficients
!!
!!
@@ -191,6 +192,11 @@ END MODULE MODI_SPAWN_MODEL2
!! Modification 01/2016 (JP Pinty) Add LIMA
!! 10/2016 (C.Lac) Add droplet deposition
!! 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
+! S. Bielli 02/2019: sea salt: significant sea wave height influences salt emission; 5 salt modes
+! P. Wautelet 22/02/2019: replace Hollerith edit descriptor (deleted from Fortran 95 standard)
+! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -228,7 +234,8 @@ USE MODD_CH_MNHC_n
USE MODD_PASPOL_n
!$20140515
USE MODD_VAR_ll, ONLY : NPROC
-USE MODD_IO_ll, ONLY: TFILEDATA,TFILE_DUMMY,TFILE_SURFEX
+USE MODD_IO, ONLY: TFILEDATA,TFILE_DUMMY,TFILE_SURFEX
+use modd_precision, only: MNHREAL_MPI
!
USE MODE_GRIDCART ! Executive modules
USE MODE_GRIDPROJ
@@ -256,12 +263,11 @@ USE MODI_CH_INIT_SCHEME_n
!$20140710
USE MODI_UPDATE_METRICS
!
-USE MODE_FM
-USE MODE_FMWRIT, ONLY : IO_WRITE_HEADER
-USE MODE_IO_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY : IO_FILE_ADD2LIST
+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
USE MODE_MODELN_HANDLER
-USE MODE_FMREAD
USE MODE_MPPDB
!
USE MODE_THERMO
@@ -286,6 +292,7 @@ USE MODD_PASPOL, ONLY : LPASPOL
!
USE MODD_MPIF
USE MODD_VAR_ll
+use modd_precision, only: LFIINT
!
IMPLICIT NONE
!
@@ -313,7 +320,7 @@ LOGICAL, INTENT(IN) :: OSPAWN_SURF ! flag to spawn surface fields
!
!
INTEGER :: ILUOUT ! Logical unit number for the output listing
-INTEGER(KIND=LFI_INT) :: INPRAR ! Number of articles predicted in the LFIFM file
+INTEGER(KIND=LFIINT) :: INPRAR ! Number of articles predicted in the LFIFM file
!
!
INTEGER :: IIU ! Upper dimension in x direction
@@ -489,15 +496,15 @@ IF (LEN_TRIM(HSONFILE) /= 0 ) THEN
! 3.3.1 Opening the son input file and reading the grid
!
WRITE(ILUOUT,*) 'SPAWN_MODEL2: spawning with a SON input file :',TRIM(HSONFILE)
- CALL IO_FILE_ADD2LIST(TZSONFILE,TRIM(HSONFILE),'UNKNOWN','READ',KLFITYPE=2,KLFIVERB=NVERB)
- CALL IO_FILE_OPEN_ll(TZSONFILE)
- CALL IO_READ_FIELD(TZSONFILE,'DAD_NAME',YDAD_SON)
- CALL IO_READ_FIELD(TZSONFILE,'IMAX', IIMAXSON)
- CALL IO_READ_FIELD(TZSONFILE,'JMAX', IJMAXSON)
- CALL IO_READ_FIELD(TZSONFILE,'XOR', IXORSON)
- CALL IO_READ_FIELD(TZSONFILE,'YOR', IYORSON)
- CALL IO_READ_FIELD(TZSONFILE,'DXRATIO', IDXRATIOSON)
- CALL IO_READ_FIELD(TZSONFILE,'DYRATIO', IDYRATIOSON)
+ CALL IO_File_add2list(TZSONFILE,TRIM(HSONFILE),'MNH','READ',KLFITYPE=2,KLFIVERB=NVERB)
+ CALL IO_File_open(TZSONFILE)
+ CALL IO_Field_read(TZSONFILE,'DAD_NAME',YDAD_SON)
+ CALL IO_Field_read(TZSONFILE,'IMAX', IIMAXSON)
+ CALL IO_Field_read(TZSONFILE,'JMAX', IJMAXSON)
+ CALL IO_Field_read(TZSONFILE,'XOR', IXORSON)
+ CALL IO_Field_read(TZSONFILE,'YOR', IYORSON)
+ CALL IO_Field_read(TZSONFILE,'DXRATIO', IDXRATIOSON)
+ CALL IO_Field_read(TZSONFILE,'DYRATIO', IDYRATIOSON)
!
IF (ADJUSTL(ADJUSTR(YDAD_SON)).NE.ADJUSTL(ADJUSTR(CMY_NAME(1)))) THEN
WRITE(ILUOUT,*) 'SPAWN_MODEL2: DAD of SON file is different from the one of model2'
@@ -650,16 +657,12 @@ ELSE
NRIMY=0
END IF
IF (NRIMX >= IIU/2-1) THEN ! Error ! this case is not supported - it should be, but there is a bug
- WRITE(*,*) "Error : The size of the LBX zone is too big for the size of the subdomains"
- WRITE(*,*) "Try with less cores, a smaller LBX size, or a bigger grid in X "
- CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'SPAWN_MODEL2', 'The size of the LBX zone is too big for the size of the subdomains. '// &
+ 'Try with less processes, a smaller LBX size or a bigger grid in X.' )
ENDIF
IF ( ( .NOT. L2D ) .AND. (NRIMY >= IJU/2-1) ) THEN ! Error ! this case is not supported - it should be, but there is a bug
- WRITE(*,*) "Error : The size of the LBY zone is too big for the size of the subdomains"
- WRITE(*,*) "Try with less cores, a smaller LBY size, or a bigger grid in Y "
- CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'SPAWN_MODEL2', 'The size of the LBY zone is too big for the size of the subdomains. '// &
+ 'Try with less processes, a smaller LBY size or a bigger grid in Y.' )
ENDIF
!
LHORELAX_UVWTH=.TRUE.
@@ -703,6 +706,8 @@ ALLOCATE(ZJ(IIU,IJU,IKU))
!
!* 4.2 Prognostic (and diagnostic) variables (module MODD_FIELD2) :
!
+ALLOCATE(XZWS(IIU,IJU)); XZWS(:,:) = XZWS_DEFAULT
+ALLOCATE(XLSZWSM(IIU,IJU))
ALLOCATE(XUT(IIU,IJU,IKU))
ALLOCATE(XVT(IIU,IJU,IKU))
ALLOCATE(XWT(IIU,IJU,IKU))
@@ -1117,18 +1122,18 @@ ALLOCATE(ZHUT(IIU,IJU,IKU))
MPPDB_CHECK_LB = .TRUE.
IF (GNOSON) THEN
CALL SPAWN_FIELD2 (NXOR,NYOR,NXEND,NYEND,NDXRATIO,NDYRATIO,CTURB, &
- XUT,XVT,XWT,ZTHVT,XRT,ZHUT,XTKET,XSVT,XATC, &
+ XUT,XVT,XWT,ZTHVT,XRT,ZHUT,XTKET,XSVT,XZWS,XATC, &
XSRCT,XSIGS, &
- XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM, &
+ XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM,XLSZWSM, &
XDTHFRC,XDRVFRC,XTHREL,XRVREL, &
XVU_FLUX_M,XVTH_FLUX_M,XWTH_FLUX_M )
CALL MPPDB_CHECK3D(XUT,"SPAWN_M2 after SPAWN_FIELD2:XUT",PRECISION)
ELSE
CALL MPPDB_CHECK3D(XUT,"SPAWN_M2 before SPAWN_FIELD2:XUT",PRECISION)
CALL SPAWN_FIELD2 (NXOR,NYOR,NXEND,NYEND,NDXRATIO,NDYRATIO,CTURB, &
- XUT,XVT,XWT,ZTHVT,XRT,ZHUT,XTKET,XSVT,XATC, &
+ XUT,XVT,XWT,ZTHVT,XRT,ZHUT,XTKET,XSVT,XZWS,XATC, &
XSRCT,XSIGS, &
- XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM, &
+ XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM,XLSZWSM, &
XDTHFRC,XDRVFRC,XTHREL,XRVREL, &
XVU_FLUX_M, XVTH_FLUX_M,XWTH_FLUX_M, &
TZSONFILE,IIUSON,IJUSON, &
@@ -1156,7 +1161,7 @@ ZTIME1 = ZTIME2
!* vertical interpolation
!
ZZS_MAX = ABS( MAXVAL(XZS(:,:)))
-CALL MPI_ALLREDUCE(ZZS_MAX, ZZS_MAX_ll, 1, MPI_PRECISION, MPI_MAX, &
+CALL MPI_ALLREDUCE(ZZS_MAX, ZZS_MAX_ll, 1, MNHREAL_MPI, MPI_MAX, &
NMNH_COMM_WORLD,IINFO_ll)
IF ( (ZZS_MAX_ll>0.) .AND. (NDXRATIO/=1 .OR. NDYRATIO/=1) ) THEN
CALL MPPDB_CHECK3D(XUT,"SPAWN_M2 before VER_INTERP_FIELD:XUT",PRECISION)
@@ -1186,7 +1191,7 @@ CALL SPAWN_PRESSURE2(NXOR,NYOR,NXEND,NYEND,NDXRATIO,NDYRATIO, &
!
IF (.NOT.GNOSON) THEN
ALLOCATE(ZWORK3D(IIUSON,IJUSON,IKU))
- CALL IO_READ_FIELD(TZSONFILE,'PABST',ZWORK3D)
+ CALL IO_Field_read(TZSONFILE,'PABST',ZWORK3D)
XPABST(IIB2:IIE2,IJB2:IJE2,:) = ZWORK3D(IIB1:IIE1,IJB1:IJE1,:)
DEALLOCATE(ZWORK3D)
END IF
@@ -1201,7 +1206,7 @@ IF (NVERB>=2) THEN
WRITE(ILUOUT,*) ' '
WRITE(ILUOUT,*) 'humidity (I=',IIJ(1),';J=',IIJ(2),')'
DO JK=IKB,IKE
- WRITE(ILUOUT,'(F6.2,2H %)') ZHUT(IIJ(1),IIJ(2),JK)
+ WRITE(ILUOUT,'(F6.2," %")') ZHUT(IIJ(1),IIJ(2),JK)
END DO
END IF
!* 5.8 Retrieve model thermodynamical variables :
@@ -1436,9 +1441,9 @@ ELSE
CMY_NAME(2)=ADJUSTL(ADJUSTR(CINIFILE)//'.spr'//ADJUSTL(HSPANBR))
END IF
!
-CALL IO_FILE_ADD2LIST(TZFILE,CMY_NAME(2),'SPAWNING','WRITE',KLFINPRAR=INPRAR,KLFITYPE=1,KLFIVERB=NVERB)
+CALL IO_File_add2list(TZFILE,CMY_NAME(2),'MNH','WRITE',KLFINPRAR=INPRAR,KLFITYPE=1,KLFIVERB=NVERB)
!
-CALL IO_FILE_OPEN_ll(TZFILE)
+CALL IO_File_open(TZFILE)
!
CALL WRITE_DESFM_n(2,TZFILE)
!
@@ -1464,7 +1469,7 @@ ELSE
CDAD_NAME(2)=CMY_NAME(1) ! model 1 becomes the DAD of model 2 (spawned one)
ENDIF
!
-CALL IO_WRITE_HEADER(TZFILE,HDAD_NAME=CDAD_NAME(2))
+CALL IO_Header_write(TZFILE,HDAD_NAME=CDAD_NAME(2))
CALL WRITE_LFIFM_n(TZFILE,CDAD_NAME(2))
!
CALL SECOND_MNH(ZTIME2)
@@ -1490,9 +1495,9 @@ ZSURF2 = ZTIME2 - ZTIME1
!* 8. CLOSES THE FMFILE
! -----------------
!
-CALL IO_FILE_CLOSE_ll(TZFILE)
+CALL IO_File_close(TZFILE)
IF (ASSOCIATED(TZSONFILE)) THEN
- CALL IO_FILE_CLOSE_ll(TZSONFILE)
+ CALL IO_File_close(TZSONFILE)
END IF
!
!-------------------------------------------------------------------------------
@@ -1655,7 +1660,7 @@ WRITE(ILUOUT,*) ' ------------------------------------------------------------ '
6 FORMAT(' | SPAWN_MODEL2 | ',F8.3,' | ',F8.3,' |')
!
!
-CALL IO_FILE_CLOSE_ll(TLUOUT)
+CALL IO_File_close(TLUOUT)
!
9900 FORMAT(' K = 001 ZHAT = ',E14.7)
9901 FORMAT(' K = ',I3.3,' ZHAT = ',E14.7,' DZ = ' ,E14.7)
diff --git a/src/MNH/spawn_surf.f90 b/src/MNH/spawn_surf.f90
index f9e126c209b7dfb521d46ef0f99f0de3106ebc52..deee96b3bd6a5bf44d5f35efadbafaa9a45f2e19 100644
--- a/src/MNH/spawn_surf.f90
+++ b/src/MNH/spawn_surf.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2004-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 SPAWN_SURF (HINIFILE, HINIFILEPGD, TPOUTDATAFILE, OSPAWN_SURF)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
CHARACTER (LEN=*), INTENT(IN) :: HINIFILE ! Input file
@@ -75,7 +75,7 @@ END MODULE MODI_SPAWN_SURF
!
USE MODD_CONF, ONLY : NVERB
USE MODD_GRID_n, ONLY : XZS
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY : TFILEDATA
USE MODD_IO_SURF_MNH, ONLY : COUTFILE
USE MODD_LUNIT, ONLY : TPGDFILE, TOUTDATAFILE
USE MODD_MNH_SURFEX_n
@@ -84,8 +84,6 @@ USE MODD_PARAM_n, ONLY : CSURF
USE MODD_TIME_n, ONLY : TDTCUR
!
USE MODE_ll
-USE MODE_FMWRIT
-USE MODE_IO_ll
USE MODE_MODELN_HANDLER
USE MODE_PREP_CTL, ONLY : PREP_CTL
!
diff --git a/src/MNH/spawn_surf2_rain.f90 b/src/MNH/spawn_surf2_rain.f90
index 2a776304a2947ffc2616a6035cb98c84e6b9e888..0c324004db2bc022e01a0d0851e92d327c927cb5 100644
--- a/src/MNH/spawn_surf2_rain.f90
+++ b/src/MNH/spawn_surf2_rain.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2004-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
!###########################
@@ -17,7 +17,7 @@ INTERFACE
KIB2,KJB2,KIE2,KJE2, &
KIB1,KJB1,KIE1,KJE1 )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
IMPLICIT NONE
!
@@ -91,7 +91,7 @@ END MODULE MODI_SPAWN_SURF2_RAIN
!! ---------
!!
!! Book1 of the documentation
-!!
+!!
!!
!! AUTHOR
!! ------
@@ -109,17 +109,17 @@ END MODULE MODI_SPAWN_SURF2_RAIN
!! C.Lac 10/2016 : Add droplet deposition for fog
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! J.Escobar 05/03/2018 : bypass gridnesting special case KD(X/Y)RATIO == 1 not parallelized
+! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_BIKHARDT_n
-USE MODD_CONF, ONLY : CCONF,CPROGRAM
-USE MODD_FIELD_n, ONLY : XTHT
-USE MODD_IO_ll, ONLY: TFILEDATA
-USE MODD_LBC_n, ONLY : LBC_MODEL
-USE MODD_LUNIT_n, ONLY : CLUOUT
+USE MODD_CONF, ONLY: CCONF, CPROGRAM
+USE MODD_FIELD_n, ONLY: XTHT
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LBC_n, ONLY: LBC_MODEL
USE MODD_SPAWN
!
USE MODE_MODELN_HANDLER
@@ -413,7 +413,7 @@ IF (PRESENT(TPSONFILE)) THEN
ALLOCATE(ZACPRH1(0,0))
YGETRHT='SKIP'
END IF
- CALL READ_PRECIP_FIELD(TPSONFILE,CLUOUT,CPROGRAM,CCONF, &
+ CALL READ_PRECIP_FIELD(TPSONFILE,CPROGRAM,CCONF, &
YGETRCT,YGETRRT,YGETRST,YGETRGT,YGETRHT, &
ZINPRC1,ZACPRC1,ZINDEP1,ZACDEP1,ZINPRR1,ZINPRR3D1,ZEVAP3D1, &
ZACPRR1,ZINPRS1,ZACPRS1, &
diff --git a/src/MNH/spawn_zs.f90 b/src/MNH/spawn_zs.f90
index 63bd460afb8f08731bf07d128f906fe8fa5da562..ea7ad57684df040d48e490829a65991582d45b1c 100644
--- a/src/MNH/spawn_zs.f90
+++ b/src/MNH/spawn_zs.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2005-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2005-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.
!-----------------------------------------------------------------
!###################
@@ -103,9 +103,10 @@ END MODULE MODI_SPAWN_ZS
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS, ONLY : JPHEXT ! Declarative modules
-USE MODD_CONF, ONLY : NVERB
+USE MODD_PARAMETERS, ONLY: JPHEXT ! Declarative modules
+USE MODD_CONF, ONLY: NVERB
USE MODD_LUNIT_n, ONLY: TLUOUT
+use modd_precision, only: MNHREAL_MPI
!
USE MODD_BIKHARDT_n
!
@@ -114,7 +115,6 @@ USE MODI_ZS_BOUNDARY
!
USE MODE_MODELN_HANDLER
!
-USE MODE_FM
USE MODE_MPPDB
USE MODD_VAR_ll
USE MODE_ll
@@ -192,7 +192,7 @@ INTEGER :: KDXRATIO_C, KDYRATIO_C
!$20140704
!$20140711 not INT, REAL !!
REAL :: ZMAXVAL
-REAL :: LOCMAXVAL
+REAL :: ZLOCMAXVAL
!$20140801
INTEGER :: IORX, IORY, IIBINT,IJBINT,IIEINT,IJEINT
INTEGER :: IXOR_C_ll, IXEND_C_ll ! origin and end of the local subdomain of the child model 2
@@ -414,8 +414,8 @@ IF (KDXRATIO/=1 .OR. KDYRATIO/=1) THEN
!
ALLOCATE(ZDZS_3D(SIZE(ZDZS_C,1),SIZE(ZDZS_C,2),1)) ! WARNING : this is highly inefficient, this copy is unecessary
ZDZS_3D(:,:,1)=ZDZS_C(:,:) ! We could write a function MAX2D_ll or use a POINTER for ZDZS_3D
- LOCMAXVAL=MAXVAL(ABS(ZDZS_C))
- CALL MPI_ALLREDUCE(LOCMAXVAL,ZMAXVAL,1,MPI_PRECISION,MPI_MAX,NMNH_COMM_WORLD,IINFO_ll)
+ ZLOCMAXVAL=MAXVAL(ABS(ZDZS_C))
+ CALL MPI_ALLREDUCE(ZLOCMAXVAL,ZMAXVAL,1,MNHREAL_MPI,MPI_MAX,NMNH_COMM_WORLD,IINFO_ll)
IF (ZMAXVAL<1.E-3) THEN
EXIT
ENDIF
diff --git a/src/MNH/spawning.f90 b/src/MNH/spawning.f90
index 7ab352665080b6bc19ddcea1d8107ccae3e71e25..2480473be3a44be2ae754e179093f444bf3c264b 100644
--- a/src/MNH/spawning.f90
+++ b/src/MNH/spawning.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1995-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ################
@@ -74,6 +74,9 @@
!! J.Escobar : 19/04/2016 : Pb IOZ/NETCDF , missing OPARALLELIO=.FALSE. for PGD files
!! 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: 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -101,7 +104,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_ll, ONLY: NIO_VERB,NVERB_DEBUG,TFILEDATA
+USE MODD_IO, ONLY: NIO_VERB,NVERB_DEBUG,TFILEDATA
USE MODD_LSFIELD_n
USE MODD_LBC_n
USE MODD_LUNIT_n
@@ -111,12 +114,12 @@ USE MODD_REF_n
USE MODD_TIME_n
USE MODD_CH_MNHC_n
USE MODD_GRID_n
-!
-USE MODE_IO_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_FIND_BYNAME,IO_FILE_PRINT_LIST
+!
+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_ll
USE MODE_POS
-USE MODE_FM
USE MODE_MODELN_HANDLER
!
USE MODI_SPAWN_MODEL2
@@ -165,7 +168,7 @@ CALL VERSION
CPROGRAM='SPAWN '
CDOMAIN= ''
!
-CALL INITIO_ll()
+CALL IO_Init()
!-------------------------------------------------------------------------------
!
!* 1. SPAWNING INITIALIZATION
@@ -180,8 +183,8 @@ CALL READ_EXSPA(CINIFILE,CINIFILEPGD,&
!* 2. NAM_BLANK, NAM_SPAWN_SURF and NAM_CONFZ READING AND EXSPA file CLOSURE
! ----------------------------------------
!
-CALL IO_FILE_FIND_BYNAME('SPAWN1.nam',TZEXPAFILE,IRESP)
-CALL IO_FILE_OPEN_ll(TZEXPAFILE)
+CALL IO_File_find_byname('SPAWN1.nam',TZEXPAFILE,IRESP)
+CALL IO_File_open(TZEXPAFILE)
ILUSPA = TZEXPAFILE%NLU
!
CALL INIT_NMLVAR
@@ -194,7 +197,7 @@ CALL POSNAM(ILUSPA,'NAM_CONFZ',GFOUND)
IF (GFOUND) READ(UNIT=ILUSPA,NML=NAM_CONFZ)
CALL POSNAM(ILUSPA,'NAM_CONF_SPAWN',GFOUND)
IF (GFOUND) READ(UNIT=ILUSPA,NML=NAM_CONF_SPAWN)
-CALL IO_FILE_CLOSE_ll(TZEXPAFILE)
+CALL IO_File_close(TZEXPAFILE)
!
!-------------------------------------------------------------------------------
!
@@ -203,9 +206,9 @@ CALL IO_FILE_CLOSE_ll(TZEXPAFILE)
!
CALL INIT_MNH
!
-CALL IO_FILE_FIND_BYNAME(TRIM(CINIFILE),TZINIFILE,IRESP)
-CALL IO_FILE_CLOSE_ll(TZINIFILE)
-CALL IO_FILE_CLOSE_ll(TINIFILEPGD,OPARALLELIO=.FALSE.)
+CALL IO_File_find_byname(TRIM(CINIFILE),TZINIFILE,IRESP)
+CALL IO_File_close(TZINIFILE)
+CALL IO_File_close(TINIFILEPGD)
!-------------------------------------------------------------------------------
!
!* 4. INITIALIZATION OF OUTER POINTS OF MODEL 1
@@ -226,7 +229,7 @@ CALL MPPDB_CHECK3D(XUT,"SPAWNING-after boundaries::XUT",PRECISION)
!* 5. SPAWNING OF MODEL 2 FROM MODEL 1
! --------------------------------
!
-CALL IO_FILE_OPEN_ll(TZEXPAFILE)
+CALL IO_File_open(TZEXPAFILE)
ILUSPA = TZEXPAFILE%NLU
!
CALL SET_POINTERS_TO_MODEL1()
@@ -236,7 +239,7 @@ CALL POSNAM(ILUSPA,'NAM_SPAWN_SURF',GFOUND)
IF (GFOUND) READ(UNIT=ILUSPA,NML=NAM_SPAWN_SURF)
CALL UPDATE_MODD_FROM_NMLVAR
CALL GOTO_MODEL(1)
-CALL IO_FILE_CLOSE_ll(TZEXPAFILE)
+CALL IO_File_close(TZEXPAFILE)
!
CALL GO_TOMODEL_ll(2,IINFO_ll)
!
@@ -246,15 +249,13 @@ CALL SPAWN_MODEL2 (NRR,NSV_USER,CTURB,CSURF,CCLOUD, &
!
CALL SURFEX_DEALLO_LIST
!
-IF(NIO_VERB>=NVERB_DEBUG) CALL IO_FILE_PRINT_LIST()
+IF(NIO_VERB>=NVERB_DEBUG) CALL IO_Filelist_print()
!
-CALL IO_FILE_CLOSE_ll(TLUOUT)
+CALL IO_File_close(TLUOUT)
!
CALL END_PARA_ll(IINFO_ll)
-!JUAN CALL ABORT
-STOP
-CONTAINS
+CONTAINS
SUBROUTINE INIT_NMLVAR
LRES=LRES_n
@@ -292,12 +293,14 @@ XRT1 => XRT
XUT1 => XUT
XVT1 => XVT
XWT1 => XWT
+XZWS1 => XZWS
XSRCT1 => XSRCT
XSIGS1 => XSIGS
TDTCUR1 => TDTCUR
XLSUM1 => XLSUM
XLSVM1 => XLSVM
XLSWM1 => XLSWM
+XLSZWSM1 => XLSZWSM
XLSTHM1 => XLSTHM
XLSRVM1 => XLSRVM
!
diff --git a/src/MNH/spec_ver_int.f90 b/src/MNH/spec_ver_int.f90
index abd3ed1e047741f659adc7fd2efc3c9c86d8c519..752f233df40446b29a850a818645f6c1f8b4be42 100644
--- a/src/MNH/spec_ver_int.f90
+++ b/src/MNH/spec_ver_int.f90
@@ -1,6 +1,6 @@
!MNH_LIC Copyright 2000-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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #################
@@ -50,6 +50,7 @@ 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
!!
!! --------------------------------------------------------------------------
!
@@ -59,8 +60,10 @@ END MODULE MODI_SPEC_VER_INT
USE MODD_LES
USE MODD_PARAMETERS
!
-USE MODE_ll
USE MODE_GATHER_ll
+USE MODE_ll
+use mode_msg
+!
USE MODI_VER_INTERP_LIN
!
IMPLICIT NONE
@@ -102,16 +105,13 @@ ELSE IF (CSPECTRA_LEVEL_TYPE=='Z') THEN
PA_SPEC = XUNDEF
END WHERE
ELSE
- PRINT*, '-------> STOP in SPEC_VER_INT <----------'
- !callabortstop
-CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'SPEC_VER_INT', 'invalid CSPECTRA_LEVEL_TYPE ('//CSPECTRA_LEVEL_TYPE//')' )
END IF
!
!-------------------------------------------------------------------------------
!
-! ONE PROCESSOR ONLY
-! ------------------
+! ONE PROCESS ONLY
+! ----------------
!
CALL GET_GLOBALDIMS_ll(IIMAX_ll,IJMAX_ll)
ALLOCATE(ZA_ll(IIMAX_ll+2*JPHEXT,IJMAX_ll+2*JPHEXT,NSPECTRA_K))
diff --git a/src/MNH/spectre.f90 b/src/MNH/spectre.f90
index ef3367cdc9e0a60eb485978090a64bc2b1302db1..22878e5a926e5263f3e868a0ef20357e13ea4179 100644
--- a/src/MNH/spectre.f90
+++ b/src/MNH/spectre.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
! ######spl
PROGRAM SPECTRE
! ############
@@ -24,7 +25,7 @@
!
!
USE MODD_CONF
-USE MODD_IO_ll, ONLY: NIO_VERB,NVERB_DEBUG,TFILEDATA
+USE MODD_IO, ONLY: NIO_VERB,NVERB_DEBUG,TFILEDATA
USE MODD_LUNIT
USE MODD_LUNIT_n
USE MODD_TIME_n
@@ -36,10 +37,10 @@ USE MODI_SPECTRE_AROME
!
USE MODE_MSG
USE MODE_POS
-USE MODE_IO_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY : IO_FILE_ADD2LIST,IO_FILE_PRINT_LIST
+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_MODELN_HANDLER
-USE MODE_FM
!USE MODD_TYPE_DATE
USE MODI_VERSION
!
@@ -84,7 +85,7 @@ CALL GOTO_MODEL(1)
CALL VERSION
CPROGRAM='SPEC '
!
-CALL INITIO_ll()
+CALL IO_Init()
!
! initialization
YINIFILE(:) = ' '
@@ -120,8 +121,8 @@ PRINT*, '*********************************************************************'
PRINT*, '*********************************************************************'
PRINT*, ' '
!
-CALL IO_FILE_ADD2LIST(TZNMLFILE,'SPEC1.nam','NML','READ')
-CALL IO_FILE_OPEN_ll(TZNMLFILE)
+CALL IO_File_add2list(TZNMLFILE,'SPEC1.nam','NML','READ')
+CALL IO_File_open(TZNMLFILE)
ILUNAM = TZNMLFILE%NLU
!
PRINT*, 'READ THE SPEC1.NAM FILE'
@@ -162,9 +163,9 @@ IF (GFOUND) THEN
READ(UNIT=ILUNAM,NML=NAM_CONFIO)
PRINT*, ' namelist NAM_CONFIO read'
END IF
-CALL SET_CONFIO_ll()
+CALL IO_Config_set()
!
-CALL IO_FILE_CLOSE_ll(TZNMLFILE)
+CALL IO_File_close(TZNMLFILE)
!
CINIFILE = YINIFILE(1)
!
@@ -188,10 +189,10 @@ ENDIF
IF (CTYPEFILE=='MESONH') THEN
CALL SPECTRE_MESONH(YOUTFILE)
!
- CALL IO_FILE_CLOSE_ll(LUNIT_MODEL(1)%TINIFILE)
- IF(NIO_VERB>=NVERB_DEBUG) CALL IO_FILE_PRINT_LIST()
- CALL IO_FILE_CLOSE_ll(TLUOUT0)
- CALL IO_FILE_CLOSE_ll(TLUOUT)
+ 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
diff --git a/src/MNH/spectre_arome.f90 b/src/MNH/spectre_arome.f90
index 532c3d9794e0859740b4b6115e3941c38de5d077..81a83ebc2089429df9c56f7ecaa107e050d6d94e 100644
--- a/src/MNH/spectre_arome.f90
+++ b/src/MNH/spectre_arome.f90
@@ -2,6 +2,11 @@
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C 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 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 10/01/2019: use NEWUNIT argument of OPEN
+!-----------------------------------------------------------------
! ####################
MODULE MODI_SPECTRE_AROME
! ####################
@@ -22,14 +27,9 @@ END MODULE
SUBROUTINE SPECTRE_AROME(HINIFILE,HOUTFILE,PDELTAX,PDELTAY,KI,KJ,KK)
! ######################################################################
-!
-! Modifications:
-! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! Philippe Wautelet: 10/01/2019: use NEWUNIT argument of OPEN
!
USE MODD_CONF
-USE MODE_FM
-USE MODE_IO_ll
+USE MODE_IO, only: IO_Pack_set
USE MODD_SPECTRE
USE MODI_COMPUTE_SPECTRE
USE MODD_PARAMETERS
@@ -54,7 +54,7 @@ INTEGER :: JJJ,III,JERR
CALL SET_SPLITTING_ll(CSPLIT)
CALL SET_JP_ll(JPMODELMAX,JPHEXT,JPVEXT, NHALO)
CALL SET_DAD0_ll()
-CALL SET_FMPACK_ll(L1D,L2D,LPACK)
+CALL IO_Pack_set(L1D,L2D,LPACK)
ALLOCATE(ZWORK1(KI+2,KJ+2,KK+2))
!
IF (LSPECTRE_U) THEN
diff --git a/src/MNH/test_nam_var.f90 b/src/MNH/test_nam_var.f90
index d26aca6f0579f3563c8fc2c607fcfa7f92a3cefc..476cf1a4d8460ad0feef3bb54068a2520d472823 100644
--- a/src/MNH/test_nam_var.f90
+++ b/src/MNH/test_nam_var.f90
@@ -80,11 +80,14 @@ END MODULE MODI_TEST_NAM_VAR
!! original 17/04/98
!! 10/2016 (C.Lac) Increase of the number of values
!! P.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
!----------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+use mode_msg
+!
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
@@ -183,8 +186,6 @@ IF ( PRESENT (HVALUE11) ) WRITE (KLUOUT,*) '"',HVALUE11,'"'
IF ( PRESENT (HVALUE12) ) WRITE (KLUOUT,*) '"',HVALUE12,'"'
FLUSH(unit=KLUOUT)
!
- !callabortstop
-CALL ABORT
-STOP
+call Print_msg( NVERB_FATAL, 'GEN', 'TEST_NAM_VARC0', trim(HVAR)//' is not allowed for variable '//trim(HNAME) )
!-------------------------------------------------------------------------------
END SUBROUTINE TEST_NAM_VARC0
diff --git a/src/MNH/tke_eps_sources.f90 b/src/MNH/tke_eps_sources.f90
index 6132cdc2ac6c732ed0b8b9c57a293c806445bca3..ed98e4519bb820e5dd4793416885b8460cf513c4 100644
--- a/src/MNH/tke_eps_sources.f90
+++ b/src/MNH/tke_eps_sources.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
TPFILE,OCLOSE_OUT,OTURB_DIAG, &
PTP,PRTKES,PRTKESM, PRTHLS,PCOEF_DISS,PTR,PDISS )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KKA !near ground array index
INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
@@ -179,15 +179,15 @@ END MODULE MODI_TKE_EPS_SOURCES
USE MODD_CST
USE MODD_CONF
USE MODD_CTURB
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_BUDGET
USE MODD_LES
USE MODD_DIAG_IN_RUN, ONLY : LDIAG_IN_RUN, XCURRENT_TKE_DISS
!
USE MODE_ll
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
-USE MODE_FMWRIT
+USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
!
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
@@ -526,7 +526,7 @@ IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,PDP)
+ CALL IO_Field_write(TPFILE,TZFIELD,PDP)
!
! stores the thermal production
!
@@ -540,7 +540,7 @@ IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,PTP)
+ CALL IO_Field_write(TPFILE,TZFIELD,PTP)
!
! stores the whole turbulent transport
!
@@ -554,7 +554,7 @@ IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,PTR)
+ CALL IO_Field_write(TPFILE,TZFIELD,PTR)
!
! stores the dissipation of TKE
!
@@ -568,7 +568,7 @@ IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,PDISS)
+ CALL IO_Field_write(TPFILE,TZFIELD,PDISS)
END IF
!
! Storage in the LES configuration of the Dynamic Production of TKE and
diff --git a/src/MNH/tools.f90 b/src/MNH/tools.f90
new file mode 100644
index 0000000000000000000000000000000000000000..68a195fac3c0874493ec93b5f4ced23a6c58ab93
--- /dev/null
+++ b/src/MNH/tools.f90
@@ -0,0 +1,46 @@
+!MNH_LIC Copyright 2019-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 mode_tools
+!################
+!
+! Purpose
+! -------
+!
+! The Purpose of this module is to provide useful tools for MesoNH
+!
+! Author
+! ------
+! P. Wautelet 14/02/2019
+!
+
+implicit none
+
+private
+
+public :: upcase
+
+contains
+
+function upcase(hstring)
+ character(len=*), intent(in) :: hstring
+ character(len=len(hstring)) :: upcase
+
+ integer :: jc
+ integer, parameter :: iamin = iachar("a")
+ integer, parameter :: iamaj = iachar("A")
+
+ do jc = 1,len(hstring)
+ if ( hstring(jc:jc) >= "a" .and. hstring(jc:jc) <= "z" ) then
+ upcase(jc:jc) = achar( iachar( hstring(jc:jc) ) - iamin + iamaj )
+ else
+ upcase(jc:jc) = hstring(jc:jc)
+ end if
+ end do
+end function upcase
+
+end module mode_tools
diff --git a/src/MNH/transfer_file.f90 b/src/MNH/transfer_file.f90
deleted file mode 100644
index 0fe173610cb2d26b89142c94d1133669e55a6dda..0000000000000000000000000000000000000000
--- a/src/MNH/transfer_file.f90
+++ /dev/null
@@ -1,92 +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 BUG1 2007/06/15 17:47:18
-!-----------------------------------------------------------------
-!#########################
-MODULE MODI_TRANSFER_FILE
-!#########################
-!
-INTERFACE
- SUBROUTINE TRANSFER_FILE(HTRANS,HCPIO,HFILENAME)
-!
-CHARACTER(LEN=*), INTENT(IN) :: HTRANS ! unix command for transfer
-CHARACTER(LEN=*), INTENT(IN) :: HCPIO ! CPIO option
-CHARACTER(LEN=*), INTENT(IN) :: HFILENAME ! name of the file to transfer
-!
-END SUBROUTINE TRANSFER_FILE
-END INTERFACE
-END MODULE MODI_TRANSFER_FILE
-!
-! ################################################
- SUBROUTINE TRANSFER_FILE(HTRANS,HCPIO,HFILENAME)
-! ################################################
-!
-!!**** *TRANSFER_FILE* - writes transfer.x command for a file in the pipe_name
-!!
-!! PURPOSE
-!! -------
-!! This subroutine writes the unix command line HTRANS HCPIO HFILENAME
-!! in the file pipe_name and flushes the buffer.
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! Routine FLUSH : to flush the buffer
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Book 2
-!!
-!! AUTHOR
-!! ------
-!!
-!! V.Masson Meteo-France
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 10/04/95
-!! modified by E.pesin 03/98 (for FUJITSU machine)
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of arguments
-! ------------------------
-!
-CHARACTER(LEN=*), INTENT(IN) :: HTRANS ! unix command for transfer
-CHARACTER(LEN=*), INTENT(IN) :: HCPIO ! CPIO option
-CHARACTER(LEN=*), INTENT(IN) :: HFILENAME ! name of the file to transfer
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-!
-CHARACTER(LEN=100) :: YCOMMAND ! command writen in pipe_name
-!
-!-------------------------------------------------------------------------------
-!
-WRITE(YCOMMAND,'(A," ",A," ",A," >> OUTPUT_TRANSFER 2>&1 &")') TRIM(HTRANS),TRIM(HCPIO),TRIM(HFILENAME)
-PRINT *,'YCOMMAND =',YCOMMAND
-!
-print*, 'WARNING: routine TRANSFER_FILE DOES NOT WORK'
-!!!!!CALL SYSTEM(YCOMMAND)
-print*, 'WARNING: "CALL SYSTEM(YCOMMAND)" is not called in TRANSFER_FILE routine'
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE TRANSFER_FILE
diff --git a/src/MNH/trid.f90 b/src/MNH/trid.f90
index 3f57d6a9c4897e67eaf7921d7b001023f9f82a5e..db2600ee0af0faddad79ec73885f01419298441e 100644
--- a/src/MNH/trid.f90
+++ b/src/MNH/trid.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ################
@@ -171,7 +171,6 @@ USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_PARAMETERS
!
USE MODE_ll
-USE MODE_IO_ll
USE MODE_MSG
!
!JUAN
diff --git a/src/MNH/tridz.f90 b/src/MNH/tridz.f90
index c72b598703421105f35c5bb78ec8c6faa24b7970..4a74457910674c6edca3bf6f463ba8ed82fda929 100644
--- a/src/MNH/tridz.f90
+++ b/src/MNH/tridz.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ################
@@ -180,7 +180,6 @@ USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_PARAMETERS
!
USE MODE_ll
-USE MODE_IO_ll
USE MODE_MSG
!JUAN P1/P2 SPLITTING
USE MODE_SPLITTINGZ_ll , ONLY : GET_DIM_EXTZ_ll,GET_ORZ_ll,LWESTZ_ll,LSOUTHZ_ll
diff --git a/src/MNH/turb.f90 b/src/MNH/turb.f90
index fefaad26a82654914fae4471d87860c5836e4144..03573095bad297e5abc533d0e8cd7db033630516 100644
--- a/src/MNH/turb.f90
+++ b/src/MNH/turb.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 @@ INTERFACE
PFLXZTHVMF,PWTH,PWRC,PWSV,PDYP,PTHP,PTR,PDISS,PLEM )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KKA !near ground array index
INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
@@ -350,7 +350,7 @@ USE MODD_CST
USE MODD_CTURB
USE MODD_CONF
USE MODD_BUDGET
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES
USE MODD_NSV
!
@@ -378,8 +378,8 @@ USE MODI_TM06
USE MODI_UPDATE_LM
USE MODI_GET_HALO
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
-USE MODE_FMWRIT
+USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_SBL
!
USE MODI_EMOIST
@@ -755,7 +755,7 @@ IF (KRRL >=1) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZATHETA)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZATHETA)
!
TZFIELD%CMNHNAME = 'AMOIST'
TZFIELD%CSTDNAME = ''
@@ -767,7 +767,7 @@ IF (KRRL >=1) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZAMOIST)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZAMOIST)
END IF
!
ELSE
@@ -1237,7 +1237,11 @@ IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
+<<<<<<< HEAD
CALL IO_WRITE_FIELD(TPFILE,TZFIELD,PLEM)
+=======
+ CALL IO_Field_write(TPFILE,TZFIELD,ZLM)
+>>>>>>> MNH-55X
!
IF (KRR /= 0) THEN
!
@@ -1254,7 +1258,7 @@ IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
!$acc update self(PTHLT)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,PTHLT)
+ CALL IO_Field_write(TPFILE,TZFIELD,PTHLT)
!
! stores the conservative mixing ratio
!
@@ -1269,7 +1273,7 @@ IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
!$acc update self(PRT)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,PRT(:,:,:,1))
+ CALL IO_Field_write(TPFILE,TZFIELD,PRT(:,:,:,1))
END IF
END IF
!
@@ -2032,7 +2036,7 @@ IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,PLEM)
+ CALL IO_Field_write(TPFILE,TZFIELD,PLEM)
ENDIF
!
! Amplification of the mixing length when the criteria are verified
@@ -2058,7 +2062,7 @@ IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZCOEF_AMPL)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZCOEF_AMPL)
!
TZFIELD%CMNHNAME = 'LM_CLOUD'
TZFIELD%CSTDNAME = ''
@@ -2069,7 +2073,7 @@ IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZLM_CLOUD)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZLM_CLOUD)
!
ENDIF
!
diff --git a/src/MNH/turb_cloud_index.f90 b/src/MNH/turb_cloud_index.f90
index b9a42c2fcfbb98adf5b71b83604818d336964cfd..a224e27eb694ad36e42c8559521034e5de408996 100644
--- a/src/MNH/turb_cloud_index.f90
+++ b/src/MNH/turb_cloud_index.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 @@ INTERFACE
PRRS,PRM,PRHODJ,PDXX,PDYY,PDZZ,PDZX,PDZY, &
PCEI )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
REAL, INTENT(IN) :: PTSTEP ! Double Time step
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
@@ -85,11 +85,11 @@ END MODULE MODI_TURB_CLOUD_INDEX
!
!-------------------------------------------------------------------------------
!
-USE MODD_IO_ll, ONLY: TFILEDATA
-USE MODD_PARAMETERS, ONLY: JPVEXT
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_PARAMETERS, ONLY: JPVEXT
!
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPEREAL
-USE MODE_FMWRIT
+USE MODE_FIELD, ONLY: TFIELDDATA,TYPEREAL
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
!
USE MODI_GRADIENT_M
!
@@ -259,7 +259,7 @@ IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZRVCI)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZRVCI)
!
TZFIELD%CMNHNAME = 'GX_RVCI'
TZFIELD%CSTDNAME = ''
@@ -271,7 +271,7 @@ IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZG_RVCI(:,:,:,1))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZG_RVCI(:,:,:,1))
!
TZFIELD%CMNHNAME = 'GY_RVCI'
TZFIELD%CSTDNAME = ''
@@ -283,7 +283,7 @@ IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZG_RVCI(:,:,:,2))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZG_RVCI(:,:,:,2))
!
TZFIELD%CMNHNAME = 'GNORM_RVCI'
TZFIELD%CSTDNAME = ''
@@ -295,7 +295,7 @@ IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZGNORM_RVCI)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZGNORM_RVCI)
!
TZFIELD%CMNHNAME = 'QX_RVCI'
TZFIELD%CSTDNAME = ''
@@ -307,7 +307,7 @@ IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZQ_RVCI(:,:,:,1))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZQ_RVCI(:,:,:,1))
!
TZFIELD%CMNHNAME = 'QY_RVCI'
TZFIELD%CSTDNAME = ''
@@ -319,7 +319,7 @@ IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZQ_RVCI(:,:,:,2))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZQ_RVCI(:,:,:,2))
!
TZFIELD%CMNHNAME = 'QNORM_RVCI'
TZFIELD%CSTDNAME = ''
@@ -331,7 +331,7 @@ IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZQNORM_RVCI)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZQNORM_RVCI)
!
TZFIELD%CMNHNAME = 'CEI'
TZFIELD%CSTDNAME = ''
@@ -343,7 +343,7 @@ IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,PCEI)
+ CALL IO_Field_write(TPFILE,TZFIELD,PCEI)
END IF
!
END SUBROUTINE TURB_CLOUD_INDEX
diff --git a/src/MNH/turb_hor.f90 b/src/MNH/turb_hor.f90
index 2b91e31073da9f16662b93935b1a220f71f5cc91..a68194934cb88840011944590c6be2162e1d84c0 100644
--- a/src/MNH/turb_hor.f90
+++ b/src/MNH/turb_hor.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ####################
@@ -27,7 +27,7 @@ INTERFACE
PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KSPLT ! current split index
INTEGER, INTENT(IN) :: KRR ! number of moist var.
@@ -266,7 +266,7 @@ END MODULE MODI_TURB_HOR
!
USE MODD_CST
USE MODD_CTURB
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_LES
!
diff --git a/src/MNH/turb_hor_dyn_corr.f90 b/src/MNH/turb_hor_dyn_corr.f90
index 3541f5a414398231105020f5481c07fc2018a70a..ed514e98a3fe789e356ee4f969aa878d2c37b378 100644
--- a/src/MNH/turb_hor_dyn_corr.f90
+++ b/src/MNH/turb_hor_dyn_corr.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
MODULE MODI_TURB_HOR_DYN_CORR
@@ -22,7 +22,7 @@ INTERFACE
PDP,PTP, &
PRUS,PRVS,PRWS )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KSPLT ! split process index
REAL, INTENT(IN) :: PTSTEP ! timestep
@@ -147,18 +147,18 @@ END MODULE MODI_TURB_HOR_DYN_CORR
!* 0. DECLARATIONS
! ------------
!
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+USE MODD_ARGSLIST_ll, ONLY: LIST_ll
USE MODD_CST
USE MODD_CONF
USE MODD_CTURB
-USE MODD_IO_ll, ONLY: TFILEDATA
+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_FMWRIT
+USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
!
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
@@ -566,7 +566,7 @@ IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZFLX)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
END IF
!
! Complete the U tendency
@@ -758,7 +758,7 @@ IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZFLX)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
END IF
!
!!! wait for the computation of PRUS (that uses ZTMP1_DEVICE and ZTMP3_DEVICE)
@@ -939,7 +939,7 @@ IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZFLX)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
END IF
!
!
diff --git a/src/MNH/turb_hor_splt.f90 b/src/MNH/turb_hor_splt.f90
index 1171330fcc71a78514caa2df988b581abb5c74d7..ac27858c6095a1b63afcf08921aec124e4207dff 100644
--- a/src/MNH/turb_hor_splt.f90
+++ b/src/MNH/turb_hor_splt.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #########################
@@ -26,7 +26,7 @@ INTERFACE
PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KSPLIT ! number of time splitting
INTEGER, INTENT(IN) :: KRR ! number of moist var.
@@ -268,7 +268,7 @@ END MODULE MODI_TURB_HOR_SPLT
USE MODD_CONF
USE MODD_CST
USE MODD_CTURB
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
!
!
diff --git a/src/MNH/turb_hor_sv_flux.f90 b/src/MNH/turb_hor_sv_flux.f90
index e89be47b72ad198db9c707ce16bf7eb5e390902f..4148d7f780dbf8a2966401ca7d3624122371427f 100644
--- a/src/MNH/turb_hor_sv_flux.f90
+++ b/src/MNH/turb_hor_sv_flux.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
PSVM, &
PRSVS )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KSPLT ! split process index
LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
@@ -122,14 +122,14 @@ END MODULE MODI_TURB_HOR_SV_FLUX
USE MODD_CST
USE MODD_CONF
USE MODD_CTURB
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
-USE MODD_NSV, ONLY : NSV_LGBEG,NSV_LGEND
+USE MODD_NSV, ONLY: NSV_LGBEG, NSV_LGEND
USE MODD_LES
USE MODD_BLOWSNOW
!
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPEREAL
-USE MODE_FMWRIT
+USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
!
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
@@ -323,7 +323,7 @@ DO JSV=1,ISV
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
!$acc update self(ZFLXX)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZFLXX)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXX)
END IF
!
IF (LLES_CALL .AND. KSPLT==1) THEN
@@ -436,7 +436,7 @@ DO JSV=1,ISV
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
!$acc update self(ZFLXY)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZFLXY)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXY)
END IF
!
ELSE
diff --git a/src/MNH/turb_hor_thermo_corr.f90 b/src/MNH/turb_hor_thermo_corr.f90
index 415cc363d562b30c0aa1c57dbf468eb774e2b4af..551945145af507066cb79fa9e97080a5973ee8c8 100644
--- a/src/MNH/turb_hor_thermo_corr.f90
+++ b/src/MNH/turb_hor_thermo_corr.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
PLOCPEXNM,PATHETA,PAMOIST,PSRCM, &
PSIGS )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
@@ -131,12 +131,12 @@ END MODULE MODI_TURB_HOR_THERMO_CORR
USE MODD_CST
USE MODD_CONF
USE MODD_CTURB
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_LES
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
-USE MODE_FMWRIT
+USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
!
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
@@ -382,7 +382,7 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. OCLOSE_OUT ) &
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
!$acc update self(ZFLX)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZFLX)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
END IF
!
! Storage in the LES configuration (addition to TURB_VER computation)
@@ -580,7 +580,7 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. OCLOSE_OUT ) &
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
!$acc update self(ZFLX)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZFLX)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
END IF
!
! Storage in the LES configuration (addition to TURB_VER computation)
@@ -756,7 +756,7 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. OCLOSE_OUT ) &
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
!$acc update self(ZFLX)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZFLX)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
END IF
!
! Storage in the LES configuration (addition to TURB_VER computation)
diff --git a/src/MNH/turb_hor_thermo_flux.f90 b/src/MNH/turb_hor_thermo_flux.f90
index edd82d225a9fb4dc2d40df5b04d681675a66f1f2..540ac628ba3028a0cadaf92d425605e1e0d7d4dc 100644
--- a/src/MNH/turb_hor_thermo_flux.f90
+++ b/src/MNH/turb_hor_thermo_flux.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ################################
@@ -21,7 +21,7 @@ INTERFACE
PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
PRTHLS,PRRS )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KSPLT ! split process index
INTEGER, INTENT(IN) :: KRR ! number of moist var.
@@ -141,12 +141,12 @@ END MODULE MODI_TURB_HOR_THERMO_FLUX
USE MODD_CST
USE MODD_CONF
USE MODD_CTURB
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_LES
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
-USE MODE_FMWRIT
+USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
!
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
@@ -521,7 +521,7 @@ IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
!$acc update self(ZFLX)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZFLX)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
END IF
!
IF (KSPLT==1 .AND. LLES_CALL) THEN
@@ -658,7 +658,7 @@ IF (KRR/=0) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZFLX)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
END IF
!
IF (KSPLT==1 .AND. LLES_CALL) THEN
@@ -919,7 +919,7 @@ END IF
!! TZFIELD%NTYPE = TYPEREAL
!! TZFIELD%NDIMS = 3
!! TZFIELD%LTIMEDEP = .TRUE.
-!! CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZVPTU)
+!! CALL IO_Field_write(TPFILE,TZFIELD,ZVPTU)
!! END IF
!!!
!!ELSE
@@ -1023,7 +1023,7 @@ IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZFLX)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
END IF
!
IF (KSPLT==1 .AND. LLES_CALL) THEN
@@ -1358,7 +1358,7 @@ IF (KRR/=0) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZFLX)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
END IF
!
IF (KSPLT==1 .AND. LLES_CALL) THEN
@@ -1640,7 +1640,7 @@ END IF
!! TZFIELD%NTYPE = TYPEREAL
!! TZFIELD%NDIMS = 3
!! TZFIELD%LTIMEDEP = .TRUE.
-!! CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZVPTV)
+!! CALL IO_Field_write(TPFILE,TZFIELD,ZVPTV)
!! END IF
!!!
!!ELSE
diff --git a/src/MNH/turb_hor_uv.f90 b/src/MNH/turb_hor_uv.f90
index 5dfa85f5678c6c083c4e9931ac5c811db7dbafc9..fb1481548a886ffbe49f40bb461da34d966e26c5 100644
--- a/src/MNH/turb_hor_uv.f90
+++ b/src/MNH/turb_hor_uv.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #######################
@@ -22,7 +22,7 @@ INTERFACE
PDP, &
PRUS,PRVS )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KSPLT ! split process index
LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
@@ -133,12 +133,12 @@ END MODULE MODI_TURB_HOR_UV
USE MODD_CST
USE MODD_CONF
USE MODD_CTURB
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_LES
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
-USE MODE_FMWRIT
+USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
!
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
@@ -417,7 +417,7 @@ IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
!$acc update self(ZFLX)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZFLX)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
END IF
!
!
diff --git a/src/MNH/turb_hor_uw.f90 b/src/MNH/turb_hor_uw.f90
index e693b33f3938721960c436a1e99613bba0689c8f..0b43466fa3961d3ca3ee732008735c533d0765fa 100644
--- a/src/MNH/turb_hor_uw.f90
+++ b/src/MNH/turb_hor_uw.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
PDP, &
PRUS,PRWS )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KSPLT ! split process index
LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
@@ -122,13 +122,13 @@ END MODULE MODI_TURB_HOR_UW
USE MODD_CST
USE MODD_CONF
USE MODD_CTURB
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_LES
USE MODD_NSV
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
-USE MODE_FMWRIT
+USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
!
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
@@ -264,7 +264,7 @@ IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
!$acc update self(ZFLX)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZFLX)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
END IF
!
!
diff --git a/src/MNH/turb_hor_vw.f90 b/src/MNH/turb_hor_vw.f90
index b54ce312cc7567bb05394cf1eb73c15a4a180ea0..641f760b4796a86cd554954a6db69d161daac26b 100644
--- a/src/MNH/turb_hor_vw.f90
+++ b/src/MNH/turb_hor_vw.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
PDP, &
PRVS,PRWS )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KSPLT ! split process index
LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
@@ -125,13 +125,13 @@ END MODULE MODI_TURB_HOR_VW
USE MODD_CST
USE MODD_CONF
USE MODD_CTURB
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_LES
USE MODD_NSV
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
-USE MODE_FMWRIT
+USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
!
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
@@ -290,7 +290,7 @@ IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
!$acc update self(ZFLX)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZFLX)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
END IF
!
! compute the source for rho*V due to this residual flux ( the other part is
diff --git a/src/MNH/turb_ver.f90 b/src/MNH/turb_ver.f90
index bfe58c1b2a0ae5dfaf7f80999f33e57c062969c8..2867e1195a9cc3ddcd3aabf7f92ad9a86a3a9eb9 100644
--- a/src/MNH/turb_ver.f90
+++ b/src/MNH/turb_ver.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ####################
@@ -27,7 +27,7 @@ INTERFACE
PDP,PTP,PSIGS,PWTH,PWRC,PWSV )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
@@ -338,10 +338,10 @@ END MODULE MODI_TURB_VER
!
USE MODD_CST
USE MODD_CTURB
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_LES
-USE MODD_NSV, ONLY : NSV
+USE MODD_NSV, ONLY: NSV
USE MODD_BLANK
!
USE MODI_PRANDTL
@@ -356,8 +356,8 @@ USE MODI_TURB_VER_SV_CORR
USE MODI_LES_MEAN_SUBGRID
USE MODI_SBL_DEPTH
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
-USE MODE_FMWRIT
+USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_PRANDTL
!
USE MODI_SECOND_MNH
@@ -737,7 +737,7 @@ IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
!$acc update self(ZPHI3)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZPHI3)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPHI3)
!
! stores the Turbulent Schmidt number
!
@@ -752,7 +752,7 @@ IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
!$acc update self(ZPSI3)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZPSI3)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPSI3)
!
!
! stores the Turbulent Schmidt number for the scalar variables
@@ -769,7 +769,7 @@ IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
WRITE(TZFIELD%CMNHNAME, '("PSI_SV_",I3.3)') JSV
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZPSI_SV(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPSI_SV(:,:,:,JSV))
END DO
!
END IF
diff --git a/src/MNH/turb_ver_dyn_flux.f90 b/src/MNH/turb_ver_dyn_flux.f90
index 7699a7021d829b7d839a06f2cf53fbefe6f25726..e85ea649b6431a247a718cc39c6b35700ec12d1b 100644
--- a/src/MNH/turb_ver_dyn_flux.f90
+++ b/src/MNH/turb_ver_dyn_flux.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 @@ INTERFACE
PRUS,PRVS,PRWS, &
PDP )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KKA !near ground array index
INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
@@ -297,32 +297,31 @@ END MODULE MODI_TURB_VER_DYN_FLUX
USE MODD_CONF
USE MODD_CST
USE MODD_CTURB
-USE MODD_IO_ll, ONLY: TFILEDATA
-USE MODD_PARAMETERS
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES
USE MODD_NSV
+USE MODD_PARAMETERS
!
-!
+#ifdef MNH_BITREP
+USE MODI_BITREP
+#endif
+USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
-USE MODI_GRADIENT_M
+USE MODI_LES_MEAN_SUBGRID
+USE MODI_SECOND_MNH
#ifndef _OPENACC
USE MODI_SHUMAN
#else
USE MODI_SHUMAN_DEVICE
#endif
-USE MODI_TRIDIAG
-USE MODI_TRIDIAG_WIND
-USE MODE_FMWRIT
-USE MODI_LES_MEAN_SUBGRID
+USE MODI_TRIDIAG
+USE MODI_TRIDIAG_WIND
!
-USE MODI_SECOND_MNH
+USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_ll
-#ifdef MNH_BITREP
-USE MODI_BITREP
-#endif
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
!
IMPLICIT NONE
!
@@ -641,7 +640,7 @@ IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZFLXZ)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
END IF
!
! first part of total momentum flux
@@ -1056,7 +1055,7 @@ IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZFLXZ)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
END IF
!
! second part of total momentum flux
@@ -1320,7 +1319,7 @@ IF ( OTURB_FLX .AND. OCLOSE_OUT .AND. HTURBDIM == '1DIM') THEN
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
!$acc update self(ZFLXZ)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZFLXZ)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
END IF
!
!----------------------------------------------------------------------------
diff --git a/src/MNH/turb_ver_sv_flux.f90 b/src/MNH/turb_ver_sv_flux.f90
index f6fa4af5cf340fd3e40225b809188c317d583a74..841371a5460d0be73f463e6876a64828a54b8126 100644
--- a/src/MNH/turb_ver_sv_flux.f90
+++ b/src/MNH/turb_ver_sv_flux.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ####################
@@ -21,7 +21,7 @@ INTERFACE
PTKEM,PLM,PPSI_SV, &
PRSVS,PWSV )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KKA !near ground array index
INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
@@ -269,14 +269,14 @@ END MODULE MODI_TURB_VER_SV_FLUX
!
USE MODD_CST
USE MODD_CTURB
-USE MODD_IO_ll, ONLY: TFILEDATA
+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_NSV, ONLY: XSVMIN, NSV_LGBEG, NSV_LGEND
USE MODD_BLOWSNOW
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPEREAL
-USE MODE_FMWRIT
+USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
!
USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
@@ -472,7 +472,7 @@ DO JSV=1,ISV
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
!
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZFLXZ)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
END IF
!
! Storage in the LES configuration
diff --git a/src/MNH/turb_ver_thermo_corr.f90 b/src/MNH/turb_ver_thermo_corr.f90
index 221d78aa53f5b4ca6a8030461d69b5ee31b2da94..b1059b576354e547326aec8a6cfcce5e2cce41e9 100644
--- a/src/MNH/turb_ver_thermo_corr.f90
+++ b/src/MNH/turb_ver_thermo_corr.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 @@ INTERFACE
PFWTH,PFWR,PFTH2,PFR2,PFTHR, &
PTHLP,PRP,PSIGS )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KKA !near ground array index
INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
@@ -325,7 +325,7 @@ END MODULE MODI_TURB_VER_THERMO_CORR
!
USE MODD_CST
USE MODD_CTURB
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_CONF
USE MODD_LES
@@ -340,10 +340,10 @@ USE MODI_SHUMAN
USE MODI_SHUMAN_DEVICE
#endif
USE MODI_TRIDIAG
-USE MODE_FMWRIT
USE MODI_LES_MEAN_SUBGRID
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_PRANDTL
!
USE MODI_SECOND_MNH
@@ -750,7 +750,7 @@ END IF
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
!$acc update self(ZFLXZ)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZFLXZ)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
END IF
!
! and we store in LES configuration
@@ -1067,7 +1067,7 @@ END IF
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
!$acc update self(ZFLXZ)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZFLXZ)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
END IF
!
! and we store in LES configuration
@@ -1349,7 +1349,7 @@ END IF
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
!$acc update self(ZFLXZ)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZFLXZ)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
END IF
!
! and we store in LES configuration
diff --git a/src/MNH/turb_ver_thermo_flux.f90 b/src/MNH/turb_ver_thermo_flux.f90
index 2ebe8030987ca123da1b6a9a72677b08da86f873..f910e5cdf6d824fa466bd1c92e04c0178cabe8de 100644
--- a/src/MNH/turb_ver_thermo_flux.f90
+++ b/src/MNH/turb_ver_thermo_flux.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ####################
@@ -26,7 +26,7 @@ INTERFACE
PFWTH,PFWR,PFTH2,PFR2,PFTHR,PBL_DEPTH, &
PWTHV,PRTHLS,PRRS,PTHLP,PRP,PTP,PWTH,PWRC )
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KKA !near ground array index
INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
@@ -344,7 +344,7 @@ END MODULE MODI_TURB_VER_THERMO_FLUX
!
USE MODD_CST
USE MODD_CTURB
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_CONF
USE MODD_LES
@@ -359,12 +359,12 @@ USE MODI_SHUMAN
USE MODI_SHUMAN_DEVICE
#endif
USE MODI_TRIDIAG
-USE MODE_FMWRIT
USE MODI_LES_MEAN_SUBGRID
USE MODI_TRIDIAG_THERMO
USE MODI_TM06_H
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_PRANDTL
!
USE MODI_SECOND_MNH
@@ -767,7 +767,7 @@ IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZFLXZ)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
END IF
!
! Contribution of the conservative temperature flux to the buoyancy flux
@@ -1169,7 +1169,7 @@ IF (KRR /= 0) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZFLXZ)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
END IF
!
! Contribution of the conservative water flux to the Buoyancy flux
@@ -1376,7 +1376,7 @@ IF ( ((OTURB_FLX .AND. OCLOSE_OUT) .OR. LLES_CALL) .AND. (KRRL > 0) ) THEN
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
!$acc update self(ZFLXZ)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZFLXZ)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
END IF
!
! and we store in LES configuration this subgrid flux <w'rc'>
diff --git a/src/MNH/two_wayn.f90 b/src/MNH/two_wayn.f90
index ff6e46c091d5e44627998416fde2fba7de6018a4..62f7596c7c77eb388a070c87d364bbc5e63a1331 100644
--- a/src/MNH/two_wayn.f90
+++ b/src/MNH/two_wayn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1997-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ###################
@@ -112,7 +112,8 @@ END MODULE MODI_TWO_WAY_n
!! Bosseur & Filippi 07/2013 Adds Forefire
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 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 29/03/2019: bugfix: use correct sizes for 3rd dimension in allocation and loops when CRAD/='NONE'
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -950,9 +951,10 @@ IF (LINTER) THEN
ALLOCATE(ZSCAFLASWD(IXOR:IXEND,IYOR:IYEND, SIZE(PSCAFLASWD, 3)))
ALLOCATE(ZDIRSRFSWD(IXOR:IXEND,IYOR:IYEND, SIZE(PDIRSRFSWD, 3)))
ELSE
- ALLOCATE(ZDIRFLASWD(0,0,0))
- ALLOCATE(ZSCAFLASWD(0,0,0))
- ALLOCATE(ZDIRSRFSWD(0,0,0))
+ !3rd dimension size can also be allocated with a zero size
+ ALLOCATE( ZDIRFLASWD(0, 0, SIZE( PDIRFLASWD, 3 )) )
+ ALLOCATE( ZSCAFLASWD(0, 0, SIZE( PSCAFLASWD, 3 )) )
+ ALLOCATE( ZDIRSRFSWD(0, 0, SIZE( PDIRSRFSWD, 3 )) )
ENDIF
ELSE
ALLOCATE(ZUM(0,0,0))
@@ -971,9 +973,11 @@ ELSE
ALLOCATE(ZINPRH(0,0))
ALLOCATE(ZPRCONV(0,0))
ALLOCATE(ZPRSCONV(0,0))
- ALLOCATE(ZDIRFLASWD(0,0,0))
- ALLOCATE(ZSCAFLASWD(0,0,0))
- ALLOCATE(ZDIRSRFSWD(0,0,0))
+ !3rd dimension of ZDIRFLASWD, ZSCAFLASWD and ZDIRSRFSWD is allocated with a not necessarily zero size
+ !because it needs to be to this size for the SET_LSFIELD_2WAY_ll loops if CRAD/='NONE'
+ ALLOCATE( ZDIRFLASWD(0, 0, SIZE( PDIRFLASWD, 3 )) )
+ ALLOCATE( ZSCAFLASWD(0, 0, SIZE( PSCAFLASWD, 3 )) )
+ ALLOCATE( ZDIRSRFSWD(0, 0, SIZE( PDIRSRFSWD, 3 )) )
ENDIF
!
! Initialize the list for the forcing
@@ -1011,11 +1015,15 @@ IF (CDCONV /= 'NONE') THEN
CALL SET_LSFIELD_2WAY_ll(ZPRSCONV , ZTPRSCONV)
END IF
IF (CRAD /= 'NONE') THEN
- DO JVAR=1,SIZE( PDIRFLASWD,3)
- CALL SET_LSFIELD_2WAY_ll(ZDIRFLASWD(:,:,JVAR) , ZTDIRFLASWD(:,:,JVAR))
- CALL SET_LSFIELD_2WAY_ll(ZSCAFLASWD(:,:,JVAR) , ZTSCAFLASWD(:,:,JVAR))
- CALL SET_LSFIELD_2WAY_ll(ZDIRSRFSWD(:,:,JVAR) , ZTDIRSRFSWD(:,:,JVAR))
- ENDDO
+ DO JVAR = 1, SIZE( PDIRFLASWD, 3 )
+ CALL SET_LSFIELD_2WAY_ll(ZDIRFLASWD(:,:,JVAR) , ZTDIRFLASWD(:,:,JVAR))
+ END DO
+ DO JVAR = 1, SIZE( PSCAFLASWD, 3 )
+ CALL SET_LSFIELD_2WAY_ll(ZSCAFLASWD(:,:,JVAR) , ZTSCAFLASWD(:,:,JVAR))
+ END DO
+ DO JVAR = 1, SIZE( PDIRSRFSWD, 3 )
+ CALL SET_LSFIELD_2WAY_ll(ZDIRSRFSWD(:,:,JVAR) , ZTDIRSRFSWD(:,:,JVAR))
+ END DO
END IF
CALL SET_LSFIELD_2WAY_ll(ZRHODJ, ZTRHODJ)
CALL SET_LSFIELD_2WAY_ll(ZRHODJU, ZTRHODJU)
diff --git a/src/MNH/update_nsv.f90 b/src/MNH/update_nsv.f90
index 0677a414a46cbded8d51314faa2b24d5ab35f780..3d691aa48dabfe34ea208d0107de0cf630208887 100644
--- a/src/MNH/update_nsv.f90
+++ b/src/MNH/update_nsv.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
! ######spl
MODULE MODI_UPDATE_NSV
! ######################
@@ -24,17 +25,20 @@ END MODULE MODI_UPDATE_NSV
!! Modify (Escobar ) 2/2014 : add Forefire var
!! 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
+!
USE MODD_CONF, ONLY : NVERB
USE MODD_NSV
+
+use mode_msg
+
IMPLICIT NONE
+
INTEGER, INTENT(IN) :: KMI ! Model index
!
! STOP if INI_NSV has not be called yet
IF (.NOT. LINI_NSV) THEN
- PRINT *, 'UPDATE_NSV FATAL Error : can t continue because INI_NSV was not called.'
-!callabortstop
- CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'UPDATE_NSV', 'can not continue because INI_NSV was not called' )
END IF
!
! Update the NSV_* variables from original NSV_*_A arrays
diff --git a/src/MNH/updraft_sope.f90 b/src/MNH/updraft_sope.f90
deleted file mode 100644
index 141eef53ba470547b024926ddd0187ba1e7bb8b7..0000000000000000000000000000000000000000
--- a/src/MNH/updraft_sope.f90
+++ /dev/null
@@ -1,148 +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 MODI_UPDRAFT_SOPE
-! #################################
-!
-INTERFACE
-!
- SUBROUTINE UPDRAFT_SOPE(KRR,KRRL,KRRI,OMIXUV, &
- PZZ,PDZZ,PSFTH,PSFRV,PPABSM,PRHODREF, &
- PTKEM,PTHM,PRM,PTHLM,PRTM,PUM,PVM,PSVM, &
- PTHL_UP,PRT_UP,PRV_UP,PU_UP,PV_UP,PSV_UP, &
- PRC_UP,PRI_UP,PTHV_UP,PW_UP,PFRAC_UP,PEMF,&
- PDETR,PENTR,KKLCL,KKETL,KKCTL )
-!
-!
-!
-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) :: OMIXUV ! True if mixing of momentum
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height at the flux point
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! depth between mass levels
-
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTH,PSFRV
- ! normal surface fluxes of theta,rv
-!
-! prognostic variables at t- deltat
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Pressure at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! dry density of the
- ! reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM ! momentum
-!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! Scalar variables
-!
-! thermodynamical variables which are transformed in conservative var.
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! pot. temp. = PTHLM in turb.f90
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! water species
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM,PRTM !cons. var.
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRV_UP,PRC_UP,PRI_UP,&!Thl,Rt,Rv,Rc,Ri
- PW_UP,PFRAC_UP,PEMF, &!w,Updraft Fraction, Mass Flux
- PDETR,PENTR,PTHV_UP, &!entrainment, detrainment, ThV
- PU_UP, PV_UP !updraft wind component
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PSV_UP ! updraft scalar variables
-INTEGER, DIMENSION(:,:), INTENT(OUT) :: KKLCL,KKETL,KKCTL !index for LCL,ETL,CTL
-!
-!
-END SUBROUTINE UPDRAFT_SOPE
-
-END INTERFACE
-!
-END MODULE MODI_UPDRAFT_SOPE
-!
-!
-! #################################################################
- SUBROUTINE UPDRAFT_SOPE(KRR,KRRL,KRRI,OMIXUV, &
- PZZ,PDZZ,PSFTH,PSFRV,PPABSM,PRHODREF, &
- PTKEM,PTHM,PRM,PTHLM,PRTM,PUM,PVM,PSVM, &
- PTHL_UP,PRT_UP,PRV_UP,PU_UP,PV_UP,PSV_UP, &
- PRC_UP,PRI_UP,PTHV_UP,PW_UP,PFRAC_UP,PEMF, &
- PDETR,PENTR,KKLCL,KKETL,KKCTL )
-! #################################################################
-!!
-!!**** *UPDRAFT_SOPE* - Interfacing routine
-!!
-!! PURPOSE
-!! -------
-!!**** Reshape arrays before updraft computations
-!!
-!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! !! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! J.Pergaud
-!! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS
-USE MODD_CST
-USE MODD_CONF
-USE MODD_NSV
-
-USE MODI_COMPUTE_UPDRAFT
-
-IMPLICIT NONE
-
-!* 1.1 Declaration of Arguments
-!
-!
-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) :: OMIXUV ! True if mixing of momentum
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height at the flux point
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! depth between mass levels
-
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTH,PSFRV
- ! normal surface fluxes of theta,rv
-!
-! prognostic variables at t- deltat
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Pressure at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! dry density of the
- ! reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM ! momentum
-
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! Scalar variables
-!
-! thermodynamical variables which are transformed in conservative var.
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! pot. temp. = PTHLM in turb.f90
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! water species
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM,PRTM !cons. var.
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRV_UP,PRC_UP,PRI_UP,&!Thl,Rt,Rv,Rc,Ri
- PW_UP,PFRAC_UP,PEMF, &!w,Updraft Fraction, Mass Flux
- PDETR,PENTR,PTHV_UP, &!entrainment, detrainment, ThV
- PU_UP, PV_UP !updraft wind component
-
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PSV_UP ! updraft scalar variables
-
-INTEGER, DIMENSION(:,:), INTENT(OUT) :: KKLCL,KKETL,KKCTL !index for LCL,ETL,CTL
-!
-!
-!
-
-END SUBROUTINE UPDRAFT_SOPE
-
diff --git a/src/MNH/uv_to_zonal_and_merid.f90 b/src/MNH/uv_to_zonal_and_merid.f90
index c78aa754a9c1775d62f5e538eda66c364d84148d..1403691bc4aa5fb2508a579179af35330f8f383c 100644
--- a/src/MNH/uv_to_zonal_and_merid.f90
+++ b/src/MNH/uv_to_zonal_and_merid.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2000-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-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.
!-----------------------------------------------------------------
! #################################
@@ -9,7 +9,7 @@
INTERFACE UV_TO_ZONAL_AND_MERID
SUBROUTINE UV_TO_ZONAL_AND_MERID3D(PU,PV,KGRID,PZC,PMC,TPFILE,TZFIELDS)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODE_FIELD, ONLY: TFIELDDATA
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PU ! Input U component
@@ -24,7 +24,7 @@ END SUBROUTINE UV_TO_ZONAL_AND_MERID3D
!
SUBROUTINE UV_TO_ZONAL_AND_MERID2D(PU,PV,KGRID,PZC,PMC,TPFILE,TZFIELDS)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODE_FIELD, ONLY: TFIELDDATA
!
REAL, DIMENSION(:,:), INTENT(IN) :: PU ! Input U component
@@ -47,7 +47,7 @@ INTERFACE
!
SUBROUTINE UV_TO_ZONAL_AND_MERID3D(PU,PV,KGRID,PZC,PMC,TPFILE,TZFIELDS)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODE_FIELD, ONLY: TFIELDDATA
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PU ! Input U component
@@ -105,12 +105,12 @@ USE MODD_CST
USE MODD_DIM_n
USE MODD_GRID
USE MODD_GRID_n
-USE MODD_IO_ll, ONLY: TFILEDATA,NVERB_ERROR,NVERB_INFO,NVERB_WARNING
-USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_PARAMETERS
!
-USE MODE_FIELD, ONLY: TFIELDDATA
-USE MODE_FMWRIT
+USE MODE_FIELD, ONLY: TFIELDDATA
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_MSG
!
USE MODI_SHUMAN
@@ -220,8 +220,8 @@ IF(PRESENT(TPFILE)) THEN
CALL PRINT_MSG(NVERB_WARNING,'IO','UV_TO_ZONAL_AND_MERID3D','inconsistent values for TZFIELDS(x)%HDIR')
END IF
!
- CALL IO_WRITE_FIELD(TPFILE,TZFIELDS(1),ZZC(:,:,:))
- CALL IO_WRITE_FIELD(TPFILE,TZFIELDS(2),ZMC(:,:,:))
+ CALL IO_Field_write(TPFILE,TZFIELDS(1),ZZC(:,:,:))
+ CALL IO_Field_write(TPFILE,TZFIELDS(2),ZMC(:,:,:))
ELSE IF (PRESENT(PZC).AND.PRESENT(PMC)) THEN
PZC(:,:,:)=ZZC(:,:,:)
PMC(:,:,:)=ZMC(:,:,:)
@@ -276,11 +276,11 @@ END SUBROUTINE UV_TO_ZONAL_AND_MERID3D
!* 0. DECLARATIONS
! ------------
!
-USE MODD_IO_ll, ONLY: TFILEDATA,NVERB_WARNING
-USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_IO, ONLY: TFILEDATA, NVERB_WARNING
+USE MODD_LUNIT_n, ONLY: TLUOUT
!
-USE MODE_FIELD, ONLY: TFIELDDATA
-USE MODE_FMWRIT
+USE MODE_FIELD, ONLY: TFIELDDATA
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_MSG
!
USE MODI_UV_TO_ZONAL_AND_MERID3D
@@ -332,8 +332,8 @@ IF(PRESENT(TPFILE)) THEN
CALL PRINT_MSG(NVERB_WARNING,'IO','UV_TO_ZONAL_AND_MERID2D','inconsistent values for TZFIELDS(x)%HDIR')
END IF
!
- CALL IO_WRITE_FIELD(TPFILE,TZFIELDS(1),ZZC3D(:,:,1))
- CALL IO_WRITE_FIELD(TPFILE,TZFIELDS(2),ZMC3D(:,:,1))
+ CALL IO_Field_write(TPFILE,TZFIELDS(1),ZZC3D(:,:,1))
+ CALL IO_Field_write(TPFILE,TZFIELDS(2),ZMC3D(:,:,1))
ELSE IF (PRESENT(PZC).AND.PRESENT(PMC)) THEN
PZC(:,:)=ZZC3D(:,:,1)
PMC(:,:)=ZMC3D(:,:,1)
diff --git a/src/MNH/ver_dyn.f90 b/src/MNH/ver_dyn.f90
index 5b6911d3eeccba0f8db3a2c386786858074ae759..009e8bd33abd589b5039ba81f1ad81dcc1ca5d51 100644
--- a/src/MNH/ver_dyn.f90
+++ b/src/MNH/ver_dyn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ###################
@@ -87,7 +87,7 @@ END MODULE MODI_VER_DYN
!! ------------------
!!
!! Module MODD_LUNIT : contains logical unit names for all models
-!! CLUOUT0 : name of output-listing
+!! TLUOUT0 : name of output-listing
!! Module MODD_FIELD1 : contains prognostics variables
!! XUM : U (:,:,:) at t-dt
!! XVM : V (:,:,:,:) at t-dt
@@ -383,7 +383,7 @@ END IF
!
!20131126 add check on XWM,XLSWM
CALL MPPDB_CHECK3D(XWT,"VER_DYN5::XWT",PRECISION)
-CALL MPPDB_CHECK3D(XLSWM,"VER_DYN5::XLSWM",PRECISION)
+! CALL MPPDB_CHECK3D(XLSWM,"VER_DYN5::XLSWM",PRECISION)
!
DEALLOCATE(NKLIN)
DEALLOCATE(XCOEFLIN)
diff --git a/src/MNH/ver_int_dyn.f90 b/src/MNH/ver_int_dyn.f90
index 4a564f41069ecef8cf9f71b004f57e656cff50f4..1065cdc10a890b91b3cdee4f2164fc58bcc768b4 100644
--- a/src/MNH/ver_int_dyn.f90
+++ b/src/MNH/ver_int_dyn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ######spl
@@ -70,7 +70,7 @@ END MODULE MODI_VER_INT_DYN
!! 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
-!! CLUOUT0 : name of output-listing
+!! TLUOUT0 : name of output-listing
!! Module MODD_GRID1 : contains grid variables for model1
!! XZS : orography of MESO-NH
!! XZZ : altitude of the w points in the MESO-NH grid.
diff --git a/src/MNH/ver_int_thermo.f90 b/src/MNH/ver_int_thermo.f90
index cb815488f7f73331d28de0250f7f9ab920b9b744..0463f3006389a1eb7e2022e1b07b647026303091 100644
--- a/src/MNH/ver_int_thermo.f90
+++ b/src/MNH/ver_int_thermo.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
PPMHP_MX,PEXNTOP2D,PTHV,PR,PPMHP,PDIAG, &
PLSTH_MX, PLSRV_MX, PLSTHM, PLSRVM )
!
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File characteristics
LOGICAL, INTENT(IN) :: OSHIFT ! T: vertical shift of BL (used for GRIB file data)
@@ -100,7 +100,7 @@ END MODULE MODI_VER_INT_THERMO
!! Module MODD_CONF1
!! NRR
!! Module MODD_LUNIT : contains logical unit names for all models
-!! CLUOUT0 : name of output-listing
+!! TLUOUT0 : name of output-listing
!! Module MODD_GRID1 : contains grid variables for model1
!! XZS : orography of MESO-NH
!! XZZ : altitude of the w points in the MESO-NH grid.
@@ -134,6 +134,7 @@ END MODULE MODI_VER_INT_THERMO
!! 08/2015 (M.Moge) add UPDATE_HALO_ll(PR(:,:,:,1)) in part 6.3
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! 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)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -144,8 +145,8 @@ USE MODD_CONF
USE MODD_CONF_n
USE MODD_CST
USE MODD_GRID_n
-USE MODD_IO_ll, ONLY: TFILEDATA
-USE MODD_LUNIT, ONLY: CLUOUT0, TLUOUT0
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT, ONLY: TLUOUT0
USE MODD_PARAMETERS
USE MODD_VER_INTERP_LIN
!
@@ -589,13 +590,13 @@ IF (NVERB>=1) THEN
WRITE(ILUOUT0,*) ' '
WRITE(ILUOUT0,*) 'Altitude and humidity on shifted grid (I=',IIJ(1),';J=',IIJ(2),')'
DO JK=IKB,IKE
- WRITE(ILUOUT0,'(6Hlevel ,F6.0,5H m : ,F6.2,2H %)') ZZMASS_SH(IIJ(1),IIJ(2),JK),ZHU_SH(IIJ(1),IIJ(2),JK)
+ WRITE(ILUOUT0,'( "level ", F6.0, " m : ", F6.2, " %" )') ZZMASS_SH(IIJ(1),IIJ(2),JK),ZHU_SH(IIJ(1),IIJ(2),JK)
END DO
!
WRITE(ILUOUT0,*) ' '
WRITE(ILUOUT0,*) 'Altitude and humidity on MESO-NH grid (I=',IIJ(1),';J=',IIJ(2),')'
DO JK=IKB,IKE
- WRITE(ILUOUT0,'(6Hlevel ,F6.0,5H m : ,F6.2,2H %)') ZZMASS (IIJ(1),IIJ(2),JK),ZHU (IIJ(1),IIJ(2),JK)
+ WRITE(ILUOUT0,'( "level ", F6.0, " m : ", F6.2, " %" )') ZZMASS (IIJ(1),IIJ(2),JK),ZHU (IIJ(1),IIJ(2),JK)
END DO
END IF
!
diff --git a/src/MNH/ver_interp_to_mixed_grid.f90 b/src/MNH/ver_interp_to_mixed_grid.f90
index 7325b1acd54d78e49b3676a7dfa1d08367bede77..dd63ee4930a93e915281f554d08de0426983dcd1 100644
--- a/src/MNH/ver_interp_to_mixed_grid.f90
+++ b/src/MNH/ver_interp_to_mixed_grid.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ####################################
@@ -109,7 +109,7 @@ END MODULE MODI_VER_INTERP_TO_MIXED_GRID
!! Module MODD_CONF1
!! NRR
!! Module MODD_LUNIT : contains logical unit names for all models
-!! CLUOUT0 : name of output-listing
+!! TLUOUT0 : name of output-listing
!! Module MODD_CST : contains physical constants
!! XRD : gas constant for dry air
!! XRV : gas constant for vapor
@@ -160,14 +160,13 @@ END MODULE MODI_VER_INTERP_TO_MIXED_GRID
!! 2014 (M.Faivre)
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! 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)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODE_THERMO
-USE MODE_FM
-USE MODE_IO_ll
!
USE MODI_COEF_VER_INTERP_LIN
USE MODI_VER_INTERP_LIN
@@ -450,13 +449,13 @@ ZCOUNT = FLOAT((IIE-IIB+1)*(IJE-IJB+1))
WRITE(ILUOUT0,*) ' '
WRITE(ILUOUT0,*) 'Altitude and humidity on large-scale grid (I=',IIJ(1),';J=',IIJ(2),')'
DO JK=1,ILU
- WRITE(ILUOUT0,'(6Hlevel ,F6.0,5H m : ,F6.2,2H %)') PZMASS_LS(IIJ(1),IIJ(2),JK),PHU_LS(IIJ(1),IIJ(2),JK)
+ WRITE(ILUOUT0,'( "level ", F6.0, " m : ", F6.2, " %" )') PZMASS_LS(IIJ(1),IIJ(2),JK),PHU_LS(IIJ(1),IIJ(2),JK)
END DO
!
WRITE(ILUOUT0,*) ' '
WRITE(ILUOUT0,*) 'Altitude and humidity on mixed grid (I=',IIJ(1),';J=',IIJ(2),')'
DO JK=JPVEXT+1,IKE
- WRITE(ILUOUT0,'(6Hlevel ,F6.0,5H m : ,F6.2,2H %)') XZMASS_MX(IIJ(1),IIJ(2),JK),ZHU_MX(IIJ(1),IIJ(2),JK)
+ WRITE(ILUOUT0,'( "level ", F6.0, " m : ", F6.2, " %" )') XZMASS_MX(IIJ(1),IIJ(2),JK),ZHU_MX(IIJ(1),IIJ(2),JK)
END DO
END IF
!
diff --git a/src/MNH/ver_prep_gribex_case.f90 b/src/MNH/ver_prep_gribex_case.f90
index 4368fc4c10aabfd7cfdaa393f936683276450f38..1c6ea2b2af6033a4dc355ca8f44fb22be3ae1cb5 100644
--- a/src/MNH/ver_prep_gribex_case.f90
+++ b/src/MNH/ver_prep_gribex_case.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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_real 2006/05/23 14:49:51
-!-----------------------------------------------------------------
! ################################
MODULE MODI_VER_PREP_GRIBEX_CASE
! ################################
@@ -52,7 +47,7 @@ END MODULE MODI_VER_PREP_GRIBEX_CASE
!! Module MODD_CONF1 : contains configuration variables for all models.
!! NVERB : verbosity level for output-listing
!! Module MODD_LUNIT : contains logical unit names for all models
-!! CLUOUT0 : name of output-listing
+!! TLUOUT0 : name of output-listing
!! Module MODD_CST : contains physical constants
!! XRD : gas constant for dry air
!! XRV : gas constant for vapor
diff --git a/src/MNH/ver_prep_netcdf_case.f90 b/src/MNH/ver_prep_netcdf_case.f90
index df0f3b7fcbb7538ceaf6b066df7a1e2c28244443..c17a1c963ebd775319412d8f7a485a27625b09d4 100644
--- a/src/MNH/ver_prep_netcdf_case.f90
+++ b/src/MNH/ver_prep_netcdf_case.f90
@@ -84,6 +84,7 @@ END MODULE MODI_VER_PREP_NETCDF_CASE
!! May 2006 Remove EPS
!! Oct 2017 (J.Escobar) minor, missing USE MODI_SECOND_MNH
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! Mars 2019 (Q. Rodier): missing SECOND_MNH(ZTIME1)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -141,6 +142,7 @@ INTEGER :: JK ! loop counter
!-------------------------------------------------------------------------------
!
ILUOUT0 = TLUOUT0%NLU
+CALL SECOND_MNH(ZTIME1)
!
!* 1. CHANGING OF VARIABLES
! ---------------------
@@ -190,7 +192,7 @@ DEALLOCATE(ZSV_LS)
!* 3. ERROR CONTROL
! -------------
!
-CALL SECOND_MNH(ZTIME1)
+CALL SECOND_MNH(ZTIME2)
PDIAG = ZTIME2 - ZTIME1
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/ver_thermo.f90 b/src/MNH/ver_thermo.f90
index 1a13b3ad198633c5a48f9c2d2cf002093702cf67..25f46514d304aa77598eea6b7e3fdf070aea5109 100644
--- a/src/MNH/ver_thermo.f90
+++ b/src/MNH/ver_thermo.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
PDXX,PDYY,PEXNTOP2D,PPSURF,PDIAG, &
PLSTH_MX,PLSRV_MX )
!
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File characteristics
LOGICAL, INTENT(IN) :: OSHIFT ! T: vertical shift of BL (used for GRIB file data)
@@ -94,7 +94,7 @@ END MODULE MODI_VER_THERMO
!! Module MODD_CONF1 : contains configuration variables for model 1.
!! NRR : number of moist variables
!! Module MODD_LUNIT : contains logical unit names for all models
-!! CLUOUT0 : name of output-listing
+!! TLUOUT0 : name of output-listing
!! Module MODD_CST : contains physical constants
!! XRD : gas constant for dry air
!! XRV : gas constant for vapor
@@ -153,25 +153,24 @@ END MODULE MODI_VER_THERMO
!* 0. DECLARATIONS
! ------------
!
-USE MODD_ARGSLIST_ll, ONLY: LIST_ll
+USE MODD_ARGSLIST_ll, ONLY: LIST_ll
USE MODD_CONF
USE MODD_CONF_n
USE MODD_CST
USE MODD_DYN_n
-USE MODD_FIELD_n, ONLY: XTHT,XRT,XPABST,XDRYMASST
+USE MODD_FIELD_n, ONLY: XTHT,XRT,XPABST,XDRYMASST
USE MODD_GRID_n
-USE MODD_IO_ll, ONLY: TFILEDATA,TFILE_DUMMY
+USE MODD_IO, ONLY: TFILEDATA,TFILE_DUMMY
USE MODD_LBC_n
USE MODD_LSFIELD_n
-USE MODD_LUNIT, ONLY: CLUOUT0,TLUOUT0
-USE MODD_LUNIT_n, ONLY: CLUOUT
+USE MODD_LUNIT, ONLY: TLUOUT0
USE MODD_PARAMETERS
USE MODD_REF_n
!
USE MODD_DIM_n
USE MODE_EXTRAPOL
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPEREAL
-USE MODE_FMWRIT
+USE MODE_FIELD, ONLY: TFIELDDATA,TYPEREAL
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_ll
USE MODE_MPPDB
!
@@ -305,7 +304,7 @@ IF (NVERB>=10) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZTHV)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZTHV)
END IF
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/viscosity.f90 b/src/MNH/viscosity.f90
index 5d822248a7121c7e01e01fef0f5ca28a00bf4209..f047a5405a3a638958afbd3f21e42fb770188a10 100644
--- a/src/MNH/viscosity.f90
+++ b/src/MNH/viscosity.f90
@@ -1,8 +1,9 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-!
+!-----------------------------------------------------------------
+!
! #####################
MODULE MODI_VISCOSITY
! #####################
@@ -103,7 +104,6 @@ SUBROUTINE VISCOSITY(HLBCX, HLBCY, KRR, KSV, PNU, PPRANDTL, &
USE MODD_BUDGET
USE MODE_ll
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
- USE MODE_FM
USE MODI_BUDGET
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/write_aircraft_balloon.f90 b/src/MNH/write_aircraft_balloon.f90
index b9cd28388de27506234212a38328f53fd73c7f19..3e4e7370ef4ba9607708e8888524e41d59e5243f 100644
--- a/src/MNH/write_aircraft_balloon.f90
+++ b/src/MNH/write_aircraft_balloon.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2000-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-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.
!-----------------------------------------------------------------
! ###########################
@@ -11,7 +11,7 @@ INTERFACE
!
SUBROUTINE WRITE_AIRCRAFT_BALLOON(TPDIAFILE)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! file to write
!
@@ -63,14 +63,15 @@ END MODULE MODI_WRITE_AIRCRAFT_BALLOON
!! 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)
!!
!! --------------------------------------------------------------------------
-!
+!
!* 0. DECLARATIONS
! ------------
!
USE MODD_CST
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT
USE MODD_PARAMETERS
!
@@ -210,12 +211,12 @@ INTEGER :: JLOOP
!
!----------------------------------------------------------------------------
!
-IKU = SIZE(TPFLYER%RTZ,2) !number of vertical levels
IF (TPFLYER%NMODEL==0) RETURN
IF (ALL(TPFLYER%X==XUNDEF)) RETURN
IF (COUNT(TPFLYER%X/=XUNDEF)<=1) RETURN
IF ( IMI /= TPFLYER%NMODEL ) RETURN
!
+IKU = SIZE(TPFLYER%RTZ,2) !number of vertical levels
!
IPROC = 20 + SIZE(TPFLYER%R,2) + SIZE(TPFLYER%SV,2) &
+ 2 + SIZE(TPFLYER%SVW_FLUX,2)
diff --git a/src/MNH/write_balloonn.f90 b/src/MNH/write_balloonn.f90
index 3bfb6091a8f7ad4f0aa4fb62e0524d2ecb307f50..c1d82c1b2378f84d968575a363c334a81ee306a0 100644
--- a/src/MNH/write_balloonn.f90
+++ b/src/MNH/write_balloonn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2001-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2001-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.
!-----------------------------------------------------------------
! ###########################
@@ -10,7 +10,7 @@
INTERFACE
!
SUBROUTINE WRITE_BALLOON_n(TPFILE)
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
IMPLICIT NONE
!
@@ -64,8 +64,8 @@ END MODULE MODI_WRITE_BALLOON_n
! ------------
!
USE MODD_AIRCRAFT_BALLOON
-USE MODD_GRID, ONLY: XLONORI,XLATORI
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_GRID, ONLY: XLONORI, XLATORI
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT_n
!
USE MODE_GRIDPROJ
@@ -96,8 +96,8 @@ CONTAINS
!-------------------------------------------------------------------------------
SUBROUTINE WRITE_LFI_BALLOON(TPFLYER)
!
-USE MODE_FIELD, ONLY : TFIELDDATA, TYPEREAL
-USE MODE_FMWRIT
+USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
!
TYPE(FLYER), INTENT(IN) :: TPFLYER
!
@@ -123,7 +123,7 @@ TZFIELD%NGRID = 0
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .TRUE.
-CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZLAT)
+CALL IO_Field_write(TPFILE,TZFIELD,ZLAT)
!
TZFIELD%CMNHNAME = TRIM(TPFLYER%TITLE)//'LON'
TZFIELD%CSTDNAME = ''
@@ -135,7 +135,7 @@ TZFIELD%NGRID = 0
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .TRUE.
-CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZLON)
+CALL IO_Field_write(TPFILE,TZFIELD,ZLON)
!
TZFIELD%CMNHNAME = TRIM(TPFLYER%TITLE)//'ALT'
TZFIELD%CSTDNAME = ''
@@ -147,7 +147,7 @@ TZFIELD%NGRID = 0
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .TRUE.
-CALL IO_WRITE_FIELD(TPFILE,TZFIELD,TPFLYER%Z_CUR)
+CALL IO_Field_write(TPFILE,TZFIELD,TPFLYER%Z_CUR)
!
TZFIELD%CMNHNAME = TRIM(TPFLYER%TITLE)//'WASCENT'
TZFIELD%CSTDNAME = ''
@@ -159,7 +159,7 @@ TZFIELD%NGRID = 0
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .TRUE.
-CALL IO_WRITE_FIELD(TPFILE,TZFIELD,TPFLYER%WASCENT)
+CALL IO_Field_write(TPFILE,TZFIELD,TPFLYER%WASCENT)
!
TZFIELD%CMNHNAME = TRIM(TPFLYER%TITLE)//'RHO'
TZFIELD%CSTDNAME = ''
@@ -171,7 +171,7 @@ TZFIELD%NGRID = 0
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .TRUE.
-CALL IO_WRITE_FIELD(TPFILE,TZFIELD,TPFLYER%RHO)
+CALL IO_Field_write(TPFILE,TZFIELD,TPFLYER%RHO)
!
!
!
diff --git a/src/MNH/write_budget.f90 b/src/MNH/write_budget.f90
index c70ee075f93e523eaf2f078906ac0b58a0c41b3e..e24f6a3009250f1f268fe012cc47cad643d5603a 100644
--- a/src/MNH/write_budget.f90
+++ b/src/MNH/write_budget.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1995-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 WRITE_BUDGET(TPDIAFILE,TPDTCUR, &
TPDTMOD,PTSTEP, KSV)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_TYPE_DATE
!
TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! file to write
@@ -131,12 +131,12 @@ END MODULE MODI_WRITE_BUDGET
!* 0.
! ------------
USE MODD_BUDGET
-USE MODD_IO_ll, ONLY: TFILEDATA
-USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
!
USE MODE_DATETIME
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPEREAL
-USE MODE_FMWRIT
+USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_TIME
!
USE MODI_END_CART_COMPRESS
@@ -199,7 +199,7 @@ TZFIELD%NGRID = 0
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
-CALL IO_WRITE_FIELD(TPDIAFILE,TZFIELD,PTSTEP)
+CALL IO_Field_write(TPDIAFILE,TZFIELD,PTSTEP)
!
TZFIELD%CMNHNAME = 'BULEN'
TZFIELD%CSTDNAME = ''
@@ -211,7 +211,7 @@ TZFIELD%NGRID = 0
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
-CALL IO_WRITE_FIELD(TPDIAFILE,TZFIELD,XBULEN)
+CALL IO_Field_write(TPDIAFILE,TZFIELD,XBULEN)
!
!* 1.1 initialize NBUTSHIFT
! ---------------------
@@ -1031,7 +1031,7 @@ SELECT CASE (CBUTYPE)
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 6
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPDIAFILE,TZFIELD,ZWORKMASK(:,:,:,:,:,:))
+ CALL IO_Field_write(TPDIAFILE,TZFIELD,ZWORKMASK(:,:,:,:,:,:))
WRITE(YRECFM,FMT="('MASK_',I4.4)") NBUTSHIFT
CALL MENU_DIACHRO(TPDIAFILE,YRECFM)
DEALLOCATE(ZWORKMASK)
diff --git a/src/MNH/write_desfmn.f90 b/src/MNH/write_desfmn.f90
index 223153f59c195a6f5df469b0eb72ec364db1bc8e..fc96071c8c8ae39e628d89700febd2003da034a3 100644
--- a/src/MNH/write_desfmn.f90
+++ b/src/MNH/write_desfmn.f90
@@ -11,7 +11,7 @@ INTERFACE
!
SUBROUTINE WRITE_DESFM_n(KMI,TPDATAFILE)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KMI ! Model index
TYPE(TFILEDATA), INTENT(IN) :: TPDATAFILE ! Datafile
@@ -150,7 +150,7 @@ END MODULE MODI_WRITE_DESFM_n
! ------------
USE MODD_CONF
USE MODD_DYN_n, ONLY: LHORELAX_SVLIMA
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_PARAMETERS
!
diff --git a/src/MNH/write_diachro.f90 b/src/MNH/write_diachro.f90
index 544eda16f7747b1d6f6a6890a272a9113a344184..5e24bc549cb02cc744252b57a5ce0e58ce34f76c 100644
--- a/src/MNH/write_diachro.f90
+++ b/src/MNH/write_diachro.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1996-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #################################################################
@@ -75,13 +75,12 @@
!
USE MODD_BUDGET
USE MODD_CONF
-USE MODE_FIELD
-USE MODD_IO_ll, ONLY : TFILEDATA
-USE MODD_PARAMETERS, ONLY : JPHEXT
+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 MODE_FMWRIT
-USE MODE_IO_ll
!
USE MODI_MENU_DIACHRO
!
@@ -229,7 +228,7 @@ TZFIELD%NGRID = KGRID(1)
TZFIELD%NTYPE = TYPECHAR
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
-CALL IO_WRITE_FIELD(TPDIAFILE,TZFIELD,HTYPE)
+CALL IO_Field_write(TPDIAFILE,TZFIELD,HTYPE)
IF (NVERB>=5) THEN
WRITE(ILUOUTDIA,*)' 1st record (',TRIM(TZFIELD%CMNHNAME),'): OK'
@@ -273,7 +272,7 @@ SELECT CASE(HTYPE)
ITABCHAR(29)=IIMASK; ITABCHAR(30)=IJMASK
ITABCHAR(31)=IKMASK; ITABCHAR(32)=ITMASK
ITABCHAR(33)=INMASK; ITABCHAR(34)=IPMASK
- CALL IO_WRITE_FIELD(TPDIAFILE,TZFIELD,ITABCHAR)
+ CALL IO_Field_write(TPDIAFILE,TZFIELD,ITABCHAR)
DEALLOCATE(ITABCHAR)
IF (NVERB>=5) THEN
WRITE(ILUOUTDIA,*)' ILENTITRE,ILENUNITE,ILENCOMMENT ',ILENTITRE,ILENUNITE,ILENCOMMENT
@@ -294,7 +293,7 @@ SELECT CASE(HTYPE)
ITABCHAR(20)=IIMASK; ITABCHAR(21)=IJMASK
ITABCHAR(22)=IKMASK; ITABCHAR(23)=ITMASK
ITABCHAR(24)=INMASK; ITABCHAR(25)=IPMASK
- CALL IO_WRITE_FIELD(TPDIAFILE,TZFIELD,ITABCHAR)
+ CALL IO_Field_write(TPDIAFILE,TZFIELD,ITABCHAR)
DEALLOCATE(ITABCHAR)
END SELECT
IF (NVERB>=5) THEN
@@ -313,7 +312,7 @@ TZFIELD%NGRID = KGRID(1)
TZFIELD%NTYPE = TYPECHAR
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
-CALL IO_WRITE_FIELD(TPDIAFILE,TZFIELD,HTITRE(1:IP))
+CALL IO_Field_write(TPDIAFILE,TZFIELD,HTITRE(1:IP))
IF (NVERB>=5) THEN
WRITE(ILUOUTDIA,*)' 3rd record (',TRIM(TZFIELD%CMNHNAME),'): OK'
@@ -331,7 +330,7 @@ TZFIELD%NGRID = KGRID(1)
TZFIELD%NTYPE = TYPECHAR
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
-CALL IO_WRITE_FIELD(TPDIAFILE,TZFIELD,HUNITE(1:IP))
+CALL IO_Field_write(TPDIAFILE,TZFIELD,HUNITE(1:IP))
IF (NVERB>=5) THEN
WRITE(ILUOUTDIA,*)' 4th record (',TRIM(TZFIELD%CMNHNAME),'): OK'
@@ -349,7 +348,7 @@ TZFIELD%NGRID = KGRID(1)
TZFIELD%NTYPE = TYPECHAR
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
-CALL IO_WRITE_FIELD(TPDIAFILE,TZFIELD,HCOMMENT(1:IP))
+CALL IO_Field_write(TPDIAFILE,TZFIELD,HCOMMENT(1:IP))
IF (NVERB>=5) THEN
WRITE(ILUOUTDIA,*)' 5th record (',TRIM(TZFIELD%CMNHNAME),'): OK'
@@ -383,7 +382,7 @@ IF (PRESENT(OICP) .AND. PRESENT(OJCP)) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 5
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD_BOX(TPDIAFILE,TZFIELD,'BUDGET',PVAR(:,:,:,:,:,J), &
+ CALL IO_Field_write_BOX(TPDIAFILE,TZFIELD,'BUDGET',PVAR(:,:,:,:,:,J), &
KIL+JPHEXT,KIH+JPHEXT,KJL+JPHEXT,KJH+JPHEXT)
ELSE
TZFIELD%CMNHNAME = TRIM(HGROUP)//'.PROC'//YJ
@@ -396,7 +395,7 @@ IF (PRESENT(OICP) .AND. PRESENT(OJCP)) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 5
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPDIAFILE,TZFIELD,PVAR(:,:,:,:,:,J))
+ CALL IO_Field_write(TPDIAFILE,TZFIELD,PVAR(:,:,:,:,:,J))
ENDIF
ELSE
TZFIELD%CMNHNAME = TRIM(HGROUP)//'.PROC'//YJ
@@ -409,7 +408,7 @@ ELSE
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 5
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPDIAFILE,TZFIELD,PVAR(:,:,:,:,:,J))
+ CALL IO_Field_write(TPDIAFILE,TZFIELD,PVAR(:,:,:,:,:,J))
END IF
IF (NVERB>=5) THEN
WRITE(ILUOUTDIA,*)J,TRIM(TZFIELD%CMNHNAME)
@@ -431,7 +430,7 @@ TZFIELD%NGRID = KGRID(1)
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .FALSE.
-CALL IO_WRITE_FIELD(TPDIAFILE,TZFIELD,PTRAJT)
+CALL IO_Field_write(TPDIAFILE,TZFIELD,PTRAJT)
IF (NVERB>=5) THEN
WRITE(ILUOUTDIA,*)' 7th record (',TRIM(TZFIELD%CMNHNAME),'): OK'
@@ -453,7 +452,7 @@ IF(PRESENT(PTRAJX))THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPDIAFILE,TZFIELD,PTRAJX)
+ CALL IO_Field_write(TPDIAFILE,TZFIELD,PTRAJX)
ENDIF
!
! ou
@@ -469,7 +468,7 @@ IF(PRESENT(PMASK))THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 6
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPDIAFILE,TZFIELD,PMASK)
+ CALL IO_Field_write(TPDIAFILE,TZFIELD,PMASK)
ENDIF
!
! 9eme enregistrement TRAJY
@@ -485,7 +484,7 @@ IF(PRESENT(PTRAJY))THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPDIAFILE,TZFIELD,PTRAJY)
+ CALL IO_Field_write(TPDIAFILE,TZFIELD,PTRAJY)
ENDIF
!
! 10eme enregistrement TRAJZ
@@ -501,7 +500,7 @@ IF(PRESENT(PTRAJZ))THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPDIAFILE,TZFIELD,PTRAJZ)
+ CALL IO_Field_write(TPDIAFILE,TZFIELD,PTRAJZ)
ENDIF
!
! 11eme enregistrement PDATIME
@@ -516,7 +515,7 @@ TZFIELD%NGRID = KGRID(1)
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .FALSE.
-CALL IO_WRITE_FIELD(TPDIAFILE,TZFIELD,PDATIME)
+CALL IO_Field_write(TPDIAFILE,TZFIELD,PDATIME)
!
CALL MENU_DIACHRO(TPDIAFILE,HGROUP)
LPACK=GPACK
diff --git a/src/MNH/write_dummy_gr_fieldn.f90 b/src/MNH/write_dummy_gr_fieldn.f90
index 358a73cbcfc569de349d4c5e6306122b8aabceb2..e177c4e2ed84ac3182383366b0217d31db542ff0 100644
--- a/src/MNH/write_dummy_gr_fieldn.f90
+++ b/src/MNH/write_dummy_gr_fieldn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1996-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 WRITE_DUMMY_GR_FIELD_n(TPFILE)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File characteristics
!
@@ -61,13 +61,13 @@ END MODULE MODI_WRITE_DUMMY_GR_FIELD_n
!* 0. DECLARATIONS
! ------------
!
-USE MODD_DUMMY_GR_FIELD_n, ONLY : NDUMMY_GR_NBR, CDUMMY_GR_NAME, &
- CDUMMY_GR_AREA, XDUMMY_GR_FIELDS
-USE MODD_IO_ll, ONLY : TFILEDATA
-USE MODD_PARAMETERS, ONLY : NMNHNAMELGTMAX
+USE MODD_DUMMY_GR_FIELD_n, ONLY: NDUMMY_GR_NBR, CDUMMY_GR_NAME, &
+ CDUMMY_GR_AREA, XDUMMY_GR_FIELDS
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_PARAMETERS, ONLY: NMNHNAMELGTMAX
!
-USE MODE_FIELD, ONLY : TFIELDDATA,TYPEINT,TYPEREAL
-USE MODE_FMWRIT
+USE MODE_FIELD, ONLY: TFIELDDATA,TYPEINT,TYPEREAL
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
!
IMPLICIT NONE
!
@@ -114,7 +114,7 @@ TZFIELD%NGRID = 0
TZFIELD%NTYPE = TYPEINT
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
-CALL IO_WRITE_FIELD(TPFILE,TZFIELD,NDUMMY_GR_NBR)
+CALL IO_Field_write(TPFILE,TZFIELD,NDUMMY_GR_NBR)
!
DO JDUMMY=1,NDUMMY_GR_NBR
WRITE(YRECFM,'(A8,I3.3)') 'DUMMY_GR',JDUMMY
@@ -134,7 +134,7 @@ DO JDUMMY=1,NDUMMY_GR_NBR
!
ZWORK2D(:,:) = XDUMMY_GR_FIELDS(:,:,JDUMMY)
!
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK2D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK2D)
END DO
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/write_hgrid.f90 b/src/MNH/write_hgrid.f90
index 9315a86d13a7c30928e49a9f453c86dbc2fa1e4d..27b0c7d1aed8fc028ca84613ff54591517976327 100644
--- a/src/MNH/write_hgrid.f90
+++ b/src/MNH/write_hgrid.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1996-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 WRITE_HGRID(KMI,TPFILE)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KMI ! model index
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File to write
@@ -58,12 +58,11 @@ END MODULE MODI_WRITE_HGRID
USE MODD_CONF
USE MODD_CONF_n
USE MODD_GRID
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PGDDIM
USE MODD_PGDGRID
!
-USE MODE_FMWRIT
-USE MODE_IO_ll
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_MSG
!
USE MODI_WRITE_HGRIDn
@@ -94,20 +93,20 @@ END IF
!* 2. WRITING FROM MODD_PGD...
! ----------------------
!
-CALL IO_WRITE_FIELD(TPFILE,'LAT0', XLAT0)
-CALL IO_WRITE_FIELD(TPFILE,'LON0', XLON0)
-CALL IO_WRITE_FIELD(TPFILE,'RPK', XRPK)
-CALL IO_WRITE_FIELD(TPFILE,'BETA', XBETA)
-CALL IO_WRITE_FIELD(TPFILE,'LATORI',XPGDLATOR)
-CALL IO_WRITE_FIELD(TPFILE,'LONORI',XPGDLONOR)
-CALL IO_WRITE_FIELD(TPFILE,'IMAX', NPGDIMAX)
-CALL IO_WRITE_FIELD(TPFILE,'JMAX', NPGDJMAX)
-CALL IO_WRITE_FIELD(TPFILE,'XHAT', XPGDXHAT)
-CALL IO_WRITE_FIELD(TPFILE,'YHAT', XPGDYHAT)
+CALL IO_Field_write(TPFILE,'LAT0', XLAT0)
+CALL IO_Field_write(TPFILE,'LON0', XLON0)
+CALL IO_Field_write(TPFILE,'RPK', XRPK)
+CALL IO_Field_write(TPFILE,'BETA', XBETA)
+CALL IO_Field_write(TPFILE,'LATORI',XPGDLATOR)
+CALL IO_Field_write(TPFILE,'LONORI',XPGDLONOR)
+CALL IO_Field_write(TPFILE,'IMAX', NPGDIMAX)
+CALL IO_Field_write(TPFILE,'JMAX', NPGDJMAX)
+CALL IO_Field_write(TPFILE,'XHAT', XPGDXHAT)
+CALL IO_Field_write(TPFILE,'YHAT', XPGDYHAT)
!
IF (CSTORAGE_TYPE=='TT') THEN
- CALL IO_WRITE_FIELD(TPFILE,'THINSHELL',LTHINSHELL)
- CALL IO_WRITE_FIELD(TPFILE,'CARTESIAN',LCARTESIAN)
+ CALL IO_Field_write(TPFILE,'THINSHELL',LTHINSHELL)
+ CALL IO_Field_write(TPFILE,'CARTESIAN',LCARTESIAN)
END IF
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/write_hgridn.f90 b/src/MNH/write_hgridn.f90
index 92765f2f71b98a796d07289becc28e10bb7703b1..4e134e365d4d8bbef29737dac1e09a1572c0c623 100644
--- a/src/MNH/write_hgridn.f90
+++ b/src/MNH/write_hgridn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1996-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 WRITE_HGRID_n(TPFILE)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File to write
!
@@ -32,8 +32,8 @@ END MODULE MODI_WRITE_HGRIDn
!!
!! EXTERNAL
!! --------
-!! FMWRIT : to write data in LFIFM file
-!!
+!! IO_Field_write : to write data in LFIFM file
+!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_GRID : contains projection definition
@@ -73,9 +73,9 @@ USE MODD_CONF_n
USE MODD_DIM_n
USE MODD_GRID
USE MODD_GRID_n
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
-USE MODE_FMWRIT
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
!
IMPLICIT NONE
!
@@ -89,20 +89,20 @@ TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File to write
! NONE
!-------------------------------------------------------------------------------
!
-CALL IO_WRITE_FIELD(TPFILE,'LAT0', XLAT0)
-CALL IO_WRITE_FIELD(TPFILE,'LON0', XLON0)
-CALL IO_WRITE_FIELD(TPFILE,'RPK', XRPK)
-CALL IO_WRITE_FIELD(TPFILE,'BETA', XBETA)
-CALL IO_WRITE_FIELD(TPFILE,'LATORI',XLATORI)
-CALL IO_WRITE_FIELD(TPFILE,'LONORI',XLONORI)
-CALL IO_WRITE_FIELD(TPFILE,'IMAX', NIMAX)
-CALL IO_WRITE_FIELD(TPFILE,'JMAX', NJMAX)
-CALL IO_WRITE_FIELD(TPFILE,'XHAT', XXHAT)
-CALL IO_WRITE_FIELD(TPFILE,'YHAT', XYHAT)
+CALL IO_Field_write(TPFILE,'LAT0', XLAT0)
+CALL IO_Field_write(TPFILE,'LON0', XLON0)
+CALL IO_Field_write(TPFILE,'RPK', XRPK)
+CALL IO_Field_write(TPFILE,'BETA', XBETA)
+CALL IO_Field_write(TPFILE,'LATORI',XLATORI)
+CALL IO_Field_write(TPFILE,'LONORI',XLONORI)
+CALL IO_Field_write(TPFILE,'IMAX', NIMAX)
+CALL IO_Field_write(TPFILE,'JMAX', NJMAX)
+CALL IO_Field_write(TPFILE,'XHAT', XXHAT)
+CALL IO_Field_write(TPFILE,'YHAT', XYHAT)
!
IF (CSTORAGE_TYPE=='TT') THEN
- CALL IO_WRITE_FIELD(TPFILE,'THINSHELL',LTHINSHELL)
- CALL IO_WRITE_FIELD(TPFILE,'CARTESIAN',LCARTESIAN)
+ CALL IO_Field_write(TPFILE,'THINSHELL',LTHINSHELL)
+ CALL IO_Field_write(TPFILE,'CARTESIAN',LCARTESIAN)
END IF
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/write_lbn.f90 b/src/MNH/write_lbn.f90
index b4044c86b79cec0bdaa52f3a69c0e968b622a9c9..32f0fd5835e0e93685737ecda1cee76b6bffd2c0 100644
--- a/src/MNH/write_lbn.f90
+++ b/src/MNH/write_lbn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1998-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.
!-----------------------------------------------------------------
! ######################
@@ -11,7 +11,7 @@ INTERFACE
!
SUBROUTINE WRITE_LB_n(TPFILE)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File characteristics
END SUBROUTINE WRITE_LB_n
@@ -76,6 +76,7 @@ END MODULE MODI_WRITE_LB_n
!! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -92,11 +93,11 @@ USE MODD_NSV
USE MODD_PARAM_LIMA
USE MODD_PARAM_n
!
-USE MODE_FMWRIT
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write, IO_Field_write_lb
USE MODE_ll
-USE MODE_IO_ll, ONLY: UPCASE, CLOSE_ll
USE MODE_MSG
USE MODE_MODELN_HANDLER
+USE MODE_TOOLS, ONLY: UPCASE
!
USE MODD_RAIN_C2R2_DESCR, ONLY: C2R2NAMES
USE MODD_ICE_C1R3_DESCR, ONLY: C1R3NAMES
@@ -111,12 +112,14 @@ USE MODI_CH_AER_REALLFI_n
USE MODD_CONF
USE MODD_REF, ONLY : XRHODREFZ
USE MODD_CONF, ONLY : CPROGRAM
+USE MODD_GRID_n, ONLY : XZZ
+USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
USE MODD_DUST
USE MODD_SALT
USE MODI_DUSTLFI_n
USE MODI_SALTLFI_n
USE MODD_PARAMETERS, ONLY: JPHEXT
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODE_FIELD, ONLY: TFIELDDATA,TYPELOG,TYPEREAL
!
!
@@ -144,6 +147,12 @@ INTEGER :: JK
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
+INTEGER :: ILBX,ILBY
+INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE
+INTEGER :: IIU, IJU, IKU
+REAL, DIMENSION(SIZE(XLBXSVM,1), SIZE(XLBXSVM,2), SIZE(XLBXSVM,3)) :: ZLBXZZ
+REAL, DIMENSION(SIZE(XLBYSVM,1), SIZE(XLBYSVM,2), SIZE(XLBYSVM,3)) :: ZLBYZZ
CHARACTER(LEN=100) :: YMSG
TYPE(TFIELDDATA) :: TZFIELD
!-------------------------------------------------------------------------------
@@ -154,36 +163,46 @@ TYPE(TFIELDDATA) :: TZFIELD
ILUOUT = TLUOUT%NLU
!
IMI = GET_CURRENT_MODEL_INDEX()
+
+IIB=JPHEXT+1
+IIE=SIZE(XZZ,1)-JPHEXT
+IIU=SIZE(XZZ,1)
+IJB=JPHEXT+1
+IJE=SIZE(XZZ,2)-JPHEXT
+IJU=SIZE(XZZ,2)
+IKB=JPVEXT+1
+IKE=SIZE(XZZ,3)-JPVEXT
+IKU=SIZE(XZZ,3)
!
! 2. WRITE THE DIMENSION OF LB FIELDS
! --------------------------------
!
-CALL IO_WRITE_FIELD(TPFILE,'RIMX',NRIMX)
-CALL IO_WRITE_FIELD(TPFILE,'RIMY',NRIMY)
+CALL IO_Field_write(TPFILE,'RIMX',NRIMX)
+CALL IO_Field_write(TPFILE,'RIMY',NRIMY)
!
!* 3. BASIC VARIABLES
! --------------
!
-CALL IO_WRITE_FIELD(TPFILE,'HORELAX_UVWTH',LHORELAX_UVWTH)
+CALL IO_Field_write(TPFILE,'HORELAX_UVWTH',LHORELAX_UVWTH)
!
!gathering and writing of the LB fields
-IF(NSIZELBXU_ll /= 0) CALL IO_WRITE_FIELD_LB(TPFILE,'LBXUM', NSIZELBXU_ll,XLBXUM)
-IF(NSIZELBX_ll /= 0) CALL IO_WRITE_FIELD_LB(TPFILE,'LBXVM', NSIZELBX_ll,XLBXVM)
-IF(NSIZELBX_ll /= 0) CALL IO_WRITE_FIELD_LB(TPFILE,'LBXWM', NSIZELBX_ll,XLBXWM)
-IF(NSIZELBY_ll /= 0) CALL IO_WRITE_FIELD_LB(TPFILE,'LBYUM', NSIZELBY_ll,XLBYUM)
-IF(NSIZELBYV_ll /= 0) CALL IO_WRITE_FIELD_LB(TPFILE,'LBYVM', NSIZELBYV_ll,XLBYVM)
-IF(NSIZELBY_ll /= 0) CALL IO_WRITE_FIELD_LB(TPFILE,'LBYWM', NSIZELBY_ll,XLBYWM)
-IF(NSIZELBX_ll /= 0) CALL IO_WRITE_FIELD_LB(TPFILE,'LBXTHM',NSIZELBX_ll,XLBXTHM)
-IF(NSIZELBY_ll /= 0) CALL IO_WRITE_FIELD_LB(TPFILE,'LBYTHM',NSIZELBY_ll,XLBYTHM)
+IF(NSIZELBXU_ll /= 0) CALL IO_Field_write_lb(TPFILE,'LBXUM', NSIZELBXU_ll,XLBXUM)
+IF(NSIZELBX_ll /= 0) CALL IO_Field_write_lb(TPFILE,'LBXVM', NSIZELBX_ll,XLBXVM)
+IF(NSIZELBX_ll /= 0) CALL IO_Field_write_lb(TPFILE,'LBXWM', NSIZELBX_ll,XLBXWM)
+IF(NSIZELBY_ll /= 0) CALL IO_Field_write_lb(TPFILE,'LBYUM', NSIZELBY_ll,XLBYUM)
+IF(NSIZELBYV_ll /= 0) CALL IO_Field_write_lb(TPFILE,'LBYVM', NSIZELBYV_ll,XLBYVM)
+IF(NSIZELBY_ll /= 0) CALL IO_Field_write_lb(TPFILE,'LBYWM', NSIZELBY_ll,XLBYWM)
+IF(NSIZELBX_ll /= 0) CALL IO_Field_write_lb(TPFILE,'LBXTHM',NSIZELBX_ll,XLBXTHM)
+IF(NSIZELBY_ll /= 0) CALL IO_Field_write_lb(TPFILE,'LBYTHM',NSIZELBY_ll,XLBYTHM)
!
!* 4 LB-TKE
! ------
!
IF(CTURB/='NONE') THEN
- CALL IO_WRITE_FIELD(TPFILE,'HORELAX_TKE',LHORELAX_TKE)
+ CALL IO_Field_write(TPFILE,'HORELAX_TKE',LHORELAX_TKE)
!
- IF(NSIZELBXTKE_ll /= 0) CALL IO_WRITE_FIELD_LB(TPFILE,'LBXTKEM',NSIZELBXTKE_ll,XLBXTKEM)
- IF(NSIZELBYTKE_ll /= 0) CALL IO_WRITE_FIELD_LB(TPFILE,'LBYTKEM',NSIZELBYTKE_ll,XLBYTKEM)
+ IF(NSIZELBXTKE_ll /= 0) CALL IO_Field_write_lb(TPFILE,'LBXTKEM',NSIZELBXTKE_ll,XLBXTKEM)
+ IF(NSIZELBYTKE_ll /= 0) CALL IO_Field_write_lb(TPFILE,'LBYTKEM',NSIZELBYTKE_ll,XLBYTKEM)
END IF
!
!
@@ -207,7 +226,7 @@ IF (NRR >=1) THEN
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
!
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,GHORELAX_R)
+ CALL IO_Field_write(TPFILE,TZFIELD,GHORELAX_R)
!
GUSER(:)=(/LUSERV,LUSERC,LUSERR,LUSERI,LUSERS,LUSERG,LUSERH/)
YC(:)=(/"V","C","R","I","S","G","H"/)
@@ -229,7 +248,7 @@ IF (NRR >=1) THEN
TZFIELD%CLONGNAME = 'LBXR'//YC(JRR)//'M'
TZFIELD%CLBTYPE = 'LBX'
TZFIELD%CCOMMENT = '2_Y_Z_LBXR'//YC(JRR)//'M'
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBXR_ll,XLBXRM(:,:,:,IRR))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXR_ll,XLBXRM(:,:,:,IRR))
END IF
!
IF(NSIZELBYR_ll /= 0) THEN
@@ -237,7 +256,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_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBXR_ll,XLBYRM(:,:,:,IRR))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXR_ll,XLBYRM(:,:,:,IRR))
END IF
END IF
END DO
@@ -261,7 +280,7 @@ IF (NSV >=1) THEN
TZFIELD%NTYPE = TYPELOG
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,GHORELAX_SV)
+ CALL IO_Field_write(TPFILE,TZFIELD,GHORELAX_SV)
!
IRIMX =(NSIZELBXSV_ll-2*JPHEXT)/2
IRIMY =(NSIZELBYSV_ll-2*JPHEXT)/2
@@ -280,7 +299,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3,A8)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
END IF
!
IF(NSIZELBYSV_ll /= 0) THEN
@@ -288,7 +307,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3,A8)')'X_2_Z_','LBYSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
END IF
END DO
END IF
@@ -308,7 +327,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
END IF
!
IF(NSIZELBYSV_ll /= 0) THEN
@@ -316,7 +335,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
END IF
END DO
END IF
@@ -336,7 +355,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
END IF
!
IF(NSIZELBYSV_ll /= 0) THEN
@@ -344,7 +363,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
END IF
END DO
END IF
@@ -367,7 +386,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
END IF
!
IF(NSIZELBYSV_ll /= 0) THEN
@@ -375,7 +394,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
END IF
END DO
!
@@ -386,7 +405,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
END IF
!
IF(NSIZELBYSV_ll /= 0) THEN
@@ -394,7 +413,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
END IF
END DO
END IF
@@ -416,7 +435,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
END IF
!
IF(NSIZELBYSV_ll /= 0) THEN
@@ -424,7 +443,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
END IF
END DO
END IF
@@ -456,7 +475,7 @@ IF (NSV >=1) THEN
END IF
!
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'kg kg-1'
+ TZFIELD%CUNITS = 'ppp'
TZFIELD%CDIR = ''
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEREAL
@@ -469,7 +488,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
END IF
!
IF(NSIZELBYSV_ll /= 0) THEN
@@ -477,7 +496,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
END IF
END DO
!
@@ -488,7 +507,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
END IF
!
IF(NSIZELBYSV_ll /= 0) THEN
@@ -496,7 +515,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
END IF
END DO
END IF
@@ -516,7 +535,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
END IF
!
IF(NSIZELBYSV_ll /= 0) THEN
@@ -524,7 +543,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
END IF
END DO
!
@@ -534,7 +553,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
END IF
!
IF(NSIZELBYSV_ll /= 0) THEN
@@ -542,7 +561,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
END IF
END DO
!
@@ -552,7 +571,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
END IF
!
IF(NSIZELBYSV_ll /= 0) THEN
@@ -560,7 +579,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
END IF
END DO
!
@@ -623,14 +642,14 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3,A8)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,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_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,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
@@ -646,14 +665,14 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3,A8)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,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_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,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
@@ -664,7 +683,7 @@ IF (NSV >=1) THEN
!in the same order as the variables in XSVM (i.e. following JPDUSTORDER)
!
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'kg kg-1'
+ TZFIELD%CUNITS = 'ppp'
TZFIELD%CDIR = ''
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEREAL
@@ -677,7 +696,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
END IF
!
IF(NSIZELBYSV_ll /= 0) THEN
@@ -685,7 +704,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
END IF
END DO
IF (LDEPOS_DST(IMI)) THEN
@@ -695,7 +714,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
END IF
!
IF(NSIZELBYSV_ll /= 0) THEN
@@ -703,7 +722,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
END IF
END DO
END IF
@@ -717,6 +736,19 @@ IF (NSV >=1) THEN
DO JK=1,size(XLBYSVM,3)
ZRHODREFY(:,:,JK) = XRHODREFZ(JK)
ENDDO
+ IIU = SIZE(XZZ,1)
+ IJU = SIZE(XZZ,2)
+ IKU = SIZE(XZZ,3)
+ IF (SIZE(ZLBXZZ) .NE. 0 ) THEN
+ ILBX=SIZE(ZLBXZZ,1)/2-1
+ ZLBXZZ(1:ILBX+1,:,:) = XZZ(IIB-1:IIB-1+ILBX,:,:)
+ ZLBXZZ(ILBX+2:2*ILBX+2,:,:) = XZZ(IIE+1-ILBX:IIE+1,:,:)
+ ENDIF
+ IF (SIZE(ZLBYZZ) .NE. 0 ) THEN
+ ILBY=SIZE(ZLBYZZ,2)/2-1
+ ZLBYZZ(:,1:ILBY+1,:) = XZZ(:,IJB-1:IJB-1+ILBY,:)
+ ZLBYZZ(:,ILBY+2:2*ILBY+2,:) = XZZ(:,IJE+1-ILBY:IJE+1,:)
+ ENDIF
IF (NSIZELBXSV_ll /= 0) &
XLBXSVM(:,:,:,NSV_SLTBEG:NSV_SLTEND) = MAX(XLBXSVM(:,:,:,NSV_SLTBEG:NSV_SLTEND), 0.)
IF (NSIZELBYSV_ll /= 0) &
@@ -727,16 +759,16 @@ IF (NSV >=1) THEN
XLBYSVM(:,:,:,NSV_SLTDEPBEG:NSV_SLTDEPEND) = MAX(XLBYSVM(:,:,:,NSV_SLTDEPBEG:NSV_SLTDEPEND), 0.)
IF ((LSLTINIT).OR.(LSLTPRES)) THEN ! GRIBEX case (dust initialization)
IF ((NSIZELBXSV_ll /= 0).AND.(CPROGRAM == 'REAL ').AND.(NSV_SLT > 1)) THEN
- CALL SALTLFI_n(XLBXSVM(:,:,:,NSV_SLTBEG:NSV_SLTEND), ZRHODREFX)
+ CALL SALTLFI_n(XLBXSVM(:,:,:,NSV_SLTBEG:NSV_SLTEND), ZRHODREFX, ZLBXZZ)
END IF
IF ((NSIZELBYSV_ll /= 0).AND.(CPROGRAM == 'REAL ').AND.(NSV_SLT > 1)) THEN
- CALL SALTLFI_n(XLBYSVM(:,:,:,NSV_SLTBEG:NSV_SLTEND), ZRHODREFY)
+ CALL SALTLFI_n(XLBYSVM(:,:,:,NSV_SLTBEG:NSV_SLTEND), ZRHODREFY, ZLBYZZ)
END IF
IF ((NSIZELBXSV_ll /= 0).AND.(CPROGRAM == 'IDEAL ').AND.(NSV_SLT > 1)) THEN
- CALL SALTLFI_n(XLBXSVM(:,:,:,NSV_SLTBEG:NSV_SLTEND), ZRHODREFX)
+ CALL SALTLFI_n(XLBXSVM(:,:,:,NSV_SLTBEG:NSV_SLTEND), ZRHODREFX, ZLBXZZ)
END IF
IF ((NSIZELBYSV_ll /= 0).AND.(CPROGRAM == 'IDEAL ').AND.(NSV_SLT > 1)) THEN
- CALL SALTLFI_n(XLBYSVM(:,:,:,NSV_SLTBEG:NSV_SLTEND), ZRHODREFY)
+ CALL SALTLFI_n(XLBYSVM(:,:,:,NSV_SLTBEG:NSV_SLTEND), ZRHODREFY, ZLBYZZ)
END IF
END IF
!
@@ -771,14 +803,14 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,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_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,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
@@ -794,14 +826,14 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,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_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,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
@@ -810,7 +842,7 @@ IF (NSV >=1) THEN
! 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 = 'kg kg-1'
+ TZFIELD%CUNITS = 'ppp'
TZFIELD%CDIR = ''
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEREAL
@@ -823,7 +855,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
END IF
!
IF(NSIZELBYSV_ll /= 0) THEN
@@ -831,7 +863,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
END IF
END DO
IF (LDEPOS_SLT(IMI)) THEN
@@ -841,7 +873,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
END IF
!
IF(NSIZELBYSV_ll /= 0) THEN
@@ -849,7 +881,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
END IF
END DO
END IF
@@ -872,7 +904,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
END IF
!
IF(NSIZELBYSV_ll /= 0) THEN
@@ -880,7 +912,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
END IF
END DO
END IF
@@ -900,7 +932,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
END IF
!
IF(NSIZELBYSV_ll /= 0) THEN
@@ -908,7 +940,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
END IF
END DO
END IF
@@ -928,7 +960,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
END IF
!
IF(NSIZELBYSV_ll /= 0) THEN
@@ -936,7 +968,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
END IF
END DO
END IF
@@ -957,7 +989,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
END IF
!
IF(NSIZELBYSV_ll /= 0) THEN
@@ -965,7 +997,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_WRITE_FIELD_LB(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
END IF
END DO
END IF
diff --git a/src/MNH/write_les_budgetn.f90 b/src/MNH/write_les_budgetn.f90
index 628ba7d6fcfd5fda8907b31c0c306e2e838e3a34..dc12b57cabc42288aa6f4d366456a91f4450f27a 100644
--- a/src/MNH/write_les_budgetn.f90
+++ b/src/MNH/write_les_budgetn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2000-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-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.
!-----------------------------------------------------------------
!######################
@@ -11,7 +11,7 @@ INTERFACE
!
SUBROUTINE WRITE_LES_BUDGET_n(TPDIAFILE,HLES_AVG)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+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
@@ -58,7 +58,7 @@ END MODULE MODI_WRITE_LES_BUDGET_n
! ------------
!
USE MODD_CST
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES
USE MODD_LES_n
USE MODD_CONF_n
diff --git a/src/MNH/write_les_rt_budgetn.f90 b/src/MNH/write_les_rt_budgetn.f90
index 558f7df3a9fa0edecd7edcdecdd3dd5dfac557d5..92f37d1dbbe8cd2a6c95b775d401f9d5ad97dd4c 100644
--- a/src/MNH/write_les_rt_budgetn.f90
+++ b/src/MNH/write_les_rt_budgetn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2002-2018 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.
!-----------------------------------------------------------------
!######################
@@ -11,7 +11,7 @@ INTERFACE
!
SUBROUTINE WRITE_LES_RT_BUDGET_n(TPDIAFILE,HLES_AVG)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+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
@@ -57,7 +57,7 @@ END MODULE MODI_WRITE_LES_RT_BUDGET_n
! ------------
!
USE MODD_CST
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES
USE MODD_LES_n
USE MODD_LES_BUDGET
diff --git a/src/MNH/write_les_sv_budgetn.f90 b/src/MNH/write_les_sv_budgetn.f90
index af1d62eac8b63f07339292499f8ced91f1e0e536..10df1eebe24ef9fa2df341213eac4eceec3bba35 100644
--- a/src/MNH/write_les_sv_budgetn.f90
+++ b/src/MNH/write_les_sv_budgetn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2002-2018 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.
!-----------------------------------------------------------------
!######################
@@ -11,7 +11,7 @@ INTERFACE
!
SUBROUTINE WRITE_LES_SV_BUDGET_n(TPDIAFILE,HLES_AVG)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+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
@@ -57,7 +57,7 @@ END MODULE MODI_WRITE_LES_SV_BUDGET_n
! ------------
!
USE MODD_CST
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES
USE MODD_LES_n
USE MODD_CONF_n
diff --git a/src/MNH/write_lesn.f90 b/src/MNH/write_lesn.f90
index 260b53bf076d5fb42893d7942e2185ce608c3501..1ae4ad90c4df2ed27e600a5de13bbcc226ba3c50 100644
--- a/src/MNH/write_lesn.f90
+++ b/src/MNH/write_lesn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2000-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-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.
!-----------------------------------------------------------------
!######################
@@ -11,7 +11,7 @@ INTERFACE
!
SUBROUTINE WRITE_LES_n(TPDIAFILE,HLES_AVG)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+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
@@ -56,14 +56,15 @@ END MODULE MODI_WRITE_LES_n
!! 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
+
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_CST
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES
USE MODD_LES_n
USE MODD_FIELD_n
@@ -382,6 +383,10 @@ 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)
diff --git a/src/MNH/write_lfifm1_for_diag.f90 b/src/MNH/write_lfifm1_for_diag.f90
index 150421cb6a5e824e9d822c7cbb22f1e9d435d141..20aa0f4647beb92f0df37401df66e993e28eb2f0 100644
--- a/src/MNH/write_lfifm1_for_diag.f90
+++ b/src/MNH/write_lfifm1_for_diag.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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 @@ MODULE MODI_WRITE_LFIFM1_FOR_DIAG
INTERFACE
SUBROUTINE WRITE_LFIFM1_FOR_DIAG(TPFILE,HDADFILE)
!
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! outpput data file
CHARACTER(LEN=28), INTENT(IN) :: HDADFILE ! corresponding FM-file name of
@@ -142,6 +142,8 @@ END MODULE MODI_WRITE_LFIFM1_FOR_DIAG
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -152,7 +154,7 @@ USE MODD_CONF
USE MODD_CONF_n
USE MODD_GRID
USE MODD_GRID_n
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY : TFILEDATA
USE MODD_METRICS_n
USE MODD_TIME
USE MODD_TIME_n
@@ -202,6 +204,7 @@ USE MODD_RADAR, ONLY: XLAT_RAD,XELEV,&
NCURV_INTERPOL,LATT,LCART_RAD,NPTS_H,NPTS_V,XGRID,&
LREFR,LDNDZ,NMAX,CNAME_RAD,NDIFF,&
XLON_RAD,XALT_RAD,XLAM_RAD,XDT_RAD,LWBSCS,LWREFL
+use modd_precision, only: MNHREAL_MPI
!
USE MODI_RADAR_SIMULATOR
!
@@ -230,15 +233,15 @@ USE MODI_FREE_ATM_PROFILE
USE MODI_GPS_ZENITH
USE MODI_CONTRAV
!
-USE MODE_FM, ONLY: IO_FILE_CLOSE_ll,IO_FILE_OPEN_ll
USE MODE_GRIDPROJ
USE MODE_FIELD
-USE MODE_FMWRIT
USE MODE_GATHER_ll
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_IO_FILE, only: IO_File_close, IO_File_open
+USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
USE MODE_ll
-USE MODE_IO_ll
-USE MODE_IO_MANAGE_STRUCT,ONLY: IO_FILE_ADD2LIST
USE MODE_THERMO
+USE MODE_TOOLS, ONLY: UPCASE
USE MODE_MODELN_HANDLER
USE MODI_LIDAR
USE MODI_CLUSTERING
@@ -365,43 +368,43 @@ TZRSFILE => NULL()
!
!* 1.0 TPFILE%CNAME and HDADFILE :
!
-CALL IO_WRITE_FIELD(TPFILE,'MASDEV', NMASDEV)
-CALL IO_WRITE_FIELD(TPFILE,'BUGFIX', NBUGFIX)
-CALL IO_WRITE_FIELD(TPFILE,'BIBUSER', CBIBUSER)
-CALL IO_WRITE_FIELD(TPFILE,'PROGRAM', CPROGRAM)
+CALL IO_Field_write(TPFILE,'MASDEV', NMASDEV)
+CALL IO_Field_write(TPFILE,'BUGFIX', NBUGFIX)
+CALL IO_Field_write(TPFILE,'BIBUSER', CBIBUSER)
+CALL IO_Field_write(TPFILE,'PROGRAM', CPROGRAM)
!
-CALL IO_WRITE_FIELD(TPFILE,'L1D', L1D)
-CALL IO_WRITE_FIELD(TPFILE,'L2D', L2D)
-CALL IO_WRITE_FIELD(TPFILE,'PACK', LPACK)
+CALL IO_Field_write(TPFILE,'L1D', L1D)
+CALL IO_Field_write(TPFILE,'L2D', L2D)
+CALL IO_Field_write(TPFILE,'PACK', LPACK)
!
-CALL IO_WRITE_FIELD(TPFILE,'MY_NAME', TPFILE%CNAME)
-CALL IO_WRITE_FIELD(TPFILE,'DAD_NAME', HDADFILE)
+CALL IO_Field_write(TPFILE,'MY_NAME', TPFILE%CNAME)
+CALL IO_Field_write(TPFILE,'DAD_NAME', HDADFILE)
!
IF (LEN_TRIM(HDADFILE)>0) THEN
- CALL IO_WRITE_FIELD(TPFILE,'DXRATIO',NDXRATIO_ALL(1))
- CALL IO_WRITE_FIELD(TPFILE,'DYRATIO',NDYRATIO_ALL(1))
- CALL IO_WRITE_FIELD(TPFILE,'XOR', NXOR_ALL(1))
- CALL IO_WRITE_FIELD(TPFILE,'YOR', NYOR_ALL(1))
+ CALL IO_Field_write(TPFILE,'DXRATIO',NDXRATIO_ALL(1))
+ CALL IO_Field_write(TPFILE,'DYRATIO',NDYRATIO_ALL(1))
+ CALL IO_Field_write(TPFILE,'XOR', NXOR_ALL(1))
+ CALL IO_Field_write(TPFILE,'YOR', NYOR_ALL(1))
END IF
!
-CALL IO_WRITE_FIELD(TPFILE,'SURF', CSURF)
+CALL IO_Field_write(TPFILE,'SURF', CSURF)
!
!* 1.1 Type and Dimensions :
!
-CALL IO_WRITE_FIELD(TPFILE,'STORAGE_TYPE','DI')
+CALL IO_Field_write(TPFILE,'STORAGE_TYPE','DI')
!
-CALL IO_WRITE_FIELD(TPFILE,'IMAX',NIMAX_ll)
-CALL IO_WRITE_FIELD(TPFILE,'JMAX',NJMAX_ll)
-CALL IO_WRITE_FIELD(TPFILE,'KMAX',NKMAX)
+CALL IO_Field_write(TPFILE,'IMAX',NIMAX_ll)
+CALL IO_Field_write(TPFILE,'JMAX',NJMAX_ll)
+CALL IO_Field_write(TPFILE,'KMAX',NKMAX)
!
-CALL IO_WRITE_FIELD(TPFILE,'JPHEXT',JPHEXT)
+CALL IO_Field_write(TPFILE,'JPHEXT',JPHEXT)
!
!* 1.2 Grid variables :
!
IF (.NOT.LCARTESIAN) THEN
- CALL IO_WRITE_FIELD(TPFILE,'RPK', XRPK)
- CALL IO_WRITE_FIELD(TPFILE,'LONORI',XLONORI)
- CALL IO_WRITE_FIELD(TPFILE,'LATORI',XLATORI)
+ CALL IO_Field_write(TPFILE,'RPK', XRPK)
+ CALL IO_Field_write(TPFILE,'LONORI',XLONORI)
+ CALL IO_Field_write(TPFILE,'LATORI',XLATORI)
!
!* diagnostic of 1st mass point
!
@@ -413,40 +416,41 @@ IF (.NOT.LCARTESIAN) THEN
CALL SM_LATLON(XLATORI,XLONORI,ZXHATM,ZYHATM,ZLATOR,ZLONOR)
DEALLOCATE(ZXHAT_ll,ZYHAT_ll)
!
- CALL IO_WRITE_FIELD(TPFILE,'LONOR',ZLONOR)
- CALL IO_WRITE_FIELD(TPFILE,'LATOR',ZLATOR)
+ CALL IO_Field_write(TPFILE,'LONOR',ZLONOR)
+ CALL IO_Field_write(TPFILE,'LATOR',ZLATOR)
!
END IF
!
-CALL IO_WRITE_FIELD(TPFILE,'THINSHELL',LTHINSHELL)
-CALL IO_WRITE_FIELD(TPFILE,'LAT0',XLAT0)
-CALL IO_WRITE_FIELD(TPFILE,'LON0',XLON0)
-CALL IO_WRITE_FIELD(TPFILE,'BETA',XBETA)
+CALL IO_Field_write(TPFILE,'THINSHELL',LTHINSHELL)
+CALL IO_Field_write(TPFILE,'LAT0',XLAT0)
+CALL IO_Field_write(TPFILE,'LON0',XLON0)
+CALL IO_Field_write(TPFILE,'BETA',XBETA)
!
-CALL IO_WRITE_FIELD(TPFILE,'XHAT',XXHAT)
-CALL IO_WRITE_FIELD(TPFILE,'YHAT',XYHAT)
-CALL IO_WRITE_FIELD(TPFILE,'ZHAT',XZHAT)
-CALL IO_WRITE_FIELD(TPFILE,'ZTOP',XZTOP)
+CALL IO_Field_write(TPFILE,'XHAT',XXHAT)
+CALL IO_Field_write(TPFILE,'YHAT',XYHAT)
+CALL IO_Field_write(TPFILE,'ZHAT',XZHAT)
+CALL IO_Field_write(TPFILE,'ZTOP',XZTOP)
!
-CALL IO_WRITE_FIELD(TPFILE,'ZS', XZS)
-CALL IO_WRITE_FIELD(TPFILE,'ZSMT', XZSMT)
-CALL IO_WRITE_FIELD(TPFILE,'SLEVE',LSLEVE)
+CALL IO_Field_write(TPFILE,'ZS', XZS)
+CALL IO_Field_write(TPFILE,'ZWS', XZWS)
+CALL IO_Field_write(TPFILE,'ZSMT', XZSMT)
+CALL IO_Field_write(TPFILE,'SLEVE',LSLEVE)
!
IF (LSLEVE) THEN
- CALL IO_WRITE_FIELD(TPFILE,'LEN1',XLEN1)
- CALL IO_WRITE_FIELD(TPFILE,'LEN2',XLEN2)
+ CALL IO_Field_write(TPFILE,'LEN1',XLEN1)
+ CALL IO_Field_write(TPFILE,'LEN2',XLEN2)
END IF
!
!
-CALL IO_WRITE_FIELD(TPFILE,'DTMOD',TDTMOD)
-CALL IO_WRITE_FIELD(TPFILE,'DTCUR',TDTCUR)
-CALL IO_WRITE_FIELD(TPFILE,'DTEXP',TDTEXP)
-CALL IO_WRITE_FIELD(TPFILE,'DTSEG',TDTSEG)
+CALL IO_Field_write(TPFILE,'DTMOD',TDTMOD)
+CALL IO_Field_write(TPFILE,'DTCUR',TDTCUR)
+CALL IO_Field_write(TPFILE,'DTEXP',TDTEXP)
+CALL IO_Field_write(TPFILE,'DTSEG',TDTSEG)
!
!* 1.3 Configuration variables :
!
-CALL IO_WRITE_FIELD(TPFILE,'CARTESIAN',LCARTESIAN)
-CALL IO_WRITE_FIELD(TPFILE,'LBOUSS', LBOUSS)
+CALL IO_Field_write(TPFILE,'CARTESIAN',LCARTESIAN)
+CALL IO_Field_write(TPFILE,'LBOUSS', LBOUSS)
!
IF (LCARTESIAN .AND. LWIND_ZM) THEN
LWIND_ZM=.FALSE.
@@ -454,12 +458,12 @@ IF (LCARTESIAN .AND. LWIND_ZM) THEN
END IF
!* 1.4 Reference state variables :
!
-CALL IO_WRITE_FIELD(TPFILE,'RHOREFZ',XRHODREFZ)
-CALL IO_WRITE_FIELD(TPFILE,'THVREFZ',XTHVREFZ)
-CALL IO_WRITE_FIELD(TPFILE,'EXNTOP', XEXNTOP)
+CALL IO_Field_write(TPFILE,'RHOREFZ',XRHODREFZ)
+CALL IO_Field_write(TPFILE,'THVREFZ',XTHVREFZ)
+CALL IO_Field_write(TPFILE,'EXNTOP', XEXNTOP)
!
-CALL IO_WRITE_FIELD(TPFILE,'RHODREF',XRHODREF)
-CALL IO_WRITE_FIELD(TPFILE,'THVREF', XTHVREF)
+CALL IO_Field_write(TPFILE,'RHODREF',XRHODREF)
+CALL IO_Field_write(TPFILE,'THVREF', XTHVREF)
!
!
!* 1.5 Variables necessary for plots
@@ -468,11 +472,11 @@ CALL IO_WRITE_FIELD(TPFILE,'THVREF', XTHVREF)
! level or constant theta level or constant PV level
!
IF (INDEX(CISO,'PR') /= 0) THEN
- CALL IO_WRITE_FIELD(TPFILE,'PABST',XPABST)
+ CALL IO_Field_write(TPFILE,'PABST',XPABST)
END IF
!
IF (INDEX(CISO,'TK') /= 0) THEN
- CALL IO_WRITE_FIELD(TPFILE,'THT',XTHT)
+ CALL IO_Field_write(TPFILE,'THT',XTHT)
END IF
!
ZCORIOZ(:,:,:)=SPREAD( XCORIOZ(:,:),DIM=3,NCOPIES=IKU )
@@ -503,13 +507,13 @@ IF (INDEX(CISO,'EV') /= 0) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZPOVO)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPOVO)
END IF
!
!
IF (LVAR_RS) THEN
- CALL IO_WRITE_FIELD(TPFILE,'UT',XUT)
- CALL IO_WRITE_FIELD(TPFILE,'VT',XVT)
+ CALL IO_Field_write(TPFILE,'UT',XUT)
+ CALL IO_Field_write(TPFILE,'VT',XVT)
!
IF (LWIND_ZM) THEN
TZFIELD2(1)%CMNHNAME = 'UM_ZM'
@@ -537,20 +541,20 @@ IF (LVAR_RS) THEN
CALL UV_TO_ZONAL_AND_MERID(XUT,XVT,23,TPFILE=TPFILE,TZFIELDS=TZFIELD2)
END IF
!
- CALL IO_WRITE_FIELD(TPFILE,'WT',XWT)
+ CALL IO_Field_write(TPFILE,'WT',XWT)
!
! write mixing ratio for water vapor required to plot radio-soundings
!
IF (LUSERV) THEN
- CALL IO_WRITE_FIELD(TPFILE,'RVT',XRT(:,:,:,IDX_RVT))
+ CALL IO_Field_write(TPFILE,'RVT',XRT(:,:,:,IDX_RVT))
END IF
END IF
!
!* Latitude and Longitude arrays
!
IF (.NOT.LCARTESIAN) THEN
- CALL IO_WRITE_FIELD(TPFILE,'LAT',XLAT)
- CALL IO_WRITE_FIELD(TPFILE,'LON',XLON)
+ CALL IO_Field_write(TPFILE,'LAT',XLAT)
+ CALL IO_Field_write(TPFILE,'LON',XLON)
END IF
!
!
@@ -562,15 +566,15 @@ ZTEMP(:,:,:)=XTHT(:,:,:)*(XPABST(:,:,:)/ XP00) **(XRD/XCPD)
!
IF (LVAR_TURB) THEN
IF (CTURB /= 'NONE') THEN
- CALL IO_WRITE_FIELD(TPFILE,'TKET',XTKET)
+ CALL IO_Field_write(TPFILE,'TKET',XTKET)
!
IF( NRR > 1 ) THEN
- CALL IO_WRITE_FIELD(TPFILE,'SRCT',XSRCT)
- CALL IO_WRITE_FIELD(TPFILE,'SIGS',XSIGS)
+ CALL IO_Field_write(TPFILE,'SRCT',XSRCT)
+ CALL IO_Field_write(TPFILE,'SIGS',XSIGS)
END IF
!
IF(CTOM=='TM06') THEN
- CALL IO_WRITE_FIELD(TPFILE,'BL_DEPTH',XBL_DEPTH)
+ CALL IO_Field_write(TPFILE,'BL_DEPTH',XBL_DEPTH)
END IF
END IF
END IF
@@ -584,15 +588,15 @@ IF (LVAR_PR .AND. LUSERR .AND. SIZE(XINPRR)>0 ) THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('INPRR',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XINPRR*3.6E6)
+ CALL IO_Field_write(TPFILE,TZFIELD,XINPRR*3.6E6)
!
- CALL IO_WRITE_FIELD(TPFILE,'INPRR3D',XINPRR3D)
- CALL IO_WRITE_FIELD(TPFILE,'EVAP3D', XEVAP3D)
+ CALL IO_Field_write(TPFILE,'INPRR3D',XINPRR3D)
+ CALL IO_Field_write(TPFILE,'EVAP3D', XEVAP3D)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRR',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XACPRR*1.0E3)
+ CALL IO_Field_write(TPFILE,TZFIELD,XACPRR*1.0E3)
!
IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR.&
CCLOUD == 'KHKO' .OR. CCLOUD == 'LIMA') THEN
@@ -600,56 +604,56 @@ IF (LVAR_PR .AND. LUSERR .AND. SIZE(XINPRR)>0 ) THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('INPRC',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XINPRC*3.6E6)
+ CALL IO_Field_write(TPFILE,TZFIELD,XINPRC*3.6E6)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRC',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XACPRC*1.0E3)
+ CALL IO_Field_write(TPFILE,TZFIELD,XACPRC*1.0E3)
END IF
IF (SIZE(XINDEP) /= 0 ) THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('INDEP',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XINDEP*3.6E6)
+ CALL IO_Field_write(TPFILE,TZFIELD,XINDEP*3.6E6)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('ACDEP',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XACDEP*1.0E3)
+ CALL IO_Field_write(TPFILE,TZFIELD,XACDEP*1.0E3)
END IF
END IF
IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'LIMA') THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('INPRS',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XINPRS*3.6E6)
+ CALL IO_Field_write(TPFILE,TZFIELD,XINPRS*3.6E6)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRS',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XACPRS*1.0E3)
+ CALL IO_Field_write(TPFILE,TZFIELD,XACPRS*1.0E3)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('INPRG',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XINPRG*3.6E6)
+ CALL IO_Field_write(TPFILE,TZFIELD,XINPRG*3.6E6)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRG',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XACPRG*1.0E3)
+ CALL IO_Field_write(TPFILE,TZFIELD,XACPRG*1.0E3)
!
IF (SIZE(XINPRH) /= 0 ) THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('INPRH',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XINPRH*3.6E6)
+ CALL IO_Field_write(TPFILE,TZFIELD,XINPRH*3.6E6)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRH',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XACPRH*1.0E3)
+ CALL IO_Field_write(TPFILE,TZFIELD,XACPRH*1.0E3)
ENDIF
!
ZWORK21(:,:) = XINPRR(:,:) + XINPRS(:,:) + XINPRG(:,:)
@@ -660,7 +664,7 @@ IF (LVAR_PR .AND. LUSERR .AND. SIZE(XINPRR)>0 ) THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('INPRT',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK21*3.6E6)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21*3.6E6)
!
ZWORK21(:,:) = (XACPRR(:,:) + XACPRS(:,:) + XACPRG(:,:))*1.0E3
IF (SIZE(XINPRC) /= 0 ) &
@@ -671,7 +675,7 @@ IF (LVAR_PR .AND. LUSERR .AND. SIZE(XINPRR)>0 ) THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRT',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK21*1.0E3)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21*1.0E3)
!
END IF
!
@@ -681,17 +685,17 @@ IF (LVAR_PR .AND. LUSERR .AND. SIZE(XINPRR)>0 ) THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('PRCONV',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XPRCONV*3.6E6)
+ CALL IO_Field_write(TPFILE,TZFIELD,XPRCONV*3.6E6)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('PACCONV',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XPACCONV*1.0E3)
+ CALL IO_Field_write(TPFILE,TZFIELD,XPACCONV*1.0E3)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('PRSCONV',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XPRSCONV*3.6E6)
+ CALL IO_Field_write(TPFILE,TZFIELD,XPRSCONV*3.6E6)
END IF
END IF
IF (LVAR_PR ) THEN
@@ -729,7 +733,7 @@ IF (LVAR_PR ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK22)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK22)
ENDIF
!
!
@@ -738,14 +742,14 @@ IF (LHU_FLX) THEN
ZWORK35(:,:,:) = XRHODREF(:,:,:) * XRT(:,:,:,1)
ZWORK31(:,:,:) = MXM(ZWORK35(:,:,:)) * XUT(:,:,:)
ZWORK32(:,:,:) = MYM(ZWORK35(:,:,:)) * XVT(:,:,:)
+ ZWORK35(:,:,:) = GX_U_M(1,IKU,1,ZWORK31,XDXX,XDZZ,XDZX) + GY_V_M(1,IKU,1,ZWORK32,XDYY,XDZZ,XDZY)
IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'LIMA') THEN
ZWORK36(:,:,:) = ZWORK35(:,:,:) + XRHODREF(:,:,:) * (XRT(:,:,:,2) + &
XRT(:,:,:,3) + XRT(:,:,:,4) + XRT(:,:,:,5) + XRT(:,:,:,6))
ZWORK33(:,:,:) = MXM(ZWORK36(:,:,:)) * XUT(:,:,:)
ZWORK34(:,:,:) = MYM(ZWORK36(:,:,:)) * XVT(:,:,:)
+ ZWORK36(:,:,:) = GX_U_M(1,IKU,1,ZWORK33,XDXX,XDZZ,XDZX) + GY_V_M(1,IKU,1,ZWORK34,XDYY,XDZZ,XDZY)
ENDIF
- ZWORK35(:,:,:) = GX_U_M(1,IKU,1,ZWORK31,XDXX,XDZZ,XDZX) + GY_V_M(1,IKU,1,ZWORK32,XDYY,XDZZ,XDZY)
- ZWORK36(:,:,:) = GX_U_M(1,IKU,1,ZWORK33,XDXX,XDZZ,XDZX) + GY_V_M(1,IKU,1,ZWORK34,XDYY,XDZZ,XDZY)
!
! Integration sur 3000 m
!
@@ -808,7 +812,7 @@ IF (LHU_FLX) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
!
TZFIELD%CMNHNAME = 'VM90'
TZFIELD%CSTDNAME = ''
@@ -820,7 +824,7 @@ IF (LHU_FLX) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK32)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK32)
! composantes U et V du flux d'humidité intégré sur 3000 metres
TZFIELD%CMNHNAME = 'UM91'
TZFIELD%CSTDNAME = ''
@@ -832,7 +836,7 @@ IF (LHU_FLX) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK21)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
!
TZFIELD%CMNHNAME = 'VM91'
TZFIELD%CSTDNAME = ''
@@ -844,7 +848,7 @@ IF (LHU_FLX) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK22)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK22)
!
! Convergence d'humidité
TZFIELD%CMNHNAME = 'HMCONV'
@@ -857,7 +861,7 @@ IF (LHU_FLX) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,-ZWORK35)
+ CALL IO_Field_write(TPFILE,TZFIELD,-ZWORK35)
!
! Convergence d'humidité intégré sur 3000 mètres
TZFIELD%CMNHNAME = 'HMCONV3000'
@@ -870,7 +874,7 @@ IF (LHU_FLX) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,-ZWORK25)
+ CALL IO_Field_write(TPFILE,TZFIELD,-ZWORK25)
!
IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'LIMA') THEN
! composantes U et V du flux surfacique d'hydrométéores
@@ -884,7 +888,7 @@ IF (LHU_FLX) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK33)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33)
!
TZFIELD%CMNHNAME = 'VM92'
TZFIELD%CSTDNAME = ''
@@ -896,7 +900,7 @@ IF (LHU_FLX) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK34)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK34)
! composantes U et V du flux d'hydrométéores intégré sur 3000 metres
TZFIELD%CMNHNAME = 'UM93'
TZFIELD%CSTDNAME = ''
@@ -908,7 +912,7 @@ IF (LHU_FLX) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK23)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK23)
!
TZFIELD%CMNHNAME = 'VM93'
TZFIELD%CSTDNAME = ''
@@ -920,7 +924,7 @@ IF (LHU_FLX) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK24)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK24)
! Convergence d'hydrométéores
TZFIELD%CMNHNAME = 'HMCONV_TT'
TZFIELD%CSTDNAME = ''
@@ -932,7 +936,7 @@ IF (LHU_FLX) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,-ZWORK36)
+ CALL IO_Field_write(TPFILE,TZFIELD,-ZWORK36)
! Convergence d'hydrométéores intégré sur 3000 mètres
TZFIELD%CMNHNAME = 'HMCONV3000_TT'
TZFIELD%CSTDNAME = ''
@@ -944,7 +948,7 @@ IF (LHU_FLX) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,-ZWORK26)
+ CALL IO_Field_write(TPFILE,TZFIELD,-ZWORK26)
ENDIF
ENDIF
!
@@ -964,43 +968,43 @@ IF (LVAR_MRW .OR. LLIMA_DIAG) THEN
TZFIELD%CLONGNAME = 'MRV'
TZFIELD%CUNITS = 'g kg-1'
TZFIELD%CCOMMENT = 'X_Y_Z_MRV'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XRT(:,:,:,IDX_RVT)*1.E3)
+ CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RVT)*1.E3)
END IF
IF (LUSERC) THEN
TZFIELD%CMNHNAME = 'MRC'
TZFIELD%CLONGNAME = 'MRC'
TZFIELD%CUNITS = 'g kg-1'
TZFIELD%CCOMMENT = 'X_Y_Z_MRC'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XRT(:,:,:,IDX_RCT)*1.E3)
+ CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RCT)*1.E3)
!
TZFIELD%CMNHNAME = 'VRC'
TZFIELD%CLONGNAME = 'VRC'
TZFIELD%CUNITS = '1' !vol/vol
TZFIELD%CCOMMENT = 'X_Y_Z_VRC (vol/vol)'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XRT(:,:,:,IDX_RCT)*XRHODREF(:,:,:)/1.E3)
+ CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RCT)*XRHODREF(:,:,:)/1.E3)
END IF
IF (LUSERR) THEN
TZFIELD%CMNHNAME = 'MRR'
TZFIELD%CLONGNAME = 'MRR'
TZFIELD%CUNITS = 'g kg-1'
TZFIELD%CCOMMENT = 'X_Y_Z_MRR'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XRT(:,:,:,IDX_RRT)*1.E3)
+ CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RRT)*1.E3)
!
TZFIELD%CMNHNAME = 'VRR'
TZFIELD%CLONGNAME = 'VRR'
TZFIELD%CUNITS = '1' !vol/vol
TZFIELD%CCOMMENT = 'X_Y_Z_VRR (vol/vol)'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XRT(:,:,:,IDX_RRT)*XRHODREF(:,:,:)/1.E3)
+ CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RRT)*XRHODREF(:,:,:)/1.E3)
END IF
IF (LUSERI) THEN
TZFIELD%CMNHNAME = 'MRI'
TZFIELD%CLONGNAME = 'MRI'
TZFIELD%CUNITS = 'g kg-1'
TZFIELD%CCOMMENT = 'X_Y_Z_MRI'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XRT(:,:,:,IDX_RIT)*1.E3)
+ CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RIT)*1.E3)
!
IF (LUSECI) THEN
- CALL IO_WRITE_FIELD(TPFILE,'CIT',XCIT(:,:,:))
+ CALL IO_Field_write(TPFILE,'CIT',XCIT(:,:,:))
END IF
END IF
IF (LUSERS) THEN
@@ -1008,21 +1012,21 @@ IF (LVAR_MRW .OR. LLIMA_DIAG) THEN
TZFIELD%CLONGNAME = 'MRS'
TZFIELD%CUNITS = 'g kg-1'
TZFIELD%CCOMMENT = 'X_Y_Z_MRS'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XRT(:,:,:,IDX_RST)*1.E3)
+ CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RST)*1.E3)
END IF
IF (LUSERG) THEN
TZFIELD%CMNHNAME = 'MRG'
TZFIELD%CLONGNAME = 'MRG'
TZFIELD%CUNITS = 'g kg-1'
TZFIELD%CCOMMENT = 'X_Y_Z_MRG'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XRT(:,:,:,IDX_RGT)*1.E3)
+ CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RGT)*1.E3)
END IF
IF (LUSERH) THEN
TZFIELD%CMNHNAME = 'MRH'
TZFIELD%CLONGNAME = 'MRH'
TZFIELD%CUNITS = 'g kg-1'
TZFIELD%CCOMMENT = 'X_Y_Z_MRH'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XRT(:,:,:,IDX_RHT)*1.E3)
+ CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RHT)*1.E3)
END IF
END IF
END IF
@@ -1044,7 +1048,7 @@ IF (LVAR_MRSV) THEN
WRITE(TZFIELD%CMNHNAME,'(A4,I3.3)')'MRSV',JSV
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','MRSV',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E3)
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E3)
END DO
END IF
! microphysical C2R2 scheme scalar variables
@@ -1068,7 +1072,7 @@ IF(LVAR_MRW) THEN
ZWORK31(:,:,:)=XSVT(:,:,:,JSV)*1.E-3
END IF
WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','MRSV',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
END DO
END IF
! microphysical C3R5 scheme additional scalar variables
@@ -1085,7 +1089,7 @@ IF(LVAR_MRW) THEN
TZFIELD%CMNHNAME = TRIM(C1R3NAMES(JSV-NSV_C1R3BEG+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E-3)
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E-3)
END DO
END IF
END IF
@@ -1158,7 +1162,7 @@ IF (LLIMA_DIAG) THEN
!
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
ZWORK31(:,:,:)=XSVT(:,:,:,JSV)*1.E-6*XRHODREF(:,:,:)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
END DO
!
IF (LUSERC) THEN
@@ -1173,7 +1177,7 @@ IF (LLIMA_DIAG) THEN
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
ZWORK31(:,:,:)=XRT(:,:,:,2)*1.E3*XRHODREF(:,:,:)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
END IF
!
IF (LUSERI) THEN
@@ -1188,7 +1192,7 @@ IF (LLIMA_DIAG) THEN
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
ZWORK31(:,:,:)=XRT(:,:,:,4)*1.E3*XRHODREF(:,:,:)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
END IF
!
END IF
@@ -1206,7 +1210,7 @@ IF (LCHEMDIAG) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E9)
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E9)
END DO
END IF
IF (LCHAQDIAG) THEN !aqueous concentration in M
@@ -1227,7 +1231,7 @@ IF (LCHAQDIAG) THEN !aqueous concentration in M
WHERE(((XRT(:,:,:,2)*XRHODREF(:,:,:))/1.e3) .GE. XRTMIN_AQ)
ZWORK31(:,:,:)=(XSVT(:,:,:,JSV)*1000.)/(XMD*1.E+3*XRT(:,:,:,2))
ENDWHERE
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
END DO
!
ZWORK31(:,:,:)=0.
@@ -1238,7 +1242,7 @@ IF (LCHAQDIAG) THEN !aqueous concentration in M
WHERE(((XRT(:,:,:,3)*XRHODREF(:,:,:))/1.e3) .GE. XRTMIN_AQ)
ZWORK31(:,:,:)=(XSVT(:,:,:,JSV)*1000.)/(XMD*1.E+3*XRT(:,:,:,3))
ENDWHERE
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
END DO
! ZWORK31(:,:,:)=0.
! DO JSV = NSV_CHICBEG,NSV_CHICEND ! ice phase
@@ -1248,7 +1252,7 @@ IF (LCHAQDIAG) THEN !aqueous concentration in M
! WHERE(((XRT(:,:,:,3)*XRHODREF(:,:,:))/1.e3) .GE. XRTMIN_AQ)
! ZWORK31(:,:,:)=(XSVT(:,:,:,JSV)*1000.)/(XMD*1.E+3*XRT(:,:,:,3))
! ENDWHERE
-! CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+! CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
! END DO
END IF
@@ -1278,7 +1282,7 @@ IF (LPASPOL) THEN
WRITE(TZFIELD%CMNHNAME,'(A3,I3.3)')'PPT',JSV
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZTMP)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZTMP)
END DO
DEALLOCATE(ZTMP)
DEALLOCATE(ZRHOT)
@@ -1297,7 +1301,7 @@ IF (LCONDSAMP) THEN
WRITE(TZFIELD%CMNHNAME,'(A3,I3.3)')'CST',JSV
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
END DO
END IF
!
@@ -1314,7 +1318,7 @@ IF(LBLOWSNOW) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XSNWSUBL3D(:,:,:))
+ CALL IO_Field_write(TPFILE,TZFIELD,XSNWSUBL3D(:,:,:))
!
ZWORK21(:,:) = 0.
DO JK = IKB,IKE
@@ -1333,7 +1337,7 @@ IF(LBLOWSNOW) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK21(:,:))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21(:,:))
!
IF(.NOT.ALLOCATED(ZBET_SNW)) &
ALLOCATE(ZBET_SNW(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3)))
@@ -1355,7 +1359,7 @@ IF(LBLOWSNOW) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZRG_SNW(:,:,:))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZRG_SNW(:,:,:))
!
TZFIELD%CMNHNAME = 'SNWBETA'
TZFIELD%CSTDNAME = ''
@@ -1367,7 +1371,7 @@ IF(LBLOWSNOW) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZBET_SNW(:,:,:))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZBET_SNW(:,:,:))
!
TZFIELD%CMNHNAME = 'SNWNOA'
TZFIELD%CSTDNAME = ''
@@ -1379,7 +1383,7 @@ IF(LBLOWSNOW) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZMA_SNW(:,:,:,1))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZMA_SNW(:,:,:,1))
!
TZFIELD%CMNHNAME = 'SNWMASS'
TZFIELD%CSTDNAME = ''
@@ -1391,7 +1395,7 @@ IF(LBLOWSNOW) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZMA_SNW(:,:,:,2))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZMA_SNW(:,:,:,2))
!
ZWORK21(:,:) = 0.
DO JK = IKB,IKE
@@ -1409,7 +1413,7 @@ IF(LBLOWSNOW) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK21(:,:))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21(:,:))
END IF
! Lagrangian variables
IF (LTRAJ) THEN
@@ -1426,7 +1430,7 @@ IF (LTRAJ) THEN
TZFIELD%CMNHNAME = TRIM(CLGNAMES(JSV-NSV_LGBEG+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A20,I3.3,A4)')'X_Y_Z_','Lagrangian variable ',JSV,' (M)'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
END DO
! X coordinate
DO JK=1,IKU
@@ -1440,7 +1444,7 @@ IF (LTRAJ) THEN
TZFIELD%CMNHNAME = 'X'
TZFIELD%CLONGNAME = 'X'
TZFIELD%CCOMMENT = 'X_Y_Z_X coordinate'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
! Y coordinate
DO JK=1,IKU
DO JI=1,IIU
@@ -1453,7 +1457,7 @@ IF (LTRAJ) THEN
TZFIELD%CMNHNAME = 'Y'
TZFIELD%CLONGNAME = 'Y'
TZFIELD%CCOMMENT = 'X_Y_Z_Y coordinate'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
END IF
! linox scalar variables
IF (.NOT.(LUSECHEM .OR. LCHEMDIAG) .AND. LCH_CONV_LINOX) THEN
@@ -1468,7 +1472,7 @@ IF (.NOT.(LUSECHEM .OR. LCHEMDIAG) .AND. LCH_CONV_LINOX) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E9)
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E9)
END DO
END IF
IF (LELECDIAG .AND. CELEC .NE. "NONE") THEN
@@ -1490,7 +1494,7 @@ IF (LELECDIAG .AND. CELEC .NE. "NONE") THEN
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3,A8)')'X_Y_Z_','SVT',JSV,' (nb ions/m3)'
END IF
ZWORK31(:,:,:)=XSVT(:,:,:,JSV) * XRHODREF(:,:,:) ! C/kg --> C/m3
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
END DO
END IF
! Sea Salt variables
@@ -1514,7 +1518,7 @@ IF (LSALT) THEN
TZFIELD%CMNHNAME = TRIM(UPCASE(CSALTNAMES(JSV-NSV_SLTBEG+1)))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','SALT',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E9)
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E9)
END DO
!
CALL PPP2SALT(XSVT(:,:,:,NSV_SLTBEG:NSV_SLTEND),XRHODREF,&
@@ -1528,30 +1532,30 @@ IF (LSALT) THEN
TZFIELD%LTIMEDEP = .TRUE.
!
DO JJ=1,NMODE_SLT
- TZFIELD%CMNHNAME = 'SLTRGA'
- TZFIELD%CLONGNAME = 'SLTRGA'
+ WRITE(TZFIELD%CMNHNAME,'(A6,I1)')'SLTRGA',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'um'
WRITE(TZFIELD%CCOMMENT,'(A18,I1)')'RG (nb) SALT MODE ',JJ
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZRG_SLT(:,:,:,JJ))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZRG_SLT(:,:,:,JJ))
!
- TZFIELD%CMNHNAME = 'SLTRGAM'
- TZFIELD%CLONGNAME = 'SLTRGAM'
+ WRITE(TZFIELD%CMNHNAME,'(A7,I1)')'SLTRGAM',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'um'
WRITE(TZFIELD%CCOMMENT,'(A17,I1)')'RG (m) SALT MODE ',JJ
ZWORK31(:,:,:)=ZRG_SLT(:,:,:,JJ) / (EXP(-3.*(LOG(ZSIG_SLT(:,:,:,JJ)))**2))
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
!
WRITE(TZFIELD%CMNHNAME,'(A6,I1)')'SLTN0A',JJ
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'm-3'
WRITE(TZFIELD%CCOMMENT,'(A13,I1)')'N0 SALT MODE ',JJ
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZN0_SLT(:,:,:,JJ))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZN0_SLT(:,:,:,JJ))
!
WRITE(TZFIELD%CMNHNAME,'(A7,I1)')'SLTSIGA',JJ
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = '1'
WRITE(TZFIELD%CCOMMENT,'(A16,I1)')'SIGMA SALT MODE ',JJ
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSIG_SLT(:,:,:,JJ))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSIG_SLT(:,:,:,JJ))
!SALT MASS CONCENTRATION
WRITE(TZFIELD%CMNHNAME,'(A4,I1)')'SLTMSS',JJ
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
@@ -1560,7 +1564,7 @@ IF (LSALT) THEN
ZWORK31(:,:,:)= ZN0_SLT(:,:,:,JJ)*4./3.*3.14*2500.*1e9 & !kg-->ug
* (ZRG_SLT(:,:,:,JJ)**3)*1.d-18 & !um-->m
* exp(4.5*log(ZSIG_SLT(:,:,:,JJ))*log(ZSIG_SLT(:,:,:,JJ)))
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
!SALT BURDEN (g/m2)
ZWORK21(:,:)=0.0
DO JK=IKB,IKE
@@ -1579,7 +1583,7 @@ IF (LSALT) THEN
TZFIELD%CUNITS = 'g m-2'
WRITE(TZFIELD%CCOMMENT,'(A6,I1)')'BURDEN',JJ
TZFIELD%NDIMS = 2
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK21)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
!
TZFIELD%NDIMS = 3
ENDDO
@@ -1600,7 +1604,7 @@ IF (LSALT.AND.LDEPOS_SLT(IMI)) THEN
TZFIELD%CMNHNAME = TRIM(UPCASE(CDESLTNAMES(JSV)))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','SALTDEP',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSSLTDEP(:,:,:,JSV)*1.E9)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSSLTDEP(:,:,:,JSV)*1.E9)
END DO
!
DO JJ=1,NMODE_SLT
@@ -1630,7 +1634,7 @@ IF (LSALT.AND.LDEPOS_SLT(IMI)) THEN
* XAVOGADRO & !==>#/mole
/ XMD & !==>#/kg_{air}
* XRHODREF(:,:,:) !==>#/m3
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
! CLOUD: DUST MASS CONCENTRATION
WRITE(TZFIELD%CMNHNAME,'(A9,I1)')'SLTDEPMSS',JJ
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
@@ -1639,7 +1643,7 @@ IF (LSALT.AND.LDEPOS_SLT(IMI)) THEN
ZWORK31(:,:,:)= ZWORK31(:,:,:)*4./3.*3.14*2500.*1e9 & !kg-->ug
* (ZRG_SLT(:,:,:,JJ)**3)*1.d-18 & !um-->m
* exp(4.5*log(ZSIG_SLT(:,:,:,JJ))*log(ZSIG_SLT(:,:,:,JJ)))
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
! FOR RAIN DROPS
WRITE(TZFIELD%CMNHNAME,'(A9,I1)')'SLTDEPN0A',JJ+NMODE_SLT
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
@@ -1666,7 +1670,7 @@ IF (LSALT.AND.LDEPOS_SLT(IMI)) THEN
* XAVOGADRO & !==>#/mole
/ XMD & !==>#/kg_{air}
* XRHODREF(:,:,:) !==>#/m3
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
! RAIN: DUST MASS CONCENTRATION
WRITE(TZFIELD%CMNHNAME,'(A9,I1)')'SLTDEPMSS',JJ+NMODE_SLT
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
@@ -1675,7 +1679,7 @@ IF (LSALT.AND.LDEPOS_SLT(IMI)) THEN
ZWORK31(:,:,:)= ZWORK31(:,:,:)*4./3.*3.14*2500.*1e9 & !kg-->ug
* (ZRG_SLT(:,:,:,JJ)**3)*1.d-18 & !um-->m
* exp(4.5*log(ZSIG_SLT(:,:,:,JJ))*log(ZSIG_SLT(:,:,:,JJ)))
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
END DO
!
END IF
@@ -1700,36 +1704,36 @@ IF (LDUST) THEN
TZFIELD%CMNHNAME = TRIM(UPCASE(CDUSTNAMES(JSV-NSV_DSTBEG+1)))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','DUST',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E9)
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E9)
END DO
!
CALL PPP2DUST(XSVT(:,:,:,NSV_DSTBEG:NSV_DSTEND),XRHODREF,&
PSIG3D=ZSIG_DST, PRG3D=ZRG_DST, PN3D=ZN0_DST)
DO JJ=1,NMODE_DST
- TZFIELD%CMNHNAME = 'DSTRGA'
- TZFIELD%CLONGNAME = 'DSTRGA'
+ WRITE(TZFIELD%CMNHNAME,'(A6,I1)')'DSTRGA',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'um'
WRITE(TZFIELD%CCOMMENT,'(A18,I1)')'RG (nb) DUST MODE ',JJ
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZRG_DST(:,:,:,JJ))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZRG_DST(:,:,:,JJ))
!
- TZFIELD%CMNHNAME = 'DSTRGAM'
- TZFIELD%CLONGNAME = 'DSTRGAM'
+ WRITE(TZFIELD%CMNHNAME,'(A7,I1)')'DSTRGAM',JJ
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'um'
WRITE(TZFIELD%CCOMMENT,'(A17,I1)')'RG (m) DUST MODE ',JJ
ZWORK31(:,:,:)=ZRG_DST(:,:,:,JJ) / (EXP(-3.*(LOG(ZSIG_DST(:,:,:,JJ)))**2))
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
!
WRITE(TZFIELD%CMNHNAME,'(A6,I1)')'DSTN0A',JJ
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'm-3'
WRITE(TZFIELD%CCOMMENT,'(A13,I1)')'N0 DUST MODE ',JJ
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZN0_DST(:,:,:,JJ))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZN0_DST(:,:,:,JJ))
!
WRITE(TZFIELD%CMNHNAME,'(A7,I1)')'DSTSIGA',JJ
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = '1'
WRITE(TZFIELD%CCOMMENT,'(A16,I1)')'SIGMA DUST MODE ',JJ
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSIG_DST(:,:,:,JJ))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSIG_DST(:,:,:,JJ))
!DUST MASS CONCENTRATION
WRITE(TZFIELD%CMNHNAME,'(A4,I1)')'DSTMSS',JJ
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
@@ -1738,7 +1742,7 @@ IF (LDUST) THEN
ZWORK31(:,:,:)= ZN0_DST(:,:,:,JJ)*4./3.*3.14*2500.*1e9 & !kg-->ug
* (ZRG_DST(:,:,:,JJ)**3)*1.d-18 & !um-->m
* exp(4.5*log(ZSIG_DST(:,:,:,JJ))*log(ZSIG_DST(:,:,:,JJ)))
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
!DUST BURDEN (g/m2)
ZWORK21(:,:)=0.0
DO JK=IKB,IKE
@@ -1757,7 +1761,7 @@ IF (LDUST) THEN
TZFIELD%CUNITS = 'g m-2'
WRITE(TZFIELD%CCOMMENT,'(A6,I1)')'BURDEN',JJ
TZFIELD%NDIMS = 2
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK21)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
!
TZFIELD%NDIMS = 3
ENDDO
@@ -1778,7 +1782,7 @@ IF (LDUST.AND.LDEPOS_DST(IMI)) THEN
TZFIELD%CMNHNAME = TRIM(UPCASE(CDEDSTNAMES(JSV)))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','DUSTDEP',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSDSTDEP(:,:,:,JSV)*1.E9)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSDSTDEP(:,:,:,JSV)*1.E9)
END DO
!
DO JJ=1,NMODE_DST
@@ -1808,7 +1812,7 @@ IF (LDUST.AND.LDEPOS_DST(IMI)) THEN
* XAVOGADRO & !==>#/mole
/ XMD & !==>#/kg_{air}
* XRHODREF(:,:,:) !==>#/m3
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
! CLOUD: DUST MASS CONCENTRATION
WRITE(TZFIELD%CMNHNAME,'(A9,I1)')'DSTDEPMSS',JJ
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
@@ -1817,7 +1821,7 @@ IF (LDUST.AND.LDEPOS_DST(IMI)) THEN
ZWORK31(:,:,:)= ZWORK31(:,:,:)*4./3.*3.14*2500.*1e9 & !kg-->ug
* (ZRG_DST(:,:,:,JJ)**3)*1.d-18 & !um-->m
* exp(4.5*log(ZSIG_DST(:,:,:,JJ))*log(ZSIG_DST(:,:,:,JJ)))
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
! FOR RAIN DROPS
WRITE(TZFIELD%CMNHNAME,'(A9,I1)')'DSTDEPN0A',JJ+NMODE_DST
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
@@ -1844,7 +1848,7 @@ IF (LDUST.AND.LDEPOS_DST(IMI)) THEN
* XAVOGADRO & !==>#/mole
/ XMD & !==>#/kg_{air}
* XRHODREF(:,:,:) !==>#/m3
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
! RAIN: DUST MASS CONCENTRATION
WRITE(TZFIELD%CMNHNAME,'(A9,I1)')'DSTDEPMSS',JJ+NMODE_DST
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
@@ -1853,7 +1857,7 @@ IF (LDUST.AND.LDEPOS_DST(IMI)) THEN
ZWORK31(:,:,:)= ZWORK31(:,:,:)*4./3.*3.14*2500.*1e9 & !kg-->ug
* (ZRG_DST(:,:,:,JJ)**3)*1.d-18 & !um-->m
* exp(4.5*log(ZSIG_DST(:,:,:,JJ))*log(ZSIG_DST(:,:,:,JJ)))
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
END DO
!
END IF
@@ -1871,7 +1875,7 @@ IF ((LCHEMDIAG).AND.(LORILAM).AND.(LUSECHEM)) THEN
TZFIELD%CMNHNAME = TRIM(UPCASE(CAERONAMES(JSV-NSV_AERBEG+1)))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','AERO',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E9)
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E9)
END DO
!
IF (.NOT.(ASSOCIATED(XN3D))) &
@@ -1888,132 +1892,132 @@ IF ((LCHEMDIAG).AND.(LORILAM).AND.(LUSECHEM)) THEN
TZFIELD%CLONGNAME = 'RGA'
TZFIELD%CUNITS = 'um'
WRITE(TZFIELD%CCOMMENT,'(A21,I1)')'RG (nb) AEROSOL MODE ',JJ
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XRG3D(:,:,:,JJ))
+ CALL IO_Field_write(TPFILE,TZFIELD,XRG3D(:,:,:,JJ))
!
TZFIELD%CMNHNAME = 'RGAM'
TZFIELD%CLONGNAME = 'RGAM'
TZFIELD%CUNITS = 'um'
WRITE(TZFIELD%CCOMMENT,'(A20,I1)')'RG (m) AEROSOL MODE ',JJ
ZWORK31(:,:,:)=XRG3D(:,:,:,JJ) / (EXP(-3.*(LOG(XSIG3D(:,:,:,JJ)))**2))
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
!
WRITE(TZFIELD%CMNHNAME,'(A3,I1)')'N0A',JJ
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'cm-3'
WRITE(TZFIELD%CCOMMENT,'(A16,I1)')'N0 AEROSOL MODE ',JJ
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XN3D(:,:,:,JJ)*1.E-6)
+ CALL IO_Field_write(TPFILE,TZFIELD,XN3D(:,:,:,JJ)*1.E-6)
!
WRITE(TZFIELD%CMNHNAME,'(A4,I1)')'SIGA',JJ
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = '1'
WRITE(TZFIELD%CCOMMENT,'(A19,I1)')'SIGMA AEROSOL MODE ',JJ
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XSIG3D(:,:,:,JJ))
+ CALL IO_Field_write(TPFILE,TZFIELD,XSIG3D(:,:,:,JJ))
!
WRITE(TZFIELD%CMNHNAME,'(A4,I1)')'MSO4',JJ
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'ug m-3'
WRITE(TZFIELD%CCOMMENT,'(A22,I1)')'MASS SO4 AEROSOL MODE ',JJ
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SO4,JJ))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SO4,JJ))
!
WRITE(TZFIELD%CMNHNAME,'(A4,I1)')'MNO3',JJ
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'ug m-3'
WRITE(TZFIELD%CCOMMENT,'(A22,I1)')'MASS NO3 AEROSOL MODE ',JJ
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_NO3,JJ))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_NO3,JJ))
!
WRITE(TZFIELD%CMNHNAME,'(A4,I1)')'MNH3',JJ
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'ug m-3'
WRITE(TZFIELD%CCOMMENT,'(A22,I1)')'MASS NH3 AEROSOL MODE ',JJ
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_NH3,JJ))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_NH3,JJ))
!
WRITE(TZFIELD%CMNHNAME,'(A4,I1)')'MH2O',JJ
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'ug m-3'
WRITE(TZFIELD%CCOMMENT,'(A22,I1)')'MASS H2O AEROSOL MODE ',JJ
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_H2O,JJ))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_H2O,JJ))
!
IF (NSOA .EQ. 10) THEN
WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA1',JJ
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'ug m-3'
WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA1 AEROSOL MODE ',JJ
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA1,JJ))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA1,JJ))
!
WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA2',JJ
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'ug m-3'
WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA2 AEROSOL MODE ',JJ
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA2,JJ))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA2,JJ))
!
WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA3',JJ
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'ug m-3'
WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA3 AEROSOL MODE ',JJ
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA3,JJ))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA3,JJ))
!
WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA4',JJ
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'ug m-3'
WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA4 AEROSOL MODE ',JJ
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA4,JJ))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA4,JJ))
!
WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA5',JJ
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'ug m-3'
WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA5 AEROSOL MODE ',JJ
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA5,JJ))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA5,JJ))
!
WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA6',JJ
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'ug m-3'
WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA6 AEROSOL MODE ',JJ
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA6,JJ))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA6,JJ))
!
WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA7',JJ
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'ug m-3'
WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA7 AEROSOL MODE ',JJ
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA7,JJ))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA7,JJ))
!
WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA8',JJ
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'ug m-3'
WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA8 AEROSOL MODE ',JJ
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA8,JJ))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA8,JJ))
!
WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA9',JJ
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'ug m-3'
WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA9 AEROSOL MODE ',JJ
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA9,JJ))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA9,JJ))
!
WRITE(TZFIELD%CMNHNAME,'(A6,I1)')'MSOA10',JJ
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'ug m-3'
WRITE(TZFIELD%CCOMMENT,'(A24,I1)')'MASS SOA10 AEROSOL MODE ',JJ
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA10,JJ))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA10,JJ))
END IF
!
WRITE(TZFIELD%CMNHNAME,'(A3,I1)')'MOC',JJ
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'ug m-3'
WRITE(TZFIELD%CCOMMENT,'(A21,I1)')'MASS OC AEROSOL MODE ',JJ
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_OC,JJ))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_OC,JJ))
!
WRITE(TZFIELD%CMNHNAME,'(A3,I1)')'MBC',JJ
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'ug m-3'
WRITE(TZFIELD%CCOMMENT,'(A21,I1)')'MASS BC AEROSOL MODE ',JJ
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_BC,JJ))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_BC,JJ))
ENDDO
END IF
!
!* Large Scale variables
!
IF (LVAR_LS) THEN
- CALL IO_WRITE_FIELD(TPFILE,'LSUM', XLSUM)
- CALL IO_WRITE_FIELD(TPFILE,'LSVM', XLSVM)
+ CALL IO_Field_write(TPFILE,'LSUM', XLSUM)
+ CALL IO_Field_write(TPFILE,'LSVM', XLSVM)
!
IF (LWIND_ZM) THEN
TZFIELD2(1)%CMNHNAME = 'LSUM_ZM'
@@ -2041,14 +2045,14 @@ IF (LVAR_LS) THEN
CALL UV_TO_ZONAL_AND_MERID(XLSUM,XLSVM,23,TPFILE=TPFILE,TZFIELDS=TZFIELD2)
ENDIF
!
- CALL IO_WRITE_FIELD(TPFILE,'LSWM', XLSWM)
- CALL IO_WRITE_FIELD(TPFILE,'LSTHM',XLSTHM)
+ CALL IO_Field_write(TPFILE,'LSWM', XLSWM)
+ CALL IO_Field_write(TPFILE,'LSTHM',XLSTHM)
!
IF (LUSERV) THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('LSRVM',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'g kg-1'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XLSRVM(:,:,:)*1.E3)
+ CALL IO_Field_write(TPFILE,TZFIELD,XLSRVM(:,:,:)*1.E3)
END IF
END IF
!
@@ -2069,7 +2073,7 @@ IF (LVAR_FRC .AND. LFORCING) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XUFRC(:,JT))
+ CALL IO_Field_write(TPFILE,TZFIELD,XUFRC(:,JT))
!
TZFIELD%CMNHNAME = 'VFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -2081,7 +2085,7 @@ IF (LVAR_FRC .AND. LFORCING) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XVFRC(:,JT))
+ CALL IO_Field_write(TPFILE,TZFIELD,XVFRC(:,JT))
!
TZFIELD%CMNHNAME = 'WFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -2093,7 +2097,7 @@ IF (LVAR_FRC .AND. LFORCING) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XWFRC(:,JT))
+ CALL IO_Field_write(TPFILE,TZFIELD,XWFRC(:,JT))
!
TZFIELD%CMNHNAME = 'THFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -2105,7 +2109,7 @@ IF (LVAR_FRC .AND. LFORCING) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XTHFRC(:,JT))
+ CALL IO_Field_write(TPFILE,TZFIELD,XTHFRC(:,JT))
!
TZFIELD%CMNHNAME = 'RVFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -2117,7 +2121,7 @@ IF (LVAR_FRC .AND. LFORCING) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XRVFRC(:,JT))
+ CALL IO_Field_write(TPFILE,TZFIELD,XRVFRC(:,JT))
!
TZFIELD%CMNHNAME = 'TENDTHFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -2129,7 +2133,7 @@ IF (LVAR_FRC .AND. LFORCING) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XTENDTHFRC(:,JT))
+ CALL IO_Field_write(TPFILE,TZFIELD,XTENDTHFRC(:,JT))
!
TZFIELD%CMNHNAME = 'TENDRVFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -2141,7 +2145,7 @@ IF (LVAR_FRC .AND. LFORCING) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XTENDRVFRC(:,JT))
+ CALL IO_Field_write(TPFILE,TZFIELD,XTENDRVFRC(:,JT))
!
TZFIELD%CMNHNAME = 'GXTHFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -2153,7 +2157,7 @@ IF (LVAR_FRC .AND. LFORCING) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XGXTHFRC(:,JT))
+ CALL IO_Field_write(TPFILE,TZFIELD,XGXTHFRC(:,JT))
!
TZFIELD%CMNHNAME = 'GYTHFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -2165,7 +2169,7 @@ IF (LVAR_FRC .AND. LFORCING) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XGYTHFRC(:,JT))
+ CALL IO_Field_write(TPFILE,TZFIELD,XGYTHFRC(:,JT))
!
TZFIELD%CMNHNAME = 'PGROUNDFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -2177,7 +2181,7 @@ IF (LVAR_FRC .AND. LFORCING) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XPGROUNDFRC(JT))
+ CALL IO_Field_write(TPFILE,TZFIELD,XPGROUNDFRC(JT))
!
END DO
END IF
@@ -2200,17 +2204,17 @@ IF (LTPZH .OR. LCOREF) THEN
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
ZWORK31(:,:,:)=ZTEMP(:,:,:) - XTT
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
!
!* Pressure in hPa
CALL FIND_FIELD_ID_FROM_MNHNAME('PABST',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CMNHNAME = 'PRES'
TZFIELD%CUNITS = 'hPa'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XPABST(:,:,:)*1E-2)
+ CALL IO_Field_write(TPFILE,TZFIELD,XPABST(:,:,:)*1E-2)
!
!* Geopotential in meters
- CALL IO_WRITE_FIELD(TPFILE,'ALT',XZZ)
+ CALL IO_Field_write(TPFILE,'ALT',XZZ)
!
!* Relative humidity in percent
IF (LUSERV) THEN
@@ -2238,7 +2242,7 @@ IF (LTPZH .OR. LCOREF) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK32)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK32)
!
TZFIELD%CMNHNAME = 'VPRES'
TZFIELD%CSTDNAME = 'water_vapor_partial_pressure_in_air'
@@ -2251,7 +2255,7 @@ IF (LTPZH .OR. LCOREF) THEN
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
ZWORK33(:,:,:)=ZWORK33(:,:,:)*ZWORK32(:,:,:)*1E-4
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK33)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33)
!
IF (LCOREF) THEN
ZWORK33(:,:,:)=(77.6*( XPABST(:,:,:)*1E-2 &
@@ -2267,7 +2271,7 @@ IF (LTPZH .OR. LCOREF) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK33)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33)
!
ZWORK33(:,:,:)=ZWORK33(:,:,:)+MZF(1,IKU,1,XZZ(:,:,:))*1E6/XRADIUS
TZFIELD%CMNHNAME = 'MCOREF'
@@ -2280,7 +2284,7 @@ IF (LTPZH .OR. LCOREF) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK33)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33)
END IF
ELSE
PRINT*, 'NO WATER VAPOR IN ',TPFILE%CNAME,' RELATIVE HUMIDITY IS NOT COMPUTED'
@@ -2321,7 +2325,7 @@ IF ( LMOIST_V .OR. LMSLP .OR. CBLTOP/='NONE' ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZTHETAV)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZTHETAV)
END IF
!
END IF
@@ -2354,7 +2358,7 @@ IF (LVISI) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZVISIKUN)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZVISIKUN)
!
IF ((CCLOUD == 'C2R2') .OR. (CCLOUD =='KHKO')) THEN
ZVISIGUL(:,:,:) = 10000.
@@ -2374,7 +2378,7 @@ IF (LVISI) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZVISIGUL)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZVISIGUL)
! Visibity Zhang
TZFIELD%CMNHNAME = 'VISIZHA'
TZFIELD%CSTDNAME = ''
@@ -2386,7 +2390,7 @@ IF (LVISI) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZVISIZHA)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZVISIZHA)
!
DEALLOCATE(ZVISIGUL,ZVISIZHA)
END IF
@@ -2421,7 +2425,7 @@ IF (( LMOIST_E .OR. LBV_FR ) .AND. (NRR>0)) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZTHETAE)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZTHETAE)
END IF
END IF
!-------------------------------------------------------------------------------
@@ -2447,7 +2451,7 @@ IF (LMOIST_ES .AND. (NRR>0)) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZTHETAES)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZTHETAES)
ENDIF
!
!-------------------------------------------------------------------------------
@@ -2498,7 +2502,7 @@ IF ( LMOIST_L .OR. LMOIST_S1 .OR. LMOIST_S2 ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZTHETAL)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZTHETAL)
END IF
!
END IF
@@ -2553,7 +2557,7 @@ IF ( LMOIST_S1 .OR. LMOIST_S2 ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZTHETAS1)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZTHETAS1)
END IF
IF (LMOIST_S2) THEN
! The Moist-air Entropy potential temperature (2nd order)
@@ -2567,7 +2571,7 @@ IF ( LMOIST_S1 .OR. LMOIST_S2 ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZTHETAS2)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZTHETAS2)
END IF
!
END IF
@@ -2590,7 +2594,7 @@ IF (LVORT) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
!
! Vorticity y
ZWORK32(:,:,:)=MZF(1,IKU,1,MXF(MYM(ZVOY(:,:,:))))
@@ -2604,7 +2608,7 @@ IF (LVORT) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK32)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK32)
!
IF (LWIND_ZM) THEN
TZFIELD2(1)%CMNHNAME = 'UM1_ZM'
@@ -2644,7 +2648,7 @@ IF (LVORT) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
!
! Absolute Vorticity
ZWORK31(:,:,:)=MYF(MXF(ZVOZ(:,:,:))) + ZCORIOZ(:,:,:)
@@ -2658,7 +2662,7 @@ IF (LVORT) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
!
END IF
!
@@ -2690,7 +2694,7 @@ IF ( LMEAN_POVO ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK21)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
END IF
!
! Virtual Potential Vorticity in PV units
@@ -2712,7 +2716,7 @@ IF (LMOIST_V .AND. (NRR>0) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK34)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK34)
!
IF (LMEAN_POVO) THEN
IWORK1(:,:)=0
@@ -2734,7 +2738,7 @@ IF (LMOIST_V .AND. (NRR>0) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK21)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
END IF
END IF
!
@@ -2758,7 +2762,7 @@ IF (LMOIST_E .AND. (NRR>0) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK34)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK34)
!
IF (LMEAN_POVO) THEN
IWORK1(:,:)=0
@@ -2780,7 +2784,7 @@ IF (LMOIST_E .AND. (NRR>0) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK21)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
DEALLOCATE(IWORK1)
END IF
!
@@ -2805,7 +2809,7 @@ IF (LMOIST_ES .AND. (NRR>0) ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK34)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK34)
ENDIF
!
!
@@ -2826,7 +2830,7 @@ IF (LDIV) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
!
IF (LUSERV) THEN
TZFIELD%CMNHNAME = 'HMDIV'
@@ -2842,7 +2846,7 @@ IF (LDIV) THEN
ZWORK31=MXM(XRHODREF*XRT(:,:,:,1))*XUT
ZWORK32=MYM(XRHODREF*XRT(:,:,:,1))*XVT
ZWORK33=GX_U_M(1,IKU,1,ZWORK31,XDXX,XDZZ,XDZX) + GY_V_M(1,IKU,1,ZWORK32,XDYY,XDZZ,XDZY)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK33)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33)
END IF
!
ENDIF
@@ -2874,7 +2878,7 @@ IF (LCLSTR) THEN
TZFIELD%NTYPE = TYPEINT
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ICLUSTERID)
+ CALL IO_Field_write(TPFILE,TZFIELD,ICLUSTERID)
!
TZFIELD%CMNHNAME = 'CLUSTERLV'
TZFIELD%CSTDNAME = ''
@@ -2886,7 +2890,7 @@ IF (LCLSTR) THEN
TZFIELD%NTYPE = TYPEINT
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ICLUSTERLV)
+ CALL IO_Field_write(TPFILE,TZFIELD,ICLUSTERLV)
!
TZFIELD%CMNHNAME = 'CLDSIZE'
TZFIELD%CSTDNAME = ''
@@ -2898,7 +2902,7 @@ IF (LCLSTR) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZCLDSIZE)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZCLDSIZE)
END IF
!
!-------------------------------------------------------------------------------
@@ -2951,7 +2955,7 @@ IF (LGEO .OR. LAGEO) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
!
TZFIELD%CMNHNAME = 'VM88'
TZFIELD%CSTDNAME = ''
@@ -2963,7 +2967,7 @@ IF (LGEO .OR. LAGEO) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK32)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK32)
!
IF (LWIND_ZM) THEN
TZFIELD2(1)%CMNHNAME = 'UM88_ZM'
@@ -2996,7 +3000,7 @@ IF (LGEO .OR. LAGEO) THEN
TZFIELD = TFIELDLIST(IID)
TZFIELD%CMNHNAME = 'WM88'
TZFIELD%CLONGNAME = 'WM88'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XWT)
+ CALL IO_Field_write(TPFILE,TZFIELD,XWT)
END IF
!
IF (LAGEO) THEN
@@ -3013,7 +3017,7 @@ IF (LGEO .OR. LAGEO) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
!
TZFIELD%CMNHNAME = 'VM89'
TZFIELD%CSTDNAME = ''
@@ -3025,7 +3029,7 @@ IF (LGEO .OR. LAGEO) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK32)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK32)
!
IF (LWIND_ZM) THEN
TZFIELD2(1)%CMNHNAME = 'UM89_ZM'
@@ -3058,7 +3062,7 @@ IF (LGEO .OR. LAGEO) THEN
TZFIELD = TFIELDLIST(IID)
TZFIELD%CMNHNAME = 'WM89'
TZFIELD%CLONGNAME = 'WM89'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XWT)
+ CALL IO_Field_write(TPFILE,TZFIELD,XWT)
END IF
!
END IF
@@ -3082,7 +3086,7 @@ IF(LWIND_CONTRAV) THEN!$
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK33)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33)
END IF
!-------------------------------------------------------------------------------
!
@@ -3115,7 +3119,7 @@ IF (LMSLP) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK22)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK22)
END IF
!-------------------------------------------------------------------------------
!
@@ -3140,7 +3144,7 @@ IF (LTHW) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK21)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
END IF
!
ZWORK21(:,:) = 0.
@@ -3160,7 +3164,7 @@ IF (LTHW) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK21)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
END IF
!
ZWORK21(:,:) = 0.
@@ -3180,7 +3184,7 @@ IF (LTHW) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK21)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
END IF
!
ZWORK21(:,:) = 0.
@@ -3200,7 +3204,7 @@ IF (LTHW) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK21)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
END IF
!
ZWORK21(:,:) = 0.
@@ -3220,7 +3224,7 @@ IF (LTHW) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK21)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
END IF
!
ZWORK21(:,:) = 0.
@@ -3240,7 +3244,7 @@ IF (LTHW) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK21)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
END IF
!
ZWORK21(:,:) = 0.
@@ -3260,7 +3264,7 @@ IF (LTHW) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK21)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
END IF
END IF
!
@@ -3301,7 +3305,7 @@ IF (LTOTAL_PR .AND. SIZE (XACPRR)>0 ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK21)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
ELSE
PRINT * ,'YOU WANT TO COMPUTE THE ACCUMULATED RAIN'
PRINT * ,'BUT NO RAIN IS PRESENT IN THE MODEL'
@@ -3327,7 +3331,7 @@ IF (LTOTAL_PR .AND. SIZE (XACPRR)>0 ) THEN
JJ=INT(XMEAN_PR(JK+1))
WRITE(TZFIELD%CMNHNAME,'(A9,2I2.2)')'LS_ACTOPR',JI,JJ
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK22)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK22)
END IF
END DO
!
@@ -3366,7 +3370,7 @@ IF (LTOTAL_PR .AND. SIZE (XACPRR)>0 ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK21)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
ELSE
PRINT * ,'YOU WANT TO COMPUTE THE RAIN RATE'
PRINT * ,'BUT NO RAIN IS PRESENT IN THE MODEL'
@@ -3386,7 +3390,7 @@ IF (LTOTAL_PR .AND. SIZE (XACPRR)>0 ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK22)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK22)
END IF
!
END IF
@@ -3415,7 +3419,7 @@ IF (NCAPE >=0 .AND. LUSERV) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK21)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
!
TZFIELD%CMNHNAME = 'CINMAX'
TZFIELD%CSTDNAME = ''
@@ -3427,7 +3431,7 @@ IF (NCAPE >=0 .AND. LUSERV) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK22)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK22)
!
IF (NCAPE >=1) THEN
TZFIELD%CMNHNAME = 'CAPE3D'
@@ -3440,7 +3444,7 @@ IF (NCAPE >=0 .AND. LUSERV) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK32)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK32)
!
TZFIELD%CMNHNAME = 'CIN3D'
TZFIELD%CSTDNAME = 'atmosphere_convective_inhibition'
@@ -3452,7 +3456,7 @@ IF (NCAPE >=0 .AND. LUSERV) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK33)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33)
!
TZFIELD%CMNHNAME = 'DCAPE3D'
TZFIELD%CSTDNAME = ''
@@ -3464,7 +3468,7 @@ IF (NCAPE >=0 .AND. LUSERV) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK34)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK34)
END IF
!
IF (NCAPE >=2) THEN
@@ -3482,7 +3486,7 @@ IF (NCAPE >=0 .AND. LUSERV) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
END IF
ENDIF
!
@@ -3514,7 +3518,7 @@ IF (LBV_FR) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
!
IF (NRR > 0) THEN
ZWORK32(:,:,:)=DZM(1,IKU,1,ZTHETAE(:,:,:))/ MZM(1,IKU,1,ZTHETAE(:,:,:))
@@ -3540,7 +3544,7 @@ IF (LBV_FR) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
END IF
END IF
!
@@ -3568,7 +3572,7 @@ IF ( NGPS>=0 ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK22)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK22)
!
IF (NGPS>=1) THEN
TZFIELD%CMNHNAME = 'ZHD'
@@ -3581,7 +3585,7 @@ IF ( NGPS>=0 ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK23)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK23)
!
TZFIELD%CMNHNAME = 'ZWD'
TZFIELD%CSTDNAME = ''
@@ -3593,7 +3597,7 @@ IF ( NGPS>=0 ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK24)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK24)
!
END IF
!
@@ -3638,7 +3642,7 @@ IF(LRADAR .AND. LUSERR) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
!
TZFIELD%CMNHNAME = 'VDOP'
TZFIELD%CSTDNAME = ''
@@ -3650,7 +3654,7 @@ IF(LRADAR .AND. LUSERR) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK32)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK32)
!
TZFIELD%CMNHNAME = 'ZDR'
TZFIELD%CSTDNAME = ''
@@ -3662,7 +3666,7 @@ IF(LRADAR .AND. LUSERR) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK33)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33)
!
TZFIELD%CMNHNAME = 'KDP'
TZFIELD%CSTDNAME = ''
@@ -3674,7 +3678,7 @@ IF(LRADAR .AND. LUSERR) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK34)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK34)
!
ELSE
!
@@ -3831,8 +3835,8 @@ IF(LRADAR .AND. LUSERR) THEN
WRITE(YGRID_SIZE,'(I3.3)') 2*NMAX
DO JJ=1,SIZE(ZWORK42(:,:,:,:,:),5)
YRS=YRAD(JJ)//CNAME_RAD(JI)(1:3)//YELEV//YGRID_SIZE//TRIM(TPFILE%CNAME)
- CALL IO_FILE_ADD2LIST(TZRSFILE,YRS,'TXT','WRITE',KRECL=8192)
- CALL IO_FILE_OPEN_ll(TZRSFILE,HSTATUS='NEW')
+ CALL IO_File_add2list(TZRSFILE,YRS,'TXT','WRITE',KRECL=8192)
+ CALL IO_File_open(TZRSFILE,HSTATUS='NEW')
ILURS = TZRSFILE%NLU
WRITE(ILURS,'(A,4F12.6,2I5)') '**domaine LATLON ',ZWORK43(JI,1,1),ZWORK43(JI,4*NMAX-1,2*NMAX), &
ZWORK43(JI,2,1),ZWORK43(JI,4*NMAX,2*NMAX),2*NMAX,2*NMAX !! HEADER
@@ -3846,14 +3850,14 @@ IF(LRADAR .AND. LUSERR) THEN
DO JV=2*NMAX,1,-1
WRITE(ILURS,*) CLATLON(JV)
END DO
- CALL IO_FILE_CLOSE_ll(TZRSFILE)
+ CALL IO_File_close(TZRSFILE)
TZRSFILE => NULL()
END DO
END DO
DEALLOCATE(CLATLON)
END DO
ELSE ! polar output
- CALL MPI_ALLREDUCE(ZWORK42, ZWORK42_BIS, SIZE(ZWORK42), MPI_PRECISION, MPI_MAX, NMNH_COMM_WORLD, IERR)
+ CALL MPI_ALLREDUCE(ZWORK42, ZWORK42_BIS, SIZE(ZWORK42), MNHREAL_MPI, MPI_MAX, NMNH_COMM_WORLD, IERR)
DO JI=1,NBRAD
IEL=NBELEV(JI)
DO JEL=1,IEL
@@ -3861,15 +3865,15 @@ IF(LRADAR .AND. LUSERR) THEN
INT(ANINT(10.*XELEV(JI,JEL))-10*INT(XELEV(JI,JEL)))
DO JJ=1,SIZE(ZWORK42(:,:,:,:,:),5)
YRS="P"//YRAD(JJ)//CNAME_RAD(JI)(1:3)//YELEV//TRIM(TPFILE%CNAME)
- CALL IO_FILE_ADD2LIST(TZRSFILE,YRS,'TXT','WRITE')
- CALL IO_FILE_OPEN_ll(TZRSFILE)
+ CALL IO_File_add2list(TZRSFILE,YRS,'TXT','WRITE')
+ CALL IO_File_open(TZRSFILE)
ILURS = TZRSFILE%NLU
DO JH=1,NBAZIM
DO JV=1,NBSTEPMAX+1
WRITE(ILURS,"(F15.7)") ZWORK42_BIS(JI,JEL,JH,JV,JJ)
END DO
END DO
- CALL IO_FILE_CLOSE_ll(TZRSFILE)
+ CALL IO_File_close(TZRSFILE)
TZRSFILE => NULL()
END DO
END DO
@@ -3982,7 +3986,7 @@ IF (LLIDAR) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
!
TZFIELD%CMNHNAME = 'LIPAR'
TZFIELD%CSTDNAME = ''
@@ -3994,7 +3998,7 @@ IF (LLIDAR) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK32)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK32)
!
END IF
!
@@ -4038,7 +4042,7 @@ IF (CBLTOP == 'THETA') THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSHMIX)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSHMIX)
!
DEALLOCATE(ZSHMIX)
ELSEIF (CBLTOP == 'RICHA') THEN
@@ -4082,7 +4086,7 @@ ELSEIF (CBLTOP == 'RICHA') THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSHMIX)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSHMIX)
!
DEALLOCATE(ZRIB,ZSHMIX)
ENDIF
@@ -4099,10 +4103,10 @@ IF (ALLOCATED(ZTHETAV)) DEALLOCATE(ZTHETAV)
!* Ligthning
!
IF ( LCH_CONV_LINOX ) THEN
- CALL IO_WRITE_FIELD(TPFILE,'IC_RATE', XIC_RATE)
- CALL IO_WRITE_FIELD(TPFILE,'CG_RATE', XCG_RATE)
- CALL IO_WRITE_FIELD(TPFILE,'IC_TOTAL_NB',XIC_TOTAL_NUMBER)
- CALL IO_WRITE_FIELD(TPFILE,'CG_TOTAL_NB',XCG_TOTAL_NUMBER)
+ CALL IO_Field_write(TPFILE,'IC_RATE', XIC_RATE)
+ CALL IO_Field_write(TPFILE,'CG_RATE', XCG_RATE)
+ CALL IO_Field_write(TPFILE,'IC_TOTAL_NB',XIC_TOTAL_NUMBER)
+ CALL IO_Field_write(TPFILE,'CG_TOTAL_NB',XCG_TOTAL_NUMBER)
END IF
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
diff --git a/src/MNH/write_lfifm1_for_diag_supp.f90 b/src/MNH/write_lfifm1_for_diag_supp.f90
index 1c0b42a312e96be3d7e7a33a828d635dad301fb5..4908ec514781ac6d48a5ffeb717a3024e9f4007e 100644
--- a/src/MNH/write_lfifm1_for_diag_supp.f90
+++ b/src/MNH/write_lfifm1_for_diag_supp.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2000-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-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.
!-----------------------------------------------------------------
! ######################################
@@ -10,7 +10,7 @@ INTERFACE
!
SUBROUTINE WRITE_LFIFM1_FOR_DIAG_SUPP(TPFILE)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
!* 0.1 Declarations of arguments
!
@@ -96,7 +96,7 @@ END MODULE MODI_WRITE_LFIFM1_FOR_DIAG_SUPP
!
USE MODE_ll
USE MODD_CST
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_CONF_n
USE MODD_CONF
@@ -157,7 +157,7 @@ USE MODI_RADTR_SATEL
USE MODI_UV_TO_ZONAL_AND_MERID
!
USE MODE_FIELD
-USE MODE_FMWRIT
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
!
USE MODI_GET_SURF_UNDEF
!
@@ -242,7 +242,7 @@ ZTEMP(:,:,:)=XTHT(:,:,:)*(XPABST(:,:,:)/ XP00) **(XRD/XCPD)
!
IF (NCONV_KF >= 0) THEN
!
- CALL IO_WRITE_FIELD(TPFILE,'CAPE',XCAPE)
+ CALL IO_Field_write(TPFILE,'CAPE',XCAPE)
!
! top height (km) of convective clouds
ZWORK21(:,:)= 0.
@@ -261,7 +261,7 @@ IF (NCONV_KF >= 0) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK21)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
!
! base height (km) of convective clouds
ZWORK21(:,:)= 0.
@@ -280,15 +280,15 @@ IF (NCONV_KF >= 0) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK21)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
!
END IF
IF (NCONV_KF >= 1) THEN
!
- CALL IO_WRITE_FIELD(TPFILE,'DTHCONV',XDTHCONV)
- CALL IO_WRITE_FIELD(TPFILE,'DRVCONV',XDRVCONV)
- CALL IO_WRITE_FIELD(TPFILE,'DRCCONV',XDRCCONV)
- CALL IO_WRITE_FIELD(TPFILE,'DRICONV',XDRICONV)
+ CALL IO_Field_write(TPFILE,'DTHCONV',XDTHCONV)
+ CALL IO_Field_write(TPFILE,'DRVCONV',XDRVCONV)
+ CALL IO_Field_write(TPFILE,'DRCCONV',XDRCCONV)
+ CALL IO_Field_write(TPFILE,'DRICONV',XDRICONV)
!
IF ( LCHTRANS .AND. NSV > 0 ) THEN
! User scalar variables
@@ -305,7 +305,7 @@ IF (NCONV_KF >= 1) THEN
WRITE(TZFIELD%CMNHNAME,'(A7,I3.3)')'DSVCONV',JSV
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A2,I3.3,A20)')'X_Y_Z_','SV',JSV,' CONVective tendency'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
END DO
END IF
! microphysical C2R2 scheme scalar variables
@@ -322,7 +322,7 @@ IF (NCONV_KF >= 1) THEN
TZFIELD%CMNHNAME = 'DSVCONV_'//TRIM(C2R2NAMES(JSV-NSV_C2R2BEG+1))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(C2R2NAMES(JSV-NSV_C2R2BEG+1))//' CONVective tendency'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
END DO
END IF
! microphysical C3R5 scheme additional scalar variables
@@ -339,7 +339,7 @@ IF (NCONV_KF >= 1) THEN
TZFIELD%CMNHNAME = 'DSVCONV_'//TRIM(C1R3NAMES(JSV-NSV_C1R3BEG+1))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(C1R3NAMES(JSV-NSV_C1R3BEG+1))//' CONVective tendency'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
END DO
END IF
! electrical scalar variables
@@ -356,7 +356,7 @@ IF (NCONV_KF >= 1) THEN
TZFIELD%CMNHNAME = 'DSVCONV_'//TRIM(CELECNAMES(JSV-NSV_ELECBEG+1))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(CELECNAMES(JSV-NSV_ELECBEG+1))//' CONVective tendency'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
END DO
END IF
! chemical scalar variables
@@ -373,7 +373,7 @@ IF (NCONV_KF >= 1) THEN
TZFIELD%CMNHNAME = 'DSVCONV_'//TRIM(CNAMES(JSV-NSV_CHEMBEG+1))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(CNAMES(JSV-NSV_CHEMBEG+1))//' CONVective tendency'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
END DO
END IF
! lagrangian variables
@@ -390,17 +390,17 @@ IF (NCONV_KF >= 1) THEN
TZFIELD%CMNHNAME = 'DSVCONV_'//TRIM(CLGNAMES(JSV-NSV_LGBEG+1))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(CLGNAMES(JSV-NSV_LGBEG+1))//' CONVective tendency'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
END DO
END IF
END IF
!
END IF
IF (NCONV_KF >= 2) THEN
- CALL IO_WRITE_FIELD(TPFILE,'PRLFLXCONV',XPRLFLXCONV)
- CALL IO_WRITE_FIELD(TPFILE,'PRSFLXCONV',XPRSFLXCONV)
- CALL IO_WRITE_FIELD(TPFILE,'UMFCONV', XUMFCONV)
- CALL IO_WRITE_FIELD(TPFILE,'DMFCONV', XDMFCONV)
+ CALL IO_Field_write(TPFILE,'PRLFLXCONV',XPRLFLXCONV)
+ CALL IO_Field_write(TPFILE,'PRSFLXCONV',XPRSFLXCONV)
+ CALL IO_Field_write(TPFILE,'UMFCONV', XUMFCONV)
+ CALL IO_Field_write(TPFILE,'DMFCONV', XDMFCONV)
END IF
!-------------------------------------------------------------------------------
!
@@ -461,7 +461,7 @@ IF (LCLD_COV .AND. LUSERC) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK21)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
!
! Higher top of the different species of clouds
!
@@ -498,7 +498,7 @@ IF (LCLD_COV .AND. LUSERC) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK21)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
ENDIF
!
TZFIELD%CMNHNAME = 'TCL'
@@ -511,9 +511,9 @@ IF (LCLD_COV .AND. LUSERC) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK22)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK22)
!
- CALL IO_WRITE_FIELD(TPFILE,'CLDFR',XCLDFR)
+ CALL IO_Field_write(TPFILE,'CLDFR',XCLDFR)
!
! Visibility
!
@@ -532,7 +532,7 @@ IF (LCLD_COV .AND. LUSERC) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
!
DEALLOCATE(IWORK1,IWORK2,ICL_HE_ST,GMASK2,ZWORK22)
END IF
@@ -544,24 +544,24 @@ END IF
!
IF (NRAD_3D >= 0) THEN
IF (CRAD /= 'NONE') THEN
- CALL IO_WRITE_FIELD(TPFILE,'DTHRAD', XDTHRAD)
- CALL IO_WRITE_FIELD(TPFILE,'FLALWD', XFLALWD)
- CALL IO_WRITE_FIELD(TPFILE,'DIRFLASWD', XDIRFLASWD)
- CALL IO_WRITE_FIELD(TPFILE,'SCAFLASWD', XSCAFLASWD)
- CALL IO_WRITE_FIELD(TPFILE,'DIRSRFSWD', XDIRSRFSWD)
- CALL IO_WRITE_FIELD(TPFILE,'CLEARCOL_TM1',NCLEARCOL_TM1)
- CALL IO_WRITE_FIELD(TPFILE,'ZENITH', XZENITH)
- CALL IO_WRITE_FIELD(TPFILE,'AZIM', XAZIM)
- CALL IO_WRITE_FIELD(TPFILE,'DIR_ALB', XDIR_ALB)
- CALL IO_WRITE_FIELD(TPFILE,'SCA_ALB', XSCA_ALB)
+ CALL IO_Field_write(TPFILE,'DTHRAD', XDTHRAD)
+ CALL IO_Field_write(TPFILE,'FLALWD', XFLALWD)
+ CALL IO_Field_write(TPFILE,'DIRFLASWD', XDIRFLASWD)
+ CALL IO_Field_write(TPFILE,'SCAFLASWD', XSCAFLASWD)
+ CALL IO_Field_write(TPFILE,'DIRSRFSWD', XDIRSRFSWD)
+ CALL IO_Field_write(TPFILE,'CLEARCOL_TM1',NCLEARCOL_TM1)
+ CALL IO_Field_write(TPFILE,'ZENITH', XZENITH)
+ CALL IO_Field_write(TPFILE,'AZIM', XAZIM)
+ CALL IO_Field_write(TPFILE,'DIR_ALB', XDIR_ALB)
+ CALL IO_Field_write(TPFILE,'SCA_ALB', XSCA_ALB)
!
CALL PRINT_MSG(NVERB_INFO,'IO','WRITE_LFIFM1_FOR_DIAG_SUPP','EMIS: writing only first band')
CALL FIND_FIELD_ID_FROM_MNHNAME('EMIS',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%NDIMS = 2
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XEMIS(:,:,1))
+ CALL IO_Field_write(TPFILE,TZFIELD,XEMIS(:,:,1))
!
- CALL IO_WRITE_FIELD(TPFILE,'TSRAD', XTSRAD)
+ CALL IO_Field_write(TPFILE,'TSRAD', XTSRAD)
ELSE
PRINT*,'YOU WANT DIAGNOSTICS RELATED TO RADIATION'
PRINT*,' BUT NO RADIATIVE SCHEME WAS ACTIVATED IN THE MODEL'
@@ -585,7 +585,7 @@ IF (NRAD_3D >= 1) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
!Dust optical depth
ZWORK21(:,:)=0.0
DO JK=IKB,IKE
@@ -606,7 +606,7 @@ IF (NRAD_3D >= 1) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK21)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
!Dust extinction (optical depth per km)
DO JK=IKB,IKE
IKRAD = JK - JPVEXT
@@ -622,7 +622,7 @@ IF (NRAD_3D >= 1) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
END IF
IF (LSALT) THEN
!Salt optical depth between two vertical levels
@@ -641,7 +641,7 @@ IF (NRAD_3D >= 1) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
!Salt optical depth
ZWORK21(:,:)=0.0
DO JK=IKB,IKE
@@ -662,7 +662,7 @@ IF (NRAD_3D >= 1) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK21)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
!Salt extinction (optical depth per km)
DO JK=IKB,IKE
IKRAD = JK - JPVEXT
@@ -678,7 +678,7 @@ IF (NRAD_3D >= 1) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
END IF
IF (LORILAM) THEN
!Orilam anthropogenic optical depth between two vertical levels
@@ -697,7 +697,7 @@ IF (NRAD_3D >= 1) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
!Orilam anthropogenic optical depth
ZWORK21(:,:)=0.0
DO JK=IKB,IKE
@@ -718,7 +718,7 @@ IF (NRAD_3D >= 1) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK21)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
!Orilam anthropogenic extinction (optical depth per km)
DO JK=IKB,IKE
IKRAD = JK - JPVEXT
@@ -734,7 +734,7 @@ IF (NRAD_3D >= 1) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
END IF
END IF
!
@@ -756,7 +756,7 @@ IF (LCHEMDIAG) THEN
TZFIELD%CMNHNAME = 'FLX_'//TRIM(CNAMES(JSV-NSV_CHEMBEG+1))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A,A)')'X_Y_Z_',TRIM(CNAMES(JSV-NSV_CHEMBEG+1)),' Net chemical flux'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XCHFLX(:,:,JSV-NSV_CHEMBEG+1) * 1E9)
+ CALL IO_Field_write(TPFILE,TZFIELD,XCHFLX(:,:,JSV-NSV_CHEMBEG+1) * 1E9)
END DO
END IF
!-------------------------------------------------------------------------------
@@ -817,7 +817,7 @@ IF (LEN_TRIM(CRAD_SAT) /= 0 .AND. NRR /=0) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZIRBT)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZIRBT)
!
TZFIELD%CMNHNAME = TRIM(YNAM_SAT(JI))//'_WVBT'
TZFIELD%CSTDNAME = ''
@@ -829,7 +829,7 @@ IF (LEN_TRIM(CRAD_SAT) /= 0 .AND. NRR /=0) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWVBT)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWVBT)
END DO
DEALLOCATE(ZIRBT,ZWVBT)
END IF
@@ -926,7 +926,7 @@ IF (CSURF=='EXTE') THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XCURRENT_ZON10M)
+ CALL IO_Field_write(TPFILE,TZFIELD,XCURRENT_ZON10M)
!
TZFIELD%CMNHNAME = 'VM10'
TZFIELD%CSTDNAME = ''
@@ -938,7 +938,7 @@ IF (CSURF=='EXTE') THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XCURRENT_MER10M)
+ CALL IO_Field_write(TPFILE,TZFIELD,XCURRENT_MER10M)
ENDIF
!
IF (SIZE(XTKET)>0) THEN
@@ -954,7 +954,7 @@ IF (CSURF=='EXTE') THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK21)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
END IF
!
IF(ANY(XCURRENT_SFCO2/=XUNDEF))THEN
@@ -968,7 +968,7 @@ IF (CSURF=='EXTE') THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XCURRENT_SFCO2)
+ CALL IO_Field_write(TPFILE,TZFIELD,XCURRENT_SFCO2)
END IF
!
IF(ANY(XCURRENT_SWD/=XUNDEF))THEN
@@ -982,7 +982,7 @@ IF (CSURF=='EXTE') THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XCURRENT_SWD)
+ CALL IO_Field_write(TPFILE,TZFIELD,XCURRENT_SWD)
END IF
!
IF(ANY(XCURRENT_SWU/=XUNDEF))THEN
@@ -996,7 +996,7 @@ IF (CSURF=='EXTE') THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XCURRENT_SWU)
+ CALL IO_Field_write(TPFILE,TZFIELD,XCURRENT_SWU)
END IF
!
IF(ANY(XCURRENT_LWD/=XUNDEF))THEN
@@ -1010,7 +1010,7 @@ IF (CSURF=='EXTE') THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XCURRENT_LWD)
+ CALL IO_Field_write(TPFILE,TZFIELD,XCURRENT_LWD)
END IF
!
IF(ANY(XCURRENT_LWU/=XUNDEF))THEN
@@ -1024,7 +1024,7 @@ IF (CSURF=='EXTE') THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XCURRENT_LWD)
+ CALL IO_Field_write(TPFILE,TZFIELD,XCURRENT_LWD)
END IF
END IF
@@ -1083,7 +1083,7 @@ ALLOCATE(ZWORK34(IIU,IJU,IKU))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'K'
TZFIELD%CCOMMENT = 'X_Y_potential temperature '//TRIM(YPRES(JK))//' hPa'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWRES(:,:,JK))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
END DO
! *********************
! Wind
@@ -1096,7 +1096,7 @@ ALLOCATE(ZWORK34(IIU,IJU,IKU))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'm s-1'
TZFIELD%CCOMMENT = 'X_Y_U component of wind '//TRIM(YPRES(JK))//' hPa'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWRES(:,:,JK))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
END DO
!
ZWORK31(:,:,:) = MYF(XVT(:,:,:))
@@ -1107,7 +1107,7 @@ ALLOCATE(ZWORK34(IIU,IJU,IKU))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'm s-1'
TZFIELD%CCOMMENT = 'X_Y_V component of wind '//TRIM(YPRES(JK))//' hPa'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWRES(:,:,JK))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
END DO
! *********************
! Water Vapour Mixing Ratio
@@ -1119,7 +1119,7 @@ ALLOCATE(ZWORK34(IIU,IJU,IKU))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'g kg-1'
TZFIELD%CCOMMENT = 'X_Y_Vapor Mixing Ratio '//TRIM(YPRES(JK))//' hPa'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWRES(:,:,JK)*1.E3)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK)*1.E3)
END DO
! *********************
! Geopotential in meters
@@ -1132,7 +1132,7 @@ ALLOCATE(ZWORK34(IIU,IJU,IKU))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'm'
TZFIELD%CCOMMENT = 'X_Y_ALTitude '//TRIM(YPRES(JK))//' hPa'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWRES(:,:,JK))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
END DO
!
DEALLOCATE(ZWRES,ZPRES,ZWORK32,ZWORK33,ZWORK34)
@@ -1187,7 +1187,7 @@ ALLOCATE(ZWORK34(IIU,IJU,IKU))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'Pa'
TZFIELD%CCOMMENT = 'X_Y_pressure '//TRIM(YTH(JK))//' K'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWTH(:,:,JK))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWTH(:,:,JK))
END DO
! *********************
! Potential Vorticity
@@ -1215,7 +1215,7 @@ ALLOCATE(ZWORK34(IIU,IJU,IKU))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'PVU'
TZFIELD%CCOMMENT = 'X_Y_POtential VOrticity '//TRIM(YTH(JK))//' K'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWTH(:,:,JK))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWTH(:,:,JK))
END DO
! *********************
! Wind
@@ -1227,7 +1227,7 @@ ALLOCATE(ZWORK34(IIU,IJU,IKU))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'm s-1'
TZFIELD%CCOMMENT = 'X_Y_U component of wind '//TRIM(YTH(JK))//' K'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWTH(:,:,JK))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWTH(:,:,JK))
END DO
!
ZWORK31(:,:,:) = MYF(XVT(:,:,:))
@@ -1237,7 +1237,7 @@ ALLOCATE(ZWORK34(IIU,IJU,IKU))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'm s-1'
TZFIELD%CCOMMENT = 'X_Y_V component of wind '//TRIM(YTH(JK))//' K'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWTH(:,:,JK))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWTH(:,:,JK))
END DO
!
DEALLOCATE(ZWTH,ZTH,ZWORK32,ZWORK33,ZWORK34)
@@ -1280,7 +1280,7 @@ IF (LISOAL .AND.XISOAL(1)/=0.) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZAL)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZAL)
!
!* Standard Variables
!
@@ -1301,7 +1301,7 @@ IF (LISOAL .AND.XISOAL(1)/=0.) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWAL)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWAL)
END IF
! *********************
! Precipitation
@@ -1320,7 +1320,7 @@ IF (LISOAL .AND.XISOAL(1)/=0.) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWAL)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWAL)
END IF
! *********************
! Pressure
@@ -1337,7 +1337,7 @@ IF (LISOAL .AND.XISOAL(1)/=0.) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWAL)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWAL)
! *********************
! Potential Vorticity
! *********************
@@ -1370,7 +1370,7 @@ IF (LISOAL .AND.XISOAL(1)/=0.) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWAL)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWAL)
! *********************
! Wind
! *********************
@@ -1387,7 +1387,7 @@ IF (LISOAL .AND.XISOAL(1)/=0.) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWAL)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWAL)
!
ZWORK31(:,:,:) = MYF(XVT(:,:,:))
CALL ZINTER(ZWORK31, XZZ, ZWAL, ZAL, IIU, IJU, IKU, IKB, IAL, XUNDEF)
@@ -1402,7 +1402,7 @@ IF (LISOAL .AND.XISOAL(1)/=0.) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWAL)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWAL)
! *********************
! Dust extinction (optical depth per km)
! *********************
@@ -1423,7 +1423,7 @@ IF (LISOAL .AND.XISOAL(1)/=0.) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWAL)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWAL)
END IF
!
! *********************
@@ -1465,7 +1465,7 @@ IF (LCOARSE) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
!---------------------------------
! MOVING AVERAGE OF TKE OVER IDX+1 POINTS
IDX = IDX/2
@@ -1495,7 +1495,7 @@ IF (LCOARSE) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK31)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
END IF
!
!-------------------------------------------------------------------------------
@@ -1517,7 +1517,7 @@ IF (NEQ_BUDGET>0) THEN
TZFIELD%CMNHNAME = TRIM(CNAMES_BUDGET(JSV))//'_BUDGET'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(CNAMES_BUDGET(JSV))//'_BUDGET'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XTCHEM(JSV)%XB_REAC(:,:,:,:))
+ CALL IO_Field_write(TPFILE,TZFIELD,XTCHEM(JSV)%XB_REAC(:,:,:,:))
END DO
!
TZFIELD%CUNITS = ''
@@ -1528,7 +1528,7 @@ IF (NEQ_BUDGET>0) THEN
TZFIELD%CMNHNAME = TRIM(CNAMES_BUDGET(JSV))//'_CHREACLIST'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CCOMMENT = TRIM(CNAMES_BUDGET(JSV))//'_REACTION_LIST'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XTCHEM(JSV)%NB_REAC(:))
+ CALL IO_Field_write(TPFILE,TZFIELD,XTCHEM(JSV)%NB_REAC(:))
END DO
END IF
!
@@ -1547,12 +1547,12 @@ IF (NEQ_PLT>0) THEN
TZFIELD%CMNHNAME = TRIM(CNAMES_PRODLOSST(JSV))//'_PROD'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(CNAMES_PRODLOSST(JSV))//'_PROD'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XPROD(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XPROD(:,:,:,JSV))
!
TZFIELD%CMNHNAME = TRIM(CNAMES_PRODLOSST(JSV))//'_LOSS'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(CNAMES_PRODLOSST(JSV))//'_LOSS'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XLOSS(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XLOSS(:,:,:,JSV))
END DO
END IF
!
diff --git a/src/MNH/write_lfifmn_fordiachron.f90 b/src/MNH/write_lfifmn_fordiachron.f90
index 528b58ed0d22e15f2cdb2ce885701ac41b29eb65..2e96502f1a4d3d4ac4a9472e35ce1bd522386d5c 100644
--- a/src/MNH/write_lfifmn_fordiachron.f90
+++ b/src/MNH/write_lfifmn_fordiachron.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #############################################
@@ -98,11 +98,11 @@ USE MODD_LUNIT_n
USE MODD_TIME
USE MODD_TYPE_DATE
USE MODD_NESTING
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
-USE MODE_FMWRIT
USE MODE_GATHER_ll
USE MODE_GRIDPROJ
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_ll
!
IMPLICIT NONE
@@ -131,26 +131,26 @@ LPACK=.FALSE.
!
!* 1.0 Version :
!
-CALL IO_WRITE_FIELD(TPFILE,'L1D', L1D)
-CALL IO_WRITE_FIELD(TPFILE,'L2D', L2D)
-CALL IO_WRITE_FIELD(TPFILE,'PACK',LPACK)
-CALL IO_WRITE_FIELD(TPFILE,'SURF',CSURF)
+CALL IO_Field_write(TPFILE,'L1D', L1D)
+CALL IO_Field_write(TPFILE,'L2D', L2D)
+CALL IO_Field_write(TPFILE,'PACK',LPACK)
+CALL IO_Field_write(TPFILE,'SURF',CSURF)
!
!* 1.1 Dimensions :
!
-CALL IO_WRITE_FIELD(TPFILE,'IMAX',NIMAX_ll)
-CALL IO_WRITE_FIELD(TPFILE,'JMAX',NJMAX_ll)
-CALL IO_WRITE_FIELD(TPFILE,'KMAX',NKMAX)
+CALL IO_Field_write(TPFILE,'IMAX',NIMAX_ll)
+CALL IO_Field_write(TPFILE,'JMAX',NJMAX_ll)
+CALL IO_Field_write(TPFILE,'KMAX',NKMAX)
!
-CALL IO_WRITE_FIELD(TPFILE,'JPHEXT',JPHEXT)
+CALL IO_Field_write(TPFILE,'JPHEXT',JPHEXT)
!
!* 1.2 Grid variables :
!
IF (.NOT.LCARTESIAN) THEN
!
- CALL IO_WRITE_FIELD(TPFILE,'RPK', XRPK)
- CALL IO_WRITE_FIELD(TPFILE,'LONORI',XLONORI)
- CALL IO_WRITE_FIELD(TPFILE,'LATORI',XLATORI)
+ CALL IO_Field_write(TPFILE,'RPK', XRPK)
+ CALL IO_Field_write(TPFILE,'LONORI',XLONORI)
+ CALL IO_Field_write(TPFILE,'LATORI',XLATORI)
!
!* diagnostic of 1st mass point
!
@@ -162,47 +162,47 @@ IF (.NOT.LCARTESIAN) THEN
CALL SM_LATLON(XLATORI,XLONORI,ZXHATM,ZYHATM,ZLATOR,ZLONOR)
DEALLOCATE(ZXHAT_ll,ZYHAT_ll)
!
- CALL IO_WRITE_FIELD(TPFILE,'LONOR',ZLONOR)
- CALL IO_WRITE_FIELD(TPFILE,'LATOR',ZLATOR)
+ CALL IO_Field_write(TPFILE,'LONOR',ZLONOR)
+ CALL IO_Field_write(TPFILE,'LATOR',ZLATOR)
END IF
!
-CALL IO_WRITE_FIELD(TPFILE,'THINSHELL',LTHINSHELL)
-CALL IO_WRITE_FIELD(TPFILE,'LAT0',XLAT0)
-CALL IO_WRITE_FIELD(TPFILE,'LON0',XLON0)
-CALL IO_WRITE_FIELD(TPFILE,'BETA',XBETA)
+CALL IO_Field_write(TPFILE,'THINSHELL',LTHINSHELL)
+CALL IO_Field_write(TPFILE,'LAT0',XLAT0)
+CALL IO_Field_write(TPFILE,'LON0',XLON0)
+CALL IO_Field_write(TPFILE,'BETA',XBETA)
!
-CALL IO_WRITE_FIELD(TPFILE,'XHAT',XXHAT)
-CALL IO_WRITE_FIELD(TPFILE,'YHAT',XYHAT)
-CALL IO_WRITE_FIELD(TPFILE,'ZHAT',XZHAT)
-CALL IO_WRITE_FIELD(TPFILE,'ZTOP',XZTOP)
+CALL IO_Field_write(TPFILE,'XHAT',XXHAT)
+CALL IO_Field_write(TPFILE,'YHAT',XYHAT)
+CALL IO_Field_write(TPFILE,'ZHAT',XZHAT)
+CALL IO_Field_write(TPFILE,'ZTOP',XZTOP)
!
-CALL IO_WRITE_FIELD(TPFILE,'ZS', XZS)
-CALL IO_WRITE_FIELD(TPFILE,'ZSMT', XZSMT)
-CALL IO_WRITE_FIELD(TPFILE,'SLEVE',LSLEVE)
+CALL IO_Field_write(TPFILE,'ZS', XZS)
+CALL IO_Field_write(TPFILE,'ZSMT', XZSMT)
+CALL IO_Field_write(TPFILE,'SLEVE',LSLEVE)
!
IF (LSLEVE) THEN
- CALL IO_WRITE_FIELD(TPFILE,'LEN1',XLEN1)
- CALL IO_WRITE_FIELD(TPFILE,'LEN2',XLEN2)
+ CALL IO_Field_write(TPFILE,'LEN1',XLEN1)
+ CALL IO_Field_write(TPFILE,'LEN2',XLEN2)
END IF
!
-CALL IO_WRITE_FIELD(TPFILE,'DTMOD',TDTMOD)
-CALL IO_WRITE_FIELD(TPFILE,'DTCUR',TDTCUR)
-CALL IO_WRITE_FIELD(TPFILE,'DTEXP',TDTEXP)
-CALL IO_WRITE_FIELD(TPFILE,'DTSEG',TDTSEG)
+CALL IO_Field_write(TPFILE,'DTMOD',TDTMOD)
+CALL IO_Field_write(TPFILE,'DTCUR',TDTCUR)
+CALL IO_Field_write(TPFILE,'DTEXP',TDTEXP)
+CALL IO_Field_write(TPFILE,'DTSEG',TDTSEG)
!
!* 1.3 Configuration variables :
!
-CALL IO_WRITE_FIELD(TPFILE,'CARTESIAN',LCARTESIAN)
-CALL IO_WRITE_FIELD(TPFILE,'LBOUSS', LBOUSS)
+CALL IO_Field_write(TPFILE,'CARTESIAN',LCARTESIAN)
+CALL IO_Field_write(TPFILE,'LBOUSS', LBOUSS)
!
!* 1.6 Reference state variables :
!
-CALL IO_WRITE_FIELD(TPFILE,'RHOREFZ',XRHODREFZ)
-CALL IO_WRITE_FIELD(TPFILE,'THVREFZ',XTHVREFZ)
-CALL IO_WRITE_FIELD(TPFILE,'EXNTOP', XEXNTOP)
+CALL IO_Field_write(TPFILE,'RHOREFZ',XRHODREFZ)
+CALL IO_Field_write(TPFILE,'THVREFZ',XTHVREFZ)
+CALL IO_Field_write(TPFILE,'EXNTOP', XEXNTOP)
!
-CALL IO_WRITE_FIELD(TPFILE,'RHODREF',XRHODREF)
-CALL IO_WRITE_FIELD(TPFILE,'THVREF', XTHVREF)
+CALL IO_Field_write(TPFILE,'RHODREF',XRHODREF)
+CALL IO_Field_write(TPFILE,'THVREF', XTHVREF)
!
LPACK=GPACK
!
diff --git a/src/MNH/write_lfin.f90 b/src/MNH/write_lfin.f90
index 43257ca72e5ab481765afe3cd87e47147b63b28d..75c4c6d8f0157264aa29c590de96ef8033ef9cd5 100644
--- a/src/MNH/write_lfin.f90
+++ b/src/MNH/write_lfin.f90
@@ -11,7 +11,7 @@ INTERFACE
!
SUBROUTINE WRITE_LFIFM_n(TPFILE,HDADFILE)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
IMPLICIT NONE
!
@@ -169,7 +169,9 @@ END MODULE MODI_WRITE_LFIFM_n
!! 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 10/04/2019: replace ABORT and STOP calls by Print_msg
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -238,16 +240,16 @@ USE MODD_PARAM_LIMA_WARM, ONLY: CLIMA_WARM_NAMES, CAERO_MASS
USE MODD_PARAM_LIMA_COLD, ONLY: CLIMA_COLD_NAMES
USE MODD_LIMA_PRECIP_SCAVENGING_n
!
-USE MODE_FM, ONLY: IO_FILE_CLOSE_ll
-USE MODE_FMWRIT
+USE MODE_IO_FILE, only: IO_File_close
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_ll
-USE MODD_IO_ll, ONLY: TFILEDATA
-USE MODE_IO_ll, ONLY: UPCASE,CLOSE_ll
+USE MODD_IO, ONLY: TFILEDATA
USE MODE_FIELD
USE MODE_GATHER_ll
USE MODE_GRIDPROJ
USE MODE_MSG
USE MODE_MODELN_HANDLER
+USE MODE_TOOLS, ONLY: UPCASE
!
USE MODI_WRITE_LB_n
USE MODI_WRITE_BALLOON_n
@@ -339,29 +341,29 @@ IKE=IKU-JPVEXT
!
!* 1.0 File and HDADFILE writing :
!
-CALL IO_WRITE_FIELD(TPFILE,'FILETYPE',TPFILE%CTYPE)
+CALL IO_Field_write(TPFILE,'FILETYPE',TPFILE%CTYPE)
!
IF (LEN_TRIM(HDADFILE)>0) THEN
- CALL IO_WRITE_FIELD(TPFILE,'DXRATIO',NDXRATIO_ALL(IMI))
- CALL IO_WRITE_FIELD(TPFILE,'DYRATIO',NDYRATIO_ALL(IMI))
- CALL IO_WRITE_FIELD(TPFILE,'XOR', NXOR_ALL(IMI))
- CALL IO_WRITE_FIELD(TPFILE,'YOR', NYOR_ALL(IMI))
+ CALL IO_Field_write(TPFILE,'DXRATIO',NDXRATIO_ALL(IMI))
+ CALL IO_Field_write(TPFILE,'DYRATIO',NDYRATIO_ALL(IMI))
+ CALL IO_Field_write(TPFILE,'XOR', NXOR_ALL(IMI))
+ CALL IO_Field_write(TPFILE,'YOR', NYOR_ALL(IMI))
END IF
!
!* 1.1 Type and Dimensions :
!
-CALL IO_WRITE_FIELD(TPFILE,'IMAX',NIMAX_ll)
-CALL IO_WRITE_FIELD(TPFILE,'JMAX',NJMAX_ll)
-CALL IO_WRITE_FIELD(TPFILE,'KMAX',NKMAX)
+CALL IO_Field_write(TPFILE,'IMAX',NIMAX_ll)
+CALL IO_Field_write(TPFILE,'JMAX',NJMAX_ll)
+CALL IO_Field_write(TPFILE,'KMAX',NKMAX)
!
-CALL IO_WRITE_FIELD(TPFILE,'JPHEXT',JPHEXT)
+CALL IO_Field_write(TPFILE,'JPHEXT',JPHEXT)
!
!* 1.2 Grid variables :
!
IF (.NOT.LCARTESIAN) THEN
- CALL IO_WRITE_FIELD(TPFILE,'RPK', XRPK)
- CALL IO_WRITE_FIELD(TPFILE,'LONORI',XLONORI)
- CALL IO_WRITE_FIELD(TPFILE,'LATORI',XLATORI)
+ CALL IO_Field_write(TPFILE,'RPK', XRPK)
+ CALL IO_Field_write(TPFILE,'LONORI',XLONORI)
+ CALL IO_Field_write(TPFILE,'LATORI',XLATORI)
!
!* diagnostic of 1st mass point
!
@@ -373,51 +375,54 @@ IF (.NOT.LCARTESIAN) THEN
CALL SM_LATLON(XLATORI,XLONORI,ZXHATM,ZYHATM,ZLATOR,ZLONOR)
DEALLOCATE(ZXHAT_ll,ZYHAT_ll)
!
- CALL IO_WRITE_FIELD(TPFILE,'LONOR',ZLONOR)
- CALL IO_WRITE_FIELD(TPFILE,'LATOR',ZLATOR)
+ CALL IO_Field_write(TPFILE,'LONOR',ZLONOR)
+ CALL IO_Field_write(TPFILE,'LATOR',ZLATOR)
END IF
!
-CALL IO_WRITE_FIELD(TPFILE,'THINSHELL',LTHINSHELL)
-CALL IO_WRITE_FIELD(TPFILE,'LAT0',XLAT0)
-CALL IO_WRITE_FIELD(TPFILE,'LON0',XLON0)
-CALL IO_WRITE_FIELD(TPFILE,'BETA',XBETA)
+CALL IO_Field_write(TPFILE,'THINSHELL',LTHINSHELL)
+CALL IO_Field_write(TPFILE,'LAT0',XLAT0)
+CALL IO_Field_write(TPFILE,'LON0',XLON0)
+CALL IO_Field_write(TPFILE,'BETA',XBETA)
!
-CALL IO_WRITE_FIELD(TPFILE,'XHAT',XXHAT)
-CALL IO_WRITE_FIELD(TPFILE,'YHAT',XYHAT)
-CALL IO_WRITE_FIELD(TPFILE,'ZHAT',XZHAT)
-CALL IO_WRITE_FIELD(TPFILE,'ZTOP',XZTOP)
+CALL IO_Field_write(TPFILE,'XHAT',XXHAT)
+CALL IO_Field_write(TPFILE,'YHAT',XYHAT)
+CALL IO_Field_write(TPFILE,'ZHAT',XZHAT)
+CALL IO_Field_write(TPFILE,'ZTOP',XZTOP)
!
IF (.NOT.LCARTESIAN) THEN
- CALL IO_WRITE_FIELD(TPFILE,'LAT',XLAT)
- CALL IO_WRITE_FIELD(TPFILE,'LON',XLON)
+ CALL IO_Field_write(TPFILE,'LAT',XLAT)
+ CALL IO_Field_write(TPFILE,'LON',XLON)
END IF
!
-CALL IO_WRITE_FIELD(TPFILE,'ZS', XZS)
-CALL IO_WRITE_FIELD(TPFILE,'ZSMT', XZSMT)
-CALL IO_WRITE_FIELD(TPFILE,'SLEVE',LSLEVE)
+CALL IO_Field_write(TPFILE,'ZS', XZS)
+IF(ASSOCIATED(XZWS)) THEN
+ CALL IO_Field_write(TPFILE,'ZWS', XZWS)
+END IF
+CALL IO_Field_write(TPFILE,'ZSMT', XZSMT)
+CALL IO_Field_write(TPFILE,'SLEVE',LSLEVE)
!
IF (LSLEVE) THEN
- CALL IO_WRITE_FIELD(TPFILE,'LEN1',XLEN1)
- CALL IO_WRITE_FIELD(TPFILE,'LEN2',XLEN2)
+ CALL IO_Field_write(TPFILE,'LEN1',XLEN1)
+ CALL IO_Field_write(TPFILE,'LEN2',XLEN2)
END IF
!
!
-CALL IO_WRITE_FIELD(TPFILE,'DTMOD',TDTMOD)
-CALL IO_WRITE_FIELD(TPFILE,'DTCUR',TDTCUR)
-CALL IO_WRITE_FIELD(TPFILE,'DTEXP',TDTEXP)
-CALL IO_WRITE_FIELD(TPFILE,'DTSEG',TDTSEG)
+CALL IO_Field_write(TPFILE,'DTMOD',TDTMOD)
+CALL IO_Field_write(TPFILE,'DTCUR',TDTCUR)
+CALL IO_Field_write(TPFILE,'DTEXP',TDTEXP)
+CALL IO_Field_write(TPFILE,'DTSEG',TDTSEG)
!
!* 1.3 Configuration variables :
!
-CALL IO_WRITE_FIELD(TPFILE,'L1D', L1D)
-CALL IO_WRITE_FIELD(TPFILE,'L2D', L2D)
-CALL IO_WRITE_FIELD(TPFILE,'PACK', LPACK)
-CALL IO_WRITE_FIELD(TPFILE,'CARTESIAN',LCARTESIAN)
-CALL IO_WRITE_FIELD(TPFILE,'LBOUSS', LBOUSS)
+CALL IO_Field_write(TPFILE,'L1D', L1D)
+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_WRITE_FIELD(TPFILE,'SURF', CSURF)
-CALL IO_WRITE_FIELD(TPFILE,'CPL_AROME',LCPL_AROME)
-CALL IO_WRITE_FIELD(TPFILE,'COUPLING', LCOUPLING)
+CALL IO_Field_write(TPFILE,'SURF', CSURF)
+CALL IO_Field_write(TPFILE,'CPL_AROME',LCPL_AROME)
+CALL IO_Field_write(TPFILE,'COUPLING', LCOUPLING)
!
!* 1.4 Prognostic variables :
!
@@ -429,27 +434,27 @@ CALL IO_WRITE_FIELD(TPFILE,'COUPLING', LCOUPLING)
! CALL EXTRAPOL('E',XUT)
! CALL EXTRAPOL('N',XUT)
! CALL EXTRAPOL('S',XUT)
-CALL MPPDB_CHECK3D(XUT,"write_lfifmn before IO_WRITE_FIELD::XUT",PRECISION)
-CALL IO_WRITE_FIELD(TPFILE,'UT',XUT)
-CALL MPPDB_CHECK3D(XUT,"write_lfifmn after IO_WRITE_FIELD::XUT",PRECISION)
+CALL MPPDB_CHECK3D(XUT,"write_lfifmn before IO_Field_write::XUT",PRECISION)
+CALL IO_Field_write(TPFILE,'UT',XUT)
+CALL MPPDB_CHECK3D(XUT,"write_lfifmn after IO_Field_write::XUT",PRECISION)
!
!20131128 check XVT-> X_Y_W_V wind component for PRC
CALL MPPDB_CHECK3D(XVT,"write_lfifmn::XVT",PRECISION)
!
-CALL IO_WRITE_FIELD(TPFILE,'VT',XVT)
-CALL IO_WRITE_FIELD(TPFILE,'WT',XWT)
+CALL IO_Field_write(TPFILE,'VT',XVT)
+CALL IO_Field_write(TPFILE,'WT',XWT)
!
-CALL IO_WRITE_FIELD(TPFILE,'THT',XTHT)
+CALL IO_Field_write(TPFILE,'THT',XTHT)
!
!* 1.4.2 Time t-dt:
!
IF ( (CUVW_ADV_SCHEME == 'CEN4TH') .AND. (CTEMP_SCHEME == 'LEFR') ) THEN
- CALL IO_WRITE_FIELD(TPFILE,'UM', XUM)
- CALL IO_WRITE_FIELD(TPFILE,'VM', XVM)
- CALL IO_WRITE_FIELD(TPFILE,'WM', XWM)
- CALL IO_WRITE_FIELD(TPFILE,'DUM',XDUM)
- CALL IO_WRITE_FIELD(TPFILE,'DVM',XDVM)
- CALL IO_WRITE_FIELD(TPFILE,'DWM',XDWM)
+ CALL IO_Field_write(TPFILE,'UM', XUM)
+ CALL IO_Field_write(TPFILE,'VM', XVM)
+ CALL IO_Field_write(TPFILE,'WM', XWM)
+ CALL IO_Field_write(TPFILE,'DUM',XDUM)
+ CALL IO_Field_write(TPFILE,'DVM',XDVM)
+ CALL IO_Field_write(TPFILE,'DWM',XDWM)
END IF
!
IF (MEAN_COUNT /= 0) THEN
@@ -467,20 +472,20 @@ IF (MEAN_COUNT /= 0) THEN
TZFIELD%CUNITS = 'm s-1'
TZFIELD%CCOMMENT = 'X_Y_Z_U component of mean wind'
ZWORK3D = XUM_MEAN/MEAN_COUNT
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D)
!
TZFIELD%CMNHNAME = 'U2ME'
TZFIELD%CLONGNAME = 'U2ME'
TZFIELD%CUNITS = 'm2 s-2'
TZFIELD%CCOMMENT = 'X_Y_Z_U component of mean wind variance'
ZWORK3D = XU2_MEAN/MEAN_COUNT-XUM_MEAN**2/MEAN_COUNT**2
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D)
!
TZFIELD%CMNHNAME = 'UMMA'
TZFIELD%CLONGNAME = 'UMMA'
TZFIELD%CUNITS = 'm s-1'
TZFIELD%CCOMMENT = 'X_Y_Z_U component of max wind'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XUM_MAX)
+ CALL IO_Field_write(TPFILE,TZFIELD,XUM_MAX)
!
TZFIELD%NGRID = 3
!
@@ -489,20 +494,20 @@ IF (MEAN_COUNT /= 0) THEN
TZFIELD%CUNITS = 'm s-1'
TZFIELD%CCOMMENT = 'X_Y_Z_V component of mean wind'
ZWORK3D = XVM_MEAN/MEAN_COUNT
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D)
!
TZFIELD%CMNHNAME = 'V2ME'
TZFIELD%CLONGNAME = 'V2ME'
TZFIELD%CUNITS = 'm2 s-2'
TZFIELD%CCOMMENT = 'X_Y_Z_V component of mean wind variance'
ZWORK3D = XV2_MEAN/MEAN_COUNT-XVM_MEAN**2/MEAN_COUNT**2
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D)
!
TZFIELD%CMNHNAME = 'VMMA'
TZFIELD%CLONGNAME = 'VMMA'
TZFIELD%CUNITS = 'm s-1'
TZFIELD%CCOMMENT = 'X_Y_Z_V component of max wind'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XVM_MAX)
+ CALL IO_Field_write(TPFILE,TZFIELD,XVM_MAX)
!
TZFIELD%NGRID = 4
!
@@ -511,20 +516,20 @@ IF (MEAN_COUNT /= 0) THEN
TZFIELD%CUNITS = 'm s-1'
TZFIELD%CCOMMENT = 'X_Y_Z_vertical mean wind'
ZWORK3D = XWM_MEAN/MEAN_COUNT
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D)
!
TZFIELD%CMNHNAME = 'W2ME'
TZFIELD%CLONGNAME = 'W2ME'
TZFIELD%CUNITS = 'm2 s-2'
TZFIELD%CCOMMENT = 'X_Y_Z_vertical mean wind variance'
ZWORK3D = XW2_MEAN/MEAN_COUNT-XWM_MEAN**2/MEAN_COUNT**2
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D)
!
TZFIELD%CMNHNAME = 'WMMA'
TZFIELD%CLONGNAME = 'WMMA'
TZFIELD%CUNITS = 'm s-1'
TZFIELD%CCOMMENT = 'X_Y_Z_vertical max wind'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XWM_MAX)
+ CALL IO_Field_write(TPFILE,TZFIELD,XWM_MAX)
!
TZFIELD%NGRID = 1
!
@@ -533,60 +538,60 @@ IF (MEAN_COUNT /= 0) THEN
TZFIELD%CUNITS = 'K'
TZFIELD%CCOMMENT = 'X_Y_Z_mean potential temperature'
ZWORK3D = XTHM_MEAN/MEAN_COUNT
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D)
!
TZFIELD%CMNHNAME = 'TH2ME'
TZFIELD%CLONGNAME = 'TH2ME'
TZFIELD%CUNITS = 'K2'
TZFIELD%CCOMMENT = 'X_Y_Z_mean potential temperature variance'
ZWORK3D = XTH2_MEAN/MEAN_COUNT-XTHM_MEAN**2/MEAN_COUNT**2
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D)
!
TZFIELD%CMNHNAME = 'THMMA'
TZFIELD%CLONGNAME = 'THMMA'
TZFIELD%CUNITS = 'K'
TZFIELD%CCOMMENT = 'X_Y_Z_max potential temperature'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XTHM_MAX)
+ CALL IO_Field_write(TPFILE,TZFIELD,XTHM_MAX)
!
TZFIELD%CMNHNAME = 'TEMPMME'
TZFIELD%CLONGNAME = 'TEMPMME'
TZFIELD%CUNITS = 'K'
TZFIELD%CCOMMENT = 'X_Y_Z_mean temperature'
ZWORK3D = XTEMPM_MEAN/MEAN_COUNT
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D)
!
TZFIELD%CMNHNAME = 'TEMP2ME'
TZFIELD%CLONGNAME = 'TEMP2ME'
TZFIELD%CUNITS = 'K2'
TZFIELD%CCOMMENT = 'X_Y_Z_mean temperature variance'
ZWORK3D = XTEMP2_MEAN/MEAN_COUNT-XTEMPM_MEAN**2/MEAN_COUNT**2
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D)
!
TZFIELD%CMNHNAME = 'TEMPMMA'
TZFIELD%CLONGNAME = 'TEMPMMA'
TZFIELD%CUNITS = 'K'
TZFIELD%CCOMMENT = 'X_Y_Z_max temperature'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XTEMPM_MAX)
+ CALL IO_Field_write(TPFILE,TZFIELD,XTEMPM_MAX)
!
TZFIELD%CMNHNAME = 'PABSMME'
TZFIELD%CLONGNAME = 'PABSMME'
TZFIELD%CUNITS = 'Pa'
TZFIELD%CCOMMENT = 'X_Y_Z_mean ABSolute Pressure'
ZWORK3D = XPABSM_MEAN/MEAN_COUNT
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D)
!
TZFIELD%CMNHNAME = 'PABS2ME'
TZFIELD%CLONGNAME = 'PABS2ME'
TZFIELD%CUNITS = 'Pa2'
TZFIELD%CCOMMENT = 'X_Y_Z_mean ABSolute Pressure variance'
ZWORK3D = XPABS2_MEAN/MEAN_COUNT-XPABSM_MEAN**2/MEAN_COUNT**2
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D)
!
TZFIELD%CMNHNAME = 'PABSMMA'
TZFIELD%CLONGNAME = 'PABSMMA'
TZFIELD%CUNITS = 'Pa'
TZFIELD%CCOMMENT = 'X_Y_Z_max ABSolute Pressure'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XPABSM_MAX)
+ CALL IO_Field_write(TPFILE,TZFIELD,XPABSM_MAX)
!
IF (CTURB /= 'NONE') THEN
TZFIELD%CMNHNAME = 'TKEMME'
@@ -594,52 +599,52 @@ IF (MEAN_COUNT /= 0) THEN
TZFIELD%CUNITS = 'm2 s-2'
TZFIELD%CCOMMENT = 'X_Y_Z_mean kinetic energy'
ZWORK3D= XTKEM_MEAN/MEAN_COUNT
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D)
!
TZFIELD%CMNHNAME = 'TKEMMA'
TZFIELD%CLONGNAME = 'TKEMMA'
TZFIELD%CUNITS = 'm2 s-2'
TZFIELD%CCOMMENT = 'X_Y_Z_max kinetic energy'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XTKEM_MAX)
+ CALL IO_Field_write(TPFILE,TZFIELD,XTKEM_MAX)
END IF
!
END IF
!
!
IF (CTURB /= 'NONE') THEN
- CALL IO_WRITE_FIELD(TPFILE,'TKET',XTKET)
- IF (CPROGRAM == 'MESONH' .AND. LSPLIT_CFL) CALL IO_WRITE_FIELD(TPFILE,'TKEMS',XRTKEMS)
+ CALL IO_Field_write(TPFILE,'TKET',XTKET)
+ IF (CPROGRAM == 'MESONH' .AND. LSPLIT_CFL) CALL IO_Field_write(TPFILE,'TKEMS',XRTKEMS)
END IF
!
!
-CALL IO_WRITE_FIELD(TPFILE,'PABST',XPABST)
+CALL IO_Field_write(TPFILE,'PABST',XPABST)
!
IF (NRR >=1) THEN
- IF (LUSERV) CALL IO_WRITE_FIELD(TPFILE,'RVT',XRT(:,:,:,IDX_RVT))
+ IF (LUSERV) CALL IO_Field_write(TPFILE,'RVT',XRT(:,:,:,IDX_RVT))
IF (LUSERC) THEN
- CALL IO_WRITE_FIELD(TPFILE,'RCT',XRT(:,:,:,IDX_RCT))
+ CALL IO_Field_write(TPFILE,'RCT',XRT(:,:,:,IDX_RCT))
WRITE (ILUOUT,*) IDX_RCT,' RC min-max ',MIN_ll(XRT(:,:,:,IDX_RCT),INFO_ll),MAX_ll(XRT(:,:,:,IDX_RCT),INFO_ll)
END IF
IF (LUSERR) THEN
- CALL IO_WRITE_FIELD(TPFILE,'RRT',XRT(:,:,:,IDX_RRT))
+ CALL IO_Field_write(TPFILE,'RRT',XRT(:,:,:,IDX_RRT))
WRITE (ILUOUT,*) IDX_RRT,' RR min-max ',MIN_ll(XRT(:,:,:,IDX_RRT),INFO_ll),MAX_ll(XRT(:,:,:,IDX_RRT),INFO_ll)
END IF
IF (LUSERI) THEN
- CALL IO_WRITE_FIELD(TPFILE,'RIT',XRT(:,:,:,IDX_RIT))
+ CALL IO_Field_write(TPFILE,'RIT',XRT(:,:,:,IDX_RIT))
WRITE (ILUOUT,*) IDX_RIT,' RI min-max ',MIN_ll(XRT(:,:,:,IDX_RIT),INFO_ll),MAX_ll(XRT(:,:,:,IDX_RIT),INFO_ll)
IF ( CPROGRAM == 'MESONH' .AND. CCLOUD(1:3) == 'ICE') THEN
- CALL IO_WRITE_FIELD(TPFILE,'CIT',XCIT(:,:,:))
+ CALL IO_Field_write(TPFILE,'CIT',XCIT(:,:,:))
END IF
END IF
IF (LUSERS) THEN
- CALL IO_WRITE_FIELD(TPFILE,'RST',XRT(:,:,:,IDX_RST))
+ CALL IO_Field_write(TPFILE,'RST',XRT(:,:,:,IDX_RST))
WRITE (ILUOUT,*) IDX_RST,' RS min-max ',MINVAL(XRT(:,:,:,IDX_RST)),MAXVAL(XRT(:,:,:,IDX_RST))
END IF
IF (LUSERG) THEN
- CALL IO_WRITE_FIELD(TPFILE,'RGT',XRT(:,:,:,IDX_RGT))
+ CALL IO_Field_write(TPFILE,'RGT',XRT(:,:,:,IDX_RGT))
WRITE (ILUOUT,*) IDX_RGT,' RG min-max ',MINVAL(XRT(:,:,:,IDX_RGT)),MAXVAL(XRT(:,:,:,IDX_RGT))
END IF
- IF (LUSERH) CALL IO_WRITE_FIELD(TPFILE,'RHT',XRT(:,:,:,IDX_RHT))
+ IF (LUSERH) CALL IO_Field_write(TPFILE,'RHT',XRT(:,:,:,IDX_RHT))
END IF
!
IF (NSV >=1) THEN
@@ -658,7 +663,7 @@ IF (NSV >=1) THEN
WRITE(TZFIELD%CMNHNAME,'(A3,I3.3)')'SVT',JSV
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
JSA=JSA+1
END DO
END IF
@@ -676,7 +681,7 @@ IF (NSV >=1) THEN
TZFIELD%CMNHNAME = TRIM(C2R2NAMES(JSV-NSV_C2R2BEG+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
JSA=JSA+1
END DO
END IF
@@ -694,7 +699,7 @@ IF (NSV >=1) THEN
TZFIELD%CMNHNAME = TRIM(C1R3NAMES(JSV-NSV_C1R3BEG+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
JSA=JSA+1
END DO
END IF
@@ -765,7 +770,7 @@ IF (NSV >=1) THEN
END IF
!
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
!
JSA=JSA+1
END DO
@@ -773,7 +778,7 @@ IF (NSV >=1) THEN
IF (LSCAV .AND. LAERO_MASS) THEN
IF (ASSOCIATED(XINPAP)) THEN
IF (SIZE(XINPAP) /= 0 ) THEN
- CALL IO_WRITE_FIELD(TPFILE,'INPAP',XINPAP)
+ CALL IO_Field_write(TPFILE,'INPAP',XINPAP)
!
ZWORK2D(:,:) = XRHOLW*XINPRR(:,:)*XSVT(:,:,2,NSV_LIMA_SCAVMASS)/ &
max( 1.e-20,XRT(:,:,2,3) ) !~2=at ground level
@@ -787,9 +792,9 @@ IF (NSV >=1) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK2D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK2D)
!
- CALL IO_WRITE_FIELD(TPFILE,'ACPAP',XACPAP)
+ CALL IO_Field_write(TPFILE,'ACPAP',XACPAP)
END IF
END IF
END IF
@@ -815,15 +820,15 @@ IF (NSV >=1) THEN
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3,A8)')'X_Y_Z_','SVT',JSV,' (nb ions/m3)'
END IF
ZWORK3D(:,:,:) = XSVT(:,:,:,JSV) * XRHODREF(:,:,:) ! C/kg --> C/m3
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D)
JSA=JSA+1
END DO
END IF
!
IF (CELEC /= 'NONE') THEN
- CALL IO_WRITE_FIELD(TPFILE,'EFIELDU',XEFIELDU)
- CALL IO_WRITE_FIELD(TPFILE,'EFIELDV',XEFIELDV)
- CALL IO_WRITE_FIELD(TPFILE,'EFIELDW',XEFIELDW)
+ CALL IO_Field_write(TPFILE,'EFIELDU',XEFIELDU)
+ CALL IO_Field_write(TPFILE,'EFIELDV',XEFIELDV)
+ CALL IO_Field_write(TPFILE,'EFIELDW',XEFIELDW)
!
TZFIELD%CMNHNAME = 'EMODULE'
TZFIELD%CSTDNAME = ''
@@ -836,34 +841,34 @@ IF (NSV >=1) THEN
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
ZWORK3D(:,:,:) = (XEFIELDU**2 + XEFIELDV**2 + XEFIELDW**2)**0.5
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK3D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('NI_IAGGS',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'pC m-3 s-1'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XNI_IAGGS*1.E12)
+ CALL IO_Field_write(TPFILE,TZFIELD,XNI_IAGGS*1.E12)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('NI_IDRYG',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'pC m-3 s-1'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XNI_IDRYG*1.E12)
+ CALL IO_Field_write(TPFILE,TZFIELD,XNI_IDRYG*1.E12)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('NI_SDRYG',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'pC m-3 s-1'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XNI_SDRYG*1.E12)
+ CALL IO_Field_write(TPFILE,TZFIELD,XNI_SDRYG*1.E12)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('INDUC_CG',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'pC m-3 s-1'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XIND_RATE*1.E12)
+ CALL IO_Field_write(TPFILE,TZFIELD,XIND_RATE*1.E12)
!
- CALL IO_WRITE_FIELD(TPFILE,'TRIG_IC', NMAP_TRIG_IC)
- CALL IO_WRITE_FIELD(TPFILE,'IMPACT_CG', NMAP_IMPACT_CG)
- CALL IO_WRITE_FIELD(TPFILE,'AREA_CG', NMAP_2DAREA_CG)
- CALL IO_WRITE_FIELD(TPFILE,'AREA_IC', NMAP_2DAREA_IC)
- CALL IO_WRITE_FIELD(TPFILE,'FLASH_3DCG',NMAP_3DCG)
- CALL IO_WRITE_FIELD(TPFILE,'FLASH_3DIC',NMAP_3DIC)
+ CALL IO_Field_write(TPFILE,'TRIG_IC', NMAP_TRIG_IC)
+ CALL IO_Field_write(TPFILE,'IMPACT_CG', NMAP_IMPACT_CG)
+ CALL IO_Field_write(TPFILE,'AREA_CG', NMAP_2DAREA_CG)
+ CALL IO_Field_write(TPFILE,'AREA_IC', NMAP_2DAREA_IC)
+ CALL IO_Field_write(TPFILE,'FLASH_3DCG',NMAP_3DCG)
+ CALL IO_Field_write(TPFILE,'FLASH_3DIC',NMAP_3DIC)
!
IF (LLNOX_EXPLICIT) THEN
TZFIELD%CMNHNAME = 'LINOX'
@@ -876,7 +881,7 @@ IF (NSV >=1) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XSVT(:,:,:,NSV_LNOXEND))
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,NSV_LNOXEND))
JSA=JSA+1
END IF
END IF
@@ -894,7 +899,7 @@ IF (NSV >=1) THEN
TZFIELD%CMNHNAME = TRIM(CLGNAMES(JSV-NSV_LGBEG+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
JSA=JSA+1
END DO
END IF
@@ -912,18 +917,18 @@ IF (NSV >=1) THEN
WRITE(TZFIELD%CMNHNAME,'(A3,I3.3)')'SVT',JSV
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
JSA=JSA+1
END DO
END IF
!
IF ( ((CCLOUD == 'KHKO') .OR.(CCLOUD == 'C2R2')) .AND. (.NOT. LSUPSAT)) THEN
- CALL IO_WRITE_FIELD(TPFILE,'SUPSATMAX',XSUPSAT(:,:,:))
- CALL IO_WRITE_FIELD(TPFILE,'NACT', XNACT(:,:,:))
+ CALL IO_Field_write(TPFILE,'SUPSATMAX',XSUPSAT(:,:,:))
+ CALL IO_Field_write(TPFILE,'NACT', XNACT(:,:,:))
END IF
IF ( ((CCLOUD == 'KHKO') .OR.(CCLOUD == 'C2R2')) .AND. LSUPSAT) THEN
- CALL IO_WRITE_FIELD(TPFILE,'SSPRO',XSSPRO(:,:,:))
- CALL IO_WRITE_FIELD(TPFILE,'NPRO', XNPRO(:,:,:))
+ CALL IO_Field_write(TPFILE,'SSPRO',XSSPRO(:,:,:))
+ CALL IO_Field_write(TPFILE,'NPRO', XNPRO(:,:,:))
END IF
!
#ifdef MNH_FOREFIRE
@@ -941,7 +946,7 @@ IF (NSV >=1) THEN
WRITE(TZFIELD%CMNHNAME,'(A3,I3.3)')'SVT',JSV
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
JSA=JSA+1
END DO
END IF
@@ -959,7 +964,7 @@ IF (NSV >=1) THEN
TZFIELD%CMNHNAME=TRIM(CSNOWNAMES(JSV-NSV_SNWBEG+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
JSA=JSA+1
END DO
TZFIELD%CSTDNAME = ''
@@ -973,7 +978,7 @@ IF (NSV >=1) THEN
WRITE(TZFIELD%CMNHNAME,'(A10,I3.3)')'SNOWCANO_M',JSV
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A8,I3.3)')'X_Y_Z_','SNOWCANO',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XSNWCANO(:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XSNWCANO(:,:,JSV))
JSA=JSA+1
END DO
ENDIF
@@ -991,7 +996,7 @@ IF (NSV >=1) THEN
WRITE(TZFIELD%CMNHNAME,'(A3,I3.3)')'SVT',JSV
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
JSA=JSA+1
END DO
!
@@ -1024,7 +1029,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'ppp'
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
!
YCHNAMES(JSV-JSA)=TZFIELD%CMNHNAME(1:LEN_TRIM(TZFIELD%CMNHNAME)-1) ! without T
END DO
@@ -1035,7 +1040,7 @@ IF (NSV >=1) THEN
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = 'ppp'
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
!
YCHNAMES(JSV-JSA)=TZFIELD%CMNHNAME(1:LEN_TRIM(TZFIELD%CMNHNAME)-1) ! without M
END DO
@@ -1048,14 +1053,14 @@ IF (NSV >=1) THEN
TZFIELD%CUNITS = 'mol i m-2'
TZFIELD%CCOMMENT = 'X_Y_Accumulated moles of aqueous species at the surface'
ZWORK2D(:,:) = XACPRAQ(:,:,JSV-NSV_CHACBEG-NSV_CHAC/2+1)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK2D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK2D)
END DO
TZFIELD%NDIMS = 3
END IF
IF (LUSECHAQ.AND.LCH_PH) THEN ! pH values in cloud
- CALL IO_WRITE_FIELD(TPFILE,'PHC',XPHC)
+ CALL IO_Field_write(TPFILE,'PHC',XPHC)
IF (NRR>=3) THEN
- CALL IO_WRITE_FIELD(TPFILE,'PHR',XPHR)
+ CALL IO_Field_write(TPFILE,'PHR',XPHR)
! compute mean pH in accumulated surface water
!ZWORK2D(:,:) = 10**(-XCH_PHINIT)
WHERE (XACPRR > 0.)
@@ -1075,7 +1080,7 @@ IF (NSV >=1) THEN
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK2D)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK2D)
ENDIF
ENDIF
ELSE IF (LCH_CONV_LINOX) THEN
@@ -1091,7 +1096,7 @@ IF (NSV >=1) THEN
TZFIELD%CMNHNAME = 'LINOXT'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)') 'X_Y_Z_','SVT',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
YCHNAMES(JSV-JSA)=TZFIELD%CMNHNAME(1:LEN_TRIM(TZFIELD%CMNHNAME)-1)
END DO
ENDIF
@@ -1114,7 +1119,7 @@ IF (NSV >=1) THEN
TZFIELD%CMNHNAME = TRIM(UPCASE(CAERONAMES(JSV-NSV_AERBEG+1)))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
IF (JSV==NSV_AERBEG) WRITE(ILUOUT,*)'MNHC: write_lfin:NSV_AERBEG ',JSV
IF (JSV==NSV_AEREND) WRITE(ILUOUT,*)'MNHC: write_lfin:NSV_AEREND ',JSV
YCHNAMES(JSV-JSA)= TZFIELD%CMNHNAME(1:LEN_TRIM(TZFIELD%CMNHNAME)-1)
@@ -1133,7 +1138,7 @@ IF (NSV >=1) THEN
TZFIELD%CMNHNAME = TRIM(CDEAERNAMES(JSV-NSV_AERDEPBEG+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
IF (JSV==NSV_AERDEPBEG) WRITE(ILUOUT,*)'MNHC: write_lfin:NSV_AERDEPBEG ',JSV
IF (JSV==NSV_AERDEPEND) WRITE(ILUOUT,*)'MNHC: write_lfin:NSV_AERDEPEND ',JSV
YCHNAMES(JSV-JSA) = TZFIELD%CMNHNAME(1:LEN_TRIM(TZFIELD%CMNHNAME)-1)
@@ -1155,12 +1160,9 @@ IF (NSV >=1) THEN
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 equal or inferior to 3'
+ 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
- !callabortstop
- CALL IO_FILE_CLOSE_ll(TLUOUT)
- CALL ABORT
- STOP
+ 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))
!
@@ -1181,7 +1183,7 @@ IF (NSV >=1) THEN
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_WRITE_FIELD(TPFILE,TZFIELD,XSVT(:,:,:,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
@@ -1194,7 +1196,7 @@ IF (NSV >=1) THEN
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_WRITE_FIELD(TPFILE,TZFIELD,XSVT(:,:,:,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
@@ -1220,7 +1222,7 @@ IF (NSV >=1) THEN
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_WRITE_FIELD(TPFILE,TZFIELD,XSVT(:,:,:,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)
@@ -1239,7 +1241,7 @@ IF (NSV >=1) THEN
TZFIELD%CMNHNAME = TRIM(CDEDSTNAMES(JSV-NSV_DSTDEPBEG+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
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)
@@ -1249,9 +1251,9 @@ IF (NSV >=1) THEN
! sea salt scalar variables
IF (LSALT) THEN
IF ((CPROGRAM == 'REAL ').AND.(NSV_SLT > 1).AND.(IMI==1).AND.(LSLTINIT)) &
- CALL SALTLFI_n(XSVT(:,:,:,NSV_SLTBEG:NSV_SLTEND), XRHODREF)
+ CALL SALTLFI_n(XSVT(:,:,:,NSV_SLTBEG:NSV_SLTEND), XRHODREF, XZZ)
IF ((CPROGRAM == 'IDEAL ').AND.(NSV_SLT > 1).AND.(IMI==1)) &
- CALL SALTLFI_n(XSVT(:,:,:,NSV_SLTBEG:NSV_SLTEND), XRHODREF)
+ 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.&
@@ -1261,12 +1263,9 @@ IF (NSV >=1) THEN
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 3'
+ WRITE(ILUOUT,*) 'Error in write_lfin: number of moments must be equal to 3'
WRITE(ILUOUT,*) NSV_SLTBEG, NSV_SLTEND,NMODE_SLT,IMOMENTS
- !callabortstop
- CALL IO_FILE_CLOSE_ll(TLUOUT)
- CALL ABORT
- STOP
+ 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 = ''
@@ -1288,7 +1287,7 @@ IF (NSV >=1) THEN
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_WRITE_FIELD(TPFILE,TZFIELD,XSVT(:,:,:,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
@@ -1312,7 +1311,7 @@ IF (NSV >=1) THEN
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_WRITE_FIELD(TPFILE,TZFIELD,XSVT(:,:,:,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)
@@ -1331,7 +1330,7 @@ IF (NSV >=1) THEN
TZFIELD%CMNHNAME = TRIM(CDESLTNAMES(JSV-NSV_SLTDEPBEG+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
IF (JSV==NSV_SLTDEPBEG) WRITE(ILUOUT,*)'MNHC: write_lfin:NSV_SLTDEPBEG ',JSV
IF (JSV==NSV_SLTDEPEND) WRITE(ILUOUT,*)'MNHC: write_lfin:NSV_SLTDEPEND ',JSV
YCHNAMES(JSV-JSA) = TZFIELD%CMNHNAME(1:LEN_TRIM(TZFIELD%CMNHNAME)-1)
@@ -1352,7 +1351,7 @@ IF (NSV >=1) THEN
TZFIELD%NTYPE = TYPEINT
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ICH_NBR)
+ CALL IO_Field_write(TPFILE,TZFIELD,ICH_NBR)
!
IF (ICH_NBR/=0) THEN
TZFIELD%CMNHNAME = 'NSV.TITRE'
@@ -1373,7 +1372,7 @@ IF (NSV >=1) THEN
ICH_NAMES(ILREC*(JSV-1)+JT) = ICHAR(YCHNAMES(JSV)(JT:JT))
ENDDO
ENDDO
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ICH_NAMES)
+ CALL IO_Field_write(TPFILE,TZFIELD,ICH_NAMES)
DEALLOCATE(YCHNAMES,ICH_NAMES)
END IF
!
@@ -1391,66 +1390,66 @@ IF (NSV >=1) THEN
TZFIELD%CMNHNAME = TRIM(CLGNAMES(JSV-NSV_LGBEG+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
END DO
END IF
END IF
!
!
-CALL IO_WRITE_FIELD(TPFILE,'LSUM', XLSUM)
-CALL IO_WRITE_FIELD(TPFILE,'LSVM', XLSVM)
-CALL IO_WRITE_FIELD(TPFILE,'LSWM', XLSWM)
-CALL IO_WRITE_FIELD(TPFILE,'LSTHM',XLSTHM)
-IF (LUSERV) CALL IO_WRITE_FIELD(TPFILE,'LSRVM',XLSRVM)
+CALL IO_Field_write(TPFILE,'LSUM', XLSUM)
+CALL IO_Field_write(TPFILE,'LSVM', XLSVM)
+CALL IO_Field_write(TPFILE,'LSWM', XLSWM)
+CALL IO_Field_write(TPFILE,'LSTHM',XLSTHM)
+IF (LUSERV) CALL IO_Field_write(TPFILE,'LSRVM',XLSRVM)
!
CALL WRITE_LB_n(TPFILE)
!
!
-CALL IO_WRITE_FIELD(TPFILE,'DRYMASST',XDRYMASST)
+CALL IO_Field_write(TPFILE,'DRYMASST',XDRYMASST)
!
IF( CTURB /= 'NONE' .AND. CTOM=='TM06') THEN
- CALL IO_WRITE_FIELD(TPFILE,'BL_DEPTH',XBL_DEPTH)
+ CALL IO_Field_write(TPFILE,'BL_DEPTH',XBL_DEPTH)
END IF
!
IF( CTURB /= 'NONE' .AND. LRMC01) THEN
- CALL IO_WRITE_FIELD(TPFILE,'SBL_DEPTH',XSBL_DEPTH)
+ CALL IO_Field_write(TPFILE,'SBL_DEPTH',XSBL_DEPTH)
END IF
!
IF( CTURB /= 'NONE' .AND. CSCONV == 'EDKF' .AND.(CPROGRAM == 'MESONH' .OR. CPROGRAM == 'DIAG')) THEN
- CALL IO_WRITE_FIELD(TPFILE,'WTHVMF',XWTHVMF)
+ CALL IO_Field_write(TPFILE,'WTHVMF',XWTHVMF)
END IF
!
IF( NRR > 1 .AND. CTURB /= 'NONE' ) THEN
- CALL IO_WRITE_FIELD(TPFILE,'SRCT',XSRCT)
- CALL IO_WRITE_FIELD(TPFILE,'SIGS',XSIGS)
+ CALL IO_Field_write(TPFILE,'SRCT',XSRCT)
+ CALL IO_Field_write(TPFILE,'SIGS',XSIGS)
END IF
!
!* 1.5 Reference state variables :
!
-CALL IO_WRITE_FIELD(TPFILE,'RHOREFZ',XRHODREFZ)
-CALL IO_WRITE_FIELD(TPFILE,'THVREFZ',XTHVREFZ)
-CALL IO_WRITE_FIELD(TPFILE,'EXNTOP', XEXNTOP)
+CALL IO_Field_write(TPFILE,'RHOREFZ',XRHODREFZ)
+CALL IO_Field_write(TPFILE,'THVREFZ',XTHVREFZ)
+CALL IO_Field_write(TPFILE,'EXNTOP', XEXNTOP)
!
!
!* 1.6 Tendencies
!
IF (CPROGRAM == 'MESONH') THEN
IF (CTEMP_SCHEME/='LEFR') THEN
- CALL IO_WRITE_FIELD(TPFILE,'US_PRES',XRUS_PRES)
- CALL IO_WRITE_FIELD(TPFILE,'VS_PRES',XRVS_PRES)
- CALL IO_WRITE_FIELD(TPFILE,'WS_PRES',XRWS_PRES)
+ CALL IO_Field_write(TPFILE,'US_PRES',XRUS_PRES)
+ CALL IO_Field_write(TPFILE,'VS_PRES',XRVS_PRES)
+ CALL IO_Field_write(TPFILE,'WS_PRES',XRWS_PRES)
END IF
IF (LSPLIT_CFL) THEN
- CALL IO_WRITE_FIELD(TPFILE,'THS_CLD',XRTHS_CLD)
+ CALL IO_Field_write(TPFILE,'THS_CLD',XRTHS_CLD)
!
IF (NRR >=1) THEN
- IF (LUSERV) CALL IO_WRITE_FIELD(TPFILE,'RVS_CLD',XRRS_CLD(:,:,:,IDX_RVT))
- IF (LUSERC) CALL IO_WRITE_FIELD(TPFILE,'RCS_CLD',XRRS_CLD(:,:,:,IDX_RCT))
- IF (LUSERR) CALL IO_WRITE_FIELD(TPFILE,'RRS_CLD',XRRS_CLD(:,:,:,IDX_RRT))
- IF (LUSERI) CALL IO_WRITE_FIELD(TPFILE,'RIS_CLD',XRRS_CLD(:,:,:,IDX_RIT))
- IF (LUSERS) CALL IO_WRITE_FIELD(TPFILE,'RSS_CLD',XRRS_CLD(:,:,:,IDX_RST))
- IF (LUSERG) CALL IO_WRITE_FIELD(TPFILE,'RGS_CLD',XRRS_CLD(:,:,:,IDX_RGT))
- IF (LUSERH) CALL IO_WRITE_FIELD(TPFILE,'RHS_CLD',XRRS_CLD(:,:,:,IDX_RHT))
+ IF (LUSERV) CALL IO_Field_write(TPFILE,'RVS_CLD',XRRS_CLD(:,:,:,IDX_RVT))
+ IF (LUSERC) CALL IO_Field_write(TPFILE,'RCS_CLD',XRRS_CLD(:,:,:,IDX_RCT))
+ IF (LUSERR) CALL IO_Field_write(TPFILE,'RRS_CLD',XRRS_CLD(:,:,:,IDX_RRT))
+ IF (LUSERI) CALL IO_Field_write(TPFILE,'RIS_CLD',XRRS_CLD(:,:,:,IDX_RIT))
+ IF (LUSERS) CALL IO_Field_write(TPFILE,'RSS_CLD',XRRS_CLD(:,:,:,IDX_RST))
+ IF (LUSERG) CALL IO_Field_write(TPFILE,'RGS_CLD',XRRS_CLD(:,:,:,IDX_RGT))
+ IF (LUSERH) CALL IO_Field_write(TPFILE,'RHS_CLD',XRRS_CLD(:,:,:,IDX_RHT))
END IF
END IF
END IF
@@ -1469,7 +1468,7 @@ END IF
! TZFIELD%NTYPE = TYPEREAL
! TZFIELD%NDIMS = 3
! TZFIELD%LTIMEDEP = .TRUE.
-! CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XRRS_CLD(:,:,:,IRR))
+! CALL IO_Field_write(TPFILE,TZFIELD,XRRS_CLD(:,:,:,IRR))
! END IF
! IF (JSV == NSV_C2R2END ) THEN
! TZFIELD%CMNHNAME = 'RSVS_CLD2'
@@ -1482,7 +1481,7 @@ END IF
! TZFIELD%NTYPE = TYPEREAL
! TZFIELD%NDIMS = 3
! TZFIELD%LTIMEDEP = .TRUE.
-! CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XRRS_CLD(:,:,:,IRR))
+! CALL IO_Field_write(TPFILE,TZFIELD,XRRS_CLD(:,:,:,IRR))
! END IF
! END DO
! END IF
@@ -1492,31 +1491,32 @@ END IF
!
!
IF (CRAD /= 'NONE') THEN
- CALL IO_WRITE_FIELD(TPFILE,'DTRAD_FULL',TDTRAD_FULL)
- CALL IO_WRITE_FIELD(TPFILE,'DTRAD_CLLY',TDTRAD_CLONLY)
-!
- CALL IO_WRITE_FIELD(TPFILE,'DTHRAD', XDTHRAD)
- CALL IO_WRITE_FIELD(TPFILE,'FLALWD', XFLALWD)
- CALL IO_WRITE_FIELD(TPFILE,'DIRFLASWD', XDIRFLASWD)
- CALL IO_WRITE_FIELD(TPFILE,'SCAFLASWD', XSCAFLASWD)
- CALL IO_WRITE_FIELD(TPFILE,'DIRSRFSWD', XDIRSRFSWD)
- CALL IO_WRITE_FIELD(TPFILE,'CLEARCOL_TM1',NCLEARCOL_TM1)
- CALL IO_WRITE_FIELD(TPFILE,'ZENITH', XZENITH)
- CALL IO_WRITE_FIELD(TPFILE,'AZIM', XAZIM)
- CALL IO_WRITE_FIELD(TPFILE,'DIR_ALB', XDIR_ALB)
- CALL IO_WRITE_FIELD(TPFILE,'SCA_ALB', XSCA_ALB)
+ CALL IO_Field_write(TPFILE,'DTRAD_FULL',TDTRAD_FULL)
+ CALL IO_Field_write(TPFILE,'DTRAD_CLLY',TDTRAD_CLONLY)
+!
+ CALL IO_Field_write(TPFILE,'DTHRAD', XDTHRAD)
+ CALL IO_Field_write(TPFILE,'FLALWD', XFLALWD)
+ CALL IO_Field_write(TPFILE,'DIRFLASWD', XDIRFLASWD)
+ CALL IO_Field_write(TPFILE,'SCAFLASWD', XSCAFLASWD)
+ CALL IO_Field_write(TPFILE,'DIRSRFSWD', XDIRSRFSWD)
+ CALL IO_Field_write(TPFILE,'CLEARCOL_TM1',NCLEARCOL_TM1)
+ CALL IO_Field_write(TPFILE,'ZENITH', XZENITH)
+ CALL IO_Field_write(TPFILE,'AZIM', XAZIM)
+ CALL IO_Field_write(TPFILE,'DIR_ALB', XDIR_ALB)
+ CALL IO_Field_write(TPFILE,'SCA_ALB', XSCA_ALB)
!
CALL PRINT_MSG(NVERB_INFO,'IO','WRITE_LFIFM_n','EMIS: writing only first band')
CALL FIND_FIELD_ID_FROM_MNHNAME('EMIS',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%NDIMS = 2
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XEMIS(:,:,1))
+ CALL IO_Field_write(TPFILE,TZFIELD,XEMIS(:,:,1))
!
- CALL IO_WRITE_FIELD(TPFILE,'TSRAD', XTSRAD)
+ CALL IO_Field_write(TPFILE,'TSRAD', XTSRAD)
ENDIF
!
IF (NRR > 1 .AND. CPROGRAM == 'MESONH') THEN
- CALL IO_WRITE_FIELD(TPFILE,'CLDFR',XCLDFR)
+ CALL IO_Field_write(TPFILE,'CLDFR',XCLDFR)
+ CALL IO_Field_write(TPFILE,'RAINFR',XRAINFR)
END IF
!
!
@@ -1527,33 +1527,33 @@ IF (CDCONV /= 'NONE' .OR. CSCONV == 'KAFR') THEN
!
!
!
- CALL IO_WRITE_FIELD(TPFILE,'DTDCONV', TDTDCONV)
- CALL IO_WRITE_FIELD(TPFILE,'COUNTCONV',NCOUNTCONV)
- CALL IO_WRITE_FIELD(TPFILE,'DTHCONV', XDTHCONV)
- CALL IO_WRITE_FIELD(TPFILE,'DRVCONV', XDRVCONV)
- CALL IO_WRITE_FIELD(TPFILE,'DRCCONV', XDRCCONV)
- CALL IO_WRITE_FIELD(TPFILE,'DRICONV', XDRICONV)
+ CALL IO_Field_write(TPFILE,'DTDCONV', TDTDCONV)
+ CALL IO_Field_write(TPFILE,'COUNTCONV',NCOUNTCONV)
+ CALL IO_Field_write(TPFILE,'DTHCONV', XDTHCONV)
+ CALL IO_Field_write(TPFILE,'DRVCONV', XDRVCONV)
+ CALL IO_Field_write(TPFILE,'DRCCONV', XDRCCONV)
+ CALL IO_Field_write(TPFILE,'DRICONV', XDRICONV)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('PRCONV',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XPRCONV*3.6E6)
+ CALL IO_Field_write(TPFILE,TZFIELD,XPRCONV*3.6E6)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('PACCONV',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XPACCONV*1.0E3)
+ CALL IO_Field_write(TPFILE,TZFIELD,XPACCONV*1.0E3)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('PRSCONV',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XPRSCONV*3.6E6)
+ CALL IO_Field_write(TPFILE,TZFIELD,XPRSCONV*3.6E6)
!
IF ( LCH_CONV_LINOX ) THEN
- CALL IO_WRITE_FIELD(TPFILE,'IC_RATE', XIC_RATE)
- CALL IO_WRITE_FIELD(TPFILE,'CG_RATE', XCG_RATE)
- CALL IO_WRITE_FIELD(TPFILE,'IC_TOTAL_NB',XIC_TOTAL_NUMBER)
- CALL IO_WRITE_FIELD(TPFILE,'CG_TOTAL_NB',XCG_TOTAL_NUMBER)
+ CALL IO_Field_write(TPFILE,'IC_RATE', XIC_RATE)
+ CALL IO_Field_write(TPFILE,'CG_RATE', XCG_RATE)
+ CALL IO_Field_write(TPFILE,'IC_TOTAL_NB',XIC_TOTAL_NUMBER)
+ CALL IO_Field_write(TPFILE,'CG_TOTAL_NB',XCG_TOTAL_NUMBER)
END IF
!
IF ( LCHTRANS .AND. NSV > 0 ) THEN
@@ -1571,31 +1571,31 @@ IF (CDCONV /= 'NONE' .OR. CSCONV == 'KAFR') THEN
WRITE(TZFIELD%CMNHNAME,'(A7,I3.3)')'DSVCONV',JSV
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
END DO
DO JSV = NSV_C2R2BEG, NSV_C2R2END
TZFIELD%CMNHNAME = 'DSVCONV_'//TRIM(C2R2NAMES(JSV-NSV_C2R2BEG+1))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
END DO
DO JSV = NSV_C1R3BEG, NSV_C1R3END
TZFIELD%CMNHNAME = 'DSVCONV_'//TRIM(C1R3NAMES(JSV-NSV_C1R3BEG+1))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
END DO
DO JSV = NSV_ELECBEG, NSV_ELECEND
TZFIELD%CMNHNAME = 'DSVCONV_'//TRIM(CELECNAMES(JSV-NSV_ELECBEG+1))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
END DO
DO JSV = NSV_PPBEG, NSV_PPEND
WRITE(TZFIELD%CMNHNAME,'(A7,I3.3)')'DSVCONV',JSV
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
END DO
#ifdef MNH_FOREFIRE
IF (LFOREFIRE) THEN
@@ -1603,7 +1603,7 @@ IF (CDCONV /= 'NONE' .OR. CSCONV == 'KAFR') THEN
WRITE(TZFIELD%CMNHNAME,'(A7,I3.3)')'DSVCONV',JSV
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
END DO
END IF
#endif
@@ -1612,14 +1612,14 @@ IF (CDCONV /= 'NONE' .OR. CSCONV == 'KAFR') THEN
TZFIELD%CMNHNAME = 'DSVCONV_'//TRIM(UPCASE(CNAMES(JSV-NSV_CHEMBEG+1)))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
END DO
IF (LORILAM) THEN
DO JSV = NSV_AERBEG, NSV_AEREND
TZFIELD%CMNHNAME = 'DSVCONV_'//TRIM(UPCASE(CAERONAMES(JSV-NSV_AERBEG+1)))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
END DO
END IF
! linox scalar variables
@@ -1628,26 +1628,26 @@ IF (CDCONV /= 'NONE' .OR. CSCONV == 'KAFR') THEN
TZFIELD%CMNHNAME = 'DSVCONV_LINOX'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
END DO
END IF
DO JSV = NSV_LGBEG, NSV_LGEND
TZFIELD%CMNHNAME = 'DSVCONV_'//TRIM(CLGNAMES(JSV-NSV_LGBEG+1))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
END DO
DO JSV = NSV_DSTBEG, NSV_DSTEND
TZFIELD%CMNHNAME = 'DSVCONV_'//TRIM(CDUSTNAMES(JSV-NSV_DSTBEG+1))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
END DO
DO JSV = NSV_SLTBEG, NSV_SLTEND
TZFIELD%CMNHNAME = 'DSVCONV_'//TRIM(CSALTNAMES(JSV-NSV_SLTBEG+1))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
+ CALL IO_Field_write(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV))
END DO
END IF
!
@@ -1662,12 +1662,12 @@ IF (CPROGRAM /= 'IDEAL') THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('INPRC',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XINPRC*3.6E6)
+ CALL IO_Field_write(TPFILE,TZFIELD,XINPRC*3.6E6)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRC',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XACPRC*1.0E3)
+ CALL IO_Field_write(TPFILE,TZFIELD,XACPRC*1.0E3)
!
ENDIF
ENDIF
@@ -1677,12 +1677,12 @@ IF (CPROGRAM /= 'IDEAL') THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('INDEP',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XINDEP*3.6E6)
+ CALL IO_Field_write(TPFILE,TZFIELD,XINDEP*3.6E6)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('ACDEP',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XACDEP*1.0E3)
+ CALL IO_Field_write(TPFILE,TZFIELD,XACDEP*1.0E3)
!
ENDIF
ENDIF
@@ -1692,15 +1692,15 @@ IF (CPROGRAM /= 'IDEAL') THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('INPRR',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XINPRR*3.6E6)
+ CALL IO_Field_write(TPFILE,TZFIELD,XINPRR*3.6E6)
!
- CALL IO_WRITE_FIELD(TPFILE,'INPRR3D',XINPRR3D)
- CALL IO_WRITE_FIELD(TPFILE,'EVAP3D', XEVAP3D)
+ CALL IO_Field_write(TPFILE,'INPRR3D',XINPRR3D)
+ CALL IO_Field_write(TPFILE,'EVAP3D', XEVAP3D)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRR',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XACPRR*1.0E3)
+ CALL IO_Field_write(TPFILE,TZFIELD,XACPRR*1.0E3)
!
ENDIF
ENDIF
@@ -1710,12 +1710,12 @@ IF (CPROGRAM /= 'IDEAL') THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('INPRS',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XINPRS*3.6E6)
+ CALL IO_Field_write(TPFILE,TZFIELD,XINPRS*3.6E6)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRS',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XACPRS*1.0E3)
+ CALL IO_Field_write(TPFILE,TZFIELD,XACPRS*1.0E3)
END IF
END IF
!
@@ -1724,12 +1724,12 @@ IF (CPROGRAM /= 'IDEAL') THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('INPRG',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XINPRG*3.6E6)
+ CALL IO_Field_write(TPFILE,TZFIELD,XINPRG*3.6E6)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRG',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XACPRG*1.0E3)
+ CALL IO_Field_write(TPFILE,TZFIELD,XACPRG*1.0E3)
END IF
END IF
!
@@ -1738,12 +1738,12 @@ IF (CPROGRAM /= 'IDEAL') THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('INPRH',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XINPRH*3.6E6)
+ CALL IO_Field_write(TPFILE,TZFIELD,XINPRH*3.6E6)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRH',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XACPRH*1.0E3)
+ CALL IO_Field_write(TPFILE,TZFIELD,XACPRH*1.0E3)
ENDIF
ENDIF
!
@@ -1756,7 +1756,7 @@ IF (CPROGRAM /= 'IDEAL') THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('INPRT',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK2D*3.6E6)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK2D*3.6E6)
!
ZWORK2D = XACPRR + XACPRS
IF (SIZE(XINPRG) /= 0 ) ZWORK2D = ZWORK2D + XACPRG
@@ -1765,7 +1765,7 @@ IF (CPROGRAM /= 'IDEAL') THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRT',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CUNITS = 'mm'
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK2D*1.0E3)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK2D*1.0E3)
END IF
END IF
!
@@ -1784,7 +1784,7 @@ IF(LBLOWSNOW) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XSNWSUBL3D(:,:,:))
+ CALL IO_Field_write(TPFILE,TZFIELD,XSNWSUBL3D(:,:,:))
ZWORK2D(:,:) = 0.
DO JK = IKB,IKE
ZWORK2D(:,:) = ZWORK2D(:,:)+XSNWSUBL3D(:,:,JK) * &
@@ -1802,7 +1802,7 @@ IF(LBLOWSNOW) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZWORK2D(:,:))
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK2D(:,:))
END IF
END IF
ENDIF
@@ -1812,7 +1812,7 @@ ENDIF
!
IF (LFORCING) THEN
!
- CALL IO_WRITE_FIELD(TPFILE,'FRC',NFRC)
+ CALL IO_Field_write(TPFILE,'FRC',NFRC)
!
DO JT=1,NFRC
!
@@ -1828,7 +1828,7 @@ IF (LFORCING) THEN
TZFIELD%NTYPE = TYPEDATE
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,TDTFRC(JT))
+ CALL IO_Field_write(TPFILE,TZFIELD,TDTFRC(JT))
!
TZFIELD%CMNHNAME = 'UFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -1840,7 +1840,7 @@ IF (LFORCING) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XUFRC(:,JT))
+ CALL IO_Field_write(TPFILE,TZFIELD,XUFRC(:,JT))
!
TZFIELD%CMNHNAME = 'VFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -1852,7 +1852,7 @@ IF (LFORCING) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XVFRC(:,JT))
+ CALL IO_Field_write(TPFILE,TZFIELD,XVFRC(:,JT))
!
TZFIELD%CMNHNAME = 'WFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -1864,7 +1864,7 @@ IF (LFORCING) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XWFRC(:,JT))
+ CALL IO_Field_write(TPFILE,TZFIELD,XWFRC(:,JT))
!
TZFIELD%CMNHNAME = 'THFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -1876,7 +1876,7 @@ IF (LFORCING) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XTHFRC(:,JT))
+ CALL IO_Field_write(TPFILE,TZFIELD,XTHFRC(:,JT))
!
TZFIELD%CMNHNAME = 'RVFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -1888,7 +1888,7 @@ IF (LFORCING) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XRVFRC(:,JT))
+ CALL IO_Field_write(TPFILE,TZFIELD,XRVFRC(:,JT))
!
TZFIELD%CMNHNAME = 'TENDTHFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -1900,7 +1900,7 @@ IF (LFORCING) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XTENDTHFRC(:,JT))
+ CALL IO_Field_write(TPFILE,TZFIELD,XTENDTHFRC(:,JT))
!
TZFIELD%CMNHNAME = 'TENDRVFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -1912,7 +1912,7 @@ IF (LFORCING) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XTENDRVFRC(:,JT))
+ CALL IO_Field_write(TPFILE,TZFIELD,XTENDRVFRC(:,JT))
!
TZFIELD%CMNHNAME = 'GXTHFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -1924,7 +1924,7 @@ IF (LFORCING) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XGXTHFRC(:,JT))
+ CALL IO_Field_write(TPFILE,TZFIELD,XGXTHFRC(:,JT))
!
TZFIELD%CMNHNAME = 'GYTHFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -1936,7 +1936,7 @@ IF (LFORCING) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XGYTHFRC(:,JT))
+ CALL IO_Field_write(TPFILE,TZFIELD,XGYTHFRC(:,JT))
!
TZFIELD%CMNHNAME = 'PGROUNDFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -1948,7 +1948,7 @@ IF (LFORCING) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XPGROUNDFRC(JT))
+ CALL IO_Field_write(TPFILE,TZFIELD,XPGROUNDFRC(JT))
!
TZFIELD%CMNHNAME = 'TENDUFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -1960,7 +1960,7 @@ IF (LFORCING) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XTENDUFRC(:,JT))
+ CALL IO_Field_write(TPFILE,TZFIELD,XTENDUFRC(:,JT))
!
TZFIELD%CMNHNAME = 'TENDVFRC'//YFRC
TZFIELD%CSTDNAME = ''
@@ -1972,7 +1972,7 @@ IF (LFORCING) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XTENDVFRC(:,JT))
+ CALL IO_Field_write(TPFILE,TZFIELD,XTENDVFRC(:,JT))
!
END DO
!
@@ -1992,7 +1992,7 @@ IF ( L2D_ADV_FRC ) THEN
TZFIELD%NTYPE = TYPEINT
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,NADVFRC)
+ CALL IO_Field_write(TPFILE,TZFIELD,NADVFRC)
!
DO JT=1,NADVFRC
!
@@ -2008,7 +2008,7 @@ IF ( L2D_ADV_FRC ) THEN
TZFIELD%NTYPE = TYPEDATE
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,TDTADVFRC(JT))
+ CALL IO_Field_write(TPFILE,TZFIELD,TDTADVFRC(JT))
!
TZFIELD%CMNHNAME = 'TH_ADV'//YFRC
TZFIELD%CSTDNAME = ''
@@ -2020,7 +2020,7 @@ IF ( L2D_ADV_FRC ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XDTHFRC(:,:,:,JT))
+ CALL IO_Field_write(TPFILE,TZFIELD,XDTHFRC(:,:,:,JT))
!
TZFIELD%CMNHNAME = 'Q_ADV'//YFRC
TZFIELD%CSTDNAME = ''
@@ -2032,7 +2032,7 @@ IF ( L2D_ADV_FRC ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XDRVFRC(:,:,:,JT))
+ CALL IO_Field_write(TPFILE,TZFIELD,XDRVFRC(:,:,:,JT))
!
ENDDO
ENDIF
@@ -2049,7 +2049,7 @@ IF ( L2D_REL_FRC ) THEN
TZFIELD%NTYPE = TYPEINT
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,NRELFRC)
+ CALL IO_Field_write(TPFILE,TZFIELD,NRELFRC)
!
DO JT=1,NRELFRC
!
@@ -2065,7 +2065,7 @@ IF ( L2D_REL_FRC ) THEN
TZFIELD%NTYPE = TYPEDATE
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,TDTRELFRC(JT))
+ CALL IO_Field_write(TPFILE,TZFIELD,TDTRELFRC(JT))
!
TZFIELD%CMNHNAME = 'TH_REL'//YFRC
TZFIELD%CSTDNAME = ''
@@ -2077,7 +2077,7 @@ IF ( L2D_REL_FRC ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XTHREL(:,:,:,JT))
+ CALL IO_Field_write(TPFILE,TZFIELD,XTHREL(:,:,:,JT))
!
TZFIELD%CMNHNAME = 'Q_REL'//YFRC
TZFIELD%CSTDNAME = ''
@@ -2089,7 +2089,7 @@ IF ( L2D_REL_FRC ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XRVREL(:,:,:,JT))
+ CALL IO_Field_write(TPFILE,TZFIELD,XRVREL(:,:,:,JT))
!
ENDDO
ENDIF
@@ -2097,11 +2097,11 @@ ENDIF
!* 1.11bis Eddy Fluxes variables ! Modif PP
!
IF ( LTH_FLX ) THEN
- CALL IO_WRITE_FIELD(TPFILE,'VT_FLX',XVTH_FLUX_M)
- CALL IO_WRITE_FIELD(TPFILE,'WT_FLX',XWTH_FLUX_M)
+ CALL IO_Field_write(TPFILE,'VT_FLX',XVTH_FLUX_M)
+ CALL IO_Field_write(TPFILE,'WT_FLX',XWTH_FLUX_M)
END IF
!
-IF ( LUV_FLX) CALL IO_WRITE_FIELD(TPFILE,'VU_FLX',XVU_FLUX_M)
+IF ( LUV_FLX) CALL IO_Field_write(TPFILE,'VU_FLX',XVU_FLUX_M)
!
!* 1.12 Balloon variables
!
@@ -2119,36 +2119,36 @@ IF ( CPROGRAM=='REAL ' ) THEN
!
! i) Total fields (TOT=BASIC+TOTDIS)
!
- CALL IO_WRITE_FIELD(TPFILE,'UT15', XUTOT)
- CALL IO_WRITE_FIELD(TPFILE,'VT15', XVTOT)
- CALL IO_WRITE_FIELD(TPFILE,'TEMPTOT',XTTOT)
- IF (INDEX(CFILTERING,'P')/=0) CALL IO_WRITE_FIELD(TPFILE,'PRESTOT',XPTOT)
- IF (INDEX(CFILTERING,'Q')/=0) CALL IO_WRITE_FIELD(TPFILE,'HUMTOT', XQTOT)
+ CALL IO_Field_write(TPFILE,'UT15', XUTOT)
+ CALL IO_Field_write(TPFILE,'VT15', XVTOT)
+ CALL IO_Field_write(TPFILE,'TEMPTOT',XTTOT)
+ IF (INDEX(CFILTERING,'P')/=0) CALL IO_Field_write(TPFILE,'PRESTOT',XPTOT)
+ IF (INDEX(CFILTERING,'Q')/=0) CALL IO_Field_write(TPFILE,'HUMTOT', XQTOT)
!
! ii) Environmental fields (ENV=TOT-VORDIS)
!
- CALL IO_WRITE_FIELD(TPFILE,'UT16', XUENV)
- CALL IO_WRITE_FIELD(TPFILE,'VT16', XVENV)
- CALL IO_WRITE_FIELD(TPFILE,'TEMPENV',XTENV)
- IF (INDEX(CFILTERING,'P')/=0) CALL IO_WRITE_FIELD(TPFILE,'PRESENV',XPENV)
- IF (INDEX(CFILTERING,'Q')/=0) CALL IO_WRITE_FIELD(TPFILE,'HUMENV', XQENV)
+ CALL IO_Field_write(TPFILE,'UT16', XUENV)
+ CALL IO_Field_write(TPFILE,'VT16', XVENV)
+ CALL IO_Field_write(TPFILE,'TEMPENV',XTENV)
+ IF (INDEX(CFILTERING,'P')/=0) CALL IO_Field_write(TPFILE,'PRESENV',XPENV)
+ IF (INDEX(CFILTERING,'Q')/=0) CALL IO_Field_write(TPFILE,'HUMENV', XQENV)
!
END IF
IF (NDIAG_FILT >=1) THEN
!
! iii) Basic (filtered) fields
!
- CALL IO_WRITE_FIELD(TPFILE,'UT17', XUBASIC)
- CALL IO_WRITE_FIELD(TPFILE,'VT17', XVBASIC)
- CALL IO_WRITE_FIELD(TPFILE,'TEMPBAS',XTBASIC)
- IF (INDEX(CFILTERING,'P')/=0) CALL IO_WRITE_FIELD(TPFILE,'PRESBAS',XPBASIC)
- IF (INDEX(CFILTERING,'Q')/=0) CALL IO_WRITE_FIELD(TPFILE,'HUMBAS', XQBASIC)
+ CALL IO_Field_write(TPFILE,'UT17', XUBASIC)
+ CALL IO_Field_write(TPFILE,'VT17', XVBASIC)
+ CALL IO_Field_write(TPFILE,'TEMPBAS',XTBASIC)
+ IF (INDEX(CFILTERING,'P')/=0) CALL IO_Field_write(TPFILE,'PRESBAS',XPBASIC)
+ IF (INDEX(CFILTERING,'Q')/=0) CALL IO_Field_write(TPFILE,'HUMBAS', XQBASIC)
END IF
IF (NDIAG_FILT >=2) THEN
!
! iv) Total disturbance tangential wind
!
- CALL IO_WRITE_FIELD(TPFILE,'VTDIS',XVTDIS)
+ CALL IO_Field_write(TPFILE,'VTDIS',XVTDIS)
!
END IF
!
@@ -2169,7 +2169,7 @@ IF ( CPROGRAM=='REAL ' ) THEN
TZFIELD%CMNHNAME = ADJUSTL(CDUMMY_2D(JSA))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME)
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,XDUMMY_2D(:,:,JSA))
+ CALL IO_Field_write(TPFILE,TZFIELD,XDUMMY_2D(:,:,JSA))
END DO
END IF
!
diff --git a/src/MNH/write_profilern.f90 b/src/MNH/write_profilern.f90
index a011479a3aec3833065e4a014f0e5f86ffd64fe6..b70fe68aa07c4e64b9abf90081b591f66930374d 100644
--- a/src/MNH/write_profilern.f90
+++ b/src/MNH/write_profilern.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2002-2018 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.
!-----------------------------------------------------------------
! ###########################
@@ -11,7 +11,7 @@ INTERFACE
!
SUBROUTINE WRITE_PROFILER_n(TPDIAFILE)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! diachronic file to write
!
@@ -67,7 +67,7 @@ END MODULE MODI_WRITE_PROFILER_n
! ------------
!
USE MODD_CST
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT
USE MODD_PARAMETERS
!
diff --git a/src/MNH/write_seriesn.f90 b/src/MNH/write_seriesn.f90
index 9a0430e09585b8fbff097e61394abc09802a8db1..d4851b5a335e5f7b4b1e0c208a61ee9499ef5cd4 100644
--- a/src/MNH/write_seriesn.f90
+++ b/src/MNH/write_seriesn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2002-2018 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.
!-----------------------------------------------------------------
!########################
@@ -13,7 +13,7 @@ INTERFACE
!
SUBROUTINE WRITE_SERIES_n(TPDIAFILE)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! file to write
!
@@ -67,14 +67,13 @@ END MODULE MODI_WRITE_SERIES_n
!* 0. Declaration
! --------------
!
-USE MODD_IO_ll, ONLY: NGEN_VERB,TFILEDATA
+USE MODD_IO, ONLY: NGEN_VERB, TFILEDATA
USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_PARAMETERS
USE MODD_SERIES
USE MODD_SERIES_n
!
USE MODE_GATHER_ll
-USE MODE_IO_ll
USE MODE_ll
USE MODE_MSG
!
diff --git a/src/MNH/write_stationn.f90 b/src/MNH/write_stationn.f90
index 2a67c0fa17ab93dbc644751da8d13850fb9a607e..92722fe09c8748365494f66fe7cd59f0728b584a 100644
--- a/src/MNH/write_stationn.f90
+++ b/src/MNH/write_stationn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2002-2018 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.
!-----------------------------------------------------------------
! ###########################
@@ -11,7 +11,7 @@ INTERFACE
!
SUBROUTINE WRITE_STATION_n(TPDIAFILE)
!
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! diachronic file to write
!
@@ -64,7 +64,7 @@ END MODULE MODI_WRITE_STATION_n
! ------------
!
USE MODD_CST
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT
USE MODD_PARAMETERS
!
diff --git a/src/MNH/write_surf_mnh.f90 b/src/MNH/write_surf_mnh.f90
index 9455eaa0abd81d933ee279cd48b0e1fc649def38..2fb2021b5e149b35978a03228e44c19f23c3d528 100644
--- a/src/MNH/write_surf_mnh.f90
+++ b/src/MNH/write_surf_mnh.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1997-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
MODULE MODE_WRITE_SURF_MNH_TOOLS
@@ -171,15 +171,15 @@ END MODULE MODE_WRITE_SURF_MNH_TOOLS
!* 0. DECLARATIONS
! ------------
!
-USE MODE_IO_WRITE_FIELD
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPEREAL
+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_CONF, ONLY: CPROGRAM
+USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
USE MODD_GRID
-USE MODD_IO_ll, ONLY: TFILE_SURFEX
+USE MODD_IO, ONLY: TFILE_SURFEX
!
IMPLICIT NONE
!
@@ -209,7 +209,7 @@ IF( ( HREC=='LAT0' .OR. HREC=='LON0' .OR. HREC=='RPK' .OR. HREC=='BETA' &
ELSE
!
CALL PREPARE_METADATA_WRITE_SURF(HREC,'--',HCOMMENT,0,TYPEREAL,0,'WRITE_SURFX0_MNH',TZFIELD)
- CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,PFIELD,KRESP)
+ CALL IO_Field_write(TFILE_SURFEX,TZFIELD,PFIELD,KRESP)
!
IF (TRIM(CPROGRAM)=='PGD') THEN
!Store these variables (necessary for PREP_PGD program when writing netCDF files)
@@ -276,20 +276,21 @@ END SUBROUTINE WRITE_SURFX0_MNH
!!
!! original 01/08/03
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! P. Wautelet 01/02/2019: bug: forgotten if for iib=iie and XX (same as for YY)
!----------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODE_IO_WRITE_FIELD
-USE MODE_FIELD, ONLY: FIND_FIELD_ID_FROM_MNHNAME,TFIELDDATA,TFIELDLIST,TYPEREAL
+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_GRID_n, ONLY: XXHAT, XYHAT
-USE MODD_IO_ll, ONLY: TFILE_SURFEX
+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, &
@@ -412,7 +413,7 @@ END IF
CALL GET_SURF_UNDEF(ZUNDEF)
WHERE (ZWORK==ZUNDEF) ZWORK=XUNDEF
-!
+ !
!! Add cases in 2D (IJB=IJE) and 1D (IJB=IJE and IIB=IIE)
!! to write the correct mesh
IF ( (CSTORAGE_TYPE=='PG' .OR. CSTORAGE_TYPE=='SU') &
@@ -425,7 +426,7 @@ IF ( (CSTORAGE_TYPE=='PG' .OR. CSTORAGE_TYPE=='SU') &
ZW1D( J1D) = 2. * ZW1D(J1D+1) - ZW1D(J1D+2)
ZW1D(IIU+1-J1D) = 2. * ZW1D(IIU-J1D) - ZW1D(IIU-J1D-1)
END DO
- ELSE IF (IIB==IIE .AND. HREC=='DX') THEN
+ ELSE IF (IIB==IIE .AND. (HREC=='DX' .OR. HREC=='XX')) THEN
ZW1D(IIB-1) = - 0.5 * ZWORK(IIB,1+JPHEXT)
ZW1D(IIB) = 0.5 * ZWORK(IIB,1+JPHEXT)
ZW1D(IIB+1) = 1.5 * ZWORK(IIB,1+JPHEXT)
@@ -435,11 +436,11 @@ IF ( (CSTORAGE_TYPE=='PG' .OR. CSTORAGE_TYPE=='SU') &
CALL FIND_FIELD_ID_FROM_MNHNAME('XHAT',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CDIR = '--'
- CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,ZW1D(:),KRESP)
+ CALL IO_Field_write(TFILE_SURFEX,TZFIELD,ZW1D(:),KRESP)
END IF
IF (HDIR=='H') THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('XHAT',IID,IRESP)
- CALL IO_WRITE_FIELD(TFILE_SURFEX,TFIELDLIST(IID),ZW1D(1+NHALO:IIU-NHALO),KRESP)
+ CALL IO_Field_write(TFILE_SURFEX,TFIELDLIST(IID),ZW1D(1+NHALO:IIU-NHALO),KRESP)
IF (.NOT. (ASSOCIATED(XXHAT))) THEN
!Store XXHAT if not yet done (necessary for PREP_PGD program when writing netCDF files)
ALLOCATE(XXHAT(IIU-2*NHALO))
@@ -466,11 +467,11 @@ ELSE IF ( (CSTORAGE_TYPE=='PG' .OR. CSTORAGE_TYPE=='SU') &
CALL FIND_FIELD_ID_FROM_MNHNAME('YHAT',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
TZFIELD%CDIR = '--'
- CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,ZW1D(:),KRESP)
+ CALL IO_Field_write(TFILE_SURFEX,TZFIELD,ZW1D(:),KRESP)
END IF
IF (HDIR=='H') THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('YHAT',IID,IRESP)
- CALL IO_WRITE_FIELD(TFILE_SURFEX,TFIELDLIST(IID),ZW1D(1+NHALO:IJU-NHALO),KRESP)
+ CALL IO_Field_write(TFILE_SURFEX,TFIELDLIST(IID),ZW1D(1+NHALO:IJU-NHALO),KRESP)
IF (.NOT. (ASSOCIATED(XYHAT))) THEN
!Store XYHAT if not yet done (necessary for PREP_PGD program when writing netCDF files)
ALLOCATE(XYHAT(IJU-2*NHALO))
@@ -480,13 +481,13 @@ ELSE IF ( (CSTORAGE_TYPE=='PG' .OR. CSTORAGE_TYPE=='SU') &
DEALLOCATE(ZW1D)
ELSE IF (HDIR=='H') THEN
CALL PREPARE_METADATA_WRITE_SURF(HREC,'XY',HCOMMENT,4,TYPEREAL,2,'WRITE_SURFX1_MNH',TZFIELD)
- CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,ZWORK(1+NHALO:IIU-NHALO,1+NHALO:IJU-NHALO),KRESP)
+ CALL IO_Field_write(TFILE_SURFEX,TZFIELD,ZWORK(1+NHALO:IIU-NHALO,1+NHALO:IJU-NHALO),KRESP)
ELSE IF (HDIR=='A') THEN
CALL PREPARE_METADATA_WRITE_SURF(HREC,'--',HCOMMENT,4,TYPEREAL,2,'WRITE_SURFX1_MNH',TZFIELD)
- CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,ZWORK(:,:),KRESP)
+ CALL IO_Field_write(TFILE_SURFEX,TZFIELD,ZWORK(:,:),KRESP)
ELSE
CALL PREPARE_METADATA_WRITE_SURF(HREC,'--',HCOMMENT,4,TYPEREAL,1,'WRITE_SURFX1_MNH',TZFIELD)
- CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,PFIELD(:),KRESP)
+ CALL IO_Field_write(TFILE_SURFEX,TZFIELD,PFIELD(:),KRESP)
END IF
!
IF (KRESP /=0) THEN
@@ -544,20 +545,20 @@ END SUBROUTINE WRITE_SURFX1_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_IO_WRITE_FIELD
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPELOG,TYPEREAL
+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_DATA_COVER_PAR,ONLY : JPCOVER
-USE MODD_IO_ll, 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, JPHEXT
+USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
+USE MODD_DATA_COVER_PAR, ONLY: JPCOVER
+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, JPHEXT
!
USE MODI_GET_SURF_UNDEF
USE MODI_UNPACK_1D_2D
@@ -647,7 +648,7 @@ TZFIELD%NGRID = 0
TZFIELD%NTYPE = TYPELOG
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
-CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,GCOVER_PACKED,KRESP)
+CALL IO_Field_write(TFILE_SURFEX,TZFIELD,GCOVER_PACKED,KRESP)
!
IF (KRESP /=0) THEN
WRITE ( YMSG, '( I5 )' ) KRESP
@@ -681,12 +682,12 @@ IF (.NOT. GCOVER_PACKED) THEN
TZFIELD%CCOMMENT = 'X_Y_'//TRIM(YREC)
IF (OFLAG(JL2)) THEN
ICOVER=ICOVER+1
- CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,ZWORK3D(1+NHALO:IIU-NHALO,1+NHALO:IJU-NHALO,ICOVER),KRESP)
+ CALL IO_Field_write(TFILE_SURFEX,TZFIELD,ZWORK3D(1+NHALO:IIU-NHALO,1+NHALO:IJU-NHALO,ICOVER),KRESP)
END IF
END DO
ELSE
CALL PREPARE_METADATA_WRITE_SURF(HREC,YDIR,HCOMMENT,4,TYPEREAL,3,'WRITE_SURFX2COV_MNH',TZFIELD)
- CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,ZWORK3D(1+NHALO:IIU-NHALO,1+NHALO:IJU-NHALO,:),KRESP)
+ CALL IO_Field_write(TFILE_SURFEX,TZFIELD,ZWORK3D(1+NHALO:IIU-NHALO,1+NHALO:IJU-NHALO,:),KRESP)
END IF
!
DEALLOCATE(ZWORK3D)
@@ -745,20 +746,20 @@ END SUBROUTINE WRITE_SURFX2COV_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_IO_WRITE_FIELD
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPEREAL
+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_IO_ll, 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 MODD_CONF_n, ONLY: CSTORAGE_TYPE
+USE MODD_DATA_COVER_PAR, ONLY: JPCOVER
+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 MODI_GET_SURF_UNDEF
USE MODI_UNPACK_1D_2D
@@ -826,11 +827,11 @@ IF (HDIR=='H' .OR. HDIR=='A') THEN
!
IF (HDIR=='H') THEN
CALL PREPARE_METADATA_WRITE_SURF(HREC,'XY',HCOMMENT,4,TYPEREAL,3,'WRITE_SURFX2_MNH',TZFIELD)
- CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,ZWORK(1+NHALO:IIU-NHALO,1+NHALO:IJU-NHALO,:),KRESP)
+ CALL IO_Field_write(TFILE_SURFEX,TZFIELD,ZWORK(1+NHALO:IIU-NHALO,1+NHALO:IJU-NHALO,:),KRESP)
END IF
IF (HDIR=='A') THEN
CALL PREPARE_METADATA_WRITE_SURF(HREC,'--',HCOMMENT,4,TYPEREAL,3,'WRITE_SURFX2_MNH',TZFIELD)
- CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,ZWORK(:,:,:),KRESP)
+ CALL IO_Field_write(TFILE_SURFEX,TZFIELD,ZWORK(:,:,:),KRESP)
END IF
!
DEALLOCATE(ZWORK)
@@ -841,7 +842,7 @@ ELSE IF (HDIR=='-') THEN
WHERE (ZFIELD==ZUNDEF) ZFIELD=XUNDEF
!
CALL PREPARE_METADATA_WRITE_SURF(HREC,'--',HCOMMENT,4,TYPEREAL,2,'WRITE_SURFX2_MNH',TZFIELD)
- CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,ZFIELD(:,:),KRESP)
+ CALL IO_Field_write(TFILE_SURFEX,TZFIELD,ZFIELD(:,:),KRESP)
!
DEALLOCATE(ZFIELD)
END IF
@@ -896,15 +897,15 @@ END SUBROUTINE WRITE_SURFX2_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_IO_WRITE_FIELD
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPEINT
+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_IO_ll, ONLY: TFILE_SURFEX
-USE MODD_IO_SURF_MNH, ONLY: NIU_ALL, NJU_ALL
-USE MODD_PARAMETERS, ONLY: JPHEXT
+USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
+USE MODD_IO, ONLY: TFILE_SURFEX
+USE MODD_IO_SURF_MNH, ONLY: NIU_ALL, NJU_ALL
+USE MODD_PARAMETERS, ONLY: JPHEXT
!
IMPLICIT NONE
!
@@ -931,14 +932,14 @@ IF( (HREC=='IMAX' .OR. HREC=='JMAX' .OR. HREC=='KMAX') .AND. &
!
ELSE IF (HREC=='VERSION' .OR. HREC=='BUG') THEN
!Field is in fieldlist
- CALL IO_WRITE_FIELD(TFILE_SURFEX,HREC,KFIELD,KRESP)
+ CALL IO_Field_write(TFILE_SURFEX,HREC,KFIELD,KRESP)
ELSE
IFIELD = KFIELD
IF (HREC=='IMAX') IFIELD = NIU_ALL-2*JPHEXT
IF (HREC=='JMAX') IFIELD = NJU_ALL-2*JPHEXT
!
CALL PREPARE_METADATA_WRITE_SURF(HREC,'--',HCOMMENT,0,TYPEINT,0,'WRITE_SURFN0_MNH',TZFIELD)
- CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,IFIELD,KRESP)
+ CALL IO_Field_write(TFILE_SURFEX,TZFIELD,IFIELD,KRESP)
END IF
!
IF (KRESP /=0) THEN
@@ -991,15 +992,15 @@ END SUBROUTINE WRITE_SURFN0_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_IO_WRITE_FIELD
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPEINT
+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_IO_ll, ONLY: TFILE_SURFEX
-USE MODD_IO_SURF_MNH, ONLY: NMASK, CMASK, &
- NIU, NJU, NIB, NJB, NIE, NJE
-USE MODD_PARAMETERS, ONLY: NUNDEF
+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 MODI_UNPACK_1D_2D
!
@@ -1030,7 +1031,7 @@ CALL PRINT_MSG(NVERB_DEBUG,'IO','WRITE_SURFN1_MNH',TRIM(TFILE_SURFEX%CNAME)//':
IF (HDIR=='-') THEN
!
CALL PREPARE_METADATA_WRITE_SURF(HREC,'--',HCOMMENT,0,TYPEINT,1,'WRITE_SURFN1_MNH',TZFIELD)
- CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,KFIELD,KRESP)
+ CALL IO_Field_write(TFILE_SURFEX,TZFIELD,KFIELD,KRESP)
!
ELSE IF (HDIR=='H') THEN
!
@@ -1040,7 +1041,7 @@ ELSE IF (HDIR=='H') THEN
CALL UNPACK_1D_2D(NMASK,KFIELD,IWORK(NIB:NIE,NJB:NJE))
!
CALL PREPARE_METADATA_WRITE_SURF(HREC,'XY',HCOMMENT,4,TYPEINT,2,'WRITE_SURFN1_MNH',TZFIELD)
- CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,IWORK(:,:),KRESP)
+ CALL IO_Field_write(TFILE_SURFEX,TZFIELD,IWORK(:,:),KRESP)
!
DEALLOCATE(IWORK)
END IF
@@ -1094,14 +1095,14 @@ END SUBROUTINE WRITE_SURFN1_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_IO_WRITE_FIELD
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPECHAR,TYPELOG
+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_IO_ll, ONLY: TFILE_SURFEX
-USE MODD_IO_SURF_MNH, ONLY: NIU_ALL, NJU_ALL
+USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
+USE MODD_IO, ONLY: TFILE_SURFEX
+USE MODD_IO_SURF_MNH, ONLY: NIU_ALL, NJU_ALL
!
IMPLICIT NONE
!
@@ -1129,7 +1130,7 @@ IF ( (CSTORAGE_TYPE=='PG' .OR. CSTORAGE_TYPE=='SU') &
GCARTESIAN = .TRUE.
END IF
!
- CALL IO_WRITE_FIELD(TFILE_SURFEX,'CARTESIAN',GCARTESIAN,KRESP)
+ CALL IO_Field_write(TFILE_SURFEX,'CARTESIAN',GCARTESIAN,KRESP)
!
IF (KRESP /=0) THEN
WRITE ( YMSG, '( I5 )' ) KRESP
@@ -1139,7 +1140,7 @@ IF ( (CSTORAGE_TYPE=='PG' .OR. CSTORAGE_TYPE=='SU') &
END IF
!
CALL PREPARE_METADATA_WRITE_SURF(HREC,'--',HCOMMENT,0,TYPECHAR,0,'WRITE_SURFC0_MNH',TZFIELD)
-CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,HFIELD,KRESP)
+CALL IO_Field_write(TFILE_SURFEX,TZFIELD,HFIELD,KRESP)
!
IF (KRESP /=0) THEN
WRITE ( YMSG, '( I5 )' ) KRESP
@@ -1190,15 +1191,15 @@ END SUBROUTINE WRITE_SURFC0_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_IO_WRITE_FIELD
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPEINT,TYPELOG
+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_IO_ll, ONLY: TFILE_SURFEX
-USE MODD_IO_SURF_MNH, ONLY: NMASK, CMASK, &
- NIU, NJU, NIB, NJB, NIE, NJE
+USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
+USE MODD_IO, ONLY: TFILE_SURFEX
+USE MODD_IO_SURF_MNH, ONLY: NMASK, CMASK, &
+ NIU, NJU, NIB, NJB, NIE, NJE
!
USE MODI_UNPACK_1D_2D
!
@@ -1234,7 +1235,7 @@ IF (HDIR=='-') THEN
RETURN
ELSE
CALL PREPARE_METADATA_WRITE_SURF(HREC,'--',HCOMMENT,0,TYPELOG,1,'WRITE_SURFL1_MNH',TZFIELD)
- CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,OFIELD(:),KRESP)
+ CALL IO_Field_write(TFILE_SURFEX,TZFIELD,OFIELD(:),KRESP)
END IF
!
ELSE IF (HDIR=='H') THEN
@@ -1249,7 +1250,7 @@ ELSE IF (HDIR=='H') THEN
WHERE(GWORK) IWORK = 1
!
CALL PREPARE_METADATA_WRITE_SURF(HREC,'XY',HCOMMENT,4,TYPEINT,2,'WRITE_SURFL1_MNH',TZFIELD)
- CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,IWORK(:,:),KRESP)
+ CALL IO_Field_write(TFILE_SURFEX,TZFIELD,IWORK(:,:),KRESP)
!
DEALLOCATE(IWORK)
DEALLOCATE(GWORK)
@@ -1305,14 +1306,14 @@ END SUBROUTINE WRITE_SURFL1_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_IO_WRITE_FIELD
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPELOG
+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_IO_ll, ONLY: TFILE_SURFEX
-USE MODD_IO_SURF_MNH, ONLY: CMASK
+USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
+USE MODD_IO, ONLY: TFILE_SURFEX
+USE MODD_IO_SURF_MNH, ONLY: CMASK
!
IMPLICIT NONE
!
@@ -1336,7 +1337,7 @@ IF( (CMASK /= 'FULL ').AND. (HREC=='COVER') ) THEN
RETURN
ELSE
CALL PREPARE_METADATA_WRITE_SURF(HREC,'--',HCOMMENT,0,TYPELOG,0,'WRITE_SURFL0_MNH',TZFIELD)
- CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,OFIELD,KRESP)
+ CALL IO_Field_write(TFILE_SURFEX,TZFIELD,OFIELD,KRESP)
END IF
!
IF (KRESP /=0) THEN
@@ -1388,14 +1389,14 @@ END SUBROUTINE WRITE_SURFL0_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEDATE
-USE MODE_FM
-USE MODE_FMWRIT
+USE MODE_FIELD, ONLY: TFIELDDATA, TYPEDATE
+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_ll, ONLY: TFILE_SURFEX
+USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
+USE MODD_IO, ONLY: TFILE_SURFEX
USE MODD_TYPE_DATE
!
!
@@ -1431,7 +1432,7 @@ ELSE
TZDATA%TIME = PTIME
!
CALL PREPARE_METADATA_WRITE_SURF(HREC,'--',HCOMMENT,0,TYPEDATE,0,'WRITE_SURFT0_MNH',TZFIELD)
- CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,TZDATA,KRESP)
+ CALL IO_Field_write(TFILE_SURFEX,TZFIELD,TZDATA,KRESP)
END IF
!
IF (KRESP /=0) THEN
@@ -1482,13 +1483,13 @@ END SUBROUTINE WRITE_SURFT0_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEINT, TYPEREAL
-USE MODE_FM
-USE MODE_FMWRIT
+USE MODE_FIELD, ONLY: TFIELDDATA, TYPEINT, TYPEREAL
+use MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_IO_FILE
USE MODE_MSG
!
-USE MODD_IO_ll, ONLY: TFILE_SURFEX
-USE MODD_CONF_n, ONLY : CSTORAGE_TYPE
+USE MODD_IO, ONLY: TFILE_SURFEX
+USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
!
!
IMPLICIT NONE
@@ -1534,7 +1535,7 @@ ELSE
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .FALSE.
!
- CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,ITDATE(:,:),KRESP)
+ CALL IO_Field_write(TFILE_SURFEX,TZFIELD,ITDATE(:,:),KRESP)
!
IF (KRESP /=0) THEN
WRITE ( YMSG, '( I5 )' ) KRESP
@@ -1552,7 +1553,7 @@ ELSE
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
!
- CALL IO_WRITE_FIELD(TFILE_SURFEX,TZFIELD,PTIME(:),KRESP)
+ CALL IO_Field_write(TFILE_SURFEX,TZFIELD,PTIME(:),KRESP)
!
IF (KRESP /=0) THEN
WRITE ( YMSG, '( I5 )' ) KRESP
diff --git a/src/MNH/write_ts1d.f90 b/src/MNH/write_ts1d.f90
index df0cd10bdacd3dcb2804d7a1b043cec6a8db4859..f57d26eef48fbf62659b9a077cc6eeafe7d1ade2 100644
--- a/src/MNH/write_ts1d.f90
+++ b/src/MNH/write_ts1d.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1995-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
!! #############################
@@ -70,16 +70,14 @@
!!
!! EXTERNAL
!! --------
-!! OPEN_ll and CLOSE_ll ! attribute a free I/O unit and close it again
!! IMPLICIT ARGUMENTS
!! ------------------
USE MODE_DATETIME
-USE MODE_FM, ONLY: IO_FILE_CLOSE_ll,IO_FILE_OPEN_ll
-USE MODE_IO_MANAGE_STRUCT,ONLY: IO_FILE_ADD2LIST
-USE MODE_IO_ll
+USE MODE_IO_FILE, ONLY: IO_File_close, IO_File_open
+USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list
USE MODE_GRIDPROJ
USE MODE_ll
!
@@ -89,7 +87,7 @@ USE MODD_NSV, ONLY: NSV,NSV_CHEMBEG,NSV_CHEMEND, &
USE MODD_CH_AEROSOL, ONLY: CAERONAMES, LORILAM
USE MODD_DYN_n, ONLY: XTSTEP ! time-step of the model
USE MODD_DIM_n, ONLY: NKMAX ! # of points in Z of the physical grid
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS, ONLY: JPVEXT ! vertical external points number
USE MODD_GRID, ONLY: XLATORI,XLONORI
USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZZ
@@ -121,7 +119,6 @@ USE MODD_CH_JVALUES_n, ONLY: XJVALUES ! Jvalues and
USE MODD_CH_INIT_JVALUES, ONLY:JPJVMAX ! their number
USE MODD_PARAMETERS, ONLY: XUNDEF
USE MODD_DIAG_FLAG, ONLY: LCHEMDIAG, XCHEMLAT, XCHEMLON
-USE MODI_TRANSFER_FILE
IMPLICIT NONE
!! EXPLICIT ARGUMENTS
@@ -232,8 +229,8 @@ DO JN=1,NBPROF
(JINDEX >= 1).AND.(JINDEX <= IJU)) THEN
! write picasso def-file
IF (GSFIRSTCALL) THEN
- CALL IO_FILE_ADD2LIST(TZFILE,YSIO1DDEF,'TXT','WRITE')
- CALL IO_FILE_OPEN_ll(TZFILE,HPOSITION='REWIND',HSTATUS='NEW')
+ CALL IO_File_add2list(TZFILE,YSIO1DDEF,'TXT','WRITE')
+ CALL IO_File_open(TZFILE,HPOSITION='REWIND',HSTATUS='NEW')
ISIO1D = TZFILE%NLU
! write comment
@@ -276,13 +273,12 @@ DO JN=1,NBPROF
END IF
END DO
- CALL IO_FILE_CLOSE_ll(TZFILE)
+ CALL IO_File_close(TZFILE)
TZFILE => NULL()
- CALL TRANSFER_FILE('fujitransfer.x','NIL',YSIO1DDEF)
! open picasso dat-file
- CALL IO_FILE_ADD2LIST(TZFILE,YSIO1DDAT,'TXT','WRITE')
- CALL IO_FILE_OPEN_ll(TZFILE,HPOSITION='REWIND',HSTATUS='NEW')
+ CALL IO_File_add2list(TZFILE,YSIO1DDAT,'TXT','WRITE')
+ CALL IO_File_open(TZFILE,HPOSITION='REWIND',HSTATUS='NEW')
ISIO1D = TZFILE%NLU
! calculate ISSKIP
@@ -390,14 +386,12 @@ DO JN=1,NBPROF
ENDDO
IF ((CPROGRAM =='DIAG ').AND.(LCHEMDIAG)) THEN
- CALL IO_FILE_CLOSE_ll(TZFILE)
+ CALL IO_File_close(TZFILE)
TZFILE => NULL()
- CALL TRANSFER_FILE('fujitransfer.x','NIL',YSIO1DDAT)
END IF
IF (L1D) THEN
GSFIRSTCALL = .FALSE.
- CALL TRANSFER_FILE('fujitransfer.x','NIL',YSIO1DDAT)
END IF
END IF
diff --git a/src/MNH/xy_to_latlon.f90 b/src/MNH/xy_to_latlon.f90
index 606aa70aaaba86ee8c7b3ab04b9c97af5501d05d..49fa91ab68950f5d1e6ab3a900e503b078828fd4 100644
--- a/src/MNH/xy_to_latlon.f90
+++ b/src/MNH/xy_to_latlon.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2006-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ####################
@@ -54,28 +54,29 @@
!! 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 07/02/2019: force TYPE to a known value for IO_File_add2list
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
! -----------
!
!
-USE MODD_GRID
-USE MODD_IO_ll, ONLY: TFILEDATA
+USE MODD_GRID
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PGDDIM
USE MODD_PGDGRID
USE MODD_PARAMETERS
USE MODD_LUNIT
!
-USE MODE_FM
USE MODE_GRIDPROJ
-USE MODE_IO_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY : IO_FILE_ADD2LIST
+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
!
USE MODI_INI_CST
USE MODI_READ_HGRID
!
-USE MODN_CONFIO, ONLY : NAM_CONFIO
+USE MODN_CONFIO, ONLY: NAM_CONFIO
!
IMPLICIT NONE
!
@@ -117,21 +118,21 @@ CALL INI_CST
!
!* 2. Reading of namelist file
! ------------------------
-CALL INITIO_ll()
+CALL IO_Init()
!
-CALL IO_FILE_ADD2LIST(TZNMLFILE,'XY2LATLON1.nam','NML','READ')
-CALL IO_FILE_OPEN_ll(TZNMLFILE)
+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 SET_CONFIO_ll()
-CALL IO_FILE_CLOSE_ll(TZNMLFILE)
+CALL IO_Config_set()
+CALL IO_File_close(TZNMLFILE)
!
!* 1. Opening of MESONH file
! ----------------------
!
-CALL IO_FILE_ADD2LIST(TZINIFILE,TRIM(YINIFILE),'UNKNOWN','READ',KLFITYPE=2,KLFIVERB=2)
-CALL IO_FILE_OPEN_ll(TZINIFILE)
+CALL IO_File_add2list(TZINIFILE,TRIM(YINIFILE),'MNH','READ',KLFITYPE=2,KLFIVERB=2)
+CALL IO_File_open(TZINIFILE)
!
!* 2. Reading of MESONH file
! ----------------------
@@ -141,7 +142,7 @@ CALL READ_HGRID(0,TZINIFILE,YNAME,YDAD,YSTORAGE_TYPE)
!* 3. Closing of MESONH file
! ----------------------
!
-CALL IO_FILE_CLOSE_ll(TZINIFILE)
+CALL IO_File_close(TZINIFILE)
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/zdiffusetup.f90 b/src/MNH/zdiffusetup.f90
index 29dafe66044e369939c000360dc4ab8657ad1fc5..40f2b1c795934cd9bf7c22920fd03520900a4a60 100644
--- a/src/MNH/zdiffusetup.f90
+++ b/src/MNH/zdiffusetup.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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/18 13:07:25
-!-----------------------------------------------------------------
! ####################
MODULE MODI_ZDIFFUSETUP
! ####################
@@ -54,8 +49,10 @@ END MODULE MODI_ZDIFFUSETUP
!! ------
!!
!! G. Zängl * University of Munich*
-!! J.Escobar 7/10/2015 : remove print
-!!
+!
+! Modifications:
+! J. Escobar 07/10/2015: remove print
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!
!* 0. DECLARATIONS
! ------------
@@ -278,6 +275,8 @@ CONTAINS
SUBROUTINE INDINT_HALO2(KII,KIJ,PZMASS,PKIND,KKMIN,KIB,KJB)
+use mode_msg
+
IMPLICIT NONE
INTEGER, INTENT(IN) :: KII,KIJ ! Relative position of remote points
@@ -322,9 +321,7 @@ ELSE IF ((KIJ.EQ.0).AND.(KII.NE.0)) THEN
ELSE
- !callabortstop
-CALL ABORT
- STOP 'Error in zdiffusetup'
+ call Print_msg( NVERB_FATAL, 'GEN', 'INDINT_HALO2', 'KII=0 and KIJ=0' )
ENDIF
DO JI = II1,II2
@@ -372,21 +369,15 @@ DO JI = II1,II2
ENDDO
ENDDO
ENDDO
-IF (MINVAL(KKMIN) .EQ. 0 ) THEN
-print *," zdiffusetup::PROBLEME MINVAL(KKMIN) .EQ. 0 "
-call abort()
-STOP
-ELSE
-!print *," zdiffusetup:: OK "
+
+IF ( MINVAL(KKMIN) == 0 ) THEN
+ call Print_msg( NVERB_FATAL, 'GEN', 'INDINT_HALO2', 'MINVAL(KKMIN)=0' )
ENDIF
-IF (MINVAL(INT(PKIND)) .EQ. 0 ) THEN
-print *," zdiffusetup::PROBLEME MINVAL(INT(PKIND)) .EQ. 0 "
-!PKIND = MAX (1.00001,PKIND)
-call abort()
-STOP
-ELSE
-!print *," zdiffusetup:: OK "
+
+IF ( MINVAL(INT(PKIND)) == 0 ) THEN
+ call Print_msg( NVERB_FATAL, 'GEN', 'INDINT_HALO2', 'MINVAL(INT(PKIND))=0' )
ENDIF
+
END SUBROUTINE INDINT_HALO2
END SUBROUTINE ZDIFFUSETUP
diff --git a/src/MNH/zoom_pgd.f90 b/src/MNH/zoom_pgd.f90
index af620d5b8b42d0197d85d8ce18f6ffeddc23258d..90103c5141e3712d2c40af6ca916c184b0856162 100644
--- a/src/MNH/zoom_pgd.f90
+++ b/src/MNH/zoom_pgd.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2005-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2005-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.
!-----------------------------------------------------------------
! ################
@@ -40,6 +40,8 @@
!! 06/2016 (G.Delautier) phasage surfex 8
!! 08/07/2016 P.Wautelet 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 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
!!
!----------------------------------------------------------------------------
!
@@ -47,19 +49,20 @@
! -----------
!
USE MODD_CONF, ONLY : CPROGRAM, L1D, L2D, LPACK
-USE MODD_IO_ll, ONLY: NIO_VERB,NVERB_DEBUG,TFILE_OUTPUTLISTING,TFILEDATA
-USE MODD_LUNIT, ONLY : CLUOUT0, TLUOUT0, TOUTDATAFILE
+USE MODD_IO, ONLY: NIO_VERB,NVERB_DEBUG,TFILE_OUTPUTLISTING,TFILEDATA
+USE MODD_LUNIT, ONLY : TLUOUT0, TOUTDATAFILE
USE MODD_PARAMETERS, ONLY : XUNDEF, NUNDEF, JPVEXT, JPHEXT, JPMODELMAX
USE MODD_PARAM_n, ONLY : CSURF
USE MODD_DIM_n, ONLY : NIMAX, NJMAX
USE MODD_CONF_n, ONLY : CSTORAGE_TYPE
+use modd_precision, only: LFIINT
!
USE MODE_POS
-USE MODE_FM
-USE MODE_FMWRIT
-USE MODE_FMREAD
-USE MODE_IO_ll
-USE MODE_IO_MANAGE_STRUCT, ONLY : IO_FILE_ADD2LIST, IO_FILE_PRINT_LIST
+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_ll
USE MODE_MSG
USE MODE_MODELN_HANDLER
@@ -119,16 +122,15 @@ CALL INI_CST
!* 1. Set default names and parallelized I/O
! --------------------------------------
!
-CALL INITIO_ll()
+CALL IO_Init()
!
-CLUOUT0='OUTPUT_LISTING0' ! name of the output-listing
-CALL IO_FILE_ADD2LIST(TLUOUT0,'OUTPUT_LISTING0','OUTPUTLISTING','WRITE')
-CALL IO_FILE_OPEN_ll(TLUOUT0)
+CALL IO_File_add2list(TLUOUT0,'OUTPUT_LISTING0','OUTPUTLISTING','WRITE')
+CALL IO_File_open(TLUOUT0)
TFILE_OUTPUTLISTING => TLUOUT0
ILUOUT0=TLUOUT0%NLU
!
-CALL IO_FILE_ADD2LIST(TZNMLFILE,'PRE_ZOOM1.nam','NML','READ')
-CALL IO_FILE_OPEN_ll(TZNMLFILE)
+CALL IO_File_add2list(TZNMLFILE,'PRE_ZOOM1.nam','NML','READ')
+CALL IO_File_open(TZNMLFILE)
ILUNAM = TZNMLFILE%NLU
!
CPGDFILE = 'PGDFILE' ! name of the input file
@@ -138,7 +140,7 @@ CALL POSNAM(ILUNAM,'NAM_PGDFILE',GFOUND,ILUOUT0)
IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_PGDFILE)
CALL POSNAM(ILUNAM,'NAM_CONFIO',GFOUND,ILUOUT0)
IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_CONFIO)
-CALL SET_CONFIO_ll()
+CALL IO_Config_set()
!
!------------------------------------------------------------------------------
!
@@ -148,8 +150,8 @@ CALL SET_CONFIO_ll()
!* 2.1 Open PGD file
! -------------
!
-CALL IO_FILE_ADD2LIST(TZPGDFILE,TRIM(CPGDFILE),'UNKNOWN','READ',KLFINPRAR=INT(1,KIND=LFI_INT),KLFITYPE=2,KLFIVERB=5)
-CALL IO_FILE_OPEN_ll(TZPGDFILE)
+CALL IO_File_add2list(TZPGDFILE,TRIM(CPGDFILE),'PGD','READ',KLFINPRAR=INT(1,KIND=LFIINT),KLFITYPE=2,KLFIVERB=5)
+CALL IO_File_open(TZPGDFILE)
!
!* 2.2 Reading of initial grid
! -----------------------
@@ -159,15 +161,15 @@ CALL READ_HGRID(1,TZPGDFILE,YMY_NAME,YDAD_NAME,YSTORAGE_TYPE)
! NIMAX, NJMAX: size of input domain
ALLOCATE(ZZS1 (NIMAX+2*JPHEXT,NJMAX+2*JPHEXT))
ALLOCATE(ZZSMT1(NIMAX+2*JPHEXT,NJMAX+2*JPHEXT))
-CALL IO_READ_FIELD(TZPGDFILE,'ZS',ZZS1)
-CALL IO_READ_FIELD(TZPGDFILE,'ZSMT',ZZSMT1)
+CALL IO_Field_read(TZPGDFILE,'ZS',ZZS1)
+CALL IO_Field_read(TZPGDFILE,'ZSMT',ZZSMT1)
!
!* 2.3 Define subdomain
! ----------------
!
CALL SET_SUBDOMAIN(TZNMLFILE,TZPGDFILE,IXOR_DAD,IYOR_DAD,IXOR,IYOR,IDXRATIO,IDYRATIO)
!
-CALL IO_FILE_CLOSE_ll(TZNMLFILE)
+CALL IO_File_close(TZNMLFILE)
!
! NIMAX, NJMAX: size of output domain
!
@@ -194,16 +196,16 @@ IF ( (LEN_TRIM(YZOOMFILE) == 0) .OR. (ADJUSTL(YZOOMFILE) == ADJUSTL(CPGDFILE)) )
YZOOMFILE=ADJUSTL(ADJUSTR(CPGDFILE)//'.z'//ADJUSTL(YZOOMNBR))
END IF
!
-CALL IO_FILE_ADD2LIST(TZZOOMFILE,TRIM(YZOOMFILE),'ZOOMPGD','WRITE',KLFINPRAR=INT(1,KIND=LFI_INT),KLFITYPE=1,KLFIVERB=5)
+CALL IO_File_add2list(TZZOOMFILE,TRIM(YZOOMFILE),'PGD','WRITE',KLFINPRAR=INT(1,KIND=LFIINT),KLFITYPE=1,KLFIVERB=5)
!PW: TODO: points to dad file (if existing) ! TZZOOMFILE%TDADFILE =>
!
-CALL IO_FILE_OPEN_ll(TZZOOMFILE)
+CALL IO_File_open(TZZOOMFILE)
CALL WRITE_HGRID(1,TZZOOMFILE)
!
!* 2.5 Preparation of surface physiographic fields
! -------------------------------------------
!
-CALL IO_READ_FIELD(TZPGDFILE,'SURF',CSURF)
+CALL IO_Field_read(TZPGDFILE,'SURF',CSURF)
!
!
IF (CSURF=='EXTE') THEN
@@ -223,26 +225,26 @@ IF (CSURF=='EXTE') THEN
ELSE
ALLOCATE(ZZS2(NIMAX+2*JPHEXT,NJMAX+2*JPHEXT))
ZZS2(:,:)=ZZS1(IXOR:IXOR+NIMAX+2*JPHEXT-1,IYOR:IYOR+NJMAX+2*JPHEXT-1)
- CALL IO_WRITE_FIELD(TZZOOMFILE,'ZS',ZZS2)
+ CALL IO_Field_write(TZZOOMFILE,'ZS',ZZS2)
END IF
!
ALLOCATE(ZZSMT2(NIMAX+2*JPHEXT,NJMAX+2*JPHEXT))
ZZSMT2(:,:)=ZZSMT1(IXOR:IXOR+NIMAX+2*JPHEXT-1,IYOR:IYOR+NJMAX+2*JPHEXT-1)
-CALL IO_WRITE_FIELD(TZZOOMFILE,'ZSMT',ZZSMT2)
+CALL IO_Field_write(TZZOOMFILE,'ZSMT',ZZSMT2)
!
!* 2.7 Write configuration variables in the output file
! ------------------------------------------------
!
-CALL IO_WRITE_HEADER(TZZOOMFILE)
-CALL IO_WRITE_FIELD(TZZOOMFILE,'DXRATIO',IDXRATIO)
-CALL IO_WRITE_FIELD(TZZOOMFILE,'DYRATIO',IDYRATIO)
-CALL IO_WRITE_FIELD(TZZOOMFILE,'XOR', IXOR_DAD)
-CALL IO_WRITE_FIELD(TZZOOMFILE,'YOR', IYOR_DAD)
-CALL IO_WRITE_FIELD(TZZOOMFILE,'L1D', L1D)
-CALL IO_WRITE_FIELD(TZZOOMFILE,'L2D', L2D)
-CALL IO_WRITE_FIELD(TZZOOMFILE,'PACK', LPACK)
-CALL IO_WRITE_FIELD(TZZOOMFILE,'SURF', CSURF)
-CALL IO_FILE_CLOSE_ll(TZZOOMFILE)
+CALL IO_Header_write(TZZOOMFILE)
+CALL IO_Field_write(TZZOOMFILE,'DXRATIO',IDXRATIO)
+CALL IO_Field_write(TZZOOMFILE,'DYRATIO',IDYRATIO)
+CALL IO_Field_write(TZZOOMFILE,'XOR', IXOR_DAD)
+CALL IO_Field_write(TZZOOMFILE,'YOR', IYOR_DAD)
+CALL IO_Field_write(TZZOOMFILE,'L1D', L1D)
+CALL IO_Field_write(TZZOOMFILE,'L2D', L2D)
+CALL IO_Field_write(TZZOOMFILE,'PACK', LPACK)
+CALL IO_Field_write(TZZOOMFILE,'SURF', CSURF)
+CALL IO_File_close(TZZOOMFILE)
!
!* 2.8 Shift to new PGD file
! ---------------------
@@ -254,16 +256,16 @@ CPGDFILE = YZOOMFILE
!* 3. CLOSE PARALLELIZED I/O
! ----------------------
!
-CALL IO_FILE_CLOSE_ll(TZPGDFILE)
+CALL IO_File_close(TZPGDFILE)
!
-IF(NIO_VERB>=NVERB_DEBUG) CALL IO_FILE_PRINT_LIST()
+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_ll(TLUOUT0)
+CALL IO_File_close(TLUOUT0)
!
CALL END_PARA_ll(IINFO_ll)
diff --git a/src/MNH/zsmt_pgd.f90 b/src/MNH/zsmt_pgd.f90
index 14a4be23bbce0a159b70a471aad86fc578fcb36d..4fa76acf100db303d96422853df7bbd998f7f663 100644
--- a/src/MNH/zsmt_pgd.f90
+++ b/src/MNH/zsmt_pgd.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 2005-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2005-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 MODI_ZSMT_PGD
! ######################
@@ -10,7 +11,7 @@ INTERFACE
!
SUBROUTINE ZSMT_PGD(TPFILE,KZSFILTER,KSLEVE,KLOCZSFILTER,OHSLOP,PHSLOP,PSMOOTH_ZS)
!
-USE MODD_IO_ll, ONLY : TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File characteristics
INTEGER, INTENT(IN) :: KZSFILTER ! number of iterations for fine orography
@@ -65,13 +66,12 @@ END MODULE MODI_ZSMT_PGD
!
!* 0. DECLARATIONS
!
-USE MODD_IO_ll, ONLY : TFILEDATA
-USE MODD_LUNIT, ONLY : CLUOUT0
+USE MODD_IO, ONLY : TFILEDATA
USE MODD_PARAMETERS, ONLY : JPHEXT, XUNDEF
!
USE MODI_MNHGET_SURF_PARAM_n
-USE MODE_FMREAD
-USE MODE_FMWRIT
+USE MODE_IO_FIELD_READ, only: IO_Field_read
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_ll , ONLY : GET_DIM_EXT_ll , ADD2DFIELD_ll , CLEANLIST_ll , UPDATE_HALO_ll
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
USE MODI_SUM_ll
@@ -150,12 +150,12 @@ ALLOCATE(ZSMOOTH_ZSINI(IIU,IJU))
ALLOCATE(ZXHAT(IIU))
ALLOCATE(ZYHAT(IJU))
!
-CALL IO_READ_FIELD(TPFILE,'XHAT',ZXHAT)
-CALL IO_READ_FIELD(TPFILE,'YHAT',ZYHAT)
+CALL IO_Field_read(TPFILE,'XHAT',ZXHAT)
+CALL IO_Field_read(TPFILE,'YHAT',ZYHAT)
!PW: bug/TODO: read a field in a file opened in WRITE mode
-!There is a test in IO_READ_FIELD_BYFIELD_X2 to allow this if TPFILE%CMODE='LFICDF4'
-CALL IO_READ_FIELD(TPFILE,'ZS',ZZS)
+!There is a test in IO_Field_read_BYFIELD_X2 to allow this if TPFILE%CMODE='LFICDF4'
+CALL IO_Field_read(TPFILE,'ZS',ZZS)
!
DO JI=1,JPHEXT
ZZS(JI,:) = ZZS(IIB,:)
@@ -342,7 +342,7 @@ IF(OHSLOP) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSLOPEX)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSLOPEX)
!
TZFIELD%CMNHNAME = 'ZSLOPEY'
TZFIELD%CSTDNAME = ''
@@ -354,7 +354,7 @@ IF(OHSLOP) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSLOPEY)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSLOPEY)
!
TZFIELD%CMNHNAME = 'ZS_FILTR'
TZFIELD%CSTDNAME = ''
@@ -366,7 +366,7 @@ IF(OHSLOP) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_WRITE_FIELD(TPFILE,TZFIELD,ZSMOOTH_ZSINI-ZFINE_ZS)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZSMOOTH_ZSINI-ZFINE_ZS)
END IF
!-------------------------------------------------------------------------------
!
@@ -374,8 +374,8 @@ END IF
! ---------------------------------------
!
!
-CALL IO_WRITE_FIELD(TPFILE,'ZS', ZFINE_ZS)
-CALL IO_WRITE_FIELD(TPFILE,'ZSMT',ZSLEVE_ZS)
+CALL IO_Field_write(TPFILE,'ZS', ZFINE_ZS)
+CALL IO_Field_write(TPFILE,'ZSMT',ZSLEVE_ZS)
!
DEALLOCATE(ZZS)
DEALLOCATE(ZFINE_ZS)
diff --git a/src/MNH/zsmt_pic.f90 b/src/MNH/zsmt_pic.f90
index e036a4c822a726cb25b42a9f6ef613a0648ee694..403b2a4635ef063d8b9009cff4123e54cfcf3928 100644
--- a/src/MNH/zsmt_pic.f90
+++ b/src/MNH/zsmt_pic.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2005-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 newsrc 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ######################
MODULE MODI_ZSMT_PIC
! ######################
@@ -61,7 +56,6 @@ END MODULE MODI_ZSMT_PIC
!
!* 0. DECLARATIONS
!
-USE MODD_LUNIT, ONLY : CLUOUT0
USE MODD_PARAMETERS, ONLY : XUNDEF
USE MODD_GRID_n, ONLY : XZS,XZSMT
!
diff --git a/src/Makefile b/src/Makefile
index ef4e4220cf8b008d851c17ba137fa40a7bf4382a..0e20e4a2ab02a54c4be1be985ac1ad7cc52bb84c 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -1,6 +1,6 @@
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
#MNH_LIC for details. version 1.
##########################################################
# #
@@ -58,7 +58,7 @@ include Rules.$(ARCH)$(F).mk
# All modification are allowed !!!!! #
# adding new subroutines #
# or #
-# adding new modules #
+# adding new modules #
# #
# REM : if during modification, you deleting some #
# FORTRAN subroutines you must also deleted the #
@@ -86,6 +86,7 @@ endif
#
ifdef DO_COMP_MASTER
VPATH += $(OBJDIR_MASTER) $(OBJDIR_MASTER)/MOD
+INC += -I$(B)$(OBJDIR_MASTER)/MOD
endif
#
##########################################################
@@ -339,8 +340,8 @@ gribapi_clean :
##########################################################
ifeq "$(VER_CDF)" "CDFAUTO"
#
-HDF_OPT = ${OPT_BASE_I4:-$OPT_BASE}
-NETCDF_OPT = ${OPT_BASE_I4:-$OPT_BASE}
+HDF_OPT ?= ${OPT_BASE_I4:-$OPT_BASE}
+NETCDF_OPT ?= ${OPT_BASE_I4:-$OPT_BASE}
#
cdf : $(CDF_MOD)
$(CDF_MOD) :
@@ -352,6 +353,12 @@ $(CDF_MOD) :
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" && \
$(MAKE) && $(MAKE) install && $(MAKE) clean
+ifdef MNH_FOREFIRE
+ cd ${DIR_CDFCXX} && ./configure --disable-shared --prefix=${CDF_PATH} --libdir=${CDF_PATH}/lib64 \
+ CXX="$(CXX)" CXXFLAGS="$(NETCDF_OPT)" FC="$(FC)" FCFLAGS="$(NETCDF_OPT) $(NETCDF_SUPPFLAGS)" FFLAGS="$(NETCDF_OPT)" \
+ CPPFLAGS="${INC_NETCDF}" ${CDF_CONF} LDFLAGS="-L${CDF_PATH}/lib64" LIBS="-lnetcdf -lhdf5_hl -lhdf5 -lsz -laec -lz" && \
+ $(MAKE) && $(MAKE) install && $(MAKE) clean
+endif
cd ${DIR_CDFF} && ./configure --disable-shared --prefix=${CDF_PATH} --libdir=${CDF_PATH}/lib64 \
CC="$(CC)" CFLAGS="$(NETCDF_OPT)" FC="$(FC)" FCFLAGS="$(NETCDF_OPT) $(NETCDF_SUPPFLAGS)" FFLAGS="$(NETCDF_OPT)" \
CPPFLAGS="${INC_NETCDF}" ${CDF_CONF} LDFLAGS="-L${CDF_PATH}/lib64" LIBS="-lnetcdf -lhdf5_hl -lhdf5 -lsz -laec -lz" && \
@@ -363,6 +370,9 @@ cleancdf :
cd ${DIR_LIBAEC} && $(MAKE) clean
cd ${DIR_HDF} && $(MAKE) clean
cd ${DIR_CDFC} && $(MAKE) clean
+ifdef MNH_FOREFIRE
+ cd ${DIR_CDFCXX} && $(MAKE) clean
+endif
cd ${DIR_CDFF} && $(MAKE) clean
endif
##########################################################
@@ -380,8 +390,26 @@ cleanmaster : cleanoasis
cleanoasis :
- [ -d ${OASIS_PATH} ] && rm -fr ${OASIS_PATH}
endif
+##########################################################
+# #
+# EXTRA LIB : S4PY #
+# #
+##########################################################
+ifdef MNH_S4PY
+all : libs4py.so
+OBJ_S4PY=$(OBJDIR_MASTER)/spll_wcompress_field.o $(OBJDIR_MASTER)/spll_wdecompress_field.o \
+$(OBJDIR_MASTER)/spll_wget_compheader.o $(OBJDIR_MASTER)/spll_wlficas.o \
+$(OBJDIR_MASTER)/spll_wlfiecr.o $(OBJDIR_MASTER)/spll_wlfifer.o \
+$(OBJDIR_MASTER)/spll_wlfilec.o $(OBJDIR_MASTER)/spll_wlfinaf.o \
+$(OBJDIR_MASTER)/spll_wlfinfo.o $(OBJDIR_MASTER)/spll_wlfiouv.o $(OBJDIR_MASTER)/spll_wlfipos.o \
+$(OBJDIR_MASTER)/spll_NEWLFI_ALL.o $(OBJDIR_MASTER)/spll_lockasgn.o \
+$(OBJDIR_MASTER)/spll_lockoff.o $(OBJDIR_MASTER)/spll_lockon.o $(OBJDIR_MASTER)/spll_lockrel.o \
+$(OBJDIR_MASTER)/fswap8buff.o $(OBJDIR_MASTER)/spll_remark2.o
+libs4py.so : progmaster
+ $(CC) -shared $(LDFLAGS) -o $(OBJDIR_MASTER)/$@ $(OBJ_S4PY) $(LIBS)
+endif
##########################################################
# #
# PROGRAM RULES #
@@ -525,10 +553,12 @@ ARFLAGS=r
#
%.o:%.f90
+ echo "inc=$(INC)"
$(F90) -I$(OBJDIR) $(INC) -c $(F90FLAGS) $<
-mv $(*F).o $(OBJDIR)/. || echo OK $(*F).o
%.o:%.f
+ echo "inc=$(INC)"
$(F77) -I$(OBJDIR) $(INC) -c $(F77FLAGS) $<
-mv $(*F).o $(OBJDIR)/. || echo OK $(*F).o
diff --git a/src/Makefile.MESONH.mk b/src/Makefile.MESONH.mk
index 8c5990af5320d824b7a820268c2cfbd8d783317c..f7b5994ea41d7dcf9088fd8a535921006ca9b110 100644
--- a/src/Makefile.MESONH.mk
+++ b/src/Makefile.MESONH.mk
@@ -1,6 +1,6 @@
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
#MNH_LIC for details. version 1.
##########################################################
# #
@@ -106,7 +106,7 @@ endif
# PRE_BUG TEST !!!
#
DIR_SURCOUCHE += LIB/SURCOUCHE/src
-#CPPFLAGS_SURCOUCHE = -DMNH_MPI_DOUBLE_PRECISION -DMNH_LINUX -DMNH_MPI_BSEND -DNAGf95
+#CPPFLAGS_SURCOUCHE = -DMNH_MPI_BSEND
#
ifdef DIR_SURCOUCHE
DIR_MASTER += $(DIR_SURCOUCHE)
@@ -229,10 +229,6 @@ OBJS_I8=spll_NEWLFI_ALL.o
$(OBJS_I8) : OPT = $(OPT_BASE) $(OPT_PERF2) $(OPT_INT8)
endif
#
-# Management/parametrisation of size of RECL for LFI I/O speedup
-#
-LFI_RECL?=512
-#
DIR_MASTER += $(DIR_NEWLFI)
CPPFLAGS += $(CPPFLAGS_NEWLFI)
OBJS_LISTE_MASTER += fswap8buff.o
@@ -242,6 +238,30 @@ VPATH += $(DIR_NEWLFI)
#ARCH_XYZ := $(ARCH_XYZ)-$(VER_NEWLFI)
endif
##########################################################
+# Source COMPRESS #
+##########################################################
+ifdef MNH_COMPRESS
+DIR_COMPRESS = ../LIBTOOLS/lib/COMPRESS/src
+INC_COMPRESS = -I$(B)$(DIR_COMPRESS)
+DIR_MASTER += $(DIR_COMPRESS)
+OBJS_LISTE_MASTER += bitbuff.o nearestpow2.o
+INC += $(INC_COMPRESS)
+VPATH += $(DIR_COMPRESS)
+CPPFLAGS_COMPRESS ?= -DLITTLE_endian
+CPPFLAGS += $(CPPFLAGS_COMPRESS)
+endif
+##########################################################
+# Source S4PY #
+##########################################################
+ifdef MNH_S4PY
+DIR_S4PY = LIB/s4py
+INC_S4PY = -I$(B)$(DIR_S4PY)
+DIR_MASTER += $(DIR_S4PY)
+OBJS_LISTE_MASTER += init_gfortran.o
+INC += $(INC_S4PY)
+VPATH += $(DIR_S4PY)
+endif
+##########################################################
# Source FOREFIRE #
##########################################################
ifdef MNH_FOREFIRE
@@ -252,6 +272,7 @@ OBJS_LISTE_MASTER += C_ForeFire_Interface.o
INC += $(INC_FOREFIRE)
VPATH += $(DIR_FOREFIRE)
CPPFLAGS += -DMNH_FOREFIRE
+ARCH_XYZ := $(ARCH_XYZ)-FF
endif
##########################################################
# Source TOOLS #
@@ -467,6 +488,7 @@ endif
#
ifeq "$(VER_CDF)" "CDFAUTO"
DIR_CDFC?=${SRC_MESONH}/src/LIB/netcdf-${VERSION_CDFC}
+DIR_CDFCXX?=${SRC_MESONH}/src/LIB/netcdf-cxx-${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_MOD?=${CDF_PATH}/include/netcdf.mod
diff --git a/src/Rules.AIX64.mk b/src/Rules.AIX64.mk
index b4de87fcfcd412263c2d4368d91f4926c9c1682d..2f125e2cef063ec5d03bb90cdd492d1e824289d5 100644
--- a/src/Rules.AIX64.mk
+++ b/src/Rules.AIX64.mk
@@ -1,6 +1,6 @@
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
#MNH_LIC for details. version 1.
##########################################################
# #
@@ -25,15 +25,12 @@ OPT_I8 = -qintsize=8
# Integer 4/8 option
#
MNH_INT ?=4
-LFI_RECL ?=512
#
OPT_BASE_I4 := $(OPT_BASE)
ifeq "$(MNH_INT)" "8"
OPT_BASE += $(OPT_I8)
LFI_INT ?=8
-MNH_MPI_RANK_KIND ?=8
else
-MNH_MPI_RANK_KIND ?=4
LFI_INT ?=4
endif
OPT = $(OPT_BASE) $(OPT_PERF2)
@@ -84,9 +81,9 @@ endif
CPP = /usr/lib/cpp -C -P -qlanglvl=classic
#
CPPFLAGS_SURFEX =
-CPPFLAGS_SURCOUCHE = -DMNH_MPI_DOUBLE_PRECISION -DMNH_LINUX -DMNH_SP4 -DMNH_MPI_RANK_KIND=$(MNH_MPI_RANK_KIND)
+CPPFLAGS_SURCOUCHE = -DMNH_SP4
CPPFLAGS_RAD =
-CPPFLAGS_NEWLFI = -DLINUX -DLFI_INT=${LFI_INT} -DLFI_RECL=${LFI_RECL}
+CPPFLAGS_NEWLFI = -DLINUX -DLFI_INT=${LFI_INT}
CPPFLAGS_MNH = -DAMAX1=MAX -DMNH -DSFX_MNH
#
# Gribex flags
@@ -101,6 +98,16 @@ CNAME_GRIBEX=""
#if MNH_TOOLS exists => compile the tools
MNH_TOOLS = yes
#
+## COMPRESS flag
+#
+#if MNH_COMPRESS exists => compile the COMPRESS library (for LFI files)
+MNH_COMPRESS=yes
+#
+## S4PY flag
+#
+#if MNH_S4PY exists => compile the libs4py library (for epygram)
+#MNH_S4PY=no
+#
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
diff --git a/src/Rules.BG.mk b/src/Rules.BG.mk
index d3d34f3f65b1ef977c168061d198e87ace822cad..068f99dea7da2ab34b6b4125f9ca99fd70b8306e 100644
--- a/src/Rules.BG.mk
+++ b/src/Rules.BG.mk
@@ -1,6 +1,6 @@
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
#MNH_LIC for details. version 1.
##########################################################
# #
@@ -30,15 +30,12 @@ OPT_I4 = -qintsize=4
# Integer 4/8 option
#
MNH_INT ?=4
-LFI_RECL ?=512
#
OPT_BASE_I4 := $(OPT_BASE)
ifeq "$(MNH_INT)" "8"
OPT_BASE += $(OPT_I8)
LFI_INT ?=8
-MNH_MPI_RANK_KIND ?=8
else
-MNH_MPI_RANK_KIND ?=4
LFI_INT ?=4
endif
#
@@ -94,10 +91,10 @@ CPP = cpp -P -traditional -Wcomment
CC = mpixlc_r
#
CPPFLAGS_SURFEX =
-#CPPFLAGS_SURCOUCHE = -DMNH_MPI_DOUBLE_PRECISION -DMNH_LINUX -DMNH_SP4 -DMNH_MPI_ISEND -DMNH_MPI_RANK_KIND=$(MNH_MPI_RANK_KIND)
-CPPFLAGS_SURCOUCHE = -DMNH_MPI_DOUBLE_PRECISION -DMNH_LINUX -DMNH_SP4 -DMNH_MPI_BSEND -DMNH_MPI_RANK_KIND=$(MNH_MPI_RANK_KIND)
+#CPPFLAGS_SURCOUCHE = -DMNH_SP4 -DMNH_MPI_ISEND
+CPPFLAGS_SURCOUCHE = -DMNH_SP4 -DMNH_MPI_BSEND
CPPFLAGS_RAD =
-CPPFLAGS_NEWLFI = -DLINUX -DLFI_INT=${LFI_INT} -DLFI_RECL=${LFI_RECL}
+CPPFLAGS_NEWLFI = -DLINUX -DLFI_INT=${LFI_INT}
CPPFLAGS_MNH = -DAMAX1=MAX -DMNH -DSFX_MNH
#
# Gribex flags
@@ -112,6 +109,16 @@ CNAME_GRIBEX=""
#if MNH_TOOLS exists => compile the tools
#MNH_TOOLS = no
#
+## COMPRESS flag
+#
+#if MNH_COMPRESS exists => compile the COMPRESS library (for LFI files)
+#MNH_COMPRESS=no
+#
+## S4PY flag
+#
+#if MNH_S4PY exists => compile the libs4py library (for epygram)
+#MNH_S4PY=no
+#
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
diff --git a/src/Rules.BGQ.mk b/src/Rules.BGQ.mk
index e1e735144e46e8f1e5aa763e8bddd442e68ee7b5..79f9363bd0dcb0e67e1fcf720242c3580f6b77d4 100644
--- a/src/Rules.BGQ.mk
+++ b/src/Rules.BGQ.mk
@@ -1,6 +1,6 @@
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
#MNH_LIC for details. version 1.
##########################################################
# #
@@ -34,16 +34,13 @@ OPT_I4 = -qintsize=4 -qxlf77=intarg
#
MNH_REAL ?=8
MNH_INT ?=4
-LFI_RECL ?=512
#
OPT_BASE_I4 := $(OPT_BASE) $(OPT_I4)
ifeq "$(MNH_INT)" "8"
OPT_BASE += $(OPT_I8)
LFI_INT ?=8
-MNH_MPI_RANK_KIND ?=8
else
OPT_BASE += $(OPT_I4)
-MNH_MPI_RANK_KIND ?=4
LFI_INT ?=4
endif
#
@@ -143,10 +140,10 @@ CPP = cpp -P -traditional -Wcomment
#
CPPFLAGS_SURFEX =
-#CPPFLAGS_SURCOUCHE = -DMNH_MPI_DOUBLE_PRECISION -DMNH_LINUX -DMNH_SP4 -DMNH_MPI_ISEND -DMNH_MPI_RANK_KIND=$(MNH_MPI_RANK_KIND)
-CPPFLAGS_SURCOUCHE = -DMNH_MPI_DOUBLE_PRECISION -DMNH_LINUX -DMNH_SP4 -DMNH_MPI_BSEND -DMNH_MPI_RANK_KIND=$(MNH_MPI_RANK_KIND) -DSNGL=REAL
+#CPPFLAGS_SURCOUCHE = -DMNH_SP4 -DMNH_MPI_ISEND
+CPPFLAGS_SURCOUCHE = -DMNH_SP4 -DMNH_MPI_BSEND -DSNGL=REAL
CPPFLAGS_RAD =
-CPPFLAGS_NEWLFI = -DLINUX -DLFI_INT=${LFI_INT} -DLFI_RECL=${LFI_RECL}
+CPPFLAGS_NEWLFI = -DLINUX -DLFI_INT=${LFI_INT}
CPPFLAGS_MNH = -DAMAX1=MAX -DMNH -DSFX_MNH
#
# Rules for GA = Global Array
@@ -171,6 +168,16 @@ GRIBAPI_CONF= --host=powerpc64-bgq-linux
#if MNH_TOOLS exists => compile the tools
#MNH_TOOLS = no
#
+## COMPRESS flag
+#
+#if MNH_COMPRESS exists => compile the COMPRESS library (for LFI files)
+#MNH_COMPRESS=no
+#
+## S4PY flag
+#
+#if MNH_S4PY exists => compile the libs4py library (for epygram)
+#MNH_S4PY=no
+#
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
diff --git a/src/Rules.LXNAGfor.mk b/src/Rules.LXNAGfor.mk
index d7a8adf967c88fa5ea120ee2497133d9ec976d60..318cb4ba34a70725def6ace645a075ffe1ba2494 100644
--- a/src/Rules.LXNAGfor.mk
+++ b/src/Rules.LXNAGfor.mk
@@ -19,21 +19,17 @@ OPT_R8 = -r8
#
MNH_REAL ?=8
MNH_INT ?=4
-LFI_RECL ?=512
#
#
ifneq "$(MNH_REAL)" "4"
OPT_BASE += $(OPT_R8)
-CPPFLAGS_SURCOUCHE += -DMNH_MPI_DOUBLE_PRECISION
endif
#
OPT_BASE_I4 := $(OPT_BASE)
ifeq "$(MNH_INT)" "8"
OPT_BASE += $(OPT_I8)
LFI_INT ?=8
-MNH_MPI_RANK_KIND ?=8
else
-MNH_MPI_RANK_KIND ?=4
LFI_INT ?=4
endif
#
@@ -72,9 +68,9 @@ FX90FLAGS = $(OPT) -fixed
CPP = cpp -P -traditional -Wcomment
#
CPPFLAGS_SURFEX =
-CPPFLAGS_SURCOUCHE += -DMNH_LINUX -DDEV_NULL -DMNH_MPI_RANK_KIND=$(MNH_MPI_RANK_KIND)
+CPPFLAGS_SURCOUCHE += -DDEV_NULL
CPPFLAGS_RAD =
-CPPFLAGS_NEWLFI = -DSWAPIO -DLINUX -DLFI_INT=${LFI_INT} -DLFI_RECL=${LFI_RECL}
+CPPFLAGS_NEWLFI = -DSWAPIO -DLINUX -DLFI_INT=${LFI_INT}
CPPFLAGS_MNH = -DMNH -DSFX_MNH
#
@@ -94,6 +90,16 @@ NETCDF_SUPPFLAGS = -dusty -kind=byte
#if MNH_TOOLS exists => compile the tools
MNH_TOOLS = yes
#
+## COMPRESS flag
+#
+#if MNH_COMPRESS exists => compile the COMPRESS library (for LFI files)
+MNH_COMPRESS=yes
+#
+## S4PY flag
+#
+#if MNH_S4PY exists => compile the libs4py library (for epygram)
+#MNH_S4PY=no
+#
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
@@ -121,5 +127,5 @@ OBJS_I4=spll_modd_netcdf.o
$(OBJS_I4) : OPT = $(OPT_BASE_I4)
endif
#
-LIST_MISMATCH=MPI_Allgatherv,MPI_Allreduce,MPI_Bcast,MPI_Bsend,MPI_Gather,MPI_Gatherv,MPI_Recv,LEPOLY
+LIST_MISMATCH=MPI_Allgatherv,MPI_Allreduce,MPI_Bcast,MPI_Bsend,MPI_Gather,MPI_Gatherv,MPI_Recv,LEPOLY,EXTRACT_BBUFF,FILL_BBUFF
diff --git a/src/Rules.LXarm.mk b/src/Rules.LXarm.mk
index 7622b6807a92a23c80581b34ac798fbae9d1b04a..c9b81e0b274aaca96506cf445314a8873526a9c1 100644
--- a/src/Rules.LXarm.mk
+++ b/src/Rules.LXarm.mk
@@ -1,6 +1,6 @@
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
#MNH_LIC for details. version 1.
##########################################################
# #
@@ -29,21 +29,17 @@ OPT_R8 = -r8
#
MNH_REAL ?=8
MNH_INT ?=4
-LFI_RECL ?=512
#
#
ifneq "$(MNH_REAL)" "4"
OPT_BASE += $(OPT_R8)
-CPPFLAGS_SURCOUCHE += -DMNH_MPI_DOUBLE_PRECISION
endif
#
OPT_BASE_I4 := $(OPT_BASE)
ifeq "$(MNH_INT)" "8"
OPT_BASE += $(OPT_I8)
LFI_INT ?=8
-MNH_MPI_RANK_KIND ?=8
else
-MNH_MPI_RANK_KIND ?=4
LFI_INT ?=4
endif
#
@@ -88,9 +84,9 @@ FX90FLAGS = $(OPT)
CPP = cpp -P -traditional -Wcomment
#
CPPFLAGS_SURFEX =
-CPPFLAGS_SURCOUCHE += -DMNH_LINUX -DDEV_NULL -DMNH_MPI_RANK_KIND=$(MNH_MPI_RANK_KIND)
+CPPFLAGS_SURCOUCHE += -DDEV_NULL
CPPFLAGS_RAD =
-CPPFLAGS_NEWLFI = -DSWAPIO -DLINUX -DLFI_INT=${LFI_INT} -DLFI_RECL=${LFI_RECL}
+CPPFLAGS_NEWLFI = -DSWAPIO -DLINUX -DLFI_INT=${LFI_INT}
CPPFLAGS_MNH = -DMNH -DSFX_MNH
ifdef VER_GA
CPPFLAGS_SURCOUCHE += -DMNH_GA
@@ -116,7 +112,15 @@ MNH_TOOLS=yes
endif
endif
#
+## COMPRESS flag
#
+#if MNH_COMPRESS exists => compile the COMPRESS library (for LFI files)
+MNH_COMPRESS=yes
+#
+## S4PY flag
+#
+#if MNH_S4PY exists => compile the libs4py library (for epygram)
+#MNH_S4PY=no
#
##########################################################
# #
diff --git a/src/Rules.LXcray.mk b/src/Rules.LXcray.mk
index 1fbd6578c079a9edf04324e5b4e2c00132417628..4e4b34b870f3dc1def5c79d66e45cc772b4b1049 100644
--- a/src/Rules.LXcray.mk
+++ b/src/Rules.LXcray.mk
@@ -1,6 +1,6 @@
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
#MNH_LIC for details. version 1.
##########################################################
# #
@@ -22,16 +22,13 @@ OPT_I8 = -sdefault64
# Integer 4/8 option
#
MNH_INT ?=4
-LFI_RECL ?=512
#
OPT_BASE_I4 := $(OPT_BASE)
ifeq "$(MNH_INT)" "8"
#OPT_BASE += $(OPT_I8)
OPT_BASE = -sdefault64 -hpic -em -ef
LFI_INT ?=8
-MNH_MPI_RANK_KIND ?=8
else
-MNH_MPI_RANK_KIND ?=4
LFI_INT ?=4
endif
#
@@ -84,9 +81,9 @@ LDFLAGS = -Wl,-warn-once $(PAR) $(OPT_BASE)
CPP = cpp -P -traditional -Wcomment
#
CPPFLAGS_SURFEX =
-CPPFLAGS_SURCOUCHE = -DMNH_MPI_DOUBLE_PRECISION -DMNH_LINUX -DDEV_NULL -DMNH_MPI_RANK_KIND=$(MNH_MPI_RANK_KIND)
+CPPFLAGS_SURCOUCHE = -DDEV_NULL
CPPFLAGS_RAD =
-CPPFLAGS_NEWLFI = -DSWAPIO -DLINUX -DLFI_INT=${LFI_INT} -DLFI_RECL=${LFI_RECL}
+CPPFLAGS_NEWLFI = -DSWAPIO -DLINUX -DLFI_INT=${LFI_INT}
CPPFLAGS_MNH = -DMNH -DSFX_MNH
ifdef VER_GA
CPPFLAGS_SURCOUCHE += -DMNH_GA
@@ -109,6 +106,16 @@ GRIBAPI_CONF="FCFLAGS= -em -ef "
#if MNH_TOOLS exists => compile the tools
MNH_TOOLS = yes
#
+## COMPRESS flag
+#
+#if MNH_COMPRESS exists => compile the COMPRESS library (for LFI files)
+MNH_COMPRESS=yes
+#
+## S4PY flag
+#
+#if MNH_S4PY exists => compile the libs4py library (for epygram)
+#MNH_S4PY=no
+#
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
diff --git a/src/Rules.LXg95.mk b/src/Rules.LXg95.mk
index fa86c4daf1e6d4f721e6b44e86c15a39e26700af..7a1add9c315f623c9f06569b07761c4f92b1953a 100644
--- a/src/Rules.LXg95.mk
+++ b/src/Rules.LXg95.mk
@@ -1,6 +1,6 @@
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
#MNH_LIC for details. version 1.
##########################################################
# #
@@ -18,15 +18,12 @@ OPT_I8 = -i8
# Integer 4/8 option
#
MNH_INT ?=4
-LFI_RECL ?=512
#
OPT_BASE_I4 := $(OPT_BASE)
ifeq "$(MNH_INT)" "8"
OPT_BASE += $(OPT_I8)
LFI_INT ?=8
-MNH_MPI_RANK_KIND ?=8
else
-MNH_MPI_RANK_KIND ?=4
LFI_INT ?=4
endif
#
@@ -64,11 +61,10 @@ LDFLAGS = -Wl,-warn-once
CPP = cpp -P -traditional -Wcomment
#
LFI_INT ?=4
-LFI_RECL ?=512
CPPFLAGS_SURFEX =
-CPPFLAGS_SURCOUCHE = -DMNH_MPI_DOUBLE_PRECISION -DMNH_LINUX -DMNH_MPI_BSEND -DDEV_NULL -DMNH_MPI_RANK_KIND=$(MNH_MPI_RANK_KIND)
+CPPFLAGS_SURCOUCHE = -DMNH_MPI_BSEND -DDEV_NULL
CPPFLAGS_RAD =
-CPPFLAGS_NEWLFI = -DSWAPIO -DLINUX -DLFI_INT=${LFI_INT} -DLFI_RECL=${LFI_RECL}
+CPPFLAGS_NEWLFI = -DSWAPIO -DLINUX -DLFI_INT=${LFI_INT}
CPPFLAGS_MNH = -DAINT=INT -DAMOD=MOD -DMNH -DSFX_MNH
#
# Gribex flags
@@ -81,6 +77,16 @@ CNAME_GRIBEX=g95
#if MNH_TOOLS exists => compile the tools
MNH_TOOLS = yes
#
+## COMPRESS flag
+#
+#if MNH_COMPRESS exists => compile the COMPRESS library (for LFI files)
+MNH_COMPRESS=yes
+#
+## S4PY flag
+#
+#if MNH_S4PY exists => compile the libs4py library (for epygram)
+#MNH_S4PY=no
+#
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
diff --git a/src/Rules.LXgfortran.mk b/src/Rules.LXgfortran.mk
index 26ff8eee58007d53025fb64547e1bada45341e7c..fdb1257865b00cf7563e691d92c8014b8ffec455 100644
--- a/src/Rules.LXgfortran.mk
+++ b/src/Rules.LXgfortran.mk
@@ -1,6 +1,6 @@
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
#MNH_LIC for details. version 1.
##########################################################
# #
@@ -26,21 +26,17 @@ OPT_R8 = -fdefault-real-8 -fdefault-double-8
#
MNH_REAL ?=8
MNH_INT ?=4
-LFI_RECL ?=512
#
#
ifneq "$(MNH_REAL)" "4"
OPT_BASE += $(OPT_R8)
-CPPFLAGS_SURCOUCHE += -DMNH_MPI_DOUBLE_PRECISION
endif
#
OPT_BASE_I4 := $(OPT_BASE)
ifeq "$(MNH_INT)" "8"
OPT_BASE += $(OPT_I8)
LFI_INT ?=8
-MNH_MPI_RANK_KIND ?=8
else
-MNH_MPI_RANK_KIND ?=4
LFI_INT ?=4
endif
#
@@ -58,6 +54,7 @@ endif
#
#
CC = gcc
+CXX = g++
FC = gfortran
ifeq "$(VER_MPI)" "MPIAUTO"
F90 = mpif90
@@ -79,9 +76,9 @@ FX90FLAGS = $(OPT)
CPP = cpp -P -traditional -Wcomment
#
CPPFLAGS_SURFEX =
-CPPFLAGS_SURCOUCHE += -DMNH_LINUX -DDEV_NULL -DMNH_MPI_RANK_KIND=$(MNH_MPI_RANK_KIND)
+CPPFLAGS_SURCOUCHE += -DDEV_NULL
CPPFLAGS_RAD =
-CPPFLAGS_NEWLFI = -DSWAPIO -DLINUX -DLFI_INT=${LFI_INT} -DLFI_RECL=${LFI_RECL}
+CPPFLAGS_NEWLFI = -DSWAPIO -DLINUX -DLFI_INT=${LFI_INT}
CPPFLAGS_MNH = -DMNH -DSFX_MNH
ifdef VER_GA
CPPFLAGS_SURCOUCHE += -DMNH_GA
@@ -97,6 +94,8 @@ CNAME_GRIBEX=_gfortran
# Netcdf/HDF5 flags
#
HDF_CONF= CFLAGS=-std=c99
+HDF_OPT ?= -fPIC
+NETCDF_OPT ?= -fPIC
#
## LIBTOOLS flags
#
@@ -107,7 +106,15 @@ MNH_TOOLS=yes
endif
endif
#
+## COMPRESS flag
#
+#if MNH_COMPRESS exists => compile the COMPRESS library (for LFI files)
+MNH_COMPRESS=yes
+#
+## S4PY flag
+#
+#if MNH_S4PY exists => compile the libs4py library (for epygram)
+#MNH_S4PY=no
#
##########################################################
# #
diff --git a/src/Rules.LXifort.mk b/src/Rules.LXifort.mk
index 48b9c5c99e0d6f784f892b511f153f4cee506e0c..e89ea60a34fab24e948a7040ae516eb254a807aa 100644
--- a/src/Rules.LXifort.mk
+++ b/src/Rules.LXifort.mk
@@ -1,6 +1,6 @@
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
#MNH_LIC for details. version 1.
##########################################################
# #
@@ -21,20 +21,16 @@ OPT_R8 = -r8
#
MNH_REAL ?=8
MNH_INT ?=4
-LFI_RECL ?=512
#
ifneq "$(MNH_REAL)" "4"
OPT_BASE += $(OPT_R8)
-CPPFLAGS_SURCOUCHE += -DMNH_MPI_DOUBLE_PRECISION
endif
#
OPT_BASE_I4 := $(OPT_BASE)
ifeq "$(MNH_INT)" "8"
OPT_BASE += $(OPT_I8)
LFI_INT ?=8
-MNH_MPI_RANK_KIND ?=8
else
-MNH_MPI_RANK_KIND ?=4
LFI_INT ?=4
endif
#
@@ -128,6 +124,7 @@ endif
#
#
CC ?= gcc
+CXX ?= g++
FC = ifort
ifeq "$(VER_MPI)" "MPIAUTO"
ifneq "$(findstring TAU,$(XYZ))" ""
@@ -176,9 +173,9 @@ LDFLAGS = -Wl,-warn-once $(PAR) -Wl,-rpath=$(LD_LIBRARY_PATH) $(OPT_BASE)
CPP = cpp -P -traditional -Wcomment
#
CPPFLAGS_SURFEX =
-CPPFLAGS_SURCOUCHE += -DMNH_LINUX -DDEV_NULL -DMNH_MPI_RANK_KIND=$(MNH_MPI_RANK_KIND)
+CPPFLAGS_SURCOUCHE += -DDEV_NULL
CPPFLAGS_RAD =
-CPPFLAGS_NEWLFI = -DSWAPIO -DLINUX -DLFI_INT=${LFI_INT} -DLFI_RECL=${LFI_RECL}
+CPPFLAGS_NEWLFI = -DSWAPIO -DLINUX -DLFI_INT=${LFI_INT}
CPPFLAGS_MNH = -DMNH -DSFX_MNH
ifdef VER_GA
CPPFLAGS_SURCOUCHE += -DMNH_GA
@@ -191,6 +188,12 @@ endif
TARGET_GRIBEX=linux
CNAME_GRIBEX=ifort
#
+# Netcdf/HDF5 flags
+#
+HDF_CONF= CFLAGS=-std=c99
+HDF_OPT ?= -fPIC
+NETCDF_OPT ?= -fPIC
+#
# LIBTOOLS flags
#
#if MNH_TOOLS exists => compile the tools
@@ -198,6 +201,16 @@ ifeq "$(MNH_INT)" "4"
MNH_TOOLS=yes
endif
#
+## COMPRESS flag
+#
+#if MNH_COMPRESS exists => compile the COMPRESS library (for LFI files)
+MNH_COMPRESS=yes
+#
+## S4PY flag
+#
+#if MNH_S4PY exists => compile the libs4py library (for epygram)
+#MNH_S4PY=no
+#
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
diff --git a/src/Rules.LXpathf95.mk b/src/Rules.LXpathf95.mk
index 014fcbaf4445afc7f81a69a5b50bdca85bca6cfd..d116ac262a9690d95c1d54cbc1119b73d111737a 100644
--- a/src/Rules.LXpathf95.mk
+++ b/src/Rules.LXpathf95.mk
@@ -1,6 +1,6 @@
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
#MNH_LIC for details. version 1.
##########################################################
# #
@@ -42,7 +42,7 @@ LDFLAGS = -Wl,-noinhibit-exec -Wl,-warn-once
CPP = cpp -P -traditional -Wcomment
#
CPPFLAGS_SURFEX =
-CPPFLAGS_SURCOUCHE = -DMNH_MPI_DOUBLE_PRECISION -DMNH_LINUX -DMNH_MPI_BSEND -DDEV_NULL
+CPPFLAGS_SURCOUCHE = -DMNH_MPI_BSEND -DDEV_NULL
CPPFLAGS_RAD =
CPPFLAGS_NEWLFI = -DSWAPIO -DLINUX
CPPFLAGS_MNH = -DAINT=INT -DAMOD=MOD -DMNH -DSFX_MNH
@@ -57,6 +57,16 @@ CNAME_GRIBEX=pathf95
#if MNH_TOOLS exists => compile the tools
MNH_TOOLS = yes
#
+## COMPRESS flag
+#
+#if MNH_COMPRESS exists => compile the COMPRESS library (for LFI files)
+MNH_COMPRESS=yes
+#
+## S4PY flag
+#
+#if MNH_S4PY exists => compile the libs4py library (for epygram)
+#MNH_S4PY=no
+#
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
diff --git a/src/Rules.LXpgi.mk b/src/Rules.LXpgi.mk
index 92ff4a70900af191a6a427411f8965752ed5b44f..21e995fab794f1cf2d243cc41e751e8f7b69ba0d 100644
--- a/src/Rules.LXpgi.mk
+++ b/src/Rules.LXpgi.mk
@@ -1,6 +1,6 @@
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
#MNH_LIC for details. version 1.
##########################################################
# #
@@ -51,20 +51,16 @@ IGNORE_OBJS += pgprof.o
#
MNH_REAL ?=8
MNH_INT ?=4
-LFI_RECL ?=512
#
ifneq "$(MNH_REAL)" "4"
OPT_BASE += $(OPT_R8)
-CPPFLAGS_SURCOUCHE += -DMNH_MPI_DOUBLE_PRECISION
endif
#
OPT_BASE_I4 := $(OPT_BASE)
ifeq "$(MNH_INT)" "8"
OPT_BASE += $(OPT_I8)
LFI_INT ?=8
-MNH_MPI_RANK_KIND ?=8
else
-MNH_MPI_RANK_KIND ?=4
LFI_INT ?=4
endif
#
@@ -150,9 +146,9 @@ LDFLAGS = -Wl,-warn-once $(OPT)
CPP = cpp -P -traditional -Wcomment
#
CPPFLAGS_SURFEX =
-CPPFLAGS_SURCOUCHE += -DMNH_LINUX -DMNH_MPI_RANK_KIND=$(MNH_MPI_RANK_KIND)
+CPPFLAGS_SURCOUCHE +=
CPPFLAGS_RAD =
-CPPFLAGS_NEWLFI = -DSWAPIO -DLINUX -DLFI_INT=${LFI_INT} -DLFI_RECL=${LFI_RECL}
+CPPFLAGS_NEWLFI = -DSWAPIO -DLINUX -DLFI_INT=${LFI_INT}
CPPFLAGS_MNH = -DMNH -DMNH_PGI -DSFX_MNH
CPPFLAGS_MNH += -Uvector -Upixel
#
@@ -176,6 +172,16 @@ endif
#if MNH_TOOLS exists => compile the tools
MNH_TOOLS = yes
#
+## COMPRESS flag
+#
+#if MNH_COMPRESS exists => compile the COMPRESS library (for LFI files)
+MNH_COMPRESS=yes
+#
+## S4PY flag
+#
+#if MNH_S4PY exists => compile the libs4py library (for epygram)
+#MNH_S4PY=no
+#
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
diff --git a/src/Rules.SX8.mk b/src/Rules.SX8.mk
index e5bb540f66d76050a6a8b064dbf354dbf02f4736..669582ee8fde48898ce5487f9c76a4ab90ee61dc 100644
--- a/src/Rules.SX8.mk
+++ b/src/Rules.SX8.mk
@@ -1,6 +1,6 @@
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
#MNH_LIC for details. version 1.
##########################################################
# #
@@ -24,15 +24,12 @@ OPT_I8 = -ew
# Integer 4/8 option
#
MNH_INT ?=4
-LFI_RECL ?=512
#
OPT_BASE_I4 := $(OPT_BASE)
ifeq "$(MNH_INT)" "8"
OPT_BASE += $(OPT_I8)
LFI_INT ?=8
-MNH_MPI_RANK_KIND ?=8
else
-MNH_MPI_RANK_KIND ?=4
LFI_INT ?=4
endif
#
@@ -87,9 +84,9 @@ CPP = cpp -P -traditional -Wcomment
AR=sxar
#
CPPFLAGS_SURFEX =
-CPPFLAGS_SURCOUCHE = -DMNH_MPI_DOUBLE_PRECISION -DMNH_SX5 -DMNH_MPI_BSEND -DMNH_MPI_RANK_KIND=$(MNH_MPI_RANK_KIND)
+CPPFLAGS_SURCOUCHE = -DMNH_SX5 -DMNH_MPI_BSEND
CPPFLAGS_RAD =
-CPPFLAGS_NEWLFI = -DMNH_SX5 -DLFI_INT=${LFI_INT} -DLFI_RECL=${LFI_RECL}
+CPPFLAGS_NEWLFI = -DMNH_SX5 -DLFI_INT=${LFI_INT}
CPPFLAGS_MNH = -DMNH -DSFX_MNH
#
# Gribex flags
@@ -103,6 +100,16 @@ CNAME_GRIBEX=sxmpif90
#if MNH_TOOLS exists => compile the tools
#MNH_TOOLS = no
#
+## COMPRESS flag
+#
+#if MNH_COMPRESS exists => compile the COMPRESS library (for LFI files)
+#MNH_COMPRESS=no
+#
+## S4PY flag
+#
+#if MNH_S4PY exists => compile the libs4py library (for epygram)
+#MNH_S4PY=no
+#
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
diff --git a/src/SURFEX/average_diag.F90 b/src/SURFEX/average_diag.F90
index 14364414e2a727b0a4b755b47730504e59c2ca61..158ea03afe9871fea872a33336159082b6ca6aec 100644
--- a/src/SURFEX/average_diag.F90
+++ b/src/SURFEX/average_diag.F90
@@ -1,6 +1,6 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC Copyright 2003-2019 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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
SUBROUTINE AVERAGE_DIAG(PFRAC_TILE, DGO, D, ND, DC, NDC )
@@ -37,6 +37,7 @@
!! Modified 08/2009 (B. Decharme) : new diag
! 02/2010 - S. Riette - Security for wind average in case of XUNDEF values
! B. decharme 04/2013 : Add EVAP and SUBL diag
+! P. Wautelet 02/2019: bug: fixed intent of PFIELD_OUT (OUT->INOUT)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -323,7 +324,7 @@ IMPLICIT NONE
!
REAL, DIMENSION(:),INTENT(IN) :: PFRAC
REAL, DIMENSION(:),INTENT(IN) :: PFIELD_IN
-REAL, DIMENSION(:), INTENT(OUT) :: PFIELD_OUT
+REAL, DIMENSION(:), INTENT(INOUT) :: PFIELD_OUT
INTEGER, INTENT(IN) :: KTILE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
INTEGER :: JT
@@ -350,7 +351,7 @@ IMPLICIT NONE
!
REAL, DIMENSION(:),INTENT(IN) :: PFRAC
REAL, DIMENSION(:,:),INTENT(IN) :: PFIELD_IN
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFIELD_OUT
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PFIELD_OUT
INTEGER, INTENT(IN) :: KTILE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
INTEGER :: JT, JL
@@ -379,7 +380,7 @@ IMPLICIT NONE
REAL, DIMENSION(:),INTENT(IN) :: PFRAC
REAL, DIMENSION(:),INTENT(IN) :: PFIELD_IN
REAL, DIMENSION(:),INTENT(IN) :: PREF
-REAL, DIMENSION(:), INTENT(OUT) :: PFIELD_OUT
+REAL, DIMENSION(:), INTENT(INOUT) :: PFIELD_OUT
INTEGER, INTENT(IN) :: KTILE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -413,7 +414,7 @@ IMPLICIT NONE
!
REAL, DIMENSION(:),INTENT(IN) :: PFRAC
REAL, DIMENSION(:),INTENT(IN) :: PFIELD_IN
-REAL, DIMENSION(:), INTENT(OUT) :: PFIELD_OUT
+REAL, DIMENSION(:), INTENT(INOUT) :: PFIELD_OUT
INTEGER, INTENT(IN) :: KTILE
REAL, DIMENSION(:), INTENT(INOUT) :: PLAND
REAL, DIMENSION(:), INTENT(INOUT) :: PSEA
diff --git a/src/SURFEX/bilin_value.F90 b/src/SURFEX/bilin_value.F90
index f4aac84c2e69c97f7092bddfdd7178fec9c166fc..48bf32aaa3335f04288061dc54d8d8cb34df244a 100644
--- a/src/SURFEX/bilin_value.F90
+++ b/src/SURFEX/bilin_value.F90
@@ -1,6 +1,6 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC Copyright 2004-2019 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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
SUBROUTINE BILIN_VALUE (KLUOUT,KX,KY,PFIELD1,PCX,PCY,KCI,KCJ,PFIELD2)
@@ -77,7 +77,7 @@
!!
!! Original 01/2004
! TD&DD: added OpenMP directives
-
+! P. Wautelet 08/02/2019: initialize ZFIELD1 even if of size=1
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -200,7 +200,8 @@ ELSE
IS2 = IBOR(2,2,0)-IBOR(2,1,0)+1
ISIZE = IS1*IS2
ALLOCATE(ZFIELD1(IS1,IS2,INL))
- IF (SUM(IBOR(:,:,0))/=0) THEN
+ IF(ISIZE==1) ZFIELD1(:,:,:) = XUNDEF !Necessary to initialize ZFIELD1 in all cases (value could be anything)
+ IF (SUM(IBOR(:,:,0))/=0) THEN
DO JL=IBOR(2,1,0),IBOR(2,2,0)
ZFIELD1(:,JL-IBOR(2,1,0)+1,:) = PFIELD1(KX*(JL-1)+IBOR(1,1,0):KX*(JL-1)+IBOR(1,2,0),:)
ENDDO
diff --git a/src/SURFEX/convert_patch_isba.F90 b/src/SURFEX/convert_patch_isba.F90
index 0ad47ed03181fa254b9bb6478e062eaa474c80b7..cad66666339946c838b566938c50ad491b38e4f0 100644
--- a/src/SURFEX/convert_patch_isba.F90
+++ b/src/SURFEX/convert_patch_isba.F90
@@ -1,6 +1,6 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC Copyright 2010-2019 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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
SUBROUTINE CONVERT_PATCH_ISBA (DTCO, DTV, IO, KDEC, KDEC2, PCOVER, OCOVER,&
@@ -45,7 +45,8 @@
!! albedo, UV albedo not defined (conserv nrj when
!! coupled to atmosphere)
!! P Samuelsson 10/2014 MEB
-!!
+! P. Wautelet 15/02/2019: bugfix: allocate ZSTRESS only when its size has a meaning
+!
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
@@ -671,13 +672,14 @@ SUBROUTINE SET_STRESS
IMPLICIT NONE
!
REAL, DIMENSION(PK%NSIZE_P) :: ZWORK
-REAL, DIMENSION(SIZE(DTV%LPAR_STRESS,1),NVEGTYPE) :: ZSTRESS
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSTRESS
INTEGER :: JI
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('CONVERT_PATCH_ISBA:SET_STRESS',0,ZHOOK_HANDLE)
!
IF (GDATA .AND. ANY(DTV%LDATA_STRESS)) THEN
+ ALLOCATE( ZSTRESS( SIZE(DTV%LPAR_STRESS,1),NVEGTYPE ) )
ZSTRESS(:,:)=0.
DO JVEG=1,NVEGTYPE
DO JI = 1,PK%NSIZE_P
@@ -686,6 +688,7 @@ IF (GDATA .AND. ANY(DTV%LDATA_STRESS)) THEN
ENDDO
CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
ZWORK,DTV%XPAR_VEGTYPE,ZSTRESS,YVEG,'ARI',PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ DEALLOCATE( ZSTRESS )
ELSE
CALL AV_PGD_1P(DTCO, ZWORK,PCOVER,XDATA_STRESS(:,:),YVEG,'ARI',OCOVER,PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
diff --git a/src/SURFEX/coupling_isban.F90 b/src/SURFEX/coupling_isban.F90
index 1250e5719706301ef0e8e6e8fbc5f1db109bc8ea..45e5eea8f4176584b60b89e1c51e6e98230261d6 100644
--- a/src/SURFEX/coupling_isban.F90
+++ b/src/SURFEX/coupling_isban.F90
@@ -69,6 +69,7 @@ SUBROUTINE COUPLING_ISBA_n (DTCO, UG, U, USS, NAG, CHI, NCHI, MGN, MSF, DTI, ID
!! P. LeMoigne 12/2014 EBA scheme update
!! R. Seferian 05/2015 : Add coupling fiels to vegetation_evol call
!! P. Tulet 06/2016 : call coupling_megan add RN leaves for MEGAN
+!! J. Pianezzej 02/2019 : correction for use of MEGAN
!!-------------------------------------------------------------------
!
USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
@@ -1154,6 +1155,12 @@ ENDIF
IF (CHI%SVI%NBEQ>0 .AND. CHI%LCH_BIO_FLUX) THEN
IF ((TRIM(CHI%CPARAMBVOC) == 'MEGAN').AND.(ANY(PEK%XLAI(:)/=XUNDEF))) THEN
+!UPG*PT
+ WHERE (GBK%XIACAN > 2000.) ! non physical values
+ GBK%XIACAN = 0.
+ END WHERE
+!UPG*PT
+
CALL COUPLING_MEGAN_n(MGN, CHI, GK, PEK, &
KYEAR, KMONTH, KDAY, PTIME, IO%LTR_ML, &
IP_SLTYP, ZP_PFT, ZP_EF, &
diff --git a/src/SURFEX/coupling_megann.F90 b/src/SURFEX/coupling_megann.F90
index 6d5641bf78b6f3acecc378ebc22d0bd2b51e0803..88bb6fd8a65007c6e2a7ad20bf6366a8f53cb603 100644
--- a/src/SURFEX/coupling_megann.F90
+++ b/src/SURFEX/coupling_megann.F90
@@ -29,6 +29,7 @@
!! -------------
!! Original: 25/10/2014
!! Modified: 06/07/2017, J. Pianezze, adaptation for SurfEx v8.0
+!! Modified: 06/07/2018, P. Tulet, correction for T leaf
!!
!! EXTERNAL
!! --------
@@ -132,27 +133,14 @@ ZPFD(:) = 0.
DO JSM = 1,SIZE(PIACAN,2)
ZPFD(:) = ZPFD(:) + PIACAN(:, JSM)
END DO
-! Test car PIACAN prends des valeurs non physiques au lever du soleil
-WHERE (ZPFD(:) .GT. 2000.) ZPFD(:) = 0.
!
-! compute sun and shade leaf temperature upon RN_SHADE and RN_SUNLIT
-! thanks to D. Carrer
-!
-ZLSUT(:) = PTEMP(:) + 3.
+! UPG*PT en attendat un calcul propre. Temperature des feuilles à l'ombre egale a la
+! température de l'air. La temparature des feuilles au soleil egale a la valeur
+! max entre la temperature de l'air et la temperaure radiative.
+ZLSUT(:) = MAX(PLEAFT(:),PTEMP(:))
ZLSHT(:) = PTEMP(:)
-!
-IF (OTR_ML) THEN
- !
- ZRN(:) = PRN_SUNLIT(:)**2 + PRN_SHADE(:)**2
- !
- WHERE ( ZRN(:).NE.0. )
- ! for sun leaves
- ZLSUT(:) = PLEAFT(:) * PRN_SUNLIT(:) * (PRN_SUNLIT(:)+PRN_SHADE(:))/ZRN(:)
- ! for shade leaves
- ZLSHT(:) = PLEAFT(:) * PRN_SHADE (:) * (PRN_SUNLIT(:)+PRN_SHADE(:))/ZRN(:)
- END WHERE
- !
-END IF
+!UPG*PT
+
!
! MEGAN : calcul des facteurs d'ajustement et de perte dans la canopée.
! ZCFSPEC: classe de sorties MEGAN (voir SPC_NOCONVER.EXT)
diff --git a/src/SURFEX/coupling_seaflux_orogn.F90 b/src/SURFEX/coupling_seaflux_orogn.F90
index 71b257f9f1cc6ad8c05be6223221fbc855a7ea35..5d222e8480eba4d94bac84f3c51a259ecb074d32 100644
--- a/src/SURFEX/coupling_seaflux_orogn.F90
+++ b/src/SURFEX/coupling_seaflux_orogn.F90
@@ -11,7 +11,7 @@ SUBROUTINE COUPLING_SEAFLUX_OROG_n (SM, DST, SLT, HPROGRAM, HCOUPLING, PTIMEC, P
PSFTS, PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB,&
PEMIS, PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, &
PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, &
- PPEQ_B_COEF, HTEST )
+ PPEQ_B_COEF, PZWS, HTEST )
! ###############################################################################
!
!!**** *COUPLING_SEAFLUX_OROG_n * - Modifies the input forcing if not
@@ -38,6 +38,7 @@ SUBROUTINE COUPLING_SEAFLUX_OROG_n (SM, DST, SLT, HPROGRAM, HCOUPLING, PTIMEC, P
!! J. Escobar 09/2012 SIZE(PTA) not allowed without-interface , replace by KI
!! B. Decharme 04/2013 new coupling variables
!! improve forcing vertical shift
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
!!-------------------------------------------------------------
!
!
@@ -106,6 +107,7 @@ REAL, DIMENSION(KI), INTENT(IN) :: PLW ! longwave radiation (on horizonta
! ! (W/m2)
REAL, DIMENSION(KI), INTENT(IN) :: PPS ! pressure at atmospheric model surface (Pa)
REAL, DIMENSION(KI), INTENT(IN) :: PPA ! pressure at forcing level (Pa)
+REAL, DIMENSION(KI), INTENT(IN) :: PZWS ! significant sea wave (m)
REAL, DIMENSION(KI), INTENT(IN) :: PZS ! atmospheric model orography (m)
REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration in the air (kg/m3)
REAL, DIMENSION(KI), INTENT(IN) :: PSNOW ! snow precipitation (kg/m2/s)
@@ -204,7 +206,7 @@ ENDIF
PSFTS, PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, &
PEMIS, PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, &
PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, ZPET_B_COEF, &
- ZPEQ_B_COEF, HTEST )
+ ZPEQ_B_COEF, PZWS, HTEST )
!
IF (LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_OROG_N',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------------
diff --git a/src/SURFEX/coupling_seaflux_sbln.F90 b/src/SURFEX/coupling_seaflux_sbln.F90
index 857f16473668a9831029b3f31d3bcaab7deb85c3..53aa72d42ebc46a6e8c6ca068027000af37bd2d6 100644
--- a/src/SURFEX/coupling_seaflux_sbln.F90
+++ b/src/SURFEX/coupling_seaflux_sbln.F90
@@ -11,7 +11,7 @@ SUBROUTINE COUPLING_SEAFLUX_SBL_n (CHS, DTS, DGS, O, OR, G, S, SB, DST, SLT,
PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, &
- PPEQ_B_COEF, HTEST )
+ PPEQ_B_COEF, PZWS, HTEST )
! ###############################################################################
!
!!**** *COUPLING_SEAFLUX_SBL_n * - Adds a SBL into SEAFLUX
@@ -38,6 +38,7 @@ SUBROUTINE COUPLING_SEAFLUX_SBL_n (CHS, DTS, DGS, O, OR, G, S, SB, DST, SLT,
!! S. Riette 10/2009 Iterative computation of XZ0
!! S. Riette 01/2010 Use of interpol_sbl to compute 10m wind diagnostic
!! B. Decharme 04/2013 new coupling variables
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
!----------------------------------------------------------------
!
!
@@ -122,6 +123,7 @@ REAL, DIMENSION(KI), INTENT(IN) :: PLW ! longwave radiation (on horizonta
! ! (W/m2)
REAL, DIMENSION(KI), INTENT(IN) :: PPS ! pressure at atmospheric model surface (Pa)
REAL, DIMENSION(KI), INTENT(IN) :: PPA ! pressure at forcing level (Pa)
+REAL, DIMENSION(KI), INTENT(IN) :: PZWS ! significant sea wave (m)
REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration in the air (kg/m3)
REAL, DIMENSION(KI), INTENT(IN) :: PSNOW ! snow precipitation (kg/m2/s)
REAL, DIMENSION(KI), INTENT(IN) :: PRAIN ! liquid precipitation (kg/m2/s)
@@ -302,7 +304,7 @@ END IF
PSV, PCO2, HSV, PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, ZPA,&
PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, &
PEMIS, PTSURF, PZ0, PZ0H, PQSURF, ZPEW_A_COEF, ZPEW_B_COEF, &
- ZPET_A_COEF, ZPEQ_A_COEF, ZPET_B_COEF, ZPEQ_B_COEF, HTEST)
+ ZPET_A_COEF, ZPEQ_A_COEF, ZPET_B_COEF, ZPEQ_B_COEF, PZWS, HTEST)
!
!-------------------------------------------------------------------------------------
!
diff --git a/src/SURFEX/coupling_seafluxn.F90 b/src/SURFEX/coupling_seafluxn.F90
index 5ea7b516c971576bf25a3d80fa24f72ba2f7690c..612b8df120d49a315c7eb105120c4afac78cb6c4 100644
--- a/src/SURFEX/coupling_seafluxn.F90
+++ b/src/SURFEX/coupling_seafluxn.F90
@@ -1,6 +1,6 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC Copyright 2004-2019 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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ###############################################################################
SUBROUTINE COUPLING_SEAFLUX_n (CHS, DTS, DGS, O, OR, G, S, DST, SLT, &
@@ -10,7 +10,7 @@ SUBROUTINE COUPLING_SEAFLUX_n (CHS, DTS, DGS, O, OR, G, S, DST, SLT, &
PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, &
PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, &
PZ0, PZ0H, PQSURF, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, &
- PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, HTEST )
+ PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, PZWS, HTEST )
! ###############################################################################
!
!!**** *COUPLING_SEAFLUX_n * - Driver of the WATER_FLUX scheme for sea
@@ -49,7 +49,9 @@ SUBROUTINE COUPLING_SEAFLUX_n (CHS, DTS, DGS, O, OR, G, S, DST, SLT, &
!! Modified 01/2015 : R. Séférian interactive ocaen surface albedo
!! Modified 03/2014 : M.N. Bouin possibility of wave parameters from external source
!! Modified 11/2014 : J. Pianezze : add currents for wave coupling
-!!
+!! Modified 02/2019 : S. Bielli Sea salt : significant sea wave height influences salt emission; 5 salt modes
+!! Modified 03/2019 : P. Wautelet: correct ZWS when variable not present in file
+!! Modified 03/2019 : P. Wautelet: missing use MODI_GET_LUOUT
!!---------------------------------------------------------------------
!
!
@@ -73,6 +75,10 @@ USE MODD_WATER_PAR, ONLY : XEMISWAT, XEMISWATICE
!
USE MODD_WATER_PAR, ONLY : XALBSEAICE
!
+#ifdef SFX_MNH
+USE MODD_FIELD_n, only: XZWS_DEFAULT
+#endif
+!
!
USE MODI_WATER_FLUX
USE MODI_MR98
@@ -103,6 +109,7 @@ USE MODI_COUPLING_ICEFLUX_n
USE MODI_SEAICE_GELATO1D_n
!
USE MODI_COUPLING_SLT_n
+USE MODI_GET_LUOUT
!
IMPLICIT NONE
!
@@ -157,6 +164,7 @@ REAL, DIMENSION(KI), INTENT(IN) :: PLW ! longwave radiation (on horizonta
! ! (W/m2)
REAL, DIMENSION(KI), INTENT(IN) :: PPS ! pressure at atmospheric model surface (Pa)
REAL, DIMENSION(KI), INTENT(IN) :: PPA ! pressure at forcing level (Pa)
+REAL, DIMENSION(KI), INTENT(IN) :: PZWS ! significant sea wave (m)
REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration in the air (kg/m3)
REAL, DIMENSION(KI), INTENT(IN) :: PSNOW ! snow precipitation (kg/m2/s)
REAL, DIMENSION(KI), INTENT(IN) :: PRAIN ! liquid precipitation (kg/m2/s)
@@ -232,6 +240,8 @@ REAL, DIMENSION(KI) :: ZHU ! Near surface relative humidity
REAL, DIMENSION(KI) :: ZQA ! specific humidity (kg/kg)
REAL, DIMENSION(KI) :: ZEMIS ! Emissivity at time t
REAL, DIMENSION(KI) :: ZTRAD ! Radiative temperature at time t
+REAL, DIMENSION(KI) :: ZHS ! significant wave height
+REAL, DIMENSION(KI) :: ZTP ! peak period
!
REAL, DIMENSION(KI) :: ZSST ! XSST corrected for anomalously low values (which actually are sea-ice temp)
REAL, DIMENSION(KI) :: ZMASK ! A mask for diagnosing where seaice exists (or, for coupling_iceflux, may appear)
@@ -245,14 +255,17 @@ INTEGER :: ISIZE_ICE ! number of points with some se
!
INTEGER :: ISWB ! number of shortwave spectral bands
INTEGER :: JSWB ! loop counter on shortwave spectral bands
-INTEGER :: ISLT ! number of sea salt variable
!
INTEGER :: IBEG, IEND
+INTEGER :: ISLT, IDST, JSV, IMOMENT ! number of sea salt, dust variables
+!
+INTEGER :: ILUOUT
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------------
! Preliminaries:
!-------------------------------------------------------------------------------------
+CALL GET_LUOUT(HPROGRAM,ILUOUT)
IF (LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_N',0,ZHOOK_HANDLE)
IF (HTEST/='OK') THEN
CALL ABOR1_SFX('COUPLING_SEAFLUXN: FATAL ERROR DURING ARGUMENT TRANSFER')
@@ -277,6 +290,8 @@ ZUSTAR (:) = XUNDEF
ZZ0 (:) = XUNDEF
ZZ0H (:) = XUNDEF
ZQSAT (:) = XUNDEF
+ZHS (:) = XUNDEF
+ZTP (:) = XUNDEF
!
ZSFTQ_ICE(:) = XUNDEF
ZSFTH_ICE(:) = XUNDEF
@@ -317,6 +332,29 @@ PSFTS(:,:) = 0.
ZHU = 1.
!
ZQA(:) = PQA(:) / PRHOA(:)
+
+! HS value from ECMWF file
+ZHS(:) = PZWS(:)
+#ifdef CPLOASIS
+! HS value from WW3 if activated
+IF (LCPL_WAVE) THEN
+ ZHS(:)=S%XHS(:)
+ ZTP(:)=S%XTP(:)
+ELSE
+ ZHS(:)=PZWS(:)
+ ZTP(:)=S%XTP(:)
+END IF
+#endif
+! if HS value is undef : constant value and alert message
+IF (ALL(ZHS==XUNDEF)) THEN
+#ifdef SFX_MNH
+ ZHS(:) = XZWS_DEFAULT
+ WRITE (ILUOUT,*) 'WARNING : no HS values from ECMWF or WW3, then it is initialized to a constant value of XZWS_DEFAULT m'
+#else
+ ZHS(:)=2.
+ WRITE (ILUOUT,*) 'WARNING : no HS values from ECMWF or WW3, then it is initialized to a constant value of 2 m'
+#endif
+END IF
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Time evolution
@@ -374,8 +412,16 @@ CALL COARE30_SEAFLUX(S, ZMASK, ISIZE_WATER, ISIZE_ICE, &
PTA, ZEXNA ,PRHOA, ZSST, ZEXNS, ZQA, PRAIN, &
PSNOW, ZWIND, PZREF, PUREF, PPS, ZQSAT, &
ZSFTH, ZSFTQ, ZUSTAR, &
- ZCD, ZCDN, ZCH, ZCE, ZRI, ZRESA_SEA, ZZ0H )
+ ZCD, ZCDN, ZCH, ZCE, ZRI, ZRESA_SEA, ZZ0H )
END SELECT
+
+#ifdef CPLOASIS
+IF (.NOT. LCPL_WAVE) THEN
+ S%XHS(:)=ZHS(:)
+ S%XTP(:)=ZTP(:)
+END IF
+#endif
+
!
!-------------------------------------------------------------------------------------
!radiative properties at time t
@@ -442,7 +488,7 @@ PSFCO2(:) = - ZWIND(:)**2 * 1.13E-3 * 8.7 * 44.E-3 / ( 365*24*3600 )
! Scalar fluxes:
!-------------------------------------------------------------------------------------
!
-IF (CHS%SVS%NBEQ>0) THEN
+IF (CHS%SVS%NBEQ>0.AND.(KI.GT.0)) THEN
!
IF (CHS%CCH_DRY_DEP == "WES89") THEN
!
@@ -475,7 +521,7 @@ IF (CHS%SVS%NBEQ>0) THEN
!
ENDIF
!
-IF (CHS%SVS%NDSTEQ>0) THEN
+IF (CHS%SVS%NDSTEQ>0.AND.(KI.GT.0)) THEN
!
IBEG = CHS%SVS%NSV_DSTBEG
IEND = CHS%SVS%NSV_DSTEND
@@ -499,7 +545,7 @@ IF (CHS%SVS%NDSTEQ>0) THEN
ENDIF
!
-IF (CHS%SVS%NSLTEQ>0) THEN
+IF (CHS%SVS%NSLTEQ>0.AND.(KI.GT.0)) THEN
!
IBEG = CHS%SVS%NSV_SLTBEG
IEND = CHS%SVS%NSV_SLTEND
@@ -510,6 +556,9 @@ IF (CHS%SVS%NSLTEQ>0) THEN
SIZE(ZUSTAR,1), & !I [nbr] number of sea point
ISLT, & !I [nbr] number of sea salt variables
ZWIND, & !I [m/s] wind velocity
+ ZHS, & !I [m] significant sea wave
+ S%XSST, &
+ ZUSTAR, &
PSFTS(:,IBEG:IEND) )
!
CALL DSLT_DEP(PSV(:,IBEG:IEND), PSFTS(:,IBEG:IEND), ZUSTAR, ZRESA_SEA, PTA, &
@@ -517,11 +566,11 @@ IF (CHS%SVS%NSLTEQ>0) THEN
XDENSITY_SLT, XMOLARWEIGHT_SLT, ZCONVERTFACM0_SLT, ZCONVERTFACM6_SLT, &
ZCONVERTFACM3_SLT, LVARSIG_SLT, LRGFIX_SLT, CVERMOD )
!
- CALL MASSFLUX2MOMENTFLUX( &
- PSFTS(:,IBEG:IEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments
+ CALL MASSFLUX2MOMENTFLUX( &
+ PSFTS(:,IBEG:IEND), & !I/O [kg/m2/sec] In: flux of only mass, out: flux of moments
PRHOA, & !I [kg/m3] air density
- SLT%XEMISRADIUS_SLT, &!I [um] emitted radius for the modes (max 3)
- SLT%XEMISSIG_SLT, &!I [-] emitted sigma for the different modes (max 3)
+ SLT%XEMISRADIUS_SLT, & !I [um] emitted radius for the modes (max 3)
+ SLT%XEMISSIG_SLT, & !I [-] emitted sigma for the different modes (max 3)
NSLTMDE, &
ZCONVERTFACM0_SLT, &
ZCONVERTFACM6_SLT, &
diff --git a/src/SURFEX/coupling_sean.F90 b/src/SURFEX/coupling_sean.F90
index 97a8b1f7c6b4bc5a12c04551a6e869c22869d3b8..ca4ae208190a3df6849a9732c4918ee675ba8c55 100644
--- a/src/SURFEX/coupling_sean.F90
+++ b/src/SURFEX/coupling_sean.F90
@@ -10,7 +10,7 @@ SUBROUTINE COUPLING_SEA_n (SM, DGO, DL, DLC, U, DST, SLT, HPROGRAM, HCOUPLING, P
PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, HTEST )
+ PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, PZWS, HTEST )
! ###############################################################################
!
!!**** *COUPLING_SEA_n * - Chooses the surface schemes for sea
@@ -33,6 +33,7 @@ SUBROUTINE COUPLING_SEA_n (SM, DGO, DL, DLC, U, DST, SLT, HPROGRAM, HCOUPLING, P
!! -------------
!! Original 01/2004
!! B. Decharme 04/2013 new coupling variables
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
!!-----------------------------------------------------------------------
!
!
@@ -104,6 +105,7 @@ REAL, DIMENSION(KI), INTENT(IN) :: PLW ! longwave radiation (on horizonta
! ! (W/m2)
REAL, DIMENSION(KI), INTENT(IN) :: PPS ! pressure at atmospheric model surface (Pa)
REAL, DIMENSION(KI), INTENT(IN) :: PPA ! pressure at forcing level (Pa)
+REAL, DIMENSION(KI), INTENT(IN) :: PZWS ! significant sea wave (m)
REAL, DIMENSION(KI), INTENT(IN) :: PZS ! atmospheric model orography (m)
REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration in the air (kg/m3)
REAL, DIMENSION(KI), INTENT(IN) :: PSNOW ! snow precipitation (kg/m2/s)
@@ -150,7 +152,7 @@ IF (U%CSEA=='SEAFLX') THEN
PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, HTEST )
+ PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, PZWS, HTEST )
ELSE IF (U%CSEA=='FLUX ') THEN
CALL COUPLING_IDEAL_FLUX(DGO, DL, DLC, HPROGRAM, HCOUPLING, PTIMEC, &
PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, &
diff --git a/src/SURFEX/coupling_sltn.F90 b/src/SURFEX/coupling_sltn.F90
index 7e66f3fa5f6cbd143802a1d3f054ce40c4e5b0cc..284fc093527a26c6342ca61c0ac9e7b190aa9b7b 100644
--- a/src/SURFEX/coupling_sltn.F90
+++ b/src/SURFEX/coupling_sltn.F90
@@ -3,16 +3,26 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
SUBROUTINE COUPLING_SLT_n (SLT, &
- KI, &!I [nbr] number of sea points
- KSLT, &!I [nbr] number of sea points
- PWIND, &!I Wind velocity
- PSFSLT &!O [kg/m2/sec] flux of sea salt
+ KI, &!I [nbr] number of sea points
+ KSLT, &!I [nbr] number of sea salt variables
+ PWIND, &!I Wind velocity
+! ++ PIERRE / MARINE SSA - MODIF ++
+ PWHEIGHT, &! Significant height of wind-generated waves (in ECMWF analyses)
+ ! local pour l'instant, PWHEIGHT plus tard
+ PSST, &! Sea water temperature (C)
+ PUSTAR, &! Friction velocity (ecmwf?) Calcule dans coupling_seafluxn.F90
+! -- PIERRE / MARINE SSA - MODIF --
+ PSFSLT &!O [kg/m2/sec] production flux of sea salt
)
!PURPOSE
!-------
! Compute sea salt emission upon Vignatti et al, 2001
+! ++ PIERRE / MARINE SSA - MODIF ++
+! Compute sea salt emission upon Ovadnevaite et al, 2014
+! -- PIERRE / MARINE SSA - MODIF --
!
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
!AUTHOR
!-------
! P. Tulet
@@ -35,45 +45,64 @@ TYPE(SLT_t), INTENT(INOUT) :: SLT
INTEGER, INTENT(IN) :: KI !I Number of sea points
INTEGER, INTENT(IN) :: KSLT !I Number of sea salt emission variables
REAL, DIMENSION(KI), INTENT(IN) :: PWIND !I wind velocity
-REAL, DIMENSION(KI,KSLT), INTENT(OUT) :: PSFSLT !Out: mole particles per mole air m/s *(MWdst/MWair*rhoair)(index #1)
- !Out: kg/m2/s (index #2)
- !Out: moles m6/moles air m/s *(MWdst/MWair*rhoair)(index #3)
+REAL, DIMENSION(KI,KSLT), INTENT(OUT) :: PSFSLT !Out: kg/m2/s (index #2)
+! ++ PIERRE / MARINE SSA - MODIF ++
+REAL, DIMENSION(KI), INTENT(INOUT) :: PWHEIGHT !Significant height of wind-generated waves (in ECMWF analyses)
+REAL, DIMENSION(KI), INTENT(IN) :: PUSTAR !Friction velocity (ecmwf?) : Unite: m.s^(-2)?
+REAL, DIMENSION(KI), INTENT(IN) :: PSST ! Sea surface temperature (K)
+! -- PIERRE / MARINE SSA - MODIF --
+
!LOCAL VARIABLES
-REAL,DIMENSION(KI,3) :: ZSFSLT_MDE ! sea salt flux from modes
-INTEGER :: JN, JI !Counter for sea salt modes
-REAL, DIMENSION(KI) :: DZSPEED
-INTEGER, DIMENSION(KI):: WCL
-REAL :: ZCONVERTFACM0_SLT
-REAL :: ZCONVERTFACM3_SLT
-REAL :: ZCONVERTFACM6_SLT
-!
-!REAL, PARAMETER :: MASS1FLUX(0:40) = (/ &
-! 0.000E+00, 2.483E-15, 2.591E-14, 1.022E-13, 2.707E-13, 5.761E-13, &
-! 1.068E-12, 1.800E-12, 2.829E-12, 4.215E-12, 6.023E-12, 8.317E-12, &
-! 1.117E-11, 1.464E-11, 1.882E-11, 2.378E-11, 2.959E-11, 3.633E-11, &
-! 4.409E-11, 5.296E-11, 6.301E-11, 7.433E-11, 8.693E-11, 1.012E-10, &
-! 1.168E-10, 1.342E-10, 1.532E-10, 1.741E-10, 1.970E-10, 2.219E-10, &
-! 2.489E-10, 2.781E-10, 3.097E-10, 3.437E-10, 3.803E-10, 4.195E-10, &
-! 4.616E-10, 5.065E-10, 5.544E-10, 6.054E-10, 6.711E-10 /)
-!
-!REAL, PARAMETER :: MASS2FLUX(0:40) = (/ &
-! 0.000E+00, 2.319E-13, 2.411E-12, 9.481E-12, 2.505E-11, 5.321E-11, &
-! 9.850E-11, 1.658E-10, 2.602E-10, 3.874E-10, 5.529E-10, 7.628E-10, &
-! 1.023E-09, 1.341E-09, 1.722E-09, 2.175E-09, 2.704E-09, 3.319E-09, &
-! 4.026E-09, 4.832E-09, 5.746E-09, 6.776E-09, 7.925E-09, 9.214E-09, &
-! 1.064E-08, 1.221E-08, 1.394E-08, 1.584E-08, 1.791E-08, 2.016E-08, &
-! 2.261E-08, 2.526E-08, 2.812E-08, 3.120E-08, 3.451E-08, 3.806E-08, &
-! 4.186E-08, 4.592E-08, 5.025E-08, 5.486E-08, 6.014E-08 /)
-!
-!REAL, PARAMETER :: MASS3FLUX(0:40) = (/ 0.0, &
-! 1.783E-12, 1.579E-11, 5.852E-11, 1.501E-10, 3.134E-10, 5.740E-10, &
-! 9.597E-10, 1.500E-09, 2.227E-09, 3.175E-09, 4.378E-09, 5.872E-09, &
-! 7.698E-09, 9.897E-09, 1.250E-08, 1.556E-08, 1.912E-08, 2.323E-08, &
-! 2.792E-08, 3.325E-08, 3.927E-08, 4.608E-08, 5.356E-08, 6.194E-08, &
+REAL,DIMENSION(KI,JPMODE_SLT) :: ZSFSLT_MDE ! sea salt flux from modes
+INTEGER :: JN, JI, II !Counter for sea salt modes
+REAL, DIMENSION(KI) :: DZSPEED
+INTEGER, DIMENSION(KI) :: WCL
+REAL :: ZCONVERTFACM0_SLT ![kg/mole*mole/molec] conversion factor
+ !for moment fluxes and used fluxes
+REAL :: ZCONVERTFACM3_SLT
+REAL :: ZCONVERTFACM6_SLT
+!
+! ++ PIERRE / MARINE SSA - MODIF ++
+
+REAL, DIMENSION(5) :: ZNUWATER ! Temperature-dependant kinematic viscosity of
+ ! sea-water (table of data to interpolate) (m².s-¹)
+REAL, DIMENSION(5) :: ZWT ! Sea water temperature in table
+REAL, DIMENSION(KI) :: ZREYNOLDS ! Reynolds Number
+REAL, DIMENSION(KI) :: ZHVAGUE ! sea wave height from wind if ZWS is unknown.
+REAL, DIMENSION(KI) :: ZVISCO ! Temperature-dependant kinematic viscosity
+ ! of sea-water interpolated
+! -- PIERRE / MARINE SSA - MODIF --
+!
+!REAL, PARAMETER :: mass1flux(0:40) = (/ &
+! 0.000E+00, 2.483E-15, 2.591E-14, 1.022E-13, 2.707E-13, 5.761E-13, &
+! 1.068E-12, 1.800E-12, 2.829E-12, 4.215E-12, 6.023E-12, 8.317E-12, &
+! 1.117E-11, 1.464E-11, 1.882E-11, 2.378E-11, 2.959E-11, 3.633E-11, &
+! 4.409E-11, 5.296E-11, 6.301E-11, 7.433E-11, 8.693E-11, 1.012E-10, &
+! 1.168E-10, 1.342E-10, 1.532E-10, 1.741E-10, 1.970E-10, 2.219E-10, &
+! 2.489E-10, 2.781E-10, 3.097E-10, 3.437E-10, 3.803E-10, 4.195E-10, &
+! 4.616E-10, 5.065E-10, 5.544E-10, 6.054E-10, 6.711E-10 /)
+
+!REAL, PARAMETER :: mass2flux(0:40) = (/ &
+! 0.000E+00, 2.319E-13, 2.411E-12, 9.481E-12, 2.505E-11, 5.321E-11, &
+! 9.850E-11, 1.658E-10, 2.602E-10, 3.874E-10, 5.529E-10, 7.628E-10, &
+! 1.023E-09, 1.341E-09, 1.722E-09, 2.175E-09, 2.704E-09, 3.319E-09, &
+! 4.026E-09, 4.832E-09, 5.746E-09, 6.776E-09, 7.925E-09, 9.214E-09, &
+! 1.064E-08, 1.221E-08, 1.394E-08, 1.584E-08, 1.791E-08, 2.016E-08, &
+! 2.261E-08, 2.526E-08, 2.812E-08, 3.120E-08, 3.451E-08, 3.806E-08, &
+! 4.186E-08, 4.592E-08, 5.025E-08, 5.486E-08, 6.014E-08 /)
+
+!REAL, PARAMETER :: mass3flux(0:40) = (/ 0.0, &
+! 1.783E-12, 1.579E-11, 5.852E-11, 1.501E-10, 3.134E-10, 5.740E-10, &
+! 9.597E-10, 1.500E-09, 2.227E-09, 3.175E-09, 4.378E-09, 5.872E-09, &
+! 7.698E-09, 9.897E-09, 1.250E-08, 1.556E-08, 1.912E-08, 2.323E-08, &
+! 2.792E-08, 3.325E-08, 3.927E-08, 4.608E-08, 5.356E-08, 6.194E-08, &
! 7.121E-08, 8.143E-08, 9.266E-08, 1.049E-07, 1.183E-07, 1.329E-07, &
! 1.487E-07, 1.658E-07, 1.843E-07, 2.041E-07, 2.255E-07, 2.484E-07, &
! 2.729E-07, 2.991E-07, 3.270E-07, 3.517E-07 /)
+REAL, PARAMETER :: HVAGUE(1:9) = (/ 0., 0.1, 0.5, 1.25, 2.5, 4., 6., 9., 14. /)
+REAL, PARAMETER :: VVENT(1:9) = (/ 1., 2.7, 4.1, 6.3, 8.3, 11.1, 13.8, &
+ 16.6, 19.4/)
REAL, PARAMETER :: NUMB1FLUX(0:40) = (/ &
0.000E+00, 3.004E+01, 3.245E+02, 1.306E+03, 3.505E+03, 7.542E+03, &
@@ -107,7 +136,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!! M0=#/molec_{air}
!! M6=um6/molec_{air}*1.d6
!! The surface model should have (for sea salt)
-!! M0=#/m3*[kg_{dst}/mole_{dst}/XAVOGADRO]
+!! M0=#/m3*[kg_{slt}/mole_{slt}/XAVOGADRO]
!! M3=kg/m3
!! M6=um6/m3
!! REFERENCE
@@ -119,71 +148,175 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('COUPLING_SLT_N',0,ZHOOK_HANDLE)
!
!Factor which is needed so that all gains normal units when leaving ground paramn
-ZCONVERTFACM0_SLT = XMOLARWEIGHT_SLT / XAVOGADRO !(kg_dst/mol_dst)/(molec/mol)
+ZCONVERTFACM0_SLT = XMOLARWEIGHT_SLT / XAVOGADRO !(kg_slt/mol_slt)/(molec/mol)
!Factor which is needed for moment 6, there is a factor 1.d6 transported around in M6 in MESONH
ZCONVERTFACM6_SLT = XMOLARWEIGHT_SLT / XAVOGADRO*1.d6
ZCONVERTFACM3_SLT = 4./3.*XPI*XDENSITY_SLT / 1.d18
!
PSFSLT(:,:)=0.d0
!
-IF (CEMISPARAM_SLT.eq."Vig01")THEN
- !
- ! Vignatti et al. 2001 (in particles.cm-2.s-1)
- ZSFSLT_MDE(:,1) = 10**(0.09 *PWIND(:) + 0.283) ! fine mode
- ZSFSLT_MDE(:,2) = 10**(0.0422*PWIND(:) + 0.288) ! median mode
- ZSFSLT_MDE(:,3) = 10**(0.069 *PWIND(:) - 3.5) ! coarse mode
- ! convert into particles.m-2.s-1)
- ZSFSLT_MDE(:,1) = MAX(ZSFSLT_MDE(:,1) * 1E4, 1E-10)
- ZSFSLT_MDE(:,2) = MAX(ZSFSLT_MDE(:,2) * 1E4, 1E-10)
- ZSFSLT_MDE(:,3) = MAX(ZSFSLT_MDE(:,3) * 1E4, 1E-10)
- !
-ELSE ! Use Schultz et al., 2004
- !
+!+ Marine
+IF (CEMISPARAM_SLT .eq. "Ova14") THEN ! Rajouter Ova14 dans fichier initialisation
+ ZHVAGUE(:) = 0.
+ DO II = 1, 8
+!++cb++19/10/16 modif de la formule : + de vent => vagues + hautes
+! WHERE ((PWIND(:) .GT. VVENT(II)).AND.(PWIND(:) .LT. VVENT(II+1)))
+ WHERE ((PWIND(:) .GT. VVENT(II)).AND.(PWIND(:) .LT. VVENT(II+1)))
+! ZHVAGUE(:) = HVAGUE(II) + (VVENT(II+1) - PWIND(:)) * &
+ ZHVAGUE(:) = HVAGUE(II) + (PWIND(:) - VVENT(II+1)) * &
+ (HVAGUE(II+1) - HVAGUE(II)) / &
+ (VVENT(II+1) - VVENT(II))
+!--cb--
+ ENDWHERE
+ ENDDO
+
+ WHERE (PWIND(:) .GE. VVENT(9))
+ ZHVAGUE(:) = HVAGUE(9)
+ END WHERE
+
+ WHERE (PWHEIGHT(:) .EQ. -1.)
+ PWHEIGHT(:) = ZHVAGUE(:)
+ END WHERE
+
+ ZWT = (/ 273.15, 283.15, 293.15, 303.15, 313.15 /) ! Unite : K
+ ZNUWATER = (/ 1.854E-6, 1.36E-6, 1.051E-6, 0.843E-6, 0.695E-6 /)
+! Unite : m².s^(-1) Pour une salinite = 35g/kg.
+! En mer Mediterranee = 38.5g/kg (Lewis and Schwartz)
+
+! Initialisation des valeurs de ZVISCO, ZREYNOLDS
+ ZVISCO(:) = 0.
+ ZREYNOLDS(:) = 0.
+
+ ! Tableau d'interpolation pour calculer ZNUWATER en fonction de la SST
+ ! Cas ou 0 < SST < 10 C
+ WHERE ((PSST(:) >= 273.15).AND.(PSST(:) < 283.15))
+ ZVISCO(:) = ZNUWATER(1) + (PSST(:) - ZWT(1)) * (ZNUWATER(2)-ZNUWATER(1)) / &
+ (ZWT(2) - ZWT(1))
+ ENDWHERE
+
+ ! Cas ou 10 < SST < 20 C
+ WHERE ((PSST(:) >= 283.15).AND.(PSST(:) < 293.15))
+ ZVISCO(:) = ZNUWATER(2) + (PSST(:) - ZWT(2)) * (ZNUWATER(3)-ZNUWATER(2)) / &
+ (ZWT(3) - ZWT(2))
+ ENDWHERE
+
+ ! Cas ou 20 < SST < 30 C
+ WHERE ((PSST(:) >= 293.15).AND.(PSST(:) < 303.15))
+ ZVISCO(:) = ZNUWATER(3) + (PSST(:) - ZWT(3)) * (ZNUWATER(4)-ZNUWATER(3)) / &
+ (ZWT(4) - ZWT(3))
+ ENDWHERE
+
+ ! Cas ou 30 < SST < 40 C
+ WHERE ((PSST(:) >= 303.15).AND.(PSST(:) < 313.15))
+ ZVISCO(:) = ZNUWATER(4) + (PSST(:) - ZWT(4)) * (ZNUWATER(5)-ZNUWATER(4)) / &
+ (ZWT(5) - ZWT(4))
+ ENDWHERE
+
+! Calcul du nombre de Reynolds
+ ZREYNOLDS(:) = (PUSTAR(:) * PWHEIGHT(:)) / ZVISCO(:)
+
+! Calcul du flux en nombre pour chaque mode
+
+! Ovadnevaite et al. 2014
+!!!!! Total number flux, Unite ZSDSLT_MDE ne correspond pas au total number
+!flux mais au size dependent SSA production flux
+
+! Ecrire equation integration pour chaque mode
+
+!Condition d'emission : ZREYNOLDS > 1E5
+
+ WHERE (ZREYNOLDS(:) > 1.E5)
+ ZSFSLT_MDE(:,1) = 104.51 * ( ZREYNOLDS(:) - 1.E5)**0.556
+ ZSFSLT_MDE(:,2) = 0.044 * ( ZREYNOLDS(:) - 1.E5)**1.08
+ ZSFSLT_MDE(:,3) = 149.64 * ( ZREYNOLDS(:) - 1.E5)**0.545
+ ZSFSLT_MDE(:,4) = 2.96 * ( ZREYNOLDS(:) - 1.E5)**0.79
+ ENDWHERE
+ WHERE (ZREYNOLDS(:) > 2.E5)
+ ZSFSLT_MDE(:,5) = 0.52 * ( ZREYNOLDS(:) - 2.E5)**0.87
+ ENDWHERE
+
+
+
+ WHERE (ZREYNOLDS(:) <= 1.E5)
+ ZSFSLT_MDE(:,1) = 1.E-10
+ ZSFSLT_MDE(:,2) = 1.E-10
+ ZSFSLT_MDE(:,3) = 1.E-10
+ ZSFSLT_MDE(:,4) = 1.E-10
+ ENDWHERE
+ WHERE (ZREYNOLDS(:) <= 2.E5)
+ ZSFSLT_MDE(:,5) = 1.E-10
+ ENDWHERE
+
+! Controle avec des valeurs limites , Pas besoin de la conversion 1E4 pour Ova
+! car deja en m-2
+ ZSFSLT_MDE(:,1) = MAX(ZSFSLT_MDE(:,1) , 1.E-10)
+ ZSFSLT_MDE(:,2) = MAX(ZSFSLT_MDE(:,2) , 1.E-10)
+ ZSFSLT_MDE(:,3) = MAX(ZSFSLT_MDE(:,3) , 1.E-10)
+ ZSFSLT_MDE(:,4) = MAX(ZSFSLT_MDE(:,4) , 1.E-10)
+ ZSFSLT_MDE(:,5) = MAX(ZSFSLT_MDE(:,5) , 1.E-10)
+!- Marine
+
+ELSEIF (CEMISPARAM_SLT .eq. "Vig01") THEN
+! Vignatti et al. 2001 (in particles.cm-2.s-1) : en #.cm-3 en fait
+ ZSFSLT_MDE(:,1) = 10.**(0.09 *PWIND(:) + 0.283) ! fine mode
+ ZSFSLT_MDE(:,2) = 10.**(0.0422*PWIND(:) + 0.288) ! median mode
+ ZSFSLT_MDE(:,3) = 10.**(0.069 *PWIND(:) - 3.5) ! coarse mode
+
+! convert into particles.m-2.s-1)
+ ZSFSLT_MDE(:,1) = MAX(ZSFSLT_MDE(:,1) * 1.E4, 1.E-10)
+ ZSFSLT_MDE(:,2) = MAX(ZSFSLT_MDE(:,2) * 1.E4, 1.E-10)
+ ZSFSLT_MDE(:,3) = MAX(ZSFSLT_MDE(:,3) * 1.E4, 1.E-10)
+!
+ELSEIF (CEMISPARAM_SLT .eq. "Sch04") THEN! Use Schultz et al., 2004
WCL(:) = INT(PWIND(:))
WCL(:) = MAX (0, MIN(WCL(:), 39))
- !
+
DZSPEED(:) = MAX(0., MIN(PWIND(:) - FLOAT(WCL(:)), 1.))
- !
- ! Flux given in particles.m-2 s-1
- !
- DO JI=1,KI
- !plm-gfortran
- ZSFSLT_MDE(JI,1) = NUMB1FLUX(WCL(JI)) + (NUMB1FLUX(WCL(JI)+1)-NUMB1FLUX(WCL(JI)))*DZSPEED(JI)
- ZSFSLT_MDE(JI,2) = NUMB2FLUX(WCL(JI)) + (NUMB2FLUX(WCL(JI)+1)-NUMB2FLUX(WCL(JI)))*DZSPEED(JI)
- ZSFSLT_MDE(JI,3) = NUMB3FLUX(WCL(JI)) + (NUMB3FLUX(WCL(JI)+1)-NUMB3FLUX(WCL(JI)))*DZSPEED(JI)
- !plm-gfortran
- ENDDO
- !
+ !
+ ! Flux given in particles.m-2 s-1
+ !
+ DO JI = 1, KI
+ !plm-gfortran
+ ZSFSLT_MDE(JI,1) = NUMB1FLUX(WCL(JI)) + &
+ (NUMB1FLUX(WCL(JI)+1)-NUMB1FLUX(WCL(JI)))*DZSPEED(JI)
+ ZSFSLT_MDE(JI,2) = NUMB2FLUX(WCL(JI)) + &
+ (NUMB2FLUX(WCL(JI)+1)-NUMB2FLUX(WCL(JI)))*DZSPEED(JI)
+ ZSFSLT_MDE(JI,3) = NUMB3FLUX(WCL(JI)) + &
+ (NUMB3FLUX(WCL(JI)+1)-NUMB3FLUX(WCL(JI)))*DZSPEED(JI)
+ !plm-gfortran
+ END DO
END IF
!
-DO JN=1,JPMODE_SLT
+DO JN = 1, JPMODE_SLT
+
+! convert particles.m-2 s-1 into kg.m-2.s-1
+! N'est calculé que pour le moment 3 (en masse), la conversion pour les autres
+! flux de moments se fait plus tard (mode_dslt_surf.F90 MASSFLUX2MOMENTFLUX)
+!+Marine
!
- IF (LVARSIG_SLT) THEN
- !
- PSFSLT(:,1+(JN-1)*3) = ZSFSLT_MDE(:,JORDER_SLT(JN))
- PSFSLT(:,2+(JN-1)*3) = PSFSLT(:,1+(JN-1)*3) * (SLT%XEMISRADIUS_SLT(JN)**3)*EXP(4.5 * LOG(SLT%XEMISSIG_SLT(JN))**2)
- PSFSLT(:,3+(JN-1)*3) = PSFSLT(:,1+(JN-1)*3) * (SLT%XEMISRADIUS_SLT(JN)**6)*EXP(18. * LOG(SLT%XEMISSIG_SLT(JN))**2)
- !
- ! Conversion into fluxes
- PSFSLT(:,1+(JN-1)*3) = PSFSLT(:,1+(JN-1)*3) * ZCONVERTFACM0_SLT
- PSFSLT(:,2+(JN-1)*3) = PSFSLT(:,1+(JN-1)*3) * ZCONVERTFACM3_SLT
- PSFSLT(:,3+(JN-1)*3) = PSFSLT(:,3+(JN-1)*3) * ZCONVERTFACM6_SLT
-
- ELSE IF (LRGFIX_SLT) THEN
- PSFSLT(:,JN) = ZSFSLT_MDE(:,JORDER_SLT(JN)) * (SLT%XEMISRADIUS_SLT(JN)**3)*EXP(4.5 * LOG(SLT%XEMISSIG_SLT(JN))**2)
- ! Conversion into fluxes
- PSFSLT(:,JN) = PSFSLT(:,JN) * ZCONVERTFACM3_SLT
-
- ELSE
- PSFSLT(:,1+(JN-1)*2) = ZSFSLT_MDE(:,JORDER_SLT(JN))
- PSFSLT(:,2+(JN-1)*2) = PSFSLT(:,1+(JN-1)*2) * (SLT%XEMISRADIUS_SLT(JN)**3)*EXP(4.5 * LOG(SLT%XEMISSIG_SLT(JN))**2)
-
- ! Conversion into fluxes
- PSFSLT(:,1+(JN-1)*2) = PSFSLT(:,1+(JN-1)*2) * ZCONVERTFACM0_SLT
- PSFSLT(:,2+(JN-1)*2) = PSFSLT(:,1+(JN-1)*2) * ZCONVERTFACM3_SLT
-
- ENDIF
+ IF (LVARSIG_SLT) THEN ! cas 3 moment
+
+ PSFSLT(:,2+(JN-1)*3) = ZSFSLT_MDE(:,JORDER_SLT(JN)) &
+ * ((SLT%XEMISRADIUS_SLT(JORDER_SLT(JN))**3) &
+ * EXP(4.5 * LOG(SLT%XEMISSIG_SLT(JORDER_SLT(JN)))**2)) &
+ * ZCONVERTFACM3_SLT
+
+ ELSEIF (LRGFIX_SLT) THEN ! cas 1 moment
+ PSFSLT(:,JN) = ZSFSLT_MDE(:,JORDER_SLT(JN)) &
+ * (SLT%XEMISRADIUS_SLT(JORDER_SLT(JN))**3) &
+ * EXP(4.5 * LOG(SLT%XEMISSIG_SLT(JORDER_SLT(JN)))**2) &
+ * ZCONVERTFACM3_SLT
+
+ ELSE ! cas 2 moments
+
+ PSFSLT(:,2+(JN-1)*2) = ZSFSLT_MDE(:,JORDER_SLT(JN)) &
+ * ((SLT%XEMISRADIUS_SLT(JORDER_SLT(JN))**3) &
+ * EXP(4.5 * LOG(SLT%XEMISSIG_SLT(JORDER_SLT(JN)))**2)) &
+ * ZCONVERTFACM3_SLT
+! -- PIERRE / MARINE SSA - MODIF --
+ END IF
END DO
+
IF (LHOOK) CALL DR_HOOK('COUPLING_SLT_N',1,ZHOOK_HANDLE)
END SUBROUTINE COUPLING_SLT_n
diff --git a/src/SURFEX/coupling_surf_atmn.F90 b/src/SURFEX/coupling_surf_atmn.F90
index f9fdb2f8ecc688ee978fc52c24137e8a27bfd143..9a52eed46e1b6525e9e0ad2a000b97fc84ef205e 100644
--- a/src/SURFEX/coupling_surf_atmn.F90
+++ b/src/SURFEX/coupling_surf_atmn.F90
@@ -1,6 +1,6 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC Copyright 2004-2019 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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #################################################################################
SUBROUTINE COUPLING_SURF_ATM_n (YSC, HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, &
@@ -10,7 +10,7 @@ SUBROUTINE COUPLING_SURF_ATM_n (YSC, HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR,
PPS, PPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, PTRAD, &
PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, &
- PPET_B_COEF, PPEQ_B_COEF, HTEST )
+ PPET_B_COEF, PPEQ_B_COEF, PZWS, HTEST )
! #################################################################################
!
!!**** *COUPLING_INLAND_WATER_n * - Driver to call the schemes for the
@@ -38,6 +38,8 @@ SUBROUTINE COUPLING_SURF_ATM_n (YSC, HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR,
!! B. Decharme 04/2013 new coupling variables and replace RW_PRECIP_n by CPL_GCM_n
!! Modified 06/2013 by J.Escobar : replace DOUBLE PRECISION by REAL to handle problem for promotion of real on IBM SP
!! R. Séférian 03/2014 Adding decoupling between CO2 seen by photosynthesis and radiative CO2
+!! P. Wautelet 02/2019 bug correction KI->KSIZE for size of KMASK argument in TREAT_SURF
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
!!-------------------------------------------------------------
!
!
@@ -127,6 +129,7 @@ REAL, DIMENSION(KI), INTENT(IN) :: PLW ! longwave radiation (on horizonta
! ! (W/m2)
REAL, DIMENSION(KI), INTENT(IN) :: PPS ! pressure at atmospheric model surface (Pa)
REAL, DIMENSION(KI), INTENT(IN) :: PPA ! pressure at forcing level (Pa)
+REAL, DIMENSION(KI), INTENT(IN) :: PZWS ! significant sea wave (m)
REAL, DIMENSION(KI), INTENT(IN) :: PZS ! atmospheric model orography (m)
REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration in the air (kg/m3)
REAL, DIMENSION(KI), INTENT(IN) :: PSNOW ! snow precipitation (kg/m2/s)
@@ -450,9 +453,9 @@ SUBROUTINE TREAT_SURF(KTILE,KSIZE,KMASK)
!
IMPLICIT NONE
!
-INTEGER, INTENT(IN) :: KTILE
-INTEGER, INTENT(IN) :: KSIZE
-INTEGER, INTENT(IN), DIMENSION(KI) :: KMASK
+INTEGER, INTENT(IN) :: KTILE
+INTEGER, INTENT(IN) :: KSIZE
+INTEGER, INTENT(IN), DIMENSION(KSIZE) :: KMASK
!
REAL, DIMENSION(KSIZE) :: ZP_TSUN ! solar time (s from midnight)
REAL, DIMENSION(KSIZE) :: ZP_ZREF ! height of T,q forcing (m)
@@ -474,6 +477,7 @@ REAL, DIMENSION(KSIZE) :: ZP_LW ! longwave radiation (on horizontal surf.)
! ! (W/m2)
REAL, DIMENSION(KSIZE) :: ZP_PS ! pressure at atmospheric model surface (Pa)
REAL, DIMENSION(KSIZE) :: ZP_PA ! pressure at forcing level (Pa)
+REAL, DIMENSION(KSIZE) :: ZP_ZWS ! significant sea wave (m)
REAL, DIMENSION(KSIZE) :: ZP_ZS ! atmospheric model orography (m)
REAL, DIMENSION(KSIZE) :: ZP_CO2 ! CO2 concentration in the air (kg/m3)
REAL, DIMENSION(KSIZE,KSV) :: ZP_SV ! scalar concentration in the air
@@ -531,6 +535,7 @@ DO JJ=1,KSIZE
ZP_LW(JJ) = PLW (JI)
ZP_PS(JJ) = PPS (JI)
ZP_PA(JJ) = PPA (JI)
+ ZP_ZWS(JJ) = PZWS (JI)
ZP_ZS(JJ) = PZS (JI)
ENDDO
!
@@ -583,7 +588,7 @@ IF (KTILE==1) THEN
ZP_PS, ZP_PA, ZP_SFTQ, ZP_SFTH, ZP_SFTS, ZP_SFCO2, ZP_SFU, ZP_SFV, &
ZP_TRAD, 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, 'OK' )
+ ZP_PET_B_COEF, ZP_PEQ_B_COEF, ZP_ZWS, 'OK' )
!
ELSEIF (KTILE==2) THEN
!
diff --git a/src/SURFEX/default_ch_bio_flux.F90 b/src/SURFEX/default_ch_bio_flux.F90
index a7a3abb71f9543286b4bd27a23babb4f77ecb218..b303ab82f9f9e2de19605c054e48b2b6094dd80e 100644
--- a/src/SURFEX/default_ch_bio_flux.F90
+++ b/src/SURFEX/default_ch_bio_flux.F90
@@ -3,7 +3,7 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE DEFAULT_CH_BIO_FLUX(OCH_BIO_FLUX)
+ SUBROUTINE DEFAULT_CH_BIO_FLUX(OCH_BIO_FLUX,PDAILYPAR,PDAILYTEMP)
! ########################################################################
!
!!**** *DEFAULT_CH_BIO_FLUX* - routine to set default values for the configuration for CH_BIO_FLUX scheme
@@ -32,7 +32,7 @@
!! MODIFICATIONS
!! -------------
!! Original 08/2007
-
+!! J.Pianezzej 02/2019 : correction for use of MEGAN
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -49,6 +49,8 @@ IMPLICIT NONE
! -------------------------
!
LOGICAL, INTENT(OUT) :: OCH_BIO_FLUX ! flag for the calculation of biogenic fluxes
+REAL, INTENT(OUT), OPTIONAL :: PDAILYPAR ! default values for megan PAR temperature
+REAL, INTENT(OUT), OPTIONAL :: PDAILYTEMP ! default values for megan daily temperature
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -60,6 +62,8 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('DEFAULT_CH_BIO_FLUX',0,ZHOOK_HANDLE)
OCH_BIO_FLUX= .FALSE.
+IF (PRESENT(PDAILYPAR)) PDAILYPAR = 200.
+IF (PRESENT(PDAILYTEMP)) PDAILYTEMP = 293.
IF (LHOOK) CALL DR_HOOK('DEFAULT_CH_BIO_FLUX',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
diff --git a/src/SURFEX/default_slt.F90 b/src/SURFEX/default_slt.F90
index e4f99f54a4c89da71b6fe82f411f277676888cc0..ca96f03f98d0b5c56c5cbd4b31838ac4d8c27045 100644
--- a/src/SURFEX/default_slt.F90
+++ b/src/SURFEX/default_slt.F90
@@ -32,6 +32,7 @@
!! MODIFICATIONS
!! -------------
!! Original 03/2005
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -52,8 +53,10 @@ IMPLICIT NONE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('DEFAULT_SLT',0,ZHOOK_HANDLE)
-CEMISPARAM_SLT = 'Vig01'
-JPMODE_SLT = 3
+! ++ PIERRE / MARINE SSA - MODIF ++
+CEMISPARAM_SLT = 'Ova14'
+JPMODE_SLT = 5
+! -- PIERRE / MARINE SSA - MODIF --
LVARSIG_SLT = .FALSE.
LRGFIX_SLT = .TRUE.
IF (LHOOK) CALL DR_HOOK('DEFAULT_SLT',1,ZHOOK_HANDLE)
diff --git a/src/SURFEX/e_budget.F90 b/src/SURFEX/e_budget.F90
index a717d91e81b0dacd266604e49073136d94ebb081..0615f6428933ad4a0b373c3857e8af20d311180f 100644
--- a/src/SURFEX/e_budget.F90
+++ b/src/SURFEX/e_budget.F90
@@ -1,6 +1,6 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC Copyright 1995-2019 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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
SUBROUTINE E_BUDGET(IO, KK, PK, PEK, DK, DMK, HIMPLICIT_WIND, &
@@ -76,6 +76,7 @@
!! (B. Decharme) 10/14 Bug in DIF composite budget
!! Use harmonic mean to compute interfacial thermal conductivities
!! "Restore" flux computed here
+!! (P. Wautelet) 02/19 Bug in intent of PDEEP_FLUX OUT->INOUT
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -183,7 +184,7 @@ REAL, DIMENSION(:), INTENT(OUT) :: PALBT, PEMIST, PDQSAT
REAL, DIMENSION(:), INTENT(IN) :: PQSAT
! PQSAT = saturation vapor humidity
!
-REAL, DIMENSION(:), INTENT(OUT) :: PDEEP_FLUX ! Heat flux at bottom of ISBA (W/m2)
+REAL, DIMENSION(:), INTENT(INOUT) :: PDEEP_FLUX ! Heat flux at bottom of ISBA (W/m2)
!
REAL, DIMENSION(:), INTENT(OUT) :: PRESTORE
! PRESTORE = surface restore flux (W m-2)
diff --git a/src/SURFEX/get_type_dimn.F90 b/src/SURFEX/get_type_dimn.F90
index b3b98462276242e11e3e7f37dc6cbc980aea6adc..05c60f73b86f8f402d50e74c1027f4e0a674dadf 100644
--- a/src/SURFEX/get_type_dimn.F90
+++ b/src/SURFEX/get_type_dimn.F90
@@ -1,6 +1,6 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC Copyright 2004-2019 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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #####################################
SUBROUTINE GET_TYPE_DIM_n (DTCO, U, &
@@ -26,6 +26,7 @@
!! MODIFICATIONS
!! -------------
!! Original 01/2004
+! P. Wautelet 15/02/2019: move computation of ZLAND (to prevent use of non initialized values)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -99,7 +100,6 @@ ELSE
ZWATER = U%XWATER
ZTOWN = U%XTOWN
END IF
-ZLAND = ZTOWN + ZNATURE
!
ALLOCATE(ZFULL(ILU))
ZFULL=1.
@@ -124,6 +124,7 @@ SELECT CASE (HTYPE)
KDIM = COUNT(ZWATER(:) > 0.)
!
CASE ('LAND ')
+ ZLAND = ZTOWN + ZNATURE
KDIM = COUNT(ZLAND(:) > 0.)
!
END SELECT
diff --git a/src/SURFEX/ini_csts.F90 b/src/SURFEX/ini_csts.F90
index 39462a53aff2b787418c5341955ebce5e3e22abc..a17a39e36b87555f47b3de7347072396f751e4c4 100644
--- a/src/SURFEX/ini_csts.F90
+++ b/src/SURFEX/ini_csts.F90
@@ -54,6 +54,9 @@
! ------------
!
USE MODD_CSTS
+#ifdef SFX_MNH
+USE MODD_PRECISION, ONLY: MNHREAL
+#endif
!
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -78,10 +81,12 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('INI_CSTS',0,ZHOOK_HANDLE)
#ifdef SFX_MNH
-#ifdef MNH_MPI_DOUBLE_PRECISION
-XSURF_TINY = 1.0e-80
-#else
+#if (MNH_REAL == 8)
+XSURF_TINY = 1.0e-80_MNHREAL
+#elif (MNH_REAL == 4)
XSURF_TINY = TINY (XSURF_TINY )
+#else
+#error "Invalid MNH_REAL"
#endif
#else
XSURF_TINY = 1.0e-80
diff --git a/src/SURFEX/init_isban.F90 b/src/SURFEX/init_isban.F90
index a6680248b113d1754300bc218d5eb03e11f17c14..dfa0031efbe28ff219ee22d8797ece38d3b8b20b 100644
--- a/src/SURFEX/init_isban.F90
+++ b/src/SURFEX/init_isban.F90
@@ -57,6 +57,7 @@ SUBROUTINE INIT_ISBA_n (DTCO, OREAD_BUDGETC, UG, U, USS, GCP, IM, DTZ,&
!! P. Wautelet 16/02/2018: bug correction: allocate some work arrays to 0,1,1 instead of 0,0,1 (crash with XLF)
!! V.VIonnet 2017 : Blow snow
!! P.Tulet 06/16 : add MEGAN coupling
+!! J.Pianezzej 02/2019 : correction for use of MEGAN
!!
!-------------------------------------------------------------------------------
!
@@ -234,7 +235,7 @@ IF (LNAM_READ) THEN
IM%O%NNBYEARSPINS, IM%O%NNBYEARSPINW, IM%O%LNITRO_DILU )
!
CALL DEFAULT_CH_DEP(IM%CHI%CCH_DRY_DEP)
- CALL DEFAULT_CH_BIO_FLUX(IM%CHI%LCH_BIO_FLUX)
+ CALL DEFAULT_CH_BIO_FLUX(IM%CHI%LCH_BIO_FLUX,PDAILYPAR=IM%MGN%XDAILYPAR,PDAILYTEMP=IM%MGN%XDAILYTEMP)
CALL DEFAULT_DIAG_ISBA(IM%ID%O%N2M, IM%ID%O%LSURF_BUDGET, IM%ID%O%L2M_MIN_ZS, IM%ID%O%LRAD_BUDGET, &
IM%ID%O%LCOEF, IM%ID%O%LSURF_VARS, IM%ID%DE%LSURF_EVAP_BUDGET, &
IM%ID%DM%LSURF_MISC_BUDGET, IM%ID%DM%LSURF_DIAG_ALBEDO, &
diff --git a/src/SURFEX/init_megann.F90 b/src/SURFEX/init_megann.F90
index e4654e149343b95b7002b1189942119ca50ede36..ee3b097f8a6b1a5ee6374c4458225f0cd1d16d81 100644
--- a/src/SURFEX/init_megann.F90
+++ b/src/SURFEX/init_megann.F90
@@ -25,6 +25,7 @@ SUBROUTINE INIT_MEGAN_n(IO, S, K, NP, MSF, MGN, PLAT, HSV, PMEGAN_FIELDS)
!! -------------
!! Original: 25/10/14
!! Modified: 06/2017, J. Pianezze, adaptation for SurfEx v8.0
+!! Modified: 06/2018, P. Tulet, add PFT and LAI
!!
!!
!! EXTERNAL
@@ -44,7 +45,8 @@ USE MODD_DATA_COVER_PAR, ONLY : NVT_C4, NVT_TRBE, NVT_TRBD, NVT_TEBE, &
NVT_BOGR, NVT_SHRB, NVT_GRAS, NVT_TROG, NVT_C3, &
NVT_NO, NVT_ROCK, NVT_SNOW, NVT_IRR, NVT_PARK
!
-USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_DATA_COVER, ONLY : XDATA_LAI
!
USE MODI_VEGTYPE_TO_PATCH
#ifdef MNH_MEGAN
@@ -86,9 +88,9 @@ REAL, DIMENSION(SIZE(K%XCLAY,1),IO%NPATCH) :: ZH_TREE
REAL,DIMENSION(SIZE(K%XCLAY,1)) :: ZSILT
REAL,DIMENSION(SIZE(K%XCLAY,1)) :: ZLAI
!
-IF (.NOT.IO%LTR_ML) THEN
- CALL ABOR1_SFX('INIT_MEGANN: FATAL ERROR PUT LTR_ML = T in NAM_ISBA (PREP_PGD step)')
-END IF
+!IF (.NOT.IO%LTR_ML) THEN
+! CALL ABOR1_SFX('INIT_MEGANN: FATAL ERROR PUT LTR_ML = T in NAM_ISBA (PREP_PGD step)')
+!END IF
!
ALLOCATE(MGN%XPFT (N_MGN_PFT,SIZE(K%XCLAY,1)))
ALLOCATE(MGN%XEF (N_MGN_SPC,SIZE(K%XCLAY,1)))
@@ -497,7 +499,25 @@ DO JSV=1, MSF%NMEGAN_NBR
IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "EFBIDER") MGN%XEF(18,:) = PMEGAN_FIELDS(:,JSV)
IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "EFSTRESS") MGN%XEF(19,:) = PMEGAN_FIELDS(:,JSV)
IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "EFOTHER") MGN%XEF(20,:) = PMEGAN_FIELDS(:,JSV)
+! IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "LAI") PLAI(:,1) = PMEGAN_FIELDS(:,JSV)
+ IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT1") MGN%XPFT(1,:) = PMEGAN_FIELDS(:,JSV)
+ IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT2") MGN%XPFT(2,:) = PMEGAN_FIELDS(:,JSV)
+ IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT3") MGN%XPFT(3,:) = PMEGAN_FIELDS(:,JSV)
+ IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT4") MGN%XPFT(4,:) = PMEGAN_FIELDS(:,JSV)
+ IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT5") MGN%XPFT(5,:) = PMEGAN_FIELDS(:,JSV)
+ IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT6") MGN%XPFT(6,:) = PMEGAN_FIELDS(:,JSV)
+ IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT7") MGN%XPFT(7,:) = PMEGAN_FIELDS(:,JSV)
+ IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT8") MGN%XPFT(8,:) = PMEGAN_FIELDS(:,JSV)
+ IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT9") MGN%XPFT(9,:) = PMEGAN_FIELDS(:,JSV)
+ IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT10") MGN%XPFT(10,:) = PMEGAN_FIELDS(:,JSV)
+ IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT11") MGN%XPFT(11,:) = PMEGAN_FIELDS(:,JSV)
+ IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT12") MGN%XPFT(12,:) = PMEGAN_FIELDS(:,JSV)
+ IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT13") MGN%XPFT(13,:) = PMEGAN_FIELDS(:,JSV)
+ IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT14") MGN%XPFT(14,:) = PMEGAN_FIELDS(:,JSV)
+ IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT15") MGN%XPFT(15,:) = PMEGAN_FIELDS(:,JSV)
+ IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT16") MGN%XPFT(16,:) = PMEGAN_FIELDS(:,JSV)
END DO
+
#endif
!
!---------------------------------------------------------------------------
diff --git a/src/SURFEX/init_slt.F90 b/src/SURFEX/init_slt.F90
index 2320d6517af47881244b62bf2f3fb97d39c4841e..44e1e1bf988df95211f08f3e438b918468c72617 100644
--- a/src/SURFEX/init_slt.F90
+++ b/src/SURFEX/init_slt.F90
@@ -5,7 +5,36 @@
SUBROUTINE INIT_SLT (SLT, &
HPROGRAM &! Program calling unit
)
-
+! ######################################################################
+!
+!!**** *INIT_SLT* -
+!!
+!! PURPOSE
+!! -------
+!
+!!** METHOD
+!! ------
+!! !!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! ?
+!!
+!! MODIFICATIONS
+!! -------------
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+!!
+!------------------------------------------------------------------------------
+!
!
USE MODD_SLT_n, ONLY : SLT_t
!
@@ -38,14 +67,28 @@ ALLOCATE(SLT%XEMISSIG_SLT (NSLTMDE))
!Get initial size distributions. This is cut and pasted
!from dead routine dstpsd.F90
!Check for different source parameterizations
-IF(CEMISPARAM_SLT.eq."Vig01") THEN
+
+IF (CEMISPARAM_SLT.eq."Ova14") THEN
+ NSLTMDE = 5
+! JORDER_SLT = (/3,2,1,4,5/) !Salt modes in order of importance
CRGUNITS = 'NUMB'
- XEMISRADIUS_INI_SLT(:) = (/ 0.2, 2.0, 12. /) ! [um] Number median radius She84 p. 75 Table 1
- XEMISSIG_INI_SLT (:) = (/ 1.9, 2.0, 3.00 /) ! [frc] Geometric standard deviation She84 p. 75 Table 1
-ELSE ! use default of Schultz et al, 2004
- CRGUNITS = 'MASS'
- XEMISRADIUS_INI_SLT(:) = 0.5*(/0.28, 2.25, 15.32/) ! [um] Mass median radius
- XEMISSIG_INI_SLT (:) = (/1.59, 2.00, 2.00 /) ! [frc] Geometric standard deviation
+ XEMISRADIUS_INI_SLT = (/0.009, 0.021, 0.045, 0.115, 0.415/)
+ XEMISSIG_INI_SLT = (/1.37, 1.5, 1.42, 1.53, 1.85/)
+
+ELSE IF(CEMISPARAM_SLT.eq."Vig01") THEN
+ NSLTMDE = 5
+! JORDER_SLT = (/3,2,1,4,5/) !Salt modes in order of importance, only three modes
+ CRGUNITS = 'NUMB'
+ XEMISRADIUS_INI_SLT = (/ 0.2, 2.0, 12.,0.,0. /) ! [um] Number median radius Viganati et al., 2001
+ XEMISSIG_INI_SLT = (/ 1.9, 2.0, 3.00,0.,0. /) ! [frc] Geometric standard deviation Viganati et al., 2001
+
+ELSE IF(CEMISPARAM_SLT.eq."Sch04") THEN ! use default of Schultz et al, 2004
+ NSLTMDE = 5
+! JORDER_SLT = (/3,2,1,4,5/), only three modes
+ CRGUNITS = 'MASS'
+ XEMISRADIUS_INI_SLT = 0.5*(/0.28, 2.25, 15.32, 0., 0./)! [um] Mass median radius
+ XEMISSIG_INI_SLT = (/1.59, 2.00, 2.00, 0., 0./) ! [frc] Geometric standard deviation
+
ENDIF
!
DO JMODE=1,NSLTMDE
diff --git a/src/SURFEX/interpol_npts.F90 b/src/SURFEX/interpol_npts.F90
index b36f719b326260cff0a600f8f6d618ae1828c261..1cf360b69b234eae1c2ae8b35684b7c5e9589793 100644
--- a/src/SURFEX/interpol_npts.F90
+++ b/src/SURFEX/interpol_npts.F90
@@ -1,6 +1,6 @@
-!SFX_LIC Copyright 2004-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC Copyright 2004-2019 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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
SUBROUTINE INTERPOL_NPTS (UG, U, HPROGRAM,KLUOUT,KNPTS,KCODE,PX,PY,PFIELD,KNEAR_NBR)
@@ -69,7 +69,7 @@ USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
#ifdef SFX_MNH
-USE MODD_IO_ll, ONLY : ISIOP, ISP, ISNPROC
+USE MODD_IO, ONLY : ISP, ISNPROC, NIO_RANK
USE MODD_VAR_ll, ONLY : NMNH_COMM_WORLD
USE MODE_GATHER_ll
USE MODE_TOOLS_ll, ONLY : GET_GLOBALDIMS_ll
@@ -178,7 +178,7 @@ IF (IOLD==2) THEN
! on met les infos de mésonh
NRANK = ISP-1
NPROC = ISNPROC
- NPIO = ISIOP-1
+ NPIO = NIO_RANK-1
NCOMM = NMNH_COMM_WORLD
!
!KCODE to 2D
@@ -187,7 +187,7 @@ IF (IOLD==2) THEN
ISIZE_2D(1+JPHEXT:IIU+JPHEXT,1+JPHEXT:IJU+JPHEXT) = RESHAPE(KCODE, (/ IIU,IJU /) )
! tasks to whole domaine
ALLOCATE(ISIZE_2D_ALL(IIMAX+2*JPHEXT,IJMAX+2*JPHEXT))
- CALL GATHER_XYFIELD(ISIZE_2D,ISIZE_2D_ALL,ISIOP,NMNH_COMM_WORLD)
+ CALL GATHER_XYFIELD(ISIZE_2D,ISIZE_2D_ALL,NIO_RANK,NMNH_COMM_WORLD)
DEALLOCATE(ISIZE_2D)
ALLOCATE(ISIZE_TOT(IDIM_FULL))
ISIZE_TOT = RESHAPE(ISIZE_2D_ALL(1+JPHEXT:IIMAX+JPHEXT,1+JPHEXT:IJMAX+JPHEXT),(/IDIM_FULL/))
@@ -247,7 +247,7 @@ IF (IOLD==2) THEN
DEALLOCATE(INUM_1D)
! tasks to whole domaine
ALLOCATE(INUM_2D_ALL(IIMAX+2*JPHEXT,IJMAX+2*JPHEXT))
- CALL GATHER_XYFIELD(INUM_2D,INUM_2D_ALL,ISIOP,NMNH_COMM_WORLD)
+ CALL GATHER_XYFIELD(INUM_2D,INUM_2D_ALL,NIO_RANK,NMNH_COMM_WORLD)
DEALLOCATE(INUM_2D)
ALLOCATE(INUM_TOT(IDIM_FULL))
INUM_TOT = RESHAPE(INUM_2D_ALL(1+JPHEXT:IIMAX+JPHEXT,1+JPHEXT:IJMAX+JPHEXT),(/IDIM_FULL/))
@@ -263,7 +263,7 @@ IF (IOLD==2) THEN
DEALLOCATE(IINDEX_1D)
! tasks to whole domaine
ALLOCATE(IINDEX_2D_ALL(IIMAX+2*JPHEXT,IJMAX+2*JPHEXT))
- CALL GATHER_XYFIELD(IINDEX_2D,IINDEX_2D_ALL,ISIOP,NMNH_COMM_WORLD)
+ CALL GATHER_XYFIELD(IINDEX_2D,IINDEX_2D_ALL,NIO_RANK,NMNH_COMM_WORLD)
DEALLOCATE(IINDEX_2D)
ALLOCATE(IINDEX_TOT(IDIM_FULL))
IINDEX_TOT = RESHAPE(IINDEX_2D_ALL(1+JPHEXT:IIMAX+JPHEXT,1+JPHEXT:IJMAX+JPHEXT),(/IDIM_FULL/))
@@ -276,13 +276,13 @@ IF (IOLD==2) THEN
!
ZCOORD_2D = 0.
ZCOORD_2D(1+JPHEXT:IIU+JPHEXT,1+JPHEXT:IJU+JPHEXT) = RESHAPE(PX, (/ IIU,IJU /) )
- CALL GATHER_XYFIELD(ZCOORD_2D,ZCOORD_2D_ALL,ISIOP,NMNH_COMM_WORLD)
+ CALL GATHER_XYFIELD(ZCOORD_2D,ZCOORD_2D_ALL,NIO_RANK,NMNH_COMM_WORLD)
ALLOCATE(ZX(IDIM_FULL))
ZX = RESHAPE(ZCOORD_2D_ALL(1+JPHEXT:IIMAX+JPHEXT,1+JPHEXT:IJMAX+JPHEXT),(/IDIM_FULL/))
!
ZCOORD_2D = 0.
ZCOORD_2D(1+JPHEXT:IIU+JPHEXT,1+JPHEXT:IJU+JPHEXT) = RESHAPE(PY, (/ IIU,IJU /) )
- CALL GATHER_XYFIELD(ZCOORD_2D,ZCOORD_2D_ALL,ISIOP,NMNH_COMM_WORLD)
+ CALL GATHER_XYFIELD(ZCOORD_2D,ZCOORD_2D_ALL,NIO_RANK,NMNH_COMM_WORLD)
ALLOCATE(ZY(IDIM_FULL))
ZY = RESHAPE(ZCOORD_2D_ALL(1+JPHEXT:IIMAX+JPHEXT,1+JPHEXT:IJMAX+JPHEXT),(/IDIM_FULL/))
!
diff --git a/src/SURFEX/make_lcover.F90 b/src/SURFEX/make_lcover.F90
index b793379d7d7857ca86534958f13e9dd05f365c6c..32d01144b21e93409c23bb608fc63bf8661fc93e 100644
--- a/src/SURFEX/make_lcover.F90
+++ b/src/SURFEX/make_lcover.F90
@@ -1,6 +1,6 @@
-!SFX_LIC Copyright 1997-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC Copyright 1997-2019 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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
@@ -46,7 +46,7 @@ USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
#ifdef SFX_MNH
-USE MODD_IO_ll, ONLY : ISIOP, ISP, ISNPROC
+USE MODD_IO, ONLY : ISP, ISNPROC, NIO_RANK
USE MODD_VAR_ll, ONLY : NMNH_COMM_WORLD
#endif
!
@@ -88,7 +88,7 @@ ICOMM_SAVE = NCOMM
! on met les infos de mésonh
NRANK = ISP-1
NPROC = ISNPROC
-NPIO = ISIOP-1
+NPIO = NIO_RANK-1
NCOMM = NMNH_COMM_WORLD
#endif
!
diff --git a/src/SURFEX/modd_megann.F90 b/src/SURFEX/modd_megann.F90
index 25702d033b72cedd26ba9206b71617c6045379fe..3f1e4e1c66ca15aaa3b303c705fc692fc5dbd184 100644
--- a/src/SURFEX/modd_megann.F90
+++ b/src/SURFEX/modd_megann.F90
@@ -26,6 +26,7 @@
!! -------------
!! 16/07/2003 (P. Tulet) restructured for externalization
!! 24/05/2017 (J. Pianezze) adaptation for SurfEx v8.0
+!! 13/02/2019 (J. Pianezze) correction for use of MEGAN
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -185,8 +186,8 @@ YMEGAN%LCONVERSION=.FALSE.
YMEGAN%NVARS3D=0
YMEGAN%N_SCON_SPC=0
YMEGAN%XDROUGHT=0.
-YMEGAN%XDAILYPAR=0.
-YMEGAN%XDAILYTEMP=0.
+YMEGAN%XDAILYPAR=150.
+YMEGAN%XDAILYTEMP=293.
YMEGAN%XMODPREC=0.
IF (LHOOK) CALL DR_HOOK("MODD_MEGAN_n:MEGAN_INIT",1,ZHOOK_HANDLE)
END SUBROUTINE MEGAN_INIT
diff --git a/src/SURFEX/modd_pgd_grid.F90 b/src/SURFEX/modd_pgd_grid.F90
index 106a7f63487970c33c1960d6dcce52b5553dfdc4..e9e91a16fee1e32e8ab3ebd7b017ba87b3e56711 100644
--- a/src/SURFEX/modd_pgd_grid.F90
+++ b/src/SURFEX/modd_pgd_grid.F90
@@ -1,6 +1,6 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC Copyright 2003-2019 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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! ##################
MODULE MODD_PGD_GRID
@@ -17,7 +17,7 @@
!! REFERENCE
!! ---------
!!
-!!
+!!
!! AUTHOR
!! ------
!! V. Masson *Meteo France*
@@ -25,6 +25,7 @@
!! MODIFICATIONS
!! -------------
!! Original 10/2003
+!! P. Wautelet 01/2019: nullify XGRID_PAR at declaration
!-------------------------------------------------------------------------------
!
IMPLICIT NONE
@@ -35,7 +36,7 @@ IMPLICIT NONE
CHARACTER(LEN=10) :: CGRID ! type of grid
INTEGER :: NL ! number of points of the surface fields
LOGICAL, DIMENSION(720,360) :: LLATLONMASK ! mask where data are to be read
-REAL, POINTER, DIMENSION(:) :: XGRID_PAR ! lits of parameters used to define the grid
+REAL, POINTER, DIMENSION(:) :: XGRID_PAR => NULL() ! list of parameters used to define the grid
INTEGER :: NGRID_PAR ! size of XGRID_PAR
REAL :: XMESHLENGTH ! average mesh length/width (decimal degre)
!
diff --git a/src/SURFEX/modd_slt_surf.F90 b/src/SURFEX/modd_slt_surf.F90
index 0ee1b2b658f75509634126c22cb7e93e5e97c9ff..5a1c91c90cb2800bcd275d326c6305d6dfc37af5 100644
--- a/src/SURFEX/modd_slt_surf.F90
+++ b/src/SURFEX/modd_slt_surf.F90
@@ -4,13 +4,18 @@
!SFX_LIC for details. version 1.
MODULE MODD_SLT_SURF
!
+! MODIFICATIONS
+!
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+
+
IMPLICIT NONE
!
REAL, PARAMETER :: XDENSITY_SLT = 2.1e3 ! [kg/m3] density of sea salt
REAL, PARAMETER :: XMOLARWEIGHT_SLT = 58.e-3 ! [kg/mol] molar weight sea salt
!
-INTEGER, PARAMETER :: NEMISMODES_MAX=3
-INTEGER, DIMENSION(NEMISMODES_MAX), PARAMETER :: JORDER_SLT=(/3,2,1/) !Dust modes in order of importance
+INTEGER, PARAMETER :: NEMISMODES_MAX=5
+INTEGER, DIMENSION(NEMISMODES_MAX), PARAMETER :: JORDER_SLT=(/1,2,3,4,5/) !Dust modes in order of importance
!Set emission related parameters
REAL,DIMENSION(NEMISMODES_MAX) :: XEMISRADIUS_INI_SLT ! number madian radius initialization for sea salt mode (um)
REAL,DIMENSION(NEMISMODES_MAX) :: XEMISSIG_INI_SLT ! dispersion initialization for sea salt mode
diff --git a/src/SURFEX/modd_sltn.F90 b/src/SURFEX/modd_sltn.F90
index 84a48d74c4c7c20da51619e79970ec1ebc6e72ad..4187b72f2450b5a50a00f2607d1ec550871476ad 100644
--- a/src/SURFEX/modd_sltn.F90
+++ b/src/SURFEX/modd_sltn.F90
@@ -10,25 +10,43 @@ MODULE MODD_SLT_n
!
!Author: Alf Grini / Pierre Tulet
!
+! MODIFICATIONS
+!
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
-!
+
TYPE SLT_t
+! ++ PIERRE / MARINE SSA DUST - MODIF ++
+! REAL, DIMENSION(:,:,:),POINTER :: XSFSLT ! Sea Salt variables to be send to output
+! -- PIERRE / MARINE SSA DUST - MODIF --
REAL,DIMENSION(:), POINTER :: XEMISRADIUS_SLT ! Number median radius for each source mode
REAL,DIMENSION(:), POINTER :: XEMISSIG_SLT ! sigma for each source mode
END TYPE SLT_t
+
+
+
+ CONTAINS
+
!
-CONTAINS
-!
+
+
+
+
SUBROUTINE SLT_INIT(YSLT)
TYPE(SLT_t), INTENT(INOUT) :: YSLT
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK("MODD_SLT_N:SLT_INIT",0,ZHOOK_HANDLE)
+! ++ PIERRE / MARINE SSA DUST - MODIF ++
+! NULLIFY(YSLT%XSFSLT)
+! -- PIERRE / MARINE SSA DUST - MODIF --
NULLIFY(YSLT%XEMISRADIUS_SLT)
NULLIFY(YSLT%XEMISSIG_SLT)
IF (LHOOK) CALL DR_HOOK("MODD_SLT_N:SLT_INIT",1,ZHOOK_HANDLE)
END SUBROUTINE SLT_INIT
-!
+
+
END MODULE MODD_SLT_n
diff --git a/src/SURFEX/modd_surf_par.F90 b/src/SURFEX/modd_surf_par.F90
index 2947cd3b09848242c0076ed458ca118df77cdd36..f38334f2d6003bdf0e8379982f11d71094f4bd59 100644
--- a/src/SURFEX/modd_surf_par.F90
+++ b/src/SURFEX/modd_surf_par.F90
@@ -33,6 +33,9 @@ MODULE MODD_SURF_PAR
!* 0. DECLARATIONS
! ------------
!
+#ifdef SFX_MNH
+USE MODD_PRECISION, ONLY: MNHREAL
+#endif
!
IMPLICIT NONE
!
@@ -43,10 +46,12 @@ INTEGER :: NBUGFIX ! bugfix number of this version
#ifndef SFX_MNH
REAL, PARAMETER :: XUNDEF = 1.E+20
#else
-#ifdef MNH_MPI_DOUBLE_PRECISION
-REAL, PARAMETER :: XUNDEF = 1.E+20! HUGE(XUNDEF) ! Z'7FFFFFFFFFFFFFFF' ! undefined value
+#if (MNH_REAL == 8)
+REAL, PARAMETER :: XUNDEF = 1.E+20_MNHREAL ! HUGE(XUNDEF) ! Z'7FFFFFFFFFFFFFFF' ! undefined value
+#elif (MNH_REAL == 4)
+REAL, PARAMETER :: XUNDEF = 1.E+9_MNHREAL ! HUGE(XUNDEF) ! Z'7FBFFFFF' ! undefined value
#else
-REAL, PARAMETER :: XUNDEF = 1.E+9 ! HUGE(XUNDEF) ! Z'7FBFFFFF' ! undefined value
+#error "Invalid MNH_REAL"
#endif
#endif
INTEGER, PARAMETER :: NUNDEF = 1E+9 ! HUGE(NUNDEF) ! undefined value
diff --git a/src/SURFEX/mode_gridtype_conf_proj.F90 b/src/SURFEX/mode_gridtype_conf_proj.F90
index ef34076286ae63ed2a5c7583305d2049e8cebae7..4e88934141e9499651e690231f105ef169a1cd4d 100644
--- a/src/SURFEX/mode_gridtype_conf_proj.F90
+++ b/src/SURFEX/mode_gridtype_conf_proj.F90
@@ -41,10 +41,11 @@ CONTAINS
!
USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
#ifdef MNH_PARALLEL
-USE MODD_VAR_ll, ONLY : NPROC, IP, MPI_PRECISION, NMNH_COMM_WORLD, YSPLITTING
USE MODD_MPIF
+use modd_precision, only: MNHREAL_MPI
USE MODE_SPLITTINGZ_ll, ONLY : LINI_PARAZ
USE MODE_TOOLS_ll, ONLY : GET_OR_ll
+USE MODD_VAR_ll, ONLY : NPROC, IP, NMNH_COMM_WORLD, YSPLITTING
#endif
!
IMPLICIT NONE
@@ -136,7 +137,7 @@ IF ( NPROC > 1 .AND. LINI_PARAZ) THEN
ENDIF
CALL MPI_ALLREDUCE(IROOT, IROOTPROC, 1, MPI_INTEGER, MPI_MIN, NMNH_COMM_WORLD, IINFO_ll)
! Then this process broadcasts the space steps in X direction in order to have the same space steps on all processes
- CALL MPI_BCAST(PGRID_PAR(9), 1, MPI_PRECISION, IROOTPROC, NMNH_COMM_WORLD, IINFO_ll)
+ CALL MPI_BCAST(PGRID_PAR(9), 1, MNHREAL_MPI, IROOTPROC, NMNH_COMM_WORLD, IINFO_ll)
!
! get the processes with IL>0 with the southmost points
CALL MPI_ALLREDUCE(IYOR, IYORMIN, 1, MPI_INTEGER, MPI_MIN, NMNH_COMM_WORLD, IINFO_ll)
@@ -147,7 +148,7 @@ IF ( NPROC > 1 .AND. LINI_PARAZ) THEN
ENDIF
CALL MPI_ALLREDUCE(IROOT, IROOTPROC, 1, MPI_INTEGER, MPI_MIN, NMNH_COMM_WORLD, IINFO_ll)
! Then this process broadcasts the space steps in Y direction in order to have the same space steps on all processes
- CALL MPI_BCAST(PGRID_PAR(10), 1, MPI_PRECISION, IROOTPROC, NMNH_COMM_WORLD, IINFO_ll)
+ CALL MPI_BCAST(PGRID_PAR(10), 1, MNHREAL_MPI, IROOTPROC, NMNH_COMM_WORLD, IINFO_ll)
ENDIF
#endif
!
diff --git a/src/SURFEX/modn_isban.F90 b/src/SURFEX/modn_isban.F90
index 7d7e5643469371159d37757c5be6ce7b04d8054c..2ea5770de36f09326b5d2219eb5302efe3a8cf43 100644
--- a/src/SURFEX/modn_isban.F90
+++ b/src/SURFEX/modn_isban.F90
@@ -1,6 +1,6 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC Copyright 2004-2019 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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
!##################
MODULE MODN_ISBA_n
@@ -27,10 +27,11 @@ MODULE MODN_ISBA_n
!!
!! MODIFICATIONS
!! -------------
-!! Original 01/2004
+!! Original 01/2004
!! Modified 08/2009 by B. Decharme : LSURF_BUDGETC for all tiles
!! Modified by A.L. Gibelin, 04/2009: add carbon spinup
!! P. Tulet & M. Leriche 06/2017 : coupling megan online
+!! P. Wautelet 01/2019: initialize XDROUGHT, XDAILYPAR, XDAILYTEMP, XMODPREC to prevent not initialized errors later on
!!
!-------------------------------------------------------------------------------
!
@@ -38,8 +39,9 @@ MODULE MODN_ISBA_n
! ------------
!
!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
+USE MODD_SURF_PAR, ONLY : XUNDEF
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE PARKIND1 , ONLY : JPRB
!
IMPLICIT NONE
!
@@ -90,10 +92,10 @@ LOGICAL :: LSURF_VARS
LOGICAL :: LCH_BIO_FLUX
LOGICAL :: LSOILNOX
LOGICAL :: LCH_NO_FLUX
-REAL :: XDROUGHT
-REAL :: XDAILYPAR
-REAL :: XDAILYTEMP
-REAL :: XMODPREC
+REAL :: XDROUGHT = XUNDEF
+REAL :: XDAILYPAR = XUNDEF
+REAL :: XDAILYTEMP = XUNDEF
+REAL :: XMODPREC = XUNDEF
LOGICAL :: LGLACIER
LOGICAL :: LVEGUPD
LOGICAL :: LNITRO_DILU
diff --git a/src/SURFEX/modn_slt.F90 b/src/SURFEX/modn_slt.F90
index 44a889c3f838d35db853431031274e7c30b52680..091c4e400dd9203e36752aa5084e7f688cc20846 100644
--- a/src/SURFEX/modn_slt.F90
+++ b/src/SURFEX/modn_slt.F90
@@ -20,10 +20,11 @@
!! MODIFICATIONS
!! -------------
!! Original 24/02/05
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
!!
!! IMPLICIT ARGUMENTS
!! ------------------
-USE MODD_SLT_SURF, ONLY : CEMISPARAM_SLT
+USE MODD_SLT_SURF
!!
!-----------------------------------------------------------------------------
!
@@ -32,7 +33,6 @@ USE MODD_SLT_SURF, ONLY : CEMISPARAM_SLT
IMPLICIT NONE
SAVE
NAMELIST /NAM_SURF_SLT/ &
- CEMISPARAM_SLT !Parameterization type
-
+ CEMISPARAM_SLT, LVARSIG_SLT, LRGFIX_SLT, JPMODE_SLT !Parameterization type
!
END MODULE MODN_SLT
diff --git a/src/SURFEX/prep_grib_grid.F90 b/src/SURFEX/prep_grib_grid.F90
index 9461f2e4015f0d8afca12bdcadf43e548b8f9ab1..de1b379580cd645f181c31d7183c6667fa425616 100644
--- a/src/SURFEX/prep_grib_grid.F90
+++ b/src/SURFEX/prep_grib_grid.F90
@@ -115,8 +115,6 @@ INTEGER :: JLOOP1 ! Dummy counter
!JUAN
!JUAN
INTEGER :: INFOMPI, J
-INTEGER(KIND=kindOfInt),DIMENSION(:),ALLOCATABLE :: INLO_GRIB ! Number of points along a parallel
-
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -495,7 +493,7 @@ SELECT CASE (HGRIDTYPE)
CALL GRIB_IS_MISSING(IGRIB,'pl',IMISSING,IRET)
IF (IRET == 0 .OR. IMISSING/=1) THEN ! quasi-regular
CALL GRIB_GET(IGRIB,'pl',ININLO_GRIB)
- XILO2=360.-360./(MAXVAL(INLO_GRIB))
+ XILO2=360.-360./(MAXVAL(ININLO_GRIB))
print*,"XILO2=",XILO2
ENDIF
DEALLOCATE(ININLO_GRIB)
diff --git a/src/SURFEX/prep_sst_init.F90 b/src/SURFEX/prep_sst_init.F90
index 3e4b1bfdf84a165cf5fd78018b72bb85d3428d89..d2dd441b4d71af1447a9b5907518ae7d851344d9 100644
--- a/src/SURFEX/prep_sst_init.F90
+++ b/src/SURFEX/prep_sst_init.F90
@@ -36,6 +36,7 @@
!! MODIFICATIONS
!! -------------
!! Original 09/2007
+!! J.Escobar 03/2019 correction for only 1 file of SST
!!
!-------------------------------------------------------------------------------
!
@@ -80,33 +81,38 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!
IF (LHOOK) CALL DR_HOOK('PREP_SST_INIT',0,ZHOOK_HANDLE)
-LOOP: DO JI = DTS%NTIME-1,1,-1
- KSX = JI
- IF (.NOT.TEMPORAL_LTS(TPTIME,DTS%TDATA_SST(KSX))) EXIT LOOP
- ENDDO LOOP
-
-IF ( TEMPORAL_LTS ( TPTIME, DTS%TDATA_SST(KSX) ) ) THEN
- ZSST(:) = DTS%XDATA_SST(:,KSX)
-ELSE IF ( .NOT. TEMPORAL_LTS ( TPTIME, DTS%TDATA_SST(DTS%NTIME) ) ) THEN
- ZSST(:) = DTS%XDATA_SST(:,DTS%NTIME)
+ IF ( DTS%NTIME ==1 ) THEN
+ ! only one value, take this
+ KSX = 1
+ ZSST(:) = DTS%XDATA_SST(:,DTS%NTIME)
ELSE
+ LOOP: DO JI = DTS%NTIME-1,1,-1
+ KSX = JI
+ IF (.NOT.TEMPORAL_LTS(TPTIME,DTS%TDATA_SST(KSX))) EXIT LOOP
+ ENDDO LOOP
+
+ IF ( TEMPORAL_LTS ( TPTIME, DTS%TDATA_SST(KSX) ) ) THEN
+ ZSST(:) = DTS%XDATA_SST(:,KSX)
+ ELSE IF ( .NOT. TEMPORAL_LTS ( TPTIME, DTS%TDATA_SST(DTS%NTIME) ) ) THEN
+ ZSST(:) = DTS%XDATA_SST(:,DTS%NTIME)
+ ELSE
- CALL TEMPORAL_DISTS ( DTS%TDATA_SST(KSX+1)%TDATE%YEAR,DTS%TDATA_SST(KSX+1)%TDATE%MONTH, &
- DTS%TDATA_SST(KSX+1)%TDATE%DAY ,DTS%TDATA_SST(KSX+1)%TIME, &
- DTS%TDATA_SST(KSX)%TDATE%YEAR,DTS%TDATA_SST(KSX)%TDATE%MONTH, &
- DTS%TDATA_SST(KSX)%TDATE%DAY ,DTS%TDATA_SST(KSX)%TIME, &
- ZSDTJX )
+ CALL TEMPORAL_DISTS ( DTS%TDATA_SST(KSX+1)%TDATE%YEAR,DTS%TDATA_SST(KSX+1)%TDATE%MONTH, &
+ DTS%TDATA_SST(KSX+1)%TDATE%DAY ,DTS%TDATA_SST(KSX+1)%TIME, &
+ DTS%TDATA_SST(KSX)%TDATE%YEAR,DTS%TDATA_SST(KSX)%TDATE%MONTH, &
+ DTS%TDATA_SST(KSX)%TDATE%DAY ,DTS%TDATA_SST(KSX)%TIME, &
+ ZSDTJX )
- CALL TEMPORAL_DISTS ( TPTIME%TDATE%YEAR ,TPTIME%TDATE%MONTH, &
- TPTIME%TDATE%DAY ,TPTIME%TIME, &
- DTS%TDATA_SST(KSX)%TDATE%YEAR,DTS%TDATA_SST(KSX)%TDATE%MONTH, &
- DTS%TDATA_SST(KSX)%TDATE%DAY ,DTS%TDATA_SST(KSX)%TIME, &
- ZDT )
-!
- ZALPHA = ZDT / ZSDTJX
-!
- ZSST(:)= DTS%XDATA_SST(:,KSX)+(DTS%XDATA_SST(:,KSX+1)-DTS%XDATA_SST(:,KSX))*ZALPHA
-
+ CALL TEMPORAL_DISTS ( TPTIME%TDATE%YEAR ,TPTIME%TDATE%MONTH, &
+ TPTIME%TDATE%DAY ,TPTIME%TIME, &
+ DTS%TDATA_SST(KSX)%TDATE%YEAR,DTS%TDATA_SST(KSX)%TDATE%MONTH, &
+ DTS%TDATA_SST(KSX)%TDATE%DAY ,DTS%TDATA_SST(KSX)%TIME, &
+ ZDT )
+ !
+ ZALPHA = ZDT / ZSDTJX
+ !
+ ZSST(:)= DTS%XDATA_SST(:,KSX)+(DTS%XDATA_SST(:,KSX+1)-DTS%XDATA_SST(:,KSX))*ZALPHA
+ END IF
END IF
PSST(:) = ZSST(:)
diff --git a/src/SURFEX/writesurf_pgd_isba_parn.F90 b/src/SURFEX/writesurf_pgd_isba_parn.F90
index 381db556ad47e7faa8e5ad7812fa8d1da9a69782..5b9fa2248459c712aa784d36c00259ec1b9ff934 100644
--- a/src/SURFEX/writesurf_pgd_isba_parn.F90
+++ b/src/SURFEX/writesurf_pgd_isba_parn.F90
@@ -1,6 +1,6 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC Copyright 2003-2019 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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
SUBROUTINE WRITESURF_PGD_ISBA_PAR_n (HSELECT, DTV, HPROGRAM)
@@ -35,6 +35,7 @@
!! Original 01/2003
!! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -499,6 +500,7 @@ 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='-')
@@ -513,6 +515,7 @@ DO JV=1,DTV%NVEGTYPE
ENDIF
ENDDO
DEALLOCATE(ZWORK)
+END IF
!
YRECFM='L_H_TREE'
YCOMMENT=YRECFM
diff --git a/src/configure b/src/configure
index 5e3eadf2e27de4560c56b8fe89f5ab92c4f2521c..06328f15970bf4de1132717556e2b53a4cc1f0ee 100755
--- a/src/configure
+++ b/src/configure
@@ -9,12 +9,13 @@ if [ "x$XYZ" = "x" ]
then
#
export VERSION_MASTER=${VERSION_MASTER:-MNH-V5-4}
-export VERSION_BUG=${VERSION_BUG:-1}
+export VERSION_BUG=${VERSION_BUG:-2}
export VERSION_XYZ=${VERSION_XYZ:-${VERSION_MASTER}-${VERSION_BUG}${VER_OASIS:+-${VER_OASIS}}}
-export VERSION_DATE=${VERSION_DATE:-"dd/mm/yyyy"}
+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_GRIBAPI=${VERSION_GRIBAPI:-"1.26.0-Source"}
export MNH_INT=${MNH_INT:-"4"}
@@ -54,6 +55,9 @@ module purge
module load intel/17.0 intelmpi/2017.2.174
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 !!!
+export CC=gcc
+export I_MPI_CC=gcc
"}
;;
'Linux service'*)
@@ -186,10 +190,9 @@ module load ga/\${VER_GA}
export MVWORK=${MVWORK:-YES}
export VER_CDF=${VER_CDF:-CDFAUTO}
export MNHENV=${MNHENV:-"
-#export OBJDIR_PATH=$WORKDIR/DIR_OBJ_ADA
-export MP_MPILIB=pempi
+#export MP_MPILIB=pempi
module purge
-module load intel/2013.1
+module load intel/2018.2
"}
;;
AIX*)
@@ -256,6 +259,7 @@ module rm grib_api eccodes
prgenvswitchto intel
module rm intel
module load intel/17.0.3.053
+export CC=gcc
"}
fi
fi
@@ -444,7 +448,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}${VER_USER:+-${VER_USER}}-${VER_MPI}-${OPTLEVEL}
+XYZ=${ARCH}-R${MNH_REAL}I${MNH_INT}-${VERSION_XYZ}${MNH_ECRAD:+-ECRAD}${MNH_FOREFIRE:+-FF}${VER_USER:+-${VER_USER}}-${VER_MPI}-${OPTLEVEL}
cp profile_mesonh profile_mesonh-${XYZ}
#
# Do some post-install stuff
@@ -481,6 +485,7 @@ 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-fortran-${VERSION_CDFF} ] && tar xvfz netcdf-fortran-${VERSION_CDFF}.tar.gz )
fi
#
diff --git a/src/job_make_examples_BG b/src/job_make_examples_BG
index a6d8d05185674070ba868f99adc46b495c18513a..3c126674242029a00049b6789ead6dce369308a0 100755
--- a/src/job_make_examples_BG
+++ b/src/job_make_examples_BG
@@ -1,6 +1,6 @@
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
#MNH_LIC for details. version 1.
# @ job_name =Examples_MNH
# @ job_type = BLUEGENE
@@ -18,7 +18,7 @@
set -x
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-BG-R8I4-MNH-V5-4-1-MPIAUTO-O2
+. ../conf/profile_mesonh-BG-R8I4-MNH-V5-4-2-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 881f6a9472f573fad86921bdae08f0d5874eda35..5b0bf5246a5d019fffc5dfdb5fafca2b802d4768 100755
--- a/src/job_make_examples_BGQ
+++ b/src/job_make_examples_BGQ
@@ -1,4 +1,4 @@
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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.
@@ -18,7 +18,7 @@
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-BGQ-R8I4-MNH-V5-4-1-MPIAUTO-O2NAN
+. ../conf/profile_mesonh-BGQ-R8I4-MNH-V5-4-2-MPIAUTO-O2NAN
set -x
diff --git a/src/job_make_examples_BullX b/src/job_make_examples_BullX
index 549491030b424cc5101fd53bf19f3df19c9aa607..6e53b1a9b2257a6da3a8043f3244934822154073 100755
--- a/src/job_make_examples_BullX
+++ b/src/job_make_examples_BullX
@@ -1,5 +1,5 @@
#!/bin/bash
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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.
@@ -19,7 +19,7 @@ set -e
hostname
# Echo des commandes
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-4-1-MPIINTEL-O3
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-4-2-MPIINTEL-O3
export MONORUN="Mpirun -np 1 "
export MPIRUN="Mpirun -np 2 "
export POSTRUN="time "
diff --git a/src/job_make_examples_BullX_irene b/src/job_make_examples_BullX_irene
index bea1188e9fa1c440b3269614cf46c4057a694f72..6e0f0f1f59d713780ab529e523a4b2cdba1e6f87 100755
--- a/src/job_make_examples_BullX_irene
+++ b/src/job_make_examples_BullX_irene
@@ -21,7 +21,7 @@ set +x
# Nom de la machine
hostname
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-4-1-MPIINTEL-O2
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-4-2-MPIINTEL-O2
set -x
diff --git a/src/job_make_examples_BullX_occigen b/src/job_make_examples_BullX_occigen
index f8d5e7c0fc6f048e10e0f80e61d5ba9609e154e0..b5f60e5f497a312918e32ff519ac0f883eccdddf 100755
--- a/src/job_make_examples_BullX_occigen
+++ b/src/job_make_examples_BullX_occigen
@@ -18,7 +18,7 @@ set -x
# Nom de la machine
hostname
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-4-1-MPIINTEL-O2
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-4-2-MPIINTEL-O2
export MONORUN="Mpirun -prepend-rank -np 1 "
export MPIRUN="Mpirun -prepend-rank -np 4 "
export POSTRUN="time "
diff --git a/src/job_make_examples_BullX_eos b/src/job_make_examples_BullX_olympe
similarity index 97%
rename from src/job_make_examples_BullX_eos
rename to src/job_make_examples_BullX_olympe
index 79c7e02e43b098ac44b48df1a085eb745fc87122..d0c38777382dcbab8a12396a468a46c1ab732dd0 100755
--- a/src/job_make_examples_BullX_eos
+++ b/src/job_make_examples_BullX_olympe
@@ -17,7 +17,7 @@ set -x
# Nom de la machine
hostname
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-4-1-MPIINTEL-O2
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-4-2-MPIINTEL-O2
export MONORUN="mpirun -prepend-rank -np 1 "
export MPIRUN="mpirun -prepend-rank -np 4 "
export POSTRUN="time "
diff --git a/src/job_make_examples_CRAY_cca b/src/job_make_examples_CRAY_cca
index 51609eb9801208ba57530efdeaa4814d12185f47..f4c87e365bc013585f8f1f738e68128bf72762ac 100755
--- a/src/job_make_examples_CRAY_cca
+++ b/src/job_make_examples_CRAY_cca
@@ -1,5 +1,5 @@
#!/bin/bash
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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.
@@ -28,7 +28,7 @@ cd ${PBS_O_WORKDIR}
ARCH=LXifort
#ARCH=LXcray
-. ../conf/profile_mesonh-${ARCH}-R8I4-MNH-V5-4-1-MPICRAY-O2
+. ../conf/profile_mesonh-${ARCH}-R8I4-MNH-V5-4-2-MPICRAY-O2
export MONORUN="aprun -n 1 "
diff --git a/src/job_make_examples_IBM_ada b/src/job_make_examples_IBM_ada
index 1dda93499733b1e16b67c7c4efadd636d8e953a5..43e1d73e003014dfaec460bb66a9a7af339446de 100755
--- a/src/job_make_examples_IBM_ada
+++ b/src/job_make_examples_IBM_ada
@@ -1,11 +1,11 @@
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
#MNH_LIC for details. version 1.
# Nom arbitraire du travail LoadLeveler
# @ job_name = Sortie_examples_ada
# Type de travail
-# @ job_type = parallel
+# @ job_type = mpich
# Fichier de sortie standard du travail
# @ output = $(job_name).$(jobid)
# Fichier de sortie d'erreur du travail
@@ -14,25 +14,22 @@
# @ wall_clock_limit = 3600
# Nombre de processus demande (ici 1)
# @ total_tasks = 4
-# @ environment = $DISPLAY
+# @ environment = NB_TASKS=$(total_tasks)
# @ queue
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-4-1-MPIINTEL-O2
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-4-2-MPIINTEL-O2
# Pour avoir l'echo des commandes
set -x
#001_2Drelief 002_3Drelief 003_KW78 004_Reunion 007_16janvier
-export MONORUN="Poe -world_sizes 1 "
-export MPIRUN="Poe -world_sizes 4 "
+export MONORUN="Mpirun -np 1 "
+export MPIRUN="Mpirun -prepend-rank -np $NB_TASKS "
export POSTRUN=" echo "
-export MP_MPILIB=pempi
-export MP_LABELIO=yes
-
time make -k 001_2Drelief
time make -k 002_3Drelief
time make -k 003_KW78
@@ -48,4 +45,3 @@ make -k << EOF
EOF
#
-
diff --git a/src/job_make_examples_IBM_sp6_vargas b/src/job_make_examples_IBM_sp6_vargas
index ef733d1689f9cc04d8feb7bc467460cdeb71beb8..8305c3663166ae8de3a6d8c1a530a6212ca4eaca 100755
--- a/src/job_make_examples_IBM_sp6_vargas
+++ b/src/job_make_examples_IBM_sp6_vargas
@@ -1,4 +1,4 @@
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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.
@@ -24,7 +24,7 @@
set -x
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-4-1-MPIAUTO-O2
+. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-4-2-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 6f2c720d9ff70646fe769e41a3eec505cb675be7..fb3a805c0b146a3298f317bb36a053da853fe468 100755
--- a/src/job_make_examples_NEC_SX8
+++ b/src/job_make_examples_NEC_SX8
@@ -1,4 +1,4 @@
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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.
@@ -18,7 +18,7 @@ hostname
[ -d $PBS_O_WORKDIR ] && cd $PBS_O_WORKDIR
#
-. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-4-1-MPIAUTO-O4
+. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-4-2-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 7580cab3983e2108656f8edb1041f243c74ca75f..de30324180c9cfed2e7d48a28b12cd9304dc6c2c 100755
--- a/src/job_make_examples_SX8
+++ b/src/job_make_examples_SX8
@@ -1,4 +1,4 @@
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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.
@@ -19,7 +19,7 @@ hostname
[ -d $PBS_O_WORKDIR ] && cd $PBS_O_WORKDIR
#
-. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-4-1-MPIAUTO-O2
+. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-4-2-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 ef7f3eef6555bb4e985ee04775c90417e5959a60..f27bea4fbabebbee2a9f2db0497c3428187da7bf 100755
--- a/src/job_make_examples_cxa
+++ b/src/job_make_examples_cxa
@@ -1,4 +1,4 @@
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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.
@@ -34,7 +34,7 @@ echo SHELL=$SHELL
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-4-1-MPIAUTO-O2
+. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-4-2-MPIAUTO-O2
ulimit -c 0 # pas de core
diff --git a/src/job_make_mesonh_BG b/src/job_make_mesonh_BG
index d6b565eb720d31e11e6eee074f95173bae151499..5b7a12e9d58ea8d185774eece6ce8486e64066d3 100755
--- a/src/job_make_mesonh_BG
+++ b/src/job_make_mesonh_BG
@@ -1,4 +1,4 @@
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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.
@@ -18,7 +18,7 @@
set -x
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-BG-R8I4-MNH-V5-4-1-MPIAUTO-O2
+. ../conf/profile_mesonh-BG-R8I4-MNH-V5-4-2-MPIAUTO-O2
#time gmake
time gmake -r -j8
diff --git a/src/job_make_mesonh_BGQ b/src/job_make_mesonh_BGQ
index 0908269206a5c674c4b03385dbaab9a52702ae80..6a8dd4cd7866686189d88ce096466b5229767307 100755
--- a/src/job_make_mesonh_BGQ
+++ b/src/job_make_mesonh_BGQ
@@ -1,4 +1,4 @@
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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.
@@ -34,7 +34,7 @@ set -x
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-BGQ-R8I4-MNH-V5-4-1-MPIAUTO-O2NAN
+. ../conf/profile_mesonh-BGQ-R8I4-MNH-V5-4-2-MPIAUTO-O2NAN
case $LOADL_STEP_NAME in
diff --git a/src/job_make_mesonh_BullX b/src/job_make_mesonh_BullX
index 50986a320c58c945abe36856ef465fb8c3c98fb7..0af2e224427ab5a5873e8a65c32e6d52186e746c 100755
--- a/src/job_make_mesonh_BullX
+++ b/src/job_make_mesonh_BullX
@@ -1,5 +1,5 @@
#!/bin/bash
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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.
@@ -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-1-MPIINTEL-O3
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-4-2-MPIINTEL-O3
time gmake -j 4
time gmake -j 1 installmaster
diff --git a/src/job_make_mesonh_CRAY_cca b/src/job_make_mesonh_CRAY_cca
index 9caef0f66285fff4b592d4ebe7863b343379a0db..1b4de21e1cb8b98a69e7e06b20a2d95590afef7a 100755
--- a/src/job_make_mesonh_CRAY_cca
+++ b/src/job_make_mesonh_CRAY_cca
@@ -1,5 +1,5 @@
#!/bin/bash
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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.
@@ -21,7 +21,7 @@ pwd
ARCH=LXifort
#ARCH=LXcray
-. ../conf/profile_mesonh-${ARCH}-R8I4-MNH-V5-4-1-MPICRAY-O2
+. ../conf/profile_mesonh-${ARCH}-R8I4-MNH-V5-4-2-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_IBM_ada b/src/job_make_mesonh_IBM_ada
index 45fbde3d03cef0adbf2dce6f23c4a22c6f922ded..4d64ed118d6792c9582d6ae47500e5dc1d14af48 100755
--- a/src/job_make_mesonh_IBM_ada
+++ b/src/job_make_mesonh_IBM_ada
@@ -1,4 +1,4 @@
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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.
@@ -16,7 +16,7 @@
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-4-1-MPIINTEL-O2
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-4-2-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 efb71b6d4be63b057b2a6fcde7926d7b80c49b49..e8f11ad2743ab1306334ca7dca7c86c934f88cae 100755
--- a/src/job_make_mesonh_IBM_sp6_vargas
+++ b/src/job_make_mesonh_IBM_sp6_vargas
@@ -1,4 +1,4 @@
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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.
@@ -24,7 +24,7 @@
set -x
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-4-1-MPIAUTO-O2
+. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-4-2-MPIAUTO-O2
time gmake -j1 gribapi
time gmake -r -j8
diff --git a/src/job_make_mesonh_MFSX8 b/src/job_make_mesonh_MFSX8
index f8bb0e308eb189c4597140ea014095a40b55a046..c1e15619bbad5f99d0e9f9e531ebd76523d5f872 100644
--- a/src/job_make_mesonh_MFSX8
+++ b/src/job_make_mesonh_MFSX8
@@ -1,4 +1,4 @@
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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.
@@ -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-1-MPIAUTO-O4
+. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-4-2-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 095159b3d60c21b0f772be0e5ef79d28fe921742..d8664fc0532a4602f35a951005a2fe7e94ae3da4 100755
--- a/src/job_make_mesonh_NEC_SX8
+++ b/src/job_make_mesonh_NEC_SX8
@@ -1,4 +1,4 @@
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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.
@@ -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-1-MPIAUTO-O4
+. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-4-2-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 69ff158751e074abd06fec6fa10045dadccb37c2..ad5b3a85872bff807991682be89249424f23f0b5 100755
--- a/src/job_make_mesonh_cxa
+++ b/src/job_make_mesonh_cxa
@@ -1,4 +1,4 @@
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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.
@@ -27,7 +27,7 @@
set -x
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-4-1-MPIAUTO-O2
+. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-4-2-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 0ef248049543e665afb9a691969bcd47b7255b9a..324daaf557e995b4e560308a52b1b820d30cad6e 100755
--- a/src/job_make_mesonh_user_BullX
+++ b/src/job_make_mesonh_user_BullX
@@ -1,5 +1,5 @@
#!/bin/bash
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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.
@@ -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-1-${VER_USER}-MPIINTEL-O3
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-4-2-${VER_USER}-MPIINTEL-O3
time gmake user
time gmake -j 1 installuser
diff --git a/src/job_make_mesonh_user_MFSX8 b/src/job_make_mesonh_user_MFSX8
index 4766235b65434a76555fc04803c7a10fb737cf73..407073d7ec4a6023b5a6b2aab6df09d375e2cadc 100644
--- a/src/job_make_mesonh_user_MFSX8
+++ b/src/job_make_mesonh_user_MFSX8
@@ -1,6 +1,6 @@
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
#MNH_LIC for details. version 1.
#PBS -q compile # obligatoire pour rester sur la frontale TX-7
#PBS -l cputim_prc=36000 # temps CPU par processus (défaut 30mn, max 5h)
@@ -14,7 +14,7 @@ set -x
[ ${PBS_O_WORKDIR} ] && cd ${PBS_O_WORKDIR}
-. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-4-1-${VER_USER}-MPIAUTO-O4
+. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-4-2-${VER_USER}-MPIAUTO-O4
time gmake user
time gmake -j 1 installuser