Skip to content
Snippets Groups Projects

Compare revisions

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

Source

Select target project
No results found

Target

Select target project
  • mesonh/mesonh-code
  • quentin.rodier/mesonh-code-fork
  • benoit.vie/mesonh-code
  • joris.pianezze/mesonh-code
  • 8qq4g5s7/mesonh-code
  • jean.baptiste.filippi/meso-nh-fire-code
  • fdl68d9p/mesonh-code-sophia
7 results
Show changes
Commits on Source (3999)
Showing
with 2240 additions and 2019 deletions
* 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
......
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/*/*/dir.??????:??:??
MY_RUN/KTEST/*/*/dir_save
MY_RUN/KTEST/*/*/dirconv
MY_RUN/KTEST/*/*/dirextract
MY_RUN/KTEST/*/*/ecmwf.OD.????????.??
MY_RUN/KTEST/*/*/file_for_xtransfer
MY_RUN/KTEST/*/*/gmeta
MY_RUN/KTEST/*/*/gtopo30.*
MY_RUN/KTEST/*/*/CLAY_HWSD_MOY.*
MY_RUN/KTEST/*/*/DATA?1
MY_RUN/KTEST/*/*/ECOCLIMAP_v2.0.*
MY_RUN/KTEST/*/*/FICJD
MY_RUN/KTEST/*/*/LISTING_DIA
MY_RUN/KTEST/*/*/OUT_DIA
MY_RUN/KTEST/*/*/OUTPUT_LISTING*
MY_RUN/KTEST/*/*/PRESSURE
MY_RUN/KTEST/*/*/REMAP*FFT*
MY_RUN/KTEST/*/*/SAND_HWSD_MOY.*
MY_RUN/KTEST/*/*/output_save*
MY_RUN/KTEST/*/*/pipe_name
MY_RUN/KTEST/*/*/gshhs(?).rim
MY_RUN/KTEST/*/*/gshhs(?).zip
MY_RUN/KTEST/*/*/rangs(?).cat
MY_RUN/KTEST/*/*/rangs(?).cel
MY_RUN/KTEST/*/*/rangs(?).zip
MY_RUN/KTEST/*/*/visu*.png
MY_RUN/KTEST/*/*/zsection*.png
MY_RUN/KTEST/007_16janvier/012_spectre/spectra_16JAN.1.12B18.001_*
MY_RUN/KTEST/009_ICARTT/001_pgd1/*.asc
MY_RUN/KTEST/009_ICARTT/002_arp2lfi/ecmwf.OD.20040810.18-V2
MY_RUN/KTEST/009_ICARTT/002_arp2lfi/mocage.GLOB22.20040810.18
MY_RUN/KTEST/9??_*
pub/FILEPP/filepp*
!pub/FILEPP/filepp*.tar.gz
pub/FILEPP/FILEPP*
pub/FILEPP/MNH_Expand_*
!pub/FILEPP/MNH_EXPAND_*.tar.gz
src/dir_obj-* src/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
# #
# Version of PACKAGE MESONH "Open distribution" # Version of PACKAGE MESONH "Open distribution"
# PACK-MNH-V5-3-0 # PACK-MNH-V5-7-1
# DATE : 12/12/2016 # DATE : 04/09/2024
# VERSION : MESONH MASDEV5_3 + BUG-0 # VERSION : MESONH MASDEV5_7 + BUG-1
# #
# MAP # MAP
# #
...@@ -13,7 +13,7 @@ ...@@ -13,7 +13,7 @@
# 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
...@@ -23,7 +23,13 @@ ...@@ -23,7 +23,13 @@
# IX) OPTIONAL COMPILATION # IX) OPTIONAL COMPILATION
# a) MNH_FOREFIRE for forefire runs ( external package needed ) # a) MNH_FOREFIRE for forefire runs ( external package needed )
# b) MNH_RTTOV for optional radiative computation # b) MNH_RTTOV for optional radiative computation
# c) cleaning previous compiled version # c) MNH_ECRAD for optional compilation of new ECRAD radiative library from ECMWF
# d) MNH_MEGAN for optional compilation of MEGAN
# e) cleaning previous compiled version
#
#
# NEW since MNH-56X : For conda package for graphic output in test-case examples , read
# the 'README_MNH_CONDA' file in this (root) directory
# #
# #
^L ^L
...@@ -72,21 +78,21 @@ ...@@ -72,21 +78,21 @@
# ========================================== # ==========================================
# #
# 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
# #
# or directly # or directly
# #
# http://mesonh.aero.obs-mip.fr/mesonh/dir_open/dir_MESONH/MNH-V5-3-0.tar.gz # http://mesonh.aero.obs-mip.fr/mesonh/dir_open/dir_MESONH/MNH-V5-7-1.tar.gz
# #
# Then untar the file "PACK-MNH-V5-3-0.tar.gz" where you want to. # Then untar the file "MNH-V5-7-1.tar.gz" where you want to.
# For example, in your home directory: # For example, in your home directory:
# #
cd ~ cd ~
tar xvfz PACK-MNH-V5-3-0.tar.gz tar xvfz MNH-V5-7-1.tar.gz
# #
# Process now to the chapter to configure the MesoNH package. # Process now to the chapter to configure the MesoNH package.
# #
...@@ -119,7 +125,7 @@ git --version ...@@ -119,7 +125,7 @@ git --version
git lfs install git lfs install
# that will set up some filters under the name "lfs" in the global Git # that will set up some filters under the name "lfs" in the global Git
# config file ($HOME/.gitconfig) # config file ($HOME/.gitconfig)
# #
# b) Before cloning # b) Before cloning
# ----------------- # -----------------
...@@ -128,7 +134,7 @@ git lfs install ...@@ -128,7 +134,7 @@ git lfs install
# only access) by following the next link: # only access) by following the next link:
# #
http://mesonh.aero.obs-mip.fr/mesonh53/GitSources?action=AttachFile&do=get&target=anongitmesonh.key http://mesonh.aero.obs-mip.fr/mesonh57/GitSources?action=AttachFile&do=get&target=anongitmesonh.key
# #
# and save the file in your $HOME/.ssh/ directory. # and save the file in your $HOME/.ssh/ directory.
...@@ -159,68 +165,68 @@ git config --global http.sslverify false ...@@ -159,68 +165,68 @@ git config --global http.sslverify false
# This is necessary to disable the certificate checks because a self-signed # This is necessary to disable the certificate checks because a self-signed
# certificate was used for the LFS server. # certificate was used for the LFS server.
# #
# c) Cloning the Meso-NH Source repository on the developpement branch MNH-53-branch # 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: # Finally you can clone the Meso-NH Git repository with the following command:
# #
git lfs clone anongit@anongit_mesonh:/gitrepos/MNH-git_open_source-lfs.git -b MNH-53-branch MNH-V5-3-0 git clone anongit@anongit_mesonh:/gitrepos/MNH-git_open_source-lfs.git -b MNH-57-branch MNH-V5-7-1
# #
# that will create the MNH-V5-3-0 directory containing a clone (copy) of the # that will create the MNH-V5-7-1 directory containing a clone (copy) of the
# Meso-NH package on the remote developpement branch MNH-53-branch # Meso-NH package on the remote developpement branch MNH-57-branch
# #
# #
# d) Checking out a given version of MESONH # d) Checking out a given version of MESONH
# ----------------------------------------- # -----------------------------------------
# #
# Once the repository is cloned, it's better for you to checkout your own branch # Once the repository is cloned, it's better for you to checkout your own branch
# (by default, you are on HEAD of the MNH-53-branch development branch ). # (by default, you are on HEAD of the MNH-57-branch development branch ).
# #
# To create your local branch corresponding to the V5-3-0 version, type: # To create your local branch corresponding to the V5-7-1 version, type:
# #
cd MNH-V5-3-0 cd MNH-V5-7-1
git checkout -b MYB-MNH-V5-3-0 PACK-MNH-V5-3-0 git checkout -b MYB-MNH-V5-7-1 PACK-MNH-V5-7-1
# #
# MYB-MNH-V5-3-0 is the name of the local branch you created # MYB-MNH-V5-7-1 is the name of the local branch you created
# and # and
# PACK-MNH-V5-3-0 is the remote/origin tag on which it is based. # PACK-MNH-V5-7-1 is the remote/origin tag on which it is based.
# #
# The advantage of this way of downloading the package is that in the future # The advantage of this way of downloading the package is that in the future
# you could check/update quickly differences with the new version of the # you could check/update quickly differences with the new version of the
# package without having to download entirely the full package. # package without having to download entirely the full package.
# #
# Suppose that a new version, for example "PACK-MNH-V5-3-1", is announced. # Suppose that a new version, for example "PACK-MNH-V5-7-1", is announced.
# #
# To see the differences with your working copy, do: # To see the differences with your working copy, do:
# #
git fetch git fetch
git diff HEAD PACK-MNH-V5-3-1 git diff HEAD PACK-MNH-V5-7-1
# #
# To go to the new version, you can, for example, create a new local branch: # To go to the new version, you can, for example, create a new local branch:
# #
git checkout -b MYB-MNH-V5-3-1 PACK-MNH-V5-3-1 git checkout -b MYB-MNH-V5-7-1 PACK-MNH-V5-7-1
# #
# At any time, you can also check for "uptodate" changes in the Git branch # At any time, you can also check for "uptodate" changes in the Git branch
# dedicated to the MNH53 version before the official release of the "bugN+1" # dedicated to the MNH57 version before the official release of the "bugN+1"
# bugfix version. # bugfix version.
# #
git fetch git fetch
git diff HEAD MNH-53-branch git diff HEAD MNH-57-branch
# #
# And, test this development (not yet official) version by going to this branch: # And, test this development (not yet official) version by going to this branch:
# #
git checkout --track origin/MNH-53-branch git checkout --track origin/MNH-57-branch
# #
# e) Cloning the Meso-NH Documentation repository # e) Cloning the Meso-NH Documentation repository
# #
...@@ -251,7 +257,7 @@ git clone anongit@anongit_mesonh:/gitrepos/MNH-DOC.git ...@@ -251,7 +257,7 @@ git clone anongit@anongit_mesonh:/gitrepos/MNH-DOC.git
# use the "./configure" script like this # use the "./configure" script like this
# #
cd ~/MNH-V5-3-0/src cd ~/MNH-V5-7-1/src
./configure ./configure
. ../conf/profile_mesonh . ../conf/profile_mesonh
...@@ -259,14 +265,20 @@ cd ~/MNH-V5-3-0/src ...@@ -259,14 +265,20 @@ cd ~/MNH-V5-3-0/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 & netCDF libraries,... # 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,
...@@ -296,7 +308,7 @@ export OPTLEVEL=O2 # Compile in O2, 4 times faster then DEBUG, but less ...@@ -296,7 +308,7 @@ export OPTLEVEL=O2 # Compile in O2, 4 times faster then DEBUG, but less
# and then source/load the new generate file # and then source/load the new generate file
. ../conf/profile_mesonh.LXifort.MNH-V5-3-0.MPIAUTO.O2 . ../conf/profile_mesonh.LXifort.MNH-V5-7-1.MPIAUTO.O2
# #
# REM: # REM:
...@@ -321,7 +333,7 @@ export OPTLEVEL=O2 # Compile in O2, 4 times faster then DEBUG, but less ...@@ -321,7 +333,7 @@ export OPTLEVEL=O2 # Compile in O2, 4 times faster then DEBUG, but less
# go to the directory "src" # go to the directory "src"
# #
cd ~/MNH-V5-3-0/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
...@@ -486,7 +498,7 @@ export VER_USER=MY_MODIF ...@@ -486,7 +498,7 @@ 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
...@@ -527,8 +539,8 @@ make examples ...@@ -527,8 +539,8 @@ 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 :
...@@ -539,120 +551,195 @@ make examples ...@@ -539,120 +551,195 @@ make examples
# #
# - 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 no 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
cd MNH-V5-3-0/src cd MNH-V5-7-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 ...
#
# - to run the test case examples run
#
# On intel Skylake
ccc_msub job_make_examples_BullX_irene
# On intel AMD
ccc_msub job_make_examples_BullX_irene_AMD
création du fichier --> ../conf/profile_mesonh-LXifortI4-MNH-V5-3-0-MPICRAY-O2 #
# 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
# And for the compilation & example job , switch the ARCH variable to LXiort : ecinteractive -c16 -m 16G -t 12:00:00
vi job_make_mesonh_CRAY_cca(job_make_examples_CRAY_cca) etc ...
ARCH=LXifort
#ARCH=LXcray # this is the default one
. ../conf/profile_mesonh-${ARCH}I4-MNH-V5-3-0-MPICRAY-O2
# - 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"
...@@ -662,7 +749,7 @@ llsubmit job_make_examples_CRAY_cca ...@@ -662,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-3-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.
...@@ -708,7 +795,7 @@ scandollar ...@@ -708,7 +795,7 @@ scandollar
## OUTPUT :: ## OUTPUT ::
># read default config file :: ---> CONF_DOLLAR=/home/escj/DEV64/PACK-MNH-V5-3-0/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
># >#
...@@ -730,7 +817,7 @@ scandollar 0* ...@@ -730,7 +817,7 @@ scandollar 0*
## OUTPUT :: ## OUTPUT ::
># >#
># read default config file :: ---> CONF_DOLLAR=/home/escj/DEV64/PACK-MNH-V5-3-0/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
># >#
...@@ -804,22 +891,22 @@ cp -R 007_16janvier_scandollar /.../your_directory ...@@ -804,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-3-0/conf/profile_mesonh-SX8-MNH-V5-3-0-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-3-0/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-3-0/conf/profile_mesonh-AIX64-MNH-V5-3-0-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-3-0/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 :
...@@ -827,11 +914,11 @@ cp -R 007_16janvier_scandollar /.../your_directory ...@@ -827,11 +914,11 @@ cp -R 007_16janvier_scandollar /.../your_directory
# #
# use # use
. /work/escobar/DEV/MNH-V5-3-0/conf/profile_mesonh-LXifort-MNH-V5-3-0-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-3-0/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 :
...@@ -839,11 +926,11 @@ cp -R 007_16janvier_scandollar /.../your_directory ...@@ -839,11 +926,11 @@ cp -R 007_16janvier_scandollar /.../your_directory
# #
# use # use
. /c1a/ms_perm/au5/MNH-V5-3-0/conf/profile_mesonh-AIX64-MNH-V5-3-0-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-3-0/MY_RUN/KTEST/007_16janvier_scandollar /c1a/ms_perm/au5/MNH-V5-7-1/MY_RUN/KTEST/007_16janvier_scandollar
# #
...@@ -930,73 +1017,102 @@ git clone -b 2014.01 https://github.com/forefireAPI/firefront.git ...@@ -930,73 +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 c) for cleaning previously version if needed
# b) 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.
# #
# ---------------------------------- # Run the 'configure' script preceded with the setting of the MNH_RTTOV variable:
# OPTION 1: Use version 11.3 of RTTOV #
# ----------------------------------- cd $SRC_MESONH/src/
# Download the RTTOV package rttov113.tar.gz by following the instructions given on http://nwpsaf.eu/site/software/rttov/ export MNH_RTTOV=1
# export VER_RTTOV=13.2
# Install the RTTOV package rttov113.tar.gz #
cd MNH.../src/LIB # Compile the HDF5 library
mkdir RTTOV-11.3 #
cd RTTOV-11.3 make cdf
tar xvfz rttov113.tar.gz #
cd src # Download the RTTOV package rttov132.tar.xz by following the instructions given on https://nwpsaf.eu/site/software/rttov/
#
# 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 make ARCH=ifort # Use Intel "ifort" compiler; other options: gfortran, NAG, pgf90, IBM
# #
# And then for the compilation, run the 'configure' script preceded with the setting of the MNH_RTTOV variable: # And then for the Meso-NH compilation, do
# #
cd $SRC_MESONH/src/
make
cd MNH.../src/ # c) MNH_ECRAD for optional compilation of new ECRAD radiative library from ECMWF
export MNH_RTTOV=1 # --------------------------------------
export VER_RTTOV=11.3 #
# The default version of ECRAD is 1.4.0 (open-source)
#
# Configure & Compilation
export MNH_ECRAD=1
./configure ./configure
etc ... etc ...
# The version of ECRAD is set by (by default):
# ---------------------------------- # export VER_ECRAD=140
# OPTION 2: Use version 8.7 of RTTOV
# ----------------------------------
# For already(old) licencied MesoNH users (MNH-4-X version with research licence see here: http://mesonh.aero.obs-mip.fr/mesonh410/UserInformation)
# #
# the package could be reloaded in this way # To use the previous version 1.0.1:
# #
# - With cvs access # 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 MNH.../src/LIB cd ${SRC_MESONH}/src/LIB/RAD
cvs up -rPACK-MNH-V4-10-3 -d -P RTTOV tar xvfz ecrad-1.0.1.tar.gz
#
# - With WEB access (with WEB login/pass as usually) the RTTOV package could also be retrieve in tarball with wget like this:
#
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
export VER_RTTOV=8.7 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
# c) 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 )
......
!----------------------------------------------------------------- !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
......
#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);
}
#!/bin/sh #!/bin/bash
# #
# #
usage(){ usage(){
......
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
!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
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
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
!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.
...@@ -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,15 +88,22 @@ subroutine read_commandline(options,hinfile,houtfile,runmode) ...@@ -80,15 +88,22 @@ subroutine read_commandline(options,hinfile,houtfile,runmode)
call check_options(options,hinfile,runmode) call check_options(options,hinfile,runmode)
houtfile = options(OPTOUTPUT)%cvalue call remove_suffix(hinfile)
!Remove level in the filename if merging LFI splitted files and output name not set by option !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) then idx = index(hinfile,'/',back=.true.)
houtfile=hinfile(1:len(hinfile)-9) options(OPTOUTPUT)%cvalue = hinfile(idx+1:len_trim(hinfile))//'_merged'
end if
end if end if
if (.NOT.options(OPTOUTPUT)%set .AND. options(OPTSPLIT)%set) then
idx = index(hinfile,'/',back=.true.)
options(OPTOUTPUT)%cvalue = trim(hinfile)
end if
houtfile = options(OPTOUTPUT)%cvalue
call remove_suffix(houtfile)
end subroutine read_commandline end subroutine read_commandline
subroutine init_options(options) subroutine init_options(options)
...@@ -98,14 +113,6 @@ subroutine init_options(options) ...@@ -98,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.
...@@ -133,6 +140,11 @@ subroutine init_options(options) ...@@ -133,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.
...@@ -142,6 +154,20 @@ subroutine init_options(options) ...@@ -142,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)
...@@ -224,24 +250,32 @@ subroutine check_options(options,infile,runmode) ...@@ -224,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
...@@ -259,63 +293,86 @@ subroutine check_options(options,infile,runmode) ...@@ -259,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
......
!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 :: MAXLFICOMMENTLENGTH=100 INTEGER,parameter :: MAXDATES=100
INTEGER,PARAMETER :: UNDEFINED = -1, READING = 1, WRITING = 2
INTEGER,PARAMETER :: UNKNOWN_FORMAT = -1, NETCDF_FORMAT = 1, LFI_FORMAT = 2
TYPE filestruct
INTEGER :: lun_id ! Logical ID of file
INTEGER :: format = UNKNOWN_FORMAT ! NETCDF, LFI
INTEGER :: status = UNDEFINED ! Opened for reading or writing
INTEGER :: var_id ! Position of the variable in the workfield structure
LOGICAL :: opened = .false.
END TYPE filestruct
TYPE filelist_struct
INTEGER :: nbfiles = 0
! TYPE(filestruct),DIMENSION(:),ALLOCATABLE :: files
TYPE(filestruct),DIMENSION(MAXFILES) :: files
END TYPE filelist_struct
INTEGER,PARAMETER :: FM_FIELD_SIZE = 32
TYPE workfield 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
...@@ -179,9 +141,6 @@ CONTAINS ...@@ -179,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.
...@@ -207,8 +166,7 @@ CONTAINS ...@@ -207,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),'+')
...@@ -224,6 +182,7 @@ CONTAINS ...@@ -224,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
...@@ -250,61 +209,80 @@ CONTAINS ...@@ -250,61 +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
!Add maximum comment size (necessary when writing LFI files because the comment is stored with the field)
leng = leng + MAXLFICOMMENTLENGTH
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
...@@ -312,1087 +290,1341 @@ END DO ...@@ -312,1087 +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
!Add maximum comment size (necessary when writing LFI files because the comment is stored with the field)
sizemax = sizemax + MAXLFICOMMENTLENGTH
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
tpreclist(ji)%TFIELD%CDIR = tpreclist(idx_var)%TFIELD%CDIR
tpreclist(ji)%TFIELD%CLBTYPE = tpreclist(idx_var)%TFIELD%CLBTYPE
tpreclist(ji)%TFIELD%CCOMMENT = TRIM(tpreclist(ji)%name)//'='//TRIM(tpreclist(idx_var)%name)
IF (tpreclist(ji)%NSRC>1) tpreclist(ji)%TFIELD%CCOMMENT = TRIM(tpreclist(ji)%TFIELD%CCOMMENT)//'+'
tpreclist(ji)%TFIELD%NGRID = tpreclist(idx_var)%TFIELD%NGRID
tpreclist(ji)%TFIELD%NTYPE = tpreclist(idx_var)%TFIELD%NTYPE
tpreclist(ji)%TFIELD%NDIMS = tpreclist(idx_var)%TFIELD%NDIMS
#if 0
tpreclist(ji)%TFIELD%NFILLVALUE
tpreclist(ji)%TFIELD%XFILLVALUE
tpreclist(ji)%TFIELD%NVALIDMIN
tpreclist(ji)%TFIELD%NVALIDMAX
tpreclist(ji)%TFIELD%XVALIDMIN
tpreclist(ji)%TFIELD%XVALIDMAX
#endif #endif
END SUBROUTINE parse_infiles DO jj=2,tpreclist(ji)%NSRC
idx_var = tpreclist(ji)%src(jj)
SUBROUTINE read_data_lfi(infiles, nbvar, tpreclist, kbuflen, current_level) !
TYPE(filelist_struct), INTENT(IN) :: infiles IF (tpreclist(ji)%TFIELD%CUNITS /= tpreclist(idx_var)%TFIELD%CUNITS) THEN
INTEGER, INTENT(INOUT) :: nbvar CALL PRINT_MSG(NVERB_WARNING,'IO','parse_infiles','CUNITS is not uniform between components of calculated variable '&
TYPE(workfield), DIMENSION(:), POINTER :: tpreclist //TRIM(tpreclist(ji)%name)//' => CUNITS not set')
INTEGER, INTENT(IN) :: kbuflen tpreclist(ji)%TFIELD%CUNITS = ''
INTEGER, INTENT(IN), OPTIONAL :: current_level 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
INTEGER :: ji,jj END SUBROUTINE parse_infiles
INTEGER :: ndb, nde
LOGICAL :: ladvan
INTEGER :: ich
INTEGER :: fsize,sizemax
CHARACTER(LEN=FM_FIELD_SIZE) :: yrecfm
CHARACTER(LEN=4) :: suffix
#ifdef LOWMEM
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: iwork
#endif
INTEGER(KIND=LFI_INT) :: iresp,ilu,ileng,ipos
CHARACTER(LEN=FM_FIELD_SIZE) :: var_calc
CHARACTER(LEN=FM_FIELD_SIZE),dimension(MAXRAW) :: var_raw
SUBROUTINE def_ncdf(infiles,outfiles,KNFILES_OUT)
USE MODD_CONF, ONLY: NMNHVERSION
use mode_io_write_nc4, only: IO_Header_write_nc4
ilu = infiles%files(1)%lun_id TYPE(TFILE_ELT),DIMENSION(:),INTENT(IN) :: infiles
TYPE(TFILE_ELT),DIMENSION(:),INTENT(IN) :: outfiles
INTEGER, INTENT(IN) :: KNFILES_OUT
IF (present(current_level)) THEN CHARACTER(LEN=*),PARAMETER :: YUNKNOWNHIST = 'Previous history is unknown'
write(suffix,'(I4.4)') current_level
ElSE
suffix=''
END IF
#ifdef LOWMEM CHARACTER(LEN=16) :: YMNHVERSION
ALLOCATE(iwork(kbuflen)) CHARACTER(LEN=:),ALLOCATABLE :: YHISTORY
#endif INTEGER :: ji
INTEGER(KIND=CDFINT) :: ilen
INTEGER(KIND=CDFINT) :: status
INTEGER(KIND=CDFINT) :: kcdf_id
DO ji=1,nbvar
IF (.NOT.tpreclist(ji)%tbr) CYCLE
yrecfm = trim(tpreclist(ji)%name)//trim(suffix)
CALL LFINFO(iresp,ilu,yrecfm,ileng,ipos)
#ifdef LOWMEM
CALL LFILEC(iresp,ilu,yrecfm,iwork,ileng)
tpreclist(ji)%grid = iwork(1)
#else
CALL LFILEC(iresp,ilu,yrecfm,lfiart(ji)%iwtab,ileng)
tpreclist(ji)%grid = lfiart(ji)%iwtab(1)
#endif
END DO
#ifdef LOWMEM CALL PRINT_MSG(NVERB_DEBUG,'IO','def_ncdf','called')
DEALLOCATE(iwork)
#endif
END SUBROUTINE read_data_lfi
SUBROUTINE HANDLE_ERR(status,line) !Copy history attribute for netCDF files
INTEGER :: status,line 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 (status /= NF90_NOERR) THEN DO ji = 1,KNFILES_OUT
PRINT *, 'line ',line,': ',NF90_STRERROR(status) kcdf_id = outfiles(ji)%TFILE%NNCID
STOP status = NF90_PUT_ATT(kcdf_id,NF90_GLOBAL,'history',YHISTORY)
if ( status /= NF90_NOERR ) call IO_Err_handle_nc4( status, 'def_ncdf', 'NF90_PUT_ATT', 'history' )
END DO
END IF END IF
END SUBROUTINE HANDLE_ERR
SUBROUTINE def_ncdf(outfiles,tpreclist,nbvar,options) !Write header for netCDF files
TYPE(filelist_struct), INTENT(IN) :: outfiles DO ji = 1,KNFILES_OUT
TYPE(workfield),DIMENSION(:),INTENT(INOUT) :: tpreclist kcdf_id = outfiles(ji)%TFILE%NNCID
INTEGER, INTENT(IN) :: nbvar
TYPE(option),DIMENSION(:), INTENT(IN) :: options
INTEGER :: compress_level, status ! global attributes
INTEGER :: idx, ji, nbfiles CALL IO_Header_write_nc4(outfiles(ji)%TFILE)
INTEGER:: kcdf_id !
TYPE(dimCDF), POINTER :: tzdim WRITE(YMNHVERSION,"( I0,'.',I0,'.',I0 )" ) NMNHVERSION(1),NMNHVERSION(2),NMNHVERSION(3)
INTEGER :: invdims status = NF90_PUT_ATT(kcdf_id,NF90_GLOBAL,'lfi2cdf_version',TRIM(YMNHVERSION))
INTEGER :: type_float if ( status /= NF90_NOERR ) call IO_Err_handle_nc4( status, 'def_ncdf', 'NF90_PUT_ATT', 'lfi2cdf_version' )
INTEGER, DIMENSION(10) :: ivdims END DO
CHARACTER(LEN=20) :: ycdfvar
END SUBROUTINE def_ncdf
nbfiles = outfiles%nbfiles SUBROUTINE fill_files(infiles,outfiles,tpreclist,knaf,options)
USE MODD_TYPE_DATE
TYPE(TFILE_ELT),DIMENSION(:), INTENT(IN) :: infiles
TYPE(TFILE_ELT),DIMENSION(:), INTENT(IN) :: outfiles
TYPE(workfield), DIMENSION(:),INTENT(INOUT) :: tpreclist
INTEGER, INTENT(IN) :: knaf
TYPE(option),DIMENSION(:), INTENT(IN) :: options
INTEGER :: idx, ji, jj
INTEGER :: IDIMS
INTEGER :: INSRC
INTEGER :: ISRC
INTEGER(KIND=CDFINT),DIMENSION(NF90_MAX_VAR_DIMS) :: IDIMLEN
logical,dimension(knaf) :: gtimedep_in, gtimedep_out
CHARACTER(LEN=:), ALLOCATABLE :: YTAB0D
INTEGER, DIMENSION(:), ALLOCATABLE :: ITAB1D, ITAB1D2
INTEGER, DIMENSION(:,:), ALLOCATABLE :: ITAB2D, ITAB2D2
INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: ITAB3D, ITAB3D2
LOGICAL, DIMENSION(:), ALLOCATABLE :: GTAB1D
REAL, DIMENSION(:), ALLOCATABLE :: XTAB1D, XTAB1D2
REAL, DIMENSION(:,:), ALLOCATABLE :: XTAB2D, XTAB2D2
REAL, DIMENSION(:,:,:), ALLOCATABLE :: XTAB3D, XTAB3D2
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XTAB4D, XTAB4D2
TYPE(DATE_TIME) :: TZDATE
TYPE(TFILEDATA) :: TZFILE
CALL PRINT_MSG(NVERB_DEBUG,'IO','fill_files','called')
! For versions of MesoNH <5.4.0, fields were not stored with a time dimension
! ->necessary to remove it when reading and to restore to the correct one when writing
if( infiles(1)%TFILE%NMNHVERSION(1)<5 .OR. &
(infiles(1)%TFILE%NMNHVERSION(1)==5 .AND. infiles(1)%TFILE%NMNHVERSION(2)<4) ) then
gtimedep_in(:) = .false.
else
gtimedep_in(:) = tpreclist(:)%TFIELD%LTIMEDEP
end if
gtimedep_out(:) = tpreclist(:)%TFIELD%LTIMEDEP
IF (options(OPTREDUCE)%set) THEN idx = 1
type_float = NF90_REAL DO ji=1,knaf
ELSE IF (.NOT.tpreclist(ji)%tbw) CYCLE
type_float = NF90_DOUBLE
END IF
DO ji = 1,nbfiles IDIMS = tpreclist(ji)%TFIELD%NDIMS
kcdf_id = outfiles%files(ji)%lun_id
! global attributes SELECT CASE(tpreclist(ji)%TFIELD%NTYPE)
status = NF90_PUT_ATT(kcdf_id,NF90_GLOBAL,'Title',VERSION_ID) CASE (TYPEINT)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__) IDIMLEN(1:IDIMS) = tpreclist(ji)%TDIMS(1:IDIMS)%nlen
! define DIMENSIONS IF (.NOT.tpreclist(ji)%calc) THEN
tzdim=>first_DimCDF() INSRC = 1
DO WHILE(ASSOCIATED(tzdim)) ISRC = ji
IF (tzdim%create) THEN ELSE
status = NF90_DEF_DIM(kcdf_id,tzdim%name,tzdim%len,tzdim%id) INSRC = tpreclist(ji)%NSRC
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__) ISRC = tpreclist(ji)%src(1)
END IF END IF
tzdim=>tzdim%next
END DO
END DO
PRINT *,'------------- NetCDF DEFINITION ---------------' tpreclist(ISRC)%TFIELD%LTIMEDEP = gtimedep_in(ISRC)
SELECT CASE(IDIMS)
CASE (0)
ALLOCATE(ITAB1D(1))
IF (tpreclist(ji)%calc) ALLOCATE(ITAB1D2(1))
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB1D(1))
CASE (1)
ALLOCATE(ITAB1D(IDIMLEN(1)))
IF (tpreclist(ji)%calc) ALLOCATE(ITAB1D2(IDIMLEN(1)))
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB1D)
CASE (2)
ALLOCATE(ITAB2D(IDIMLEN(1),IDIMLEN(2)))
IF (tpreclist(ji)%calc) ALLOCATE(ITAB2D2(IDIMLEN(1),IDIMLEN(2)))
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB2D)
CASE (3)
ALLOCATE(ITAB3D(IDIMLEN(1),IDIMLEN(2),IDIMLEN(3)))
IF (tpreclist(ji)%calc) ALLOCATE(ITAB3D2(IDIMLEN(1),IDIMLEN(2),IDIMLEN(3)))
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB3D)
CASE DEFAULT
CALL PRINT_MSG(NVERB_WARNING,'IO','fill_files','too many dimensions for ' &
//TRIM(tpreclist(ISRC)%name)//' => ignored')
CYCLE
END SELECT
DO JJ=2,INSRC
ISRC = tpreclist(ji)%src(jj)
tpreclist(ISRC)%TFIELD%LTIMEDEP = gtimedep_in(ISRC)
SELECT CASE(IDIMS)
CASE (0)
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB1D2(1))
ITAB1D(1) = ITAB1D(1) + ITAB1D2(1)
CASE (1)
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB1D2)
ITAB1D(:) = ITAB1D(:) + ITAB1D2(:)
CASE (2)
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB2D2)
ITAB2D(:,:) = ITAB2D(:,:) + ITAB2D2(:,:)
CASE (3)
CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,ITAB3D2)
ITAB3D(:,:,:) = ITAB3D(:,:,:) + ITAB3D2(:,:,:)
END SELECT
END DO
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_out(ji)
SELECT CASE(IDIMS)
CASE (0)
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,ITAB1D(1))
DEALLOCATE(ITAB1D)
IF (tpreclist(ji)%calc) DEALLOCATE(ITAB1D2)
CASE (1)
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,ITAB1D)
DEALLOCATE(ITAB1D)
IF (tpreclist(ji)%calc) DEALLOCATE(ITAB1D2)
CASE (2)
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,ITAB2D)
DEALLOCATE(ITAB2D)
IF (tpreclist(ji)%calc) DEALLOCATE(ITAB2D2)
CASE (3)
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,ITAB3D)
DEALLOCATE(ITAB3D)
IF (tpreclist(ji)%calc) DEALLOCATE(ITAB3D2)
END SELECT
CASE (TYPELOG)
IDIMLEN(1:IDIMS) = tpreclist(ji)%TDIMS(1:IDIMS)%nlen
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_in(ji)
SELECT CASE(IDIMS)
CASE (0)
ALLOCATE(GTAB1D(1))
CALL IO_Field_read (INFILES(1)%TFILE, tpreclist(ji)%TFIELD,GTAB1D(1))
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_out(ji)
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,GTAB1D(1))
DEALLOCATE(GTAB1D)
CASE (1)
ALLOCATE(GTAB1D(IDIMLEN(1)))
CALL IO_Field_read (INFILES(1)%TFILE, tpreclist(ji)%TFIELD,GTAB1D)
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_out(ji)
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,GTAB1D)
DEALLOCATE(GTAB1D)
CASE DEFAULT
CALL PRINT_MSG(NVERB_WARNING,'IO','fill_files','too many dimensions for ' &
//TRIM(tpreclist(ji)%name)//' => ignored')
CYCLE
END SELECT
CASE (TYPEREAL)
IDIMLEN(1:IDIMS) = tpreclist(ji)%TDIMS(1:IDIMS)%nlen
IF (.NOT.tpreclist(ji)%calc) THEN
INSRC = 1
ISRC = ji
ELSE
INSRC = tpreclist(ji)%NSRC
ISRC = tpreclist(ji)%src(1)
END IF
! define VARIABLES and ATTRIBUTES tpreclist(ISRC)%TFIELD%LTIMEDEP = gtimedep_in(ISRC)
idx = 1 SELECT CASE(IDIMS)
DO ji=1,nbvar CASE (0)
IF (.NOT.tpreclist(ji)%tbw) CYCLE ALLOCATE(XTAB1D(1))
IF (tpreclist(ji)%calc) ALLOCATE(XTAB1D2(1))
IF (ASSOCIATED(tpreclist(ji)%dim)) THEN CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB1D(1))
IF (tpreclist(ji)%dim%create) THEN CASE (1)
invdims = 1 ALLOCATE(XTAB1D(IDIMLEN(1)))
ivdims(1) = tpreclist(ji)%dim%id IF (tpreclist(ji)%calc) ALLOCATE(XTAB1D2(IDIMLEN(1)))
ELSE CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB1D)
invdims = tpreclist(ji)%dim%ndims CASE (2)
IF(options(OPTMERGE)%set) invdims=invdims+1 !when merging variables from LFI splitted files ALLOCATE(XTAB2D(IDIMLEN(1),IDIMLEN(2)))
SELECT CASE(invdims) IF (tpreclist(ji)%calc) ALLOCATE(XTAB2D2(IDIMLEN(1),IDIMLEN(2)))
CASE(2) CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB2D)
ivdims(1)=ptdimx%id CASE (3)
ivdims(2)=ptdimy%id ALLOCATE(XTAB3D(IDIMLEN(1),IDIMLEN(2),IDIMLEN(3)))
CASE(3) IF (tpreclist(ji)%calc) ALLOCATE(XTAB3D2(IDIMLEN(1),IDIMLEN(2),IDIMLEN(3)))
ivdims(1)=ptdimx%id !Hack not very clean: 3D LB fields are not split
ivdims(2)=ptdimy%id !If NSUBFILES_IOZ is set to 0, IO_Field_read will read it as a non-split field
ivdims(3)=ptdimz%id !CAUTION: there are no guarantee the IO_Field_read will continue to use this information that way...
CASE(12) if ( tpreclist(ji)%tfield%clbtype /= 'NONE' .or. tpreclist(ji)%name(1:2) == 'LB' ) then
ivdims(1)=ptdimx%id tzfile = infiles(1)%tfile
ivdims(2)=ptdimz%id tzfile%nsubfiles_ioz=0
invdims = 2 ! on retablit la bonne valeur du nbre de dimension call IO_Field_read(tzfile,tpreclist(isrc)%tfield,xtab3d)
CASE default else
PRINT *,'Fatal error in NetCDF dimension definition' call IO_Field_read(infiles(1)%tfile,tpreclist(isrc)%tfield,xtab3d)
STOP end if
END SELECT CASE (4)
END IF ALLOCATE(XTAB4D(IDIMLEN(1),IDIMLEN(2),IDIMLEN(3),IDIMLEN(4)))
ELSE IF (tpreclist(ji)%calc) ALLOCATE(XTAB4D2(IDIMLEN(1),IDIMLEN(2),IDIMLEN(3),IDIMLEN(4)))
! scalar variables CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB4D)
invdims = 0 CASE DEFAULT
ivdims(1) = 0 ! ignore dans ce cas CALL PRINT_MSG(NVERB_WARNING,'IO','fill_files','too many dimensions for ' &
END IF //TRIM(tpreclist(ISRC)%name)//' => ignored')
CYCLE
! Variables definition END SELECT
!! NetCDF n'aime pas les '%' dans le nom des variables DO JJ=2,INSRC
!! "%" remplaces par '__' ISRC = tpreclist(ji)%src(jj)
ycdfvar = str_replace(tpreclist(ji)%name,'%','__') tpreclist(ISRC)%TFIELD%LTIMEDEP = gtimedep_in(ISRC)
!! ni les '.' remplaces par '--'
ycdfvar = str_replace(ycdfvar,'.','--') SELECT CASE(IDIMS)
CASE (0)
kcdf_id = outfiles%files(idx)%lun_id CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB1D2(1))
XTAB1D(1) = XTAB1D(1) + XTAB1D2(1)
SELECT CASE(tpreclist(ji)%TYPE) CASE (1)
CASE (TEXT) CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB1D2)
! PRINT *,'TEXT : ',tpreclist(ji)%name XTAB1D(:) = XTAB1D(:) + XTAB1D2(:)
status = NF90_DEF_VAR(kcdf_id,ycdfvar,NF90_CHAR,& CASE (2)
ivdims(:invdims),tpreclist(ji)%id_out) CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB2D2)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__) XTAB2D(:,:) = XTAB2D(:,:) + XTAB2D2(:,:)
CASE (3)
CASE (INT,BOOL) CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB3D2)
! PRINT *,'INT,BOOL : ',tpreclist(ji)%name XTAB3D(:,:,:) = XTAB3D(:,:,:) + XTAB3D2(:,:,:)
status = NF90_DEF_VAR(kcdf_id,ycdfvar,NF90_INT,& CASE (4)
ivdims(:invdims),tpreclist(ji)%id_out) CALL IO_Field_read(INFILES(1)%TFILE,tpreclist(ISRC)%TFIELD,XTAB4D2)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__) XTAB4D(:,:,:,:) = XTAB4D(:,:,:,:) + XTAB4D2(:,:,:,:)
END SELECT
CASE(FLOAT) END DO
! PRINT *,'FLOAT : ',tpreclist(ji)%name
status = NF90_DEF_VAR(kcdf_id,ycdfvar,type_float,& tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_out(ji)
ivdims(:invdims),tpreclist(ji)%id_out) SELECT CASE(IDIMS)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__) CASE (0)
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,XTAB1D(1))
DEALLOCATE(XTAB1D)
CASE default IF (tpreclist(ji)%calc) DEALLOCATE(XTAB1D2)
PRINT *,'ATTENTION : ',TRIM(tpreclist(ji)%name),' est de& CASE (1)
& TYPE inconnu --> force a REAL' CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,XTAB1D)
status = NF90_DEF_VAR(kcdf_id,ycdfvar,type_float,& DEALLOCATE(XTAB1D)
ivdims(:invdims),tpreclist(ji)%id_out) IF (tpreclist(ji)%calc) DEALLOCATE(XTAB1D2)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__) CASE (2)
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,XTAB2D)
DEALLOCATE(XTAB2D)
END SELECT IF (tpreclist(ji)%calc) DEALLOCATE(XTAB2D2)
CASE (3)
! Compress data (costly operation for the CPU) CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,XTAB3D)
IF (options(OPTCOMPRESS)%set .AND. invdims>0) THEN DEALLOCATE(XTAB3D)
compress_level = options(OPTCOMPRESS)%ivalue IF (tpreclist(ji)%calc) DEALLOCATE(XTAB3D2)
status = NF90_DEF_VAR_DEFLATE(kcdf_id,tpreclist(ji)%id_out,1,1,compress_level) CASE (4)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__) CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,XTAB4D)
END IF 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
! GRID attribute definition ALLOCATE(CHARACTER(LEN=tpreclist(ji)%NSIZE)::YTAB0D)
status = NF90_PUT_ATT(kcdf_id,tpreclist(ji)%id_out,'GRID',tpreclist(ji)%grid) tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_in(ji)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__) CALL IO_Field_read (INFILES(1)%TFILE, tpreclist(ji)%TFIELD,YTAB0D)
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_out(ji)
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,YTAB0D)
DEALLOCATE(YTAB0D)
! 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 CASE (TYPEDATE)
END DO ISRC = ji
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 SUBROUTINE def_ncdf IF (IDIMS/=0) THEN
CALL PRINT_MSG(NVERB_WARNING,'IO','fill_files','too many dimensions for ' &
//TRIM(tpreclist(ISRC)%name)//' => ignored')
CYCLE
END IF
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_in(ji)
CALL IO_Field_read (INFILES(1)%TFILE, tpreclist(ji)%TFIELD%CMNHNAME,TZDATE)
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_out(ji)
CALL IO_Field_write(outfiles(idx)%TFILE,tpreclist(ji)%TFIELD,TZDATE)
SUBROUTINE fill_ncdf(infiles,outfiles,tpreclist,knaf,kbuflen,options,current_level)
TYPE(filelist_struct), INTENT(IN):: infiles, outfiles
TYPE(workfield), DIMENSION(:),INTENT(IN):: tpreclist
INTEGER, INTENT(IN):: knaf
INTEGER, INTENT(IN):: kbuflen
TYPE(option),DIMENSION(:), INTENT(IN):: options
INTEGER, INTENT(IN), OPTIONAL :: current_level
#ifdef LOWMEM CASE default
INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: iwork ISRC = ji
#endif
INTEGER :: idx, ji,jj
INTEGER :: kcdf_id
INTEGER :: status
INTEGER :: extent, ndims
INTEGER :: ich
INTEGER :: src
INTEGER :: level
INTEGER(KIND=LFI_INT) :: iresp,ilu,ileng,ipos
CHARACTER(LEN=4) :: suffix
INTEGER,DIMENSION(3) :: idims, start
INTEGER,DIMENSION(:),ALLOCATABLE :: itab
REAL(KIND=8),DIMENSION(:),ALLOCATABLE :: xtab
CHARACTER, DIMENSION(:), ALLOCATABLE :: ytab
REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: xtab3d, xtab3d2
INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: itab3d, itab3d2
CALL PRINT_MSG(NVERB_WARNING,'IO','fill_files','invalid datatype for ' &
//TRIM(tpreclist(ISRC)%name)//' => ignored')
END SELECT
if (options(OPTSPLIT)%set) idx = idx + 1
END DO
END SUBROUTINE fill_files
SUBROUTINE OPEN_FILES(infiles,outfiles,KNFILES_OUT,hinfile,houtfile,nbvar_infile,options,runmode)
USE MODD_CONF, ONLY: LCARTESIAN
USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
USE MODD_CONFZ, ONLY: NB_PROCIO_R
USE MODD_DIM_n, ONLY: NIMAX_ll, NJMAX_ll, NKMAX
USE MODD_GRID, ONLY: XBETA, XRPK, XLAT0, XLON0, XLATORI, XLONORI
USE MODD_GRID_n, ONLY: LSLEVE, XXHAT, XXHATM, XYHAT, XYHATM, XZHAT, XZHATM, &
XXHAT_ll, XYHAT_ll, XXHATM_ll, XYHATM_ll
USE MODD_IO, ONLY: LIOCDF4
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
USE MODD_PARAMETERS_ll, ONLY: JPHEXT_ll=>JPHEXT, JPVEXT_ll=>JPVEXT
USE MODD_TIME_n, ONLY: TDTCUR, TDTMOD
USE MODE_IO_FILE, ONLY: IO_FILE_OPEN, IO_FILE_CLOSE
USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST
USE MODE_SET_GRID, ONLY: INTERP_VERGRID_TO_MASSPOINTS
TYPE(TFILE_ELT),DIMENSION(:),INTENT(OUT) :: infiles
TYPE(TFILE_ELT),DIMENSION(:),INTENT(OUT) :: outfiles
INTEGER, INTENT(OUT) :: KNFILES_OUT
CHARACTER(LEN=*), INTENT(IN) :: hinfile
CHARACTER(LEN=*), INTENT(IN) :: houtfile
INTEGER, INTENT(OUT) :: nbvar_infile
TYPE(option),DIMENSION(:), INTENT(IN) :: options
INTEGER, INTENT(IN) :: runmode
character(len=:), allocatable :: yunits
INTEGER :: idx, IRESP2
integer :: iiu, iju, iku
integer :: inb_procio_r_save
INTEGER(KIND=CDFINT) :: ioldmode
INTEGER(KIND=CDFINT) :: istatus
INTEGER(KIND=CDFINT) :: ivar_id
integer(kind=CDFINT) :: ilen
INTEGER(KIND=LFIINT) :: ilu,iresp
logical :: gok
CALL PRINT_MSG(NVERB_DEBUG,'IO','OPEN_FILES','called')
KNFILES_OUT = 0
! !
IF (infiles%files(1)%format == LFI_FORMAT) ilu = infiles%files(1)%lun_id ! 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)
IF (present(current_level)) THEN ilu = INFILES(1)%TFILE%NLFIFLU
write(suffix,'(I4.4)') current_level
level = current_level
ElSE
suffix=''
level = 1
END IF
#if LOWMEM
ALLOCATE(iwork(kbuflen))
#endif
ALLOCATE(itab(kbuflen))
ALLOCATE(xtab(kbuflen))
idx = 1
DO ji=1,knaf
IF (.NOT.tpreclist(ji)%tbw) CYCLE
kcdf_id = outfiles%files(idx)%lun_id nbvar_infile = INFILES(1)%TFILE%NLFININAR
IF (ASSOCIATED(tpreclist(ji)%dim)) THEN IF (options(OPTLIST)%set) THEN
extent = tpreclist(ji)%dim%len CALL LFILAF(iresp,ilu,lfalse)
ndims = tpreclist(ji)%dim%ndims CALL IO_FILE_CLOSE(INFILES(1)%TFILE)
ELSE return
extent = 1
ndims = 0
END IF END IF
idims(:) = 1 !Open fallback file if provided
if(ndims>0) idims(1) = ptdimx%len if ( options( OPTFALLBACK )%set ) then
if(ndims>1) idims(2) = ptdimy%len inb_procio_r_save = NB_PROCIO_R
if(ndims>2) idims(3) = ptdimz%len NB_PROCIO_R = 1
if(ndims>3) then CALL IO_FILE_ADD2LIST(INFILES(2)%TFILE,options( OPTFALLBACK )%cvalue,'UNKNOWN','READ', &
PRINT *,'Too many dimensions' HFORMAT='LFI',KLFIVERB=0)
STOP CALL IO_FILE_OPEN(INFILES(2)%TFILE)
endif NB_PROCIO_R = inb_procio_r_save
end if
SELECT CASE(tpreclist(ji)%TYPE) END IF
CASE (INT,BOOL) !
IF (infiles%files(1)%format == LFI_FORMAT) THEN !Read problem dimensions and some grid variables (needed to determine domain size and also by IO_FILE_OPEN to create netCDF files)
#if LOWMEM JPHEXT = 1
IF (.NOT.tpreclist(ji)%calc) THEN CALL IO_Field_read(INFILES(1)%TFILE,'JPHEXT',JPHEXT,IRESP2)
CALL LFINFO(iresp,ilu,trim(tpreclist(ji)%name)//trim(suffix),ileng,ipos) !If not found in main file, try the fallback one
CALL LFILEC(iresp,ilu,trim(tpreclist(ji)%name)//trim(suffix),iwork,ileng) if ( options( OPTFALLBACK )%set .and. iresp2 /= 0 ) CALL IO_Field_read(INFILES(2)%TFILE,'JPHEXT',JPHEXT,IRESP2)
itab(1:extent) = iwork(3+iwork(2):3+iwork(2)+extent-1) if ( iresp2 /= 0 ) call Print_msg( NVERB_ERROR, 'IO', 'OPEN_FILES', 'JPHEXT not found')
ELSE
src=tpreclist(ji)%src(1) JPHEXT_ll = JPHEXT
CALL LFINFO(iresp,ilu,trim(tpreclist(src)%name)//trim(suffix),ileng,ipos) JPVEXT_ll = JPVEXT
CALL LFILEC(iresp,ilu,trim(tpreclist(src)%name)//trim(suffix),iwork,ileng) !
itab(1:extent) = iwork(3+iwork(2):3+iwork(2)+extent-1) ALLOCATE(NIMAX_ll,NJMAX_ll,NKMAX)
jj = 2 CALL IO_Field_read(INFILES(1)%TFILE,'IMAX',NIMAX_ll,IRESP2)
DO WHILE (tpreclist(ji)%src(jj)>0 .AND. jj.LE.MAXRAW) !If not found in main file, try the fallback one
src=tpreclist(ji)%src(jj) if ( options( OPTFALLBACK )%set .and. iresp2 /= 0 ) CALL IO_Field_read(INFILES(2)%TFILE,'IMAX',NIMAX_ll,IRESP2)
CALL LFILEC(iresp,ilu,trim(tpreclist(src)%name)//trim(suffix),iwork,ileng) if ( iresp2 /= 0 ) call Print_msg( NVERB_ERROR, 'IO', 'OPEN_FILES', 'IMAX not found')
itab(1:extent) = itab(1:extent) + iwork(3+iwork(2):3+iwork(2)+extent-1)
jj=jj+1 CALL IO_Field_read(INFILES(1)%TFILE,'JMAX',NJMAX_ll,IRESP2)
END DO !If not found in main file, try the fallback one
ENDIF if ( options( OPTFALLBACK )%set .and. iresp2 /= 0 ) CALL IO_Field_read(INFILES(2)%TFILE,'JMAX',NJMAX_ll,IRESP2)
#else if ( iresp2 /= 0 ) call Print_msg( NVERB_ERROR, 'IO', 'OPEN_FILES', 'JMAX not found')
IF (.NOT.tpreclist(ji)%calc) THEN
itab(1:extent) = lfiart(ji)%iwtab(3+lfiart(ji)%iwtab(2):) CALL IO_Field_read(INFILES(1)%TFILE,'KMAX',NKMAX,IRESP2)
ELSE !If not found in main file, try the fallback one
src=tpreclist(ji)%src(1) if ( options( OPTFALLBACK )%set .and. iresp2 /= 0 ) CALL IO_Field_read(INFILES(2)%TFILE,'KMAX',NKMAX,IRESP2)
itab(1:extent) = lfiart(src)%iwtab(3+lfiart(src)%iwtab(2):) IF (IRESP2/=0) NKMAX = 0
jj = 2 !
DO WHILE (tpreclist(ji)%src(jj)>0 .AND. jj.LE.MAXRAW) CALL IO_Field_read(INFILES(1)%TFILE,'PROGRAM',CPROGRAM_ORIG,IRESP2)
src=tpreclist(ji)%src(jj) !If not found in main file, try the fallback one
itab(1:extent) = xtab(1:extent) + lfiart(src)%iwtab(3+lfiart(src)%iwtab(2):) if ( options( OPTFALLBACK )%set .and. iresp2 /= 0 ) CALL IO_Field_read(INFILES(2)%TFILE,'PROGRAM',CPROGRAM_ORIG,IRESP2)
jj=jj+1 if ( iresp2 /= 0 ) call Print_msg( NVERB_ERROR, 'IO', 'OPEN_FILES', 'PROGRAM not found')
END DO !
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
KNFILES_OUT = KNFILES_OUT + 1
idx = KNFILES_OUT
if ( options(OPTDIR)%set ) then
CALL IO_FILE_ADD2LIST(outfiles(idx)%TFILE,HOUTFILE,'MNH','WRITE', &
HFORMAT='NETCDF4',OOLD=.TRUE., hdirname = options(OPTDIR)%cvalue )
else
CALL IO_FILE_ADD2LIST(outfiles(idx)%TFILE,HOUTFILE,'MNH','WRITE', &
HFORMAT='NETCDF4',OOLD=.TRUE.)
end if
CALL IO_FILE_OPEN(outfiles(idx)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)
IF (options(OPTCOMPRESS)%set) THEN
outfiles(idx)%tfile%LNCCOMPRESS = .TRUE.
outfiles(idx)%tfile%NNCCOMPRESS_LEVEL = options(OPTCOMPRESS)%ivalue
END IF END IF
#endif
!TODO: works in all cases??? (X, Y, Z dimensions assumed to be ptdimx,y or z) IF (options(OPTREDUCE)%set) THEN
SELECT CASE(ndims) outfiles(idx)%tfile%LNCREDUCE_FLOAT_PRECISION = .TRUE.
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 END IF
!TODO: not clean, should be done only if merging z-levels istatus = NF90_SET_FILL(outfiles(idx)%TFILE%NNCID,NF90_NOFILL,ioldmode)
IF (ndims == 2) THEN if ( istatus /= NF90_NOERR ) call IO_Err_handle_nc4( istatus, 'OPEN_FILES', 'NF90_SET_FILL', '' )
start = (/1,1,level/) END IF ! .NOT.osplit
ELSE ELSE
start = (/1,1,1/) !
ENDIF ! LFI
status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id_out,itab3d,start=start) !
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__) KNFILES_OUT = KNFILES_OUT + 1
idx = KNFILES_OUT
DEALLOCATE(itab3d) if ( options(OPTDIR)%set ) then
END IF CALL IO_FILE_ADD2LIST(outfiles(idx)%TFILE,houtfile,'MNH','WRITE', &
HFORMAT='LFI',KLFIVERB=0,OOLD=.TRUE., hdirname = options(OPTDIR)%cvalue )
else
CASE (FLOAT) CALL IO_FILE_ADD2LIST(outfiles(idx)%TFILE,houtfile,'MNH','WRITE', &
IF (infiles%files(1)%format == LFI_FORMAT) THEN HFORMAT='LFI',KLFIVERB=0,OOLD=.TRUE.)
#if LOWMEM end if
IF (.NOT.tpreclist(ji)%calc) THEN LIOCDF4 = .FALSE. !Necessary to open correctly the LFI file
CALL LFINFO(iresp,ilu,trim(tpreclist(ji)%name)//trim(suffix),ileng,ipos) CALL IO_FILE_OPEN(outfiles(idx)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)
CALL LFILEC(iresp,ilu,trim(tpreclist(ji)%name)//trim(suffix),iwork,ileng) LIOCDF4 = .TRUE.
xtab(1:extent) = TRANSFER(iwork(3+iwork(2):),(/ 0.0_8 /)) END IF
ELSE !
src=tpreclist(ji)%src(1) ! Create a dummy netCDF file necessary to manage correctly the netCDF dims
CALL LFINFO(iresp,ilu,trim(tpreclist(src)%name)//trim(suffix),ileng,ipos) IF (runmode == MODECDF2LFI) THEN
CALL LFILEC(iresp,ilu,trim(tpreclist(src)%name)//trim(suffix),iwork,ileng) KNFILES_OUT = KNFILES_OUT + 1
xtab(1:extent) = TRANSFER(iwork(3+iwork(2):),(/ 0.0_8 /))
jj = 2 idx = KNFILES_OUT
DO WHILE (tpreclist(ji)%src(jj)>0 .AND. jj.LE.MAXRAW) if ( options(OPTDIR)%set ) then
src=tpreclist(ji)%src(jj) CALL IO_FILE_ADD2LIST(outfiles(idx)%TFILE,'dummy_file','MNH','WRITE', &
CALL LFILEC(iresp,ilu,trim(tpreclist(src)%name)//trim(suffix),iwork,ileng) HFORMAT='NETCDF4',OOLD=.TRUE., hdirname = options(OPTDIR)%cvalue )
xtab(1:extent) = xtab(1:extent) + TRANSFER(iwork(3+iwork(2):),(/ 0.0_8 /)) else
jj=jj+1 CALL IO_FILE_ADD2LIST(outfiles(idx)%TFILE,'dummy_file','MNH','WRITE', &
END DO HFORMAT='NETCDF4',OOLD=.TRUE.)
ENDIF end if
#else CALL IO_FILE_OPEN(outfiles(idx)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)
IF (.NOT.tpreclist(ji)%calc) THEN END IF
xtab(1:extent) = TRANSFER(lfiart(ji)%iwtab(3+lfiart(ji)%iwtab(2):),(/ 0.0_8 /))
ELSE call Print_msg( NVERB_INFO, 'IO', 'parse_infiles', '--> Converted to file: ' // trim(houtfile) )
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 END SUBROUTINE OPEN_FILES
IF (ndims == 2) THEN
start = (/1,1,level/)
ELSE
start = (/1,1,1/)
ENDIF
status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id_out,xtab3d,start=start)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
DEALLOCATE(xtab3d) SUBROUTINE OPEN_SPLIT_NCFILES_OUT(outfiles,KNFILES_OUT,houtfile,nbvar,options)
END IF USE MODE_IO_FILE, ONLY: IO_FILE_OPEN
USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST
CASE (TEXT) TYPE(TFILE_ELT),DIMENSION(:), INTENT(INOUT) :: outfiles
IF (infiles%files(1)%format == LFI_FORMAT) THEN INTEGER, INTENT(OUT) :: KNFILES_OUT
#if LOWMEM CHARACTER(LEN=*), INTENT(IN) :: houtfile
CALL LFINFO(iresp,ilu,trim(tpreclist(ji)%name)//trim(suffix),ileng,ipos) INTEGER, INTENT(IN) :: nbvar
CALL LFILEC(iresp,ilu,trim(tpreclist(ji)%name)//trim(suffix),iwork,ileng) TYPE(option),DIMENSION(:), INTENT(IN) :: options
#endif
ALLOCATE(ytab(extent))
DO jj=1,extent
#if LOWMEM
ich = iwork(2+iwork(2)+jj)
#else
ich = lfiart(ji)%iwtab(2+lfiart(ji)%iwtab(2)+jj)
#endif
ytab(jj) = CHAR(ich)
END DO
status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id_out,ytab,count=(/extent/))
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
DEALLOCATE(ytab)
ELSE IF (infiles%files(1)%format == NETCDF_FORMAT) THEN
status = NF90_GET_VAR(infiles%files(1)%lun_id,tpreclist(ji)%id_in,ytab,count=(/extent/))
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id_out,ytab,count=(/extent/))
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
END IF
CASE default CHARACTER(LEN=:),ALLOCATABLE :: filename
IF (infiles%files(1)%format == LFI_FORMAT) THEN CHARACTER(LEN=:),ALLOCATABLE :: YLIST
#if LOWMEM CHARACTER(LEN=NMNHNAMELGTMAX),DIMENSION(nbvar) :: YVARS
IF (.NOT.tpreclist(ji)%calc) THEN INTEGER :: ji
CALL LFINFO(iresp,ilu,trim(tpreclist(ji)%name)//trim(suffix),ileng,ipos) INTEGER :: idx1, idx2
CALL LFILEC(iresp,ilu,trim(tpreclist(ji)%name)//trim(suffix),iwork,ileng) INTEGER(KIND=CDFINT) :: status
xtab(1:extent) = TRANSFER(iwork(3+iwork(2):),(/ 0.0_8 /)) INTEGER(KIND=CDFINT) :: ioldmode
ELSE
src=tpreclist(ji)%src(1) CALL PRINT_MSG(NVERB_DEBUG,'IO','OPEN_SPLIT_NCFILES_OUT','called')
CALL LFINFO(iresp,ilu,trim(tpreclist(src)%name)//trim(suffix),ileng,ipos)
CALL LFILEC(iresp,ilu,trim(tpreclist(src)%name)//trim(suffix),iwork,ileng) KNFILES_OUT = nbvar
xtab(1:extent) = TRANSFER(iwork(3+iwork(2):),(/ 0.0_8 /)) YLIST = TRIM(options(OPTVAR)%cvalue)
jj = 2
DO WHILE (tpreclist(ji)%src(jj)>0 .AND. jj.LE.MAXRAW) DO ji = 1,nbvar-1
src=tpreclist(ji)%src(jj) idx1 = INDEX(YLIST,',')
CALL LFILEC(iresp,ilu,trim(tpreclist(src)%name)//trim(suffix),iwork,ileng) idx2 = INDEX(YLIST,'=')
xtab(1:extent) = xtab(1:extent) + TRANSFER(iwork(3+iwork(2):),(/ 0.0_8 /)) IF (idx1/=0) THEN
jj=jj+1 IF (idx2/=0 .AND. idx2<idx1) THEN
END DO YVARS(ji) = YLIST(1:idx2-1)
ENDIF ELSE
#else YVARS(ji) = YLIST(1:idx1-1)
IF (.NOT.tpreclist(ji)%calc) THEN
xtab(1:extent) = TRANSFER(lfiart(ji)%iwtab(3+lfiart(ji)%iwtab(2):),(/ 0.0_8 /))
ELSE
src=tpreclist(ji)%src(1)
xtab(1:extent) = TRANSFER(lfiart(src)%iwtab(3+lfiart(src)%iwtab(2):),(/ 0.0_8 /))
jj = 2
DO WHILE (tpreclist(ji)%src(jj)>0 .AND. jj.LE.MAXRAW)
src=tpreclist(ji)%src(jj)
xtab(1:extent) = xtab(1:extent) + TRANSFER(lfiart(src)%iwtab(3+lfiart(src)%iwtab(2):),(/ 0.0_8 /))
jj=jj+1
END DO
END IF
#endif
!TODO: works in all cases??? (X, Y, Z dimensions assumed to be ptdimx,y or z)
SELECT CASE(ndims)
CASE (0)
status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id_out,xtab(1))
CASE (1)
status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id_out,xtab(1:extent),count=(/extent/))
CASE (2)
status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id_out,reshape(xtab,(/ptdimx%len,ptdimy%len/)), &
start = (/1,1,level/) )
CASE (3)
status = NF90_PUT_VAR(kcdf_id,tpreclist(ji)%id_out,reshape(xtab,(/ptdimx%len,ptdimy%len,ptdimz%len/)))
CASE DEFAULT
print *,'Error: arrays with ',tpreclist(ji)%dim%ndims,' dimensions are not supported'
END SELECT
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
ELSE IF (infiles%files(1)%format == NETCDF_FORMAT) THEN
print *,'Error: unknown datatype'
STOP
END IF END IF
YLIST = YLIST(idx1+1:)
END SELECT ELSE
CALL PRINT_MSG(NVERB_FATAL,'IO','OPEN_SPLIT_NCFILES_OUT','problem separating variable names')
if (options(OPTSPLIT)%set) idx = idx + 1 END IF
END DO END DO
DEALLOCATE(itab,xtab) idx2 = INDEX(YLIST,'=')
#if LOWMEM IF (idx2>0) THEN
DEALLOCATE(iwork) YVARS(nbvar) = YLIST(1:idx2-1)
#endif ELSE
END SUBROUTINE fill_ncdf YVARS(nbvar) = YLIST
END IF
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
kcdf_id = infiles%files(1)%lun_id
! Un article LFI est compose de :
! - 1 entier identifiant le numero de grille
! - 1 entier contenant la taille du commentaire
! - le commentaire code en entier 64 bits
! - les donnees proprement dites
PRINT *,'Taille buffer = ',2+kbuflen
ALLOCATE(iwork(2+kbuflen))
DO ivar=1,SIZE(tpreclist)
icomlen = LEN(tpreclist(ivar)%comment)
IF (icomlen > MAXLFICOMMENTLENGTH) THEN
PRINT *,'ERROR: comment length is too big. Please increase MAXLFICOMMENTLENGTH'
STOP
END IF
! traitement Grille et Commentaire DO ji = 1,nbvar
iwork(1) = tpreclist(ivar)%grid filename = trim(houtfile)//'.'//TRIM(YVARS(ji))
iwork(2) = icomlen if ( options(OPTDIR)%set ) then
DO jj=1,iwork(2) CALL IO_FILE_ADD2LIST(outfiles(ji)%TFILE,filename,'MNH','WRITE', &
iwork(2+jj)=ICHAR(tpreclist(ivar)%comment(jj:jj)) HFORMAT='NETCDF4', hdirname = options(OPTDIR)%cvalue )
END DO 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
IF (ASSOCIATED(tpreclist(ivar)%dim)) THEN IF (options(OPTREDUCE)%set) THEN
idlen = tpreclist(ivar)%dim%len outfiles(ji)%tfile%LNCREDUCE_FLOAT_PRECISION = .TRUE.
ndims = tpreclist(ivar)%dim%ndims END IF
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)
status = NF90_SET_FILL(outfiles(ji)%TFILE%NNCID,NF90_NOFILL,ioldmode)
if ( status /= NF90_NOERR ) call IO_Err_handle_nc4( status, 'OPEN_SPLIT_NCFILES_OUT', 'NF90_SET_FILL', '' )
END DO END DO
DEALLOCATE(iwork)
END SUBROUTINE build_lfi END SUBROUTINE OPEN_SPLIT_NCFILES_OUT
SUBROUTINE UPDATE_VARID_IN(infiles,hinfile,tpreclist,nbvar,current_level) SUBROUTINE CLOSE_FILES(filelist,KNFILES)
!Update the id_in for netCDF files (could change from one file to the other) USE MODE_IO_FILE, ONLY: IO_FILE_CLOSE
TYPE(filelist_struct), INTENT(IN) :: infiles
CHARACTER(LEN=*), INTENT(IN) :: hinfile
TYPE(workfield), DIMENSION(:), INTENT(INOUT) :: tpreclist
INTEGER, INTENT(IN) :: nbvar
INTEGER, INTENT(IN) :: current_level
INTEGER :: ji, status
CHARACTER(len=4) :: suffix
TYPE(TFILE_ELT),DIMENSION(:),INTENT(INOUT) :: filelist
INTEGER, INTENT(IN) :: KNFILES
INTEGER :: ji
if (infiles%files(1)%format /= NETCDF_FORMAT) return
write(suffix,'(I4.4)') current_level CALL PRINT_MSG(NVERB_DEBUG,'IO','CLOSE_FILES','called')
DO ji=1,nbvar DO ji=1,KNFILES
IF (.NOT.tpreclist(ji)%tbr) CYCLE IF (filelist(ji)%TFILE%LOPENED) CALL IO_FILE_CLOSE(filelist(ji)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)
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 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 END SUBROUTINE CLOSE_FILES
CALL LFILAF(iresp,ilu,lfalse)
CALL LFIFER(iresp,ilu,'KEEP')
return
END IF
IF (.NOT.options(OPTSPLIT)%set) THEN
outfiles%nbfiles = outfiles%nbfiles + 1
idx = outfiles%nbfiles
outfiles%files(idx)%format = NETCDF_FORMAT
outfiles%files(idx)%status = WRITING
IF (options(OPTCDF4)%set) THEN
status = NF90_CREATE(TRIM(houtfile)//'.nc4', IOR(NF90_CLOBBER,NF90_NETCDF4), outfiles%files(idx)%lun_id)
ELSE
status = NF90_CREATE(TRIM(houtfile)//'.nc', IOR(NF90_CLOBBER,NF90_64BIT_OFFSET), outfiles%files(idx)%lun_id)
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__)
SUBROUTINE IO_Metadata_get_nc4(TPFILE,KVAR_ID,TPREC)
USE MODD_DIM_n, ONLY: NKMAX
USE MODD_PARAMETERS, ONLY: JPVEXT
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
INTEGER(KIND=CDFINT), INTENT(IN) :: KVAR_ID
TYPE(workfield), INTENT(INOUT) :: TPREC
character(len=:), allocatable :: YSPLIT
character(len=:), allocatable :: YTIMEDEP
integer :: iblocks
INTEGER :: ILENG
INTEGER :: JDIM
INTEGER(KIND=CDFINT) :: ISTATUS
INTEGER(KIND=CDFINT) :: IFILE_ID
INTEGER(KIND=CDFINT) :: IVAR_ID
INTEGER(KIND=CDFINT),DIMENSION(NF90_MAX_VAR_DIMS) :: IDIMS_ID
LOGICAL :: GSPLIT_AT_ENTRY
LOGICAL :: GSPLIT_INFO_AVAILABLE
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Metadata_get_nc4','called')
!Necessary to know if we already are in a split file for determining correct number of dimensions
GSPLIT_AT_ENTRY = TPREC%LSPLIT
IFILE_ID = TPFILE%NNCID
iblocks = -1
ISTATUS = NF90_INQUIRE_VARIABLE(IFILE_ID, KVAR_ID, NDIMS = TPREC%NDIMS_FILE, &
XTYPE = TPREC%NTYPE_FILE, DIMIDS = IDIMS_ID)
if ( istatus /= NF90_NOERR ) call IO_Err_handle_nc4( istatus, 'IO_Metadata_get_nc4', 'NF90_INQUIRE_VARIABLE', '' )
!split_variable and other attributes were added in MesoNH > 5.4.2
GSPLIT_INFO_AVAILABLE = .FALSE.
ISTATUS = NF90_INQUIRE_ATTRIBUTE(IFILE_ID, KVAR_ID, 'split_variable', LEN=ILENG)
IF (ISTATUS == NF90_NOERR) THEN
GSPLIT_INFO_AVAILABLE = .TRUE.
IF (GSPLIT_AT_ENTRY) CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Metadata_get_nc4','split variable declaration inside a split file')
ALLOCATE(CHARACTER(LEN=ILENG) :: YSPLIT)
ISTATUS = NF90_GET_ATT(IFILE_ID, KVAR_ID, 'split_variable', YSPLIT)
IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4( istatus, 'IO_Metadata_get_nc4', 'NF90_GET_ATT', 'split_variable' )
IF ( YSPLIT == 'yes' ) then
TPREC%LSPLIT = .true.
ISTATUS = NF90_GET_ATT(IFILE_ID, KVAR_ID, 'ndims', TPREC%NDIMS_FILE)
IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4( istatus, 'IO_Metadata_get_nc4', 'NF90_GET_ATT', 'ndims' )
IF ( TPREC%NDIMS_FILE/=3 ) CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Metadata_get_nc4', &
'split variable with ndims/=3 not supported')
ISTATUS = NF90_INQUIRE_ATTRIBUTE(IFILE_ID, KVAR_ID, 'time_dependent', LEN=ILENG)
IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4( istatus, 'IO_Metadata_get_nc4', 'NF90_INQUIRE_ATTRIBUTE', &
'time_dependent' )
ALLOCATE(CHARACTER(LEN=ILENG) :: YTIMEDEP)
ISTATUS = NF90_GET_ATT(IFILE_ID, KVAR_ID, 'time_dependent', YTIMEDEP)
IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4( istatus, 'IO_Metadata_get_nc4', 'NF90_GET_ATT', 'time_dependent' )
IF ( YTIMEDEP == 'yes' ) then
TPREC%TFIELD%LTIMEDEP = .TRUE.
ELSE IF ( YTIMEDEP == 'no' ) THEN
TPREC%TFIELD%LTIMEDEP = .FALSE.
ELSE
CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Metadata_get_nc4','unknown value '//trim(YTIMEDEP)// &
' for time_dependent attribute' )
END IF
IF (.NOT.options(OPTSPLIT)%set) THEN ISTATUS = NF90_GET_ATT(IFILE_ID, KVAR_ID, 'split_nblocks', iblocks)
outfiles%nbfiles = outfiles%nbfiles + 1 IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4( istatus, 'IO_Metadata_get_nc4', 'NF90_GET_ATT', 'split_nblocks' )
idx = outfiles%nbfiles
IF (options(OPTCDF4)%set) THEN IFILE_ID = TPFILE%TFILES_IOZ(1)%TFILE%NNCID
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__) istatus = NF90_INQ_VARID(IFILE_ID,trim(TPREC%NAME)//'0001',ivar_id)
outfiles%files(idx)%opened = .TRUE. IF (ISTATUS /= NF90_NOERR) CALL IO_Err_handle_nc4( istatus, 'IO_Metadata_get_nc4', 'NF90_INQ_VARID', &
outfiles%files(idx)%format = NETCDF_FORMAT trim(TPREC%NAME)//'0001' )
outfiles%files(idx)%status = WRITING 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' )
status = NF90_SET_FILL(outfiles%files(idx)%lun_id,NF90_NOFILL,omode) DEALLOCATE(YTIMEDEP)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__) ELSE IF ( YSPLIT /= 'no' ) THEN
END IF ! .NOT.osplit CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Metadata_get_nc4','unknown value '//trim(YSPLIT)//' for split_variable attribute' )
END IF
ELSE DEALLOCATE(YSPLIT)
! Cas NetCDF -> LFI
infiles%nbfiles = infiles%nbfiles + 1
idx = infiles%nbfiles
status = NF90_OPEN(hinfile,NF90_NOWRITE,infiles%files(idx)%lun_id)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
infiles%files(idx)%opened = .TRUE.
infiles%files(idx)%format = NETCDF_FORMAT
infiles%files(idx)%status = READING
status = NF90_INQUIRE(infiles%files(idx)%lun_id, nvariables = nbvar_infile)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
inap = 100
outfiles%nbfiles = outfiles%nbfiles + 1
idx = outfiles%nbfiles
outfiles%files(idx)%lun_id = 11
outfiles%files(idx)%format = LFI_FORMAT
outfiles%files(idx)%status = WRITING
ilu = outfiles%files(idx)%lun_id
CALL LFIOUV(iresp,ilu,ltrue,TRIM(houtfile)//'.lfi','NEW' ,lfalse,lfalse,iverb,inap,inaf)
outfiles%files(idx)%opened = .TRUE.
END IF END IF
PRINT *,'--> Fichier converti : ', TRIM(houtfile) !Reset IFILE_ID to master file (if split files)
IFILE_ID = TPFILE%NNCID
END SUBROUTINE OPEN_FILES ISTATUS = NF90_GET_ATT(IFILE_ID,KVAR_ID,'long_name',TPREC%TFIELD%CLONGNAME)
IF (ISTATUS /= NF90_NOERR) TPREC%TFIELD%CLONGNAME = TRIM( TPREC%TFIELD%CMNHNAME )
SUBROUTINE OPEN_SPLIT_LFIFILE_IN(infiles,hinfile,current_level)
TYPE(filelist_struct), INTENT(INOUT) :: infiles
CHARACTER(LEN=*), INTENT(IN) :: hinfile
INTEGER, INTENT(IN) :: current_level
INTEGER(KIND=LFI_INT) :: ilu,iresp,iverb,inap,nbvar
CHARACTER(LEN=3) :: suffix
CHARACTER(LEN=:),ALLOCATABLE :: filename
ISTATUS = NF90_GET_ATT(IFILE_ID,KVAR_ID,'comment',TPREC%TFIELD%CCOMMENT)
IF (ISTATUS /= NF90_NOERR) TPREC%TFIELD%CCOMMENT = ''
iverb = 0 !Verbosity level for LFI 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
ALLOCATE(character(len=len(hinfile)) :: filename) ISTATUS = NF90_GET_ATT(IFILE_ID,KVAR_ID,'units',TPREC%CUNITS_FILE)
IF (ISTATUS /= NF90_NOERR) TPREC%CUNITS_FILE = ''
ilu = infiles%files(1)%lun_id !We assume only 1 infile IF (.NOT.TPREC%LSPLIT) THEN
ALLOCATE(TPREC%NDIMSIZES_FILE(TPREC%NDIMS_FILE))
ALLOCATE(TPREC%CDIMNAMES_FILE(TPREC%NDIMS_FILE))
ELSE
IF ( GSPLIT_AT_ENTRY ) THEN
ALLOCATE(TPREC%NDIMSIZES_FILE(TPREC%NDIMS_FILE+1))
ALLOCATE(TPREC%CDIMNAMES_FILE(TPREC%NDIMS_FILE+1))
ELSE
IF (TPREC%TFIELD%LTIMEDEP) THEN
ALLOCATE(TPREC%NDIMSIZES_FILE(TPREC%NDIMS_FILE+1))
ALLOCATE(TPREC%CDIMNAMES_FILE(TPREC%NDIMS_FILE+1))
ELSE
ALLOCATE(TPREC%NDIMSIZES_FILE(TPREC%NDIMS_FILE))
ALLOCATE(TPREC%CDIMNAMES_FILE(TPREC%NDIMS_FILE))
END IF
END IF
END IF
write(suffix,'(I3.3)') current_level IF (TPREC%NDIMS_FILE == 0) THEN
filename=hinfile(1:len(hinfile)-7)//suffix//'.lfi' ! Scalar variable
CALL LFIOUV(iresp,ilu,ltrue,filename,'OLD',lfalse,lfalse,iverb,inap,nbvar) ILENG = 1
infiles%files(1)%opened = .TRUE. 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
DEALLOCATE(filename) IF (TPREC%NDIMS_FILE>0) THEN
END SUBROUTINE OPEN_SPLIT_LFIFILE_IN IF (TPREC%CDIMNAMES_FILE(TPREC%NDIMS_FILE)=='time') THEN
TPREC%TFIELD%LTIMEDEP = .TRUE.
ELSE
TPREC%TFIELD%LTIMEDEP = .FALSE.
END IF
ELSE
TPREC%TFIELD%LTIMEDEP = .FALSE.
END IF
SUBROUTINE OPEN_SPLIT_NCFILE_IN(infiles,hinfile,current_level) IF (TPREC%LSPLIT) THEN
TYPE(filelist_struct), INTENT(INOUT) :: infiles #if 0
CHARACTER(LEN=*), INTENT(IN) :: hinfile IF( (.NOT.TPREC%TFIELD%LTIMEDEP .AND. TPREC%NDIMS_FILE/=2) &
INTEGER, INTENT(IN) :: current_level .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
INTEGER :: status !Add vertical/3rd dimension
CHARACTER(LEN=3) :: suffix SELECT CASE(TPREC%NGRID_FILE)
CHARACTER(LEN=:),ALLOCATABLE :: filename 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
TPREC%NSIZE = ILENG
END SUBROUTINE IO_Metadata_get_nc4
ALLOCATE(character(len=len(hinfile)) :: filename)
write(suffix,'(I3.3)') current_level SUBROUTINE IO_Dims_fill_nc4(TPFILE,TPREC,KRESP)
filename=hinfile(1:len(hinfile)-6)//suffix//'.nc' USE MODD_IO, ONLY: TFILEDATA
status = NF90_OPEN(filename,NF90_NOWRITE,infiles%files(1)%lun_id) use mode_io_tools_nc4, only: IO_Dim_find_create_nc4, IO_Dim_find_byname_nc4
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
infiles%files(1)%opened = .TRUE.
DEALLOCATE(filename) TYPE(TFILEDATA),INTENT(IN) :: TPFILE
END SUBROUTINE OPEN_SPLIT_NCFILE_IN TYPE(workfield),INTENT(INOUT) :: TPREC
INTEGER, INTENT(OUT) :: KRESP
SUBROUTINE OPEN_SPLIT_NCFILES_OUT(outfiles,houtfile,nbvar,tpreclist,options) integer :: iidx
TYPE(filelist_struct), INTENT(INOUT) :: outfiles INTEGER :: JJ
CHARACTER(LEN=*), INTENT(IN) :: houtfile
INTEGER, INTENT(IN) :: nbvar
TYPE(workfield), DIMENSION(:), INTENT(IN) :: tpreclist
TYPE(option),DIMENSION(:), INTENT(IN) :: options
INTEGER :: ji, idx CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Dims_fill_nc4','called')
INTEGER :: status
INTEGER :: omode
CHARACTER(LEN=MAXLEN) :: filename
KRESP = 0
DO ji = 1,nbvar IF (TPREC%NDIMS_FILE<TPREC%TFIELD%NDIMS) THEN
IF (tpreclist(ji)%tbw) outfiles%nbfiles = outfiles%nbfiles + 1 CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Dims_fill_nc4','less dimensions than expected for '//TRIM(TPREC%TFIELD%CMNHNAME)// &
END DO ' => ignored')
TPREC%tbw = .FALSE.
TPREC%tbr = .FALSE.
TPREC%found = .FALSE.
RETURN
END IF
idx = 1 ALLOCATE(TPREC%TDIMS(TPREC%TFIELD%NDIMS))
DO ji = 1,nbvar
IF (.NOT.tpreclist(ji)%tbw) CYCLE
outfiles%files(idx)%var_id = ji
IF (options(OPTCDF4)%set) THEN DO JJ=1,TPREC%TFIELD%NDIMS
filename = trim(houtfile)//'.'//trim(tpreclist(ji)%name)//'.nc' !DO JJ=1,TPREC%NDIMS_FILE !NDIMS_FILE can be bigger than NDIMS due to time dimension (it can be ignored here)
status = NF90_CREATE(trim(filename), IOR(NF90_CLOBBER,NF90_NETCDF4), outfiles%files(idx)%lun_id) CALL IO_Dim_find_byname_nc4(TPFILE,TPREC%CDIMNAMES_FILE(JJ),TPREC%TDIMS(JJ),KRESP)
ELSE !If dimension not found => create it
filename = trim(houtfile)//'.'//trim(tpreclist(ji)%name)//'.nc' IF (KRESP/=0) THEN
status = NF90_CREATE(trim(filename), IOR(NF90_CLOBBER,NF90_64BIT_OFFSET), outfiles%files(idx)%lun_id) call IO_Dim_find_create_nc4( tpfile, tprec%ndimsizes_file(jj), iidx )
tprec%tdims(jj) = tpfile%tncdims%tdims(iidx)
KRESP = 0
END IF END IF
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__) IF (TRIM(TPREC%TDIMS(JJ)%cname)/='time' .AND. &
TPREC%TDIMS(JJ)%nlen /= TPREC%NDIMSIZES_FILE(JJ)) THEN
status = NF90_SET_FILL(outfiles%files(idx)%lun_id,NF90_NOFILL,omode) CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Dims_fill_nc4','problem with dimensions for '//TPREC%TFIELD%CMNHNAME)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__) KRESP = -3
EXIT
outfiles%files(idx)%opened = .TRUE.
outfiles%files(idx)%format = NETCDF_FORMAT
outfiles%files(idx)%status = WRITING
idx = idx + 1
END DO
END SUBROUTINE OPEN_SPLIT_NCFILES_OUT
SUBROUTINE CLOSE_FILES(filelist)
TYPE(filelist_struct),INTENT(INOUT) :: filelist
INTEGER(KIND=LFI_INT) :: ilu,iresp
INTEGER :: ji,status
DO ji=1,filelist%nbfiles
IF ( .NOT.filelist%files(ji)%opened ) CYCLE
IF ( filelist%files(ji)%format == LFI_FORMAT ) THEN
ilu = filelist%files(ji)%lun_id
CALL LFIFER(iresp,ilu,'KEEP')
ELSE IF ( filelist%files(ji)%format == NETCDF_FORMAT ) THEN
status = NF90_CLOSE(filelist%files(ji)%lun_id)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
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
...@@ -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
......
...@@ -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
......
#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,
......
#!/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)
#!/bin/sh
#SBATCH -J tools
#SBATCH -N 1 # nodes number
#SBATCH -n 1 # CPUs number (on all nodes)
#SBATCH -o tools.eo%j #
#SBATCH -e tools.eo%j #
#SBATCH -t 01:00:00 # time limit
# Echo des commandes
ulimit -c 0
ulimit -s unlimited
# Arrete du job des la premiere erreur
set -e
. ~rodierq/DEV_57/MNH-PHYEX070-b95d84d7/conf/profile_mesonh-LXifort-R8I4-MNH-V5-6-2-ECRAD140-MPIAUTO-O2
ln -sf ${SRC_MESONH}/src/LIB/Python/* .
module purge
module load python/3.7.6
python3 plot_16JAN.py
convert *.png 16JAN.pdf
&NAM_CONFIO LCDF4=T, LLFIOUT=F, LLFIREAD=F /
&NAM_DIAG
CISO='TKPREV',
LVAR_RS=T,
LVAR_TURB=F,
NCONV_KF=1,
LVAR_MRW=T,
LVAR_MRSV=F,
LTRAJ=F,
LTPZH=T,
CBLTOP="RICHA",
LMSLP=T,
LAGEO=T,
LTHW=T,
LCLD_COV=T,
NCAPE=1,
LRADAR=T,
LDIAG(:)=.FALSE.,
LISOAL=T, XISOAL(1)=9000,
LISOPR=T, XISOPR(1)=850, XISOPR(2)=700 /
&NAM_DIAG_FILE YINIFILE(1) = "16JA1.1.WENO5.004" ,
YINIFILEPGD(1) = "16JAN98_36km.neste1",
YSUFFIX='dg' /
&NAM_DIAG_SURFn N2M=2 LSURF_BUDGET=T /
&NAM_DIAG_ISBAn LPGD=F LSURF_EVAP_BUDGET=T /
&NAM_CONFIO LCDF4=T, LLFIOUT=F, LLFIREAD=F /
&NAM_DIAG CISO='', LVAR_RS=F, LVAR_LS=F, LVAR_PR=T, LTOTAL_PR=T,
LISOAL=T, XISOAL(1)=9000,
LISOPR=T, XISOPR(1)=850, XISOPR(2)=700 /
&NAM_BLANK /
&NAM_DIAG_FILE YINIFILE(1) = "16JA2.2.WENO5.002",
YINIFILEPGD(1) = "16JAN98_9km.neste1",
YSUFFIX = "dg" /
&NAM_CONFIO LCDF4=T, LLFIOUT=F, LLFIREAD=F /
&NAM_LUNITn CINIFILE = "15JAN_12_MNH" ,
CINIFILEPGD = "16JAN98_36km.neste1",
CCPLFILE(1) = "15JAN_18_MNH",
CCPLFILE(2) = "16JAN_00_MNH" /
&NAM_CONFZ
NZ_VERB=5 , NZ_PROC=0 , NB_PROCIO_R=1 , NB_PROCIO_W=1
/
&NAM_DYNn XTSTEP = 120., CPRESOPT = "ZRESI", NITR = 8,
LHORELAX_UVWTH = T, LHORELAX_RV = T, LVE_RELAX = T,
NRIMX = 5, NRIMY = 5, XRIMKMAX = 0.0083, XT4DIFU = 5000.,XT4DIFTH = 5000. /
&NAM_ADVn CUVW_ADV_SCHEME = "WENO_K" ,CMET_ADV_SCHEME = "PPM_01",NWENO_ORDER=5,CTEMP_SCHEME='RK53' /
&NAM_PARAMn CTURB = "TKEL", CRAD = "ECMW",
CDCONV = "KAFR", CCLOUD= "KESS",CSCONV="KAFR" /
&NAM_PARAM_RADn XDTRAD = 3600., XDTRAD_CLONLY = 3600., NRAD_COLNBR= 400 /
&NAM_PARAM_KAFRn XDTCONV = 300., NICE = 1, LREFRESH_ALL = T, LDOWN = T /
&NAM_LBCn CLBCX = 2*"OPEN", CLBCY = 2*"OPEN" /
&NAM_TURBn CTURBLEN = "BL89", CTURBDIM = "1DIM",
LTURB_DIAG = F, LTURB_FLX = F /
&NAM_CONF CCONF = "START", NMODEL = 1, NVERB = 5,
CEXP = "16JA1 ", CSEG = "WENO5",NHALO=3 /
&NAM_DYN XSEGLEN = 43200., LCORIO = T, LNUMDIFU = F,LNUMDIFTH = F,
XALKTOP = 0.001, XALZBOT = 15000. /
&NAM_BACKUP XBAK_TIME(1,1)=10800., XBAK_TIME(1,2)=21600.,XBAK_TIME(1,3)=32400.,XBAK_TIME(1,4)=43200./
&NAM_DIAG_SURFn /
&NAM_ISBA CALBEDO = "DRY" /
&NAM_ISBAn CSCOND = "NP89",
CC1DRY='DEF', CSOILFRZ='DEF', CDIFSFCOND='DEF', CSNOWRES='DEF' /
&NAM_SSOn CROUGH="Z01D"/
&NAM_DIAG_ISBAn /
&NAM_SEAFLUXn CSEA_ALB="UNIF" /
&NAM_BLANK /
&NAM_SGH_ISBAn CRUNOFF = "WSAT"/
&NAM_NEBn LSUBG_COND= F /