Skip to content
Snippets Groups Projects

Compare revisions

Changes are shown as if the source revision was being merged into the target revision. Learn more about comparing revisions.

Source

Select target project
No results found

Target

Select target project
  • mesonh/mesonh-code
  • quentin.rodier/mesonh-code-fork
  • benoit.vie/mesonh-code
  • joris.pianezze/mesonh-code
  • 8qq4g5s7/mesonh-code
  • jean.baptiste.filippi/meso-nh-fire-code
  • fdl68d9p/mesonh-code-sophia
7 results
Show changes
Commits on Source (4177)
4,077 additional commits have been omitted to prevent performance issues.
Hide whitespace changes
Inline Side-by-side
Showing
with 2310 additions and 2206 deletions
.gitattributes
View file @ 6bb35ca8
* text=auto
*.tar filter=lfs diff=lfs merge=lfs -crlf
*.tar.gz filter=lfs diff=lfs merge=lfs -crlf
*/ecmwf.OD* filter=lfs diff=lfs merge=lfs -crlf
......
.gitignore
View file @ 6bb35ca8
conf/profile_mesonh
conf/profile_mesonh-*
pub/ncl_ncarg*/
exe/*
MY_RUN/INTEGRATION_CASES/**/*.des
MY_RUN/INTEGRATION_CASES/**/*.dir
MY_RUN/INTEGRATION_CASES/**/*.hdr
MY_RUN/INTEGRATION_CASES/**/*.nc
MY_RUN/INTEGRATION_CASES/**/ecmwf.OD.????????.??
MY_RUN/INTEGRATION_CASES/**/file_for_xtransfer
MY_RUN/INTEGRATION_CASES/**/OUTPUT_LISTING*
MY_RUN/INTEGRATION_CASES/**/PRESSURE
MY_RUN/KTEST/*/*/*.des
MY_RUN/KTEST/*/*/*.lfi
MY_RUN/KTEST/*/*/*.nc
MY_RUN/KTEST/*/*/dir.??????:??:??
MY_RUN/KTEST/*/*/dir_save
MY_RUN/KTEST/*/*/dirconv
MY_RUN/KTEST/*/*/dirextract
MY_RUN/KTEST/*/*/ecmwf.OD.????????.??
MY_RUN/KTEST/*/*/file_for_xtransfer
MY_RUN/KTEST/*/*/gmeta
MY_RUN/KTEST/*/*/gtopo30.*
MY_RUN/KTEST/*/*/CLAY_HWSD_MOY.*
MY_RUN/KTEST/*/*/DATA?1
MY_RUN/KTEST/*/*/ECOCLIMAP_v2.0.*
MY_RUN/KTEST/*/*/FICJD
MY_RUN/KTEST/*/*/LISTING_DIA
MY_RUN/KTEST/*/*/OUT_DIA
MY_RUN/KTEST/*/*/OUTPUT_LISTING*
MY_RUN/KTEST/*/*/PRESSURE
MY_RUN/KTEST/*/*/REMAP*FFT*
MY_RUN/KTEST/*/*/SAND_HWSD_MOY.*
MY_RUN/KTEST/*/*/output_save*
MY_RUN/KTEST/*/*/pipe_name
MY_RUN/KTEST/*/*/gshhs(?).rim
MY_RUN/KTEST/*/*/gshhs(?).zip
MY_RUN/KTEST/*/*/rangs(?).cat
MY_RUN/KTEST/*/*/rangs(?).cel
MY_RUN/KTEST/*/*/rangs(?).zip
MY_RUN/KTEST/*/*/visu*.png
MY_RUN/KTEST/*/*/zsection*.png
MY_RUN/KTEST/007_16janvier/012_spectre/spectra_16JAN.1.12B18.001_*
MY_RUN/KTEST/009_ICARTT/001_pgd1/*.asc
MY_RUN/KTEST/009_ICARTT/002_arp2lfi/ecmwf.OD.20040810.18-V2
MY_RUN/KTEST/009_ICARTT/002_arp2lfi/mocage.GLOB22.20040810.18
MY_RUN/KTEST/9??_*
pub/FILEPP/filepp*
!pub/FILEPP/filepp*.tar.gz
pub/FILEPP/FILEPP*
pub/FILEPP/MNH_Expand_*
!pub/FILEPP/MNH_EXPAND_*.tar.gz
src/dir_obj-*
src/LIB/eccodes*
!src/LIB/eccodes*.tar.gz
src/LIB/grib_api*
!src/LIB/grib_api*.tar.gz
src/LIB/hdf5*
!src/LIB/hdf5*.tar.gz
src/LIB/libaec*
!src/LIB/libaec*.tar.gz
src/LIB/netcdf*
!src/LIB/netcdf*.tar.gz
src/LIB/MEGAN*
src/LIB/oasis3-mct*
!src/LIB/oasis3-mct*.tar.gz
src/LIB/toy*
!src/LIB/toy*.tar.gz
vscode_mod
A-INSTALL
View file @ 6bb35ca8
#
# Version of PACKAGE MESONH "Open distribution"
# PACK-MNH-V5-2-1
# DATE : 02/05/2016
# VERSION : MESONH MASDEV5_2 + BUG-1
# PACK-MNH-V5-7-1
# DATE : 04/09/2024
# VERSION : MESONH MASDEV5_7 + BUG-1
#
# MAP
#
# 0) TWO WAYS OF DOWNLOADING MESONH
# I-A) DOWNLOAD VIA THE WEB MESONH HOME PAGE
# I-B) DOWNLOAD VIA CVS ANONYMOUS
# I-B) DOWNLOAD VIA GIT ANONYMOUS
# II) CONFIGURING THE MESONH PACKAGE
# III) COMPILING/INSTALLING THE MESONH PACKAGE ON YOUR LINUX COMPUTER
# IV) RUN SOME "SMALL KTEST" EXAMPLES
# V) RECOMPILING YOUR 'OWN' SOURCES ONLY
# VI) COMPILING/INSTALLING MESONH ON GENCI & ECMWF & METEO COMPUTERS
# VI) COMPILING/INSTALLING MESONH ON GENCI & ECMWF & METEO & CALMIP COMPUTERS
# VII) "SCANDOLLAR" = SCRIPTING YOUR OWN PROCEDURES
#
# VIII) TROUBLE-SHOOTING
......@@ -21,19 +21,25 @@
# b) Compiler bug with "ifort 10.0.xxx"
#
# IX) OPTIONAL COMPILATION
# a) MNH_NCWRIT for netcdf graphic output file
# b) MNH_FOREFIRE for forefire runs ( external package needed )
# c) MNH_RTTOV for optional radiative computation
# d) cleaning previous compiled version
# a) MNH_FOREFIRE for forefire runs ( external package needed )
# b) MNH_RTTOV for optional radiative computation
# c) MNH_ECRAD for optional compilation of new ECRAD radiative library from ECMWF
# d) MNH_MEGAN for optional compilation of MEGAN
# e) cleaning previous compiled version
#
#
# NEW since MNH-56X : For conda package for graphic output in test-case examples , read
# the 'README_MNH_CONDA' file in this (root) directory
#
#
^L
# 0) TWO WAYS OF DOWNLOADING MESONH
# =================================
#
# MESONH sources and executables
# http://mesonh.aero.obs-mip.fr
# are developed and maintained with the
# CVS tools ( http://www.cvshome.org/ )
# Git tools ( https://git-scm.com/ )
#
# There are two ways to download the package of
# MESONH containing :
......@@ -47,22 +53,24 @@
# via a download of a "tar ball" in the WEB site of MESONH
#
# The second way is for USER/DEVELOPER of MESONH
# via the use of the CVS tools and an access via anonymous
# connection with "ssh" to the CVS REPOSITORY of the MESONH package
# via the use of Git and an anonymous ssh connection to the Git repository of
# the MESONH package
#
#
# REM: It is now strongly recommended, but it's not an obligation,
# for all users to use de CVS solution, because:
# REM: It is now strongly recommended, but not mandatory,
# for all users to use the Git solution, because:
#
# * It's far more easy for us ( support team ) to give you some assistance
# in case of trouble ... as the CVS tool permits us to know exactly
# in case of trouble... as Git permits us to know exactly
# what you have changed in the original PACKAGE
#
# * It's much more easy for you to update to the last version ...
# or at least see the change made for BUGFIX directly on our installation .
# * It's much more easy for you to update to the last version...
# or at least see the change made for BUGFIX directly on our
# installation.
#
#
# So here are explained the two ways <=> mutually exclusif
# Following, are presented the two mutually exclusive ways to get the MesoNH
# package:
#
#
^L
......@@ -70,194 +78,172 @@
# ==========================================
#
# With your preferred web browser go to the MESONH WEB SITE
#
#
# http://mesonh.aero.obs-mip.fr/mesonh
# ---> Download
# ---> CVS MESONH
#
# or directly
#
# http://mesonh.aero.obs-mip.fr/cgi-bin/mesonh_interne/viewcvs.cgi/MNH-VX-Y-Z
#
# in the field "Show files using tag:"
#
# ---> select "PACK-MNH-V5-2-1"
#
# and then download the file "PACK-MNH-VX-Y-Z.tar.gz" by the link
#
# --> Download tarball
# http://mesonh.aero.obs-mip.fr/mesonh/dir_open/dir_MESONH/MNH-V5-7-1.tar.gz
#
# Then untar the file "PACK-MNH-VX-Y-Z.tar.gz" where you want to,
# in your home directory for example:
# Then untar the file "MNH-V5-7-1.tar.gz" where you want to.
# For example, in your home directory:
#
cd ~
tar xvfz PACK-MNH-VX-Y-Z.tar.gz
tar xvfz MNH-V5-7-1.tar.gz
#
# As the directory did not reflect the last version name move it
# to the right one
#
mv MNH-VX-Y-Z MNH-V5-2-1
#
# Process now to the chapter to configure the MesoNH
# Process now to the chapter to configure the MesoNH package.
#
# => II) CONFIGURING THE MESONH PACKAGE
#
^L
# I-B) DOWNLOAD VIA CVS ANONYMOUS
# I-B) DOWNLOAD VIA GIT ANONYMOUS
# ===============================
#
# a) download the ssh key file "anoncvs.key" for anonymous connection
# -------------------------------------------------------------------
# a) Prerequisites
# ----------------
#
# With your preferred web browser go to the MESONH WEB SITE
#
# http://mesonh.aero.obs-mip.fr/mesonh
# ---> Download
# ---> CVS PACKAGE MESONH
# In order to clone the Meso-NH git repository that contains sources, compiled
# libraries and binary tools, the git LFS extension is required to handle
# binary (or large) files. So before starting, be sure:
#
# or directly
#
# http://mesonh.aero.obs-mip.fr/cgi-bin/mesonh_interne/viewcvs.cgi/MNH-VX-Y-Z
#
# in the field "Show files using tag:"
#
# ---> select "PACK-MNH-V5-2-1"
#
# download the file "anoncvs.key"
# * to have git v1.8.2 or higher installed on your workstation. You can run
# and check with:
git --version
# * to install the git LFS extension (not included by default in the Git
# package):
# - get the linux git-lfs archive from the "Download v1.X.Y (Linux)" link on
# the web page https://git-lfs.github.com/
# - extract the archive and copy the git-lfs binary in your $HOME/bin (the
# provided install.sh script doesn't need to be executed)
# - from any directory, you can now execute:
git lfs install
# that will set up some filters under the name "lfs" in the global Git
# config file ($HOME/.gitconfig)
#
# by :
# 1) a "left-click" in the "Rev." column
# + 2) a "right-click" on "download"
# ---> save link to disk
# (Warning :: don't copy the file content with mouse copy/past
# because it contains binary-encoded information !!!)
# b) Before cloning
# -----------------
#
# then copy this file in your "${HOME}/.ssh/" directory
# * Download the private key to access the anonymous Meso-NH Git server (read-
# only access) by following the next link:
#
# AND VERY IMPORTANT !!!
# Modify the "read/write" permission with:
#
chmod 600 anoncvs.key
http://mesonh.aero.obs-mip.fr/mesonh57/GitSources?action=AttachFile&do=get&target=anongitmesonh.key
#
# b) download the config file "config.anoncvs_www"
# ------------------------------------------------
# and save the file in your $HOME/.ssh/ directory.
#
# For METEO-FRANCE & IDRIS & CINES & Laboratoire d'Aerologie computers ( IP address filter )
# ==========================================================================================
# * Change the access permissions of the key with:
#
# download the file
chmod 600 $HOME/.ssh/anongitmesonh.key
#
# --> "config.anoncvs_www"
# * Copy/paste the following lines and add them in your $HOME/.ssh/config file
# (create the file if it is missing):
#
# Then concatened the file content with your "${HOME}/.ssh/config" file
# ( this will define the computer alias "mesonh_anoncvs_www" for future ssh
# anonymous connections )
cd ${HOME}/.ssh
cat config.anoncvs_www >> config
Host anongit_mesonh
User anongit
IdentityFile ~/.ssh/anongitmesonh.key
Hostname 195.83.22.22
Port 22222
#
# FOR OTHER COMPUTERS USE special "config.anoncvs_www"
# ===================================================
#
# if the computer, from which you download the MESONH sources,
# is external to METEO-FRANCE & IDRIS & CINES & Laboratoire d'Aerologie Laboratoire download this file
# Before cloning the repository, execute:
#
# --> "config.anoncvs_www_ext"
cd ${HOME}/.ssh
cat config.anoncvs_www_ext >> config
git config --global http.sslverify false
#
# OR for ECMWF computer ( cca ) download this config file
# ( to bypass the gateway filter )
# This is necessary to disable the certificate checks because a self-signed
# certificate was used for the LFS server.
#
# --> "config.anoncvs_www_ecmwf"
# c) Cloning the Meso-NH Source repository on the developpement branch MNH-57-branch
# ----------------------------------------------------------------------------------
#
# Finally you can clone the Meso-NH Git repository with the following command:
#
cd ${HOME}/.ssh
cat config.anoncvs_www_ecmwf >> config
git clone anongit@anongit_mesonh:/gitrepos/MNH-git_open_source-lfs.git -b MNH-57-branch MNH-V5-7-1
#
# c) Setting CVS variables
# ------------------------
# that will create the MNH-V5-7-1 directory containing a clone (copy) of the
# Meso-NH package on the remote developpement branch MNH-57-branch
#
# set the CVS_RSH et CVSROOT like this
# ( in your ".profile" or ".bashrc" file )
#
export CVS_RSH=ssh
export CVSROOT=:ext:mesonh_anoncvs_www:/home/cvsroot
# d) Checking out a given version of MESONH
# -----------------------------------------
#
# Once the repository is cloned, it's better for you to checkout your own branch
# (by default, you are on HEAD of the MNH-57-branch development branch ).
#
# c) Checking out the "MESONH PACKAGE"
# -------------------------------------
# To create your local branch corresponding to the V5-7-1 version, type:
#
# Now, from your "$HOME" directory for example
# extract the version "PACK-MNH-V5-2-1"
# of the directory "MNH-VX-Y-Z" from the
# cvs repository :
cd ~
cvs co -r PACK-MNH-V5-2-1 -d MNH-V5-2-1 MNH-VX-Y-Z
cd MNH-V5-7-1
git checkout -b MYB-MNH-V5-7-1 PACK-MNH-V5-7-1
#
# WARNING : don't use a sub-directory with dot "." in the name
# ---> you could have some trouble when compiling mesonh
# MYB-MNH-V5-7-1 is the name of the local branch you created
# and
# PACK-MNH-V5-7-1 is the remote/origin tag on which it is based.
#
# this will create in your "$HOME" a directory "MNH-V5-2-1"
# which contains of the last revision named "PACK-MNH-V5-2-1"
# of the MESONH PACKAGE
# 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.
#
# 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-7-1", is announced.
#
# Suppose that a new version for example
# "PACK-MNH-V5-2-2" is announced ...
# To see the differences with your working copy, do:
#
# To see the differences with your working copy
# do
git fetch
git diff HEAD PACK-MNH-V5-7-1
#
# To go to the new version, you can, for example, create a new local branch:
#
cd ~/MNH-V5-2-1
cvs diff -r PACK-MNH-V5-2-2
git checkout -b MYB-MNH-V5-7-1 PACK-MNH-V5-7-1
#
# And to upgrade your working copy
# At any time, you can also check for "uptodate" changes in the Git branch
# dedicated to the MNH57 version before the official release of the "bugN+1"
# bugfix version.
#
cd ~/MNH-V5-2-1
cvs update -r PACK-MNH-V5-2-2 -d -P
git fetch
git diff HEAD MNH-57-branch
#
# At any time you could also check for "uptodate"
# changes in the CVS "branch" dedicated to the MNH52 version
# before the official release of the "bugN+1" bugfix
# And, test this development (not yet official) version by going to this branch:
#
cvs diff -r MNH52-BUG-branch
git checkout --track origin/MNH-57-branch
#
# An at "your own risk" update to this
# ( not yet official ) version by
# e) Cloning the Meso-NH Documentation repository
#
# In a similar fashion, you can clone the Meso-NH documentation Git repository
# with the following command:
#
git clone anongit@anongit_mesonh:/gitrepos/MNH-DOC.git
cd ~/MNH-V5-2-1
cvs update -r MNH52-BUG-branch -d -P
#
# that will create the MNH-DOC directory containing the latest LaTeX sources of
# the Meso-NH documentation.
#
# Well, the use of CVS is not under the scope of this "INSTALL" document ...
# Well, the use of git is not under the scope of this "INSTALL" document...
#
# Now go to then next chapter
# Now, go to the next chapter
#
# => II) CONFIGURING THE MESONH PACKAGE
#
......@@ -271,7 +257,7 @@ cvs update -r MNH52-BUG-branch -d -P
# use the "./configure" script like this
#
cd ~/MNH-V5-2-1/src
cd ~/MNH-V5-7-1/src
./configure
. ../conf/profile_mesonh
......@@ -279,56 +265,62 @@ cd ~/MNH-V5-2-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 & cdf library , etc ...
# 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,
# VER_MPI = version of MPi to, use
# VER_MPI = version of MPI to use ,
# OPTLEVEL =
# etc ...
# and all the other environnement variables .
# and all the other environnement variables.
#
# Be default, for an unknow computer, you will have :
# Be default, for an unknown computer, you will have:
#
# - the compiler choosen to be "gfortran" => ARCH=LXgfortran
# - the mpi library to be the MPIVIDE => VER_MPI=MPIVIDE
# ( empty mpi library coming with MESONH package = no parallel run possible )
# - the level compiler optimization => OPTLEVEL=DEBUG
# - the MPI library to be the MPIVIDE => VER_MPI=MPIVIDE
# ( empty MPI library coming with MESONH package = no parallel run possible )
# - the level of optimization for the compiler => OPTLEVEL=DEBUG
# ( for development purpose ,fast compilation & debugging )
#
# SO IF NEEDED:
# ============
# you could change the default FLAG compiler/mpi/optlevel
# you could change the default FLAG compiler/MPI/optlevel
# like this, for example
export ARCH=LXifort # Use Intel "ifort" compiler on LX=linux Plateform
export VER_MPI=MPIAUTO # Use MPI with compiler wrapper 'mpif90', for computer having this wrapper installed
export OPTLEVEL=O2 # Compile in O2 , 4 time faster then DEBUG, but least error check
export OPTLEVEL=O2 # Compile in O2, 4 times faster then DEBUG, but less error checks
./configure
# and then source/load the new generate file
. ../conf/profile_mesonh.LXifort.MNH-V5-2-1.MPIAUTO.O2
. ../conf/profile_mesonh.LXifort.MNH-V5-7-1.MPIAUTO.O2
#
# REM:
# ====
#
# - Options specific to compile/architecture, like 'OPTLEVEL' are defined inside the "Rules.${ARCH}.mk" .
# - Options specific to compiling/architecture, like 'OPTLEVEL' are defined inside the "Rules.${ARCH}.mk" .
#
# - Options specific to library like "mpi"="VER_MPI" or "cdf"="VER_CDF" are defined inside "Makefile.MESONH.mk"
#
# - If need, for adaptation to your requirement, look inside the files and changes options for your needs .
# - If needed, for adaptation to your requirements, look inside the files and changes options for your needs.
#
# - On PC-Linux, if needed , look in the "MesonhTEAM Wiki" to know how to compile the library MPI = OPEN-MPI , with MESONH
# - On PC-Linux, if needed, look at the "MesonhTEAM Wiki" to know how to compile the OpenMPI library with MESONH:
#
# http://mesonh.aero.obs-mip.fr/teamwiki/MesonhTEAMFAQ/PC_Linux
# --> Compilation of OPEN-MPI
......@@ -341,7 +333,7 @@ export OPTLEVEL=O2 # Compile in O2 , 4 time faster then DEBUG, but least
# go to the directory "src"
#
cd ~/MNH-V5-2-1/src
cd ~/MNH-V5-7-1/src
#
# if you have not already configured your MESONH environment
......@@ -362,9 +354,9 @@ cd ~/MNH-V5-2-1/src
# The compilation will take about 20 minutes on modern PC-Linux ...
#
# If you have a multi-processor machine you can speedup
# the compilation, for example, on two processors with:
# the compilation, for example on four cores, with:
(g)make -j 2
(g)make -j 4
#
#
......@@ -382,9 +374,9 @@ cd ~/MNH-V5-2-1/src
# The exact name of this "dir_obj..." depends on the different environnement
# variables set by the "profile_mesonh...." which you have loaded before the compilation.
#
# This allow by loading different "profile_mesonh.." files to compile in the same
# source/installation directory different version of MESONH , with different
# compiler, different version of MPI , different USER sources , etc ...
# This allows by loading different "profile_mesonh.." files to compile in the same
# source/installation directory different versions of MESONH , with different
# compilers, different versions of MPI, different USER sources...
#
#
# To install the new compiled program in the "$SRC_MESONH/exe"
......@@ -394,13 +386,13 @@ cd ~/MNH-V5-2-1/src
make installmaster
#
# The executable with their full name, including, $ARCH , compiler
# and MPI , level of optimization, will be linked in the "../exe" directory
# The executables with their full name, including $ARCH, compiler,
# MPI and level of optimization, will be linked in the "../exe" directory
#
# REM:
# ---
# The "make installmaster" need to be done only one time by "version" .
# If you change/add source only you have to do "make"
# The "make installmaster" need to be done only one time by "version".
# If you only change/add source, you have to do "make"
make
......@@ -408,7 +400,7 @@ make
# IV) RUN SOME "SMALL KTEST" EXAMPLES
# ===================================
#
# After compilation & installation you could run
# After compilation & installation, you could run
# some basic "KTEST" examples from the "src" directory
# by running:
......@@ -459,13 +451,13 @@ make 004_Reunion_ncl2
# Step-1 : prepare your source directory
# ---------------------------------------
#
# Put your own source in a subdirectory of "${SRC_MESONH}/src" named
# Put your own sources in a subdirectory of "${SRC_MESONH}/src" named
#
${SRC_MESONH}/src/MY_MODIF
#
# All subdirectories in "MY_MODIF" will be scanned so if you want
# All subdirectories in "MY_MODIF" will be scanned. So if you want,
# you could make a subdirectory for each component of the MESONH
# Package
#
......@@ -476,24 +468,24 @@ cp .../isba.f90 MY_MODIF/SURFEX/.
#
# /!\ WARNING :
# -------------
# - In this subdirectory put only fortran source you want to compile !!!
# Don't use it as a trash, with old sources file like 'my_source.f90.old'
# - In this subdirectory, put only fortran source you want to compile !!!
# Don't use it as a trash with old sources file like 'my_source.f90.old'
# or 'tar' files 'mysource.tar' .
# - All 'spirituous' file will confuse the 'make' commande .
# - All 'spirituous' file will confuse the 'make' command.
#
#
# Step-2 : configure/compiling with VER_USER=...
# ----------------------------------------------
#
# - Logout of the current session, to be sure to unset all the
# environnement variables load with the your 'master 'profile_mesonh'
# - Logout of the current session to be sure to unset all the
# environnement variables loaded with the your 'master 'profile_mesonh'
#
# - Login again and :
# - Login again and:
#
# - set the variable "VER_USER" with the name of your "USER VERSION",
# - set also optionnal the , ARCH, VER_MPI ,etc... , you want to use
# - set also the optional ARCH, VER_MPI... you want to use.
#
# and run again the "./configure" commande
# and run again the "./configure" command
#export ARCH=...
#export VER_MPI=...
......@@ -506,21 +498,21 @@ 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
# this will compilation Only your sources, and the files depending of your sources
# and generate the new executables in your own directory
# this will compile only your sources and the files depending on your sources
# and generate the new executables in your own directory
#
# dir_obj-$(ARCH).../${VER_USER}
#
#
# WARNING :
# ========
# before compiling your own sources be sure that these ones
# are younger than the "*.o" files of the MASTER directory
# if any doubt, at any time use the command
# Before compiling your own sources be sure that these ones
# are younger than the "*.o" files of the MASTER directory.
# If any doubt, at any time use the command
#
# touch *.f*
#
......@@ -531,25 +523,24 @@ make user
# -----------------------------
#
#
# Now if the compilatio is OK, you could to test this new version with the "make examples"
# Now if the compilation is OK, you could test this new version with the "make examples".
#
# First, install the new binaries in the '${SRC_MESONH}/exe' with
# First, install the new binaries in the '${SRC_MESONH}/exe' with
make installuser
# The "make installuser" need to be done only one time by "version" .
# The "make installuser" needs to be done only one time by "version".
#
# And run the examples, your Version should appear in the name of the executables
# used .
# And run the examples. Your version should appear in the name of the used executables.
#
make examples
^L
#
# VI) COMPILING/INSTALLING ON GENCI & ECMWF & METEO COMPUTERS
# ===========================================================
# VI) COMPILING/INSTALLING ON GENCI & ECMWF & METEO & CALMIP COMPUTERS
# ====================================================================
#
# After downloading "exactly" like on "any standalone PC"
# run the "./configure" command :
......@@ -558,123 +549,197 @@ make examples
./configure
#
# - If you do not have sufficient space in your "$HOME" directory
# - If you do not have sufficient space in your "$HOME" directory,
# install the whole package directly on the ${WORKDIR}
# /!\ the name of the WORKDIR differ in the differents computer center
# read the doc , most of them manage disk space throw 'multi-projet' with only one unique login .
#
# WARNING :
# ========
# - Think to do a backup of your installation
# - This space is not more "purged" but a "crash disk" could/will
# - This space is no "purged" but a "crash disk" could/will
# probably occur !!!
#
cd $WORKDIR
cvs co -r PACK-MNH-V5-2-1 -d MNH-V5-2-1 MNH-VX-Y-Z
cd MNH-V5-2-1/src
cd MNH-V5-7-1/src
./configure
#
# Due to limitation in time & memory on interactive connection
# then compile the MESONH PACKAGE in batch mode with the different "job_make_mesonh*" files
# in some computer you have to compile the MESONH PACKAGE in batch mode with the different "job_make_mesonh*" files
#
# at IDRIS :
# ---------
#
# - On ADA ( IBM/x3750 ) with :
# - On JEAN-ZAY ( HPE ) the compilation is in interactive :
llsubmit job_make_mesonh_IBM_ada
cd MNH-V5-7-1/src
. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-7-1-MPIINTEL-O2
make -j16 |& tee error$XYZ
make installmaster
#
#
# - On TURING (IBM BG/Q ) :
# You could also use the 'compil' partition
llsubmit job_make_mesonh_BGQ
sbatch job_make_mesonh_HPE_jeanzay
# - to run the test case examples run
sbatch -A {your_projet}@cpu job_make_examples_BullX_jeanzay
#
#
# BACKUP : /!\ backup your work on "ergon"
#
#
# at CINES on JADE( SGI/ICE ) , OCCIGEN not tested yet :
# at CINES on ADASTRA (BULLX) :
# -------------------------------------------------------
#
# - install the PACKAGE in your "/store/${USER}" directory
# - you could compile in interactive mode
# - install the PACKAGE in your $HOME ( default 50Go of quota )
# - Compile in interactive mode ( see IDRIS )
#
# BACKUP : /!\ backup your work on "/data/${USER}"
#
# - to run the test case examples run
sbatch job_make_examples_BullX_occigen
#
#
# at TGCC on IRENE (BULLX) :
# -------------------------------------------------------
#
# At TGCC , you have two architectures accessible throw 2 differents frontals
# but with a commun disk space , connect to :
#
# - ssh irene-fr : for Intel SkyLake processors
# On Intel processors the MPI use is OPENMPI/4.1.4
# the configure will generate a
# profile_mesonh-LXifort-R8I4-MNH-V5-7-1-MPIAUTO-O2
#
# - ssh irene-amd : for AMD , processors
# On AMD processors the MPI use is OPENMPI/4.1.4
# the configure will generate a
# profile_mesonh-LXifort-R8I4-MNH-V5-7-1-AMD-MPIAUTO-O2
#
# at ECMWF on cca ( CRAY/XC30 ) :
# ----------------------------
#
# - to install MESONH go to your $PERM directory
# if you need more disk space than allowed for 'standard' user
# Ask to Dominique Lucas, look this email :
# At TGCC they use 'one login' for multi-project allocation .
# This induce 'strange' problem with the installation of eccodes
# resulting in file with the wrong default group and 'disk quota excedeed' error
#
# http://mesonh.aero.obs-mip.fr/cgi-bin/mesonh_interne/mail2html.cgi?file=2009_09_24_15:31:54
# You could get your different project info by 'ccc_myproject'
#
# - for the compilation use :
qsub job_make_mesonh_CRAY_cca
# I recommand you first, supposing that the "Genci Allocation" you want to use
# as for projet group "genXXXX"
#
# 1) to add in your "~/.bash_profile"
#
module switch dfldatadir dfldatadir/genXXXX
newgrp genXXXX
# 2) "logout & login" again
# and check that you have now the good default group
#
# REM : On CRAY computer cca , the default compiler is the CRAY one = crayftn .
# I you have trouble with this one , you could compile with the Intel/ifort one .
# Use the ifort one do :
id -ng
--> genXXXX
echo $CCCHOME
--> /ccc/.../home/genXXXX/{your_login}
export ARCH=LXifort
# If all is OK, you can install the code interactively as usual
#
# - install the PACKAGE in your ${CCCHOME} ( default 20Go of quota )
# for example on Intel frontal
cd ${CCCHOME}
cd MNH-V5-7-1/src
./configure
. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-7-1-MPIAUTO-O2
make -j16 |& tee error$XYZ
make installmaster
...
# REM: The eccode lib will be installed in your ${CCCWORKDIR}
# also for the quota problem ...
#
création du fichier --> ../conf/profile_mesonh-LXifortI4-MNH-V5-2-1-MPICRAY-O2
# - to run the test case examples run
#
# On intel Skylake
ccc_msub job_make_examples_BullX_irene
# And for the compilation & example job , switch the ARCH variable to LXiort :
# On intel AMD
ccc_msub job_make_examples_BullX_irene_AMD
vi job_make_mesonh_CRAY_cca(job_make_examples_CRAY_cca)
#
# at ECMWF on hpc-login ( ATos/HPCF ) :
# ------------------------------------------
#
# - to install MESONH go to your $HPCPERM directory
#
# - for the compilation :
# after the ./configure in the login node
#
# connecte to an "interactive compute node" via ( 16 core & 16GO of memory
ARCH=LXifort
#ARCH=LXcray # this is the default one
. ../conf/profile_mesonh-${ARCH}I4-MNH-V5-2-1-MPICRAY-O2
ecinteractive -c16 -m 16G -t 12:00:00
etc ...
# - to run the test case examples run
sbatch job_make_examples_Atos_HPCF
#
# EXAMPLES ON GENCI & ECMWF PLATFORMS
# ====================================
# - At Meteo-France DSI on belenos
#
# - At IDRIS
# to install the whole package on your "$HOME" directory
# untar the file "MNH-V5-7-1.tar.gz" from its location :
cd ~
tar xvf $MESONH/MNH-V5-7-1.tar.gz
# run the "./configure" command :
cd MNH-V5-7-1/src
./configure
#
# Due to limitation in time & memory on interactive connection
# then compile the MESONH PACKAGE in batch mode with the job_make_mesonh_BullX_belenos file :
# on ADA
sbatch job_make_mesonh_BullX_belenos
llsubmit job_make_examples_IBM_ada
# This job does : gmake -j 4
# then : make installmaster
#on TURING
# To run basic KTEST examples :
llsubmit job_make_examples_BGQ
sbatch job_make_examples_BullX_belenos
# 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
#
# - At CINES on JADE( SGI/ICE ) :
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)..."
#
# load ".profile_mesonh..." & set the variables :
export MONORUN="mpirun -np 1"
export MPIRUN="mpirun -np 4 "
# and run with
# in job_make_mesonh_user_BullX insert " export VER_USER=MY_MODIF "
# then submit in batch mode
make examples
sbatch job_make_mesonh_user_BullX_belenos
#
# - At ECMWF on cca
#
# at CALMIP on OLYMPE (BULLX) :
# -------------------------------------------------------
#
# - install the PACKAGE in your /tmpdir/$USER
# - Compile in interactive mode
#
# - to run the test case examples run
llsubmit job_make_examples_CRAY_cca
sbatch job_make_examples_BullX_olympe
#
# That's all for the basic INSTALLATION of the "MESONH PACKAGE"
......@@ -684,7 +749,7 @@ llsubmit job_make_examples_CRAY_cca
# VII) "SCANDOLLAR" = SCRIPTING YOUR OWN PROCEDURES
# ====================================================
REM : not tested on 5-1-X version ...
REM : not tested on 5-5-X version ...
# A small script 'scandollar' is in test in this version of MESONH.
# It will help you to build a complete chaining of an experiment.
......@@ -730,7 +795,7 @@ scandollar
## OUTPUT ::
># read default config file :: ---> CONF_DOLLAR=/home/escj/DEV64/PACK-MNH-V5-2-1/conf/post/confdollar_aeropc_default
># read default config file :: ---> CONF_DOLLAR=/home/escj/DEV64/PACK-MNH-V5-7-1/conf/post/confdollar_aeropc_default
>#
># read user config file :: ---> CONFIG=confdollar
>#
......@@ -752,7 +817,7 @@ scandollar 0*
## OUTPUT ::
>#
># read default config file :: ---> CONF_DOLLAR=/home/escj/DEV64/PACK-MNH-V5-2-1/conf/post/confdollar_aeropc_default
># read default config file :: ---> CONF_DOLLAR=/home/escj/DEV64/PACK-MNH-V5-7-1/conf/post/confdollar_aeropc_default
>#
># read user config file :: ---> CONFIG=confdollar
>#
......@@ -826,22 +891,22 @@ cp -R 007_16janvier_scandollar /.../your_directory
#
# use this "profile_mesonh" :
. /home/rech/mnh/rmnh007/DEV/MNH-V5-2-1/conf/profile_mesonh-SX8-MNH-V5-2-1-MPIAUTO-O4
. /home/rech/mnh/rmnh007/DEV/MNH-V5-7-1/conf/profile_mesonh-SX8-MNH-V5-7-1-MPIAUTO-O4
# And the examples are here ( link to my $WORKDIR in actually )
/home/rech/mnh/rmnh007/DEV/MNH-V5-2-1/MY_RUN/KTEST/007_16janvier_scandollar
/home/rech/mnh/rmnh007/DEV/MNH-V5-7-1/MY_RUN/KTEST/007_16janvier_scandollar
#
# On vargas
# ---------
# use this "profile_mesonh" :
. /workgpfs/rech/mnh/rmnh007/DEV/MNH-V5-2-1/conf/profile_mesonh-AIX64-MNH-V5-2-1-MPIAUTO-O2
. /workgpfs/rech/mnh/rmnh007/DEV/MNH-V5-7-1/conf/profile_mesonh-AIX64-MNH-V5-7-1-MPIAUTO-O2
# and examples here :
/workgpfs/rech/mnh/rmnh007/DEV/MNH-V5-2-1/MY_RUN/KTEST/007_16janvier_scandollar
/workgpfs/rech/mnh/rmnh007/DEV/MNH-V5-7-1/MY_RUN/KTEST/007_16janvier_scandollar
#
# - At CINES on JADE :
......@@ -849,11 +914,11 @@ cp -R 007_16janvier_scandollar /.../your_directory
#
# use
. /work/escobar/DEV/MNH-V5-2-1/conf/profile_mesonh-LXifort-MNH-V5-2-1-MPIICE-O2
. /work/escobar/DEV/MNH-V5-7-1/conf/profile_mesonh-LXifort-MNH-V5-7-1-MPIICE-O2
# and the exemples
/work/escobar/DEV/MNH-V5-2-1/MY_RUN/KTEST/007_16janvier_scandollar
/work/escobar/DEV/MNH-V5-7-1/MY_RUN/KTEST/007_16janvier_scandollar
#
# - At ECMWF on cxa :
......@@ -861,11 +926,11 @@ cp -R 007_16janvier_scandollar /.../your_directory
#
# use
. /c1a/ms_perm/au5/MNH-V5-2-1/conf/profile_mesonh-AIX64-MNH-V5-2-1-MPIAUTO-O2
. /c1a/ms_perm/au5/MNH-V5-7-1/conf/profile_mesonh-AIX64-MNH-V5-7-1-MPIAUTO-O2
# and the examples
/c1a/ms_perm/au5/MNH-V5-2-1/MY_RUN/KTEST/007_16janvier_scandollar
/c1a/ms_perm/au5/MNH-V5-7-1/MY_RUN/KTEST/007_16janvier_scandollar
#
......@@ -920,34 +985,7 @@ ulimit -s unlimited
#
# IX) OPTIONAL COMPILATION
===========================
#
# a) MNH_NCWRIT for netcdf graphic output file
# --------------------------------------------
#
# If you want to use the option of writing directly netcdf file for graphical
# postprocessing ( no restart ) you could compile and use the package
# developped by Soline Bielli as exmplained in this mail
# http://mesonh.aero.obs-mip.fr/cgi-bin/mesonh_interne/mail2html.cgi?file=2012_12_19_18:35:16
# and on this wiki
# http://mesonh.aero.obs-mip.fr/mesonh410/UseNCL
#
# So before any compilation you have to set the MNH_NCWRIT variable
export MNH_NCWRIT=MNH_NCWRIT
#
# and then the configure
./configure
#
# after this compile as usually
#
make
etc ...
# see d) for cleaning previously version if needed
# b) MNH_FOREFIRE for forefire runs ( external package needed )
# a) MNH_FOREFIRE for forefire runs ( external package needed )
# -------------------------------------------------------------
#
# If you want to use coupled(inline) run with FOREFIRE and MESONH
......@@ -979,46 +1017,102 @@ git clone -b 2014.01 https://github.com/forefireAPI/firefront.git
# or move/linked to the 'exe' directory of MesoNH
#
# see d) for cleaning previously version if needed
# c) MNH_RTTOV for optional radiative computation
# b) MNH_RTTOV for optional radiative computation
# --------------------------------------
#
# The RTTOV package was not included into the open source version of Meso-NH
# because it needs a licence agrement .
# The RTTOV 13.2 package was not included into the open source version of Meso-NH
# because it needs a licence agrement.
#
# For already(old) licencied MesoNH users (MNH-4-X version with research licence see here: http://mesonh.aero.obs-mip.fr/mesonh410/UserInformation)
# Run the 'configure' script preceded with the setting of the MNH_RTTOV variable:
#
# the package could be reloaded in this way
cd $SRC_MESONH/src/
export MNH_RTTOV=1
export VER_RTTOV=13.2
#
# Compile the HDF5 library
#
make cdf
#
# Download the RTTOV package rttov132.tar.xz by following the instructions given on https://nwpsaf.eu/site/software/rttov/
#
# - With cvs access
# Install the RTTOV package rttov132.tar.xz
cd $SRC_MESONH/src/LIB
mkdir RTTOV-13.2
cd RTTOV-13.2
tar xJf rttov132.tar.xz
cd build
edit Makefile.local and set HDF5_PREFIX, FFLAGS_HDF5 and LDFLAGS_HDF5 as shown below
"
HDF5_PREFIX = $(SRC_MESONH)/src/dir_obj${XYZ}/MASTER/NETCDF-${VERSION_CDFF}
FFLAGS_HDF5 = -D_RTTOV_HDF $(FFLAG_MOD)$(HDF5_PREFIX)/include
LDFLAGS_HDF5 = -L$(HDF5_PREFIX)/lib64 -lhdf5hl_fortran -lhdf5_hl -lhdf5_fortran -lhdf5 -lsz -laec -lz -ldl
"
cd ../src
../build/Makefile.PL RTTOV_HDF=1
make ARCH=ifort # Use Intel "ifort" compiler; other options: gfortran, NAG, pgf90, IBM
#
# And then for the Meso-NH compilation, do
#
cd $SRC_MESONH/src/
make
cd MNH.../src/LIB
cvs up -rPACK-MNH-V4-10-3 -d -P RTTOV
# c) MNH_ECRAD for optional compilation of new ECRAD radiative library from ECMWF
# --------------------------------------
#
# The default version of ECRAD is 1.4.0 (open-source)
#
# Configure & Compilation
export MNH_ECRAD=1
./configure
etc ...
# The version of ECRAD is set by (by default):
# export VER_ECRAD=140
#
# - With WEB access (with WEB login/pass as usually) the RTTOV package could also be retrieve in tarball with wget like this:
# To use the previous version 1.0.1:
#
# The full ECRAD package 1.0.1 was not included into the open source version of Meso-NH
# because it needs a licence agrement.
#
# See here to get the licence & full sources : https://software.ecmwf.int/wiki/display/ECRAD/ECMWF+Radiation+Scheme+Home
#
# REM : some of the files modified for MNH are included in the directory ${SRC_MESONH}/src/LIB/RAD/ecrad-1.0.1_mnh
#
# Install the ECRAD package ecrad-1.0.1.tar.gz in the MNH tree directory
cd ${SRC_MESONH}/src/LIB/RAD
tar xvfz ecrad-1.0.1.tar.gz
cd MNH.../src/LIB
wget --http-user=USER --http-password=PASS 'http://mesonh.aero.obs-mip.fr/cgi-bin/mesonh_interne/viewcvs.cgi/MNH-VX-Y-Z/src/LIB/RTTOV/?view=tar&pathrev=PACK-MNH-V4-10-3' -O RTTOV.tar.gz
tar xvfz RTTOV.tar.gz
# Configure & Compilation
export MNH_ECRAD=1
export VER_ECRAD=101
./configure
# /!\ don't forget the ''. Otherwise, this will not work!
etc ...
#
# And then for the compilation, run the 'configure' script preceded with the setting of the MNH_RTTOV variable:
# REM : the 'profile_mesonh...' file & the 'dir_obj...' directory will be suffixed with an ECRAD extension
#
cd MNH.../src/
export MNH_RTTOV=1
# Usage :
# 1) In namelist replace RAD='ECMW' by RAD='ECRA'
# 2) Add link to all 'ecrad-1.X.X/data' files in your mesonh run directory
ln -sf ${SRC_MESONH}/src/LIB/RAD/ecrad-1.X.X/data/* .
#
# REM : you can replace CDATADIR = "." by CDATADIR = "data" of ini_radiations_ecrad.f90 to link only the data folder instead of all the files one by one
#
# See 007_16janvier/008_run2 test case for example
#
# d) MNH_MEGAN for optional compilation of MEGAN code
# --------------------------------------
#
# Configure & Compilation
export MNH_MEGAN=1
./configure
etc ...
# d) cleaning previous compiled version
# e) cleaning previous compiled version
# --------------------------------------
#
# If you have already compiled exactly the same version of MesoNH on this computer ( same $XYZ value )
......
LIBTOOLS/lib/COMPRESS/src/compress.f90
View file @ 6bb35ca8
!-----------------------------------------------------------------
!--------------- 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
......
LIBTOOLS/lib/COMPRESS/src/ieee_is_nan.c deleted 100644 → 0
View file @ a327da8d
#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);
}
LIBTOOLS/tools/lfi2cdf/scripts/lfi2cdfregex.sh
View file @ 6bb35ca8
#!/bin/sh
#!/bin/bash
#
#
usage(){
......
LIBTOOLS/tools/lfi2cdf/src/fieldtype.f90 deleted 100644 → 0
View file @ a327da8d
MODULE MODE_FIELDTYPE
USE MODD_PARAM
IMPLICIT NONE
PRIVATE
TYPE field
CHARACTER(LEN=FM_FIELD_SIZE) :: name ! Le nom de l'article LFI
INTEGER :: TYPE ! Type :entier(INT) ou reel(FLOAT)
INTEGER :: dim ! Dimension de l'article
END TYPE field
TYPE(field), DIMENSION(:), ALLOCATABLE :: userfield
! Les champs contenant %TDATE et %TIME sont traites en dur
! dans la routine de recherche de type
TYPE(field), DIMENSION(2), PARAMETER :: datefield = (/&
field('%TDA', INT, D0), &
field('%TIM', FLOAT, D0) &
/)
TYPE(field), DIMENSION(219), SAVE :: sysfield
PUBLIC :: get_ftype, init_sysfield
CONTAINS
SUBROUTINE init_sysfield()
sysfield(1) = field('LBXSVMxxx', FLOAT , D0)
sysfield(2) = field('LBYSVMxxx', FLOAT , D0)
sysfield(3) = field('LBXUM', FLOAT, D0)
sysfield(4) = field('LBYUM', FLOAT, D0)
sysfield(5) = field('LBXVM', FLOAT, D0)
sysfield(6) = field('LBYVM', FLOAT, D0)
sysfield(7) = field('LBXWM', FLOAT, D0)
sysfield(8) = field('LBYWM', FLOAT, D0)
sysfield(9) = field('LBXTHM', FLOAT, D0)
sysfield(10) = field('LBYTHM', FLOAT, D0)
sysfield(11) = field('LBXRVM', FLOAT, D0)
sysfield(12) = field('LBYRVM', FLOAT, D0)
sysfield(13) = field('AVG_ZS', FLOAT, D0)
sysfield(14) = field('SIL_ZS', FLOAT, D0)
sysfield(15) = field('AOSIP', FLOAT, D0)
sysfield(16) = field('AOSIM', FLOAT, D0)
sysfield(17) = field('AOSJP', FLOAT, D0)
sysfield(18) = field('AOSJM', FLOAT, D0)
sysfield(19) = field('HO2IP', FLOAT, D0)
sysfield(20) = field('HO2IM', FLOAT, D0)
sysfield(21) = field('HO2JP', FLOAT, D0)
sysfield(22) = field('HO2JM', FLOAT, D0)
sysfield(23) = field('RIMX',INT, D0)
sysfield(24) = field('RIMY',INT, D0)
sysfield(25) = field('HORELAX_UVWTH',BOOL, D0)
sysfield(26) = field('HORELAX_R',BOOL, D0)
sysfield(27) = field('I2D_XY', INT, D0)
sysfield(28) = field('MENU_BUDGET',TEXT, D0)
sysfield(29) = field('IE', INT, D0)
sysfield(30) = field('ZR', FLOAT, D0)
sysfield(31) = field('GOK', BOOL, D0)
sysfield(32) = field('YTEXT', TEXT, D0)
sysfield(33) = field('X1D', FLOAT, D0)
sysfield(34) = field('I1D', INT, D0)
sysfield(35) = field('DEB', INT, D0)
sysfield(36) = field('3D1', FLOAT, D0)
sysfield(37) = field('3D2', FLOAT, D0)
sysfield(38) = field('3D3', FLOAT, D0)
sysfield(39) = field('3D4', FLOAT, D0)
sysfield(40) = field('3D5', FLOAT, D0)
sysfield(41) = field('RHODREFZ', FLOAT, D0)
sysfield(42) = field('RSVS', FLOAT, D0)
sysfield(43) = field('RUS', FLOAT, D0)
sysfield(44) = field('MY_NAME', TEXT, D0)
sysfield(45) = field('DAD_NAME', TEXT, D0)
sysfield(46) = field('STORAGE_TYPE', TEXT, D0)
sysfield(47) = field('IMAX', INT, D0)
sysfield(48) = field('JMAX', INT, D0)
sysfield(49) = field('KMAX', INT, D0)
sysfield(50) = field('RPK', FLOAT, D0)
sysfield(51) = field('NEB', FLOAT , D0)
sysfield(52) = field('LONOR', FLOAT, D0)
sysfield(53) = field('LATOR', FLOAT, D0)
sysfield(54) = field('THINSHELL', BOOL, D0)
sysfield(55) = field('LAT0', FLOAT, D0)
sysfield(56) = field('LON0', FLOAT, D0)
sysfield(57) = field('BETA', FLOAT, D0)
sysfield(58) = field('XHAT', FLOAT, D0)
sysfield(59) = field('YHAT', FLOAT, D0)
sysfield(60) = field('ZHAT', FLOAT, D0)
sysfield(61) = field('ZS', FLOAT, D0)
sysfield(62) = field('CARTESIAN', BOOL, D0)
sysfield(63) = field('UM', FLOAT, D0)
sysfield(64) = field('VM', FLOAT, D0)
sysfield(65) = field('WM', FLOAT, D0)
sysfield(66) = field('THM', FLOAT, D0)
sysfield(67) = field('TKEM', FLOAT, D0)
sysfield(68) = field('EPSM', FLOAT, D0)
sysfield(69) = field('PABSM',FLOAT, D0)
sysfield(70) = field('RVM', FLOAT, D0)
sysfield(71) = field('RCM', FLOAT, D0)
sysfield(72) = field('RRM', FLOAT, D0)
sysfield(73) = field('RIM', FLOAT, D0)
sysfield(74) = field('RSM', FLOAT, D0)
sysfield(75) = field('RGM', FLOAT, D0)
sysfield(76) = field('RHM', FLOAT, D0)
sysfield(77) = field('SVMxxx', FLOAT, D0)
sysfield(78) = field('LSUM', FLOAT, D0)
sysfield(79) = field('LSVM', FLOAT, D0)
sysfield(80) = field('LSWM',FLOAT , D0)
sysfield(81) = field('LSTHM',FLOAT, D0)
sysfield(82) = field('LSRVM',FLOAT, D0)
sysfield(83) = field('LSXTKEM',FLOAT, D0)
sysfield(84) = field('LSYTKEM',FLOAT, D0)
sysfield(85) = field('LSXEPSM',FLOAT, D0)
sysfield(86) = field('LSYEPSM',FLOAT, D0)
sysfield(87) = field('LSXRCM',FLOAT , D0)
sysfield(88) = field('LSYRCM', FLOAT, D0)
sysfield(89) = field('LSXRRM', FLOAT, D0)
sysfield(90) = field('LSYRRM', FLOAT, D0)
sysfield(91) = field('LSXRIM', FLOAT, D0)
sysfield(92) = field('LSYRIM', FLOAT, D0)
sysfield(93) = field('LSXRSM', FLOAT, D0)
sysfield(94) = field('LSYRSM', FLOAT, D0)
sysfield(95) = field('LSXRGM', FLOAT, D0)
sysfield(96) = field('LSYRGM', FLOAT, D0)
sysfield(97) = field('LSXRHM', FLOAT, D0)
sysfield(98) = field('LSYRHM', FLOAT, D0)
sysfield(99) = field('LSXSVMxxx', FLOAT, D0)
sysfield(100) = field('LSYSVMxxx', FLOAT, D0)
sysfield(101) = field('UT',FLOAT, D0)
sysfield(102) = field('VT',FLOAT, D0)
sysfield(103) = field('WT',FLOAT, D0)
sysfield(104) = field('THT',FLOAT, D0)
sysfield(105) = field('TKET',FLOAT, D0)
sysfield(106) = field('EPST',FLOAT, D0)
sysfield(107) = field('PABST',FLOAT, D0)
sysfield(108) = field('RVT',FLOAT, D0)
sysfield(109) = field('RCT',FLOAT, D0)
sysfield(110) = field('RRT',FLOAT, D0)
sysfield(111) = field('RIT',FLOAT, D0)
sysfield(112) = field('CIT',FLOAT, D0)
sysfield(113) = field('RST',FLOAT, D0)
sysfield(114) = field('RGT',FLOAT, D0)
sysfield(115) = field('RHT',FLOAT, D0)
sysfield(116) = field('SVTxxx',FLOAT, D0)
sysfield(117) = field('DRYMASST',FLOAT, D0)
sysfield(118) = field('SRCM',FLOAT, D0)
sysfield(119) = field('SRCT',FLOAT, D0)
sysfield(120) = field('SIGS',FLOAT, D0)
sysfield(121) = field('RHOREFZ',FLOAT, D0)
sysfield(122) = field('THVREFZ',FLOAT, D0)
sysfield(123) = field('EXNTOP',FLOAT, D0)
sysfield(124) = field('RESA', FLOAT , D0)
sysfield(125) = field('Z0SEA', FLOAT , D0)
sysfield(126) = field('TS', FLOAT , D0)
sysfield(127) = field('WG', FLOAT , D0)
sysfield(128) = field('SST', FLOAT , D0)
sysfield(129) = field('T2', FLOAT , D0)
sysfield(130) = field('W2', FLOAT , D0)
sysfield(131) = field('WR', FLOAT , D0)
sysfield(132) = field('WS', FLOAT , D0)
sysfield(133) = field('ALBS', FLOAT , D0)
sysfield(134) = field('RHOS', FLOAT , D0)
sysfield(135) = field('LAND', FLOAT , D0)
sysfield(136) = field('SEA', FLOAT , D0)
sysfield(137) = field('Z0VEG', FLOAT , D0)
sysfield(138) = field('Z0HVEG', FLOAT , D0)
sysfield(139) = field('Z0REL', FLOAT , D0)
sysfield(140) = field('Z0EFFIP', FLOAT , D0)
sysfield(141) = field('Z0EFFIM', FLOAT , D0)
sysfield(142) = field('Z0EFFJP', FLOAT , D0)
sysfield(143) = field('Z0EFFJM', FLOAT , D0)
sysfield(144) = field('SSO_STDEV', FLOAT , D0)
sysfield(145) = field('SSO_ANIS', FLOAT , D0)
sysfield(146) = field('SSO_DIRECTION', FLOAT , D0)
sysfield(147) = field('SSO_SLOPE', FLOAT , D0)
sysfield(148) = field('ALBVIS', FLOAT , D0)
sysfield(149) = field('ALBNIR', FLOAT , D0)
sysfield(150) = field('EMIS', FLOAT , D0)
sysfield(151) = field('CLAY', FLOAT , D0)
sysfield(152) = field('SAND', FLOAT , D0)
sysfield(153) = field('D2', FLOAT , D0)
sysfield(154) = field('VEG', FLOAT , D0)
sysfield(155) = field('LAI', FLOAT , D0)
sysfield(156) = field('RSMIN', FLOAT , D0)
sysfield(157) = field('GAMMA', FLOAT , D0)
sysfield(158) = field('RGL', FLOAT , D0)
sysfield(159) = field('CV', FLOAT , D0)
sysfield(160) = field('SFTHT', FLOAT , D0)
sysfield(161) = field('SFTHP', FLOAT , D0)
sysfield(162) = field('SFRT', FLOAT , D0)
sysfield(163) = field('SFRP', FLOAT , D0)
sysfield(164) = field('SFSVT', FLOAT , D0)
sysfield(165) = field('SFSVP', FLOAT , D0)
sysfield(166) = field('DTHRAD', FLOAT , D0)
sysfield(167) = field('SRFLWD', FLOAT , D0)
sysfield(168) = field('SRFSWD', FLOAT , D0)
sysfield(169) = field('CLDFR', FLOAT , D0)
sysfield(170) = field('COUNTCONV', INT , D0)
sysfield(171) = field('DTHCONV', FLOAT , D0)
sysfield(172) = field('DRVCONV', FLOAT , D0)
sysfield(173) = field('DRCCONV', FLOAT , D0)
sysfield(174) = field('DRICONV', FLOAT , D0)
sysfield(175) = field('PRCONV', FLOAT , D0)
sysfield(176) = field('PACCONV', FLOAT , D0)
sysfield(177) = field('WSUBCONV', FLOAT , D0)
sysfield(178) = field('INPRR', FLOAT , D0)
sysfield(179) = field('ACPRR', FLOAT , D0)
sysfield(180) = field('INPRS', FLOAT , D0)
sysfield(181) = field('ACPRS', FLOAT , D0)
sysfield(182) = field('INPRG', FLOAT , D0)
sysfield(183) = field('ACPRG', FLOAT , D0)
sysfield(184) = field('INPRT', FLOAT , D0)
sysfield(185) = field('ACPRT', FLOAT , D0)
sysfield(186) = field('FRC', INT, D0)
sysfield(187) = field('UFRCxx', FLOAT , D0)
sysfield(188) = field('VFRCxx', FLOAT , D0)
sysfield(189) = field('WFRCxx', FLOAT , D0)
sysfield(190) = field('THFRCxx', FLOAT , D0)
sysfield(191) = field('RVFRCxx', FLOAT , D0)
sysfield(192) = field('GXRVFRCxx', FLOAT , D0)
sysfield(193) = field('GYRVFRCxx', FLOAT , D0)
sysfield(194) = field('GXTHFRCxx', FLOAT , D0)
sysfield(195) = field('GYTHFRCxx', FLOAT , D0)
sysfield(196) = field('DUMMY_GRxxx', FLOAT , D0)
sysfield(197) = field('MASDEV', INT , D0)
sysfield(198) = field('EMISFILE_GR_NBR', INT , D0)
sysfield(199) = field('EMISPEC_GR_NBR', INT , D0)
sysfield(200) = field('EMISNAMExxx', TEXT , D0)
sysfield(201) = field('EMISTIMESxxx', INT , D0)
sysfield(202) = field('DUMMY_GR_NBR', INT , D0)
sysfield(203) = field('COVERxxx', FLOAT , D0)
sysfield(204) = field('TGx', FLOAT, D0)
sysfield(205) = field('T_ROOFx', FLOAT, D0)
sysfield(206) = field('T_ROADx', FLOAT, D0)
sysfield(207) = field('T_WALLx', FLOAT, D0)
sysfield(208) = field('WGx', FLOAT, D0)
sysfield(209) = field('WGIx', FLOAT, D0)
sysfield(210) = field('MAX_ZS', FLOAT, D0)
sysfield(211) = field('MIN_ZS', FLOAT, D0)
sysfield(212) = field('XOR', INT, D0)
sysfield(213) = field('YOR', INT, D0)
sysfield(214) = field('DXRATIO', INT, D0)
sysfield(215) = field('DYRATIO', INT, D0)
sysfield(216) = field('PATCH_NUMBER', INT, D0)
sysfield(217) = field('BUGFIX', INT, D0)
sysfield(218) = field('BIBUSER', TEXT, D0)
sysfield(219) = field('LFI_COMPRESSED', INT, D0)
END SUBROUTINE init_sysfield
FUNCTION get_ftype(hfname,level)
CHARACTER(LEN=*) :: hfname
INTEGER :: get_ftype
INTEGER,INTENT(IN) :: level
TYPE(field) :: tzf
! Is this a diachronic field ?
IF (INDEX(hfname,".TY",.TRUE.) /=0 .OR.&
& INDEX(hfname,".TI",.TRUE.) /=0 .OR.&
& INDEX(hfname,".UN",.TRUE.) /=0 .OR.&
& INDEX(hfname,".CO",.TRUE.)/=0) THEN
get_ftype = TEXT
ELSE IF (INDEX(hfname,".DI",.TRUE.) /= 0) THEN
get_ftype = INT
ELSE IF (INDEX(hfname,".PR",.TRUE.)/= 0 .OR.&
& INDEX(hfname,".TR",.TRUE.)/= 0 .OR.&
& INDEX(hfname,".DA",.TRUE.)/= 0) THEN
get_ftype = FLOAT
ELSE IF (searchfield(hfname,tzf,level)) THEN
! search in databases
get_ftype = tzf%TYPE
ELSE
get_ftype = -1
END IF
END FUNCTION get_ftype
FUNCTION searchfield(hfname, tpf, level)
CHARACTER(LEN=*), INTENT(IN) :: hfname
TYPE(field), INTENT(OUT) :: tpf
INTEGER,INTENT(IN) :: level
LOGICAL :: searchfield
INTEGER :: ji,iposx
LOGICAL :: found
CHARACTER(LEN=4) :: clevel
found = .FALSE.
! First is this a date field ?
DO ji=1,SIZE(datefield)
IF (INDEX(hfname,TRIM(datefield(ji)%name)) /= 0) THEN
found = .TRUE.
tpf = datefield(ji)
EXIT
END IF
END DO
IF (.NOT. found) THEN
! Next, search in user field tab
IF (ALLOCATED(userfield)) THEN
DO ji=1,SIZE(userfield)
IF (hfname==userfield(ji)%name) THEN
found = .TRUE.
tpf = userfield(ji)
EXIT
END IF
END DO
END IF
IF (.NOT. found) THEN
! then search in system field tab
DO ji=1,SIZE(sysfield)
IF (hfname==sysfield(ji)%name) THEN
found = .TRUE.
tpf = sysfield(ji)
EXIT
ELSE
iposx = INDEX(sysfield(ji)%name,'x')
IF (iposx /= 0) THEN
IF (isnumeric(hfname(iposx:LEN_TRIM(sysfield(ji)%name))) .AND. &
sysfield(ji)%name(1:iposx-1)//&
hfname(iposx:LEN_TRIM(sysfield(ji)%name))==hfname) THEN
found = .TRUE.
tpf = sysfield(ji)
EXIT
END IF
ELSE IF (level>-1) THEN
!Maybe it is a z-level splitted field
!Warning: false positives are possible (but should be rare)
write(clevel,'(I4.4)') level
iposx = INDEX(hfname,clevel)
IF (iposx /= 0) THEN
IF (hfname(:iposx-1)==sysfield(ji)%name) THEN
found = .TRUE.
tpf = sysfield(ji)
EXIT
END IF
END IF
END IF
END IF
END DO
END IF
END IF
searchfield = found
END FUNCTION searchfield
FUNCTION isnumeric(hname)
CHARACTER(LEN=*) :: hname
LOGICAL :: isnumeric
INTEGER :: ji
isnumeric = .TRUE.
DO ji = 1,LEN(hname)
IF (hname(ji:ji) > '9' .OR. hname(ji:ji) < '0') THEN
isnumeric = .FALSE.
EXIT
END IF
END DO
END FUNCTION isnumeric
END MODULE MODE_FIELDTYPE
LIBTOOLS/tools/lfi2cdf/src/lfi2cdf.f90
View file @ 6bb35ca8
!MNH_LIC Copyright 1994-2024 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! Modifications:
! P. Wautelet 19/09/2019: add possibility to provide a fallback file if some information are not found in the input file
!-----------------------------------------------------------------
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_GRID_n, ONLY: XXHAT, XXHATM, XYHAT, XYHATM
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_field, only: Ini_field_list
USE MODE_IO, ONLY: IO_Init, IO_Config_set
use mode_ll
use mode_modeln_handler, only: Goto_model
USE mode_options
USE MODE_SET_GRID, ONLY: INTERP_HORGRID_TO_MASSPOINTS
USE MODE_SPLITTINGZ_ll, ONLY: INI_PARAZ_ll
USE mode_util
USE MODI_VERSION
USE MODN_CONFIO, ONLY: LCDF4, LLFIOUT, LLFIREAD
IMPLICIT NONE
INTEGER :: ibuflen
INTEGER :: ji
INTEGER :: nbvar_infile ! number of variables available in the input file
INTEGER :: nbvar_tbr ! number of variables to be read
INTEGER :: nbvar_calc ! number of variables to be computed from others
INTEGER :: nbvar_tbw ! number of variables to be written
INTEGER :: nbvar ! number of defined variables
INTEGER :: first_level, current_level, last_level, nb_levels
INTEGER :: nbvar_infile = 0 ! number of variables available in the input file
INTEGER :: nbvar_tbr = 0 ! number of variables to be read
INTEGER :: nbvar_calc = 0 ! number of variables to be computed from others
INTEGER :: nbvar_tbw = 0 ! number of variables to be written
INTEGER :: nbvar = 0 ! number of defined variables
INTEGER :: IINFO_ll ! return code of // routines
INTEGER :: nfiles_out = 0 ! number of output files
CHARACTER(LEN=:),allocatable :: hvarlist
TYPE(filelist_struct) :: infiles, outfiles
TYPE(TFILE_ELT),DIMENSION(2) :: infiles
TYPE(TFILE_ELT),DIMENSION(MAXFILES) :: outfiles
TYPE(workfield), DIMENSION(:), POINTER :: tzreclist
type(option),dimension(:),allocatable :: options
......@@ -20,18 +49,83 @@ program LFI2CDF
integer :: runmode
CPROGRAM = 'LFICDF'
CALL Goto_model(1)
CALL IO_Init()
CALL VERSION
CALL INI_CST
ALLOCATE(TIMEZ) !Used by IO_WRITE_FIELD
NIO_VERB = NVERB_INFO
NGEN_VERB = NVERB_INFO
NIO_ABORT_LEVEL = NVERB_FATAL
NGEN_ABORT_LEVEL = NVERB_FATAL
LVERB_OUTLST = .FALSE.
LVERB_STDOUT = .TRUE.
call read_commandline(options,hinfile,houtfile,runmode)
CALL OPEN_FILES(infiles, outfiles, hinfile, houtfile, nbvar_infile, options, runmode)
IF (options(OPTLIST)%set) return
if (options(OPTVERBOSE)%set) then
NIO_VERB = NVERB_DEBUG
NGEN_VERB = NVERB_DEBUG
end if
IF (options(OPTMERGE)%set) THEN
NB_PROCIO_R = options(OPTMERGE)%ivalue
ELSE
NB_PROCIO_R = 1
END IF
IF (runmode == MODELFI2CDF) THEN
LCDF4 = .TRUE.
LLFIOUT = .FALSE.
LLFIREAD = .TRUE.
CALL IO_Config_set()
ELSE IF (runmode == MODECDF2CDF) THEN
LCDF4 = .TRUE.
LLFIOUT = .FALSE.
LLFIREAD = .FALSE.
CALL IO_Config_set()
ELSE
LCDF4 = .TRUE.
LLFIOUT = .TRUE.
LLFIREAD = .FALSE.
CALL IO_Config_set()
END IF
CALL INI_FIELD_LIST()
CALL OPEN_FILES(infiles, outfiles, nfiles_out, hinfile, houtfile, nbvar_infile, options, runmode)
IF (options(OPTLIST)%set) STOP
!Set and initialize parallel variables (necessary to read split files)
CALL SET_JP_ll(1,JPHEXT,JPVEXT,JPHEXT)
CALL SET_DAD0_ll()
CALL SET_DIM_ll(NIMAX_ll, NJMAX_ll, NKMAX)
CALL SET_XRATIO_ll(1, 1)
CALL SET_YRATIO_ll(1, 1)
CALL SET_XOR_ll(1, 1)
CALL SET_XEND_ll(NIMAX_ll+2*JPHEXT, 1)
CALL SET_YOR_ll(1, 1)
CALL SET_YEND_ll(NJMAX_ll+2*JPHEXT, 1)
CALL INI_PARAZ_ll(IINFO_ll)
! This has to be done after INI_PARAZ_ll and after reading of XXHAT and XYHAT (in OPEN_FILES)
ALLOCATE(XXHATM(NIMAX_ll+2*JPHEXT))
ALLOCATE(XYHATM(NJMAX_ll+2*JPHEXT))
! Interpolations of positions to mass points
CALL INTERP_HORGRID_TO_MASSPOINTS( XXHAT, XYHAT, XXHATM, XYHATM )
IF (runmode == MODELFI2CDF .OR. runmode == MODECDF2CDF) THEN
IF (options(OPTVAR)%set) THEN
! nbvar_tbr is computed from number of requested variables
! by counting commas, = and +
nbvar_tbr = 0
nbvar_tbr = 1
nbvar_calc = 0
nbvar_tbw = 0
nbvar_tbw = 1
hvarlist = options(OPTVAR)%cvalue
DO ji=1,len(hvarlist)
IF (hvarlist(ji:ji) == ',' .OR.hvarlist(ji:ji) == '+') THEN
......@@ -48,87 +142,35 @@ program LFI2CDF
ELSE
nbvar = nbvar_infile
END IF
ELSE
nbvar = nbvar_infile
END IF
IF (runmode == MODELFI2CDF) THEN
! Conversion LFI -> NetCDF
!Standard treatment (one LFI file only)
IF (.not.options(OPTMERGE)%set) THEN
CALL parse_infiles(infiles,nbvar_infile,nbvar_tbr,nbvar_calc,nbvar_tbw,tzreclist,ibuflen,options)
IF (options(OPTSPLIT)%set) call open_split_ncfiles_out(outfiles,houtfile,nbvar,tzreclist,options)
CALL def_ncdf(outfiles,tzreclist,nbvar,options)
CALL fill_ncdf(infiles,outfiles,tzreclist,nbvar,ibuflen,options)
ELSE
!Treat several LFI files and merge into 1 NC file
!Determine first level (eg needed to find suffix of the variable name)
read( hinfile(len(hinfile)-6:len(hinfile)-4) , "(I3)" ) first_level
nb_levels = options(OPTMERGE)%ivalue
current_level = first_level
last_level = first_level + nb_levels - 1
!Read 1st LFI file
CALL parse_infiles(infiles,nbvar_infile,nbvar_tbr,nbvar_calc,nbvar_tbw,tzreclist,ibuflen,options,current_level)
IF (options(OPTSPLIT)%set) call open_split_ncfiles_out(outfiles,houtfile,nbvar,tzreclist,options)
!Define NC variables
CALL def_ncdf(outfiles,tzreclist,nbvar,options)
DO current_level = first_level,last_level
print *,'Treating level ',current_level
IF (current_level/=first_level) THEN
CALL open_split_lfifile_in(infiles,hinfile,current_level)
CALL read_data_lfi(infiles,nbvar,tzreclist,ibuflen,current_level)
END IF
CALL fill_ncdf(infiles,outfiles,tzreclist,nbvar,ibuflen,options,current_level)
IF (current_level/=last_level) CALL close_files(infiles)
END DO
END IF
IF (options(OPTSPLIT)%set) call open_split_ncfiles_out(outfiles,nfiles_out,houtfile,nbvar_tbw,options)
CALL parse_infiles(infiles,outfiles,nfiles_out,nbvar_infile,nbvar_tbr,nbvar_calc,nbvar_tbw,tzreclist,options,runmode)
CALL def_ncdf(infiles,outfiles,nfiles_out)
CALL fill_files(infiles,outfiles,tzreclist,nbvar,options)
ELSE IF (runmode == MODECDF2CDF) THEN
! Conversion netCDF -> netCDF
!Standard treatment (one netCDF file only)
IF (.not.options(OPTMERGE)%set) THEN
CALL parse_infiles(infiles,nbvar_infile,nbvar_tbr,nbvar_calc,nbvar_tbw,tzreclist,ibuflen,options,current_level)
IF (options(OPTSPLIT)%set) call open_split_ncfiles_out(outfiles,houtfile,nbvar,tzreclist,options)
CALL def_ncdf(outfiles,tzreclist,nbvar,options)
CALL fill_ncdf(infiles,outfiles,tzreclist,nbvar,ibuflen,options)
ELSE
!Treat several NC files and merge into 1 NC file
!Determine first level (eg needed to find suffix of the variable name)
read( hinfile(len(hinfile)-5:len(hinfile)-3) , "(I3)" ) first_level
nb_levels = options(OPTMERGE)%ivalue
current_level = first_level
last_level = first_level + nb_levels - 1
!Read 1st NC file
CALL parse_infiles(infiles,nbvar_infile,nbvar_tbr,nbvar_calc,nbvar_tbw,tzreclist,ibuflen,options,current_level)
IF (options(OPTSPLIT)%set) call open_split_ncfiles_out(outfiles,houtfile,nbvar,tzreclist,options)
!Define NC variables
CALL def_ncdf(outfiles,tzreclist,nbvar,options)
DO current_level = first_level,last_level
print *,'Treating level ',current_level
IF (current_level/=first_level) THEN
CALL open_split_ncfile_in(infiles,hinfile,current_level)
CALL update_varid_in(infiles,hinfile,tzreclist,nbvar,current_level)
END IF
CALL fill_ncdf(infiles,outfiles,tzreclist,nbvar,ibuflen,options,current_level)
IF (current_level/=last_level) CALL close_files(infiles)
END DO
END IF
IF (options(OPTSPLIT)%set) call open_split_ncfiles_out(outfiles,nfiles_out,houtfile,nbvar_tbw,options)
CALL parse_infiles(infiles,outfiles,nfiles_out,nbvar_infile,nbvar_tbr,nbvar_calc,nbvar_tbw,tzreclist,options,runmode)
CALL def_ncdf(infiles,outfiles,nfiles_out)
CALL fill_files(infiles,outfiles,tzreclist,nbvar,options)
ELSE
! Conversion NetCDF -> LFI
CALL parse_infiles(infiles,nbvar_infile,nbvar_tbr,nbvar_calc,nbvar_tbw,tzreclist,ibuflen,options,current_level)
CALL build_lfi(infiles,outfiles,tzreclist,ibuflen)
CALL parse_infiles(infiles,outfiles,nfiles_out,nbvar_infile,nbvar_tbr,nbvar_calc,nbvar_tbw,tzreclist,options,runmode)
CALL fill_files(infiles,outfiles,tzreclist,nbvar,options)
END IF
CALL CLOSE_FILES(infiles)
CALL CLOSE_FILES(outfiles)
if ( options( OPTFALLBACK )%set ) then
CALL CLOSE_FILES(infiles, 2)
else
CALL CLOSE_FILES(infiles, 1)
end if
CALL CLOSE_FILES(outfiles,nfiles_out)
end program LFI2CDF
LIBTOOLS/tools/lfi2cdf/src/modd_ncparam.f90 deleted 100644 → 0
View file @ a327da8d
MODULE MODD_PARAM
IMPLICIT NONE
CHARACTER(LEN=*), PARAMETER :: VERSION_ID='lfi2cdf Ver. Alpha'
INTEGER, PARAMETER :: INT = 1
INTEGER, PARAMETER :: FLOAT = 2
INTEGER, PARAMETER :: TEXT = 3
INTEGER, PARAMETER :: BOOL = 4
INTEGER, PARAMETER :: D0 = 100
INTEGER, PARAMETER :: D1 = 200
INTEGER, PARAMETER :: D2 = 300
INTEGER, PARAMETER :: D3 = 400
INTEGER, PARAMETER :: NOTFOUND = -1
INTEGER, PARAMETER :: FM_FIELD_SIZE = 32
END MODULE MODD_PARAM
LIBTOOLS/tools/lfi2cdf/src/mode_dimlist.f90 deleted 100644 → 0
View file @ a327da8d
MODULE mode_dimlist
IMPLICIT NONE
TYPE dimCDF
CHARACTER(LEN=8) :: name
INTEGER :: len
INTEGER :: id
LOGICAL :: create
INTEGER :: ndims ! number of dim reference (when create=.FALSE.)
TYPE(dimCDF), POINTER :: next
END TYPE dimCDF
TYPE(dimCDF), POINTER, PRIVATE, SAVE :: dimlist
INTEGER, PRIVATE, SAVE :: nbelt = 0
INTEGER, SAVE :: IDIMX = 0
INTEGER, SAVE :: IDIMY = 0
INTEGER, SAVE :: IDIMZ = 0
LOGICAL, SAVE :: GUSEDIM = .FALSE.
TYPE(dimCDF), POINTER :: ptdimx, ptdimy, ptdimz
CONTAINS
SUBROUTINE init_dimCDF()
NULLIFY(dimlist)
NULLIFY(ptdimx, ptdimy, ptdimz)
IF (GUSEDIM) THEN
! reservation for DIMX,DIMY,DIMZ
ptdimx=>get_dimCDF(IDIMX,.TRUE.)
ptdimx%name = 'DIMX'
ptdimy=>get_dimCDF(IDIMY,.TRUE.)
ptdimy%name = 'DIMY'
! PGD MesoNH files doesn't contain KMAX
IF (IDIMZ > 0) THEN
ptdimz=>get_dimCDF(IDIMZ,.TRUE.)
ptdimz%name = 'DIMZ'
END IF
END IF
END SUBROUTINE init_dimCDF
FUNCTION size_dimCDF()
INTEGER :: size_dimCDF
size_dimCDF = nbelt
END FUNCTION size_dimCDF
FUNCTION first_dimCDF()
TYPE(dimCDF), POINTER :: first_dimCDF
first_dimCDF=>dimlist
END FUNCTION first_dimCDF
FUNCTION get_dimCDF(len,ocreate)
INTEGER, INTENT(IN) :: len
LOGICAL, INTENT(IN), OPTIONAL :: ocreate ! when .TRUE. create a dim CELL
TYPE(dimCDF), POINTER :: get_dimCDF
TYPE(dimCDF), POINTER :: tmp
INTEGER :: count
CHARACTER(LEN=5) :: yndim
LOGICAL :: gforce
IF (PRESENT(ocreate)) THEN
gforce = ocreate
ELSE
gforce = .FALSE.
ENDIF
!
IF (len /= 1) THEN
IF (gforce) THEN
count = 0
NULLIFY(tmp)
ELSE
count = 1
tmp=>dimlist
DO WHILE(ASSOCIATED(tmp))
IF (tmp%len == len) EXIT
tmp=>tmp%next
count = count+1
END DO
END IF
IF (.NOT. ASSOCIATED(tmp)) THEN
ALLOCATE(tmp)
nbelt = nbelt+1
WRITE(yndim,'(i5)') count
tmp%name = 'DIM'//ADJUSTL(yndim)
tmp%len = len
tmp%id = 0
IF (GUSEDIM .AND. len == IDIMX*IDIMY) THEN
tmp%create = .FALSE.
tmp%ndims = 2
ELSEIF (GUSEDIM .AND. len == IDIMX*IDIMY*IDIMZ) THEN
tmp%ndims = 3
tmp%create = .FALSE.
ELSEIF (GUSEDIM .AND. IDIMY == 3 .AND. len == IDIMX*IDIMZ) THEN
tmp%ndims = 12 ! faux mais reconnu dans def_ncdf
tmp%create = .FALSE.
ELSE
tmp%ndims = 0
tmp%create = .TRUE.
END IF
tmp%next => dimlist
dimlist => tmp
END IF
get_dimCDF=>tmp
ELSE
NULLIFY(get_dimCDF)
END IF
END FUNCTION get_dimCDF
END MODULE mode_dimlist
LIBTOOLS/tools/lfi2cdf/src/mode_options.f90
View file @ 6bb35ca8
!MNH_LIC Copyright 2015-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! Modifications:
! P. Wautelet 19/09/2019: add possibility to provide a fallback file if some information are not found in the input file
! P. Wautelet 21/10/2019: add OPTDIR option to set directory for writing outfiles
!-----------------------------------------------------------------
module mode_options
use modd_field, only: TYPEUNDEF, TYPEINT, TYPELOG, TYPEREAL, TYPECHAR, TYPEDATE
implicit none
integer,parameter :: nbavailoptions = 10
integer,parameter :: TYPEUNDEF = -1, TYPEINT = 1, TYPELOG = 2, TYPEREAL = 3, TYPECHAR = 4
integer,parameter :: NBAVAILOPTIONS = 12
integer,parameter :: MODEUNDEF = -11, MODECDF2CDF = 11, MODELFI2CDF = 12, MODECDF2LFI = 13
integer,parameter :: OPTCDF3 = 1, OPTCDF4 = 2, OPTCOMPRESS = 3
integer,parameter :: OPTHELP = 4, OPTLIST = 5, OPTMERGE = 6
integer,parameter :: OPTOUTPUT = 7, OPTREDUCE = 8, OPTSPLIT = 9
integer,parameter :: OPTVAR = 10
integer,parameter :: OPTCOMPRESS = 1, OPTHELP = 2, OPTLIST = 3
integer,parameter :: OPTMERGE = 4, OPTOUTPUT = 5, OPTREDUCE = 6
integer,parameter :: OPTMODE = 7, OPTSPLIT = 8, OPTVAR = 9
integer,parameter :: OPTVERBOSE = 10, OPTFALLBACK = 11, OPTDIR = 12
type option
logical :: set = .false.
......@@ -31,7 +41,7 @@ subroutine read_commandline(options,hinfile,houtfile,runmode)
character(len=:),allocatable,intent(out) :: houtfile
integer,intent(out) :: runmode
integer :: idx, ji, nbargs, status, sz
integer :: idx, nbargs, status, sz
logical :: finished
character(len=:),allocatable :: command, fullcommand
......@@ -53,8 +63,6 @@ subroutine read_commandline(options,hinfile,houtfile,runmode)
runmode = MODELFI2CDF
case default
runmode = MODEUNDEF
print *,'Error: program started with unknown command: ',command
call help()
end select
deallocate(command,fullcommand)
......@@ -80,30 +88,21 @@ subroutine read_commandline(options,hinfile,houtfile,runmode)
call check_options(options,hinfile,runmode)
houtfile = options(OPTOUTPUT)%cvalue
call remove_suffix(hinfile)
!Remove level in the filename if merging LFI splitted files
if (.NOT.options(OPTOUTPUT)%set) then
if (options(OPTMERGE)%set .AND. .NOT.options(OPTSPLIT)%set) then
houtfile=houtfile(1:len(houtfile)-9)//houtfile(len(houtfile)-3:)
end if
if (.NOT.options(OPTMERGE)%set .AND. options(OPTSPLIT)%set) then
if (options(OPTCDF4)%set) then
ji=4
else
ji=3
end if
houtfile=houtfile(1:len(houtfile)-ji)
end if
if (options(OPTMERGE)%set .AND. options(OPTSPLIT)%set) then
if (options(OPTCDF4)%set) then
ji=9
else
ji=8
end if
houtfile=houtfile(1:len(houtfile)-ji)
end if
!Determine outfile name if not given
if (.NOT.options(OPTOUTPUT)%set .AND. .NOT.options(OPTSPLIT)%set) then
idx = index(hinfile,'/',back=.true.)
options(OPTOUTPUT)%cvalue = hinfile(idx+1:len_trim(hinfile))//'_merged'
end if
if (.NOT.options(OPTOUTPUT)%set .AND. options(OPTSPLIT)%set) then
idx = index(hinfile,'/',back=.true.)
options(OPTOUTPUT)%cvalue = trim(hinfile)
end if
houtfile = options(OPTOUTPUT)%cvalue
call remove_suffix(houtfile)
end subroutine read_commandline
......@@ -114,14 +113,6 @@ subroutine init_options(options)
allocate(options(nbavailoptions))
options(OPTCDF3)%long_name = "cdf3"
options(OPTCDF3)%short_name = '3'
options(OPTCDF3)%has_argument = .false.
options(OPTCDF4)%long_name = "cdf4"
options(OPTCDF4)%short_name = '4'
options(OPTCDF4)%has_argument = .false.
options(OPTCOMPRESS)%long_name = "compress"
options(OPTCOMPRESS)%short_name = 'c'
options(OPTCOMPRESS)%has_argument = .true.
......@@ -149,6 +140,11 @@ subroutine init_options(options)
options(OPTREDUCE)%short_name = 'r'
options(OPTREDUCE)%has_argument = .false.
options(OPTMODE)%long_name = "runmode"
options(OPTMODE)%short_name = 'R'
options(OPTMODE)%has_argument = .true.
options(OPTMODE)%type = TYPECHAR
options(OPTSPLIT)%long_name = "split"
options(OPTSPLIT)%short_name = 's'
options(OPTSPLIT)%has_argument = .false.
......@@ -158,6 +154,20 @@ subroutine init_options(options)
options(OPTVAR)%has_argument = .true.
options(OPTVAR)%type = TYPECHAR
options(OPTVERBOSE)%long_name = "verbose"
options(OPTVERBOSE)%short_name = 'V'
options(OPTVERBOSE)%has_argument = .false.
options(OPTFALLBACK)%long_name = "fallback-file"
options(OPTFALLBACK)%short_name = 'f'
options(OPTFALLBACK)%has_argument = .true.
options(OPTFALLBACK)%type = TYPECHAR
options(OPTDIR)%long_name = "outdir"
options(OPTDIR)%short_name = 'd'
options(OPTDIR)%has_argument = .true.
options(OPTDIR)%type = TYPECHAR
end subroutine init_options
subroutine get_option(options,finished)
......@@ -240,24 +250,32 @@ subroutine check_options(options,infile,runmode)
type(option),dimension(:),intent(inout) :: options
character(len=:),allocatable,intent(in) :: infile
integer,intent(in) :: runmode
integer,intent(inout) :: runmode
integer :: idx1, idx2
!Check if help has been asked
if (options(OPTHELP)%set) then
call help()
end if
!Use NetCF-4 by default
if (.NOT.options(OPTCDF3)%set) then
options(OPTCDF4)%set = .true.
!Check runmode
if (options(OPTMODE)%set) then
select case (options(OPTMODE)%cvalue)
case ('cdf2cdf')
runmode = MODECDF2CDF
case ('lfi2cdf')
runmode = MODELFI2CDF
case ('cdf2lfi')
runmode = MODECDF2LFI
case default
print *,'Error: invalid runmode option'
call help()
end select
else
if (options(OPTCDF4)%set) then
print *,'Warning: NetCDF-3 and NetCDF-4 options are not compatible'
print *,'NetCDF-4 is forced'
options(OPTCDF3)%set = .false.
if(runmode==MODEUNDEF) then
print *,'Error: program started with unknown command'
call help()
end if
end if
......@@ -275,63 +293,86 @@ subroutine check_options(options,infile,runmode)
call help()
end if
!Merge flag only supported if -v is set
if (options(OPTMERGE)%set .AND. .NOT.options(OPTVAR)%set) then
print *,'Error: merge option must be used with var option'
call help()
end if
!Split flag only supported if -v is set
if (options(OPTSPLIT)%set .AND. .NOT.options(OPTVAR)%set) then
options(OPTSPLIT)%set = .false.
print *,"Warning: split option is forced to disable"
end if
!Determine outfile name if not given
if (.NOT.options(OPTOUTPUT)%set) then
idx1 = index(infile,'/',back=.true.)
idx2 = index(infile,'.',back=.true.)
options(OPTOUTPUT)%cvalue = infile(idx1+1:idx2-1)
!Check list option
if (options(OPTSPLIT)%set .AND. runmode==MODECDF2LFI) then
print *,'Error: split option is not supported by cdf2lfi'
call help()
end if
end subroutine check_options
subroutine remove_suffix(hfile)
character(len=:),allocatable,intent(inout) :: hfile
integer :: idx1, idx2
character(len=:),allocatable :: yfile
idx1 = index(hfile,'.lfi',back=.true.)
idx2 = index(hfile,'.nc', back=.true.)
if (idx1>0) then
yfile=hfile(1:idx1-1)
else if (idx2>0) then
yfile=hfile(1:idx2-1)
else
yfile=trim(hfile)
endif
deallocate(hfile)
hfile = trim(yfile)
deallocate(yfile)
end subroutine remove_suffix
subroutine help()
implicit none
!TODO: -l option for cdf2cdf and cdf2lfi
print *,"Usage : lfi2cdf [-h --help] [--cdf4 -4] [-l] [-v --var var1[,...]] [-r --reduce-precision]"
print *,"Usage : lfi2cdf [-h --help] [-l] [-v --var var1[,...]] [-r --reduce-precision]"
print *," [-m --merge number_of_z_levels] [-s --split] [-o --output output-file.nc]"
print *," [-R --runmode mode] [-V --verbose] [-f --fallback-file fallback-file]"
print *," [-c --compress compression_level] input-file.lfi"
print *," cdf2cdf [-h --help] [--cdf4 -4] [-v --var var1[,...]] [-r --reduce-precision]"
print *," [-m --merge number_of_z_levels] [-s --split] [-o --output output-file.nc]"
print *," cdf2cdf [-h --help] [-v --var var1[,...]] [-r --reduce-precision]"
print *," [-m --merge number_of_split_files] [-s --split] [-o --output output-file.nc]"
print *," [-R --runmode mode] [-V --verbose] [-f --fallback-file fallback-file]"
print *," [-c --compress compression_level] input-file.nc"
print *," cdf2lfi [-o --output output-file.lfi] input-file.nc"
print *," cdf2lfi [-o --output output-file.lfi] [-R --runmode mode] [-V --verbose]"
print *," [-f --fallback-file fallback-file] input-file.nc"
print *,""
print *,"Options:"
print *," --cdf3, -3"
print *," Write netCDF file in netCDF-3 format (cdf2cdf and lfi2cdf only)"
print *," --cdf4, -4 (by default)"
print *," Write netCDF file in netCDF-4 format (HDF5 compatible) (cdf2cdf and lfi2cdf only)"
print *," --compress, -c compression_level"
print *," Compress data. The compression level should be in the 1 to 9 interval."
print *," Only supported with the netCDF-4 format (cdf2cdf and lfi2cdf only)"
print *," Only supported with the netCDF format (cdf2cdf and lfi2cdf only)"
print *," -f --fallback-file fallback-file"
print *," File to use to read some grid information if not found in input-file"
print *," --help, -h"
print *," Print this text"
print *," --list, -l"
print *," List all the fields of the LFI file and returns (lfi2cdf only)"
print *," --merge, -m number_of_z_levels"
print *," Merge LFI files which are split by vertical level (cdf2cdf and lfi2cdf only)"
print *," --merge, -m number_of_split_files"
print *," Merge files which are split by vertical level (cdf2cdf and lfi2cdf only)"
print *," --output, -o"
print *," Name of file for the output"
print *," --reduce-precision, -r"
print *," Reduce the precision of the floating point variables to single precision (cdf2cdf and lfi2cdf only)"
print *," --runmode, -R"
print *," Force runmode (lfi2cdf, cdf2cdf or cdf2lfi)"
print *," --split, -s"
print *," Split variables specified with the -v option (one per file) (cdf2cdf and lfi2cdf only)"
print *," --var, -v var1[,...]"
print *," List of the variable to write in the output file. Variables names have to be separated by commas (,)."
print *," A variable can be computed from the sum of existing variables (format: new_var=var1+var2[+...])"
print *," (cdf2cdf and lfi2cdf only)"
print *," --verbose, -V"
print *," Be verbose (for debugging purpose)"
print *,""
stop
......
LIBTOOLS/tools/lfi2cdf/src/mode_util.f90
View file @ 6bb35ca8
!MNH_LIC Copyright 1994-2024 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C 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 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
! P. Wautelet 25/06/2019: add support for 3D integer arrays
! P. Wautelet 01/08/2019: allow merge of entire Z-split files
! P. Wautelet 18/09/2019: correct support of 64bit integers (MNH_INT=8)
! P. Wautelet 19/09/2019: add possibility to provide a fallback file if some information are not found in the input file
! P. Wautelet 21/10/2019: add OPTDIR option to set directory for writing outfiles
! P. Wautelet 21/10/2019: if DTMOD and DTCUR not found, try to read the time coordinate
! P. Wautelet 10/11/2020: new data structures for netCDF dimensions
!-----------------------------------------------------------------
MODULE mode_util
USE MODE_FIELDTYPE
USE mode_dimlist
use modd_field, only: tfieldmetadata, tfieldlist
USE MODD_IO, ONLY: TFILEDATA, TFILE_ELT
USE MODD_NETCDF, ONLY: CDFINT, tdimnc
USE MODD_PARAMETERS, ONLY: NLFIMAXCOMMENTLENGTH, NMNHNAMELGTMAX
use modd_precision, only: LFIINT
use mode_field, only: Find_field_id_from_mnhname
USE MODE_IO_FIELD_READ
USE MODE_IO_FIELD_WRITE
use mode_io_tools_nc4, only: IO_Err_handle_nc4
use mode_msg
USE mode_options
USE MODD_PARAM
USE netcdf
USE NETCDF
IMPLICIT NONE
INTEGER,PARAMETER :: MAXRAW=10
INTEGER,PARAMETER :: MAXLEN=512
INTEGER,PARAMETER :: MAXFILES=100
INTEGER,parameter :: MAXDATES=100
INTEGER,PARAMETER :: UNDEFINED = -1, READING = 1, WRITING = 2
INTEGER,PARAMETER :: UNKNOWN_FORMAT = -1, NETCDF_FORMAT = 1, LFI_FORMAT = 2
TYPE filestruct
INTEGER :: lun_id ! Logical ID of file
INTEGER :: format = UNKNOWN_FORMAT ! NETCDF, LFI
INTEGER :: status = UNDEFINED ! Opened for reading or writing
INTEGER :: var_id ! Position of the variable in the workfield structure
LOGICAL :: opened = .false.
END TYPE filestruct
TYPE filelist_struct
INTEGER :: nbfiles = 0
! TYPE(filestruct),DIMENSION(:),ALLOCATABLE :: files
TYPE(filestruct),DIMENSION(MAXFILES) :: files
END TYPE filelist_struct
INTEGER,PARAMETER :: FM_FIELD_SIZE = 32
TYPE workfield
CHARACTER(LEN=FM_FIELD_SIZE) :: name ! nom du champ
INTEGER :: TYPE ! type (entier ou reel)
CHARACTER(LEN=:), POINTER :: comment
TYPE(dimCDF), POINTER :: dim
INTEGER :: id_in = -1, id_out = -1
INTEGER :: grid
LOGICAL :: found ! T if found in the input file
LOGICAL :: calc ! T if computed from other variables
LOGICAL :: tbw ! to be written or not
LOGICAL :: tbr ! to be read or not
INTEGER,DIMENSION(MAXRAW) :: src ! List of variables used to compute the variable (needed only if calc=.true.)
INTEGER :: tgt ! Target: id of the variable that use it (calc variable)
CHARACTER(LEN=NMNHNAMELGTMAX) :: name ! nom du champ
LOGICAL :: found ! T if found in the input file
LOGICAL :: calc ! T if computed from other variables
LOGICAL :: tbw ! to be written or not
LOGICAL :: tbr ! to be read or not
LOGICAL :: LSPLIT = .FALSE. ! TRUE if variable is split by vertical level
INTEGER :: NSIZE = 0 ! Size of the variable (in number of elements)
INTEGER :: NSRC = 0 ! Number of variables used to compute the variable (needed only if calc=.true.)
INTEGER(kind=CDFINT) :: NDIMS_FILE ! Number of dims (as present in input file)
INTEGER(kind=CDFINT), DIMENSION(:),ALLOCATABLE :: NDIMSIZES_FILE ! Dimensions sizes (as present in input file)
CHARACTER(LEN=NF90_MAX_NAME),DIMENSION(:),ALLOCATABLE :: CDIMNAMES_FILE ! Dimensions names (as present in input file)
CHARACTER(LEN=40) :: CUNITS_FILE = '' ! Units (as present in input file)
INTEGER :: NGRID_FILE ! Grid number (as present in input file)
INTEGER(kind=CDFINT) :: NTYPE_FILE ! netCDF datatype (NF90_CHAR, NF90_INT...) (as present in input file)
INTEGER,DIMENSION(MAXRAW) :: src ! List of variables used to compute the variable (needed only if calc=.true.)
INTEGER :: tgt ! Target: id of the variable that use it (calc variable)
TYPE(TFIELDMETADATA) :: TFIELD ! Metadata about the field
TYPE(tdimnc),DIMENSION(:),ALLOCATABLE :: TDIMS ! Dimensions of the field
END TYPE workfield
#ifndef LOWMEM
TYPE lfidata
INTEGER(KIND=8), DIMENSION(:), POINTER :: iwtab
END TYPE lfidata
TYPE(lfidata), DIMENSION(:), ALLOCATABLE :: lfiart
#endif
LOGICAL(KIND=LFIINT), PARAMETER :: ltrue = .TRUE.
LOGICAL(KIND=LFIINT), PARAMETER :: lfalse = .FALSE.
LOGICAL(KIND=LFI_INT), PARAMETER :: ltrue = .TRUE.
LOGICAL(KIND=LFI_INT), PARAMETER :: lfalse = .FALSE.
CHARACTER(LEN=6) :: CPROGRAM_ORIG
CONTAINS
FUNCTION str_replace(hstr, hold, hnew)
CHARACTER(LEN=*) :: hstr, hold, hnew
CHARACTER(LEN=LEN_TRIM(hstr)+MAX(0,LEN(hnew)-LEN(hold))) :: str_replace
INTEGER :: pos
pos = INDEX(hstr,hold)
IF (pos /= 0) THEN
str_replace = hstr(1:pos-1)//hnew//hstr(pos+LEN(hold):)
ELSE
str_replace = hstr
END IF
END FUNCTION str_replace
SUBROUTINE FMREADLFIN1(klu,hrecfm,kval,kresp)
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 :: icomlen
INTEGER(KIND=LFI_INT) :: iresp,ilenga,iposex
!
CALL LFINFO(iresp,klu,hrecfm,ilenga,iposex)
IF (iresp /=0 .OR. ilenga == 0) THEN
kresp = -1
kval = 0
ELSE
ALLOCATE(IWORK(ilenga))
CALL LFILEC(iresp,klu,hrecfm,iwork,ilenga)
icomlen = iwork(2)
kval = iwork(3+icomlen)
kresp = iresp
DEALLOCATE(IWORK)
END IF
END SUBROUTINE FMREADLFIN1
SUBROUTINE parse_infiles(infiles, nbvar_infile, nbvar_tbr, nbvar_calc, nbvar_tbw, tpreclist, kbuflen, options, icurrent_level)
TYPE(filelist_struct), INTENT(IN) :: infiles
INTEGER, INTENT(IN) :: nbvar_infile, nbvar_tbr, nbvar_calc, nbvar_tbw
TYPE(workfield), DIMENSION(:), POINTER :: tpreclist
INTEGER, INTENT(OUT) :: kbuflen
TYPE(option),DIMENSION(:), INTENT(IN) :: options
INTEGER, INTENT(IN), OPTIONAL :: icurrent_level
INTEGER :: ji,jj, kcdf_id, itype
INTEGER :: ndb, nde, ndey, idx, idx_var, maxvar
INTEGER :: idims, idimtmp, jdim, status, var_id
LOGICAL :: ladvan
INTEGER :: ich, current_level, leng
INTEGER :: comment_size, fsize, sizemax
CHARACTER(LEN=FM_FIELD_SIZE) :: yrecfm
CHARACTER(LEN=4) :: suffix
#ifdef LOWMEM
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: iwork
#endif
INTEGER(KIND=LFI_INT) :: iresp,ilu,ileng,ipos
SUBROUTINE parse_infiles(infiles, outfiles, KNFILES_OUT, nbvar_infile, nbvar_tbr, nbvar_calc, nbvar_tbw, &
tpreclist, options, runmode)
USE MODD_DIM_n, ONLY: NIMAX_ll, NJMAX_ll, NKMAX
use modd_io, only: nio_verb
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT, NGRIDUNKNOWN
use mode_io_tools_nc4, only: IO_Dimids_guess_nc4
TYPE(TFILE_ELT),DIMENSION(:), INTENT(IN) :: infiles
TYPE(TFILE_ELT),DIMENSION(:), INTENT(IN) :: outfiles
INTEGER, INTENT(IN) :: KNFILES_OUT
INTEGER, INTENT(IN) :: nbvar_infile, nbvar_tbr, nbvar_calc, nbvar_tbw
TYPE(workfield), DIMENSION(:),POINTER,INTENT(OUT) :: tpreclist
TYPE(option),DIMENSION(:), INTENT(IN) :: options
INTEGER, INTENT(IN) :: runmode
TYPE TLFIDATE
CHARACTER(LEN=FM_FIELD_SIZE) :: CNAME = '' !Name of the date variable
INTEGER :: NIDX_DATE = -1 !Index of the date part
INTEGER :: NIDX_TIME = -1 !Index of the time part
END TYPE TLFIDATE
CHARACTER(LEN=FM_FIELD_SIZE) :: yrecfm, YDATENAME
CHARACTER(LEN=FM_FIELD_SIZE) :: var_calc
CHARACTER(LEN=FM_FIELD_SIZE),dimension(MAXRAW) :: var_raw
INTEGER, DIMENSION(10) :: idim_id
INTEGER :: JPHEXT
IF (infiles%files(1)%format == LFI_FORMAT) THEN
ilu = infiles%files(1)%lun_id
CALL FMREADLFIN1(ilu,'JPHEXT',JPHEXT,iresp)
IF (iresp /= 0) JPHEXT=1
CHARACTER(LEN=1) :: YNDIMS
CHARACTER(LEN=32) :: YTYPE
INTEGER :: ji,jj
INTEGER :: ndb, nde, ndey, idx, idx_out, idx_var, maxvar
INTEGER :: leng
INTEGER :: IID, IRESP, IDATES, ICURDATE
INTEGER :: IDXDATE, IDXTIME
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
type(TFILEDATA) :: tzfile
! First check if IMAX,JMAX,KMAX exist in LFI file
! to handle 3D, 2D variables -> update IDIMX,IDIMY,IDIMZ
CALL FMREADLFIN1(ilu,'IMAX',IDIMX,iresp)
IF (iresp == 0) IDIMX = IDIMX+2*JPHEXT ! IMAX + 2*JPHEXT
!
CALL FMREADLFIN1(ilu,'JMAX',IDIMY,iresp)
IF (iresp == 0) IDIMY = IDIMY+2*JPHEXT ! JMAX + 2*JPHEXT
!
CALL FMREADLFIN1(ilu,'KMAX',IDIMZ,iresp)
IF (iresp == 0) IDIMZ = IDIMZ+2 ! KMAX + 2*JPVEXT
ELSE IF (infiles%files(1)%format == NETCDF_FORMAT) THEN
kcdf_id = infiles%files(1)%lun_id
status = NF90_INQ_DIMID(kcdf_id, "DIMX", idim_id(1))
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
status = NF90_INQUIRE_DIMENSION(kcdf_id,idim_id(1),len = IDIMX)
status = NF90_INQ_DIMID(kcdf_id, "DIMY", idim_id(2))
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
status = NF90_INQUIRE_DIMENSION(kcdf_id,idim_id(2),len = IDIMY)
status = NF90_INQ_DIMID(kcdf_id, "DIMZ", idim_id(3))
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
status = NF90_INQUIRE_DIMENSION(kcdf_id,idim_id(3),len = IDIMZ)
END IF
CALL PRINT_MSG(NVERB_DEBUG,'IO','parse_infiles','called')
GUSEDIM = (IDIMX*IDIMY > 0)
IF (GUSEDIM) THEN
PRINT *,'MESONH 3D, 2D articles DIMENSIONS used :'
PRINT *,'DIMX =',IDIMX
PRINT *,'DIMY =',IDIMY
PRINT *,'DIMZ =',IDIMZ ! IDIMZ may be equal to 0 (PGD files)
IF (options(OPTSPLIT)%set) THEN
idx_out = 0
ELSE
PRINT *,'BEWARE : ALL MesoNH arrays are handled as 1D arrays !'
idx_out = 1
END IF
sizemax = 0
IDATES = 0
IF (runmode==MODECDF2LFI) THEN
!This file is a dummy one to manage netCDF dims
idx_out = KNFILES_OUT
END IF
IF (present(icurrent_level)) THEN
write(suffix,'(I4.4)') icurrent_level
current_level = icurrent_level
ElSE
suffix=''
current_level = -1
IF (INFILES(1)%TFILE%CFORMAT == 'LFI') THEN
ilu = INFILES(1)%TFILE%NLFIFLU
ELSE IF (INFILES(1)%TFILE%CFORMAT == 'NETCDF4') THEN
kcdf_id = INFILES(1)%TFILE%NNCID
END IF
WRITE( cmnhmsg(1), '( A )' ) 'MESONH 3D, 2D articles DIMENSIONS used :'
WRITE( cmnhmsg(2), '( "DIMX = ", I0 )' ) NIMAX_ll + 2 * JPHEXT
WRITE( cmnhmsg(3), '( "DIMY = ", I0 )' ) NJMAX_ll + 2 * JPHEXT
WRITE( cmnhmsg(4), '( "DIMZ = ", I0 )' ) NKMAX + 2 * JPVEXT
call Print_msg( NVERB_INFO, 'IO', 'parse_infiles' )
! Phase 1 : build articles list to convert.
!
! Pour l'instant tous les articles du fichier LFI sont
......@@ -179,15 +141,12 @@ CONTAINS
! l'utilisateur par exemple)
!
IF (options(OPTVAR)%set) THEN
#ifndef LOWMEM
IF(.NOT.ALLOCATED(lfiart) .AND. infiles%files(1)%format == LFI_FORMAT) ALLOCATE(lfiart(nbvar_tbr+nbvar_calc))
#endif
ALLOCATE(tpreclist(nbvar_tbr+nbvar_calc))
DO ji=1,nbvar_tbr+nbvar_calc
tpreclist(ji)%found = .FALSE.
tpreclist(ji)%calc = .FALSE. !By default variables are not computed from others
tpreclist(ji)%tbw = .TRUE. !By default variables are written
tpreclist(ji)%tbr = .TRUE. !By default variables are written
tpreclist(ji)%tbr = .TRUE. !By default variables are read
tpreclist(ji)%src(:) = -1
tpreclist(ji)%tgt = -1
END DO
......@@ -198,8 +157,8 @@ CONTAINS
DO ji=1,nbvar_tbw
!crash compiler GCC 4.2.0: nde = INDEX(TRIM(options(OPTVAR)%cvalue(ndb:)),',')
nde = INDEX(TRIM(options(OPTVAR)%cvalue(ndb:len(trim(options(OPTVAR)%cvalue)))),',')
IF (nde == 0) nde = LEN( TRIM(options(OPTVAR)%cvalue(ndb:len(trim(options(OPTVAR)%cvalue)))) ) + 1
yrecfm = options(OPTVAR)%cvalue(ndb:ndb+nde-2)
!Detect operations on variables (only + is supported now)
ndey = INDEX(TRIM(yrecfm),'=')
idx = 1
......@@ -207,8 +166,7 @@ CONTAINS
var_calc = yrecfm(1:ndey-1)
DO WHILE (ndey /= 0)
IF (idx>MAXRAW) THEN
print *,'Error: MAXRAW exceeded (too many raw variables for 1 computed one)'
STOP
CALL PRINT_MSG(NVERB_FATAL,'IO','parse_infiles','MAXRAW exceeded (too many raw variables for 1 computed one)')
END IF
yrecfm = yrecfm(ndey+1:)
ndey = INDEX(TRIM(yrecfm),'+')
......@@ -224,6 +182,7 @@ CONTAINS
tpreclist(idx_var)%calc = .TRUE.
tpreclist(idx_var)%tbw = .TRUE.
tpreclist(idx_var)%tbr = .FALSE.
tpreclist(idx_var)%NSRC = idx-1
idx_var=idx_var+1
DO jj = 1, idx-1
tpreclist(idx_var-jj)%src(jj) = idx_var
......@@ -250,60 +209,80 @@ CONTAINS
IF (tpreclist(ji)%calc) CYCLE
yrecfm = TRIM(tpreclist(ji)%name)
IF (infiles%files(1)%format == LFI_FORMAT) THEN
CALL LFINFO(iresp,ilu,trim(yrecfm)//trim(suffix),ileng,ipos)
IF (iresp == 0 .AND. ileng /= 0) tpreclist(ji)%found = .true.
leng = ileng
ELSE IF (infiles%files(1)%format == NETCDF_FORMAT) THEN
status = NF90_INQ_VARID(kcdf_id,trim(yrecfm)//trim(suffix),tpreclist(ji)%id_in)
IF (status == NF90_NOERR) THEN
IF (INFILES(1)%TFILE%CFORMAT == 'LFI') THEN
CALL LFINFO(iresp2,ilu,trim(yrecfm),ileng,ipos)
IF (iresp2 == 0 .AND. ileng /= 0) THEN
tpreclist(ji)%found = .true.
status = NF90_INQUIRE_VARIABLE(kcdf_id,tpreclist(ji)%id_in,ndims = idims,dimids = idim_id)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
!TODO:useful?
!DUPLICATED
IF (idims == 0) THEN
! variable scalaire
leng = 1
tpreclist(ji)%NSIZE = ileng - 2 - NLFIMAXCOMMENTLENGTH
END IF
IF (iresp2==0 .AND. ileng == 0 .AND. ipos==0 .AND. INFILES(1)%TFILE%NSUBFILES_IOZ>0) THEN
!Variable not found with no error (iresp2==0 .AND. ileng == 0 .AND. ipos==0)
!If we are merging, maybe it is one of the split variable
!In that case, the 1st part of the variable is in the 1st split file with a 0001 suffix
CALL LFINFO(iresp2,INFILES(1)%TFILE%TFILES_IOZ(1)%TFILE%NLFIFLU,trim(yrecfm)//'0001',ileng,ipos)
IF (iresp2 == 0 .AND. ileng /= 0) THEN
tpreclist(ji)%found = .true.
tpreclist(ji)%LSPLIT = .true.
IF (tpreclist(ji)%tgt > 0) THEN !If this variable is used for a calculated one
tpreclist(tpreclist(ji)%tgt)%LSPLIT = .true.
END IF
END IF
tpreclist(ji)%NSIZE = (ileng - 2 - NLFIMAXCOMMENTLENGTH) * (NKMAX+2*JPVEXT)
ileng = tpreclist(ji)%NSIZE + 2 + NLFIMAXCOMMENTLENGTH
END IF
leng = ileng
ELSE IF (INFILES(1)%TFILE%CFORMAT == 'NETCDF4') THEN
status = NF90_INQ_VARID(kcdf_id,trim(yrecfm),var_id)
IF (status /= NF90_NOERR .AND. INFILES(1)%TFILE%NSUBFILES_IOZ>0) THEN
!Variable probably not found (other error possible...)
!If we are merging, maybe it is one of the split variable
!In that case, the 1st part of the variable is in the 1st split file with a 0001 suffix
kcdf_id2 = INFILES(1)%TFILE%TFILES_IOZ(1)%TFILE%NNCID
tzfile = INFILES(1)%TFILE%TFILES_IOZ(1)%TFILE
status = NF90_INQ_VARID(kcdf_id2,trim(yrecfm)//'0001',var_id)
IF (status == NF90_NOERR) THEN
tpreclist(ji)%LSPLIT = .true.
IF (tpreclist(ji)%tgt > 0) THEN !If this variable is used for a calculated one
tpreclist(tpreclist(ji)%tgt)%LSPLIT = .true.
END IF
ELSE
! infos sur dimensions
leng = 1
DO jdim=1,idims
status = NF90_INQUIRE_DIMENSION(kcdf_id,idim_id(jdim),len = idimtmp)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
leng = leng*idimtmp
END DO
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 IO_Err_handle_nc4( status, 'parse_infiles', 'NF90_INQ_VARID', trim(yrecfm) )
ELSE
kcdf_id2 = kcdf_id
tzfile = INFILES(1)%TFILE
ENDIF
!
IF (status == NF90_NOERR) THEN
tpreclist(ji)%found = .true.
CALL IO_Metadata_get_nc4(tzfile,var_id,tpreclist(ji))
END IF
END IF
IF (.NOT.tpreclist(ji)%found) THEN
PRINT *,'Article ',TRIM(yrecfm), ' not found!'
CALL PRINT_MSG(NVERB_WARNING,'IO','parse_infiles','variable '//TRIM(yrecfm)//' not found => ignored')
tpreclist(ji)%tbw = .FAlSE.
tpreclist(ji)%tbr = .FAlSE.
ELSE
! PRINT *,'Article ',ji,' : ',TRIM(yrecfm),', longueur = ',ileng
IF (leng > sizemax) sizemax = leng
#ifndef LOWMEM
!TODO:useful for netcdf?
IF (infiles%files(1)%format == LFI_FORMAT) ALLOCATE(lfiart(ji)%iwtab(leng))
#endif
END IF
END DO
maxvar = nbvar_tbr+nbvar_calc
DO ji=1,nbvar_tbr+nbvar_calc
print *,ji,'name=',trim(tpreclist(ji)%name),' calc=',tpreclist(ji)%calc,' tbw=',tpreclist(ji)%tbw,&
' tbr=',tpreclist(ji)%tbr,' found=',tpreclist(ji)%found
END DO
if ( nio_verb >= NVERB_INFO ) then
do ji = 1, nbvar_tbr + nbvar_calc
write ( cmnhmsg(1), '( I0, " name=", A, "calc=", L1, " tbw=", L1, " tbr=", L1, " found=", L1 )' ) &
ji, tpreclist(ji)%name, tpreclist(ji)%calc, tpreclist(ji)%tbw, tpreclist(ji)%tbr, tpreclist(ji)%found
call Print_msg( NVERB_INFO, 'IO', 'parse_infiles' )
end do
end if
ELSE
! Entire file is converted
#ifndef LOWMEM
IF(.NOT.ALLOCATED(lfiart) .AND. infiles%files(1)%format == LFI_FORMAT) ALLOCATE(lfiart(nbvar_infile))
#endif
ALLOCATE(tpreclist(nbvar_infile))
DO ji=1,nbvar_infile
tpreclist(ji)%calc = .FALSE. !By default variables are not computed from others
......@@ -311,1076 +290,1341 @@ END DO
tpreclist(ji)%src(:) = -1
END DO
IF (infiles%files(1)%format == LFI_FORMAT) THEN
CALL LFIPOS(iresp,ilu)
IF (INFILES(1)%TFILE%CFORMAT == 'LFI') THEN
CALL LFIPOS(iresp2,ilu)
ladvan = .TRUE.
DO ji=1,nbvar_infile
CALL LFICAS(iresp,ilu,yrecfm,ileng,ipos,ladvan)
! PRINT *,'Article ',ji,' : ',TRIM(yrecfm),', longueur = ',ileng
tpreclist(ji)%name = trim(yrecfm)
CALL LFICAS(iresp2,ilu,yrecfm,ileng,ipos,ladvan)
tpreclist(ji)%name = trim(yrecfm)
tpreclist(ji)%found = .TRUE.
IF (ileng > sizemax) sizemax = ileng
#ifndef LOWMEM
ALLOCATE(lfiart(ji)%iwtab(ileng))
#endif
tpreclist(ji)%NSIZE = ileng - 2 - NLFIMAXCOMMENTLENGTH
!Detect if date variable
IDXDATE = INDEX(trim(yrecfm),"%TDATE",.TRUE.)
IDXTIME = INDEX(trim(yrecfm),"%TIME", .TRUE.)
IF (IDXDATE/=0 .AND. IDXTIME/=0) &
CALL PRINT_MSG(NVERB_FATAL,'IO','parse_infiles','field in LFI file with %TDATE and %TIME in name '//TRIM(YRECFM))
IDX = MAX(IDXDATE,IDXTIME)
IF (IDX>0) THEN
YDATENAME = YRECFM(1:IDX-1)
!Look if datename is already known
ICURDATE = 0
DO JJ=1,IDATES
IF (TRIM(YDATENAME)==TRIM(TLFIDATES(JJ)%CNAME)) THEN
ICURDATE = JJ
EXIT
END IF
END DO
!
IF (ICURDATE == 0) THEN
!New date name detected
IDATES = IDATES + 1
IF (IDATES>MAXDATES) CALL PRINT_MSG(NVERB_FATAL,'IO','parse_infiles','too many dates, increase MAXDATES')
ICURDATE = IDATES
END IF
TLFIDATES(ICURDATE)%CNAME = TRIM(YDATENAME)
IF (IDXTIME>0) THEN
IF (TLFIDATES(ICURDATE)%NIDX_TIME /= -1) &
CALL PRINT_MSG(NVERB_FATAL,'IO','parse_infiles','NIDX_TIME already set for '//TRIM(YDATENAME))
TLFIDATES(ICURDATE)%NIDX_TIME = JI
!Set variable name to truncated name (necessary to correctly identify the variable when read)
tpreclist(ji)%name = TRIM(YDATENAME)
END IF
IF (IDXDATE>0) THEN
IF (TLFIDATES(ICURDATE)%NIDX_DATE /= -1) &
CALL PRINT_MSG(NVERB_FATAL,'IO','parse_infiles','NIDX_DATE already set for '//TRIM(YDATENAME))
TLFIDATES(ICURDATE)%NIDX_DATE = JI
!Do not treat this variable (the date part will be read with the time part)
tpreclist(ji)%name = 'removed_date'
tpreclist(ji)%tbw = .FALSE.
tpreclist(ji)%tbr = .FALSE.
tpreclist(ji)%found = .FALSE.
END IF
END IF
END DO
ELSE IF (infiles%files(1)%format == NETCDF_FORMAT) THEN
!
DO JI=1,IDATES
IF (TLFIDATES(JI)%NIDX_DATE == -1 .OR. TLFIDATES(JI)%NIDX_TIME == -1) &
CALL PRINT_MSG(NVERB_FATAL,'IO','parse_infiles','incomplete DATE/TIME fields for '//TRIM(TLFIDATES(JI)%CNAME))
END DO
!
ELSE IF (INFILES(1)%TFILE%CFORMAT == 'NETCDF4') THEN
DO ji=1,nbvar_infile
tpreclist(ji)%id_in = ji
status = NF90_INQUIRE_VARIABLE(kcdf_id,tpreclist(ji)%id_in, name = tpreclist(ji)%name, ndims = idims, &
dimids = idim_id)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
! PRINT *,'Article ',ji,' : ',TRIM(tpreclist(ji)%name),', longueur = ',ileng
var_id = ji
status = NF90_INQUIRE_VARIABLE(kcdf_id,var_id, name = tpreclist(ji)%name)
if ( status /= NF90_NOERR ) &
call IO_Err_handle_nc4( status, 'parse_infiles', 'NF90_INQUIRE_VARIABLE', tpreclist(ji)%name )
tpreclist(ji)%found = .TRUE.
!TODO:useful?
!DUPLICATED
IF (idims == 0) THEN
! variable scalaire
leng = 1
ELSE
! infos sur dimensions
leng = 1
DO jdim=1,idims
status = NF90_INQUIRE_DIMENSION(kcdf_id,idim_id(jdim),len = idimtmp)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
leng = leng*idimtmp
END DO
END IF
IF (leng > sizemax) sizemax = leng
CALL IO_Metadata_get_nc4(INFILES(1)%TFILE,var_id,tpreclist(ji))
END DO
END IF
maxvar = nbvar_infile
END IF
kbuflen = sizemax
#ifdef LOWMEM
WRITE(*,'("Taille maximale du buffer :",f10.3," Mio")') sizemax*8./1048576.
ALLOCATE(iwork(sizemax))
#endif
! Phase 2 : Extract comments and dimensions for valid articles.
! Infos are put in tpreclist.
CALL init_dimCDF()
! Check if variable is in TFIELDLIST and populate corresponding metadata
DO ji=1,maxvar
IF (tpreclist(ji)%calc .OR. .NOT.tpreclist(ji)%found) CYCLE
IF (infiles%files(1)%format == LFI_FORMAT) THEN
yrecfm = trim(tpreclist(ji)%name)//trim(suffix)
CALL LFINFO(iresp,ilu,yrecfm,ileng,ipos)
#ifdef LOWMEM
CALL LFILEC(iresp,ilu,yrecfm,iwork,ileng)
tpreclist(ji)%grid = iwork(1)
comment_size = iwork(2)
#else
CALL LFILEC(iresp,ilu,yrecfm,lfiart(ji)%iwtab,ileng)
tpreclist(ji)%grid = lfiart(ji)%iwtab(1)
comment_size = lfiart(ji)%iwtab(2)
#endif
tpreclist(ji)%TYPE = get_ftype(yrecfm,current_level)
ALLOCATE(character(len=comment_size) :: tpreclist(ji)%comment)
DO jj=1,comment_size
#ifdef LOWMEM
ich = iwork(2+jj)
#else
ich = lfiart(ji)%iwtab(2+jj)
#endif
tpreclist(ji)%comment(jj:jj) = CHAR(ich)
END DO
IF (runmode/=MODECDF2LFI .AND. options(OPTSPLIT)%set .AND. tpreclist(ji)%tbw) idx_out = idx_out + 1
fsize = ileng-(2+comment_size)
ELSE IF (infiles%files(1)%format == NETCDF_FORMAT) THEN
! GRID attribute definition
status = NF90_GET_ATT(kcdf_id,tpreclist(ji)%id_in,'GRID',tpreclist(ji)%grid)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
! COMMENT attribute definition
status = NF90_INQUIRE_ATTRIBUTE(kcdf_id,tpreclist(ji)%id_in,'COMMENT',len=comment_size)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
ALLOCATE(character(len=comment_size) :: tpreclist(ji)%comment)
status = NF90_GET_ATT(kcdf_id,tpreclist(ji)%id_in,'COMMENT',tpreclist(ji)%comment)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
status = NF90_INQUIRE_VARIABLE(kcdf_id,tpreclist(ji)%id_in, xtype = itype, ndims = idims, &
dimids = idim_id)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
SELECT CASE(itype)
CASE(NF90_CHAR)
tpreclist(ji)%TYPE = TEXT
CASE(NF90_INT)
tpreclist(ji)%TYPE = INT
CASE(NF90_FLOAT,NF90_DOUBLE)
tpreclist(ji)%TYPE = FLOAT
CASE default
PRINT *, 'Attention : variable ',TRIM(tpreclist(ji)%name), ' a un TYPE non reconnu par le convertisseur.'
PRINT *, '--> TYPE force a REAL(KIND 8) dans LFI !'
END SELECT
!DUPLICATED
IF (idims == 0) THEN
! variable scalaire
leng = 1
ELSE
! infos sur dimensions
leng = 1
DO jdim=1,idims
status = NF90_INQUIRE_DIMENSION(kcdf_id,idim_id(jdim),len = idimtmp)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
leng = leng*idimtmp
END DO
END IF
IF (.NOT.tpreclist(ji)%found .OR. tpreclist(ji)%calc ) CYCLE
!
!Do not treat dimension variables (they are automatically added when creating netCDF file)
IF ( tpreclist(ji)%name == 'ni' &
.OR. tpreclist(ji)%name == 'nj' &
.OR. tpreclist(ji)%name == 'ni_u' &
.OR. tpreclist(ji)%name == 'nj_u' &
.OR. tpreclist(ji)%name == 'ni_v' &
.OR. tpreclist(ji)%name == 'nj_v' &
.OR. tpreclist(ji)%name == 'latitude' &
.OR. tpreclist(ji)%name == 'longitude' &
.OR. tpreclist(ji)%name == 'latitude_u' &
.OR. tpreclist(ji)%name == 'longitude_u' &
.OR. tpreclist(ji)%name == 'latitude_v' &
.OR. tpreclist(ji)%name == 'longitude_v' &
.OR. tpreclist(ji)%name == 'latitude_f' &
.OR. tpreclist(ji)%name == 'longitude_f' &
.OR. tpreclist(ji)%name == 'level' &
.OR. tpreclist(ji)%name == 'level_w' &
.OR. tpreclist(ji)%name == 'time' ) THEN
tpreclist(ji)%tbw = .FALSE.
tpreclist(ji)%tbr = .FALSE.
tpreclist(ji)%found = .FALSE.
ELSE
CALL FIND_FIELD_ID_FROM_MNHNAME(tpreclist(ji)%name,IID,IRESP,ONOWARNING=.TRUE.)
IF (IRESP==0) THEN
tpreclist(ji)%TFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
! Determine TDIMS
IF (runmode==MODELFI2CDF) THEN
ALLOCATE(tpreclist(ji)%TDIMS(tpreclist(ji)%TFIELD%NDIMS))
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_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// &
' => ignored')
tpreclist(ji)%tbw = .FALSE.
tpreclist(ji)%tbr = .FALSE.
tpreclist(ji)%found = .FALSE.
CYCLE
END IF
ELSE !Field not found in list, try to determine characteristics
tpreclist(ji)%TFIELD%CMNHNAME = TRIM(tpreclist(ji)%name)
tpreclist(ji)%TFIELD%CSTDNAME = ''
!Set in IO_Metadata_get_nc4 (and not used for LFI) tpreclist(ji)%TFIELD%CLONGNAME = TRIM(tpreclist(ji)%name)
!Set in IO_Metadata_get_nc4 (and not used for LFI) tpreclist(ji)%TFIELD%CUNITS = ''
tpreclist(ji)%TFIELD%CDIR = 'XY' !Assumption...
tpreclist(ji)%TFIELD%CLBTYPE = 'NONE'
!Set in IO_Metadata_get_nc4 (and not used for LFI) tpreclist(ji)%TFIELD%CCOMMENT = ''
!
IF (runmode==MODELFI2CDF) THEN
tpreclist(ji)%TFIELD%NGRID = 1 !Assumption
tpreclist(ji)%TFIELD%NTYPE = TYPEREAL !Assumption
WRITE(YTYPE,'( A )') 'REAL (forced)'
IF (tpreclist(ji)%NSIZE>1) THEN
ALLOCATE(tpreclist(ji)%TDIMS(3))
! 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_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)%nlen==1) THEN
CALL PRINT_MSG(NVERB_DEBUG,'IO','parse_infiles',tpreclist(ji)%TFIELD%CMNHNAME//': try 2D')
!Try again with 2D
tpreclist(ji)%TFIELD%NDIMS = 2
CALL IO_Dimids_guess_nc4(outfiles(idx_out)%TFILE,tpreclist(ji)%TFIELD,&
tpreclist(ji)%NSIZE,tpreclist(ji)%TDIMS,IRESP)
END IF
!
IF (IRESP/=0 .OR. tpreclist(ji)%TDIMS(2)%nlen==1) THEN
CALL PRINT_MSG(NVERB_DEBUG,'IO','parse_infiles',tpreclist(ji)%TFIELD%CMNHNAME//': try 1D')
!Try again with 1D
tpreclist(ji)%TFIELD%NDIMS = 1
tpreclist(ji)%TFIELD%CDIR = '--' !Assumption...
CALL IO_Dimids_guess_nc4(outfiles(idx_out)%TFILE,tpreclist(ji)%TFIELD,&
tpreclist(ji)%NSIZE,tpreclist(ji)%TDIMS,IRESP)
END IF
!
IF (IRESP/=0) THEN !Could not find valid characteristics
tpreclist(ji)%tbw = .FALSE.
tpreclist(ji)%tbr = .FALSE.
tpreclist(ji)%found = .FALSE.
CYCLE
END IF
ELSE !NSIZE==0
tpreclist(ji)%TFIELD%CDIR = '--'
tpreclist(ji)%TFIELD%NDIMS = 0
tpreclist(ji)%TFIELD%NGRID = 0
END IF
tpreclist(ji)%TFIELD%LTIMEDEP = .FALSE. !Assumption
ELSE ! Input file is netCDF
tpreclist(ji)%TFIELD%NGRID = tpreclist(ji)%NGRID_FILE
SELECT CASE(tpreclist(ji)%NTYPE_FILE)
CASE (NF90_INT1) !NF90_INT1=NF90_BYTE
tpreclist(ji)%TFIELD%NTYPE = TYPELOG
tpreclist(ji)%TFIELD%NDIMS = tpreclist(ji)%NDIMS_FILE
WRITE(YTYPE,'( A )') 'LOGICAL'
CASE (NF90_CHAR)
tpreclist(ji)%TFIELD%NTYPE = TYPECHAR
tpreclist(ji)%TFIELD%NDIMS = tpreclist(ji)%NDIMS_FILE-1
WRITE(YTYPE,'( A )') 'CHARACTER'
CASE (NF90_INT,NF90_INT64)
tpreclist(ji)%TFIELD%NTYPE = TYPEINT
tpreclist(ji)%TFIELD%NDIMS = tpreclist(ji)%NDIMS_FILE
WRITE(YTYPE,'( A )') 'INTEGER'
CASE (NF90_FLOAT,NF90_DOUBLE)
tpreclist(ji)%TFIELD%NTYPE = TYPEREAL
tpreclist(ji)%TFIELD%NDIMS = tpreclist(ji)%NDIMS_FILE
WRITE(YTYPE,'( A )') 'REAL'
CASE DEFAULT
tpreclist(ji)%TFIELD%NTYPE = TYPEUNDEF
tpreclist(ji)%TFIELD%NDIMS = tpreclist(ji)%NDIMS_FILE
WRITE(YTYPE,'( A )') 'UNKNOWN'
END SELECT
tpreclist(ji)%TFIELD%CUNITS = tpreclist(ji)%CUNITS_FILE
IF (tpreclist(ji)%TFIELD%NDIMS<2) THEN
tpreclist(ji)%TFIELD%CDIR = '--' !Assumption
ELSE
tpreclist(ji)%TFIELD%CDIR = 'XY' !Assumption
END IF
fsize = leng
END IF
CALL IO_Dims_fill_nc4(outfiles(idx_out)%TFILE,tpreclist(ji),IRESP)
tpreclist(ji)%dim=>get_dimCDF(fsize)
IF (tpreclist(ji)%NDIMS_FILE>0) THEN
IF (tpreclist(ji)%CDIMNAMES_FILE(tpreclist(ji)%NDIMS_FILE)=='time') THEN
tpreclist(ji)%TFIELD%NDIMS = tpreclist(ji)%TFIELD%NDIMS - 1
END IF
END IF
!
IF (IRESP/=0) THEN
tpreclist(ji)%tbw = .FALSE.
tpreclist(ji)%tbr = .FALSE.
tpreclist(ji)%found = .FALSE.
END IF
END IF
!
IF (runmode==MODELFI2CDF) THEN
tpreclist(ji)%TFIELD%NGRID = NGRIDUNKNOWN !Assumption
IF(tpreclist(ji)%TFIELD%NDIMS == 0 .OR. tpreclist(ji)%TFIELD%NTYPE == TYPECHAR) THEN
tpreclist(ji)%TFIELD%NGRID = 0
END IF
END IF
!
IF (.NOT.tpreclist(ji)%found) THEN
CALL PRINT_MSG(NVERB_WARNING,'IO','parse_infiles','can not guess dimensions for '// &
TRIM(tpreclist(ji)%TFIELD%CMNHNAME)//' => ignored')
ELSE
IF (tpreclist(ji)%TFIELD%LTIMEDEP) THEN
WRITE(YNDIMS,'( I1 )') tpreclist(ji)%TFIELD%NDIMS-1
CALL PRINT_MSG(NVERB_WARNING,'IO','unknown field',tpreclist(ji)%TFIELD%CMNHNAME//' seems to be '// &
YNDIMS//'D of type '//TRIM(YTYPE)//' (time dependent)')
ELSE
WRITE(YNDIMS,'( I1 )') tpreclist(ji)%TFIELD%NDIMS
CALL PRINT_MSG(NVERB_WARNING,'IO','unknown field',tpreclist(ji)%TFIELD%CMNHNAME//' seems to be '// &
YNDIMS//'D of type '//TRIM(YTYPE))
END IF
END IF
END IF
END IF
END DO
!Complete info for calculated variables
IF (nbvar_calc>0) THEN
!Calculated variables
!Done after previous loop to reuse metadata from component variables
!Derive metadata from its components
!If same value for all components => take it
!If not => nothing or default value
!Check sizes: must be the same for all
DO ji=1,maxvar
IF (.NOT.tpreclist(ji)%calc) CYCLE
tpreclist(ji)%TYPE = tpreclist(tpreclist(ji)%src(1))%TYPE
tpreclist(ji)%grid = tpreclist(tpreclist(ji)%src(1))%grid
tpreclist(ji)%dim => tpreclist(tpreclist(ji)%src(1))%dim
!TODO: cleaner length!
ALLOCATE(character(len=256) :: tpreclist(ji)%comment)
tpreclist(ji)%comment='Constructed from'
jj = 1
DO WHILE (tpreclist(ji)%src(jj)>0 .AND. jj.LE.MAXRAW)
tpreclist(ji)%comment = trim(tpreclist(ji)%comment)//' '//trim(tpreclist(tpreclist(ji)%src(jj))%name)
IF (jj<MAXRAW .AND. tpreclist(ji)%src(jj+1)>0) THEN
tpreclist(ji)%comment = trim(tpreclist(ji)%comment)//' +'
END IF
jj=jj+1
END DO
END DO
END IF
PRINT *,'Nombre de dimensions = ', size_dimCDF()
#ifdef LOWMEM
DEALLOCATE(iwork)
#endif
END SUBROUTINE parse_infiles
SUBROUTINE read_data_lfi(infiles, nbvar, tpreclist, kbuflen, current_level)
TYPE(filelist_struct), INTENT(IN) :: infiles
INTEGER, INTENT(INOUT) :: nbvar
TYPE(workfield), DIMENSION(:), POINTER :: tpreclist
INTEGER, INTENT(IN) :: kbuflen
INTEGER, INTENT(IN), OPTIONAL :: current_level
INTEGER :: ji,jj
INTEGER :: ndb, nde
LOGICAL :: ladvan
INTEGER :: ich
INTEGER :: fsize,sizemax
CHARACTER(LEN=FM_FIELD_SIZE) :: yrecfm
CHARACTER(LEN=4) :: suffix
#ifdef LOWMEM
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: iwork
#endif
INTEGER(KIND=LFI_INT) :: iresp,ilu,ileng,ipos
CHARACTER(LEN=FM_FIELD_SIZE) :: var_calc
CHARACTER(LEN=FM_FIELD_SIZE),dimension(MAXRAW) :: var_raw
ilu = infiles%files(1)%lun_id
IF (present(current_level)) THEN
write(suffix,'(I4.4)') current_level
ElSE
suffix=''
END IF
#ifdef LOWMEM
ALLOCATE(iwork(kbuflen))
IF (.NOT.tpreclist(ji)%calc ) CYCLE
!
tpreclist(ji)%TFIELD%CMNHNAME = tpreclist(ji)%name
tpreclist(ji)%TFIELD%CSTDNAME = ''
tpreclist(ji)%TFIELD%CLONGNAME = tpreclist(ji)%name
!
GOK = .TRUE.
DO jj=1,tpreclist(ji)%NSRC
idx_var = tpreclist(ji)%src(jj)
IF(.NOT.tpreclist(idx_var)%found) THEN
CALL PRINT_MSG(NVERB_WARNING,'IO','parse_infiles','some components for calculated variable ' &
//TRIM(tpreclist(ji)%name)//' are not known => ignored')
tpreclist(ji)%tbw = .FALSE.
tpreclist(ji)%tbr = .FALSE.
tpreclist(ji)%found = .FALSE.
GOK = .FALSE.
EXIT
END IF
END DO
!
IF (GOK) THEN
idx_var = tpreclist(ji)%src(1)
tpreclist(ji)%TFIELD%CUNITS = tpreclist(idx_var)%TFIELD%CUNITS
tpreclist(ji)%TFIELD%CDIR = tpreclist(idx_var)%TFIELD%CDIR
tpreclist(ji)%TFIELD%CLBTYPE = tpreclist(idx_var)%TFIELD%CLBTYPE
tpreclist(ji)%TFIELD%CCOMMENT = TRIM(tpreclist(ji)%name)//'='//TRIM(tpreclist(idx_var)%name)
IF (tpreclist(ji)%NSRC>1) tpreclist(ji)%TFIELD%CCOMMENT = TRIM(tpreclist(ji)%TFIELD%CCOMMENT)//'+'
tpreclist(ji)%TFIELD%NGRID = tpreclist(idx_var)%TFIELD%NGRID
tpreclist(ji)%TFIELD%NTYPE = tpreclist(idx_var)%TFIELD%NTYPE
tpreclist(ji)%TFIELD%NDIMS = tpreclist(idx_var)%TFIELD%NDIMS
#if 0
tpreclist(ji)%TFIELD%NFILLVALUE
tpreclist(ji)%TFIELD%XFILLVALUE
tpreclist(ji)%TFIELD%NVALIDMIN
tpreclist(ji)%TFIELD%NVALIDMAX
tpreclist(ji)%TFIELD%XVALIDMIN
tpreclist(ji)%TFIELD%XVALIDMAX
#endif
DO jj=2,tpreclist(ji)%NSRC
idx_var = tpreclist(ji)%src(jj)
!
IF (tpreclist(ji)%TFIELD%CUNITS /= tpreclist(idx_var)%TFIELD%CUNITS) THEN
CALL PRINT_MSG(NVERB_WARNING,'IO','parse_infiles','CUNITS is not uniform between components of calculated variable '&
//TRIM(tpreclist(ji)%name)//' => CUNITS not set')
tpreclist(ji)%TFIELD%CUNITS = ''
END IF
!
IF (tpreclist(ji)%TFIELD%CDIR /= tpreclist(idx_var)%TFIELD%CDIR) THEN
CALL PRINT_MSG(NVERB_ERROR,'IO','parse_infiles','CDIR is not uniform between components of calculated variable '&
//TRIM(tpreclist(ji)%name)//' => CDIR=--')
tpreclist(ji)%TFIELD%CDIR = '--'
END IF
!
IF (tpreclist(ji)%TFIELD%CLBTYPE /= tpreclist(idx_var)%TFIELD%CLBTYPE) THEN
CALL PRINT_MSG(NVERB_ERROR,'IO','parse_infiles','CLBTYPE is not uniform between components of calculated variable '&
//TRIM(tpreclist(ji)%name)//' => CLBTYPE=NONE')
tpreclist(ji)%TFIELD%CLBTYPE = 'NONE'
END IF
!
tpreclist(ji)%TFIELD%CCOMMENT = TRIM(tpreclist(ji)%TFIELD%CCOMMENT)//TRIM(tpreclist(idx_var)%name)
IF (jj<tpreclist(ji)%NSRC) tpreclist(ji)%TFIELD%CCOMMENT = TRIM(tpreclist(ji)%TFIELD%CCOMMENT)//'+'
!
IF (tpreclist(ji)%TFIELD%NGRID /= tpreclist(idx_var)%TFIELD%NGRID) THEN
CALL PRINT_MSG(NVERB_WARNING,'IO','parse_infiles','NGRID is not uniform between components of calculated variable '&
//TRIM(tpreclist(ji)%name)//' => NGRID=1')
tpreclist(ji)%TFIELD%NGRID = 1
END IF
!
IF (tpreclist(ji)%TFIELD%NTYPE /= tpreclist(idx_var)%TFIELD%NTYPE) THEN
CALL PRINT_MSG(NVERB_FATAL,'IO','parse_infiles','NTYPE is not uniform between components of calculated variable '&
//TRIM(tpreclist(ji)%name))
tpreclist(ji)%TFIELD%NTYPE = TYPEUNDEF
END IF
!
IF (tpreclist(ji)%TFIELD%NDIMS /= tpreclist(idx_var)%TFIELD%NDIMS) THEN
CALL PRINT_MSG(NVERB_FATAL,'IO','parse_infiles','NDIMS is not uniform between components of calculated variable '&
//TRIM(tpreclist(ji)%name))
END IF
END DO
!
ALLOCATE(tpreclist(ji)%TDIMS(tpreclist(ji)%TFIELD%NDIMS))
tpreclist(ji)%TDIMS = tpreclist(idx_var)%TDIMS
!
END IF
END DO !ji=1,maxvar
END IF !nbvar_calc>0
DO ji=1,nbvar
IF (.NOT.tpreclist(ji)%tbr) CYCLE
yrecfm = trim(tpreclist(ji)%name)//trim(suffix)
CALL LFINFO(iresp,ilu,yrecfm,ileng,ipos)
#ifdef LOWMEM
CALL LFILEC(iresp,ilu,yrecfm,iwork,ileng)
tpreclist(ji)%grid = iwork(1)
#else
CALL LFILEC(iresp,ilu,yrecfm,lfiart(ji)%iwtab,ileng)
tpreclist(ji)%grid = lfiart(ji)%iwtab(1)
#endif
END DO
END SUBROUTINE parse_infiles
#ifdef LOWMEM
DEALLOCATE(iwork)
#endif
END SUBROUTINE read_data_lfi
SUBROUTINE def_ncdf(infiles,outfiles,KNFILES_OUT)
USE MODD_CONF, ONLY: NMNHVERSION
use mode_io_write_nc4, only: IO_Header_write_nc4
SUBROUTINE HANDLE_ERR(status,line)
INTEGER :: status,line
TYPE(TFILE_ELT),DIMENSION(:),INTENT(IN) :: infiles
TYPE(TFILE_ELT),DIMENSION(:),INTENT(IN) :: outfiles
INTEGER, INTENT(IN) :: KNFILES_OUT
IF (status /= NF90_NOERR) THEN
PRINT *, 'line ',line,': ',NF90_STRERROR(status)
STOP
END IF
END SUBROUTINE HANDLE_ERR
CHARACTER(LEN=*),PARAMETER :: YUNKNOWNHIST = 'Previous history is unknown'
SUBROUTINE def_ncdf(outfiles,tpreclist,nbvar,options)
TYPE(filelist_struct), INTENT(IN) :: outfiles
TYPE(workfield),DIMENSION(:),INTENT(INOUT) :: tpreclist
INTEGER, INTENT(IN) :: nbvar
TYPE(option),DIMENSION(:), INTENT(IN) :: options
CHARACTER(LEN=16) :: YMNHVERSION
CHARACTER(LEN=:),ALLOCATABLE :: YHISTORY
INTEGER :: ji
INTEGER(KIND=CDFINT) :: ilen
INTEGER(KIND=CDFINT) :: status
INTEGER(KIND=CDFINT) :: kcdf_id
INTEGER :: compress_level, status
INTEGER :: idx, ji, nbfiles
INTEGER:: kcdf_id
TYPE(dimCDF), POINTER :: tzdim
INTEGER :: invdims
INTEGER :: type_float
INTEGER, DIMENSION(10) :: ivdims
CHARACTER(LEN=20) :: ycdfvar
CALL PRINT_MSG(NVERB_DEBUG,'IO','def_ncdf','called')
nbfiles = outfiles%nbfiles
!Copy history attribute for netCDF files
IF( outfiles(1)%TFILE%CFORMAT=='NETCDF4' ) THEN
IF( infiles(1)%TFILE%CFORMAT=='NETCDF4' ) THEN
status = NF90_INQUIRE_ATTRIBUTE(infiles(1)%TFILE%NNCID, NF90_GLOBAL, 'history', LEN=ilen)
IF (status == NF90_NOERR) THEN
ALLOCATE(CHARACTER(LEN=ilen) :: YHISTORY)
status = NF90_GET_ATT(infiles(1)%TFILE%NNCID, NF90_GLOBAL, 'history', YHISTORY)
ELSE
YHISTORY = YUNKNOWNHIST
END IF
ELSE
YHISTORY = YUNKNOWNHIST
END IF
IF (options(OPTREDUCE)%set) THEN
type_float = NF90_REAL
ELSE
type_float = NF90_DOUBLE
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 IO_Err_handle_nc4( status, 'def_ncdf', 'NF90_PUT_ATT', 'history' )
END DO
END IF
DO ji = 1,nbfiles
kcdf_id = outfiles%files(ji)%lun_id
!Write header for netCDF files
DO ji = 1,KNFILES_OUT
kcdf_id = outfiles(ji)%TFILE%NNCID
! global attributes
status = NF90_PUT_ATT(kcdf_id,NF90_GLOBAL,'Title',VERSION_ID)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
! define DIMENSIONS
tzdim=>first_DimCDF()
DO WHILE(ASSOCIATED(tzdim))
IF (tzdim%create) THEN
status = NF90_DEF_DIM(kcdf_id,tzdim%name,tzdim%len,tzdim%id)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
END IF
tzdim=>tzdim%next
END DO
END DO
PRINT *,'------------- NetCDF DEFINITION ---------------'
! define VARIABLES and ATTRIBUTES
idx = 1
DO ji=1,nbvar
IF (.NOT.tpreclist(ji)%tbw) CYCLE
IF (ASSOCIATED(tpreclist(ji)%dim)) THEN
IF (tpreclist(ji)%dim%create) THEN
invdims = 1
ivdims(1) = tpreclist(ji)%dim%id
ELSE
invdims = tpreclist(ji)%dim%ndims
IF(options(OPTMERGE)%set) invdims=invdims+1 !when merging variables from LFI splitted files
SELECT CASE(invdims)
CASE(2)
ivdims(1)=ptdimx%id
ivdims(2)=ptdimy%id
CASE(3)
ivdims(1)=ptdimx%id
ivdims(2)=ptdimy%id
ivdims(3)=ptdimz%id
CASE(12)
ivdims(1)=ptdimx%id
ivdims(2)=ptdimz%id
invdims = 2 ! on retablit la bonne valeur du nbre de dimension
CASE default
PRINT *,'Fatal error in NetCDF dimension definition'
STOP
END SELECT
END IF
ELSE
! scalar variables
invdims = 0
ivdims(1) = 0 ! ignore dans ce cas
END IF
! Variables definition
!! NetCDF n'aime pas les '%' dans le nom des variables
!! "%" remplaces par '__'
ycdfvar = str_replace(tpreclist(ji)%name,'%','__')
!! ni les '.' remplaces par '--'
ycdfvar = str_replace(ycdfvar,'.','--')
kcdf_id = outfiles%files(idx)%lun_id
SELECT CASE(tpreclist(ji)%TYPE)
CASE (TEXT)
! PRINT *,'TEXT : ',tpreclist(ji)%name
status = NF90_DEF_VAR(kcdf_id,ycdfvar,NF90_CHAR,&
ivdims(:invdims),tpreclist(ji)%id_out)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
CASE (INT,BOOL)
! PRINT *,'INT,BOOL : ',tpreclist(ji)%name
status = NF90_DEF_VAR(kcdf_id,ycdfvar,NF90_INT,&
ivdims(:invdims),tpreclist(ji)%id_out)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
CASE(FLOAT)
! PRINT *,'FLOAT : ',tpreclist(ji)%name
status = NF90_DEF_VAR(kcdf_id,ycdfvar,type_float,&
ivdims(:invdims),tpreclist(ji)%id_out)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
CASE default
PRINT *,'ATTENTION : ',TRIM(tpreclist(ji)%name),' est de&
& TYPE inconnu --> force a REAL'
status = NF90_DEF_VAR(kcdf_id,ycdfvar,type_float,&
ivdims(:invdims),tpreclist(ji)%id_out)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
END SELECT
! Compress data (costly operation for the CPU)
IF (options(OPTCOMPRESS)%set .AND. invdims>0) THEN
compress_level = options(OPTCOMPRESS)%ivalue
status = NF90_DEF_VAR_DEFLATE(kcdf_id,tpreclist(ji)%id_out,1,1,compress_level)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
END IF
! GRID attribute definition
status = NF90_PUT_ATT(kcdf_id,tpreclist(ji)%id_out,'GRID',tpreclist(ji)%grid)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
! COMMENT attribute definition
status = NF90_PUT_ATT(kcdf_id,tpreclist(ji)%id_out,'COMMENT',trim(tpreclist(ji)%comment))
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
IF (options(OPTSPLIT)%set) idx = idx + 1
END DO
DO ji = 1,nbfiles
kcdf_id = outfiles%files(ji)%lun_id
status = NF90_ENDDEF(kcdf_id)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
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 IO_Err_handle_nc4( status, 'def_ncdf', 'NF90_PUT_ATT', 'lfi2cdf_version' )
END DO
END SUBROUTINE def_ncdf
SUBROUTINE fill_ncdf(infiles,outfiles,tpreclist,knaf,kbuflen,options,current_level)
TYPE(filelist_struct), INTENT(IN):: infiles, outfiles
TYPE(workfield), DIMENSION(:),INTENT(IN):: tpreclist
INTEGER, INTENT(IN):: knaf
INTEGER, INTENT(IN):: kbuflen
TYPE(option),DIMENSION(:), INTENT(IN):: options
INTEGER, INTENT(IN), OPTIONAL :: current_level
#ifdef LOWMEM
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: iwork
#endif
INTEGER :: idx, ji,jj
INTEGER :: kcdf_id
INTEGER :: status
INTEGER :: extent, ndims
INTEGER :: ich
INTEGER :: src
INTEGER :: level
INTEGER(KIND=LFI_INT) :: iresp,ilu,ileng,ipos
CHARACTER(LEN=4) :: suffix
INTEGER,DIMENSION(3) :: idims, start
INTEGER,DIMENSION(:),ALLOCATABLE :: itab
REAL(KIND=8),DIMENSION(:),ALLOCATABLE :: xtab
CHARACTER, DIMENSION(:), ALLOCATABLE :: ytab
REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: xtab3d, xtab3d2
INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: itab3d, itab3d2
!
IF (infiles%files(1)%format == LFI_FORMAT) ilu = infiles%files(1)%lun_id
!
IF (present(current_level)) THEN
write(suffix,'(I4.4)') current_level
level = current_level
ElSE
suffix=''
level = 1
END IF
#if LOWMEM
ALLOCATE(iwork(kbuflen))
#endif
ALLOCATE(itab(kbuflen))
ALLOCATE(xtab(kbuflen))
SUBROUTINE fill_files(infiles,outfiles,tpreclist,knaf,options)
USE MODD_TYPE_DATE
TYPE(TFILE_ELT),DIMENSION(:), INTENT(IN) :: infiles
TYPE(TFILE_ELT),DIMENSION(:), INTENT(IN) :: outfiles
TYPE(workfield), DIMENSION(:),INTENT(INOUT) :: tpreclist
INTEGER, INTENT(IN) :: knaf
TYPE(option),DIMENSION(:), INTENT(IN) :: options
INTEGER :: idx, ji, jj
INTEGER :: IDIMS
INTEGER :: INSRC
INTEGER :: ISRC
INTEGER(KIND=CDFINT),DIMENSION(NF90_MAX_VAR_DIMS) :: IDIMLEN
logical,dimension(knaf) :: gtimedep_in, gtimedep_out
CHARACTER(LEN=:), ALLOCATABLE :: YTAB0D
INTEGER, DIMENSION(:), ALLOCATABLE :: ITAB1D, ITAB1D2
INTEGER, DIMENSION(:,:), ALLOCATABLE :: ITAB2D, ITAB2D2
INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: ITAB3D, ITAB3D2
LOGICAL, DIMENSION(:), ALLOCATABLE :: GTAB1D
REAL, DIMENSION(:), ALLOCATABLE :: XTAB1D, XTAB1D2
REAL, DIMENSION(:,:), ALLOCATABLE :: XTAB2D, XTAB2D2
REAL, DIMENSION(:,:,:), ALLOCATABLE :: XTAB3D, XTAB3D2
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XTAB4D, XTAB4D2
TYPE(DATE_TIME) :: TZDATE
TYPE(TFILEDATA) :: TZFILE
CALL PRINT_MSG(NVERB_DEBUG,'IO','fill_files','called')
! For versions of MesoNH <5.4.0, fields were not stored with a time dimension
! ->necessary to remove it when reading and to restore to the correct one when writing
if( infiles(1)%TFILE%NMNHVERSION(1)<5 .OR. &
(infiles(1)%TFILE%NMNHVERSION(1)==5 .AND. infiles(1)%TFILE%NMNHVERSION(2)<4) ) then
gtimedep_in(:) = .false.
else
gtimedep_in(:) = tpreclist(:)%TFIELD%LTIMEDEP
end if
gtimedep_out(:) = tpreclist(:)%TFIELD%LTIMEDEP
idx = 1
DO ji=1,knaf
IF (.NOT.tpreclist(ji)%tbw) CYCLE
kcdf_id = outfiles%files(idx)%lun_id
IF (ASSOCIATED(tpreclist(ji)%dim)) THEN
extent = tpreclist(ji)%dim%len
ndims = tpreclist(ji)%dim%ndims
ELSE
extent = 1
ndims = 0
END IF
idims(:) = 1
if(ndims>0) idims(1) = ptdimx%len
if(ndims>1) idims(2) = ptdimy%len
if(ndims>2) idims(3) = ptdimz%len
if(ndims>3) then
PRINT *,'Too many dimensions'
STOP
endif
SELECT CASE(tpreclist(ji)%TYPE)
CASE (INT,BOOL)
IF (infiles%files(1)%format == LFI_FORMAT) THEN
#if LOWMEM
IF (.NOT.tpreclist(ji)%calc) THEN
CALL LFINFO(iresp,ilu,trim(tpreclist(ji)%name)//trim(suffix),ileng,ipos)
CALL LFILEC(iresp,ilu,trim(tpreclist(ji)%name)//trim(suffix),iwork,ileng)
itab(1:extent) = iwork(3+iwork(2):)
ELSE
src=tpreclist(ji)%src(1)
CALL LFINFO(iresp,ilu,trim(tpreclist(src)%name)//trim(suffix),ileng,ipos)
CALL LFILEC(iresp,ilu,trim(tpreclist(src)%name)//trim(suffix),iwork,ileng)
itab(1:extent) = iwork(3+iwork(2):)
jj = 2
DO WHILE (tpreclist(ji)%src(jj)>0 .AND. jj.LE.MAXRAW)
src=tpreclist(ji)%src(jj)
CALL LFILEC(iresp,ilu,trim(tpreclist(src)%name)//trim(suffix),iwork,ileng)
itab(1:extent) = itab(1:extent) + iwork(3+iwork(2):)
jj=jj+1
END DO
ENDIF
#else
IF (.NOT.tpreclist(ji)%calc) THEN
itab(1:extent) = lfiart(ji)%iwtab(3+lfiart(ji)%iwtab(2):)
ELSE
src=tpreclist(ji)%src(1)
itab(1:extent) = lfiart(src)%iwtab(3+lfiart(src)%iwtab(2):)
jj = 2
DO WHILE (tpreclist(ji)%src(jj)>0 .AND. jj.LE.MAXRAW)
src=tpreclist(ji)%src(jj)
itab(1:extent) = xtab(1:extent) + lfiart(src)%iwtab(3+lfiart(src)%iwtab(2):)
jj=jj+1
END DO
END IF
#endif
IF (.NOT.tpreclist(ji)%tbw) CYCLE
!TODO: works in all cases??? (X, Y, Z dimensions assumed to be ptdimx,y or z)
SELECT CASE(ndims)
CASE (0)
status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id_out,itab(1))
CASE (1)
status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id_out,itab(1:extent),count=(/extent/))
CASE (2)
status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id_out,reshape(itab,(/ptdimx%len,ptdimy%len/)), &
start = (/1,1,level/) )
CASE (3)
status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id_out,reshape(itab,(/ptdimx%len,ptdimy%len,ptdimz%len/)))
CASE DEFAULT
print *,'Error: arrays with ',tpreclist(ji)%dim%ndims,' dimensions are not supported'
END SELECT
ELSE IF (infiles%files(1)%format == NETCDF_FORMAT) THEN
ALLOCATE( itab3d(idims(1),idims(2),idims(3)) )
IF (.NOT.tpreclist(ji)%calc) THEN
status = NF90_GET_VAR(infiles%files(1)%lun_id,tpreclist(ji)%id_in,itab3d)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
ELSE
ALLOCATE( itab3d2(idims(1),idims(2),idims(3)) )
src=tpreclist(ji)%src(1)
status = NF90_GET_VAR(infiles%files(1)%lun_id,tpreclist(src)%id_in,itab3d)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
jj = 2
DO WHILE (tpreclist(ji)%src(jj)>0 .AND. jj.LE.MAXRAW)
src=tpreclist(ji)%src(jj)
status = NF90_GET_VAR(infiles%files(1)%lun_id,tpreclist(src)%id_in,itab3d2)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
itab3d(:,:,:) = itab3d(:,:,:) + itab3d2(:,:,:)
jj=jj+1
END DO
DEALLOCATE(itab3d2)
END IF
IDIMS = tpreclist(ji)%TFIELD%NDIMS
!TODO: not clean, should be done only if merging z-levels
IF (ndims == 2) THEN
start = (/1,1,level/)
ELSE
start = (/1,1,1/)
ENDIF
status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id_out,itab3d,start=start)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
SELECT CASE(tpreclist(ji)%TFIELD%NTYPE)
CASE (TYPEINT)
IDIMLEN(1:IDIMS) = tpreclist(ji)%TDIMS(1:IDIMS)%nlen
DEALLOCATE(itab3d)
IF (.NOT.tpreclist(ji)%calc) THEN
INSRC = 1
ISRC = ji
ELSE
INSRC = tpreclist(ji)%NSRC
ISRC = tpreclist(ji)%src(1)
END IF
CASE (FLOAT)
IF (infiles%files(1)%format == LFI_FORMAT) THEN
#if LOWMEM
IF (.NOT.tpreclist(ji)%calc) THEN
CALL LFINFO(iresp,ilu,trim(tpreclist(ji)%name)//trim(suffix),ileng,ipos)
CALL LFILEC(iresp,ilu,trim(tpreclist(ji)%name)//trim(suffix),iwork,ileng)
xtab(1:extent) = TRANSFER(iwork(3+iwork(2):),(/ 0.0_8 /))
ELSE
src=tpreclist(ji)%src(1)
CALL LFINFO(iresp,ilu,trim(tpreclist(src)%name)//trim(suffix),ileng,ipos)
CALL LFILEC(iresp,ilu,trim(tpreclist(src)%name)//trim(suffix),iwork,ileng)
xtab(1:extent) = TRANSFER(iwork(3+iwork(2):),(/ 0.0_8 /))
jj = 2
DO WHILE (tpreclist(ji)%src(jj)>0 .AND. jj.LE.MAXRAW)
src=tpreclist(ji)%src(jj)
CALL LFILEC(iresp,ilu,trim(tpreclist(src)%name)//trim(suffix),iwork,ileng)
xtab(1:extent) = xtab(1:extent) + TRANSFER(iwork(3+iwork(2):),(/ 0.0_8 /))
jj=jj+1
END DO
ENDIF
#else
IF (.NOT.tpreclist(ji)%calc) THEN
xtab(1:extent) = TRANSFER(lfiart(ji)%iwtab(3+lfiart(ji)%iwtab(2):),(/ 0.0_8 /))
ELSE
src=tpreclist(ji)%src(1)
xtab(1:extent) = TRANSFER(lfiart(src)%iwtab(3+lfiart(src)%iwtab(2):),(/ 0.0_8 /))
jj = 2
DO WHILE (tpreclist(ji)%src(jj)>0 .AND. jj.LE.MAXRAW)
src=tpreclist(ji)%src(jj)
xtab(1:extent) = xtab(1:extent) + TRANSFER(lfiart(src)%iwtab(3+lfiart(src)%iwtab(2):),(/ 0.0_8 /))
jj=jj+1
END DO
END IF
#endif
!TODO: works in all cases??? (X, Y, Z dimensions assumed to be ptdimx,y or z)
SELECT CASE(ndims)
CASE (0)
status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id_out,xtab(1))
CASE (1)
status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id_out,xtab(1:extent),count=(/extent/))
CASE (2)
status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id_out,reshape(xtab,(/ptdimx%len,ptdimy%len/)), &
start = (/1,1,level/) )
CASE (3)
status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id_out,reshape(xtab,(/ptdimx%len,ptdimy%len,ptdimz%len/)))
CASE DEFAULT
print *,'Error: arrays with ',tpreclist(ji)%dim%ndims,' dimensions are not supported'
END SELECT
ELSE IF (infiles%files(1)%format == NETCDF_FORMAT) THEN
ALLOCATE( xtab3d(idims(1),idims(2),idims(3)) )
IF (.NOT.tpreclist(ji)%calc) THEN
status = NF90_GET_VAR(infiles%files(1)%lun_id,tpreclist(ji)%id_in,xtab3d)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
ELSE
ALLOCATE( xtab3d2(idims(1),idims(2),idims(3)) )
src=tpreclist(ji)%src(1)
status = NF90_GET_VAR(infiles%files(1)%lun_id,tpreclist(src)%id_in,xtab3d)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
jj = 2
DO WHILE (tpreclist(ji)%src(jj)>0 .AND. jj.LE.MAXRAW)
src=tpreclist(ji)%src(jj)
status = NF90_GET_VAR(infiles%files(1)%lun_id,tpreclist(src)%id_in,xtab3d2)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
xtab3d(:,:,:) = xtab3d(:,:,:) + xtab3d2(:,:,:)
jj=jj+1
END DO
DEALLOCATE(xtab3d2)
END IF
!TODO: not clean, should be done only if merging z-levels
IF (ndims == 2) THEN
start = (/1,1,level/)
ELSE
start = (/1,1,1/)
ENDIF
status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id_out,xtab3d,start=start)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
DEALLOCATE(xtab3d)
tpreclist(ISRC)%TFIELD%LTIMEDEP = gtimedep_in(ISRC)
SELECT CASE(IDIMS)
CASE (0)
ALLOCATE(ITAB1D(1))
IF (tpreclist(ji)%calc) ALLOCATE(ITAB1D2(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_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_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB2D)
CASE (3)
ALLOCATE(ITAB3D(IDIMLEN(1),IDIMLEN(2),IDIMLEN(3)))
IF (tpreclist(ji)%calc) ALLOCATE(ITAB3D2(IDIMLEN(1),IDIMLEN(2),IDIMLEN(3)))
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB3D)
CASE DEFAULT
CALL PRINT_MSG(NVERB_WARNING,'IO','fill_files','too many dimensions for ' &
//TRIM(tpreclist(ISRC)%name)//' => ignored')
CYCLE
END SELECT
DO JJ=2,INSRC
ISRC = tpreclist(ji)%src(jj)
tpreclist(ISRC)%TFIELD%LTIMEDEP = gtimedep_in(ISRC)
SELECT CASE(IDIMS)
CASE (0)
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB1D2(1))
ITAB1D(1) = ITAB1D(1) + ITAB1D2(1)
CASE (1)
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB1D2)
ITAB1D(:) = ITAB1D(:) + ITAB1D2(:)
CASE (2)
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB2D2)
ITAB2D(:,:) = ITAB2D(:,:) + ITAB2D2(:,:)
CASE (3)
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB3D2)
ITAB3D(:,:,:) = ITAB3D(:,:,:) + ITAB3D2(:,:,:)
END SELECT
END DO
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_out(ji)
SELECT CASE(IDIMS)
CASE (0)
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,ITAB1D(1))
DEALLOCATE(ITAB1D)
IF (tpreclist(ji)%calc) DEALLOCATE(ITAB1D2)
CASE (1)
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,ITAB1D)
DEALLOCATE(ITAB1D)
IF (tpreclist(ji)%calc) DEALLOCATE(ITAB1D2)
CASE (2)
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,ITAB2D)
DEALLOCATE(ITAB2D)
IF (tpreclist(ji)%calc) DEALLOCATE(ITAB2D2)
CASE (3)
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,ITAB3D)
DEALLOCATE(ITAB3D)
IF (tpreclist(ji)%calc) DEALLOCATE(ITAB3D2)
END SELECT
CASE (TYPELOG)
IDIMLEN(1:IDIMS) = tpreclist(ji)%TDIMS(1:IDIMS)%nlen
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_in(ji)
SELECT CASE(IDIMS)
CASE (0)
ALLOCATE(GTAB1D(1))
CALL IO_Field_read (INFILES(1)%TFILE, tpreclist(ji)%TFIELD,GTAB1D(1))
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_out(ji)
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,GTAB1D(1))
DEALLOCATE(GTAB1D)
CASE (1)
ALLOCATE(GTAB1D(IDIMLEN(1)))
CALL IO_Field_read (INFILES(1)%TFILE, tpreclist(ji)%TFIELD,GTAB1D)
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_out(ji)
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 ' &
//TRIM(tpreclist(ji)%name)//' => ignored')
CYCLE
END SELECT
CASE (TYPEREAL)
IDIMLEN(1:IDIMS) = tpreclist(ji)%TDIMS(1:IDIMS)%nlen
IF (.NOT.tpreclist(ji)%calc) THEN
INSRC = 1
ISRC = ji
ELSE
INSRC = tpreclist(ji)%NSRC
ISRC = tpreclist(ji)%src(1)
END IF
CASE (TEXT)
IF (infiles%files(1)%format == LFI_FORMAT) THEN
ALLOCATE(ytab(extent))
DO jj=1,extent
#if LOWMEM
ich = iwork(2+iwork(2)+jj)
#else
ich = lfiart(ji)%iwtab(2+lfiart(ji)%iwtab(2)+jj)
#endif
ytab(jj) = CHAR(ich)
END DO
status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id_out,ytab,count=(/extent/))
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
DEALLOCATE(ytab)
ELSE IF (infiles%files(1)%format == NETCDF_FORMAT) THEN
status = NF90_GET_VAR(infiles%files(1)%lun_id,tpreclist(ji)%id_in,ytab,count=(/extent/))
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id_out,ytab,count=(/extent/))
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
END IF
CASE default
IF (infiles%files(1)%format == LFI_FORMAT) THEN
#if LOWMEM
IF (.NOT.tpreclist(ji)%calc) THEN
CALL LFINFO(iresp,ilu,trim(tpreclist(ji)%name)//trim(suffix),ileng,ipos)
CALL LFILEC(iresp,ilu,trim(tpreclist(ji)%name)//trim(suffix),iwork,ileng)
xtab(1:extent) = TRANSFER(iwork(3+iwork(2):),(/ 0.0_8 /))
ELSE
src=tpreclist(ji)%src(1)
CALL LFINFO(iresp,ilu,trim(tpreclist(src)%name)//trim(suffix),ileng,ipos)
CALL LFILEC(iresp,ilu,trim(tpreclist(src)%name)//trim(suffix),iwork,ileng)
xtab(1:extent) = TRANSFER(iwork(3+iwork(2):),(/ 0.0_8 /))
jj = 2
DO WHILE (tpreclist(ji)%src(jj)>0 .AND. jj.LE.MAXRAW)
src=tpreclist(ji)%src(jj)
CALL LFILEC(iresp,ilu,trim(tpreclist(src)%name)//trim(suffix),iwork,ileng)
xtab(1:extent) = xtab(1:extent) + TRANSFER(iwork(3+iwork(2):),(/ 0.0_8 /))
jj=jj+1
END DO
ENDIF
#else
IF (.NOT.tpreclist(ji)%calc) THEN
xtab(1:extent) = TRANSFER(lfiart(ji)%iwtab(3+lfiart(ji)%iwtab(2):),(/ 0.0_8 /))
ELSE
src=tpreclist(ji)%src(1)
xtab(1:extent) = TRANSFER(lfiart(src)%iwtab(3+lfiart(src)%iwtab(2):),(/ 0.0_8 /))
jj = 2
DO WHILE (tpreclist(ji)%src(jj)>0 .AND. jj.LE.MAXRAW)
src=tpreclist(ji)%src(jj)
xtab(1:extent) = xtab(1:extent) + TRANSFER(lfiart(src)%iwtab(3+lfiart(src)%iwtab(2):),(/ 0.0_8 /))
jj=jj+1
END DO
END IF
#endif
!TODO: works in all cases??? (X, Y, Z dimensions assumed to be ptdimx,y or z)
SELECT CASE(ndims)
CASE (0)
status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id_out,xtab(1))
CASE (1)
status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id_out,xtab(1:extent),count=(/extent/))
CASE (2)
status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id_out,reshape(xtab,(/ptdimx%len,ptdimy%len/)), &
start = (/1,1,level/) )
CASE (3)
status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id_out,reshape(xtab,(/ptdimx%len,ptdimy%len,ptdimz%len/)))
CASE DEFAULT
print *,'Error: arrays with ',tpreclist(ji)%dim%ndims,' dimensions are not supported'
END SELECT
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
ELSE IF (infiles%files(1)%format == NETCDF_FORMAT) THEN
print *,'Error: unknown datatype'
STOP
tpreclist(ISRC)%TFIELD%LTIMEDEP = gtimedep_in(ISRC)
SELECT CASE(IDIMS)
CASE (0)
ALLOCATE(XTAB1D(1))
IF (tpreclist(ji)%calc) ALLOCATE(XTAB1D2(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_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_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)))
!Hack not very clean: 3D LB fields are not split
!If NSUBFILES_IOZ is set to 0, IO_Field_read will read it as a non-split field
!CAUTION: there are no guarantee the IO_Field_read will continue to use this information that way...
if ( tpreclist(ji)%tfield%clbtype /= 'NONE' .or. tpreclist(ji)%name(1:2) == 'LB' ) then
tzfile = infiles(1)%tfile
tzfile%nsubfiles_ioz=0
call IO_Field_read(tzfile,tpreclist(isrc)%tfield,xtab3d)
else
call IO_Field_read(infiles(1)%tfile,tpreclist(isrc)%tfield,xtab3d)
end if
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_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')
CYCLE
END SELECT
DO JJ=2,INSRC
ISRC = tpreclist(ji)%src(jj)
tpreclist(ISRC)%TFIELD%LTIMEDEP = gtimedep_in(ISRC)
SELECT CASE(IDIMS)
CASE (0)
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB1D2(1))
XTAB1D(1) = XTAB1D(1) + XTAB1D2(1)
CASE (1)
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB1D2)
XTAB1D(:) = XTAB1D(:) + XTAB1D2(:)
CASE (2)
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB2D2)
XTAB2D(:,:) = XTAB2D(:,:) + XTAB2D2(:,:)
CASE (3)
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB3D2)
XTAB3D(:,:,:) = XTAB3D(:,:,:) + XTAB3D2(:,:,:)
CASE (4)
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB4D2)
XTAB4D(:,:,:,:) = XTAB4D(:,:,:,:) + XTAB4D2(:,:,:,:)
END SELECT
END DO
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_out(ji)
SELECT CASE(IDIMS)
CASE (0)
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,XTAB1D(1))
DEALLOCATE(XTAB1D)
IF (tpreclist(ji)%calc) DEALLOCATE(XTAB1D2)
CASE (1)
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,XTAB1D)
DEALLOCATE(XTAB1D)
IF (tpreclist(ji)%calc) DEALLOCATE(XTAB1D2)
CASE (2)
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,XTAB2D)
DEALLOCATE(XTAB2D)
IF (tpreclist(ji)%calc) DEALLOCATE(XTAB2D2)
CASE (3)
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,XTAB3D)
DEALLOCATE(XTAB3D)
IF (tpreclist(ji)%calc) DEALLOCATE(XTAB3D2)
CASE (4)
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,XTAB4D)
DEALLOCATE(XTAB4D)
IF (tpreclist(ji)%calc) DEALLOCATE(XTAB4D2)
END SELECT
CASE (TYPECHAR)
ISRC = ji
IF (IDIMS/=0) THEN
CALL PRINT_MSG(NVERB_WARNING,'IO','fill_files','too many dimensions for ' &
//TRIM(tpreclist(ISRC)%name)//' => ignored')
CYCLE
END IF
END SELECT
if (options(OPTSPLIT)%set) idx = idx + 1
END DO
DEALLOCATE(itab,xtab)
#if LOWMEM
DEALLOCATE(iwork)
#endif
END SUBROUTINE fill_ncdf
SUBROUTINE build_lfi(infiles,outfiles,tpreclist,kbuflen)
TYPE(filelist_struct), INTENT(IN) :: infiles, outfiles
TYPE(workfield), DIMENSION(:), INTENT(IN) :: tpreclist
INTEGER, INTENT(IN) :: kbuflen
INTEGER :: kcdf_id, status
INTEGER :: ivar,ji,jj,ndims
INTEGER,DIMENSION(3) :: idims
INTEGER(KIND=8), DIMENSION(:), POINTER :: iwork
INTEGER(KIND=8), DIMENSION(:), POINTER :: idata
REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: xtab3d
INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: itab3d
CHARACTER, DIMENSION(:), ALLOCATABLE :: ytab
CHARACTER(LEN=FM_FIELD_SIZE) :: yrecfm
INTEGER :: iartlen, idlen, icomlen
INTEGER(KIND=LFI_INT) :: iresp,ilu,iartlen8
ALLOCATE(CHARACTER(LEN=tpreclist(ji)%NSIZE)::YTAB0D)
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_in(ji)
CALL IO_Field_read (INFILES(1)%TFILE, tpreclist(ji)%TFIELD,YTAB0D)
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_out(ji)
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,YTAB0D)
DEALLOCATE(YTAB0D)
ilu = outfiles%files(1)%lun_id
kcdf_id = infiles%files(1)%lun_id
! Un article LFI est compose de :
! - 1 entier identifiant le numero de grille
! - 1 entier contenant la taille du commentaire
! - le commentaire code en entier 64 bits
! - les donnees proprement dites
CASE (TYPEDATE)
ISRC = ji
PRINT *,'Taille buffer = ',2+kbuflen
IF (IDIMS/=0) THEN
CALL PRINT_MSG(NVERB_WARNING,'IO','fill_files','too many dimensions for ' &
//TRIM(tpreclist(ISRC)%name)//' => ignored')
CYCLE
END IF
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_in(ji)
CALL IO_Field_read (INFILES(1)%TFILE, tpreclist(ji)%TFIELD%CMNHNAME,TZDATE)
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_out(ji)
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,TZDATE)
ALLOCATE(iwork(2+kbuflen))
DO ivar=1,SIZE(tpreclist)
icomlen = LEN(tpreclist(ivar)%comment)
CASE default
ISRC = ji
! traitement Grille et Commentaire
iwork(1) = tpreclist(ivar)%grid
iwork(2) = icomlen
DO jj=1,iwork(2)
iwork(2+jj)=ICHAR(tpreclist(ivar)%comment(jj:jj))
END DO
CALL PRINT_MSG(NVERB_WARNING,'IO','fill_files','invalid datatype for ' &
//TRIM(tpreclist(ISRC)%name)//' => ignored')
IF (ASSOCIATED(tpreclist(ivar)%dim)) THEN
idlen = tpreclist(ivar)%dim%len
ndims = tpreclist(ivar)%dim%ndims
ELSE
idlen = 1
ndims = 0
END IF
idims(:) = 1
if(ndims>0) idims(1) = ptdimx%len
if(ndims>1) idims(2) = ptdimy%len
if(ndims>2) idims(3) = ptdimz%len
if(ndims>3) then
PRINT *,'Too many dimensions'
STOP
endif
iartlen = 2+icomlen+idlen
idata=>iwork(3+icomlen:iartlen)
SELECT CASE(tpreclist(ivar)%TYPE)
CASE(INT,BOOL)
ALLOCATE( itab3d(idims(1),idims(2),idims(3)) )
status = NF90_GET_VAR(kcdf_id,tpreclist(ivar)%id_in,itab3d)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
! PRINT *,'INT,BOOL --> ',tpreclist(ivar)%name,',len = ',idlen
idata(1:idlen) = RESHAPE( itab3d , (/ idims(1)*idims(2)*idims(3) /) )
DEALLOCATE(itab3d)
CASE(FLOAT)
ALLOCATE( xtab3d(idims(1),idims(2),idims(3)) )
status = NF90_GET_VAR(kcdf_id,tpreclist(ivar)%id_in,xtab3d)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
! PRINT *,'FLOAT --> ',tpreclist(ivar)%name,',len = ',idlen
idata(1:idlen) = RESHAPE( TRANSFER(xtab3d,(/ 0_8 /),idlen) , (/ idims(1)*idims(2)*idims(3) /) )
DEALLOCATE(xtab3d)
CASE(TEXT)
ALLOCATE(ytab(idlen))
status = NF90_GET_VAR(kcdf_id,tpreclist(ivar)%id_in,ytab)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
! PRINT *,'TEXT --> ',tpreclist(ivar)%name,',len = ',idlen
DO jj=1,idlen
idata(jj) = ICHAR(ytab(jj))
END DO
DEALLOCATE(ytab)
CASE default
ALLOCATE( xtab3d(idims(1),idims(2),idims(3)) )
status = NF90_GET_VAR(kcdf_id,tpreclist(ivar)%id_in,xtab3d)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
PRINT *,'Default (ERROR) -->',tpreclist(ivar)%name,',len = ',idlen
idata(1:idlen) = RESHAPE( TRANSFER(xtab3d,(/ 0_8 /),idlen) , (/ idims(1)*idims(2)*idims(3) /) )
DEALLOCATE(xtab3d)
END SELECT
! Attention restoration des '%' dans le nom des champs LFI
yrecfm = str_replace(tpreclist(ivar)%name,'__','%')
! et des '.'
yrecfm = str_replace(yrecfm,'--','.')
iartlen8 = iartlen
CALL LFIECR(iresp,ilu,yrecfm,iwork,iartlen8)
END SELECT
if (options(OPTSPLIT)%set) idx = idx + 1
END DO
DEALLOCATE(iwork)
END SUBROUTINE build_lfi
SUBROUTINE UPDATE_VARID_IN(infiles,hinfile,tpreclist,nbvar,current_level)
!Update the id_in for netCDF files (could change from one file to the other)
TYPE(filelist_struct), INTENT(IN) :: infiles
CHARACTER(LEN=*), INTENT(IN) :: hinfile
TYPE(workfield), DIMENSION(:), INTENT(INOUT) :: tpreclist
INTEGER, INTENT(IN) :: nbvar
INTEGER, INTENT(IN) :: current_level
INTEGER :: ji, status
CHARACTER(len=4) :: suffix
if (infiles%files(1)%format /= NETCDF_FORMAT) return
END SUBROUTINE fill_files
SUBROUTINE OPEN_FILES(infiles,outfiles,KNFILES_OUT,hinfile,houtfile,nbvar_infile,options,runmode)
USE MODD_CONF, ONLY: LCARTESIAN
USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
USE MODD_CONFZ, ONLY: NB_PROCIO_R
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, XXHATM, XYHAT, XYHATM, XZHAT, XZHATM, &
XXHAT_ll, XYHAT_ll, XXHATM_ll, XYHATM_ll
USE MODD_IO, ONLY: LIOCDF4
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
USE MODD_PARAMETERS_ll, ONLY: JPHEXT_ll=>JPHEXT, JPVEXT_ll=>JPVEXT
USE MODD_TIME_n, ONLY: TDTCUR, TDTMOD
USE MODE_IO_FILE, ONLY: IO_FILE_OPEN, IO_FILE_CLOSE
USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST
USE MODE_SET_GRID, ONLY: INTERP_VERGRID_TO_MASSPOINTS
TYPE(TFILE_ELT),DIMENSION(:),INTENT(OUT) :: infiles
TYPE(TFILE_ELT),DIMENSION(:),INTENT(OUT) :: outfiles
INTEGER, INTENT(OUT) :: KNFILES_OUT
CHARACTER(LEN=*), INTENT(IN) :: hinfile
CHARACTER(LEN=*), INTENT(IN) :: houtfile
INTEGER, INTENT(OUT) :: nbvar_infile
TYPE(option),DIMENSION(:), INTENT(IN) :: options
INTEGER, INTENT(IN) :: runmode
character(len=:), allocatable :: yunits
INTEGER :: idx, IRESP2
integer :: iiu, iju, iku
integer :: inb_procio_r_save
INTEGER(KIND=CDFINT) :: ioldmode
INTEGER(KIND=CDFINT) :: istatus
INTEGER(KIND=CDFINT) :: ivar_id
integer(kind=CDFINT) :: ilen
INTEGER(KIND=LFIINT) :: ilu,iresp
logical :: gok
CALL PRINT_MSG(NVERB_DEBUG,'IO','OPEN_FILES','called')
KNFILES_OUT = 0
!
! Infiles
!
IF (runmode == MODECDF2CDF .OR. runmode == MODECDF2LFI) THEN
!
! NetCDF
!
CALL IO_FILE_ADD2LIST(INFILES(1)%TFILE,HINFILE,'MNH','READ',HFORMAT='NETCDF4')
CALL IO_FILE_OPEN(INFILES(1)%TFILE)
istatus = NF90_INQUIRE( infiles(1)%tfile%nncid, nvariables=nbvar_infile )
if (istatus /= NF90_NOERR) then
call Print_msg( NVERB_FATAL, 'IO', 'OPEN_FILES', 'NF90_INQUIRE for ' &
// trim(infiles(1)%tfile%cname) // '.nc: ' // NF90_STRERROR(istatus) )
end if
!Open fallback file if provided
if ( options( OPTFALLBACK )%set ) then
inb_procio_r_save = NB_PROCIO_R
NB_PROCIO_R = 1
CALL IO_FILE_ADD2LIST(INFILES(2)%TFILE,options( OPTFALLBACK )%cvalue,'MNH','READ',HFORMAT='NETCDF4')
CALL IO_FILE_OPEN(INFILES(2)%TFILE)
NB_PROCIO_R = inb_procio_r_save
end if
ELSE
!
! LFI
!
CALL IO_FILE_ADD2LIST(INFILES(1)%TFILE,HINFILE,'MNH','READ', &
HFORMAT='LFI',KLFIVERB=0)
CALL IO_FILE_OPEN(INFILES(1)%TFILE)
write(suffix,'(I4.4)') current_level
ilu = INFILES(1)%TFILE%NLFIFLU
DO ji=1,nbvar
IF (.NOT.tpreclist(ji)%tbr) CYCLE
status = NF90_INQ_VARID(infiles%files(1)%lun_id,trim(tpreclist(ji)%name)//trim(suffix),tpreclist(ji)%id_in)
IF (status /= NF90_NOERR .AND. tpreclist(ji)%found) THEN
tpreclist(ji)%found=.false.
tpreclist(ji)%tbr=.false.
tpreclist(ji)%tbw=.false.
print *,'Error: variable ',trim(tpreclist(ji)%name),' not found anymore in split file'
END IF
END DO
END SUBROUTINE UPDATE_VARID_IN
SUBROUTINE OPEN_FILES(infiles,outfiles,hinfile,houtfile,nbvar_infile,options,runmode)
TYPE(filelist_struct),INTENT(OUT) :: infiles, outfiles
CHARACTER(LEN=*), INTENT(IN) :: hinfile
CHARACTER(LEN=*), INTENT(IN) :: houtfile
INTEGER , INTENT(OUT) :: nbvar_infile
TYPE(option),DIMENSION(:),INTENT(IN) :: options
INTEGER , INTENT(IN) :: runmode
INTEGER :: extindex
INTEGER(KIND=LFI_INT) :: iresp,iverb,inap,inaf
INTEGER :: idx,status
CHARACTER(LEN=4) :: ypextsrc, ypextdest
LOGICAL :: fexist
INTEGER :: omode
iverb = 0
CALL init_sysfield()
IF (runmode == MODELFI2CDF) THEN
! Cas LFI -> NetCDF
infiles%nbfiles = infiles%nbfiles + 1
idx = infiles%nbfiles
infiles%files(idx)%lun_id = 11
infiles%files(idx)%format = LFI_FORMAT
infiles%files(idx)%status = READING
CALL LFIOUV(iresp,infiles%files(idx)%lun_id,ltrue,hinfile,'OLD',lfalse&
& ,lfalse,iverb,inap,inaf)
infiles%files(idx)%opened = .TRUE.
nbvar_infile = inaf
nbvar_infile = INFILES(1)%TFILE%NLFININAR
IF (options(OPTLIST)%set) THEN
CALL LFILAF(iresp,infiles%files(idx)%lun_id,lfalse)
CALL LFIFER(iresp,infiles%files(idx)%lun_id,'KEEP')
CALL LFILAF(iresp,ilu,lfalse)
CALL IO_FILE_CLOSE(INFILES(1)%TFILE)
return
END IF
!Open fallback file if provided
if ( options( OPTFALLBACK )%set ) then
inb_procio_r_save = NB_PROCIO_R
NB_PROCIO_R = 1
CALL IO_FILE_ADD2LIST(INFILES(2)%TFILE,options( OPTFALLBACK )%cvalue,'UNKNOWN','READ', &
HFORMAT='LFI',KLFIVERB=0)
CALL IO_FILE_OPEN(INFILES(2)%TFILE)
NB_PROCIO_R = inb_procio_r_save
end if
END IF
!
!Read problem dimensions and some grid variables (needed to determine domain size and also by IO_FILE_OPEN to create netCDF files)
JPHEXT = 1
CALL IO_Field_read(INFILES(1)%TFILE,'JPHEXT',JPHEXT,IRESP2)
!If not found in main file, try the fallback one
if ( options( OPTFALLBACK )%set .and. iresp2 /= 0 ) CALL IO_Field_read(INFILES(2)%TFILE,'JPHEXT',JPHEXT,IRESP2)
if ( iresp2 /= 0 ) call Print_msg( NVERB_ERROR, 'IO', 'OPEN_FILES', 'JPHEXT not found')
JPHEXT_ll = JPHEXT
JPVEXT_ll = JPVEXT
!
ALLOCATE(NIMAX_ll,NJMAX_ll,NKMAX)
CALL IO_Field_read(INFILES(1)%TFILE,'IMAX',NIMAX_ll,IRESP2)
!If not found in main file, try the fallback one
if ( options( OPTFALLBACK )%set .and. iresp2 /= 0 ) CALL IO_Field_read(INFILES(2)%TFILE,'IMAX',NIMAX_ll,IRESP2)
if ( iresp2 /= 0 ) call Print_msg( NVERB_ERROR, 'IO', 'OPEN_FILES', 'IMAX not found')
CALL IO_Field_read(INFILES(1)%TFILE,'JMAX',NJMAX_ll,IRESP2)
!If not found in main file, try the fallback one
if ( options( OPTFALLBACK )%set .and. iresp2 /= 0 ) CALL IO_Field_read(INFILES(2)%TFILE,'JMAX',NJMAX_ll,IRESP2)
if ( iresp2 /= 0 ) call Print_msg( NVERB_ERROR, 'IO', 'OPEN_FILES', 'JMAX not found')
CALL IO_Field_read(INFILES(1)%TFILE,'KMAX',NKMAX,IRESP2)
!If not found in main file, try the fallback one
if ( options( OPTFALLBACK )%set .and. iresp2 /= 0 ) CALL IO_Field_read(INFILES(2)%TFILE,'KMAX',NKMAX,IRESP2)
IF (IRESP2/=0) NKMAX = 0
!
CALL IO_Field_read(INFILES(1)%TFILE,'PROGRAM',CPROGRAM_ORIG,IRESP2)
!If not found in main file, try the fallback one
if ( options( OPTFALLBACK )%set .and. iresp2 /= 0 ) CALL IO_Field_read(INFILES(2)%TFILE,'PROGRAM',CPROGRAM_ORIG,IRESP2)
if ( iresp2 /= 0 ) call Print_msg( NVERB_ERROR, 'IO', 'OPEN_FILES', 'PROGRAM not found')
!
ALLOCATE(CSTORAGE_TYPE)
CALL IO_Field_read(INFILES(1)%TFILE,'STORAGE_TYPE',CSTORAGE_TYPE,IRESP2)
!If not found in main file, try the fallback one
if ( options( OPTFALLBACK )%set .and. iresp2 /= 0 ) CALL IO_Field_read(INFILES(2)%TFILE,'STORAGE_TYPE',CSTORAGE_TYPE,IRESP2)
if ( iresp2 /= 0 ) call Print_msg( NVERB_ERROR, 'IO', 'OPEN_FILES', 'STORAGE_TYPE not found')
!
iiu = nimax_ll + 2 * JPHEXT
ALLOCATE( XXHAT(iiu), XXHATM(iiu) )
CALL IO_Field_read(INFILES(1)%TFILE,'XHAT',XXHAT,IRESP2)
!If not found in main file, try the fallback one
if ( options( OPTFALLBACK )%set .and. iresp2 /= 0 ) CALL IO_Field_read(INFILES(2)%TFILE,'XHAT',XXHAT,IRESP2)
if ( iresp2 /= 0 ) call Print_msg( NVERB_ERROR, 'IO', 'OPEN_FILES', 'XHAT not found')
iju = njmax_ll + 2 * JPHEXT
ALLOCATE( XYHAT(iju), XYHATM(iju) )
CALL IO_Field_read(INFILES(1)%TFILE,'YHAT',XYHAT,IRESP2)
!If not found in main file, try the fallback one
if ( options( OPTFALLBACK )%set .and. iresp2 /= 0 ) CALL IO_Field_read(INFILES(2)%TFILE,'YHAT',XYHAT,IRESP2)
if ( iresp2 /= 0 ) call Print_msg( NVERB_ERROR, 'IO', 'OPEN_FILES', 'YHAT not found')
! Interpolations of positions to mass points
XXHATM(1:IIU-1) = 0.5 * XXHAT(1:IIU-1) + 0.5 * XXHAT(2:IIU)
XXHATM( IIU) = 1.5 * XXHAT( IIU) - 0.5 * XXHAT(IIU-1)
XYHATM(1:IJU-1) = 0.5 * XYHAT(1:IJU-1) + 0.5 * XYHAT(2:IJU)
XYHATM( IJU) = 1.5 * XYHAT( IJU) - 0.5 * XYHAT(IJU-1)
! Set global domain boundaries (hypothesis: only 1 process)
XXHAT_ll => XXHAT
XYHAT_ll => XYHAT
XXHATM_ll => XXHATM
XYHATM_ll => XYHATM
CALL IO_Field_read(INFILES(1)%TFILE,'CARTESIAN',LCARTESIAN,IRESP2)
!If not found in main file, try the fallback one
if ( options( OPTFALLBACK )%set .and. iresp2 /= 0 ) CALL IO_Field_read(INFILES(2)%TFILE,'CARTESIAN',LCARTESIAN,IRESP2)
if ( iresp2 /= 0 ) call Print_msg( NVERB_ERROR, 'IO', 'OPEN_FILES', 'CARTESIAN not found')
CALL IO_Field_read(INFILES(1)%TFILE,'LAT0',XLAT0,IRESP2)
!If not found in main file, try the fallback one
if ( options( OPTFALLBACK )%set .and. iresp2 /= 0 ) CALL IO_Field_read(INFILES(2)%TFILE,'LAT0',XLAT0,IRESP2)
if ( iresp2 /= 0 ) call Print_msg( NVERB_ERROR, 'IO', 'OPEN_FILES', 'LAT0 not found')
CALL IO_Field_read(INFILES(1)%TFILE,'LON0',XLON0,IRESP2)
!If not found in main file, try the fallback one
if ( options( OPTFALLBACK )%set .and. iresp2 /= 0 ) CALL IO_Field_read(INFILES(2)%TFILE,'LON0',XLON0,IRESP2)
if ( iresp2 /= 0 ) call Print_msg( NVERB_ERROR, 'IO', 'OPEN_FILES', 'LON0 not found')
CALL IO_Field_read(INFILES(1)%TFILE,'BETA',XBETA,IRESP2)
!If not found in main file, try the fallback one
if ( options( OPTFALLBACK )%set .and. iresp2 /= 0 ) CALL IO_Field_read(INFILES(2)%TFILE,'BETA',XBETA,IRESP2)
if ( iresp2 /= 0 ) call Print_msg( NVERB_ERROR, 'IO', 'OPEN_FILES', 'BETA not found')
IF (.NOT.LCARTESIAN) THEN
CALL IO_Field_read(INFILES(1)%TFILE,'RPK', XRPK, IRESP2)
!If not found in main file, try the fallback one
if ( options( OPTFALLBACK )%set .and. iresp2 /= 0 ) CALL IO_Field_read(INFILES(2)%TFILE,'RPK', XRPK,IRESP2)
if ( iresp2 /= 0 ) call Print_msg( NVERB_ERROR, 'IO', 'OPEN_FILES', 'RPK not found')
CALL IO_Field_read(INFILES(1)%TFILE,'LATORI',XLATORI,IRESP2)
!If not found in main file, try the fallback one
if ( options( OPTFALLBACK )%set .and. iresp2 /= 0 ) CALL IO_Field_read(INFILES(2)%TFILE,'LATORI',XLATORI,IRESP2)
if ( iresp2 /= 0 ) call Print_msg( NVERB_ERROR, 'IO', 'OPEN_FILES', 'LATORI not found')
CALL IO_Field_read(INFILES(1)%TFILE,'LONORI',XLONORI,IRESP2)
!If not found in main file, try the fallback one
if ( options( OPTFALLBACK )%set .and. iresp2 /= 0 ) CALL IO_Field_read(INFILES(2)%TFILE,'LONORI',XLONORI,IRESP2)
if ( iresp2 /= 0 ) call Print_msg( NVERB_ERROR, 'IO', 'OPEN_FILES', 'LONORI not found')
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
iku = nkmax + 2 * JPVEXT
ALLOCATE( XZHAT(iku), XZHATM(iku) )
CALL IO_Field_read(INFILES(1)%TFILE,'ZHAT',XZHAT,IRESP2)
!If not found in main file, try the fallback one
if ( options( OPTFALLBACK )%set .and. iresp2 /= 0 ) CALL IO_Field_read(INFILES(2)%TFILE,'ZHAT',XZHAT,IRESP2)
if ( iresp2 /= 0 ) call Print_msg( NVERB_ERROR, 'IO', 'OPEN_FILES', 'ZHAT not found')
! Interpolations of vertical positions to mass points
CALL INTERP_VERGRID_TO_MASSPOINTS( XZHAT, XZHATM )
ALLOCATE(LSLEVE)
CALL IO_Field_read(INFILES(1)%TFILE,'SLEVE',LSLEVE,IRESP2)
!If not found in main file, try the fallback one
if ( options( OPTFALLBACK )%set .and. iresp2 /= 0 ) CALL IO_Field_read(INFILES(2)%TFILE,'SLEVE',LSLEVE,IRESP2)
if ( iresp2 /= 0 ) call Print_msg( NVERB_ERROR, 'IO', 'OPEN_FILES', 'SLEVE not found')
ALLOCATE(TDTMOD)
CALL IO_Field_read(INFILES(1)%TFILE,'DTMOD',TDTMOD,IRESP2)
IF(IRESP2/=0) DEALLOCATE(TDTMOD)
ALLOCATE(TDTCUR)
CALL IO_Field_read(INFILES(1)%TFILE,'DTCUR',TDTCUR,IRESP2)
IF(IRESP2/=0) DEALLOCATE(TDTCUR)
!If time values were not found, try to get it from the time coordinate
if ( .not. associated( tdtcur ) .and. infiles(1)%tfile%cformat == 'NETCDF4' ) then
gok = .false.
istatus = NF90_INQ_VARID( infiles(1)%tfile%nncid, 'time', ivar_id )
if ( istatus == NF90_NOERR ) then
allocate( tdtcur )
istatus = NF90_GET_VAR( infiles(1)%tfile%nncid, ivar_id, tdtcur%xtime )
if ( istatus == NF90_NOERR ) then
istatus = NF90_INQUIRE_ATTRIBUTE( infiles(1)%tfile%nncid, ivar_id, 'units', len = ilen )
if ( istatus == NF90_NOERR ) then
allocate( character(len = ilen ) :: yunits )
istatus = NF90_GET_ATT( infiles(1)%tfile%nncid, ivar_id, 'units', yunits )
! Extract date from yunits
idx = INDEX( yunits, 'since ' )
Read( yunits(idx+6 :idx+9 ) , '( I4.4 )' ) tdtcur%nyear
Read( yunits(idx+11:idx+12 ), '( I2.2 )' ) tdtcur%nmonth
Read( yunits(idx+14:idx+15 ), '( I2.2 )' ) tdtcur%nday
if ( .not. associated( tdtmod ) ) then
allocate( tdtmod )
tdtmod = tdtcur
tdtmod%xtime = 0.
end if
gok = .true.
end if
end if
end if
if ( .not. gok ) deallocate( tdtcur )
end if
END IF
!
! Outfiles
!
IF (runmode == MODELFI2CDF .OR. runmode == MODECDF2CDF) THEN
!
! NetCDF
!
IF (.NOT.options(OPTSPLIT)%set) THEN
outfiles%nbfiles = outfiles%nbfiles + 1
idx = outfiles%nbfiles
outfiles%files(idx)%format = NETCDF_FORMAT
outfiles%files(idx)%status = WRITING
IF (options(OPTCDF4)%set) THEN
status = NF90_CREATE(houtfile, IOR(NF90_CLOBBER,NF90_NETCDF4), outfiles%files(idx)%lun_id)
ELSE
status = NF90_CREATE(houtfile, IOR(NF90_CLOBBER,NF90_64BIT_OFFSET), outfiles%files(idx)%lun_id)
KNFILES_OUT = KNFILES_OUT + 1
idx = KNFILES_OUT
if ( options(OPTDIR)%set ) then
CALL IO_FILE_ADD2LIST(outfiles(idx)%TFILE,HOUTFILE,'MNH','WRITE', &
HFORMAT='NETCDF4',OOLD=.TRUE., hdirname = options(OPTDIR)%cvalue )
else
CALL IO_FILE_ADD2LIST(outfiles(idx)%TFILE,HOUTFILE,'MNH','WRITE', &
HFORMAT='NETCDF4',OOLD=.TRUE.)
end if
CALL IO_FILE_OPEN(outfiles(idx)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)
IF (options(OPTCOMPRESS)%set) THEN
outfiles(idx)%tfile%LNCCOMPRESS = .TRUE.
outfiles(idx)%tfile%NNCCOMPRESS_LEVEL = options(OPTCOMPRESS)%ivalue
END IF
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
outfiles%files(idx)%opened = .TRUE.
status = NF90_SET_FILL(outfiles%files(idx)%lun_id,NF90_NOFILL,omode)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
!!$ SELECT CASE(omode)
!!$ CASE (NF90_FILL)
!!$ PRINT *,'Ancien mode : NF90_FILL'
!!$ CASE (NF90_NOFILL)
!!$ PRINT *,'Ancien mode : NF90_NOFILL'
!!$ CASE default
!!$ PRINT *, 'Ancien mode : inconnu'
!!$ END SELECT
END IF ! .NOT.osplit
ELSE IF (runmode == MODECDF2CDF) THEN
! Cas netCDF -> netCDF
infiles%nbfiles = infiles%nbfiles + 1
idx = infiles%nbfiles
status = NF90_OPEN(hinfile,NF90_NOWRITE,infiles%files(idx)%lun_id)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
infiles%files(idx)%opened = .TRUE.
infiles%files(idx)%format = NETCDF_FORMAT
infiles%files(idx)%status = READING
status = NF90_INQUIRE(infiles%files(idx)%lun_id, nvariables = nbvar_infile)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
IF (options(OPTREDUCE)%set) THEN
outfiles(idx)%tfile%LNCREDUCE_FLOAT_PRECISION = .TRUE.
END IF
IF (.NOT.options(OPTSPLIT)%set) THEN
outfiles%nbfiles = outfiles%nbfiles + 1
idx = outfiles%nbfiles
istatus = NF90_SET_FILL(outfiles(idx)%TFILE%NNCID,NF90_NOFILL,ioldmode)
if ( istatus /= NF90_NOERR ) call IO_Err_handle_nc4( istatus, 'OPEN_FILES', 'NF90_SET_FILL', '' )
END IF ! .NOT.osplit
ELSE
!
! LFI
!
KNFILES_OUT = KNFILES_OUT + 1
idx = KNFILES_OUT
if ( options(OPTDIR)%set ) then
CALL IO_FILE_ADD2LIST(outfiles(idx)%TFILE,houtfile,'MNH','WRITE', &
HFORMAT='LFI',KLFIVERB=0,OOLD=.TRUE., hdirname = options(OPTDIR)%cvalue )
else
CALL IO_FILE_ADD2LIST(outfiles(idx)%TFILE,houtfile,'MNH','WRITE', &
HFORMAT='LFI',KLFIVERB=0,OOLD=.TRUE.)
end if
LIOCDF4 = .FALSE. !Necessary to open correctly the LFI file
CALL IO_FILE_OPEN(outfiles(idx)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)
LIOCDF4 = .TRUE.
END IF
!
! Create a dummy netCDF file necessary to manage correctly the netCDF dims
IF (runmode == MODECDF2LFI) THEN
KNFILES_OUT = KNFILES_OUT + 1
idx = KNFILES_OUT
if ( options(OPTDIR)%set ) then
CALL IO_FILE_ADD2LIST(outfiles(idx)%TFILE,'dummy_file','MNH','WRITE', &
HFORMAT='NETCDF4',OOLD=.TRUE., hdirname = options(OPTDIR)%cvalue )
else
CALL IO_FILE_ADD2LIST(outfiles(idx)%TFILE,'dummy_file','MNH','WRITE', &
HFORMAT='NETCDF4',OOLD=.TRUE.)
end if
CALL IO_FILE_OPEN(outfiles(idx)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)
END IF
call Print_msg( NVERB_INFO, 'IO', 'parse_infiles', '--> Converted to file: ' // trim(houtfile) )
IF (options(OPTCDF4)%set) THEN
status = NF90_CREATE(houtfile, IOR(NF90_CLOBBER,NF90_NETCDF4), outfiles%files(idx)%lun_id)
ELSE
status = NF90_CREATE(houtfile, IOR(NF90_CLOBBER,NF90_64BIT_OFFSET), outfiles%files(idx)%lun_id)
END IF
END SUBROUTINE OPEN_FILES
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
outfiles%files(idx)%opened = .TRUE.
outfiles%files(idx)%format = NETCDF_FORMAT
outfiles%files(idx)%status = WRITING
SUBROUTINE OPEN_SPLIT_NCFILES_OUT(outfiles,KNFILES_OUT,houtfile,nbvar,options)
USE MODE_IO_FILE, ONLY: IO_FILE_OPEN
USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST
status = NF90_SET_FILL(outfiles%files(idx)%lun_id,NF90_NOFILL,omode)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
END IF ! .NOT.osplit
TYPE(TFILE_ELT),DIMENSION(:), INTENT(INOUT) :: outfiles
INTEGER, INTENT(OUT) :: KNFILES_OUT
CHARACTER(LEN=*), INTENT(IN) :: houtfile
INTEGER, INTENT(IN) :: nbvar
TYPE(option),DIMENSION(:), INTENT(IN) :: options
CHARACTER(LEN=:),ALLOCATABLE :: filename
CHARACTER(LEN=:),ALLOCATABLE :: YLIST
CHARACTER(LEN=NMNHNAMELGTMAX),DIMENSION(nbvar) :: YVARS
INTEGER :: ji
INTEGER :: idx1, idx2
INTEGER(KIND=CDFINT) :: status
INTEGER(KIND=CDFINT) :: ioldmode
CALL PRINT_MSG(NVERB_DEBUG,'IO','OPEN_SPLIT_NCFILES_OUT','called')
KNFILES_OUT = nbvar
YLIST = TRIM(options(OPTVAR)%cvalue)
DO ji = 1,nbvar-1
idx1 = INDEX(YLIST,',')
idx2 = INDEX(YLIST,'=')
IF (idx1/=0) THEN
IF (idx2/=0 .AND. idx2<idx1) THEN
YVARS(ji) = YLIST(1:idx2-1)
ELSE
YVARS(ji) = YLIST(1:idx1-1)
END IF
YLIST = YLIST(idx1+1:)
ELSE
CALL PRINT_MSG(NVERB_FATAL,'IO','OPEN_SPLIT_NCFILES_OUT','problem separating variable names')
END IF
END DO
idx2 = INDEX(YLIST,'=')
IF (idx2>0) THEN
YVARS(nbvar) = YLIST(1:idx2-1)
ELSE
! Cas NetCDF -> LFI
infiles%nbfiles = infiles%nbfiles + 1
idx = infiles%nbfiles
status = NF90_OPEN(hinfile,NF90_NOWRITE,infiles%files(idx)%lun_id)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
infiles%files(idx)%opened = .TRUE.
infiles%files(idx)%format = NETCDF_FORMAT
infiles%files(idx)%status = READING
status = NF90_INQUIRE(infiles%files(idx)%lun_id, nvariables = nbvar_infile)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
inap = 100
outfiles%nbfiles = outfiles%nbfiles + 1
idx = outfiles%nbfiles
outfiles%files(idx)%lun_id = 11
outfiles%files(idx)%format = LFI_FORMAT
outfiles%files(idx)%status = WRITING
CALL LFIOUV(iresp,outfiles%files(idx)%lun_id,ltrue,houtfile,'NEW'&
& ,lfalse,lfalse,iverb,inap,inaf)
outfiles%files(idx)%opened = .TRUE.
YVARS(nbvar) = YLIST
END IF
PRINT *,'--> Fichier converti : ', houtfile
DO ji = 1,nbvar
filename = trim(houtfile)//'.'//TRIM(YVARS(ji))
if ( options(OPTDIR)%set ) then
CALL IO_FILE_ADD2LIST(outfiles(ji)%TFILE,filename,'MNH','WRITE', &
HFORMAT='NETCDF4', hdirname = options(OPTDIR)%cvalue )
else
CALL IO_FILE_ADD2LIST(outfiles(ji)%TFILE,filename,'MNH','WRITE', &
HFORMAT='NETCDF4')
end if
CALL IO_FILE_OPEN(outfiles(ji)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)
IF (options(OPTCOMPRESS)%set) THEN
outfiles(ji)%tfile%LNCCOMPRESS = .TRUE.
outfiles(ji)%tfile%NNCCOMPRESS_LEVEL = options(OPTCOMPRESS)%ivalue
END IF
END SUBROUTINE OPEN_FILES
IF (options(OPTREDUCE)%set) THEN
outfiles(ji)%tfile%LNCREDUCE_FLOAT_PRECISION = .TRUE.
END IF
SUBROUTINE OPEN_SPLIT_LFIFILE_IN(infiles,hinfile,current_level)
TYPE(filelist_struct), INTENT(INOUT) :: infiles
CHARACTER(LEN=*), INTENT(IN) :: hinfile
INTEGER, INTENT(IN) :: current_level
status = NF90_SET_FILL(outfiles(ji)%TFILE%NNCID,NF90_NOFILL,ioldmode)
if ( status /= NF90_NOERR ) call IO_Err_handle_nc4( status, 'OPEN_SPLIT_NCFILES_OUT', 'NF90_SET_FILL', '' )
END DO
INTEGER(KIND=LFI_INT) :: ilu,iresp,iverb,inap,nbvar
END SUBROUTINE OPEN_SPLIT_NCFILES_OUT
SUBROUTINE CLOSE_FILES(filelist,KNFILES)
USE MODE_IO_FILE, ONLY: IO_FILE_CLOSE
CHARACTER(LEN=3) :: suffix
CHARACTER(LEN=:),ALLOCATABLE :: filename
TYPE(TFILE_ELT),DIMENSION(:),INTENT(INOUT) :: filelist
INTEGER, INTENT(IN) :: KNFILES
INTEGER :: ji
iverb = 0 !Verbosity level for LFI
CALL PRINT_MSG(NVERB_DEBUG,'IO','CLOSE_FILES','called')
ALLOCATE(character(len=len(hinfile)) :: filename)
DO ji=1,KNFILES
IF (filelist(ji)%TFILE%LOPENED) CALL IO_FILE_CLOSE(filelist(ji)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)
END DO
ilu = infiles%files(1)%lun_id !We assume only 1 infile
END SUBROUTINE CLOSE_FILES
write(suffix,'(I3.3)') current_level
filename=hinfile(1:len(hinfile)-7)//suffix//'.lfi'
CALL LFIOUV(iresp,ilu,ltrue,filename,'OLD',lfalse,lfalse,iverb,inap,nbvar)
infiles%files(1)%opened = .TRUE.
DEALLOCATE(filename)
END SUBROUTINE OPEN_SPLIT_LFIFILE_IN
SUBROUTINE IO_Metadata_get_nc4(TPFILE,KVAR_ID,TPREC)
USE MODD_DIM_n, ONLY: NKMAX
USE MODD_PARAMETERS, ONLY: JPVEXT
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
INTEGER(KIND=CDFINT), INTENT(IN) :: KVAR_ID
TYPE(workfield), INTENT(INOUT) :: TPREC
character(len=:), allocatable :: YSPLIT
character(len=:), allocatable :: YTIMEDEP
integer :: iblocks
INTEGER :: ILENG
INTEGER :: JDIM
INTEGER(KIND=CDFINT) :: ISTATUS
INTEGER(KIND=CDFINT) :: IFILE_ID
INTEGER(KIND=CDFINT) :: IVAR_ID
INTEGER(KIND=CDFINT),DIMENSION(NF90_MAX_VAR_DIMS) :: IDIMS_ID
LOGICAL :: GSPLIT_AT_ENTRY
LOGICAL :: GSPLIT_INFO_AVAILABLE
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Metadata_get_nc4','called')
!Necessary to know if we already are in a split file for determining correct number of dimensions
GSPLIT_AT_ENTRY = TPREC%LSPLIT
IFILE_ID = TPFILE%NNCID
iblocks = -1
ISTATUS = NF90_INQUIRE_VARIABLE(IFILE_ID, KVAR_ID, NDIMS = TPREC%NDIMS_FILE, &
XTYPE = TPREC%NTYPE_FILE, DIMIDS = IDIMS_ID)
if ( istatus /= NF90_NOERR ) call IO_Err_handle_nc4( istatus, 'IO_Metadata_get_nc4', 'NF90_INQUIRE_VARIABLE', '' )
!split_variable and other attributes were added in MesoNH > 5.4.2
GSPLIT_INFO_AVAILABLE = .FALSE.
ISTATUS = NF90_INQUIRE_ATTRIBUTE(IFILE_ID, KVAR_ID, 'split_variable', LEN=ILENG)
IF (ISTATUS == NF90_NOERR) THEN
GSPLIT_INFO_AVAILABLE = .TRUE.
IF (GSPLIT_AT_ENTRY) CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Metadata_get_nc4','split variable declaration inside a split file')
ALLOCATE(CHARACTER(LEN=ILENG) :: YSPLIT)
ISTATUS = NF90_GET_ATT(IFILE_ID, KVAR_ID, 'split_variable', YSPLIT)
IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4( istatus, 'IO_Metadata_get_nc4', 'NF90_GET_ATT', 'split_variable' )
IF ( YSPLIT == 'yes' ) then
TPREC%LSPLIT = .true.
ISTATUS = NF90_GET_ATT(IFILE_ID, KVAR_ID, 'ndims', TPREC%NDIMS_FILE)
IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4( istatus, 'IO_Metadata_get_nc4', 'NF90_GET_ATT', 'ndims' )
IF ( TPREC%NDIMS_FILE/=3 ) CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Metadata_get_nc4', &
'split variable with ndims/=3 not supported')
ISTATUS = NF90_INQUIRE_ATTRIBUTE(IFILE_ID, KVAR_ID, 'time_dependent', LEN=ILENG)
IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4( istatus, 'IO_Metadata_get_nc4', 'NF90_INQUIRE_ATTRIBUTE', &
'time_dependent' )
ALLOCATE(CHARACTER(LEN=ILENG) :: YTIMEDEP)
ISTATUS = NF90_GET_ATT(IFILE_ID, KVAR_ID, 'time_dependent', YTIMEDEP)
IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4( istatus, 'IO_Metadata_get_nc4', 'NF90_GET_ATT', 'time_dependent' )
IF ( YTIMEDEP == 'yes' ) then
TPREC%TFIELD%LTIMEDEP = .TRUE.
ELSE IF ( YTIMEDEP == 'no' ) THEN
TPREC%TFIELD%LTIMEDEP = .FALSE.
ELSE
CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Metadata_get_nc4','unknown value '//trim(YTIMEDEP)// &
' for time_dependent attribute' )
END IF
SUBROUTINE OPEN_SPLIT_NCFILE_IN(infiles,hinfile,current_level)
TYPE(filelist_struct), INTENT(INOUT) :: infiles
CHARACTER(LEN=*), INTENT(IN) :: hinfile
INTEGER, INTENT(IN) :: current_level
ISTATUS = NF90_GET_ATT(IFILE_ID, KVAR_ID, 'split_nblocks', iblocks)
IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4( istatus, 'IO_Metadata_get_nc4', 'NF90_GET_ATT', 'split_nblocks' )
INTEGER :: status
CHARACTER(LEN=3) :: suffix
CHARACTER(LEN=:),ALLOCATABLE :: filename
IFILE_ID = TPFILE%TFILES_IOZ(1)%TFILE%NNCID
istatus = NF90_INQ_VARID(IFILE_ID,trim(TPREC%NAME)//'0001',ivar_id)
IF (ISTATUS /= NF90_NOERR) CALL IO_Err_handle_nc4( istatus, 'IO_Metadata_get_nc4', 'NF90_INQ_VARID', &
trim(TPREC%NAME)//'0001' )
ISTATUS = NF90_INQUIRE_VARIABLE(IFILE_ID, IVAR_ID, DIMIDS = IDIMS_ID)
IF (ISTATUS /= NF90_NOERR) CALL IO_Err_handle_nc4( istatus, 'IO_Metadata_get_nc4', 'NF90_INQUIRE_VARIABLE',&
trim(TPREC%NAME)//'0001' )
ALLOCATE(character(len=len(hinfile)) :: filename)
DEALLOCATE(YTIMEDEP)
ELSE IF ( YSPLIT /= 'no' ) THEN
CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Metadata_get_nc4','unknown value '//trim(YSPLIT)//' for split_variable attribute' )
END IF
write(suffix,'(I3.3)') current_level
filename=hinfile(1:len(hinfile)-6)//suffix//'.nc'
status = NF90_OPEN(filename,NF90_NOWRITE,infiles%files(1)%lun_id)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
infiles%files(1)%opened = .TRUE.
DEALLOCATE(YSPLIT)
END IF
DEALLOCATE(filename)
END SUBROUTINE OPEN_SPLIT_NCFILE_IN
!Reset IFILE_ID to master file (if split files)
IFILE_ID = TPFILE%NNCID
SUBROUTINE OPEN_SPLIT_NCFILES_OUT(outfiles,houtfile,nbvar,tpreclist,options)
TYPE(filelist_struct), INTENT(INOUT) :: outfiles
CHARACTER(LEN=*), INTENT(IN) :: houtfile
INTEGER, INTENT(IN) :: nbvar
TYPE(workfield), DIMENSION(:), INTENT(IN) :: tpreclist
TYPE(option),DIMENSION(:), INTENT(IN) :: options
ISTATUS = NF90_GET_ATT(IFILE_ID,KVAR_ID,'long_name',TPREC%TFIELD%CLONGNAME)
IF (ISTATUS /= NF90_NOERR) TPREC%TFIELD%CLONGNAME = TRIM( TPREC%TFIELD%CMNHNAME )
INTEGER :: ji, idx
INTEGER :: status
INTEGER :: omode
CHARACTER(LEN=MAXLEN) :: filename
ISTATUS = NF90_GET_ATT(IFILE_ID,KVAR_ID,'comment',TPREC%TFIELD%CCOMMENT)
IF (ISTATUS /= NF90_NOERR) TPREC%TFIELD%CCOMMENT = ''
ISTATUS = NF90_GET_ATT(IFILE_ID,KVAR_ID,'grid',TPREC%NGRID_FILE)
!On MesoNH versions < 5.4.0, the grid number was stored in 'GRID' instead of 'grid'
IF (ISTATUS /= NF90_NOERR) ISTATUS = NF90_GET_ATT(IFILE_ID,KVAR_ID,'GRID',TPREC%NGRID_FILE)
IF (ISTATUS /= NF90_NOERR) TPREC%NGRID_FILE = 0
DO ji = 1,nbvar
IF (tpreclist(ji)%tbw) outfiles%nbfiles = outfiles%nbfiles + 1
END DO
ISTATUS = NF90_GET_ATT(IFILE_ID,KVAR_ID,'units',TPREC%CUNITS_FILE)
IF (ISTATUS /= NF90_NOERR) TPREC%CUNITS_FILE = ''
idx = 1
DO ji = 1,nbvar
IF (.NOT.tpreclist(ji)%tbw) CYCLE
outfiles%files(idx)%var_id = ji
IF (.NOT.TPREC%LSPLIT) THEN
ALLOCATE(TPREC%NDIMSIZES_FILE(TPREC%NDIMS_FILE))
ALLOCATE(TPREC%CDIMNAMES_FILE(TPREC%NDIMS_FILE))
ELSE
IF ( GSPLIT_AT_ENTRY ) THEN
ALLOCATE(TPREC%NDIMSIZES_FILE(TPREC%NDIMS_FILE+1))
ALLOCATE(TPREC%CDIMNAMES_FILE(TPREC%NDIMS_FILE+1))
ELSE
IF (TPREC%TFIELD%LTIMEDEP) THEN
ALLOCATE(TPREC%NDIMSIZES_FILE(TPREC%NDIMS_FILE+1))
ALLOCATE(TPREC%CDIMNAMES_FILE(TPREC%NDIMS_FILE+1))
ELSE
ALLOCATE(TPREC%NDIMSIZES_FILE(TPREC%NDIMS_FILE))
ALLOCATE(TPREC%CDIMNAMES_FILE(TPREC%NDIMS_FILE))
END IF
END IF
END IF
IF (TPREC%NDIMS_FILE == 0) THEN
! Scalar variable
ILENG = 1
ELSE
! Fill dimensions info
ILENG = 1
DO JDIM=1,TPREC%NDIMS_FILE
ISTATUS = NF90_INQUIRE_DIMENSION(IFILE_ID,IDIMS_ID(JDIM), &
len = TPREC%NDIMSIZES_FILE(JDIM), &
name = TPREC%CDIMNAMES_FILE(JDIM) )
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
IF (options(OPTCDF4)%set) THEN
filename = trim(houtfile)//'.'//trim(tpreclist(ji)%name)//'.nc4'
status = NF90_CREATE(trim(filename), IOR(NF90_CLOBBER,NF90_NETCDF4), outfiles%files(idx)%lun_id)
IF (TPREC%NDIMS_FILE>0) THEN
IF (TPREC%CDIMNAMES_FILE(TPREC%NDIMS_FILE)=='time') THEN
TPREC%TFIELD%LTIMEDEP = .TRUE.
ELSE
TPREC%TFIELD%LTIMEDEP = .FALSE.
END IF
ELSE
filename = trim(houtfile)//'.'//trim(tpreclist(ji)%name)//'.nc'
status = NF90_CREATE(trim(filename), IOR(NF90_CLOBBER,NF90_64BIT_OFFSET), outfiles%files(idx)%lun_id)
TPREC%TFIELD%LTIMEDEP = .FALSE.
END IF
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
IF (TPREC%LSPLIT) THEN
#if 0
IF( (.NOT.TPREC%TFIELD%LTIMEDEP .AND. TPREC%NDIMS_FILE/=2) &
.OR. ( TPREC%TFIELD%LTIMEDEP .AND. TPREC%NDIMS_FILE/=3) ) &
#else
IF( ( GSPLIT_INFO_AVAILABLE .AND. TPREC%NDIMS_FILE/=3 ) &
.OR. ( .NOT.GSPLIT_INFO_AVAILABLE .AND. &
( (.NOT.TPREC%TFIELD%LTIMEDEP .AND. TPREC%NDIMS_FILE/=2) &
.OR. ( TPREC%TFIELD%LTIMEDEP .AND. TPREC%NDIMS_FILE/=3) ) ) ) &
#endif
CALL PRINT_MSG(NVERB_FATAL,'IO','IO_Metadata_get_nc4',trim(TPREC%NAME)//': split variables can only be 3D')
!Split variables are Z-split
!Move time dimension to last (4th) position
IF (TPREC%TFIELD%LTIMEDEP) THEN
TPREC%NDIMSIZES_FILE(4) = TPREC%NDIMSIZES_FILE(3)
TPREC%CDIMNAMES_FILE(4) = TPREC%CDIMNAMES_FILE(3)
END IF
status = NF90_SET_FILL(outfiles%files(idx)%lun_id,NF90_NOFILL,omode)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
!Add vertical/3rd dimension
SELECT CASE(TPREC%NGRID_FILE)
CASE (1, 2, 3, 5)
TPREC%CDIMNAMES_FILE(3) = 'level'
CASE (4, 6, 7, 8)
TPREC%CDIMNAMES_FILE(3) = 'level_w'
CASE DEFAULT
TPREC%CDIMNAMES_FILE(3) = 'unknown'
END SELECT
IF (iblocks == -1 ) then
TPREC%NDIMSIZES_FILE(3) = NKMAX+2*JPVEXT
else
if (TPREC%NGRID_FILE/=0 .and. iblocks/=NKMAX+2*JPVEXT) THEN
!If size is not as expected, reset its name
CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Metadata_get_nc4',trim(TPREC%NAME)//': strange nblocks size')
TPREC%CDIMNAMES_FILE(3) = 'unknown'
end if
TPREC%NDIMSIZES_FILE(3) = iblocks
end if
ILENG = ILENG * TPREC%NDIMSIZES_FILE(3)
END IF
END IF
outfiles%files(idx)%opened = .TRUE.
outfiles%files(idx)%format = NETCDF_FORMAT
outfiles%files(idx)%status = WRITING
TPREC%NSIZE = ILENG
END SUBROUTINE IO_Metadata_get_nc4
idx = idx + 1
END DO
END SUBROUTINE OPEN_SPLIT_NCFILES_OUT
SUBROUTINE CLOSE_FILES(filelist)
TYPE(filelist_struct),INTENT(INOUT) :: filelist
INTEGER(KIND=LFI_INT) :: iresp
INTEGER :: ji,status
SUBROUTINE IO_Dims_fill_nc4(TPFILE,TPREC,KRESP)
USE MODD_IO, ONLY: TFILEDATA
use mode_io_tools_nc4, only: IO_Dim_find_create_nc4, IO_Dim_find_byname_nc4
TYPE(TFILEDATA),INTENT(IN) :: TPFILE
TYPE(workfield),INTENT(INOUT) :: TPREC
INTEGER, INTENT(OUT) :: KRESP
DO ji=1,filelist%nbfiles
IF ( .NOT.filelist%files(ji)%opened ) CYCLE
integer :: iidx
INTEGER :: JJ
IF ( filelist%files(ji)%format == LFI_FORMAT ) THEN
CALL LFIFER(iresp,filelist%files(ji)%lun_id,'KEEP')
ELSE IF ( filelist%files(ji)%format == NETCDF_FORMAT ) THEN
status = NF90_CLOSE(filelist%files(ji)%lun_id)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
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_Dims_fill_nc4','less dimensions than expected for '//TRIM(TPREC%TFIELD%CMNHNAME)// &
' => ignored')
TPREC%tbw = .FALSE.
TPREC%tbr = .FALSE.
TPREC%found = .FALSE.
RETURN
END IF
ALLOCATE(TPREC%TDIMS(TPREC%TFIELD%NDIMS))
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_Dim_find_byname_nc4(TPFILE,TPREC%CDIMNAMES_FILE(JJ),TPREC%TDIMS(JJ),KRESP)
!If dimension not found => create it
IF (KRESP/=0) THEN
call IO_Dim_find_create_nc4( tpfile, tprec%ndimsizes_file(jj), iidx )
tprec%tdims(jj) = tpfile%tncdims%tdims(iidx)
KRESP = 0
END IF
IF (TRIM(TPREC%TDIMS(JJ)%cname)/='time' .AND. &
TPREC%TDIMS(JJ)%nlen /= TPREC%NDIMSIZES_FILE(JJ)) THEN
CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Dims_fill_nc4','problem with dimensions for '//TPREC%TFIELD%CMNHNAME)
KRESP = -3
EXIT
END IF
filelist%files(ji)%opened=.false.
END DO
END SUBROUTINE CLOSE_FILES
END SUBROUTINE IO_Dims_fill_nc4
END MODULE mode_util
LIBTOOLS/tools/lfiz/src/lfiz.f90
View file @ 6bb35ca8
......@@ -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
......
LIBTOOLS/tools/lfiz/src/unlfiz.f90
View file @ 6bb35ca8
......@@ -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
......
MY_RUN/BENCH/001_RELIEF_PERTURB/002_mesonh/EXSEG1_NSTEP.nam.ihm
View file @ 6bb35ca8
......@@ -82,7 +82,7 @@
LNUMDIFF = T /
&NAM_FMOUT
XFMOUT(1,1) = 100000.0 /
XBAK_TIME(1,1) = 100000.0 /
&NAM_BUDGET
CBUTYPE = "NONE"
/
......
MY_RUN/BENCH/003_MEDATL_FULLHD/003_mesonh/run_mesonh_xyz_SEG1.ihm
View file @ 6bb35ca8
......@@ -134,7 +134,7 @@ cat > EXSEG1.nam << EOF
/
&NAM_FMOUT
${XFMOUT}
${XBAK_TIME}
/
EOF
cp EXSEG1.nam SURF1.nam
......
MY_RUN/BENCH/003_MEDATL_FULLHD/003_mesonh/run_mesonh_xyz_SEGN.ihm
View file @ 6bb35ca8
#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
#MNH_LIC Copyright 1994-2024 CNRS, Meteo-France and Universite Paul Sabatier
#MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
#MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
#MNH_LIC for details. version 1.
......@@ -54,7 +54,6 @@ cat > EXSEG1.nam << EOF
&NAM_DYNn
XTSTEP = ${XTSTEP} ,
CPRESOPT = "CRESI",
NITR = 12,
LITRADJ = T,
XRELAX = 1.,
LHORELAX_UVWTH = T,
......@@ -134,7 +133,7 @@ cat > EXSEG1.nam << EOF
/
&NAM_FMOUT
${XFMOUT}
${XBAK_TIME}
/
EOF
cp EXSEG1.nam SURF1.nam
......
MY_RUN/BENCH/003_MEDATL_FULLHD/grillE_3072_1920_MNH490
View file @ 6bb35ca8
......@@ -203,16 +203,16 @@ export XTSTEP=$( echo " scale=5 ; ${XTSTEP0} / ${GRIDFAC} " | bc -l )
export XSEGLEN=$( echo "1 * 3600 " | bc -l )
export XSEGLEN=3600.0
#export XFMOUT="XFMOUT(1,1) = 1800., XFMOUT(1,2) = 3600. , XFMOUT(1,3) = 5400., XFMOUT(1,4) = 7200., \
# XFMOUT(1,5) = 9000., XFMOUT(1,6) = 10800. , XFMOUT(1,7) = 12600., XFMOUT(1,8) = 14400. , \
# XFMOUT(1,9) = 16200., XFMOUT(1,10) = 18000. , XFMOUT(1,11) = 19800., XFMOUT(1,12) = 21600. "
#export XFMOUT="XFMOUT(1,1) = 3600. , XFMOUT(1,2) = 7200., \
# XFMOUT(1,3) = 10800. , XFMOUT(1,4) = 14400. , \
# XFMOUT(1,5) = 18000. , XFMOUT(1,6) = 21600. "
#export XFMOUT="XFMOUT(1,1) = 21600. , XFMOUT(1,2) = 43200. , XFMOUT(1,3) = 64800. , XFMOUT(1,4) = 86400. "
#export XFMOUT="XFMOUT(1,1) = 21540. , XFMOUT(1,2) = 43140. , XFMOUT(1,3) = 64740. , XFMOUT(1,4) = 86340. "
export XFMOUT="XFMOUT(1,1) = 900. , XFMOUT(1,2)= 1800. XFMOUT(1,3) = 2400. , XFMOUT(1,4) = 3600. "
#export XBAK_TIME="XBAK_TIME(1,1) = 1800., XBAK_TIME(1,2) = 3600. , XBAK_TIME(1,3) = 5400., XBAK_TIME(1,4) = 7200., \
# XBAK_TIME(1,5) = 9000., XBAK_TIME(1,6) = 10800. , XBAK_TIME(1,7) = 12600., XBAK_TIME(1,8) = 14400. , \
# XBAK_TIME(1,9) = 16200., XBAK_TIME(1,10) = 18000. , XBAK_TIME(1,11) = 19800., XBAK_TIME(1,12) = 21600. "
#export XBAK_TIME="XBAK_TIME(1,1) = 3600. , XBAK_TIME(1,2) = 7200., \
# XBAK_TIME(1,3) = 10800. , XBAK_TIME(1,4) = 14400. , \
# XBAK_TIME(1,5) = 18000. , XBAK_TIME(1,6) = 21600. "
#export XBAK_TIME="XBAK_TIME(1,1) = 21600. , XBAK_TIME(1,2) = 43200. , XBAK_TIME(1,3) = 64800. , XBAK_TIME(1,4) = 86400. "
#export XBAK_TIME="XBAK_TIME(1,1) = 21540. , XBAK_TIME(1,2) = 43140. , XBAK_TIME(1,3) = 64740. , XBAK_TIME(1,4) = 86340. "
export XBAK_TIME="XBAK_TIME(1,1) = 900. , XBAK_TIME(1,2)= 1800. XBAK_TIME(1,3) = 2400. , XBAK_TIME(1,4) = 3600. "
if [ $(echo " scale=0 ; ( ${XDX} - 5000.0 ) / 1 " | bc -l ) -gt 0 ] ; then
# XDX > 5KM
......
MY_RUN/BENCH/003_MEDATL_FULLHD/grille_4km_1920x0600_I8_MED_ATL
View file @ 6bb35ca8
......@@ -279,15 +279,15 @@ export XTSTEP=$( echo " scale=5 ; ${XTSTEP0} / ${GRIDFAC} " | bc -l )
export XSEGLEN=$( echo "24 * 3600 - 60 " | bc -l )
#export XSEGLEN=60.0
#export XFMOUT="XFMOUT(1,1) = 1800., XFMOUT(1,2) = 3600. , XFMOUT(1,3) = 5400., XFMOUT(1,4) = 7200., \
# XFMOUT(1,5) = 9000., XFMOUT(1,6) = 10800. , XFMOUT(1,7) = 12600., XFMOUT(1,8) = 14400. , \
# XFMOUT(1,9) = 16200., XFMOUT(1,10) = 18000. , XFMOUT(1,11) = 19800., XFMOUT(1,12) = 21600. "
#export XFMOUT="XFMOUT(1,1) = 3600. , XFMOUT(1,2) = 7200., \
# XFMOUT(1,3) = 10800. , XFMOUT(1,4) = 14400. , \
# XFMOUT(1,5) = 18000. , XFMOUT(1,6) = 21600. "
#export XFMOUT="XFMOUT(1,1) = 21600. , XFMOUT(1,2) = 43200. , XFMOUT(1,3) = 64800. , XFMOUT(1,4) = 86400. "
export XFMOUT="XFMOUT(1,1) = 21540. , XFMOUT(1,2) = 43140. , XFMOUT(1,3) = 64740. , XFMOUT(1,4) = 86340. "
#export XFMOUT="XFMOUT(1,1) = 60. "
#export XBAK_TIME="XBAK_TIME(1,1) = 1800., XBAK_TIME(1,2) = 3600. , XBAK_TIME(1,3) = 5400., XBAK_TIME(1,4) = 7200., \
# XBAK_TIME(1,5) = 9000., XBAK_TIME(1,6) = 10800. , XBAK_TIME(1,7) = 12600., XBAK_TIME(1,8) = 14400. , \
# XBAK_TIME(1,9) = 16200., XBAK_TIME(1,10) = 18000. , XBAK_TIME(1,11) = 19800., XBAK_TIME(1,12) = 21600. "
#export XBAK_TIME="XBAK_TIME(1,1) = 3600. , XBAK_TIME(1,2) = 7200., \
# XBAK_TIME(1,3) = 10800. , XBAK_TIME(1,4) = 14400. , \
# XBAK_TIME(1,5) = 18000. , XBAK_TIME(1,6) = 21600. "
#export XBAK_TIME="XBAK_TIME(1,1) = 21600. , XBAK_TIME(1,2) = 43200. , XBAK_TIME(1,3) = 64800. , XBAK_TIME(1,4) = 86400. "
export XBAK_TIME="XBAK_TIME(1,1) = 21540. , XBAK_TIME(1,2) = 43140. , XBAK_TIME(1,3) = 64740. , XBAK_TIME(1,4) = 86340. "
#export XBAK_TIME="XBAK_TIME(1,1) = 60. "
#export XR=2.0
......
MY_RUN/INTEGRATION_CASES/HPC/16JAN/PYTHON/plot_16JAN.py 0 → 100644
View file @ 6bb35ca8
#!/usr/bin/env python3
"""
@author: Quentin Rodier
Creation : 07/01/2021
Last modifications
"""
import matplotlib as mpl
mpl.use('Agg')
import cartopy.crs as ccrs
from read_MNHfile import read_netcdf
from Panel_Plot import PanelPlot
import os
os.system('rm -f tempgraph*')
#
# User's parameter / Namelist
#
#
path="../RUN/"
LnameFiles = ['16JA1.1.WENO5.004dg.nc', '16JA2.2.WENO5.002dg.nc']
Dvar_input = {
'f1':['MRV700HPA','THT850HPA','UT850HPA','VT850HPA','UT700HPA','VT700HPA', 'ALT_PRESSURE','ALT_U','ALT_V', 'ZS', 'latitude', 'longitude'],
'f2':['MRV700HPA','THT850HPA','UT850HPA','VT850HPA','UT700HPA','VT700HPA', 'ALT_PRESSURE', 'ZS', 'ALT_U','ALT_V','latitude', 'longitude']
}
# Read the variables in the files
Dvar = {}
Dvar = read_netcdf(LnameFiles, Dvar_input, path=path, removeHALO=True)
################################################################
######### PANEL 1
###############################################################
Panel1 = PanelPlot(2,2, [15,10],'16 JAN domaine 1 ', minmaxpad=1.05, minmaxTextSize=7.7, colorbaraspect=14)
Lplot = [ Dvar['f1']['ZS'],Dvar['f1']['THT850HPA'], Dvar['f1']['MRV700HPA'],Dvar['f1']['ALT_PRESSURE']]
lon = [Dvar['f1']['longitude']]*len(Lplot)
lat = [Dvar['f1']['latitude']]*len(Lplot)
Ltitle = ['Orography', 'Potential Temperature at 850hPa', 'Water vapor mixing at 700hPa','Pressure at z = 9000m']
Lcbarlabel = ['m','K', 'g/kg', 'hPa']
Lxlab = ['longitude']*len(Lplot)
Lylab = ['latitude']*len(Lplot)
Lminval = [0, 280, 0.5, 270]
Lmaxval = [1500, 293, 4.2, 303]
Lstep = [10, 0.25, 0.1, 1]
Lstepticks = [500, 2, 0.5, 5]
Lfacconv = [1.0, 1.0, 1.0, 1./100.0]
Lcolormap = ['terrain', 'gist_rainbow_r', 'gist_rainbow_r', 'gist_rainbow_r']
Lprojection = [ccrs.PlateCarree()]*len(Lplot)
Llvl = [0, 0, 0, 0]
fig1 = Panel1.psectionH(lon=lon, lat=lat, Lvar=Lplot, Lcarte=[], Llevel=Llvl, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lminval=Lminval, Lmaxval=Lmaxval,
Lstep=Lstep, Lstepticks=Lstepticks, Lcolormap=Lcolormap, Lcbarlabel=Lcbarlabel, Lproj=Lprojection, Lfacconv=Lfacconv)
Lplot1 = [ Dvar['f1']['UT850HPA'], Dvar['f1']['UT700HPA'], Dvar['f1']['ALT_U']]
Lplot2 = [ Dvar['f1']['VT850HPA'], Dvar['f1']['VT700HPA'], Dvar['f1']['ALT_V']]
Ltitle = ['Wind at 850hPa', 'Wind at 700hPa', 'Wind at 9000m']
Lxlab = ['longitude']*len(Lplot1)
Lylab = ['latitude']*len(Lplot1)
Llegendval = [20,20,40]
Llegendlabel = ['(m/s)']*len(Lplot1)
Larrowstep = [2]*len(Lplot1)
Lwidth = [0.002]*len(Lplot1)
Lcolor = ['black']*len(Lplot1)
Lprojection = [ccrs.PlateCarree()]*len(Lplot1)
Llvl = [0]*len(Lplot1)
fig2 = Panel1.pvector(Lxx=lon, Lyy=lat, Lvar1=Lplot1, Lvar2=Lplot2, Lcarte=[], Llevel=Llvl, Lxlab=Lxlab, Lylab=Lylab,
Ltitle=Ltitle, Lwidth=Lwidth, Larrowstep=Larrowstep, Lproj=Lprojection,
Lcolor=Lcolor, Llegendval=Llegendval, Llegendlabel=Llegendlabel, Lid_overlap=[2,4,6], ax=fig1.axes)
Panel1.save_graph(1,fig2)
################################################################
######### PANEL 2
###############################################################
Panel2 = PanelPlot(2,2, [15,10],'16 JAN domaine 2 ', minmaxpad=1.05, minmaxTextSize=8, colorbaraspect=14)
Lplot = [ Dvar['f2']['ZS'],Dvar['f2']['THT850HPA'], Dvar['f2']['MRV700HPA'],Dvar['f2']['ALT_PRESSURE']]
lon = [Dvar['f2']['longitude']]*len(Lplot)
lat = [Dvar['f2']['latitude']]*len(Lplot)
Ltitle = ['Orography', 'Potential Temperature at 850hPa', 'Water vapor mixing at 700hPa','Pressure at z = 9000m']
Lcbarlabel = ['m','K', 'g/kg', 'hPa']
Lxlab = ['longitude']*len(Lplot)
Lylab = ['latitude']*len(Lplot)
Lminval = [0, 285, 0.9, 280]
Lmaxval = [2600, 293, 4, 294]
Lstep = [10, 0.5, 0.1, 0.5]
Lstepticks = [500, 1, 0.2, 5]
Lfacconv = [1.0, 1.0, 1.0, 1./100.0]
Lcolormap = ['terrain', 'gist_rainbow_r', 'gist_rainbow_r', 'gist_rainbow_r']
Lprojection = [ccrs.PlateCarree()]*len(Lplot)
Llvl = [0]*len(Lplot)
fig1 = Panel2.psectionH(lon=lon, lat=lat, Lvar=Lplot, Lcarte=[], Llevel=Llvl, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lminval=Lminval, Lmaxval=Lmaxval,
Lstep=Lstep, Lstepticks=Lstepticks, Lcolormap=Lcolormap, Lcbarlabel=Lcbarlabel, Lproj=Lprojection, Lfacconv=Lfacconv)
Lplot1 = [ Dvar['f2']['UT850HPA'], Dvar['f2']['UT700HPA'], Dvar['f2']['ALT_U']]
Lplot2 = [ Dvar['f2']['VT850HPA'], Dvar['f2']['VT700HPA'], Dvar['f2']['ALT_V']]
Ltitle = ['Wind at 850hPa', 'Wind at 700hPa', 'Wind at 9000m']
Llegendval = [20,20,40]
Lxlab = ['longitude']*len(Lplot1)
Lylab = ['latitude']*len(Lplot1)
Llegendlabel = ['(m/s)']*len(Lplot1)
Larrowstep = [2]*len(Lplot1)
Lwidth = [0.002]*len(Lplot1)
Lcolor = ['black']*len(Lplot1)
Lprojection = [ccrs.PlateCarree()]*len(Lplot1)
Llvl = [0]*len(Lplot1)
fig2 = Panel2.pvector(Lxx=lon, Lyy=lat, Lvar1=Lplot1, Lvar2=Lplot2, Lcarte=[], Llevel=Llvl, Lxlab=Lxlab, Lylab=Lylab,
Ltitle=Ltitle, Lwidth=Lwidth, Larrowstep=Larrowstep, Lproj=Lprojection,
Lcolor=Lcolor, Llegendval=Llegendval, Llegendlabel=Llegendlabel, Lid_overlap=[2,4,6], ax=fig1.axes)
Panel2.save_graph(2,fig2)

Documentation | Mentions légales | CGU | Accessibilité : non conforme