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
Select Git revision

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
  • jean.wurtz/mesonh-code
8 results
Select Git revision
Show changes
Commits on Source (4198)
4,098 additional commits have been omitted to prevent performance issues.
Hide whitespace changes
Inline Side-by-side
Showing
with 2302 additions and 2209 deletions
.gitattributes
View file @ 050d6a3c
* text=auto
*.tar filter=lfs diff=lfs merge=lfs -crlf *.tar filter=lfs diff=lfs merge=lfs -crlf
*.tar.gz 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 */ecmwf.OD* filter=lfs diff=lfs merge=lfs -crlf
......
.gitignore
View file @ 050d6a3c
conf/profile_mesonh
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/*/*/ecmwf.OD.????????.??
MY_RUN/KTEST/*/*/file_for_xtransfer
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/*/*/pipe_name
MY_RUN/KTEST/*/*/__pycache__
MY_RUN/KTEST/*/*/misc_functions.py
MY_RUN/KTEST/*/*/Panel_Plot.py
MY_RUN/KTEST/*/*/read_MNHfile.py
MY_RUN/KTEST/*/*/tutorial_readme
MY_RUN/KTEST/*/*/*.png
MY_RUN/KTEST/*/*/*.pdf
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/dir_obj-*
src/LIB/eccodes*
!src/LIB/eccodes*.tar.gz
src/LIB/grib_api* src/LIB/grib_api*
!src/LIB/grib_api*.tar.gz
src/LIB/hdf5* src/LIB/hdf5*
!src/LIB/hdf5*.tar.gz
src/LIB/libaec*
!src/LIB/libaec*.tar.gz
src/LIB/netcdf* 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 @ 050d6a3c
# #
# Version of PACKAGE MESONH "Open distribution" # Version of PACKAGE MESONH "Open distribution"
# PACK-MNH-V5-2-1 # PACK-MNH-V5-7-1
# DATE : 02/05/2016 # DATE : 04/09/2024
# VERSION : MESONH MASDEV5_2 + BUG-1 # VERSION : MESONH MASDEV5_7 + BUG-1
# #
# MAP # MAP
# #
# 0) TWO WAYS OF DOWNLOADING MESONH # 0) TWO WAYS OF DOWNLOADING MESONH
# I-A) DOWNLOAD VIA THE WEB MESONH HOME PAGE # 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 # II) CONFIGURING THE MESONH PACKAGE
# III) COMPILING/INSTALLING THE MESONH PACKAGE ON YOUR LINUX COMPUTER # III) COMPILING/INSTALLING THE MESONH PACKAGE ON YOUR LINUX COMPUTER
# IV) RUN SOME "SMALL KTEST" EXAMPLES # IV) RUN SOME "SMALL KTEST" EXAMPLES
# V) RECOMPILING YOUR 'OWN' SOURCES ONLY # 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 # VII) "SCANDOLLAR" = SCRIPTING YOUR OWN PROCEDURES
# #
# VIII) TROUBLE-SHOOTING # VIII) TROUBLE-SHOOTING
...@@ -21,19 +21,25 @@ ...@@ -21,19 +21,25 @@
# b) Compiler bug with "ifort 10.0.xxx" # b) Compiler bug with "ifort 10.0.xxx"
# #
# IX) OPTIONAL COMPILATION # IX) OPTIONAL COMPILATION
# a) MNH_NCWRIT for netcdf graphic output file # a) MNH_FOREFIRE for forefire runs ( external package needed )
# b) MNH_FOREFIRE for forefire runs ( external package needed ) # b) MNH_RTTOV for optional radiative computation
# c) MNH_RTTOV for optional radiative computation # c) MNH_ECRAD for optional compilation of new ECRAD radiative library from ECMWF
# d) cleaning previous compiled version # 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 # 0) TWO WAYS OF DOWNLOADING MESONH
# ================================= # =================================
# #
# MESONH sources and executables # MESONH sources and executables
# http://mesonh.aero.obs-mip.fr # http://mesonh.aero.obs-mip.fr
# are developed and maintained with the # 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 # There are two ways to download the package of
# MESONH containing : # MESONH containing :
...@@ -47,22 +53,24 @@ ...@@ -47,22 +53,24 @@
# via a download of a "tar ball" in the WEB site of MESONH # via a download of a "tar ball" in the WEB site of MESONH
# #
# The second way is for USER/DEVELOPER of MESONH # The second way is for USER/DEVELOPER of MESONH
# via the use of the CVS tools and an access via anonymous # via the use of Git and an anonymous ssh connection to the Git repository of
# connection with "ssh" to the CVS REPOSITORY of the MESONH package # the MESONH package
# #
# #
# REM: It is now strongly recommended, but it's not an obligation, # REM: It is now strongly recommended, but not mandatory,
# for all users to use de CVS solution, because: # for all users to use the Git solution, because:
# #
# * It's far more easy for us ( support team ) to give you some assistance # * 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 # what you have changed in the original PACKAGE
# #
# * It's much more easy for you to update to the last version ... # * 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 . # 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 ^L
...@@ -70,194 +78,172 @@ ...@@ -70,194 +78,172 @@
# ========================================== # ==========================================
# #
# With your preferred web browser go to the MESONH WEB SITE # With your preferred web browser go to the MESONH WEB SITE
# #
# http://mesonh.aero.obs-mip.fr/mesonh # http://mesonh.aero.obs-mip.fr/mesonh
# ---> Download # ---> Download
# ---> CVS MESONH
# #
# or directly # or directly
# #
# http://mesonh.aero.obs-mip.fr/cgi-bin/mesonh_interne/viewcvs.cgi/MNH-VX-Y-Z # http://mesonh.aero.obs-mip.fr/mesonh/dir_open/dir_MESONH/MNH-V5-7-1.tar.gz
#
# 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
# #
# Then untar the file "PACK-MNH-VX-Y-Z.tar.gz" where you want to, # Then untar the file "MNH-V5-7-1.tar.gz" where you want to.
# in your home directory for example: # For example, in your home directory:
# #
cd ~ 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 # Process now to the chapter to configure the MesoNH package.
# to the right one
#
mv MNH-VX-Y-Z MNH-V5-2-1
#
# Process now to the chapter to configure the MesoNH
# #
# => II) CONFIGURING THE MESONH PACKAGE # => II) CONFIGURING THE MESONH PACKAGE
# #
^L ^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 # 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
# http://mesonh.aero.obs-mip.fr/mesonh # binary (or large) files. So before starting, be sure:
# ---> Download
# ---> CVS PACKAGE MESONH
# #
# or directly # * to have git v1.8.2 or higher installed on your workstation. You can run
# # and check with:
# http://mesonh.aero.obs-mip.fr/cgi-bin/mesonh_interne/viewcvs.cgi/MNH-VX-Y-Z
# git --version
# in the field "Show files using tag:"
# # * to install the git LFS extension (not included by default in the Git
# ---> select "PACK-MNH-V5-2-1" # package):
# # - get the linux git-lfs archive from the "Download v1.X.Y (Linux)" link on
# download the file "anoncvs.key" # 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 : # b) Before cloning
# 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 !!!)
# #
# 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 Host anongit_mesonh
cat config.anoncvs_www >> config User anongit
IdentityFile ~/.ssh/anongitmesonh.key
Hostname 195.83.22.22
Port 22222
# #
# FOR OTHER COMPUTERS USE special "config.anoncvs_www" # Before cloning the repository, execute:
# ===================================================
#
# if the computer, from which you download the MESONH sources,
# is external to METEO-FRANCE & IDRIS & CINES & Laboratoire d'Aerologie Laboratoire download this file
# #
# --> "config.anoncvs_www_ext"
cd ${HOME}/.ssh git config --global http.sslverify false
cat config.anoncvs_www_ext >> config
# #
# OR for ECMWF computer ( cca ) download this config file # This is necessary to disable the certificate checks because a self-signed
# ( to bypass the gateway filter ) # 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 git clone anongit@anongit_mesonh:/gitrepos/MNH-git_open_source-lfs.git -b MNH-57-branch MNH-V5-7-1
cat config.anoncvs_www_ecmwf >> config
# #
# 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 )
# #
# d) Checking out a given version of MESONH
export CVS_RSH=ssh # -----------------------------------------
export CVSROOT=:ext:mesonh_anoncvs_www:/home/cvsroot #
# 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 ~ cd MNH-V5-7-1
cvs co -r PACK-MNH-V5-2-1 -d MNH-V5-2-1 MNH-VX-Y-Z 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 # MYB-MNH-V5-7-1 is the name of the local branch you created
# ---> you could have some trouble when compiling mesonh # 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" # The advantage of this way of downloading the package is that in the future
# which contains of the last revision named "PACK-MNH-V5-2-1" # you could check/update quickly differences with the new version of the
# of the MESONH PACKAGE # package without having to download entirely the full package.
# #
# The advantage of this way of downloading # Suppose that a new version, for example "PACK-MNH-V5-7-1", is announced.
# 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 # To see the differences with your working copy, do:
# "PACK-MNH-V5-2-2" is announced ...
# #
# 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 git checkout -b MYB-MNH-V5-7-1 PACK-MNH-V5-7-1
cvs diff -r PACK-MNH-V5-2-2
# #
# 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 git fetch
cvs update -r PACK-MNH-V5-2-2 -d -P git diff HEAD MNH-57-branch
# #
# At any time you could also check for "uptodate" # And, test this development (not yet official) version by going to this branch:
# changes in the CVS "branch" dedicated to the MNH52 version
# before the official release of the "bugN+1" bugfix
# #
cvs diff -r MNH52-BUG-branch git checkout --track origin/MNH-57-branch
# #
# An at "your own risk" update to this # e) Cloning the Meso-NH Documentation repository
# ( not yet official ) version by
# #
# 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 # => II) CONFIGURING THE MESONH PACKAGE
# #
...@@ -271,7 +257,7 @@ cvs update -r MNH52-BUG-branch -d -P ...@@ -271,7 +257,7 @@ cvs update -r MNH52-BUG-branch -d -P
# use the "./configure" script like this # use the "./configure" script like this
# #
cd ~/MNH-V5-2-1/src cd ~/MNH-V5-7-1/src
./configure ./configure
. ../conf/profile_mesonh . ../conf/profile_mesonh
...@@ -279,56 +265,62 @@ cd ~/MNH-V5-2-1/src ...@@ -279,56 +265,62 @@ cd ~/MNH-V5-2-1/src
# this will create a configuration file "profile_mesonh" with # this will create a configuration file "profile_mesonh" with
# an extension reflecting the different "choices" made automatically # an extension reflecting the different "choices" made automatically
# to match the computer on which you want to install MESONH # to match the computer on which you want to install MESONH
# #
# WARNING : # 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 # 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 # 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 ... # /!\ This is not the case in your "own" personal Linux computer ...
# So is up to you to set the ARCH variable correctly # So is up to you to set the ARCH variable correctly
# ARCH = Fortran compiler to use, # ARCH = Fortran compiler to use,
# VER_MPI = version of MPi to, use # VER_MPI = version of MPI to use ,
# OPTLEVEL = # OPTLEVEL =
# etc ... # 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 compiler choosen to be "gfortran" => ARCH=LXgfortran
# - the mpi library to be the MPIVIDE => VER_MPI=MPIVIDE # - the MPI library to be the MPIVIDE => VER_MPI=MPIVIDE
# ( empty mpi library coming with MESONH package = no parallel run possible ) # ( empty MPI library coming with MESONH package = no parallel run possible )
# - the level compiler optimization => OPTLEVEL=DEBUG # - the level of optimization for the compiler => OPTLEVEL=DEBUG
# ( for development purpose ,fast compilation & debugging ) # ( for development purpose ,fast compilation & debugging )
# #
# SO IF NEEDED: # 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 # like this, for example
export ARCH=LXifort # Use Intel "ifort" compiler on LX=linux Plateform 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 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 ./configure
# and then source/load the new generate file # 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: # 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" # - 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 # http://mesonh.aero.obs-mip.fr/teamwiki/MesonhTEAMFAQ/PC_Linux
# --> Compilation of OPEN-MPI # --> Compilation of OPEN-MPI
...@@ -341,7 +333,7 @@ export OPTLEVEL=O2 # Compile in O2 , 4 time faster then DEBUG, but least ...@@ -341,7 +333,7 @@ export OPTLEVEL=O2 # Compile in O2 , 4 time faster then DEBUG, but least
# go to the directory "src" # 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 # if you have not already configured your MESONH environment
...@@ -362,9 +354,9 @@ cd ~/MNH-V5-2-1/src ...@@ -362,9 +354,9 @@ cd ~/MNH-V5-2-1/src
# The compilation will take about 20 minutes on modern PC-Linux ... # The compilation will take about 20 minutes on modern PC-Linux ...
# #
# If you have a multi-processor machine you can speedup # 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 ...@@ -382,9 +374,9 @@ cd ~/MNH-V5-2-1/src
# The exact name of this "dir_obj..." depends on the different environnement # 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. # 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 # This allows by loading different "profile_mesonh.." files to compile in the same
# source/installation directory different version of MESONH , with different # source/installation directory different versions of MESONH , with different
# compiler, different version of MPI , different USER sources , etc ... # compilers, different versions of MPI, different USER sources...
# #
# #
# To install the new compiled program in the "$SRC_MESONH/exe" # To install the new compiled program in the "$SRC_MESONH/exe"
...@@ -394,13 +386,13 @@ cd ~/MNH-V5-2-1/src ...@@ -394,13 +386,13 @@ cd ~/MNH-V5-2-1/src
make installmaster make installmaster
# #
# The executable with their full name, including, $ARCH , compiler # The executables with their full name, including $ARCH, compiler,
# and MPI , level of optimization, will be linked in the "../exe" directory # MPI and level of optimization, will be linked in the "../exe" directory
# #
# REM: # REM:
# --- # ---
# The "make installmaster" need to be done only one time by "version" . # The "make installmaster" need to be done only one time by "version".
# If you change/add source only you have to do "make" # If you only change/add source, you have to do "make"
make make
...@@ -408,7 +400,7 @@ make ...@@ -408,7 +400,7 @@ make
# IV) RUN SOME "SMALL KTEST" EXAMPLES # 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 # some basic "KTEST" examples from the "src" directory
# by running: # by running:
...@@ -459,13 +451,13 @@ make 004_Reunion_ncl2 ...@@ -459,13 +451,13 @@ make 004_Reunion_ncl2
# Step-1 : prepare your source directory # 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 ${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 # you could make a subdirectory for each component of the MESONH
# Package # Package
# #
...@@ -476,24 +468,24 @@ cp .../isba.f90 MY_MODIF/SURFEX/. ...@@ -476,24 +468,24 @@ cp .../isba.f90 MY_MODIF/SURFEX/.
# #
# /!\ WARNING : # /!\ WARNING :
# ------------- # -------------
# - In this subdirectory put only fortran source you want to compile !!! # - 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' # Don't use it as a trash with old sources file like 'my_source.f90.old'
# or 'tar' files 'mysource.tar' . # 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=... # Step-2 : configure/compiling with VER_USER=...
# ---------------------------------------------- # ----------------------------------------------
# #
# - Logout of the current session, to be sure to unset all the # - Logout of the current session to be sure to unset all the
# environnement variables load with the your 'master 'profile_mesonh' # 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 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 ARCH=...
#export VER_MPI=... #export VER_MPI=...
...@@ -506,21 +498,21 @@ export VER_USER=MY_MODIF ...@@ -506,21 +498,21 @@ export VER_USER=MY_MODIF
# #
# as before load it & and compile with the command "make user" # as before load it & and compile with the command "make user"
. ../conf/profile_mesnh...${VER_USER}... . ../conf/profile_mesonh...${VER_USER}...
make user make user
# this will compilation Only your sources, and the files depending of your sources # this will compile only your sources and the files depending on your sources
# and generate the new executables in your own directory # and generate the new executables in your own directory
# #
# dir_obj-$(ARCH).../${VER_USER} # dir_obj-$(ARCH).../${VER_USER}
# #
# #
# WARNING : # WARNING :
# ======== # ========
# before compiling your own sources be sure that these ones # Before compiling your own sources be sure that these ones
# are younger than the "*.o" files of the MASTER directory # are younger than the "*.o" files of the MASTER directory.
# if any doubt, at any time use the command # If any doubt, at any time use the command
# #
# touch *.f* # touch *.f*
# #
...@@ -531,25 +523,24 @@ make user ...@@ -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 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 # And run the examples. Your version should appear in the name of the used executables.
# used .
# #
make examples make examples
^L ^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" # After downloading "exactly" like on "any standalone PC"
# run the "./configure" command : # run the "./configure" command :
...@@ -558,123 +549,197 @@ make examples ...@@ -558,123 +549,197 @@ make examples
./configure ./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} # 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 : # WARNING :
# ======== # ========
# - Think to do a backup of your installation # - 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 !!! # probably occur !!!
# #
cd $WORKDIR cd $WORKDIR
cvs co -r PACK-MNH-V5-2-1 -d MNH-V5-2-1 MNH-VX-Y-Z cd MNH-V5-7-1/src
cd MNH-V5-2-1/src
./configure ./configure
# #
# Due to limitation in time & memory on interactive connection # 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 : # 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
# # You could also use the 'compil' partition
#
# - On TURING (IBM BG/Q ) :
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 # - install the PACKAGE in your $HOME ( default 50Go of quota )
# - you could compile in interactive mode # - 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 # At TGCC they use 'one login' for multi-project allocation .
# if you need more disk space than allowed for 'standard' user # This induce 'strange' problem with the installation of eccodes
# Ask to Dominique Lucas, look this email : # 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 : # I recommand you first, supposing that the "Genci Allocation" you want to use
# as for projet group "genXXXX"
qsub job_make_mesonh_CRAY_cca #
# 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 . id -ng
# I you have trouble with this one , you could compile with the Intel/ifort one . --> genXXXX
# Use the ifort one do : 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 ./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 ecinteractive -c16 -m 16G -t 12:00:00
#ARCH=LXcray # this is the default one
. ../conf/profile_mesonh-${ARCH}I4-MNH-V5-2-1-MPICRAY-O2 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 : # in job_make_mesonh_user_BullX insert " export VER_USER=MY_MODIF "
# then submit in batch mode
export MONORUN="mpirun -np 1"
export MPIRUN="mpirun -np 4 "
# and run with
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" # That's all for the basic INSTALLATION of the "MESONH PACKAGE"
...@@ -684,7 +749,7 @@ llsubmit job_make_examples_CRAY_cca ...@@ -684,7 +749,7 @@ llsubmit job_make_examples_CRAY_cca
# VII) "SCANDOLLAR" = SCRIPTING YOUR OWN PROCEDURES # 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. # A small script 'scandollar' is in test in this version of MESONH.
# It will help you to build a complete chaining of an experiment. # It will help you to build a complete chaining of an experiment.
...@@ -730,7 +795,7 @@ scandollar ...@@ -730,7 +795,7 @@ scandollar
## OUTPUT :: ## 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 ># read user config file :: ---> CONFIG=confdollar
># >#
...@@ -752,7 +817,7 @@ scandollar 0* ...@@ -752,7 +817,7 @@ scandollar 0*
## OUTPUT :: ## 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 ># read user config file :: ---> CONFIG=confdollar
># >#
...@@ -826,22 +891,22 @@ cp -R 007_16janvier_scandollar /.../your_directory ...@@ -826,22 +891,22 @@ cp -R 007_16janvier_scandollar /.../your_directory
# #
# use this "profile_mesonh" : # 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 ) # 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 # On vargas
# --------- # ---------
# use this "profile_mesonh" : # 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 : # 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 : # - At CINES on JADE :
...@@ -849,11 +914,11 @@ cp -R 007_16janvier_scandollar /.../your_directory ...@@ -849,11 +914,11 @@ cp -R 007_16janvier_scandollar /.../your_directory
# #
# use # 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 # 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 : # - At ECMWF on cxa :
...@@ -861,11 +926,11 @@ cp -R 007_16janvier_scandollar /.../your_directory ...@@ -861,11 +926,11 @@ cp -R 007_16janvier_scandollar /.../your_directory
# #
# use # 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 # 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 ...@@ -920,34 +985,7 @@ ulimit -s unlimited
# #
# IX) OPTIONAL COMPILATION # IX) OPTIONAL COMPILATION
=========================== ===========================
# # a) MNH_FOREFIRE for forefire runs ( external package needed )
# 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 )
# ------------------------------------------------------------- # -------------------------------------------------------------
# #
# If you want to use coupled(inline) run with FOREFIRE and MESONH # 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 ...@@ -979,46 +1017,102 @@ git clone -b 2014.01 https://github.com/forefireAPI/firefront.git
# or move/linked to the 'exe' directory of MesoNH # or move/linked to the 'exe' directory of MesoNH
# #
# see d) for cleaning previously version if needed # 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 # The RTTOV 13.2 package was not included into the open source version of Meso-NH
# because it needs a licence agrement . # 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 # c) MNH_ECRAD for optional compilation of new ECRAD radiative library from ECMWF
cvs up -rPACK-MNH-V4-10-3 -d -P RTTOV # --------------------------------------
#
# 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 # Configure & Compilation
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 export MNH_ECRAD=1
tar xvfz RTTOV.tar.gz 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
# #
# Usage :
cd MNH.../src/ # 1) In namelist replace RAD='ECMW' by RAD='ECRA'
export MNH_RTTOV=1 # 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 ./configure
etc ... etc ...
# e) cleaning previous compiled version
# d) cleaning previous compiled version
# -------------------------------------- # --------------------------------------
# #
# If you have already compiled exactly the same version of MesoNH on this computer ( same $XYZ value ) # 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 @ 050d6a3c
!----------------------------------------------------------------- !MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
!--------------- special set of characters for RCS information !MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!----------------------------------------------------------------- !MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
! $Source$ $Revision$ $Date$ !MNH_LIC for details. version 1.
!----------------------------------------------------------------- !-----------------------------------------------------------------
SUBROUTINE COMPRESS_FIELD(XTAB,KX,KY,KNBTOT,KNBUSE) SUBROUTINE COMPRESS_FIELD(XTAB,KX,KY,KNBTOT,KNBUSE)
USE MODD_COMPPAR USE MODD_COMPPAR
USE MODE_SEARCHGRP USE MODE_SEARCHGRP
#ifdef NAGf95
USE,INTRINSIC :: IEEE_ARITHMETIC USE,INTRINSIC :: IEEE_ARITHMETIC
#endif
IMPLICIT NONE IMPLICIT NONE
...@@ -38,17 +36,21 @@ INTEGER :: IEXTCOD ...@@ -38,17 +36,21 @@ INTEGER :: IEXTCOD
CHARACTER(LEN=8),PARAMETER :: KEYWORD='COMPRESS' CHARACTER(LEN=8),PARAMETER :: KEYWORD='COMPRESS'
REAL,DIMENSION(KNBTOT) :: XWORKTAB REAL,DIMENSION(KNBTOT) :: XWORKTAB
LOGICAL :: LUPREAL,LNAN LOGICAL :: LUPREAL,LNAN
#ifndef NAGf95 logical :: gnansupport
LOGICAL, EXTERNAL :: IEEE_IS_NAN
#endif
ILEVNBELT = KX*KY ILEVNBELT = KX*KY
LUPREAL = .FALSE. LUPREAL = .FALSE.
LNAN = .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. ! Check for NAN and change Upper and Lower bound according to 32bits real limits.
DO JI=1,KNBTOT DO JI=1,KNBTOT
IF (IEEE_IS_NAN(XTAB(JI))) THEN IF ( gnansupport .and. IEEE_IS_NAN(XTAB(JI)) ) THEN
XTAB(JI)=0. XTAB(JI)=0.
LNAN = .TRUE. LNAN = .TRUE.
ELSE IF (ABS(XTAB(JI)) > HUGE(1.0_4)) THEN ELSE IF (ABS(XTAB(JI)) > HUGE(1.0_4)) THEN
......
LIBTOOLS/lib/COMPRESS/src/ieee_is_nan.c deleted 100644 → 0
View file @ 46061192
#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 @ 050d6a3c
#!/bin/sh #!/bin/bash
# #
# #
usage(){ usage(){
......
LIBTOOLS/tools/lfi2cdf/src/fieldtype.f90 deleted 100644 → 0
View file @ 46061192
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 @ 050d6a3c
!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 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_options
USE MODE_SET_GRID, ONLY: INTERP_HORGRID_TO_MASSPOINTS
USE MODE_SPLITTINGZ_ll, ONLY: INI_PARAZ_ll
USE mode_util USE mode_util
USE MODI_VERSION
USE MODN_CONFIO, ONLY: LCDF4, LLFIOUT, LLFIREAD
IMPLICIT NONE IMPLICIT NONE
INTEGER :: ibuflen
INTEGER :: ji INTEGER :: ji
INTEGER :: nbvar_infile ! number of variables available in the input file INTEGER :: nbvar_infile = 0 ! number of variables available in the input file
INTEGER :: nbvar_tbr ! number of variables to be read INTEGER :: nbvar_tbr = 0 ! number of variables to be read
INTEGER :: nbvar_calc ! number of variables to be computed from others INTEGER :: nbvar_calc = 0 ! number of variables to be computed from others
INTEGER :: nbvar_tbw ! number of variables to be written INTEGER :: nbvar_tbw = 0 ! number of variables to be written
INTEGER :: nbvar ! number of defined variables INTEGER :: nbvar = 0 ! number of defined variables
INTEGER :: first_level, current_level, last_level, nb_levels INTEGER :: IINFO_ll ! return code of // routines
INTEGER :: nfiles_out = 0 ! number of output files
CHARACTER(LEN=:),allocatable :: hvarlist 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(workfield), DIMENSION(:), POINTER :: tzreclist
type(option),dimension(:),allocatable :: options type(option),dimension(:),allocatable :: options
...@@ -20,11 +49,76 @@ program LFI2CDF ...@@ -20,11 +49,76 @@ program LFI2CDF
integer :: runmode 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 read_commandline(options,hinfile,houtfile,runmode)
CALL OPEN_FILES(infiles, outfiles, hinfile, houtfile, nbvar_infile, options, runmode) 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 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 (runmode == MODELFI2CDF .OR. runmode == MODECDF2CDF) THEN
IF (options(OPTVAR)%set) THEN IF (options(OPTVAR)%set) THEN
! nbvar_tbr is computed from number of requested variables ! nbvar_tbr is computed from number of requested variables
...@@ -48,87 +142,35 @@ program LFI2CDF ...@@ -48,87 +142,35 @@ program LFI2CDF
ELSE ELSE
nbvar = nbvar_infile nbvar = nbvar_infile
END IF END IF
ELSE
nbvar = nbvar_infile
END IF END IF
IF (runmode == MODELFI2CDF) THEN IF (runmode == MODELFI2CDF) THEN
! Conversion LFI -> NetCDF ! Conversion LFI -> NetCDF
IF (options(OPTSPLIT)%set) call open_split_ncfiles_out(outfiles,nfiles_out,houtfile,nbvar_tbw,options)
!Standard treatment (one LFI file only) CALL parse_infiles(infiles,outfiles,nfiles_out,nbvar_infile,nbvar_tbr,nbvar_calc,nbvar_tbw,tzreclist,options,runmode)
IF (.not.options(OPTMERGE)%set) THEN CALL def_ncdf(infiles,outfiles,nfiles_out)
CALL parse_infiles(infiles,nbvar_infile,nbvar_tbr,nbvar_calc,nbvar_tbw,tzreclist,ibuflen,options) CALL fill_files(infiles,outfiles,tzreclist,nbvar,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
ELSE IF (runmode == MODECDF2CDF) THEN ELSE IF (runmode == MODECDF2CDF) THEN
! Conversion netCDF -> netCDF ! Conversion netCDF -> netCDF
IF (options(OPTSPLIT)%set) call open_split_ncfiles_out(outfiles,nfiles_out,houtfile,nbvar_tbw,options)
!Standard treatment (one netCDF file only) CALL parse_infiles(infiles,outfiles,nfiles_out,nbvar_infile,nbvar_tbr,nbvar_calc,nbvar_tbw,tzreclist,options,runmode)
IF (.not.options(OPTMERGE)%set) THEN CALL def_ncdf(infiles,outfiles,nfiles_out)
CALL parse_infiles(infiles,nbvar_infile,nbvar_tbr,nbvar_calc,nbvar_tbw,tzreclist,ibuflen,options,current_level) CALL fill_files(infiles,outfiles,tzreclist,nbvar,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 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
ELSE ELSE
! Conversion NetCDF -> LFI ! Conversion NetCDF -> LFI
CALL parse_infiles(infiles,nbvar_infile,nbvar_tbr,nbvar_calc,nbvar_tbw,tzreclist,ibuflen,options,current_level) CALL parse_infiles(infiles,outfiles,nfiles_out,nbvar_infile,nbvar_tbr,nbvar_calc,nbvar_tbw,tzreclist,options,runmode)
CALL build_lfi(infiles,outfiles,tzreclist,ibuflen) CALL fill_files(infiles,outfiles,tzreclist,nbvar,options)
END IF END IF
CALL CLOSE_FILES(infiles) if ( options( OPTFALLBACK )%set ) then
CALL CLOSE_FILES(outfiles) CALL CLOSE_FILES(infiles, 2)
else
CALL CLOSE_FILES(infiles, 1)
end if
CALL CLOSE_FILES(outfiles,nfiles_out)
end program LFI2CDF end program LFI2CDF
LIBTOOLS/tools/lfi2cdf/src/modd_ncparam.f90 deleted 100644 → 0
View file @ 46061192
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 @ 46061192
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 @ 050d6a3c
!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 module mode_options
use modd_field, only: TYPEUNDEF, TYPEINT, TYPELOG, TYPEREAL, TYPECHAR, TYPEDATE
implicit none implicit none
integer,parameter :: nbavailoptions = 10 integer,parameter :: NBAVAILOPTIONS = 12
integer,parameter :: TYPEUNDEF = -1, TYPEINT = 1, TYPELOG = 2, TYPEREAL = 3, TYPECHAR = 4
integer,parameter :: MODEUNDEF = -11, MODECDF2CDF = 11, MODELFI2CDF = 12, MODECDF2LFI = 13 integer,parameter :: MODEUNDEF = -11, MODECDF2CDF = 11, MODELFI2CDF = 12, MODECDF2LFI = 13
integer,parameter :: OPTCDF3 = 1, OPTCDF4 = 2, OPTCOMPRESS = 3 integer,parameter :: OPTCOMPRESS = 1, OPTHELP = 2, OPTLIST = 3
integer,parameter :: OPTHELP = 4, OPTLIST = 5, OPTMERGE = 6 integer,parameter :: OPTMERGE = 4, OPTOUTPUT = 5, OPTREDUCE = 6
integer,parameter :: OPTOUTPUT = 7, OPTREDUCE = 8, OPTSPLIT = 9 integer,parameter :: OPTMODE = 7, OPTSPLIT = 8, OPTVAR = 9
integer,parameter :: OPTVAR = 10 integer,parameter :: OPTVERBOSE = 10, OPTFALLBACK = 11, OPTDIR = 12
type option type option
logical :: set = .false. logical :: set = .false.
...@@ -31,7 +41,7 @@ subroutine read_commandline(options,hinfile,houtfile,runmode) ...@@ -31,7 +41,7 @@ subroutine read_commandline(options,hinfile,houtfile,runmode)
character(len=:),allocatable,intent(out) :: houtfile character(len=:),allocatable,intent(out) :: houtfile
integer,intent(out) :: runmode integer,intent(out) :: runmode
integer :: idx, ji, nbargs, status, sz integer :: idx, nbargs, status, sz
logical :: finished logical :: finished
character(len=:),allocatable :: command, fullcommand character(len=:),allocatable :: command, fullcommand
...@@ -53,8 +63,6 @@ subroutine read_commandline(options,hinfile,houtfile,runmode) ...@@ -53,8 +63,6 @@ subroutine read_commandline(options,hinfile,houtfile,runmode)
runmode = MODELFI2CDF runmode = MODELFI2CDF
case default case default
runmode = MODEUNDEF runmode = MODEUNDEF
print *,'Error: program started with unknown command: ',command
call help()
end select end select
deallocate(command,fullcommand) deallocate(command,fullcommand)
...@@ -80,31 +88,21 @@ subroutine read_commandline(options,hinfile,houtfile,runmode) ...@@ -80,31 +88,21 @@ subroutine read_commandline(options,hinfile,houtfile,runmode)
call check_options(options,hinfile,runmode) call check_options(options,hinfile,runmode)
call remove_suffix(hinfile)
!Remove level in the filename if merging LFI splitted files !Determine outfile name if not given
if (.NOT.options(OPTOUTPUT)%set) then if (.NOT.options(OPTOUTPUT)%set .AND. .NOT.options(OPTSPLIT)%set) then
if (options(OPTMERGE)%set .AND. .NOT.options(OPTSPLIT)%set) then idx = index(hinfile,'/',back=.true.)
houtfile=houtfile(1:len(houtfile)-9)//houtfile(len(houtfile)-3:) options(OPTOUTPUT)%cvalue = hinfile(idx+1:len_trim(hinfile))//'_merged'
end if end if
if (.NOT.options(OPTMERGE)%set .AND. options(OPTSPLIT)%set) then
if (options(OPTCDF4)%set) then if (.NOT.options(OPTOUTPUT)%set .AND. options(OPTSPLIT)%set) then
ji=4 idx = index(hinfile,'/',back=.true.)
else options(OPTOUTPUT)%cvalue = trim(hinfile)
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
else
houtfile = options(OPTOUTPUT)%cvalue
end if end if
houtfile = options(OPTOUTPUT)%cvalue
call remove_suffix(houtfile)
end subroutine read_commandline end subroutine read_commandline
...@@ -115,14 +113,6 @@ subroutine init_options(options) ...@@ -115,14 +113,6 @@ subroutine init_options(options)
allocate(options(nbavailoptions)) 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)%long_name = "compress"
options(OPTCOMPRESS)%short_name = 'c' options(OPTCOMPRESS)%short_name = 'c'
options(OPTCOMPRESS)%has_argument = .true. options(OPTCOMPRESS)%has_argument = .true.
...@@ -150,6 +140,11 @@ subroutine init_options(options) ...@@ -150,6 +140,11 @@ subroutine init_options(options)
options(OPTREDUCE)%short_name = 'r' options(OPTREDUCE)%short_name = 'r'
options(OPTREDUCE)%has_argument = .false. 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)%long_name = "split"
options(OPTSPLIT)%short_name = 's' options(OPTSPLIT)%short_name = 's'
options(OPTSPLIT)%has_argument = .false. options(OPTSPLIT)%has_argument = .false.
...@@ -159,6 +154,20 @@ subroutine init_options(options) ...@@ -159,6 +154,20 @@ subroutine init_options(options)
options(OPTVAR)%has_argument = .true. options(OPTVAR)%has_argument = .true.
options(OPTVAR)%type = TYPECHAR 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 end subroutine init_options
subroutine get_option(options,finished) subroutine get_option(options,finished)
...@@ -241,24 +250,32 @@ subroutine check_options(options,infile,runmode) ...@@ -241,24 +250,32 @@ subroutine check_options(options,infile,runmode)
type(option),dimension(:),intent(inout) :: options type(option),dimension(:),intent(inout) :: options
character(len=:),allocatable,intent(in) :: infile character(len=:),allocatable,intent(in) :: infile
integer,intent(in) :: runmode integer,intent(inout) :: runmode
integer :: idx1, idx2 integer :: idx1, idx2
!Check if help has been asked !Check if help has been asked
if (options(OPTHELP)%set) then if (options(OPTHELP)%set) then
call help() call help()
end if end if
!Use NetCF-4 by default !Check runmode
if (.NOT.options(OPTCDF3)%set) then if (options(OPTMODE)%set) then
options(OPTCDF4)%set = .true. 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 else
if (options(OPTCDF4)%set) then if(runmode==MODEUNDEF) then
print *,'Warning: NetCDF-3 and NetCDF-4 options are not compatible' print *,'Error: program started with unknown command'
print *,'NetCDF-4 is forced' call help()
options(OPTCDF3)%set = .false.
end if end if
end if end if
...@@ -276,63 +293,86 @@ subroutine check_options(options,infile,runmode) ...@@ -276,63 +293,86 @@ subroutine check_options(options,infile,runmode)
call help() call help()
end if 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 !Split flag only supported if -v is set
if (options(OPTSPLIT)%set .AND. .NOT.options(OPTVAR)%set) then if (options(OPTSPLIT)%set .AND. .NOT.options(OPTVAR)%set) then
options(OPTSPLIT)%set = .false. options(OPTSPLIT)%set = .false.
print *,"Warning: split option is forced to disable" print *,"Warning: split option is forced to disable"
end if end if
!Determine outfile name if not given !Check list option
if (.NOT.options(OPTOUTPUT)%set) then if (options(OPTSPLIT)%set .AND. runmode==MODECDF2LFI) then
idx1 = index(infile,'/',back=.true.) print *,'Error: split option is not supported by cdf2lfi'
idx2 = index(infile,'.',back=.true.) call help()
options(OPTOUTPUT)%cvalue = infile(idx1+1:idx2-1)
end if end if
end subroutine check_options 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() subroutine help()
implicit none implicit none
!TODO: -l option for cdf2cdf and cdf2lfi !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 *," [-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 *," [-c --compress compression_level] input-file.lfi"
print *," cdf2cdf [-h --help] [--cdf4 -4] [-v --var var1[,...]] [-r --reduce-precision]" print *," cdf2cdf [-h --help] [-v --var var1[,...]] [-r --reduce-precision]"
print *," [-m --merge number_of_z_levels] [-s --split] [-o --output output-file.nc]" 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 *," [-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 *,""
print *,"Options:" 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, -c compression_level"
print *," Compress data. The compression level should be in the 1 to 9 interval." 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 *," --help, -h"
print *," Print this text" print *," Print this text"
print *," --list, -l" print *," --list, -l"
print *," List all the fields of the LFI file and returns (lfi2cdf only)" print *," List all the fields of the LFI file and returns (lfi2cdf only)"
print *," --merge, -m number_of_z_levels" print *," --merge, -m number_of_split_files"
print *," Merge LFI files which are split by vertical level (cdf2cdf and lfi2cdf only)" print *," Merge files which are split by vertical level (cdf2cdf and lfi2cdf only)"
print *," --output, -o" print *," --output, -o"
print *," Name of file for the output" print *," Name of file for the output"
print *," --reduce-precision, -r" print *," --reduce-precision, -r"
print *," Reduce the precision of the floating point variables to single precision (cdf2cdf and lfi2cdf only)" 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, -s"
print *," Split variables specified with the -v option (one per file) (cdf2cdf and lfi2cdf only)" print *," Split variables specified with the -v option (one per file) (cdf2cdf and lfi2cdf only)"
print *," --var, -v var1[,...]" print *," --var, -v var1[,...]"
print *," List of the variable to write in the output file. Variables names have to be separated by commas (,)." 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 *," A variable can be computed from the sum of existing variables (format: new_var=var1+var2[+...])"
print *," (cdf2cdf and lfi2cdf only)" print *," (cdf2cdf and lfi2cdf only)"
print *," --verbose, -V"
print *," Be verbose (for debugging purpose)"
print *,"" print *,""
stop stop
......
LIBTOOLS/tools/lfi2cdf/src/mode_util.f90
View file @ 050d6a3c
!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 MODULE mode_util
USE MODE_FIELDTYPE use modd_field, only: tfieldmetadata, tfieldlist
USE mode_dimlist 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 mode_options
USE MODD_PARAM
USE netcdf
USE NETCDF
IMPLICIT NONE IMPLICIT NONE
INTEGER,PARAMETER :: MAXRAW=10 INTEGER,PARAMETER :: MAXRAW=10
INTEGER,PARAMETER :: MAXLEN=512
INTEGER,PARAMETER :: MAXFILES=100 INTEGER,PARAMETER :: MAXFILES=100
INTEGER,parameter :: MAXDATES=100
INTEGER,PARAMETER :: UNDEFINED = -1, READING = 1, WRITING = 2 INTEGER,PARAMETER :: FM_FIELD_SIZE = 32
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
TYPE workfield TYPE workfield
CHARACTER(LEN=FM_FIELD_SIZE) :: name ! nom du champ CHARACTER(LEN=NMNHNAMELGTMAX) :: name ! nom du champ
INTEGER :: TYPE ! type (entier ou reel) LOGICAL :: found ! T if found in the input file
CHARACTER(LEN=:), POINTER :: comment LOGICAL :: calc ! T if computed from other variables
TYPE(dimCDF), POINTER :: dim LOGICAL :: tbw ! to be written or not
INTEGER :: id_in = -1, id_out = -1 LOGICAL :: tbr ! to be read or not
INTEGER :: grid LOGICAL :: LSPLIT = .FALSE. ! TRUE if variable is split by vertical level
LOGICAL :: found ! T if found in the input file INTEGER :: NSIZE = 0 ! Size of the variable (in number of elements)
LOGICAL :: calc ! T if computed from other variables INTEGER :: NSRC = 0 ! Number of variables used to compute the variable (needed only if calc=.true.)
LOGICAL :: tbw ! to be written or not INTEGER(kind=CDFINT) :: NDIMS_FILE ! Number of dims (as present in input file)
LOGICAL :: tbr ! to be read or not INTEGER(kind=CDFINT), DIMENSION(:),ALLOCATABLE :: NDIMSIZES_FILE ! Dimensions sizes (as present in input file)
INTEGER,DIMENSION(MAXRAW) :: src ! List of variables used to compute the variable (needed only if calc=.true.) CHARACTER(LEN=NF90_MAX_NAME),DIMENSION(:),ALLOCATABLE :: CDIMNAMES_FILE ! Dimensions names (as present in input file)
INTEGER :: tgt ! Target: id of the variable that use it (calc variable) 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 END TYPE workfield
#ifndef LOWMEM LOGICAL(KIND=LFIINT), PARAMETER :: ltrue = .TRUE.
TYPE lfidata LOGICAL(KIND=LFIINT), PARAMETER :: lfalse = .FALSE.
INTEGER(KIND=8), DIMENSION(:), POINTER :: iwtab
END TYPE lfidata
TYPE(lfidata), DIMENSION(:), ALLOCATABLE :: lfiart
#endif
LOGICAL(KIND=LFI_INT), PARAMETER :: ltrue = .TRUE. CHARACTER(LEN=6) :: CPROGRAM_ORIG
LOGICAL(KIND=LFI_INT), PARAMETER :: lfalse = .FALSE.
CONTAINS CONTAINS
FUNCTION str_replace(hstr, hold, hnew) SUBROUTINE parse_infiles(infiles, outfiles, KNFILES_OUT, nbvar_infile, nbvar_tbr, nbvar_calc, nbvar_tbw, &
CHARACTER(LEN=*) :: hstr, hold, hnew tpreclist, options, runmode)
CHARACTER(LEN=LEN_TRIM(hstr)+MAX(0,LEN(hnew)-LEN(hold))) :: str_replace USE MODD_DIM_n, ONLY: NIMAX_ll, NJMAX_ll, NKMAX
use modd_io, only: nio_verb
INTEGER :: pos USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT, NGRIDUNKNOWN
pos = INDEX(hstr,hold) use mode_io_tools_nc4, only: IO_Dimids_guess_nc4
IF (pos /= 0) THEN
str_replace = hstr(1:pos-1)//hnew//hstr(pos+LEN(hold):) TYPE(TFILE_ELT),DIMENSION(:), INTENT(IN) :: infiles
ELSE TYPE(TFILE_ELT),DIMENSION(:), INTENT(IN) :: outfiles
str_replace = hstr INTEGER, INTENT(IN) :: KNFILES_OUT
END IF INTEGER, INTENT(IN) :: nbvar_infile, nbvar_tbr, nbvar_calc, nbvar_tbw
TYPE(workfield), DIMENSION(:),POINTER,INTENT(OUT) :: tpreclist
END FUNCTION str_replace TYPE(option),DIMENSION(:), INTENT(IN) :: options
INTEGER, INTENT(IN) :: runmode
SUBROUTINE FMREADLFIN1(klu,hrecfm,kval,kresp)
INTEGER(KIND=LFI_INT), INTENT(IN) :: klu ! logical fortran unit au lfi file TYPE TLFIDATE
CHARACTER(LEN=*),INTENT(IN) :: hrecfm ! article name to be read CHARACTER(LEN=FM_FIELD_SIZE) :: CNAME = '' !Name of the date variable
INTEGER, INTENT(OUT) :: kval ! integer value for hrecfm article INTEGER :: NIDX_DATE = -1 !Index of the date part
INTEGER(KIND=LFI_INT), INTENT(OUT):: kresp! return code null if OK INTEGER :: NIDX_TIME = -1 !Index of the time part
! END TYPE TLFIDATE
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE::iwork
INTEGER :: icomlen CHARACTER(LEN=FM_FIELD_SIZE) :: yrecfm, YDATENAME
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
CHARACTER(LEN=FM_FIELD_SIZE) :: var_calc CHARACTER(LEN=FM_FIELD_SIZE) :: var_calc
CHARACTER(LEN=FM_FIELD_SIZE),dimension(MAXRAW) :: var_raw CHARACTER(LEN=FM_FIELD_SIZE),dimension(MAXRAW) :: var_raw
INTEGER, DIMENSION(10) :: idim_id CHARACTER(LEN=1) :: YNDIMS
INTEGER :: JPHEXT CHARACTER(LEN=32) :: YTYPE
INTEGER :: ji,jj
IF (infiles%files(1)%format == LFI_FORMAT) THEN INTEGER :: ndb, nde, ndey, idx, idx_out, idx_var, maxvar
ilu = infiles%files(1)%lun_id INTEGER :: leng
CALL FMREADLFIN1(ilu,'JPHEXT',JPHEXT,iresp) INTEGER :: IID, IRESP, IDATES, ICURDATE
IF (iresp /= 0) JPHEXT=1 INTEGER :: IDXDATE, IDXTIME
INTEGER(KIND=LFIINT) :: iresp2,ilu,ileng,ipos
! First check if IMAX,JMAX,KMAX exist in LFI file INTEGER(KIND=CDFINT) :: kcdf_id, kcdf_id2, var_id
! to handle 3D, 2D variables -> update IDIMX,IDIMY,IDIMZ INTEGER(KIND=CDFINT) :: status
CALL FMREADLFIN1(ilu,'IMAX',IDIMX,iresp) LOGICAL :: ladvan
IF (iresp == 0) IDIMX = IDIMX+2*JPHEXT ! IMAX + 2*JPHEXT LOGICAL :: GOK
! TYPE(TLFIDATE),DIMENSION(MAXDATES) :: TLFIDATES
CALL FMREADLFIN1(ilu,'JMAX',IDIMY,iresp) type(TFILEDATA) :: tzfile
IF (iresp == 0) IDIMY = IDIMY+2*JPHEXT ! JMAX + 2*JPHEXT
! CALL PRINT_MSG(NVERB_DEBUG,'IO','parse_infiles','called')
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
GUSEDIM = (IDIMX*IDIMY > 0) IF (options(OPTSPLIT)%set) THEN
IF (GUSEDIM) THEN idx_out = 0
PRINT *,'MESONH 3D, 2D articles DIMENSIONS used :'
PRINT *,'DIMX =',IDIMX
PRINT *,'DIMY =',IDIMY
PRINT *,'DIMZ =',IDIMZ ! IDIMZ may be equal to 0 (PGD files)
ELSE ELSE
PRINT *,'BEWARE : ALL MesoNH arrays are handled as 1D arrays !' idx_out = 1
END IF 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 IF (INFILES(1)%TFILE%CFORMAT == 'LFI') THEN
write(suffix,'(I4.4)') icurrent_level ilu = INFILES(1)%TFILE%NLFIFLU
current_level = icurrent_level ELSE IF (INFILES(1)%TFILE%CFORMAT == 'NETCDF4') THEN
ElSE kcdf_id = INFILES(1)%TFILE%NNCID
suffix=''
current_level = -1
END IF 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. ! Phase 1 : build articles list to convert.
! !
! Pour l'instant tous les articles du fichier LFI sont ! Pour l'instant tous les articles du fichier LFI sont
...@@ -178,9 +141,6 @@ CONTAINS ...@@ -178,9 +141,6 @@ CONTAINS
! l'utilisateur par exemple) ! l'utilisateur par exemple)
! !
IF (options(OPTVAR)%set) THEN 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)) ALLOCATE(tpreclist(nbvar_tbr+nbvar_calc))
DO ji=1,nbvar_tbr+nbvar_calc DO ji=1,nbvar_tbr+nbvar_calc
tpreclist(ji)%found = .FALSE. tpreclist(ji)%found = .FALSE.
...@@ -206,8 +166,7 @@ CONTAINS ...@@ -206,8 +166,7 @@ CONTAINS
var_calc = yrecfm(1:ndey-1) var_calc = yrecfm(1:ndey-1)
DO WHILE (ndey /= 0) DO WHILE (ndey /= 0)
IF (idx>MAXRAW) THEN IF (idx>MAXRAW) THEN
print *,'Error: MAXRAW exceeded (too many raw variables for 1 computed one)' CALL PRINT_MSG(NVERB_FATAL,'IO','parse_infiles','MAXRAW exceeded (too many raw variables for 1 computed one)')
STOP
END IF END IF
yrecfm = yrecfm(ndey+1:) yrecfm = yrecfm(ndey+1:)
ndey = INDEX(TRIM(yrecfm),'+') ndey = INDEX(TRIM(yrecfm),'+')
...@@ -223,6 +182,7 @@ CONTAINS ...@@ -223,6 +182,7 @@ CONTAINS
tpreclist(idx_var)%calc = .TRUE. tpreclist(idx_var)%calc = .TRUE.
tpreclist(idx_var)%tbw = .TRUE. tpreclist(idx_var)%tbw = .TRUE.
tpreclist(idx_var)%tbr = .FALSE. tpreclist(idx_var)%tbr = .FALSE.
tpreclist(idx_var)%NSRC = idx-1
idx_var=idx_var+1 idx_var=idx_var+1
DO jj = 1, idx-1 DO jj = 1, idx-1
tpreclist(idx_var-jj)%src(jj) = idx_var tpreclist(idx_var-jj)%src(jj) = idx_var
...@@ -249,59 +209,80 @@ CONTAINS ...@@ -249,59 +209,80 @@ CONTAINS
IF (tpreclist(ji)%calc) CYCLE IF (tpreclist(ji)%calc) CYCLE
yrecfm = TRIM(tpreclist(ji)%name) yrecfm = TRIM(tpreclist(ji)%name)
IF (infiles%files(1)%format == LFI_FORMAT) THEN IF (INFILES(1)%TFILE%CFORMAT == 'LFI') THEN
CALL LFINFO(iresp,ilu,trim(yrecfm)//trim(suffix),ileng,ipos) CALL LFINFO(iresp2,ilu,trim(yrecfm),ileng,ipos)
IF (iresp == 0 .AND. ileng /= 0) tpreclist(ji)%found = .true. IF (iresp2 == 0 .AND. ileng /= 0) THEN
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
tpreclist(ji)%found = .true. tpreclist(ji)%found = .true.
status = NF90_INQUIRE_VARIABLE(kcdf_id,tpreclist(ji)%id_in,ndims = idims,dimids = idim_id) tpreclist(ji)%NSIZE = ileng - 2 - NLFIMAXCOMMENTLENGTH
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__) END IF
!TODO:useful? IF (iresp2==0 .AND. ileng == 0 .AND. ipos==0 .AND. INFILES(1)%TFILE%NSUBFILES_IOZ>0) THEN
!DUPLICATED !Variable not found with no error (iresp2==0 .AND. ileng == 0 .AND. ipos==0)
IF (idims == 0) THEN !If we are merging, maybe it is one of the split variable
! variable scalaire !In that case, the 1st part of the variable is in the 1st split file with a 0001 suffix
leng = 1 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 ELSE
! infos sur dimensions if ( status /= NF90_NOERR ) &
leng = 1 call IO_Err_handle_nc4( status, 'parse_infiles', 'NF90_INQ_VARID', trim(yrecfm)//'0001' )
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 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
END IF END IF
IF (.NOT.tpreclist(ji)%found) THEN 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)%tbw = .FAlSE.
tpreclist(ji)%tbr = .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 IF
END DO END DO
maxvar = nbvar_tbr+nbvar_calc 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,& if ( nio_verb >= NVERB_INFO ) then
' tbr=',tpreclist(ji)%tbr,' found=',tpreclist(ji)%found do ji = 1, nbvar_tbr + nbvar_calc
END DO 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 ELSE
! Entire file is converted ! 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)) ALLOCATE(tpreclist(nbvar_infile))
DO ji=1,nbvar_infile DO ji=1,nbvar_infile
tpreclist(ji)%calc = .FALSE. !By default variables are not computed from others tpreclist(ji)%calc = .FALSE. !By default variables are not computed from others
...@@ -309,1082 +290,1341 @@ END DO ...@@ -309,1082 +290,1341 @@ END DO
tpreclist(ji)%src(:) = -1 tpreclist(ji)%src(:) = -1
END DO END DO
IF (infiles%files(1)%format == LFI_FORMAT) THEN IF (INFILES(1)%TFILE%CFORMAT == 'LFI') THEN
CALL LFIPOS(iresp,ilu) CALL LFIPOS(iresp2,ilu)
ladvan = .TRUE. ladvan = .TRUE.
DO ji=1,nbvar_infile DO ji=1,nbvar_infile
CALL LFICAS(iresp,ilu,yrecfm,ileng,ipos,ladvan) CALL LFICAS(iresp2,ilu,yrecfm,ileng,ipos,ladvan)
! PRINT *,'Article ',ji,' : ',TRIM(yrecfm),', longueur = ',ileng tpreclist(ji)%name = trim(yrecfm)
tpreclist(ji)%name = trim(yrecfm)
tpreclist(ji)%found = .TRUE. tpreclist(ji)%found = .TRUE.
IF (ileng > sizemax) sizemax = ileng tpreclist(ji)%NSIZE = ileng - 2 - NLFIMAXCOMMENTLENGTH
#ifndef LOWMEM
ALLOCATE(lfiart(ji)%iwtab(ileng)) !Detect if date variable
#endif 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
!
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 END DO
ELSE IF (infiles%files(1)%format == NETCDF_FORMAT) THEN
!
ELSE IF (INFILES(1)%TFILE%CFORMAT == 'NETCDF4') THEN
DO ji=1,nbvar_infile DO ji=1,nbvar_infile
tpreclist(ji)%id_in = ji var_id = ji
status = NF90_INQUIRE_VARIABLE(kcdf_id,tpreclist(ji)%id_in, name = tpreclist(ji)%name, ndims = idims, & status = NF90_INQUIRE_VARIABLE(kcdf_id,var_id, name = tpreclist(ji)%name)
dimids = idim_id) if ( status /= NF90_NOERR ) &
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__) call IO_Err_handle_nc4( status, 'parse_infiles', 'NF90_INQUIRE_VARIABLE', tpreclist(ji)%name )
! PRINT *,'Article ',ji,' : ',TRIM(tpreclist(ji)%name),', longueur = ',ileng
tpreclist(ji)%found = .TRUE. tpreclist(ji)%found = .TRUE.
!TODO:useful? CALL IO_Metadata_get_nc4(INFILES(1)%TFILE,var_id,tpreclist(ji))
!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
END DO END DO
END IF END IF
maxvar = nbvar_infile maxvar = nbvar_infile
END IF END IF
kbuflen = sizemax ! Check if variable is in TFIELDLIST and populate corresponding metadata
#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()
DO ji=1,maxvar DO ji=1,maxvar
IF (tpreclist(ji)%calc .OR. .NOT.tpreclist(ji)%found) CYCLE IF (runmode/=MODECDF2LFI .AND. options(OPTSPLIT)%set .AND. tpreclist(ji)%tbw) idx_out = idx_out + 1
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) IF (.NOT.tpreclist(ji)%found .OR. tpreclist(ji)%calc ) CYCLE
DO jj=1,comment_size !
#ifdef LOWMEM !Do not treat dimension variables (they are automatically added when creating netCDF file)
ich = iwork(2+jj) IF ( tpreclist(ji)%name == 'ni' &
#else .OR. tpreclist(ji)%name == 'nj' &
ich = lfiart(ji)%iwtab(2+jj) .OR. tpreclist(ji)%name == 'ni_u' &
#endif .OR. tpreclist(ji)%name == 'nj_u' &
tpreclist(ji)%comment(jj:jj) = CHAR(ich) .OR. tpreclist(ji)%name == 'ni_v' &
END DO .OR. tpreclist(ji)%name == 'nj_v' &
.OR. tpreclist(ji)%name == 'latitude' &
fsize = ileng-(2+comment_size) .OR. tpreclist(ji)%name == 'longitude' &
.OR. tpreclist(ji)%name == 'latitude_u' &
ELSE IF (infiles%files(1)%format == NETCDF_FORMAT) THEN .OR. tpreclist(ji)%name == 'longitude_u' &
! GRID attribute definition .OR. tpreclist(ji)%name == 'latitude_v' &
status = NF90_GET_ATT(kcdf_id,tpreclist(ji)%id_in,'GRID',tpreclist(ji)%grid) .OR. tpreclist(ji)%name == 'longitude_v' &
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__) .OR. tpreclist(ji)%name == 'latitude_f' &
.OR. tpreclist(ji)%name == 'longitude_f' &
! COMMENT attribute definition .OR. tpreclist(ji)%name == 'level' &
status = NF90_INQUIRE_ATTRIBUTE(kcdf_id,tpreclist(ji)%id_in,'COMMENT',len=comment_size) .OR. tpreclist(ji)%name == 'level_w' &
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__) .OR. tpreclist(ji)%name == 'time' ) THEN
ALLOCATE(character(len=comment_size) :: tpreclist(ji)%comment) tpreclist(ji)%tbw = .FALSE.
status = NF90_GET_ATT(kcdf_id,tpreclist(ji)%id_in,'COMMENT',tpreclist(ji)%comment) tpreclist(ji)%tbr = .FALSE.
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__) tpreclist(ji)%found = .FALSE.
ELSE
status = NF90_INQUIRE_VARIABLE(kcdf_id,tpreclist(ji)%id_in, xtype = itype, ndims = idims, & CALL FIND_FIELD_ID_FROM_MNHNAME(tpreclist(ji)%name,IID,IRESP,ONOWARNING=.TRUE.)
dimids = idim_id) IF (IRESP==0) THEN
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__) tpreclist(ji)%TFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
! Determine TDIMS
SELECT CASE(itype) IF (runmode==MODELFI2CDF) THEN
CASE(NF90_CHAR) ALLOCATE(tpreclist(ji)%TDIMS(tpreclist(ji)%TFIELD%NDIMS))
tpreclist(ji)%TYPE = TEXT CALL IO_Dimids_guess_nc4(outfiles(idx_out)%TFILE,tpreclist(ji)%TFIELD,&
CASE(NF90_INT) tpreclist(ji)%NSIZE,tpreclist(ji)%TDIMS,IRESP)
tpreclist(ji)%TYPE = INT ELSE !If we read netCDF4, we already have all necessary data
CASE(NF90_FLOAT,NF90_DOUBLE) !Special case for EMIS (only the first band is read/written) -> NDIMS reduced to 2
tpreclist(ji)%TYPE = FLOAT if(tpreclist(ji)%TFIELD%CMNHNAME=="EMIS") tpreclist(ji)%TFIELD%NDIMS = 2
CASE default
PRINT *, 'Attention : variable ',TRIM(tpreclist(ji)%name), ' a un TYPE non reconnu par le convertisseur.' CALL IO_Dims_fill_nc4(outfiles(idx_out)%TFILE,tpreclist(ji),IRESP)
PRINT *, '--> TYPE force a REAL(KIND 8) dans LFI !' ENDIF
END SELECT IF (IRESP/=0) THEN
CALL PRINT_MSG(NVERB_WARNING,'IO','parse_infiles','can not guess dimensions for '//tpreclist(ji)%TFIELD%CMNHNAME// &
!DUPLICATED ' => ignored')
IF (idims == 0) THEN tpreclist(ji)%tbw = .FALSE.
! variable scalaire tpreclist(ji)%tbr = .FALSE.
leng = 1 tpreclist(ji)%found = .FALSE.
ELSE CYCLE
! infos sur dimensions END IF
leng = 1 ELSE !Field not found in list, try to determine characteristics
DO jdim=1,idims tpreclist(ji)%TFIELD%CMNHNAME = TRIM(tpreclist(ji)%name)
status = NF90_INQUIRE_DIMENSION(kcdf_id,idim_id(jdim),len = idimtmp) tpreclist(ji)%TFIELD%CSTDNAME = ''
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__) !Set in IO_Metadata_get_nc4 (and not used for LFI) tpreclist(ji)%TFIELD%CLONGNAME = TRIM(tpreclist(ji)%name)
leng = leng*idimtmp !Set in IO_Metadata_get_nc4 (and not used for LFI) tpreclist(ji)%TFIELD%CUNITS = ''
END DO tpreclist(ji)%TFIELD%CDIR = 'XY' !Assumption...
END IF 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 CALL IO_Dims_fill_nc4(outfiles(idx_out)%TFILE,tpreclist(ji),IRESP)
END IF
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 END DO
!Complete info for calculated variables
IF (nbvar_calc>0) THEN 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 DO ji=1,maxvar
IF (.NOT.tpreclist(ji)%calc) CYCLE 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)%TFIELD%CMNHNAME = tpreclist(ji)%name
tpreclist(ji)%dim => tpreclist(tpreclist(ji)%src(1))%dim tpreclist(ji)%TFIELD%CSTDNAME = ''
tpreclist(ji)%TFIELD%CLONGNAME = tpreclist(ji)%name
!TODO: cleaner length! !
ALLOCATE(character(len=256) :: tpreclist(ji)%comment) GOK = .TRUE.
tpreclist(ji)%comment='Constructed from' DO jj=1,tpreclist(ji)%NSRC
jj = 1 idx_var = tpreclist(ji)%src(jj)
DO WHILE (tpreclist(ji)%src(jj)>0 .AND. jj.LE.MAXRAW) IF(.NOT.tpreclist(idx_var)%found) THEN
tpreclist(ji)%comment = trim(tpreclist(ji)%comment)//' '//trim(tpreclist(tpreclist(ji)%src(jj))%name) CALL PRINT_MSG(NVERB_WARNING,'IO','parse_infiles','some components for calculated variable ' &
IF (jj<MAXRAW .AND. tpreclist(ji)%src(jj+1)>0) THEN //TRIM(tpreclist(ji)%name)//' are not known => ignored')
tpreclist(ji)%comment = trim(tpreclist(ji)%comment)//' +' tpreclist(ji)%tbw = .FALSE.
END IF tpreclist(ji)%tbr = .FALSE.
jj=jj+1 tpreclist(ji)%found = .FALSE.
END DO GOK = .FALSE.
END DO EXIT
END IF END IF
END DO
!
PRINT *,'Nombre de dimensions = ', size_dimCDF() IF (GOK) THEN
#ifdef LOWMEM idx_var = tpreclist(ji)%src(1)
DEALLOCATE(iwork) tpreclist(ji)%TFIELD%CUNITS = tpreclist(idx_var)%TFIELD%CUNITS
#endif tpreclist(ji)%TFIELD%CDIR = tpreclist(idx_var)%TFIELD%CDIR
END SUBROUTINE parse_infiles tpreclist(ji)%TFIELD%CLBTYPE = tpreclist(idx_var)%TFIELD%CLBTYPE
tpreclist(ji)%TFIELD%CCOMMENT = TRIM(tpreclist(ji)%name)//'='//TRIM(tpreclist(idx_var)%name)
SUBROUTINE read_data_lfi(infiles, nbvar, tpreclist, kbuflen, current_level) IF (tpreclist(ji)%NSRC>1) tpreclist(ji)%TFIELD%CCOMMENT = TRIM(tpreclist(ji)%TFIELD%CCOMMENT)//'+'
TYPE(filelist_struct), INTENT(IN) :: infiles tpreclist(ji)%TFIELD%NGRID = tpreclist(idx_var)%TFIELD%NGRID
INTEGER, INTENT(INOUT) :: nbvar tpreclist(ji)%TFIELD%NTYPE = tpreclist(idx_var)%TFIELD%NTYPE
TYPE(workfield), DIMENSION(:), POINTER :: tpreclist tpreclist(ji)%TFIELD%NDIMS = tpreclist(idx_var)%TFIELD%NDIMS
INTEGER, INTENT(IN) :: kbuflen #if 0
INTEGER, INTENT(IN), OPTIONAL :: current_level tpreclist(ji)%TFIELD%NFILLVALUE
tpreclist(ji)%TFIELD%XFILLVALUE
INTEGER :: ji,jj tpreclist(ji)%TFIELD%NVALIDMIN
INTEGER :: ndb, nde tpreclist(ji)%TFIELD%NVALIDMAX
LOGICAL :: ladvan tpreclist(ji)%TFIELD%XVALIDMIN
INTEGER :: ich tpreclist(ji)%TFIELD%XVALIDMAX
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))
#endif #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 END SUBROUTINE parse_infiles
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
#ifdef LOWMEM SUBROUTINE def_ncdf(infiles,outfiles,KNFILES_OUT)
DEALLOCATE(iwork) USE MODD_CONF, ONLY: NMNHVERSION
#endif use mode_io_write_nc4, only: IO_Header_write_nc4
END SUBROUTINE read_data_lfi
SUBROUTINE HANDLE_ERR(status,line) TYPE(TFILE_ELT),DIMENSION(:),INTENT(IN) :: infiles
INTEGER :: status,line TYPE(TFILE_ELT),DIMENSION(:),INTENT(IN) :: outfiles
INTEGER, INTENT(IN) :: KNFILES_OUT
IF (status /= NF90_NOERR) THEN CHARACTER(LEN=*),PARAMETER :: YUNKNOWNHIST = 'Previous history is unknown'
PRINT *, 'line ',line,': ',NF90_STRERROR(status)
STOP
END IF
END SUBROUTINE HANDLE_ERR
SUBROUTINE def_ncdf(outfiles,tpreclist,nbvar,options) CHARACTER(LEN=16) :: YMNHVERSION
TYPE(filelist_struct), INTENT(IN) :: outfiles CHARACTER(LEN=:),ALLOCATABLE :: YHISTORY
TYPE(workfield),DIMENSION(:),INTENT(INOUT) :: tpreclist INTEGER :: ji
INTEGER, INTENT(IN) :: nbvar INTEGER(KIND=CDFINT) :: ilen
TYPE(option),DIMENSION(:), INTENT(IN) :: options 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 DO ji = 1,KNFILES_OUT
type_float = NF90_REAL kcdf_id = outfiles(ji)%TFILE%NNCID
ELSE status = NF90_PUT_ATT(kcdf_id,NF90_GLOBAL,'history',YHISTORY)
type_float = NF90_DOUBLE if ( status /= NF90_NOERR ) call IO_Err_handle_nc4( status, 'def_ncdf', 'NF90_PUT_ATT', 'history' )
END DO
END IF END IF
DO ji = 1,nbfiles !Write header for netCDF files
kcdf_id = outfiles%files(ji)%lun_id DO ji = 1,KNFILES_OUT
kcdf_id = outfiles(ji)%TFILE%NNCID
! global attributes ! global attributes
status = NF90_PUT_ATT(kcdf_id,NF90_GLOBAL,'Title',VERSION_ID) CALL IO_Header_write_nc4(outfiles(ji)%TFILE)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__) !
WRITE(YMNHVERSION,"( I0,'.',I0,'.',I0 )" ) NMNHVERSION(1),NMNHVERSION(2),NMNHVERSION(3)
! define DIMENSIONS status = NF90_PUT_ATT(kcdf_id,NF90_GLOBAL,'lfi2cdf_version',TRIM(YMNHVERSION))
tzdim=>first_DimCDF() if ( status /= NF90_NOERR ) call IO_Err_handle_nc4( status, 'def_ncdf', 'NF90_PUT_ATT', 'lfi2cdf_version' )
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__)
END DO END DO
END SUBROUTINE def_ncdf END SUBROUTINE def_ncdf
SUBROUTINE fill_ncdf(infiles,outfiles,tpreclist,knaf,kbuflen,options,current_level) SUBROUTINE fill_files(infiles,outfiles,tpreclist,knaf,options)
TYPE(filelist_struct), INTENT(IN):: infiles, outfiles USE MODD_TYPE_DATE
TYPE(workfield), DIMENSION(:),INTENT(IN):: tpreclist
INTEGER, INTENT(IN):: knaf TYPE(TFILE_ELT),DIMENSION(:), INTENT(IN) :: infiles
INTEGER, INTENT(IN):: kbuflen TYPE(TFILE_ELT),DIMENSION(:), INTENT(IN) :: outfiles
TYPE(option),DIMENSION(:), INTENT(IN):: options TYPE(workfield), DIMENSION(:),INTENT(INOUT) :: tpreclist
INTEGER, INTENT(IN), OPTIONAL :: current_level INTEGER, INTENT(IN) :: knaf
TYPE(option),DIMENSION(:), INTENT(IN) :: options
#ifdef LOWMEM
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: iwork INTEGER :: idx, ji, jj
#endif INTEGER :: IDIMS
INTEGER :: idx, ji,jj INTEGER :: INSRC
INTEGER :: kcdf_id INTEGER :: ISRC
INTEGER :: status INTEGER(KIND=CDFINT),DIMENSION(NF90_MAX_VAR_DIMS) :: IDIMLEN
INTEGER :: extent, ndims logical,dimension(knaf) :: gtimedep_in, gtimedep_out
INTEGER :: ich
INTEGER :: src CHARACTER(LEN=:), ALLOCATABLE :: YTAB0D
INTEGER :: level INTEGER, DIMENSION(:), ALLOCATABLE :: ITAB1D, ITAB1D2
INTEGER(KIND=LFI_INT) :: iresp,ilu,ileng,ipos INTEGER, DIMENSION(:,:), ALLOCATABLE :: ITAB2D, ITAB2D2
CHARACTER(LEN=4) :: suffix INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: ITAB3D, ITAB3D2
INTEGER,DIMENSION(3) :: idims, start LOGICAL, DIMENSION(:), ALLOCATABLE :: GTAB1D
INTEGER,DIMENSION(:),ALLOCATABLE :: itab REAL, DIMENSION(:), ALLOCATABLE :: XTAB1D, XTAB1D2
REAL(KIND=8),DIMENSION(:),ALLOCATABLE :: xtab REAL, DIMENSION(:,:), ALLOCATABLE :: XTAB2D, XTAB2D2
CHARACTER, DIMENSION(:), ALLOCATABLE :: ytab REAL, DIMENSION(:,:,:), ALLOCATABLE :: XTAB3D, XTAB3D2
REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: xtab3d, xtab3d2 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XTAB4D, XTAB4D2
INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: itab3d, itab3d2 TYPE(DATE_TIME) :: TZDATE
TYPE(TFILEDATA) :: TZFILE
!
IF (infiles%files(1)%format == LFI_FORMAT) ilu = infiles%files(1)%lun_id CALL PRINT_MSG(NVERB_DEBUG,'IO','fill_files','called')
!
! For versions of MesoNH <5.4.0, fields were not stored with a time dimension
IF (present(current_level)) THEN ! ->necessary to remove it when reading and to restore to the correct one when writing
write(suffix,'(I4.4)') current_level if( infiles(1)%TFILE%NMNHVERSION(1)<5 .OR. &
level = current_level (infiles(1)%TFILE%NMNHVERSION(1)==5 .AND. infiles(1)%TFILE%NMNHVERSION(2)<4) ) then
ElSE gtimedep_in(:) = .false.
suffix='' else
level = 1 gtimedep_in(:) = tpreclist(:)%TFIELD%LTIMEDEP
END IF end if
gtimedep_out(:) = tpreclist(:)%TFIELD%LTIMEDEP
#if LOWMEM
ALLOCATE(iwork(kbuflen))
#endif
ALLOCATE(itab(kbuflen))
ALLOCATE(xtab(kbuflen))
idx = 1 idx = 1
DO ji=1,knaf DO ji=1,knaf
IF (.NOT.tpreclist(ji)%tbw) CYCLE 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):3+iwork(2)+extent-1)
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):3+iwork(2)+extent-1)
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):3+iwork(2)+extent-1)
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
!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
!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__)
DEALLOCATE(itab3d)
END IF
IDIMS = tpreclist(ji)%TFIELD%NDIMS
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 SELECT CASE(tpreclist(ji)%TFIELD%NTYPE)
IF (ndims == 2) THEN CASE (TYPEINT)
start = (/1,1,level/) IDIMLEN(1:IDIMS) = tpreclist(ji)%TDIMS(1:IDIMS)%nlen
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) IF (.NOT.tpreclist(ji)%calc) THEN
INSRC = 1
ISRC = ji
ELSE
INSRC = tpreclist(ji)%NSRC
ISRC = tpreclist(ji)%src(1)
END IF END IF
CASE (TEXT) tpreclist(ISRC)%TFIELD%LTIMEDEP = gtimedep_in(ISRC)
IF (infiles%files(1)%format == LFI_FORMAT) THEN SELECT CASE(IDIMS)
#if LOWMEM CASE (0)
CALL LFINFO(iresp,ilu,trim(tpreclist(ji)%name)//trim(suffix),ileng,ipos) ALLOCATE(ITAB1D(1))
CALL LFILEC(iresp,ilu,trim(tpreclist(ji)%name)//trim(suffix),iwork,ileng) IF (tpreclist(ji)%calc) ALLOCATE(ITAB1D2(1))
#endif CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB1D(1))
ALLOCATE(ytab(extent)) CASE (1)
DO jj=1,extent ALLOCATE(ITAB1D(IDIMLEN(1)))
#if LOWMEM IF (tpreclist(ji)%calc) ALLOCATE(ITAB1D2(IDIMLEN(1)))
ich = iwork(2+iwork(2)+jj) CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB1D)
#else CASE (2)
ich = lfiart(ji)%iwtab(2+lfiart(ji)%iwtab(2)+jj) ALLOCATE(ITAB2D(IDIMLEN(1),IDIMLEN(2)))
#endif IF (tpreclist(ji)%calc) ALLOCATE(ITAB2D2(IDIMLEN(1),IDIMLEN(2)))
ytab(jj) = CHAR(ich) CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB2D)
END DO CASE (3)
status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id_out,ytab,count=(/extent/)) ALLOCATE(ITAB3D(IDIMLEN(1),IDIMLEN(2),IDIMLEN(3)))
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__) IF (tpreclist(ji)%calc) ALLOCATE(ITAB3D2(IDIMLEN(1),IDIMLEN(2),IDIMLEN(3)))
DEALLOCATE(ytab) CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB3D)
ELSE IF (infiles%files(1)%format == NETCDF_FORMAT) THEN CASE DEFAULT
status = NF90_GET_VAR(infiles%files(1)%lun_id,tpreclist(ji)%id_in,ytab,count=(/extent/)) CALL PRINT_MSG(NVERB_WARNING,'IO','fill_files','too many dimensions for ' &
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__) //TRIM(tpreclist(ISRC)%name)//' => ignored')
CYCLE
status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id_out,ytab,count=(/extent/)) END SELECT
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
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 END IF
CASE default tpreclist(ISRC)%TFIELD%LTIMEDEP = gtimedep_in(ISRC)
IF (infiles%files(1)%format == LFI_FORMAT) THEN SELECT CASE(IDIMS)
#if LOWMEM CASE (0)
IF (.NOT.tpreclist(ji)%calc) THEN ALLOCATE(XTAB1D(1))
CALL LFINFO(iresp,ilu,trim(tpreclist(ji)%name)//trim(suffix),ileng,ipos) IF (tpreclist(ji)%calc) ALLOCATE(XTAB1D2(1))
CALL LFILEC(iresp,ilu,trim(tpreclist(ji)%name)//trim(suffix),iwork,ileng) CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB1D(1))
xtab(1:extent) = TRANSFER(iwork(3+iwork(2):),(/ 0.0_8 /)) CASE (1)
ELSE ALLOCATE(XTAB1D(IDIMLEN(1)))
src=tpreclist(ji)%src(1) IF (tpreclist(ji)%calc) ALLOCATE(XTAB1D2(IDIMLEN(1)))
CALL LFINFO(iresp,ilu,trim(tpreclist(src)%name)//trim(suffix),ileng,ipos) CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB1D)
CALL LFILEC(iresp,ilu,trim(tpreclist(src)%name)//trim(suffix),iwork,ileng) CASE (2)
xtab(1:extent) = TRANSFER(iwork(3+iwork(2):),(/ 0.0_8 /)) ALLOCATE(XTAB2D(IDIMLEN(1),IDIMLEN(2)))
jj = 2 IF (tpreclist(ji)%calc) ALLOCATE(XTAB2D2(IDIMLEN(1),IDIMLEN(2)))
DO WHILE (tpreclist(ji)%src(jj)>0 .AND. jj.LE.MAXRAW) CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB2D)
src=tpreclist(ji)%src(jj) CASE (3)
CALL LFILEC(iresp,ilu,trim(tpreclist(src)%name)//trim(suffix),iwork,ileng) ALLOCATE(XTAB3D(IDIMLEN(1),IDIMLEN(2),IDIMLEN(3)))
xtab(1:extent) = xtab(1:extent) + TRANSFER(iwork(3+iwork(2):),(/ 0.0_8 /)) IF (tpreclist(ji)%calc) ALLOCATE(XTAB3D2(IDIMLEN(1),IDIMLEN(2),IDIMLEN(3)))
jj=jj+1 !Hack not very clean: 3D LB fields are not split
END DO !If NSUBFILES_IOZ is set to 0, IO_Field_read will read it as a non-split field
ENDIF !CAUTION: there are no guarantee the IO_Field_read will continue to use this information that way...
#else if ( tpreclist(ji)%tfield%clbtype /= 'NONE' .or. tpreclist(ji)%name(1:2) == 'LB' ) then
IF (.NOT.tpreclist(ji)%calc) THEN tzfile = infiles(1)%tfile
xtab(1:extent) = TRANSFER(lfiart(ji)%iwtab(3+lfiart(ji)%iwtab(2):),(/ 0.0_8 /)) tzfile%nsubfiles_ioz=0
ELSE call IO_Field_read(tzfile,tpreclist(isrc)%tfield,xtab3d)
src=tpreclist(ji)%src(1) else
xtab(1:extent) = TRANSFER(lfiart(src)%iwtab(3+lfiart(src)%iwtab(2):),(/ 0.0_8 /)) call IO_Field_read(infiles(1)%tfile,tpreclist(isrc)%tfield,xtab3d)
jj = 2 end if
DO WHILE (tpreclist(ji)%src(jj)>0 .AND. jj.LE.MAXRAW) CASE (4)
src=tpreclist(ji)%src(jj) ALLOCATE(XTAB4D(IDIMLEN(1),IDIMLEN(2),IDIMLEN(3),IDIMLEN(4)))
xtab(1:extent) = xtab(1:extent) + TRANSFER(lfiart(src)%iwtab(3+lfiart(src)%iwtab(2):),(/ 0.0_8 /)) IF (tpreclist(ji)%calc) ALLOCATE(XTAB4D2(IDIMLEN(1),IDIMLEN(2),IDIMLEN(3),IDIMLEN(4)))
jj=jj+1 CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB4D)
END DO CASE DEFAULT
END IF CALL PRINT_MSG(NVERB_WARNING,'IO','fill_files','too many dimensions for ' &
#endif //TRIM(tpreclist(ISRC)%name)//' => ignored')
!TODO: works in all cases??? (X, Y, Z dimensions assumed to be ptdimx,y or z) CYCLE
SELECT CASE(ndims) END SELECT
CASE (0)
status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id_out,xtab(1)) DO JJ=2,INSRC
CASE (1) ISRC = tpreclist(ji)%src(jj)
status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id_out,xtab(1:extent),count=(/extent/)) tpreclist(ISRC)%TFIELD%LTIMEDEP = gtimedep_in(ISRC)
CASE (2)
status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id_out,reshape(xtab,(/ptdimx%len,ptdimy%len/)), & SELECT CASE(IDIMS)
start = (/1,1,level/) ) CASE (0)
CASE (3) CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB1D2(1))
status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id_out,reshape(xtab,(/ptdimx%len,ptdimy%len,ptdimz%len/))) XTAB1D(1) = XTAB1D(1) + XTAB1D2(1)
CASE DEFAULT CASE (1)
print *,'Error: arrays with ',tpreclist(ji)%dim%ndims,' dimensions are not supported' CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB1D2)
END SELECT XTAB1D(:) = XTAB1D(:) + XTAB1D2(:)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__) CASE (2)
ELSE IF (infiles%files(1)%format == NETCDF_FORMAT) THEN CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB2D2)
print *,'Error: unknown datatype' XTAB2D(:,:) = XTAB2D(:,:) + XTAB2D2(:,:)
STOP 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 IF
END SELECT ALLOCATE(CHARACTER(LEN=tpreclist(ji)%NSIZE)::YTAB0D)
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_in(ji)
if (options(OPTSPLIT)%set) idx = idx + 1 CALL IO_Field_read (INFILES(1)%TFILE, tpreclist(ji)%TFIELD,YTAB0D)
END DO tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_out(ji)
DEALLOCATE(itab,xtab) CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,YTAB0D)
#if LOWMEM DEALLOCATE(YTAB0D)
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
ilu = outfiles%files(1)%lun_id CASE (TYPEDATE)
kcdf_id = infiles%files(1)%lun_id ISRC = ji
! Un article LFI est compose de : IF (IDIMS/=0) THEN
! - 1 entier identifiant le numero de grille CALL PRINT_MSG(NVERB_WARNING,'IO','fill_files','too many dimensions for ' &
! - 1 entier contenant la taille du commentaire //TRIM(tpreclist(ISRC)%name)//' => ignored')
! - le commentaire code en entier 64 bits CYCLE
! - les donnees proprement dites END IF
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_in(ji)
PRINT *,'Taille buffer = ',2+kbuflen 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) CASE default
icomlen = LEN(tpreclist(ivar)%comment) ISRC = ji
! traitement Grille et Commentaire CALL PRINT_MSG(NVERB_WARNING,'IO','fill_files','invalid datatype for ' &
iwork(1) = tpreclist(ivar)%grid //TRIM(tpreclist(ISRC)%name)//' => ignored')
iwork(2) = icomlen
DO jj=1,iwork(2)
iwork(2+jj)=ICHAR(tpreclist(ivar)%comment(jj:jj))
END DO
IF (ASSOCIATED(tpreclist(ivar)%dim)) THEN END SELECT
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)
if (options(OPTSPLIT)%set) idx = idx + 1
END DO END DO
DEALLOCATE(iwork) END SUBROUTINE fill_files
END SUBROUTINE build_lfi
SUBROUTINE OPEN_FILES(infiles,outfiles,KNFILES_OUT,hinfile,houtfile,nbvar_infile,options,runmode)
SUBROUTINE UPDATE_VARID_IN(infiles,hinfile,tpreclist,nbvar,current_level) USE MODD_CONF, ONLY: LCARTESIAN
!Update the id_in for netCDF files (could change from one file to the other) USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
TYPE(filelist_struct), INTENT(IN) :: infiles USE MODD_CONFZ, ONLY: NB_PROCIO_R
CHARACTER(LEN=*), INTENT(IN) :: hinfile USE MODD_DIM_n, ONLY: NIMAX_ll, NJMAX_ll, NKMAX
TYPE(workfield), DIMENSION(:), INTENT(INOUT) :: tpreclist USE MODD_GRID, ONLY: XBETA, XRPK, XLAT0, XLON0, XLATORI, XLONORI
INTEGER, INTENT(IN) :: nbvar USE MODD_GRID_n, ONLY: LSLEVE, XXHAT, XXHATM, XYHAT, XYHATM, XZHAT, XZHATM, &
INTEGER, INTENT(IN) :: current_level XXHAT_ll, XYHAT_ll, XXHATM_ll, XYHATM_ll
USE MODD_IO, ONLY: LIOCDF4
INTEGER :: ji, status USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
CHARACTER(len=4) :: suffix USE MODD_PARAMETERS_ll, ONLY: JPHEXT_ll=>JPHEXT, JPVEXT_ll=>JPVEXT
USE MODD_TIME_n, ONLY: TDTCUR, TDTMOD
if (infiles%files(1)%format /= NETCDF_FORMAT) return 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 nbvar_infile = INFILES(1)%TFILE%NLFININAR
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) :: ilu,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
ilu = infiles%files(idx)%lun_id
CALL LFIOUV(iresp,ilu,ltrue,hinfile,'OLD',lfalse&
& ,lfalse,iverb,inap,inaf)
infiles%files(idx)%opened = .TRUE.
nbvar_infile = inaf
IF (options(OPTLIST)%set) THEN IF (options(OPTLIST)%set) THEN
CALL LFILAF(iresp,ilu,lfalse) CALL LFILAF(iresp,ilu,lfalse)
CALL LFIFER(iresp,ilu,'KEEP') CALL IO_FILE_CLOSE(INFILES(1)%TFILE)
return return
END IF 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 IF (.NOT.options(OPTSPLIT)%set) THEN
outfiles%nbfiles = outfiles%nbfiles + 1 KNFILES_OUT = KNFILES_OUT + 1
idx = outfiles%nbfiles idx = KNFILES_OUT
outfiles%files(idx)%format = NETCDF_FORMAT if ( options(OPTDIR)%set ) then
outfiles%files(idx)%status = WRITING CALL IO_FILE_ADD2LIST(outfiles(idx)%TFILE,HOUTFILE,'MNH','WRITE', &
IF (options(OPTCDF4)%set) THEN HFORMAT='NETCDF4',OOLD=.TRUE., hdirname = options(OPTDIR)%cvalue )
status = NF90_CREATE(TRIM(houtfile)//'.nc', IOR(NF90_CLOBBER,NF90_NETCDF4), outfiles%files(idx)%lun_id) else
ELSE CALL IO_FILE_ADD2LIST(outfiles(idx)%TFILE,HOUTFILE,'MNH','WRITE', &
status = NF90_CREATE(TRIM(houtfile)//'.nc', IOR(NF90_CLOBBER,NF90_64BIT_OFFSET), outfiles%files(idx)%lun_id) 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 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 istatus = NF90_SET_FILL(outfiles(idx)%TFILE%NNCID,NF90_NOFILL,ioldmode)
outfiles%nbfiles = outfiles%nbfiles + 1 if ( istatus /= NF90_NOERR ) call IO_Err_handle_nc4( istatus, 'OPEN_FILES', 'NF90_SET_FILL', '' )
idx = outfiles%nbfiles 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 END SUBROUTINE OPEN_FILES
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
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__) SUBROUTINE OPEN_SPLIT_NCFILES_OUT(outfiles,KNFILES_OUT,houtfile,nbvar,options)
outfiles%files(idx)%opened = .TRUE. USE MODE_IO_FILE, ONLY: IO_FILE_OPEN
outfiles%files(idx)%format = NETCDF_FORMAT USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST
outfiles%files(idx)%status = WRITING
status = NF90_SET_FILL(outfiles%files(idx)%lun_id,NF90_NOFILL,omode) TYPE(TFILE_ELT),DIMENSION(:), INTENT(INOUT) :: outfiles
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__) INTEGER, INTENT(OUT) :: KNFILES_OUT
END IF ! .NOT.osplit 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 ELSE
! Cas NetCDF -> LFI YVARS(nbvar) = YLIST
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
ilu = outfiles%files(idx)%lun_id
CALL LFIOUV(iresp,ilu,ltrue,houtfile,'NEW' ,lfalse,lfalse,iverb,inap,inaf)
outfiles%files(idx)%opened = .TRUE.
END IF END IF
PRINT *,'--> Fichier converti : ', TRIM(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) status = NF90_SET_FILL(outfiles(ji)%TFILE%NNCID,NF90_NOFILL,ioldmode)
TYPE(filelist_struct), INTENT(INOUT) :: infiles if ( status /= NF90_NOERR ) call IO_Err_handle_nc4( status, 'OPEN_SPLIT_NCFILES_OUT', 'NF90_SET_FILL', '' )
CHARACTER(LEN=*), INTENT(IN) :: hinfile END DO
INTEGER, INTENT(IN) :: current_level
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 TYPE(TFILE_ELT),DIMENSION(:),INTENT(INOUT) :: filelist
CHARACTER(LEN=:),ALLOCATABLE :: filename 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) SUBROUTINE IO_Metadata_get_nc4(TPFILE,KVAR_ID,TPREC)
END SUBROUTINE OPEN_SPLIT_LFIFILE_IN 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) ISTATUS = NF90_GET_ATT(IFILE_ID, KVAR_ID, 'split_nblocks', iblocks)
TYPE(filelist_struct), INTENT(INOUT) :: infiles IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4( istatus, 'IO_Metadata_get_nc4', 'NF90_GET_ATT', 'split_nblocks' )
CHARACTER(LEN=*), INTENT(IN) :: hinfile
INTEGER, INTENT(IN) :: current_level
INTEGER :: status IFILE_ID = TPFILE%TFILES_IOZ(1)%TFILE%NNCID
CHARACTER(LEN=3) :: suffix
CHARACTER(LEN=:),ALLOCATABLE :: filename
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 DEALLOCATE(YSPLIT)
filename=hinfile(1:len(hinfile)-6)//suffix//'.nc' END IF
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(filename) !Reset IFILE_ID to master file (if split files)
END SUBROUTINE OPEN_SPLIT_NCFILE_IN IFILE_ID = TPFILE%NNCID
SUBROUTINE OPEN_SPLIT_NCFILES_OUT(outfiles,houtfile,nbvar,tpreclist,options) ISTATUS = NF90_GET_ATT(IFILE_ID,KVAR_ID,'long_name',TPREC%TFIELD%CLONGNAME)
TYPE(filelist_struct), INTENT(INOUT) :: outfiles IF (ISTATUS /= NF90_NOERR) TPREC%TFIELD%CLONGNAME = TRIM( TPREC%TFIELD%CMNHNAME )
CHARACTER(LEN=*), INTENT(IN) :: houtfile
INTEGER, INTENT(IN) :: nbvar
TYPE(workfield), DIMENSION(:), INTENT(IN) :: tpreclist
TYPE(option),DIMENSION(:), INTENT(IN) :: options
INTEGER :: ji, idx ISTATUS = NF90_GET_ATT(IFILE_ID,KVAR_ID,'comment',TPREC%TFIELD%CCOMMENT)
INTEGER :: status IF (ISTATUS /= NF90_NOERR) TPREC%TFIELD%CCOMMENT = ''
INTEGER :: omode
CHARACTER(LEN=MAXLEN) :: filename
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 ISTATUS = NF90_GET_ATT(IFILE_ID,KVAR_ID,'units',TPREC%CUNITS_FILE)
IF (tpreclist(ji)%tbw) outfiles%nbfiles = outfiles%nbfiles + 1 IF (ISTATUS /= NF90_NOERR) TPREC%CUNITS_FILE = ''
END DO
idx = 1 IF (.NOT.TPREC%LSPLIT) THEN
DO ji = 1,nbvar ALLOCATE(TPREC%NDIMSIZES_FILE(TPREC%NDIMS_FILE))
IF (.NOT.tpreclist(ji)%tbw) CYCLE ALLOCATE(TPREC%CDIMNAMES_FILE(TPREC%NDIMS_FILE))
outfiles%files(idx)%var_id = ji 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 (options(OPTCDF4)%set) THEN IF (TPREC%NDIMS_FILE == 0) THEN
filename = trim(houtfile)//'.'//trim(tpreclist(ji)%name)//'.nc' ! Scalar variable
status = NF90_CREATE(trim(filename), IOR(NF90_CLOBBER,NF90_NETCDF4), outfiles%files(idx)%lun_id) 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 (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 ELSE
filename = trim(houtfile)//'.'//trim(tpreclist(ji)%name)//'.nc' TPREC%TFIELD%LTIMEDEP = .FALSE.
status = NF90_CREATE(trim(filename), IOR(NF90_CLOBBER,NF90_64BIT_OFFSET), outfiles%files(idx)%lun_id)
END IF 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) !Add vertical/3rd dimension
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__) 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. TPREC%NSIZE = ILENG
outfiles%files(idx)%format = NETCDF_FORMAT END SUBROUTINE IO_Metadata_get_nc4
outfiles%files(idx)%status = WRITING
idx = idx + 1
END DO
END SUBROUTINE OPEN_SPLIT_NCFILES_OUT SUBROUTINE IO_Dims_fill_nc4(TPFILE,TPREC,KRESP)
USE MODD_IO, ONLY: TFILEDATA
SUBROUTINE CLOSE_FILES(filelist) use mode_io_tools_nc4, only: IO_Dim_find_create_nc4, IO_Dim_find_byname_nc4
TYPE(filelist_struct),INTENT(INOUT) :: filelist
TYPE(TFILEDATA),INTENT(IN) :: TPFILE
INTEGER(KIND=LFI_INT) :: ilu,iresp TYPE(workfield),INTENT(INOUT) :: TPREC
INTEGER :: ji,status INTEGER, INTENT(OUT) :: KRESP
DO ji=1,filelist%nbfiles integer :: iidx
IF ( .NOT.filelist%files(ji)%opened ) CYCLE INTEGER :: JJ
IF ( filelist%files(ji)%format == LFI_FORMAT ) THEN CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Dims_fill_nc4','called')
ilu = filelist%files(ji)%lun_id
CALL LFIFER(iresp,ilu,'KEEP') KRESP = 0
ELSE IF ( filelist%files(ji)%format == NETCDF_FORMAT ) THEN
status = NF90_CLOSE(filelist%files(ji)%lun_id) IF (TPREC%NDIMS_FILE<TPREC%TFIELD%NDIMS) THEN
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__) 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 END IF
filelist%files(ji)%opened=.false.
END DO END DO
END SUBROUTINE CLOSE_FILES END SUBROUTINE IO_Dims_fill_nc4
END MODULE mode_util END MODULE mode_util
LIBTOOLS/tools/lfiz/src/lfiz.f90
View file @ 050d6a3c
...@@ -14,25 +14,27 @@ INTEGER :: arglen ...@@ -14,25 +14,27 @@ INTEGER :: arglen
INTEGER :: inarg INTEGER :: inarg
CHARACTER(LEN=50) :: yexe 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 :: FM_FIELD_SIZE = 16
INTEGER, PARAMETER :: ISRCLU = 11 INTEGER(KIND=LFI_INT), PARAMETER :: ISRCLU = 11
INTEGER, PARAMETER :: IDESTLU = 12 INTEGER(KIND=LFI_INT), PARAMETER :: IDESTLU = 12
INTEGER :: JPHEXT INTEGER :: JPHEXT
INTEGER :: iverb INTEGER(KIND=LFI_INT) :: iverb
INTEGER :: inap ! nb d'articles prevus (utile a la creation) INTEGER(KIND=LFI_INT) :: inap ! nb d'articles prevus (utile a la creation)
INTEGER :: inaf ! nb d'articles presents dans un fichier existant INTEGER(KIND=LFI_INT) :: inaf ! nb d'articles presents dans un fichier existant
INTEGER :: inafdest INTEGER(KIND=LFI_INT) :: inafdest
CHARACTER(LEN=128) :: filename,DESTFNAME CHARACTER(LEN=128) :: filename,DESTFNAME
INTEGER :: JI,JJ INTEGER :: JI,JJ
INTEGER :: IRESP INTEGER(KIND=LFI_INT) :: IRESP
CHARACTER(LEN=FM_FIELD_SIZE),DIMENSION(:),ALLOCATABLE :: yrecfm 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(KIND=8), DIMENSION(:),ALLOCATABLE :: iwork
INTEGER :: ilengs INTEGER(KIND=LFI_INT) :: ilengs
INTEGER :: ipos INTEGER(KIND=LFI_INT) :: ipos
INTEGER :: sizemax INTEGER :: sizemax
INTEGER :: IGRID INTEGER :: IGRID
...@@ -46,7 +48,9 @@ INTEGER :: LFICOMP ...@@ -46,7 +48,9 @@ INTEGER :: LFICOMP
INTEGER :: NEWSIZE INTEGER :: NEWSIZE
INTEGER :: searchndx INTEGER :: searchndx
INTEGER :: INDDATIM INTEGER :: INDDATIM
INARG = IARGC()
!OLD: INARG = IARGC()
INARG = COMMAND_ARGUMENT_COUNT()
#if defined(F90HP) #if defined(F90HP)
#define HPINCR 1 #define HPINCR 1
...@@ -54,6 +58,9 @@ INARG = IARGC() ...@@ -54,6 +58,9 @@ INARG = IARGC()
#define HPINCR 0 #define HPINCR 0
#endif #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) #if defined(FUJI) || defined(NAGf95) || defined(NEC) || defined(HP) || defined(pgf) || defined(G95) || defined(GFORTRAN)
CALL GETARG(0+HPINCR,yexe) CALL GETARG(0+HPINCR,yexe)
IF (LEN_TRIM(yexe) == 0) THEN IF (LEN_TRIM(yexe) == 0) THEN
...@@ -63,12 +70,17 @@ INARG = IARGC() ...@@ -63,12 +70,17 @@ INARG = IARGC()
#else #else
CALL PXFGETARG(0,yexe,arglen,iresp) CALL PXFGETARG(0,yexe,arglen,iresp)
#endif #endif
#endif
! PRINT *,yexe, ' avec ',INARG,' arguments.' ! PRINT *,yexe, ' avec ',INARG,' arguments.'
IF (INARG == 1) THEN 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) #if defined(FUJI) || defined(NAGf95) || defined(NEC) || defined(HP) || defined(pgf) || defined(G95)|| defined(GFORTRAN)
CALL GETARG(1+HPINCR,filename) CALL GETARG(1+HPINCR,filename)
#else #else
CALL PXFGETARG(1,filename,arglen,iresp) CALL PXFGETARG(1,filename,arglen,iresp)
#endif
#endif #endif
ELSE ELSE
PRINT *,'Usage : ', TRIM(yexe), ' [fichier lfi]' PRINT *,'Usage : ', TRIM(yexe), ' [fichier lfi]'
...@@ -91,8 +103,8 @@ IDIMY = 0 ...@@ -91,8 +103,8 @@ IDIMY = 0
IDIMZ = 0 IDIMZ = 0
GUSEDIM = .FALSE. GUSEDIM = .FALSE.
CALL LFIOUV(IRESP,ISRCLU,.TRUE.,filename,'OLD',.FALSE.& CALL LFIOUV(IRESP,ISRCLU,GTRUE,filename,'OLD',GFALSE&
& ,.FALSE.,iverb,inap,inaf) & ,GFALSE,iverb,inap,inaf)
CALL FMREADLFIN1(ISRCLU,'LFI_COMPRESSED',LFICOMP,iresp) CALL FMREADLFIN1(ISRCLU,'LFI_COMPRESSED',LFICOMP,iresp)
IF (iresp == 0) THEN IF (iresp == 0) THEN
...@@ -139,8 +151,8 @@ END IF ...@@ -139,8 +151,8 @@ END IF
PRINT *,'compressed file : ',DESTFNAME PRINT *,'compressed file : ',DESTFNAME
CALL LFIOUV(IRESP,IDESTLU,.TRUE.,DESTFNAME,'NEW'& CALL LFIOUV(IRESP,IDESTLU,GTRUE,DESTFNAME,'NEW'&
& ,.FALSE.,.FALSE.,iverb,inaf+1,inafdest) & ,GFALSE,GFALSE,iverb,inaf+1,inafdest)
CALL LFIPOS(IRESP,ISRCLU) CALL LFIPOS(IRESP,ISRCLU)
ALLOCATE(yrecfm(inaf)) ALLOCATE(yrecfm(inaf))
...@@ -148,7 +160,7 @@ ALLOCATE(ileng(inaf)) ...@@ -148,7 +160,7 @@ ALLOCATE(ileng(inaf))
yrecfm(:) = '' yrecfm(:) = ''
sizemax=0 sizemax=0
DO ji=1,inaf 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) IF (ileng(ji) > sizemax) sizemax=ileng(ji)
END DO END DO
PRINT *,' Nombre total d''articles dans fichier source :', inaf PRINT *,' Nombre total d''articles dans fichier source :', inaf
...@@ -218,13 +230,13 @@ CALL LFIFER(IRESP,IDESTLU,'KEEP') ...@@ -218,13 +230,13 @@ CALL LFIFER(IRESP,IDESTLU,'KEEP')
CONTAINS CONTAINS
SUBROUTINE FMREADLFIN1(klu,hrecfm,kval,kresp) SUBROUTINE FMREADLFIN1(klu,hrecfm,kval,kresp)
INTEGER, INTENT(IN) :: klu ! logical fortran unit au lfi file INTEGER(KIND=LFI_INT), INTENT(IN) :: klu ! logical fortran unit au lfi file
CHARACTER(LEN=*),INTENT(IN) :: hrecfm ! article name to be read CHARACTER(LEN=*), INTENT(IN) :: hrecfm ! article name to be read
INTEGER, INTENT(OUT) :: kval ! integer value for hrecfm article INTEGER, INTENT(OUT) :: kval ! integer value for hrecfm article
INTEGER, INTENT(OUT) :: kresp! return code null if OK INTEGER(KIND=LFI_INT), INTENT(OUT) :: kresp! return code null if OK
! !
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE::iwork INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: iwork
INTEGER :: iresp,ilenga,iposex,icomlen INTEGER(KIND=LFI_INT) :: iresp,ilenga,iposex,icomlen
! !
CALL LFINFO(iresp,klu,hrecfm,ilenga,iposex) CALL LFINFO(iresp,klu,hrecfm,ilenga,iposex)
IF (iresp /=0 .OR. ilenga == 0) THEN IF (iresp /=0 .OR. ilenga == 0) THEN
......
LIBTOOLS/tools/lfiz/src/unlfiz.f90
View file @ 050d6a3c
...@@ -14,24 +14,26 @@ INTEGER :: arglen ...@@ -14,24 +14,26 @@ INTEGER :: arglen
INTEGER :: inarg INTEGER :: inarg
CHARACTER(LEN=50) :: yexe 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 :: FM_FIELD_SIZE = 16
INTEGER, PARAMETER :: ISRCLU = 11 INTEGER(KIND=LFI_INT), PARAMETER :: ISRCLU = 11
INTEGER, PARAMETER :: IDESTLU = 12 INTEGER(KIND=LFI_INT), PARAMETER :: IDESTLU = 12
INTEGER :: iverb INTEGER(KIND=LFI_INT) :: iverb
INTEGER :: inap ! nb d'articles prevus (utile a la creation) INTEGER(KIND=LFI_INT) :: inap ! nb d'articles prevus (utile a la creation)
INTEGER :: inaf ! nb d'articles presents dans un fichier existant INTEGER(KIND=LFI_INT) :: inaf ! nb d'articles presents dans un fichier existant
INTEGER :: inafdest INTEGER(KIND=LFI_INT) :: inafdest
CHARACTER(LEN=128) :: filename,DESTFNAME CHARACTER(LEN=128) :: filename,DESTFNAME
INTEGER :: JI,JJ INTEGER :: JI,JJ
INTEGER :: IRESP INTEGER(KIND=LFI_INT) :: IRESP
CHARACTER(LEN=FM_FIELD_SIZE),DIMENSION(:),ALLOCATABLE :: yrecfm 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(KIND=8), DIMENSION(:),ALLOCATABLE :: iwork,iworknew
INTEGER :: ilengs INTEGER(KIND=LFI_INT) :: ilengs
INTEGER :: ipos INTEGER(KIND=LFI_INT) :: ipos
INTEGER :: sizemax INTEGER :: sizemax
INTEGER :: ICOMLEN INTEGER :: ICOMLEN
...@@ -43,9 +45,10 @@ INTEGER :: CPT ...@@ -43,9 +45,10 @@ INTEGER :: CPT
INTEGER :: LFICOMP INTEGER :: LFICOMP
INTEGER :: searchndx INTEGER :: searchndx
INTEGER :: ITYPCOD INTEGER :: ITYPCOD
INTEGER :: ITOTAL,ITOTALMAX INTEGER(KIND=LFI_INT) :: ITOTAL,ITOTALMAX
INARG = IARGC() !OLD: INARG = IARGC()
INARG = COMMAND_ARGUMENT_COUNT()
#if defined(F90HP) #if defined(F90HP)
#define HPINCR 1 #define HPINCR 1
...@@ -53,6 +56,9 @@ INARG = IARGC() ...@@ -53,6 +56,9 @@ INARG = IARGC()
#define HPINCR 0 #define HPINCR 0
#endif #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) #if defined(FUJI) || defined(NAGf95) || defined(NEC) || defined(HP) || defined(pgf) || defined(G95) || defined(GFORTRAN)
CALL GETARG(0+HPINCR,yexe) CALL GETARG(0+HPINCR,yexe)
IF (LEN_TRIM(yexe) == 0) THEN IF (LEN_TRIM(yexe) == 0) THEN
...@@ -62,12 +68,17 @@ INARG = IARGC() ...@@ -62,12 +68,17 @@ INARG = IARGC()
#else #else
CALL PXFGETARG(0,yexe,arglen,iresp) CALL PXFGETARG(0,yexe,arglen,iresp)
#endif #endif
#endif
! PRINT *,yexe, ' avec ',INARG,' arguments.' ! PRINT *,yexe, ' avec ',INARG,' arguments.'
IF (INARG == 1) THEN 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) #if defined(FUJI) || defined(NAGf95) || defined(NEC) || defined(HP) || defined(pgf) || defined(G95) || defined(GFORTRAN)
CALL GETARG(1+HPINCR,filename) CALL GETARG(1+HPINCR,filename)
#else #else
CALL PXFGETARG(1,filename,arglen,iresp) CALL PXFGETARG(1,filename,arglen,iresp)
#endif
#endif #endif
ELSE ELSE
PRINT *,'Usage : ', TRIM(yexe), ' [fichier lfi]' PRINT *,'Usage : ', TRIM(yexe), ' [fichier lfi]'
...@@ -93,8 +104,8 @@ IDIMY = 0 ...@@ -93,8 +104,8 @@ IDIMY = 0
IDIMZ = 0 IDIMZ = 0
GUSEDIM = .FALSE. GUSEDIM = .FALSE.
CALL LFIOUV(IRESP,ISRCLU,.TRUE.,filename,'OLD',.FALSE.& CALL LFIOUV(IRESP,ISRCLU,GTRUE,filename,'OLD',GFALSE&
& ,.FALSE.,iverb,inap,inaf) & ,GFALSE,iverb,inap,inaf)
CALL FMREADLFIN1(ISRCLU,'LFI_COMPRESSED',LFICOMP,iresp) CALL FMREADLFIN1(ISRCLU,'LFI_COMPRESSED',LFICOMP,iresp)
IF (iresp /= 0 .OR. LFICOMP /= 1) THEN IF (iresp /= 0 .OR. LFICOMP /= 1) THEN
...@@ -104,8 +115,8 @@ IF (iresp /= 0 .OR. LFICOMP /= 1) THEN ...@@ -104,8 +115,8 @@ IF (iresp /= 0 .OR. LFICOMP /= 1) THEN
END IF END IF
PRINT *,'Uncompressed (but 32 bits REAL precision) file : ',DESTFNAME PRINT *,'Uncompressed (but 32 bits REAL precision) file : ',DESTFNAME
CALL LFIOUV(IRESP,IDESTLU,.TRUE.,DESTFNAME,'NEW'& CALL LFIOUV(IRESP,IDESTLU,GTRUE,DESTFNAME,'NEW'&
& ,.FALSE.,.FALSE.,iverb,inaf,inafdest) & ,GFALSE,GFALSE,iverb,inaf,inafdest)
CALL LFIPOS(IRESP,ISRCLU) CALL LFIPOS(IRESP,ISRCLU)
ALLOCATE(yrecfm(inaf)) ALLOCATE(yrecfm(inaf))
...@@ -113,7 +124,7 @@ ALLOCATE(ileng(inaf)) ...@@ -113,7 +124,7 @@ ALLOCATE(ileng(inaf))
yrecfm(:) = '' yrecfm(:) = ''
sizemax=0 sizemax=0
DO ji=1,inaf 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) IF (ileng(ji) > sizemax) sizemax=ileng(ji)
END DO END DO
PRINT *,' Nombre total d''articles dans fichier source :', inaf PRINT *,' Nombre total d''articles dans fichier source :', inaf
...@@ -173,13 +184,13 @@ CALL LFIFER(IRESP,IDESTLU,'KEEP') ...@@ -173,13 +184,13 @@ CALL LFIFER(IRESP,IDESTLU,'KEEP')
CONTAINS CONTAINS
SUBROUTINE FMREADLFIN1(klu,hrecfm,kval,kresp) SUBROUTINE FMREADLFIN1(klu,hrecfm,kval,kresp)
INTEGER, INTENT(IN) :: klu ! logical fortran unit au lfi file INTEGER(KIND=LFI_INT), INTENT(IN) :: klu ! logical fortran unit au lfi file
CHARACTER(LEN=*),INTENT(IN) :: hrecfm ! article name to be read CHARACTER(LEN=*), INTENT(IN) :: hrecfm ! article name to be read
INTEGER, INTENT(OUT) :: kval ! integer value for hrecfm article INTEGER, INTENT(OUT) :: kval ! integer value for hrecfm article
INTEGER, INTENT(OUT) :: kresp! return code null if OK INTEGER(KIND=LFI_INT), INTENT(OUT) :: kresp! return code null if OK
! !
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE::iwork INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: iwork
INTEGER :: iresp,ilenga,iposex,icomlen INTEGER(KIND=LFI_INT) :: iresp,ilenga,iposex,icomlen
! !
CALL LFINFO(iresp,klu,hrecfm,ilenga,iposex) CALL LFINFO(iresp,klu,hrecfm,ilenga,iposex)
IF (iresp /=0 .OR. ilenga == 0) THEN IF (iresp /=0 .OR. ilenga == 0) THEN
......
MY_RUN/BENCH/001_RELIEF_PERTURB/002_mesonh/EXSEG1_NSTEP.nam.ihm
View file @ 050d6a3c
...@@ -82,7 +82,7 @@ ...@@ -82,7 +82,7 @@
LNUMDIFF = T / LNUMDIFF = T /
&NAM_FMOUT &NAM_FMOUT
XFMOUT(1,1) = 100000.0 / XBAK_TIME(1,1) = 100000.0 /
&NAM_BUDGET &NAM_BUDGET
CBUTYPE = "NONE" CBUTYPE = "NONE"
/ /
......
MY_RUN/BENCH/003_MEDATL_FULLHD/003_mesonh/run_mesonh_xyz_SEG1.ihm
View file @ 050d6a3c
...@@ -134,7 +134,7 @@ cat > EXSEG1.nam << EOF ...@@ -134,7 +134,7 @@ cat > EXSEG1.nam << EOF
/ /
&NAM_FMOUT &NAM_FMOUT
${XFMOUT} ${XBAK_TIME}
/ /
EOF EOF
cp EXSEG1.nam SURF1.nam cp EXSEG1.nam SURF1.nam
......
MY_RUN/BENCH/003_MEDATL_FULLHD/003_mesonh/run_mesonh_xyz_SEGN.ihm
View file @ 050d6a3c
#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 This is part of the Meso-NH software governed by the CeCILL-C licence
#MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt #MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
#MNH_LIC for details. version 1. #MNH_LIC for details. version 1.
...@@ -54,7 +54,6 @@ cat > EXSEG1.nam << EOF ...@@ -54,7 +54,6 @@ cat > EXSEG1.nam << EOF
&NAM_DYNn &NAM_DYNn
XTSTEP = ${XTSTEP} , XTSTEP = ${XTSTEP} ,
CPRESOPT = "CRESI", CPRESOPT = "CRESI",
NITR = 12,
LITRADJ = T, LITRADJ = T,
XRELAX = 1., XRELAX = 1.,
LHORELAX_UVWTH = T, LHORELAX_UVWTH = T,
...@@ -134,7 +133,7 @@ cat > EXSEG1.nam << EOF ...@@ -134,7 +133,7 @@ cat > EXSEG1.nam << EOF
/ /
&NAM_FMOUT &NAM_FMOUT
${XFMOUT} ${XBAK_TIME}
/ /
EOF EOF
cp EXSEG1.nam SURF1.nam cp EXSEG1.nam SURF1.nam
......
MY_RUN/BENCH/003_MEDATL_FULLHD/grillE_3072_1920_MNH490
View file @ 050d6a3c
...@@ -203,16 +203,16 @@ export XTSTEP=$( echo " scale=5 ; ${XTSTEP0} / ${GRIDFAC} " | bc -l ) ...@@ -203,16 +203,16 @@ export XTSTEP=$( echo " scale=5 ; ${XTSTEP0} / ${GRIDFAC} " | bc -l )
export XSEGLEN=$( echo "1 * 3600 " | bc -l ) export XSEGLEN=$( echo "1 * 3600 " | bc -l )
export XSEGLEN=3600.0 export XSEGLEN=3600.0
#export XFMOUT="XFMOUT(1,1) = 1800., XFMOUT(1,2) = 3600. , XFMOUT(1,3) = 5400., XFMOUT(1,4) = 7200., \ #export XBAK_TIME="XBAK_TIME(1,1) = 1800., XBAK_TIME(1,2) = 3600. , XBAK_TIME(1,3) = 5400., XBAK_TIME(1,4) = 7200., \
# XFMOUT(1,5) = 9000., XFMOUT(1,6) = 10800. , XFMOUT(1,7) = 12600., XFMOUT(1,8) = 14400. , \ # XBAK_TIME(1,5) = 9000., XBAK_TIME(1,6) = 10800. , XBAK_TIME(1,7) = 12600., XBAK_TIME(1,8) = 14400. , \
# XFMOUT(1,9) = 16200., XFMOUT(1,10) = 18000. , XFMOUT(1,11) = 19800., XFMOUT(1,12) = 21600. " # XBAK_TIME(1,9) = 16200., XBAK_TIME(1,10) = 18000. , XBAK_TIME(1,11) = 19800., XBAK_TIME(1,12) = 21600. "
#export XFMOUT="XFMOUT(1,1) = 3600. , XFMOUT(1,2) = 7200., \ #export XBAK_TIME="XBAK_TIME(1,1) = 3600. , XBAK_TIME(1,2) = 7200., \
# XFMOUT(1,3) = 10800. , XFMOUT(1,4) = 14400. , \ # XBAK_TIME(1,3) = 10800. , XBAK_TIME(1,4) = 14400. , \
# XFMOUT(1,5) = 18000. , XFMOUT(1,6) = 21600. " # XBAK_TIME(1,5) = 18000. , XBAK_TIME(1,6) = 21600. "
#export XFMOUT="XFMOUT(1,1) = 21600. , XFMOUT(1,2) = 43200. , XFMOUT(1,3) = 64800. , XFMOUT(1,4) = 86400. " #export XBAK_TIME="XBAK_TIME(1,1) = 21600. , XBAK_TIME(1,2) = 43200. , XBAK_TIME(1,3) = 64800. , XBAK_TIME(1,4) = 86400. "
#export XFMOUT="XFMOUT(1,1) = 21540. , XFMOUT(1,2) = 43140. , XFMOUT(1,3) = 64740. , XFMOUT(1,4) = 86340. " #export XBAK_TIME="XBAK_TIME(1,1) = 21540. , XBAK_TIME(1,2) = 43140. , XBAK_TIME(1,3) = 64740. , XBAK_TIME(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) = 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 if [ $(echo " scale=0 ; ( ${XDX} - 5000.0 ) / 1 " | bc -l ) -gt 0 ] ; then
# XDX > 5KM # XDX > 5KM
......
MY_RUN/BENCH/003_MEDATL_FULLHD/grille_4km_1920x0600_I8_MED_ATL
View file @ 050d6a3c
...@@ -279,15 +279,15 @@ export XTSTEP=$( echo " scale=5 ; ${XTSTEP0} / ${GRIDFAC} " | bc -l ) ...@@ -279,15 +279,15 @@ export XTSTEP=$( echo " scale=5 ; ${XTSTEP0} / ${GRIDFAC} " | bc -l )
export XSEGLEN=$( echo "24 * 3600 - 60 " | bc -l ) export XSEGLEN=$( echo "24 * 3600 - 60 " | bc -l )
#export XSEGLEN=60.0 #export XSEGLEN=60.0
#export XFMOUT="XFMOUT(1,1) = 1800., XFMOUT(1,2) = 3600. , XFMOUT(1,3) = 5400., XFMOUT(1,4) = 7200., \ #export XBAK_TIME="XBAK_TIME(1,1) = 1800., XBAK_TIME(1,2) = 3600. , XBAK_TIME(1,3) = 5400., XBAK_TIME(1,4) = 7200., \
# XFMOUT(1,5) = 9000., XFMOUT(1,6) = 10800. , XFMOUT(1,7) = 12600., XFMOUT(1,8) = 14400. , \ # XBAK_TIME(1,5) = 9000., XBAK_TIME(1,6) = 10800. , XBAK_TIME(1,7) = 12600., XBAK_TIME(1,8) = 14400. , \
# XFMOUT(1,9) = 16200., XFMOUT(1,10) = 18000. , XFMOUT(1,11) = 19800., XFMOUT(1,12) = 21600. " # XBAK_TIME(1,9) = 16200., XBAK_TIME(1,10) = 18000. , XBAK_TIME(1,11) = 19800., XBAK_TIME(1,12) = 21600. "
#export XFMOUT="XFMOUT(1,1) = 3600. , XFMOUT(1,2) = 7200., \ #export XBAK_TIME="XBAK_TIME(1,1) = 3600. , XBAK_TIME(1,2) = 7200., \
# XFMOUT(1,3) = 10800. , XFMOUT(1,4) = 14400. , \ # XBAK_TIME(1,3) = 10800. , XBAK_TIME(1,4) = 14400. , \
# XFMOUT(1,5) = 18000. , XFMOUT(1,6) = 21600. " # XBAK_TIME(1,5) = 18000. , XBAK_TIME(1,6) = 21600. "
#export XFMOUT="XFMOUT(1,1) = 21600. , XFMOUT(1,2) = 43200. , XFMOUT(1,3) = 64800. , XFMOUT(1,4) = 86400. " #export XBAK_TIME="XBAK_TIME(1,1) = 21600. , XBAK_TIME(1,2) = 43200. , XBAK_TIME(1,3) = 64800. , XBAK_TIME(1,4) = 86400. "
export XFMOUT="XFMOUT(1,1) = 21540. , XFMOUT(1,2) = 43140. , XFMOUT(1,3) = 64740. , XFMOUT(1,4) = 86340. " export XBAK_TIME="XBAK_TIME(1,1) = 21540. , XBAK_TIME(1,2) = 43140. , XBAK_TIME(1,3) = 64740. , XBAK_TIME(1,4) = 86340. "
#export XFMOUT="XFMOUT(1,1) = 60. " #export XBAK_TIME="XBAK_TIME(1,1) = 60. "
#export XR=2.0 #export XR=2.0
......
MY_RUN/INTEGRATION_CASES/HPC/16JAN/PYTHON/plot_16JAN.py 0 → 100644
View file @ 050d6a3c
#!/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