etsf_io-1.0.3/0000777000353400050620000000000011354151526010155 500000000000000etsf_io-1.0.3/config/0000777000353400050620000000000011354151521011415 500000000000000etsf_io-1.0.3/config/m4/0000777000353400050620000000000011354151521011735 500000000000000etsf_io-1.0.3/config/m4/fortran.m40000644000353400050630000004222311352707147013603 00000000000000# -*- Autoconf -*- # # Copyright (c) 2005-2010 ABINIT Group (Yann Pouillon) # All rights reserved. # # This file is part of the ABINIT software package. For license information, # please see the COPYING file in the top-level directory of the ABINIT source # distribution. # # # Fortran compilers support # # _ABI_CHECK_FC_ABSOFT(COMPILER) # ------------------------------ # # Checks whether the specified Fortran compiler is the ABSoft Fortran compiler. # If yes, tries to determine its version number and sets the fc_type # and fc_version variables accordingly. # AC_DEFUN([_ABI_CHECK_FC_ABSOFT], [dnl Do some sanity checking of the arguments m4_if([$1], , [AC_FATAL([$0: missing argument 1])])dnl dnl AC_MSG_CHECKING([if we are using the ABSoft Fortran compiler]) fc_info_string=`$1 -V 2> /dev/null` abi_result=`echo "${fc_info_string}" | grep '^Pro Fortran'` if test "${abi_result}" = ""; then abi_result="no" fc_info_string="" fc_type="UNKNOWN" fc_version="UNKNOWN" else AC_DEFINE([FC_ABSOFT],1,[Define to 1 if you are using the ABSOFT Fortran compiler]) fc_type="absoft" fc_version=`echo "${abi_result}" | sed -e 's/Pro Fortran //'` if test "${fc_version}" = "${abi_result}"; then fc_version="UNKNOWN" fi abi_result="yes" fi dnl AC_MSG_RESULT(${abi_result}) ]) # _ABI_CHECK_FC_ABSOFT # _ABI_CHECK_FC_COMPAQ(COMPILER) # ------------------------------ # # Checks whether the specified Fortran compiler is the COMPAQ Fortran compiler. # If yes, tries to determine its version number and sets the fc_type # and fc_version variables accordingly. # AC_DEFUN([_ABI_CHECK_FC_COMPAQ], [dnl Do some sanity checking of the arguments m4_if([$1], , [AC_FATAL([$0: missing argument 1])])dnl dnl AC_MSG_CHECKING([if we are using the Compaq Fortran compiler]) fc_info_string=`$1 -version 2>&1 | sed -e 's/^ //' | grep '^Compaq Fortran Compiler'` abi_result="${fc_info_string}" if test "${abi_result}" = ""; then fc_info_string=`$1 -version 2>&1 | sed -e 's/^ //' | grep '^HP Fortran Compiler'` abi_result="${fc_info_string}" fi if test "${abi_result}" = ""; then abi_result="no" fc_info_string="" fc_type="UNKNOWN" fc_version="UNKNOWN" else AC_DEFINE([FC_COMPAQ],1,[Define to 1 if you are using the COMPAQ Fortran compiler]) fc_type="compaq" fc_version=`echo "${abi_result}" | sed -e 's/.* V//;s/-.*//'` if test "${fc_version}" = "${abi_result}"; then fc_version="UNKNOWN" fi abi_result="yes" fi dnl AC_MSG_RESULT(${abi_result}) ]) # _ABI_CHECK_FC_COMPAQ # _ABI_CHECK_FC_FUJITSU(COMPILER) # ------------------------------- # # Checks whether the specified Fortran compiler is the Fujitsu Fortran compiler. # If yes, tries to determine its version number and sets the fc_type # and fc_version variables accordingly. # AC_DEFUN([_ABI_CHECK_FC_FUJITSU], [dnl Do some sanity checking of the arguments m4_if([$1], , [AC_FATAL([$0: missing argument 1])])dnl dnl AC_MSG_CHECKING([if we are using the Fujitsu Fortran compiler]) fc_info_string=`$1 -V 2> /dev/null` abi_result=`echo "${fc_info_string}" | grep '^Fujitsu Fortran'` if test "${abi_result}" = ""; then abi_result="no" fc_info_string="" fc_type="UNKNOWN" fc_version="UNKNOWN" else AC_DEFINE([FC_FUJITSU],1,[Define to 1 if you are using the Fujitsu Fortran compiler]) fc_type="fujitsu" fc_version=`echo "${abi_result}" | sed -e 's/.*Driver //;s/ .*//'` if test "${fc_version}" = "${abi_result}"; then fc_version="UNKNOWN" fi abi_result="yes" fi dnl AC_MSG_RESULT(${abi_result}) ]) # _ABI_CHECK_FC_FUJITSU # _ABI_CHECK_FC_G95(COMPILER) # --------------------------- # # Checks whether the specified Fortran compiler is the G95 Fortran compiler. # If yes, tries to determine its version number and sets the fc_type # and fc_version variables accordingly. # AC_DEFUN([_ABI_CHECK_FC_G95], [dnl Do some sanity checking of the arguments m4_if([$1], , [AC_FATAL([$0: missing argument 1])])dnl dnl AC_MSG_CHECKING([if we are using the G95 Fortran compiler]) fc_info_string=`$1 --version 2>&1` abi_result=`echo "${fc_info_string}" | grep '^G95'` if test "${abi_result}" = ""; then abi_result="no" fc_info_string="" fc_type="UNKNOWN" fc_version="UNKNOWN" else AC_DEFINE([FC_G95],1,[Define to 1 if you are using the G95 Fortran compiler]) fc_type="g95" fc_version=`echo ${abi_result} | sed -e 's/.*GCC //; s/ .*//'` if test "${fc_version}" = "${abi_result}"; then fc_version="UNKNOWN" fi abi_result="yes" fi dnl AC_MSG_RESULT(${abi_result}) ]) # _ABI_CHECK_FC_G95 # _ABI_CHECK_FC_GCC(COMPILER) # --------------------------- # # Checks whether the specified Fortran compiler is the GCC Fortran compiler. # If yes, tries to determine its version number and sets the fc_type # and fc_version variables accordingly. # AC_DEFUN([_ABI_CHECK_FC_GCC], [dnl Do some sanity checking of the arguments m4_if([$1], , [AC_FATAL([$0: missing argument 1])])dnl dnl AC_MSG_CHECKING([if we are using the GCC Fortran compiler]) fc_info_string=`$1 --version 2>&1` abi_result=`echo "${fc_info_string}" | grep '^GNU Fortran'` if test "${abi_result}" = ""; then abi_result="no" fc_info_string="" fc_type="UNKNOWN" fc_version="UNKNOWN" else AC_DEFINE([FC_GCC],1,[Define to 1 if you are using the GNU Fortran compiler]) fc_type="gcc" fc_version=`echo ${abi_result} | sed -e 's/.*(GCC) //; s/.*GCC //; s/ .*//'` abi_result="yes" fi dnl AC_MSG_RESULT(${abi_result}) ]) # _ABI_CHECK_FC_GCC # _ABI_CHECK_FC_HITACHI(COMPILER) # ------------------------------- # # Checks whether the specified Fortran compiler is the Hitachi Fortran compiler. # If yes, tries to determine its version number and sets the fc_type # and fc_version variables accordingly. # AC_DEFUN([_ABI_CHECK_FC_HITACHI], [dnl Do some sanity checking of the arguments m4_if([$1], , [AC_FATAL([$0: missing argument 1])])dnl dnl AC_MSG_CHECKING([if we are using the Hitachi Fortran compiler]) fc_info_string=`$1 -V 2> /dev/null` abi_result=`echo "${fc_info_string}" | grep '^Hitachi Fortran'` if test "${abi_result}" = ""; then abi_result="no" fc_info_string="" fc_type="UNKNOWN" fc_version="UNKNOWN" else AC_DEFINE([FC_HITACHI],1,[Define to 1 if you are using the Hitachi Fortran compiler]) fc_type="hitachi" fc_version=`echo "${abi_result}" | sed -e 's/.*Driver //;s/ .*//'` if test "${fc_version}" = "${abi_result}"; then fc_version="UNKNOWN" fi abi_result="yes" fi dnl AC_MSG_RESULT(${abi_result}) ]) # _ABI_CHECK_FC_HITACHI # _ABI_CHECK_FC_IBM(COMPILER) # --------------------------- # # Checks whether the specified Fortran compiler is the IBM XL Fortran compiler. # If yes, tries to determine its version number and sets the fc_type # and fc_version variables accordingly. # AC_DEFUN([_ABI_CHECK_FC_IBM], [dnl Do some sanity checking of the arguments m4_if([$1], , [AC_FATAL([$0: missing argument 1])])dnl dnl AC_MSG_CHECKING([if we are using the IBM XL Fortran compiler]) fc_info_string=`$1 -qversion 2>&1` fc_garbage=`$1 -qversion 2>&1 | wc -l | sed -e 's/ //g'` abi_result=`echo "${fc_info_string}" | grep 'IBM(R) XL Fortran'` if test "${abi_result}" = ""; then abi_result=`echo "${fc_info_string}" | grep 'IBM XL Fortran'` fi if test "${abi_result}" = ""; then abi_result="no" fc_info_string="" fc_type="UNKNOWN" fc_version="UNKNOWN" if test "${fc_garbage}" -gt 50; then AC_DEFINE([FC_IBM],1,[Define to 1 if you are using the IBM XL Fortran compiler]) fc_type="ibm" fc_version="UNKNOWN" abi_result="yes" fi else AC_DEFINE([FC_IBM],1,[Define to 1 if you are using the IBM XL Fortran compiler]) fc_type="ibm" fc_version=`echo "${abi_result}" | sed -e 's/.* V\([[0-9\.]]*\) .*/\1/'` if test "${fc_version}" = "${abi_result}"; then fc_version="UNKNOWN" fi abi_result="yes" fi dnl AC_MSG_RESULT(${abi_result}) ]) # _ABI_CHECK_FC_IBM # _ABI_CHECK_FC_INTEL(COMPILER) # ----------------------------- # # Checks whether the specified Fortran compiler is the Intel Fortran compiler. # If yes, tries to determine its version number and sets the fc_type # and fc_version variables accordingly. # AC_DEFUN([_ABI_CHECK_FC_INTEL], [dnl Do some sanity checking of the arguments m4_if([$1], , [AC_FATAL([$0: missing argument 1])])dnl dnl AC_MSG_CHECKING([if we are using the Intel Fortran compiler]) fc_info_string=`$1 -v -V 2>&1 | sed -e '/^ifc: warning/d'` abi_result=`echo "${fc_info_string}" | grep '^Intel(R) Fortran'` if test "${abi_result}" = ""; then abi_result="no" fc_info_string="" fc_type="UNKNOWN" fc_version="UNKNOWN" else AC_DEFINE([FC_INTEL],1,[Define to 1 if you are using the Intel Fortran compiler]) fc_type="intel" fc_version=`echo "${fc_info_string}" | grep '^Version' | sed -e 's/Version //;s/ .*//;s/ //g' | head -n 1` if test "${fc_version}" = ""; then fc_version="UNKNOWN" fi abi_result="yes" fi dnl AC_MSG_RESULT(${abi_result}) ]) # _ABI_CHECK_FC_INTEL # _ABI_CHECK_FC_MIPSPRO(COMPILER) # ------------------------------- # # Checks whether the specified Fortran compiler is the MIPSpro Fortran # compiler. # If yes, tries to determine its version number and sets the fc_type # and fc_version variables accordingly. # AC_DEFUN([_ABI_CHECK_FC_MIPSPRO], [dnl Do some sanity checking of the arguments m4_if([$1], , [AC_FATAL([$0: missing argument 1])])dnl dnl AC_MSG_CHECKING([if we are using the MIPSpro Fortran compiler]) fc_info_string=`$1 -version 2>&1 | sed -e '/^$/d'` abi_result=`echo "${fc_info_string}" | grep '^MIPSpro'` if test "${abi_result}" = ""; then abi_result="no" fc_info_string="" fc_type="UNKNOWN" fc_version="UNKNOWN" else AC_DEFINE([FC_MIPSPRO],1,[Define to 1 if you are using the MIPSpro Fortran compiler]) fc_type="mipspro" fc_version=`echo "${abi_result}" | sed -e 's/.*Version //'` if test "${fc_version}" = "${abi_result}"; then fc_version="UNKNOWN" fi abi_result="yes" fi dnl AC_MSG_RESULT(${abi_result}) ]) # _ABI_CHECK_FC_MIPSPRO # _ABI_CHECK_FC_OPEN64(COMPILER) # ------------------------------ # # Checks whether the specified Fortran compiler is the Open64 # Fortran compiler. # If yes, tries to determine its version number and sets the fc_type # and fc_version variables accordingly. # AC_DEFUN([_ABI_CHECK_FC_OPEN64], [dnl Do some sanity checking of the arguments m4_if([$1], , [AC_FATAL([$0: missing argument 1])])dnl dnl AC_MSG_CHECKING([if we are using the PathScale Fortran compiler]) fc_info_string=`$1 --version 2>&1` abi_result=`echo "${fc_info_string}" | grep '^Open64'` if test "${abi_result}" = ""; then abi_result="no" fc_info_string="" fc_type="UNKNOWN" fc_version="UNKNOWN" else AC_DEFINE([FC_OPEN64],1,[Define to 1 if you are using the Open64 Fortran compiler]) fc_type="open64" fc_version=`echo "${abi_result}" | sed -e 's/.* Version //; s/ .*//'` if test "${fc_version}" = "${abi_result}"; then fc_version="UNKNOWN" fi abi_result="yes" fi dnl AC_MSG_RESULT(${abi_result}) ]) # _ABI_CHECK_FC_OPEN64 # _ABI_CHECK_FC_PATHSCALE(COMPILER) # --------------------------------- # # Checks whether the specified Fortran compiler is the PathScale # Fortran compiler. # If yes, tries to determine its version number and sets the fc_type # and fc_version variables accordingly. # AC_DEFUN([_ABI_CHECK_FC_PATHSCALE], [dnl Do some sanity checking of the arguments m4_if([$1], , [AC_FATAL([$0: missing argument 1])])dnl dnl AC_MSG_CHECKING([if we are using the PathScale Fortran compiler]) fc_info_string=`$1 -version 2>&1` abi_result=`echo "${fc_info_string}" | grep '^PathScale'` if test "${abi_result}" = ""; then abi_result="no" fc_info_string="" fc_type="UNKNOWN" fc_version="UNKNOWN" else AC_DEFINE([FC_PATHSCALE],1,[Define to 1 if you are using the PathScale Fortran compiler]) fc_type="pathscale" fc_version=`echo "${abi_result}" | sed -e 's/.* Version //; s/ .*//'` if test "${fc_version}" = "${abi_result}"; then fc_version="UNKNOWN" fi abi_result="yes" fi dnl AC_MSG_RESULT(${abi_result}) ]) # _ABI_CHECK_FC_PATHSCALE # _ABI_CHECK_FC_PGI(COMPILER) # --------------------------- # # Checks whether the specified Fortran compiler is the Portland Group # Fortran compiler. # If yes, tries to determine its version number and sets the fc_type # and fc_version variables accordingly. # AC_DEFUN([_ABI_CHECK_FC_PGI], [dnl Do some sanity checking of the arguments m4_if([$1], , [AC_FATAL([$0: missing argument 1])])dnl dnl AC_MSG_CHECKING([if we are using the Portland Group Fortran compiler]) fc_info_string=`$1 -V 2>&1 | sed -e '/^$/d'` abi_result=`echo "${fc_info_string}" | grep '^pgf9[[05]]' | grep -v 'No files to process'` if test "${abi_result}" = ""; then abi_result="no" fc_info_string="" fc_type="UNKNOWN" fc_version="UNKNOWN" else AC_DEFINE([FC_PGI],1,[Define to 1 if you are using the Portland Group Fortran compiler]) fc_type="pgi" fc_version=`echo "${abi_result}" | sed -e 's/^pgf9[[05]] //' | sed -e 's/-.*//'` if test "${fc_version}" = "${abi_result}"; then fc_version="UNKNOWN" else if test "${fc_version}" = "6.0"; then AC_DEFINE([FC_PGI6],1,[Define to 1 if you are using the Portland Group Fortran compiler version 6]) fi fi abi_result="yes" fi dnl AC_MSG_RESULT(${abi_result}) ]) # _ABI_CHECK_FC_PGI # _ABI_CHECK_FC_SUN(COMPILER) # --------------------------- # # Checks whether the specified Fortran compiler is the Sun WorkShop Fortran compiler. # If yes, tries to determine its version number and sets the fc_type # and fc_version variables accordingly. # AC_DEFUN([_ABI_CHECK_FC_SUN], [dnl Do some sanity checking of the arguments m4_if([$1], , [AC_FATAL([$0: missing argument 1])])dnl dnl AC_MSG_CHECKING([if we are using the Sun WorkShop Fortran compiler]) fc_info_string=`$1 -V 2>&1 | head -n 1` abi_result=`echo "${fc_info_string}" | grep 'Sun' | grep 'Fortran 95'` if test "${abi_result}" = ""; then abi_result="no" fc_info_string="" fc_type="UNKNOWN" fc_version="UNKNOWN" else AC_DEFINE([FC_SUN],1,[Define to 1 if you are using the Sun WorkShop]) fc_type="sun" fc_version=`echo "${abi_result}" | sed -e 's/.* Fortran 95 //;s/ .*//'` if test "${fc_version}" = "${abi_result}" -o "${fc_version}" = ""; then fc_version="UNKNOWN" fi abi_result="yes" fi dnl AC_MSG_RESULT(${abi_result}) ]) # _ABI_CHECK_FC_SUN ############################################################################## # _ABI_CHECK_FC_EXIT() # -------------------- # # Checks whether the Fortran compiler supports the exit() subroutine. # AC_DEFUN([_ABI_CHECK_FC_EXIT], [dnl Init fc_has_exit="no" AC_MSG_CHECKING([whether the Fortran compiler accepts exit()]) dnl Try to compile a program calling exit() AC_LANG_PUSH([Fortran]) AC_LINK_IFELSE([AC_LANG_PROGRAM([], [[ call exit(1) ]])], [fc_has_exit="yes"]) AC_LANG_POP() if test "${fc_has_exit}" = "yes"; then AC_DEFINE([HAVE_FC_EXIT],1, [Define to 1 if your Fortran compiler supports exit()]) fi AC_MSG_RESULT(${fc_has_exit}) ]) # _ABI_CHECK_FC_EXIT # _ABI_CHECK_FC_FLUSH() # --------------------- # # Checks whether the Fortran compiler supports the flush() subroutine. # AC_DEFUN([_ABI_CHECK_FC_FLUSH], [dnl Init fc_has_flush="no" AC_MSG_CHECKING([whether the Fortran compiler accepts flush()]) dnl Try to compile a program calling flush() AC_LANG_PUSH([Fortran]) AC_LINK_IFELSE([AC_LANG_PROGRAM([], [[ call flush() ]])], [fc_has_flush="yes"]) AC_LANG_POP() if test "${fc_has_flush}" = "yes"; then AC_DEFINE([HAVE_FC_FLUSH],1, [Define to 1 if your Fortran compiler supports flush()]) fi AC_MSG_RESULT(${fc_has_flush}) ]) # _ABI_CHECK_FC_FLUSH # ABI_PROG_FC() # ------------- # # Tries to determine which type of Fortran compiler is installed. # AC_DEFUN([ABI_PROG_FC], [dnl Init if test "${fc_type}" = ""; then fc_type="UNKNOWN" fi if test "${fc_version}" = ""; then fc_version="UNKNOWN" fi fc_wrap="no" dnl Determine Fortran compiler type (the order is important) AC_MSG_CHECKING([which type of Fortran compiler we have]) if test "${fc_type}" = "UNKNOWN"; then _ABI_CHECK_FC_G95(${FC}) fi if test "${fc_type}" = "UNKNOWN"; then _ABI_CHECK_FC_GCC(${FC}) fi if test "${fc_type}" = "UNKNOWN"; then _ABI_CHECK_FC_INTEL(${FC}) fi if test "${fc_type}" = "UNKNOWN"; then _ABI_CHECK_FC_PATHSCALE(${FC}) fi if test "${fc_type}" = "UNKNOWN"; then _ABI_CHECK_FC_PGI(${FC}) fi if test "${fc_type}" = "UNKNOWN"; then _ABI_CHECK_FC_COMPAQ(${FC}) fi if test "${fc_type}" = "UNKNOWN"; then _ABI_CHECK_FC_ABSOFT(${FC}) fi if test "${fc_type}" = "UNKNOWN"; then _ABI_CHECK_FC_MIPSPRO(${FC}) fi if test "${fc_type}" = "UNKNOWN"; then _ABI_CHECK_FC_OPEN64(${FC}) fi if test "${fc_type}" = "UNKNOWN"; then _ABI_CHECK_FC_FUJITSU(${FC}) fi if test "${fc_type}" = "UNKNOWN"; then _ABI_CHECK_FC_SUN(${FC}) fi if test "${fc_type}" = "UNKNOWN"; then _ABI_CHECK_FC_HITACHI(${FC}) fi dnl Always keep that one at the end if test "${fc_type}" = "UNKNOWN"; then _ABI_CHECK_FC_IBM(${FC}) fi dnl Fall back to generic when detection fails if test "${fc_type}" = "UNKNOWN"; then fc_type="generic" fc_version="0.0" fi dnl Normalise Fortran compiler version fc_version=`echo ${fc_version} | cut -d. -f1-2` dnl Display final result AC_MSG_RESULT([${fc_type} ${fc_version}]) dnl Schedule compiler info for substitution AC_SUBST(fc_type) AC_SUBST(fc_version) AC_SUBST(fc_wrap) dnl Further explore compiler peculiarities _ABI_CHECK_FC_EXIT _ABI_CHECK_FC_FLUSH ]) # ABI_PROG_FC etsf_io-1.0.3/config/install-sh0000754000353400050630000002202110621016456013335 00000000000000#!/bin/sh # install - install a program, script, or datafile scriptversion=2005-02-02.21 # This originates from X11R5 (mit/util/scripts/install.sh), which was # later released in X11R6 (xc/config/util/install.sh) with the # following copyright and license. # # Copyright (C) 1994 X Consortium # # Permission is hereby granted, free of charge, to any person obtaining a copy # of this software and associated documentation files (the "Software"), to # deal in the Software without restriction, including without limitation the # rights to use, copy, modify, merge, publish, distribute, sublicense, and/or # sell copies of the Software, and to permit persons to whom the Software is # furnished to do so, subject to the following conditions: # # The above copyright notice and this permission notice shall be included in # all copies or substantial portions of the Software. # # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE # X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN # AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC- # TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. # # Except as contained in this notice, the name of the X Consortium shall not # be used in advertising or otherwise to promote the sale, use or other deal- # ings in this Software without prior written authorization from the X Consor- # tium. # # # FSF changes to this file are in the public domain. # # Calling this script install-sh is preferred over install.sh, to prevent # `make' implicit rules from creating a file called install from it # when there is no Makefile. # # This script is compatible with the BSD install script, but was written # from scratch. It can only install one file at a time, a restriction # shared with many OS's install programs. # set DOITPROG to echo to test this script # Don't use :- since 4.3BSD and earlier shells don't like it. doit="${DOITPROG-}" # put in absolute paths if you don't have them in your path; or use env. vars. mvprog="${MVPROG-mv}" cpprog="${CPPROG-cp}" chmodprog="${CHMODPROG-chmod}" chownprog="${CHOWNPROG-chown}" chgrpprog="${CHGRPPROG-chgrp}" stripprog="${STRIPPROG-strip}" rmprog="${RMPROG-rm}" mkdirprog="${MKDIRPROG-mkdir}" chmodcmd="$chmodprog 0755" chowncmd= chgrpcmd= stripcmd= rmcmd="$rmprog -f" mvcmd="$mvprog" src= dst= dir_arg= dstarg= no_target_directory= usage="Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE or: $0 [OPTION]... SRCFILES... DIRECTORY or: $0 [OPTION]... -t DIRECTORY SRCFILES... or: $0 [OPTION]... -d DIRECTORIES... In the 1st form, copy SRCFILE to DSTFILE. In the 2nd and 3rd, copy all SRCFILES to DIRECTORY. In the 4th, create DIRECTORIES. Options: -c (ignored) -d create directories instead of installing files. -g GROUP $chgrpprog installed files to GROUP. -m MODE $chmodprog installed files to MODE. -o USER $chownprog installed files to USER. -s $stripprog installed files. -t DIRECTORY install into DIRECTORY. -T report an error if DSTFILE is a directory. --help display this help and exit. --version display version info and exit. Environment variables override the default commands: CHGRPPROG CHMODPROG CHOWNPROG CPPROG MKDIRPROG MVPROG RMPROG STRIPPROG " while test -n "$1"; do case $1 in -c) shift continue;; -d) dir_arg=true shift continue;; -g) chgrpcmd="$chgrpprog $2" shift shift continue;; --help) echo "$usage"; exit $?;; -m) chmodcmd="$chmodprog $2" shift shift continue;; -o) chowncmd="$chownprog $2" shift shift continue;; -s) stripcmd=$stripprog shift continue;; -t) dstarg=$2 shift shift continue;; -T) no_target_directory=true shift continue;; --version) echo "$0 $scriptversion"; exit $?;; *) # When -d is used, all remaining arguments are directories to create. # When -t is used, the destination is already specified. test -n "$dir_arg$dstarg" && break # Otherwise, the last argument is the destination. Remove it from $@. for arg do if test -n "$dstarg"; then # $@ is not empty: it contains at least $arg. set fnord "$@" "$dstarg" shift # fnord fi shift # arg dstarg=$arg done break;; esac done if test -z "$1"; then if test -z "$dir_arg"; then echo "$0: no input file specified." >&2 exit 1 fi # It's OK to call `install-sh -d' without argument. # This can happen when creating conditional directories. exit 0 fi for src do # Protect names starting with `-'. case $src in -*) src=./$src ;; esac if test -n "$dir_arg"; then dst=$src src= if test -d "$dst"; then mkdircmd=: chmodcmd= else mkdircmd=$mkdirprog fi else # Waiting for this to be detected by the "$cpprog $src $dsttmp" command # might cause directories to be created, which would be especially bad # if $src (and thus $dsttmp) contains '*'. if test ! -f "$src" && test ! -d "$src"; then echo "$0: $src does not exist." >&2 exit 1 fi if test -z "$dstarg"; then echo "$0: no destination specified." >&2 exit 1 fi dst=$dstarg # Protect names starting with `-'. case $dst in -*) dst=./$dst ;; esac # If destination is a directory, append the input filename; won't work # if double slashes aren't ignored. if test -d "$dst"; then if test -n "$no_target_directory"; then echo "$0: $dstarg: Is a directory" >&2 exit 1 fi dst=$dst/`basename "$src"` fi fi # This sed command emulates the dirname command. dstdir=`echo "$dst" | sed -e 's,/*$,,;s,[^/]*$,,;s,/*$,,;s,^$,.,'` # Make sure that the destination directory exists. # Skip lots of stat calls in the usual case. if test ! -d "$dstdir"; then defaultIFS=' ' IFS="${IFS-$defaultIFS}" oIFS=$IFS # Some sh's can't handle IFS=/ for some reason. IFS='%' set x `echo "$dstdir" | sed -e 's@/@%@g' -e 's@^%@/@'` shift IFS=$oIFS pathcomp= while test $# -ne 0 ; do pathcomp=$pathcomp$1 shift if test ! -d "$pathcomp"; then $mkdirprog "$pathcomp" # mkdir can fail with a `File exist' error in case several # install-sh are creating the directory concurrently. This # is OK. test -d "$pathcomp" || exit fi pathcomp=$pathcomp/ done fi if test -n "$dir_arg"; then $doit $mkdircmd "$dst" \ && { test -z "$chowncmd" || $doit $chowncmd "$dst"; } \ && { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } \ && { test -z "$stripcmd" || $doit $stripcmd "$dst"; } \ && { test -z "$chmodcmd" || $doit $chmodcmd "$dst"; } else dstfile=`basename "$dst"` # Make a couple of temp file names in the proper directory. dsttmp=$dstdir/_inst.$$_ rmtmp=$dstdir/_rm.$$_ # Trap to clean up those temp files at exit. trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0 trap '(exit $?); exit' 1 2 13 15 # Copy the file name to the temp name. $doit $cpprog "$src" "$dsttmp" && # and set any options; do chmod last to preserve setuid bits. # # If any of these fail, we abort the whole thing. If we want to # ignore errors from any of these, just make sure not to ignore # errors from the above "$doit $cpprog $src $dsttmp" command. # { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } \ && { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } \ && { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } \ && { test -z "$chmodcmd" || $doit $chmodcmd "$dsttmp"; } && # Now rename the file to the real destination. { $doit $mvcmd -f "$dsttmp" "$dstdir/$dstfile" 2>/dev/null \ || { # The rename failed, perhaps because mv can't rename something else # to itself, or perhaps because mv is so ancient that it does not # support -f. # Now remove or move aside any old file at destination location. # We try this two ways since rm can't unlink itself on some # systems and the destination file might be busy for other # reasons. In this case, the final cleanup might fail but the new # file should still install successfully. { if test -f "$dstdir/$dstfile"; then $doit $rmcmd -f "$dstdir/$dstfile" 2>/dev/null \ || $doit $mvcmd -f "$dstdir/$dstfile" "$rmtmp" 2>/dev/null \ || { echo "$0: cannot unlink or rename $dstdir/$dstfile" >&2 (exit 1); exit 1 } else : fi } && # Now rename the file to the real destination. $doit $mvcmd "$dsttmp" "$dstdir/$dstfile" } } fi || { (exit 1); exit 1; } done # The final little trick to "correctly" pass the exit status to the exit trap. { (exit 0); exit 0 } # Local variables: # eval: (add-hook 'write-file-hooks 'time-stamp) # time-stamp-start: "scriptversion=" # time-stamp-format: "%:y-%02m-%02d.%02H" # time-stamp-end: "$" # End: etsf_io-1.0.3/config/missing0000754000353400050630000002517010621016456012740 00000000000000#! /bin/sh # Common stub for a few missing GNU programs while installing. scriptversion=2005-02-08.22 # Copyright (C) 1996, 1997, 1999, 2000, 2002, 2003, 2004, 2005 # Free Software Foundation, Inc. # Originally by Fran,cois Pinard , 1996. # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA # 02111-1307, USA. # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under # the same distribution terms that you use for the rest of that program. if test $# -eq 0; then echo 1>&2 "Try \`$0 --help' for more information" exit 1 fi run=: # In the cases where this matters, `missing' is being run in the # srcdir already. if test -f configure.ac; then configure_ac=configure.ac else configure_ac=configure.in fi msg="missing on your system" case "$1" in --run) # Try to run requested program, and just exit if it succeeds. run= shift "$@" && exit 0 # Exit code 63 means version mismatch. This often happens # when the user try to use an ancient version of a tool on # a file that requires a minimum version. In this case we # we should proceed has if the program had been absent, or # if --run hadn't been passed. if test $? = 63; then run=: msg="probably too old" fi ;; -h|--h|--he|--hel|--help) echo "\ $0 [OPTION]... PROGRAM [ARGUMENT]... Handle \`PROGRAM [ARGUMENT]...' for when PROGRAM is missing, or return an error status if there is no known handling for PROGRAM. Options: -h, --help display this help and exit -v, --version output version information and exit --run try to run the given command, and emulate it if it fails Supported PROGRAM values: aclocal touch file \`aclocal.m4' autoconf touch file \`configure' autoheader touch file \`config.h.in' automake touch all \`Makefile.in' files bison create \`y.tab.[ch]', if possible, from existing .[ch] flex create \`lex.yy.c', if possible, from existing .c help2man touch the output file lex create \`lex.yy.c', if possible, from existing .c makeinfo touch the output file tar try tar, gnutar, gtar, then tar without non-portable flags yacc create \`y.tab.[ch]', if possible, from existing .[ch] Send bug reports to ." exit $? ;; -v|--v|--ve|--ver|--vers|--versi|--versio|--version) echo "missing $scriptversion (GNU Automake)" exit $? ;; -*) echo 1>&2 "$0: Unknown \`$1' option" echo 1>&2 "Try \`$0 --help' for more information" exit 1 ;; esac # Now exit if we have it, but it failed. Also exit now if we # don't have it and --version was passed (most likely to detect # the program). case "$1" in lex|yacc) # Not GNU programs, they don't have --version. ;; tar) if test -n "$run"; then echo 1>&2 "ERROR: \`tar' requires --run" exit 1 elif test "x$2" = "x--version" || test "x$2" = "x--help"; then exit 1 fi ;; *) if test -z "$run" && ($1 --version) > /dev/null 2>&1; then # We have it, but it failed. exit 1 elif test "x$2" = "x--version" || test "x$2" = "x--help"; then # Could not run --version or --help. This is probably someone # running `$TOOL --version' or `$TOOL --help' to check whether # $TOOL exists and not knowing $TOOL uses missing. exit 1 fi ;; esac # If it does not exist, or fails to run (possibly an outdated version), # try to emulate it. case "$1" in aclocal*) echo 1>&2 "\ WARNING: \`$1' is $msg. You should only need it if you modified \`acinclude.m4' or \`${configure_ac}'. You might want to install the \`Automake' and \`Perl' packages. Grab them from any GNU archive site." touch aclocal.m4 ;; autoconf) echo 1>&2 "\ WARNING: \`$1' is $msg. You should only need it if you modified \`${configure_ac}'. You might want to install the \`Autoconf' and \`GNU m4' packages. Grab them from any GNU archive site." touch configure ;; autoheader) echo 1>&2 "\ WARNING: \`$1' is $msg. You should only need it if you modified \`acconfig.h' or \`${configure_ac}'. You might want to install the \`Autoconf' and \`GNU m4' packages. Grab them from any GNU archive site." files=`sed -n 's/^[ ]*A[CM]_CONFIG_HEADER(\([^)]*\)).*/\1/p' ${configure_ac}` test -z "$files" && files="config.h" touch_files= for f in $files; do case "$f" in *:*) touch_files="$touch_files "`echo "$f" | sed -e 's/^[^:]*://' -e 's/:.*//'`;; *) touch_files="$touch_files $f.in";; esac done touch $touch_files ;; automake*) echo 1>&2 "\ WARNING: \`$1' is $msg. You should only need it if you modified \`Makefile.am', \`acinclude.m4' or \`${configure_ac}'. You might want to install the \`Automake' and \`Perl' packages. Grab them from any GNU archive site." find . -type f -name Makefile.am -print | sed 's/\.am$/.in/' | while read f; do touch "$f"; done ;; autom4te) echo 1>&2 "\ WARNING: \`$1' is needed, but is $msg. You might have modified some files without having the proper tools for further handling them. You can get \`$1' as part of \`Autoconf' from any GNU archive site." file=`echo "$*" | sed -n 's/.*--output[ =]*\([^ ]*\).*/\1/p'` test -z "$file" && file=`echo "$*" | sed -n 's/.*-o[ ]*\([^ ]*\).*/\1/p'` if test -f "$file"; then touch $file else test -z "$file" || exec >$file echo "#! /bin/sh" echo "# Created by GNU Automake missing as a replacement of" echo "# $ $@" echo "exit 0" chmod +x $file exit 1 fi ;; bison|yacc) echo 1>&2 "\ WARNING: \`$1' $msg. You should only need it if you modified a \`.y' file. You may need the \`Bison' package in order for those modifications to take effect. You can get \`Bison' from any GNU archive site." rm -f y.tab.c y.tab.h if [ $# -ne 1 ]; then eval LASTARG="\${$#}" case "$LASTARG" in *.y) SRCFILE=`echo "$LASTARG" | sed 's/y$/c/'` if [ -f "$SRCFILE" ]; then cp "$SRCFILE" y.tab.c fi SRCFILE=`echo "$LASTARG" | sed 's/y$/h/'` if [ -f "$SRCFILE" ]; then cp "$SRCFILE" y.tab.h fi ;; esac fi if [ ! -f y.tab.h ]; then echo >y.tab.h fi if [ ! -f y.tab.c ]; then echo 'main() { return 0; }' >y.tab.c fi ;; lex|flex) echo 1>&2 "\ WARNING: \`$1' is $msg. You should only need it if you modified a \`.l' file. You may need the \`Flex' package in order for those modifications to take effect. You can get \`Flex' from any GNU archive site." rm -f lex.yy.c if [ $# -ne 1 ]; then eval LASTARG="\${$#}" case "$LASTARG" in *.l) SRCFILE=`echo "$LASTARG" | sed 's/l$/c/'` if [ -f "$SRCFILE" ]; then cp "$SRCFILE" lex.yy.c fi ;; esac fi if [ ! -f lex.yy.c ]; then echo 'main() { return 0; }' >lex.yy.c fi ;; help2man) echo 1>&2 "\ WARNING: \`$1' is $msg. You should only need it if you modified a dependency of a manual page. You may need the \`Help2man' package in order for those modifications to take effect. You can get \`Help2man' from any GNU archive site." file=`echo "$*" | sed -n 's/.*-o \([^ ]*\).*/\1/p'` if test -z "$file"; then file=`echo "$*" | sed -n 's/.*--output=\([^ ]*\).*/\1/p'` fi if [ -f "$file" ]; then touch $file else test -z "$file" || exec >$file echo ".ab help2man is required to generate this page" exit 1 fi ;; makeinfo) echo 1>&2 "\ WARNING: \`$1' is $msg. You should only need it if you modified a \`.texi' or \`.texinfo' file, or any other file indirectly affecting the aspect of the manual. The spurious call might also be the consequence of using a buggy \`make' (AIX, DU, IRIX). You might want to install the \`Texinfo' package or the \`GNU make' package. Grab either from any GNU archive site." # The file to touch is that specified with -o ... file=`echo "$*" | sed -n 's/.*-o \([^ ]*\).*/\1/p'` if test -z "$file"; then # ... or it is the one specified with @setfilename ... infile=`echo "$*" | sed 's/.* \([^ ]*\) *$/\1/'` file=`sed -n '/^@setfilename/ { s/.* \([^ ]*\) *$/\1/; p; q; }' $infile` # ... or it is derived from the source name (dir/f.texi becomes f.info) test -z "$file" && file=`echo "$infile" | sed 's,.*/,,;s,.[^.]*$,,'`.info fi touch $file ;; tar) shift # We have already tried tar in the generic part. # Look for gnutar/gtar before invocation to avoid ugly error # messages. if (gnutar --version > /dev/null 2>&1); then gnutar "$@" && exit 0 fi if (gtar --version > /dev/null 2>&1); then gtar "$@" && exit 0 fi firstarg="$1" if shift; then case "$firstarg" in *o*) firstarg=`echo "$firstarg" | sed s/o//` tar "$firstarg" "$@" && exit 0 ;; esac case "$firstarg" in *h*) firstarg=`echo "$firstarg" | sed s/h//` tar "$firstarg" "$@" && exit 0 ;; esac fi echo 1>&2 "\ WARNING: I can't seem to be able to run \`tar' with the given arguments. You may want to install GNU tar or Free paxutils, or check the command line arguments." exit 1 ;; *) echo 1>&2 "\ WARNING: \`$1' is needed, and is $msg. You might have modified some files without having the proper tools for further handling them. Check the \`README' file, it often tells you about the needed prerequisites for installing this package. You may also peek at any GNU archive site, in case some other package would contain this missing \`$1' program." exit 1 ;; esac exit 0 # Local variables: # eval: (add-hook 'write-file-hooks 'time-stamp) # time-stamp-start: "scriptversion=" # time-stamp-format: "%:y-%02m-%02d.%02H" # time-stamp-end: "$" # End: etsf_io-1.0.3/README0000644000353400050630000000631411352707237010762 00000000000000README for etsf_io ================== Copyright (C) 2006-2010 This file is part of ETSF_IO. This program is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this program; see the file COPYING. If not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ETSF_IO is a library build on top of NetCDF that gives easy access to files conforming to the ETSF specifications (see http://www.etsf.eu/specifications). NetCDF files are binary files with key-values access, optimized to store large volume of data. The ETSF specifications define all key-value pairs that are normalized for a file containing informations of an electronic calculation. This library is available in Fortran90 (and a coming day in C). It gives three level access on files: - the low level (see etsf_io_low_level module). It is a generic API to access NetCDF files, with less capabilities than the NetCDF API, but with all in one methods and dimension checkings. For instance etsf_io_low_read_var will read a var, knowing its name, checking that provided dimensions and shape are compatible with the definition of the variable in the NetCDF file. - the group level (see etsf_io, which is the main part indeed). In the ETSF specifications, variables are gathered by groups. With this API, one to all groups can be read or write at once, giving a complete structure to store data. - the utility level (see etsf_io_file and etsf_io_tools modules) with incorporated high level handling routines like file merging, validation checkers... There is also here a command line program to access all these utilities. Please see the files in the doc/www directory for documentation of the API, browsable with a web browser (use doc/www/index.html). See also the doc/www/tutorials/index.html directory for indications on how to use the library in an other program (link on it, examples of low level access or group level access). Please see the file COPYING for copying conditions. See the file INSTALL for generic compilation and installation instructions. In addition to the usual configure options ETSF_IO requires the pathes to the netcdf library to be specified. --with-netcdf-module-path Give the path of the NetCDF Fortran90 module (default = /usr/include). --with-netcdf-ldflags Give the flags required to link with the NetCDF library (default is -L/usr/lib). The main targets in the top Makefile are: - make, to build the library and the tests executables. - make check, to run all incorporated unitary tests. - make install, to install the program Please report bugs to Caliste Damien . etsf_io-1.0.3/configure.ac0000644000353400050630000001400011353170333012347 00000000000000dnl Process this file with autoconf to produce a configure script. AC_PREREQ(2.59) dnl Init basic data for package dnl define following variables : dnl - PACKAGE_NAME, the name ; dnl - PACKAGE_TARNAME, the name used for the tarball ; dnl - PACKAGE_VERSION, the version ; dnl - PACKAGE_STRING, the name + the version ; dnl - PACKAGE_BUGREPORT, the mail. AC_INIT([ETSF - IO library], [1.0.3], [damien.caliste@cea.fr], [etsf_io]) dnl All temporary building files are put in this directory. dnl his must be called before AM_INIT_AUTOMAKE AC_CONFIG_AUX_DIR(config) AC_CONFIG_MACRO_DIR([config/m4]) dnl Init something, don't know exactly what... AM_INIT_AUTOMAKE dnl Defining fortran language for tests. AC_LANG(Fortran) AC_FC_SRCEXT(f90) dnl Set th default prefix to /opt (see the discussion dnl on the nanoquanta mailing list of october 2006). AC_PREFIX_DEFAULT(/opt) dnl If FC environement variable is not already set, it dnl looks for a modern Fortran compiler, prefering newest dnl fortran available (e. g. Fortran95). Then FC variable dnl is set. AC_PROG_FC() dnl Imported script from ABINIT to defined which compiler is under usage. dnl It will define fc_type and fc_version that are required when installing. ABI_PROG_FC() dnl Set if the module name are capitalized or not with the FC compiler. AC_MSG_CHECKING([for module extension for compiler '$fc_type']) case "$fc_type" in "pathscale") capitalize_module=yes capitalize_module_ext="mod" ;; "open64") capitalize_module=yes capitalize_module_ext="mod" ;; *) capitalize_module=no capitalize_module_ext="mod" ;; esac AC_MSG_RESULT([$capitalize_module_ext]) dnl We custom the module naming scheme depending on the compiler dnl and the platform. dnl Not done yet AM_CONDITIONAL(CAPITALIZE, test "$capitalize_module" = "yes") AC_SUBST(MODULE_EXT, $capitalize_module_ext) dnl Set the FCFLAGS and FFLAGS variable if test -z "$FFLAGS" ; then AC_SUBST(FFLAGS, "-O2") fi if test -z "$FCFLAGS" ; then AC_SUBST(FCFLAGS, "-O2") fi dnl Look for ranlib and canonicalize it with the $host variable AC_CHECK_TOOL(RANLIB, ranlib, :) if test "$ranlib" = ":" ; then AC_MSG_ERROR(["No 'ranlib' program found."]) fi dnl Look for ar and canonicalize it with the $host variable AC_CHECK_TOOL(AR, ar, :) if test "$ar" = ":" ; then AC_MSG_ERROR(["No 'ar' program found."]) fi dnl Get the NetCDF module AC_ARG_WITH(netcdf-module-path, AS_HELP_STRING([--with-netcdf-module-path], [Give the path of the NetCDF Fortran90 module (default = /usr/include).]), ac_netcdf_mod=$withval, ac_netcdf_mod=/usr/include) AC_CHECK_FILE(${ac_netcdf_mod}/netcdf.mod, withnetcdf=yes, withnetcdf=no) if test "$withnetcdf" = "no" ; then AC_CHECK_FILE(${ac_netcdf_mod}/NETCDF.mod, withnetcdf=yes, withnetcdf=no) if test "$withnetcdf" = "no" ; then AC_CHECK_FILE(${ac_netcdf_mod}/NETCDF.MOD, withnetcdf=yes, withnetcdf=no) fi fi if test "$withnetcdf" = "no" ; then echo "Action: install NetCDF and set its path with --with-netcdf-module-path." AC_MSG_ERROR(["No 'NetCDF' module found."]) fi AC_SUBST(NETCDF_CFLAGS, "$ac_netcdf_mod") dnl Get the NetCDF library ac_netcdf_dir=/usr/lib AC_ARG_WITH(netcdf-ldflags, AS_HELP_STRING([--with-netcdf-ldflags], [Give the flags required to link with the NetCDF library (default is -L/usr/lib).]), ac_netcdf_dir=$withval, ac_netcdf_dir=) if test -n "$ac_netcdf_dir" ; then LDFLAGS="$LDFLAGS $ac_netcdf_dir" fi AC_MSG_CHECKING([for netcdf library]) FCFLAGS_SVG=$FCFLAGS FCFLAGS="$FCFLAGS -I$ac_netcdf_mod" LIBS_SVG=$LIBS LIBS="$LIBS_SVG -lnetcdf" AC_LINK_IFELSE([ program main use netcdf integer :: s, ncid s = nf90_open(path = "", mode = NF90_NOWRITE, ncid = ncid) end program main ], withnetcdf="-lnetcdf", withnetcdf=no) if test "$withnetcdf" = "no" ; then LIBS="$LIBS_SVG -lnetcdff -lnetcdf" AC_LINK_IFELSE([ program main use netcdf integer :: s, ncid s = nf90_open(path = "", mode = NF90_NOWRITE, ncid = ncid) end program main ], withnetcdf="-lnetcdff -lnetcdf", withnetcdf=no) fi AC_MSG_RESULT([$withnetcdf]) if test "$withnetcdf" = "no" ; then echo "LDFLAGS was '$LDFLAGS'" echo "Action: install NetCDF and set the library link path with --with-netcdf-ldflags." AC_MSG_ERROR(["No 'NetCDF' library found."]) fi FCFLAGS=$FCFLAGS_SVG LIBS="$LIBS_SVG"$withnetcdf dnl Test if only the library must be built ac_build_tutorials="no" AC_ARG_ENABLE(build-tutorials, AS_HELP_STRING([--enable-build-tutorials], [Create the tutorial binaries (disable by default).]), ac_build_tutorials=$enableval, ac_build_tutorials="no") AM_CONDITIONAL(BUILD_TUTORIALS, test "$ac_build_tutorials" = "yes") dnl default installation directories AC_ARG_WITH(moduledir, AS_HELP_STRING([--with-moduledir], [installation directory for module files [[INCLUDEDIR/FC_TYPE]]]), ac_moduledir=$withval, ac_moduledir="no") if test x"$ac_moduledir" != x"no" ; then moduledir=$ac_moduledir else moduledir=${includedir}/${fc_type} fi AC_SUBST(moduledir) dnl Append $FCFLAGS_SRCEXT to $FCFLAGS since the former is not dnl added automatically in the Makefile.in. FCFLAGS="$FCFLAGS $FCFLAGS_f90" lowleveldocdir=$docdir"/low_level" AC_SUBST(lowleveldocdir) groupleveldocdir=$docdir"/group_level" AC_SUBST(groupleveldocdir) utilsdocdir=$docdir"/utils" AC_SUBST(utilsdocdir) tutorialsdocdir=$docdir"/tutorials" AC_SUBST(tutorialsdocdir) dnl Give the name of file.in to transform to file AC_CONFIG_FILES([ Makefile src/low_level/Makefile src/group_level/Makefile src/tutorials/Makefile src/utils/Makefile tests/low_level/Makefile tests/group_level/Makefile tests/utils/Makefile doc/www/Makefile doc/www/low_level/Makefile doc/www/group_level/Makefile doc/www/utils/Makefile doc/www/tutorials/Makefile ]) AC_OUTPUT echo " Basics: Prefix: $prefix Fortran90 compiler: $FC Fortran90 flags: $FCFLAGS Linker flags: $LDFLAGS Linked libraries: $LIBS Installed module dir: $moduledir Installed lib dir: $libdir Installed doc dir: $docdir " etsf_io-1.0.3/aclocal.m40000644000353400050620000005221111353170335011730 00000000000000# generated automatically by aclocal 1.10.1 -*- Autoconf -*- # Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, # 2005, 2006, 2007, 2008 Free Software Foundation, Inc. # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY, to the extent permitted by law; without # even the implied warranty of MERCHANTABILITY or FITNESS FOR A # PARTICULAR PURPOSE. m4_ifndef([AC_AUTOCONF_VERSION], [m4_copy([m4_PACKAGE_VERSION], [AC_AUTOCONF_VERSION])])dnl m4_if(AC_AUTOCONF_VERSION, [2.61],, [m4_warning([this file was generated for autoconf 2.61. You have another version of autoconf. It may work, but is not guaranteed to. If you have problems, you may need to regenerate the build system entirely. To do so, use the procedure documented by the package, typically `autoreconf'.])]) # Copyright (C) 2002, 2003, 2005, 2006, 2007 Free Software Foundation, Inc. # # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. # AM_AUTOMAKE_VERSION(VERSION) # ---------------------------- # Automake X.Y traces this macro to ensure aclocal.m4 has been # generated from the m4 files accompanying Automake X.Y. # (This private macro should not be called outside this file.) AC_DEFUN([AM_AUTOMAKE_VERSION], [am__api_version='1.10' dnl Some users find AM_AUTOMAKE_VERSION and mistake it for a way to dnl require some minimum version. Point them to the right macro. m4_if([$1], [1.10.1], [], [AC_FATAL([Do not call $0, use AM_INIT_AUTOMAKE([$1]).])])dnl ]) # _AM_AUTOCONF_VERSION(VERSION) # ----------------------------- # aclocal traces this macro to find the Autoconf version. # This is a private macro too. Using m4_define simplifies # the logic in aclocal, which can simply ignore this definition. m4_define([_AM_AUTOCONF_VERSION], []) # AM_SET_CURRENT_AUTOMAKE_VERSION # ------------------------------- # Call AM_AUTOMAKE_VERSION and AM_AUTOMAKE_VERSION so they can be traced. # This function is AC_REQUIREd by AC_INIT_AUTOMAKE. AC_DEFUN([AM_SET_CURRENT_AUTOMAKE_VERSION], [AM_AUTOMAKE_VERSION([1.10.1])dnl m4_ifndef([AC_AUTOCONF_VERSION], [m4_copy([m4_PACKAGE_VERSION], [AC_AUTOCONF_VERSION])])dnl _AM_AUTOCONF_VERSION(AC_AUTOCONF_VERSION)]) # AM_AUX_DIR_EXPAND -*- Autoconf -*- # Copyright (C) 2001, 2003, 2005 Free Software Foundation, Inc. # # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. # For projects using AC_CONFIG_AUX_DIR([foo]), Autoconf sets # $ac_aux_dir to `$srcdir/foo'. In other projects, it is set to # `$srcdir', `$srcdir/..', or `$srcdir/../..'. # # Of course, Automake must honor this variable whenever it calls a # tool from the auxiliary directory. The problem is that $srcdir (and # therefore $ac_aux_dir as well) can be either absolute or relative, # depending on how configure is run. This is pretty annoying, since # it makes $ac_aux_dir quite unusable in subdirectories: in the top # source directory, any form will work fine, but in subdirectories a # relative path needs to be adjusted first. # # $ac_aux_dir/missing # fails when called from a subdirectory if $ac_aux_dir is relative # $top_srcdir/$ac_aux_dir/missing # fails if $ac_aux_dir is absolute, # fails when called from a subdirectory in a VPATH build with # a relative $ac_aux_dir # # The reason of the latter failure is that $top_srcdir and $ac_aux_dir # are both prefixed by $srcdir. In an in-source build this is usually # harmless because $srcdir is `.', but things will broke when you # start a VPATH build or use an absolute $srcdir. # # So we could use something similar to $top_srcdir/$ac_aux_dir/missing, # iff we strip the leading $srcdir from $ac_aux_dir. That would be: # am_aux_dir='\$(top_srcdir)/'`expr "$ac_aux_dir" : "$srcdir//*\(.*\)"` # and then we would define $MISSING as # MISSING="\${SHELL} $am_aux_dir/missing" # This will work as long as MISSING is not called from configure, because # unfortunately $(top_srcdir) has no meaning in configure. # However there are other variables, like CC, which are often used in # configure, and could therefore not use this "fixed" $ac_aux_dir. # # Another solution, used here, is to always expand $ac_aux_dir to an # absolute PATH. The drawback is that using absolute paths prevent a # configured tree to be moved without reconfiguration. AC_DEFUN([AM_AUX_DIR_EXPAND], [dnl Rely on autoconf to set up CDPATH properly. AC_PREREQ([2.50])dnl # expand $ac_aux_dir to an absolute path am_aux_dir=`cd $ac_aux_dir && pwd` ]) # AM_CONDITIONAL -*- Autoconf -*- # Copyright (C) 1997, 2000, 2001, 2003, 2004, 2005, 2006 # Free Software Foundation, Inc. # # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. # serial 8 # AM_CONDITIONAL(NAME, SHELL-CONDITION) # ------------------------------------- # Define a conditional. AC_DEFUN([AM_CONDITIONAL], [AC_PREREQ(2.52)dnl ifelse([$1], [TRUE], [AC_FATAL([$0: invalid condition: $1])], [$1], [FALSE], [AC_FATAL([$0: invalid condition: $1])])dnl AC_SUBST([$1_TRUE])dnl AC_SUBST([$1_FALSE])dnl _AM_SUBST_NOTMAKE([$1_TRUE])dnl _AM_SUBST_NOTMAKE([$1_FALSE])dnl if $2; then $1_TRUE= $1_FALSE='#' else $1_TRUE='#' $1_FALSE= fi AC_CONFIG_COMMANDS_PRE( [if test -z "${$1_TRUE}" && test -z "${$1_FALSE}"; then AC_MSG_ERROR([[conditional "$1" was never defined. Usually this means the macro was only invoked conditionally.]]) fi])]) # Do all the work for Automake. -*- Autoconf -*- # Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, # 2005, 2006, 2008 Free Software Foundation, Inc. # # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. # serial 13 # This macro actually does too much. Some checks are only needed if # your package does certain things. But this isn't really a big deal. # AM_INIT_AUTOMAKE(PACKAGE, VERSION, [NO-DEFINE]) # AM_INIT_AUTOMAKE([OPTIONS]) # ----------------------------------------------- # The call with PACKAGE and VERSION arguments is the old style # call (pre autoconf-2.50), which is being phased out. PACKAGE # and VERSION should now be passed to AC_INIT and removed from # the call to AM_INIT_AUTOMAKE. # We support both call styles for the transition. After # the next Automake release, Autoconf can make the AC_INIT # arguments mandatory, and then we can depend on a new Autoconf # release and drop the old call support. AC_DEFUN([AM_INIT_AUTOMAKE], [AC_PREREQ([2.60])dnl dnl Autoconf wants to disallow AM_ names. We explicitly allow dnl the ones we care about. m4_pattern_allow([^AM_[A-Z]+FLAGS$])dnl AC_REQUIRE([AM_SET_CURRENT_AUTOMAKE_VERSION])dnl AC_REQUIRE([AC_PROG_INSTALL])dnl if test "`cd $srcdir && pwd`" != "`pwd`"; then # Use -I$(srcdir) only when $(srcdir) != ., so that make's output # is not polluted with repeated "-I." AC_SUBST([am__isrc], [' -I$(srcdir)'])_AM_SUBST_NOTMAKE([am__isrc])dnl # test to see if srcdir already configured if test -f $srcdir/config.status; then AC_MSG_ERROR([source directory already configured; run "make distclean" there first]) fi fi # test whether we have cygpath if test -z "$CYGPATH_W"; then if (cygpath --version) >/dev/null 2>/dev/null; then CYGPATH_W='cygpath -w' else CYGPATH_W=echo fi fi AC_SUBST([CYGPATH_W]) # Define the identity of the package. dnl Distinguish between old-style and new-style calls. m4_ifval([$2], [m4_ifval([$3], [_AM_SET_OPTION([no-define])])dnl AC_SUBST([PACKAGE], [$1])dnl AC_SUBST([VERSION], [$2])], [_AM_SET_OPTIONS([$1])dnl dnl Diagnose old-style AC_INIT with new-style AM_AUTOMAKE_INIT. m4_if(m4_ifdef([AC_PACKAGE_NAME], 1)m4_ifdef([AC_PACKAGE_VERSION], 1), 11,, [m4_fatal([AC_INIT should be called with package and version arguments])])dnl AC_SUBST([PACKAGE], ['AC_PACKAGE_TARNAME'])dnl AC_SUBST([VERSION], ['AC_PACKAGE_VERSION'])])dnl _AM_IF_OPTION([no-define],, [AC_DEFINE_UNQUOTED(PACKAGE, "$PACKAGE", [Name of package]) AC_DEFINE_UNQUOTED(VERSION, "$VERSION", [Version number of package])])dnl # Some tools Automake needs. AC_REQUIRE([AM_SANITY_CHECK])dnl AC_REQUIRE([AC_ARG_PROGRAM])dnl AM_MISSING_PROG(ACLOCAL, aclocal-${am__api_version}) AM_MISSING_PROG(AUTOCONF, autoconf) AM_MISSING_PROG(AUTOMAKE, automake-${am__api_version}) AM_MISSING_PROG(AUTOHEADER, autoheader) AM_MISSING_PROG(MAKEINFO, makeinfo) AM_PROG_INSTALL_SH AM_PROG_INSTALL_STRIP AC_REQUIRE([AM_PROG_MKDIR_P])dnl # We need awk for the "check" target. The system "awk" is bad on # some platforms. AC_REQUIRE([AC_PROG_AWK])dnl AC_REQUIRE([AC_PROG_MAKE_SET])dnl AC_REQUIRE([AM_SET_LEADING_DOT])dnl _AM_IF_OPTION([tar-ustar], [_AM_PROG_TAR([ustar])], [_AM_IF_OPTION([tar-pax], [_AM_PROG_TAR([pax])], [_AM_PROG_TAR([v7])])]) _AM_IF_OPTION([no-dependencies],, [AC_PROVIDE_IFELSE([AC_PROG_CC], [_AM_DEPENDENCIES(CC)], [define([AC_PROG_CC], defn([AC_PROG_CC])[_AM_DEPENDENCIES(CC)])])dnl AC_PROVIDE_IFELSE([AC_PROG_CXX], [_AM_DEPENDENCIES(CXX)], [define([AC_PROG_CXX], defn([AC_PROG_CXX])[_AM_DEPENDENCIES(CXX)])])dnl AC_PROVIDE_IFELSE([AC_PROG_OBJC], [_AM_DEPENDENCIES(OBJC)], [define([AC_PROG_OBJC], defn([AC_PROG_OBJC])[_AM_DEPENDENCIES(OBJC)])])dnl ]) ]) # When config.status generates a header, we must update the stamp-h file. # This file resides in the same directory as the config header # that is generated. The stamp files are numbered to have different names. # Autoconf calls _AC_AM_CONFIG_HEADER_HOOK (when defined) in the # loop where config.status creates the headers, so we can generate # our stamp files there. AC_DEFUN([_AC_AM_CONFIG_HEADER_HOOK], [# Compute $1's index in $config_headers. _am_arg=$1 _am_stamp_count=1 for _am_header in $config_headers :; do case $_am_header in $_am_arg | $_am_arg:* ) break ;; * ) _am_stamp_count=`expr $_am_stamp_count + 1` ;; esac done echo "timestamp for $_am_arg" >`AS_DIRNAME(["$_am_arg"])`/stamp-h[]$_am_stamp_count]) # Copyright (C) 2001, 2003, 2005 Free Software Foundation, Inc. # # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. # AM_PROG_INSTALL_SH # ------------------ # Define $install_sh. AC_DEFUN([AM_PROG_INSTALL_SH], [AC_REQUIRE([AM_AUX_DIR_EXPAND])dnl install_sh=${install_sh-"\$(SHELL) $am_aux_dir/install-sh"} AC_SUBST(install_sh)]) # Copyright (C) 2003, 2005 Free Software Foundation, Inc. # # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. # serial 2 # Check whether the underlying file-system supports filenames # with a leading dot. For instance MS-DOS doesn't. AC_DEFUN([AM_SET_LEADING_DOT], [rm -rf .tst 2>/dev/null mkdir .tst 2>/dev/null if test -d .tst; then am__leading_dot=. else am__leading_dot=_ fi rmdir .tst 2>/dev/null AC_SUBST([am__leading_dot])]) # Fake the existence of programs that GNU maintainers use. -*- Autoconf -*- # Copyright (C) 1997, 1999, 2000, 2001, 2003, 2004, 2005 # Free Software Foundation, Inc. # # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. # serial 5 # AM_MISSING_PROG(NAME, PROGRAM) # ------------------------------ AC_DEFUN([AM_MISSING_PROG], [AC_REQUIRE([AM_MISSING_HAS_RUN]) $1=${$1-"${am_missing_run}$2"} AC_SUBST($1)]) # AM_MISSING_HAS_RUN # ------------------ # Define MISSING if not defined so far and test if it supports --run. # If it does, set am_missing_run to use it, otherwise, to nothing. AC_DEFUN([AM_MISSING_HAS_RUN], [AC_REQUIRE([AM_AUX_DIR_EXPAND])dnl AC_REQUIRE_AUX_FILE([missing])dnl test x"${MISSING+set}" = xset || MISSING="\${SHELL} $am_aux_dir/missing" # Use eval to expand $SHELL if eval "$MISSING --run true"; then am_missing_run="$MISSING --run " else am_missing_run= AC_MSG_WARN([`missing' script is too old or missing]) fi ]) # Copyright (C) 2003, 2004, 2005, 2006 Free Software Foundation, Inc. # # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. # AM_PROG_MKDIR_P # --------------- # Check for `mkdir -p'. AC_DEFUN([AM_PROG_MKDIR_P], [AC_PREREQ([2.60])dnl AC_REQUIRE([AC_PROG_MKDIR_P])dnl dnl Automake 1.8 to 1.9.6 used to define mkdir_p. We now use MKDIR_P, dnl while keeping a definition of mkdir_p for backward compatibility. dnl @MKDIR_P@ is magic: AC_OUTPUT adjusts its value for each Makefile. dnl However we cannot define mkdir_p as $(MKDIR_P) for the sake of dnl Makefile.ins that do not define MKDIR_P, so we do our own dnl adjustment using top_builddir (which is defined more often than dnl MKDIR_P). AC_SUBST([mkdir_p], ["$MKDIR_P"])dnl case $mkdir_p in [[\\/$]]* | ?:[[\\/]]*) ;; */*) mkdir_p="\$(top_builddir)/$mkdir_p" ;; esac ]) # Helper functions for option handling. -*- Autoconf -*- # Copyright (C) 2001, 2002, 2003, 2005 Free Software Foundation, Inc. # # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. # serial 3 # _AM_MANGLE_OPTION(NAME) # ----------------------- AC_DEFUN([_AM_MANGLE_OPTION], [[_AM_OPTION_]m4_bpatsubst($1, [[^a-zA-Z0-9_]], [_])]) # _AM_SET_OPTION(NAME) # ------------------------------ # Set option NAME. Presently that only means defining a flag for this option. AC_DEFUN([_AM_SET_OPTION], [m4_define(_AM_MANGLE_OPTION([$1]), 1)]) # _AM_SET_OPTIONS(OPTIONS) # ---------------------------------- # OPTIONS is a space-separated list of Automake options. AC_DEFUN([_AM_SET_OPTIONS], [AC_FOREACH([_AM_Option], [$1], [_AM_SET_OPTION(_AM_Option)])]) # _AM_IF_OPTION(OPTION, IF-SET, [IF-NOT-SET]) # ------------------------------------------- # Execute IF-SET if OPTION is set, IF-NOT-SET otherwise. AC_DEFUN([_AM_IF_OPTION], [m4_ifset(_AM_MANGLE_OPTION([$1]), [$2], [$3])]) # Check to make sure that the build environment is sane. -*- Autoconf -*- # Copyright (C) 1996, 1997, 2000, 2001, 2003, 2005 # Free Software Foundation, Inc. # # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. # serial 4 # AM_SANITY_CHECK # --------------- AC_DEFUN([AM_SANITY_CHECK], [AC_MSG_CHECKING([whether build environment is sane]) # Just in case sleep 1 echo timestamp > conftest.file # Do `set' in a subshell so we don't clobber the current shell's # arguments. Must try -L first in case configure is actually a # symlink; some systems play weird games with the mod time of symlinks # (eg FreeBSD returns the mod time of the symlink's containing # directory). if ( set X `ls -Lt $srcdir/configure conftest.file 2> /dev/null` if test "$[*]" = "X"; then # -L didn't work. set X `ls -t $srcdir/configure conftest.file` fi rm -f conftest.file if test "$[*]" != "X $srcdir/configure conftest.file" \ && test "$[*]" != "X conftest.file $srcdir/configure"; then # If neither matched, then we have a broken ls. This can happen # if, for instance, CONFIG_SHELL is bash and it inherits a # broken ls alias from the environment. This has actually # happened. Such a system could not be considered "sane". AC_MSG_ERROR([ls -t appears to fail. Make sure there is not a broken alias in your environment]) fi test "$[2]" = conftest.file ) then # Ok. : else AC_MSG_ERROR([newly created file is older than distributed files! Check your system clock]) fi AC_MSG_RESULT(yes)]) # Copyright (C) 2001, 2003, 2005 Free Software Foundation, Inc. # # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. # AM_PROG_INSTALL_STRIP # --------------------- # One issue with vendor `install' (even GNU) is that you can't # specify the program used to strip binaries. This is especially # annoying in cross-compiling environments, where the build's strip # is unlikely to handle the host's binaries. # Fortunately install-sh will honor a STRIPPROG variable, so we # always use install-sh in `make install-strip', and initialize # STRIPPROG with the value of the STRIP variable (set by the user). AC_DEFUN([AM_PROG_INSTALL_STRIP], [AC_REQUIRE([AM_PROG_INSTALL_SH])dnl # Installed binaries are usually stripped using `strip' when the user # run `make install-strip'. However `strip' might not be the right # tool to use in cross-compilation environments, therefore Automake # will honor the `STRIP' environment variable to overrule this program. dnl Don't test for $cross_compiling = yes, because it might be `maybe'. if test "$cross_compiling" != no; then AC_CHECK_TOOL([STRIP], [strip], :) fi INSTALL_STRIP_PROGRAM="\$(install_sh) -c -s" AC_SUBST([INSTALL_STRIP_PROGRAM])]) # Copyright (C) 2006 Free Software Foundation, Inc. # # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. # _AM_SUBST_NOTMAKE(VARIABLE) # --------------------------- # Prevent Automake from outputting VARIABLE = @VARIABLE@ in Makefile.in. # This macro is traced by Automake. AC_DEFUN([_AM_SUBST_NOTMAKE]) # Check how to create a tarball. -*- Autoconf -*- # Copyright (C) 2004, 2005 Free Software Foundation, Inc. # # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. # serial 2 # _AM_PROG_TAR(FORMAT) # -------------------- # Check how to create a tarball in format FORMAT. # FORMAT should be one of `v7', `ustar', or `pax'. # # Substitute a variable $(am__tar) that is a command # writing to stdout a FORMAT-tarball containing the directory # $tardir. # tardir=directory && $(am__tar) > result.tar # # Substitute a variable $(am__untar) that extract such # a tarball read from stdin. # $(am__untar) < result.tar AC_DEFUN([_AM_PROG_TAR], [# Always define AMTAR for backward compatibility. AM_MISSING_PROG([AMTAR], [tar]) m4_if([$1], [v7], [am__tar='${AMTAR} chof - "$$tardir"'; am__untar='${AMTAR} xf -'], [m4_case([$1], [ustar],, [pax],, [m4_fatal([Unknown tar format])]) AC_MSG_CHECKING([how to create a $1 tar archive]) # Loop over all known methods to create a tar archive until one works. _am_tools='gnutar m4_if([$1], [ustar], [plaintar]) pax cpio none' _am_tools=${am_cv_prog_tar_$1-$_am_tools} # Do not fold the above two line into one, because Tru64 sh and # Solaris sh will not grok spaces in the rhs of `-'. for _am_tool in $_am_tools do case $_am_tool in gnutar) for _am_tar in tar gnutar gtar; do AM_RUN_LOG([$_am_tar --version]) && break done am__tar="$_am_tar --format=m4_if([$1], [pax], [posix], [$1]) -chf - "'"$$tardir"' am__tar_="$_am_tar --format=m4_if([$1], [pax], [posix], [$1]) -chf - "'"$tardir"' am__untar="$_am_tar -xf -" ;; plaintar) # Must skip GNU tar: if it does not support --format= it doesn't create # ustar tarball either. (tar --version) >/dev/null 2>&1 && continue am__tar='tar chf - "$$tardir"' am__tar_='tar chf - "$tardir"' am__untar='tar xf -' ;; pax) am__tar='pax -L -x $1 -w "$$tardir"' am__tar_='pax -L -x $1 -w "$tardir"' am__untar='pax -r' ;; cpio) am__tar='find "$$tardir" -print | cpio -o -H $1 -L' am__tar_='find "$tardir" -print | cpio -o -H $1 -L' am__untar='cpio -i -H $1 -d' ;; none) am__tar=false am__tar_=false am__untar=false ;; esac # If the value was cached, stop now. We just wanted to have am__tar # and am__untar set. test -n "${am_cv_prog_tar_$1}" && break # tar/untar a dummy directory, and stop if the command works rm -rf conftest.dir mkdir conftest.dir echo GrepMe > conftest.dir/file AM_RUN_LOG([tardir=conftest.dir && eval $am__tar_ >conftest.tar]) rm -rf conftest.dir if test -s conftest.tar; then AM_RUN_LOG([$am__untar /dev/null 2>&1 && break fi done rm -rf conftest.dir AC_CACHE_VAL([am_cv_prog_tar_$1], [am_cv_prog_tar_$1=$_am_tool]) AC_MSG_RESULT([$am_cv_prog_tar_$1])]) AC_SUBST([am__tar]) AC_SUBST([am__untar]) ]) # _AM_PROG_TAR m4_include([config/m4/fortran.m4]) etsf_io-1.0.3/Makefile.am0000644000353400050630000000041011353164673012127 00000000000000if BUILD_TUTORIALS subdir_tutorials = src/tutorials else subdir_tutorials = endif ACLOCAL_AMFLAGS = -I config/m4 SUBDIRS = \ src/low_level \ src/group_level \ src/utils \ tests/low_level \ tests/group_level \ tests/utils \ doc/www \ $(subdir_tutorials) etsf_io-1.0.3/Makefile.in0000644000353400050620000004470011354150421012134 00000000000000# Makefile.in generated by automake 1.10.1 from Makefile.am. # @configure_input@ # Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, # 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. # This Makefile.in is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY, to the extent permitted by law; without # even the implied warranty of MERCHANTABILITY or FITNESS FOR A # PARTICULAR PURPOSE. @SET_MAKE@ VPATH = @srcdir@ pkgdatadir = $(datadir)/@PACKAGE@ pkglibdir = $(libdir)/@PACKAGE@ pkgincludedir = $(includedir)/@PACKAGE@ am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd install_sh_DATA = $(install_sh) -c -m 644 install_sh_PROGRAM = $(install_sh) -c install_sh_SCRIPT = $(install_sh) -c INSTALL_HEADER = $(INSTALL_DATA) transform = $(program_transform_name) NORMAL_INSTALL = : PRE_INSTALL = : POST_INSTALL = : NORMAL_UNINSTALL = : PRE_UNINSTALL = : POST_UNINSTALL = : subdir = . DIST_COMMON = README $(am__configure_deps) $(srcdir)/Makefile.am \ $(srcdir)/Makefile.in $(top_srcdir)/configure AUTHORS COPYING \ ChangeLog INSTALL NEWS TODO config/install-sh config/missing ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 am__aclocal_m4_deps = $(top_srcdir)/config/m4/fortran.m4 \ $(top_srcdir)/configure.ac am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ $(ACLOCAL_M4) am__CONFIG_DISTCLEAN_FILES = config.status config.cache config.log \ configure.lineno config.status.lineno mkinstalldirs = $(install_sh) -d CONFIG_CLEAN_FILES = SOURCES = DIST_SOURCES = RECURSIVE_TARGETS = all-recursive check-recursive dvi-recursive \ html-recursive info-recursive install-data-recursive \ install-dvi-recursive install-exec-recursive \ install-html-recursive install-info-recursive \ install-pdf-recursive install-ps-recursive install-recursive \ installcheck-recursive installdirs-recursive pdf-recursive \ ps-recursive uninstall-recursive RECURSIVE_CLEAN_TARGETS = mostlyclean-recursive clean-recursive \ distclean-recursive maintainer-clean-recursive ETAGS = etags CTAGS = ctags DIST_SUBDIRS = src/low_level src/group_level src/utils tests/low_level \ tests/group_level tests/utils doc/www src/tutorials DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) distdir = $(PACKAGE)-$(VERSION) top_distdir = $(distdir) am__remove_distdir = \ { test ! -d $(distdir) \ || { find $(distdir) -type d ! -perm -200 -exec chmod u+w {} ';' \ && rm -fr $(distdir); }; } DIST_ARCHIVES = $(distdir).tar.gz GZIP_ENV = --best distuninstallcheck_listfiles = find . -type f -print distcleancheck_listfiles = find . -type f -print ACLOCAL = @ACLOCAL@ AMTAR = @AMTAR@ AR = @AR@ AUTOCONF = @AUTOCONF@ AUTOHEADER = @AUTOHEADER@ AUTOMAKE = @AUTOMAKE@ AWK = @AWK@ CYGPATH_W = @CYGPATH_W@ DEFS = @DEFS@ ECHO_C = @ECHO_C@ ECHO_N = @ECHO_N@ ECHO_T = @ECHO_T@ EXEEXT = @EXEEXT@ FC = @FC@ FCFLAGS = @FCFLAGS@ FCFLAGS_f90 = @FCFLAGS_f90@ FFLAGS = @FFLAGS@ INSTALL = @INSTALL@ INSTALL_DATA = @INSTALL_DATA@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ INSTALL_SCRIPT = @INSTALL_SCRIPT@ INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ LDFLAGS = @LDFLAGS@ LIBOBJS = @LIBOBJS@ LIBS = @LIBS@ LTLIBOBJS = @LTLIBOBJS@ MAKEINFO = @MAKEINFO@ MKDIR_P = @MKDIR_P@ MODULE_EXT = @MODULE_EXT@ NETCDF_CFLAGS = @NETCDF_CFLAGS@ OBJEXT = @OBJEXT@ PACKAGE = @PACKAGE@ PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ PACKAGE_NAME = @PACKAGE_NAME@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_VERSION = @PACKAGE_VERSION@ PATH_SEPARATOR = @PATH_SEPARATOR@ RANLIB = @RANLIB@ SET_MAKE = @SET_MAKE@ SHELL = @SHELL@ STRIP = @STRIP@ VERSION = @VERSION@ abs_builddir = @abs_builddir@ abs_srcdir = @abs_srcdir@ abs_top_builddir = @abs_top_builddir@ abs_top_srcdir = @abs_top_srcdir@ ac_ct_FC = @ac_ct_FC@ am__leading_dot = @am__leading_dot@ am__tar = @am__tar@ am__untar = @am__untar@ bindir = @bindir@ build_alias = @build_alias@ builddir = @builddir@ datadir = @datadir@ datarootdir = @datarootdir@ docdir = @docdir@ dvidir = @dvidir@ exec_prefix = @exec_prefix@ fc_type = @fc_type@ fc_version = @fc_version@ fc_wrap = @fc_wrap@ groupleveldocdir = @groupleveldocdir@ host_alias = @host_alias@ htmldir = @htmldir@ includedir = @includedir@ infodir = @infodir@ install_sh = @install_sh@ libdir = @libdir@ libexecdir = @libexecdir@ localedir = @localedir@ localstatedir = @localstatedir@ lowleveldocdir = @lowleveldocdir@ mandir = @mandir@ mkdir_p = @mkdir_p@ moduledir = @moduledir@ oldincludedir = @oldincludedir@ pdfdir = @pdfdir@ prefix = @prefix@ program_transform_name = @program_transform_name@ psdir = @psdir@ sbindir = @sbindir@ sharedstatedir = @sharedstatedir@ srcdir = @srcdir@ sysconfdir = @sysconfdir@ target_alias = @target_alias@ top_builddir = @top_builddir@ top_srcdir = @top_srcdir@ tutorialsdocdir = @tutorialsdocdir@ utilsdocdir = @utilsdocdir@ @BUILD_TUTORIALS_FALSE@subdir_tutorials = @BUILD_TUTORIALS_TRUE@subdir_tutorials = src/tutorials ACLOCAL_AMFLAGS = -I config/m4 SUBDIRS = \ src/low_level \ src/group_level \ src/utils \ tests/low_level \ tests/group_level \ tests/utils \ doc/www \ $(subdir_tutorials) all: all-recursive .SUFFIXES: am--refresh: @: $(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) @for dep in $?; do \ case '$(am__configure_deps)' in \ *$$dep*) \ echo ' cd $(srcdir) && $(AUTOMAKE) --gnu '; \ cd $(srcdir) && $(AUTOMAKE) --gnu \ && exit 0; \ exit 1;; \ esac; \ done; \ echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu Makefile'; \ cd $(top_srcdir) && \ $(AUTOMAKE) --gnu Makefile .PRECIOUS: Makefile Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status @case '$?' in \ *config.status*) \ echo ' $(SHELL) ./config.status'; \ $(SHELL) ./config.status;; \ *) \ echo ' cd $(top_builddir) && $(SHELL) ./config.status $@ $(am__depfiles_maybe)'; \ cd $(top_builddir) && $(SHELL) ./config.status $@ $(am__depfiles_maybe);; \ esac; $(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) $(SHELL) ./config.status --recheck $(top_srcdir)/configure: $(am__configure_deps) cd $(srcdir) && $(AUTOCONF) $(ACLOCAL_M4): $(am__aclocal_m4_deps) cd $(srcdir) && $(ACLOCAL) $(ACLOCAL_AMFLAGS) # This directory's subdirectories are mostly independent; you can cd # into them and run `make' without going through this Makefile. # To change the values of `make' variables: instead of editing Makefiles, # (1) if the variable is set in `config.status', edit `config.status' # (which will cause the Makefiles to be regenerated when you run `make'); # (2) otherwise, pass the desired values on the `make' command line. $(RECURSIVE_TARGETS): @failcom='exit 1'; \ for f in x $$MAKEFLAGS; do \ case $$f in \ *=* | --[!k]*);; \ *k*) failcom='fail=yes';; \ esac; \ done; \ dot_seen=no; \ target=`echo $@ | sed s/-recursive//`; \ list='$(SUBDIRS)'; for subdir in $$list; do \ echo "Making $$target in $$subdir"; \ if test "$$subdir" = "."; then \ dot_seen=yes; \ local_target="$$target-am"; \ else \ local_target="$$target"; \ fi; \ (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \ || eval $$failcom; \ done; \ if test "$$dot_seen" = "no"; then \ $(MAKE) $(AM_MAKEFLAGS) "$$target-am" || exit 1; \ fi; test -z "$$fail" $(RECURSIVE_CLEAN_TARGETS): @failcom='exit 1'; \ for f in x $$MAKEFLAGS; do \ case $$f in \ *=* | --[!k]*);; \ *k*) failcom='fail=yes';; \ esac; \ done; \ dot_seen=no; \ case "$@" in \ distclean-* | maintainer-clean-*) list='$(DIST_SUBDIRS)' ;; \ *) list='$(SUBDIRS)' ;; \ esac; \ rev=''; for subdir in $$list; do \ if test "$$subdir" = "."; then :; else \ rev="$$subdir $$rev"; \ fi; \ done; \ rev="$$rev ."; \ target=`echo $@ | sed s/-recursive//`; \ for subdir in $$rev; do \ echo "Making $$target in $$subdir"; \ if test "$$subdir" = "."; then \ local_target="$$target-am"; \ else \ local_target="$$target"; \ fi; \ (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \ || eval $$failcom; \ done && test -z "$$fail" tags-recursive: list='$(SUBDIRS)'; for subdir in $$list; do \ test "$$subdir" = . || (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) tags); \ done ctags-recursive: list='$(SUBDIRS)'; for subdir in $$list; do \ test "$$subdir" = . || (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) ctags); \ done ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES) list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ unique=`for i in $$list; do \ if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ done | \ $(AWK) '{ files[$$0] = 1; nonemtpy = 1; } \ END { if (nonempty) { for (i in files) print i; }; }'`; \ mkid -fID $$unique tags: TAGS TAGS: tags-recursive $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \ $(TAGS_FILES) $(LISP) tags=; \ here=`pwd`; \ if ($(ETAGS) --etags-include --version) >/dev/null 2>&1; then \ include_option=--etags-include; \ empty_fix=.; \ else \ include_option=--include; \ empty_fix=; \ fi; \ list='$(SUBDIRS)'; for subdir in $$list; do \ if test "$$subdir" = .; then :; else \ test ! -f $$subdir/TAGS || \ tags="$$tags $$include_option=$$here/$$subdir/TAGS"; \ fi; \ done; \ list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ unique=`for i in $$list; do \ if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ done | \ $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ END { if (nonempty) { for (i in files) print i; }; }'`; \ if test -z "$(ETAGS_ARGS)$$tags$$unique"; then :; else \ test -n "$$unique" || unique=$$empty_fix; \ $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ $$tags $$unique; \ fi ctags: CTAGS CTAGS: ctags-recursive $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \ $(TAGS_FILES) $(LISP) tags=; \ list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ unique=`for i in $$list; do \ if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ done | \ $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ END { if (nonempty) { for (i in files) print i; }; }'`; \ test -z "$(CTAGS_ARGS)$$tags$$unique" \ || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ $$tags $$unique GTAGS: here=`$(am__cd) $(top_builddir) && pwd` \ && cd $(top_srcdir) \ && gtags -i $(GTAGS_ARGS) $$here distclean-tags: -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags distdir: $(DISTFILES) $(am__remove_distdir) test -d $(distdir) || mkdir $(distdir) @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ list='$(DISTFILES)'; \ dist_files=`for file in $$list; do echo $$file; done | \ sed -e "s|^$$srcdirstrip/||;t" \ -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ case $$dist_files in \ */*) $(MKDIR_P) `echo "$$dist_files" | \ sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ sort -u` ;; \ esac; \ for file in $$dist_files; do \ if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ if test -d $$d/$$file; then \ dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ cp -pR $(srcdir)/$$file $(distdir)$$dir || exit 1; \ fi; \ cp -pR $$d/$$file $(distdir)$$dir || exit 1; \ else \ test -f $(distdir)/$$file \ || cp -p $$d/$$file $(distdir)/$$file \ || exit 1; \ fi; \ done list='$(DIST_SUBDIRS)'; for subdir in $$list; do \ if test "$$subdir" = .; then :; else \ test -d "$(distdir)/$$subdir" \ || $(MKDIR_P) "$(distdir)/$$subdir" \ || exit 1; \ distdir=`$(am__cd) $(distdir) && pwd`; \ top_distdir=`$(am__cd) $(top_distdir) && pwd`; \ (cd $$subdir && \ $(MAKE) $(AM_MAKEFLAGS) \ top_distdir="$$top_distdir" \ distdir="$$distdir/$$subdir" \ am__remove_distdir=: \ am__skip_length_check=: \ distdir) \ || exit 1; \ fi; \ done -find $(distdir) -type d ! -perm -777 -exec chmod a+rwx {} \; -o \ ! -type d ! -perm -444 -links 1 -exec chmod a+r {} \; -o \ ! -type d ! -perm -400 -exec chmod a+r {} \; -o \ ! -type d ! -perm -444 -exec $(install_sh) -c -m a+r {} {} \; \ || chmod -R a+r $(distdir) dist-gzip: distdir tardir=$(distdir) && $(am__tar) | GZIP=$(GZIP_ENV) gzip -c >$(distdir).tar.gz $(am__remove_distdir) dist-bzip2: distdir tardir=$(distdir) && $(am__tar) | bzip2 -9 -c >$(distdir).tar.bz2 $(am__remove_distdir) dist-lzma: distdir tardir=$(distdir) && $(am__tar) | lzma -9 -c >$(distdir).tar.lzma $(am__remove_distdir) dist-tarZ: distdir tardir=$(distdir) && $(am__tar) | compress -c >$(distdir).tar.Z $(am__remove_distdir) dist-shar: distdir shar $(distdir) | GZIP=$(GZIP_ENV) gzip -c >$(distdir).shar.gz $(am__remove_distdir) dist-zip: distdir -rm -f $(distdir).zip zip -rq $(distdir).zip $(distdir) $(am__remove_distdir) dist dist-all: distdir tardir=$(distdir) && $(am__tar) | GZIP=$(GZIP_ENV) gzip -c >$(distdir).tar.gz $(am__remove_distdir) # This target untars the dist file and tries a VPATH configuration. Then # it guarantees that the distribution is self-contained by making another # tarfile. distcheck: dist case '$(DIST_ARCHIVES)' in \ *.tar.gz*) \ GZIP=$(GZIP_ENV) gunzip -c $(distdir).tar.gz | $(am__untar) ;;\ *.tar.bz2*) \ bunzip2 -c $(distdir).tar.bz2 | $(am__untar) ;;\ *.tar.lzma*) \ unlzma -c $(distdir).tar.lzma | $(am__untar) ;;\ *.tar.Z*) \ uncompress -c $(distdir).tar.Z | $(am__untar) ;;\ *.shar.gz*) \ GZIP=$(GZIP_ENV) gunzip -c $(distdir).shar.gz | unshar ;;\ *.zip*) \ unzip $(distdir).zip ;;\ esac chmod -R a-w $(distdir); chmod a+w $(distdir) mkdir $(distdir)/_build mkdir $(distdir)/_inst chmod a-w $(distdir) dc_install_base=`$(am__cd) $(distdir)/_inst && pwd | sed -e 's,^[^:\\/]:[\\/],/,'` \ && dc_destdir="$${TMPDIR-/tmp}/am-dc-$$$$/" \ && cd $(distdir)/_build \ && ../configure --srcdir=.. --prefix="$$dc_install_base" \ $(DISTCHECK_CONFIGURE_FLAGS) \ && $(MAKE) $(AM_MAKEFLAGS) \ && $(MAKE) $(AM_MAKEFLAGS) dvi \ && $(MAKE) $(AM_MAKEFLAGS) check \ && $(MAKE) $(AM_MAKEFLAGS) install \ && $(MAKE) $(AM_MAKEFLAGS) installcheck \ && $(MAKE) $(AM_MAKEFLAGS) uninstall \ && $(MAKE) $(AM_MAKEFLAGS) distuninstallcheck_dir="$$dc_install_base" \ distuninstallcheck \ && chmod -R a-w "$$dc_install_base" \ && ({ \ (cd ../.. && umask 077 && mkdir "$$dc_destdir") \ && $(MAKE) $(AM_MAKEFLAGS) DESTDIR="$$dc_destdir" install \ && $(MAKE) $(AM_MAKEFLAGS) DESTDIR="$$dc_destdir" uninstall \ && $(MAKE) $(AM_MAKEFLAGS) DESTDIR="$$dc_destdir" \ distuninstallcheck_dir="$$dc_destdir" distuninstallcheck; \ } || { rm -rf "$$dc_destdir"; exit 1; }) \ && rm -rf "$$dc_destdir" \ && $(MAKE) $(AM_MAKEFLAGS) dist \ && rm -rf $(DIST_ARCHIVES) \ && $(MAKE) $(AM_MAKEFLAGS) distcleancheck $(am__remove_distdir) @(echo "$(distdir) archives ready for distribution: "; \ list='$(DIST_ARCHIVES)'; for i in $$list; do echo $$i; done) | \ sed -e 1h -e 1s/./=/g -e 1p -e 1x -e '$$p' -e '$$x' distuninstallcheck: @cd $(distuninstallcheck_dir) \ && test `$(distuninstallcheck_listfiles) | wc -l` -le 1 \ || { echo "ERROR: files left after uninstall:" ; \ if test -n "$(DESTDIR)"; then \ echo " (check DESTDIR support)"; \ fi ; \ $(distuninstallcheck_listfiles) ; \ exit 1; } >&2 distcleancheck: distclean @if test '$(srcdir)' = . ; then \ echo "ERROR: distcleancheck can only run from a VPATH build" ; \ exit 1 ; \ fi @test `$(distcleancheck_listfiles) | wc -l` -eq 0 \ || { echo "ERROR: files left in build directory after distclean:" ; \ $(distcleancheck_listfiles) ; \ exit 1; } >&2 check-am: all-am check: check-recursive all-am: Makefile installdirs: installdirs-recursive installdirs-am: install: install-recursive install-exec: install-exec-recursive install-data: install-data-recursive uninstall: uninstall-recursive install-am: all-am @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am installcheck: installcheck-recursive install-strip: $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ `test -z '$(STRIP)' || \ echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install mostlyclean-generic: clean-generic: distclean-generic: -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) maintainer-clean-generic: @echo "This command is intended for maintainers to use" @echo "it deletes files that may require special tools to rebuild." clean: clean-recursive clean-am: clean-generic mostlyclean-am distclean: distclean-recursive -rm -f $(am__CONFIG_DISTCLEAN_FILES) -rm -f Makefile distclean-am: clean-am distclean-generic distclean-tags dvi: dvi-recursive dvi-am: html: html-recursive info: info-recursive info-am: install-data-am: install-dvi: install-dvi-recursive install-exec-am: install-html: install-html-recursive install-info: install-info-recursive install-man: install-pdf: install-pdf-recursive install-ps: install-ps-recursive installcheck-am: maintainer-clean: maintainer-clean-recursive -rm -f $(am__CONFIG_DISTCLEAN_FILES) -rm -rf $(top_srcdir)/autom4te.cache -rm -f Makefile maintainer-clean-am: distclean-am maintainer-clean-generic mostlyclean: mostlyclean-recursive mostlyclean-am: mostlyclean-generic pdf: pdf-recursive pdf-am: ps: ps-recursive ps-am: uninstall-am: .MAKE: $(RECURSIVE_CLEAN_TARGETS) $(RECURSIVE_TARGETS) install-am \ install-strip .PHONY: $(RECURSIVE_CLEAN_TARGETS) $(RECURSIVE_TARGETS) CTAGS GTAGS \ all all-am am--refresh check check-am clean clean-generic \ ctags ctags-recursive dist dist-all dist-bzip2 dist-gzip \ dist-lzma dist-shar dist-tarZ dist-zip distcheck distclean \ distclean-generic distclean-tags distcleancheck distdir \ distuninstallcheck dvi dvi-am html html-am info info-am \ install install-am install-data install-data-am install-dvi \ install-dvi-am install-exec install-exec-am install-html \ install-html-am install-info install-info-am install-man \ install-pdf install-pdf-am install-ps install-ps-am \ install-strip installcheck installcheck-am installdirs \ installdirs-am maintainer-clean maintainer-clean-generic \ mostlyclean mostlyclean-generic pdf pdf-am ps ps-am tags \ tags-recursive uninstall uninstall-am # Tell versions [3.59,3.63) of GNU make to not export all variables. # Otherwise a system limit (for SysV at least) may be exceeded. .NOEXPORT: etsf_io-1.0.3/configure0000754000353400050620000043226311353170337012011 00000000000000#! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated by GNU Autoconf 2.61 for ETSF - IO library 1.0.3. # # Report bugs to . # # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, # 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix ;; esac fi # PATH needs CR # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # IFS # We need space, tab and new line, in precisely that order. Quoting is # there to prevent editors from complaining about space-tab. # (If _AS_PATH_WALK were called with IFS unset, it would disable word # splitting by setting IFS to empty value.) as_nl=' ' IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 { (exit 1); exit 1; } fi # Work around bugs in pre-3.0 UWIN ksh. for as_var in ENV MAIL MAILPATH do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var done PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # CDPATH. $as_unset CDPATH if test "x$CONFIG_SHELL" = x; then if (eval ":") 2>/dev/null; then as_have_required=yes else as_have_required=no fi if test $as_have_required = yes && (eval ": (as_func_return () { (exit \$1) } as_func_success () { as_func_return 0 } as_func_failure () { as_func_return 1 } as_func_ret_success () { return 0 } as_func_ret_failure () { return 1 } exitcode=0 if as_func_success; then : else exitcode=1 echo as_func_success failed. fi if as_func_failure; then exitcode=1 echo as_func_failure succeeded. fi if as_func_ret_success; then : else exitcode=1 echo as_func_ret_success failed. fi if as_func_ret_failure; then exitcode=1 echo as_func_ret_failure succeeded. fi if ( set x; as_func_ret_success y && test x = \"\$1\" ); then : else exitcode=1 echo positional parameters were not saved. fi test \$exitcode = 0) || { (exit 1); exit 1; } ( as_lineno_1=\$LINENO as_lineno_2=\$LINENO test \"x\$as_lineno_1\" != \"x\$as_lineno_2\" && test \"x\`expr \$as_lineno_1 + 1\`\" = \"x\$as_lineno_2\") || { (exit 1); exit 1; } ") 2> /dev/null; then : else as_candidate_shells= as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. case $as_dir in /*) for as_base in sh bash ksh sh5; do as_candidate_shells="$as_candidate_shells $as_dir/$as_base" done;; esac done IFS=$as_save_IFS for as_shell in $as_candidate_shells $SHELL; do # Try only shells that exist, to save several forks. if { test -f "$as_shell" || test -f "$as_shell.exe"; } && { ("$as_shell") 2> /dev/null <<\_ASEOF if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix ;; esac fi : _ASEOF }; then CONFIG_SHELL=$as_shell as_have_required=yes if { "$as_shell" 2> /dev/null <<\_ASEOF if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix ;; esac fi : (as_func_return () { (exit $1) } as_func_success () { as_func_return 0 } as_func_failure () { as_func_return 1 } as_func_ret_success () { return 0 } as_func_ret_failure () { return 1 } exitcode=0 if as_func_success; then : else exitcode=1 echo as_func_success failed. fi if as_func_failure; then exitcode=1 echo as_func_failure succeeded. fi if as_func_ret_success; then : else exitcode=1 echo as_func_ret_success failed. fi if as_func_ret_failure; then exitcode=1 echo as_func_ret_failure succeeded. fi if ( set x; as_func_ret_success y && test x = "$1" ); then : else exitcode=1 echo positional parameters were not saved. fi test $exitcode = 0) || { (exit 1); exit 1; } ( as_lineno_1=$LINENO as_lineno_2=$LINENO test "x$as_lineno_1" != "x$as_lineno_2" && test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2") || { (exit 1); exit 1; } _ASEOF }; then break fi fi done if test "x$CONFIG_SHELL" != x; then for as_var in BASH_ENV ENV do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var done export CONFIG_SHELL exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"} fi if test $as_have_required = no; then echo This script requires a shell more modern than all the echo shells that I found on your system. Please install a echo modern shell, or manually run the script under such a echo shell if you do have one. { (exit 1); exit 1; } fi fi fi (eval "as_func_return () { (exit \$1) } as_func_success () { as_func_return 0 } as_func_failure () { as_func_return 1 } as_func_ret_success () { return 0 } as_func_ret_failure () { return 1 } exitcode=0 if as_func_success; then : else exitcode=1 echo as_func_success failed. fi if as_func_failure; then exitcode=1 echo as_func_failure succeeded. fi if as_func_ret_success; then : else exitcode=1 echo as_func_ret_success failed. fi if as_func_ret_failure; then exitcode=1 echo as_func_ret_failure succeeded. fi if ( set x; as_func_ret_success y && test x = \"\$1\" ); then : else exitcode=1 echo positional parameters were not saved. fi test \$exitcode = 0") || { echo No shell found that supports shell functions. echo Please tell autoconf@gnu.org about your system, echo including any error possibly output before this echo message } as_lineno_1=$LINENO as_lineno_2=$LINENO test "x$as_lineno_1" != "x$as_lineno_2" && test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || { # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line after each line using $LINENO; the second 'sed' # does the real work. The second script uses 'N' to pair each # line-number line with the line containing $LINENO, and appends # trailing '-' during substitution so that $LINENO is not a special # case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # scripts with optimization help from Paolo Bonzini. Blame Lee # E. McMahon (1931-1989) for sed's syntax. :-) sed -n ' p /[$]LINENO/= ' <$as_myself | sed ' s/[$]LINENO.*/&-/ t lineno b :lineno N :loop s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ t loop s/-\n.*// ' >$as_me.lineno && chmod +x "$as_me.lineno" || { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this). . "./$as_me.lineno" # Exit status is that of the last command. exit } if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in -n*) case `echo 'x\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. *) ECHO_C='\c';; esac;; *) ECHO_N='-n';; esac if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir fi echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. # In both cases, we have to default to `cp -p'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -p' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi if test -x / >/dev/null 2>&1; then as_test_x='test -x' else if ls -dL / >/dev/null 2>&1; then as_ls_L_option=L else as_ls_L_option= fi as_test_x=' eval sh -c '\'' if test -d "$1"; then test -d "$1/."; else case $1 in -*)set "./$1";; esac; case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in ???[sx]*):;;*)false;;esac;fi '\'' sh ' fi as_executable_p=$as_test_x # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" exec 7<&0 &1 # Name of the host. # hostname on some systems (SVR3.2, Linux) returns a bogus exit status, # so uname gets run too. ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` # # Initializations. # ac_default_prefix=/usr/local ac_clean_files= ac_config_libobj_dir=. LIBOBJS= cross_compiling=no subdirs= MFLAGS= MAKEFLAGS= SHELL=${CONFIG_SHELL-/bin/sh} # Identity of this package. PACKAGE_NAME='ETSF - IO library' PACKAGE_TARNAME='etsf_io' PACKAGE_VERSION='1.0.3' PACKAGE_STRING='ETSF - IO library 1.0.3' PACKAGE_BUGREPORT='damien.caliste@cea.fr' ac_default_prefix=/opt ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datarootdir datadir sysconfdir sharedstatedir localstatedir includedir oldincludedir docdir infodir htmldir dvidir pdfdir psdir libdir localedir mandir DEFS ECHO_C ECHO_N ECHO_T LIBS build_alias host_alias target_alias INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA am__isrc CYGPATH_W PACKAGE VERSION ACLOCAL AUTOCONF AUTOMAKE AUTOHEADER MAKEINFO install_sh STRIP INSTALL_STRIP_PROGRAM mkdir_p AWK SET_MAKE am__leading_dot AMTAR am__tar am__untar FC FCFLAGS LDFLAGS ac_ct_FC EXEEXT OBJEXT FCFLAGS_f90 fc_type fc_version fc_wrap CAPITALIZE_TRUE CAPITALIZE_FALSE MODULE_EXT FFLAGS RANLIB AR NETCDF_CFLAGS BUILD_TUTORIALS_TRUE BUILD_TUTORIALS_FALSE moduledir lowleveldocdir groupleveldocdir utilsdocdir tutorialsdocdir LIBOBJS LTLIBOBJS' ac_subst_files='' ac_precious_vars='build_alias host_alias target_alias FC FCFLAGS LDFLAGS LIBS' # Initialize some variables set by options. ac_init_help= ac_init_version=false # The variables have the same names as the options, with # dashes changed to underlines. cache_file=/dev/null exec_prefix=NONE no_create= no_recursion= prefix=NONE program_prefix=NONE program_suffix=NONE program_transform_name=s,x,x, silent= site= srcdir= verbose= x_includes=NONE x_libraries=NONE # Installation directory options. # These are left unexpanded so users can "make install exec_prefix=/foo" # and all the variables that are supposed to be based on exec_prefix # by default will actually change. # Use braces instead of parens because sh, perl, etc. also accept them. # (The list follows the same order as the GNU Coding Standards.) bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datarootdir='${prefix}/share' datadir='${datarootdir}' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' includedir='${prefix}/include' oldincludedir='/usr/include' docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' infodir='${datarootdir}/info' htmldir='${docdir}' dvidir='${docdir}' pdfdir='${docdir}' psdir='${docdir}' libdir='${exec_prefix}/lib' localedir='${datarootdir}/locale' mandir='${datarootdir}/man' ac_prev= ac_dashdash= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval $ac_prev=\$ac_option ac_prev= continue fi case $ac_option in *=*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; *) ac_optarg=yes ;; esac # Accept the important Cygnus configure options, so we can diagnose typos. case $ac_dashdash$ac_option in --) ac_dashdash=yes ;; -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) bindir=$ac_optarg ;; -build | --build | --buil | --bui | --bu) ac_prev=build_alias ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) build_alias=$ac_optarg ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) cache_file=$ac_optarg ;; --config-cache | -C) cache_file=config.cache ;; -datadir | --datadir | --datadi | --datad) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=*) datadir=$ac_optarg ;; -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ | --dataroo | --dataro | --datar) ac_prev=datarootdir ;; -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) datarootdir=$ac_optarg ;; -disable-* | --disable-*) ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-._$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/[-.]/_/g'` eval enable_$ac_feature=no ;; -docdir | --docdir | --docdi | --doc | --do) ac_prev=docdir ;; -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) docdir=$ac_optarg ;; -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) ac_prev=dvidir ;; -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) dvidir=$ac_optarg ;; -enable-* | --enable-*) ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-._$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/[-.]/_/g'` eval enable_$ac_feature=\$ac_optarg ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ | --exec | --exe | --ex) ac_prev=exec_prefix ;; -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) exec_prefix=$ac_optarg ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; -help | --help | --hel | --he | -h) ac_init_help=long ;; -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) ac_init_help=recursive ;; -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) ac_init_help=short ;; -host | --host | --hos | --ho) ac_prev=host_alias ;; -host=* | --host=* | --hos=* | --ho=*) host_alias=$ac_optarg ;; -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) ac_prev=htmldir ;; -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ | --ht=*) htmldir=$ac_optarg ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) includedir=$ac_optarg ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) infodir=$ac_optarg ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) libdir=$ac_optarg ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) libexecdir=$ac_optarg ;; -localedir | --localedir | --localedi | --localed | --locale) ac_prev=localedir ;; -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) localedir=$ac_optarg ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst | --locals) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) mandir=$ac_optarg ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c | -n) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) no_recursion=yes ;; -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ | --oldin | --oldi | --old | --ol | --o) ac_prev=oldincludedir ;; -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) oldincludedir=$ac_optarg ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) prefix=$ac_optarg ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) program_prefix=$ac_optarg ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) program_suffix=$ac_optarg ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ | --program-transform-n | --program-transform- \ | --program-transform | --program-transfor \ | --program-transfo | --program-transf \ | --program-trans | --program-tran \ | --progr-tra | --program-tr | --program-t) ac_prev=program_transform_name ;; -program-transform-name=* | --program-transform-name=* \ | --program-transform-nam=* | --program-transform-na=* \ | --program-transform-n=* | --program-transform-=* \ | --program-transform=* | --program-transfor=* \ | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name=$ac_optarg ;; -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) ac_prev=pdfdir ;; -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) pdfdir=$ac_optarg ;; -psdir | --psdir | --psdi | --psd | --ps) ac_prev=psdir ;; -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) psdir=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir=$ac_optarg ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ | --sharedst | --shareds | --shared | --share | --shar \ | --sha | --sh) ac_prev=sharedstatedir ;; -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) sharedstatedir=$ac_optarg ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) site=$ac_optarg ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) srcdir=$ac_optarg ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) sysconfdir=$ac_optarg ;; -target | --target | --targe | --targ | --tar | --ta | --t) ac_prev=target_alias ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) target_alias=$ac_optarg ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers | -V) ac_init_version=: ;; -with-* | --with-*) ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-._$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package | sed 's/[-.]/_/g'` eval with_$ac_package=\$ac_optarg ;; -without-* | --without-*) ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-._$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package | sed 's/[-.]/_/g'` eval with_$ac_package=no ;; --x) # Obsolete; use --with-x. with_x=yes ;; -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ | --x-incl | --x-inc | --x-in | --x-i) ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) x_includes=$ac_optarg ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; -*) { echo "$as_me: error: unrecognized option: $ac_option Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; } ;; *=*) ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` # Reject names that are not valid shell variable names. expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid variable name: $ac_envvar" >&2 { (exit 1); exit 1; }; } eval $ac_envvar=\$ac_optarg export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. echo "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && echo "$as_me: WARNING: invalid host type: $ac_option" >&2 : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} ;; esac done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` { echo "$as_me: error: missing argument to $ac_option" >&2 { (exit 1); exit 1; }; } fi # Be sure to have absolute directory names. for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ datadir sysconfdir sharedstatedir localstatedir includedir \ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ libdir localedir mandir do eval ac_val=\$$ac_var case $ac_val in [\\/$]* | ?:[\\/]* ) continue;; NONE | '' ) case $ac_var in *prefix ) continue;; esac;; esac { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 { (exit 1); exit 1; }; } done # There might be people who depend on the old broken behavior: `$host' # used to hold the argument of --host etc. # FIXME: To remove some day. build=$build_alias host=$host_alias target=$target_alias # FIXME: To remove some day. if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. If a cross compiler is detected then cross compile mode will be used." >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi fi ac_tool_prefix= test -n "$host_alias" && ac_tool_prefix=$host_alias- test "$silent" = yes && exec 6>/dev/null ac_pwd=`pwd` && test -n "$ac_pwd" && ac_ls_di=`ls -di .` && ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || { echo "$as_me: error: Working directory cannot be determined" >&2 { (exit 1); exit 1; }; } test "X$ac_ls_di" = "X$ac_pwd_ls_di" || { echo "$as_me: error: pwd does not report name of working directory" >&2 { (exit 1); exit 1; }; } # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then the parent directory. ac_confdir=`$as_dirname -- "$0" || $as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$0" : 'X\(//\)[^/]' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || echo X"$0" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` srcdir=$ac_confdir if test ! -r "$srcdir/$ac_unique_file"; then srcdir=.. fi else ac_srcdir_defaulted=no fi if test ! -r "$srcdir/$ac_unique_file"; then test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 { (exit 1); exit 1; }; } fi ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" ac_abs_confdir=`( cd "$srcdir" && test -r "./$ac_unique_file" || { echo "$as_me: error: $ac_msg" >&2 { (exit 1); exit 1; }; } pwd)` # When building in place, set srcdir=. if test "$ac_abs_confdir" = "$ac_pwd"; then srcdir=. fi # Remove unnecessary trailing slashes from srcdir. # Double slashes in file names in object file debugging info # mess up M-x gdb in Emacs. case $srcdir in */) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; esac for ac_var in $ac_precious_vars; do eval ac_env_${ac_var}_set=\${${ac_var}+set} eval ac_env_${ac_var}_value=\$${ac_var} eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} eval ac_cv_env_${ac_var}_value=\$${ac_var} done # # Report the --help message. # if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF \`configure' configures ETSF - IO library 1.0.3 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. Defaults for the options are specified in brackets. Configuration: -h, --help display this help and exit --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit -q, --quiet, --silent do not print \`checking...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for \`--cache-file=config.cache' -n, --no-create do not create output files --srcdir=DIR find the sources in DIR [configure dir or \`..'] Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [PREFIX] By default, \`make install' will install all the files in \`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify an installation prefix other than \`$ac_default_prefix' using \`--prefix', for instance \`--prefix=\$HOME'. For better control, use the options below. Fine tuning of the installation directories: --bindir=DIR user executables [EPREFIX/bin] --sbindir=DIR system admin executables [EPREFIX/sbin] --libexecdir=DIR program executables [EPREFIX/libexec] --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] --datadir=DIR read-only architecture-independent data [DATAROOTDIR] --infodir=DIR info documentation [DATAROOTDIR/info] --localedir=DIR locale-dependent data [DATAROOTDIR/locale] --mandir=DIR man documentation [DATAROOTDIR/man] --docdir=DIR documentation root [DATAROOTDIR/doc/etsf_io] --htmldir=DIR html documentation [DOCDIR] --dvidir=DIR dvi documentation [DOCDIR] --pdfdir=DIR pdf documentation [DOCDIR] --psdir=DIR ps documentation [DOCDIR] _ACEOF cat <<\_ACEOF Program names: --program-prefix=PREFIX prepend PREFIX to installed program names --program-suffix=SUFFIX append SUFFIX to installed program names --program-transform-name=PROGRAM run sed PROGRAM on installed program names _ACEOF fi if test -n "$ac_init_help"; then case $ac_init_help in short | recursive ) echo "Configuration of ETSF - IO library 1.0.3:";; esac cat <<\_ACEOF Optional Features: --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --enable-build-tutorials Create the tutorial binaries (disable by default). Optional Packages: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --with-netcdf-module-path Give the path of the NetCDF Fortran90 module (default = /usr/include). --with-netcdf-ldflags Give the flags required to link with the NetCDF library (default is -L/usr/lib). --with-moduledir installation directory for module files [INCLUDEDIR/FC_TYPE] Some influential environment variables: FC Fortran compiler command FCFLAGS Fortran compiler flags LDFLAGS linker flags, e.g. -L if you have libraries in a nonstandard directory LIBS libraries to pass to the linker, e.g. -l Use these variables to override the choices made by `configure' or to help it to find libraries and programs with nonstandard names/locations. Report bugs to . _ACEOF ac_status=$? fi if test "$ac_init_help" = "recursive"; then # If there are subdirs, report their specific --help. for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue test -d "$ac_dir" || continue ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,/..,g;s,/,,'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix cd "$ac_dir" || { ac_status=$?; continue; } # Check for guested configure. if test -f "$ac_srcdir/configure.gnu"; then echo && $SHELL "$ac_srcdir/configure.gnu" --help=recursive elif test -f "$ac_srcdir/configure"; then echo && $SHELL "$ac_srcdir/configure" --help=recursive else echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 fi || ac_status=$? cd "$ac_pwd" || { ac_status=$?; break; } done fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF ETSF - IO library configure 1.0.3 generated by GNU Autoconf 2.61 Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF exit fi cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by ETSF - IO library $as_me 1.0.3, which was generated by GNU Autoconf 2.61. Invocation command line was $ $0 $@ _ACEOF exec 5>>config.log { cat <<_ASUNAME ## --------- ## ## Platform. ## ## --------- ## hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` uname -m = `(uname -m) 2>/dev/null || echo unknown` uname -r = `(uname -r) 2>/dev/null || echo unknown` uname -s = `(uname -s) 2>/dev/null || echo unknown` uname -v = `(uname -v) 2>/dev/null || echo unknown` /usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` /bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` /bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` /usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` /usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` /bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` /usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` /bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` _ASUNAME as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. echo "PATH: $as_dir" done IFS=$as_save_IFS } >&5 cat >&5 <<_ACEOF ## ----------- ## ## Core tests. ## ## ----------- ## _ACEOF # Keep a trace of the command line. # Strip out --no-create and --no-recursion so they do not pile up. # Strip out --silent because we don't want to record it for future runs. # Also quote any args containing shell meta-characters. # Make two passes to allow for proper duplicate-argument suppression. ac_configure_args= ac_configure_args0= ac_configure_args1= ac_must_keep_next=false for ac_pass in 1 2 do for ac_arg do case $ac_arg in -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; *\'*) ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac case $ac_pass in 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;; 2) ac_configure_args1="$ac_configure_args1 '$ac_arg'" if test $ac_must_keep_next = true; then ac_must_keep_next=false # Got value, back to normal. else case $ac_arg in *=* | --config-cache | -C | -disable-* | --disable-* \ | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ | -with-* | --with-* | -without-* | --without-* | --x) case "$ac_configure_args0 " in "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; esac ;; -* ) ac_must_keep_next=true ;; esac fi ac_configure_args="$ac_configure_args '$ac_arg'" ;; esac done done $as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; } $as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; } # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. # WARNING: Use '\'' to represent an apostrophe within the trap. # WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. trap 'exit_status=$? # Save into config.log some information that might help in debugging. { echo cat <<\_ASBOX ## ---------------- ## ## Cache variables. ## ## ---------------- ## _ASBOX echo # The following way of writing the cache mishandles newlines in values, ( for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { echo "$as_me:$LINENO: WARNING: Cache variable $ac_var contains a newline." >&5 echo "$as_me: WARNING: Cache variable $ac_var contains a newline." >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( *) $as_unset $ac_var ;; esac ;; esac done (set) 2>&1 | case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( *${as_nl}ac_space=\ *) sed -n \ "s/'\''/'\''\\\\'\'''\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" ;; #( *) sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) echo cat <<\_ASBOX ## ----------------- ## ## Output variables. ## ## ----------------- ## _ASBOX echo for ac_var in $ac_subst_vars do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac echo "$ac_var='\''$ac_val'\''" done | sort echo if test -n "$ac_subst_files"; then cat <<\_ASBOX ## ------------------- ## ## File substitutions. ## ## ------------------- ## _ASBOX echo for ac_var in $ac_subst_files do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac echo "$ac_var='\''$ac_val'\''" done | sort echo fi if test -s confdefs.h; then cat <<\_ASBOX ## ----------- ## ## confdefs.h. ## ## ----------- ## _ASBOX echo cat confdefs.h echo fi test "$ac_signal" != 0 && echo "$as_me: caught signal $ac_signal" echo "$as_me: exit $exit_status" } >&5 rm -f core *.core core.conftest.* && rm -f -r conftest* confdefs* conf$$* $ac_clean_files && exit $exit_status ' 0 for ac_signal in 1 2 13 15; do trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal done ac_signal=0 # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -f -r conftest* confdefs.h # Predefined preprocessor variables. cat >>confdefs.h <<_ACEOF #define PACKAGE_NAME "$PACKAGE_NAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_TARNAME "$PACKAGE_TARNAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_VERSION "$PACKAGE_VERSION" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_STRING "$PACKAGE_STRING" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" _ACEOF # Let the site file select an alternate cache file if it wants to. # Prefer explicitly selected file to automatically selected ones. if test -n "$CONFIG_SITE"; then set x "$CONFIG_SITE" elif test "x$prefix" != xNONE; then set x "$prefix/share/config.site" "$prefix/etc/config.site" else set x "$ac_default_prefix/share/config.site" \ "$ac_default_prefix/etc/config.site" fi shift for ac_site_file do if test -r "$ac_site_file"; then { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5 echo "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" fi done if test -r "$cache_file"; then # Some versions of bash will fail to source /dev/null (special # files actually), so we avoid doing that. if test -f "$cache_file"; then { echo "$as_me:$LINENO: loading cache $cache_file" >&5 echo "$as_me: loading cache $cache_file" >&6;} case $cache_file in [\\/]* | ?:[\\/]* ) . "$cache_file";; *) . "./$cache_file";; esac fi else { echo "$as_me:$LINENO: creating cache $cache_file" >&5 echo "$as_me: creating cache $cache_file" >&6;} >$cache_file fi # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false for ac_var in $ac_precious_vars; do eval ac_old_set=\$ac_cv_env_${ac_var}_set eval ac_new_set=\$ac_env_${ac_var}_set eval ac_old_val=\$ac_cv_env_${ac_var}_value eval ac_new_val=\$ac_env_${ac_var}_value case $ac_old_set,$ac_new_set in set,) { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5 echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} { echo "$as_me:$LINENO: former value: $ac_old_val" >&5 echo "$as_me: former value: $ac_old_val" >&2;} { echo "$as_me:$LINENO: current value: $ac_new_val" >&5 echo "$as_me: current value: $ac_new_val" >&2;} ac_cache_corrupted=: fi;; esac # Pass precious variables to config.status. if test "$ac_new_set" = set; then case $ac_new_val in *\'*) ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; *) ac_arg=$ac_var=$ac_new_val ;; esac case " $ac_configure_args " in *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. *) ac_configure_args="$ac_configure_args '$ac_arg'" ;; esac fi done if $ac_cache_corrupted; then { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5 echo "$as_me: error: changes in the environment can compromise the build" >&2;} { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu ac_aux_dir= for ac_dir in config "$srcdir"/config; do if test -f "$ac_dir/install-sh"; then ac_aux_dir=$ac_dir ac_install_sh="$ac_aux_dir/install-sh -c" break elif test -f "$ac_dir/install.sh"; then ac_aux_dir=$ac_dir ac_install_sh="$ac_aux_dir/install.sh -c" break elif test -f "$ac_dir/shtool"; then ac_aux_dir=$ac_dir ac_install_sh="$ac_aux_dir/shtool install -c" break fi done if test -z "$ac_aux_dir"; then { { echo "$as_me:$LINENO: error: cannot find install-sh or install.sh in config \"$srcdir\"/config" >&5 echo "$as_me: error: cannot find install-sh or install.sh in config \"$srcdir\"/config" >&2;} { (exit 1); exit 1; }; } fi # These three variables are undocumented and unsupported, # and are intended to be withdrawn in a future Autoconf release. # They can cause serious problems if a builder's source tree is in a directory # whose full name contains unusual characters. ac_config_guess="$SHELL $ac_aux_dir/config.guess" # Please don't use this var. ac_config_sub="$SHELL $ac_aux_dir/config.sub" # Please don't use this var. ac_configure="$SHELL $ac_aux_dir/configure" # Please don't use this var. am__api_version='1.10' # Find a good install program. We prefer a C program (faster), # so one script is as good as another. But avoid the broken or # incompatible versions: # SysV /etc/install, /usr/sbin/install # SunOS /usr/etc/install # IRIX /sbin/install # AIX /bin/install # AmigaOS /C/install, which installs bootblocks on floppy discs # AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag # AFS /usr/afsws/bin/install, which mishandles nonexistent args # SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" # OS/2's system install, which has a completely different semantic # ./install, which can be erroneously created by make from ./install.sh. { echo "$as_me:$LINENO: checking for a BSD-compatible install" >&5 echo $ECHO_N "checking for a BSD-compatible install... $ECHO_C" >&6; } if test -z "$INSTALL"; then if test "${ac_cv_path_install+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. # Account for people who put trailing slashes in PATH elements. case $as_dir/ in ./ | .// | /cC/* | \ /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \ ?:\\/os2\\/install\\/* | ?:\\/OS2\\/INSTALL\\/* | \ /usr/ucb/* ) ;; *) # OSF1 and SCO ODT 3.0 have their own names for install. # Don't use installbsd from OSF since it installs stuff as root # by default. for ac_prog in ginstall scoinst install; do for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_prog$ac_exec_ext" && $as_test_x "$as_dir/$ac_prog$ac_exec_ext"; }; then if test $ac_prog = install && grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then # AIX install. It has an incompatible calling convention. : elif test $ac_prog = install && grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then # program-specific install script used by HP pwplus--don't use. : else ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c" break 3 fi fi done done ;; esac done IFS=$as_save_IFS fi if test "${ac_cv_path_install+set}" = set; then INSTALL=$ac_cv_path_install else # As a last resort, use the slow shell script. Don't cache a # value for INSTALL within a source directory, because that will # break other packages using the cache if that directory is # removed, or if the value is a relative name. INSTALL=$ac_install_sh fi fi { echo "$as_me:$LINENO: result: $INSTALL" >&5 echo "${ECHO_T}$INSTALL" >&6; } # Use test -z because SunOS4 sh mishandles braces in ${var-val}. # It thinks the first close brace ends the variable substitution. test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}' test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}' test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644' { echo "$as_me:$LINENO: checking whether build environment is sane" >&5 echo $ECHO_N "checking whether build environment is sane... $ECHO_C" >&6; } # Just in case sleep 1 echo timestamp > conftest.file # Do `set' in a subshell so we don't clobber the current shell's # arguments. Must try -L first in case configure is actually a # symlink; some systems play weird games with the mod time of symlinks # (eg FreeBSD returns the mod time of the symlink's containing # directory). if ( set X `ls -Lt $srcdir/configure conftest.file 2> /dev/null` if test "$*" = "X"; then # -L didn't work. set X `ls -t $srcdir/configure conftest.file` fi rm -f conftest.file if test "$*" != "X $srcdir/configure conftest.file" \ && test "$*" != "X conftest.file $srcdir/configure"; then # If neither matched, then we have a broken ls. This can happen # if, for instance, CONFIG_SHELL is bash and it inherits a # broken ls alias from the environment. This has actually # happened. Such a system could not be considered "sane". { { echo "$as_me:$LINENO: error: ls -t appears to fail. Make sure there is not a broken alias in your environment" >&5 echo "$as_me: error: ls -t appears to fail. Make sure there is not a broken alias in your environment" >&2;} { (exit 1); exit 1; }; } fi test "$2" = conftest.file ) then # Ok. : else { { echo "$as_me:$LINENO: error: newly created file is older than distributed files! Check your system clock" >&5 echo "$as_me: error: newly created file is older than distributed files! Check your system clock" >&2;} { (exit 1); exit 1; }; } fi { echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6; } test "$program_prefix" != NONE && program_transform_name="s&^&$program_prefix&;$program_transform_name" # Use a double $ so make ignores it. test "$program_suffix" != NONE && program_transform_name="s&\$&$program_suffix&;$program_transform_name" # Double any \ or $. echo might interpret backslashes. # By default was `s,x,x', remove it if useless. cat <<\_ACEOF >conftest.sed s/[\\$]/&&/g;s/;s,x,x,$// _ACEOF program_transform_name=`echo $program_transform_name | sed -f conftest.sed` rm -f conftest.sed # expand $ac_aux_dir to an absolute path am_aux_dir=`cd $ac_aux_dir && pwd` test x"${MISSING+set}" = xset || MISSING="\${SHELL} $am_aux_dir/missing" # Use eval to expand $SHELL if eval "$MISSING --run true"; then am_missing_run="$MISSING --run " else am_missing_run= { echo "$as_me:$LINENO: WARNING: \`missing' script is too old or missing" >&5 echo "$as_me: WARNING: \`missing' script is too old or missing" >&2;} fi { echo "$as_me:$LINENO: checking for a thread-safe mkdir -p" >&5 echo $ECHO_N "checking for a thread-safe mkdir -p... $ECHO_C" >&6; } if test -z "$MKDIR_P"; then if test "${ac_cv_path_mkdir+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH$PATH_SEPARATOR/opt/sfw/bin do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_prog in mkdir gmkdir; do for ac_exec_ext in '' $ac_executable_extensions; do { test -f "$as_dir/$ac_prog$ac_exec_ext" && $as_test_x "$as_dir/$ac_prog$ac_exec_ext"; } || continue case `"$as_dir/$ac_prog$ac_exec_ext" --version 2>&1` in #( 'mkdir (GNU coreutils) '* | \ 'mkdir (coreutils) '* | \ 'mkdir (fileutils) '4.1*) ac_cv_path_mkdir=$as_dir/$ac_prog$ac_exec_ext break 3;; esac done done done IFS=$as_save_IFS fi if test "${ac_cv_path_mkdir+set}" = set; then MKDIR_P="$ac_cv_path_mkdir -p" else # As a last resort, use the slow shell script. Don't cache a # value for MKDIR_P within a source directory, because that will # break other packages using the cache if that directory is # removed, or if the value is a relative name. test -d ./--version && rmdir ./--version MKDIR_P="$ac_install_sh -d" fi fi { echo "$as_me:$LINENO: result: $MKDIR_P" >&5 echo "${ECHO_T}$MKDIR_P" >&6; } mkdir_p="$MKDIR_P" case $mkdir_p in [\\/$]* | ?:[\\/]*) ;; */*) mkdir_p="\$(top_builddir)/$mkdir_p" ;; esac for ac_prog in gawk mawk nawk awk do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_AWK+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$AWK"; then ac_cv_prog_AWK="$AWK" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_AWK="$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi AWK=$ac_cv_prog_AWK if test -n "$AWK"; then { echo "$as_me:$LINENO: result: $AWK" >&5 echo "${ECHO_T}$AWK" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi test -n "$AWK" && break done { echo "$as_me:$LINENO: checking whether ${MAKE-make} sets \$(MAKE)" >&5 echo $ECHO_N "checking whether ${MAKE-make} sets \$(MAKE)... $ECHO_C" >&6; } set x ${MAKE-make}; ac_make=`echo "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'` if { as_var=ac_cv_prog_make_${ac_make}_set; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.make <<\_ACEOF SHELL = /bin/sh all: @echo '@@@%%%=$(MAKE)=@@@%%%' _ACEOF # GNU make sometimes prints "make[1]: Entering...", which would confuse us. case `${MAKE-make} -f conftest.make 2>/dev/null` in *@@@%%%=?*=@@@%%%*) eval ac_cv_prog_make_${ac_make}_set=yes;; *) eval ac_cv_prog_make_${ac_make}_set=no;; esac rm -f conftest.make fi if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then { echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6; } SET_MAKE= else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } SET_MAKE="MAKE=${MAKE-make}" fi rm -rf .tst 2>/dev/null mkdir .tst 2>/dev/null if test -d .tst; then am__leading_dot=. else am__leading_dot=_ fi rmdir .tst 2>/dev/null if test "`cd $srcdir && pwd`" != "`pwd`"; then # Use -I$(srcdir) only when $(srcdir) != ., so that make's output # is not polluted with repeated "-I." am__isrc=' -I$(srcdir)' # test to see if srcdir already configured if test -f $srcdir/config.status; then { { echo "$as_me:$LINENO: error: source directory already configured; run \"make distclean\" there first" >&5 echo "$as_me: error: source directory already configured; run \"make distclean\" there first" >&2;} { (exit 1); exit 1; }; } fi fi # test whether we have cygpath if test -z "$CYGPATH_W"; then if (cygpath --version) >/dev/null 2>/dev/null; then CYGPATH_W='cygpath -w' else CYGPATH_W=echo fi fi # Define the identity of the package. PACKAGE='etsf_io' VERSION='1.0.3' cat >>confdefs.h <<_ACEOF #define PACKAGE "$PACKAGE" _ACEOF cat >>confdefs.h <<_ACEOF #define VERSION "$VERSION" _ACEOF # Some tools Automake needs. ACLOCAL=${ACLOCAL-"${am_missing_run}aclocal-${am__api_version}"} AUTOCONF=${AUTOCONF-"${am_missing_run}autoconf"} AUTOMAKE=${AUTOMAKE-"${am_missing_run}automake-${am__api_version}"} AUTOHEADER=${AUTOHEADER-"${am_missing_run}autoheader"} MAKEINFO=${MAKEINFO-"${am_missing_run}makeinfo"} install_sh=${install_sh-"\$(SHELL) $am_aux_dir/install-sh"} # Installed binaries are usually stripped using `strip' when the user # run `make install-strip'. However `strip' might not be the right # tool to use in cross-compilation environments, therefore Automake # will honor the `STRIP' environment variable to overrule this program. if test "$cross_compiling" != no; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}strip", so it can be a program name with args. set dummy ${ac_tool_prefix}strip; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_STRIP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$STRIP"; then ac_cv_prog_STRIP="$STRIP" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_STRIP="${ac_tool_prefix}strip" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi STRIP=$ac_cv_prog_STRIP if test -n "$STRIP"; then { echo "$as_me:$LINENO: result: $STRIP" >&5 echo "${ECHO_T}$STRIP" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi fi if test -z "$ac_cv_prog_STRIP"; then ac_ct_STRIP=$STRIP # Extract the first word of "strip", so it can be a program name with args. set dummy strip; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_ac_ct_STRIP+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_STRIP"; then ac_cv_prog_ac_ct_STRIP="$ac_ct_STRIP" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_STRIP="strip" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_STRIP=$ac_cv_prog_ac_ct_STRIP if test -n "$ac_ct_STRIP"; then { echo "$as_me:$LINENO: result: $ac_ct_STRIP" >&5 echo "${ECHO_T}$ac_ct_STRIP" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi if test "x$ac_ct_STRIP" = x; then STRIP=":" else case $cross_compiling:$ac_tool_warned in yes:) { echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&5 echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&2;} ac_tool_warned=yes ;; esac STRIP=$ac_ct_STRIP fi else STRIP="$ac_cv_prog_STRIP" fi fi INSTALL_STRIP_PROGRAM="\$(install_sh) -c -s" # We need awk for the "check" target. The system "awk" is bad on # some platforms. # Always define AMTAR for backward compatibility. AMTAR=${AMTAR-"${am_missing_run}tar"} am__tar='${AMTAR} chof - "$$tardir"'; am__untar='${AMTAR} xf -' ac_ext=${ac_fc_srcext-f} ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_fc_compiler_gnu ac_ext=${ac_fc_srcext-f} ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_fc_compiler_gnu if test -n "$ac_tool_prefix"; then for ac_prog in gfortran g95 xlf95 f95 fort ifort ifc efc pgf95 lf95 ftn xlf90 f90 pgf90 pghpf epcf90 g77 xlf f77 frt pgf77 cf77 fort77 fl32 af77 do # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. set dummy $ac_tool_prefix$ac_prog; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_FC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$FC"; then ac_cv_prog_FC="$FC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_FC="$ac_tool_prefix$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi FC=$ac_cv_prog_FC if test -n "$FC"; then { echo "$as_me:$LINENO: result: $FC" >&5 echo "${ECHO_T}$FC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi test -n "$FC" && break done fi if test -z "$FC"; then ac_ct_FC=$FC for ac_prog in gfortran g95 xlf95 f95 fort ifort ifc efc pgf95 lf95 ftn xlf90 f90 pgf90 pghpf epcf90 g77 xlf f77 frt pgf77 cf77 fort77 fl32 af77 do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_ac_ct_FC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_FC"; then ac_cv_prog_ac_ct_FC="$ac_ct_FC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_FC="$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_FC=$ac_cv_prog_ac_ct_FC if test -n "$ac_ct_FC"; then { echo "$as_me:$LINENO: result: $ac_ct_FC" >&5 echo "${ECHO_T}$ac_ct_FC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi test -n "$ac_ct_FC" && break done if test "x$ac_ct_FC" = x; then FC="" else case $cross_compiling:$ac_tool_warned in yes:) { echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&5 echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&2;} ac_tool_warned=yes ;; esac FC=$ac_ct_FC fi fi # Provide some information about the compiler. echo "$as_me:$LINENO: checking for Fortran compiler version" >&5 ac_compiler=`set X $ac_compile; echo $2` { (ac_try="$ac_compiler --version >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compiler --version >&5") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (ac_try="$ac_compiler -v >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compiler -v >&5") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (ac_try="$ac_compiler -V >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compiler -V >&5") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } rm -f a.out cat >conftest.$ac_ext <<_ACEOF program main end _ACEOF ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files a.out a.exe b.out" # Try to create an executable without -o first, disregard a.out. # It will help us diagnose broken compilers, and finding out an intuition # of exeext. { echo "$as_me:$LINENO: checking for Fortran compiler default output file name" >&5 echo $ECHO_N "checking for Fortran compiler default output file name... $ECHO_C" >&6; } ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` # # List of possible output files, starting from the most likely. # The algorithm is not robust to junk in `.', hence go to wildcards (a.*) # only as a last resort. b.out is created by i960 compilers. ac_files='a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out' # # The IRIX 6 linker writes into existing files which may not be # executable, retaining their permissions. Remove them first so a # subsequent execution test works. ac_rmfiles= for ac_file in $ac_files do case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;; * ) ac_rmfiles="$ac_rmfiles $ac_file";; esac done rm -f $ac_rmfiles if { (ac_try="$ac_link_default" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link_default") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. # So ignore a value of `no', otherwise this would lead to `EXEEXT = no' # in a Makefile. We should not override ac_cv_exeext if it was cached, # so that the user can short-circuit this test for compilers unknown to # Autoconf. for ac_file in $ac_files '' do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;; [ab].out ) # We found the default executable, but exeext='' is most # certainly right. break;; *.* ) if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no; then :; else ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` fi # We set ac_cv_exeext here because the later test for it is not # safe: cross compilers may not add the suffix if given an `-o' # argument, so we may need to know it at that point already. # Even if this section looks crufty: it has the advantage of # actually working. break;; * ) break;; esac done test "$ac_cv_exeext" = no && ac_cv_exeext= else ac_file='' fi { echo "$as_me:$LINENO: result: $ac_file" >&5 echo "${ECHO_T}$ac_file" >&6; } if test -z "$ac_file"; then echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: Fortran compiler cannot create executables See \`config.log' for more details." >&5 echo "$as_me: error: Fortran compiler cannot create executables See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } fi ac_exeext=$ac_cv_exeext # Check that the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. { echo "$as_me:$LINENO: checking whether the Fortran compiler works" >&5 echo $ECHO_N "checking whether the Fortran compiler works... $ECHO_C" >&6; } # FIXME: These cross compiler hacks should be removed for Autoconf 3.0 # If not cross compiling, check that we can run a simple program. if test "$cross_compiling" != yes; then if { ac_try='./$ac_file' { (case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_try") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then cross_compiling=no else if test "$cross_compiling" = maybe; then cross_compiling=yes else { { echo "$as_me:$LINENO: error: cannot run Fortran compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&5 echo "$as_me: error: cannot run Fortran compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi fi fi { echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6; } rm -f a.out a.exe conftest$ac_cv_exeext b.out ac_clean_files=$ac_clean_files_save # Check that the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. { echo "$as_me:$LINENO: checking whether we are cross compiling" >&5 echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6; } { echo "$as_me:$LINENO: result: $cross_compiling" >&5 echo "${ECHO_T}$cross_compiling" >&6; } { echo "$as_me:$LINENO: checking for suffix of executables" >&5 echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6; } if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # If both `conftest.exe' and `conftest' are `present' (well, observable) # catch `conftest.exe'. For instance with Cygwin, `ls conftest' will # work properly (i.e., refer to `conftest.exe'), while it won't with # `rm'. for ac_file in conftest.exe conftest conftest.*; do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` break;; * ) break;; esac done else { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest$ac_cv_exeext { echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5 echo "${ECHO_T}$ac_cv_exeext" >&6; } rm -f conftest.$ac_ext EXEEXT=$ac_cv_exeext ac_exeext=$EXEEXT { echo "$as_me:$LINENO: checking for suffix of object files" >&5 echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6; } if test "${ac_cv_objext+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF program main end _ACEOF rm -f conftest.o conftest.obj if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then for ac_file in conftest.o conftest.obj conftest.*; do test -f "$ac_file" || continue; case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf ) ;; *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` break;; esac done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest.$ac_cv_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_objext" >&5 echo "${ECHO_T}$ac_cv_objext" >&6; } OBJEXT=$ac_cv_objext ac_objext=$OBJEXT # If we don't use `.F' as extension, the preprocessor is not run on the # input file. (Note that this only needs to work for GNU compilers.) ac_save_ext=$ac_ext ac_ext=F { echo "$as_me:$LINENO: checking whether we are using the GNU Fortran compiler" >&5 echo $ECHO_N "checking whether we are using the GNU Fortran compiler... $ECHO_C" >&6; } if test "${ac_cv_fc_compiler_gnu+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF program main #ifndef __GNUC__ choke me #endif end _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_fc_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_compiler_gnu=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_compiler_gnu=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ac_cv_fc_compiler_gnu=$ac_compiler_gnu fi { echo "$as_me:$LINENO: result: $ac_cv_fc_compiler_gnu" >&5 echo "${ECHO_T}$ac_cv_fc_compiler_gnu" >&6; } ac_ext=$ac_save_ext ac_test_FFLAGS=${FCFLAGS+set} ac_save_FFLAGS=$FCFLAGS FCFLAGS= { echo "$as_me:$LINENO: checking whether $FC accepts -g" >&5 echo $ECHO_N "checking whether $FC accepts -g... $ECHO_C" >&6; } if test "${ac_cv_prog_fc_g+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else FCFLAGS=-g cat >conftest.$ac_ext <<_ACEOF program main end _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_fc_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_cv_prog_fc_g=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_prog_fc_g=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_prog_fc_g" >&5 echo "${ECHO_T}$ac_cv_prog_fc_g" >&6; } if test "$ac_test_FFLAGS" = set; then FCFLAGS=$ac_save_FFLAGS elif test $ac_cv_prog_fc_g = yes; then if test "x$ac_cv_fc_compiler_gnu" = xyes; then FCFLAGS="-g -O2" else FCFLAGS="-g" fi else if test "x$ac_cv_fc_compiler_gnu" = xyes; then FCFLAGS="-O2" else FCFLAGS= fi fi ac_ext=${ac_fc_srcext-f} ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_fc_compiler_gnu ac_ext=${ac_fc_srcext-f} ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_fc_compiler_gnu { echo "$as_me:$LINENO: checking for Fortran flag to compile .f90 files" >&5 echo $ECHO_N "checking for Fortran flag to compile .f90 files... $ECHO_C" >&6; } if test "${ac_cv_fc_srcext_f90+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_ext=f90 ac_fcflags_srcext_save=$ac_fcflags_srcext ac_fcflags_srcext= ac_cv_fc_srcext_f90=unknown for ac_flag in none -qsuffix=f=f90 -Tf; do test "x$ac_flag" != xnone && ac_fcflags_srcext="$ac_flag" cat >conftest.$ac_ext <<_ACEOF program main end _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_fc_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_cv_fc_srcext_f90=$ac_flag; break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext done rm -f conftest.$ac_objext conftest.f90 ac_fcflags_srcext=$ac_fcflags_srcext_save fi { echo "$as_me:$LINENO: result: $ac_cv_fc_srcext_f90" >&5 echo "${ECHO_T}$ac_cv_fc_srcext_f90" >&6; } if test "x$ac_cv_fc_srcext_f90" = xunknown; then { { echo "$as_me:$LINENO: error: Fortran could not compile .f90 files" >&5 echo "$as_me: error: Fortran could not compile .f90 files" >&2;} { (exit 1); exit 1; }; } else ac_fc_srcext=f90 if test "x$ac_cv_fc_srcext_f90" = xnone; then ac_fcflags_srcext="" FCFLAGS_f90="" else ac_fcflags_srcext=$ac_cv_fc_srcext_f90 FCFLAGS_f90=$ac_cv_fc_srcext_f90 fi fi ac_ext=${ac_fc_srcext-f} ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_fc_compiler_gnu ac_ext=${ac_fc_srcext-f} ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_fc_compiler_gnu if test -n "$ac_tool_prefix"; then for ac_prog in gfortran g95 xlf95 f95 fort ifort ifc efc pgf95 lf95 ftn xlf90 f90 pgf90 pghpf epcf90 g77 xlf f77 frt pgf77 cf77 fort77 fl32 af77 do # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. set dummy $ac_tool_prefix$ac_prog; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_FC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$FC"; then ac_cv_prog_FC="$FC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_FC="$ac_tool_prefix$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi FC=$ac_cv_prog_FC if test -n "$FC"; then { echo "$as_me:$LINENO: result: $FC" >&5 echo "${ECHO_T}$FC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi test -n "$FC" && break done fi if test -z "$FC"; then ac_ct_FC=$FC for ac_prog in gfortran g95 xlf95 f95 fort ifort ifc efc pgf95 lf95 ftn xlf90 f90 pgf90 pghpf epcf90 g77 xlf f77 frt pgf77 cf77 fort77 fl32 af77 do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_ac_ct_FC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_FC"; then ac_cv_prog_ac_ct_FC="$ac_ct_FC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_FC="$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_FC=$ac_cv_prog_ac_ct_FC if test -n "$ac_ct_FC"; then { echo "$as_me:$LINENO: result: $ac_ct_FC" >&5 echo "${ECHO_T}$ac_ct_FC" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi test -n "$ac_ct_FC" && break done if test "x$ac_ct_FC" = x; then FC="" else case $cross_compiling:$ac_tool_warned in yes:) { echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&5 echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&2;} ac_tool_warned=yes ;; esac FC=$ac_ct_FC fi fi # Provide some information about the compiler. echo "$as_me:$LINENO: checking for Fortran compiler version" >&5 ac_compiler=`set X $ac_compile; echo $2` { (ac_try="$ac_compiler --version >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compiler --version >&5") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (ac_try="$ac_compiler -v >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compiler -v >&5") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (ac_try="$ac_compiler -V >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compiler -V >&5") 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } rm -f a.out # If we don't use `.F' as extension, the preprocessor is not run on the # input file. (Note that this only needs to work for GNU compilers.) ac_save_ext=$ac_ext ac_ext=F { echo "$as_me:$LINENO: checking whether we are using the GNU Fortran compiler" >&5 echo $ECHO_N "checking whether we are using the GNU Fortran compiler... $ECHO_C" >&6; } if test "${ac_cv_fc_compiler_gnu+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF program main #ifndef __GNUC__ choke me #endif end _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_fc_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_compiler_gnu=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_compiler_gnu=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ac_cv_fc_compiler_gnu=$ac_compiler_gnu fi { echo "$as_me:$LINENO: result: $ac_cv_fc_compiler_gnu" >&5 echo "${ECHO_T}$ac_cv_fc_compiler_gnu" >&6; } ac_ext=$ac_save_ext ac_test_FFLAGS=${FCFLAGS+set} ac_save_FFLAGS=$FCFLAGS FCFLAGS= { echo "$as_me:$LINENO: checking whether $FC accepts -g" >&5 echo $ECHO_N "checking whether $FC accepts -g... $ECHO_C" >&6; } if test "${ac_cv_prog_fc_g+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else FCFLAGS=-g cat >conftest.$ac_ext <<_ACEOF program main end _ACEOF rm -f conftest.$ac_objext if { (ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_compile") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_fc_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then ac_cv_prog_fc_g=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_prog_fc_g=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $ac_cv_prog_fc_g" >&5 echo "${ECHO_T}$ac_cv_prog_fc_g" >&6; } if test "$ac_test_FFLAGS" = set; then FCFLAGS=$ac_save_FFLAGS elif test $ac_cv_prog_fc_g = yes; then if test "x$ac_cv_fc_compiler_gnu" = xyes; then FCFLAGS="-g -O2" else FCFLAGS="-g" fi else if test "x$ac_cv_fc_compiler_gnu" = xyes; then FCFLAGS="-O2" else FCFLAGS= fi fi ac_ext=${ac_fc_srcext-f} ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_fc_compiler_gnu if test "${fc_type}" = ""; then fc_type="UNKNOWN" fi if test "${fc_version}" = ""; then fc_version="UNKNOWN" fi fc_wrap="no" { echo "$as_me:$LINENO: checking which type of Fortran compiler we have" >&5 echo $ECHO_N "checking which type of Fortran compiler we have... $ECHO_C" >&6; } if test "${fc_type}" = "UNKNOWN"; then fc_info_string=`${FC} --version 2>&1` abi_result=`echo "${fc_info_string}" | grep '^G95'` if test "${abi_result}" = ""; then abi_result="no" fc_info_string="" fc_type="UNKNOWN" fc_version="UNKNOWN" else cat >>confdefs.h <<\_ACEOF #define FC_G95 1 _ACEOF fc_type="g95" fc_version=`echo ${abi_result} | sed -e 's/.*GCC //; s/ .*//'` if test "${fc_version}" = "${abi_result}"; then fc_version="UNKNOWN" fi abi_result="yes" fi fi if test "${fc_type}" = "UNKNOWN"; then fc_info_string=`${FC} --version 2>&1` abi_result=`echo "${fc_info_string}" | grep '^GNU Fortran'` if test "${abi_result}" = ""; then abi_result="no" fc_info_string="" fc_type="UNKNOWN" fc_version="UNKNOWN" else cat >>confdefs.h <<\_ACEOF #define FC_GCC 1 _ACEOF fc_type="gcc" fc_version=`echo ${abi_result} | sed -e 's/.*(GCC) //; s/.*GCC //; s/ .*//'` abi_result="yes" fi fi if test "${fc_type}" = "UNKNOWN"; then fc_info_string=`${FC} -v -V 2>&1 | sed -e '/^ifc: warning/d'` abi_result=`echo "${fc_info_string}" | grep '^Intel(R) Fortran'` if test "${abi_result}" = ""; then abi_result="no" fc_info_string="" fc_type="UNKNOWN" fc_version="UNKNOWN" else cat >>confdefs.h <<\_ACEOF #define FC_INTEL 1 _ACEOF fc_type="intel" fc_version=`echo "${fc_info_string}" | grep '^Version' | sed -e 's/Version //;s/ .*//;s/ //g' | head -n 1` if test "${fc_version}" = ""; then fc_version="UNKNOWN" fi abi_result="yes" fi fi if test "${fc_type}" = "UNKNOWN"; then fc_info_string=`${FC} -version 2>&1` abi_result=`echo "${fc_info_string}" | grep '^PathScale'` if test "${abi_result}" = ""; then abi_result="no" fc_info_string="" fc_type="UNKNOWN" fc_version="UNKNOWN" else cat >>confdefs.h <<\_ACEOF #define FC_PATHSCALE 1 _ACEOF fc_type="pathscale" fc_version=`echo "${abi_result}" | sed -e 's/.* Version //; s/ .*//'` if test "${fc_version}" = "${abi_result}"; then fc_version="UNKNOWN" fi abi_result="yes" fi fi if test "${fc_type}" = "UNKNOWN"; then fc_info_string=`${FC} -V 2>&1 | sed -e '/^$/d'` abi_result=`echo "${fc_info_string}" | grep '^pgf9[05]' | grep -v 'No files to process'` if test "${abi_result}" = ""; then abi_result="no" fc_info_string="" fc_type="UNKNOWN" fc_version="UNKNOWN" else cat >>confdefs.h <<\_ACEOF #define FC_PGI 1 _ACEOF fc_type="pgi" fc_version=`echo "${abi_result}" | sed -e 's/^pgf9[05] //' | sed -e 's/-.*//'` if test "${fc_version}" = "${abi_result}"; then fc_version="UNKNOWN" else if test "${fc_version}" = "6.0"; then cat >>confdefs.h <<\_ACEOF #define FC_PGI6 1 _ACEOF fi fi abi_result="yes" fi fi if test "${fc_type}" = "UNKNOWN"; then fc_info_string=`${FC} -version 2>&1 | sed -e 's/^ //' | grep '^Compaq Fortran Compiler'` abi_result="${fc_info_string}" if test "${abi_result}" = ""; then fc_info_string=`${FC} -version 2>&1 | sed -e 's/^ //' | grep '^HP Fortran Compiler'` abi_result="${fc_info_string}" fi if test "${abi_result}" = ""; then abi_result="no" fc_info_string="" fc_type="UNKNOWN" fc_version="UNKNOWN" else cat >>confdefs.h <<\_ACEOF #define FC_COMPAQ 1 _ACEOF fc_type="compaq" fc_version=`echo "${abi_result}" | sed -e 's/.* V//;s/-.*//'` if test "${fc_version}" = "${abi_result}"; then fc_version="UNKNOWN" fi abi_result="yes" fi fi if test "${fc_type}" = "UNKNOWN"; then fc_info_string=`${FC} -V 2> /dev/null` abi_result=`echo "${fc_info_string}" | grep '^Pro Fortran'` if test "${abi_result}" = ""; then abi_result="no" fc_info_string="" fc_type="UNKNOWN" fc_version="UNKNOWN" else cat >>confdefs.h <<\_ACEOF #define FC_ABSOFT 1 _ACEOF fc_type="absoft" fc_version=`echo "${abi_result}" | sed -e 's/Pro Fortran //'` if test "${fc_version}" = "${abi_result}"; then fc_version="UNKNOWN" fi abi_result="yes" fi fi if test "${fc_type}" = "UNKNOWN"; then fc_info_string=`${FC} -version 2>&1 | sed -e '/^$/d'` abi_result=`echo "${fc_info_string}" | grep '^MIPSpro'` if test "${abi_result}" = ""; then abi_result="no" fc_info_string="" fc_type="UNKNOWN" fc_version="UNKNOWN" else cat >>confdefs.h <<\_ACEOF #define FC_MIPSPRO 1 _ACEOF fc_type="mipspro" fc_version=`echo "${abi_result}" | sed -e 's/.*Version //'` if test "${fc_version}" = "${abi_result}"; then fc_version="UNKNOWN" fi abi_result="yes" fi fi if test "${fc_type}" = "UNKNOWN"; then fc_info_string=`${FC} --version 2>&1` abi_result=`echo "${fc_info_string}" | grep '^Open64'` if test "${abi_result}" = ""; then abi_result="no" fc_info_string="" fc_type="UNKNOWN" fc_version="UNKNOWN" else cat >>confdefs.h <<\_ACEOF #define FC_OPEN64 1 _ACEOF fc_type="open64" fc_version=`echo "${abi_result}" | sed -e 's/.* Version //; s/ .*//'` if test "${fc_version}" = "${abi_result}"; then fc_version="UNKNOWN" fi abi_result="yes" fi fi if test "${fc_type}" = "UNKNOWN"; then fc_info_string=`${FC} -V 2> /dev/null` abi_result=`echo "${fc_info_string}" | grep '^Fujitsu Fortran'` if test "${abi_result}" = ""; then abi_result="no" fc_info_string="" fc_type="UNKNOWN" fc_version="UNKNOWN" else cat >>confdefs.h <<\_ACEOF #define FC_FUJITSU 1 _ACEOF fc_type="fujitsu" fc_version=`echo "${abi_result}" | sed -e 's/.*Driver //;s/ .*//'` if test "${fc_version}" = "${abi_result}"; then fc_version="UNKNOWN" fi abi_result="yes" fi fi if test "${fc_type}" = "UNKNOWN"; then fc_info_string=`${FC} -V 2>&1 | head -n 1` abi_result=`echo "${fc_info_string}" | grep 'Sun' | grep 'Fortran 95'` if test "${abi_result}" = ""; then abi_result="no" fc_info_string="" fc_type="UNKNOWN" fc_version="UNKNOWN" else cat >>confdefs.h <<\_ACEOF #define FC_SUN 1 _ACEOF fc_type="sun" fc_version=`echo "${abi_result}" | sed -e 's/.* Fortran 95 //;s/ .*//'` if test "${fc_version}" = "${abi_result}" -o "${fc_version}" = ""; then fc_version="UNKNOWN" fi abi_result="yes" fi fi if test "${fc_type}" = "UNKNOWN"; then fc_info_string=`${FC} -V 2> /dev/null` abi_result=`echo "${fc_info_string}" | grep '^Hitachi Fortran'` if test "${abi_result}" = ""; then abi_result="no" fc_info_string="" fc_type="UNKNOWN" fc_version="UNKNOWN" else cat >>confdefs.h <<\_ACEOF #define FC_HITACHI 1 _ACEOF fc_type="hitachi" fc_version=`echo "${abi_result}" | sed -e 's/.*Driver //;s/ .*//'` if test "${fc_version}" = "${abi_result}"; then fc_version="UNKNOWN" fi abi_result="yes" fi fi if test "${fc_type}" = "UNKNOWN"; then fc_info_string=`${FC} -qversion 2>&1` fc_garbage=`${FC} -qversion 2>&1 | wc -l | sed -e 's/ //g'` abi_result=`echo "${fc_info_string}" | grep 'IBM(R) XL Fortran'` if test "${abi_result}" = ""; then abi_result=`echo "${fc_info_string}" | grep 'IBM XL Fortran'` fi if test "${abi_result}" = ""; then abi_result="no" fc_info_string="" fc_type="UNKNOWN" fc_version="UNKNOWN" if test "${fc_garbage}" -gt 50; then cat >>confdefs.h <<\_ACEOF #define FC_IBM 1 _ACEOF fc_type="ibm" fc_version="UNKNOWN" abi_result="yes" fi else cat >>confdefs.h <<\_ACEOF #define FC_IBM 1 _ACEOF fc_type="ibm" fc_version=`echo "${abi_result}" | sed -e 's/.* V\([0-9\.]*\) .*/\1/'` if test "${fc_version}" = "${abi_result}"; then fc_version="UNKNOWN" fi abi_result="yes" fi fi if test "${fc_type}" = "UNKNOWN"; then fc_type="generic" fc_version="0.0" fi fc_version=`echo ${fc_version} | cut -d. -f1-2` { echo "$as_me:$LINENO: result: ${fc_type} ${fc_version}" >&5 echo "${ECHO_T}${fc_type} ${fc_version}" >&6; } fc_has_exit="no" { echo "$as_me:$LINENO: checking whether the Fortran compiler accepts exit()" >&5 echo $ECHO_N "checking whether the Fortran compiler accepts exit()... $ECHO_C" >&6; } ac_ext=${ac_fc_srcext-f} ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_fc_compiler_gnu cat >conftest.$ac_ext <<_ACEOF program main call exit(1) end _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_fc_werror_flag" || test ! -s conftest.err } && test -s conftest$ac_exeext && $as_test_x conftest$ac_exeext; then fc_has_exit="yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext ac_ext=${ac_fc_srcext-f} ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_fc_compiler_gnu if test "${fc_has_exit}" = "yes"; then cat >>confdefs.h <<\_ACEOF #define HAVE_FC_EXIT 1 _ACEOF fi { echo "$as_me:$LINENO: result: ${fc_has_exit}" >&5 echo "${ECHO_T}${fc_has_exit}" >&6; } fc_has_flush="no" { echo "$as_me:$LINENO: checking whether the Fortran compiler accepts flush()" >&5 echo $ECHO_N "checking whether the Fortran compiler accepts flush()... $ECHO_C" >&6; } ac_ext=${ac_fc_srcext-f} ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_fc_compiler_gnu cat >conftest.$ac_ext <<_ACEOF program main call flush() end _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_fc_werror_flag" || test ! -s conftest.err } && test -s conftest$ac_exeext && $as_test_x conftest$ac_exeext; then fc_has_flush="yes" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext ac_ext=${ac_fc_srcext-f} ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_fc_compiler_gnu if test "${fc_has_flush}" = "yes"; then cat >>confdefs.h <<\_ACEOF #define HAVE_FC_FLUSH 1 _ACEOF fi { echo "$as_me:$LINENO: result: ${fc_has_flush}" >&5 echo "${ECHO_T}${fc_has_flush}" >&6; } { echo "$as_me:$LINENO: checking for module extension for compiler '$fc_type'" >&5 echo $ECHO_N "checking for module extension for compiler '$fc_type'... $ECHO_C" >&6; } case "$fc_type" in "pathscale") capitalize_module=yes capitalize_module_ext="mod" ;; "open64") capitalize_module=yes capitalize_module_ext="mod" ;; *) capitalize_module=no capitalize_module_ext="mod" ;; esac { echo "$as_me:$LINENO: result: $capitalize_module_ext" >&5 echo "${ECHO_T}$capitalize_module_ext" >&6; } if test "$capitalize_module" = "yes"; then CAPITALIZE_TRUE= CAPITALIZE_FALSE='#' else CAPITALIZE_TRUE='#' CAPITALIZE_FALSE= fi MODULE_EXT=$capitalize_module_ext if test -z "$FFLAGS" ; then FFLAGS="-O2" fi if test -z "$FCFLAGS" ; then FCFLAGS="-O2" fi if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. set dummy ${ac_tool_prefix}ranlib; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_RANLIB+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$RANLIB"; then ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi RANLIB=$ac_cv_prog_RANLIB if test -n "$RANLIB"; then { echo "$as_me:$LINENO: result: $RANLIB" >&5 echo "${ECHO_T}$RANLIB" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi fi if test -z "$ac_cv_prog_RANLIB"; then ac_ct_RANLIB=$RANLIB # Extract the first word of "ranlib", so it can be a program name with args. set dummy ranlib; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_ac_ct_RANLIB+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_RANLIB"; then ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_RANLIB="ranlib" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB if test -n "$ac_ct_RANLIB"; then { echo "$as_me:$LINENO: result: $ac_ct_RANLIB" >&5 echo "${ECHO_T}$ac_ct_RANLIB" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi if test "x$ac_ct_RANLIB" = x; then RANLIB=":" else case $cross_compiling:$ac_tool_warned in yes:) { echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&5 echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&2;} ac_tool_warned=yes ;; esac RANLIB=$ac_ct_RANLIB fi else RANLIB="$ac_cv_prog_RANLIB" fi if test "$ranlib" = ":" ; then { { echo "$as_me:$LINENO: error: \"No 'ranlib' program found.\"" >&5 echo "$as_me: error: \"No 'ranlib' program found.\"" >&2;} { (exit 1); exit 1; }; } fi if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args. set dummy ${ac_tool_prefix}ar; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_AR+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$AR"; then ac_cv_prog_AR="$AR" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_AR="${ac_tool_prefix}ar" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi AR=$ac_cv_prog_AR if test -n "$AR"; then { echo "$as_me:$LINENO: result: $AR" >&5 echo "${ECHO_T}$AR" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi fi if test -z "$ac_cv_prog_AR"; then ac_ct_AR=$AR # Extract the first word of "ar", so it can be a program name with args. set dummy ar; ac_word=$2 { echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } if test "${ac_cv_prog_ac_ct_AR+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_AR"; then ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_AR="ar" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_AR=$ac_cv_prog_ac_ct_AR if test -n "$ac_ct_AR"; then { echo "$as_me:$LINENO: result: $ac_ct_AR" >&5 echo "${ECHO_T}$ac_ct_AR" >&6; } else { echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6; } fi if test "x$ac_ct_AR" = x; then AR=":" else case $cross_compiling:$ac_tool_warned in yes:) { echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&5 echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools whose name does not start with the host triplet. If you think this configuration is useful to you, please write to autoconf@gnu.org." >&2;} ac_tool_warned=yes ;; esac AR=$ac_ct_AR fi else AR="$ac_cv_prog_AR" fi if test "$ar" = ":" ; then { { echo "$as_me:$LINENO: error: \"No 'ar' program found.\"" >&5 echo "$as_me: error: \"No 'ar' program found.\"" >&2;} { (exit 1); exit 1; }; } fi # Check whether --with-netcdf-module-path was given. if test "${with_netcdf_module_path+set}" = set; then withval=$with_netcdf_module_path; ac_netcdf_mod=$withval else ac_netcdf_mod=/usr/include fi as_ac_File=`echo "ac_cv_file_${ac_netcdf_mod}/netcdf.mod" | $as_tr_sh` { echo "$as_me:$LINENO: checking for ${ac_netcdf_mod}/netcdf.mod" >&5 echo $ECHO_N "checking for ${ac_netcdf_mod}/netcdf.mod... $ECHO_C" >&6; } if { as_var=$as_ac_File; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else test "$cross_compiling" = yes && { { echo "$as_me:$LINENO: error: cannot check for file existence when cross compiling" >&5 echo "$as_me: error: cannot check for file existence when cross compiling" >&2;} { (exit 1); exit 1; }; } if test -r "${ac_netcdf_mod}/netcdf.mod"; then eval "$as_ac_File=yes" else eval "$as_ac_File=no" fi fi ac_res=`eval echo '${'$as_ac_File'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_File'}'` = yes; then withnetcdf=yes else withnetcdf=no fi if test "$withnetcdf" = "no" ; then as_ac_File=`echo "ac_cv_file_${ac_netcdf_mod}/NETCDF.mod" | $as_tr_sh` { echo "$as_me:$LINENO: checking for ${ac_netcdf_mod}/NETCDF.mod" >&5 echo $ECHO_N "checking for ${ac_netcdf_mod}/NETCDF.mod... $ECHO_C" >&6; } if { as_var=$as_ac_File; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else test "$cross_compiling" = yes && { { echo "$as_me:$LINENO: error: cannot check for file existence when cross compiling" >&5 echo "$as_me: error: cannot check for file existence when cross compiling" >&2;} { (exit 1); exit 1; }; } if test -r "${ac_netcdf_mod}/NETCDF.mod"; then eval "$as_ac_File=yes" else eval "$as_ac_File=no" fi fi ac_res=`eval echo '${'$as_ac_File'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_File'}'` = yes; then withnetcdf=yes else withnetcdf=no fi if test "$withnetcdf" = "no" ; then as_ac_File=`echo "ac_cv_file_${ac_netcdf_mod}/NETCDF.MOD" | $as_tr_sh` { echo "$as_me:$LINENO: checking for ${ac_netcdf_mod}/NETCDF.MOD" >&5 echo $ECHO_N "checking for ${ac_netcdf_mod}/NETCDF.MOD... $ECHO_C" >&6; } if { as_var=$as_ac_File; eval "test \"\${$as_var+set}\" = set"; }; then echo $ECHO_N "(cached) $ECHO_C" >&6 else test "$cross_compiling" = yes && { { echo "$as_me:$LINENO: error: cannot check for file existence when cross compiling" >&5 echo "$as_me: error: cannot check for file existence when cross compiling" >&2;} { (exit 1); exit 1; }; } if test -r "${ac_netcdf_mod}/NETCDF.MOD"; then eval "$as_ac_File=yes" else eval "$as_ac_File=no" fi fi ac_res=`eval echo '${'$as_ac_File'}'` { echo "$as_me:$LINENO: result: $ac_res" >&5 echo "${ECHO_T}$ac_res" >&6; } if test `eval echo '${'$as_ac_File'}'` = yes; then withnetcdf=yes else withnetcdf=no fi fi fi if test "$withnetcdf" = "no" ; then echo "Action: install NetCDF and set its path with --with-netcdf-module-path." { { echo "$as_me:$LINENO: error: \"No 'NetCDF' module found.\"" >&5 echo "$as_me: error: \"No 'NetCDF' module found.\"" >&2;} { (exit 1); exit 1; }; } fi NETCDF_CFLAGS="$ac_netcdf_mod" ac_netcdf_dir=/usr/lib # Check whether --with-netcdf-ldflags was given. if test "${with_netcdf_ldflags+set}" = set; then withval=$with_netcdf_ldflags; ac_netcdf_dir=$withval else ac_netcdf_dir= fi if test -n "$ac_netcdf_dir" ; then LDFLAGS="$LDFLAGS $ac_netcdf_dir" fi { echo "$as_me:$LINENO: checking for netcdf library" >&5 echo $ECHO_N "checking for netcdf library... $ECHO_C" >&6; } FCFLAGS_SVG=$FCFLAGS FCFLAGS="$FCFLAGS -I$ac_netcdf_mod" LIBS_SVG=$LIBS LIBS="$LIBS_SVG -lnetcdf" cat >conftest.$ac_ext <<_ACEOF program main use netcdf integer :: s, ncid s = nf90_open(path = "", mode = NF90_NOWRITE, ncid = ncid) end program main _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_fc_werror_flag" || test ! -s conftest.err } && test -s conftest$ac_exeext && $as_test_x conftest$ac_exeext; then withnetcdf="-lnetcdf" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 withnetcdf=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext if test "$withnetcdf" = "no" ; then LIBS="$LIBS_SVG -lnetcdff -lnetcdf" cat >conftest.$ac_ext <<_ACEOF program main use netcdf integer :: s, ncid s = nf90_open(path = "", mode = NF90_NOWRITE, ncid = ncid) end program main _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 (eval "$ac_link") 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { test -z "$ac_fc_werror_flag" || test ! -s conftest.err } && test -s conftest$ac_exeext && $as_test_x conftest$ac_exeext; then withnetcdf="-lnetcdff -lnetcdf" else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 withnetcdf=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext fi { echo "$as_me:$LINENO: result: $withnetcdf" >&5 echo "${ECHO_T}$withnetcdf" >&6; } if test "$withnetcdf" = "no" ; then echo "LDFLAGS was '$LDFLAGS'" echo "Action: install NetCDF and set the library link path with --with-netcdf-ldflags." { { echo "$as_me:$LINENO: error: \"No 'NetCDF' library found.\"" >&5 echo "$as_me: error: \"No 'NetCDF' library found.\"" >&2;} { (exit 1); exit 1; }; } fi FCFLAGS=$FCFLAGS_SVG LIBS="$LIBS_SVG"$withnetcdf ac_build_tutorials="no" # Check whether --enable-build-tutorials was given. if test "${enable_build_tutorials+set}" = set; then enableval=$enable_build_tutorials; ac_build_tutorials=$enableval else ac_build_tutorials="no" fi if test "$ac_build_tutorials" = "yes"; then BUILD_TUTORIALS_TRUE= BUILD_TUTORIALS_FALSE='#' else BUILD_TUTORIALS_TRUE='#' BUILD_TUTORIALS_FALSE= fi # Check whether --with-moduledir was given. if test "${with_moduledir+set}" = set; then withval=$with_moduledir; ac_moduledir=$withval else ac_moduledir="no" fi if test x"$ac_moduledir" != x"no" ; then moduledir=$ac_moduledir else moduledir=${includedir}/${fc_type} fi FCFLAGS="$FCFLAGS $FCFLAGS_f90" lowleveldocdir=$docdir"/low_level" groupleveldocdir=$docdir"/group_level" utilsdocdir=$docdir"/utils" tutorialsdocdir=$docdir"/tutorials" ac_config_files="$ac_config_files Makefile src/low_level/Makefile src/group_level/Makefile src/tutorials/Makefile src/utils/Makefile tests/low_level/Makefile tests/group_level/Makefile tests/utils/Makefile doc/www/Makefile doc/www/low_level/Makefile doc/www/group_level/Makefile doc/www/utils/Makefile doc/www/tutorials/Makefile" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs, see configure's option --config-cache. # It is not useful on other systems. If it contains results you don't # want to keep, you may remove or edit it. # # config.status only pays attention to the cache file if you give it # the --recheck option to rerun configure. # # `ac_cv_env_foo' variables (set or unset) will be overridden when # loading this file, other *unset* `ac_cv_foo' will be assigned the # following values. _ACEOF # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. # So, we kill variables containing newlines. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. ( for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { echo "$as_me:$LINENO: WARNING: Cache variable $ac_var contains a newline." >&5 echo "$as_me: WARNING: Cache variable $ac_var contains a newline." >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( *) $as_unset $ac_var ;; esac ;; esac done (set) 2>&1 | case $as_nl`(ac_space=' '; set) 2>&1` in #( *${as_nl}ac_space=\ *) # `set' does not quote correctly, so add quotes (double-quote # substitution turns \\\\ into \\, and sed turns \\ into \). sed -n \ "s/'/'\\\\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" ;; #( *) # `set' quotes correctly as required by POSIX, so do not add quotes. sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) | sed ' /^ac_cv_env_/b end t clear :clear s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ t end s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ :end' >>confcache if diff "$cache_file" confcache >/dev/null 2>&1; then :; else if test -w "$cache_file"; then test "x$cache_file" != "x/dev/null" && { echo "$as_me:$LINENO: updating cache $cache_file" >&5 echo "$as_me: updating cache $cache_file" >&6;} cat confcache >$cache_file else { echo "$as_me:$LINENO: not updating unwritable cache $cache_file" >&5 echo "$as_me: not updating unwritable cache $cache_file" >&6;} fi fi rm -f confcache test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' # Transform confdefs.h into DEFS. # Protect against shell expansion while executing Makefile rules. # Protect against Makefile macro expansion. # # If the first sed substitution is executed (which looks for macros that # take arguments), then branch to the quote section. Otherwise, # look for a macro that doesn't take arguments. ac_script=' t clear :clear s/^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\)/-D\1=\2/g t quote s/^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)/-D\1=\2/g t quote b any :quote s/[ `~#$^&*(){}\\|;'\''"<>?]/\\&/g s/\[/\\&/g s/\]/\\&/g s/\$/$$/g H :any ${ g s/^\n// s/\n/ /g p } ' DEFS=`sed -n "$ac_script" confdefs.h` ac_libobjs= ac_ltlibobjs= for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue # 1. Remove the extension, and $U if already installed. ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' ac_i=`echo "$ac_i" | sed "$ac_script"` # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR # will be set to the directory where LIBOBJS objects are built. ac_libobjs="$ac_libobjs \${LIBOBJDIR}$ac_i\$U.$ac_objext" ac_ltlibobjs="$ac_ltlibobjs \${LIBOBJDIR}$ac_i"'$U.lo' done LIBOBJS=$ac_libobjs LTLIBOBJS=$ac_ltlibobjs if test -z "${CAPITALIZE_TRUE}" && test -z "${CAPITALIZE_FALSE}"; then { { echo "$as_me:$LINENO: error: conditional \"CAPITALIZE\" was never defined. Usually this means the macro was only invoked conditionally." >&5 echo "$as_me: error: conditional \"CAPITALIZE\" was never defined. Usually this means the macro was only invoked conditionally." >&2;} { (exit 1); exit 1; }; } fi if test -z "${BUILD_TUTORIALS_TRUE}" && test -z "${BUILD_TUTORIALS_FALSE}"; then { { echo "$as_me:$LINENO: error: conditional \"BUILD_TUTORIALS\" was never defined. Usually this means the macro was only invoked conditionally." >&5 echo "$as_me: error: conditional \"BUILD_TUTORIALS\" was never defined. Usually this means the macro was only invoked conditionally." >&2;} { (exit 1); exit 1; }; } fi : ${CONFIG_STATUS=./config.status} ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" { echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5 echo "$as_me: creating $CONFIG_STATUS" >&6;} cat >$CONFIG_STATUS <<_ACEOF #! $SHELL # Generated by $as_me. # Run this file to recreate the current configuration. # Compiler output produced by configure, useful for debugging # configure, is in config.log if it exists. debug=false ac_cs_recheck=false ac_cs_silent=false SHELL=\${CONFIG_SHELL-$SHELL} _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix ;; esac fi # PATH needs CR # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # IFS # We need space, tab and new line, in precisely that order. Quoting is # there to prevent editors from complaining about space-tab. # (If _AS_PATH_WALK were called with IFS unset, it would disable word # splitting by setting IFS to empty value.) as_nl=' ' IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 { (exit 1); exit 1; } fi # Work around bugs in pre-3.0 UWIN ksh. for as_var in ENV MAIL MAILPATH do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var done PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # CDPATH. $as_unset CDPATH as_lineno_1=$LINENO as_lineno_2=$LINENO test "x$as_lineno_1" != "x$as_lineno_2" && test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || { # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line after each line using $LINENO; the second 'sed' # does the real work. The second script uses 'N' to pair each # line-number line with the line containing $LINENO, and appends # trailing '-' during substitution so that $LINENO is not a special # case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # scripts with optimization help from Paolo Bonzini. Blame Lee # E. McMahon (1931-1989) for sed's syntax. :-) sed -n ' p /[$]LINENO/= ' <$as_myself | sed ' s/[$]LINENO.*/&-/ t lineno b :lineno N :loop s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ t loop s/-\n.*// ' >$as_me.lineno && chmod +x "$as_me.lineno" || { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this). . "./$as_me.lineno" # Exit status is that of the last command. exit } if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in -n*) case `echo 'x\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. *) ECHO_C='\c';; esac;; *) ECHO_N='-n';; esac if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir fi echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. # In both cases, we have to default to `cp -p'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -p' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi if test -x / >/dev/null 2>&1; then as_test_x='test -x' else if ls -dL / >/dev/null 2>&1; then as_ls_L_option=L else as_ls_L_option= fi as_test_x=' eval sh -c '\'' if test -d "$1"; then test -d "$1/."; else case $1 in -*)set "./$1";; esac; case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in ???[sx]*):;;*)false;;esac;fi '\'' sh ' fi as_executable_p=$as_test_x # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" exec 6>&1 # Save the log message, to keep $[0] and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" This file was extended by ETSF - IO library $as_me 1.0.3, which was generated by GNU Autoconf 2.61. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ on `(hostname || uname -n) 2>/dev/null | sed 1q` " _ACEOF cat >>$CONFIG_STATUS <<_ACEOF # Files that config.status was made for. config_files="$ac_config_files" _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF ac_cs_usage="\ \`$as_me' instantiates files from templates according to the current configuration. Usage: $0 [OPTIONS] [FILE]... -h, --help print this help, then exit -V, --version print version number and configuration settings, then exit -q, --quiet do not print progress messages -d, --debug don't remove temporary files --recheck update $as_me by reconfiguring in the same conditions --file=FILE[:TEMPLATE] instantiate the configuration file FILE Configuration files: $config_files Report bugs to ." _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ ETSF - IO library config.status 1.0.3 configured by $0, generated by GNU Autoconf 2.61, with options \\"`echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\" Copyright (C) 2006 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." ac_pwd='$ac_pwd' srcdir='$srcdir' INSTALL='$INSTALL' MKDIR_P='$MKDIR_P' _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # If no file are specified by the user, then we need to provide default # value. By we need to know if files were specified by the user. ac_need_defaults=: while test $# != 0 do case $1 in --*=*) ac_option=`expr "X$1" : 'X\([^=]*\)='` ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` ac_shift=: ;; *) ac_option=$1 ac_optarg=$2 ac_shift=shift ;; esac case $ac_option in # Handling of the options. -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) echo "$ac_cs_version"; exit ;; --debug | --debu | --deb | --de | --d | -d ) debug=: ;; --file | --fil | --fi | --f ) $ac_shift CONFIG_FILES="$CONFIG_FILES $ac_optarg" ac_need_defaults=false;; --he | --h | --help | --hel | -h ) echo "$ac_cs_usage"; exit ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil | --si | --s) ac_cs_silent=: ;; # This is an error. -*) { echo "$as_me: error: unrecognized option: $1 Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; } ;; *) ac_config_targets="$ac_config_targets $1" ac_need_defaults=false ;; esac shift done ac_configure_extra_args= if $ac_cs_silent; then exec 6>/dev/null ac_configure_extra_args="$ac_configure_extra_args --silent" fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF if \$ac_cs_recheck; then echo "running CONFIG_SHELL=$SHELL $SHELL $0 "$ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6 CONFIG_SHELL=$SHELL export CONFIG_SHELL exec $SHELL "$0"$ac_configure_args \$ac_configure_extra_args --no-create --no-recursion fi _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF exec 5>>config.log { echo sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX ## Running $as_me. ## _ASBOX echo "$ac_log" } >&5 _ACEOF cat >>$CONFIG_STATUS <<_ACEOF _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # Handling of arguments. for ac_config_target in $ac_config_targets do case $ac_config_target in "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;; "src/low_level/Makefile") CONFIG_FILES="$CONFIG_FILES src/low_level/Makefile" ;; "src/group_level/Makefile") CONFIG_FILES="$CONFIG_FILES src/group_level/Makefile" ;; "src/tutorials/Makefile") CONFIG_FILES="$CONFIG_FILES src/tutorials/Makefile" ;; "src/utils/Makefile") CONFIG_FILES="$CONFIG_FILES src/utils/Makefile" ;; "tests/low_level/Makefile") CONFIG_FILES="$CONFIG_FILES tests/low_level/Makefile" ;; "tests/group_level/Makefile") CONFIG_FILES="$CONFIG_FILES tests/group_level/Makefile" ;; "tests/utils/Makefile") CONFIG_FILES="$CONFIG_FILES tests/utils/Makefile" ;; "doc/www/Makefile") CONFIG_FILES="$CONFIG_FILES doc/www/Makefile" ;; "doc/www/low_level/Makefile") CONFIG_FILES="$CONFIG_FILES doc/www/low_level/Makefile" ;; "doc/www/group_level/Makefile") CONFIG_FILES="$CONFIG_FILES doc/www/group_level/Makefile" ;; "doc/www/utils/Makefile") CONFIG_FILES="$CONFIG_FILES doc/www/utils/Makefile" ;; "doc/www/tutorials/Makefile") CONFIG_FILES="$CONFIG_FILES doc/www/tutorials/Makefile" ;; *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 echo "$as_me: error: invalid argument: $ac_config_target" >&2;} { (exit 1); exit 1; }; };; esac done # If the user did not use the arguments to specify the items to instantiate, # then the envvar interface is used. Set only those that are not. # We use the long form for the default assignment because of an extremely # bizarre bug on SunOS 4.1.3. if $ac_need_defaults; then test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files fi # Have a temporary directory for convenience. Make it in the build tree # simply because there is no reason against having it here, and in addition, # creating and moving files from /tmp can sometimes cause problems. # Hook for its removal unless debugging. # Note that there is a small window in which the directory will not be cleaned: # after its creation but before its name has been assigned to `$tmp'. $debug || { tmp= trap 'exit_status=$? { test -z "$tmp" || test ! -d "$tmp" || rm -fr "$tmp"; } && exit $exit_status ' 0 trap '{ (exit 1); exit 1; }' 1 2 13 15 } # Create a (secure) tmp directory for tmp files. { tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" } || { tmp=./conf$$-$RANDOM (umask 077 && mkdir "$tmp") } || { echo "$me: cannot create a temporary directory in ." >&2 { (exit 1); exit 1; } } # # Set up the sed scripts for CONFIG_FILES section. # # No need to generate the scripts if there are no CONFIG_FILES. # This happens for instance when ./config.status config.h if test -n "$CONFIG_FILES"; then _ACEOF ac_delim='%!_!# ' for ac_last_try in false false false false false :; do cat >conf$$subs.sed <<_ACEOF SHELL!$SHELL$ac_delim PATH_SEPARATOR!$PATH_SEPARATOR$ac_delim PACKAGE_NAME!$PACKAGE_NAME$ac_delim PACKAGE_TARNAME!$PACKAGE_TARNAME$ac_delim PACKAGE_VERSION!$PACKAGE_VERSION$ac_delim PACKAGE_STRING!$PACKAGE_STRING$ac_delim PACKAGE_BUGREPORT!$PACKAGE_BUGREPORT$ac_delim exec_prefix!$exec_prefix$ac_delim prefix!$prefix$ac_delim program_transform_name!$program_transform_name$ac_delim bindir!$bindir$ac_delim sbindir!$sbindir$ac_delim libexecdir!$libexecdir$ac_delim datarootdir!$datarootdir$ac_delim datadir!$datadir$ac_delim sysconfdir!$sysconfdir$ac_delim sharedstatedir!$sharedstatedir$ac_delim localstatedir!$localstatedir$ac_delim includedir!$includedir$ac_delim oldincludedir!$oldincludedir$ac_delim docdir!$docdir$ac_delim infodir!$infodir$ac_delim htmldir!$htmldir$ac_delim dvidir!$dvidir$ac_delim pdfdir!$pdfdir$ac_delim psdir!$psdir$ac_delim libdir!$libdir$ac_delim localedir!$localedir$ac_delim mandir!$mandir$ac_delim DEFS!$DEFS$ac_delim ECHO_C!$ECHO_C$ac_delim ECHO_N!$ECHO_N$ac_delim ECHO_T!$ECHO_T$ac_delim LIBS!$LIBS$ac_delim build_alias!$build_alias$ac_delim host_alias!$host_alias$ac_delim target_alias!$target_alias$ac_delim INSTALL_PROGRAM!$INSTALL_PROGRAM$ac_delim INSTALL_SCRIPT!$INSTALL_SCRIPT$ac_delim INSTALL_DATA!$INSTALL_DATA$ac_delim am__isrc!$am__isrc$ac_delim CYGPATH_W!$CYGPATH_W$ac_delim PACKAGE!$PACKAGE$ac_delim VERSION!$VERSION$ac_delim ACLOCAL!$ACLOCAL$ac_delim AUTOCONF!$AUTOCONF$ac_delim AUTOMAKE!$AUTOMAKE$ac_delim AUTOHEADER!$AUTOHEADER$ac_delim MAKEINFO!$MAKEINFO$ac_delim install_sh!$install_sh$ac_delim STRIP!$STRIP$ac_delim INSTALL_STRIP_PROGRAM!$INSTALL_STRIP_PROGRAM$ac_delim mkdir_p!$mkdir_p$ac_delim AWK!$AWK$ac_delim SET_MAKE!$SET_MAKE$ac_delim am__leading_dot!$am__leading_dot$ac_delim AMTAR!$AMTAR$ac_delim am__tar!$am__tar$ac_delim am__untar!$am__untar$ac_delim FC!$FC$ac_delim FCFLAGS!$FCFLAGS$ac_delim LDFLAGS!$LDFLAGS$ac_delim ac_ct_FC!$ac_ct_FC$ac_delim EXEEXT!$EXEEXT$ac_delim OBJEXT!$OBJEXT$ac_delim FCFLAGS_f90!$FCFLAGS_f90$ac_delim fc_type!$fc_type$ac_delim fc_version!$fc_version$ac_delim fc_wrap!$fc_wrap$ac_delim CAPITALIZE_TRUE!$CAPITALIZE_TRUE$ac_delim CAPITALIZE_FALSE!$CAPITALIZE_FALSE$ac_delim MODULE_EXT!$MODULE_EXT$ac_delim FFLAGS!$FFLAGS$ac_delim RANLIB!$RANLIB$ac_delim AR!$AR$ac_delim NETCDF_CFLAGS!$NETCDF_CFLAGS$ac_delim BUILD_TUTORIALS_TRUE!$BUILD_TUTORIALS_TRUE$ac_delim BUILD_TUTORIALS_FALSE!$BUILD_TUTORIALS_FALSE$ac_delim moduledir!$moduledir$ac_delim lowleveldocdir!$lowleveldocdir$ac_delim groupleveldocdir!$groupleveldocdir$ac_delim utilsdocdir!$utilsdocdir$ac_delim tutorialsdocdir!$tutorialsdocdir$ac_delim LIBOBJS!$LIBOBJS$ac_delim LTLIBOBJS!$LTLIBOBJS$ac_delim _ACEOF if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 85; then break elif $ac_last_try; then { { echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5 echo "$as_me: error: could not make $CONFIG_STATUS" >&2;} { (exit 1); exit 1; }; } else ac_delim="$ac_delim!$ac_delim _$ac_delim!! " fi done ac_eof=`sed -n '/^CEOF[0-9]*$/s/CEOF/0/p' conf$$subs.sed` if test -n "$ac_eof"; then ac_eof=`echo "$ac_eof" | sort -nru | sed 1q` ac_eof=`expr $ac_eof + 1` fi cat >>$CONFIG_STATUS <<_ACEOF cat >"\$tmp/subs-1.sed" <<\CEOF$ac_eof /@[a-zA-Z_][a-zA-Z_0-9]*@/!b end _ACEOF sed ' s/[,\\&]/\\&/g; s/@/@|#_!!_#|/g s/^/s,@/; s/!/@,|#_!!_#|/ :n t n s/'"$ac_delim"'$/,g/; t s/$/\\/; p N; s/^.*\n//; s/[,\\&]/\\&/g; s/@/@|#_!!_#|/g; b n ' >>$CONFIG_STATUS >$CONFIG_STATUS <<_ACEOF :end s/|#_!!_#|//g CEOF$ac_eof _ACEOF # VPATH may cause trouble with some makes, so we remove $(srcdir), # ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and # trailing colons and then remove the whole line if VPATH becomes empty # (actually we leave an empty line to preserve line numbers). if test "x$srcdir" = x.; then ac_vpsub='/^[ ]*VPATH[ ]*=/{ s/:*\$(srcdir):*/:/ s/:*\${srcdir}:*/:/ s/:*@srcdir@:*/:/ s/^\([^=]*=[ ]*\):*/\1/ s/:*$// s/^[^=]*=[ ]*$// }' fi cat >>$CONFIG_STATUS <<\_ACEOF fi # test -n "$CONFIG_FILES" for ac_tag in :F $CONFIG_FILES do case $ac_tag in :[FHLC]) ac_mode=$ac_tag; continue;; esac case $ac_mode$ac_tag in :[FHL]*:*);; :L* | :C*:*) { { echo "$as_me:$LINENO: error: Invalid tag $ac_tag." >&5 echo "$as_me: error: Invalid tag $ac_tag." >&2;} { (exit 1); exit 1; }; };; :[FH]-) ac_tag=-:-;; :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; esac ac_save_IFS=$IFS IFS=: set x $ac_tag IFS=$ac_save_IFS shift ac_file=$1 shift case $ac_mode in :L) ac_source=$1;; :[FH]) ac_file_inputs= for ac_f do case $ac_f in -) ac_f="$tmp/stdin";; *) # Look for the file first in the build tree, then in the source tree # (if the path is not absolute). The absolute path cannot be DOS-style, # because $ac_f cannot contain `:'. test -f "$ac_f" || case $ac_f in [\\/$]*) false;; *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; esac || { { echo "$as_me:$LINENO: error: cannot find input file: $ac_f" >&5 echo "$as_me: error: cannot find input file: $ac_f" >&2;} { (exit 1); exit 1; }; };; esac ac_file_inputs="$ac_file_inputs $ac_f" done # Let's still pretend it is `configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ configure_input="Generated from "`IFS=: echo $* | sed 's|^[^:]*/||;s|:[^:]*/|, |g'`" by configure." if test x"$ac_file" != x-; then configure_input="$ac_file. $configure_input" { echo "$as_me:$LINENO: creating $ac_file" >&5 echo "$as_me: creating $ac_file" >&6;} fi case $ac_tag in *:-:* | *:-) cat >"$tmp/stdin";; esac ;; esac ac_dir=`$as_dirname -- "$ac_file" || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || echo X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` { as_dir="$ac_dir" case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || { $as_mkdir_p && mkdir -p "$as_dir"; } || { as_dirs= while :; do case $as_dir in #( *\'*) as_qdir=`echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #( *) as_qdir=$as_dir;; esac as_dirs="'$as_qdir' $as_dirs" as_dir=`$as_dirname -- "$as_dir" || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` test -d "$as_dir" && break done test -z "$as_dirs" || eval "mkdir $as_dirs" } || test -d "$as_dir" || { { echo "$as_me:$LINENO: error: cannot create directory $as_dir" >&5 echo "$as_me: error: cannot create directory $as_dir" >&2;} { (exit 1); exit 1; }; }; } ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,/..,g;s,/,,'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix case $ac_mode in :F) # # CONFIG_FILE # case $INSTALL in [\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;; *) ac_INSTALL=$ac_top_build_prefix$INSTALL ;; esac ac_MKDIR_P=$MKDIR_P case $MKDIR_P in [\\/$]* | ?:[\\/]* ) ;; */*) ac_MKDIR_P=$ac_top_build_prefix$MKDIR_P ;; esac _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # If the template does not know about datarootdir, expand it. # FIXME: This hack should be removed a few years after 2.60. ac_datarootdir_hack=; ac_datarootdir_seen= case `sed -n '/datarootdir/ { p q } /@datadir@/p /@docdir@/p /@infodir@/p /@localedir@/p /@mandir@/p ' $ac_file_inputs` in *datarootdir*) ac_datarootdir_seen=yes;; *@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) { echo "$as_me:$LINENO: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_datarootdir_hack=' s&@datadir@&$datadir&g s&@docdir@&$docdir&g s&@infodir@&$infodir&g s&@localedir@&$localedir&g s&@mandir@&$mandir&g s&\\\${datarootdir}&$datarootdir&g' ;; esac _ACEOF # Neutralize VPATH when `$srcdir' = `.'. # Shell code in configure.ac might set extrasub. # FIXME: do we really want to maintain this feature? cat >>$CONFIG_STATUS <<_ACEOF sed "$ac_vpsub $extrasub _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF :t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b s&@configure_input@&$configure_input&;t t s&@top_builddir@&$ac_top_builddir_sub&;t t s&@srcdir@&$ac_srcdir&;t t s&@abs_srcdir@&$ac_abs_srcdir&;t t s&@top_srcdir@&$ac_top_srcdir&;t t s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t s&@builddir@&$ac_builddir&;t t s&@abs_builddir@&$ac_abs_builddir&;t t s&@abs_top_builddir@&$ac_abs_top_builddir&;t t s&@INSTALL@&$ac_INSTALL&;t t s&@MKDIR_P@&$ac_MKDIR_P&;t t $ac_datarootdir_hack " $ac_file_inputs | sed -f "$tmp/subs-1.sed" >$tmp/out test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && { ac_out=`sed -n '/\${datarootdir}/p' "$tmp/out"`; test -n "$ac_out"; } && { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' "$tmp/out"`; test -z "$ac_out"; } && { echo "$as_me:$LINENO: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined." >&5 echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined." >&2;} rm -f "$tmp/stdin" case $ac_file in -) cat "$tmp/out"; rm -f "$tmp/out";; *) rm -f "$ac_file"; mv "$tmp/out" $ac_file;; esac ;; esac done # for ac_tag { (exit 0); exit 0; } _ACEOF chmod +x $CONFIG_STATUS ac_clean_files=$ac_clean_files_save # configure is writing to config.log, and then calls config.status. # config.status does its own redirection, appending to config.log. # Unfortunately, on DOS this fails, as config.log is still kept open # by configure, so config.status won't be able to write to it; its # output is simply discarded. So we exec the FD to /dev/null, # effectively closing config.log, so it can be properly (re)opened and # appended to by config.status. When coming back to configure, we # need to make the FD available again. if test "$no_create" != yes; then ac_cs_success=: ac_config_status_args= test "$silent" = yes && ac_config_status_args="$ac_config_status_args --quiet" exec 5>/dev/null $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. $ac_cs_success || { (exit 1); exit 1; } fi echo " Basics: Prefix: $prefix Fortran90 compiler: $FC Fortran90 flags: $FCFLAGS Linker flags: $LDFLAGS Linked libraries: $LIBS Installed module dir: $moduledir Installed lib dir: $libdir Installed doc dir: $docdir " etsf_io-1.0.3/AUTHORS0000644000353400050630000000012410662533067011144 00000000000000Damien Caliste (DC) Valerio Olevano (VO) Yann Pouillon (YP) Matthieu Verstaete (MV) etsf_io-1.0.3/COPYING0000644000353400050630000006350410621016457011134 00000000000000 GNU LESSER GENERAL PUBLIC LICENSE Version 2.1, February 1999 Copyright (C) 1991, 1999 Free Software Foundation, Inc. 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. [This is the first released version of the Lesser GPL. It also counts as the successor of the GNU Library Public License, version 2, hence the version number 2.1.] Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below. When we speak of free software, we are referring to freedom of use, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things. To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it. For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights. We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library. To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others. Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license. Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs. When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library. We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances. For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License. In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system. Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library. The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run. GNU LESSER GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you". A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) The modified work must itself be a software library. b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. 6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with. c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License. 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 13. The Free Software Foundation may publish revised and/or new versions of the Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Libraries If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License). To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the library `Frob' (a library for tweaking knobs) written by James Random Hacker. , 1 April 1990 Ty Coon, President of Vice That's all there is to it! etsf_io-1.0.3/ChangeLog0000644000353400050630000002136111354151411011640 00000000000000* Mon Mar 29 2010 Damien Caliste 1.0.3 - Correct configure.ac and Makefile.am for aclocal to always run with its config/m4 inclusion. - Modify the dielectric function specification to fullfil specs 3.3. - Comment out the phonon part since not yet included officially in the spec. - Modify the NetCDF detection in configure.ac to automatically detect NetCDF on Debian (using -lnetcdff and -lnetcdf). - Modify the build system in doc to properly install the developper doc. * Thu Nov 07 2008 Damien Caliste 1.0.3-dev2 - Add the proposal specification for the phonons. - Modify the code generation to correctly handle the case with twice the same dimension in the shape declaration of an array. In that case _%d is appended to the name of the attricute in the group structure. - Correct a bug to actually use the restriction on the number of elements for the variables that have a max_something dimension but that has no split flag. * Thu Nov 06 2008 Damien Caliste 1.0.3-dev1 - Add the proposal specification for the dielectric function. * Thu Sep 11 2008 Damien Caliste 1.0.2 - Update the fortran.m4 macro to recognise the open64 compiler. - Update the configure.ac to handle the open64 compiler. * Fri Apr 04 2008 Damien Caliste 1.0.1 - Add a --with-moduledir option to the configure to be able to choose the installation path for modules. - Update the fortran.m4 macro to recognise newest version of gfortran (>4.1). * Tue Aug 21 2007 Damien Caliste 1.0.0 - Official publication of version 1.0.0. * Thu Aug 09 2007 Damien Caliste 1.0-rc2 - correct a bug in etsf_io when checking the wavefunctions in plane_waves mode with k_dependent = "no". - add a simple routine in etsf_io_low_level to read the flag attribute as defined in the specifications. Also add tests for this routine. - add the support of split definition in the check routines. - bugs corrections in tests/low_level, src/low_level/read_routines.f90, the documentation... * Fri Jul 06 2007 Damien Caliste 1.0-rc1 - add tests for the copy action of the ETSF groups. - add a tutorial on the reading part, very simple with the basics of the etsf_io__get routines and the possible split definitions. - add gestion of the use_time_reversal_at_gamma attribute as introduced by the 2.2 specifications. - add a full backtrace for the routines in the library to ease the tracking of errors when called from an other program. - add a way to precisely choose the variables when defining a file. This has bringed some minor in the ETSF group API, for etsf_io_main_* and for etsf_io_data_*. - add the wavelet basis set as discussed in the IT9 meeting in San Sebastian in May 2007 (still in a draft for inclusion in specifications when 0.10 has been shipped). * Fri May 11 2007 Damien Caliste 0.9 - complete all TODO occurances in the HTML pages. - update all licence citation and remove all ABINIT occurance. Also add 2007 to the copyright and the name of the author for each part of the code. - implement a copy_all_attribute routine in the low_level module. This routine is then used by the group level copy routines and the utils level merge routine to keep tracks of attributes in file merging. Several tests have been added in the low level pool to ensure this new copy routine. - add a tutorial on the creation of non-ETSF variables, concurrently with ETSF ones. - change the name of the wavedata group to basisdata for a better consistency. * Fri Mar 09 2007 Damien Caliste 0.8 - add two more tutorials, one on the split usage and one on the high level routines. - improve the documentation, especially the non robodoc pages. - create a high level routine to check the validity of a file on the big domains the specifications deal with. - create a high level routine to get the names of chemical species following the recommendations in the specifications. - add two more actions to the etsf_io tool: the content and the check actions. - fix some bugs in the build system and in the low level part. * Wed Jan 17 2007 Damien Caliste 0.7 - add a new Fortran type to store the split definitions (e.g. my_kpoints...). This structure can be used when defining the variables on initialisation to set the splitted dimensions to the variables that need them. - add a new source directory src/utils that will contains some high level library not mandatory but with convienient tools. It currently contains a routine to merge files that have been created with some split definition. To do it several group level have been added, especially some to copy variables from one file to another. The split action is complete for all ETSF variables, but other ones are currently lost, but also attributes and headers are lost. - add a new tutorial on sub access. It explain how to use the __[spin|kpoint]_access attributes of groups that have been introduced in the last release. * Tue Dec 12 2006 Damien Caliste 0.6 - rewrite the generating script for low access in Python for a better portability. - complete the implementation of all attributes (units, k_dependent and symmorphic). The unit attributes change the reading behavior, getting the values into atomic units, except if the optional argument use_atomic_units is set to false. The k_dependent attribute change the size of the array reduced_coordinates_of_plane_waves when set on creation. The symmorphic attribute is changed whenever the reduced_symmetry_translations are written. - modify the support for sub access in an array, using new elements in each groups instead of a special type for selected variables. These new element are based on a short name for the variable, followed by two underscore and spin_access or kpoint_access, storing an integer corresponding to the spin or the k point to be read or written. Whenever a variable has a dimension with max_number_of_something, such an element is also created in the group to be able to read or write only a part in that dimension. - add a documentation for the argument of group level routines. - create an index.html page in the doc/www section. - create a tutorial section in the sources, being cases heavily documented. Only one example is currently given. * Wed Nov 29 2006 Damien Caliste 0.5 - Completely change the low level sub-part access, using now the start, count and map argument as in NetCDF (with small modifications). This has been required to be able to have sub access on every dimensions, not only the last and to have access to part of one dimension (not only one element or the all set of elements of one dimension). With the map attribute, it will be possible to swap dimensions on the fly when reading or writing. - change the status of the main group in the group level access. The main group is now part of the etsf_groups folder as others. When defining, it is still possible to choose one or several variables of this main group. - add partial support for the units attribute (writing is done with default values and reading only load the values but do nothing with them) and the k_dependant attribute for number_of_coefficients and number_of_states. - correct a bug in the implementation while still using the old number_of_symmetries dimension. * Fri Nov 17 2006 Damien Caliste 0.4 - create a type for variables that can have a partial access. Update the code routine to cope with this new type. - upgrade the documentation by using sections and subsections. - correct a bug when using sub access on low level. * Mon Nov 13 2006 Damien Caliste 0.3 - import the group level scripts of Yann Pouillon to build a high level API on the ETSF specifications. - modify then to use the unformatted shape for the main data in the ETSF specs. - make the group level routines use the low level ones (guaranteeing dimension checks). - add default values in the etsf_io structure and add the consistency checks in calls. * Mon Nov 06 2006 Damien Caliste 0.2 - modify the low level API to allow to use different (but compatible) shapes for variables. - add the capability to address only part of variables. - create a generic type of pointers to be able to use the library without dupplicating data in memory and access same data with the same high level routine but with an unformatted shape array. * Thu Nov 02 2006 Damien Caliste 0.1 - basic read/write low level API in Fortran90. - put library under the LGPL, waiting for global discussion on the future licence. - initial API documentation using ROBODoc. etsf_io-1.0.3/INSTALL0000644000353400050630000002240610621016473011124 00000000000000Installation Instructions ************************* Copyright (C) 1994, 1995, 1996, 1999, 2000, 2001, 2002, 2004, 2005 Free Software Foundation, Inc. This file is free documentation; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. Basic Installation ================== These are generic installation instructions. The `configure' shell script attempts to guess correct values for various system-dependent variables used during compilation. It uses those values to create a `Makefile' in each directory of the package. It may also create one or more `.h' files containing system-dependent definitions. Finally, it creates a shell script `config.status' that you can run in the future to recreate the current configuration, and a file `config.log' containing compiler output (useful mainly for debugging `configure'). It can also use an optional file (typically called `config.cache' and enabled with `--cache-file=config.cache' or simply `-C') that saves the results of its tests to speed up reconfiguring. (Caching is disabled by default to prevent problems with accidental use of stale cache files.) If you need to do unusual things to compile the package, please try to figure out how `configure' could check whether to do them, and mail diffs or instructions to the address given in the `README' so they can be considered for the next release. If you are using the cache, and at some point `config.cache' contains results you don't want to keep, you may remove or edit it. The file `configure.ac' (or `configure.in') is used to create `configure' by a program called `autoconf'. You only need `configure.ac' if you want to change it or regenerate `configure' using a newer version of `autoconf'. The simplest way to compile this package is: 1. `cd' to the directory containing the package's source code and type `./configure' to configure the package for your system. If you're using `csh' on an old version of System V, you might need to type `sh ./configure' instead to prevent `csh' from trying to execute `configure' itself. Running `configure' takes awhile. While running, it prints some messages telling which features it is checking for. 2. Type `make' to compile the package. 3. Optionally, type `make check' to run any self-tests that come with the package. 4. Type `make install' to install the programs and any data files and documentation. 5. You can remove the program binaries and object files from the source code directory by typing `make clean'. To also remove the files that `configure' created (so you can compile the package for a different kind of computer), type `make distclean'. There is also a `make maintainer-clean' target, but that is intended mainly for the package's developers. If you use it, you may have to get all sorts of other programs in order to regenerate files that came with the distribution. Compilers and Options ===================== Some systems require unusual options for compilation or linking that the `configure' script does not know about. Run `./configure --help' for details on some of the pertinent environment variables. You can give `configure' initial values for configuration parameters by setting variables in the command line or in the environment. Here is an example: ./configure CC=c89 CFLAGS=-O2 LIBS=-lposix *Note Defining Variables::, for more details. Compiling For Multiple Architectures ==================================== You can compile the package for more than one kind of computer at the same time, by placing the object files for each architecture in their own directory. To do this, you must use a version of `make' that supports the `VPATH' variable, such as GNU `make'. `cd' to the directory where you want the object files and executables to go and run the `configure' script. `configure' automatically checks for the source code in the directory that `configure' is in and in `..'. If you have to use a `make' that does not support the `VPATH' variable, you have to compile the package for one architecture at a time in the source code directory. After you have installed the package for one architecture, use `make distclean' before reconfiguring for another architecture. Installation Names ================== By default, `make install' will install the package's files in `/usr/local/bin', `/usr/local/man', etc. You can specify an installation prefix other than `/usr/local' by giving `configure' the option `--prefix=PREFIX'. You can specify separate installation prefixes for architecture-specific files and architecture-independent files. If you give `configure' the option `--exec-prefix=PREFIX', the package will use PREFIX as the prefix for installing programs and libraries. Documentation and other data files will still use the regular prefix. In addition, if you use an unusual directory layout you can give options like `--bindir=DIR' to specify different values for particular kinds of files. Run `configure --help' for a list of the directories you can set and what kinds of files go in them. If the package supports it, you can cause programs to be installed with an extra prefix or suffix on their names by giving `configure' the option `--program-prefix=PREFIX' or `--program-suffix=SUFFIX'. Optional Features ================= Some packages pay attention to `--enable-FEATURE' options to `configure', where FEATURE indicates an optional part of the package. They may also pay attention to `--with-PACKAGE' options, where PACKAGE is something like `gnu-as' or `x' (for the X Window System). The `README' should mention any `--enable-' and `--with-' options that the package recognizes. For packages that use the X Window System, `configure' can usually find the X include and library files automatically, but if it doesn't, you can use the `configure' options `--x-includes=DIR' and `--x-libraries=DIR' to specify their locations. Specifying the System Type ========================== There may be some features `configure' cannot figure out automatically, but needs to determine by the type of machine the package will run on. Usually, assuming the package is built to be run on the _same_ architectures, `configure' can figure that out, but if it prints a message saying it cannot guess the machine type, give it the `--build=TYPE' option. TYPE can either be a short name for the system type, such as `sun4', or a canonical name which has the form: CPU-COMPANY-SYSTEM where SYSTEM can have one of these forms: OS KERNEL-OS See the file `config.sub' for the possible values of each field. If `config.sub' isn't included in this package, then this package doesn't need to know the machine type. If you are _building_ compiler tools for cross-compiling, you should use the `--target=TYPE' option to select the type of system they will produce code for. If you want to _use_ a cross compiler, that generates code for a platform different from the build platform, you should specify the "host" platform (i.e., that on which the generated programs will eventually be run) with `--host=TYPE'. Sharing Defaults ================ If you want to set default values for `configure' scripts to share, you can create a site shell script called `config.site' that gives default values for variables like `CC', `cache_file', and `prefix'. `configure' looks for `PREFIX/share/config.site' if it exists, then `PREFIX/etc/config.site' if it exists. Or, you can set the `CONFIG_SITE' environment variable to the location of the site script. A warning: not all `configure' scripts look for a site script. Defining Variables ================== Variables not defined in a site shell script can be set in the environment passed to `configure'. However, some packages may run configure again during the build, and the customized values of these variables may be lost. In order to avoid this problem, you should set them in the `configure' command line, using `VAR=value'. For example: ./configure CC=/usr/local2/bin/gcc causes the specified `gcc' to be used as the C compiler (unless it is overridden in the site shell script). Here is a another example: /bin/bash ./configure CONFIG_SHELL=/bin/bash Here the `CONFIG_SHELL=/bin/bash' operand causes subsequent configuration-related scripts to be executed by `/bin/bash'. `configure' Invocation ====================== `configure' recognizes the following options to control how it operates. `--help' `-h' Print a summary of the options to `configure', and exit. `--version' `-V' Print the version of Autoconf used to generate the `configure' script, and exit. `--cache-file=FILE' Enable the cache: use and save the results of the tests in FILE, traditionally `config.cache'. FILE defaults to `/dev/null' to disable caching. `--config-cache' `-C' Alias for `--cache-file=config.cache'. `--quiet' `--silent' `-q' Do not print messages saying which checks are being made. To suppress all normal output, redirect it to `/dev/null' (any error messages will still be shown). `--srcdir=DIR' Look for the package's source code in directory DIR. Usually `configure' can determine that directory automatically. `configure' also accepts some other, not widely useful, options. Run `configure --help' for more details. etsf_io-1.0.3/NEWS0000644000353400050630000000000010621016456010555 00000000000000etsf_io-1.0.3/TODO0000644000353400050630000000005710662533047010567 00000000000000* add tests for exotic actions (in group API). etsf_io-1.0.3/src/0000777000353400050620000000000011354151532010741 500000000000000etsf_io-1.0.3/src/low_level/0000777000353400050620000000000011354151522012730 500000000000000etsf_io-1.0.3/src/low_level/Makefile.am0000644000353400050630000000121210621016466014700 00000000000000lib_LIBRARIES = libetsf_io_low_level.a EXTRA_DIST = public_variables.f90 \ read_routines_auto.f90 \ read_routines.f90 \ write_routines.f90 \ write_routines_auto.f90 if CAPITALIZE module_DATA = ETSF_IO_LOW_LEVEL.@MODULE_EXT@ else module_DATA = etsf_io_low_level.@MODULE_EXT@ endif AM_FCFLAGS = -I@NETCDF_CFLAGS@ -I$(srcdir) libetsf_io_low_level_a_SOURCES = etsf_io_low_level.f90 #dependencies etsf_io_low_level.o: etsf_io_low_level.f90 \ public_variables.f90 \ read_routines.f90 \ read_routines_auto.f90 \ write_routines.f90 \ write_routines_auto.f90 etsf_io_low_level.@MODULE_EXT@ ETSF_IO_LOW_LEVEL.@MODULE_EXT@: etsf_io_low_level.o etsf_io-1.0.3/src/low_level/Makefile.in0000644000353400050620000003271611354150420014716 00000000000000# Makefile.in generated by automake 1.10.1 from Makefile.am. # @configure_input@ # Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, # 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. # This Makefile.in is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY, to the extent permitted by law; without # even the implied warranty of MERCHANTABILITY or FITNESS FOR A # PARTICULAR PURPOSE. @SET_MAKE@ VPATH = @srcdir@ pkgdatadir = $(datadir)/@PACKAGE@ pkglibdir = $(libdir)/@PACKAGE@ pkgincludedir = $(includedir)/@PACKAGE@ am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd install_sh_DATA = $(install_sh) -c -m 644 install_sh_PROGRAM = $(install_sh) -c install_sh_SCRIPT = $(install_sh) -c INSTALL_HEADER = $(INSTALL_DATA) transform = $(program_transform_name) NORMAL_INSTALL = : PRE_INSTALL = : POST_INSTALL = : NORMAL_UNINSTALL = : PRE_UNINSTALL = : POST_UNINSTALL = : subdir = src/low_level DIST_COMMON = $(srcdir)/Makefile.am $(srcdir)/Makefile.in ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 am__aclocal_m4_deps = $(top_srcdir)/config/m4/fortran.m4 \ $(top_srcdir)/configure.ac am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ $(ACLOCAL_M4) mkinstalldirs = $(install_sh) -d CONFIG_CLEAN_FILES = am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; am__vpath_adj = case $$p in \ $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \ *) f=$$p;; \ esac; am__strip_dir = `echo $$p | sed -e 's|^.*/||'`; am__installdirs = "$(DESTDIR)$(libdir)" "$(DESTDIR)$(moduledir)" libLIBRARIES_INSTALL = $(INSTALL_DATA) LIBRARIES = $(lib_LIBRARIES) ARFLAGS = cru libetsf_io_low_level_a_AR = $(AR) $(ARFLAGS) libetsf_io_low_level_a_LIBADD = am_libetsf_io_low_level_a_OBJECTS = etsf_io_low_level.$(OBJEXT) libetsf_io_low_level_a_OBJECTS = $(am_libetsf_io_low_level_a_OBJECTS) DEFAULT_INCLUDES = -I.@am__isrc@ FCCOMPILE = $(FC) $(AM_FCFLAGS) $(FCFLAGS) FCLD = $(FC) FCLINK = $(FCLD) $(AM_FCFLAGS) $(FCFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o \ $@ SOURCES = $(libetsf_io_low_level_a_SOURCES) DIST_SOURCES = $(libetsf_io_low_level_a_SOURCES) moduleDATA_INSTALL = $(INSTALL_DATA) DATA = $(module_DATA) ETAGS = etags CTAGS = ctags DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) ACLOCAL = @ACLOCAL@ AMTAR = @AMTAR@ AR = @AR@ AUTOCONF = @AUTOCONF@ AUTOHEADER = @AUTOHEADER@ AUTOMAKE = @AUTOMAKE@ AWK = @AWK@ CYGPATH_W = @CYGPATH_W@ DEFS = @DEFS@ ECHO_C = @ECHO_C@ ECHO_N = @ECHO_N@ ECHO_T = @ECHO_T@ EXEEXT = @EXEEXT@ FC = @FC@ FCFLAGS = @FCFLAGS@ FCFLAGS_f90 = @FCFLAGS_f90@ FFLAGS = @FFLAGS@ INSTALL = @INSTALL@ INSTALL_DATA = @INSTALL_DATA@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ INSTALL_SCRIPT = @INSTALL_SCRIPT@ INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ LDFLAGS = @LDFLAGS@ LIBOBJS = @LIBOBJS@ LIBS = @LIBS@ LTLIBOBJS = @LTLIBOBJS@ MAKEINFO = @MAKEINFO@ MKDIR_P = @MKDIR_P@ MODULE_EXT = @MODULE_EXT@ NETCDF_CFLAGS = @NETCDF_CFLAGS@ OBJEXT = @OBJEXT@ PACKAGE = @PACKAGE@ PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ PACKAGE_NAME = @PACKAGE_NAME@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_VERSION = @PACKAGE_VERSION@ PATH_SEPARATOR = @PATH_SEPARATOR@ RANLIB = @RANLIB@ SET_MAKE = @SET_MAKE@ SHELL = @SHELL@ STRIP = @STRIP@ VERSION = @VERSION@ abs_builddir = @abs_builddir@ abs_srcdir = @abs_srcdir@ abs_top_builddir = @abs_top_builddir@ abs_top_srcdir = @abs_top_srcdir@ ac_ct_FC = @ac_ct_FC@ am__leading_dot = @am__leading_dot@ am__tar = @am__tar@ am__untar = @am__untar@ bindir = @bindir@ build_alias = @build_alias@ builddir = @builddir@ datadir = @datadir@ datarootdir = @datarootdir@ docdir = @docdir@ dvidir = @dvidir@ exec_prefix = @exec_prefix@ fc_type = @fc_type@ fc_version = @fc_version@ fc_wrap = @fc_wrap@ groupleveldocdir = @groupleveldocdir@ host_alias = @host_alias@ htmldir = @htmldir@ includedir = @includedir@ infodir = @infodir@ install_sh = @install_sh@ libdir = @libdir@ libexecdir = @libexecdir@ localedir = @localedir@ localstatedir = @localstatedir@ lowleveldocdir = @lowleveldocdir@ mandir = @mandir@ mkdir_p = @mkdir_p@ moduledir = @moduledir@ oldincludedir = @oldincludedir@ pdfdir = @pdfdir@ prefix = @prefix@ program_transform_name = @program_transform_name@ psdir = @psdir@ sbindir = @sbindir@ sharedstatedir = @sharedstatedir@ srcdir = @srcdir@ sysconfdir = @sysconfdir@ target_alias = @target_alias@ top_builddir = @top_builddir@ top_srcdir = @top_srcdir@ tutorialsdocdir = @tutorialsdocdir@ utilsdocdir = @utilsdocdir@ lib_LIBRARIES = libetsf_io_low_level.a EXTRA_DIST = public_variables.f90 \ read_routines_auto.f90 \ read_routines.f90 \ write_routines.f90 \ write_routines_auto.f90 @CAPITALIZE_FALSE@module_DATA = etsf_io_low_level.@MODULE_EXT@ @CAPITALIZE_TRUE@module_DATA = ETSF_IO_LOW_LEVEL.@MODULE_EXT@ AM_FCFLAGS = -I@NETCDF_CFLAGS@ -I$(srcdir) libetsf_io_low_level_a_SOURCES = etsf_io_low_level.f90 all: all-am .SUFFIXES: .SUFFIXES: .f90 .o .obj $(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) @for dep in $?; do \ case '$(am__configure_deps)' in \ *$$dep*) \ cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh \ && exit 0; \ exit 1;; \ esac; \ done; \ echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu src/low_level/Makefile'; \ cd $(top_srcdir) && \ $(AUTOMAKE) --gnu src/low_level/Makefile .PRECIOUS: Makefile Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status @case '$?' in \ *config.status*) \ cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ *) \ echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ esac; $(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh $(top_srcdir)/configure: $(am__configure_deps) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh $(ACLOCAL_M4): $(am__aclocal_m4_deps) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh install-libLIBRARIES: $(lib_LIBRARIES) @$(NORMAL_INSTALL) test -z "$(libdir)" || $(MKDIR_P) "$(DESTDIR)$(libdir)" @list='$(lib_LIBRARIES)'; for p in $$list; do \ if test -f $$p; then \ f=$(am__strip_dir) \ echo " $(libLIBRARIES_INSTALL) '$$p' '$(DESTDIR)$(libdir)/$$f'"; \ $(libLIBRARIES_INSTALL) "$$p" "$(DESTDIR)$(libdir)/$$f"; \ else :; fi; \ done @$(POST_INSTALL) @list='$(lib_LIBRARIES)'; for p in $$list; do \ if test -f $$p; then \ p=$(am__strip_dir) \ echo " $(RANLIB) '$(DESTDIR)$(libdir)/$$p'"; \ $(RANLIB) "$(DESTDIR)$(libdir)/$$p"; \ else :; fi; \ done uninstall-libLIBRARIES: @$(NORMAL_UNINSTALL) @list='$(lib_LIBRARIES)'; for p in $$list; do \ p=$(am__strip_dir) \ echo " rm -f '$(DESTDIR)$(libdir)/$$p'"; \ rm -f "$(DESTDIR)$(libdir)/$$p"; \ done clean-libLIBRARIES: -test -z "$(lib_LIBRARIES)" || rm -f $(lib_LIBRARIES) libetsf_io_low_level.a: $(libetsf_io_low_level_a_OBJECTS) $(libetsf_io_low_level_a_DEPENDENCIES) -rm -f libetsf_io_low_level.a $(libetsf_io_low_level_a_AR) libetsf_io_low_level.a $(libetsf_io_low_level_a_OBJECTS) $(libetsf_io_low_level_a_LIBADD) $(RANLIB) libetsf_io_low_level.a mostlyclean-compile: -rm -f *.$(OBJEXT) distclean-compile: -rm -f *.tab.c .f90.o: $(FCCOMPILE) -c -o $@ $< .f90.obj: $(FCCOMPILE) -c -o $@ `$(CYGPATH_W) '$<'` install-moduleDATA: $(module_DATA) @$(NORMAL_INSTALL) test -z "$(moduledir)" || $(MKDIR_P) "$(DESTDIR)$(moduledir)" @list='$(module_DATA)'; for p in $$list; do \ if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ f=$(am__strip_dir) \ echo " $(moduleDATA_INSTALL) '$$d$$p' '$(DESTDIR)$(moduledir)/$$f'"; \ $(moduleDATA_INSTALL) "$$d$$p" "$(DESTDIR)$(moduledir)/$$f"; \ done uninstall-moduleDATA: @$(NORMAL_UNINSTALL) @list='$(module_DATA)'; for p in $$list; do \ f=$(am__strip_dir) \ echo " rm -f '$(DESTDIR)$(moduledir)/$$f'"; \ rm -f "$(DESTDIR)$(moduledir)/$$f"; \ done ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES) list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ unique=`for i in $$list; do \ if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ done | \ $(AWK) '{ files[$$0] = 1; nonemtpy = 1; } \ END { if (nonempty) { for (i in files) print i; }; }'`; \ mkid -fID $$unique tags: TAGS TAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \ $(TAGS_FILES) $(LISP) tags=; \ here=`pwd`; \ list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ unique=`for i in $$list; do \ if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ done | \ $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ END { if (nonempty) { for (i in files) print i; }; }'`; \ if test -z "$(ETAGS_ARGS)$$tags$$unique"; then :; else \ test -n "$$unique" || unique=$$empty_fix; \ $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ $$tags $$unique; \ fi ctags: CTAGS CTAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \ $(TAGS_FILES) $(LISP) tags=; \ list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ unique=`for i in $$list; do \ if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ done | \ $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ END { if (nonempty) { for (i in files) print i; }; }'`; \ test -z "$(CTAGS_ARGS)$$tags$$unique" \ || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ $$tags $$unique GTAGS: here=`$(am__cd) $(top_builddir) && pwd` \ && cd $(top_srcdir) \ && gtags -i $(GTAGS_ARGS) $$here distclean-tags: -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags distdir: $(DISTFILES) @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ list='$(DISTFILES)'; \ dist_files=`for file in $$list; do echo $$file; done | \ sed -e "s|^$$srcdirstrip/||;t" \ -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ case $$dist_files in \ */*) $(MKDIR_P) `echo "$$dist_files" | \ sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ sort -u` ;; \ esac; \ for file in $$dist_files; do \ if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ if test -d $$d/$$file; then \ dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ cp -pR $(srcdir)/$$file $(distdir)$$dir || exit 1; \ fi; \ cp -pR $$d/$$file $(distdir)$$dir || exit 1; \ else \ test -f $(distdir)/$$file \ || cp -p $$d/$$file $(distdir)/$$file \ || exit 1; \ fi; \ done check-am: all-am check: check-am all-am: Makefile $(LIBRARIES) $(DATA) installdirs: for dir in "$(DESTDIR)$(libdir)" "$(DESTDIR)$(moduledir)"; do \ test -z "$$dir" || $(MKDIR_P) "$$dir"; \ done install: install-am install-exec: install-exec-am install-data: install-data-am uninstall: uninstall-am install-am: all-am @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am installcheck: installcheck-am install-strip: $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ `test -z '$(STRIP)' || \ echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install mostlyclean-generic: clean-generic: distclean-generic: -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) maintainer-clean-generic: @echo "This command is intended for maintainers to use" @echo "it deletes files that may require special tools to rebuild." clean: clean-am clean-am: clean-generic clean-libLIBRARIES mostlyclean-am distclean: distclean-am -rm -f Makefile distclean-am: clean-am distclean-compile distclean-generic \ distclean-tags dvi: dvi-am dvi-am: html: html-am info: info-am info-am: install-data-am: install-moduleDATA install-dvi: install-dvi-am install-exec-am: install-libLIBRARIES install-html: install-html-am install-info: install-info-am install-man: install-pdf: install-pdf-am install-ps: install-ps-am installcheck-am: maintainer-clean: maintainer-clean-am -rm -f Makefile maintainer-clean-am: distclean-am maintainer-clean-generic mostlyclean: mostlyclean-am mostlyclean-am: mostlyclean-compile mostlyclean-generic pdf: pdf-am pdf-am: ps: ps-am ps-am: uninstall-am: uninstall-libLIBRARIES uninstall-moduleDATA .MAKE: install-am install-strip .PHONY: CTAGS GTAGS all all-am check check-am clean clean-generic \ clean-libLIBRARIES ctags distclean distclean-compile \ distclean-generic distclean-tags distdir dvi dvi-am html \ html-am info info-am install install-am install-data \ install-data-am install-dvi install-dvi-am install-exec \ install-exec-am install-html install-html-am install-info \ install-info-am install-libLIBRARIES install-man \ install-moduleDATA install-pdf install-pdf-am install-ps \ install-ps-am install-strip installcheck installcheck-am \ installdirs maintainer-clean maintainer-clean-generic \ mostlyclean mostlyclean-compile mostlyclean-generic pdf pdf-am \ ps ps-am tags uninstall uninstall-am uninstall-libLIBRARIES \ uninstall-moduleDATA #dependencies etsf_io_low_level.o: etsf_io_low_level.f90 \ public_variables.f90 \ read_routines.f90 \ read_routines_auto.f90 \ write_routines.f90 \ write_routines_auto.f90 etsf_io_low_level.@MODULE_EXT@ ETSF_IO_LOW_LEVEL.@MODULE_EXT@: etsf_io_low_level.o # Tell versions [3.59,3.63) of GNU make to not export all variables. # Otherwise a system limit (for SysV at least) may be exceeded. .NOEXPORT: etsf_io-1.0.3/src/low_level/etsf_io_low_level.f900000644000353400050620000015415510655606055016710 00000000000000!!****h* low_level/etsf_io_low_level !! NAME !! etsf_io_low_level -- ESTF I/O low level wrapper around NetCDF routines !! !! FUNCTION !! This module is used to wrap commonly used NetCDF calls. It gives an API !! which should be safe with automatic dimensions checks, and easy to use !! with methods only needed by a parser/writer library focused on the !! ETSF specifications. Nevertheless, this module can be used for other !! purpose than only reading/writing files conforming to ETSF specifications. !! !! It also support an optional error handling structure. This structure !! can be used on any methods to get fine informations about any failure. !! !! All methods have a logical argument that is set to .true. if everything !! went fine. In that case, all output arguments have relevant values. If @lstat !! is .false., no output values should be used since their values are not !! guaranteed. !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !!*** module etsf_io_low_level use netcdf implicit none ! Basic variables character(len = *), parameter, private :: & & etsf_io_low_file_format = "ETSF Nanoquanta" character(len = *), parameter, private :: & & etsf_io_low_conventions = "http://www.etsf.eu/fileformats/" ! Error handling integer, parameter, private :: nb_access_mode = 7 character(len = 15), dimension(nb_access_mode), parameter, private :: & & etsf_io_low_error_mode = (/ "define ", & & "get ", & & "input/output ", & & "inquire ", & & "put ", & & "specifications ", & & "copy " /) integer, parameter, private :: nb_target_type = 12 character(len = 22), dimension(nb_target_type), parameter, private :: & & etsf_io_low_error_type = (/ "attribute ", "dimension ID ", & & "dimension ", "end definitions ", & & "define mode ", "create file ", & & "open file for reading ", "open file for writing ", & & "variable ", "variable ID ", & & "close file ", "routine argument " /) include "public_variables.f90" !!****m* etsf_io_low_read_group/etsf_io_low_read_var !! NAME !! etsf_io_low_read_var !! !! SYNOPSIS !! * call etsf_io_low_read_var(ncid, varname, var, lstat, !! ncvarid, start, count, map, error_data) !! * call etsf_io_low_read_var(ncid, varname, var, charlen, lstat, !! ncvarid, start, count, map, error_data) !! !! FUNCTION !! This is a generic interface to read values of a variables (either integer !! or double or character). Before puting values in the @var argument, the !! dimensions of the read data are compared with the assumed dimensions of @var. !! The type is also checked, based on the type of the @var argument. Using !! this routine is then a safe way to read data from a NetCDF file. The size and !! shape of @var can be either a scalar, a one dimensional array or a multi !! dimensional array. Strings should be given with their length. See !! the example below on how to read a string. @var can also be a #etsf_io_low_var_double, !! or a #etsf_io_low_var_integer. In this case, the associated pointer is used !! as the storage area for the read values. !! !! If the shape of the given storage variable (@var) and the definition of the !! corresponding NetCDF variable differ ; the read is done only if the number of !! elements are identical. Number of elements is the product over all dimensions !! of the size (see example below). !! !! It is also possible to read some particular dimensions of one variable using !! the optional @start, @count and @map arguments. These are identical to their !! counterpart in NetCDF, with small differences and improvements: !! * start is used to define for each dimensions of the ETSF variable where to !! start reading. Indexes are numbered from 1 to the size of their dimension. !! * count is used to given the number of elements to be read for each dimenion. !! The sum start(i) + count(i) - 1 must be lower than the size of the i dimension. !! As an improvement compared to NetCDF count argument, if one wants to read all !! values from the dimension i, one can put count(i) = 0 instead of the size !! of the dimension itself which is not always easily accessible. !! * map is used to describe where to write data in memory when reading an ETSF !! variable. It gives for each dimension how many elements must be skip in memory. !! It also can used to switch order of dimensions. For instance, for an ETSF !! variable etsf_var(3,2) that we want to put in a variable my_var(2,3), we !! will use a map (/ 2, 1 /) which means that all values from first index of the !! etsf_var will put put every 2 elements in memory, while values from the second index !! will be put every single element. !! The order of dimensions are given in the Fortran order (inverse of the specification !! order). !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = a NetCDF handler, opened with read access. !! * varname = a string identifying a variable. !! !! OUTPUT !! * var = an allocated array to store the read values (or a simple scalar). !! * lstat = .true. if operation succeed. !! * start = (optional) an array, with the same size than the shape of the NetCDF !! variable to be read. Give the first index to be read for each dimension. !! By default value is 1 for each dimension. !! * count = (optional) an array, with the same size than the shape of the NetCDF !! variable to be read. Give the number of indexes to be read for each dimension. !! By default value is the size for each dimension. !! * map = (optional) an array, with the same size than the shape of the NetCDF !! variable to be read. Give how values are written into memory. By default !! map = (/ 1, (product(dims(1:i), i = 1, shape - 1) /) !! * ncvarid = (optional) the id used by NetCDF to identify the read variable. !! * error_data = (optional) location to store error data. !! !! EXAMPLE !! Read a string stored in "exchange_functional" variable of length 80: !! character(len = 80) :: var !! call etsf_io_low_read_var(ncid, "exchange_functional", var, 80, lstat) !! !! Get one single integer stored in "space_group": !! integer :: sp !! call etsf_io_low_read_var(ncid, "space_group", sp, lstat) !! !! Get a 2 dimensional array storing reduced atom coordinates: !! double precision :: coord(3, 5) !! call etsf_io_low_read_var(ncid, "reduced_atom_positions", coord, lstat) !! !! Get a 2 dimensional array stored as a four dimensional array: !! NetCDF def: density(2, 3, 3, 3) # dimensions in NetCDF are reverted !! # compared to Fortran style !! double precision :: density(27, 2) !! call etsf_io_low_read_var(ncid, "density", density, lstat) !! !! Get the last 3 dimensions of a 4D array: !! NetCDF def: density(2, 3, 4, 5) # dimensions in NetCDF are reverted !! # compared to Fortran style !! double precision :: density_down(5, 4, 3) !! call etsf_io_low_read_var(ncid, "density", density_down, lstat, & !! & start = (/ 1, 1, 1, 2 /), count = (/ 0, 0, 0, 1 /)) !! !! Get the last 3 dimensions of a 4D array and store them into a 1D array: !! NetCDF def: density(2, 3, 3, 3) # dimensions in NetCDF are reverted !! # compared to Fortran style !! double precision :: density_up(27) !! call etsf_io_low_read_var(ncid, "density", density_up, lstat, & !! & start = (/ 1, 1, 1, 2 /), count = (/ 0, 0, 0, 1 /)) !! !! Read data to a dimension stored in the main program, without duplication !! of data in memory: !! integer, target :: atom_species(number_of_atoms) !! ... !! type(etsf_io_low_var_integer) :: var !! var%data1D => atom_species !! call etsf_io_low_read_var(ncid, "atom_species", var, lstat) !!*** !Generic interface of the routines etsf_io_low_read_var interface etsf_io_low_read_var module procedure read_var_integer_var module procedure read_var_integer_0D module procedure read_var_integer_1D module procedure read_var_integer_2D module procedure read_var_integer_3D module procedure read_var_integer_4D module procedure read_var_integer_5D module procedure read_var_integer_6D module procedure read_var_integer_7D module procedure read_var_double_var module procedure read_var_double_0D module procedure read_var_double_1D module procedure read_var_double_2D module procedure read_var_double_3D module procedure read_var_double_4D module procedure read_var_double_5D module procedure read_var_double_6D module procedure read_var_double_7D module procedure read_var_character_1D module procedure read_var_character_2D module procedure read_var_character_3D module procedure read_var_character_4D module procedure read_var_character_5D module procedure read_var_character_6D module procedure read_var_character_7D end interface etsf_io_low_read_var !End of the generic interface of etsf_io_low_read_var !!****m* etsf_io_low_read_group/etsf_io_low_read_att !! NAME !! etsf_io_low_read_att !! !! SYNOPSIS !! * call etsf_io_low_read_att(ncid, ncvarid, attname, attlen, att, lstat, error_data) !! * call etsf_io_low_read_att(ncid, ncvarid, attname, att, lstat, error_data) !! * call etsf_io_low_read_att(ncid, varname, attname, attlen, att, lstat, error_data) !! * call etsf_io_low_read_att(ncid, varname, attname, att, lstat, error_data) !! !! FUNCTION !! This is a generic interface to read values of an attribute (either integer, !! real, double or character). Before puting values in the @att argument, the !! dimensions of the read data are compared with the given dimensions (@attlen). !! The type is also checked, based on the type of the @att argument. Using !! this routine is then a safe way to read attribute data from a NetCDF file. !! The size and shape of @att can be either a scalar or a one dimensional array. !! In the former case, the argument @attlen must be omitted. Strings are considered !! to be one dimensional arrays. See the example below on how to read a string. !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = a NetCDF handler, opened with read access. !! * ncvarid = the id of the variable the attribute is attached to. !! in the case of global attributes, use the constance !! NF90_GLOBAL (when linking against NetCDF) or #etsf_io_low_global_att !! which is a wrapper exported by this module (see #ETSF_IO_LOW_CONSTANTS). !! * varname = can be used instead of ncvarid to select a variable by its name. !! * attname = a string identifying an attribute. !! * attlen = the size of the array @att (when required). !! !! OUTPUT !! * att = an allocated array to store the read values. When @attlen is !! omitted, this argument @att must be a scalar, not an array. !! * lstat = .true. if operation succeed. !! * error_data = (optional) location to store error data. !! !! EXAMPLE !! Read a string stored in "symmorphic" attribute of length 80: !! character(len = 80) :: att !! call etsf_io_low_read_att(ncid, ncvarid, "symmorphic", 80, att, lstat) !! !! Get one single real stored in "file_format_version" which is a global attribute: !! real :: version !! call etsf_io_low_read_att(ncid, etsf_io_low_global_att, "file_format_version", version, lstat) !! !!*** !Generic interface of the routines etsf_io_low_read_att interface etsf_io_low_read_att module procedure read_att_id_integer_0D module procedure read_att_id_real_0D module procedure read_att_id_double_0D module procedure read_att_id_integer_1D module procedure read_att_id_real_1D module procedure read_att_id_double_1D module procedure read_att_id_character_1D module procedure read_att_integer_0D module procedure read_att_real_0D module procedure read_att_double_0D module procedure read_att_integer_1D module procedure read_att_real_1D module procedure read_att_double_1D module procedure read_att_character_1D end interface etsf_io_low_read_att !End of the generic interface of etsf_io_low_read_att !!****m* etsf_io_low_read_group/etsf_io_low_read_flag !! NAME !! etsf_io_low_read_flag !! !! SYNOPSIS !! * call etsf_io_low_read_flag(ncid, flag, ncvarid, attname, lstat, error_data) !! * call etsf_io_low_read_flag(ncid, flag, varname, attname, lstat, error_data) !! !! FUNCTION !! This method is a specialized version of etsf_io_low_read_att(). It reads !! the attribute @attname of the given variable and set @flag to .true. if !! the attribute value is "yes" or "YES" or "Yes", .false. otherwise. !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = a NetCDF handler, opened with read access. !! * ncvarid = the id of the variable the attribute is attached to. !! in the case of global attributes, use the constance !! NF90_GLOBAL (when linking against NetCDF) or #etsf_io_low_global_att !! which is a wrapper exported by this module (see #ETSF_IO_LOW_CONSTANTS). !! * varname = can be used instead of ncvarid to select a variable by its name. !! * attname = a string identifying an attribute. !! !! OUTPUT !! * flag = .true. if the attribute match "yes" or its variant. !! * lstat = .true. if operation succeed. !! * error_data = (optional) location to store error data. !!*** interface etsf_io_low_read_flag module procedure read_flag_id module procedure read_flag end interface etsf_io_low_read_flag !End of the generic interface of etsf_io_low_read_flag !!****m* etsf_io_low_write_group/etsf_io_low_def_var !! NAME !! etsf_io_low_def_var !! !! SYNOPSIS !! * call etsf_io_low_def_var(ncid, varname, vartype, vardims, lstat, ncvarid, error_data) !! * call etsf_io_low_def_var(ncid, varname, vartype, lstat, ncvarid, error_data) !! !! FUNCTION !! In the contrary of dimensions or attributes, before using a write method on variables !! they must be defined using such methods. This allow to choose the type, the shape !! and the size of a new variable. Once defined, a variable can't be changed or removed. !! !! One can add scalars, one dimensional arrays or multi-dimensional arrays (restricted !! to a maximum of 7 dimensions). See the examples below to know how to use such methods. !! !! As in pure NetCDF, it is impossible to overwrite the definition of a variable. !! Nevertheless, the method returns .true. in @lstat, if the definition is done a second !! time with the same type, shape and dimensions. !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = a NetCDF handler, opened with write access (define mode). !! * varname = the name for the new variable. !! * vartype = the type of the new variable (see #ETSF_IO_LOW_CONSTANTS). !! * vardims = an array with the size for each dimension of the variable. !! Each size is given by the name of its dimension. Thus dimensions !! must already exist (see etsf_io_low_write_dim()). !! When omitted, the variable is considered as a scalar. !! !! OUTPUT !! * lstat = .true. if operation succeed. !! * ncvarid = (optional) the id used by NetCDF to identify the written variable. !! * error_data = (optional) location to store error data. !! !! EXAMPLE !! Define a string stored as "basis_set" of length "character_string_length": !! call etsf_io_low_def_var(ncid, "basis_set", etsf_io_low_character, & !! & (/ "character_string_length" /), lstat) !! !! Define one integer stored as "space_group": !! call etsf_io_low_def_var(ncid, "space_group", etsf_io_low_integer, lstat) !! !! Define a two dimensional array of double stored as "reduced_symetry_translations": !! call etsf_io_low_def_var(ncid, "reduced_symetry_translations", etsf_io_low_double, & !! & (/ "number_of_reduced_dimensions", & !! & "number_of_symetry_operations" /), lstat) !!*** !Generic interface of the routines etsf_io_low_def_var interface etsf_io_low_def_var module procedure etsf_io_low_def_var_0D module procedure etsf_io_low_def_var_nD end interface etsf_io_low_def_var !End of the generic interface of etsf_io_low_def_var !!****m* etsf_io_low_write_group/etsf_io_low_write_att !! NAME !! etsf_io_low_write_att !! !! SYNOPSIS !! call etsf_io_low_write_att(ncid, ncvarid, attname, att, lstat, error_data) !! !! FUNCTION !! When in defined mode, one can add attributes and set then a value in one call !! using such a method. Attributes can be strings, scalar or one dimensional arrays !! of integer, real or double precision. !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = a NetCDF handler, opened with write access (define mode). !! * ncvarid = the id of the variable the attribute is attached to. !! in the case of global attributes, use the constance !! NF90_GLOBAL (when linking against NetCDF) or #etsf_io_low_global_att !! which is a wrapper exported by this module (see #ETSF_IO_LOW_CONSTANTS). !! * attname = the name for the new attribute. !! * att = the value, can be a string a scalar or a one-dimension array. !! !! OUTPUT !! * lstat = .true. if operation succeed. !! * error_data = (optional) location to store error data. !! !! EXAMPLE !! Write a string stored as "symmorphic", attribute of varaible ncvarid: !! call etsf_io_low_def_var(ncid, ncvarid, "symmorphic", "Yes", lstat) !! !! Write one real stored as "file_format_version", global attribute: !! call etsf_io_low_def_var(ncid, etsf_io_low_global_att, "file_format_version", & !! & 1.3, lstat) !!*** !Generic interface of the routines etsf_io_low_write_att interface etsf_io_low_write_att module procedure write_att_integer_0D module procedure write_att_real_0D module procedure write_att_double_0D module procedure write_att_integer_1D module procedure write_att_real_1D module procedure write_att_double_1D module procedure write_att_character_1D module procedure write_att_id_integer_0D module procedure write_att_id_real_0D module procedure write_att_id_double_0D module procedure write_att_id_integer_1D module procedure write_att_id_real_1D module procedure write_att_id_double_1D module procedure write_att_id_character_1D end interface etsf_io_low_write_att !End of the generic interface of etsf_io_low_write_att !!****m* etsf_io_low_write_group/etsf_io_low_write_var !! NAME !! etsf_io_low_write_var !! !! SYNOPSIS !! * call etsf_io_low_write_var(ncid, varname, var, lstat, !! ncvarid, start, count, map, error_data) !! * call etsf_io_low_write_var(ncid, varname, var, charlen, lstat, !! ncvarid, start, count, map, error_data) !! !! FUNCTION !! This is a generic interface to write values of a variables (either integer !! or double or strings). Before using such methods, variables must have been !! defined using etsf_io_low_def_var(). Before writting values from the @var argument, the !! dimensions of the given data are compared with the defined dimensions. !! The type is also checked, based on the type of the @var argument. Using !! this routine is then a safe way to write data from a NetCDF file. The size and !! shape of @var can be either a scalar, a one dimensional array or a multi !! dimensional array. Strings should be given with their length. See !! the example below on how to write a string. @var can also be a #etsf_io_low_var_double, !! or a #etsf_io_low_var_integer. In this case, the associated pointer is used !! as the storage area for the written values. !! !! If the shape of the input data variable (@var) and the definition of the !! corresponding NetCDF variable differ ; the write action is performed only if the number of !! elements are identical. Number of elements is the product over all dimensions !! of the size (see example below). !! !! It is also possible to write some particular dimensions of one variable using !! the optional @start, @count and @map arguments. These are identical to their !! counterpart in NetCDF, with small differences and improvements: !! * start is used to define for each dimensions of the ETSF variable where to !! start writing. Indexes are numbered from 1 to the size of their dimension. !! * count is used to given the number of elements to be read for each dimenion. !! The sum start(i) + count(i) - 1 must be lower than the size of the i dimension. !! As an improvement compared to NetCDF count argument, if one wants to write all !! values from the dimension i, one can put count(i) = 0 instead of the size !! of the dimension itself which is not always easily accessible. !! * map is used to describe where to read data in memory when writing an ETSF !! variable. It gives for each dimension how many elements must be skip in memory. !! It also can used to switch order of dimensions. For instance, for an ETSF !! variable etsf_var(3,2) that we want to be put from a variable my_var(2,3), we !! will use a map (/ 2, 1 /) which means that all values of first index of the !! etsf_var will read from every 2 elements in memory, while values of the second index !! will be read from every single element. !! The order of dimensions are given in the Fortran order (inverse of the specification !! order). !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = a NetCDF handler, opened with read access. !! * varname = a string identifying a variable. !! * var = the values to be written, either a scalar or an array. !! * charlen = when @var is a string or an array of strings, their size !! must be given. !! !! OUTPUT !! * lstat = .true. if operation succeed. !! * start = (optional) an array, with the same size than the shape of the NetCDF !! variable to be read. Give the first index to be read for each dimension. !! By default value is 1 for each dimension. !! * count = (optional) an array, with the same size than the shape of the NetCDF !! variable to be read. Give the number of indexes to be read for each dimension. !! By default value is the size for each dimension. !! * map = (optional) an array, with the same size than the shape of the NetCDF !! variable to be read. Give how values are written into memory. By default !! map = (/ 1, (product(dims(1:i), i = 1, shape - 1) /) !! * ncvarid = (optional) the id used by NetCDF to identify the written variable. !! * error_data = (optional) location to store error data. !! !! EXAMPLE !! Write a string stored in "exchange_functional" variable of length 80: !! call etsf_io_low_read_var(ncid, "exchange_functional", "My functional", 80, lstat) !! !! Write one single integer stored in "space_group": !! call etsf_io_low_read_var(ncid, "space_group", 156, lstat) !! !! Write a 2 dimensional array storing reduced atom coordinates: !! double precision :: coord2d(3, 4) !! coord2d = reshape((/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12 /), (/ 3, 4 /)) !! call etsf_io_low_read_var(ncid, "reduced_atom_positions", coord2d, lstat) !! or, !! double precision :: coord(12) !! coord = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12 /) !! call etsf_io_low_read_var(ncid, "reduced_atom_positions", coord, lstat) !! !! Write the last 3 dimensions of a 4D array: !! NetCDF def: density(2, 3, 4, 5) # dimensions in NetCDF are reverted !! # compared to Fortran style !! double precision :: density_down(5, 4, 3) !! call etsf_io_low_write_var(ncid, "density", density_down, lstat, & !! & start = (/ 1, 1, 1, 2 /), count = (/ 0, 0, 0, 1 /)) !! !! Write the last 3 dimensions of a 4D array and read them from a 1D array: !! NetCDF def: density(2, 3, 3, 3) # dimensions in NetCDF are reverted !! # compared to Fortran style !! double precision :: density_up(27) !! call etsf_io_low_write_var(ncid, "density", density_up, lstat, & !! & start = (/ 1, 1, 1, 2 /), count = (/ 0, 0, 0, 1 /)) !! !! Write data from a dimension stored in the main program, without duplication !! of data in memory: !! integer, target :: atom_species(number_of_atoms) !! ... !! type(etsf_io_low_var_integer) :: var !! var%data1D => atom_species !! call etsf_io_low_write_var(ncid, "atom_species", var, lstat) !!*** !Generic interface of the routines etsf_io_low_write_var interface etsf_io_low_write_var module procedure write_var_integer_var module procedure write_var_integer_0D module procedure write_var_integer_1D module procedure write_var_integer_2D module procedure write_var_integer_3D module procedure write_var_integer_4D module procedure write_var_integer_5D module procedure write_var_integer_6D module procedure write_var_integer_7D module procedure write_var_double_var module procedure write_var_double_0D module procedure write_var_double_1D module procedure write_var_double_2D module procedure write_var_double_3D module procedure write_var_double_4D module procedure write_var_double_5D module procedure write_var_double_6D module procedure write_var_double_7D module procedure write_var_character_1D module procedure write_var_character_2D module procedure write_var_character_3D module procedure write_var_character_4D module procedure write_var_character_5D module procedure write_var_character_6D module procedure write_var_character_7D end interface etsf_io_low_write_var !End of the generic interface of etsf_io_low_write_var !!****f* etsf_io_low_var/etsf_io_low_var_associated !! NAME !! etsf_io_low_var_associated !! !! FUNCTION !! This function works as the associated() intrinsic function but with !! pointers of undefined shapes (see #etsf_io_low_var_integer and #etsf_io_low_var_double). !! !! SYNOPSIS !! call etsf_io_low_var_associated(array) !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * array = an undefined shape array. !! !! OUTPUT !! * returns .true. if one of the array datanD is associated. !!*** interface etsf_io_low_var_associated module procedure var_integer_associated module procedure var_double_associated end interface etsf_io_low_var_associated !!****f* etsf_io_low_var/etsf_io_low_var_multiply !! NAME !! etsf_io_low_var_multiply !! !! FUNCTION !! This subroutine is used to multiply the array of an unformatted pointer. !! The factor must be of the same kind (integer or double) than the array. !! !! SYNOPSIS !! call etsf_io_low_var_multiply(array, factor) !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * array = an undefined shape array. !! * factor = the multiplying factor (either integr or double). !!*** interface etsf_io_low_var_multiply module procedure var_integer_multiply module procedure var_double_multiply end interface !!****m* etsf_io_low_var_infos/etsf_io_low_read_var_infos !! NAME !! etsf_io_low_read_var_infos !! !! FUNCTION !! This method is used to retrieve informations about a variable: !! * its NetCDF id or its name ; !! * its type (see #ETSF_IO_LOW_CONSTANTS) ; !! * its shape and length for each dimension. !! One can get informations knowing the name or the id of a variable. Using !! the dim_name argument to .true., the name of each used dimensions are !! retrieved. In that case, the var_infos should be freed after use, calling !! etsf_io_low_free_var_infos(). !! !! SYNOPSIS !! * call etsf_io_low_read_var_infos(ncid, varname, var_infos, lstat, error_data, dim_name, att_name) !! * call etsf_io_low_read_var_infos(ncid, varid, var_infos, lstat, error_data, dim_name, att_name) !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = a NetCDF handler, opened with read access. !! * varname = a string identifying a variable. !! * varid = a integer identifying a variable. !! * dim_name = (optional) if .true. retrieve the names of the dimensions, !! and store them in a newly allocated array in the var_infos !! structure (see etsf_io_low_free_var_infos()). !! * att_name = (optional) if .true. retrieve the names of the attributes, !! and store them in a newly allocated array in the var_infos !! structure (see etsf_io_low_free_var_infos()). !! !! OUTPUT !! * var_infos = store, type, shape, dimensions and NetCDF id. !! * lstat = .true. if operation succeed. !! * error_data = (optional) location to store error data. !!*** interface etsf_io_low_read_var_infos module procedure read_var_infos_name module procedure read_var_infos_id module procedure read_var_infos end interface !!****g* etsf_io_low_level/etsf_io_low_error_group !! FUNCTION !! These methods are used to handle errors generated by ETSF access. !! For this a Fortran type is used and called #etsf_io_low_error. It !! stores several informations such as the name of the method where the !! error occured or a message describing the error. One can create an !! error using etsf_io_low_error_set() and then put it into a nice !! string for future use with etsf_io_low_error_to_str(). !! !! SOURCE public :: etsf_io_low_error public :: etsf_io_low_error_set public :: etsf_io_low_error_update public :: etsf_io_low_error_to_str public :: etsf_io_low_error_handle !!*** !!****g* etsf_io_low_level/etsf_io_low_file_group !! FUNCTION !! When accessing a ETSF file, there is three routines to do that. One can: !! * create a new file with etsf_io_low_open_create() ; !! * read an already existing file with etsf_io_low_open_read() ; !! * write data to a an already existing file with etsf_io_low_open_modify(). !! !! SOURCE public :: etsf_io_low_close public :: etsf_io_low_open_create public :: etsf_io_low_open_modify public :: etsf_io_low_open_read !!*** !!****g* etsf_io_low_level/etsf_io_low_check_group !! FUNCTION !! These routines are used to check informations defined in an openend ETSF file. !! !! SOURCE public :: etsf_io_low_check_att public :: etsf_io_low_check_header public :: etsf_io_low_check_var !!*** !!****g* etsf_io_low_level/etsf_io_low_read_group !! FUNCTION !! These routines are used read data from an ETSF file. These data can be: !! * dimensions ; !! * attributes (global or not) ; !! * variables. !! !! SOURCE public :: etsf_io_low_read_att public :: etsf_io_low_read_flag public :: etsf_io_low_read_dim public :: etsf_io_low_read_var !!*** !!****g* etsf_io_low_level/etsf_io_low_write_group !! FUNCTION !! These routines are used write (or define) data from an ETSF file. These data can be: !! * dimensions ; !! * attributes (global or not) ; !! * variables. !! !! SOURCE public :: etsf_io_low_def_var public :: etsf_io_low_write_att public :: etsf_io_low_copy_all_att public :: etsf_io_low_write_dim public :: etsf_io_low_write_var !!*** !!****g* etsf_io_low_level/etsf_io_low_var !! FUNCTION !! These routines are used to defined an array without predefined shape. !! !! SOURCE public :: etsf_io_low_var_integer public :: etsf_io_low_var_double public :: etsf_io_low_var_multiply public :: etsf_io_low_var_associated !!*** ! Private variables & methods. private :: var_integer_associated private :: var_double_associated private :: var_integer_multiply private :: var_double_multiply contains !!****m* etsf_io_low_error_group/etsf_io_low_error_set !! NAME !! etsf_io_low_error_set !! !! FUNCTION !! This routine is used to initialise a #etsf_io_low_error object with values. !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * mode = a value from #ERROR_MODE, specifying the action when the error occurs. !! * type = a value from #ERROR_TYPE, specifying the kind of target. !! * parent = the name of the routine in which the error occurs. !! * tgtid = (optional) an id representing the target (or -1). !! * tgtname = (optional) a name representing the target (or ""). !! * errmess = (optional) a string with an explanation. !! !! OUTPUT !! * error_data = the error with sensible values in its fields. !! !! SOURCE subroutine etsf_io_low_error_set(error_data, mode, type, parent, tgtid, tgtname, errid, errmess) type(etsf_io_low_error), intent(out) :: error_data integer, intent(in) :: mode, type character(len = *), intent(in) :: parent integer, intent(in), optional :: tgtid, errid character(len = *), intent(in), optional :: tgtname, errmess ! Consistency checkings if (mode < 1 .or. mode > nb_access_mode) then write(0, *) " *** ETSF I/O Internal error ***" write(0, *) " mode argument out of range: ", mode return end if if (type < 1 .or. type > nb_target_type) then write(0, *) " *** ETSF I/O Internal error ***" write(0, *) " type argument out of range: ", type return end if ! Storing mandatory informations write(error_data%backtrace(1), "(A)") parent(1:min(80, len(parent))) error_data%backtraceId = 1 error_data%access_mode_id = mode write(error_data%access_mode_str, "(A)") etsf_io_low_error_mode(mode) error_data%target_type_id = type write(error_data%target_type_str, "(A)") etsf_io_low_error_type(type) ! Storing possible other informations if (present(tgtid)) then error_data%target_id = tgtid else error_data%target_id = -1 end if if (present(tgtname)) then write(error_data%target_name, "(A)") trim(tgtname(1:min(80, len(tgtname)))) else write(error_data%target_name, "(A)") "" end if if (present(errid)) then error_data%error_id = errid else error_data%error_id = nf90_noerr end if if (present(errmess)) then write(error_data%error_message, "(A)") trim(errmess(1:min(256, len(errmess)))) else write(error_data%error_message, "(A)") "" end if end subroutine etsf_io_low_error_set !!*** !!****m* etsf_io_low_error_group/etsf_io_low_error_update !! NAME !! etsf_io_low_error_update !! !! FUNCTION !! This method must be called when a routine receives an error and need !! to propagate it further. !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * method = the name of the routine that propagate the error. !! !! SIDE EFFECTS !! * error = informations about an error. !! !! SOURCE subroutine etsf_io_low_error_update(error, method) type(etsf_io_low_error), intent(inout) :: error character(len = *), intent(in) :: method if (error%backtraceId == 100) return error%backtraceId = error%backtraceId + 1 write(error%backtrace(error%backtraceId), "(A)") method(1:min(80, len(method))) end subroutine etsf_io_low_error_update !!*** !!****m* etsf_io_low_error_group/etsf_io_low_error_to_str !! NAME !! etsf_io_low_error_to_str !! !! FUNCTION !! This method can be used to get a string from the given error. !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * error_data =informations about an error. !! !! OUTPUT !! * str = a string to write the error message to. !! !! SOURCE subroutine etsf_io_low_error_to_str(str, error_data) character(len = etsf_io_low_error_len), intent(out) :: str type(etsf_io_low_error), intent(in) :: error_data character(len = 80) :: line_tgtname, line_tgtid, line_messid character(len = 256) :: line_mess integer :: i if (trim(error_data%target_name) /= "") then write(line_tgtname, "(A,A,A)") " Target (name) : ", trim(error_data%target_name), char(10) else write(line_tgtname, "(A)") "" end if if (error_data%target_id >= 0) then write(line_tgtid, "(A,I0,A)") " Target (id) : ", error_data%target_id, char(10) else write(line_tgtid, "(A)") "" end if if (trim(error_data%error_message) /= "") then write(line_mess, "(A,A,A)") " Error message : ", trim(error_data%error_message), char(10) else write(line_mess, "(A)") "" end if if (error_data%error_id /= nf90_noerr) then write(line_messid, "(A,I0,A)") " Error id : ", error_data%error_id, char(10) else write(line_messid, "(A)") "" end if ! Write the back trace write(str, "(A,A,A)") " Backtrace : ", & & trim(error_data%backtrace(error_data%backtraceId)), "()" do i = error_data%backtraceId - 1, 1, -1 if (len(trim(str)) + 80 + 26 < etsf_io_low_error_len) then write(str, "(5A)") trim(str(1:3900)), char(10), & & " ", trim(error_data%backtrace(i)), "()" end if end do ! Write all the rest. write(str, "(11A)") trim(str(1:3000)), char(10),& & " Action performed : ", trim(error_data%access_mode_str), & & " ", trim(error_data%target_type_str), char(10), & & trim(line_tgtname), & & trim(line_tgtid), & & trim(line_mess), & & trim(line_messid) end subroutine etsf_io_low_error_to_str !!*** !!****m* etsf_io_low_error_group/etsf_io_low_error_handle !! NAME !! etsf_io_low_error_handle !! !! FUNCTION !! This method can be used to output the informations contained in an error !! structure. The output is done on standard output. Write your own method !! if custom error handling is required. !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * error_data =informations about an error. !! !! SOURCE subroutine etsf_io_low_error_handle(error_data) type(etsf_io_low_error), intent(in) :: error_data integer :: i ! Error handling write(*,*) write(*,*) " ***" write(*,*) " *** ETSF I/O ERROR" write(*,*) " ***" write(*,*) " *** Backtrace : ", & & trim(error_data%backtrace(error_data%backtraceId)), "()" do i = error_data%backtraceId - 1, 1, -1 write(*,*) " *** ", trim(error_data%backtrace(i)), "()" end do write(*,*) " *** Action performed : ", trim(error_data%access_mode_str), & & " ", trim(error_data%target_type_str) if (trim(error_data%target_name) /= "") then write(*,*) " *** Target (name) : ", trim(error_data%target_name) end if if (error_data%target_id /= 0) then write(*,*) " *** Target (id) : ", error_data%target_id end if if (trim(error_data%error_message) /= "") then write(*,*) " *** Error message : ", trim(error_data%error_message) end if if (error_data%error_id /= nf90_noerr) then write(*,*) " *** Error id : ", error_data%error_id end if write(*,*) " ***" write(*,*) end subroutine etsf_io_low_error_handle !!*** !!****m* etsf_io_low_file_group/etsf_io_low_close !! NAME !! etsf_io_low_close !! !! FUNCTION !! This method is used to close an openend NetCDF file. !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = a NetCDF handler, opened with write access. !! !! OUTPUT !! * lstat = .true. if operation succeed. !! * error_data = (optional) location to store error data. !! !! SOURCE subroutine etsf_io_low_close(ncid, lstat, error_data) integer, intent(in) :: ncid logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "etsf_io_low_close" integer :: s lstat = .false. ! Close file s = nf90_close(ncid) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_IO, ERROR_TYPE_CLO, me, & & errid = s, errmess = nf90_strerror(s)) end if return end if lstat = .true. end subroutine etsf_io_low_close !!*** !!****m* etsf_io_low_file_group/etsf_io_low_set_write_mode !! NAME !! etsf_io_low_set_write_mode !! !! FUNCTION !! This method put the given NetCDF file handler in a data mode, by closing !! a define mode. When a file is opened (see etsf_io_low_open_create() or !! etsf_io_low_open_modify()), the NetCDF file handler is in a define mode. !! This is convienient for all write accesses (create new dimensions, modifying !! attribute values...) ; but when puting values into variables, the handler must !! be in the data mode. !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = a NetCDF handler, opened with write access. !! !! OUTPUT !! * lstat = .true. if operation succeed. !! * error_data = (optional) location to store error data. !! !! SOURCE subroutine etsf_io_low_set_write_mode(ncid, lstat, error_data) integer, intent(in) :: ncid logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "etsf_io_low_set_write_mode" integer :: s lstat = .false. ! Change the mode. s = nf90_enddef(ncid) if (s /= nf90_noerr .and. s /= -38) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_IO, ERROR_TYPE_END, me, & & errid = s, errmess = nf90_strerror(s)) end if return end if lstat = .true. end subroutine etsf_io_low_set_write_mode !!*** !!****m* etsf_io_low_file_group/etsf_io_low_set_define_mode !! NAME !! etsf_io_low_set_define_mode !! !! FUNCTION !! This method put the given NetCDF file handler in a define mode, by closing !! a data mode. When opening a file (create or modify), this is the default mode. !! Use etsf_io_low_set_write_mode() to switch then to data mode to write !! variable values. But to set attributes, the file must be in define mode !! again. This method is then usefull. !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = a NetCDF handler, opened with write access. !! !! OUTPUT !! * lstat = .true. if operation succeed. !! * error_data = (optional) location to store error data. !! !! SOURCE subroutine etsf_io_low_set_define_mode(ncid, lstat, error_data) integer, intent(in) :: ncid logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "etsf_io_low_set_define_mode" integer :: s lstat = .false. ! Change the mode. s = nf90_redef(ncid) if (s /= nf90_noerr .and. s /= -39) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_IO, ERROR_TYPE_DEF, me, & & errid = s, errmess = nf90_strerror(s)) end if return end if lstat = .true. end subroutine etsf_io_low_set_define_mode !!*** !!****f* etsf_io_low_level/pad !! NAME !! pad !! !! FUNCTION !! Little tool to format chains to constant length (256). This is usefull !! when calling the etsf_io_low_def_var() routine which takes an array of !! strings as argument. Since not all compilers like to construct static !! arrays from strings of different lengths, this function can wrap all !! strings. !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * string = the string to convert to character(len = 256). !! !! OUTPUT !! !! SOURCE function pad(string) character(len = *), intent(in) :: string character(len = 256) :: pad write(pad, "(A)") string(1:min(256, len(string))) end function pad !!*** !!****m* etsf_io_low_level/strip !! NAME !! strip !! !! FUNCTION !! Little tool to change all final '\0' (end of string in C) characters to !! ' ' (space). !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! SIDE EFFECTS !! * string = the string to convert. It is done in-place. !! !! SOURCE subroutine strip(string) character(len = *), intent(inout) :: string integer :: i, l i = index(string, char(0)) if (i > 0) then l = len(string) string(i:l) = repeat(" ", l - i + 1) end if end subroutine strip !!*** !!****m* etsf_io_low_var_infos/etsf_io_low_free_all_var_infos !! NAME !! etsf_io_low_free_all_var_infos !! !! FUNCTION !! This method is used to free all associated memory in an array of !! #etsf_io_low_var_infos elements. The array is also deallocated. !! This routine is convenient after a call to etsf_io_low_read_all_var_infos() !! with the optional argument @with_dim_name set to true. !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! SIDE EFFECTS !! * var_infos_array = a pointer on an associated !! array to be deallocated. !! !! SOURCE subroutine etsf_io_low_free_all_var_infos(var_infos_array) type(etsf_io_low_var_infos), pointer :: var_infos_array(:) integer :: i if (associated(var_infos_array)) then do i = 1, size(var_infos_array), 1 call etsf_io_low_free_var_infos(var_infos_array(i)) end do deallocate(var_infos_array) end if end subroutine etsf_io_low_free_all_var_infos !!*** !!****m* etsf_io_low_var_infos/etsf_io_low_free_var_infos !! NAME !! etsf_io_low_free_var_infos !! !! FUNCTION !! This method free all internal allocated memory of a given #etsf_io_low_var_infos !! object after use. !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! SIDE EFFECTS !! * var_infos = the type object to be freed. !! !! SOURCE subroutine etsf_io_low_free_var_infos(var_infos) type(etsf_io_low_var_infos), intent(inout) :: var_infos if (associated(var_infos%ncdimnames)) then deallocate(var_infos%ncdimnames) end if var_infos%ncdimnames => null() if (associated(var_infos%ncattnames)) then deallocate(var_infos%ncattnames) end if var_infos%ncattnames => null() end subroutine etsf_io_low_free_var_infos !!*** include "read_routines.f90" include "read_routines_auto.f90" include "write_routines.f90" include "write_routines_auto.f90" function var_integer_associated(array) type(etsf_io_low_var_integer), intent(in) :: array logical :: var_integer_associated var_integer_associated = (associated(array%data1D) .or. & & associated(array%data2D) .or. & & associated(array%data3D) .or. & & associated(array%data4D) .or. & & associated(array%data5D) .or. & & associated(array%data6D) .or. & & associated(array%data7D)) end function var_integer_associated function var_double_associated(array) type(etsf_io_low_var_double), intent(in) :: array logical :: var_double_associated var_double_associated = (associated(array%data1D) .or. & & associated(array%data2D) .or. & & associated(array%data3D) .or. & & associated(array%data4D) .or. & & associated(array%data5D) .or. & & associated(array%data6D) .or. & & associated(array%data7D)) end function var_double_associated subroutine var_integer_multiply(array, factor) type(etsf_io_low_var_integer), intent(inout) :: array integer :: factor if (associated(array%data1D)) array%data1D = array%data1D * factor if (associated(array%data2D)) array%data2D = array%data2D * factor if (associated(array%data3D)) array%data3D = array%data3D * factor if (associated(array%data4D)) array%data4D = array%data4D * factor if (associated(array%data5D)) array%data5D = array%data5D * factor if (associated(array%data6D)) array%data6D = array%data6D * factor if (associated(array%data7D)) array%data7D = array%data7D * factor end subroutine var_integer_multiply subroutine var_double_multiply(array, factor) type(etsf_io_low_var_double), intent(inout) :: array double precision :: factor if (associated(array%data1D)) array%data1D = array%data1D * factor if (associated(array%data2D)) array%data2D = array%data2D * factor if (associated(array%data3D)) array%data3D = array%data3D * factor if (associated(array%data4D)) array%data4D = array%data4D * factor if (associated(array%data5D)) array%data5D = array%data5D * factor if (associated(array%data6D)) array%data6D = array%data6D * factor if (associated(array%data7D)) array%data7D = array%data7D * factor end subroutine var_double_multiply end module etsf_io_low_level etsf_io-1.0.3/src/low_level/public_variables.f900000644000353400050630000001623710654631642016514 00000000000000 !!****d* etsf_io_low_error_group/ERROR_MODE !! NAME !! ERROR_MODE !! !! FUNCTION !! These values are used to index the action done when an error occurs. We found !! the following values: !! * ERROR_MODE_DEF = error when defining a variable or a dimension. !! * ERROR_MODE_GET = error when read a value for a valid dimension, !! attribute or variable. !! * ERROR_MODE_IO = error when accessing one file (opening or closing). !! * ERROR_MODE_INQ = error when looking in the NetCDF file for informations. !! * ERROR_MODE_PUT = error when writing a value to a valid target. !! * ERROR_MODE_SPEC = error of match between read value and awaited type or shape. !! * ERROR_MODE_COPY = error when copying a value. !! !! SOURCE integer, parameter :: ERROR_MODE_DEF = 1, ERROR_MODE_GET = 2, ERROR_MODE_IO = 3, & & ERROR_MODE_INQ = 4, ERROR_MODE_PUT = 5, ERROR_MODE_SPEC = 6, & & ERROR_MODE_COPY = 7 !!*** !!****d* etsf_io_low_error_group/ERROR_TYPE !! NAME !! ERROR_TYPE !! !! FUNCTION !! These values are used to index the type of target when an error occurs. We found !! the following values: !! * ERROR_TYPE_ATT = error on attributes. !! * ERROR_TYPE_DID = error on dimension ids. !! * ERROR_TYPE_DIM = error on dimensions. !! * ERROR_TYPE_END = error on ending define mode. !! * ERROR_TYPE_DEF = error on switching to define mode. !! * ERROR_TYPE_OCR = . !! * ERROR_TYPE_ORD = error on opening for read access. !! * ERROR_TYPE_OWR = error on opening for write access. !! * ERROR_TYPE_VAR = error on variables. !! * ERROR_TYPE_VID = error on variable ids. !! * ERROR_TYPE_CLO = error on closing. !! * ERROR_TYPE_ARG = error on routine argument. !! !! SOURCE integer, parameter :: ERROR_TYPE_ATT = 1, ERROR_TYPE_DID = 2, ERROR_TYPE_DIM = 3, & & ERROR_TYPE_END = 4, ERROR_TYPE_DEF = 5, ERROR_TYPE_OCR = 6, & & ERROR_TYPE_ORD = 7, ERROR_TYPE_OWR = 8, ERROR_TYPE_VAR = 9, & & ERROR_TYPE_VID = 10, ERROR_TYPE_CLO = 11, ERROR_TYPE_ARG = 12 !!*** !!****d* etsf_io_low_level/ETSF_IO_LOW_CONSTANTS !! NAME !! ETSF_IO_LOW_CONSTANTS !! !! FUNCTION !! These values are identical to the ones defined in NetCDF. They are defined !! to be able to use "implicit none" without linking with NetCDF library. !! !! SOURCE integer, parameter :: etsf_io_low_global_att = NF90_GLOBAL integer, parameter :: etsf_io_low_integer = NF90_INT integer, parameter :: etsf_io_low_real = NF90_FLOAT integer, parameter :: etsf_io_low_double = NF90_DOUBLE integer, parameter :: etsf_io_low_character = NF90_CHAR !!*** !!****d* etsf_io_low_error_group/etsf_io_low_error_len !! NAME !! etsf_io_low_error_len !! !! FUNCTION !! This value is the length of the strings used to represent errors, see !! etsf_io_low_error_to_str(). !! !! SOURCE integer, parameter :: etsf_io_low_error_len = 4096 !!*** !!****s* etsf_io_low_error_group/etsf_io_low_error !! NAME !! etsf_io_low_error !! !! FUNCTION !! This structure is used to store error informations. Three fields are mandatory !! and can always be read: !! * backtrace, which is a list of strings with the name of the methods where !! the error occurs and come from (the number of relevent names is given !! by @backtraceId) ; !! * access_mode_id, which is a #ERROR_MODE value ; !! * target_type_id, which is a #ERROR_TYPE value. !! All other fields may be filled depending on the calling method. When a field !! is irrelevant, if an id, it is null or negative, and when a string it is !! void string (trim(string) == ""). !! !! SOURCE type etsf_io_low_error character(len = 80), dimension(100) :: backtrace integer :: backtraceId = 0 integer :: access_mode_id character(len = 80) :: access_mode_str integer :: target_type_id character(len = 80) :: target_type_str integer :: target_id character(len = 80) :: target_name integer :: error_id character(len = 256) :: error_message end type etsf_io_low_error !!*** !!****s* etsf_io_low_level/etsf_io_low_var_infos !! NAME !! etsf_io_low_var_infos !! !! FUNCTION !! This structure is used to store variable informations, such as !! name, NetCDF id, type, shape and dimensions. It contains the following !! elements: !! * nctype: the type of the variable, see #ETSF_IO_LOW_CONSTANTS. !! * ncid: the id used by NetCDF to access this variable. !! * name: the variable name. !! * ncshape: the number of dimensions (0 for scalar variable). !! * ncdims: the size for each dimension (only (1:ncshape) are relevent). !! * ncdimnames: the name corresponding to such dimensions (may be unset ; !! if set, use etsf_io_low_free_var_infos()). !! * ncattnames: the name corresponding to all associated attributes !! (may be unset ; if set, use etsf_io_low_free_var_infos()). !! !! SOURCE type etsf_io_low_var_infos character(len = 80) :: name integer :: nctype integer :: ncid integer :: ncshape integer :: ncdims(1:16) character(len = 80), pointer :: ncdimnames(:) => null() character(len = 80), pointer :: ncattnames(:) => null() end type etsf_io_low_var_infos !!*** !!****s* etsf_io_low_var/etsf_io_low_var_double !! NAME !! etsf_io_low_var_double !! !! FUNCTION !! This structure is used as an abstraction on a storage for a variable. Only !! one pointer can be associated at a time. The shape of the stored data is !! then defined by the associated pointer. This structure is used to read or !! write data when the storage area in memory can have different shapes. !! !! SOURCE type etsf_io_low_var_double double precision, pointer :: data1D(:) => null() double precision, pointer :: data2D(:, :) => null() double precision, pointer :: data3D(:, :, :) => null() double precision, pointer :: data4D(:, :, :, :) => null() double precision, pointer :: data5D(:, :, :, :, :) => null() double precision, pointer :: data6D(:, :, :, :, :, :) => null() double precision, pointer :: data7D(:, :, :, :, :, :, :) => null() end type etsf_io_low_var_double !!*** !!****s* etsf_io_low_var/etsf_io_low_var_integer !! NAME !! etsf_io_low_var_integer !! !! FUNCTION !! This structure is used as an abstraction on a storage for a variable. Only !! one pointer can be associated at a time. The shape of the stored data is !! then defined by the associated pointer. This structure is used to read or !! write data when the storage area in memory can have different shapes. !! !! SOURCE type etsf_io_low_var_integer integer, pointer :: data1D(:) => null() integer, pointer :: data2D(:, :) => null() integer, pointer :: data3D(:, :, :) => null() integer, pointer :: data4D(:, :, :, :) => null() integer, pointer :: data5D(:, :, :, :, :) => null() integer, pointer :: data6D(:, :, :, :, :, :) => null() integer, pointer :: data7D(:, :, :, :, :, :, :) => null() end type etsf_io_low_var_integer !!*** etsf_io-1.0.3/src/low_level/read_routines_auto.f900000644000353400050630000040114311354150412017060 00000000000000!================================================================ ! WARNING! this file is autogenerated. All modifications should ! will be overwritten on next build. This file is automatically ! produced by the config/scripts/autogen_low_level.py. !================================================================ subroutine read_var_integer_0D(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid integer, intent(out) :: var character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_var_integer_0D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_INT var_user%ncshape = 0 !var_user%ncdims(1:0) = shape(var) !var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & ! & ,count = my_count(1:max(1, var_nc%ncshape)) & ! & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine read_var_integer_0D subroutine read_var_integer_1D(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid integer, intent(out) :: var(:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_var_integer_1D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_INT var_user%ncshape = 1 var_user%ncdims(1:1) = shape(var) !var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine read_var_integer_1D subroutine read_var_integer_2D(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid integer, intent(out) :: var(:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_var_integer_2D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_INT var_user%ncshape = 2 var_user%ncdims(1:2) = shape(var) !var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine read_var_integer_2D subroutine read_var_integer_3D(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid integer, intent(out) :: var(:,:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_var_integer_3D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_INT var_user%ncshape = 3 var_user%ncdims(1:3) = shape(var) !var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine read_var_integer_3D subroutine read_var_integer_4D(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid integer, intent(out) :: var(:,:,:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_var_integer_4D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_INT var_user%ncshape = 4 var_user%ncdims(1:4) = shape(var) !var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine read_var_integer_4D subroutine read_var_integer_5D(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid integer, intent(out) :: var(:,:,:,:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_var_integer_5D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_INT var_user%ncshape = 5 var_user%ncdims(1:5) = shape(var) !var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine read_var_integer_5D subroutine read_var_integer_6D(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid integer, intent(out) :: var(:,:,:,:,:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_var_integer_6D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_INT var_user%ncshape = 6 var_user%ncdims(1:6) = shape(var) !var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine read_var_integer_6D subroutine read_var_integer_7D(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid integer, intent(out) :: var(:,:,:,:,:,:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_var_integer_7D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_INT var_user%ncshape = 7 var_user%ncdims(1:7) = shape(var) !var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine read_var_integer_7D subroutine read_var_double_0D(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid double precision, intent(out) :: var character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_var_double_0D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_DOUBLE var_user%ncshape = 0 !var_user%ncdims(1:0) = shape(var) !var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & ! & ,count = my_count(1:max(1, var_nc%ncshape)) & ! & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine read_var_double_0D subroutine read_var_double_1D(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid double precision, intent(out) :: var(:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_var_double_1D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_DOUBLE var_user%ncshape = 1 var_user%ncdims(1:1) = shape(var) !var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine read_var_double_1D subroutine read_var_double_2D(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid double precision, intent(out) :: var(:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_var_double_2D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_DOUBLE var_user%ncshape = 2 var_user%ncdims(1:2) = shape(var) !var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine read_var_double_2D subroutine read_var_double_3D(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid double precision, intent(out) :: var(:,:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_var_double_3D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_DOUBLE var_user%ncshape = 3 var_user%ncdims(1:3) = shape(var) !var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine read_var_double_3D subroutine read_var_double_4D(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid double precision, intent(out) :: var(:,:,:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_var_double_4D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_DOUBLE var_user%ncshape = 4 var_user%ncdims(1:4) = shape(var) !var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine read_var_double_4D subroutine read_var_double_5D(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid double precision, intent(out) :: var(:,:,:,:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_var_double_5D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_DOUBLE var_user%ncshape = 5 var_user%ncdims(1:5) = shape(var) !var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine read_var_double_5D subroutine read_var_double_6D(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid double precision, intent(out) :: var(:,:,:,:,:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_var_double_6D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_DOUBLE var_user%ncshape = 6 var_user%ncdims(1:6) = shape(var) !var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine read_var_double_6D subroutine read_var_double_7D(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid double precision, intent(out) :: var(:,:,:,:,:,:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_var_double_7D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_DOUBLE var_user%ncshape = 7 var_user%ncdims(1:7) = shape(var) !var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine read_var_double_7D subroutine read_var_character_1D(ncid, varname, var, charlen, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid, charlen character(len = charlen), intent(out) :: var character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_var_character_1D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_CHAR var_user%ncshape = 1 !var_user%ncdims(2:1) = shape(var) var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & ! & ,count = my_count(1:max(1, var_nc%ncshape)) & ! & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine read_var_character_1D subroutine read_var_character_2D(ncid, varname, var, charlen, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid, charlen character(len = charlen), intent(out) :: var(:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_var_character_2D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_CHAR var_user%ncshape = 2 var_user%ncdims(2:2) = shape(var) var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine read_var_character_2D subroutine read_var_character_3D(ncid, varname, var, charlen, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid, charlen character(len = charlen), intent(out) :: var(:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_var_character_3D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_CHAR var_user%ncshape = 3 var_user%ncdims(2:3) = shape(var) var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine read_var_character_3D subroutine read_var_character_4D(ncid, varname, var, charlen, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid, charlen character(len = charlen), intent(out) :: var(:,:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_var_character_4D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_CHAR var_user%ncshape = 4 var_user%ncdims(2:4) = shape(var) var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine read_var_character_4D subroutine read_var_character_5D(ncid, varname, var, charlen, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid, charlen character(len = charlen), intent(out) :: var(:,:,:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_var_character_5D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_CHAR var_user%ncshape = 5 var_user%ncdims(2:5) = shape(var) var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine read_var_character_5D subroutine read_var_character_6D(ncid, varname, var, charlen, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid, charlen character(len = charlen), intent(out) :: var(:,:,:,:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_var_character_6D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_CHAR var_user%ncshape = 6 var_user%ncdims(2:6) = shape(var) var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine read_var_character_6D subroutine read_var_character_7D(ncid, varname, var, charlen, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid, charlen character(len = charlen), intent(out) :: var(:,:,:,:,:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_var_character_7D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_CHAR var_user%ncshape = 7 var_user%ncdims(2:7) = shape(var) var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine read_var_character_7D subroutine read_att_integer_0D(ncid, varname, attname, att, & & lstat, error_data) character(len = *), intent(in) :: varname !integer, intent(in) :: attlen integer, intent(out) :: att integer, intent(in) :: ncid character(len = *), intent(in) :: attname logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_att_integer_0D" integer :: s type(etsf_io_low_var_infos) :: var_infos lstat = .false. if (present(error_data)) then call etsf_io_low_read_var_infos(ncid, varname, var_infos, & & lstat, error_data = error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_read_var_infos(ncid, varname, var_infos, lstat) end if if (.not. lstat) return ! We first check the definition of the attribute (name, type and dims) if (present(error_data)) then call etsf_io_low_check_att(ncid, var_infos%ncid, attname, NF90_INT, & & 1, lstat, error_data = error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_check_att(ncid, var_infos%ncid, attname, NF90_INT, & & 1, lstat) end if if (.not. lstat) return ! Now that we are sure that the read attribute has the same type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_att(ncid, var_infos%ncid, attname, att) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_ATT, & & me, tgtname = attname, tgtid = var_infos%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if lstat = .true. end subroutine read_att_integer_0D subroutine read_att_id_integer_0D(ncid, ncvarid, attname, att, & & lstat, error_data) integer, intent(in) :: ncvarid !integer, intent(in) :: attlen integer, intent(out) :: att integer, intent(in) :: ncid character(len = *), intent(in) :: attname logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_att_id_integer_0D" integer :: s lstat = .false. ! We first check the definition of the attribute (name, type and dims) if (present(error_data)) then call etsf_io_low_check_att(ncid, ncvarid, attname, NF90_INT, & & 1, lstat, error_data = error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_check_att(ncid, ncvarid, attname, NF90_INT, & & 1, lstat) end if if (.not. lstat) return ! Now that we are sure that the read attribute has the same type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_att(ncid, ncvarid, attname, att) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_ATT, & & me, tgtname = attname, tgtid = ncvarid, errid = s, & & errmess = nf90_strerror(s)) end if return end if lstat = .true. end subroutine read_att_id_integer_0D subroutine read_att_integer_1D(ncid, varname, attname, attlen, att, & & lstat, error_data) character(len = *), intent(in) :: varname integer, intent(in) :: attlen integer, intent(out) :: att(1:attlen) integer, intent(in) :: ncid character(len = *), intent(in) :: attname logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_att_integer_1D" integer :: s type(etsf_io_low_var_infos) :: var_infos lstat = .false. if (present(error_data)) then call etsf_io_low_read_var_infos(ncid, varname, var_infos, & & lstat, error_data = error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_read_var_infos(ncid, varname, var_infos, lstat) end if if (.not. lstat) return ! We first check the definition of the attribute (name, type and dims) if (present(error_data)) then call etsf_io_low_check_att(ncid, var_infos%ncid, attname, NF90_INT, & & attlen, lstat, error_data = error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_check_att(ncid, var_infos%ncid, attname, NF90_INT, & & attlen, lstat) end if if (.not. lstat) return ! Now that we are sure that the read attribute has the same type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_att(ncid, var_infos%ncid, attname, att) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_ATT, & & me, tgtname = attname, tgtid = var_infos%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if lstat = .true. end subroutine read_att_integer_1D subroutine read_att_id_integer_1D(ncid, ncvarid, attname, attlen, att, & & lstat, error_data) integer, intent(in) :: ncvarid integer, intent(in) :: attlen integer, intent(out) :: att(1:attlen) integer, intent(in) :: ncid character(len = *), intent(in) :: attname logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_att_id_integer_1D" integer :: s lstat = .false. ! We first check the definition of the attribute (name, type and dims) if (present(error_data)) then call etsf_io_low_check_att(ncid, ncvarid, attname, NF90_INT, & & attlen, lstat, error_data = error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_check_att(ncid, ncvarid, attname, NF90_INT, & & attlen, lstat) end if if (.not. lstat) return ! Now that we are sure that the read attribute has the same type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_att(ncid, ncvarid, attname, att) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_ATT, & & me, tgtname = attname, tgtid = ncvarid, errid = s, & & errmess = nf90_strerror(s)) end if return end if lstat = .true. end subroutine read_att_id_integer_1D subroutine read_att_real_0D(ncid, varname, attname, att, & & lstat, error_data) character(len = *), intent(in) :: varname !integer, intent(in) :: attlen real, intent(out) :: att integer, intent(in) :: ncid character(len = *), intent(in) :: attname logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_att_real_0D" integer :: s type(etsf_io_low_var_infos) :: var_infos lstat = .false. if (present(error_data)) then call etsf_io_low_read_var_infos(ncid, varname, var_infos, & & lstat, error_data = error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_read_var_infos(ncid, varname, var_infos, lstat) end if if (.not. lstat) return ! We first check the definition of the attribute (name, type and dims) if (present(error_data)) then call etsf_io_low_check_att(ncid, var_infos%ncid, attname, NF90_FLOAT, & & 1, lstat, error_data = error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_check_att(ncid, var_infos%ncid, attname, NF90_FLOAT, & & 1, lstat) end if if (.not. lstat) return ! Now that we are sure that the read attribute has the same type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_att(ncid, var_infos%ncid, attname, att) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_ATT, & & me, tgtname = attname, tgtid = var_infos%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if lstat = .true. end subroutine read_att_real_0D subroutine read_att_id_real_0D(ncid, ncvarid, attname, att, & & lstat, error_data) integer, intent(in) :: ncvarid !integer, intent(in) :: attlen real, intent(out) :: att integer, intent(in) :: ncid character(len = *), intent(in) :: attname logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_att_id_real_0D" integer :: s lstat = .false. ! We first check the definition of the attribute (name, type and dims) if (present(error_data)) then call etsf_io_low_check_att(ncid, ncvarid, attname, NF90_FLOAT, & & 1, lstat, error_data = error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_check_att(ncid, ncvarid, attname, NF90_FLOAT, & & 1, lstat) end if if (.not. lstat) return ! Now that we are sure that the read attribute has the same type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_att(ncid, ncvarid, attname, att) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_ATT, & & me, tgtname = attname, tgtid = ncvarid, errid = s, & & errmess = nf90_strerror(s)) end if return end if lstat = .true. end subroutine read_att_id_real_0D subroutine read_att_real_1D(ncid, varname, attname, attlen, att, & & lstat, error_data) character(len = *), intent(in) :: varname integer, intent(in) :: attlen real, intent(out) :: att(1:attlen) integer, intent(in) :: ncid character(len = *), intent(in) :: attname logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_att_real_1D" integer :: s type(etsf_io_low_var_infos) :: var_infos lstat = .false. if (present(error_data)) then call etsf_io_low_read_var_infos(ncid, varname, var_infos, & & lstat, error_data = error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_read_var_infos(ncid, varname, var_infos, lstat) end if if (.not. lstat) return ! We first check the definition of the attribute (name, type and dims) if (present(error_data)) then call etsf_io_low_check_att(ncid, var_infos%ncid, attname, NF90_FLOAT, & & attlen, lstat, error_data = error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_check_att(ncid, var_infos%ncid, attname, NF90_FLOAT, & & attlen, lstat) end if if (.not. lstat) return ! Now that we are sure that the read attribute has the same type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_att(ncid, var_infos%ncid, attname, att) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_ATT, & & me, tgtname = attname, tgtid = var_infos%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if lstat = .true. end subroutine read_att_real_1D subroutine read_att_id_real_1D(ncid, ncvarid, attname, attlen, att, & & lstat, error_data) integer, intent(in) :: ncvarid integer, intent(in) :: attlen real, intent(out) :: att(1:attlen) integer, intent(in) :: ncid character(len = *), intent(in) :: attname logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_att_id_real_1D" integer :: s lstat = .false. ! We first check the definition of the attribute (name, type and dims) if (present(error_data)) then call etsf_io_low_check_att(ncid, ncvarid, attname, NF90_FLOAT, & & attlen, lstat, error_data = error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_check_att(ncid, ncvarid, attname, NF90_FLOAT, & & attlen, lstat) end if if (.not. lstat) return ! Now that we are sure that the read attribute has the same type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_att(ncid, ncvarid, attname, att) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_ATT, & & me, tgtname = attname, tgtid = ncvarid, errid = s, & & errmess = nf90_strerror(s)) end if return end if lstat = .true. end subroutine read_att_id_real_1D subroutine read_att_double_0D(ncid, varname, attname, att, & & lstat, error_data) character(len = *), intent(in) :: varname !integer, intent(in) :: attlen double precision, intent(out) :: att integer, intent(in) :: ncid character(len = *), intent(in) :: attname logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_att_double_0D" integer :: s type(etsf_io_low_var_infos) :: var_infos lstat = .false. if (present(error_data)) then call etsf_io_low_read_var_infos(ncid, varname, var_infos, & & lstat, error_data = error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_read_var_infos(ncid, varname, var_infos, lstat) end if if (.not. lstat) return ! We first check the definition of the attribute (name, type and dims) if (present(error_data)) then call etsf_io_low_check_att(ncid, var_infos%ncid, attname, NF90_DOUBLE, & & 1, lstat, error_data = error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_check_att(ncid, var_infos%ncid, attname, NF90_DOUBLE, & & 1, lstat) end if if (.not. lstat) return ! Now that we are sure that the read attribute has the same type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_att(ncid, var_infos%ncid, attname, att) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_ATT, & & me, tgtname = attname, tgtid = var_infos%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if lstat = .true. end subroutine read_att_double_0D subroutine read_att_id_double_0D(ncid, ncvarid, attname, att, & & lstat, error_data) integer, intent(in) :: ncvarid !integer, intent(in) :: attlen double precision, intent(out) :: att integer, intent(in) :: ncid character(len = *), intent(in) :: attname logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_att_id_double_0D" integer :: s lstat = .false. ! We first check the definition of the attribute (name, type and dims) if (present(error_data)) then call etsf_io_low_check_att(ncid, ncvarid, attname, NF90_DOUBLE, & & 1, lstat, error_data = error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_check_att(ncid, ncvarid, attname, NF90_DOUBLE, & & 1, lstat) end if if (.not. lstat) return ! Now that we are sure that the read attribute has the same type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_att(ncid, ncvarid, attname, att) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_ATT, & & me, tgtname = attname, tgtid = ncvarid, errid = s, & & errmess = nf90_strerror(s)) end if return end if lstat = .true. end subroutine read_att_id_double_0D subroutine read_att_double_1D(ncid, varname, attname, attlen, att, & & lstat, error_data) character(len = *), intent(in) :: varname integer, intent(in) :: attlen double precision, intent(out) :: att(1:attlen) integer, intent(in) :: ncid character(len = *), intent(in) :: attname logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_att_double_1D" integer :: s type(etsf_io_low_var_infos) :: var_infos lstat = .false. if (present(error_data)) then call etsf_io_low_read_var_infos(ncid, varname, var_infos, & & lstat, error_data = error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_read_var_infos(ncid, varname, var_infos, lstat) end if if (.not. lstat) return ! We first check the definition of the attribute (name, type and dims) if (present(error_data)) then call etsf_io_low_check_att(ncid, var_infos%ncid, attname, NF90_DOUBLE, & & attlen, lstat, error_data = error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_check_att(ncid, var_infos%ncid, attname, NF90_DOUBLE, & & attlen, lstat) end if if (.not. lstat) return ! Now that we are sure that the read attribute has the same type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_att(ncid, var_infos%ncid, attname, att) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_ATT, & & me, tgtname = attname, tgtid = var_infos%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if lstat = .true. end subroutine read_att_double_1D subroutine read_att_id_double_1D(ncid, ncvarid, attname, attlen, att, & & lstat, error_data) integer, intent(in) :: ncvarid integer, intent(in) :: attlen double precision, intent(out) :: att(1:attlen) integer, intent(in) :: ncid character(len = *), intent(in) :: attname logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_att_id_double_1D" integer :: s lstat = .false. ! We first check the definition of the attribute (name, type and dims) if (present(error_data)) then call etsf_io_low_check_att(ncid, ncvarid, attname, NF90_DOUBLE, & & attlen, lstat, error_data = error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_check_att(ncid, ncvarid, attname, NF90_DOUBLE, & & attlen, lstat) end if if (.not. lstat) return ! Now that we are sure that the read attribute has the same type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_att(ncid, ncvarid, attname, att) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_ATT, & & me, tgtname = attname, tgtid = ncvarid, errid = s, & & errmess = nf90_strerror(s)) end if return end if lstat = .true. end subroutine read_att_id_double_1D subroutine read_att_character_1D(ncid, varname, attname, attlen, att, & & lstat, error_data) character(len = *), intent(in) :: varname integer, intent(in) :: attlen character(len = attlen), intent(out) :: att integer, intent(in) :: ncid character(len = *), intent(in) :: attname logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_att_character_1D" integer :: s type(etsf_io_low_var_infos) :: var_infos lstat = .false. write(att, "(A)") repeat(" " , attlen) if (present(error_data)) then call etsf_io_low_read_var_infos(ncid, varname, var_infos, & & lstat, error_data = error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_read_var_infos(ncid, varname, var_infos, lstat) end if if (.not. lstat) return ! We first check the definition of the attribute (name, type and dims) if (present(error_data)) then call etsf_io_low_check_att(ncid, var_infos%ncid, attname, NF90_CHAR, & & attlen, lstat, error_data = error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_check_att(ncid, var_infos%ncid, attname, NF90_CHAR, & & attlen, lstat) end if if (.not. lstat) return ! Now that we are sure that the read attribute has the same type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_att(ncid, var_infos%ncid, attname, att) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_ATT, & & me, tgtname = attname, tgtid = var_infos%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if lstat = .true. end subroutine read_att_character_1D subroutine read_att_id_character_1D(ncid, ncvarid, attname, attlen, att, & & lstat, error_data) integer, intent(in) :: ncvarid integer, intent(in) :: attlen character(len = attlen), intent(out) :: att integer, intent(in) :: ncid character(len = *), intent(in) :: attname logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_att_id_character_1D" integer :: s lstat = .false. write(att, "(A)") repeat(" " , attlen) ! We first check the definition of the attribute (name, type and dims) if (present(error_data)) then call etsf_io_low_check_att(ncid, ncvarid, attname, NF90_CHAR, & & attlen, lstat, error_data = error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_check_att(ncid, ncvarid, attname, NF90_CHAR, & & attlen, lstat) end if if (.not. lstat) return ! Now that we are sure that the read attribute has the same type and dimension ! that the argument one, we can do the get action securely. s = nf90_get_att(ncid, ncvarid, attname, att) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_ATT, & & me, tgtname = attname, tgtid = ncvarid, errid = s, & & errmess = nf90_strerror(s)) end if return end if lstat = .true. end subroutine read_att_id_character_1D etsf_io-1.0.3/src/low_level/read_routines.f900000644000353400050630000017716611354145411016052 00000000000000 !!****m* etsf_io_low_read_group/etsf_io_low_read_dim !! NAME !! etsf_io_low_read_dim !! !! FUNCTION !! This method is a wraper to get in one call the id of one dimension !! and its value. !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = a NetCDF handler, opened with read access. !! * dimname = a string identifying a dimension. !! !! OUTPUT !! * dimvalue = a positive integer which is the length of the dimension. !! * lstat = .true. if operation succeed. !! * ncdimid = (optional) the id used by NetCDF to identify the read dimension. !! * error_data = (optional) location to store error data. !! !! SOURCE subroutine etsf_io_low_read_dim(ncid, dimname, dimvalue, lstat, ncdimid, error_data) integer, intent(in) :: ncid character(len = *), intent(in) :: dimname integer, intent(out) :: dimvalue logical, intent(out) :: lstat integer, intent(out), optional :: ncdimid type(etsf_io_low_error), intent(out), optional :: error_data !local character(len = *), parameter :: me = "etsf_io_low_read_dim" integer :: s, dimid lstat = .false. ! will inq_dimid() and inq_dimlen() + error handling s = nf90_inq_dimid(ncid, dimname, dimid) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_INQ, ERROR_TYPE_DID, me, & & tgtname = dimname, errid = s, errmess = nf90_strerror(s)) end if return end if s = nf90_inquire_dimension(ncid, dimid, len = dimvalue) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_INQ, ERROR_TYPE_DIM, me, & & tgtname = dimname, tgtid = dimid, errid = s, errmess = nf90_strerror(s)) end if return end if if (present(ncdimid)) then ncdimid = dimid end if lstat = .true. end subroutine etsf_io_low_read_dim !!*** subroutine read_var_infos_name(ncid, varname, var_infos, lstat, error_data, & & dim_name, att_name) integer, intent(in) :: ncid character(len = *), intent(in) :: varname type(etsf_io_low_var_infos), intent(out) :: var_infos logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data logical, intent(in), optional :: dim_name logical, intent(in), optional :: att_name !Local character(len = *), parameter :: me = "read_var_infos_name" integer :: s logical :: my_dim_name, my_att_name lstat = .false. var_infos%name = varname(1:min(80, len(varname))) ! will inq_varid() s = nf90_inq_varid(ncid, varname, var_infos%ncid) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_INQ, ERROR_TYPE_VID, me, & & tgtname = varname, errid = s, errmess = nf90_strerror(s)) end if return end if if (present(dim_name)) then my_dim_name = dim_name else my_dim_name = .false. end if if (present(att_name)) then my_att_name = att_name else my_att_name = .false. end if if (present(error_data)) then call read_var_infos(ncid, var_infos, my_dim_name, my_att_name, & & lstat, error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, me) else call read_var_infos(ncid, var_infos, my_dim_name, my_att_name, lstat) end if end subroutine read_var_infos_name subroutine read_var_infos_id(ncid, varid, var_infos, lstat, error_data, & & dim_name, att_name) integer, intent(in) :: ncid integer, intent(in) :: varid type(etsf_io_low_var_infos), intent(out) :: var_infos logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data logical, intent(in), optional :: dim_name logical, intent(in), optional :: att_name !Local character(len = *), parameter :: me = "read_var_infos_id" integer :: s character(len = NF90_MAX_NAME) :: varname logical :: my_dim_name, my_att_name lstat = .false. var_infos%ncid = varid ! will inq_varid() s = nf90_inquire_variable(ncid, var_infos%ncid, name = varname) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_INQ, ERROR_TYPE_VAR, me, & & tgtid = varid, errid = s, errmess = nf90_strerror(s)) end if return end if var_infos%name = varname(1:min(80, len(varname))) if (present(dim_name)) then my_dim_name = dim_name else my_dim_name = .false. end if if (present(att_name)) then my_att_name = att_name else my_att_name = .false. end if if (present(error_data)) then call read_var_infos(ncid, var_infos, my_dim_name, my_att_name, & & lstat, error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, me) else call read_var_infos(ncid, var_infos, my_dim_name, my_att_name, lstat) end if end subroutine read_var_infos_id ! Read dimensions..., varid must be set, varname is left untouched. subroutine read_var_infos(ncid, var_infos, with_dim_name, with_att_name, & & lstat, error_data) integer, intent(in) :: ncid type(etsf_io_low_var_infos), intent(inout) :: var_infos logical, intent(in) :: with_dim_name logical, intent(in) :: with_att_name logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_var_infos" integer :: i, s, n integer, allocatable :: ncdimids(:) character(len = NF90_MAX_NAME) :: ncname lstat = .false. ! will inq_vartype() ! will inq_varndims() s = nf90_inquire_variable(ncid, var_infos%ncid, xtype = var_infos%nctype, & & ndims = var_infos%ncshape, nAtts = n) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_INQ, ERROR_TYPE_VAR, me, & & tgtname = var_infos%name, tgtid = var_infos%ncid, & & errid = s, errmess = nf90_strerror(s)) end if return end if if (var_infos%ncshape > 0) then ! will inq_vardimid() allocate(ncdimids(1:var_infos%ncshape)) if (with_dim_name) then allocate(var_infos%ncdimnames(1:var_infos%ncshape)) end if s = nf90_inquire_variable(ncid, var_infos%ncid, dimids = ncdimids) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_INQ, ERROR_TYPE_VAR, & & me, tgtname = var_infos%name, tgtid = var_infos%ncid, & & errid = s, errmess = nf90_strerror(s)) end if deallocate(ncdimids) return end if do i = 1, var_infos%ncshape, 1 ! will inq_dimlen() if (with_dim_name) then s = nf90_inquire_dimension(ncid, ncdimids(i), len = var_infos%ncdims(i), & & name = ncname) write(var_infos%ncdimnames(i), "(A)") ncname(1:min(80, len(ncname))) else s = nf90_inquire_dimension(ncid, ncdimids(i), len = var_infos%ncdims(i)) end if if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_INQ, & & ERROR_TYPE_DIM, me, tgtid = ncdimids(i), errid = s, & & errmess = nf90_strerror(s)) end if deallocate(ncdimids) call etsf_io_low_free_var_infos(var_infos) return end if end do deallocate(ncdimids) end if ! will inquire the number of attributes and their names. if (with_att_name) then if (n > 0) then allocate(var_infos%ncattnames(1:n)) do i = 1, n, 1 s = nf90_inq_attname(ncid, var_infos%ncid, i, ncname) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_INQ, & & ERROR_TYPE_ATT, me, tgtid = i, errid = s, & & errmess = nf90_strerror(s)) end if call etsf_io_low_free_var_infos(var_infos) return end if write(var_infos%ncattnames(i), "(A)") ncname(1:min(80, len(ncname))) end do else var_infos%ncattnames => null() end if end if lstat = .true. end subroutine read_var_infos !!****s* etsf_io_low_var_infos/etsf_io_low_read_all_var_infos !! NAME !! etsf_io_low_read_all_var_infos !! !! FUNCTION !! Read a NetCDF file and create an array storing all variable !! informations. These informations are stored in an array allocated in !! this routine. It must be deallocated after use. The retrieved informations !! include NetCDF varid, variable name, shape and dimensions. If the !! with_dim_name is set to .true., the names of dimensions are also stored. !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = a NetCDF handler, opened with read access. !! * with_dim_name = (optional) if set to .true., the dimension names are also !! retrieved. In that case, each element of output array !! @var_infos_array must be freed using !! etsf_io_low_free_var_infos(). !! * with_att_name = (optional) if set to .true., the attribute names are also !! retrieved. In that case, each element of output array !! @var_infos_array must be freed using !! etsf_io_low_free_var_infos(). !! !! OUTPUT !! * var_infos_array = a pointer on an array to !! store the informations. This !! pointer must be null() on !! enter. If no variables are !! found or an error occurs, the !! pointer is let null(). !! * lstat = .true. if the file has been read without error. !! * error_data = (optional) location to store error data. !! !! !! SOURCE subroutine etsf_io_low_read_all_var_infos(ncid, var_infos_array, lstat, & & error_data, with_dim_name, with_att_name) integer, intent(in) :: ncid type(etsf_io_low_var_infos), pointer :: var_infos_array(:) logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data logical, optional, intent(in) :: with_dim_name logical, optional, intent(in) :: with_att_name !Local character(len = *), parameter :: me = "etsf_io_low_read_all_var_infos" integer :: i, j, s, nvars logical :: my_with_dim_name, my_with_att_name lstat = .false. if (present(with_dim_name))then my_with_dim_name = with_dim_name else my_with_dim_name = .false. end if if (present(with_att_name))then my_with_att_name = with_att_name else my_with_att_name = .false. end if ! Consistency checks... if (associated(var_infos_array)) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_INQ, ERROR_TYPE_ARG, me, & & tgtname = "var_infos_array", errid = 0, & & errmess = "pointer already allocated.") end if return end if var_infos_array => null() ! Inquire the NetCDF file for number of variables s = nf90_inquire(ncid, nVariables = nvars) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_INQ, ERROR_TYPE_VAR, me, & & errid = s, errmess = nf90_strerror(s)) end if return end if if (nvars == 0) then ! No variables in the file. lstat = .true. return end if ! Allocate the var_infos_array argument and read var_infos for each ! variables in the NetCDF file. allocate(var_infos_array(nvars)) do i = 1, nvars, 1 if (present(error_data))then call read_var_infos_id(ncid, i, var_infos_array(i), lstat, error_data, & & dim_name = my_with_dim_name, att_name = my_with_att_name) if (.not. lstat) call etsf_io_low_error_update(error_data, me) else call read_var_infos_id(ncid, i, var_infos_array(i), lstat, & & dim_name = my_with_dim_name, att_name = my_with_att_name) end if ! Handle the error, if required. if (.not. lstat) then ! Free the var_infos_array argument before leaving do j = 1, i, 1 call etsf_io_low_free_var_infos(var_infos_array(i)) end do deallocate(var_infos_array) var_infos_array => null() return end if end do lstat = .true. end subroutine etsf_io_low_read_all_var_infos !!*** subroutine read_flag_id(ncid, flag, ncvarid, attname, lstat, error_data) logical, intent(out) :: flag integer, intent(in) :: ncid, ncvarid character(len = *), intent(in) :: attname logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data character(len = *), parameter :: me = "read_flag_id" character(len = 3) :: value flag = .false. call etsf_io_low_read_att(ncid, ncvarid, attname, 3, value, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, me) return end if flag = (value == "Yes" .or. value == "YES" .or. value == "yes") end subroutine read_flag_id subroutine read_flag(ncid, flag, varname, attname, lstat, error_data) logical, intent(out) :: flag integer, intent(in) :: ncid character(len = *), intent(in) :: varname character(len = *), intent(in) :: attname logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data character(len = *), parameter :: me = "read_flag" character(len = 3) :: value flag = .false. call etsf_io_low_read_att(ncid, varname, attname, 3, value, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, me) return end if flag = (value == "Yes" .or. value == "YES" .or. value == "yes") end subroutine read_flag ! Create the start, count and map arrays for a put or a get action using the ! NetCDF routines. subroutine etsf_io_low_make_access(start, count, map, var_infos, lstat, & & opt_start, opt_count, opt_map, error_data) integer, intent(out) :: start(16), count(16), map(16) type(etsf_io_low_var_infos), intent(in) :: var_infos logical, intent(out) :: lstat integer, intent(in), optional :: opt_start(:), opt_count(:), opt_map(:) type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "etsf_io_low_make_access" integer :: i, val(16), j logical :: permut lstat = .true. if (var_infos%ncshape < 1) then return end if ! We create the start, count and map arguments required by NetCDF. if (present(opt_start)) then ! Size checks. if (size(opt_start) /= var_infos%ncshape) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ARG, & & me, tgtname = "opt_start", errmess = "inconsistent length") end if lstat = .false. return end if ! Copy start start(1:var_infos%ncshape) = opt_start(1:var_infos%ncshape) else start(1:max(1, var_infos%ncshape)) = 1 end if ! The count array if (present(opt_count)) then ! Size checks. if (size(opt_count) /= var_infos%ncshape) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ARG, & & me, tgtname = "opt_count", errmess = "inconsistent length") end if lstat = .false. return end if ! Copy count excempt when negative do i = 1, var_infos%ncshape, 1 if (opt_count(i) > 0) then count(i) = opt_count(i) else count(i) = var_infos%ncdims(i) end if end do else count(1:max(1, var_infos%ncshape)) = var_infos%ncdims(1:max(1, var_infos%ncshape)) end if ! The map array if (present(opt_map)) then ! Size checks. if (size(opt_map) /= var_infos%ncshape) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ARG, & & me, tgtname = "opt_map", errmess = "inconsistent length") end if lstat = .false. return end if ! Copy map if all positive, else apply permutations permut = .false. do i = 1, var_infos%ncshape, 1 if (opt_map(i) <= 0) then permut = .true. end if if (permut .and. opt_map(i) > 0) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ARG, & & me, tgtname = "opt_map", errmess = "inconsistent values") end if end do if (permut) then ! Create a map from the count information val(1) = 1 ! j is the index of previous non unity count value if (count(1) > 1) then j = 1 else j = 0 end if do i = 2, var_infos%ncshape, 1 if (count(i) > 1) then if (j > 0) then val(i) = val(i - 1) * count(j) else val(i) = val(i - 1) end if j = i else val(i) = val(i - 1) end if end do ! We do the permutations. do i = 1, var_infos%ncshape, 1 if (-opt_map(i) <= 0 .or. -opt_map(i) > var_infos%ncshape) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ARG, & & me, tgtname = "opt_map", errmess = "out of bounds permutation") end if lstat = .false. return end if map(i) = val(-opt_map(i)) end do else ! Copy map map(1:var_infos%ncshape) = opt_map(1:var_infos%ncshape) end if else ! Create a map from the count information map(1) = 1 ! j is the index of previous non unity count value if (count(1) > 1) then j = 1 else j = 0 end if do i = 2, var_infos%ncshape, 1 if (count(i) > 1) then if (j > 0) then map(i) = map(i - 1) * count(j) else map(i) = map(i - 1) end if j = i else map(i) = map(i - 1) end if end do end if end subroutine etsf_io_low_make_access !!****m* etsf_io_low_check_group/etsf_io_low_check_var !! NAME !! etsf_io_low_check_var !! !! FUNCTION !! This method is used to compare the informations (type, shape...) of two !! given variables. It returns .true. if the variables are compatible (data !! from one can be transfered to the other). It can also say if the match !! is perfect or if the transfer requires convertion (type or shape). !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * var_ref = store, type, shape, dimensions and NetCDF id. !! * var = store, type, shape, dimensions and NetCDF id. !! * sub = (optional) restrict the check to the lower dimensions (0 < sub <= var_ref%ncshape). !! !! OUTPUT !! * lstat = .true. if the two variable definitions are compatible. !! * level = (optional) when variables are compatibles (lstat = .true.), !! this flag gives information on matching (see #FLAGS_MATCHING). !! * error_data = (optional) location to store error data. !! !! SOURCE subroutine etsf_io_low_check_var(var_ref, var, start, count, map, lstat, error_data) type(etsf_io_low_var_infos), intent(in) :: var_ref type(etsf_io_low_var_infos), intent(in) :: var integer, intent(in) :: start(:), count(:), map(:) logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "etsf_io_low_check_var" character(len = 80) :: err integer :: i, s, nb_ele_ref, nb_ele, sub_shape integer :: nclendims(1:7) lstat = .false. ! Check the type, if both numeric or both strings, vars are compatible. if ((var_ref%nctype == NF90_CHAR .and. var%nctype /= NF90_CHAR) .or. & & (var_ref%nctype /= NF90_CHAR .and. var%nctype == NF90_CHAR)) then write(err, "(A)") "incompatible type, both must be either numeric or character." if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = var_ref%name, errmess = err) end if return end if ! Size checks. if (var_ref%ncshape > 1 .and. (size(start) /= var_ref%ncshape .or. & & size(count) /= var_ref%ncshape .or. size(map) /= var_ref%ncshape)) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ARG, me, & & tgtname = trim(var_ref%name) // " (start | count | map)", & & errmess = "inconsistent length") end if return end if ! Checks on start. do i = 1, var_ref%ncshape, 1 if (start(i) <= 0 .or. start(i) > var_ref%ncdims(i)) then if (present(error_data)) then write(err, "(A,I0,A,I0,A,I5,A)") "wrong start value for index ", i, & & " (start(", i, ") = ", start(i), ")" call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ARG, & & me, tgtname = trim(var_ref%name)//" (start)", errmess = err) end if return end if end do ! Checks on count. do i = 1, var_ref%ncshape, 1 if (count(i) <= 0 .or. count(i) > var_ref%ncdims(i)) then if (present(error_data)) then write(err, "(A,I0,A,I0,A,I5,A)") "wrong count value for index ", i, & & " (count(", i, ") = ", count(i), ")" call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ARG, & & me, tgtname = trim(var_ref%name)//" (count)", errmess = err) end if return end if end do ! Checks on map ! We get the number of destination elements if (var%ncshape == 0) then nb_ele = 1 else nb_ele = product(var%ncdims(1:var%ncshape)) end if ! We check that the mapping will not exceed the number of destination elements. nb_ele_ref = 1 if (var%ncshape == 0) then ! if the destination variable is a scalar, ! we can ignore the map argument. nb_ele_ref = 1 else do i = 1, var_ref%ncshape, 1 nb_ele_ref = nb_ele_ref + map(i) * (count(i) - 1) end do end if if (nb_ele_ref > nb_ele) then if (present(error_data)) then write(err, "(A,A,I5,A,I5,A)") "wrong map value ", & & " (map address = ", nb_ele_ref, & & " & max address = ", nb_ele , ")" call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ARG, me, & & tgtname = trim(var_ref%name)//" (map)", errmess = err) end if return end if ! The argument has a different shape that the store variable. ! We check the compatibility, product(var_to%ncdims) == product(var_from%ncdims) if (var_ref%ncshape == 0 .or. var%ncshape == 0) then ! If var shape is scalar, then always one element will be accessed. nb_ele_ref = 1 else nb_ele_ref = product(count(1:var_ref%ncshape)) end if if (nb_ele_ref /= nb_ele) then write(err, "(A,I5,A,I5,A)") "incompatible number of data (var_ref = ", & & nb_ele_ref, " & var = ", nb_ele, ")" if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = var_ref%name, errmess = err) end if return end if lstat = .true. end subroutine etsf_io_low_check_var !!*** !!****m* etsf_io_low_check_group/etsf_io_low_check_att !! NAME !! etsf_io_low_check_att !! !! FUNCTION !! This method is used to check that an attribute: !! * exists in the read NetCDF file ; !! * has the right type ; !! * has the right length (1 for scalar, > 1 for arrays). !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = a NetCDF handler, opened with read access. !! * ncvarid = the id of the variable the attribute is attached to. !! in the case of global attributes, use the constance !! NF90_GLOBAL (when linking against NetCDF) or #etsf_io_low_global_att !! which is a wrapper exported by this module (see #ETSF_IO_LOW_CONSTANTS). !! * attname = a string identifying an attribute. !! * atttype = an integer identifying the type (see #ETSF_IO_LOW_CONSTANTS). !! * attlen = the size of the array, or 1 when the attribute is a scalar. !! !! OUTPUT !! * lstat = .true. if operation succeed. !! * error_data = (optional) location to store error data. !! !! ERRORS !! * ERROR_MODE_INQ & ERROR_TYPE_ATT: when the attribute doesn't exist. !! * ERROR_MODE_SPEC & ERROR_TYPE_ATT: when the attribute has a wrong type or dimension. !! !! SOURCE subroutine etsf_io_low_check_att(ncid, ncvarid, attname, atttype, attlen, lstat, error_data) integer, intent(in) :: ncid integer, intent(in) :: ncvarid character(len = *), intent(in) :: attname integer, intent(in) :: atttype, attlen logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "etsf_io_low_check_att" character(len = 80) :: err integer :: s, nctype, nclen lstat = .false. s = nf90_inquire_attribute(ncid, ncvarid, attname, xtype = nctype, len = nclen) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_INQ, ERROR_TYPE_ATT, & & me, tgtname = attname, errid = s, errmess = nf90_strerror(s)) end if return end if ! Check the type if (nctype /= atttype) then write(err, "(A,I5,A,I5,A)") "wrong type (read = ", nctype, & & ", awaited = ", atttype, ")" if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ATT, & & me, tgtname = attname, errmess = err) end if return end if ! Check the dimensions if ((atttype == NF90_CHAR .and. nclen > attlen) .or. & & (atttype /= NF90_CHAR .and. nclen /= attlen)) then write(err, "(A,I5,A,I5,A)") "wrong length (read = ", nclen, & & ", awaited = ", attlen, ")" if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ATT, & & me, tgtname = attname, errmess = err) end if return end if lstat = .true. end subroutine etsf_io_low_check_att !!*** !!****m* etsf_io_low_check_group/etsf_io_low_check_header !! NAME !! etsf_io_low_check_header !! !! FUNCTION !! This method is specific to ETSF files. It checks if the header is !! conform to the specifications, which means having the right "file_format" !! attribute, the right "file_format_version" one and also an attribute named !! "Conventions". Moreover, the routine can do a check on the value of the !! file_format_version to ensure high enough value. !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = a NetCDF handler, opened with read access. !! !! OUTPUT !! * lstat = .true. if operation succeed. !! * version_min = (optional) the number of minimal version to be read. ! when not specified, 1.3 is the minimum value by default. !! * error_data = (optional) location to store error data. !! !! SOURCE subroutine etsf_io_low_check_header(ncid, lstat, version_min, error_data) integer, intent(in) :: ncid logical, intent(out) :: lstat real, intent(in), optional :: version_min type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "etsf_io_low_check_header" character(len = 80) :: err, format integer :: s real :: version_real logical :: stat lstat = .false. ! Check the header write(format, "(A80)") " " if (present(error_data)) then call etsf_io_low_read_att(ncid, NF90_GLOBAL, "file_format", 80, format, & & stat, error_data) if (.not. stat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_read_att(ncid, NF90_GLOBAL, "file_format", 80, format, stat) end if if (.not. stat) then call etsf_io_low_close(ncid, stat) return end if if (trim(adjustl(format)) /= "ETSF Nanoquanta") then write(err, "(A,A,A)") "wrong value: '", trim(adjustl(format(1:60))), "'" if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ATT, & & me, tgtname = "file_format", errmess = err) end if call etsf_io_low_close(ncid, stat) return end if ! Check the version if (present(error_data)) then call etsf_io_low_read_att(ncid, NF90_GLOBAL, "file_format_version", & & version_real, stat, error_data) if (.not. stat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_read_att(ncid, NF90_GLOBAL, "file_format_version", & & version_real, stat) end if if (.not. stat) then call etsf_io_low_close(ncid, stat) return end if if (present(version_min)) then stat = (version_real >= version_min) else stat = (version_real >= 1.3) end if if (.not. stat) then write(err, "(A,F10.5)") "wrong value: ", version_real if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ATT, & & me, tgtname = "file_format_version", errmess = err) end if call etsf_io_low_close(ncid, stat) return end if ! Check for the Conventions flag if (present(error_data)) then call etsf_io_low_check_att(ncid, NF90_GLOBAL, "Conventions", & & NF90_CHAR, 80, stat, error_data) if (.not. stat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_check_att(ncid, NF90_GLOBAL, "Conventions", NF90_CHAR, 80, stat) end if if (.not. stat) then call etsf_io_low_close(ncid, stat) return end if lstat = .true. end subroutine etsf_io_low_check_header !!*** !!****m* etsf_io_low_file_group/etsf_io_low_open_read !! NAME !! etsf_io_low_open_read !! !! FUNCTION !! This method is used to open a NetCDF file with read access only. Moreover, !! a check on the header is done to verify that the file is conformed to !! specifications (see etsf_io_low_check_header()). !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * filename = the path to the file to open. !! !! OUTPUT !! * ncid = the NetCDF handler, opened with read access. !! * lstat = .true. if operation succeed. !! * version_min = (optional) the number of minimal version to be read. ! when not specified, 1.3 is the minimum value by default. !! * error_data = (optional) location to store error data. !! * with_etsf_header = (optional) if true, will check that there is a header !! as defined in the ETSF specifications (default is .true.). !! !! SOURCE subroutine etsf_io_low_open_read(ncid, filename, lstat, version_min, & & error_data, with_etsf_header) integer, intent(out) :: ncid character(len = *), intent(in) :: filename logical, intent(out) :: lstat real, intent(in), optional :: version_min type(etsf_io_low_error), intent(out), optional :: error_data logical, intent(in), optional :: with_etsf_header !Local character(len = *), parameter :: me = "etsf_io_low_open_read" integer :: s logical :: my_with_etsf_header lstat = .false. ! Open file for reading s = nf90_open(path = filename, mode = NF90_NOWRITE, ncid = ncid) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_IO, ERROR_TYPE_ORD, & & me, tgtname = filename, errid = s, errmess = nf90_strerror(s)) end if return end if ! From now on the file is open. If an error occur, ! we should close it. if (present(with_etsf_header)) then my_with_etsf_header = with_etsf_header else my_with_etsf_header = .true. end if if (my_with_etsf_header) then if (present(error_data)) then if (present(version_min)) then call etsf_io_low_check_header(ncid, lstat, version_min, error_data) else call etsf_io_low_check_header(ncid, lstat, error_data = error_data) end if if (.not. lstat) call etsf_io_low_error_update(error_data, me) else if (present(version_min)) then call etsf_io_low_check_header(ncid, lstat, version_min = version_min) else call etsf_io_low_check_header(ncid, lstat) end if end if else lstat = .true. end if end subroutine etsf_io_low_open_read !!*** ! Generic routine, documented in the module file. subroutine read_var_double_var(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid character(len = *), intent(in) :: varname type(etsf_io_low_var_double), intent(inout) :: var logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_var_double_var" character(len = 80) :: err integer :: varid type(etsf_io_low_error) :: error if (associated(var%data1D)) then if (present(start) .and. present(count) .and. present(map)) then call read_var_double_1D(ncid, varname, var%data1D, lstat, & & start = start, count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(count)) then call read_var_double_1D(ncid, varname, var%data1D, lstat, & & start = start, count = count, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(map)) then call read_var_double_1D(ncid, varname, var%data1D, lstat, & & start = start, map = map, & & ncvarid = varid, error_data = error) else if (present(count) .and. present(map)) then call read_var_double_1D(ncid, varname, var%data1D, lstat, & & count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start)) then call read_var_double_1D(ncid, varname, var%data1D, lstat, start = start, & & ncvarid = varid, error_data = error) else if (present(count)) then call read_var_double_1D(ncid, varname, var%data1D, lstat, count = count, & & ncvarid = varid, error_data = error) else if (present(map)) then call read_var_double_1D(ncid, varname, var%data1D, lstat, map = map, & & ncvarid = varid, error_data = error) else call read_var_double_1D(ncid, varname, var%data1D, lstat, & & ncvarid = varid, error_data = error) end if else if (associated(var%data2D)) then if (present(start) .and. present(count) .and. present(map)) then call read_var_double_2D(ncid, varname, var%data2D, lstat, & & start = start, count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(count)) then call read_var_double_2D(ncid, varname, var%data2D, lstat, & & start = start, count = count, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(map)) then call read_var_double_2D(ncid, varname, var%data2D, lstat, & & start = start, map = map, & & ncvarid = varid, error_data = error) else if (present(count) .and. present(map)) then call read_var_double_2D(ncid, varname, var%data2D, lstat, & & count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start)) then call read_var_double_2D(ncid, varname, var%data2D, lstat, start = start, & & ncvarid = varid, error_data = error) else if (present(count)) then call read_var_double_2D(ncid, varname, var%data2D, lstat, count = count, & & ncvarid = varid, error_data = error) else if (present(map)) then call read_var_double_2D(ncid, varname, var%data2D, lstat, map = map, & & ncvarid = varid, error_data = error) else call read_var_double_2D(ncid, varname, var%data2D, lstat, & & ncvarid = varid, error_data = error) end if else if (associated(var%data3D)) then if (present(start) .and. present(count) .and. present(map)) then call read_var_double_3D(ncid, varname, var%data3D, lstat, & & start = start, count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(count)) then call read_var_double_3D(ncid, varname, var%data3D, lstat, & & start = start, count = count, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(map)) then call read_var_double_3D(ncid, varname, var%data3D, lstat, & & start = start, map = map, & & ncvarid = varid, error_data = error) else if (present(count) .and. present(map)) then call read_var_double_3D(ncid, varname, var%data3D, lstat, & & count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start)) then call read_var_double_3D(ncid, varname, var%data3D, lstat, start = start, & & ncvarid = varid, error_data = error) else if (present(count)) then call read_var_double_3D(ncid, varname, var%data3D, lstat, count = count, & & ncvarid = varid, error_data = error) else if (present(map)) then call read_var_double_3D(ncid, varname, var%data3D, lstat, map = map, & & ncvarid = varid, error_data = error) else call read_var_double_3D(ncid, varname, var%data3D, lstat, & & ncvarid = varid, error_data = error) end if else if (associated(var%data4D)) then if (present(start) .and. present(count) .and. present(map)) then call read_var_double_4D(ncid, varname, var%data4D, lstat, & & start = start, count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(count)) then call read_var_double_4D(ncid, varname, var%data4D, lstat, & & start = start, count = count, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(map)) then call read_var_double_4D(ncid, varname, var%data4D, lstat, & & start = start, map = map, & & ncvarid = varid, error_data = error) else if (present(count) .and. present(map)) then call read_var_double_4D(ncid, varname, var%data4D, lstat, & & count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start)) then call read_var_double_4D(ncid, varname, var%data4D, lstat, start = start, & & ncvarid = varid, error_data = error) else if (present(count)) then call read_var_double_4D(ncid, varname, var%data4D, lstat, count = count, & & ncvarid = varid, error_data = error) else if (present(map)) then call read_var_double_4D(ncid, varname, var%data4D, lstat, map = map, & & ncvarid = varid, error_data = error) else call read_var_double_4D(ncid, varname, var%data4D, lstat, & & ncvarid = varid, error_data = error) end if else if (associated(var%data5D)) then if (present(start) .and. present(count) .and. present(map)) then call read_var_double_5D(ncid, varname, var%data5D, lstat, & & start = start, count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(count)) then call read_var_double_5D(ncid, varname, var%data5D, lstat, & & start = start, count = count, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(map)) then call read_var_double_5D(ncid, varname, var%data5D, lstat, & & start = start, map = map, & & ncvarid = varid, error_data = error) else if (present(count) .and. present(map)) then call read_var_double_5D(ncid, varname, var%data5D, lstat, & & count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start)) then call read_var_double_5D(ncid, varname, var%data5D, lstat, start = start, & & ncvarid = varid, error_data = error) else if (present(count)) then call read_var_double_5D(ncid, varname, var%data5D, lstat, count = count, & & ncvarid = varid, error_data = error) else if (present(map)) then call read_var_double_5D(ncid, varname, var%data5D, lstat, map = map, & & ncvarid = varid, error_data = error) else call read_var_double_5D(ncid, varname, var%data5D, lstat, & & ncvarid = varid, error_data = error) end if else if (associated(var%data6D)) then if (present(start) .and. present(count) .and. present(map)) then call read_var_double_6D(ncid, varname, var%data6D, lstat, & & start = start, count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(count)) then call read_var_double_6D(ncid, varname, var%data6D, lstat, & & start = start, count = count, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(map)) then call read_var_double_6D(ncid, varname, var%data6D, lstat, & & start = start, map = map, & & ncvarid = varid, error_data = error) else if (present(count) .and. present(map)) then call read_var_double_6D(ncid, varname, var%data6D, lstat, & & count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start)) then call read_var_double_6D(ncid, varname, var%data6D, lstat, start = start, & & ncvarid = varid, error_data = error) else if (present(count)) then call read_var_double_6D(ncid, varname, var%data6D, lstat, count = count, & & ncvarid = varid, error_data = error) else if (present(map)) then call read_var_double_6D(ncid, varname, var%data6D, lstat, map = map, & & ncvarid = varid, error_data = error) else call read_var_double_6D(ncid, varname, var%data6D, lstat, & & ncvarid = varid, error_data = error) end if else if (associated(var%data7D)) then if (present(start) .and. present(count) .and. present(map)) then call read_var_double_7D(ncid, varname, var%data7D, lstat, & & start = start, count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(count)) then call read_var_double_7D(ncid, varname, var%data7D, lstat, & & start = start, count = count, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(map)) then call read_var_double_7D(ncid, varname, var%data7D, lstat, & & start = start, map = map, & & ncvarid = varid, error_data = error) else if (present(count) .and. present(map)) then call read_var_double_7D(ncid, varname, var%data7D, lstat, & & count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start)) then call read_var_double_7D(ncid, varname, var%data7D, lstat, start = start, & & ncvarid = varid, error_data = error) else if (present(count)) then call read_var_double_7D(ncid, varname, var%data7D, lstat, count = count, & & ncvarid = varid, error_data = error) else if (present(map)) then call read_var_double_7D(ncid, varname, var%data7D, lstat, map = map, & & ncvarid = varid, error_data = error) else call read_var_double_7D(ncid, varname, var%data7D, lstat, & & ncvarid = varid, error_data = error) end if else write(err, "(A,F10.5)") "no data array associated" call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_ARG, me, & & tgtname = "var", errmess = err) lstat = .false. end if if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if if (present(ncvarid)) then ncvarid = varid end if end subroutine read_var_double_var ! Generic routine, documented in the module file. subroutine read_var_integer_var(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid character(len = *), intent(in) :: varname type(etsf_io_low_var_integer), intent(inout) :: var logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "read_var_integer_var" character(len = 80) :: err integer :: varid type(etsf_io_low_error) :: error if (associated(var%data1D)) then if (present(start) .and. present(count) .and. present(map)) then call read_var_integer_1D(ncid, varname, var%data1D, lstat, & & start = start, count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(count)) then call read_var_integer_1D(ncid, varname, var%data1D, lstat, & & start = start, count = count, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(map)) then call read_var_integer_1D(ncid, varname, var%data1D, lstat, & & start = start, map = map, & & ncvarid = varid, error_data = error) else if (present(count) .and. present(map)) then call read_var_integer_1D(ncid, varname, var%data1D, lstat, & & count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start)) then call read_var_integer_1D(ncid, varname, var%data1D, lstat, start = start, & & ncvarid = varid, error_data = error) else if (present(count)) then call read_var_integer_1D(ncid, varname, var%data1D, lstat, count = count, & & ncvarid = varid, error_data = error) else if (present(map)) then call read_var_integer_1D(ncid, varname, var%data1D, lstat, map = map, & & ncvarid = varid, error_data = error) else call read_var_integer_1D(ncid, varname, var%data1D, lstat, & & ncvarid = varid, error_data = error) end if else if (associated(var%data2D)) then if (present(start) .and. present(count) .and. present(map)) then call read_var_integer_2D(ncid, varname, var%data2D, lstat, & & start = start, count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(count)) then call read_var_integer_2D(ncid, varname, var%data2D, lstat, & & start = start, count = count, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(map)) then call read_var_integer_2D(ncid, varname, var%data2D, lstat, & & start = start, map = map, & & ncvarid = varid, error_data = error) else if (present(count) .and. present(map)) then call read_var_integer_2D(ncid, varname, var%data2D, lstat, & & count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start)) then call read_var_integer_2D(ncid, varname, var%data2D, lstat, start = start, & & ncvarid = varid, error_data = error) else if (present(count)) then call read_var_integer_2D(ncid, varname, var%data2D, lstat, count = count, & & ncvarid = varid, error_data = error) else if (present(map)) then call read_var_integer_2D(ncid, varname, var%data2D, lstat, map = map, & & ncvarid = varid, error_data = error) else call read_var_integer_2D(ncid, varname, var%data2D, lstat, & & ncvarid = varid, error_data = error) end if else if (associated(var%data3D)) then if (present(start) .and. present(count) .and. present(map)) then call read_var_integer_3D(ncid, varname, var%data3D, lstat, & & start = start, count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(count)) then call read_var_integer_3D(ncid, varname, var%data3D, lstat, & & start = start, count = count, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(map)) then call read_var_integer_3D(ncid, varname, var%data3D, lstat, & & start = start, map = map, & & ncvarid = varid, error_data = error) else if (present(count) .and. present(map)) then call read_var_integer_3D(ncid, varname, var%data3D, lstat, & & count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start)) then call read_var_integer_3D(ncid, varname, var%data3D, lstat, start = start, & & ncvarid = varid, error_data = error) else if (present(count)) then call read_var_integer_3D(ncid, varname, var%data3D, lstat, count = count, & & ncvarid = varid, error_data = error) else if (present(map)) then call read_var_integer_3D(ncid, varname, var%data3D, lstat, map = map, & & ncvarid = varid, error_data = error) else call read_var_integer_3D(ncid, varname, var%data3D, lstat, & & ncvarid = varid, error_data = error) end if else if (associated(var%data4D)) then if (present(start) .and. present(count) .and. present(map)) then call read_var_integer_4D(ncid, varname, var%data4D, lstat, & & start = start, count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(count)) then call read_var_integer_4D(ncid, varname, var%data4D, lstat, & & start = start, count = count, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(map)) then call read_var_integer_4D(ncid, varname, var%data4D, lstat, & & start = start, map = map, & & ncvarid = varid, error_data = error) else if (present(count) .and. present(map)) then call read_var_integer_4D(ncid, varname, var%data4D, lstat, & & count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start)) then call read_var_integer_4D(ncid, varname, var%data4D, lstat, start = start, & & ncvarid = varid, error_data = error) else if (present(count)) then call read_var_integer_4D(ncid, varname, var%data4D, lstat, count = count, & & ncvarid = varid, error_data = error) else if (present(map)) then call read_var_integer_4D(ncid, varname, var%data4D, lstat, map = map, & & ncvarid = varid, error_data = error) else call read_var_integer_4D(ncid, varname, var%data4D, lstat, & & ncvarid = varid, error_data = error) end if else if (associated(var%data5D)) then if (present(start) .and. present(count) .and. present(map)) then call read_var_integer_5D(ncid, varname, var%data5D, lstat, & & start = start, count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(count)) then call read_var_integer_5D(ncid, varname, var%data5D, lstat, & & start = start, count = count, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(map)) then call read_var_integer_5D(ncid, varname, var%data5D, lstat, & & start = start, map = map, & & ncvarid = varid, error_data = error) else if (present(count) .and. present(map)) then call read_var_integer_5D(ncid, varname, var%data5D, lstat, & & count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start)) then call read_var_integer_5D(ncid, varname, var%data5D, lstat, start = start, & & ncvarid = varid, error_data = error) else if (present(count)) then call read_var_integer_5D(ncid, varname, var%data5D, lstat, count = count, & & ncvarid = varid, error_data = error) else if (present(map)) then call read_var_integer_5D(ncid, varname, var%data5D, lstat, map = map, & & ncvarid = varid, error_data = error) else call read_var_integer_5D(ncid, varname, var%data5D, lstat, & & ncvarid = varid, error_data = error) end if else if (associated(var%data6D)) then if (present(start) .and. present(count) .and. present(map)) then call read_var_integer_6D(ncid, varname, var%data6D, lstat, & & start = start, count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(count)) then call read_var_integer_6D(ncid, varname, var%data6D, lstat, & & start = start, count = count, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(map)) then call read_var_integer_6D(ncid, varname, var%data6D, lstat, & & start = start, map = map, & & ncvarid = varid, error_data = error) else if (present(count) .and. present(map)) then call read_var_integer_6D(ncid, varname, var%data6D, lstat, & & count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start)) then call read_var_integer_6D(ncid, varname, var%data6D, lstat, start = start, & & ncvarid = varid, error_data = error) else if (present(count)) then call read_var_integer_6D(ncid, varname, var%data6D, lstat, count = count, & & ncvarid = varid, error_data = error) else if (present(map)) then call read_var_integer_6D(ncid, varname, var%data6D, lstat, map = map, & & ncvarid = varid, error_data = error) else call read_var_integer_6D(ncid, varname, var%data6D, lstat, & & ncvarid = varid, error_data = error) end if else if (associated(var%data7D)) then if (present(start) .and. present(count) .and. present(map)) then call read_var_integer_7D(ncid, varname, var%data7D, lstat, & & start = start, count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(count)) then call read_var_integer_7D(ncid, varname, var%data7D, lstat, & & start = start, count = count, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(map)) then call read_var_integer_7D(ncid, varname, var%data7D, lstat, & & start = start, map = map, & & ncvarid = varid, error_data = error) else if (present(count) .and. present(map)) then call read_var_integer_7D(ncid, varname, var%data7D, lstat, & & count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start)) then call read_var_integer_7D(ncid, varname, var%data7D, lstat, start = start, & & ncvarid = varid, error_data = error) else if (present(count)) then call read_var_integer_7D(ncid, varname, var%data7D, lstat, count = count, & & ncvarid = varid, error_data = error) else if (present(map)) then call read_var_integer_7D(ncid, varname, var%data7D, lstat, map = map, & & ncvarid = varid, error_data = error) else call read_var_integer_7D(ncid, varname, var%data7D, lstat, & & ncvarid = varid, error_data = error) end if else write(err, "(A,F10.5)") "no data array associated" call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_ARG, me, & & tgtname = "var", errmess = err) lstat = .false. end if if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if if (present(ncvarid)) then ncvarid = varid end if end subroutine read_var_integer_var etsf_io-1.0.3/src/low_level/write_routines.f900000644000353400050630000015062610657022237016266 00000000000000 !!****m* etsf_io_low_file_group/etsf_io_low_open_create !! NAME !! etsf_io_low_open_create !! !! FUNCTION !! This method is used to open a NetCDF file. The file should not already exist. !! The ETSF header for the created file is automatically added by this method. !! When finished, the file handled by @ncid, is in define mode, which means !! that dimensions (see etsf_io_low_write_dim()), variables (see !! etsf_io_low_def_var()) and attributes (see etsf_io_low_write_att()) can be defined. !! To use etsf_io_low_write_var(), the file should be switched to data mode using !! etsf_io_low_set_write_mode(). !! !! If title or history are given and are too long, they will be truncated. !! !! If one wants to modify an already existing file, one should use !! etsf_io_low_open_modify() instead. !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * filename = the path to the file to open. !! * version = the number of version to be created. !! * title = (optional) a title for the file (80 characters max). !! * history = (optional) the first line of history (1024 characters max). !! * with_etsf_header = (optional) if true, will create a header !! as defined in the ETSF specifications (default is .true.). !! When value is .false., arguments title, history and version !! are ignored. !! * overwrite = (optional) if true, an existing file with the same name as @filename !! would be overwritten. Default is .false., which means that an IO !! error is raised if a file already exists. !! !! OUTPUT !! * ncid = the NetCDF handler, opened with write access (define mode). !! * lstat = .true. if operation succeed. !! * error_data = (optional) location to store error data. !! !! SOURCE subroutine etsf_io_low_open_create(ncid, filename, version, lstat, & & title, history, error_data, with_etsf_header, & & overwrite) integer, intent(out) :: ncid character(len = *), intent(in) :: filename real, intent(in) :: version logical, intent(out) :: lstat character(len = *), intent(in), optional :: title character(len = *), intent(in), optional :: history type(etsf_io_low_error), intent(out), optional :: error_data logical, intent(in), optional :: with_etsf_header logical, intent(in), optional :: overwrite !Local character(len = *), parameter :: me = "etsf_io_low_open_create" character(len = 256) :: err integer :: s, cmode logical :: stat lstat = .false. ! Checking that @version argument is valid. if (version < 1.0) then if (present(error_data)) then write(err, "(A,I0,A)") "Wrong version argument (given: ", version, " ; awaited >= 1.0)" call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ATT, me, & & tgtname = "file_format_version", errmess = err) end if return end if ! Open file for writing cmode = NF90_NOCLOBBER if (present(overwrite)) then if (overwrite) then cmode = NF90_CLOBBER end if end if ! We don't use the 64bits flag since the specifications advice ! to split huge quantities of data into several smaller files. s = nf90_create(path = filename, cmode = cmode, ncid = ncid) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_IO, ERROR_TYPE_OWR, & & me, tgtname = filename, errid = s, errmess = nf90_strerror(s)) end if return end if ! From now on the file is open. If an error occur, ! we should close it. ! We create the header if required. if (present(with_etsf_header)) then if (.not. with_etsf_header) then lstat = .true. return end if end if ! The file format s = nf90_put_att(ncid, NF90_GLOBAL, "file_format", etsf_io_low_file_format) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_PUT, ERROR_TYPE_ATT, & & me, tgtname = "file_format", errid = s, errmess = nf90_strerror(s)) end if call etsf_io_low_close(ncid, stat) return end if ! The version s = nf90_put_att(ncid, NF90_GLOBAL, "file_format_version", version) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_PUT, ERROR_TYPE_ATT, me, & & tgtname = "file_format_version", errid = s, errmess = nf90_strerror(s)) end if call etsf_io_low_close(ncid, stat) return end if ! The conventions s = nf90_put_att(ncid, NF90_GLOBAL, "Conventions", etsf_io_low_conventions) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_PUT, ERROR_TYPE_ATT, me, & & tgtname = "Conventions", errid = s, errmess = nf90_strerror(s)) end if call etsf_io_low_close(ncid, stat) return end if ! The title if present if (present(title)) then s = nf90_put_att(ncid, NF90_GLOBAL, "title", title(1:min(80, len(title)))) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_PUT, ERROR_TYPE_ATT, & & me, tgtname = "title", errid = s, errmess = nf90_strerror(s)) end if call etsf_io_low_close(ncid, stat) return end if end if ! The history if present if (present(history)) then s = nf90_put_att(ncid, NF90_GLOBAL, "history", history(1:min(1024, len(history)))) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_PUT, ERROR_TYPE_ATT, & & me, tgtname = "history", errid = s, errmess = nf90_strerror(s)) end if call etsf_io_low_close(ncid, stat) return end if end if lstat = .true. end subroutine etsf_io_low_open_create !!*** !!****m* etsf_io_low_file_group/etsf_io_low_open_modify !! NAME !! etsf_io_low_open_modify !! !! FUNCTION !! This method is used to open a NetCDF file for modifications. The file should !! already exist and have a valid ETSF header (if @with_etsf_header is not set to !! .false.). !! !! When finished, the file handled by @ncid, is in define mode, which means !! that dimensions (see etsf_io_low_write_dim()), variables (see !! etsf_io_low_def_var()) and attributes (see etsf_io_low_write_att()) can be defined. !! To use etsf_io_low_write_var(), the file should be switched to data mode using !! etsf_io_low_set_write_mode(). !! !! If title or history are given and are too long, they will be truncated. Moreover !! the given history is appended to the already existing history (if enough !! place exists). !! !! If one wants to create a new file, one should use etsf_io_low_open_create() instead. !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * filename = the path to the file to open. !! * title = (optional) a title for the file (80 characters max). !! * history = (optional) the first line of history (1024 characters max). !! * version = (optional) the number of version to be changed (>= 1.0). !! !! OUTPUT !! * ncid = the NetCDF handler, opened with write access (define mode). !! * lstat = .true. if operation succeed. !! * error_data = (optional) location to store error data. !! * with_etsf_header = (optional) if true, will check that there is a header !! as defined in the ETSF specifications (default is .true.). !! !! SOURCE subroutine etsf_io_low_open_modify(ncid, filename, lstat, & & title, history, version, error_data, with_etsf_header) integer, intent(out) :: ncid character(len = *), intent(in) :: filename logical, intent(out) :: lstat character(len = *), intent(in), optional :: title character(len = *), intent(in), optional :: history real, intent(in), optional :: version type(etsf_io_low_error), intent(out), optional :: error_data logical, intent(in), optional :: with_etsf_header !Local character(len = *), parameter :: me = "etsf_io_low_open_modify" character(len = 256) :: err character(len = 1024) :: current_history integer :: s logical :: stat logical :: my_with_etsf_header lstat = .false. ! Checking that @version argument is valid. if (present(version)) then if (version < 1.0) then if (present(error_data)) then write(err, "(A,I0,A)") "Wrong version argument (given: ", version, " ; awaited >= 1.0)" call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ATT, & & me, tgtname = "file_format_version", errmess = err) end if return end if end if ! Open file for writing s = nf90_open(path = filename, mode = NF90_WRITE, ncid = ncid) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_IO, ERROR_TYPE_OWR, & & me, tgtname = filename, errid = s, errmess = nf90_strerror(s)) end if return end if ! From now on the file is open. If an error occur, ! we should close it. ! Before according access to modifications, we check ! that the header is valid. if (present(with_etsf_header)) then my_with_etsf_header = with_etsf_header else my_with_etsf_header = .true. end if if (my_with_etsf_header) then if (present(error_data)) then call etsf_io_low_check_header(ncid, stat, error_data = error_data) if (.not. stat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_check_header(ncid, stat) end if if (.not. stat) then call etsf_io_low_close(ncid, stat) return end if end if ! We switch to define mode to set attributes. if (present(error_data)) then call etsf_io_low_set_define_mode(ncid, stat, error_data = error_data) if (.not. stat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_set_define_mode(ncid, stat) end if if (.not. stat) then call etsf_io_low_close(ncid, stat) return end if if (.not. my_with_etsf_header) then lstat = .true. return end if ! If a title is given, we change it. if (present(title)) then s = nf90_put_att(ncid, NF90_GLOBAL, "title", title(1:min(80, len(title)))) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_PUT, & & ERROR_TYPE_ATT, me, tgtname = "title", & & errid = s, errmess = nf90_strerror(s)) end if call etsf_io_low_close(ncid, stat) return end if end if ! If a new version is given, we change it. if (present(version)) then s = nf90_put_att(ncid, NF90_GLOBAL, "file_format_version", version) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_PUT, ERROR_TYPE_ATT, me, & & tgtname = "file_format_version", & & errid = s, errmess = nf90_strerror(s)) end if call etsf_io_low_close(ncid, stat) return end if end if ! If an history value is given, we append it. if (present(history)) then call etsf_io_low_read_att(ncid, NF90_GLOBAL, "history", 1024, & & current_history, stat) if (stat) then ! appending mode if (len(trim(current_history)) + len(history) < 1024) then current_history = trim(current_history) // char(10) // history end if else ! overwriting mode current_history = history end if s = nf90_put_att(ncid, NF90_GLOBAL, "history", current_history) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_PUT, ERROR_TYPE_ATT, me, & & tgtname = "history", & & errid = s, errmess = nf90_strerror(s)) end if call etsf_io_low_close(ncid, stat) return end if end if lstat = .true. end subroutine etsf_io_low_open_modify !!*** !!****m* etsf_io_low_write_group/etsf_io_low_write_dim !! NAME !! etsf_io_low_write_dim !! !! FUNCTION !! This method is a wraper add a dimension to a NetCDF file. As in pure NetCDF !! calls, overwriting a value is not permitted. Nevertheless, the method returns !! .true. in @lstat, if the dimension already exists and has the same value. !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = a NetCDF handler, opened with write access (define mode). !! * dimname = a string identifying a dimension. !! * dimvalue = a positive integer which is the length of the dimension. !! !! OUTPUT !! * lstat = .true. if operation succeed. !! * ncdimid = (optional) the id used by NetCDF to identify the written dimension. !! * error_data = (optional) location to store error data. !! !! SOURCE subroutine etsf_io_low_write_dim(ncid, dimname, dimvalue, lstat, ncdimid, error_data) integer, intent(in) :: ncid character(len = *), intent(in) :: dimname integer, intent(in) :: dimvalue logical, intent(out) :: lstat integer, intent(out), optional :: ncdimid type(etsf_io_low_error), intent(out), optional :: error_data ! Local character(len = *), parameter :: me = "etsf_io_low_write_dim" character(len = 500) :: message integer :: s, dimid, readvalue ! Check if dimension already exists. call etsf_io_low_read_dim(ncid, dimname, readvalue, lstat) if (lstat) then ! Dimension already exists. if (readvalue /= dimvalue) then ! Dimension differs, raise error. if (present(error_data)) then write(message, "(2A,I0,A,I0,A)") "dimension already exists with a different", & & " value (read = ", readvalue, " ; write = ", & & dimvalue, ")." call etsf_io_low_error_set(error_data, ERROR_MODE_DEF, ERROR_TYPE_DIM, me, & & tgtname = dimname, errmess = message) end if lstat = .false. return else ! Dimension matches, return. return end if end if ! Define dimension since it don't already exist. lstat = .false. s = nf90_def_dim(ncid, dimname, dimvalue, dimid) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_DEF, ERROR_TYPE_DIM, me, & & tgtname = dimname, errid = s, errmess = nf90_strerror(s)) end if return end if if (present(ncdimid)) then ncdimid = dimid end if lstat = .true. end subroutine etsf_io_low_write_dim !!*** ! Interfaced routine: ! See etsf_io_low_level.f90 for documentation subroutine etsf_io_low_def_var_0D(ncid, varname, vartype, lstat, ncvarid, error_data) integer, intent(in) :: ncid character(len = *), intent(in) :: varname integer, intent(in) :: vartype logical, intent(out) :: lstat integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data ! Local character(len = *), parameter :: me = "etsf_io_low_def_var_0D" type(etsf_io_low_var_infos) :: var_infos integer :: s, varid ! We put a default value. if (present(ncvarid)) then ncvarid = -1 end if lstat = .false. ! Check if dimension already exists. call etsf_io_low_read_var_infos(ncid, varname, var_infos, lstat) if (lstat) then ! Variable already exists. lstat = (var_infos%nctype == vartype .and. var_infos%ncshape == 0) if (.not. lstat) then ! Variable differs, raise error. if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_DEF, ERROR_TYPE_VAR, me, & & tgtname = varname, errmess = & & "variable already exists with a different definition.") end if lstat = .false. return else ! Dimension matches, return. return end if end if ! Define variable since it don't already exist. lstat = .false. ! Special case where dimension is null s = nf90_def_var(ncid, varname, vartype, varid) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_DEF, ERROR_TYPE_VAR, me, & & tgtname = varname, errid = s, errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = varid end if lstat = .true. end subroutine etsf_io_low_def_var_0D ! Interfaced routine: ! See etsf_io_low_level.f90 for documentation subroutine etsf_io_low_def_var_nD(ncid, varname, vartype, vardims, lstat, ncvarid, error_data) integer, intent(in) :: ncid character(len = *), intent(in) :: varname integer, intent(in) :: vartype character(len = *), intent(in) :: vardims(:) logical, intent(out) :: lstat integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data ! Local character(len = *), parameter :: me = "etsf_io_low_def_var_nD" type(etsf_io_low_var_infos) :: var_infos integer :: s, varid, ndims, i integer, allocatable :: ncdims(:, :) logical :: stat ! We put a default value. if (present(ncvarid)) then ncvarid = -1 end if lstat = .false. ! The dimension are given by their names, we must first fetch them. ndims = size(vardims) allocate(ncdims(0:1, 1:ndims)) do i = 1, ndims, 1 if (present(error_data)) then call etsf_io_low_read_dim(ncid, trim(vardims(i)), ncdims(0, i), & & stat, ncdimid = ncdims(1, i), error_data = error_data) if (.not. stat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_read_dim(ncid, trim(vardims(i)), ncdims(0, i), & & stat, ncdimid = ncdims(1, i)) end if if (.not. stat) then deallocate(ncdims) return end if end do ! Check if dimension already exists. call etsf_io_low_read_var_infos(ncid, varname, var_infos, lstat) if (lstat) then ! Variable already exists. lstat = (var_infos%nctype == vartype .and. var_infos%ncshape == ndims) do i = 1, min(var_infos%ncshape, ndims), 1 lstat = lstat .and. (ncdims(0, i) == var_infos%ncdims(i)) end do if (.not. lstat) then ! Variable differs, raise error. if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_DEF, ERROR_TYPE_VAR, me, & & tgtname = varname, errmess = & & "variable already exists with a different definition.") end if end if deallocate(ncdims) return end if ! Define variable since it don't already exist. s = nf90_def_var(ncid, varname, vartype, ncdims(1, :), varid) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_DEF, ERROR_TYPE_VAR, me, & & tgtname = varname, errid = s, errmess = nf90_strerror(s)) end if deallocate(ncdims) return end if deallocate(ncdims) if (present(ncvarid)) then ncvarid = varid end if lstat = .true. end subroutine etsf_io_low_def_var_nD !!****m* etsf_io_low_write_group/etsf_io_low_copy_all_att !! NAME !! etsf_io_low_copy_all_att !! !! FUNCTION !! Copy all attributes from the given variable of the given file to an other !! variable (of a different file, but not necessary). The variable ids from and to !! can be either valid variables or etsf_io_low_global_att. !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid_from = a NetCDF handler, opened with read access. !! * ncid_to = a NetCDF handler, opened with write access. !! * ncvarid_from = a NetCDF variable id with attributes to copy. !! * ncvarid_to = a NetCDF variable id to copy the attributes to. !! !! OUTPUT !! * lstat = .true. if the file has been read without error. !! * error_data = (optional) location to store error data. !! !! !! SOURCE subroutine etsf_io_low_copy_all_att(ncid_from, ncid_to, ncvarid_from, & & ncvarid_to, lstat, error_data) integer, intent(in) :: ncid_from, ncid_to integer, intent(in) :: ncvarid_from, ncvarid_to logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data character(len = *), parameter :: me = "etsf_io_low_copy_all_att" type(etsf_io_low_var_infos) :: var_infos integer :: i, s, n character(len = NF90_MAX_NAME) :: ncname lstat = .true. if (ncvarid_from /= etsf_io_low_global_att) then if (present(error_data)) then call read_var_infos_id(ncid_from, ncvarid_from, var_infos, lstat, & & error_data = error_data, dim_name = .false., att_name = .true.) if (.not. lstat) call etsf_io_low_error_update(error_data, me) else call read_var_infos_id(ncid_from, ncvarid_from, var_infos, lstat, & & dim_name = .false., att_name = .true.) end if if (.not. lstat) return else s = nf90_inquire(ncid_from, nAttributes = n) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_INQ, ERROR_TYPE_ATT, & & me, tgtname = "global attributes", errid = s, & & errmess = nf90_strerror(s)) end if lstat = .false. return end if if (n > 0) then allocate(var_infos%ncattnames(1:n)) do i = 1, n, 1 s = nf90_inq_attname(ncid_from, etsf_io_low_global_att, i, ncname) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_INQ, & & ERROR_TYPE_ATT, me, tgtid = i, errid = s, & & errmess = nf90_strerror(s)) end if call etsf_io_low_free_var_infos(var_infos) lstat = .false. return end if write(var_infos%ncattnames(i), "(A)") ncname(1:min(80, len(ncname))) end do end if end if if (associated(var_infos%ncattnames)) then do i = 1, size(var_infos%ncattnames, 1), 1 s = nf90_copy_att(ncid_from, ncvarid_from, trim(var_infos%ncattnames(i)), & & ncid_to, ncvarid_to) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_COPY, ERROR_TYPE_ATT, & & me, tgtname = trim(var_infos%ncattnames(i)), errid = s, & & errmess = nf90_strerror(s)) end if lstat = .false. exit end if end do end if call etsf_io_low_free_var_infos(var_infos) end subroutine etsf_io_low_copy_all_att !!*** ! Generic routine, documented in the module file. subroutine write_var_double_var(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid character(len = *), intent(in) :: varname type(etsf_io_low_var_double), intent(in) :: var logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_var_double_var" integer :: varid type(etsf_io_low_error) :: error if (associated(var%data1D)) then if (present(start) .and. present(count) .and. present(map)) then call write_var_double_1D(ncid, varname, var%data1D, lstat, & & start = start, count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(count)) then call write_var_double_1D(ncid, varname, var%data1D, lstat, & & start = start, count = count, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(map)) then call write_var_double_1D(ncid, varname, var%data1D, lstat, & & start = start, map = map, & & ncvarid = varid, error_data = error) else if (present(count) .and. present(map)) then call write_var_double_1D(ncid, varname, var%data1D, lstat, & & count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start)) then call write_var_double_1D(ncid, varname, var%data1D, lstat, start = start, & & ncvarid = varid, error_data = error) else if (present(count)) then call write_var_double_1D(ncid, varname, var%data1D, lstat, count = count, & & ncvarid = varid, error_data = error) else if (present(map)) then call write_var_double_1D(ncid, varname, var%data1D, lstat, map = map, & & ncvarid = varid, error_data = error) else call write_var_double_1D(ncid, varname, var%data1D, lstat, & & ncvarid = varid, error_data = error) end if else if (associated(var%data2D)) then if (present(start) .and. present(count) .and. present(map)) then call write_var_double_2D(ncid, varname, var%data2D, lstat, & & start = start, count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(count)) then call write_var_double_2D(ncid, varname, var%data2D, lstat, & & start = start, count = count, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(map)) then call write_var_double_2D(ncid, varname, var%data2D, lstat, & & start = start, map = map, & & ncvarid = varid, error_data = error) else if (present(count) .and. present(map)) then call write_var_double_2D(ncid, varname, var%data2D, lstat, & & count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start)) then call write_var_double_2D(ncid, varname, var%data2D, lstat, start = start, & & ncvarid = varid, error_data = error) else if (present(count)) then call write_var_double_2D(ncid, varname, var%data2D, lstat, count = count, & & ncvarid = varid, error_data = error) else if (present(map)) then call write_var_double_2D(ncid, varname, var%data2D, lstat, map = map, & & ncvarid = varid, error_data = error) else call write_var_double_2D(ncid, varname, var%data2D, lstat, & & ncvarid = varid, error_data = error) end if else if (associated(var%data3D)) then if (present(start) .and. present(count) .and. present(map)) then call write_var_double_3D(ncid, varname, var%data3D, lstat, & & start = start, count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(count)) then call write_var_double_3D(ncid, varname, var%data3D, lstat, & & start = start, count = count, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(map)) then call write_var_double_3D(ncid, varname, var%data3D, lstat, & & start = start, map = map, & & ncvarid = varid, error_data = error) else if (present(count) .and. present(map)) then call write_var_double_3D(ncid, varname, var%data3D, lstat, & & count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start)) then call write_var_double_3D(ncid, varname, var%data3D, lstat, start = start, & & ncvarid = varid, error_data = error) else if (present(count)) then call write_var_double_3D(ncid, varname, var%data3D, lstat, count = count, & & ncvarid = varid, error_data = error) else if (present(map)) then call write_var_double_3D(ncid, varname, var%data3D, lstat, map = map, & & ncvarid = varid, error_data = error) else call write_var_double_3D(ncid, varname, var%data3D, lstat, & & ncvarid = varid, error_data = error) end if else if (associated(var%data4D)) then if (present(start) .and. present(count) .and. present(map)) then call write_var_double_4D(ncid, varname, var%data4D, lstat, & & start = start, count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(count)) then call write_var_double_4D(ncid, varname, var%data4D, lstat, & & start = start, count = count, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(map)) then call write_var_double_4D(ncid, varname, var%data4D, lstat, & & start = start, map = map, & & ncvarid = varid, error_data = error) else if (present(count) .and. present(map)) then call write_var_double_4D(ncid, varname, var%data4D, lstat, & & count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start)) then call write_var_double_4D(ncid, varname, var%data4D, lstat, start = start, & & ncvarid = varid, error_data = error) else if (present(count)) then call write_var_double_4D(ncid, varname, var%data4D, lstat, count = count, & & ncvarid = varid, error_data = error) else if (present(map)) then call write_var_double_4D(ncid, varname, var%data4D, lstat, map = map, & & ncvarid = varid, error_data = error) else call write_var_double_4D(ncid, varname, var%data4D, lstat, & & ncvarid = varid, error_data = error) end if else if (associated(var%data5D)) then if (present(start) .and. present(count) .and. present(map)) then call write_var_double_5D(ncid, varname, var%data5D, lstat, & & start = start, count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(count)) then call write_var_double_5D(ncid, varname, var%data5D, lstat, & & start = start, count = count, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(map)) then call write_var_double_5D(ncid, varname, var%data5D, lstat, & & start = start, map = map, & & ncvarid = varid, error_data = error) else if (present(count) .and. present(map)) then call write_var_double_5D(ncid, varname, var%data5D, lstat, & & count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start)) then call write_var_double_5D(ncid, varname, var%data5D, lstat, start = start, & & ncvarid = varid, error_data = error) else if (present(count)) then call write_var_double_5D(ncid, varname, var%data5D, lstat, count = count, & & ncvarid = varid, error_data = error) else if (present(map)) then call write_var_double_5D(ncid, varname, var%data5D, lstat, map = map, & & ncvarid = varid, error_data = error) else call write_var_double_5D(ncid, varname, var%data5D, lstat, & & ncvarid = varid, error_data = error) end if else if (associated(var%data6D)) then if (present(start) .and. present(count) .and. present(map)) then call write_var_double_6D(ncid, varname, var%data6D, lstat, & & start = start, count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(count)) then call write_var_double_6D(ncid, varname, var%data6D, lstat, & & start = start, count = count, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(map)) then call write_var_double_6D(ncid, varname, var%data6D, lstat, & & start = start, map = map, & & ncvarid = varid, error_data = error) else if (present(count) .and. present(map)) then call write_var_double_6D(ncid, varname, var%data6D, lstat, & & count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start)) then call write_var_double_6D(ncid, varname, var%data6D, lstat, start = start, & & ncvarid = varid, error_data = error) else if (present(count)) then call write_var_double_6D(ncid, varname, var%data6D, lstat, count = count, & & ncvarid = varid, error_data = error) else if (present(map)) then call write_var_double_6D(ncid, varname, var%data6D, lstat, map = map, & & ncvarid = varid, error_data = error) else call write_var_double_6D(ncid, varname, var%data6D, lstat, & & ncvarid = varid, error_data = error) end if else if (associated(var%data7D)) then if (present(start) .and. present(count) .and. present(map)) then call write_var_double_7D(ncid, varname, var%data7D, lstat, & & start = start, count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(count)) then call write_var_double_7D(ncid, varname, var%data7D, lstat, & & start = start, count = count, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(map)) then call write_var_double_7D(ncid, varname, var%data7D, lstat, & & start = start, map = map, & & ncvarid = varid, error_data = error) else if (present(count) .and. present(map)) then call write_var_double_7D(ncid, varname, var%data7D, lstat, & & count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start)) then call write_var_double_7D(ncid, varname, var%data7D, lstat, start = start, & & ncvarid = varid, error_data = error) else if (present(count)) then call write_var_double_7D(ncid, varname, var%data7D, lstat, count = count, & & ncvarid = varid, error_data = error) else if (present(map)) then call write_var_double_7D(ncid, varname, var%data7D, lstat, map = map, & & ncvarid = varid, error_data = error) else call write_var_double_7D(ncid, varname, var%data7D, lstat, & & ncvarid = varid, error_data = error) end if else call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_ARG, me, & & tgtname = "var", errmess = "no data array associated") lstat = .false. end if if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if if (present(ncvarid)) then ncvarid = varid end if end subroutine write_var_double_var ! Generic routine, documented in the module file. subroutine write_var_integer_var(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid character(len = *), intent(in) :: varname type(etsf_io_low_var_integer), intent(in) :: var logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_var_integer_var" integer :: varid type(etsf_io_low_error) :: error if (associated(var%data1D)) then if (present(start) .and. present(count) .and. present(map)) then call write_var_integer_1D(ncid, varname, var%data1D, lstat, & & start = start, count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(count)) then call write_var_integer_1D(ncid, varname, var%data1D, lstat, & & start = start, count = count, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(map)) then call write_var_integer_1D(ncid, varname, var%data1D, lstat, & & start = start, map = map, & & ncvarid = varid, error_data = error) else if (present(count) .and. present(map)) then call write_var_integer_1D(ncid, varname, var%data1D, lstat, & & count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start)) then call write_var_integer_1D(ncid, varname, var%data1D, lstat, start = start, & & ncvarid = varid, error_data = error) else if (present(count)) then call write_var_integer_1D(ncid, varname, var%data1D, lstat, count = count, & & ncvarid = varid, error_data = error) else if (present(map)) then call write_var_integer_1D(ncid, varname, var%data1D, lstat, map = map, & & ncvarid = varid, error_data = error) else call write_var_integer_1D(ncid, varname, var%data1D, lstat, & & ncvarid = varid, error_data = error) end if else if (associated(var%data2D)) then if (present(start) .and. present(count) .and. present(map)) then call write_var_integer_2D(ncid, varname, var%data2D, lstat, & & start = start, count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(count)) then call write_var_integer_2D(ncid, varname, var%data2D, lstat, & & start = start, count = count, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(map)) then call write_var_integer_2D(ncid, varname, var%data2D, lstat, & & start = start, map = map, & & ncvarid = varid, error_data = error) else if (present(count) .and. present(map)) then call write_var_integer_2D(ncid, varname, var%data2D, lstat, & & count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start)) then call write_var_integer_2D(ncid, varname, var%data2D, lstat, start = start, & & ncvarid = varid, error_data = error) else if (present(count)) then call write_var_integer_2D(ncid, varname, var%data2D, lstat, count = count, & & ncvarid = varid, error_data = error) else if (present(map)) then call write_var_integer_2D(ncid, varname, var%data2D, lstat, map = map, & & ncvarid = varid, error_data = error) else call write_var_integer_2D(ncid, varname, var%data2D, lstat, & & ncvarid = varid, error_data = error) end if else if (associated(var%data3D)) then if (present(start) .and. present(count) .and. present(map)) then call write_var_integer_3D(ncid, varname, var%data3D, lstat, & & start = start, count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(count)) then call write_var_integer_3D(ncid, varname, var%data3D, lstat, & & start = start, count = count, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(map)) then call write_var_integer_3D(ncid, varname, var%data3D, lstat, & & start = start, map = map, & & ncvarid = varid, error_data = error) else if (present(count) .and. present(map)) then call write_var_integer_3D(ncid, varname, var%data3D, lstat, & & count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start)) then call write_var_integer_3D(ncid, varname, var%data3D, lstat, start = start, & & ncvarid = varid, error_data = error) else if (present(count)) then call write_var_integer_3D(ncid, varname, var%data3D, lstat, count = count, & & ncvarid = varid, error_data = error) else if (present(map)) then call write_var_integer_3D(ncid, varname, var%data3D, lstat, map = map, & & ncvarid = varid, error_data = error) else call write_var_integer_3D(ncid, varname, var%data3D, lstat, & & ncvarid = varid, error_data = error) end if else if (associated(var%data4D)) then if (present(start) .and. present(count) .and. present(map)) then call write_var_integer_4D(ncid, varname, var%data4D, lstat, & & start = start, count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(count)) then call write_var_integer_4D(ncid, varname, var%data4D, lstat, & & start = start, count = count, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(map)) then call write_var_integer_4D(ncid, varname, var%data4D, lstat, & & start = start, map = map, & & ncvarid = varid, error_data = error) else if (present(count) .and. present(map)) then call write_var_integer_4D(ncid, varname, var%data4D, lstat, & & count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start)) then call write_var_integer_4D(ncid, varname, var%data4D, lstat, start = start, & & ncvarid = varid, error_data = error) else if (present(count)) then call write_var_integer_4D(ncid, varname, var%data4D, lstat, count = count, & & ncvarid = varid, error_data = error) else if (present(map)) then call write_var_integer_4D(ncid, varname, var%data4D, lstat, map = map, & & ncvarid = varid, error_data = error) else call write_var_integer_4D(ncid, varname, var%data4D, lstat, & & ncvarid = varid, error_data = error) end if else if (associated(var%data5D)) then if (present(start) .and. present(count) .and. present(map)) then call write_var_integer_5D(ncid, varname, var%data5D, lstat, & & start = start, count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(count)) then call write_var_integer_5D(ncid, varname, var%data5D, lstat, & & start = start, count = count, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(map)) then call write_var_integer_5D(ncid, varname, var%data5D, lstat, & & start = start, map = map, & & ncvarid = varid, error_data = error) else if (present(count) .and. present(map)) then call write_var_integer_5D(ncid, varname, var%data5D, lstat, & & count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start)) then call write_var_integer_5D(ncid, varname, var%data5D, lstat, start = start, & & ncvarid = varid, error_data = error) else if (present(count)) then call write_var_integer_5D(ncid, varname, var%data5D, lstat, count = count, & & ncvarid = varid, error_data = error) else if (present(map)) then call write_var_integer_5D(ncid, varname, var%data5D, lstat, map = map, & & ncvarid = varid, error_data = error) else call write_var_integer_5D(ncid, varname, var%data5D, lstat, & & ncvarid = varid, error_data = error) end if else if (associated(var%data6D)) then if (present(start) .and. present(count) .and. present(map)) then call write_var_integer_6D(ncid, varname, var%data6D, lstat, & & start = start, count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(count)) then call write_var_integer_6D(ncid, varname, var%data6D, lstat, & & start = start, count = count, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(map)) then call write_var_integer_6D(ncid, varname, var%data6D, lstat, & & start = start, map = map, & & ncvarid = varid, error_data = error) else if (present(count) .and. present(map)) then call write_var_integer_6D(ncid, varname, var%data6D, lstat, & & count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start)) then call write_var_integer_6D(ncid, varname, var%data6D, lstat, start = start, & & ncvarid = varid, error_data = error) else if (present(count)) then call write_var_integer_6D(ncid, varname, var%data6D, lstat, count = count, & & ncvarid = varid, error_data = error) else if (present(map)) then call write_var_integer_6D(ncid, varname, var%data6D, lstat, map = map, & & ncvarid = varid, error_data = error) else call write_var_integer_6D(ncid, varname, var%data6D, lstat, & & ncvarid = varid, error_data = error) end if else if (associated(var%data7D)) then if (present(start) .and. present(count) .and. present(map)) then call write_var_integer_7D(ncid, varname, var%data7D, lstat, & & start = start, count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(count)) then call write_var_integer_7D(ncid, varname, var%data7D, lstat, & & start = start, count = count, & & ncvarid = varid, error_data = error) else if (present(start) .and. present(map)) then call write_var_integer_7D(ncid, varname, var%data7D, lstat, & & start = start, map = map, & & ncvarid = varid, error_data = error) else if (present(count) .and. present(map)) then call write_var_integer_7D(ncid, varname, var%data7D, lstat, & & count = count, map = map, & & ncvarid = varid, error_data = error) else if (present(start)) then call write_var_integer_7D(ncid, varname, var%data7D, lstat, start = start, & & ncvarid = varid, error_data = error) else if (present(count)) then call write_var_integer_7D(ncid, varname, var%data7D, lstat, count = count, & & ncvarid = varid, error_data = error) else if (present(map)) then call write_var_integer_7D(ncid, varname, var%data7D, lstat, map = map, & & ncvarid = varid, error_data = error) else call write_var_integer_7D(ncid, varname, var%data7D, lstat, & & ncvarid = varid, error_data = error) end if else call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_ARG, me, & & tgtname = "var", errmess = "no data array associated") lstat = .false. end if if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if if (present(ncvarid)) then ncvarid = varid end if end subroutine write_var_integer_var etsf_io-1.0.3/src/low_level/write_routines_auto.f900000644000353400050630000036406511354150412017312 00000000000000!================================================================ ! WARNING! this file is autogenerated. All modifications should ! will be overwritten on next build. This file is automatically ! produced by the config/scripts/autogen_low_level.py. !================================================================ subroutine write_var_integer_0D(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid integer, intent(in) :: var character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_var_integer_0D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_INT var_user%ncshape = 0 !var_user%ncdims(1:0) = shape(var) !var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & ! & ,count = my_count(1:max(1, var_nc%ncshape)) & ! & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine write_var_integer_0D subroutine write_var_integer_1D(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid integer, intent(in) :: var(:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_var_integer_1D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_INT var_user%ncshape = 1 var_user%ncdims(1:1) = shape(var) !var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine write_var_integer_1D subroutine write_var_integer_2D(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid integer, intent(in) :: var(:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_var_integer_2D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_INT var_user%ncshape = 2 var_user%ncdims(1:2) = shape(var) !var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine write_var_integer_2D subroutine write_var_integer_3D(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid integer, intent(in) :: var(:,:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_var_integer_3D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_INT var_user%ncshape = 3 var_user%ncdims(1:3) = shape(var) !var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine write_var_integer_3D subroutine write_var_integer_4D(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid integer, intent(in) :: var(:,:,:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_var_integer_4D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_INT var_user%ncshape = 4 var_user%ncdims(1:4) = shape(var) !var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine write_var_integer_4D subroutine write_var_integer_5D(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid integer, intent(in) :: var(:,:,:,:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_var_integer_5D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_INT var_user%ncshape = 5 var_user%ncdims(1:5) = shape(var) !var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine write_var_integer_5D subroutine write_var_integer_6D(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid integer, intent(in) :: var(:,:,:,:,:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_var_integer_6D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_INT var_user%ncshape = 6 var_user%ncdims(1:6) = shape(var) !var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine write_var_integer_6D subroutine write_var_integer_7D(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid integer, intent(in) :: var(:,:,:,:,:,:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_var_integer_7D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_INT var_user%ncshape = 7 var_user%ncdims(1:7) = shape(var) !var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine write_var_integer_7D subroutine write_var_double_0D(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid double precision, intent(in) :: var character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_var_double_0D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_DOUBLE var_user%ncshape = 0 !var_user%ncdims(1:0) = shape(var) !var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & ! & ,count = my_count(1:max(1, var_nc%ncshape)) & ! & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine write_var_double_0D subroutine write_var_double_1D(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid double precision, intent(in) :: var(:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_var_double_1D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_DOUBLE var_user%ncshape = 1 var_user%ncdims(1:1) = shape(var) !var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine write_var_double_1D subroutine write_var_double_2D(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid double precision, intent(in) :: var(:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_var_double_2D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_DOUBLE var_user%ncshape = 2 var_user%ncdims(1:2) = shape(var) !var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine write_var_double_2D subroutine write_var_double_3D(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid double precision, intent(in) :: var(:,:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_var_double_3D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_DOUBLE var_user%ncshape = 3 var_user%ncdims(1:3) = shape(var) !var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine write_var_double_3D subroutine write_var_double_4D(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid double precision, intent(in) :: var(:,:,:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_var_double_4D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_DOUBLE var_user%ncshape = 4 var_user%ncdims(1:4) = shape(var) !var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine write_var_double_4D subroutine write_var_double_5D(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid double precision, intent(in) :: var(:,:,:,:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_var_double_5D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_DOUBLE var_user%ncshape = 5 var_user%ncdims(1:5) = shape(var) !var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine write_var_double_5D subroutine write_var_double_6D(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid double precision, intent(in) :: var(:,:,:,:,:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_var_double_6D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_DOUBLE var_user%ncshape = 6 var_user%ncdims(1:6) = shape(var) !var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine write_var_double_6D subroutine write_var_double_7D(ncid, varname, var, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid double precision, intent(in) :: var(:,:,:,:,:,:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_var_double_7D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_DOUBLE var_user%ncshape = 7 var_user%ncdims(1:7) = shape(var) !var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine write_var_double_7D subroutine write_var_character_1D(ncid, varname, var, charlen, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid, charlen character(len = charlen), intent(in) :: var character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_var_character_1D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_CHAR var_user%ncshape = 1 !var_user%ncdims(2:1) = shape(var) var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & ! & ,count = my_count(1:max(1, var_nc%ncshape)) & ! & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine write_var_character_1D subroutine write_var_character_2D(ncid, varname, var, charlen, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid, charlen character(len = charlen), intent(in) :: var(:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_var_character_2D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_CHAR var_user%ncshape = 2 var_user%ncdims(2:2) = shape(var) var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine write_var_character_2D subroutine write_var_character_3D(ncid, varname, var, charlen, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid, charlen character(len = charlen), intent(in) :: var(:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_var_character_3D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_CHAR var_user%ncshape = 3 var_user%ncdims(2:3) = shape(var) var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine write_var_character_3D subroutine write_var_character_4D(ncid, varname, var, charlen, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid, charlen character(len = charlen), intent(in) :: var(:,:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_var_character_4D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_CHAR var_user%ncshape = 4 var_user%ncdims(2:4) = shape(var) var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine write_var_character_4D subroutine write_var_character_5D(ncid, varname, var, charlen, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid, charlen character(len = charlen), intent(in) :: var(:,:,:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_var_character_5D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_CHAR var_user%ncshape = 5 var_user%ncdims(2:5) = shape(var) var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine write_var_character_5D subroutine write_var_character_6D(ncid, varname, var, charlen, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid, charlen character(len = charlen), intent(in) :: var(:,:,:,:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_var_character_6D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_CHAR var_user%ncshape = 6 var_user%ncdims(2:6) = shape(var) var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine write_var_character_6D subroutine write_var_character_7D(ncid, varname, var, charlen, lstat, & & start, count, map, ncvarid, error_data) integer, intent(in) :: ncid, charlen character(len = charlen), intent(in) :: var(:,:,:,:,:,:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat integer, intent(in), optional :: start(:), count(:), map(:) integer, intent(out), optional :: ncvarid type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_var_character_7D" character(len = 80) :: err type(etsf_io_low_var_infos) :: var_nc, var_user type(etsf_io_low_error) :: error integer :: s, i integer :: my_start(16), my_count(16), my_map(16) logical :: stat lstat = .false. ! We get the dimensions and shape of the ref variable in the NetCDF file. call etsf_io_low_read_var_infos(ncid, varname, var_nc, & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error call etsf_io_low_error_update(error_data, me) end if return end if var_user%name = varname var_user%nctype = NF90_CHAR var_user%ncshape = 7 var_user%ncdims(2:7) = shape(var) var_user%ncdims(1) = charlen ! Create the access arrays from optional arguments. if (present(start) .and. present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & opt_map = map, error_data = error) else if (present(start) .and. present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_count = count, & & error_data = error) else if (present(start) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, opt_map = map, & & error_data = error) else if (present(count) .and. present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, opt_map = map, & & error_data = error) else if (present(start)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_start = start, error_data = error) else if (present(count)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_count = count, error_data = error) else if (present(map)) then call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, stat, & & opt_map = map, error_data = error) else call etsf_io_low_make_access(my_start, my_count, my_map, var_nc, & & stat, error_data = error) end if if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Number of elements checks call etsf_io_low_check_var(var_nc, var_user, my_start(1:var_nc%ncshape), & & my_count(1:var_nc%ncshape), & & my_map(1:var_nc%ncshape), & & stat, error_data = error) if (.not. stat) then if (present(error_data)) then error_data = error if (.not. lstat) call etsf_io_low_error_update(error_data, me) end if return end if ! Now that we are sure that the read var has compatible type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_var(ncid, var_nc%ncid, values = var, & & start = my_start(1:max(1, var_nc%ncshape)) & & ,count = my_count(1:max(1, var_nc%ncshape)) & & ,map = my_map(1:max(1, var_nc%ncshape)) & & ) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_VAR, & & me, tgtname = varname, tgtid = var_nc%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if if (present(ncvarid)) then ncvarid = var_nc%ncid end if lstat = .true. end subroutine write_var_character_7D subroutine write_att_integer_0D(ncid, varname, attname, att, & & lstat, error_data) character(len = *), intent(in) :: varname !integer, intent(in) :: attlen integer, intent(in) :: att integer, intent(in) :: ncid character(len = *), intent(in) :: attname logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_att_integer_0D" integer :: s type(etsf_io_low_var_infos) :: var_infos lstat = .false. if (present(error_data)) then call etsf_io_low_read_var_infos(ncid, varname, var_infos, & & lstat, error_data = error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_read_var_infos(ncid, varname, var_infos, lstat) end if if (.not. lstat) return ! Now that we are sure that the read attribute has the same type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_att(ncid, var_infos%ncid, attname, att) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_ATT, & & me, tgtname = attname, tgtid = var_infos%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if lstat = .true. end subroutine write_att_integer_0D subroutine write_att_id_integer_0D(ncid, ncvarid, attname, att, & & lstat, error_data) integer, intent(in) :: ncvarid !integer, intent(in) :: attlen integer, intent(in) :: att integer, intent(in) :: ncid character(len = *), intent(in) :: attname logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_att_id_integer_0D" integer :: s lstat = .false. ! Now that we are sure that the read attribute has the same type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_att(ncid, ncvarid, attname, att) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_ATT, & & me, tgtname = attname, tgtid = ncvarid, errid = s, & & errmess = nf90_strerror(s)) end if return end if lstat = .true. end subroutine write_att_id_integer_0D subroutine write_att_integer_1D(ncid, varname, attname, att, & & lstat, error_data) character(len = *), intent(in) :: varname !integer, intent(in) :: attlen integer, intent(in) :: att(:) integer, intent(in) :: ncid character(len = *), intent(in) :: attname logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_att_integer_1D" integer :: s type(etsf_io_low_var_infos) :: var_infos lstat = .false. if (present(error_data)) then call etsf_io_low_read_var_infos(ncid, varname, var_infos, & & lstat, error_data = error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_read_var_infos(ncid, varname, var_infos, lstat) end if if (.not. lstat) return ! Now that we are sure that the read attribute has the same type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_att(ncid, var_infos%ncid, attname, att) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_ATT, & & me, tgtname = attname, tgtid = var_infos%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if lstat = .true. end subroutine write_att_integer_1D subroutine write_att_id_integer_1D(ncid, ncvarid, attname, att, & & lstat, error_data) integer, intent(in) :: ncvarid !integer, intent(in) :: attlen integer, intent(in) :: att(:) integer, intent(in) :: ncid character(len = *), intent(in) :: attname logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_att_id_integer_1D" integer :: s lstat = .false. ! Now that we are sure that the read attribute has the same type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_att(ncid, ncvarid, attname, att) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_ATT, & & me, tgtname = attname, tgtid = ncvarid, errid = s, & & errmess = nf90_strerror(s)) end if return end if lstat = .true. end subroutine write_att_id_integer_1D subroutine write_att_real_0D(ncid, varname, attname, att, & & lstat, error_data) character(len = *), intent(in) :: varname !integer, intent(in) :: attlen real, intent(in) :: att integer, intent(in) :: ncid character(len = *), intent(in) :: attname logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_att_real_0D" integer :: s type(etsf_io_low_var_infos) :: var_infos lstat = .false. if (present(error_data)) then call etsf_io_low_read_var_infos(ncid, varname, var_infos, & & lstat, error_data = error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_read_var_infos(ncid, varname, var_infos, lstat) end if if (.not. lstat) return ! Now that we are sure that the read attribute has the same type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_att(ncid, var_infos%ncid, attname, att) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_ATT, & & me, tgtname = attname, tgtid = var_infos%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if lstat = .true. end subroutine write_att_real_0D subroutine write_att_id_real_0D(ncid, ncvarid, attname, att, & & lstat, error_data) integer, intent(in) :: ncvarid !integer, intent(in) :: attlen real, intent(in) :: att integer, intent(in) :: ncid character(len = *), intent(in) :: attname logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_att_id_real_0D" integer :: s lstat = .false. ! Now that we are sure that the read attribute has the same type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_att(ncid, ncvarid, attname, att) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_ATT, & & me, tgtname = attname, tgtid = ncvarid, errid = s, & & errmess = nf90_strerror(s)) end if return end if lstat = .true. end subroutine write_att_id_real_0D subroutine write_att_real_1D(ncid, varname, attname, att, & & lstat, error_data) character(len = *), intent(in) :: varname !integer, intent(in) :: attlen real, intent(in) :: att(:) integer, intent(in) :: ncid character(len = *), intent(in) :: attname logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_att_real_1D" integer :: s type(etsf_io_low_var_infos) :: var_infos lstat = .false. if (present(error_data)) then call etsf_io_low_read_var_infos(ncid, varname, var_infos, & & lstat, error_data = error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_read_var_infos(ncid, varname, var_infos, lstat) end if if (.not. lstat) return ! Now that we are sure that the read attribute has the same type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_att(ncid, var_infos%ncid, attname, att) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_ATT, & & me, tgtname = attname, tgtid = var_infos%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if lstat = .true. end subroutine write_att_real_1D subroutine write_att_id_real_1D(ncid, ncvarid, attname, att, & & lstat, error_data) integer, intent(in) :: ncvarid !integer, intent(in) :: attlen real, intent(in) :: att(:) integer, intent(in) :: ncid character(len = *), intent(in) :: attname logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_att_id_real_1D" integer :: s lstat = .false. ! Now that we are sure that the read attribute has the same type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_att(ncid, ncvarid, attname, att) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_ATT, & & me, tgtname = attname, tgtid = ncvarid, errid = s, & & errmess = nf90_strerror(s)) end if return end if lstat = .true. end subroutine write_att_id_real_1D subroutine write_att_double_0D(ncid, varname, attname, att, & & lstat, error_data) character(len = *), intent(in) :: varname !integer, intent(in) :: attlen double precision, intent(in) :: att integer, intent(in) :: ncid character(len = *), intent(in) :: attname logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_att_double_0D" integer :: s type(etsf_io_low_var_infos) :: var_infos lstat = .false. if (present(error_data)) then call etsf_io_low_read_var_infos(ncid, varname, var_infos, & & lstat, error_data = error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_read_var_infos(ncid, varname, var_infos, lstat) end if if (.not. lstat) return ! Now that we are sure that the read attribute has the same type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_att(ncid, var_infos%ncid, attname, att) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_ATT, & & me, tgtname = attname, tgtid = var_infos%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if lstat = .true. end subroutine write_att_double_0D subroutine write_att_id_double_0D(ncid, ncvarid, attname, att, & & lstat, error_data) integer, intent(in) :: ncvarid !integer, intent(in) :: attlen double precision, intent(in) :: att integer, intent(in) :: ncid character(len = *), intent(in) :: attname logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_att_id_double_0D" integer :: s lstat = .false. ! Now that we are sure that the read attribute has the same type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_att(ncid, ncvarid, attname, att) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_ATT, & & me, tgtname = attname, tgtid = ncvarid, errid = s, & & errmess = nf90_strerror(s)) end if return end if lstat = .true. end subroutine write_att_id_double_0D subroutine write_att_double_1D(ncid, varname, attname, att, & & lstat, error_data) character(len = *), intent(in) :: varname !integer, intent(in) :: attlen double precision, intent(in) :: att(:) integer, intent(in) :: ncid character(len = *), intent(in) :: attname logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_att_double_1D" integer :: s type(etsf_io_low_var_infos) :: var_infos lstat = .false. if (present(error_data)) then call etsf_io_low_read_var_infos(ncid, varname, var_infos, & & lstat, error_data = error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_read_var_infos(ncid, varname, var_infos, lstat) end if if (.not. lstat) return ! Now that we are sure that the read attribute has the same type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_att(ncid, var_infos%ncid, attname, att) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_ATT, & & me, tgtname = attname, tgtid = var_infos%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if lstat = .true. end subroutine write_att_double_1D subroutine write_att_id_double_1D(ncid, ncvarid, attname, att, & & lstat, error_data) integer, intent(in) :: ncvarid !integer, intent(in) :: attlen double precision, intent(in) :: att(:) integer, intent(in) :: ncid character(len = *), intent(in) :: attname logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_att_id_double_1D" integer :: s lstat = .false. ! Now that we are sure that the read attribute has the same type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_att(ncid, ncvarid, attname, att) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_ATT, & & me, tgtname = attname, tgtid = ncvarid, errid = s, & & errmess = nf90_strerror(s)) end if return end if lstat = .true. end subroutine write_att_id_double_1D subroutine write_att_character_1D(ncid, varname, attname, att, & & lstat, error_data) character(len = *), intent(in) :: varname !integer, intent(in) :: attlen character(len = *), intent(in) :: att integer, intent(in) :: ncid character(len = *), intent(in) :: attname logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_att_character_1D" integer :: s type(etsf_io_low_var_infos) :: var_infos lstat = .false. if (present(error_data)) then call etsf_io_low_read_var_infos(ncid, varname, var_infos, & & lstat, error_data = error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, me) else call etsf_io_low_read_var_infos(ncid, varname, var_infos, lstat) end if if (.not. lstat) return ! Now that we are sure that the read attribute has the same type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_att(ncid, var_infos%ncid, attname, att) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_ATT, & & me, tgtname = attname, tgtid = var_infos%ncid, errid = s, & & errmess = nf90_strerror(s)) end if return end if lstat = .true. end subroutine write_att_character_1D subroutine write_att_id_character_1D(ncid, ncvarid, attname, att, & & lstat, error_data) integer, intent(in) :: ncvarid !integer, intent(in) :: attlen character(len = *), intent(in) :: att integer, intent(in) :: ncid character(len = *), intent(in) :: attname logical, intent(out) :: lstat type(etsf_io_low_error), intent(out), optional :: error_data !Local character(len = *), parameter :: me = "write_att_id_character_1D" integer :: s lstat = .false. ! Now that we are sure that the read attribute has the same type and dimension ! that the argument one, we can do the get action securely. s = nf90_put_att(ncid, ncvarid, attname, att) if (s /= nf90_noerr) then if (present(error_data)) then call etsf_io_low_error_set(error_data, ERROR_MODE_GET, ERROR_TYPE_ATT, & & me, tgtname = attname, tgtid = ncvarid, errid = s, & & errmess = nf90_strerror(s)) end if return end if lstat = .true. end subroutine write_att_id_character_1D etsf_io-1.0.3/src/group_level/0000777000353400050620000000000011354151523013264 500000000000000etsf_io-1.0.3/src/group_level/Makefile.am0000644000353400050630000000561311354150413015237 00000000000000lib_LIBRARIES = libetsf_io.a EXTRA_DIST = \ etsf_io_dims_def.f90 \ etsf_io_dims_get.f90 \ etsf_io_dims_merge.f90 \ etsf_io_dims_trace.f90 \ etsf_io_geometry_def.f90 \ etsf_io_electrons_def.f90 \ etsf_io_kpoints_def.f90 \ etsf_io_basisdata_def.f90 \ etsf_io_gwdata_def.f90 \ etsf_io_dielectric_def.f90 \ etsf_io_main_def.f90 \ etsf_io_geometry_get.f90 \ etsf_io_electrons_get.f90 \ etsf_io_kpoints_get.f90 \ etsf_io_basisdata_get.f90 \ etsf_io_gwdata_get.f90 \ etsf_io_dielectric_get.f90 \ etsf_io_main_get.f90 \ etsf_io_geometry_put.f90 \ etsf_io_electrons_put.f90 \ etsf_io_kpoints_put.f90 \ etsf_io_basisdata_put.f90 \ etsf_io_gwdata_put.f90 \ etsf_io_dielectric_put.f90 \ etsf_io_main_put.f90 \ etsf_io_geometry_copy.f90 \ etsf_io_electrons_copy.f90 \ etsf_io_kpoints_copy.f90 \ etsf_io_basisdata_copy.f90 \ etsf_io_gwdata_copy.f90 \ etsf_io_dielectric_copy.f90 \ etsf_io_main_copy.f90 \ etsf_io_split_init.f90 \ etsf_io_split_allocate.f90 \ etsf_io_split_free.f90 \ etsf_io_split_def.f90 \ etsf_io_split_get.f90 \ etsf_io_split_put.f90 \ etsf_io_split_copy.f90 \ etsf_io_split_merge.f90 \ etsf_io_vars_free.f90 \ etsf_io_data_init.f90 \ etsf_io_data_read.f90 \ etsf_io_data_write.f90 \ etsf_io_data_contents.f90 \ etsf_io_data_get.f90 \ etsf_io_data_copy.f90 if CAPITALIZE module_DATA = ETSF_IO.@MODULE_EXT@ else module_DATA = etsf_io.@MODULE_EXT@ endif AM_FCFLAGS = -I$(top_builddir)/src/low_level -I$(srcdir) -I@NETCDF_CFLAGS@ libetsf_io_a_SOURCES = etsf_io.f90 libetsf_io_a_LIBADD = $(top_builddir)/src/low_level/etsf_io_low_level.o #dependencies etsf_io.o: etsf_io.f90 \ etsf_io_dims_def.f90 \ etsf_io_dims_get.f90 \ etsf_io_dims_merge.f90 \ etsf_io_dims_trace.f90 \ etsf_io_geometry_def.f90 \ etsf_io_electrons_def.f90 \ etsf_io_kpoints_def.f90 \ etsf_io_basisdata_def.f90 \ etsf_io_gwdata_def.f90 \ etsf_io_dielectric_def.f90 \ etsf_io_main_def.f90 \ etsf_io_geometry_get.f90 \ etsf_io_electrons_get.f90 \ etsf_io_kpoints_get.f90 \ etsf_io_basisdata_get.f90 \ etsf_io_gwdata_get.f90 \ etsf_io_dielectric_get.f90 \ etsf_io_main_get.f90 \ etsf_io_geometry_put.f90 \ etsf_io_electrons_put.f90 \ etsf_io_kpoints_put.f90 \ etsf_io_basisdata_put.f90 \ etsf_io_gwdata_put.f90 \ etsf_io_dielectric_put.f90 \ etsf_io_main_put.f90 \ etsf_io_geometry_copy.f90 \ etsf_io_electrons_copy.f90 \ etsf_io_kpoints_copy.f90 \ etsf_io_basisdata_copy.f90 \ etsf_io_gwdata_copy.f90 \ etsf_io_dielectric_copy.f90 \ etsf_io_main_copy.f90 \ etsf_io_split_init.f90 \ etsf_io_split_allocate.f90 \ etsf_io_split_free.f90 \ etsf_io_split_def.f90 \ etsf_io_split_get.f90 \ etsf_io_split_put.f90 \ etsf_io_split_copy.f90 \ etsf_io_split_merge.f90 \ etsf_io_vars_free.f90 \ etsf_io_data_init.f90 \ etsf_io_data_read.f90 \ etsf_io_data_write.f90 \ etsf_io_data_contents.f90 \ etsf_io_data_get.f90 \ etsf_io_data_copy.f90 ETSF_IO.@MODULE_EXT@ etsf_io.@MODULE_EXT@: etsf_io.o etsf_io-1.0.3/src/group_level/Makefile.in0000644000353400050620000003714711354150420015254 00000000000000# Makefile.in generated by automake 1.10.1 from Makefile.am. # @configure_input@ # Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, # 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. # This Makefile.in is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY, to the extent permitted by law; without # even the implied warranty of MERCHANTABILITY or FITNESS FOR A # PARTICULAR PURPOSE. @SET_MAKE@ VPATH = @srcdir@ pkgdatadir = $(datadir)/@PACKAGE@ pkglibdir = $(libdir)/@PACKAGE@ pkgincludedir = $(includedir)/@PACKAGE@ am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd install_sh_DATA = $(install_sh) -c -m 644 install_sh_PROGRAM = $(install_sh) -c install_sh_SCRIPT = $(install_sh) -c INSTALL_HEADER = $(INSTALL_DATA) transform = $(program_transform_name) NORMAL_INSTALL = : PRE_INSTALL = : POST_INSTALL = : NORMAL_UNINSTALL = : PRE_UNINSTALL = : POST_UNINSTALL = : subdir = src/group_level DIST_COMMON = $(srcdir)/Makefile.am $(srcdir)/Makefile.in ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 am__aclocal_m4_deps = $(top_srcdir)/config/m4/fortran.m4 \ $(top_srcdir)/configure.ac am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ $(ACLOCAL_M4) mkinstalldirs = $(install_sh) -d CONFIG_CLEAN_FILES = am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; am__vpath_adj = case $$p in \ $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \ *) f=$$p;; \ esac; am__strip_dir = `echo $$p | sed -e 's|^.*/||'`; am__installdirs = "$(DESTDIR)$(libdir)" "$(DESTDIR)$(moduledir)" libLIBRARIES_INSTALL = $(INSTALL_DATA) LIBRARIES = $(lib_LIBRARIES) ARFLAGS = cru libetsf_io_a_AR = $(AR) $(ARFLAGS) libetsf_io_a_DEPENDENCIES = \ $(top_builddir)/src/low_level/etsf_io_low_level.o am_libetsf_io_a_OBJECTS = etsf_io.$(OBJEXT) libetsf_io_a_OBJECTS = $(am_libetsf_io_a_OBJECTS) DEFAULT_INCLUDES = -I.@am__isrc@ FCCOMPILE = $(FC) $(AM_FCFLAGS) $(FCFLAGS) FCLD = $(FC) FCLINK = $(FCLD) $(AM_FCFLAGS) $(FCFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o \ $@ SOURCES = $(libetsf_io_a_SOURCES) DIST_SOURCES = $(libetsf_io_a_SOURCES) moduleDATA_INSTALL = $(INSTALL_DATA) DATA = $(module_DATA) ETAGS = etags CTAGS = ctags DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) ACLOCAL = @ACLOCAL@ AMTAR = @AMTAR@ AR = @AR@ AUTOCONF = @AUTOCONF@ AUTOHEADER = @AUTOHEADER@ AUTOMAKE = @AUTOMAKE@ AWK = @AWK@ CYGPATH_W = @CYGPATH_W@ DEFS = @DEFS@ ECHO_C = @ECHO_C@ ECHO_N = @ECHO_N@ ECHO_T = @ECHO_T@ EXEEXT = @EXEEXT@ FC = @FC@ FCFLAGS = @FCFLAGS@ FCFLAGS_f90 = @FCFLAGS_f90@ FFLAGS = @FFLAGS@ INSTALL = @INSTALL@ INSTALL_DATA = @INSTALL_DATA@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ INSTALL_SCRIPT = @INSTALL_SCRIPT@ INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ LDFLAGS = @LDFLAGS@ LIBOBJS = @LIBOBJS@ LIBS = @LIBS@ LTLIBOBJS = @LTLIBOBJS@ MAKEINFO = @MAKEINFO@ MKDIR_P = @MKDIR_P@ MODULE_EXT = @MODULE_EXT@ NETCDF_CFLAGS = @NETCDF_CFLAGS@ OBJEXT = @OBJEXT@ PACKAGE = @PACKAGE@ PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ PACKAGE_NAME = @PACKAGE_NAME@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_VERSION = @PACKAGE_VERSION@ PATH_SEPARATOR = @PATH_SEPARATOR@ RANLIB = @RANLIB@ SET_MAKE = @SET_MAKE@ SHELL = @SHELL@ STRIP = @STRIP@ VERSION = @VERSION@ abs_builddir = @abs_builddir@ abs_srcdir = @abs_srcdir@ abs_top_builddir = @abs_top_builddir@ abs_top_srcdir = @abs_top_srcdir@ ac_ct_FC = @ac_ct_FC@ am__leading_dot = @am__leading_dot@ am__tar = @am__tar@ am__untar = @am__untar@ bindir = @bindir@ build_alias = @build_alias@ builddir = @builddir@ datadir = @datadir@ datarootdir = @datarootdir@ docdir = @docdir@ dvidir = @dvidir@ exec_prefix = @exec_prefix@ fc_type = @fc_type@ fc_version = @fc_version@ fc_wrap = @fc_wrap@ groupleveldocdir = @groupleveldocdir@ host_alias = @host_alias@ htmldir = @htmldir@ includedir = @includedir@ infodir = @infodir@ install_sh = @install_sh@ libdir = @libdir@ libexecdir = @libexecdir@ localedir = @localedir@ localstatedir = @localstatedir@ lowleveldocdir = @lowleveldocdir@ mandir = @mandir@ mkdir_p = @mkdir_p@ moduledir = @moduledir@ oldincludedir = @oldincludedir@ pdfdir = @pdfdir@ prefix = @prefix@ program_transform_name = @program_transform_name@ psdir = @psdir@ sbindir = @sbindir@ sharedstatedir = @sharedstatedir@ srcdir = @srcdir@ sysconfdir = @sysconfdir@ target_alias = @target_alias@ top_builddir = @top_builddir@ top_srcdir = @top_srcdir@ tutorialsdocdir = @tutorialsdocdir@ utilsdocdir = @utilsdocdir@ lib_LIBRARIES = libetsf_io.a EXTRA_DIST = \ etsf_io_dims_def.f90 \ etsf_io_dims_get.f90 \ etsf_io_dims_merge.f90 \ etsf_io_dims_trace.f90 \ etsf_io_geometry_def.f90 \ etsf_io_electrons_def.f90 \ etsf_io_kpoints_def.f90 \ etsf_io_basisdata_def.f90 \ etsf_io_gwdata_def.f90 \ etsf_io_dielectric_def.f90 \ etsf_io_main_def.f90 \ etsf_io_geometry_get.f90 \ etsf_io_electrons_get.f90 \ etsf_io_kpoints_get.f90 \ etsf_io_basisdata_get.f90 \ etsf_io_gwdata_get.f90 \ etsf_io_dielectric_get.f90 \ etsf_io_main_get.f90 \ etsf_io_geometry_put.f90 \ etsf_io_electrons_put.f90 \ etsf_io_kpoints_put.f90 \ etsf_io_basisdata_put.f90 \ etsf_io_gwdata_put.f90 \ etsf_io_dielectric_put.f90 \ etsf_io_main_put.f90 \ etsf_io_geometry_copy.f90 \ etsf_io_electrons_copy.f90 \ etsf_io_kpoints_copy.f90 \ etsf_io_basisdata_copy.f90 \ etsf_io_gwdata_copy.f90 \ etsf_io_dielectric_copy.f90 \ etsf_io_main_copy.f90 \ etsf_io_split_init.f90 \ etsf_io_split_allocate.f90 \ etsf_io_split_free.f90 \ etsf_io_split_def.f90 \ etsf_io_split_get.f90 \ etsf_io_split_put.f90 \ etsf_io_split_copy.f90 \ etsf_io_split_merge.f90 \ etsf_io_vars_free.f90 \ etsf_io_data_init.f90 \ etsf_io_data_read.f90 \ etsf_io_data_write.f90 \ etsf_io_data_contents.f90 \ etsf_io_data_get.f90 \ etsf_io_data_copy.f90 @CAPITALIZE_FALSE@module_DATA = etsf_io.@MODULE_EXT@ @CAPITALIZE_TRUE@module_DATA = ETSF_IO.@MODULE_EXT@ AM_FCFLAGS = -I$(top_builddir)/src/low_level -I$(srcdir) -I@NETCDF_CFLAGS@ libetsf_io_a_SOURCES = etsf_io.f90 libetsf_io_a_LIBADD = $(top_builddir)/src/low_level/etsf_io_low_level.o all: all-am .SUFFIXES: .SUFFIXES: .f90 .o .obj $(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) @for dep in $?; do \ case '$(am__configure_deps)' in \ *$$dep*) \ cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh \ && exit 0; \ exit 1;; \ esac; \ done; \ echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu src/group_level/Makefile'; \ cd $(top_srcdir) && \ $(AUTOMAKE) --gnu src/group_level/Makefile .PRECIOUS: Makefile Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status @case '$?' in \ *config.status*) \ cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ *) \ echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ esac; $(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh $(top_srcdir)/configure: $(am__configure_deps) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh $(ACLOCAL_M4): $(am__aclocal_m4_deps) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh install-libLIBRARIES: $(lib_LIBRARIES) @$(NORMAL_INSTALL) test -z "$(libdir)" || $(MKDIR_P) "$(DESTDIR)$(libdir)" @list='$(lib_LIBRARIES)'; for p in $$list; do \ if test -f $$p; then \ f=$(am__strip_dir) \ echo " $(libLIBRARIES_INSTALL) '$$p' '$(DESTDIR)$(libdir)/$$f'"; \ $(libLIBRARIES_INSTALL) "$$p" "$(DESTDIR)$(libdir)/$$f"; \ else :; fi; \ done @$(POST_INSTALL) @list='$(lib_LIBRARIES)'; for p in $$list; do \ if test -f $$p; then \ p=$(am__strip_dir) \ echo " $(RANLIB) '$(DESTDIR)$(libdir)/$$p'"; \ $(RANLIB) "$(DESTDIR)$(libdir)/$$p"; \ else :; fi; \ done uninstall-libLIBRARIES: @$(NORMAL_UNINSTALL) @list='$(lib_LIBRARIES)'; for p in $$list; do \ p=$(am__strip_dir) \ echo " rm -f '$(DESTDIR)$(libdir)/$$p'"; \ rm -f "$(DESTDIR)$(libdir)/$$p"; \ done clean-libLIBRARIES: -test -z "$(lib_LIBRARIES)" || rm -f $(lib_LIBRARIES) libetsf_io.a: $(libetsf_io_a_OBJECTS) $(libetsf_io_a_DEPENDENCIES) -rm -f libetsf_io.a $(libetsf_io_a_AR) libetsf_io.a $(libetsf_io_a_OBJECTS) $(libetsf_io_a_LIBADD) $(RANLIB) libetsf_io.a mostlyclean-compile: -rm -f *.$(OBJEXT) distclean-compile: -rm -f *.tab.c .f90.o: $(FCCOMPILE) -c -o $@ $< .f90.obj: $(FCCOMPILE) -c -o $@ `$(CYGPATH_W) '$<'` install-moduleDATA: $(module_DATA) @$(NORMAL_INSTALL) test -z "$(moduledir)" || $(MKDIR_P) "$(DESTDIR)$(moduledir)" @list='$(module_DATA)'; for p in $$list; do \ if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ f=$(am__strip_dir) \ echo " $(moduleDATA_INSTALL) '$$d$$p' '$(DESTDIR)$(moduledir)/$$f'"; \ $(moduleDATA_INSTALL) "$$d$$p" "$(DESTDIR)$(moduledir)/$$f"; \ done uninstall-moduleDATA: @$(NORMAL_UNINSTALL) @list='$(module_DATA)'; for p in $$list; do \ f=$(am__strip_dir) \ echo " rm -f '$(DESTDIR)$(moduledir)/$$f'"; \ rm -f "$(DESTDIR)$(moduledir)/$$f"; \ done ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES) list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ unique=`for i in $$list; do \ if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ done | \ $(AWK) '{ files[$$0] = 1; nonemtpy = 1; } \ END { if (nonempty) { for (i in files) print i; }; }'`; \ mkid -fID $$unique tags: TAGS TAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \ $(TAGS_FILES) $(LISP) tags=; \ here=`pwd`; \ list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ unique=`for i in $$list; do \ if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ done | \ $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ END { if (nonempty) { for (i in files) print i; }; }'`; \ if test -z "$(ETAGS_ARGS)$$tags$$unique"; then :; else \ test -n "$$unique" || unique=$$empty_fix; \ $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ $$tags $$unique; \ fi ctags: CTAGS CTAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \ $(TAGS_FILES) $(LISP) tags=; \ list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ unique=`for i in $$list; do \ if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ done | \ $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ END { if (nonempty) { for (i in files) print i; }; }'`; \ test -z "$(CTAGS_ARGS)$$tags$$unique" \ || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ $$tags $$unique GTAGS: here=`$(am__cd) $(top_builddir) && pwd` \ && cd $(top_srcdir) \ && gtags -i $(GTAGS_ARGS) $$here distclean-tags: -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags distdir: $(DISTFILES) @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ list='$(DISTFILES)'; \ dist_files=`for file in $$list; do echo $$file; done | \ sed -e "s|^$$srcdirstrip/||;t" \ -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ case $$dist_files in \ */*) $(MKDIR_P) `echo "$$dist_files" | \ sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ sort -u` ;; \ esac; \ for file in $$dist_files; do \ if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ if test -d $$d/$$file; then \ dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ cp -pR $(srcdir)/$$file $(distdir)$$dir || exit 1; \ fi; \ cp -pR $$d/$$file $(distdir)$$dir || exit 1; \ else \ test -f $(distdir)/$$file \ || cp -p $$d/$$file $(distdir)/$$file \ || exit 1; \ fi; \ done check-am: all-am check: check-am all-am: Makefile $(LIBRARIES) $(DATA) installdirs: for dir in "$(DESTDIR)$(libdir)" "$(DESTDIR)$(moduledir)"; do \ test -z "$$dir" || $(MKDIR_P) "$$dir"; \ done install: install-am install-exec: install-exec-am install-data: install-data-am uninstall: uninstall-am install-am: all-am @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am installcheck: installcheck-am install-strip: $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ `test -z '$(STRIP)' || \ echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install mostlyclean-generic: clean-generic: distclean-generic: -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) maintainer-clean-generic: @echo "This command is intended for maintainers to use" @echo "it deletes files that may require special tools to rebuild." clean: clean-am clean-am: clean-generic clean-libLIBRARIES mostlyclean-am distclean: distclean-am -rm -f Makefile distclean-am: clean-am distclean-compile distclean-generic \ distclean-tags dvi: dvi-am dvi-am: html: html-am info: info-am info-am: install-data-am: install-moduleDATA install-dvi: install-dvi-am install-exec-am: install-libLIBRARIES install-html: install-html-am install-info: install-info-am install-man: install-pdf: install-pdf-am install-ps: install-ps-am installcheck-am: maintainer-clean: maintainer-clean-am -rm -f Makefile maintainer-clean-am: distclean-am maintainer-clean-generic mostlyclean: mostlyclean-am mostlyclean-am: mostlyclean-compile mostlyclean-generic pdf: pdf-am pdf-am: ps: ps-am ps-am: uninstall-am: uninstall-libLIBRARIES uninstall-moduleDATA .MAKE: install-am install-strip .PHONY: CTAGS GTAGS all all-am check check-am clean clean-generic \ clean-libLIBRARIES ctags distclean distclean-compile \ distclean-generic distclean-tags distdir dvi dvi-am html \ html-am info info-am install install-am install-data \ install-data-am install-dvi install-dvi-am install-exec \ install-exec-am install-html install-html-am install-info \ install-info-am install-libLIBRARIES install-man \ install-moduleDATA install-pdf install-pdf-am install-ps \ install-ps-am install-strip installcheck installcheck-am \ installdirs maintainer-clean maintainer-clean-generic \ mostlyclean mostlyclean-compile mostlyclean-generic pdf pdf-am \ ps ps-am tags uninstall uninstall-am uninstall-libLIBRARIES \ uninstall-moduleDATA #dependencies etsf_io.o: etsf_io.f90 \ etsf_io_dims_def.f90 \ etsf_io_dims_get.f90 \ etsf_io_dims_merge.f90 \ etsf_io_dims_trace.f90 \ etsf_io_geometry_def.f90 \ etsf_io_electrons_def.f90 \ etsf_io_kpoints_def.f90 \ etsf_io_basisdata_def.f90 \ etsf_io_gwdata_def.f90 \ etsf_io_dielectric_def.f90 \ etsf_io_main_def.f90 \ etsf_io_geometry_get.f90 \ etsf_io_electrons_get.f90 \ etsf_io_kpoints_get.f90 \ etsf_io_basisdata_get.f90 \ etsf_io_gwdata_get.f90 \ etsf_io_dielectric_get.f90 \ etsf_io_main_get.f90 \ etsf_io_geometry_put.f90 \ etsf_io_electrons_put.f90 \ etsf_io_kpoints_put.f90 \ etsf_io_basisdata_put.f90 \ etsf_io_gwdata_put.f90 \ etsf_io_dielectric_put.f90 \ etsf_io_main_put.f90 \ etsf_io_geometry_copy.f90 \ etsf_io_electrons_copy.f90 \ etsf_io_kpoints_copy.f90 \ etsf_io_basisdata_copy.f90 \ etsf_io_gwdata_copy.f90 \ etsf_io_dielectric_copy.f90 \ etsf_io_main_copy.f90 \ etsf_io_split_init.f90 \ etsf_io_split_allocate.f90 \ etsf_io_split_free.f90 \ etsf_io_split_def.f90 \ etsf_io_split_get.f90 \ etsf_io_split_put.f90 \ etsf_io_split_copy.f90 \ etsf_io_split_merge.f90 \ etsf_io_vars_free.f90 \ etsf_io_data_init.f90 \ etsf_io_data_read.f90 \ etsf_io_data_write.f90 \ etsf_io_data_contents.f90 \ etsf_io_data_get.f90 \ etsf_io_data_copy.f90 ETSF_IO.@MODULE_EXT@ etsf_io.@MODULE_EXT@: etsf_io.o # Tell versions [3.59,3.63) of GNU make to not export all variables. # Otherwise a system limit (for SysV at least) may be exceeded. .NOEXPORT: etsf_io-1.0.3/src/group_level/etsf_io.f900000644000353400050630000007342111354150413015155 00000000000000!{\src2tex{textfont=tt}} !!****h* group_level/etsf_io !! NAME !! etsf_io !! !! FUNCTION !! This module contains all information required by the ETSF/Nanoquanta !! file format specifications. See http://www.etsf.eu/fileformats for !! details. !! !! It contains definitions of: !! * #ETSF_IO_CONSTANTS some constants defined by the specifications ; !! * #FLAGS_GROUPS & #FLAGS_MAIN, public flags to identify specific !! structures ; !! * the list of all dimensions declared in the specifications, see !! #etsf_dimensions. !! * several structures to store variable used in a same context, such as !! geometry informations, k points data... !! * a container (see #etsf_groups) to agregate all previous structures. !! * a container to store the main data (see #etsf_main). !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! NOTES !! This file has been automatically generated by the autogen_module !! script. Any change you would bring to it will systematically be !! overwritten. !!*** module etsf_io use etsf_io_low_level implicit none !!****d* etsf_io_basics_group/ETSF_IO_CONSTANTS !! NAME !! ETSF_IO_CONSTANTS !! !! FUNCTION !! These values are fixed by the specifications or are static values. !! * etsf_spec_dimension = to be used in a count argument (see !! etsf_io_low_read_var() for instance) when !! one wants to read all the values of one !! dimension. For example count = (/ 1, etsf_spec_dimension /) !! will read one element from the first dimension and !! all for the second. !! * etsf_no_sub_access = some variable can be accessed only for one index in a !! specific dimension (usually spin or k points). This !! value is used to tell the library to access all the values !! of that dimension. !! * etsf_no_dimension = this value is given to a dimension. It means that !! the file does not contain that dimension. !! !! SOURCE ! Constants for internal dimensions integer, parameter :: etsf_charlen = 80 integer, parameter :: etsf_histlen = 1024 integer, parameter :: etsf_chemlen = 2 integer, parameter :: etsf_2dimlen = 2 integer, parameter :: etsf_3dimlen = 3 integer, parameter :: etsf_spec_dimension = 0 integer, parameter :: etsf_no_sub_access = 0 integer, parameter :: etsf_no_dimension = 0 ! Global attributes character(len=etsf_charlen),parameter :: etsf_file_format = & & "ETSF Nanoquanta" character(len=etsf_charlen),parameter :: etsf_conventions = & & "http://www.etsf.eu/fileformats" real,parameter :: etsf_file_format_version = 3.3 !!*** !!****s* etsf_io_basics_group/etsf_vars !! NAME !! etsf_vars !! !! FUNCTION !! This structure contains informations about a list of variables. It inherits !! from etsf_io_low_var_infos type, but it adds new fields, specific to !! the ETSF norm. These fields are: !! * @group which is a value in FLAGS_GROUPS ; !! * @varid which is a value in FLAGS_MAIN ; !! * @split which defines if the variable is a split definition array. !! This structure is intrinsectly an array for performance reasons since !! variables are usually handled together. Use etsf_io_vars_free() to !! deallocate it. !! !! SOURCE type etsf_vars integer :: n_vars = 0 type(etsf_io_low_var_infos), pointer :: parent(:) => null() integer, pointer :: group(:) => null() integer, pointer :: varid(:) => null() logical, pointer :: split(:) => null() end type etsf_vars !!*** !!****d* etsf_io_basics_group/FLAGS_GROUPS !! NAME !! FLAGS_GROUPS !! !! FUNCTION !! These flags are used when indicating which groups must be used. !! If several groups must be accessed, then, simply add the corresponding !! flags. See etsf_io_data_write() or etsf_io_data_read() for usage. !! !! SOURCE ! Constants for groups of variables integer, parameter :: etsf_grp_none = 0 integer, parameter :: etsf_grp_geometry = 1 integer, parameter :: etsf_grp_electrons = 2 integer, parameter :: etsf_grp_kpoints = 4 integer, parameter :: etsf_grp_basisdata = 8 integer, parameter :: etsf_grp_gwdata = 16 integer, parameter :: etsf_grp_dielectric = 32 integer, parameter :: etsf_grp_main = 64 integer, parameter :: etsf_ngroups = 7 !!*** !!****d* etsf_io_basics_group/FLAGS_VARIABLES !! NAME !! FLAGS_VARIABLES !! !! FUNCTION !! These flags are used on data definition (see etsf_io_data_init()) to specify !! which variables should be defined in the NetCDF file. They are not exclusive. !! !! SOURCE ! 'geometry' variables integer, parameter :: etsf_geometry_none = 0 integer, parameter :: etsf_geometry_space_group = 1 integer, parameter :: etsf_geometry_primitive_vectors = 2 integer, parameter :: etsf_geometry_red_sym_matrices = 4 integer, parameter :: etsf_geometry_red_sym_trans = 8 integer, parameter :: etsf_geometry_atom_species = 16 integer, parameter :: etsf_geometry_red_at_pos = 32 integer, parameter :: etsf_geometry_valence_charges = 64 integer, parameter :: etsf_geometry_atomic_numbers = 128 integer, parameter :: etsf_geometry_atom_species_names = 256 integer, parameter :: etsf_geometry_chemical_symbols = 512 integer, parameter :: etsf_geometry_pseudo_types = 1024 integer, parameter :: etsf_geometry_all = 2047 integer, parameter :: etsf_geometry_nvars = 11 ! 'electrons' variables integer, parameter :: etsf_electrons_none = 0 integer, parameter :: etsf_electrons_number_of_electrons = 1 integer, parameter :: etsf_electrons_x_functional = 2 integer, parameter :: etsf_electrons_c_functional = 4 integer, parameter :: etsf_electrons_fermi_energy = 8 integer, parameter :: etsf_electrons_smearing_scheme = 16 integer, parameter :: etsf_electrons_smearing_width = 32 integer, parameter :: etsf_electrons_number_of_states = 64 integer, parameter :: etsf_electrons_eigenvalues = 128 integer, parameter :: etsf_electrons_occupations = 256 integer, parameter :: etsf_electrons_all = 511 integer, parameter :: etsf_electrons_nvars = 9 ! 'kpoints' variables integer, parameter :: etsf_kpoints_none = 0 integer, parameter :: etsf_kpoints_kpoint_grid_shift = 1 integer, parameter :: etsf_kpoints_kpoint_grid_vectors = 2 integer, parameter :: etsf_kpoints_mp_folding = 4 integer, parameter :: etsf_kpoints_red_coord_kpt = 8 integer, parameter :: etsf_kpoints_kpoint_weights = 16 integer, parameter :: etsf_kpoints_all = 31 integer, parameter :: etsf_kpoints_nvars = 5 ! 'basisdata' variables integer, parameter :: etsf_basisdata_none = 0 integer, parameter :: etsf_basisdata_basis_set = 1 integer, parameter :: etsf_basisdata_kin_cutoff = 2 integer, parameter :: etsf_basisdata_n_coeff = 4 integer, parameter :: etsf_basisdata_red_coord_pw = 8 integer, parameter :: etsf_basisdata_coord_grid = 16 integer, parameter :: etsf_basisdata_n_coeff_grid = 32 integer, parameter :: etsf_basisdata_all = 63 integer, parameter :: etsf_basisdata_nvars = 6 ! 'gwdata' variables integer, parameter :: etsf_gwdata_none = 0 integer, parameter :: etsf_gwdata_gw_corrections = 1 integer, parameter :: etsf_gwdata_kb_coeff_sig = 2 integer, parameter :: etsf_gwdata_kb_coeff = 4 integer, parameter :: etsf_gwdata_kb_coeff_der = 8 integer, parameter :: etsf_gwdata_all = 15 integer, parameter :: etsf_gwdata_nvars = 4 ! 'dielectric' variables integer, parameter :: etsf_dielectric_none = 0 integer, parameter :: etsf_dielectric_frequencies = 1 integer, parameter :: etsf_dielectric_qpt = 2 integer, parameter :: etsf_dielectric_qpt_g_lim = 4 integer, parameter :: etsf_dielectric_function = 8 integer, parameter :: etsf_dielectric_function_head = 16 integer, parameter :: etsf_dielectric_function_lower = 32 integer, parameter :: etsf_dielectric_function_upper = 64 integer, parameter :: etsf_dielectric_function_inv = 128 integer, parameter :: etsf_dielectric_function_inv_head = 256 integer, parameter :: etsf_dielectric_function_inv_lower = 512 integer, parameter :: etsf_dielectric_function_inv_upper = 1024 integer, parameter :: etsf_dielectric_polarizability = 2048 integer, parameter :: etsf_dielectric_pol_head = 4096 integer, parameter :: etsf_dielectric_pol_lower = 8192 integer, parameter :: etsf_dielectric_pol_upper = 16384 integer, parameter :: etsf_dielectric_polarizability_inv = 32768 integer, parameter :: etsf_dielectric_pol_inv_head = 65536 integer, parameter :: etsf_dielectric_pol_inv_lower = 131072 integer, parameter :: etsf_dielectric_pol_inv_upper = 262144 integer, parameter :: etsf_dielectric_all = 524287 integer, parameter :: etsf_dielectric_nvars = 19 ! 'main' variables integer, parameter :: etsf_main_none = 0 integer, parameter :: etsf_main_density = 1 integer, parameter :: etsf_main_pot_x_only = 2 integer, parameter :: etsf_main_pot_c_only = 4 integer, parameter :: etsf_main_pot_xc = 8 integer, parameter :: etsf_main_wfs_coeff = 16 integer, parameter :: etsf_main_wfs_rsp = 32 integer, parameter :: etsf_main_all = 63 integer, parameter :: etsf_main_nvars = 6 !!*** !!****d* etsf_io_basics_group/ETSF_IO_VALIDITY_FLAGS !! NAME !! ETSF_IO_VALIDITY_FLAGS !! !! FUNCTION !! These flags are used to identify a valid file as defined !! in the specifications. These valid files contains physical informations such as !! a potential or crystalographic data. Flags are not exclusive. !! !! SOURCE integer, parameter :: etsf_specs_none = 0 integer, parameter :: etsf_dielectric_function_data = 1 integer, parameter :: etsf_wavefunctions_data = 2 integer, parameter :: etsf_scalar_field_data = 4 integer, parameter :: etsf_crystallographic_data = 8 integer, parameter :: etsf_nspecs_data = 4 character(len = *), parameter :: etsf_specs_names(4) = (/ & & "dielectric_function_data ", & & "wavefunctions_data ", & & "scalar_field_data ", & & "crystallographic_data " /) !!*** !!****s* etsf_io_basics_group/etsf_dims !! NAME !! etsf_dimensions !! !! FUNCTION !! This structure is a container that stores all dimensions defined in the !! specifications. An instance of this structure is required when a new !! ETSF file is created. !! !! SOURCE ! Data type for dimensions type etsf_dims integer :: character_string_length = etsf_charlen integer :: complex = etsf_2dimlen integer :: max_number_of_angular_momenta = 1 integer :: max_number_of_basis_grid_points = 1 integer :: max_number_of_coefficients = 1 integer :: max_number_of_projectors = 1 integer :: max_number_of_states = 1 integer :: number_of_atoms = 1 integer :: number_of_atom_species = 1 integer :: number_of_cartesian_directions = etsf_3dimlen integer :: number_of_coefficients_dielectric_function = 1 integer :: number_of_components = 1 integer :: number_of_frequencies_dielectric_function = 1 integer :: number_of_grid_points_vector1 = 1 integer :: number_of_grid_points_vector2 = 1 integer :: number_of_grid_points_vector3 = 1 integer :: number_of_kpoints = 1 integer :: number_of_localization_regions = 1 integer :: number_of_qpoints_dielectric_function = 1 integer :: number_of_qpoints_gamma_limit = 1 integer :: number_of_reduced_dimensions = etsf_3dimlen integer :: number_of_spinor_components = 1 integer :: number_of_spins = 1 integer :: number_of_symmetry_operations = 1 integer :: number_of_vectors = etsf_3dimlen integer :: real_or_complex_coefficients = 1 integer :: real_or_complex_density = 1 integer :: real_or_complex_gw_corrections = 1 integer :: real_or_complex_potential = 1 integer :: real_or_complex_wavefunctions = 1 integer :: symbol_length = etsf_chemlen !Dimensions for variables that can be splitted. integer :: my_max_number_of_coefficients = etsf_no_dimension integer :: my_max_number_of_states = etsf_no_dimension integer :: my_number_of_components = etsf_no_dimension integer :: my_number_of_grid_points_vect1 = etsf_no_dimension integer :: my_number_of_grid_points_vect2 = etsf_no_dimension integer :: my_number_of_grid_points_vect3 = etsf_no_dimension integer :: my_number_of_kpoints = etsf_no_dimension integer :: my_number_of_spins = etsf_no_dimension end type etsf_dims !!*** !!****s* etsf_groups/etsf_geometry !! NAME !! etsf_geometry !! !! FUNCTION !! All variables from the specifications have been gathered into types called !! groups. These groups can be gathered into a container called #etsf_groups. !! This container is the main argument of the routines etsf_io_data_read() !! and etsf_io_data_write(). !! !! SOURCE ! Data type for geometry type etsf_geometry integer, pointer :: space_group => null() double precision, pointer :: primitive_vectors(:,:) => null() integer, pointer :: reduced_symmetry_matrices(:,:,:) => null() double precision, pointer :: reduced_symmetry_translations(:,:) => null() integer, pointer :: atom_species(:) => null() double precision, pointer :: reduced_atom_positions(:,:) => null() double precision, pointer :: valence_charges(:) => null() double precision, pointer :: atomic_numbers(:) => null() character(len=etsf_charlen), pointer :: atom_species_names(:) => null() character(len=etsf_chemlen), pointer :: chemical_symbols(:) => null() character(len=etsf_charlen), pointer :: pseudopotential_types(:) => null() end type etsf_geometry !!*** !!****s* etsf_groups/etsf_electrons !! NAME !! etsf_electrons !! !! FUNCTION !! All variables from the specifications have been gathered into types called !! groups. These groups can be gathered into a container called #etsf_groups. !! This container is the main argument of the routines etsf_io_data_read() !! and etsf_io_data_write(). !! !! SOURCE ! Data type for electrons type etsf_electrons integer, pointer :: number_of_electrons => null() character(len=etsf_charlen), pointer :: exchange_functional => null() character(len=etsf_charlen), pointer :: correlation_functional => null() double precision, pointer :: fermi_energy => null() character(len=etsf_charlen), pointer :: smearing_scheme => null() double precision, pointer :: smearing_width => null() type(etsf_io_low_var_integer) :: number_of_states type(etsf_io_low_var_double) :: eigenvalues type(etsf_io_low_var_double) :: occupations ! Attributes ! Units attributes for variable fermi_energy character(len=etsf_charlen) :: fermi_energy__units = "atomic units" double precision :: fermi_energy__scale_to_atomic_units = 1.0d0 ! Units attributes for variable smearing_width character(len=etsf_charlen) :: smearing_width__units = "atomic units" double precision :: smearing_width__scale_to_atomic_units = 1.0d0 ! Units attributes for variable eigenvalues character(len=etsf_charlen) :: eigenvalues__units = "atomic units" double precision :: eigenvalues__scale_to_atomic_units = 1.0d0 ! Specific dimensions (etsf_spec_dimension get the value ! of the max_number_of_something when the variable is get ! or put, change it to a lower value if less values are to ! be accessed). integer :: eigenvalues__number_of_states = etsf_spec_dimension integer :: eigenvalues__spin_access = etsf_no_sub_access integer :: eigenvalues__kpoint_access = etsf_no_sub_access integer :: eigenvalues__state_access = etsf_no_sub_access integer :: occupations__number_of_states = etsf_spec_dimension integer :: occupations__spin_access = etsf_no_sub_access integer :: occupations__kpoint_access = etsf_no_sub_access integer :: occupations__state_access = etsf_no_sub_access end type etsf_electrons !!*** !!****s* etsf_groups/etsf_kpoints !! NAME !! etsf_kpoints !! !! FUNCTION !! All variables from the specifications have been gathered into types called !! groups. These groups can be gathered into a container called #etsf_groups. !! This container is the main argument of the routines etsf_io_data_read() !! and etsf_io_data_write(). !! !! SOURCE ! Data type for kpoints type etsf_kpoints double precision, pointer :: kpoint_grid_shift(:) => null() double precision, pointer :: kpoint_grid_vectors(:,:) => null() integer, pointer :: monkhorst_pack_folding(:) => null() double precision, pointer :: reduced_coordinates_of_kpoints(:,:) => null() double precision, pointer :: kpoint_weights(:) => null() end type etsf_kpoints !!*** !!****s* etsf_groups/etsf_basisdata !! NAME !! etsf_basisdata !! !! FUNCTION !! All variables from the specifications have been gathered into types called !! groups. These groups can be gathered into a container called #etsf_groups. !! This container is the main argument of the routines etsf_io_data_read() !! and etsf_io_data_write(). !! !! SOURCE ! Data type for basisdata type etsf_basisdata character(len=etsf_charlen), pointer :: basis_set => null() double precision, pointer :: kinetic_energy_cutoff => null() integer, pointer :: number_of_coefficients(:) => null() type(etsf_io_low_var_integer) :: reduced_coordinates_of_plane_waves type(etsf_io_low_var_integer) :: coordinates_of_basis_grid_points type(etsf_io_low_var_integer) :: number_of_coefficients_per_grid_point ! Attributes ! Units attributes for variable kinetic_energy_cutoff character(len=etsf_charlen) :: kin_cutoff__units = "atomic units" double precision :: kin_cutoff__scale_to_atomic_units = 1.0d0 ! Specific dimensions (etsf_spec_dimension get the value ! of the max_number_of_something when the variable is get ! or put, change it to a lower value if less values are to ! be accessed). integer :: red_coord_pw__number_of_coefficients = etsf_spec_dimension integer :: red_coord_pw__kpoint_access = etsf_no_sub_access integer :: coord_grid__number_of_basis_grid_points = etsf_spec_dimension integer :: n_coeff_grid__number_of_basis_grid_points = etsf_spec_dimension end type etsf_basisdata !!*** !!****s* etsf_groups/etsf_gwdata !! NAME !! etsf_gwdata !! !! FUNCTION !! All variables from the specifications have been gathered into types called !! groups. These groups can be gathered into a container called #etsf_groups. !! This container is the main argument of the routines etsf_io_data_read() !! and etsf_io_data_write(). !! !! SOURCE ! Data type for gwdata type etsf_gwdata type(etsf_io_low_var_double) :: gw_corrections type(etsf_io_low_var_integer) :: kb_formfactor_sign type(etsf_io_low_var_double) :: kb_formfactors type(etsf_io_low_var_double) :: kb_formfactor_derivative ! Specific dimensions (etsf_spec_dimension get the value ! of the max_number_of_something when the variable is get ! or put, change it to a lower value if less values are to ! be accessed). integer :: gw_corrections__number_of_states = etsf_spec_dimension integer :: gw_corrections__spin_access = etsf_no_sub_access integer :: gw_corrections__kpoint_access = etsf_no_sub_access integer :: gw_corrections__state_access = etsf_no_sub_access integer :: kb_coeff_sig__number_of_angular_momenta = etsf_spec_dimension integer :: kb_coeff_sig__number_of_projectors = etsf_spec_dimension integer :: kb_coeff__number_of_angular_momenta = etsf_spec_dimension integer :: kb_coeff__number_of_projectors = etsf_spec_dimension integer :: kb_coeff__number_of_coefficients = etsf_spec_dimension integer :: kb_coeff__kpoint_access = etsf_no_sub_access integer :: kb_coeff_der__number_of_angular_momenta = etsf_spec_dimension integer :: kb_coeff_der__number_of_projectors = etsf_spec_dimension integer :: kb_coeff_der__number_of_coefficients = etsf_spec_dimension integer :: kb_coeff_der__kpoint_access = etsf_no_sub_access end type etsf_gwdata !!*** !!****s* etsf_groups/etsf_dielectric !! NAME !! etsf_dielectric !! !! FUNCTION !! All variables from the specifications have been gathered into types called !! groups. These groups can be gathered into a container called #etsf_groups. !! This container is the main argument of the routines etsf_io_data_read() !! and etsf_io_data_write(). !! !! SOURCE ! Data type for dielectric type etsf_dielectric double precision, pointer :: frequencies_dielectric_function(:,:) => null() double precision, pointer :: qpoints_dielectric_function(:,:) => null() double precision, pointer :: qpoints_gamma_limit(:,:) => null() type(etsf_io_low_var_double) :: dielectric_function type(etsf_io_low_var_double) :: dielectric_function_head type(etsf_io_low_var_double) :: dielectric_function_lower_wing type(etsf_io_low_var_double) :: dielectric_function_upper_wing type(etsf_io_low_var_double) :: inverse_dielectric_function type(etsf_io_low_var_double) :: inverse_dielectric_function_head type(etsf_io_low_var_double) :: inverse_dielectric_function_lower_wing type(etsf_io_low_var_double) :: inverse_dielectric_function_upper_wing type(etsf_io_low_var_double) :: polarizability type(etsf_io_low_var_double) :: polarizability_head type(etsf_io_low_var_double) :: polarizability_lower_wing type(etsf_io_low_var_double) :: polarizability_upper_wing type(etsf_io_low_var_double) :: inverse_polarizability type(etsf_io_low_var_double) :: inverse_polarizability_head type(etsf_io_low_var_double) :: inverse_polarizability_lower_wing type(etsf_io_low_var_double) :: inverse_polarizability_upper_wing end type etsf_dielectric !!*** !!****s* etsf_groups/etsf_main !! NAME !! etsf_main !! !! FUNCTION !! All variables from the specifications have been gathered into types called !! groups. These groups can be gathered into a container called #etsf_groups. !! This container is the main argument of the routines etsf_io_data_read() !! and etsf_io_data_write(). !! !! SOURCE ! Data type for main type etsf_main type(etsf_io_low_var_double) :: density type(etsf_io_low_var_double) :: exchange_potential type(etsf_io_low_var_double) :: correlation_potential type(etsf_io_low_var_double) :: exchange_correlation_potential type(etsf_io_low_var_double) :: coefficients_of_wavefunctions type(etsf_io_low_var_double) :: real_space_wavefunctions ! Attributes ! Units attributes for variable density character(len=etsf_charlen) :: density__units = "atomic units" double precision :: density__scale_to_atomic_units = 1.0d0 ! Units attributes for variable exchange_potential character(len=etsf_charlen) :: pot_x_only__units = "atomic units" double precision :: pot_x_only__scale_to_atomic_units = 1.0d0 ! Units attributes for variable correlation_potential character(len=etsf_charlen) :: pot_c_only__units = "atomic units" double precision :: pot_c_only__scale_to_atomic_units = 1.0d0 ! Units attributes for variable exchange_correlation_potential character(len=etsf_charlen) :: pot_xc__units = "atomic units" double precision :: pot_xc__scale_to_atomic_units = 1.0d0 ! Specific dimensions (etsf_spec_dimension get the value ! of the max_number_of_something when the variable is get ! or put, change it to a lower value if less values are to ! be accessed). integer :: wfs_coeff__number_of_states = etsf_spec_dimension integer :: wfs_coeff__number_of_coefficients = etsf_spec_dimension integer :: wfs_coeff__spin_access = etsf_no_sub_access integer :: wfs_coeff__kpoint_access = etsf_no_sub_access integer :: wfs_coeff__state_access = etsf_no_sub_access integer :: wfs_rsp__number_of_states = etsf_spec_dimension integer :: wfs_rsp__spin_access = etsf_no_sub_access integer :: wfs_rsp__kpoint_access = etsf_no_sub_access integer :: wfs_rsp__state_access = etsf_no_sub_access end type etsf_main !!*** !!****s* etsf_io_basics_group/etsf_groups_flags !! NAME !! etsf_groups_flags !! !! FUNCTION !! This structure is a container for each group to specify which variables !! are required (see etsf_io_data_init()). !! !! SOURCE ! Folder for the variable ids in each group type etsf_groups_flags integer :: geometry = etsf_geometry_none integer :: electrons = etsf_electrons_none integer :: kpoints = etsf_kpoints_none integer :: basisdata = etsf_basisdata_none integer :: gwdata = etsf_gwdata_none integer :: dielectric = etsf_dielectric_none integer :: main = etsf_main_none end type etsf_groups_flags !!*** !!****s* etsf_io/etsf_groups !! NAME !! etsf_groups !! !! FUNCTION !! This structure is a container for all available groups defined in the specifications. !! To use this structure, create a group (instanciating a #etsf_basisdata or a !! #etsf_geometry), and associate this group to its pointer: !! type(etsf_geometry) :: geometry_data !! type(etsf_groups) :: my_groups !! ... do something with geometry_data ... !! my_groups%geometry => geometry_data !! ... do something with my_groups ... !! Several groups can be associated at a time in #etsf_groups. !! !! SOURCE ! Folder for the groups of variables type etsf_groups type(etsf_geometry), pointer :: geometry => null() type(etsf_electrons), pointer :: electrons => null() type(etsf_kpoints), pointer :: kpoints => null() type(etsf_basisdata), pointer :: basisdata => null() type(etsf_gwdata), pointer :: gwdata => null() type(etsf_dielectric), pointer :: dielectric => null() type(etsf_main), pointer :: main => null() end type etsf_groups !!*** !!****s* etsf_io_basics_group/etsf_split !! FUNCTION !! This group is used to store description array in the case of a splitted file. !! !! SOURCE type etsf_split integer, pointer :: my_kpoints(:) => null() integer, pointer :: my_grid_points_vector3(:) => null() integer, pointer :: my_spins(:) => null() integer, pointer :: my_grid_points_vector1(:) => null() integer, pointer :: my_grid_points_vector2(:) => null() integer, pointer :: my_coefficients(:) => null() integer, pointer :: my_components(:) => null() integer, pointer :: my_states(:) => null() end type etsf_split !!*** ! Private group, use internally to get the name of dimensions ! that can be splitted. type split_dim_names character(len = 256) :: number_of_kpoints = "number_of_kpoints" character(len = 256) :: number_of_grid_points_vector3 = "number_of_grid_points_vector3" character(len = 256) :: number_of_spins = "number_of_spins" character(len = 256) :: number_of_grid_points_vector1 = "number_of_grid_points_vector1" character(len = 256) :: number_of_grid_points_vector2 = "number_of_grid_points_vector2" character(len = 256) :: max_number_of_coefficients = "max_number_of_coefficients" character(len = 256) :: number_of_components = "number_of_components" character(len = 256) :: max_number_of_states = "max_number_of_states" end type split_dim_names private :: split_dim_names !!****g* etsf_io/etsf_io_data_group !! FUNCTION !! These are the most usefull routines of the library etsf_io. They are used !! to read/write all or some selected variables of the ETSF specifications. !! !! SOURCE public :: etsf_groups public :: etsf_io_data_init public :: etsf_io_data_read public :: etsf_io_data_write !!*** !!****g* etsf_io/etsf_io_basics_group !! FUNCTION !! These are public parameters or types defined in the ETSF library. !! !! SOURCE public :: etsf_dims !!*** contains include "etsf_io_dims_def.f90" include "etsf_io_dims_get.f90" include "etsf_io_dims_merge.f90" include "etsf_io_dims_trace.f90" include "etsf_io_geometry_def.f90" include "etsf_io_electrons_def.f90" include "etsf_io_kpoints_def.f90" include "etsf_io_basisdata_def.f90" include "etsf_io_gwdata_def.f90" include "etsf_io_dielectric_def.f90" include "etsf_io_main_def.f90" include "etsf_io_geometry_get.f90" include "etsf_io_electrons_get.f90" include "etsf_io_kpoints_get.f90" include "etsf_io_basisdata_get.f90" include "etsf_io_gwdata_get.f90" include "etsf_io_dielectric_get.f90" include "etsf_io_main_get.f90" include "etsf_io_geometry_put.f90" include "etsf_io_electrons_put.f90" include "etsf_io_kpoints_put.f90" include "etsf_io_basisdata_put.f90" include "etsf_io_gwdata_put.f90" include "etsf_io_dielectric_put.f90" include "etsf_io_main_put.f90" include "etsf_io_geometry_copy.f90" include "etsf_io_electrons_copy.f90" include "etsf_io_kpoints_copy.f90" include "etsf_io_basisdata_copy.f90" include "etsf_io_gwdata_copy.f90" include "etsf_io_dielectric_copy.f90" include "etsf_io_main_copy.f90" include "etsf_io_split_init.f90" include "etsf_io_split_allocate.f90" include "etsf_io_split_free.f90" include "etsf_io_split_def.f90" include "etsf_io_split_get.f90" include "etsf_io_split_put.f90" include "etsf_io_split_copy.f90" include "etsf_io_split_merge.f90" include "etsf_io_vars_free.f90" include "etsf_io_data_init.f90" include "etsf_io_data_read.f90" include "etsf_io_data_write.f90" include "etsf_io_data_contents.f90" include "etsf_io_data_get.f90" include "etsf_io_data_copy.f90" end module etsf_io etsf_io-1.0.3/src/group_level/etsf_io_dims_def.f900000644000353400050630000004227311354150412017007 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_dims/etsf_io_dims_def !! NAME !! etsf_io_dims_def !! !! FUNCTION !! Create dimensions and set their values. For normal dimensions, their are defined !! if their values are different from etsf_no_dimension (see ETSF_IO_CONSTANTS). !! For split dimensions (my_), they are defined only if they are !! different from etsf_no_dimension or from the value of dimension . !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = !! integer returned by an 'open' NetCDF call. The file can be !! either in define or write mode. This status can be changed !! by the call. !! * dims = !! contains all the dimensions required by the ETSF file. These values !! will be used later to allocate the disk space for variables, see !! etsf_io_electrons_def() or routines of the same kind. !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_dims_def(ncid, dims, lstat, error_data) !Arguments ------------------------------------ integer, intent(in) :: ncid type(etsf_dims), intent(in) :: dims logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_dims_def' ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_dims_def : enter' !ENDDEBUG if (dims%character_string_length /= etsf_no_dimension) then call etsf_io_low_write_dim(ncid, "character_string_length", & & dims%character_string_length, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%complex /= etsf_no_dimension) then call etsf_io_low_write_dim(ncid, "complex", & & dims%complex, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%max_number_of_angular_momenta /= etsf_no_dimension) then call etsf_io_low_write_dim(ncid, "max_number_of_angular_momenta", & & dims%max_number_of_angular_momenta, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%max_number_of_basis_grid_points /= etsf_no_dimension) then call etsf_io_low_write_dim(ncid, "max_number_of_basis_grid_points", & & dims%max_number_of_basis_grid_points, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%max_number_of_coefficients /= etsf_no_dimension) then call etsf_io_low_write_dim(ncid, "max_number_of_coefficients", & & dims%max_number_of_coefficients, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%max_number_of_projectors /= etsf_no_dimension) then call etsf_io_low_write_dim(ncid, "max_number_of_projectors", & & dims%max_number_of_projectors, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%max_number_of_states /= etsf_no_dimension) then call etsf_io_low_write_dim(ncid, "max_number_of_states", & & dims%max_number_of_states, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%number_of_atoms /= etsf_no_dimension) then call etsf_io_low_write_dim(ncid, "number_of_atoms", & & dims%number_of_atoms, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%number_of_atom_species /= etsf_no_dimension) then call etsf_io_low_write_dim(ncid, "number_of_atom_species", & & dims%number_of_atom_species, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%number_of_cartesian_directions /= etsf_no_dimension) then call etsf_io_low_write_dim(ncid, "number_of_cartesian_directions", & & dims%number_of_cartesian_directions, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%number_of_coefficients_dielectric_function /= etsf_no_dimension) then call etsf_io_low_write_dim(ncid, "number_of_coefficients_dielectric_function", & & dims%number_of_coefficients_dielectric_function, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%number_of_components /= etsf_no_dimension) then call etsf_io_low_write_dim(ncid, "number_of_components", & & dims%number_of_components, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%number_of_frequencies_dielectric_function /= etsf_no_dimension) then call etsf_io_low_write_dim(ncid, "number_of_frequencies_dielectric_function", & & dims%number_of_frequencies_dielectric_function, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%number_of_grid_points_vector1 /= etsf_no_dimension) then call etsf_io_low_write_dim(ncid, "number_of_grid_points_vector1", & & dims%number_of_grid_points_vector1, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%number_of_grid_points_vector2 /= etsf_no_dimension) then call etsf_io_low_write_dim(ncid, "number_of_grid_points_vector2", & & dims%number_of_grid_points_vector2, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%number_of_grid_points_vector3 /= etsf_no_dimension) then call etsf_io_low_write_dim(ncid, "number_of_grid_points_vector3", & & dims%number_of_grid_points_vector3, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%number_of_kpoints /= etsf_no_dimension) then call etsf_io_low_write_dim(ncid, "number_of_kpoints", & & dims%number_of_kpoints, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%number_of_localization_regions /= etsf_no_dimension) then call etsf_io_low_write_dim(ncid, "number_of_localization_regions", & & dims%number_of_localization_regions, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%number_of_qpoints_dielectric_function /= etsf_no_dimension) then call etsf_io_low_write_dim(ncid, "number_of_qpoints_dielectric_function", & & dims%number_of_qpoints_dielectric_function, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%number_of_qpoints_gamma_limit /= etsf_no_dimension) then call etsf_io_low_write_dim(ncid, "number_of_qpoints_gamma_limit", & & dims%number_of_qpoints_gamma_limit, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%number_of_reduced_dimensions /= etsf_no_dimension) then call etsf_io_low_write_dim(ncid, "number_of_reduced_dimensions", & & dims%number_of_reduced_dimensions, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%number_of_spinor_components /= etsf_no_dimension) then call etsf_io_low_write_dim(ncid, "number_of_spinor_components", & & dims%number_of_spinor_components, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%number_of_spins /= etsf_no_dimension) then call etsf_io_low_write_dim(ncid, "number_of_spins", & & dims%number_of_spins, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%number_of_symmetry_operations /= etsf_no_dimension) then call etsf_io_low_write_dim(ncid, "number_of_symmetry_operations", & & dims%number_of_symmetry_operations, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%number_of_vectors /= etsf_no_dimension) then call etsf_io_low_write_dim(ncid, "number_of_vectors", & & dims%number_of_vectors, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%real_or_complex_coefficients /= etsf_no_dimension) then call etsf_io_low_write_dim(ncid, "real_or_complex_coefficients", & & dims%real_or_complex_coefficients, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%real_or_complex_density /= etsf_no_dimension) then call etsf_io_low_write_dim(ncid, "real_or_complex_density", & & dims%real_or_complex_density, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%real_or_complex_gw_corrections /= etsf_no_dimension) then call etsf_io_low_write_dim(ncid, "real_or_complex_gw_corrections", & & dims%real_or_complex_gw_corrections, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%real_or_complex_potential /= etsf_no_dimension) then call etsf_io_low_write_dim(ncid, "real_or_complex_potential", & & dims%real_or_complex_potential, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%real_or_complex_wavefunctions /= etsf_no_dimension) then call etsf_io_low_write_dim(ncid, "real_or_complex_wavefunctions", & & dims%real_or_complex_wavefunctions, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%symbol_length /= etsf_no_dimension) then call etsf_io_low_write_dim(ncid, "symbol_length", & & dims%symbol_length, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%my_max_number_of_coefficients /= etsf_no_dimension .and. & dims%my_max_number_of_coefficients /= dims%max_number_of_coefficients) then call etsf_io_low_write_dim(ncid, "my_max_number_of_coefficients", & & dims%my_max_number_of_coefficients, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%my_max_number_of_states /= etsf_no_dimension .and. & dims%my_max_number_of_states /= dims%max_number_of_states) then call etsf_io_low_write_dim(ncid, "my_max_number_of_states", & & dims%my_max_number_of_states, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%my_number_of_components /= etsf_no_dimension .and. & dims%my_number_of_components /= dims%number_of_components) then call etsf_io_low_write_dim(ncid, "my_number_of_components", & & dims%my_number_of_components, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%my_number_of_grid_points_vect1 /= etsf_no_dimension .and. & dims%my_number_of_grid_points_vect1 /= dims%number_of_grid_points_vector1) then call etsf_io_low_write_dim(ncid, "my_number_of_grid_points_vector1", & & dims%my_number_of_grid_points_vect1, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%my_number_of_grid_points_vect2 /= etsf_no_dimension .and. & dims%my_number_of_grid_points_vect2 /= dims%number_of_grid_points_vector2) then call etsf_io_low_write_dim(ncid, "my_number_of_grid_points_vector2", & & dims%my_number_of_grid_points_vect2, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%my_number_of_grid_points_vect3 /= etsf_no_dimension .and. & dims%my_number_of_grid_points_vect3 /= dims%number_of_grid_points_vector3) then call etsf_io_low_write_dim(ncid, "my_number_of_grid_points_vector3", & & dims%my_number_of_grid_points_vect3, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%my_number_of_kpoints /= etsf_no_dimension .and. & dims%my_number_of_kpoints /= dims%number_of_kpoints) then call etsf_io_low_write_dim(ncid, "my_number_of_kpoints", & & dims%my_number_of_kpoints, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (dims%my_number_of_spins /= etsf_no_dimension .and. & dims%my_number_of_spins /= dims%number_of_spins) then call etsf_io_low_write_dim(ncid, "my_number_of_spins", & & dims%my_number_of_spins, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if lstat = .true. !DEBUG !write (*,*) 'etsf_io_dims_def : exit' !ENDDEBUG end subroutine etsf_io_dims_def !!*** etsf_io-1.0.3/src/group_level/etsf_io_dims_get.f900000644000353400050630000004445511354150412017034 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_dims/etsf_io_dims_get !! NAME !! etsf_io_dims_get !! !! FUNCTION !! Read the dimensions from an ETSF file. If one dimension is not found, !! its value is put to etsf_no_dimension (see ETSF_IO_CONSTANTS). !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = !! integer returned by an 'open' NetCDF call. The file can be !! either in define or write mode. This status can be changed !! by the call. !! OUTPUT !! * dims = !! an allocated structure to put the read values for all dimensions !! of the ETSF file pointed by @ncid. !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_dims_get(ncid, dims, lstat, error_data) !Arguments ------------------------------------ integer, intent(in) :: ncid type(etsf_dims), intent(out) :: dims logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_dims_get' ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_dims_get : enter' !ENDDEBUG call etsf_io_low_read_dim(ncid, "character_string_length", & & dims%character_string_length, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%character_string_length = etsf_no_dimension else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "complex", & & dims%complex, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%complex = etsf_no_dimension else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "max_number_of_angular_momenta", & & dims%max_number_of_angular_momenta, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%max_number_of_angular_momenta = etsf_no_dimension else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "max_number_of_basis_grid_points", & & dims%max_number_of_basis_grid_points, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%max_number_of_basis_grid_points = etsf_no_dimension else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "max_number_of_coefficients", & & dims%max_number_of_coefficients, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%max_number_of_coefficients = etsf_no_dimension else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "max_number_of_projectors", & & dims%max_number_of_projectors, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%max_number_of_projectors = etsf_no_dimension else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "max_number_of_states", & & dims%max_number_of_states, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%max_number_of_states = etsf_no_dimension else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "number_of_atoms", & & dims%number_of_atoms, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%number_of_atoms = etsf_no_dimension else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "number_of_atom_species", & & dims%number_of_atom_species, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%number_of_atom_species = etsf_no_dimension else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "number_of_cartesian_directions", & & dims%number_of_cartesian_directions, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%number_of_cartesian_directions = etsf_no_dimension else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "number_of_coefficients_dielectric_function", & & dims%number_of_coefficients_dielectric_function, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%number_of_coefficients_dielectric_function = etsf_no_dimension else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "number_of_components", & & dims%number_of_components, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%number_of_components = etsf_no_dimension else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "number_of_frequencies_dielectric_function", & & dims%number_of_frequencies_dielectric_function, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%number_of_frequencies_dielectric_function = etsf_no_dimension else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "number_of_grid_points_vector1", & & dims%number_of_grid_points_vector1, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%number_of_grid_points_vector1 = etsf_no_dimension else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "number_of_grid_points_vector2", & & dims%number_of_grid_points_vector2, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%number_of_grid_points_vector2 = etsf_no_dimension else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "number_of_grid_points_vector3", & & dims%number_of_grid_points_vector3, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%number_of_grid_points_vector3 = etsf_no_dimension else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "number_of_kpoints", & & dims%number_of_kpoints, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%number_of_kpoints = etsf_no_dimension else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "number_of_localization_regions", & & dims%number_of_localization_regions, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%number_of_localization_regions = etsf_no_dimension else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "number_of_qpoints_dielectric_function", & & dims%number_of_qpoints_dielectric_function, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%number_of_qpoints_dielectric_function = etsf_no_dimension else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "number_of_qpoints_gamma_limit", & & dims%number_of_qpoints_gamma_limit, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%number_of_qpoints_gamma_limit = etsf_no_dimension else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "number_of_reduced_dimensions", & & dims%number_of_reduced_dimensions, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%number_of_reduced_dimensions = etsf_no_dimension else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "number_of_spinor_components", & & dims%number_of_spinor_components, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%number_of_spinor_components = etsf_no_dimension else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "number_of_spins", & & dims%number_of_spins, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%number_of_spins = etsf_no_dimension else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "number_of_symmetry_operations", & & dims%number_of_symmetry_operations, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%number_of_symmetry_operations = etsf_no_dimension else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "number_of_vectors", & & dims%number_of_vectors, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%number_of_vectors = etsf_no_dimension else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "real_or_complex_coefficients", & & dims%real_or_complex_coefficients, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%real_or_complex_coefficients = etsf_no_dimension else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "real_or_complex_density", & & dims%real_or_complex_density, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%real_or_complex_density = etsf_no_dimension else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "real_or_complex_gw_corrections", & & dims%real_or_complex_gw_corrections, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%real_or_complex_gw_corrections = etsf_no_dimension else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "real_or_complex_potential", & & dims%real_or_complex_potential, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%real_or_complex_potential = etsf_no_dimension else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "real_or_complex_wavefunctions", & & dims%real_or_complex_wavefunctions, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%real_or_complex_wavefunctions = etsf_no_dimension else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "symbol_length", & & dims%symbol_length, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%symbol_length = etsf_no_dimension else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "my_max_number_of_coefficients", & & dims%my_max_number_of_coefficients, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%my_max_number_of_coefficients = dims%max_number_of_coefficients else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "my_max_number_of_states", & & dims%my_max_number_of_states, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%my_max_number_of_states = dims%max_number_of_states else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "my_number_of_components", & & dims%my_number_of_components, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%my_number_of_components = dims%number_of_components else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "my_number_of_grid_points_vector1", & & dims%my_number_of_grid_points_vect1, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%my_number_of_grid_points_vect1 = dims%number_of_grid_points_vector1 else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "my_number_of_grid_points_vector2", & & dims%my_number_of_grid_points_vect2, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%my_number_of_grid_points_vect2 = dims%number_of_grid_points_vector2 else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "my_number_of_grid_points_vector3", & & dims%my_number_of_grid_points_vect3, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%my_number_of_grid_points_vect3 = dims%number_of_grid_points_vector3 else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "my_number_of_kpoints", & & dims%my_number_of_kpoints, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%my_number_of_kpoints = dims%number_of_kpoints else call etsf_io_low_error_update(error_data, my_name) return end if end if call etsf_io_low_read_dim(ncid, "my_number_of_spins", & & dims%my_number_of_spins, & & lstat, error_data = error_data) if (.not. lstat) then if (error_data%access_mode_id == ERROR_MODE_INQ) then dims%my_number_of_spins = dims%number_of_spins else call etsf_io_low_error_update(error_data, my_name) return end if end if lstat = .true. !DEBUG !write (*,*) 'etsf_io_dims_get : exit' !ENDDEBUG end subroutine etsf_io_dims_get !!*** etsf_io-1.0.3/src/group_level/etsf_io_dims_merge.f900000644000353400050630000003025511354150412017345 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_dims/etsf_io_dims_merge !! NAME !! etsf_io_dims_merge !! !! FUNCTION !! It is a checking routine. For all variable, it checks that values are the same !! in source and destination. For my_ variables, if values are different !! then output value is the sum of previous value and input value. This is useful !! when the dimensions have split definition. In that case, merging all input file !! dimensions will check classical dimensions and sum all split dimensions. At !! the end, if my_ is equal to then the merging of the !! files will end up in suppressing the split for the variable. In !! the other case (my_ < ), the resulting merge file !! will still have a split dimension but with more values. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * dims = !! the dimensions to be merge into argument @output_dims. If the dimension begin !! with my_something, if the value is different from the something dimension, it !! is added into @output_dims. If the dimension is a regular one, the equity is !! only checked between dims and output_dims. !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! SIDE EFFECTS !! * output_dims = !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_dims_merge(output_dims, dims, lstat, error_data) !Arguments ------------------------------------ type(etsf_dims), intent(inout) :: output_dims type(etsf_dims), intent(in) :: dims logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_dims_merge' ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_dims_merge : enter' !ENDDEBUG lstat = .false. if (output_dims%character_string_length /= dims%character_string_length) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible dimension for merge.") return end if if (output_dims%complex /= dims%complex) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible dimension for merge.") return end if if (output_dims%max_number_of_angular_momenta /= dims%max_number_of_angular_momenta) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible dimension for merge.") return end if if (output_dims%max_number_of_basis_grid_points /= dims%max_number_of_basis_grid_points) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible dimension for merge.") return end if if (output_dims%max_number_of_coefficients /= dims%max_number_of_coefficients) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible dimension for merge.") return end if if (output_dims%max_number_of_projectors /= dims%max_number_of_projectors) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible dimension for merge.") return end if if (output_dims%max_number_of_states /= dims%max_number_of_states) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible dimension for merge.") return end if if (output_dims%number_of_atoms /= dims%number_of_atoms) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible dimension for merge.") return end if if (output_dims%number_of_atom_species /= dims%number_of_atom_species) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible dimension for merge.") return end if if (output_dims%number_of_cartesian_directions /= dims%number_of_cartesian_directions) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible dimension for merge.") return end if if (output_dims%number_of_coefficients_dielectric_function /= dims%number_of_coefficients_dielectric_function) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible dimension for merge.") return end if if (output_dims%number_of_components /= dims%number_of_components) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible dimension for merge.") return end if if (output_dims%number_of_frequencies_dielectric_function /= dims%number_of_frequencies_dielectric_function) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible dimension for merge.") return end if if (output_dims%number_of_grid_points_vector1 /= dims%number_of_grid_points_vector1) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible dimension for merge.") return end if if (output_dims%number_of_grid_points_vector2 /= dims%number_of_grid_points_vector2) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible dimension for merge.") return end if if (output_dims%number_of_grid_points_vector3 /= dims%number_of_grid_points_vector3) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible dimension for merge.") return end if if (output_dims%number_of_kpoints /= dims%number_of_kpoints) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible dimension for merge.") return end if if (output_dims%number_of_localization_regions /= dims%number_of_localization_regions) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible dimension for merge.") return end if if (output_dims%number_of_qpoints_dielectric_function /= dims%number_of_qpoints_dielectric_function) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible dimension for merge.") return end if if (output_dims%number_of_qpoints_gamma_limit /= dims%number_of_qpoints_gamma_limit) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible dimension for merge.") return end if if (output_dims%number_of_reduced_dimensions /= dims%number_of_reduced_dimensions) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible dimension for merge.") return end if if (output_dims%number_of_spinor_components /= dims%number_of_spinor_components) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible dimension for merge.") return end if if (output_dims%number_of_spins /= dims%number_of_spins) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible dimension for merge.") return end if if (output_dims%number_of_symmetry_operations /= dims%number_of_symmetry_operations) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible dimension for merge.") return end if if (output_dims%number_of_vectors /= dims%number_of_vectors) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible dimension for merge.") return end if if (output_dims%real_or_complex_coefficients /= dims%real_or_complex_coefficients) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible dimension for merge.") return end if if (output_dims%real_or_complex_density /= dims%real_or_complex_density) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible dimension for merge.") return end if if (output_dims%real_or_complex_gw_corrections /= dims%real_or_complex_gw_corrections) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible dimension for merge.") return end if if (output_dims%real_or_complex_potential /= dims%real_or_complex_potential) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible dimension for merge.") return end if if (output_dims%real_or_complex_wavefunctions /= dims%real_or_complex_wavefunctions) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible dimension for merge.") return end if if (output_dims%symbol_length /= dims%symbol_length) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible dimension for merge.") return end if if (output_dims%my_max_number_of_coefficients /= output_dims%max_number_of_coefficients) then output_dims%my_max_number_of_coefficients = output_dims%my_max_number_of_coefficients + & & dims%my_max_number_of_coefficients end if if (output_dims%my_max_number_of_states /= output_dims%max_number_of_states) then output_dims%my_max_number_of_states = output_dims%my_max_number_of_states + & & dims%my_max_number_of_states end if if (output_dims%my_number_of_components /= output_dims%number_of_components) then output_dims%my_number_of_components = output_dims%my_number_of_components + & & dims%my_number_of_components end if if (output_dims%my_number_of_grid_points_vect1 /= output_dims%number_of_grid_points_vector1) then output_dims%my_number_of_grid_points_vect1 = output_dims%my_number_of_grid_points_vect1 + & & dims%my_number_of_grid_points_vect1 end if if (output_dims%my_number_of_grid_points_vect2 /= output_dims%number_of_grid_points_vector2) then output_dims%my_number_of_grid_points_vect2 = output_dims%my_number_of_grid_points_vect2 + & & dims%my_number_of_grid_points_vect2 end if if (output_dims%my_number_of_grid_points_vect3 /= output_dims%number_of_grid_points_vector3) then output_dims%my_number_of_grid_points_vect3 = output_dims%my_number_of_grid_points_vect3 + & & dims%my_number_of_grid_points_vect3 end if if (output_dims%my_number_of_kpoints /= output_dims%number_of_kpoints) then output_dims%my_number_of_kpoints = output_dims%my_number_of_kpoints + & & dims%my_number_of_kpoints end if if (output_dims%my_number_of_spins /= output_dims%number_of_spins) then output_dims%my_number_of_spins = output_dims%my_number_of_spins + & & dims%my_number_of_spins end if lstat = .true. !DEBUG !write (*,*) 'etsf_io_dims_merge : exit' !ENDDEBUG end subroutine etsf_io_dims_merge !!*** etsf_io-1.0.3/src/group_level/etsf_io_dims_trace.f900000644000353400050630000001172511354150413017346 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_dims/etsf_io_dims_trace !! NAME !! etsf_io_dims_trace !! !! FUNCTION !! Output for each variable its value. Essentially used for debugging. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * dims = !! the structure that should be output on screen. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_dims_trace(dims) !Arguments ------------------------------------ type(etsf_dims), intent(in) :: dims !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_dims_trace' ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_dims_trace : enter' !ENDDEBUG write(*, "(A42,A,I6)") "character_string_length", & & ": ", dims%character_string_length write(*, "(A42,A,I6)") "complex", & & ": ", dims%complex write(*, "(A42,A,I6)") "max_number_of_angular_momenta", & & ": ", dims%max_number_of_angular_momenta write(*, "(A42,A,I6)") "max_number_of_basis_grid_points", & & ": ", dims%max_number_of_basis_grid_points write(*, "(A42,A,I6)") "max_number_of_coefficients", & & ": ", dims%max_number_of_coefficients write(*, "(A42,A,I6)") "max_number_of_projectors", & & ": ", dims%max_number_of_projectors write(*, "(A42,A,I6)") "max_number_of_states", & & ": ", dims%max_number_of_states write(*, "(A42,A,I6)") "number_of_atoms", & & ": ", dims%number_of_atoms write(*, "(A42,A,I6)") "number_of_atom_species", & & ": ", dims%number_of_atom_species write(*, "(A42,A,I6)") "number_of_cartesian_directions", & & ": ", dims%number_of_cartesian_directions write(*, "(A42,A,I6)") "number_of_coefficients_dielectric_function", & & ": ", dims%number_of_coefficients_dielectric_function write(*, "(A42,A,I6)") "number_of_components", & & ": ", dims%number_of_components write(*, "(A42,A,I6)") "number_of_frequencies_dielectric_function", & & ": ", dims%number_of_frequencies_dielectric_function write(*, "(A42,A,I6)") "number_of_grid_points_vector1", & & ": ", dims%number_of_grid_points_vector1 write(*, "(A42,A,I6)") "number_of_grid_points_vector2", & & ": ", dims%number_of_grid_points_vector2 write(*, "(A42,A,I6)") "number_of_grid_points_vector3", & & ": ", dims%number_of_grid_points_vector3 write(*, "(A42,A,I6)") "number_of_kpoints", & & ": ", dims%number_of_kpoints write(*, "(A42,A,I6)") "number_of_localization_regions", & & ": ", dims%number_of_localization_regions write(*, "(A42,A,I6)") "number_of_qpoints_dielectric_function", & & ": ", dims%number_of_qpoints_dielectric_function write(*, "(A42,A,I6)") "number_of_qpoints_gamma_limit", & & ": ", dims%number_of_qpoints_gamma_limit write(*, "(A42,A,I6)") "number_of_reduced_dimensions", & & ": ", dims%number_of_reduced_dimensions write(*, "(A42,A,I6)") "number_of_spinor_components", & & ": ", dims%number_of_spinor_components write(*, "(A42,A,I6)") "number_of_spins", & & ": ", dims%number_of_spins write(*, "(A42,A,I6)") "number_of_symmetry_operations", & & ": ", dims%number_of_symmetry_operations write(*, "(A42,A,I6)") "number_of_vectors", & & ": ", dims%number_of_vectors write(*, "(A42,A,I6)") "real_or_complex_coefficients", & & ": ", dims%real_or_complex_coefficients write(*, "(A42,A,I6)") "real_or_complex_density", & & ": ", dims%real_or_complex_density write(*, "(A42,A,I6)") "real_or_complex_gw_corrections", & & ": ", dims%real_or_complex_gw_corrections write(*, "(A42,A,I6)") "real_or_complex_potential", & & ": ", dims%real_or_complex_potential write(*, "(A42,A,I6)") "real_or_complex_wavefunctions", & & ": ", dims%real_or_complex_wavefunctions write(*, "(A42,A,I6)") "symbol_length", & & ": ", dims%symbol_length write(*, "(A42,A,I6)") "my_max_number_of_coefficients", & & ": ", dims%my_max_number_of_coefficients write(*, "(A42,A,I6)") "my_max_number_of_states", & & ": ", dims%my_max_number_of_states write(*, "(A42,A,I6)") "my_number_of_components", & & ": ", dims%my_number_of_components write(*, "(A42,A,I6)") "my_number_of_grid_points_vect1", & & ": ", dims%my_number_of_grid_points_vect1 write(*, "(A42,A,I6)") "my_number_of_grid_points_vect2", & & ": ", dims%my_number_of_grid_points_vect2 write(*, "(A42,A,I6)") "my_number_of_grid_points_vect3", & & ": ", dims%my_number_of_grid_points_vect3 write(*, "(A42,A,I6)") "my_number_of_kpoints", & & ": ", dims%my_number_of_kpoints write(*, "(A42,A,I6)") "my_number_of_spins", & & ": ", dims%my_number_of_spins !DEBUG !write (*,*) 'etsf_io_dims_trace : exit' !ENDDEBUG end subroutine etsf_io_dims_trace !!*** etsf_io-1.0.3/src/group_level/etsf_io_geometry_def.f900000644000353400050630000002436211354150413017706 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_geometry/etsf_io_geometry_def !! NAME !! etsf_io_geometry_def !! !! FUNCTION !! The given ETSF file must be opened and in define state (see !! etsf_io_low_set_define_mode() to change it). Then, all variable of the group !! are defined. All required dimensions must have already defined (see !! etsf_io_dims_def(). If some dimensions are missing, then the variable !! is not defined and no error are generated. !! !! One can specify which variable may be splitted using the optional argument !! @split. For each associated array in this structure, variable with appropriated !! dimensions will use my_ instead of . !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = !! integer returned by an 'open' NetCDF call. The file can be !! either in define or write mode. This status can be changed !! by the call. !! * k_dependent = (optional) !! use this argument to set the attribute flag 'k_dependent' to 'yes' !! or 'no' on variables that have it. If no variable in the group has !! the attribute 'k_dependent', this argument has no effect. The default !! value is .true. (which puts 'yes' in the file). !! * flags = (optional) !! One can choose the variables of the group !! that will be defined (and disk allocated) using this flag. This is a sum !! of values taken from #FLAGS_VARIABLES. !! * split = (optional) !! for each array associated in the type, the dimension used to declared the !! variables sizes will be 'my_/something/'. !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_geometry_def(ncid, lstat, error_data, k_dependent, flags, & & split) !Arguments ------------------------------------ integer, intent(in) :: ncid logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data logical, optional, intent(in) :: k_dependent integer, optional, intent(in) :: flags type(etsf_split), optional, intent(in) :: split !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_geometry_def' logical :: my_k_dependent integer :: my_flags type(etsf_split) :: my_split integer :: ivar type(split_dim_names) :: split_dims ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_geometry_def : enter' !ENDDEBUG ! Get values for optional arguments, set default. if (present(k_dependent)) then my_k_dependent = k_dependent else my_k_dependent = .true. end if if (present(flags)) then my_flags = flags else my_flags = etsf_geometry_all end if ! Consistency checks. if (my_flags < etsf_geometry_none .or. my_flags > etsf_geometry_all) then call etsf_io_low_error_set(error_data, ERROR_MODE_DEF, ERROR_TYPE_ARG, my_name, & & tgtname = "flags", errmess = "value out of bounds") lstat = .false. return end if if (iand(my_flags, etsf_geometry_space_group) /= 0) then call etsf_io_low_def_var(ncid, "space_group", & & etsf_io_low_integer, & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_geometry_primitive_vectors) /= 0) then call etsf_io_low_def_var(ncid, "primitive_vectors", & & etsf_io_low_double, & & (/ pad("number_of_cartesian_directions"), & & pad("number_of_vectors") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_geometry_red_sym_matrices) /= 0) then call etsf_io_low_def_var(ncid, "reduced_symmetry_matrices", & & etsf_io_low_integer, & & (/ pad("number_of_reduced_dimensions"), & & pad("number_of_reduced_dimensions"), & & pad("number_of_symmetry_operations") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if if (ivar >= 0) then ! Handle the symmorphic attribute. call etsf_io_low_write_att(ncid, ivar, & & "symmorphic", & & "yes", & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if end if if (iand(my_flags, etsf_geometry_red_sym_trans) /= 0) then call etsf_io_low_def_var(ncid, "reduced_symmetry_translations", & & etsf_io_low_double, & & (/ pad("number_of_reduced_dimensions"), & & pad("number_of_symmetry_operations") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_geometry_atom_species) /= 0) then call etsf_io_low_def_var(ncid, "atom_species", & & etsf_io_low_integer, & & (/ pad("number_of_atoms") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_geometry_red_at_pos) /= 0) then call etsf_io_low_def_var(ncid, "reduced_atom_positions", & & etsf_io_low_double, & & (/ pad("number_of_reduced_dimensions"), & & pad("number_of_atoms") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_geometry_valence_charges) /= 0) then call etsf_io_low_def_var(ncid, "valence_charges", & & etsf_io_low_double, & & (/ pad("number_of_atom_species") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_geometry_atomic_numbers) /= 0) then call etsf_io_low_def_var(ncid, "atomic_numbers", & & etsf_io_low_double, & & (/ pad("number_of_atom_species") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_geometry_atom_species_names) /= 0) then call etsf_io_low_def_var(ncid, "atom_species_names", & & etsf_io_low_character, & & (/ pad("character_string_length"), & & pad("number_of_atom_species") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_geometry_chemical_symbols) /= 0) then call etsf_io_low_def_var(ncid, "chemical_symbols", & & etsf_io_low_character, & & (/ pad("symbol_length"), & & pad("number_of_atom_species") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_geometry_pseudo_types) /= 0) then call etsf_io_low_def_var(ncid, "pseudopotential_types", & & etsf_io_low_character, & & (/ pad("character_string_length"), & & pad("number_of_atom_species") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if ! If we reach the end, then it should be OK. lstat = .true. !DEBUG !write (*,*) 'etsf_io_geometry_def : exit' !ENDDEBUG end subroutine etsf_io_geometry_def !!*** etsf_io-1.0.3/src/group_level/etsf_io_electrons_def.f900000644000353400050630000002557611354150413020061 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_electrons/etsf_io_electrons_def !! NAME !! etsf_io_electrons_def !! !! FUNCTION !! The given ETSF file must be opened and in define state (see !! etsf_io_low_set_define_mode() to change it). Then, all variable of the group !! are defined. All required dimensions must have already defined (see !! etsf_io_dims_def(). If some dimensions are missing, then the variable !! is not defined and no error are generated. !! !! One can specify which variable may be splitted using the optional argument !! @split. For each associated array in this structure, variable with appropriated !! dimensions will use my_ instead of . !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = !! integer returned by an 'open' NetCDF call. The file can be !! either in define or write mode. This status can be changed !! by the call. !! * k_dependent = (optional) !! use this argument to set the attribute flag 'k_dependent' to 'yes' !! or 'no' on variables that have it. If no variable in the group has !! the attribute 'k_dependent', this argument has no effect. The default !! value is .true. (which puts 'yes' in the file). !! * flags = (optional) !! One can choose the variables of the group !! that will be defined (and disk allocated) using this flag. This is a sum !! of values taken from #FLAGS_VARIABLES. !! * split = (optional) !! for each array associated in the type, the dimension used to declared the !! variables sizes will be 'my_/something/'. !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_electrons_def(ncid, lstat, error_data, k_dependent, flags, & & split) !Arguments ------------------------------------ integer, intent(in) :: ncid logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data logical, optional, intent(in) :: k_dependent integer, optional, intent(in) :: flags type(etsf_split), optional, intent(in) :: split !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_electrons_def' logical :: my_k_dependent integer :: my_flags type(etsf_split) :: my_split integer :: ivar type(split_dim_names) :: split_dims ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_electrons_def : enter' !ENDDEBUG ! Get values for optional arguments, set default. if (present(k_dependent)) then my_k_dependent = k_dependent else my_k_dependent = .true. end if if (present(flags)) then my_flags = flags else my_flags = etsf_electrons_all end if ! Consistency checks. if (my_flags < etsf_electrons_none .or. my_flags > etsf_electrons_all) then call etsf_io_low_error_set(error_data, ERROR_MODE_DEF, ERROR_TYPE_ARG, my_name, & & tgtname = "flags", errmess = "value out of bounds") lstat = .false. return end if ! Set the name for dimensions that could be splitted. if (present(split)) then if (associated(split%my_kpoints)) then write(split_dims%number_of_kpoints, "(A)") & & "my_number_of_kpoints" end if if (associated(split%my_spins)) then write(split_dims%number_of_spins, "(A)") & & "my_number_of_spins" end if if (associated(split%my_states)) then write(split_dims%max_number_of_states, "(A)") & & "my_max_number_of_states" end if end if if (iand(my_flags, etsf_electrons_number_of_electrons) /= 0) then call etsf_io_low_def_var(ncid, "number_of_electrons", & & etsf_io_low_integer, & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_electrons_x_functional) /= 0) then call etsf_io_low_def_var(ncid, "exchange_functional", & & etsf_io_low_character, & & (/ pad("character_string_length") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_electrons_c_functional) /= 0) then call etsf_io_low_def_var(ncid, "correlation_functional", & & etsf_io_low_character, & & (/ pad("character_string_length") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_electrons_fermi_energy) /= 0) then call etsf_io_low_def_var(ncid, "fermi_energy", & & etsf_io_low_double, & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if if (ivar >= 0) then ! Handle the units attribute. call etsf_io_low_write_att(ncid, ivar, & & "units", & & "atomic units", & & lstat, error_data = error_data) if (.not. lstat) return call etsf_io_low_write_att(ncid, ivar, & & "scale_to_atomic_units", & & 1.0d0, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if end if if (iand(my_flags, etsf_electrons_smearing_scheme) /= 0) then call etsf_io_low_def_var(ncid, "smearing_scheme", & & etsf_io_low_character, & & (/ pad("character_string_length") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_electrons_smearing_width) /= 0) then call etsf_io_low_def_var(ncid, "smearing_width", & & etsf_io_low_double, & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if if (ivar >= 0) then ! Handle the units attribute. call etsf_io_low_write_att(ncid, ivar, & & "units", & & "atomic units", & & lstat, error_data = error_data) if (.not. lstat) return call etsf_io_low_write_att(ncid, ivar, & & "scale_to_atomic_units", & & 1.0d0, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if end if if (iand(my_flags, etsf_electrons_number_of_states) /= 0) then call etsf_io_low_def_var(ncid, "number_of_states", & & etsf_io_low_integer, & & (/ split_dims%number_of_kpoints, & & split_dims%number_of_spins /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_electrons_eigenvalues) /= 0) then call etsf_io_low_def_var(ncid, "eigenvalues", & & etsf_io_low_double, & & (/ split_dims%max_number_of_states, & & split_dims%number_of_kpoints, & & split_dims%number_of_spins /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if if (ivar >= 0) then ! Handle the units attribute. call etsf_io_low_write_att(ncid, ivar, & & "units", & & "atomic units", & & lstat, error_data = error_data) if (.not. lstat) return call etsf_io_low_write_att(ncid, ivar, & & "scale_to_atomic_units", & & 1.0d0, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if end if if (iand(my_flags, etsf_electrons_occupations) /= 0) then call etsf_io_low_def_var(ncid, "occupations", & & etsf_io_low_double, & & (/ split_dims%max_number_of_states, & & split_dims%number_of_kpoints, & & split_dims%number_of_spins /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if ! If we reach the end, then it should be OK. lstat = .true. !DEBUG !write (*,*) 'etsf_io_electrons_def : exit' !ENDDEBUG end subroutine etsf_io_electrons_def !!*** etsf_io-1.0.3/src/group_level/etsf_io_kpoints_def.f900000644000353400050630000001521211354150413017534 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_kpoints/etsf_io_kpoints_def !! NAME !! etsf_io_kpoints_def !! !! FUNCTION !! The given ETSF file must be opened and in define state (see !! etsf_io_low_set_define_mode() to change it). Then, all variable of the group !! are defined. All required dimensions must have already defined (see !! etsf_io_dims_def(). If some dimensions are missing, then the variable !! is not defined and no error are generated. !! !! One can specify which variable may be splitted using the optional argument !! @split. For each associated array in this structure, variable with appropriated !! dimensions will use my_ instead of . !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = !! integer returned by an 'open' NetCDF call. The file can be !! either in define or write mode. This status can be changed !! by the call. !! * k_dependent = (optional) !! use this argument to set the attribute flag 'k_dependent' to 'yes' !! or 'no' on variables that have it. If no variable in the group has !! the attribute 'k_dependent', this argument has no effect. The default !! value is .true. (which puts 'yes' in the file). !! * flags = (optional) !! One can choose the variables of the group !! that will be defined (and disk allocated) using this flag. This is a sum !! of values taken from #FLAGS_VARIABLES. !! * split = (optional) !! for each array associated in the type, the dimension used to declared the !! variables sizes will be 'my_/something/'. !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_kpoints_def(ncid, lstat, error_data, k_dependent, flags, & & split) !Arguments ------------------------------------ integer, intent(in) :: ncid logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data logical, optional, intent(in) :: k_dependent integer, optional, intent(in) :: flags type(etsf_split), optional, intent(in) :: split !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_kpoints_def' logical :: my_k_dependent integer :: my_flags type(etsf_split) :: my_split integer :: ivar type(split_dim_names) :: split_dims ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_kpoints_def : enter' !ENDDEBUG ! Get values for optional arguments, set default. if (present(k_dependent)) then my_k_dependent = k_dependent else my_k_dependent = .true. end if if (present(flags)) then my_flags = flags else my_flags = etsf_kpoints_all end if ! Consistency checks. if (my_flags < etsf_kpoints_none .or. my_flags > etsf_kpoints_all) then call etsf_io_low_error_set(error_data, ERROR_MODE_DEF, ERROR_TYPE_ARG, my_name, & & tgtname = "flags", errmess = "value out of bounds") lstat = .false. return end if ! Set the name for dimensions that could be splitted. if (present(split)) then if (associated(split%my_kpoints)) then write(split_dims%number_of_kpoints, "(A)") & & "my_number_of_kpoints" end if end if if (iand(my_flags, etsf_kpoints_kpoint_grid_shift) /= 0) then call etsf_io_low_def_var(ncid, "kpoint_grid_shift", & & etsf_io_low_double, & & (/ pad("number_of_reduced_dimensions") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_kpoints_kpoint_grid_vectors) /= 0) then call etsf_io_low_def_var(ncid, "kpoint_grid_vectors", & & etsf_io_low_double, & & (/ pad("number_of_reduced_dimensions"), & & pad("number_of_vectors") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_kpoints_mp_folding) /= 0) then call etsf_io_low_def_var(ncid, "monkhorst_pack_folding", & & etsf_io_low_integer, & & (/ pad("number_of_vectors") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_kpoints_red_coord_kpt) /= 0) then call etsf_io_low_def_var(ncid, "reduced_coordinates_of_kpoints", & & etsf_io_low_double, & & (/ pad("number_of_reduced_dimensions"), & & split_dims%number_of_kpoints /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_kpoints_kpoint_weights) /= 0) then call etsf_io_low_def_var(ncid, "kpoint_weights", & & etsf_io_low_double, & & (/ split_dims%number_of_kpoints /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if ! If we reach the end, then it should be OK. lstat = .true. !DEBUG !write (*,*) 'etsf_io_kpoints_def : exit' !ENDDEBUG end subroutine etsf_io_kpoints_def !!*** etsf_io-1.0.3/src/group_level/etsf_io_basisdata_def.f900000644000353400050630000002340011354150413017776 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_basisdata/etsf_io_basisdata_def !! NAME !! etsf_io_basisdata_def !! !! FUNCTION !! The given ETSF file must be opened and in define state (see !! etsf_io_low_set_define_mode() to change it). Then, all variable of the group !! are defined. All required dimensions must have already defined (see !! etsf_io_dims_def(). If some dimensions are missing, then the variable !! is not defined and no error are generated. !! !! One can specify which variable may be splitted using the optional argument !! @split. For each associated array in this structure, variable with appropriated !! dimensions will use my_ instead of . !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = !! integer returned by an 'open' NetCDF call. The file can be !! either in define or write mode. This status can be changed !! by the call. !! * k_dependent = (optional) !! use this argument to set the attribute flag 'k_dependent' to 'yes' !! or 'no' on variables that have it. If no variable in the group has !! the attribute 'k_dependent', this argument has no effect. The default !! value is .true. (which puts 'yes' in the file). !! * flags = (optional) !! One can choose the variables of the group !! that will be defined (and disk allocated) using this flag. This is a sum !! of values taken from #FLAGS_VARIABLES. !! * split = (optional) !! for each array associated in the type, the dimension used to declared the !! variables sizes will be 'my_/something/'. !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_basisdata_def(ncid, lstat, error_data, k_dependent, flags, & & split) !Arguments ------------------------------------ integer, intent(in) :: ncid logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data logical, optional, intent(in) :: k_dependent integer, optional, intent(in) :: flags type(etsf_split), optional, intent(in) :: split !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_basisdata_def' logical :: my_k_dependent integer :: my_flags type(etsf_split) :: my_split integer :: ivar type(split_dim_names) :: split_dims ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_basisdata_def : enter' !ENDDEBUG ! Get values for optional arguments, set default. if (present(k_dependent)) then my_k_dependent = k_dependent else my_k_dependent = .true. end if if (present(flags)) then my_flags = flags else my_flags = etsf_basisdata_all end if ! Consistency checks. if (my_flags < etsf_basisdata_none .or. my_flags > etsf_basisdata_all) then call etsf_io_low_error_set(error_data, ERROR_MODE_DEF, ERROR_TYPE_ARG, my_name, & & tgtname = "flags", errmess = "value out of bounds") lstat = .false. return end if ! Set the name for dimensions that could be splitted. if (present(split)) then if (associated(split%my_kpoints)) then write(split_dims%number_of_kpoints, "(A)") & & "my_number_of_kpoints" end if if (associated(split%my_coefficients)) then write(split_dims%max_number_of_coefficients, "(A)") & & "my_max_number_of_coefficients" end if end if if (iand(my_flags, etsf_basisdata_basis_set) /= 0) then call etsf_io_low_def_var(ncid, "basis_set", & & etsf_io_low_character, & & (/ pad("character_string_length") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_basisdata_kin_cutoff) /= 0) then call etsf_io_low_def_var(ncid, "kinetic_energy_cutoff", & & etsf_io_low_double, & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if if (ivar >= 0) then ! Handle the units attribute. call etsf_io_low_write_att(ncid, ivar, & & "units", & & "atomic units", & & lstat, error_data = error_data) if (.not. lstat) return call etsf_io_low_write_att(ncid, ivar, & & "scale_to_atomic_units", & & 1.0d0, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if end if if (iand(my_flags, etsf_basisdata_n_coeff) /= 0) then call etsf_io_low_def_var(ncid, "number_of_coefficients", & & etsf_io_low_integer, & & (/ split_dims%number_of_kpoints /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if if (ivar >= 0) then ! Handle the k_dependent attribute. if (my_k_dependent) then call etsf_io_low_write_att(ncid, ivar, & & "k_dependent", & & "yes", & & lstat, error_data = error_data) else call etsf_io_low_write_att(ncid, ivar, & & "k_dependent", & & "no", & & lstat, error_data = error_data) end if if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if end if if (iand(my_flags, etsf_basisdata_red_coord_pw) /= 0) then if (.not. my_k_dependent) then call etsf_io_low_def_var(ncid, "reduced_coordinates_of_plane_waves", & & etsf_io_low_integer, & & (/ pad("number_of_reduced_dimensions"), & & split_dims%max_number_of_coefficients /), & & lstat, ncvarid = ivar, error_data = error_data) else call etsf_io_low_def_var(ncid, "reduced_coordinates_of_plane_waves", & & etsf_io_low_integer, & & (/ pad("number_of_reduced_dimensions"), & & split_dims%max_number_of_coefficients, & & split_dims%number_of_kpoints /), & & lstat, ncvarid = ivar, error_data = error_data) end if ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if if (ivar >= 0) then ! Handle the k_dependent attribute. if (my_k_dependent) then call etsf_io_low_write_att(ncid, ivar, & & "k_dependent", & & "yes", & & lstat, error_data = error_data) else call etsf_io_low_write_att(ncid, ivar, & & "k_dependent", & & "no", & & lstat, error_data = error_data) end if if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if end if if (iand(my_flags, etsf_basisdata_coord_grid) /= 0) then call etsf_io_low_def_var(ncid, "coordinates_of_basis_grid_points", & & etsf_io_low_integer, & & (/ pad("number_of_reduced_dimensions"), & & pad("max_number_of_basis_grid_points"), & & pad("number_of_localization_regions") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_basisdata_n_coeff_grid) /= 0) then call etsf_io_low_def_var(ncid, "number_of_coefficients_per_grid_point", & & etsf_io_low_integer, & & (/ pad("max_number_of_basis_grid_points"), & & pad("number_of_localization_regions") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if ! If we reach the end, then it should be OK. lstat = .true. !DEBUG !write (*,*) 'etsf_io_basisdata_def : exit' !ENDDEBUG end subroutine etsf_io_basisdata_def !!*** etsf_io-1.0.3/src/group_level/etsf_io_gwdata_def.f900000644000353400050630000001577711354150413017334 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_gwdata/etsf_io_gwdata_def !! NAME !! etsf_io_gwdata_def !! !! FUNCTION !! The given ETSF file must be opened and in define state (see !! etsf_io_low_set_define_mode() to change it). Then, all variable of the group !! are defined. All required dimensions must have already defined (see !! etsf_io_dims_def(). If some dimensions are missing, then the variable !! is not defined and no error are generated. !! !! One can specify which variable may be splitted using the optional argument !! @split. For each associated array in this structure, variable with appropriated !! dimensions will use my_ instead of . !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = !! integer returned by an 'open' NetCDF call. The file can be !! either in define or write mode. This status can be changed !! by the call. !! * k_dependent = (optional) !! use this argument to set the attribute flag 'k_dependent' to 'yes' !! or 'no' on variables that have it. If no variable in the group has !! the attribute 'k_dependent', this argument has no effect. The default !! value is .true. (which puts 'yes' in the file). !! * flags = (optional) !! One can choose the variables of the group !! that will be defined (and disk allocated) using this flag. This is a sum !! of values taken from #FLAGS_VARIABLES. !! * split = (optional) !! for each array associated in the type, the dimension used to declared the !! variables sizes will be 'my_/something/'. !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_gwdata_def(ncid, lstat, error_data, k_dependent, flags, & & split) !Arguments ------------------------------------ integer, intent(in) :: ncid logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data logical, optional, intent(in) :: k_dependent integer, optional, intent(in) :: flags type(etsf_split), optional, intent(in) :: split !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_gwdata_def' logical :: my_k_dependent integer :: my_flags type(etsf_split) :: my_split integer :: ivar type(split_dim_names) :: split_dims ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_gwdata_def : enter' !ENDDEBUG ! Get values for optional arguments, set default. if (present(k_dependent)) then my_k_dependent = k_dependent else my_k_dependent = .true. end if if (present(flags)) then my_flags = flags else my_flags = etsf_gwdata_all end if ! Consistency checks. if (my_flags < etsf_gwdata_none .or. my_flags > etsf_gwdata_all) then call etsf_io_low_error_set(error_data, ERROR_MODE_DEF, ERROR_TYPE_ARG, my_name, & & tgtname = "flags", errmess = "value out of bounds") lstat = .false. return end if ! Set the name for dimensions that could be splitted. if (present(split)) then if (associated(split%my_kpoints)) then write(split_dims%number_of_kpoints, "(A)") & & "my_number_of_kpoints" end if if (associated(split%my_spins)) then write(split_dims%number_of_spins, "(A)") & & "my_number_of_spins" end if if (associated(split%my_coefficients)) then write(split_dims%max_number_of_coefficients, "(A)") & & "my_max_number_of_coefficients" end if if (associated(split%my_states)) then write(split_dims%max_number_of_states, "(A)") & & "my_max_number_of_states" end if end if if (iand(my_flags, etsf_gwdata_gw_corrections) /= 0) then call etsf_io_low_def_var(ncid, "gw_corrections", & & etsf_io_low_double, & & (/ pad("real_or_complex_gw_corrections"), & & split_dims%max_number_of_states, & & split_dims%number_of_kpoints, & & split_dims%number_of_spins /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_gwdata_kb_coeff_sig) /= 0) then call etsf_io_low_def_var(ncid, "kb_formfactor_sign", & & etsf_io_low_integer, & & (/ pad("max_number_of_projectors"), & & pad("max_number_of_angular_momenta"), & & pad("number_of_atom_species") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_gwdata_kb_coeff) /= 0) then call etsf_io_low_def_var(ncid, "kb_formfactors", & & etsf_io_low_double, & & (/ split_dims%max_number_of_coefficients, & & split_dims%number_of_kpoints, & & pad("max_number_of_projectors"), & & pad("max_number_of_angular_momenta"), & & pad("number_of_atom_species") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_gwdata_kb_coeff_der) /= 0) then call etsf_io_low_def_var(ncid, "kb_formfactor_derivative", & & etsf_io_low_double, & & (/ split_dims%max_number_of_coefficients, & & split_dims%number_of_kpoints, & & pad("max_number_of_projectors"), & & pad("max_number_of_angular_momenta"), & & pad("number_of_atom_species") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if ! If we reach the end, then it should be OK. lstat = .true. !DEBUG !write (*,*) 'etsf_io_gwdata_def : exit' !ENDDEBUG end subroutine etsf_io_gwdata_def !!*** etsf_io-1.0.3/src/group_level/etsf_io_dielectric_def.f900000644000353400050620000004442011354150413020156 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_dielectric/etsf_io_dielectric_def !! NAME !! etsf_io_dielectric_def !! !! FUNCTION !! The given ETSF file must be opened and in define state (see !! etsf_io_low_set_define_mode() to change it). Then, all variable of the group !! are defined. All required dimensions must have already defined (see !! etsf_io_dims_def(). If some dimensions are missing, then the variable !! is not defined and no error are generated. !! !! One can specify which variable may be splitted using the optional argument !! @split. For each associated array in this structure, variable with appropriated !! dimensions will use my_ instead of . !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = !! integer returned by an 'open' NetCDF call. The file can be !! either in define or write mode. This status can be changed !! by the call. !! * k_dependent = (optional) !! use this argument to set the attribute flag 'k_dependent' to 'yes' !! or 'no' on variables that have it. If no variable in the group has !! the attribute 'k_dependent', this argument has no effect. The default !! value is .true. (which puts 'yes' in the file). !! * flags = (optional) !! One can choose the variables of the group !! that will be defined (and disk allocated) using this flag. This is a sum !! of values taken from #FLAGS_VARIABLES. !! * split = (optional) !! for each array associated in the type, the dimension used to declared the !! variables sizes will be 'my_/something/'. !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_dielectric_def(ncid, lstat, error_data, k_dependent, flags, & & split) !Arguments ------------------------------------ integer, intent(in) :: ncid logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data logical, optional, intent(in) :: k_dependent integer, optional, intent(in) :: flags type(etsf_split), optional, intent(in) :: split !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_dielectric_def' logical :: my_k_dependent integer :: my_flags type(etsf_split) :: my_split integer :: ivar type(split_dim_names) :: split_dims ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_dielectric_def : enter' !ENDDEBUG ! Get values for optional arguments, set default. if (present(k_dependent)) then my_k_dependent = k_dependent else my_k_dependent = .true. end if if (present(flags)) then my_flags = flags else my_flags = etsf_dielectric_all end if ! Consistency checks. if (my_flags < etsf_dielectric_none .or. my_flags > etsf_dielectric_all) then call etsf_io_low_error_set(error_data, ERROR_MODE_DEF, ERROR_TYPE_ARG, my_name, & & tgtname = "flags", errmess = "value out of bounds") lstat = .false. return end if ! Set the name for dimensions that could be splitted. if (present(split)) then if (associated(split%my_spins)) then write(split_dims%number_of_spins, "(A)") & & "my_number_of_spins" end if end if if (iand(my_flags, etsf_dielectric_frequencies) /= 0) then call etsf_io_low_def_var(ncid, "frequencies_dielectric_function", & & etsf_io_low_double, & & (/ pad("complex"), & & pad("number_of_frequencies_dielectric_function") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_dielectric_qpt) /= 0) then call etsf_io_low_def_var(ncid, "qpoints_dielectric_function", & & etsf_io_low_double, & & (/ pad("number_of_reduced_dimensions"), & & pad("number_of_qpoints_dielectric_function") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_dielectric_qpt_g_lim) /= 0) then call etsf_io_low_def_var(ncid, "qpoints_gamma_limit", & & etsf_io_low_double, & & (/ pad("number_of_reduced_dimensions"), & & pad("number_of_qpoints_gamma_limit") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_dielectric_function) /= 0) then call etsf_io_low_def_var(ncid, "dielectric_function", & & etsf_io_low_double, & & (/ pad("complex"), & & pad("number_of_coefficients_dielectric_function"), & & pad("number_of_coefficients_dielectric_function"), & & split_dims%number_of_spins, & & split_dims%number_of_spins, & & pad("number_of_qpoints_dielectric_function"), & & pad("number_of_frequencies_dielectric_function") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_dielectric_function_head) /= 0) then call etsf_io_low_def_var(ncid, "dielectric_function_head", & & etsf_io_low_double, & & (/ pad("complex"), & & split_dims%number_of_spins, & & split_dims%number_of_spins, & & pad("number_of_qpoints_dielectric_function"), & & pad("number_of_frequencies_dielectric_function") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_dielectric_function_lower) /= 0) then call etsf_io_low_def_var(ncid, "dielectric_function_lower_wing", & & etsf_io_low_double, & & (/ pad("complex"), & & pad("number_of_coefficients_dielectric_function"), & & split_dims%number_of_spins, & & split_dims%number_of_spins, & & pad("number_of_qpoints_gamma_limit"), & & pad("number_of_frequencies_dielectric_function") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_dielectric_function_upper) /= 0) then call etsf_io_low_def_var(ncid, "dielectric_function_upper_wing", & & etsf_io_low_double, & & (/ pad("complex"), & & pad("number_of_coefficients_dielectric_function"), & & split_dims%number_of_spins, & & split_dims%number_of_spins, & & pad("number_of_qpoints_gamma_limit"), & & pad("number_of_frequencies_dielectric_function") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_dielectric_function_inv) /= 0) then call etsf_io_low_def_var(ncid, "inverse_dielectric_function", & & etsf_io_low_double, & & (/ pad("complex"), & & pad("number_of_coefficients_dielectric_function"), & & pad("number_of_coefficients_dielectric_function"), & & split_dims%number_of_spins, & & split_dims%number_of_spins, & & pad("number_of_qpoints_dielectric_function"), & & pad("number_of_frequencies_dielectric_function") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_dielectric_function_inv_head) /= 0) then call etsf_io_low_def_var(ncid, "inverse_dielectric_function_head", & & etsf_io_low_double, & & (/ pad("complex"), & & split_dims%number_of_spins, & & split_dims%number_of_spins, & & pad("number_of_qpoints_dielectric_function"), & & pad("number_of_frequencies_dielectric_function") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_dielectric_function_inv_lower) /= 0) then call etsf_io_low_def_var(ncid, "inverse_dielectric_function_lower_wing", & & etsf_io_low_double, & & (/ pad("complex"), & & pad("number_of_coefficients_dielectric_function"), & & split_dims%number_of_spins, & & split_dims%number_of_spins, & & pad("number_of_qpoints_gamma_limit"), & & pad("number_of_frequencies_dielectric_function") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_dielectric_function_inv_upper) /= 0) then call etsf_io_low_def_var(ncid, "inverse_dielectric_function_upper_wing", & & etsf_io_low_double, & & (/ pad("complex"), & & pad("number_of_coefficients_dielectric_function"), & & split_dims%number_of_spins, & & split_dims%number_of_spins, & & pad("number_of_qpoints_gamma_limit"), & & pad("number_of_frequencies_dielectric_function") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_dielectric_polarizability) /= 0) then call etsf_io_low_def_var(ncid, "polarizability", & & etsf_io_low_double, & & (/ pad("complex"), & & pad("number_of_coefficients_dielectric_function"), & & pad("number_of_coefficients_dielectric_function"), & & split_dims%number_of_spins, & & split_dims%number_of_spins, & & pad("number_of_qpoints_dielectric_function"), & & pad("number_of_frequencies_dielectric_function") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_dielectric_pol_head) /= 0) then call etsf_io_low_def_var(ncid, "polarizability_head", & & etsf_io_low_double, & & (/ pad("complex"), & & split_dims%number_of_spins, & & split_dims%number_of_spins, & & pad("number_of_qpoints_dielectric_function"), & & pad("number_of_frequencies_dielectric_function") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_dielectric_pol_lower) /= 0) then call etsf_io_low_def_var(ncid, "polarizability_lower_wing", & & etsf_io_low_double, & & (/ pad("complex"), & & pad("number_of_coefficients_dielectric_function"), & & split_dims%number_of_spins, & & split_dims%number_of_spins, & & pad("number_of_qpoints_gamma_limit"), & & pad("number_of_frequencies_dielectric_function") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_dielectric_pol_upper) /= 0) then call etsf_io_low_def_var(ncid, "polarizability_upper_wing", & & etsf_io_low_double, & & (/ pad("complex"), & & pad("number_of_coefficients_dielectric_function"), & & split_dims%number_of_spins, & & split_dims%number_of_spins, & & pad("number_of_qpoints_gamma_limit"), & & pad("number_of_frequencies_dielectric_function") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_dielectric_polarizability_inv) /= 0) then call etsf_io_low_def_var(ncid, "inverse_polarizability", & & etsf_io_low_double, & & (/ pad("complex"), & & pad("number_of_coefficients_dielectric_function"), & & pad("number_of_coefficients_dielectric_function"), & & split_dims%number_of_spins, & & split_dims%number_of_spins, & & pad("number_of_qpoints_dielectric_function"), & & pad("number_of_frequencies_dielectric_function") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_dielectric_pol_inv_head) /= 0) then call etsf_io_low_def_var(ncid, "inverse_polarizability_head", & & etsf_io_low_double, & & (/ pad("complex"), & & split_dims%number_of_spins, & & split_dims%number_of_spins, & & pad("number_of_qpoints_dielectric_function"), & & pad("number_of_frequencies_dielectric_function") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_dielectric_pol_inv_lower) /= 0) then call etsf_io_low_def_var(ncid, "inverse_polarizability_lower_wing", & & etsf_io_low_double, & & (/ pad("complex"), & & pad("number_of_coefficients_dielectric_function"), & & split_dims%number_of_spins, & & split_dims%number_of_spins, & & pad("number_of_qpoints_gamma_limit"), & & pad("number_of_frequencies_dielectric_function") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_dielectric_pol_inv_upper) /= 0) then call etsf_io_low_def_var(ncid, "inverse_polarizability_upper_wing", & & etsf_io_low_double, & & (/ pad("complex"), & & pad("number_of_coefficients_dielectric_function"), & & split_dims%number_of_spins, & & split_dims%number_of_spins, & & pad("number_of_qpoints_gamma_limit"), & & pad("number_of_frequencies_dielectric_function") /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if ! If we reach the end, then it should be OK. lstat = .true. !DEBUG !write (*,*) 'etsf_io_dielectric_def : exit' !ENDDEBUG end subroutine etsf_io_dielectric_def !!*** etsf_io-1.0.3/src/group_level/etsf_io_main_def.f900000644000353400050630000002770611354150413017004 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_main/etsf_io_main_def !! NAME !! etsf_io_main_def !! !! FUNCTION !! The given ETSF file must be opened and in define state (see !! etsf_io_low_set_define_mode() to change it). Then, all variable of the group !! are defined. All required dimensions must have already defined (see !! etsf_io_dims_def(). If some dimensions are missing, then the variable !! is not defined and no error are generated. !! !! One can specify which variable may be splitted using the optional argument !! @split. For each associated array in this structure, variable with appropriated !! dimensions will use my_ instead of . !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = !! integer returned by an 'open' NetCDF call. The file can be !! either in define or write mode. This status can be changed !! by the call. !! * k_dependent = (optional) !! use this argument to set the attribute flag 'k_dependent' to 'yes' !! or 'no' on variables that have it. If no variable in the group has !! the attribute 'k_dependent', this argument has no effect. The default !! value is .true. (which puts 'yes' in the file). !! * flags = (optional) !! One can choose the variables of the group !! that will be defined (and disk allocated) using this flag. This is a sum !! of values taken from #FLAGS_VARIABLES. !! * split = (optional) !! for each array associated in the type, the dimension used to declared the !! variables sizes will be 'my_/something/'. !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_main_def(ncid, lstat, error_data, k_dependent, flags, split) !Arguments ------------------------------------ integer, intent(in) :: ncid logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data logical, optional, intent(in) :: k_dependent integer, optional, intent(in) :: flags type(etsf_split), optional, intent(in) :: split !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_main_def' logical :: my_k_dependent integer :: my_flags type(etsf_split) :: my_split integer :: ivar type(split_dim_names) :: split_dims ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_main_def : enter' !ENDDEBUG ! Get values for optional arguments, set default. if (present(k_dependent)) then my_k_dependent = k_dependent else my_k_dependent = .true. end if if (present(flags)) then my_flags = flags else my_flags = etsf_main_all end if ! Consistency checks. if (my_flags < etsf_main_none .or. my_flags > etsf_main_all) then call etsf_io_low_error_set(error_data, ERROR_MODE_DEF, ERROR_TYPE_ARG, my_name, & & tgtname = "flags", errmess = "value out of bounds") lstat = .false. return end if ! Set the name for dimensions that could be splitted. if (present(split)) then if (associated(split%my_kpoints)) then write(split_dims%number_of_kpoints, "(A)") & & "my_number_of_kpoints" end if if (associated(split%my_grid_points_vector3)) then write(split_dims%number_of_grid_points_vector3, "(A)") & & "my_number_of_grid_points_vector3" end if if (associated(split%my_spins)) then write(split_dims%number_of_spins, "(A)") & & "my_number_of_spins" end if if (associated(split%my_grid_points_vector1)) then write(split_dims%number_of_grid_points_vector1, "(A)") & & "my_number_of_grid_points_vector1" end if if (associated(split%my_grid_points_vector2)) then write(split_dims%number_of_grid_points_vector2, "(A)") & & "my_number_of_grid_points_vector2" end if if (associated(split%my_coefficients)) then write(split_dims%max_number_of_coefficients, "(A)") & & "my_max_number_of_coefficients" end if if (associated(split%my_components)) then write(split_dims%number_of_components, "(A)") & & "my_number_of_components" end if if (associated(split%my_states)) then write(split_dims%max_number_of_states, "(A)") & & "my_max_number_of_states" end if end if if (iand(my_flags, etsf_main_density) /= 0) then call etsf_io_low_def_var(ncid, "density", & & etsf_io_low_double, & & (/ pad("real_or_complex_density"), & & split_dims%number_of_grid_points_vector1, & & split_dims%number_of_grid_points_vector2, & & split_dims%number_of_grid_points_vector3, & & split_dims%number_of_components /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if if (ivar >= 0) then ! Handle the units attribute. call etsf_io_low_write_att(ncid, ivar, & & "units", & & "atomic units", & & lstat, error_data = error_data) if (.not. lstat) return call etsf_io_low_write_att(ncid, ivar, & & "scale_to_atomic_units", & & 1.0d0, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if end if if (iand(my_flags, etsf_main_pot_x_only) /= 0) then call etsf_io_low_def_var(ncid, "exchange_potential", & & etsf_io_low_double, & & (/ pad("real_or_complex_potential"), & & split_dims%number_of_grid_points_vector1, & & split_dims%number_of_grid_points_vector2, & & split_dims%number_of_grid_points_vector3, & & split_dims%number_of_components /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if if (ivar >= 0) then ! Handle the units attribute. call etsf_io_low_write_att(ncid, ivar, & & "units", & & "atomic units", & & lstat, error_data = error_data) if (.not. lstat) return call etsf_io_low_write_att(ncid, ivar, & & "scale_to_atomic_units", & & 1.0d0, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if end if if (iand(my_flags, etsf_main_pot_c_only) /= 0) then call etsf_io_low_def_var(ncid, "correlation_potential", & & etsf_io_low_double, & & (/ pad("real_or_complex_potential"), & & split_dims%number_of_grid_points_vector1, & & split_dims%number_of_grid_points_vector2, & & split_dims%number_of_grid_points_vector3, & & split_dims%number_of_components /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if if (ivar >= 0) then ! Handle the units attribute. call etsf_io_low_write_att(ncid, ivar, & & "units", & & "atomic units", & & lstat, error_data = error_data) if (.not. lstat) return call etsf_io_low_write_att(ncid, ivar, & & "scale_to_atomic_units", & & 1.0d0, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if end if if (iand(my_flags, etsf_main_pot_xc) /= 0) then call etsf_io_low_def_var(ncid, "exchange_correlation_potential", & & etsf_io_low_double, & & (/ pad("real_or_complex_potential"), & & split_dims%number_of_grid_points_vector1, & & split_dims%number_of_grid_points_vector2, & & split_dims%number_of_grid_points_vector3, & & split_dims%number_of_components /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if if (ivar >= 0) then ! Handle the units attribute. call etsf_io_low_write_att(ncid, ivar, & & "units", & & "atomic units", & & lstat, error_data = error_data) if (.not. lstat) return call etsf_io_low_write_att(ncid, ivar, & & "scale_to_atomic_units", & & 1.0d0, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if end if if (iand(my_flags, etsf_main_wfs_coeff) /= 0) then call etsf_io_low_def_var(ncid, "coefficients_of_wavefunctions", & & etsf_io_low_double, & & (/ pad("real_or_complex_coefficients"), & & split_dims%max_number_of_coefficients, & & pad("number_of_spinor_components"), & & split_dims%max_number_of_states, & & split_dims%number_of_kpoints, & & split_dims%number_of_spins /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (iand(my_flags, etsf_main_wfs_rsp) /= 0) then call etsf_io_low_def_var(ncid, "real_space_wavefunctions", & & etsf_io_low_double, & & (/ pad("real_or_complex_wavefunctions"), & & split_dims%number_of_grid_points_vector1, & & split_dims%number_of_grid_points_vector2, & & split_dims%number_of_grid_points_vector3, & & pad("number_of_spinor_components"), & & split_dims%max_number_of_states, & & split_dims%number_of_kpoints, & & split_dims%number_of_spins /), & & lstat, ncvarid = ivar, error_data = error_data) ! We raise don't raise an error if a dimension is missing. if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. & & error_data%target_type_id /= ERROR_TYPE_DID)) then call etsf_io_low_error_update(error_data, my_name) return end if end if ! If we reach the end, then it should be OK. lstat = .true. !DEBUG !write (*,*) 'etsf_io_main_def : exit' !ENDDEBUG end subroutine etsf_io_main_def !!*** etsf_io-1.0.3/src/group_level/etsf_io_geometry_get.f900000644000353400050630000001717011354150413017726 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_geometry/etsf_io_geometry_get !! NAME !! etsf_io_geometry_get !! !! FUNCTION !! Read an opened ETSF file to get data related to the given group. !! Only associated pointers of argument @folder will be accessed. If any accessed !! variable is missing, this routine returns an error (usually an access_mode_id !! of argument error_data set to ERROR_MODE_INQ). Any other errors implies a !! return with @lstat = .false.. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = !! integer returned by an 'open' NetCDF call. The file can be !! either in define or write mode. This status can be changed !! by the call. !! * use_atomic_units = (optional) !! set this flag to .true. makes the library use the value of the attribute !! scale_to_atomic_units to multiply the read variables (that are units dependent) !! by this factor (if different from 1.0d0). !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! SIDE EFFECTS !! * folder = !! an allocated structure with pointers on allocated areas in memory. !! These areas will be read or written if the pointer is associated, if !! not, the variable will be ignored. It is possible to access to specific !! dimensions of a variable using the __kpoint_access or !! __spin_access of this @folder structure. The !! __number_of_ can also been set if only a subpart !! in one dimension should be accessed (this is possible when the specifications !! have been declared with a max_number_of_. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_geometry_get(ncid, folder, lstat, error_data, use_atomic_units) !Arguments ------------------------------------ integer, intent(in) :: ncid type(etsf_geometry), intent(inout) :: folder logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data logical, optional, intent(in) :: use_atomic_units !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_geometry_get' logical :: my_use_atomic_units integer,allocatable :: varid(:) integer,allocatable :: start(:) integer,allocatable :: count(:) integer :: len character(etsf_charlen) :: flag ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_geometry_get : enter' !ENDDEBUG ! Get values for optional arguments, set default. if (present(use_atomic_units)) then my_use_atomic_units = use_atomic_units else my_use_atomic_units = .true. end if allocate(varid(11)) if (associated(folder%space_group)) then call etsf_io_low_read_var(ncid, "space_group", & & folder%space_group, & & lstat, ncvarid = varid(1), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%primitive_vectors)) then call etsf_io_low_read_var(ncid, "primitive_vectors", & & folder%primitive_vectors, & & lstat, ncvarid = varid(2), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%reduced_symmetry_matrices)) then call etsf_io_low_read_var(ncid, "reduced_symmetry_matrices", & & folder%reduced_symmetry_matrices, & & lstat, ncvarid = varid(3), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%reduced_symmetry_translations)) then call etsf_io_low_read_var(ncid, "reduced_symmetry_translations", & & folder%reduced_symmetry_translations, & & lstat, ncvarid = varid(4), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%atom_species)) then call etsf_io_low_read_var(ncid, "atom_species", & & folder%atom_species, & & lstat, ncvarid = varid(5), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%reduced_atom_positions)) then call etsf_io_low_read_var(ncid, "reduced_atom_positions", & & folder%reduced_atom_positions, & & lstat, ncvarid = varid(6), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%valence_charges)) then call etsf_io_low_read_var(ncid, "valence_charges", & & folder%valence_charges, & & lstat, ncvarid = varid(7), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%atomic_numbers)) then call etsf_io_low_read_var(ncid, "atomic_numbers", & & folder%atomic_numbers, & & lstat, ncvarid = varid(8), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%atom_species_names)) then call etsf_io_low_read_var(ncid, "atom_species_names", & & folder%atom_species_names, etsf_charlen, & & lstat, ncvarid = varid(9), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%chemical_symbols)) then call etsf_io_low_read_var(ncid, "chemical_symbols", & & folder%chemical_symbols, etsf_chemlen, & & lstat, ncvarid = varid(10), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%pseudopotential_types)) then call etsf_io_low_read_var(ncid, "pseudopotential_types", & & folder%pseudopotential_types, etsf_charlen, & & lstat, ncvarid = varid(11), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if deallocate(varid) !DEBUG !write (*,*) 'etsf_io_geometry_get : exit' !ENDDEBUG end subroutine etsf_io_geometry_get !!*** etsf_io-1.0.3/src/group_level/etsf_io_electrons_get.f900000644000353400050630000002602211354150413020065 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_electrons/etsf_io_electrons_get !! NAME !! etsf_io_electrons_get !! !! FUNCTION !! Read an opened ETSF file to get data related to the given group. !! Only associated pointers of argument @folder will be accessed. If any accessed !! variable is missing, this routine returns an error (usually an access_mode_id !! of argument error_data set to ERROR_MODE_INQ). Any other errors implies a !! return with @lstat = .false.. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = !! integer returned by an 'open' NetCDF call. The file can be !! either in define or write mode. This status can be changed !! by the call. !! * use_atomic_units = (optional) !! set this flag to .true. makes the library use the value of the attribute !! scale_to_atomic_units to multiply the read variables (that are units dependent) !! by this factor (if different from 1.0d0). !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! SIDE EFFECTS !! * folder = !! an allocated structure with pointers on allocated areas in memory. !! These areas will be read or written if the pointer is associated, if !! not, the variable will be ignored. It is possible to access to specific !! dimensions of a variable using the __kpoint_access or !! __spin_access of this @folder structure. The !! __number_of_ can also been set if only a subpart !! in one dimension should be accessed (this is possible when the specifications !! have been declared with a max_number_of_. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_electrons_get(ncid, folder, lstat, error_data, use_atomic_units) !Arguments ------------------------------------ integer, intent(in) :: ncid type(etsf_electrons), intent(inout) :: folder logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data logical, optional, intent(in) :: use_atomic_units !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_electrons_get' logical :: my_use_atomic_units integer,allocatable :: varid(:) integer,allocatable :: start(:) integer,allocatable :: count(:) integer :: len character(etsf_charlen) :: flag ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_electrons_get : enter' !ENDDEBUG ! Get values for optional arguments, set default. if (present(use_atomic_units)) then my_use_atomic_units = use_atomic_units else my_use_atomic_units = .true. end if allocate(varid(9)) if (associated(folder%number_of_electrons)) then call etsf_io_low_read_var(ncid, "number_of_electrons", & & folder%number_of_electrons, & & lstat, ncvarid = varid(1), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%exchange_functional)) then call etsf_io_low_read_var(ncid, "exchange_functional", & & folder%exchange_functional, etsf_charlen, & & lstat, ncvarid = varid(2), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%correlation_functional)) then call etsf_io_low_read_var(ncid, "correlation_functional", & & folder%correlation_functional, etsf_charlen, & & lstat, ncvarid = varid(3), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%fermi_energy)) then call etsf_io_low_read_var(ncid, "fermi_energy", & & folder%fermi_energy, & & lstat, ncvarid = varid(4), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%smearing_scheme)) then call etsf_io_low_read_var(ncid, "smearing_scheme", & & folder%smearing_scheme, etsf_charlen, & & lstat, ncvarid = varid(5), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%smearing_width)) then call etsf_io_low_read_var(ncid, "smearing_width", & & folder%smearing_width, & & lstat, ncvarid = varid(6), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%number_of_states)) then call etsf_io_low_read_var(ncid, "number_of_states", & & folder%number_of_states, & & lstat, ncvarid = varid(7), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%eigenvalues)) then allocate(start(3), count(3)) start(:) = 1 count(:) = 0 if (folder%eigenvalues__spin_access /= etsf_no_sub_access) then start(3) = folder%eigenvalues__spin_access count(3) = 1 end if if (folder%eigenvalues__kpoint_access /= etsf_no_sub_access) then start(2) = folder%eigenvalues__kpoint_access count(2) = 1 end if count(1) = folder%eigenvalues__number_of_states if (folder%eigenvalues__state_access /= etsf_no_sub_access) then start(1) = folder%eigenvalues__state_access count(1) = 1 end if call etsf_io_low_read_var(ncid, "eigenvalues", & & folder%eigenvalues, & & lstat, ncvarid = varid(8), & & error_data = error_data, start = start, count = count) deallocate(start, count) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%occupations)) then allocate(start(3), count(3)) start(:) = 1 count(:) = 0 if (folder%occupations__spin_access /= etsf_no_sub_access) then start(3) = folder%occupations__spin_access count(3) = 1 end if if (folder%occupations__kpoint_access /= etsf_no_sub_access) then start(2) = folder%occupations__kpoint_access count(2) = 1 end if count(1) = folder%occupations__number_of_states if (folder%occupations__state_access /= etsf_no_sub_access) then start(1) = folder%occupations__state_access count(1) = 1 end if call etsf_io_low_read_var(ncid, "occupations", & & folder%occupations, & & lstat, ncvarid = varid(9), & & error_data = error_data, start = start, count = count) deallocate(start, count) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if ! Handle all attributes for the group. if (associated(folder%fermi_energy)) then ! Handle the units attribute. call etsf_io_low_read_att(ncid, varid(4), & & "units", & & etsf_charlen, folder%fermi_energy__units, & & lstat, error_data = error_data) if (.not. lstat) return if (trim(folder%fermi_energy__units) /= "atomic units") then call etsf_io_low_read_att(ncid, varid(4), & & "scale_to_atomic_units", & & folder%fermi_energy__scale_to_atomic_units, & & lstat, error_data = error_data) if (.not. lstat) return else folder%fermi_energy__scale_to_atomic_units = 1.0d0 end if if (my_use_atomic_units .and. & & folder%fermi_energy__scale_to_atomic_units /= 1.0d0) then folder%fermi_energy = folder%fermi_energy * & & folder%fermi_energy__scale_to_atomic_units end if end if if (associated(folder%smearing_width)) then ! Handle the units attribute. call etsf_io_low_read_att(ncid, varid(6), & & "units", & & etsf_charlen, folder%smearing_width__units, & & lstat, error_data = error_data) if (.not. lstat) return if (trim(folder%smearing_width__units) /= "atomic units") then call etsf_io_low_read_att(ncid, varid(6), & & "scale_to_atomic_units", & & folder%smearing_width__scale_to_atomic_units, & & lstat, error_data = error_data) if (.not. lstat) return else folder%smearing_width__scale_to_atomic_units = 1.0d0 end if if (my_use_atomic_units .and. & & folder%smearing_width__scale_to_atomic_units /= 1.0d0) then folder%smearing_width = folder%smearing_width * & & folder%smearing_width__scale_to_atomic_units end if end if if (etsf_io_low_var_associated(folder%eigenvalues)) then ! Handle the units attribute. call etsf_io_low_read_att(ncid, varid(8), & & "units", & & etsf_charlen, folder%eigenvalues__units, & & lstat, error_data = error_data) if (.not. lstat) return if (trim(folder%eigenvalues__units) /= "atomic units") then call etsf_io_low_read_att(ncid, varid(8), & & "scale_to_atomic_units", & & folder%eigenvalues__scale_to_atomic_units, & & lstat, error_data = error_data) if (.not. lstat) return else folder%eigenvalues__scale_to_atomic_units = 1.0d0 end if if (my_use_atomic_units .and. & & folder%eigenvalues__scale_to_atomic_units /= 1.0d0) then call etsf_io_low_var_multiply(folder%eigenvalues, & & folder%eigenvalues__scale_to_atomic_units) end if end if deallocate(varid) !DEBUG !write (*,*) 'etsf_io_electrons_get : exit' !ENDDEBUG end subroutine etsf_io_electrons_get !!*** etsf_io-1.0.3/src/group_level/etsf_io_kpoints_get.f900000644000353400050630000001236311354150413017561 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_kpoints/etsf_io_kpoints_get !! NAME !! etsf_io_kpoints_get !! !! FUNCTION !! Read an opened ETSF file to get data related to the given group. !! Only associated pointers of argument @folder will be accessed. If any accessed !! variable is missing, this routine returns an error (usually an access_mode_id !! of argument error_data set to ERROR_MODE_INQ). Any other errors implies a !! return with @lstat = .false.. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = !! integer returned by an 'open' NetCDF call. The file can be !! either in define or write mode. This status can be changed !! by the call. !! * use_atomic_units = (optional) !! set this flag to .true. makes the library use the value of the attribute !! scale_to_atomic_units to multiply the read variables (that are units dependent) !! by this factor (if different from 1.0d0). !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! SIDE EFFECTS !! * folder = !! an allocated structure with pointers on allocated areas in memory. !! These areas will be read or written if the pointer is associated, if !! not, the variable will be ignored. It is possible to access to specific !! dimensions of a variable using the __kpoint_access or !! __spin_access of this @folder structure. The !! __number_of_ can also been set if only a subpart !! in one dimension should be accessed (this is possible when the specifications !! have been declared with a max_number_of_. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_kpoints_get(ncid, folder, lstat, error_data, use_atomic_units) !Arguments ------------------------------------ integer, intent(in) :: ncid type(etsf_kpoints), intent(inout) :: folder logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data logical, optional, intent(in) :: use_atomic_units !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_kpoints_get' logical :: my_use_atomic_units integer,allocatable :: varid(:) integer,allocatable :: start(:) integer,allocatable :: count(:) integer :: len character(etsf_charlen) :: flag ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_kpoints_get : enter' !ENDDEBUG ! Get values for optional arguments, set default. if (present(use_atomic_units)) then my_use_atomic_units = use_atomic_units else my_use_atomic_units = .true. end if allocate(varid(5)) if (associated(folder%kpoint_grid_shift)) then call etsf_io_low_read_var(ncid, "kpoint_grid_shift", & & folder%kpoint_grid_shift, & & lstat, ncvarid = varid(1), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%kpoint_grid_vectors)) then call etsf_io_low_read_var(ncid, "kpoint_grid_vectors", & & folder%kpoint_grid_vectors, & & lstat, ncvarid = varid(2), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%monkhorst_pack_folding)) then call etsf_io_low_read_var(ncid, "monkhorst_pack_folding", & & folder%monkhorst_pack_folding, & & lstat, ncvarid = varid(3), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%reduced_coordinates_of_kpoints)) then call etsf_io_low_read_var(ncid, "reduced_coordinates_of_kpoints", & & folder%reduced_coordinates_of_kpoints, & & lstat, ncvarid = varid(4), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%kpoint_weights)) then call etsf_io_low_read_var(ncid, "kpoint_weights", & & folder%kpoint_weights, & & lstat, ncvarid = varid(5), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if deallocate(varid) !DEBUG !write (*,*) 'etsf_io_kpoints_get : exit' !ENDDEBUG end subroutine etsf_io_kpoints_get !!*** etsf_io-1.0.3/src/group_level/etsf_io_basisdata_get.f900000644000353400050630000002120011354150413020013 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_basisdata/etsf_io_basisdata_get !! NAME !! etsf_io_basisdata_get !! !! FUNCTION !! Read an opened ETSF file to get data related to the given group. !! Only associated pointers of argument @folder will be accessed. If any accessed !! variable is missing, this routine returns an error (usually an access_mode_id !! of argument error_data set to ERROR_MODE_INQ). Any other errors implies a !! return with @lstat = .false.. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = !! integer returned by an 'open' NetCDF call. The file can be !! either in define or write mode. This status can be changed !! by the call. !! * use_atomic_units = (optional) !! set this flag to .true. makes the library use the value of the attribute !! scale_to_atomic_units to multiply the read variables (that are units dependent) !! by this factor (if different from 1.0d0). !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! SIDE EFFECTS !! * folder = !! an allocated structure with pointers on allocated areas in memory. !! These areas will be read or written if the pointer is associated, if !! not, the variable will be ignored. It is possible to access to specific !! dimensions of a variable using the __kpoint_access or !! __spin_access of this @folder structure. The !! __number_of_ can also been set if only a subpart !! in one dimension should be accessed (this is possible when the specifications !! have been declared with a max_number_of_. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_basisdata_get(ncid, folder, lstat, error_data, use_atomic_units) !Arguments ------------------------------------ integer, intent(in) :: ncid type(etsf_basisdata), intent(inout) :: folder logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data logical, optional, intent(in) :: use_atomic_units !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_basisdata_get' logical :: my_use_atomic_units integer,allocatable :: varid(:) integer,allocatable :: start(:) integer,allocatable :: count(:) integer :: len character(etsf_charlen) :: flag ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_basisdata_get : enter' !ENDDEBUG ! Get values for optional arguments, set default. if (present(use_atomic_units)) then my_use_atomic_units = use_atomic_units else my_use_atomic_units = .true. end if allocate(varid(6)) if (associated(folder%basis_set)) then call etsf_io_low_read_var(ncid, "basis_set", & & folder%basis_set, etsf_charlen, & & lstat, ncvarid = varid(1), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%kinetic_energy_cutoff)) then call etsf_io_low_read_var(ncid, "kinetic_energy_cutoff", & & folder%kinetic_energy_cutoff, & & lstat, ncvarid = varid(2), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%number_of_coefficients)) then ! Handle the k_dependent attribute. call etsf_io_low_read_att(ncid, "number_of_coefficients", & & "k_dependent", & & etsf_charlen, flag, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if if (flag(1:2) == "no") then call etsf_io_low_read_dim(ncid, "max_number_of_coefficients", len, & & lstat, error_data = error_data) folder%number_of_coefficients = len else call etsf_io_low_read_var(ncid, "number_of_coefficients", & & folder%number_of_coefficients, & & lstat, ncvarid = varid(3), & & error_data = error_data) end if if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%reduced_coordinates_of_plane_waves)) then ! Handle the k_dependent attribute. call etsf_io_low_read_att(ncid, "reduced_coordinates_of_plane_waves", & & "k_dependent", & & etsf_charlen, flag, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if if (flag(1:2) == "no") then allocate(start(2), count(2)) else allocate(start(3), count(3)) end if start(:) = 1 count(:) = 0 if (flag(1:3) == "yes" .and. & & folder%red_coord_pw__kpoint_access /= etsf_no_sub_access) then start(3) = folder%red_coord_pw__kpoint_access count(3) = 1 end if count(2) = folder%red_coord_pw__number_of_coefficients call etsf_io_low_read_var(ncid, "reduced_coordinates_of_plane_waves", & & folder%reduced_coordinates_of_plane_waves, & & lstat, ncvarid = varid(4), & & error_data = error_data, start = start, count = count) deallocate(start, count) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%coordinates_of_basis_grid_points)) then allocate(start(3), count(3)) start(:) = 1 count(:) = 0 count(2) = folder%coord_grid__number_of_basis_grid_points call etsf_io_low_read_var(ncid, "coordinates_of_basis_grid_points", & & folder%coordinates_of_basis_grid_points, & & lstat, ncvarid = varid(5), & & error_data = error_data, start = start, count = count) deallocate(start, count) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%number_of_coefficients_per_grid_point)) then allocate(start(2), count(2)) start(:) = 1 count(:) = 0 count(1) = folder%n_coeff_grid__number_of_basis_grid_points call etsf_io_low_read_var(ncid, "number_of_coefficients_per_grid_point", & & folder%number_of_coefficients_per_grid_point, & & lstat, ncvarid = varid(6), & & error_data = error_data, start = start, count = count) deallocate(start, count) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if ! Handle all attributes for the group. if (associated(folder%kinetic_energy_cutoff)) then ! Handle the units attribute. call etsf_io_low_read_att(ncid, varid(2), & & "units", & & etsf_charlen, folder%kin_cutoff__units, & & lstat, error_data = error_data) if (.not. lstat) return if (trim(folder%kin_cutoff__units) /= "atomic units") then call etsf_io_low_read_att(ncid, varid(2), & & "scale_to_atomic_units", & & folder%kin_cutoff__scale_to_atomic_units, & & lstat, error_data = error_data) if (.not. lstat) return else folder%kin_cutoff__scale_to_atomic_units = 1.0d0 end if if (my_use_atomic_units .and. & & folder%kin_cutoff__scale_to_atomic_units /= 1.0d0) then folder%kinetic_energy_cutoff = folder%kinetic_energy_cutoff * & & folder%kin_cutoff__scale_to_atomic_units end if end if deallocate(varid) !DEBUG !write (*,*) 'etsf_io_basisdata_get : exit' !ENDDEBUG end subroutine etsf_io_basisdata_get !!*** etsf_io-1.0.3/src/group_level/etsf_io_gwdata_get.f900000644000353400050630000001514611354150413017343 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_gwdata/etsf_io_gwdata_get !! NAME !! etsf_io_gwdata_get !! !! FUNCTION !! Read an opened ETSF file to get data related to the given group. !! Only associated pointers of argument @folder will be accessed. If any accessed !! variable is missing, this routine returns an error (usually an access_mode_id !! of argument error_data set to ERROR_MODE_INQ). Any other errors implies a !! return with @lstat = .false.. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = !! integer returned by an 'open' NetCDF call. The file can be !! either in define or write mode. This status can be changed !! by the call. !! * use_atomic_units = (optional) !! set this flag to .true. makes the library use the value of the attribute !! scale_to_atomic_units to multiply the read variables (that are units dependent) !! by this factor (if different from 1.0d0). !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! SIDE EFFECTS !! * folder = !! an allocated structure with pointers on allocated areas in memory. !! These areas will be read or written if the pointer is associated, if !! not, the variable will be ignored. It is possible to access to specific !! dimensions of a variable using the __kpoint_access or !! __spin_access of this @folder structure. The !! __number_of_ can also been set if only a subpart !! in one dimension should be accessed (this is possible when the specifications !! have been declared with a max_number_of_. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_gwdata_get(ncid, folder, lstat, error_data, use_atomic_units) !Arguments ------------------------------------ integer, intent(in) :: ncid type(etsf_gwdata), intent(inout) :: folder logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data logical, optional, intent(in) :: use_atomic_units !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_gwdata_get' logical :: my_use_atomic_units integer,allocatable :: varid(:) integer,allocatable :: start(:) integer,allocatable :: count(:) integer :: len character(etsf_charlen) :: flag ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_gwdata_get : enter' !ENDDEBUG ! Get values for optional arguments, set default. if (present(use_atomic_units)) then my_use_atomic_units = use_atomic_units else my_use_atomic_units = .true. end if allocate(varid(4)) if (etsf_io_low_var_associated(folder%gw_corrections)) then allocate(start(4), count(4)) start(:) = 1 count(:) = 0 if (folder%gw_corrections__spin_access /= etsf_no_sub_access) then start(4) = folder%gw_corrections__spin_access count(4) = 1 end if if (folder%gw_corrections__kpoint_access /= etsf_no_sub_access) then start(3) = folder%gw_corrections__kpoint_access count(3) = 1 end if count(2) = folder%gw_corrections__number_of_states if (folder%gw_corrections__state_access /= etsf_no_sub_access) then start(2) = folder%gw_corrections__state_access count(2) = 1 end if call etsf_io_low_read_var(ncid, "gw_corrections", & & folder%gw_corrections, & & lstat, ncvarid = varid(1), & & error_data = error_data, start = start, count = count) deallocate(start, count) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%kb_formfactor_sign)) then allocate(start(3), count(3)) start(:) = 1 count(:) = 0 count(2) = folder%kb_coeff_sig__number_of_angular_momenta count(1) = folder%kb_coeff_sig__number_of_projectors call etsf_io_low_read_var(ncid, "kb_formfactor_sign", & & folder%kb_formfactor_sign, & & lstat, ncvarid = varid(2), & & error_data = error_data, start = start, count = count) deallocate(start, count) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%kb_formfactors)) then allocate(start(5), count(5)) start(:) = 1 count(:) = 0 count(4) = folder%kb_coeff__number_of_angular_momenta count(3) = folder%kb_coeff__number_of_projectors if (folder%kb_coeff__kpoint_access /= etsf_no_sub_access) then start(2) = folder%kb_coeff__kpoint_access count(2) = 1 end if count(1) = folder%kb_coeff__number_of_coefficients call etsf_io_low_read_var(ncid, "kb_formfactors", & & folder%kb_formfactors, & & lstat, ncvarid = varid(3), & & error_data = error_data, start = start, count = count) deallocate(start, count) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%kb_formfactor_derivative)) then allocate(start(5), count(5)) start(:) = 1 count(:) = 0 count(4) = folder%kb_coeff_der__number_of_angular_momenta count(3) = folder%kb_coeff_der__number_of_projectors if (folder%kb_coeff_der__kpoint_access /= etsf_no_sub_access) then start(2) = folder%kb_coeff_der__kpoint_access count(2) = 1 end if count(1) = folder%kb_coeff_der__number_of_coefficients call etsf_io_low_read_var(ncid, "kb_formfactor_derivative", & & folder%kb_formfactor_derivative, & & lstat, ncvarid = varid(4), & & error_data = error_data, start = start, count = count) deallocate(start, count) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if deallocate(varid) !DEBUG !write (*,*) 'etsf_io_gwdata_get : exit' !ENDDEBUG end subroutine etsf_io_gwdata_get !!*** etsf_io-1.0.3/src/group_level/etsf_io_dielectric_get.f900000644000353400050620000002676511354150413020213 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_dielectric/etsf_io_dielectric_get !! NAME !! etsf_io_dielectric_get !! !! FUNCTION !! Read an opened ETSF file to get data related to the given group. !! Only associated pointers of argument @folder will be accessed. If any accessed !! variable is missing, this routine returns an error (usually an access_mode_id !! of argument error_data set to ERROR_MODE_INQ). Any other errors implies a !! return with @lstat = .false.. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = !! integer returned by an 'open' NetCDF call. The file can be !! either in define or write mode. This status can be changed !! by the call. !! * use_atomic_units = (optional) !! set this flag to .true. makes the library use the value of the attribute !! scale_to_atomic_units to multiply the read variables (that are units dependent) !! by this factor (if different from 1.0d0). !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! SIDE EFFECTS !! * folder = !! an allocated structure with pointers on allocated areas in memory. !! These areas will be read or written if the pointer is associated, if !! not, the variable will be ignored. It is possible to access to specific !! dimensions of a variable using the __kpoint_access or !! __spin_access of this @folder structure. The !! __number_of_ can also been set if only a subpart !! in one dimension should be accessed (this is possible when the specifications !! have been declared with a max_number_of_. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_dielectric_get(ncid, folder, lstat, error_data, use_atomic_units) !Arguments ------------------------------------ integer, intent(in) :: ncid type(etsf_dielectric), intent(inout) :: folder logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data logical, optional, intent(in) :: use_atomic_units !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_dielectric_get' logical :: my_use_atomic_units integer,allocatable :: varid(:) integer,allocatable :: start(:) integer,allocatable :: count(:) integer :: len character(etsf_charlen) :: flag ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_dielectric_get : enter' !ENDDEBUG ! Get values for optional arguments, set default. if (present(use_atomic_units)) then my_use_atomic_units = use_atomic_units else my_use_atomic_units = .true. end if allocate(varid(19)) if (associated(folder%frequencies_dielectric_function)) then call etsf_io_low_read_var(ncid, "frequencies_dielectric_function", & & folder%frequencies_dielectric_function, & & lstat, ncvarid = varid(1), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%qpoints_dielectric_function)) then call etsf_io_low_read_var(ncid, "qpoints_dielectric_function", & & folder%qpoints_dielectric_function, & & lstat, ncvarid = varid(2), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%qpoints_gamma_limit)) then call etsf_io_low_read_var(ncid, "qpoints_gamma_limit", & & folder%qpoints_gamma_limit, & & lstat, ncvarid = varid(3), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%dielectric_function)) then call etsf_io_low_read_var(ncid, "dielectric_function", & & folder%dielectric_function, & & lstat, ncvarid = varid(4), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%dielectric_function_head)) then call etsf_io_low_read_var(ncid, "dielectric_function_head", & & folder%dielectric_function_head, & & lstat, ncvarid = varid(5), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%dielectric_function_lower_wing)) then call etsf_io_low_read_var(ncid, "dielectric_function_lower_wing", & & folder%dielectric_function_lower_wing, & & lstat, ncvarid = varid(6), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%dielectric_function_upper_wing)) then call etsf_io_low_read_var(ncid, "dielectric_function_upper_wing", & & folder%dielectric_function_upper_wing, & & lstat, ncvarid = varid(7), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%inverse_dielectric_function)) then call etsf_io_low_read_var(ncid, "inverse_dielectric_function", & & folder%inverse_dielectric_function, & & lstat, ncvarid = varid(8), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%inverse_dielectric_function_head)) then call etsf_io_low_read_var(ncid, "inverse_dielectric_function_head", & & folder%inverse_dielectric_function_head, & & lstat, ncvarid = varid(9), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%inverse_dielectric_function_lower_wing)) then call etsf_io_low_read_var(ncid, "inverse_dielectric_function_lower_wing", & & folder%inverse_dielectric_function_lower_wing, & & lstat, ncvarid = varid(10), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%inverse_dielectric_function_upper_wing)) then call etsf_io_low_read_var(ncid, "inverse_dielectric_function_upper_wing", & & folder%inverse_dielectric_function_upper_wing, & & lstat, ncvarid = varid(11), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%polarizability)) then call etsf_io_low_read_var(ncid, "polarizability", & & folder%polarizability, & & lstat, ncvarid = varid(12), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%polarizability_head)) then call etsf_io_low_read_var(ncid, "polarizability_head", & & folder%polarizability_head, & & lstat, ncvarid = varid(13), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%polarizability_lower_wing)) then call etsf_io_low_read_var(ncid, "polarizability_lower_wing", & & folder%polarizability_lower_wing, & & lstat, ncvarid = varid(14), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%polarizability_upper_wing)) then call etsf_io_low_read_var(ncid, "polarizability_upper_wing", & & folder%polarizability_upper_wing, & & lstat, ncvarid = varid(15), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%inverse_polarizability)) then call etsf_io_low_read_var(ncid, "inverse_polarizability", & & folder%inverse_polarizability, & & lstat, ncvarid = varid(16), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%inverse_polarizability_head)) then call etsf_io_low_read_var(ncid, "inverse_polarizability_head", & & folder%inverse_polarizability_head, & & lstat, ncvarid = varid(17), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%inverse_polarizability_lower_wing)) then call etsf_io_low_read_var(ncid, "inverse_polarizability_lower_wing", & & folder%inverse_polarizability_lower_wing, & & lstat, ncvarid = varid(18), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%inverse_polarizability_upper_wing)) then call etsf_io_low_read_var(ncid, "inverse_polarizability_upper_wing", & & folder%inverse_polarizability_upper_wing, & & lstat, ncvarid = varid(19), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if deallocate(varid) !DEBUG !write (*,*) 'etsf_io_dielectric_get : exit' !ENDDEBUG end subroutine etsf_io_dielectric_get !!*** etsf_io-1.0.3/src/group_level/etsf_io_main_get.f900000644000353400050630000002600411354150413017013 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_main/etsf_io_main_get !! NAME !! etsf_io_main_get !! !! FUNCTION !! Read an opened ETSF file to get data related to the given group. !! Only associated pointers of argument @folder will be accessed. If any accessed !! variable is missing, this routine returns an error (usually an access_mode_id !! of argument error_data set to ERROR_MODE_INQ). Any other errors implies a !! return with @lstat = .false.. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = !! integer returned by an 'open' NetCDF call. The file can be !! either in define or write mode. This status can be changed !! by the call. !! * use_atomic_units = (optional) !! set this flag to .true. makes the library use the value of the attribute !! scale_to_atomic_units to multiply the read variables (that are units dependent) !! by this factor (if different from 1.0d0). !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! SIDE EFFECTS !! * folder = !! an allocated structure with pointers on allocated areas in memory. !! These areas will be read or written if the pointer is associated, if !! not, the variable will be ignored. It is possible to access to specific !! dimensions of a variable using the __kpoint_access or !! __spin_access of this @folder structure. The !! __number_of_ can also been set if only a subpart !! in one dimension should be accessed (this is possible when the specifications !! have been declared with a max_number_of_. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_main_get(ncid, folder, lstat, error_data, use_atomic_units) !Arguments ------------------------------------ integer, intent(in) :: ncid type(etsf_main), intent(inout) :: folder logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data logical, optional, intent(in) :: use_atomic_units !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_main_get' logical :: my_use_atomic_units integer,allocatable :: varid(:) integer,allocatable :: start(:) integer,allocatable :: count(:) integer :: len character(etsf_charlen) :: flag ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_main_get : enter' !ENDDEBUG ! Get values for optional arguments, set default. if (present(use_atomic_units)) then my_use_atomic_units = use_atomic_units else my_use_atomic_units = .true. end if allocate(varid(6)) if (etsf_io_low_var_associated(folder%density)) then call etsf_io_low_read_var(ncid, "density", & & folder%density, & & lstat, ncvarid = varid(1), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%exchange_potential)) then call etsf_io_low_read_var(ncid, "exchange_potential", & & folder%exchange_potential, & & lstat, ncvarid = varid(2), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%correlation_potential)) then call etsf_io_low_read_var(ncid, "correlation_potential", & & folder%correlation_potential, & & lstat, ncvarid = varid(3), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%exchange_correlation_potential)) then call etsf_io_low_read_var(ncid, "exchange_correlation_potential", & & folder%exchange_correlation_potential, & & lstat, ncvarid = varid(4), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%coefficients_of_wavefunctions)) then allocate(start(6), count(6)) start(:) = 1 count(:) = 0 if (folder%wfs_coeff__spin_access /= etsf_no_sub_access) then start(6) = folder%wfs_coeff__spin_access count(6) = 1 end if if (folder%wfs_coeff__kpoint_access /= etsf_no_sub_access) then start(5) = folder%wfs_coeff__kpoint_access count(5) = 1 end if count(4) = folder%wfs_coeff__number_of_states if (folder%wfs_coeff__state_access /= etsf_no_sub_access) then start(4) = folder%wfs_coeff__state_access count(4) = 1 end if count(2) = folder%wfs_coeff__number_of_coefficients call etsf_io_low_read_var(ncid, "coefficients_of_wavefunctions", & & folder%coefficients_of_wavefunctions, & & lstat, ncvarid = varid(5), & & error_data = error_data, start = start, count = count) deallocate(start, count) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%real_space_wavefunctions)) then allocate(start(8), count(8)) start(:) = 1 count(:) = 0 if (folder%wfs_rsp__spin_access /= etsf_no_sub_access) then start(8) = folder%wfs_rsp__spin_access count(8) = 1 end if if (folder%wfs_rsp__kpoint_access /= etsf_no_sub_access) then start(7) = folder%wfs_rsp__kpoint_access count(7) = 1 end if count(6) = folder%wfs_rsp__number_of_states if (folder%wfs_rsp__state_access /= etsf_no_sub_access) then start(6) = folder%wfs_rsp__state_access count(6) = 1 end if call etsf_io_low_read_var(ncid, "real_space_wavefunctions", & & folder%real_space_wavefunctions, & & lstat, ncvarid = varid(6), & & error_data = error_data, start = start, count = count) deallocate(start, count) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if ! Handle all attributes for the group. if (etsf_io_low_var_associated(folder%density)) then ! Handle the units attribute. call etsf_io_low_read_att(ncid, varid(1), & & "units", & & etsf_charlen, folder%density__units, & & lstat, error_data = error_data) if (.not. lstat) return if (trim(folder%density__units) /= "atomic units") then call etsf_io_low_read_att(ncid, varid(1), & & "scale_to_atomic_units", & & folder%density__scale_to_atomic_units, & & lstat, error_data = error_data) if (.not. lstat) return else folder%density__scale_to_atomic_units = 1.0d0 end if if (my_use_atomic_units .and. & & folder%density__scale_to_atomic_units /= 1.0d0) then call etsf_io_low_var_multiply(folder%density, & & folder%density__scale_to_atomic_units) end if end if if (etsf_io_low_var_associated(folder%exchange_potential)) then ! Handle the units attribute. call etsf_io_low_read_att(ncid, varid(2), & & "units", & & etsf_charlen, folder%pot_x_only__units, & & lstat, error_data = error_data) if (.not. lstat) return if (trim(folder%pot_x_only__units) /= "atomic units") then call etsf_io_low_read_att(ncid, varid(2), & & "scale_to_atomic_units", & & folder%pot_x_only__scale_to_atomic_units, & & lstat, error_data = error_data) if (.not. lstat) return else folder%pot_x_only__scale_to_atomic_units = 1.0d0 end if if (my_use_atomic_units .and. & & folder%pot_x_only__scale_to_atomic_units /= 1.0d0) then call etsf_io_low_var_multiply(folder%exchange_potential, & & folder%pot_x_only__scale_to_atomic_units) end if end if if (etsf_io_low_var_associated(folder%correlation_potential)) then ! Handle the units attribute. call etsf_io_low_read_att(ncid, varid(3), & & "units", & & etsf_charlen, folder%pot_c_only__units, & & lstat, error_data = error_data) if (.not. lstat) return if (trim(folder%pot_c_only__units) /= "atomic units") then call etsf_io_low_read_att(ncid, varid(3), & & "scale_to_atomic_units", & & folder%pot_c_only__scale_to_atomic_units, & & lstat, error_data = error_data) if (.not. lstat) return else folder%pot_c_only__scale_to_atomic_units = 1.0d0 end if if (my_use_atomic_units .and. & & folder%pot_c_only__scale_to_atomic_units /= 1.0d0) then call etsf_io_low_var_multiply(folder%correlation_potential, & & folder%pot_c_only__scale_to_atomic_units) end if end if if (etsf_io_low_var_associated(folder%exchange_correlation_potential)) then ! Handle the units attribute. call etsf_io_low_read_att(ncid, varid(4), & & "units", & & etsf_charlen, folder%pot_xc__units, & & lstat, error_data = error_data) if (.not. lstat) return if (trim(folder%pot_xc__units) /= "atomic units") then call etsf_io_low_read_att(ncid, varid(4), & & "scale_to_atomic_units", & & folder%pot_xc__scale_to_atomic_units, & & lstat, error_data = error_data) if (.not. lstat) return else folder%pot_xc__scale_to_atomic_units = 1.0d0 end if if (my_use_atomic_units .and. & & folder%pot_xc__scale_to_atomic_units /= 1.0d0) then call etsf_io_low_var_multiply(folder%exchange_correlation_potential, & & folder%pot_xc__scale_to_atomic_units) end if end if deallocate(varid) !DEBUG !write (*,*) 'etsf_io_main_get : exit' !ENDDEBUG end subroutine etsf_io_main_get !!*** etsf_io-1.0.3/src/group_level/etsf_io_geometry_put.f900000644000353400050630000002032411354150413017752 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_geometry/etsf_io_geometry_put !! NAME !! etsf_io_geometry_put !! !! FUNCTION !! Write data related to the given group in an opened ETSF file (it must be in !! write mode, use etsf_io_low_set_write_mode() to change it). !! Only associated pointers of argument @folder will be accessed. If any errors !! occurs it returns with @lstat = .false.. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = !! integer returned by an 'open' NetCDF call. The file can be !! either in define or write mode. This status can be changed !! by the call. !! * folder = !! an allocated structure with pointers on allocated areas in memory. !! These areas will be read or written if the pointer is associated, if !! not, the variable will be ignored. It is possible to access to specific !! dimensions of a variable using the __kpoint_access or !! __spin_access of this @folder structure. The !! __number_of_ can also been set if only a subpart !! in one dimension should be accessed (this is possible when the specifications !! have been declared with a max_number_of_. !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_geometry_put(ncid, folder, lstat, error_data) !Arguments ------------------------------------ integer, intent(in) :: ncid type(etsf_geometry), intent(in) :: folder logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_geometry_put' integer,allocatable :: varid(:) integer,allocatable :: start(:) integer,allocatable :: count(:) integer :: len character(etsf_charlen) :: flag ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_geometry_put : enter' !ENDDEBUG allocate(varid(11)) ! Begin by putting the file in write mode. call etsf_io_low_set_write_mode(ncid, lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if if (associated(folder%space_group)) then call etsf_io_low_write_var(ncid, "space_group", & & folder%space_group, & & lstat, ncvarid = varid(1), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%primitive_vectors)) then call etsf_io_low_write_var(ncid, "primitive_vectors", & & folder%primitive_vectors, & & lstat, ncvarid = varid(2), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%reduced_symmetry_matrices)) then call etsf_io_low_write_var(ncid, "reduced_symmetry_matrices", & & folder%reduced_symmetry_matrices, & & lstat, ncvarid = varid(3), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%reduced_symmetry_translations)) then call etsf_io_low_write_var(ncid, "reduced_symmetry_translations", & & folder%reduced_symmetry_translations, & & lstat, ncvarid = varid(4), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%atom_species)) then call etsf_io_low_write_var(ncid, "atom_species", & & folder%atom_species, & & lstat, ncvarid = varid(5), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%reduced_atom_positions)) then call etsf_io_low_write_var(ncid, "reduced_atom_positions", & & folder%reduced_atom_positions, & & lstat, ncvarid = varid(6), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%valence_charges)) then call etsf_io_low_write_var(ncid, "valence_charges", & & folder%valence_charges, & & lstat, ncvarid = varid(7), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%atomic_numbers)) then call etsf_io_low_write_var(ncid, "atomic_numbers", & & folder%atomic_numbers, & & lstat, ncvarid = varid(8), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%atom_species_names)) then call etsf_io_low_write_var(ncid, "atom_species_names", & & folder%atom_species_names, etsf_charlen, & & lstat, ncvarid = varid(9), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%chemical_symbols)) then call etsf_io_low_write_var(ncid, "chemical_symbols", & & folder%chemical_symbols, etsf_chemlen, & & lstat, ncvarid = varid(10), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%pseudopotential_types)) then call etsf_io_low_write_var(ncid, "pseudopotential_types", & & folder%pseudopotential_types, etsf_charlen, & & lstat, ncvarid = varid(11), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if ! Handle all attributes for the group. call etsf_io_low_set_define_mode(ncid, lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if if (associated(folder%reduced_symmetry_translations)) then ! Handle the symmorphic attribute. ! We test if translations are not nul flag = "yes" do len = 1, size(folder%reduced_symmetry_translations, 2), 1 if (folder%reduced_symmetry_translations(1, len) /= 0.d0 .or. & & folder%reduced_symmetry_translations(2, len) /= 0.d0 .or. & & folder%reduced_symmetry_translations(3, len) /= 0.d0) then flag = "no" end if end do call etsf_io_low_write_att(ncid, varid(3), & & "symmorphic", & & trim(flag), & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if deallocate(varid) !DEBUG !write (*,*) 'etsf_io_geometry_put : exit' !ENDDEBUG end subroutine etsf_io_geometry_put !!*** etsf_io-1.0.3/src/group_level/etsf_io_electrons_put.f900000644000353400050630000001721111354150413020116 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_electrons/etsf_io_electrons_put !! NAME !! etsf_io_electrons_put !! !! FUNCTION !! Write data related to the given group in an opened ETSF file (it must be in !! write mode, use etsf_io_low_set_write_mode() to change it). !! Only associated pointers of argument @folder will be accessed. If any errors !! occurs it returns with @lstat = .false.. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = !! integer returned by an 'open' NetCDF call. The file can be !! either in define or write mode. This status can be changed !! by the call. !! * folder = !! an allocated structure with pointers on allocated areas in memory. !! These areas will be read or written if the pointer is associated, if !! not, the variable will be ignored. It is possible to access to specific !! dimensions of a variable using the __kpoint_access or !! __spin_access of this @folder structure. The !! __number_of_ can also been set if only a subpart !! in one dimension should be accessed (this is possible when the specifications !! have been declared with a max_number_of_. !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_electrons_put(ncid, folder, lstat, error_data) !Arguments ------------------------------------ integer, intent(in) :: ncid type(etsf_electrons), intent(in) :: folder logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_electrons_put' integer,allocatable :: varid(:) integer,allocatable :: start(:) integer,allocatable :: count(:) integer :: len character(etsf_charlen) :: flag ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_electrons_put : enter' !ENDDEBUG allocate(varid(9)) ! Begin by putting the file in write mode. call etsf_io_low_set_write_mode(ncid, lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if if (associated(folder%number_of_electrons)) then call etsf_io_low_write_var(ncid, "number_of_electrons", & & folder%number_of_electrons, & & lstat, ncvarid = varid(1), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%exchange_functional)) then call etsf_io_low_write_var(ncid, "exchange_functional", & & folder%exchange_functional, etsf_charlen, & & lstat, ncvarid = varid(2), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%correlation_functional)) then call etsf_io_low_write_var(ncid, "correlation_functional", & & folder%correlation_functional, etsf_charlen, & & lstat, ncvarid = varid(3), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%fermi_energy)) then call etsf_io_low_write_var(ncid, "fermi_energy", & & folder%fermi_energy, & & lstat, ncvarid = varid(4), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%smearing_scheme)) then call etsf_io_low_write_var(ncid, "smearing_scheme", & & folder%smearing_scheme, etsf_charlen, & & lstat, ncvarid = varid(5), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%smearing_width)) then call etsf_io_low_write_var(ncid, "smearing_width", & & folder%smearing_width, & & lstat, ncvarid = varid(6), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%number_of_states)) then call etsf_io_low_write_var(ncid, "number_of_states", & & folder%number_of_states, & & lstat, ncvarid = varid(7), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%eigenvalues)) then allocate(start(3), count(3)) start(:) = 1 count(:) = 0 if (folder%eigenvalues__spin_access /= etsf_no_sub_access) then start(3) = folder%eigenvalues__spin_access count(3) = 1 end if if (folder%eigenvalues__kpoint_access /= etsf_no_sub_access) then start(2) = folder%eigenvalues__kpoint_access count(2) = 1 end if count(1) = folder%eigenvalues__number_of_states if (folder%eigenvalues__state_access /= etsf_no_sub_access) then start(1) = folder%eigenvalues__state_access count(1) = 1 end if call etsf_io_low_write_var(ncid, "eigenvalues", & & folder%eigenvalues, & & lstat, ncvarid = varid(8), & & error_data = error_data, start = start, count = count) deallocate(start, count) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%occupations)) then allocate(start(3), count(3)) start(:) = 1 count(:) = 0 if (folder%occupations__spin_access /= etsf_no_sub_access) then start(3) = folder%occupations__spin_access count(3) = 1 end if if (folder%occupations__kpoint_access /= etsf_no_sub_access) then start(2) = folder%occupations__kpoint_access count(2) = 1 end if count(1) = folder%occupations__number_of_states if (folder%occupations__state_access /= etsf_no_sub_access) then start(1) = folder%occupations__state_access count(1) = 1 end if call etsf_io_low_write_var(ncid, "occupations", & & folder%occupations, & & lstat, ncvarid = varid(9), & & error_data = error_data, start = start, count = count) deallocate(start, count) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if deallocate(varid) !DEBUG !write (*,*) 'etsf_io_electrons_put : exit' !ENDDEBUG end subroutine etsf_io_electrons_put !!*** etsf_io-1.0.3/src/group_level/etsf_io_kpoints_put.f900000644000353400050630000001152611354150413017612 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_kpoints/etsf_io_kpoints_put !! NAME !! etsf_io_kpoints_put !! !! FUNCTION !! Write data related to the given group in an opened ETSF file (it must be in !! write mode, use etsf_io_low_set_write_mode() to change it). !! Only associated pointers of argument @folder will be accessed. If any errors !! occurs it returns with @lstat = .false.. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = !! integer returned by an 'open' NetCDF call. The file can be !! either in define or write mode. This status can be changed !! by the call. !! * folder = !! an allocated structure with pointers on allocated areas in memory. !! These areas will be read or written if the pointer is associated, if !! not, the variable will be ignored. It is possible to access to specific !! dimensions of a variable using the __kpoint_access or !! __spin_access of this @folder structure. The !! __number_of_ can also been set if only a subpart !! in one dimension should be accessed (this is possible when the specifications !! have been declared with a max_number_of_. !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_kpoints_put(ncid, folder, lstat, error_data) !Arguments ------------------------------------ integer, intent(in) :: ncid type(etsf_kpoints), intent(in) :: folder logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_kpoints_put' integer,allocatable :: varid(:) integer,allocatable :: start(:) integer,allocatable :: count(:) integer :: len character(etsf_charlen) :: flag ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_kpoints_put : enter' !ENDDEBUG allocate(varid(5)) ! Begin by putting the file in write mode. call etsf_io_low_set_write_mode(ncid, lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if if (associated(folder%kpoint_grid_shift)) then call etsf_io_low_write_var(ncid, "kpoint_grid_shift", & & folder%kpoint_grid_shift, & & lstat, ncvarid = varid(1), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%kpoint_grid_vectors)) then call etsf_io_low_write_var(ncid, "kpoint_grid_vectors", & & folder%kpoint_grid_vectors, & & lstat, ncvarid = varid(2), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%monkhorst_pack_folding)) then call etsf_io_low_write_var(ncid, "monkhorst_pack_folding", & & folder%monkhorst_pack_folding, & & lstat, ncvarid = varid(3), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%reduced_coordinates_of_kpoints)) then call etsf_io_low_write_var(ncid, "reduced_coordinates_of_kpoints", & & folder%reduced_coordinates_of_kpoints, & & lstat, ncvarid = varid(4), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%kpoint_weights)) then call etsf_io_low_write_var(ncid, "kpoint_weights", & & folder%kpoint_weights, & & lstat, ncvarid = varid(5), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if deallocate(varid) !DEBUG !write (*,*) 'etsf_io_kpoints_put : exit' !ENDDEBUG end subroutine etsf_io_kpoints_put !!*** etsf_io-1.0.3/src/group_level/etsf_io_basisdata_put.f900000644000353400050630000001515411354150413020057 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_basisdata/etsf_io_basisdata_put !! NAME !! etsf_io_basisdata_put !! !! FUNCTION !! Write data related to the given group in an opened ETSF file (it must be in !! write mode, use etsf_io_low_set_write_mode() to change it). !! Only associated pointers of argument @folder will be accessed. If any errors !! occurs it returns with @lstat = .false.. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = !! integer returned by an 'open' NetCDF call. The file can be !! either in define or write mode. This status can be changed !! by the call. !! * folder = !! an allocated structure with pointers on allocated areas in memory. !! These areas will be read or written if the pointer is associated, if !! not, the variable will be ignored. It is possible to access to specific !! dimensions of a variable using the __kpoint_access or !! __spin_access of this @folder structure. The !! __number_of_ can also been set if only a subpart !! in one dimension should be accessed (this is possible when the specifications !! have been declared with a max_number_of_. !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_basisdata_put(ncid, folder, lstat, error_data) !Arguments ------------------------------------ integer, intent(in) :: ncid type(etsf_basisdata), intent(in) :: folder logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_basisdata_put' integer,allocatable :: varid(:) integer,allocatable :: start(:) integer,allocatable :: count(:) integer :: len character(etsf_charlen) :: flag ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_basisdata_put : enter' !ENDDEBUG allocate(varid(6)) ! Begin by putting the file in write mode. call etsf_io_low_set_write_mode(ncid, lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if if (associated(folder%basis_set)) then call etsf_io_low_write_var(ncid, "basis_set", & & folder%basis_set, etsf_charlen, & & lstat, ncvarid = varid(1), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%kinetic_energy_cutoff)) then call etsf_io_low_write_var(ncid, "kinetic_energy_cutoff", & & folder%kinetic_energy_cutoff, & & lstat, ncvarid = varid(2), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%number_of_coefficients)) then call etsf_io_low_write_var(ncid, "number_of_coefficients", & & folder%number_of_coefficients, & & lstat, ncvarid = varid(3), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%reduced_coordinates_of_plane_waves)) then ! Handle the k_dependent attribute. call etsf_io_low_read_att(ncid, "reduced_coordinates_of_plane_waves", & & "k_dependent", & & etsf_charlen, flag, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if if (flag(1:2) == "no") then allocate(start(2), count(2)) else allocate(start(3), count(3)) end if start(:) = 1 count(:) = 0 if (flag(1:3) == "yes" .and. & & folder%red_coord_pw__kpoint_access /= etsf_no_sub_access) then start(3) = folder%red_coord_pw__kpoint_access count(3) = 1 end if count(2) = folder%red_coord_pw__number_of_coefficients call etsf_io_low_write_var(ncid, "reduced_coordinates_of_plane_waves", & & folder%reduced_coordinates_of_plane_waves, & & lstat, ncvarid = varid(4), & & error_data = error_data, start = start, count = count) deallocate(start, count) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%coordinates_of_basis_grid_points)) then allocate(start(3), count(3)) start(:) = 1 count(:) = 0 count(2) = folder%coord_grid__number_of_basis_grid_points call etsf_io_low_write_var(ncid, "coordinates_of_basis_grid_points", & & folder%coordinates_of_basis_grid_points, & & lstat, ncvarid = varid(5), & & error_data = error_data, start = start, count = count) deallocate(start, count) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%number_of_coefficients_per_grid_point)) then allocate(start(2), count(2)) start(:) = 1 count(:) = 0 count(1) = folder%n_coeff_grid__number_of_basis_grid_points call etsf_io_low_write_var(ncid, "number_of_coefficients_per_grid_point", & & folder%number_of_coefficients_per_grid_point, & & lstat, ncvarid = varid(6), & & error_data = error_data, start = start, count = count) deallocate(start, count) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if deallocate(varid) !DEBUG !write (*,*) 'etsf_io_basisdata_put : exit' !ENDDEBUG end subroutine etsf_io_basisdata_put !!*** etsf_io-1.0.3/src/group_level/etsf_io_gwdata_put.f900000644000353400050630000001431011354150413017364 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_gwdata/etsf_io_gwdata_put !! NAME !! etsf_io_gwdata_put !! !! FUNCTION !! Write data related to the given group in an opened ETSF file (it must be in !! write mode, use etsf_io_low_set_write_mode() to change it). !! Only associated pointers of argument @folder will be accessed. If any errors !! occurs it returns with @lstat = .false.. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = !! integer returned by an 'open' NetCDF call. The file can be !! either in define or write mode. This status can be changed !! by the call. !! * folder = !! an allocated structure with pointers on allocated areas in memory. !! These areas will be read or written if the pointer is associated, if !! not, the variable will be ignored. It is possible to access to specific !! dimensions of a variable using the __kpoint_access or !! __spin_access of this @folder structure. The !! __number_of_ can also been set if only a subpart !! in one dimension should be accessed (this is possible when the specifications !! have been declared with a max_number_of_. !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_gwdata_put(ncid, folder, lstat, error_data) !Arguments ------------------------------------ integer, intent(in) :: ncid type(etsf_gwdata), intent(in) :: folder logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_gwdata_put' integer,allocatable :: varid(:) integer,allocatable :: start(:) integer,allocatable :: count(:) integer :: len character(etsf_charlen) :: flag ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_gwdata_put : enter' !ENDDEBUG allocate(varid(4)) ! Begin by putting the file in write mode. call etsf_io_low_set_write_mode(ncid, lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if if (etsf_io_low_var_associated(folder%gw_corrections)) then allocate(start(4), count(4)) start(:) = 1 count(:) = 0 if (folder%gw_corrections__spin_access /= etsf_no_sub_access) then start(4) = folder%gw_corrections__spin_access count(4) = 1 end if if (folder%gw_corrections__kpoint_access /= etsf_no_sub_access) then start(3) = folder%gw_corrections__kpoint_access count(3) = 1 end if count(2) = folder%gw_corrections__number_of_states if (folder%gw_corrections__state_access /= etsf_no_sub_access) then start(2) = folder%gw_corrections__state_access count(2) = 1 end if call etsf_io_low_write_var(ncid, "gw_corrections", & & folder%gw_corrections, & & lstat, ncvarid = varid(1), & & error_data = error_data, start = start, count = count) deallocate(start, count) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%kb_formfactor_sign)) then allocate(start(3), count(3)) start(:) = 1 count(:) = 0 count(2) = folder%kb_coeff_sig__number_of_angular_momenta count(1) = folder%kb_coeff_sig__number_of_projectors call etsf_io_low_write_var(ncid, "kb_formfactor_sign", & & folder%kb_formfactor_sign, & & lstat, ncvarid = varid(2), & & error_data = error_data, start = start, count = count) deallocate(start, count) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%kb_formfactors)) then allocate(start(5), count(5)) start(:) = 1 count(:) = 0 count(4) = folder%kb_coeff__number_of_angular_momenta count(3) = folder%kb_coeff__number_of_projectors if (folder%kb_coeff__kpoint_access /= etsf_no_sub_access) then start(2) = folder%kb_coeff__kpoint_access count(2) = 1 end if count(1) = folder%kb_coeff__number_of_coefficients call etsf_io_low_write_var(ncid, "kb_formfactors", & & folder%kb_formfactors, & & lstat, ncvarid = varid(3), & & error_data = error_data, start = start, count = count) deallocate(start, count) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%kb_formfactor_derivative)) then allocate(start(5), count(5)) start(:) = 1 count(:) = 0 count(4) = folder%kb_coeff_der__number_of_angular_momenta count(3) = folder%kb_coeff_der__number_of_projectors if (folder%kb_coeff_der__kpoint_access /= etsf_no_sub_access) then start(2) = folder%kb_coeff_der__kpoint_access count(2) = 1 end if count(1) = folder%kb_coeff_der__number_of_coefficients call etsf_io_low_write_var(ncid, "kb_formfactor_derivative", & & folder%kb_formfactor_derivative, & & lstat, ncvarid = varid(4), & & error_data = error_data, start = start, count = count) deallocate(start, count) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if deallocate(varid) !DEBUG !write (*,*) 'etsf_io_gwdata_put : exit' !ENDDEBUG end subroutine etsf_io_gwdata_put !!*** etsf_io-1.0.3/src/group_level/etsf_io_dielectric_put.f900000644000353400050620000002614611354150413020235 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_dielectric/etsf_io_dielectric_put !! NAME !! etsf_io_dielectric_put !! !! FUNCTION !! Write data related to the given group in an opened ETSF file (it must be in !! write mode, use etsf_io_low_set_write_mode() to change it). !! Only associated pointers of argument @folder will be accessed. If any errors !! occurs it returns with @lstat = .false.. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = !! integer returned by an 'open' NetCDF call. The file can be !! either in define or write mode. This status can be changed !! by the call. !! * folder = !! an allocated structure with pointers on allocated areas in memory. !! These areas will be read or written if the pointer is associated, if !! not, the variable will be ignored. It is possible to access to specific !! dimensions of a variable using the __kpoint_access or !! __spin_access of this @folder structure. The !! __number_of_ can also been set if only a subpart !! in one dimension should be accessed (this is possible when the specifications !! have been declared with a max_number_of_. !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_dielectric_put(ncid, folder, lstat, error_data) !Arguments ------------------------------------ integer, intent(in) :: ncid type(etsf_dielectric), intent(in) :: folder logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_dielectric_put' integer,allocatable :: varid(:) integer,allocatable :: start(:) integer,allocatable :: count(:) integer :: len character(etsf_charlen) :: flag ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_dielectric_put : enter' !ENDDEBUG allocate(varid(19)) ! Begin by putting the file in write mode. call etsf_io_low_set_write_mode(ncid, lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if if (associated(folder%frequencies_dielectric_function)) then call etsf_io_low_write_var(ncid, "frequencies_dielectric_function", & & folder%frequencies_dielectric_function, & & lstat, ncvarid = varid(1), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%qpoints_dielectric_function)) then call etsf_io_low_write_var(ncid, "qpoints_dielectric_function", & & folder%qpoints_dielectric_function, & & lstat, ncvarid = varid(2), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(folder%qpoints_gamma_limit)) then call etsf_io_low_write_var(ncid, "qpoints_gamma_limit", & & folder%qpoints_gamma_limit, & & lstat, ncvarid = varid(3), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%dielectric_function)) then call etsf_io_low_write_var(ncid, "dielectric_function", & & folder%dielectric_function, & & lstat, ncvarid = varid(4), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%dielectric_function_head)) then call etsf_io_low_write_var(ncid, "dielectric_function_head", & & folder%dielectric_function_head, & & lstat, ncvarid = varid(5), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%dielectric_function_lower_wing)) then call etsf_io_low_write_var(ncid, "dielectric_function_lower_wing", & & folder%dielectric_function_lower_wing, & & lstat, ncvarid = varid(6), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%dielectric_function_upper_wing)) then call etsf_io_low_write_var(ncid, "dielectric_function_upper_wing", & & folder%dielectric_function_upper_wing, & & lstat, ncvarid = varid(7), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%inverse_dielectric_function)) then call etsf_io_low_write_var(ncid, "inverse_dielectric_function", & & folder%inverse_dielectric_function, & & lstat, ncvarid = varid(8), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%inverse_dielectric_function_head)) then call etsf_io_low_write_var(ncid, "inverse_dielectric_function_head", & & folder%inverse_dielectric_function_head, & & lstat, ncvarid = varid(9), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%inverse_dielectric_function_lower_wing)) then call etsf_io_low_write_var(ncid, "inverse_dielectric_function_lower_wing", & & folder%inverse_dielectric_function_lower_wing, & & lstat, ncvarid = varid(10), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%inverse_dielectric_function_upper_wing)) then call etsf_io_low_write_var(ncid, "inverse_dielectric_function_upper_wing", & & folder%inverse_dielectric_function_upper_wing, & & lstat, ncvarid = varid(11), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%polarizability)) then call etsf_io_low_write_var(ncid, "polarizability", & & folder%polarizability, & & lstat, ncvarid = varid(12), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%polarizability_head)) then call etsf_io_low_write_var(ncid, "polarizability_head", & & folder%polarizability_head, & & lstat, ncvarid = varid(13), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%polarizability_lower_wing)) then call etsf_io_low_write_var(ncid, "polarizability_lower_wing", & & folder%polarizability_lower_wing, & & lstat, ncvarid = varid(14), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%polarizability_upper_wing)) then call etsf_io_low_write_var(ncid, "polarizability_upper_wing", & & folder%polarizability_upper_wing, & & lstat, ncvarid = varid(15), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%inverse_polarizability)) then call etsf_io_low_write_var(ncid, "inverse_polarizability", & & folder%inverse_polarizability, & & lstat, ncvarid = varid(16), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%inverse_polarizability_head)) then call etsf_io_low_write_var(ncid, "inverse_polarizability_head", & & folder%inverse_polarizability_head, & & lstat, ncvarid = varid(17), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%inverse_polarizability_lower_wing)) then call etsf_io_low_write_var(ncid, "inverse_polarizability_lower_wing", & & folder%inverse_polarizability_lower_wing, & & lstat, ncvarid = varid(18), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%inverse_polarizability_upper_wing)) then call etsf_io_low_write_var(ncid, "inverse_polarizability_upper_wing", & & folder%inverse_polarizability_upper_wing, & & lstat, ncvarid = varid(19), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if deallocate(varid) !DEBUG !write (*,*) 'etsf_io_dielectric_put : exit' !ENDDEBUG end subroutine etsf_io_dielectric_put !!*** etsf_io-1.0.3/src/group_level/etsf_io_main_put.f900000644000353400050630000001506611354150413017052 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_main/etsf_io_main_put !! NAME !! etsf_io_main_put !! !! FUNCTION !! Write data related to the given group in an opened ETSF file (it must be in !! write mode, use etsf_io_low_set_write_mode() to change it). !! Only associated pointers of argument @folder will be accessed. If any errors !! occurs it returns with @lstat = .false.. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = !! integer returned by an 'open' NetCDF call. The file can be !! either in define or write mode. This status can be changed !! by the call. !! * folder = !! an allocated structure with pointers on allocated areas in memory. !! These areas will be read or written if the pointer is associated, if !! not, the variable will be ignored. It is possible to access to specific !! dimensions of a variable using the __kpoint_access or !! __spin_access of this @folder structure. The !! __number_of_ can also been set if only a subpart !! in one dimension should be accessed (this is possible when the specifications !! have been declared with a max_number_of_. !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_main_put(ncid, folder, lstat, error_data) !Arguments ------------------------------------ integer, intent(in) :: ncid type(etsf_main), intent(in) :: folder logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_main_put' integer,allocatable :: varid(:) integer,allocatable :: start(:) integer,allocatable :: count(:) integer :: len character(etsf_charlen) :: flag ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_main_put : enter' !ENDDEBUG allocate(varid(6)) ! Begin by putting the file in write mode. call etsf_io_low_set_write_mode(ncid, lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if if (etsf_io_low_var_associated(folder%density)) then call etsf_io_low_write_var(ncid, "density", & & folder%density, & & lstat, ncvarid = varid(1), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%exchange_potential)) then call etsf_io_low_write_var(ncid, "exchange_potential", & & folder%exchange_potential, & & lstat, ncvarid = varid(2), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%correlation_potential)) then call etsf_io_low_write_var(ncid, "correlation_potential", & & folder%correlation_potential, & & lstat, ncvarid = varid(3), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%exchange_correlation_potential)) then call etsf_io_low_write_var(ncid, "exchange_correlation_potential", & & folder%exchange_correlation_potential, & & lstat, ncvarid = varid(4), & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%coefficients_of_wavefunctions)) then allocate(start(6), count(6)) start(:) = 1 count(:) = 0 if (folder%wfs_coeff__spin_access /= etsf_no_sub_access) then start(6) = folder%wfs_coeff__spin_access count(6) = 1 end if if (folder%wfs_coeff__kpoint_access /= etsf_no_sub_access) then start(5) = folder%wfs_coeff__kpoint_access count(5) = 1 end if count(4) = folder%wfs_coeff__number_of_states if (folder%wfs_coeff__state_access /= etsf_no_sub_access) then start(4) = folder%wfs_coeff__state_access count(4) = 1 end if count(2) = folder%wfs_coeff__number_of_coefficients call etsf_io_low_write_var(ncid, "coefficients_of_wavefunctions", & & folder%coefficients_of_wavefunctions, & & lstat, ncvarid = varid(5), & & error_data = error_data, start = start, count = count) deallocate(start, count) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (etsf_io_low_var_associated(folder%real_space_wavefunctions)) then allocate(start(8), count(8)) start(:) = 1 count(:) = 0 if (folder%wfs_rsp__spin_access /= etsf_no_sub_access) then start(8) = folder%wfs_rsp__spin_access count(8) = 1 end if if (folder%wfs_rsp__kpoint_access /= etsf_no_sub_access) then start(7) = folder%wfs_rsp__kpoint_access count(7) = 1 end if count(6) = folder%wfs_rsp__number_of_states if (folder%wfs_rsp__state_access /= etsf_no_sub_access) then start(6) = folder%wfs_rsp__state_access count(6) = 1 end if call etsf_io_low_write_var(ncid, "real_space_wavefunctions", & & folder%real_space_wavefunctions, & & lstat, ncvarid = varid(6), & & error_data = error_data, start = start, count = count) deallocate(start, count) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if deallocate(varid) !DEBUG !write (*,*) 'etsf_io_main_put : exit' !ENDDEBUG end subroutine etsf_io_main_put !!*** etsf_io-1.0.3/src/group_level/etsf_io_geometry_copy.f900000644000353400050630000004042511354150413020120 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_geometry/etsf_io_geometry_copy !! NAME !! etsf_io_geometry_copy !! !! FUNCTION !! This routine copy all variable of a group from one file @ncid_from to another !! @ncid_to. If a variable is missing in the source file, this does not raise an !! error, it is simply skipped. But if a variable in the destination file is not !! defined, this will raise an error. !! !! The copy is done per variable. This means that memory occupation is reduced !! during the copy. !! !! Normally, copies are pristine copies. But if optional argument @split is !! given, then the read values are copied to the specified locations in split !! arrays. In that case, the destination variable must have a compatible definition !! with the split values. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid_to = !! integer returned by an 'open' NetCDF call. This id must have write access !! granted. It will be modified by the routine. The file must be in write !! mode (see etsf_io_low_set_write_mode()). !! * ncid_from = !! integer returned by an 'open' NetCDF call. This id must have read access !! granted. It will be left untouched. !! * dims = !! these dimensions correspond to the source_file ones and are used to allocate !! temporary arrays in memory during the copy. !! * split = (optional) !! if this argument is given, the values in the split definition (e.g. my_kpoints) !! are used to put the data in the destination file in a bigger array at the right !! placed. !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_geometry_copy(ncid_to, ncid_from, dims, lstat, error_data, & & split) !Arguments ------------------------------------ integer, intent(in) :: ncid_to integer, intent(in) :: ncid_from type(etsf_dims), intent(in) :: dims logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data type(etsf_split), optional, intent(in) :: split !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_geometry_copy' type(etsf_split) :: my_split integer,allocatable :: varids(:,:) integer :: nvarids integer,allocatable :: start(:) integer,allocatable :: count(:) integer :: len integer :: istart integer :: idim1,idim2,idim3,idim4,idim5,idim6,idim7,idim8 integer,allocatable :: istop(:) integer,allocatable :: jstart(:) integer,allocatable :: jend(:) type(etsf_geometry) :: folder ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_geometry_copy : enter' !ENDDEBUG lstat = .false. call etsf_io_low_set_write_mode(ncid_to, lstat, error_data = error_data) if (.not. lstat) return allocate(varids(2,11)) nvarids = 1 ! Variable 'space_group' ! allocate and read data allocate(folder%space_group) call etsf_io_low_read_var(ncid_from, "space_group", & & folder%space_group, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%space_group) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then call etsf_io_low_write_var(ncid_to, "space_group", & & folder%space_group, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%space_group) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if nvarids = nvarids + 1 end if deallocate(folder%space_group) lstat = .true. ! Variable 'primitive_vectors' ! allocate and read data allocate(folder%primitive_vectors( & & dims%number_of_vectors, & & dims%number_of_cartesian_directions)) call etsf_io_low_read_var(ncid_from, "primitive_vectors", & & folder%primitive_vectors, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%primitive_vectors) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then call etsf_io_low_write_var(ncid_to, "primitive_vectors", & & folder%primitive_vectors, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%primitive_vectors) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if nvarids = nvarids + 1 end if deallocate(folder%primitive_vectors) lstat = .true. ! Variable 'reduced_symmetry_matrices' ! allocate and read data allocate(folder%reduced_symmetry_matrices( & & dims%number_of_symmetry_operations, & & dims%number_of_reduced_dimensions, & & dims%number_of_reduced_dimensions)) call etsf_io_low_read_var(ncid_from, "reduced_symmetry_matrices", & & folder%reduced_symmetry_matrices, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%reduced_symmetry_matrices) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then call etsf_io_low_write_var(ncid_to, "reduced_symmetry_matrices", & & folder%reduced_symmetry_matrices, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%reduced_symmetry_matrices) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if nvarids = nvarids + 1 end if deallocate(folder%reduced_symmetry_matrices) lstat = .true. ! Variable 'reduced_symmetry_translations' ! allocate and read data allocate(folder%reduced_symmetry_translations( & & dims%number_of_symmetry_operations, & & dims%number_of_reduced_dimensions)) call etsf_io_low_read_var(ncid_from, "reduced_symmetry_translations", & & folder%reduced_symmetry_translations, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%reduced_symmetry_translations) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then call etsf_io_low_write_var(ncid_to, "reduced_symmetry_translations", & & folder%reduced_symmetry_translations, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%reduced_symmetry_translations) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if nvarids = nvarids + 1 end if deallocate(folder%reduced_symmetry_translations) lstat = .true. ! Variable 'atom_species' ! allocate and read data allocate(folder%atom_species( & & dims%number_of_atoms)) call etsf_io_low_read_var(ncid_from, "atom_species", & & folder%atom_species, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%atom_species) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then call etsf_io_low_write_var(ncid_to, "atom_species", & & folder%atom_species, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%atom_species) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if nvarids = nvarids + 1 end if deallocate(folder%atom_species) lstat = .true. ! Variable 'reduced_atom_positions' ! allocate and read data allocate(folder%reduced_atom_positions( & & dims%number_of_atoms, & & dims%number_of_reduced_dimensions)) call etsf_io_low_read_var(ncid_from, "reduced_atom_positions", & & folder%reduced_atom_positions, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%reduced_atom_positions) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then call etsf_io_low_write_var(ncid_to, "reduced_atom_positions", & & folder%reduced_atom_positions, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%reduced_atom_positions) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if nvarids = nvarids + 1 end if deallocate(folder%reduced_atom_positions) lstat = .true. ! Variable 'valence_charges' ! allocate and read data allocate(folder%valence_charges( & & dims%number_of_atom_species)) call etsf_io_low_read_var(ncid_from, "valence_charges", & & folder%valence_charges, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%valence_charges) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then call etsf_io_low_write_var(ncid_to, "valence_charges", & & folder%valence_charges, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%valence_charges) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if nvarids = nvarids + 1 end if deallocate(folder%valence_charges) lstat = .true. ! Variable 'atomic_numbers' ! allocate and read data allocate(folder%atomic_numbers( & & dims%number_of_atom_species)) call etsf_io_low_read_var(ncid_from, "atomic_numbers", & & folder%atomic_numbers, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%atomic_numbers) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then call etsf_io_low_write_var(ncid_to, "atomic_numbers", & & folder%atomic_numbers, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%atomic_numbers) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if nvarids = nvarids + 1 end if deallocate(folder%atomic_numbers) lstat = .true. ! Variable 'atom_species_names' ! allocate and read data allocate(folder%atom_species_names( & & dims%number_of_atom_species)) call etsf_io_low_read_var(ncid_from, "atom_species_names", & & folder%atom_species_names, dims%character_string_length, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%atom_species_names) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then call etsf_io_low_write_var(ncid_to, "atom_species_names", & & folder%atom_species_names, dims%character_string_length, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%atom_species_names) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if nvarids = nvarids + 1 end if deallocate(folder%atom_species_names) lstat = .true. ! Variable 'chemical_symbols' ! allocate and read data allocate(folder%chemical_symbols( & & dims%number_of_atom_species)) call etsf_io_low_read_var(ncid_from, "chemical_symbols", & & folder%chemical_symbols, dims%symbol_length, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%chemical_symbols) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then call etsf_io_low_write_var(ncid_to, "chemical_symbols", & & folder%chemical_symbols, dims%symbol_length, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%chemical_symbols) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if nvarids = nvarids + 1 end if deallocate(folder%chemical_symbols) lstat = .true. ! Variable 'pseudopotential_types' ! allocate and read data allocate(folder%pseudopotential_types( & & dims%number_of_atom_species)) call etsf_io_low_read_var(ncid_from, "pseudopotential_types", & & folder%pseudopotential_types, dims%character_string_length, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%pseudopotential_types) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then call etsf_io_low_write_var(ncid_to, "pseudopotential_types", & & folder%pseudopotential_types, dims%character_string_length, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%pseudopotential_types) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if nvarids = nvarids + 1 end if deallocate(folder%pseudopotential_types) lstat = .true. ! We copy all the attributes (ETSF and non-ETSF) of the group variables. call etsf_io_low_set_define_mode(ncid_to, lstat, error_data = error_data) if (.not. lstat) nvarids = 0 do len = 1, nvarids - 1, 1 call etsf_io_low_copy_all_att(ncid_from, ncid_to, varids(1, len), varids(2, len), & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) exit end if end do deallocate(varids) !DEBUG !write (*,*) 'etsf_io_geometry_copy : exit' !ENDDEBUG end subroutine etsf_io_geometry_copy !!*** etsf_io-1.0.3/src/group_level/etsf_io_electrons_copy.f900000644000353400050630000004757011354150413020273 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_electrons/etsf_io_electrons_copy !! NAME !! etsf_io_electrons_copy !! !! FUNCTION !! This routine copy all variable of a group from one file @ncid_from to another !! @ncid_to. If a variable is missing in the source file, this does not raise an !! error, it is simply skipped. But if a variable in the destination file is not !! defined, this will raise an error. !! !! The copy is done per variable. This means that memory occupation is reduced !! during the copy. !! !! Normally, copies are pristine copies. But if optional argument @split is !! given, then the read values are copied to the specified locations in split !! arrays. In that case, the destination variable must have a compatible definition !! with the split values. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid_to = !! integer returned by an 'open' NetCDF call. This id must have write access !! granted. It will be modified by the routine. The file must be in write !! mode (see etsf_io_low_set_write_mode()). !! * ncid_from = !! integer returned by an 'open' NetCDF call. This id must have read access !! granted. It will be left untouched. !! * dims = !! these dimensions correspond to the source_file ones and are used to allocate !! temporary arrays in memory during the copy. !! * split = (optional) !! if this argument is given, the values in the split definition (e.g. my_kpoints) !! are used to put the data in the destination file in a bigger array at the right !! placed. !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_electrons_copy(ncid_to, ncid_from, dims, lstat, error_data, & & split) !Arguments ------------------------------------ integer, intent(in) :: ncid_to integer, intent(in) :: ncid_from type(etsf_dims), intent(in) :: dims logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data type(etsf_split), optional, intent(in) :: split !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_electrons_copy' type(etsf_split) :: my_split integer,allocatable :: varids(:,:) integer :: nvarids integer,allocatable :: start(:) integer,allocatable :: count(:) integer :: len integer :: istart integer :: idim1,idim2,idim3,idim4,idim5,idim6,idim7,idim8 integer,allocatable :: istop(:) integer,allocatable :: jstart(:) integer,allocatable :: jend(:) type(etsf_electrons) :: folder ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_electrons_copy : enter' !ENDDEBUG lstat = .false. call etsf_io_low_set_write_mode(ncid_to, lstat, error_data = error_data) if (.not. lstat) return allocate(varids(2,9)) nvarids = 1 ! Variable 'number_of_electrons' ! allocate and read data allocate(folder%number_of_electrons) call etsf_io_low_read_var(ncid_from, "number_of_electrons", & & folder%number_of_electrons, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%number_of_electrons) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then call etsf_io_low_write_var(ncid_to, "number_of_electrons", & & folder%number_of_electrons, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%number_of_electrons) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if nvarids = nvarids + 1 end if deallocate(folder%number_of_electrons) lstat = .true. ! Variable 'exchange_functional' ! allocate and read data allocate(folder%exchange_functional) call etsf_io_low_read_var(ncid_from, "exchange_functional", & & folder%exchange_functional, dims%character_string_length, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%exchange_functional) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then call etsf_io_low_write_var(ncid_to, "exchange_functional", & & folder%exchange_functional, dims%character_string_length, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%exchange_functional) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if nvarids = nvarids + 1 end if deallocate(folder%exchange_functional) lstat = .true. ! Variable 'correlation_functional' ! allocate and read data allocate(folder%correlation_functional) call etsf_io_low_read_var(ncid_from, "correlation_functional", & & folder%correlation_functional, dims%character_string_length, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%correlation_functional) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then call etsf_io_low_write_var(ncid_to, "correlation_functional", & & folder%correlation_functional, dims%character_string_length, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%correlation_functional) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if nvarids = nvarids + 1 end if deallocate(folder%correlation_functional) lstat = .true. ! Variable 'fermi_energy' ! allocate and read data allocate(folder%fermi_energy) call etsf_io_low_read_var(ncid_from, "fermi_energy", & & folder%fermi_energy, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%fermi_energy) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then call etsf_io_low_write_var(ncid_to, "fermi_energy", & & folder%fermi_energy, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%fermi_energy) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if nvarids = nvarids + 1 end if deallocate(folder%fermi_energy) lstat = .true. ! Variable 'smearing_scheme' ! allocate and read data allocate(folder%smearing_scheme) call etsf_io_low_read_var(ncid_from, "smearing_scheme", & & folder%smearing_scheme, dims%character_string_length, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%smearing_scheme) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then call etsf_io_low_write_var(ncid_to, "smearing_scheme", & & folder%smearing_scheme, dims%character_string_length, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%smearing_scheme) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if nvarids = nvarids + 1 end if deallocate(folder%smearing_scheme) lstat = .true. ! Variable 'smearing_width' ! allocate and read data allocate(folder%smearing_width) call etsf_io_low_read_var(ncid_from, "smearing_width", & & folder%smearing_width, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%smearing_width) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then call etsf_io_low_write_var(ncid_to, "smearing_width", & & folder%smearing_width, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%smearing_width) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if nvarids = nvarids + 1 end if deallocate(folder%smearing_width) lstat = .true. ! Variable 'number_of_states' ! allocate and read data allocate(folder%number_of_states%data1D( & & dims%my_number_of_spins * & & dims%my_number_of_kpoints)) call etsf_io_low_read_var(ncid_from, "number_of_states", & & folder%number_of_states%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%number_of_states%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(2), count(2)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(2)) istart = 1 len = 1 if (.not. associated(split%my_spins)) then istop(2) = 1 len = len * dims%my_number_of_spins else istop(2) = size(split%my_spins) count(2) = 1 end if if (.not. associated(split%my_kpoints)) then istop(1) = 1 len = len * dims%my_number_of_kpoints else istop(1) = size(split%my_kpoints) count(1) = 1 end if do idim2 = 1, istop(2), 1 if (associated(split%my_spins)) then start(2) = split%my_spins(idim2) end if do idim1 = 1, istop(1), 1 if (associated(split%my_kpoints)) then start(1) = split%my_kpoints(idim1) end if call etsf_io_low_write_var(ncid_to, "number_of_states", & & folder%number_of_states%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%number_of_states%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do deallocate(start, count, istop) else ! No split information, we copy everything in the same shape. call etsf_io_low_write_var(ncid_to, "number_of_states", & & folder%number_of_states%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%number_of_states%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%number_of_states%data1D) lstat = .true. ! Variable 'eigenvalues' ! allocate and read data allocate(folder%eigenvalues%data1D( & & dims%my_number_of_spins * & & dims%my_number_of_kpoints * & & dims%my_max_number_of_states)) call etsf_io_low_read_var(ncid_from, "eigenvalues", & & folder%eigenvalues%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%eigenvalues%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(3), count(3)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(3)) istart = 1 len = 1 if (.not. associated(split%my_spins)) then istop(3) = 1 len = len * dims%my_number_of_spins else istop(3) = size(split%my_spins) count(3) = 1 end if if (.not. associated(split%my_kpoints)) then istop(2) = 1 len = len * dims%my_number_of_kpoints else istop(2) = size(split%my_kpoints) count(2) = 1 end if if (.not. associated(split%my_states)) then istop(1) = 1 len = len * dims%my_max_number_of_states else istop(1) = size(split%my_states) count(1) = 1 end if do idim3 = 1, istop(3), 1 if (associated(split%my_spins)) then start(3) = split%my_spins(idim3) end if do idim2 = 1, istop(2), 1 if (associated(split%my_kpoints)) then start(2) = split%my_kpoints(idim2) end if do idim1 = 1, istop(1), 1 if (associated(split%my_states)) then start(1) = split%my_states(idim1) end if call etsf_io_low_write_var(ncid_to, "eigenvalues", & & folder%eigenvalues%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%eigenvalues%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do end do deallocate(start, count, istop) else ! No split information, we copy everything in the same shape. call etsf_io_low_write_var(ncid_to, "eigenvalues", & & folder%eigenvalues%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%eigenvalues%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%eigenvalues%data1D) lstat = .true. ! Variable 'occupations' ! allocate and read data allocate(folder%occupations%data1D( & & dims%my_number_of_spins * & & dims%my_number_of_kpoints * & & dims%my_max_number_of_states)) call etsf_io_low_read_var(ncid_from, "occupations", & & folder%occupations%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%occupations%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(3), count(3)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(3)) istart = 1 len = 1 if (.not. associated(split%my_spins)) then istop(3) = 1 len = len * dims%my_number_of_spins else istop(3) = size(split%my_spins) count(3) = 1 end if if (.not. associated(split%my_kpoints)) then istop(2) = 1 len = len * dims%my_number_of_kpoints else istop(2) = size(split%my_kpoints) count(2) = 1 end if if (.not. associated(split%my_states)) then istop(1) = 1 len = len * dims%my_max_number_of_states else istop(1) = size(split%my_states) count(1) = 1 end if do idim3 = 1, istop(3), 1 if (associated(split%my_spins)) then start(3) = split%my_spins(idim3) end if do idim2 = 1, istop(2), 1 if (associated(split%my_kpoints)) then start(2) = split%my_kpoints(idim2) end if do idim1 = 1, istop(1), 1 if (associated(split%my_states)) then start(1) = split%my_states(idim1) end if call etsf_io_low_write_var(ncid_to, "occupations", & & folder%occupations%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%occupations%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do end do deallocate(start, count, istop) else ! No split information, we copy everything in the same shape. call etsf_io_low_write_var(ncid_to, "occupations", & & folder%occupations%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%occupations%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%occupations%data1D) lstat = .true. ! We copy all the attributes (ETSF and non-ETSF) of the group variables. call etsf_io_low_set_define_mode(ncid_to, lstat, error_data = error_data) if (.not. lstat) nvarids = 0 do len = 1, nvarids - 1, 1 call etsf_io_low_copy_all_att(ncid_from, ncid_to, varids(1, len), varids(2, len), & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) exit end if end do deallocate(varids) !DEBUG !write (*,*) 'etsf_io_electrons_copy : exit' !ENDDEBUG end subroutine etsf_io_electrons_copy !!*** etsf_io-1.0.3/src/group_level/etsf_io_kpoints_copy.f900000644000353400050630000003121211354150413017746 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_kpoints/etsf_io_kpoints_copy !! NAME !! etsf_io_kpoints_copy !! !! FUNCTION !! This routine copy all variable of a group from one file @ncid_from to another !! @ncid_to. If a variable is missing in the source file, this does not raise an !! error, it is simply skipped. But if a variable in the destination file is not !! defined, this will raise an error. !! !! The copy is done per variable. This means that memory occupation is reduced !! during the copy. !! !! Normally, copies are pristine copies. But if optional argument @split is !! given, then the read values are copied to the specified locations in split !! arrays. In that case, the destination variable must have a compatible definition !! with the split values. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid_to = !! integer returned by an 'open' NetCDF call. This id must have write access !! granted. It will be modified by the routine. The file must be in write !! mode (see etsf_io_low_set_write_mode()). !! * ncid_from = !! integer returned by an 'open' NetCDF call. This id must have read access !! granted. It will be left untouched. !! * dims = !! these dimensions correspond to the source_file ones and are used to allocate !! temporary arrays in memory during the copy. !! * split = (optional) !! if this argument is given, the values in the split definition (e.g. my_kpoints) !! are used to put the data in the destination file in a bigger array at the right !! placed. !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_kpoints_copy(ncid_to, ncid_from, dims, lstat, error_data, & & split) !Arguments ------------------------------------ integer, intent(in) :: ncid_to integer, intent(in) :: ncid_from type(etsf_dims), intent(in) :: dims logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data type(etsf_split), optional, intent(in) :: split !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_kpoints_copy' type(etsf_split) :: my_split integer,allocatable :: varids(:,:) integer :: nvarids integer,allocatable :: start(:) integer,allocatable :: count(:) integer :: len integer :: istart integer :: idim1,idim2,idim3,idim4,idim5,idim6,idim7,idim8 integer,allocatable :: istop(:) integer,allocatable :: jstart(:) integer,allocatable :: jend(:) type(etsf_kpoints) :: folder ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_kpoints_copy : enter' !ENDDEBUG lstat = .false. call etsf_io_low_set_write_mode(ncid_to, lstat, error_data = error_data) if (.not. lstat) return allocate(varids(2,5)) nvarids = 1 ! Variable 'kpoint_grid_shift' ! allocate and read data allocate(folder%kpoint_grid_shift( & & dims%number_of_reduced_dimensions)) call etsf_io_low_read_var(ncid_from, "kpoint_grid_shift", & & folder%kpoint_grid_shift, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%kpoint_grid_shift) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then call etsf_io_low_write_var(ncid_to, "kpoint_grid_shift", & & folder%kpoint_grid_shift, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%kpoint_grid_shift) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if nvarids = nvarids + 1 end if deallocate(folder%kpoint_grid_shift) lstat = .true. ! Variable 'kpoint_grid_vectors' ! allocate and read data allocate(folder%kpoint_grid_vectors( & & dims%number_of_vectors, & & dims%number_of_reduced_dimensions)) call etsf_io_low_read_var(ncid_from, "kpoint_grid_vectors", & & folder%kpoint_grid_vectors, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%kpoint_grid_vectors) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then call etsf_io_low_write_var(ncid_to, "kpoint_grid_vectors", & & folder%kpoint_grid_vectors, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%kpoint_grid_vectors) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if nvarids = nvarids + 1 end if deallocate(folder%kpoint_grid_vectors) lstat = .true. ! Variable 'monkhorst_pack_folding' ! allocate and read data allocate(folder%monkhorst_pack_folding( & & dims%number_of_vectors)) call etsf_io_low_read_var(ncid_from, "monkhorst_pack_folding", & & folder%monkhorst_pack_folding, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%monkhorst_pack_folding) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then call etsf_io_low_write_var(ncid_to, "monkhorst_pack_folding", & & folder%monkhorst_pack_folding, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%monkhorst_pack_folding) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if nvarids = nvarids + 1 end if deallocate(folder%monkhorst_pack_folding) lstat = .true. ! Variable 'reduced_coordinates_of_kpoints' ! allocate and read data allocate(folder%reduced_coordinates_of_kpoints( & & dims%my_number_of_kpoints, & & dims%number_of_reduced_dimensions)) call etsf_io_low_read_var(ncid_from, "reduced_coordinates_of_kpoints", & & folder%reduced_coordinates_of_kpoints, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%reduced_coordinates_of_kpoints) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(2), count(2)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(2)) allocate(jstart(2), jend(2)) if (.not. associated(split%my_kpoints)) then istop(2) = 1 jstart(2) = 1 jend(2) = dims%my_number_of_kpoints else istop(2) = size(split%my_kpoints) count(2) = 1 end if do idim2 = 1, istop(2), 1 if (associated(split%my_kpoints)) then start(2) = split%my_kpoints(idim2) jstart(2) = split%my_kpoints(idim2) jend(2) = split%my_kpoints(idim2) end if call etsf_io_low_write_var(ncid_to, "reduced_coordinates_of_kpoints", & & folder%reduced_coordinates_of_kpoints(:, jstart(2):jend(2)), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%reduced_coordinates_of_kpoints) deallocate(start, count, istop) deallocate(jstart, jend) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end do deallocate(start, count, istop) deallocate(jstart, jend) else ! No split information, we copy everything in the same shape. call etsf_io_low_write_var(ncid_to, "reduced_coordinates_of_kpoints", & & folder%reduced_coordinates_of_kpoints, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%reduced_coordinates_of_kpoints) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%reduced_coordinates_of_kpoints) lstat = .true. ! Variable 'kpoint_weights' ! allocate and read data allocate(folder%kpoint_weights( & & dims%my_number_of_kpoints)) call etsf_io_low_read_var(ncid_from, "kpoint_weights", & & folder%kpoint_weights, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%kpoint_weights) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(1), count(1)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(1)) allocate(jstart(1), jend(1)) if (.not. associated(split%my_kpoints)) then istop(1) = 1 jstart(1) = 1 jend(1) = dims%my_number_of_kpoints else istop(1) = size(split%my_kpoints) count(1) = 1 end if do idim1 = 1, istop(1), 1 if (associated(split%my_kpoints)) then start(1) = split%my_kpoints(idim1) jstart(1) = split%my_kpoints(idim1) jend(1) = split%my_kpoints(idim1) end if call etsf_io_low_write_var(ncid_to, "kpoint_weights", & & folder%kpoint_weights(jstart(1):jend(1)), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%kpoint_weights) deallocate(start, count, istop) deallocate(jstart, jend) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end do deallocate(start, count, istop) deallocate(jstart, jend) else ! No split information, we copy everything in the same shape. call etsf_io_low_write_var(ncid_to, "kpoint_weights", & & folder%kpoint_weights, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%kpoint_weights) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%kpoint_weights) lstat = .true. ! We copy all the attributes (ETSF and non-ETSF) of the group variables. call etsf_io_low_set_define_mode(ncid_to, lstat, error_data = error_data) if (.not. lstat) nvarids = 0 do len = 1, nvarids - 1, 1 call etsf_io_low_copy_all_att(ncid_from, ncid_to, varids(1, len), varids(2, len), & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) exit end if end do deallocate(varids) !DEBUG !write (*,*) 'etsf_io_kpoints_copy : exit' !ENDDEBUG end subroutine etsf_io_kpoints_copy !!*** etsf_io-1.0.3/src/group_level/etsf_io_basisdata_copy.f900000644000353400050630000003527711354150413020231 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_basisdata/etsf_io_basisdata_copy !! NAME !! etsf_io_basisdata_copy !! !! FUNCTION !! This routine copy all variable of a group from one file @ncid_from to another !! @ncid_to. If a variable is missing in the source file, this does not raise an !! error, it is simply skipped. But if a variable in the destination file is not !! defined, this will raise an error. !! !! The copy is done per variable. This means that memory occupation is reduced !! during the copy. !! !! Normally, copies are pristine copies. But if optional argument @split is !! given, then the read values are copied to the specified locations in split !! arrays. In that case, the destination variable must have a compatible definition !! with the split values. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid_to = !! integer returned by an 'open' NetCDF call. This id must have write access !! granted. It will be modified by the routine. The file must be in write !! mode (see etsf_io_low_set_write_mode()). !! * ncid_from = !! integer returned by an 'open' NetCDF call. This id must have read access !! granted. It will be left untouched. !! * dims = !! these dimensions correspond to the source_file ones and are used to allocate !! temporary arrays in memory during the copy. !! * split = (optional) !! if this argument is given, the values in the split definition (e.g. my_kpoints) !! are used to put the data in the destination file in a bigger array at the right !! placed. !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_basisdata_copy(ncid_to, ncid_from, dims, lstat, error_data, & & split) !Arguments ------------------------------------ integer, intent(in) :: ncid_to integer, intent(in) :: ncid_from type(etsf_dims), intent(in) :: dims logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data type(etsf_split), optional, intent(in) :: split !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_basisdata_copy' type(etsf_split) :: my_split integer,allocatable :: varids(:,:) integer :: nvarids integer,allocatable :: start(:) integer,allocatable :: count(:) integer :: len integer :: istart integer :: idim1,idim2,idim3,idim4,idim5,idim6,idim7,idim8 integer,allocatable :: istop(:) integer,allocatable :: jstart(:) integer,allocatable :: jend(:) type(etsf_basisdata) :: folder ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_basisdata_copy : enter' !ENDDEBUG lstat = .false. call etsf_io_low_set_write_mode(ncid_to, lstat, error_data = error_data) if (.not. lstat) return allocate(varids(2,6)) nvarids = 1 ! Variable 'basis_set' ! allocate and read data allocate(folder%basis_set) call etsf_io_low_read_var(ncid_from, "basis_set", & & folder%basis_set, dims%character_string_length, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%basis_set) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then call etsf_io_low_write_var(ncid_to, "basis_set", & & folder%basis_set, dims%character_string_length, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%basis_set) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if nvarids = nvarids + 1 end if deallocate(folder%basis_set) lstat = .true. ! Variable 'kinetic_energy_cutoff' ! allocate and read data allocate(folder%kinetic_energy_cutoff) call etsf_io_low_read_var(ncid_from, "kinetic_energy_cutoff", & & folder%kinetic_energy_cutoff, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%kinetic_energy_cutoff) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then call etsf_io_low_write_var(ncid_to, "kinetic_energy_cutoff", & & folder%kinetic_energy_cutoff, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%kinetic_energy_cutoff) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if nvarids = nvarids + 1 end if deallocate(folder%kinetic_energy_cutoff) lstat = .true. ! Variable 'number_of_coefficients' ! allocate and read data allocate(folder%number_of_coefficients( & & dims%my_number_of_kpoints)) call etsf_io_low_read_var(ncid_from, "number_of_coefficients", & & folder%number_of_coefficients, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%number_of_coefficients) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(1), count(1)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(1)) allocate(jstart(1), jend(1)) if (.not. associated(split%my_kpoints)) then istop(1) = 1 jstart(1) = 1 jend(1) = dims%my_number_of_kpoints else istop(1) = size(split%my_kpoints) count(1) = 1 end if do idim1 = 1, istop(1), 1 if (associated(split%my_kpoints)) then start(1) = split%my_kpoints(idim1) jstart(1) = split%my_kpoints(idim1) jend(1) = split%my_kpoints(idim1) end if call etsf_io_low_write_var(ncid_to, "number_of_coefficients", & & folder%number_of_coefficients(jstart(1):jend(1)), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%number_of_coefficients) deallocate(start, count, istop) deallocate(jstart, jend) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end do deallocate(start, count, istop) deallocate(jstart, jend) else ! No split information, we copy everything in the same shape. call etsf_io_low_write_var(ncid_to, "number_of_coefficients", & & folder%number_of_coefficients, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%number_of_coefficients) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%number_of_coefficients) lstat = .true. ! Variable 'reduced_coordinates_of_plane_waves' ! allocate and read data allocate(folder%reduced_coordinates_of_plane_waves%data1D( & & dims%my_number_of_kpoints * & & dims%my_max_number_of_coefficients * & & dims%number_of_reduced_dimensions)) call etsf_io_low_read_var(ncid_from, "reduced_coordinates_of_plane_waves", & & folder%reduced_coordinates_of_plane_waves%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%reduced_coordinates_of_plane_waves%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(3), count(3)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(3)) istart = 1 len = 1 if (.not. associated(split%my_kpoints)) then istop(3) = 1 len = len * dims%my_number_of_kpoints else istop(3) = size(split%my_kpoints) count(3) = 1 end if if (.not. associated(split%my_coefficients)) then istop(2) = 1 len = len * dims%my_max_number_of_coefficients else istop(2) = size(split%my_coefficients) count(2) = 1 end if len = len * dims%number_of_reduced_dimensions do idim3 = 1, istop(3), 1 if (associated(split%my_kpoints)) then start(3) = split%my_kpoints(idim3) end if do idim2 = 1, istop(2), 1 if (associated(split%my_coefficients)) then start(2) = split%my_coefficients(idim2) end if call etsf_io_low_write_var(ncid_to, "reduced_coordinates_of_plane_waves", & & folder%reduced_coordinates_of_plane_waves%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%reduced_coordinates_of_plane_waves%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do deallocate(start, count, istop) else ! No split information, we copy everything in the same shape. call etsf_io_low_write_var(ncid_to, "reduced_coordinates_of_plane_waves", & & folder%reduced_coordinates_of_plane_waves%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%reduced_coordinates_of_plane_waves%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%reduced_coordinates_of_plane_waves%data1D) lstat = .true. ! Variable 'coordinates_of_basis_grid_points' ! allocate and read data allocate(folder%coordinates_of_basis_grid_points%data1D( & & dims%number_of_localization_regions * & & dims%max_number_of_basis_grid_points * & & dims%number_of_reduced_dimensions)) call etsf_io_low_read_var(ncid_from, "coordinates_of_basis_grid_points", & & folder%coordinates_of_basis_grid_points%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%coordinates_of_basis_grid_points%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then call etsf_io_low_write_var(ncid_to, "coordinates_of_basis_grid_points", & & folder%coordinates_of_basis_grid_points%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%coordinates_of_basis_grid_points%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if nvarids = nvarids + 1 end if deallocate(folder%coordinates_of_basis_grid_points%data1D) lstat = .true. ! Variable 'number_of_coefficients_per_grid_point' ! allocate and read data allocate(folder%number_of_coefficients_per_grid_point%data1D( & & dims%number_of_localization_regions * & & dims%max_number_of_basis_grid_points)) call etsf_io_low_read_var(ncid_from, "number_of_coefficients_per_grid_point", & & folder%number_of_coefficients_per_grid_point%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%number_of_coefficients_per_grid_point%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then call etsf_io_low_write_var(ncid_to, "number_of_coefficients_per_grid_point", & & folder%number_of_coefficients_per_grid_point%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%number_of_coefficients_per_grid_point%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if nvarids = nvarids + 1 end if deallocate(folder%number_of_coefficients_per_grid_point%data1D) lstat = .true. ! We copy all the attributes (ETSF and non-ETSF) of the group variables. call etsf_io_low_set_define_mode(ncid_to, lstat, error_data = error_data) if (.not. lstat) nvarids = 0 do len = 1, nvarids - 1, 1 call etsf_io_low_copy_all_att(ncid_from, ncid_to, varids(1, len), varids(2, len), & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) exit end if end do deallocate(varids) !DEBUG !write (*,*) 'etsf_io_basisdata_copy : exit' !ENDDEBUG end subroutine etsf_io_basisdata_copy !!*** etsf_io-1.0.3/src/group_level/etsf_io_gwdata_copy.f900000644000353400050630000003611511354150413017535 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_gwdata/etsf_io_gwdata_copy !! NAME !! etsf_io_gwdata_copy !! !! FUNCTION !! This routine copy all variable of a group from one file @ncid_from to another !! @ncid_to. If a variable is missing in the source file, this does not raise an !! error, it is simply skipped. But if a variable in the destination file is not !! defined, this will raise an error. !! !! The copy is done per variable. This means that memory occupation is reduced !! during the copy. !! !! Normally, copies are pristine copies. But if optional argument @split is !! given, then the read values are copied to the specified locations in split !! arrays. In that case, the destination variable must have a compatible definition !! with the split values. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid_to = !! integer returned by an 'open' NetCDF call. This id must have write access !! granted. It will be modified by the routine. The file must be in write !! mode (see etsf_io_low_set_write_mode()). !! * ncid_from = !! integer returned by an 'open' NetCDF call. This id must have read access !! granted. It will be left untouched. !! * dims = !! these dimensions correspond to the source_file ones and are used to allocate !! temporary arrays in memory during the copy. !! * split = (optional) !! if this argument is given, the values in the split definition (e.g. my_kpoints) !! are used to put the data in the destination file in a bigger array at the right !! placed. !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_gwdata_copy(ncid_to, ncid_from, dims, lstat, error_data, & & split) !Arguments ------------------------------------ integer, intent(in) :: ncid_to integer, intent(in) :: ncid_from type(etsf_dims), intent(in) :: dims logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data type(etsf_split), optional, intent(in) :: split !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_gwdata_copy' type(etsf_split) :: my_split integer,allocatable :: varids(:,:) integer :: nvarids integer,allocatable :: start(:) integer,allocatable :: count(:) integer :: len integer :: istart integer :: idim1,idim2,idim3,idim4,idim5,idim6,idim7,idim8 integer,allocatable :: istop(:) integer,allocatable :: jstart(:) integer,allocatable :: jend(:) type(etsf_gwdata) :: folder ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_gwdata_copy : enter' !ENDDEBUG lstat = .false. call etsf_io_low_set_write_mode(ncid_to, lstat, error_data = error_data) if (.not. lstat) return allocate(varids(2,4)) nvarids = 1 ! Variable 'gw_corrections' ! allocate and read data allocate(folder%gw_corrections%data1D( & & dims%my_number_of_spins * & & dims%my_number_of_kpoints * & & dims%my_max_number_of_states * & & dims%real_or_complex_gw_corrections)) call etsf_io_low_read_var(ncid_from, "gw_corrections", & & folder%gw_corrections%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%gw_corrections%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(4), count(4)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(4)) istart = 1 len = 1 if (.not. associated(split%my_spins)) then istop(4) = 1 len = len * dims%my_number_of_spins else istop(4) = size(split%my_spins) count(4) = 1 end if if (.not. associated(split%my_kpoints)) then istop(3) = 1 len = len * dims%my_number_of_kpoints else istop(3) = size(split%my_kpoints) count(3) = 1 end if if (.not. associated(split%my_states)) then istop(2) = 1 len = len * dims%my_max_number_of_states else istop(2) = size(split%my_states) count(2) = 1 end if len = len * dims%real_or_complex_gw_corrections do idim4 = 1, istop(4), 1 if (associated(split%my_spins)) then start(4) = split%my_spins(idim4) end if do idim3 = 1, istop(3), 1 if (associated(split%my_kpoints)) then start(3) = split%my_kpoints(idim3) end if do idim2 = 1, istop(2), 1 if (associated(split%my_states)) then start(2) = split%my_states(idim2) end if call etsf_io_low_write_var(ncid_to, "gw_corrections", & & folder%gw_corrections%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%gw_corrections%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do end do deallocate(start, count, istop) else ! No split information, we copy everything in the same shape. call etsf_io_low_write_var(ncid_to, "gw_corrections", & & folder%gw_corrections%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%gw_corrections%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%gw_corrections%data1D) lstat = .true. ! Variable 'kb_formfactor_sign' ! allocate and read data allocate(folder%kb_formfactor_sign%data1D( & & dims%number_of_atom_species * & & dims%max_number_of_angular_momenta * & & dims%max_number_of_projectors)) call etsf_io_low_read_var(ncid_from, "kb_formfactor_sign", & & folder%kb_formfactor_sign%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%kb_formfactor_sign%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then call etsf_io_low_write_var(ncid_to, "kb_formfactor_sign", & & folder%kb_formfactor_sign%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%kb_formfactor_sign%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if nvarids = nvarids + 1 end if deallocate(folder%kb_formfactor_sign%data1D) lstat = .true. ! Variable 'kb_formfactors' ! allocate and read data allocate(folder%kb_formfactors%data1D( & & dims%number_of_atom_species * & & dims%max_number_of_angular_momenta * & & dims%max_number_of_projectors * & & dims%my_number_of_kpoints * & & dims%my_max_number_of_coefficients)) call etsf_io_low_read_var(ncid_from, "kb_formfactors", & & folder%kb_formfactors%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%kb_formfactors%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(5), count(5)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(5)) istart = 1 len = 1 len = len * dims%number_of_atom_species len = len * dims%max_number_of_angular_momenta len = len * dims%max_number_of_projectors if (.not. associated(split%my_kpoints)) then istop(2) = 1 len = len * dims%my_number_of_kpoints else istop(2) = size(split%my_kpoints) count(2) = 1 end if if (.not. associated(split%my_coefficients)) then istop(1) = 1 len = len * dims%my_max_number_of_coefficients else istop(1) = size(split%my_coefficients) count(1) = 1 end if do idim2 = 1, istop(2), 1 if (associated(split%my_kpoints)) then start(2) = split%my_kpoints(idim2) end if do idim1 = 1, istop(1), 1 if (associated(split%my_coefficients)) then start(1) = split%my_coefficients(idim1) end if call etsf_io_low_write_var(ncid_to, "kb_formfactors", & & folder%kb_formfactors%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%kb_formfactors%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do deallocate(start, count, istop) else ! No split information, we copy everything in the same shape. call etsf_io_low_write_var(ncid_to, "kb_formfactors", & & folder%kb_formfactors%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%kb_formfactors%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%kb_formfactors%data1D) lstat = .true. ! Variable 'kb_formfactor_derivative' ! allocate and read data allocate(folder%kb_formfactor_derivative%data1D( & & dims%number_of_atom_species * & & dims%max_number_of_angular_momenta * & & dims%max_number_of_projectors * & & dims%my_number_of_kpoints * & & dims%my_max_number_of_coefficients)) call etsf_io_low_read_var(ncid_from, "kb_formfactor_derivative", & & folder%kb_formfactor_derivative%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%kb_formfactor_derivative%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(5), count(5)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(5)) istart = 1 len = 1 len = len * dims%number_of_atom_species len = len * dims%max_number_of_angular_momenta len = len * dims%max_number_of_projectors if (.not. associated(split%my_kpoints)) then istop(2) = 1 len = len * dims%my_number_of_kpoints else istop(2) = size(split%my_kpoints) count(2) = 1 end if if (.not. associated(split%my_coefficients)) then istop(1) = 1 len = len * dims%my_max_number_of_coefficients else istop(1) = size(split%my_coefficients) count(1) = 1 end if do idim2 = 1, istop(2), 1 if (associated(split%my_kpoints)) then start(2) = split%my_kpoints(idim2) end if do idim1 = 1, istop(1), 1 if (associated(split%my_coefficients)) then start(1) = split%my_coefficients(idim1) end if call etsf_io_low_write_var(ncid_to, "kb_formfactor_derivative", & & folder%kb_formfactor_derivative%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%kb_formfactor_derivative%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do deallocate(start, count, istop) else ! No split information, we copy everything in the same shape. call etsf_io_low_write_var(ncid_to, "kb_formfactor_derivative", & & folder%kb_formfactor_derivative%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%kb_formfactor_derivative%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%kb_formfactor_derivative%data1D) lstat = .true. ! We copy all the attributes (ETSF and non-ETSF) of the group variables. call etsf_io_low_set_define_mode(ncid_to, lstat, error_data = error_data) if (.not. lstat) nvarids = 0 do len = 1, nvarids - 1, 1 call etsf_io_low_copy_all_att(ncid_from, ncid_to, varids(1, len), varids(2, len), & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) exit end if end do deallocate(varids) !DEBUG !write (*,*) 'etsf_io_gwdata_copy : exit' !ENDDEBUG end subroutine etsf_io_gwdata_copy !!*** etsf_io-1.0.3/src/group_level/etsf_io_dielectric_copy.f900000644000353400050620000017500311354150413020374 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_dielectric/etsf_io_dielectric_copy !! NAME !! etsf_io_dielectric_copy !! !! FUNCTION !! This routine copy all variable of a group from one file @ncid_from to another !! @ncid_to. If a variable is missing in the source file, this does not raise an !! error, it is simply skipped. But if a variable in the destination file is not !! defined, this will raise an error. !! !! The copy is done per variable. This means that memory occupation is reduced !! during the copy. !! !! Normally, copies are pristine copies. But if optional argument @split is !! given, then the read values are copied to the specified locations in split !! arrays. In that case, the destination variable must have a compatible definition !! with the split values. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid_to = !! integer returned by an 'open' NetCDF call. This id must have write access !! granted. It will be modified by the routine. The file must be in write !! mode (see etsf_io_low_set_write_mode()). !! * ncid_from = !! integer returned by an 'open' NetCDF call. This id must have read access !! granted. It will be left untouched. !! * dims = !! these dimensions correspond to the source_file ones and are used to allocate !! temporary arrays in memory during the copy. !! * split = (optional) !! if this argument is given, the values in the split definition (e.g. my_kpoints) !! are used to put the data in the destination file in a bigger array at the right !! placed. !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_dielectric_copy(ncid_to, ncid_from, dims, lstat, error_data, & & split) !Arguments ------------------------------------ integer, intent(in) :: ncid_to integer, intent(in) :: ncid_from type(etsf_dims), intent(in) :: dims logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data type(etsf_split), optional, intent(in) :: split !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_dielectric_copy' type(etsf_split) :: my_split integer,allocatable :: varids(:,:) integer :: nvarids integer,allocatable :: start(:) integer,allocatable :: count(:) integer :: len integer :: istart integer :: idim1,idim2,idim3,idim4,idim5,idim6,idim7,idim8 integer,allocatable :: istop(:) integer,allocatable :: jstart(:) integer,allocatable :: jend(:) type(etsf_dielectric) :: folder ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_dielectric_copy : enter' !ENDDEBUG lstat = .false. call etsf_io_low_set_write_mode(ncid_to, lstat, error_data = error_data) if (.not. lstat) return allocate(varids(2,19)) nvarids = 1 ! Variable 'frequencies_dielectric_function' ! allocate and read data allocate(folder%frequencies_dielectric_function( & & dims%number_of_frequencies_dielectric_function, & & dims%complex)) call etsf_io_low_read_var(ncid_from, "frequencies_dielectric_function", & & folder%frequencies_dielectric_function, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%frequencies_dielectric_function) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then call etsf_io_low_write_var(ncid_to, "frequencies_dielectric_function", & & folder%frequencies_dielectric_function, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%frequencies_dielectric_function) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if nvarids = nvarids + 1 end if deallocate(folder%frequencies_dielectric_function) lstat = .true. ! Variable 'qpoints_dielectric_function' ! allocate and read data allocate(folder%qpoints_dielectric_function( & & dims%number_of_qpoints_dielectric_function, & & dims%number_of_reduced_dimensions)) call etsf_io_low_read_var(ncid_from, "qpoints_dielectric_function", & & folder%qpoints_dielectric_function, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%qpoints_dielectric_function) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then call etsf_io_low_write_var(ncid_to, "qpoints_dielectric_function", & & folder%qpoints_dielectric_function, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%qpoints_dielectric_function) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if nvarids = nvarids + 1 end if deallocate(folder%qpoints_dielectric_function) lstat = .true. ! Variable 'qpoints_gamma_limit' ! allocate and read data allocate(folder%qpoints_gamma_limit( & & dims%number_of_qpoints_gamma_limit, & & dims%number_of_reduced_dimensions)) call etsf_io_low_read_var(ncid_from, "qpoints_gamma_limit", & & folder%qpoints_gamma_limit, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%qpoints_gamma_limit) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then call etsf_io_low_write_var(ncid_to, "qpoints_gamma_limit", & & folder%qpoints_gamma_limit, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%qpoints_gamma_limit) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if nvarids = nvarids + 1 end if deallocate(folder%qpoints_gamma_limit) lstat = .true. ! Variable 'dielectric_function' ! allocate and read data allocate(folder%dielectric_function%data1D( & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_dielectric_function * & & dims%my_number_of_spins * & & dims%my_number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%number_of_coefficients_dielectric_function * & & dims%complex)) call etsf_io_low_read_var(ncid_from, "dielectric_function", & & folder%dielectric_function%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%dielectric_function%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(7), count(7)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(7)) istart = 1 len = 1 len = len * dims%number_of_frequencies_dielectric_function len = len * dims%number_of_qpoints_dielectric_function if (.not. associated(split%my_spins)) then istop(5) = 1 len = len * dims%my_number_of_spins else istop(5) = size(split%my_spins) count(5) = 1 end if if (.not. associated(split%my_spins)) then istop(4) = 1 len = len * dims%my_number_of_spins else istop(4) = size(split%my_spins) count(4) = 1 end if len = len * dims%number_of_coefficients_dielectric_function len = len * dims%number_of_coefficients_dielectric_function len = len * dims%complex do idim5 = 1, istop(5), 1 if (associated(split%my_spins)) then start(5) = split%my_spins(idim5) end if do idim4 = 1, istop(4), 1 if (associated(split%my_spins)) then start(4) = split%my_spins(idim4) end if call etsf_io_low_write_var(ncid_to, "dielectric_function", & & folder%dielectric_function%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%dielectric_function%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do deallocate(start, count, istop) else ! No split information, we copy everything in the same shape. call etsf_io_low_write_var(ncid_to, "dielectric_function", & & folder%dielectric_function%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%dielectric_function%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%dielectric_function%data1D) lstat = .true. ! Variable 'dielectric_function_head' ! allocate and read data allocate(folder%dielectric_function_head%data1D( & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_dielectric_function * & & dims%my_number_of_spins * & & dims%my_number_of_spins * & & dims%complex)) call etsf_io_low_read_var(ncid_from, "dielectric_function_head", & & folder%dielectric_function_head%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%dielectric_function_head%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(5), count(5)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(5)) istart = 1 len = 1 len = len * dims%number_of_frequencies_dielectric_function len = len * dims%number_of_qpoints_dielectric_function if (.not. associated(split%my_spins)) then istop(3) = 1 len = len * dims%my_number_of_spins else istop(3) = size(split%my_spins) count(3) = 1 end if if (.not. associated(split%my_spins)) then istop(2) = 1 len = len * dims%my_number_of_spins else istop(2) = size(split%my_spins) count(2) = 1 end if len = len * dims%complex do idim3 = 1, istop(3), 1 if (associated(split%my_spins)) then start(3) = split%my_spins(idim3) end if do idim2 = 1, istop(2), 1 if (associated(split%my_spins)) then start(2) = split%my_spins(idim2) end if call etsf_io_low_write_var(ncid_to, "dielectric_function_head", & & folder%dielectric_function_head%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%dielectric_function_head%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do deallocate(start, count, istop) else ! No split information, we copy everything in the same shape. call etsf_io_low_write_var(ncid_to, "dielectric_function_head", & & folder%dielectric_function_head%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%dielectric_function_head%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%dielectric_function_head%data1D) lstat = .true. ! Variable 'dielectric_function_lower_wing' ! allocate and read data allocate(folder%dielectric_function_lower_wing%data1D( & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_gamma_limit * & & dims%my_number_of_spins * & & dims%my_number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%complex)) call etsf_io_low_read_var(ncid_from, "dielectric_function_lower_wing", & & folder%dielectric_function_lower_wing%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%dielectric_function_lower_wing%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(6), count(6)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(6)) istart = 1 len = 1 len = len * dims%number_of_frequencies_dielectric_function len = len * dims%number_of_qpoints_gamma_limit if (.not. associated(split%my_spins)) then istop(4) = 1 len = len * dims%my_number_of_spins else istop(4) = size(split%my_spins) count(4) = 1 end if if (.not. associated(split%my_spins)) then istop(3) = 1 len = len * dims%my_number_of_spins else istop(3) = size(split%my_spins) count(3) = 1 end if len = len * dims%number_of_coefficients_dielectric_function len = len * dims%complex do idim4 = 1, istop(4), 1 if (associated(split%my_spins)) then start(4) = split%my_spins(idim4) end if do idim3 = 1, istop(3), 1 if (associated(split%my_spins)) then start(3) = split%my_spins(idim3) end if call etsf_io_low_write_var(ncid_to, "dielectric_function_lower_wing", & & folder%dielectric_function_lower_wing%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%dielectric_function_lower_wing%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do deallocate(start, count, istop) else ! No split information, we copy everything in the same shape. call etsf_io_low_write_var(ncid_to, "dielectric_function_lower_wing", & & folder%dielectric_function_lower_wing%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%dielectric_function_lower_wing%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%dielectric_function_lower_wing%data1D) lstat = .true. ! Variable 'dielectric_function_upper_wing' ! allocate and read data allocate(folder%dielectric_function_upper_wing%data1D( & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_gamma_limit * & & dims%my_number_of_spins * & & dims%my_number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%complex)) call etsf_io_low_read_var(ncid_from, "dielectric_function_upper_wing", & & folder%dielectric_function_upper_wing%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%dielectric_function_upper_wing%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(6), count(6)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(6)) istart = 1 len = 1 len = len * dims%number_of_frequencies_dielectric_function len = len * dims%number_of_qpoints_gamma_limit if (.not. associated(split%my_spins)) then istop(4) = 1 len = len * dims%my_number_of_spins else istop(4) = size(split%my_spins) count(4) = 1 end if if (.not. associated(split%my_spins)) then istop(3) = 1 len = len * dims%my_number_of_spins else istop(3) = size(split%my_spins) count(3) = 1 end if len = len * dims%number_of_coefficients_dielectric_function len = len * dims%complex do idim4 = 1, istop(4), 1 if (associated(split%my_spins)) then start(4) = split%my_spins(idim4) end if do idim3 = 1, istop(3), 1 if (associated(split%my_spins)) then start(3) = split%my_spins(idim3) end if call etsf_io_low_write_var(ncid_to, "dielectric_function_upper_wing", & & folder%dielectric_function_upper_wing%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%dielectric_function_upper_wing%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do deallocate(start, count, istop) else ! No split information, we copy everything in the same shape. call etsf_io_low_write_var(ncid_to, "dielectric_function_upper_wing", & & folder%dielectric_function_upper_wing%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%dielectric_function_upper_wing%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%dielectric_function_upper_wing%data1D) lstat = .true. ! Variable 'inverse_dielectric_function' ! allocate and read data allocate(folder%inverse_dielectric_function%data1D( & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_dielectric_function * & & dims%my_number_of_spins * & & dims%my_number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%number_of_coefficients_dielectric_function * & & dims%complex)) call etsf_io_low_read_var(ncid_from, "inverse_dielectric_function", & & folder%inverse_dielectric_function%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%inverse_dielectric_function%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(7), count(7)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(7)) istart = 1 len = 1 len = len * dims%number_of_frequencies_dielectric_function len = len * dims%number_of_qpoints_dielectric_function if (.not. associated(split%my_spins)) then istop(5) = 1 len = len * dims%my_number_of_spins else istop(5) = size(split%my_spins) count(5) = 1 end if if (.not. associated(split%my_spins)) then istop(4) = 1 len = len * dims%my_number_of_spins else istop(4) = size(split%my_spins) count(4) = 1 end if len = len * dims%number_of_coefficients_dielectric_function len = len * dims%number_of_coefficients_dielectric_function len = len * dims%complex do idim5 = 1, istop(5), 1 if (associated(split%my_spins)) then start(5) = split%my_spins(idim5) end if do idim4 = 1, istop(4), 1 if (associated(split%my_spins)) then start(4) = split%my_spins(idim4) end if call etsf_io_low_write_var(ncid_to, "inverse_dielectric_function", & & folder%inverse_dielectric_function%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%inverse_dielectric_function%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do deallocate(start, count, istop) else ! No split information, we copy everything in the same shape. call etsf_io_low_write_var(ncid_to, "inverse_dielectric_function", & & folder%inverse_dielectric_function%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%inverse_dielectric_function%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%inverse_dielectric_function%data1D) lstat = .true. ! Variable 'inverse_dielectric_function_head' ! allocate and read data allocate(folder%inverse_dielectric_function_head%data1D( & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_dielectric_function * & & dims%my_number_of_spins * & & dims%my_number_of_spins * & & dims%complex)) call etsf_io_low_read_var(ncid_from, "inverse_dielectric_function_head", & & folder%inverse_dielectric_function_head%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%inverse_dielectric_function_head%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(5), count(5)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(5)) istart = 1 len = 1 len = len * dims%number_of_frequencies_dielectric_function len = len * dims%number_of_qpoints_dielectric_function if (.not. associated(split%my_spins)) then istop(3) = 1 len = len * dims%my_number_of_spins else istop(3) = size(split%my_spins) count(3) = 1 end if if (.not. associated(split%my_spins)) then istop(2) = 1 len = len * dims%my_number_of_spins else istop(2) = size(split%my_spins) count(2) = 1 end if len = len * dims%complex do idim3 = 1, istop(3), 1 if (associated(split%my_spins)) then start(3) = split%my_spins(idim3) end if do idim2 = 1, istop(2), 1 if (associated(split%my_spins)) then start(2) = split%my_spins(idim2) end if call etsf_io_low_write_var(ncid_to, "inverse_dielectric_function_head", & & folder%inverse_dielectric_function_head%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%inverse_dielectric_function_head%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do deallocate(start, count, istop) else ! No split information, we copy everything in the same shape. call etsf_io_low_write_var(ncid_to, "inverse_dielectric_function_head", & & folder%inverse_dielectric_function_head%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%inverse_dielectric_function_head%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%inverse_dielectric_function_head%data1D) lstat = .true. ! Variable 'inverse_dielectric_function_lower_wing' ! allocate and read data allocate(folder%inverse_dielectric_function_lower_wing%data1D( & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_gamma_limit * & & dims%my_number_of_spins * & & dims%my_number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%complex)) call etsf_io_low_read_var(ncid_from, "inverse_dielectric_function_lower_wing", & & folder%inverse_dielectric_function_lower_wing%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%inverse_dielectric_function_lower_wing%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(6), count(6)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(6)) istart = 1 len = 1 len = len * dims%number_of_frequencies_dielectric_function len = len * dims%number_of_qpoints_gamma_limit if (.not. associated(split%my_spins)) then istop(4) = 1 len = len * dims%my_number_of_spins else istop(4) = size(split%my_spins) count(4) = 1 end if if (.not. associated(split%my_spins)) then istop(3) = 1 len = len * dims%my_number_of_spins else istop(3) = size(split%my_spins) count(3) = 1 end if len = len * dims%number_of_coefficients_dielectric_function len = len * dims%complex do idim4 = 1, istop(4), 1 if (associated(split%my_spins)) then start(4) = split%my_spins(idim4) end if do idim3 = 1, istop(3), 1 if (associated(split%my_spins)) then start(3) = split%my_spins(idim3) end if call etsf_io_low_write_var(ncid_to, "inverse_dielectric_function_lower_wing", & & folder%inverse_dielectric_function_lower_wing%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%inverse_dielectric_function_lower_wing%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do deallocate(start, count, istop) else ! No split information, we copy everything in the same shape. call etsf_io_low_write_var(ncid_to, "inverse_dielectric_function_lower_wing", & & folder%inverse_dielectric_function_lower_wing%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%inverse_dielectric_function_lower_wing%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%inverse_dielectric_function_lower_wing%data1D) lstat = .true. ! Variable 'inverse_dielectric_function_upper_wing' ! allocate and read data allocate(folder%inverse_dielectric_function_upper_wing%data1D( & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_gamma_limit * & & dims%my_number_of_spins * & & dims%my_number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%complex)) call etsf_io_low_read_var(ncid_from, "inverse_dielectric_function_upper_wing", & & folder%inverse_dielectric_function_upper_wing%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%inverse_dielectric_function_upper_wing%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(6), count(6)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(6)) istart = 1 len = 1 len = len * dims%number_of_frequencies_dielectric_function len = len * dims%number_of_qpoints_gamma_limit if (.not. associated(split%my_spins)) then istop(4) = 1 len = len * dims%my_number_of_spins else istop(4) = size(split%my_spins) count(4) = 1 end if if (.not. associated(split%my_spins)) then istop(3) = 1 len = len * dims%my_number_of_spins else istop(3) = size(split%my_spins) count(3) = 1 end if len = len * dims%number_of_coefficients_dielectric_function len = len * dims%complex do idim4 = 1, istop(4), 1 if (associated(split%my_spins)) then start(4) = split%my_spins(idim4) end if do idim3 = 1, istop(3), 1 if (associated(split%my_spins)) then start(3) = split%my_spins(idim3) end if call etsf_io_low_write_var(ncid_to, "inverse_dielectric_function_upper_wing", & & folder%inverse_dielectric_function_upper_wing%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%inverse_dielectric_function_upper_wing%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do deallocate(start, count, istop) else ! No split information, we copy everything in the same shape. call etsf_io_low_write_var(ncid_to, "inverse_dielectric_function_upper_wing", & & folder%inverse_dielectric_function_upper_wing%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%inverse_dielectric_function_upper_wing%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%inverse_dielectric_function_upper_wing%data1D) lstat = .true. ! Variable 'polarizability' ! allocate and read data allocate(folder%polarizability%data1D( & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_dielectric_function * & & dims%my_number_of_spins * & & dims%my_number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%number_of_coefficients_dielectric_function * & & dims%complex)) call etsf_io_low_read_var(ncid_from, "polarizability", & & folder%polarizability%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%polarizability%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(7), count(7)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(7)) istart = 1 len = 1 len = len * dims%number_of_frequencies_dielectric_function len = len * dims%number_of_qpoints_dielectric_function if (.not. associated(split%my_spins)) then istop(5) = 1 len = len * dims%my_number_of_spins else istop(5) = size(split%my_spins) count(5) = 1 end if if (.not. associated(split%my_spins)) then istop(4) = 1 len = len * dims%my_number_of_spins else istop(4) = size(split%my_spins) count(4) = 1 end if len = len * dims%number_of_coefficients_dielectric_function len = len * dims%number_of_coefficients_dielectric_function len = len * dims%complex do idim5 = 1, istop(5), 1 if (associated(split%my_spins)) then start(5) = split%my_spins(idim5) end if do idim4 = 1, istop(4), 1 if (associated(split%my_spins)) then start(4) = split%my_spins(idim4) end if call etsf_io_low_write_var(ncid_to, "polarizability", & & folder%polarizability%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%polarizability%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do deallocate(start, count, istop) else ! No split information, we copy everything in the same shape. call etsf_io_low_write_var(ncid_to, "polarizability", & & folder%polarizability%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%polarizability%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%polarizability%data1D) lstat = .true. ! Variable 'polarizability_head' ! allocate and read data allocate(folder%polarizability_head%data1D( & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_dielectric_function * & & dims%my_number_of_spins * & & dims%my_number_of_spins * & & dims%complex)) call etsf_io_low_read_var(ncid_from, "polarizability_head", & & folder%polarizability_head%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%polarizability_head%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(5), count(5)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(5)) istart = 1 len = 1 len = len * dims%number_of_frequencies_dielectric_function len = len * dims%number_of_qpoints_dielectric_function if (.not. associated(split%my_spins)) then istop(3) = 1 len = len * dims%my_number_of_spins else istop(3) = size(split%my_spins) count(3) = 1 end if if (.not. associated(split%my_spins)) then istop(2) = 1 len = len * dims%my_number_of_spins else istop(2) = size(split%my_spins) count(2) = 1 end if len = len * dims%complex do idim3 = 1, istop(3), 1 if (associated(split%my_spins)) then start(3) = split%my_spins(idim3) end if do idim2 = 1, istop(2), 1 if (associated(split%my_spins)) then start(2) = split%my_spins(idim2) end if call etsf_io_low_write_var(ncid_to, "polarizability_head", & & folder%polarizability_head%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%polarizability_head%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do deallocate(start, count, istop) else ! No split information, we copy everything in the same shape. call etsf_io_low_write_var(ncid_to, "polarizability_head", & & folder%polarizability_head%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%polarizability_head%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%polarizability_head%data1D) lstat = .true. ! Variable 'polarizability_lower_wing' ! allocate and read data allocate(folder%polarizability_lower_wing%data1D( & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_gamma_limit * & & dims%my_number_of_spins * & & dims%my_number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%complex)) call etsf_io_low_read_var(ncid_from, "polarizability_lower_wing", & & folder%polarizability_lower_wing%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%polarizability_lower_wing%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(6), count(6)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(6)) istart = 1 len = 1 len = len * dims%number_of_frequencies_dielectric_function len = len * dims%number_of_qpoints_gamma_limit if (.not. associated(split%my_spins)) then istop(4) = 1 len = len * dims%my_number_of_spins else istop(4) = size(split%my_spins) count(4) = 1 end if if (.not. associated(split%my_spins)) then istop(3) = 1 len = len * dims%my_number_of_spins else istop(3) = size(split%my_spins) count(3) = 1 end if len = len * dims%number_of_coefficients_dielectric_function len = len * dims%complex do idim4 = 1, istop(4), 1 if (associated(split%my_spins)) then start(4) = split%my_spins(idim4) end if do idim3 = 1, istop(3), 1 if (associated(split%my_spins)) then start(3) = split%my_spins(idim3) end if call etsf_io_low_write_var(ncid_to, "polarizability_lower_wing", & & folder%polarizability_lower_wing%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%polarizability_lower_wing%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do deallocate(start, count, istop) else ! No split information, we copy everything in the same shape. call etsf_io_low_write_var(ncid_to, "polarizability_lower_wing", & & folder%polarizability_lower_wing%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%polarizability_lower_wing%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%polarizability_lower_wing%data1D) lstat = .true. ! Variable 'polarizability_upper_wing' ! allocate and read data allocate(folder%polarizability_upper_wing%data1D( & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_gamma_limit * & & dims%my_number_of_spins * & & dims%my_number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%complex)) call etsf_io_low_read_var(ncid_from, "polarizability_upper_wing", & & folder%polarizability_upper_wing%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%polarizability_upper_wing%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(6), count(6)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(6)) istart = 1 len = 1 len = len * dims%number_of_frequencies_dielectric_function len = len * dims%number_of_qpoints_gamma_limit if (.not. associated(split%my_spins)) then istop(4) = 1 len = len * dims%my_number_of_spins else istop(4) = size(split%my_spins) count(4) = 1 end if if (.not. associated(split%my_spins)) then istop(3) = 1 len = len * dims%my_number_of_spins else istop(3) = size(split%my_spins) count(3) = 1 end if len = len * dims%number_of_coefficients_dielectric_function len = len * dims%complex do idim4 = 1, istop(4), 1 if (associated(split%my_spins)) then start(4) = split%my_spins(idim4) end if do idim3 = 1, istop(3), 1 if (associated(split%my_spins)) then start(3) = split%my_spins(idim3) end if call etsf_io_low_write_var(ncid_to, "polarizability_upper_wing", & & folder%polarizability_upper_wing%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%polarizability_upper_wing%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do deallocate(start, count, istop) else ! No split information, we copy everything in the same shape. call etsf_io_low_write_var(ncid_to, "polarizability_upper_wing", & & folder%polarizability_upper_wing%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%polarizability_upper_wing%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%polarizability_upper_wing%data1D) lstat = .true. ! Variable 'inverse_polarizability' ! allocate and read data allocate(folder%inverse_polarizability%data1D( & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_dielectric_function * & & dims%my_number_of_spins * & & dims%my_number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%number_of_coefficients_dielectric_function * & & dims%complex)) call etsf_io_low_read_var(ncid_from, "inverse_polarizability", & & folder%inverse_polarizability%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%inverse_polarizability%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(7), count(7)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(7)) istart = 1 len = 1 len = len * dims%number_of_frequencies_dielectric_function len = len * dims%number_of_qpoints_dielectric_function if (.not. associated(split%my_spins)) then istop(5) = 1 len = len * dims%my_number_of_spins else istop(5) = size(split%my_spins) count(5) = 1 end if if (.not. associated(split%my_spins)) then istop(4) = 1 len = len * dims%my_number_of_spins else istop(4) = size(split%my_spins) count(4) = 1 end if len = len * dims%number_of_coefficients_dielectric_function len = len * dims%number_of_coefficients_dielectric_function len = len * dims%complex do idim5 = 1, istop(5), 1 if (associated(split%my_spins)) then start(5) = split%my_spins(idim5) end if do idim4 = 1, istop(4), 1 if (associated(split%my_spins)) then start(4) = split%my_spins(idim4) end if call etsf_io_low_write_var(ncid_to, "inverse_polarizability", & & folder%inverse_polarizability%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%inverse_polarizability%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do deallocate(start, count, istop) else ! No split information, we copy everything in the same shape. call etsf_io_low_write_var(ncid_to, "inverse_polarizability", & & folder%inverse_polarizability%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%inverse_polarizability%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%inverse_polarizability%data1D) lstat = .true. ! Variable 'inverse_polarizability_head' ! allocate and read data allocate(folder%inverse_polarizability_head%data1D( & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_dielectric_function * & & dims%my_number_of_spins * & & dims%my_number_of_spins * & & dims%complex)) call etsf_io_low_read_var(ncid_from, "inverse_polarizability_head", & & folder%inverse_polarizability_head%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%inverse_polarizability_head%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(5), count(5)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(5)) istart = 1 len = 1 len = len * dims%number_of_frequencies_dielectric_function len = len * dims%number_of_qpoints_dielectric_function if (.not. associated(split%my_spins)) then istop(3) = 1 len = len * dims%my_number_of_spins else istop(3) = size(split%my_spins) count(3) = 1 end if if (.not. associated(split%my_spins)) then istop(2) = 1 len = len * dims%my_number_of_spins else istop(2) = size(split%my_spins) count(2) = 1 end if len = len * dims%complex do idim3 = 1, istop(3), 1 if (associated(split%my_spins)) then start(3) = split%my_spins(idim3) end if do idim2 = 1, istop(2), 1 if (associated(split%my_spins)) then start(2) = split%my_spins(idim2) end if call etsf_io_low_write_var(ncid_to, "inverse_polarizability_head", & & folder%inverse_polarizability_head%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%inverse_polarizability_head%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do deallocate(start, count, istop) else ! No split information, we copy everything in the same shape. call etsf_io_low_write_var(ncid_to, "inverse_polarizability_head", & & folder%inverse_polarizability_head%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%inverse_polarizability_head%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%inverse_polarizability_head%data1D) lstat = .true. ! Variable 'inverse_polarizability_lower_wing' ! allocate and read data allocate(folder%inverse_polarizability_lower_wing%data1D( & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_gamma_limit * & & dims%my_number_of_spins * & & dims%my_number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%complex)) call etsf_io_low_read_var(ncid_from, "inverse_polarizability_lower_wing", & & folder%inverse_polarizability_lower_wing%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%inverse_polarizability_lower_wing%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(6), count(6)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(6)) istart = 1 len = 1 len = len * dims%number_of_frequencies_dielectric_function len = len * dims%number_of_qpoints_gamma_limit if (.not. associated(split%my_spins)) then istop(4) = 1 len = len * dims%my_number_of_spins else istop(4) = size(split%my_spins) count(4) = 1 end if if (.not. associated(split%my_spins)) then istop(3) = 1 len = len * dims%my_number_of_spins else istop(3) = size(split%my_spins) count(3) = 1 end if len = len * dims%number_of_coefficients_dielectric_function len = len * dims%complex do idim4 = 1, istop(4), 1 if (associated(split%my_spins)) then start(4) = split%my_spins(idim4) end if do idim3 = 1, istop(3), 1 if (associated(split%my_spins)) then start(3) = split%my_spins(idim3) end if call etsf_io_low_write_var(ncid_to, "inverse_polarizability_lower_wing", & & folder%inverse_polarizability_lower_wing%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%inverse_polarizability_lower_wing%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do deallocate(start, count, istop) else ! No split information, we copy everything in the same shape. call etsf_io_low_write_var(ncid_to, "inverse_polarizability_lower_wing", & & folder%inverse_polarizability_lower_wing%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%inverse_polarizability_lower_wing%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%inverse_polarizability_lower_wing%data1D) lstat = .true. ! Variable 'inverse_polarizability_upper_wing' ! allocate and read data allocate(folder%inverse_polarizability_upper_wing%data1D( & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_gamma_limit * & & dims%my_number_of_spins * & & dims%my_number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%complex)) call etsf_io_low_read_var(ncid_from, "inverse_polarizability_upper_wing", & & folder%inverse_polarizability_upper_wing%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%inverse_polarizability_upper_wing%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(6), count(6)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(6)) istart = 1 len = 1 len = len * dims%number_of_frequencies_dielectric_function len = len * dims%number_of_qpoints_gamma_limit if (.not. associated(split%my_spins)) then istop(4) = 1 len = len * dims%my_number_of_spins else istop(4) = size(split%my_spins) count(4) = 1 end if if (.not. associated(split%my_spins)) then istop(3) = 1 len = len * dims%my_number_of_spins else istop(3) = size(split%my_spins) count(3) = 1 end if len = len * dims%number_of_coefficients_dielectric_function len = len * dims%complex do idim4 = 1, istop(4), 1 if (associated(split%my_spins)) then start(4) = split%my_spins(idim4) end if do idim3 = 1, istop(3), 1 if (associated(split%my_spins)) then start(3) = split%my_spins(idim3) end if call etsf_io_low_write_var(ncid_to, "inverse_polarizability_upper_wing", & & folder%inverse_polarizability_upper_wing%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%inverse_polarizability_upper_wing%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do deallocate(start, count, istop) else ! No split information, we copy everything in the same shape. call etsf_io_low_write_var(ncid_to, "inverse_polarizability_upper_wing", & & folder%inverse_polarizability_upper_wing%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%inverse_polarizability_upper_wing%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%inverse_polarizability_upper_wing%data1D) lstat = .true. ! We copy all the attributes (ETSF and non-ETSF) of the group variables. call etsf_io_low_set_define_mode(ncid_to, lstat, error_data = error_data) if (.not. lstat) nvarids = 0 do len = 1, nvarids - 1, 1 call etsf_io_low_copy_all_att(ncid_from, ncid_to, varids(1, len), varids(2, len), & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) exit end if end do deallocate(varids) !DEBUG !write (*,*) 'etsf_io_dielectric_copy : exit' !ENDDEBUG end subroutine etsf_io_dielectric_copy !!*** etsf_io-1.0.3/src/group_level/etsf_io_main_copy.f900000644000353400050630000007341111354150413017212 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_main/etsf_io_main_copy !! NAME !! etsf_io_main_copy !! !! FUNCTION !! This routine copy all variable of a group from one file @ncid_from to another !! @ncid_to. If a variable is missing in the source file, this does not raise an !! error, it is simply skipped. But if a variable in the destination file is not !! defined, this will raise an error. !! !! The copy is done per variable. This means that memory occupation is reduced !! during the copy. !! !! Normally, copies are pristine copies. But if optional argument @split is !! given, then the read values are copied to the specified locations in split !! arrays. In that case, the destination variable must have a compatible definition !! with the split values. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid_to = !! integer returned by an 'open' NetCDF call. This id must have write access !! granted. It will be modified by the routine. The file must be in write !! mode (see etsf_io_low_set_write_mode()). !! * ncid_from = !! integer returned by an 'open' NetCDF call. This id must have read access !! granted. It will be left untouched. !! * dims = !! these dimensions correspond to the source_file ones and are used to allocate !! temporary arrays in memory during the copy. !! * split = (optional) !! if this argument is given, the values in the split definition (e.g. my_kpoints) !! are used to put the data in the destination file in a bigger array at the right !! placed. !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_main_copy(ncid_to, ncid_from, dims, lstat, error_data, split) !Arguments ------------------------------------ integer, intent(in) :: ncid_to integer, intent(in) :: ncid_from type(etsf_dims), intent(in) :: dims logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data type(etsf_split), optional, intent(in) :: split !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_main_copy' type(etsf_split) :: my_split integer,allocatable :: varids(:,:) integer :: nvarids integer,allocatable :: start(:) integer,allocatable :: count(:) integer :: len integer :: istart integer :: idim1,idim2,idim3,idim4,idim5,idim6,idim7,idim8 integer,allocatable :: istop(:) integer,allocatable :: jstart(:) integer,allocatable :: jend(:) type(etsf_main) :: folder ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_main_copy : enter' !ENDDEBUG lstat = .false. call etsf_io_low_set_write_mode(ncid_to, lstat, error_data = error_data) if (.not. lstat) return allocate(varids(2,6)) nvarids = 1 ! Variable 'density' ! allocate and read data allocate(folder%density%data1D( & & dims%my_number_of_components * & & dims%my_number_of_grid_points_vect3 * & & dims%my_number_of_grid_points_vect2 * & & dims%my_number_of_grid_points_vect1 * & & dims%real_or_complex_density)) call etsf_io_low_read_var(ncid_from, "density", & & folder%density%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%density%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(5), count(5)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(5)) istart = 1 len = 1 if (.not. associated(split%my_components)) then istop(5) = 1 len = len * dims%my_number_of_components else istop(5) = size(split%my_components) count(5) = 1 end if if (.not. associated(split%my_grid_points_vector3)) then istop(4) = 1 len = len * dims%my_number_of_grid_points_vect3 else istop(4) = size(split%my_grid_points_vector3) count(4) = 1 end if if (.not. associated(split%my_grid_points_vector2)) then istop(3) = 1 len = len * dims%my_number_of_grid_points_vect2 else istop(3) = size(split%my_grid_points_vector2) count(3) = 1 end if if (.not. associated(split%my_grid_points_vector1)) then istop(2) = 1 len = len * dims%my_number_of_grid_points_vect1 else istop(2) = size(split%my_grid_points_vector1) count(2) = 1 end if len = len * dims%real_or_complex_density do idim5 = 1, istop(5), 1 if (associated(split%my_components)) then start(5) = split%my_components(idim5) end if do idim4 = 1, istop(4), 1 if (associated(split%my_grid_points_vector3)) then start(4) = split%my_grid_points_vector3(idim4) end if do idim3 = 1, istop(3), 1 if (associated(split%my_grid_points_vector2)) then start(3) = split%my_grid_points_vector2(idim3) end if do idim2 = 1, istop(2), 1 if (associated(split%my_grid_points_vector1)) then start(2) = split%my_grid_points_vector1(idim2) end if call etsf_io_low_write_var(ncid_to, "density", & & folder%density%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%density%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do end do end do deallocate(start, count, istop) else ! No split information, we copy everything in the same shape. call etsf_io_low_write_var(ncid_to, "density", & & folder%density%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%density%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%density%data1D) lstat = .true. ! Variable 'exchange_potential' ! allocate and read data allocate(folder%exchange_potential%data1D( & & dims%my_number_of_components * & & dims%my_number_of_grid_points_vect3 * & & dims%my_number_of_grid_points_vect2 * & & dims%my_number_of_grid_points_vect1 * & & dims%real_or_complex_potential)) call etsf_io_low_read_var(ncid_from, "exchange_potential", & & folder%exchange_potential%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%exchange_potential%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(5), count(5)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(5)) istart = 1 len = 1 if (.not. associated(split%my_components)) then istop(5) = 1 len = len * dims%my_number_of_components else istop(5) = size(split%my_components) count(5) = 1 end if if (.not. associated(split%my_grid_points_vector3)) then istop(4) = 1 len = len * dims%my_number_of_grid_points_vect3 else istop(4) = size(split%my_grid_points_vector3) count(4) = 1 end if if (.not. associated(split%my_grid_points_vector2)) then istop(3) = 1 len = len * dims%my_number_of_grid_points_vect2 else istop(3) = size(split%my_grid_points_vector2) count(3) = 1 end if if (.not. associated(split%my_grid_points_vector1)) then istop(2) = 1 len = len * dims%my_number_of_grid_points_vect1 else istop(2) = size(split%my_grid_points_vector1) count(2) = 1 end if len = len * dims%real_or_complex_potential do idim5 = 1, istop(5), 1 if (associated(split%my_components)) then start(5) = split%my_components(idim5) end if do idim4 = 1, istop(4), 1 if (associated(split%my_grid_points_vector3)) then start(4) = split%my_grid_points_vector3(idim4) end if do idim3 = 1, istop(3), 1 if (associated(split%my_grid_points_vector2)) then start(3) = split%my_grid_points_vector2(idim3) end if do idim2 = 1, istop(2), 1 if (associated(split%my_grid_points_vector1)) then start(2) = split%my_grid_points_vector1(idim2) end if call etsf_io_low_write_var(ncid_to, "exchange_potential", & & folder%exchange_potential%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%exchange_potential%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do end do end do deallocate(start, count, istop) else ! No split information, we copy everything in the same shape. call etsf_io_low_write_var(ncid_to, "exchange_potential", & & folder%exchange_potential%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%exchange_potential%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%exchange_potential%data1D) lstat = .true. ! Variable 'correlation_potential' ! allocate and read data allocate(folder%correlation_potential%data1D( & & dims%my_number_of_components * & & dims%my_number_of_grid_points_vect3 * & & dims%my_number_of_grid_points_vect2 * & & dims%my_number_of_grid_points_vect1 * & & dims%real_or_complex_potential)) call etsf_io_low_read_var(ncid_from, "correlation_potential", & & folder%correlation_potential%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%correlation_potential%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(5), count(5)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(5)) istart = 1 len = 1 if (.not. associated(split%my_components)) then istop(5) = 1 len = len * dims%my_number_of_components else istop(5) = size(split%my_components) count(5) = 1 end if if (.not. associated(split%my_grid_points_vector3)) then istop(4) = 1 len = len * dims%my_number_of_grid_points_vect3 else istop(4) = size(split%my_grid_points_vector3) count(4) = 1 end if if (.not. associated(split%my_grid_points_vector2)) then istop(3) = 1 len = len * dims%my_number_of_grid_points_vect2 else istop(3) = size(split%my_grid_points_vector2) count(3) = 1 end if if (.not. associated(split%my_grid_points_vector1)) then istop(2) = 1 len = len * dims%my_number_of_grid_points_vect1 else istop(2) = size(split%my_grid_points_vector1) count(2) = 1 end if len = len * dims%real_or_complex_potential do idim5 = 1, istop(5), 1 if (associated(split%my_components)) then start(5) = split%my_components(idim5) end if do idim4 = 1, istop(4), 1 if (associated(split%my_grid_points_vector3)) then start(4) = split%my_grid_points_vector3(idim4) end if do idim3 = 1, istop(3), 1 if (associated(split%my_grid_points_vector2)) then start(3) = split%my_grid_points_vector2(idim3) end if do idim2 = 1, istop(2), 1 if (associated(split%my_grid_points_vector1)) then start(2) = split%my_grid_points_vector1(idim2) end if call etsf_io_low_write_var(ncid_to, "correlation_potential", & & folder%correlation_potential%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%correlation_potential%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do end do end do deallocate(start, count, istop) else ! No split information, we copy everything in the same shape. call etsf_io_low_write_var(ncid_to, "correlation_potential", & & folder%correlation_potential%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%correlation_potential%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%correlation_potential%data1D) lstat = .true. ! Variable 'exchange_correlation_potential' ! allocate and read data allocate(folder%exchange_correlation_potential%data1D( & & dims%my_number_of_components * & & dims%my_number_of_grid_points_vect3 * & & dims%my_number_of_grid_points_vect2 * & & dims%my_number_of_grid_points_vect1 * & & dims%real_or_complex_potential)) call etsf_io_low_read_var(ncid_from, "exchange_correlation_potential", & & folder%exchange_correlation_potential%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%exchange_correlation_potential%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(5), count(5)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(5)) istart = 1 len = 1 if (.not. associated(split%my_components)) then istop(5) = 1 len = len * dims%my_number_of_components else istop(5) = size(split%my_components) count(5) = 1 end if if (.not. associated(split%my_grid_points_vector3)) then istop(4) = 1 len = len * dims%my_number_of_grid_points_vect3 else istop(4) = size(split%my_grid_points_vector3) count(4) = 1 end if if (.not. associated(split%my_grid_points_vector2)) then istop(3) = 1 len = len * dims%my_number_of_grid_points_vect2 else istop(3) = size(split%my_grid_points_vector2) count(3) = 1 end if if (.not. associated(split%my_grid_points_vector1)) then istop(2) = 1 len = len * dims%my_number_of_grid_points_vect1 else istop(2) = size(split%my_grid_points_vector1) count(2) = 1 end if len = len * dims%real_or_complex_potential do idim5 = 1, istop(5), 1 if (associated(split%my_components)) then start(5) = split%my_components(idim5) end if do idim4 = 1, istop(4), 1 if (associated(split%my_grid_points_vector3)) then start(4) = split%my_grid_points_vector3(idim4) end if do idim3 = 1, istop(3), 1 if (associated(split%my_grid_points_vector2)) then start(3) = split%my_grid_points_vector2(idim3) end if do idim2 = 1, istop(2), 1 if (associated(split%my_grid_points_vector1)) then start(2) = split%my_grid_points_vector1(idim2) end if call etsf_io_low_write_var(ncid_to, "exchange_correlation_potential", & & folder%exchange_correlation_potential%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%exchange_correlation_potential%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do end do end do deallocate(start, count, istop) else ! No split information, we copy everything in the same shape. call etsf_io_low_write_var(ncid_to, "exchange_correlation_potential", & & folder%exchange_correlation_potential%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%exchange_correlation_potential%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%exchange_correlation_potential%data1D) lstat = .true. ! Variable 'coefficients_of_wavefunctions' ! allocate and read data allocate(folder%coefficients_of_wavefunctions%data1D( & & dims%my_number_of_spins * & & dims%my_number_of_kpoints * & & dims%my_max_number_of_states * & & dims%number_of_spinor_components * & & dims%my_max_number_of_coefficients * & & dims%real_or_complex_coefficients)) call etsf_io_low_read_var(ncid_from, "coefficients_of_wavefunctions", & & folder%coefficients_of_wavefunctions%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%coefficients_of_wavefunctions%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(6), count(6)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(6)) istart = 1 len = 1 if (.not. associated(split%my_spins)) then istop(6) = 1 len = len * dims%my_number_of_spins else istop(6) = size(split%my_spins) count(6) = 1 end if if (.not. associated(split%my_kpoints)) then istop(5) = 1 len = len * dims%my_number_of_kpoints else istop(5) = size(split%my_kpoints) count(5) = 1 end if if (.not. associated(split%my_states)) then istop(4) = 1 len = len * dims%my_max_number_of_states else istop(4) = size(split%my_states) count(4) = 1 end if len = len * dims%number_of_spinor_components if (.not. associated(split%my_coefficients)) then istop(2) = 1 len = len * dims%my_max_number_of_coefficients else istop(2) = size(split%my_coefficients) count(2) = 1 end if len = len * dims%real_or_complex_coefficients do idim6 = 1, istop(6), 1 if (associated(split%my_spins)) then start(6) = split%my_spins(idim6) end if do idim5 = 1, istop(5), 1 if (associated(split%my_kpoints)) then start(5) = split%my_kpoints(idim5) end if do idim4 = 1, istop(4), 1 if (associated(split%my_states)) then start(4) = split%my_states(idim4) end if do idim2 = 1, istop(2), 1 if (associated(split%my_coefficients)) then start(2) = split%my_coefficients(idim2) end if call etsf_io_low_write_var(ncid_to, "coefficients_of_wavefunctions", & & folder%coefficients_of_wavefunctions%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%coefficients_of_wavefunctions%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do end do end do deallocate(start, count, istop) else ! No split information, we copy everything in the same shape. call etsf_io_low_write_var(ncid_to, "coefficients_of_wavefunctions", & & folder%coefficients_of_wavefunctions%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%coefficients_of_wavefunctions%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%coefficients_of_wavefunctions%data1D) lstat = .true. ! Variable 'real_space_wavefunctions' ! allocate and read data allocate(folder%real_space_wavefunctions%data1D( & & dims%my_number_of_spins * & & dims%my_number_of_kpoints * & & dims%my_max_number_of_states * & & dims%number_of_spinor_components * & & dims%my_number_of_grid_points_vect3 * & & dims%my_number_of_grid_points_vect2 * & & dims%my_number_of_grid_points_vect1 * & & dims%real_or_complex_wavefunctions)) call etsf_io_low_read_var(ncid_from, "real_space_wavefunctions", & & folder%real_space_wavefunctions%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%real_space_wavefunctions%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if ! write data and deallocate (if read succeed) if (lstat) then if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(8), count(8)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(8)) istart = 1 len = 1 if (.not. associated(split%my_spins)) then istop(8) = 1 len = len * dims%my_number_of_spins else istop(8) = size(split%my_spins) count(8) = 1 end if if (.not. associated(split%my_kpoints)) then istop(7) = 1 len = len * dims%my_number_of_kpoints else istop(7) = size(split%my_kpoints) count(7) = 1 end if if (.not. associated(split%my_states)) then istop(6) = 1 len = len * dims%my_max_number_of_states else istop(6) = size(split%my_states) count(6) = 1 end if len = len * dims%number_of_spinor_components if (.not. associated(split%my_grid_points_vector3)) then istop(4) = 1 len = len * dims%my_number_of_grid_points_vect3 else istop(4) = size(split%my_grid_points_vector3) count(4) = 1 end if if (.not. associated(split%my_grid_points_vector2)) then istop(3) = 1 len = len * dims%my_number_of_grid_points_vect2 else istop(3) = size(split%my_grid_points_vector2) count(3) = 1 end if if (.not. associated(split%my_grid_points_vector1)) then istop(2) = 1 len = len * dims%my_number_of_grid_points_vect1 else istop(2) = size(split%my_grid_points_vector1) count(2) = 1 end if len = len * dims%real_or_complex_wavefunctions do idim8 = 1, istop(8), 1 if (associated(split%my_spins)) then start(8) = split%my_spins(idim8) end if do idim7 = 1, istop(7), 1 if (associated(split%my_kpoints)) then start(7) = split%my_kpoints(idim7) end if do idim6 = 1, istop(6), 1 if (associated(split%my_states)) then start(6) = split%my_states(idim6) end if do idim4 = 1, istop(4), 1 if (associated(split%my_grid_points_vector3)) then start(4) = split%my_grid_points_vector3(idim4) end if do idim3 = 1, istop(3), 1 if (associated(split%my_grid_points_vector2)) then start(3) = split%my_grid_points_vector2(idim3) end if do idim2 = 1, istop(2), 1 if (associated(split%my_grid_points_vector1)) then start(2) = split%my_grid_points_vector1(idim2) end if call etsf_io_low_write_var(ncid_to, "real_space_wavefunctions", & & folder%real_space_wavefunctions%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%real_space_wavefunctions%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do end do end do end do end do deallocate(start, count, istop) else ! No split information, we copy everything in the same shape. call etsf_io_low_write_var(ncid_to, "real_space_wavefunctions", & & folder%real_space_wavefunctions%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%real_space_wavefunctions%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%real_space_wavefunctions%data1D) lstat = .true. ! We copy all the attributes (ETSF and non-ETSF) of the group variables. call etsf_io_low_set_define_mode(ncid_to, lstat, error_data = error_data) if (.not. lstat) nvarids = 0 do len = 1, nvarids - 1, 1 call etsf_io_low_copy_all_att(ncid_from, ncid_to, varids(1, len), varids(2, len), & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) exit end if end do deallocate(varids) !DEBUG !write (*,*) 'etsf_io_main_copy : exit' !ENDDEBUG end subroutine etsf_io_main_copy !!*** etsf_io-1.0.3/src/group_level/etsf_io_split_init.f900000644000353400050630000000700011354150413017401 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_split/etsf_io_split_init !! NAME !! etsf_io_split_init !! !! FUNCTION !! This routine is used to set the dimensions from a split defintion. It !! copies to @dims%my_ the size of associated arrays in !! @split_definition. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * split_definition = !! give for each associated array the number of elements (given by the size) !! and the values of these elements in a splitted file. !! SIDE EFFECTS !! * dims = !! will be changed according to the @split argument. For each allocated array !! in @split, their corresponding dimension will be put to the array size ; !! else, the none-split value is used. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_split_init(dims, split_definition) !Arguments ------------------------------------ type(etsf_dims), intent(inout) :: dims type(etsf_split), intent(in) :: split_definition !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_split_init' ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_split_init : enter' !ENDDEBUG if (associated(split_definition%my_kpoints)) then dims%my_number_of_kpoints = & & size(split_definition%my_kpoints) else dims%my_number_of_kpoints = & & dims%number_of_kpoints end if if (associated(split_definition%my_grid_points_vector3)) then dims%my_number_of_grid_points_vect3 = & & size(split_definition%my_grid_points_vector3) else dims%my_number_of_grid_points_vect3 = & & dims%number_of_grid_points_vector3 end if if (associated(split_definition%my_spins)) then dims%my_number_of_spins = & & size(split_definition%my_spins) else dims%my_number_of_spins = & & dims%number_of_spins end if if (associated(split_definition%my_grid_points_vector1)) then dims%my_number_of_grid_points_vect1 = & & size(split_definition%my_grid_points_vector1) else dims%my_number_of_grid_points_vect1 = & & dims%number_of_grid_points_vector1 end if if (associated(split_definition%my_grid_points_vector2)) then dims%my_number_of_grid_points_vect2 = & & size(split_definition%my_grid_points_vector2) else dims%my_number_of_grid_points_vect2 = & & dims%number_of_grid_points_vector2 end if if (associated(split_definition%my_coefficients)) then dims%my_max_number_of_coefficients = & & size(split_definition%my_coefficients) else dims%my_max_number_of_coefficients = & & dims%max_number_of_coefficients end if if (associated(split_definition%my_components)) then dims%my_number_of_components = & & size(split_definition%my_components) else dims%my_number_of_components = & & dims%number_of_components end if if (associated(split_definition%my_states)) then dims%my_max_number_of_states = & & size(split_definition%my_states) else dims%my_max_number_of_states = & & dims%max_number_of_states end if !DEBUG !write (*,*) 'etsf_io_split_init : exit' !ENDDEBUG end subroutine etsf_io_split_init !!*** etsf_io-1.0.3/src/group_level/etsf_io_split_allocate.f900000644000353400050630000000734611354150413020237 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_split/etsf_io_split_allocate !! NAME !! etsf_io_split_allocate !! !! FUNCTION !! Allocate internal pointers of structure etsf_split given the dimensions !! in @dims. The split arrays are allocated only if the associated dimensions !! are different from etsf_no_dimension (see ETSF_IO_CONSTANTS) and from !! the associated full dimension. To free a split structure, use !! etsf_io_split_free(). !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * dims = !! these dimensions define which arrays of argument @split should be allocated ; !! it give also the size for these arrays. !! OUTPUT !! * split = !! read the @dims argument to allocate the required split arrays, use !! etsf_io_split_free() when the split structure is not needed anymore. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_split_allocate(split, dims) !Arguments ------------------------------------ type(etsf_split), intent(out) :: split type(etsf_dims), intent(in) :: dims !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_split_allocate' ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_split_allocate : enter' !ENDDEBUG if (dims%my_number_of_kpoints /= etsf_no_dimension .and. & & dims%my_number_of_kpoints /= dims%number_of_kpoints) then allocate(split%my_kpoints(dims%my_number_of_kpoints)) split%my_kpoints(:) = -1 end if if (dims%my_number_of_grid_points_vect3 /= etsf_no_dimension .and. & & dims%my_number_of_grid_points_vect3 /= dims%number_of_grid_points_vector3) then allocate(split%my_grid_points_vector3(dims%my_number_of_grid_points_vect3)) split%my_grid_points_vector3(:) = -1 end if if (dims%my_number_of_spins /= etsf_no_dimension .and. & & dims%my_number_of_spins /= dims%number_of_spins) then allocate(split%my_spins(dims%my_number_of_spins)) split%my_spins(:) = -1 end if if (dims%my_number_of_grid_points_vect1 /= etsf_no_dimension .and. & & dims%my_number_of_grid_points_vect1 /= dims%number_of_grid_points_vector1) then allocate(split%my_grid_points_vector1(dims%my_number_of_grid_points_vect1)) split%my_grid_points_vector1(:) = -1 end if if (dims%my_number_of_grid_points_vect2 /= etsf_no_dimension .and. & & dims%my_number_of_grid_points_vect2 /= dims%number_of_grid_points_vector2) then allocate(split%my_grid_points_vector2(dims%my_number_of_grid_points_vect2)) split%my_grid_points_vector2(:) = -1 end if if (dims%my_max_number_of_coefficients /= etsf_no_dimension .and. & & dims%my_max_number_of_coefficients /= dims%max_number_of_coefficients) then allocate(split%my_coefficients(dims%my_max_number_of_coefficients)) split%my_coefficients(:) = -1 end if if (dims%my_number_of_components /= etsf_no_dimension .and. & & dims%my_number_of_components /= dims%number_of_components) then allocate(split%my_components(dims%my_number_of_components)) split%my_components(:) = -1 end if if (dims%my_max_number_of_states /= etsf_no_dimension .and. & & dims%my_max_number_of_states /= dims%max_number_of_states) then allocate(split%my_states(dims%my_max_number_of_states)) split%my_states(:) = -1 end if !DEBUG !write (*,*) 'etsf_io_split_allocate : exit' !ENDDEBUG end subroutine etsf_io_split_allocate !!*** etsf_io-1.0.3/src/group_level/etsf_io_split_free.f900000644000353400050630000000364711354150413017374 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_split/etsf_io_split_free !! NAME !! etsf_io_split_free !! !! FUNCTION !! Deallocate a split defintions, previously allocated with !! etsf_io_split_allocate(). !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! SIDE EFFECTS !! * split = !! free all associated array in the split definition. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_split_free(split) !Arguments ------------------------------------ type(etsf_split), intent(inout) :: split !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_split_free' ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_split_free : enter' !ENDDEBUG if (associated(split%my_kpoints)) then deallocate(split%my_kpoints) end if if (associated(split%my_grid_points_vector3)) then deallocate(split%my_grid_points_vector3) end if if (associated(split%my_spins)) then deallocate(split%my_spins) end if if (associated(split%my_grid_points_vector1)) then deallocate(split%my_grid_points_vector1) end if if (associated(split%my_grid_points_vector2)) then deallocate(split%my_grid_points_vector2) end if if (associated(split%my_coefficients)) then deallocate(split%my_coefficients) end if if (associated(split%my_components)) then deallocate(split%my_components) end if if (associated(split%my_states)) then deallocate(split%my_states) end if !DEBUG !write (*,*) 'etsf_io_split_free : exit' !ENDDEBUG end subroutine etsf_io_split_free !!*** etsf_io-1.0.3/src/group_level/etsf_io_split_def.f900000644000353400050630000001120311354150413017174 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_split/etsf_io_split_def !! NAME !! etsf_io_split_def !! !! FUNCTION !! Create arrays for split definitions. They are defined only if their !! dimensions (my_) are different from etsf_no_dimension (see !! ETSF_IO_CONSTANTS) or from the value of dimension . !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = !! integer returned by an 'open' NetCDF call. The file can be !! either in define or write mode. This status can be changed !! by the call. !! * dims = !! contains all the dimensions required by the special my_something arrays. !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_split_def(ncid, dims, lstat, error_data) !Arguments ------------------------------------ integer, intent(in) :: ncid type(etsf_dims), intent(in) :: dims logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_split_def' ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_split_def : enter' !ENDDEBUG if (dims%my_number_of_kpoints /= etsf_no_dimension .and. & & dims%my_number_of_kpoints /= dims%number_of_kpoints) then call etsf_io_low_def_var(ncid, "my_kpoints", & & etsf_io_low_integer, & & (/ pad("my_number_of_kpoints") /), & & lstat, error_data = error_data) if (.not. lstat) return end if if (dims%my_number_of_grid_points_vect3 /= etsf_no_dimension .and. & & dims%my_number_of_grid_points_vect3 /= dims%number_of_grid_points_vector3) then call etsf_io_low_def_var(ncid, "my_grid_points_vector3", & & etsf_io_low_integer, & & (/ pad("my_number_of_grid_points_vector3") /), & & lstat, error_data = error_data) if (.not. lstat) return end if if (dims%my_number_of_spins /= etsf_no_dimension .and. & & dims%my_number_of_spins /= dims%number_of_spins) then call etsf_io_low_def_var(ncid, "my_spins", & & etsf_io_low_integer, & & (/ pad("my_number_of_spins") /), & & lstat, error_data = error_data) if (.not. lstat) return end if if (dims%my_number_of_grid_points_vect1 /= etsf_no_dimension .and. & & dims%my_number_of_grid_points_vect1 /= dims%number_of_grid_points_vector1) then call etsf_io_low_def_var(ncid, "my_grid_points_vector1", & & etsf_io_low_integer, & & (/ pad("my_number_of_grid_points_vector1") /), & & lstat, error_data = error_data) if (.not. lstat) return end if if (dims%my_number_of_grid_points_vect2 /= etsf_no_dimension .and. & & dims%my_number_of_grid_points_vect2 /= dims%number_of_grid_points_vector2) then call etsf_io_low_def_var(ncid, "my_grid_points_vector2", & & etsf_io_low_integer, & & (/ pad("my_number_of_grid_points_vector2") /), & & lstat, error_data = error_data) if (.not. lstat) return end if if (dims%my_max_number_of_coefficients /= etsf_no_dimension .and. & & dims%my_max_number_of_coefficients /= dims%max_number_of_coefficients) then call etsf_io_low_def_var(ncid, "my_coefficients", & & etsf_io_low_integer, & & (/ pad("my_max_number_of_coefficients") /), & & lstat, error_data = error_data) if (.not. lstat) return end if if (dims%my_number_of_components /= etsf_no_dimension .and. & & dims%my_number_of_components /= dims%number_of_components) then call etsf_io_low_def_var(ncid, "my_components", & & etsf_io_low_integer, & & (/ pad("my_number_of_components") /), & & lstat, error_data = error_data) if (.not. lstat) return end if if (dims%my_max_number_of_states /= etsf_no_dimension .and. & & dims%my_max_number_of_states /= dims%max_number_of_states) then call etsf_io_low_def_var(ncid, "my_states", & & etsf_io_low_integer, & & (/ pad("my_max_number_of_states") /), & & lstat, error_data = error_data) if (.not. lstat) return end if !DEBUG !write (*,*) 'etsf_io_split_def : exit' !ENDDEBUG end subroutine etsf_io_split_def !!*** etsf_io-1.0.3/src/group_level/etsf_io_split_get.f900000644000353400050630000000740711354150413017230 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_split/etsf_io_split_get !! NAME !! etsf_io_split_get !! !! FUNCTION !! Read the split defintions from a file. Only associated pointers from the !! @split structure will be read. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = !! integer returned by an 'open' NetCDF call. The file can be !! either in define or write mode. This status can be changed !! by the call. !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! SIDE EFFECTS !! * split = !! read from the disk the values of each associated array of @split. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_split_get(ncid, split, lstat, error_data) !Arguments ------------------------------------ integer, intent(in) :: ncid type(etsf_split), intent(inout) :: split logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_split_get' ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_split_get : enter' !ENDDEBUG if (associated(split%my_kpoints)) then call etsf_io_low_read_var(ncid, "my_kpoints", & & split%my_kpoints, & & lstat, error_data = error_data) if (.not. lstat) return end if if (associated(split%my_grid_points_vector3)) then call etsf_io_low_read_var(ncid, "my_grid_points_vector3", & & split%my_grid_points_vector3, & & lstat, error_data = error_data) if (.not. lstat) return end if if (associated(split%my_spins)) then call etsf_io_low_read_var(ncid, "my_spins", & & split%my_spins, & & lstat, error_data = error_data) if (.not. lstat) return end if if (associated(split%my_grid_points_vector1)) then call etsf_io_low_read_var(ncid, "my_grid_points_vector1", & & split%my_grid_points_vector1, & & lstat, error_data = error_data) if (.not. lstat) return end if if (associated(split%my_grid_points_vector2)) then call etsf_io_low_read_var(ncid, "my_grid_points_vector2", & & split%my_grid_points_vector2, & & lstat, error_data = error_data) if (.not. lstat) return end if if (associated(split%my_coefficients)) then call etsf_io_low_read_var(ncid, "my_coefficients", & & split%my_coefficients, & & lstat, error_data = error_data) if (.not. lstat) return end if if (associated(split%my_components)) then call etsf_io_low_read_var(ncid, "my_components", & & split%my_components, & & lstat, error_data = error_data) if (.not. lstat) return end if if (associated(split%my_states)) then call etsf_io_low_read_var(ncid, "my_states", & & split%my_states, & & lstat, error_data = error_data) if (.not. lstat) return end if !DEBUG !write (*,*) 'etsf_io_split_get : exit' !ENDDEBUG end subroutine etsf_io_split_get !!*** etsf_io-1.0.3/src/group_level/etsf_io_split_put.f900000644000353400050630000000731611354150413017260 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_split/etsf_io_split_put !! NAME !! etsf_io_split_put !! !! FUNCTION !! Simply write the split definition (of associated pointers) to the file. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = !! integer returned by an 'open' NetCDF call. The file can be !! either in define or write mode. This status can be changed !! by the call. !! * split = !! copy the allocated arrays from this argument to the disk. !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_split_put(ncid, split, lstat, error_data) !Arguments ------------------------------------ integer, intent(in) :: ncid type(etsf_split), intent(in) :: split logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_split_put' ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_split_put : enter' !ENDDEBUG if (associated(split%my_kpoints)) then call etsf_io_low_write_var(ncid, "my_kpoints", & & split%my_kpoints, & & lstat, error_data = error_data) if (.not. lstat) return end if if (associated(split%my_grid_points_vector3)) then call etsf_io_low_write_var(ncid, "my_grid_points_vector3", & & split%my_grid_points_vector3, & & lstat, error_data = error_data) if (.not. lstat) return end if if (associated(split%my_spins)) then call etsf_io_low_write_var(ncid, "my_spins", & & split%my_spins, & & lstat, error_data = error_data) if (.not. lstat) return end if if (associated(split%my_grid_points_vector1)) then call etsf_io_low_write_var(ncid, "my_grid_points_vector1", & & split%my_grid_points_vector1, & & lstat, error_data = error_data) if (.not. lstat) return end if if (associated(split%my_grid_points_vector2)) then call etsf_io_low_write_var(ncid, "my_grid_points_vector2", & & split%my_grid_points_vector2, & & lstat, error_data = error_data) if (.not. lstat) return end if if (associated(split%my_coefficients)) then call etsf_io_low_write_var(ncid, "my_coefficients", & & split%my_coefficients, & & lstat, error_data = error_data) if (.not. lstat) return end if if (associated(split%my_components)) then call etsf_io_low_write_var(ncid, "my_components", & & split%my_components, & & lstat, error_data = error_data) if (.not. lstat) return end if if (associated(split%my_states)) then call etsf_io_low_write_var(ncid, "my_states", & & split%my_states, & & lstat, error_data = error_data) if (.not. lstat) return end if !DEBUG !write (*,*) 'etsf_io_split_put : exit' !ENDDEBUG end subroutine etsf_io_split_put !!*** etsf_io-1.0.3/src/group_level/etsf_io_split_copy.f900000644000353400050630000002102611354150413017414 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_split/etsf_io_split_copy !! NAME !! etsf_io_split_copy !! !! FUNCTION !! As for etsf_io_electrons_copy() for instance, it copy all values from split !! definitions of file @ncid_from to file @ncid_to. Arrays are copied only if !! their dimensions are neither etsf_no_dimension (see ETSF_IO_CONSTANTS) nor !! the associated full dimension value. The arrays in @ncid_to must already be !! defined, use etsf_io_split_def() to do it. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid_to = !! integer returned by an 'open' NetCDF call. This id must have write access !! granted. It will be modified by the routine. The file must be in write !! mode (see etsf_io_low_set_write_mode()). !! * ncid_from = !! integer returned by an 'open' NetCDF call. This id must have read access !! granted. It will be left untouched. !! * dims = !! the special split arrays are copied if their corresponding dimension, read !! from @dims, are different from etsf_no_dimension and different from their !! non-split value. !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_split_copy(ncid_to, ncid_from, dims, lstat, error_data) !Arguments ------------------------------------ integer, intent(in) :: ncid_to integer, intent(in) :: ncid_from type(etsf_dims), intent(in) :: dims logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_split_copy' integer,allocatable :: split_array(:) ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_split_copy : enter' !ENDDEBUG if (dims%my_number_of_kpoints /= etsf_no_dimension .and. & & dims%my_number_of_kpoints /= dims%number_of_kpoints) then allocate(split_array(dims%my_number_of_kpoints)) call etsf_io_low_read_var(ncid_from, "my_kpoints", & & split_array, lstat, error_data = error_data) if (.not. lstat) then deallocate(split_array) call etsf_io_low_error_update(error_data, my_name) return end if call etsf_io_low_write_var(ncid_to, "my_kpoints", & & split_array, lstat, error_data = error_data) if (.not. lstat) then deallocate(split_array) call etsf_io_low_error_update(error_data, my_name) return end if deallocate(split_array) end if if (dims%my_number_of_grid_points_vect3 /= etsf_no_dimension .and. & & dims%my_number_of_grid_points_vect3 /= dims%number_of_grid_points_vector3) then allocate(split_array(dims%my_number_of_grid_points_vect3)) call etsf_io_low_read_var(ncid_from, "my_grid_points_vector3", & & split_array, lstat, error_data = error_data) if (.not. lstat) then deallocate(split_array) call etsf_io_low_error_update(error_data, my_name) return end if call etsf_io_low_write_var(ncid_to, "my_grid_points_vector3", & & split_array, lstat, error_data = error_data) if (.not. lstat) then deallocate(split_array) call etsf_io_low_error_update(error_data, my_name) return end if deallocate(split_array) end if if (dims%my_number_of_spins /= etsf_no_dimension .and. & & dims%my_number_of_spins /= dims%number_of_spins) then allocate(split_array(dims%my_number_of_spins)) call etsf_io_low_read_var(ncid_from, "my_spins", & & split_array, lstat, error_data = error_data) if (.not. lstat) then deallocate(split_array) call etsf_io_low_error_update(error_data, my_name) return end if call etsf_io_low_write_var(ncid_to, "my_spins", & & split_array, lstat, error_data = error_data) if (.not. lstat) then deallocate(split_array) call etsf_io_low_error_update(error_data, my_name) return end if deallocate(split_array) end if if (dims%my_number_of_grid_points_vect1 /= etsf_no_dimension .and. & & dims%my_number_of_grid_points_vect1 /= dims%number_of_grid_points_vector1) then allocate(split_array(dims%my_number_of_grid_points_vect1)) call etsf_io_low_read_var(ncid_from, "my_grid_points_vector1", & & split_array, lstat, error_data = error_data) if (.not. lstat) then deallocate(split_array) call etsf_io_low_error_update(error_data, my_name) return end if call etsf_io_low_write_var(ncid_to, "my_grid_points_vector1", & & split_array, lstat, error_data = error_data) if (.not. lstat) then deallocate(split_array) call etsf_io_low_error_update(error_data, my_name) return end if deallocate(split_array) end if if (dims%my_number_of_grid_points_vect2 /= etsf_no_dimension .and. & & dims%my_number_of_grid_points_vect2 /= dims%number_of_grid_points_vector2) then allocate(split_array(dims%my_number_of_grid_points_vect2)) call etsf_io_low_read_var(ncid_from, "my_grid_points_vector2", & & split_array, lstat, error_data = error_data) if (.not. lstat) then deallocate(split_array) call etsf_io_low_error_update(error_data, my_name) return end if call etsf_io_low_write_var(ncid_to, "my_grid_points_vector2", & & split_array, lstat, error_data = error_data) if (.not. lstat) then deallocate(split_array) call etsf_io_low_error_update(error_data, my_name) return end if deallocate(split_array) end if if (dims%my_max_number_of_coefficients /= etsf_no_dimension .and. & & dims%my_max_number_of_coefficients /= dims%max_number_of_coefficients) then allocate(split_array(dims%my_max_number_of_coefficients)) call etsf_io_low_read_var(ncid_from, "my_coefficients", & & split_array, lstat, error_data = error_data) if (.not. lstat) then deallocate(split_array) call etsf_io_low_error_update(error_data, my_name) return end if call etsf_io_low_write_var(ncid_to, "my_coefficients", & & split_array, lstat, error_data = error_data) if (.not. lstat) then deallocate(split_array) call etsf_io_low_error_update(error_data, my_name) return end if deallocate(split_array) end if if (dims%my_number_of_components /= etsf_no_dimension .and. & & dims%my_number_of_components /= dims%number_of_components) then allocate(split_array(dims%my_number_of_components)) call etsf_io_low_read_var(ncid_from, "my_components", & & split_array, lstat, error_data = error_data) if (.not. lstat) then deallocate(split_array) call etsf_io_low_error_update(error_data, my_name) return end if call etsf_io_low_write_var(ncid_to, "my_components", & & split_array, lstat, error_data = error_data) if (.not. lstat) then deallocate(split_array) call etsf_io_low_error_update(error_data, my_name) return end if deallocate(split_array) end if if (dims%my_max_number_of_states /= etsf_no_dimension .and. & & dims%my_max_number_of_states /= dims%max_number_of_states) then allocate(split_array(dims%my_max_number_of_states)) call etsf_io_low_read_var(ncid_from, "my_states", & & split_array, lstat, error_data = error_data) if (.not. lstat) then deallocate(split_array) call etsf_io_low_error_update(error_data, my_name) return end if call etsf_io_low_write_var(ncid_to, "my_states", & & split_array, lstat, error_data = error_data) if (.not. lstat) then deallocate(split_array) call etsf_io_low_error_update(error_data, my_name) return end if deallocate(split_array) end if !DEBUG !write (*,*) 'etsf_io_split_copy : exit' !ENDDEBUG end subroutine etsf_io_split_copy !!*** etsf_io-1.0.3/src/group_level/etsf_io_split_merge.f900000644000353400050630000002460211354150413017544 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_split/etsf_io_split_merge !! NAME !! etsf_io_split_merge !! !! FUNCTION !! This is a complex routine that create a larger split definition (@output_split) !! from an input split definition (@split). For each associated array in @split, !! it copies all values of this array into the corresponding array in @output_split. !! The position in the corresponding array is the first unused index (i.e. with a !! negative value). !! !! The input @split definition is then modified to reflect the new position of values !! in @output_split. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! SIDE EFFECTS !! * output_split = !! * split = !! the value from this structure are copied into the right arrays in !! @output_split and the values are changed then to be the indexes used in !! @output_split. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_split_merge(output_split, split, lstat, error_data) !Arguments ------------------------------------ type(etsf_split), intent(inout) :: output_split type(etsf_split), intent(inout) :: split logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_split_merge' integer :: ivar integer :: len ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_split_merge : enter' !ENDDEBUG lstat = .false. if (associated(output_split%my_kpoints)) then if (.not. associated(split%my_kpoints)) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible split for merge (not allocated).") return end if do ivar = 1, size(output_split%my_kpoints), 1 if (output_split%my_kpoints(ivar) < 0) then exit end if end do if ((ivar + size(split%my_kpoints) - 1) > size(output_split%my_kpoints)) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible split for merge (wrong length).") return end if output_split%my_kpoints(ivar:ivar + size(split%my_kpoints) - 1) = & & split%my_kpoints ! We modify the split value to be used in accordance with ! the new output_split split%my_kpoints = & & (/ (len, len = ivar, ivar + size(split%my_kpoints) - 1, 1) /) end if if (associated(output_split%my_grid_points_vector3)) then if (.not. associated(split%my_grid_points_vector3)) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible split for merge (not allocated).") return end if do ivar = 1, size(output_split%my_grid_points_vector3), 1 if (output_split%my_grid_points_vector3(ivar) < 0) then exit end if end do if ((ivar + size(split%my_grid_points_vector3) - 1) > size(output_split%my_grid_points_vector3)) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible split for merge (wrong length).") return end if output_split%my_grid_points_vector3(ivar:ivar + size(split%my_grid_points_vector3) - 1) = & & split%my_grid_points_vector3 ! We modify the split value to be used in accordance with ! the new output_split split%my_grid_points_vector3 = & & (/ (len, len = ivar, ivar + size(split%my_grid_points_vector3) - 1, 1) /) end if if (associated(output_split%my_spins)) then if (.not. associated(split%my_spins)) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible split for merge (not allocated).") return end if do ivar = 1, size(output_split%my_spins), 1 if (output_split%my_spins(ivar) < 0) then exit end if end do if ((ivar + size(split%my_spins) - 1) > size(output_split%my_spins)) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible split for merge (wrong length).") return end if output_split%my_spins(ivar:ivar + size(split%my_spins) - 1) = & & split%my_spins ! We modify the split value to be used in accordance with ! the new output_split split%my_spins = & & (/ (len, len = ivar, ivar + size(split%my_spins) - 1, 1) /) end if if (associated(output_split%my_grid_points_vector1)) then if (.not. associated(split%my_grid_points_vector1)) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible split for merge (not allocated).") return end if do ivar = 1, size(output_split%my_grid_points_vector1), 1 if (output_split%my_grid_points_vector1(ivar) < 0) then exit end if end do if ((ivar + size(split%my_grid_points_vector1) - 1) > size(output_split%my_grid_points_vector1)) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible split for merge (wrong length).") return end if output_split%my_grid_points_vector1(ivar:ivar + size(split%my_grid_points_vector1) - 1) = & & split%my_grid_points_vector1 ! We modify the split value to be used in accordance with ! the new output_split split%my_grid_points_vector1 = & & (/ (len, len = ivar, ivar + size(split%my_grid_points_vector1) - 1, 1) /) end if if (associated(output_split%my_grid_points_vector2)) then if (.not. associated(split%my_grid_points_vector2)) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible split for merge (not allocated).") return end if do ivar = 1, size(output_split%my_grid_points_vector2), 1 if (output_split%my_grid_points_vector2(ivar) < 0) then exit end if end do if ((ivar + size(split%my_grid_points_vector2) - 1) > size(output_split%my_grid_points_vector2)) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible split for merge (wrong length).") return end if output_split%my_grid_points_vector2(ivar:ivar + size(split%my_grid_points_vector2) - 1) = & & split%my_grid_points_vector2 ! We modify the split value to be used in accordance with ! the new output_split split%my_grid_points_vector2 = & & (/ (len, len = ivar, ivar + size(split%my_grid_points_vector2) - 1, 1) /) end if if (associated(output_split%my_coefficients)) then if (.not. associated(split%my_coefficients)) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible split for merge (not allocated).") return end if do ivar = 1, size(output_split%my_coefficients), 1 if (output_split%my_coefficients(ivar) < 0) then exit end if end do if ((ivar + size(split%my_coefficients) - 1) > size(output_split%my_coefficients)) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible split for merge (wrong length).") return end if output_split%my_coefficients(ivar:ivar + size(split%my_coefficients) - 1) = & & split%my_coefficients ! We modify the split value to be used in accordance with ! the new output_split split%my_coefficients = & & (/ (len, len = ivar, ivar + size(split%my_coefficients) - 1, 1) /) end if if (associated(output_split%my_components)) then if (.not. associated(split%my_components)) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible split for merge (not allocated).") return end if do ivar = 1, size(output_split%my_components), 1 if (output_split%my_components(ivar) < 0) then exit end if end do if ((ivar + size(split%my_components) - 1) > size(output_split%my_components)) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible split for merge (wrong length).") return end if output_split%my_components(ivar:ivar + size(split%my_components) - 1) = & & split%my_components ! We modify the split value to be used in accordance with ! the new output_split split%my_components = & & (/ (len, len = ivar, ivar + size(split%my_components) - 1, 1) /) end if if (associated(output_split%my_states)) then if (.not. associated(split%my_states)) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible split for merge (not allocated).") return end if do ivar = 1, size(output_split%my_states), 1 if (output_split%my_states(ivar) < 0) then exit end if end do if ((ivar + size(split%my_states) - 1) > size(output_split%my_states)) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_DIM, my_name, & & errmess = "incompatible split for merge (wrong length).") return end if output_split%my_states(ivar:ivar + size(split%my_states) - 1) = & & split%my_states ! We modify the split value to be used in accordance with ! the new output_split split%my_states = & & (/ (len, len = ivar, ivar + size(split%my_states) - 1, 1) /) end if lstat = .true. !DEBUG !write (*,*) 'etsf_io_split_merge : exit' !ENDDEBUG end subroutine etsf_io_split_merge !!*** etsf_io-1.0.3/src/group_level/etsf_io_vars_free.f900000644000353400050630000000273411354150413017210 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_vars/etsf_io_vars_free !! NAME !! etsf_io_vars_free !! !! FUNCTION !! Free the given variable list. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! SIDE EFFECTS !! * vars_infos = !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_vars_free(vars_infos) !Arguments ------------------------------------ type(etsf_vars), intent(inout) :: vars_infos !Local variables------------------------------- character(len = *), parameter :: my_name = 'etsf_io_vars_free' ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_vars_free : enter' !ENDDEBUG ! Deallocate all associated pointers. if (associated(vars_infos%parent)) then call etsf_io_low_free_all_var_infos(vars_infos%parent) end if if (associated(vars_infos%group)) then deallocate(vars_infos%group) end if if (associated(vars_infos%varid)) then deallocate(vars_infos%varid) end if if (associated(vars_infos%split)) then deallocate(vars_infos%split) end if !DEBUG !write (*,*) 'etsf_io_vars_free : exit' !ENDDEBUG end subroutine etsf_io_vars_free !!*** etsf_io-1.0.3/src/group_level/etsf_io_data_init.f900000644000353400050630000002025711354150413017170 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_io_data_group/etsf_io_data_init !! NAME !! etsf_io_data_init !! !! FUNCTION !! High-level routine to create an ETSF file. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * filename = !! the path to the file to be accessed. !! * groups = !! choose the groups and the variables (from #etsf_groups_flags) that will !! be used. This is a sum of values taken from #FLAGS_VARIABLES for each group. !! Let the value to etsf__none not to define a wall group. !! * title = !! the title of the file (maybe null but should not). !! * history = !! some history information (maybe null). !! * k_dependent = (optional) !! use this argument to set the attribute flag 'k_dependent' to 'yes' !! or 'no' on variables that have it. If no variable in the group has !! the attribute 'k_dependent', this argument has no effect. The default !! value is .true. (which puts 'yes' in the file). !! * overwrite = (optional) !! will overwrite an existing file with the same file name (default is .false.). !! * split_definition = (optional) !! give for each associated array the number of elements (given by the size) !! and the values of these elements in a splitted file. !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! SIDE EFFECTS !! * dims = !! contains all the dimensions required by the ETSF file. It will be modify !! by setting the constant dimensions to their right values, and the my_something !! dimensions will be set according to the @split optional argument (if not !! present, they will be put to their none split values). !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_data_init(filename, groups, dims, title, history, lstat, & & error_data, k_dependent, overwrite, split_definition) !Arguments ------------------------------------ character(len=*), intent(in) :: filename type(etsf_groups_flags), intent(in) :: groups type(etsf_dims), intent(inout) :: dims character(len=*), intent(in) :: title character(len=*), intent(in) :: history logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data logical, optional, intent(in) :: k_dependent logical, optional, intent(in) :: overwrite type(etsf_split), optional, intent(in) :: split_definition !Local variables------------------------------- character(len=*),parameter :: my_name = 'etsf_io_data_init' integer :: ncid, i logical :: my_k_dependent logical :: my_overwrite type(etsf_split) :: my_split_definition ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_data_init : enter' !ENDDEBUG ! Get values for optional arguments, set default. if (present(k_dependent)) then my_k_dependent = k_dependent else my_k_dependent = .true. end if if (present(overwrite)) then my_overwrite = overwrite else my_overwrite = .false. end if if (present(split_definition)) then my_split_definition = split_definition end if ! Create the NetCDF file call etsf_io_low_open_create(ncid, filename, etsf_file_format_version, lstat, & & title = trim(title), history = trim(history), & & error_data = error_data, overwrite = my_overwrite) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if ! Define dimensions dims%character_string_length = etsf_charlen dims%number_of_cartesian_directions = etsf_3dimlen dims%number_of_reduced_dimensions = etsf_3dimlen dims%number_of_vectors = etsf_3dimlen dims%symbol_length = etsf_chemlen ! We set the size of split arrays, if required. if (present(split_definition)) then call etsf_io_split_init(dims, split_definition) end if ! We write the dimensions to the file. call etsf_io_dims_def(ncid, dims, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if ! Define split arrays. if (present(split_definition)) then call etsf_io_split_def(ncid, dims, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if ! Define groups. if (groups%geometry /= etsf_geometry_none) then call etsf_io_geometry_def(ncid, lstat, error_data, & & k_dependent = my_k_dependent, & & flags = groups%geometry, & & split = my_split_definition) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (groups%electrons /= etsf_electrons_none) then call etsf_io_electrons_def(ncid, lstat, error_data, & & k_dependent = my_k_dependent, & & flags = groups%electrons, & & split = my_split_definition) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (groups%kpoints /= etsf_kpoints_none) then call etsf_io_kpoints_def(ncid, lstat, error_data, & & k_dependent = my_k_dependent, & & flags = groups%kpoints, & & split = my_split_definition) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (groups%basisdata /= etsf_basisdata_none) then call etsf_io_basisdata_def(ncid, lstat, error_data, & & k_dependent = my_k_dependent, & & flags = groups%basisdata, & & split = my_split_definition) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (groups%gwdata /= etsf_gwdata_none) then call etsf_io_gwdata_def(ncid, lstat, error_data, & & k_dependent = my_k_dependent, & & flags = groups%gwdata, & & split = my_split_definition) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (groups%dielectric /= etsf_dielectric_none) then call etsf_io_dielectric_def(ncid, lstat, error_data, & & k_dependent = my_k_dependent, & & flags = groups%dielectric, & & split = my_split_definition) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (groups%main /= etsf_main_none) then call etsf_io_main_def(ncid, lstat, error_data, & & k_dependent = my_k_dependent, & & flags = groups%main, & & split = my_split_definition) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if ! Write the split arrays. if (present(split_definition)) then ! Begin by putting the file in write mode. call etsf_io_low_set_write_mode(ncid, lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if ! Write the arrays. call etsf_io_split_put(ncid, split_definition, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if ! End definitions and close file call etsf_io_low_close(ncid, lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if !DEBUG !write (*,*) 'etsf_io_data_init : exit' !ENDDEBUG end subroutine etsf_io_data_init !!*** etsf_io-1.0.3/src/group_level/etsf_io_data_read.f900000644000353400050630000001131011354150413017126 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_io_data_group/etsf_io_data_read !! NAME !! etsf_io_data_read !! !! FUNCTION !! High-level routine to read a lot of ETSF variable at once. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * filename = !! the path to the file to be accessed. !! * use_atomic_units = (optional) !! set this flag to .true. makes the library use the value of the attribute !! scale_to_atomic_units to multiply the read variables (that are units dependent) !! by this factor (if different from 1.0d0). !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! SIDE EFFECTS !! * group_folder = !! a container for different groups. All groups specified in the @groups argument !! must be associated. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_data_read(filename, group_folder, lstat, error_data, use_atomic_units) !Arguments ------------------------------------ character(len=*), intent(in) :: filename type(etsf_groups), intent(inout) :: group_folder logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data logical, optional, intent(in) :: use_atomic_units !Local variables------------------------------- character(len=*),parameter :: my_name = 'etsf_io_data_read' integer :: ncid, i logical :: my_use_atomic_units ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_data_read : enter' !ENDDEBUG ! Get values for optional arguments, set default. if (present(use_atomic_units)) then my_use_atomic_units = use_atomic_units else my_use_atomic_units = .true. end if ! Open file for reading call etsf_io_low_open_read(ncid, trim(filename), lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if ! Get Data if (associated(group_folder%geometry)) then call etsf_io_geometry_get(ncid, group_folder%geometry, lstat, error_data, & & use_atomic_units = my_use_atomic_units) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(group_folder%electrons)) then call etsf_io_electrons_get(ncid, group_folder%electrons, lstat, error_data, & & use_atomic_units = my_use_atomic_units) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(group_folder%kpoints)) then call etsf_io_kpoints_get(ncid, group_folder%kpoints, lstat, error_data, & & use_atomic_units = my_use_atomic_units) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(group_folder%basisdata)) then call etsf_io_basisdata_get(ncid, group_folder%basisdata, lstat, error_data, & & use_atomic_units = my_use_atomic_units) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(group_folder%gwdata)) then call etsf_io_gwdata_get(ncid, group_folder%gwdata, lstat, error_data, & & use_atomic_units = my_use_atomic_units) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(group_folder%dielectric)) then call etsf_io_dielectric_get(ncid, group_folder%dielectric, lstat, error_data, & & use_atomic_units = my_use_atomic_units) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(group_folder%main)) then call etsf_io_main_get(ncid, group_folder%main, lstat, error_data, & & use_atomic_units = my_use_atomic_units) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if ! Close file call etsf_io_low_close(ncid, lstat, error_data = error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, my_name) !DEBUG !write (*,*) 'etsf_io_data_read : exit' !ENDDEBUG end subroutine etsf_io_data_read !!*** etsf_io-1.0.3/src/group_level/etsf_io_data_write.f900000644000353400050630000000761311354150413017360 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_io_data_group/etsf_io_data_write !! NAME !! etsf_io_data_write !! !! FUNCTION !! High-level routine to write a lot of ETSF variable at once. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * filename = !! the path to the file to be accessed. !! * group_folder = !! a container for different groups. All groups specified in the @groups argument !! must be associated. !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_data_write(filename, group_folder, lstat, error_data) !Arguments ------------------------------------ character(len=*), intent(in) :: filename type(etsf_groups), intent(in) :: group_folder logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data !Local variables------------------------------- character(len=*),parameter :: my_name = 'etsf_io_data_write' integer :: ncid, i ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_data_write : enter' !ENDDEBUG ! Open file for writing call etsf_io_low_open_modify(ncid, trim(filename), lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if ! We switch to write mode. call etsf_io_low_set_write_mode(ncid, lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if ! Put Data if (associated(group_folder%geometry)) then call etsf_io_geometry_put(ncid, group_folder%geometry, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(group_folder%electrons)) then call etsf_io_electrons_put(ncid, group_folder%electrons, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(group_folder%kpoints)) then call etsf_io_kpoints_put(ncid, group_folder%kpoints, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(group_folder%basisdata)) then call etsf_io_basisdata_put(ncid, group_folder%basisdata, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(group_folder%gwdata)) then call etsf_io_gwdata_put(ncid, group_folder%gwdata, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(group_folder%dielectric)) then call etsf_io_dielectric_put(ncid, group_folder%dielectric, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if if (associated(group_folder%main)) then call etsf_io_main_put(ncid, group_folder%main, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if end if ! Close file call etsf_io_low_close(ncid, lstat, error_data = error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, my_name) !DEBUG !write (*,*) 'etsf_io_data_write : exit' !ENDDEBUG end subroutine etsf_io_data_write !!*** etsf_io-1.0.3/src/group_level/etsf_io_data_contents.f900000644000353400050630000001624411354150413020063 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_io_data_group/etsf_io_data_contents !! NAME !! etsf_io_data_contents !! !! FUNCTION !! High-level routine that get informations from a given @filename. Returned values !! are the list of dimensions, allocated split definitions (if any), flags for !! main variables (see FLAGS_VARIABLES) and flags for groups (see FLAGS_GROUPS). !! !! This routine can also be used to get the comprehensive list of read variables !! with their definitions (name, shape, dimension names...). Use !! etsf_io_vars_free() to deallocate this list. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * filename = !! the path to the file to be accessed. !! OUTPUT !! * dims = !! the dimensions will be read and stored, using etsf_io_dims_get(). !! * split = !! if any, read the split array from the given file and put their values !! in this argument. If lstat = .true., it may be allocated in output. !! So, after use, it must be deallocated, using etsf_io_split_free(). !! * etsf_groups = !! an integer which is the sum of all present group ids in the read file (see !! FLAGS_GROUPS). !! * etsf_variables = !! an integer for each group detailling which ETSF variables are indeed !! present in the read file (see FLAGS_VARIABLES). !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! SIDE EFFECTS !! * vars_infos = (optional) !! when reading the file for variable informations, it creates a list of !! type(etsf_var) that describes all the variables in the !! file. This list contains non ETSF informations such as variable names, !! types, shapes, an array of dimension values and an other array of dimension !! names. It also contains ETSF informations, like group id or if the variable !! is a split definition. When given, internal pointers are associated in the !! subroutine. To free them, use etsf_io_vars_free(). !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_data_contents(filename, dims, split, etsf_groups, etsf_variables, & & lstat, error_data, vars_infos) !Arguments ------------------------------------ character(len=*), intent(in) :: filename type(etsf_dims), intent(out) :: dims type(etsf_split), intent(out) :: split integer, intent(out) :: etsf_groups type(etsf_groups_flags), intent(out) :: etsf_variables logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data type(etsf_vars), optional, intent(inout) :: vars_infos !Local variables------------------------------- character(len=*),parameter :: my_name = 'etsf_io_data_contents' integer :: ncid, i type(etsf_vars) :: my_vars_infos logical :: with_dim_name logical :: with_att_name integer :: group_id integer :: var_id logical :: split_id ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_data_contents : enter' !ENDDEBUG lstat = .false. if (present(vars_infos)) then vars_infos%n_vars = 0 vars_infos%parent => null() with_dim_name = .true. with_att_name = .true. else with_dim_name = .false. with_att_name = .false. end if ! Open file for reading call etsf_io_low_open_read(ncid, trim(filename), & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if ! Get the dimensions. call etsf_io_dims_get(ncid, dims, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if ! We allocate the split arrays. call etsf_io_split_allocate(split, dims) ! We read the split informations. call etsf_io_split_get(ncid, split, lstat, error_data) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, my_name) return end if ! Get all variables definitions. ! It will allocate my_vars_infos%parent array. call etsf_io_low_read_all_var_infos(ncid, my_vars_infos%parent, & & lstat, error_data, with_dim_name = with_dim_name, & & with_att_name = with_att_name) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, my_name) return end if etsf_variables%geometry = etsf_geometry_none etsf_variables%electrons = etsf_electrons_none etsf_variables%kpoints = etsf_kpoints_none etsf_variables%basisdata = etsf_basisdata_none etsf_variables%gwdata = etsf_gwdata_none etsf_variables%dielectric = etsf_dielectric_none etsf_variables%main = etsf_main_none if (associated(my_vars_infos%parent)) then my_vars_infos%n_vars = size(my_vars_infos%parent) if (present(vars_infos)) then ! Allocate vars_infos arrays for future use. vars_infos%n_vars = my_vars_infos%n_vars allocate(vars_infos%group(vars_infos%n_vars)) allocate(vars_infos%varid(vars_infos%n_vars)) allocate(vars_infos%split(vars_infos%n_vars)) end if ! get the main_id and the group_id for all variables. do i = 1, my_vars_infos%n_vars, 1 call etsf_io_data_get(group_id, var_id, & & split_id, my_vars_infos%parent(i)%name) select case (group_id) case (etsf_grp_geometry) etsf_variables%geometry = ior(etsf_variables%geometry, var_id) case (etsf_grp_electrons) etsf_variables%electrons = ior(etsf_variables%electrons, var_id) case (etsf_grp_kpoints) etsf_variables%kpoints = ior(etsf_variables%kpoints, var_id) case (etsf_grp_basisdata) etsf_variables%basisdata = ior(etsf_variables%basisdata, var_id) case (etsf_grp_gwdata) etsf_variables%gwdata = ior(etsf_variables%gwdata, var_id) case (etsf_grp_dielectric) etsf_variables%dielectric = ior(etsf_variables%dielectric, var_id) case (etsf_grp_main) etsf_variables%main = ior(etsf_variables%main, var_id) end select etsf_groups = ior(etsf_groups, group_id) if (present(vars_infos)) then ! Update vars_infos arrays. vars_infos%group(i) = group_id vars_infos%varid(i) = var_id vars_infos%split(i) = split_id end if end do end if if (present(vars_infos)) then ! Associate vars_infos%parent to the one computed in my_vars_infos. vars_infos%parent => my_vars_infos%parent else if (associated(my_vars_infos%parent)) then call etsf_io_low_free_all_var_infos(my_vars_infos%parent) end if ! Close file call etsf_io_low_close(ncid, lstat, error_data = error_data) if (.not. lstat) call etsf_io_low_error_update(error_data, my_name) !DEBUG !write (*,*) 'etsf_io_data_contents : exit' !ENDDEBUG end subroutine etsf_io_data_contents !!*** etsf_io-1.0.3/src/group_level/etsf_io_data_get.f900000644000353400050630000002520411354150413017001 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_io_data_group/etsf_io_data_get !! NAME !! etsf_io_data_get !! !! FUNCTION !! This is a query routine to get informations about a variable when its name !! is given. It does not interact with any files and is just a Firtran version of !! the specifications. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * varname = !! the name of a variable, to know if it is part of ETSF or not. !! OUTPUT !! * etsf_group = !! this integer is a flag corresponding to the group in which the given !! @varname is defined. !! * etsf_variable = !! * etsf_split = !! this logical is .true. if @varname is a valid split name. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_data_get(etsf_group, etsf_variable, etsf_split, varname) !Arguments ------------------------------------ integer, intent(out) :: etsf_group integer, intent(out) :: etsf_variable logical, intent(out) :: etsf_split character(len=*), intent(in) :: varname !Local variables------------------------------- character(len=*),parameter :: my_name = 'etsf_io_data_get' integer :: ncid, i ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_data_get : enter' !ENDDEBUG etsf_group = etsf_grp_none etsf_variable = 0 etsf_split = .false. if (trim(varname) == "gw_corrections") then etsf_group = etsf_grp_gwdata etsf_variable = etsf_gwdata_gw_corrections else if (trim(varname) == "kb_formfactor_sign") then etsf_group = etsf_grp_gwdata etsf_variable = etsf_gwdata_kb_coeff_sig else if (trim(varname) == "kb_formfactors") then etsf_group = etsf_grp_gwdata etsf_variable = etsf_gwdata_kb_coeff else if (trim(varname) == "kb_formfactor_derivative") then etsf_group = etsf_grp_gwdata etsf_variable = etsf_gwdata_kb_coeff_der else if (trim(varname) == "space_group") then etsf_group = etsf_grp_geometry etsf_variable = etsf_geometry_space_group else if (trim(varname) == "primitive_vectors") then etsf_group = etsf_grp_geometry etsf_variable = etsf_geometry_primitive_vectors else if (trim(varname) == "reduced_symmetry_matrices") then etsf_group = etsf_grp_geometry etsf_variable = etsf_geometry_red_sym_matrices else if (trim(varname) == "reduced_symmetry_translations") then etsf_group = etsf_grp_geometry etsf_variable = etsf_geometry_red_sym_trans else if (trim(varname) == "atom_species") then etsf_group = etsf_grp_geometry etsf_variable = etsf_geometry_atom_species else if (trim(varname) == "reduced_atom_positions") then etsf_group = etsf_grp_geometry etsf_variable = etsf_geometry_red_at_pos else if (trim(varname) == "valence_charges") then etsf_group = etsf_grp_geometry etsf_variable = etsf_geometry_valence_charges else if (trim(varname) == "atomic_numbers") then etsf_group = etsf_grp_geometry etsf_variable = etsf_geometry_atomic_numbers else if (trim(varname) == "atom_species_names") then etsf_group = etsf_grp_geometry etsf_variable = etsf_geometry_atom_species_names else if (trim(varname) == "chemical_symbols") then etsf_group = etsf_grp_geometry etsf_variable = etsf_geometry_chemical_symbols else if (trim(varname) == "pseudopotential_types") then etsf_group = etsf_grp_geometry etsf_variable = etsf_geometry_pseudo_types else if (trim(varname) == "kpoint_grid_shift") then etsf_group = etsf_grp_kpoints etsf_variable = etsf_kpoints_kpoint_grid_shift else if (trim(varname) == "kpoint_grid_vectors") then etsf_group = etsf_grp_kpoints etsf_variable = etsf_kpoints_kpoint_grid_vectors else if (trim(varname) == "monkhorst_pack_folding") then etsf_group = etsf_grp_kpoints etsf_variable = etsf_kpoints_mp_folding else if (trim(varname) == "reduced_coordinates_of_kpoints") then etsf_group = etsf_grp_kpoints etsf_variable = etsf_kpoints_red_coord_kpt else if (trim(varname) == "kpoint_weights") then etsf_group = etsf_grp_kpoints etsf_variable = etsf_kpoints_kpoint_weights else if (trim(varname) == "basis_set") then etsf_group = etsf_grp_basisdata etsf_variable = etsf_basisdata_basis_set else if (trim(varname) == "kinetic_energy_cutoff") then etsf_group = etsf_grp_basisdata etsf_variable = etsf_basisdata_kin_cutoff else if (trim(varname) == "number_of_coefficients") then etsf_group = etsf_grp_basisdata etsf_variable = etsf_basisdata_n_coeff else if (trim(varname) == "reduced_coordinates_of_plane_waves") then etsf_group = etsf_grp_basisdata etsf_variable = etsf_basisdata_red_coord_pw else if (trim(varname) == "coordinates_of_basis_grid_points") then etsf_group = etsf_grp_basisdata etsf_variable = etsf_basisdata_coord_grid else if (trim(varname) == "number_of_coefficients_per_grid_point") then etsf_group = etsf_grp_basisdata etsf_variable = etsf_basisdata_n_coeff_grid else if (trim(varname) == "number_of_electrons") then etsf_group = etsf_grp_electrons etsf_variable = etsf_electrons_number_of_electrons else if (trim(varname) == "exchange_functional") then etsf_group = etsf_grp_electrons etsf_variable = etsf_electrons_x_functional else if (trim(varname) == "correlation_functional") then etsf_group = etsf_grp_electrons etsf_variable = etsf_electrons_c_functional else if (trim(varname) == "fermi_energy") then etsf_group = etsf_grp_electrons etsf_variable = etsf_electrons_fermi_energy else if (trim(varname) == "smearing_scheme") then etsf_group = etsf_grp_electrons etsf_variable = etsf_electrons_smearing_scheme else if (trim(varname) == "smearing_width") then etsf_group = etsf_grp_electrons etsf_variable = etsf_electrons_smearing_width else if (trim(varname) == "number_of_states") then etsf_group = etsf_grp_electrons etsf_variable = etsf_electrons_number_of_states else if (trim(varname) == "eigenvalues") then etsf_group = etsf_grp_electrons etsf_variable = etsf_electrons_eigenvalues else if (trim(varname) == "occupations") then etsf_group = etsf_grp_electrons etsf_variable = etsf_electrons_occupations else if (trim(varname) == "density") then etsf_group = etsf_grp_main etsf_variable = etsf_main_density else if (trim(varname) == "exchange_potential") then etsf_group = etsf_grp_main etsf_variable = etsf_main_pot_x_only else if (trim(varname) == "correlation_potential") then etsf_group = etsf_grp_main etsf_variable = etsf_main_pot_c_only else if (trim(varname) == "exchange_correlation_potential") then etsf_group = etsf_grp_main etsf_variable = etsf_main_pot_xc else if (trim(varname) == "coefficients_of_wavefunctions") then etsf_group = etsf_grp_main etsf_variable = etsf_main_wfs_coeff else if (trim(varname) == "real_space_wavefunctions") then etsf_group = etsf_grp_main etsf_variable = etsf_main_wfs_rsp else if (trim(varname) == "frequencies_dielectric_function") then etsf_group = etsf_grp_dielectric etsf_variable = etsf_dielectric_frequencies else if (trim(varname) == "qpoints_dielectric_function") then etsf_group = etsf_grp_dielectric etsf_variable = etsf_dielectric_qpt else if (trim(varname) == "qpoints_gamma_limit") then etsf_group = etsf_grp_dielectric etsf_variable = etsf_dielectric_qpt_g_lim else if (trim(varname) == "dielectric_function") then etsf_group = etsf_grp_dielectric etsf_variable = etsf_dielectric_function else if (trim(varname) == "dielectric_function_head") then etsf_group = etsf_grp_dielectric etsf_variable = etsf_dielectric_function_head else if (trim(varname) == "dielectric_function_lower_wing") then etsf_group = etsf_grp_dielectric etsf_variable = etsf_dielectric_function_lower else if (trim(varname) == "dielectric_function_upper_wing") then etsf_group = etsf_grp_dielectric etsf_variable = etsf_dielectric_function_upper else if (trim(varname) == "inverse_dielectric_function") then etsf_group = etsf_grp_dielectric etsf_variable = etsf_dielectric_function_inv else if (trim(varname) == "inverse_dielectric_function_head") then etsf_group = etsf_grp_dielectric etsf_variable = etsf_dielectric_function_inv_head else if (trim(varname) == "inverse_dielectric_function_lower_wing") then etsf_group = etsf_grp_dielectric etsf_variable = etsf_dielectric_function_inv_lower else if (trim(varname) == "inverse_dielectric_function_upper_wing") then etsf_group = etsf_grp_dielectric etsf_variable = etsf_dielectric_function_inv_upper else if (trim(varname) == "polarizability") then etsf_group = etsf_grp_dielectric etsf_variable = etsf_dielectric_polarizability else if (trim(varname) == "polarizability_head") then etsf_group = etsf_grp_dielectric etsf_variable = etsf_dielectric_pol_head else if (trim(varname) == "polarizability_lower_wing") then etsf_group = etsf_grp_dielectric etsf_variable = etsf_dielectric_pol_lower else if (trim(varname) == "polarizability_upper_wing") then etsf_group = etsf_grp_dielectric etsf_variable = etsf_dielectric_pol_upper else if (trim(varname) == "inverse_polarizability") then etsf_group = etsf_grp_dielectric etsf_variable = etsf_dielectric_polarizability_inv else if (trim(varname) == "inverse_polarizability_head") then etsf_group = etsf_grp_dielectric etsf_variable = etsf_dielectric_pol_inv_head else if (trim(varname) == "inverse_polarizability_lower_wing") then etsf_group = etsf_grp_dielectric etsf_variable = etsf_dielectric_pol_inv_lower else if (trim(varname) == "inverse_polarizability_upper_wing") then etsf_group = etsf_grp_dielectric etsf_variable = etsf_dielectric_pol_inv_upper else if (trim(varname) == "my_kpoints") then etsf_split = .true. else if (trim(varname) == "my_grid_points_vector3") then etsf_split = .true. else if (trim(varname) == "my_spins") then etsf_split = .true. else if (trim(varname) == "my_grid_points_vector1") then etsf_split = .true. else if (trim(varname) == "my_grid_points_vector2") then etsf_split = .true. else if (trim(varname) == "my_coefficients") then etsf_split = .true. else if (trim(varname) == "my_components") then etsf_split = .true. else if (trim(varname) == "my_states") then etsf_split = .true. end if !DEBUG !write (*,*) 'etsf_io_data_get : exit' !ENDDEBUG end subroutine etsf_io_data_get !!*** etsf_io-1.0.3/src/group_level/etsf_io_data_copy.f900000644000353400050630000001315511354150413017176 00000000000000!{\src2tex{textfont=tt}} !!****m* etsf_io_data_group/etsf_io_data_copy !! NAME !! etsf_io_data_copy !! !! FUNCTION !! High-level routine that copy all ETSF variables from one file to another. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * dest_file = !! the path to the file to be written. !! * source_file = !! A path to the file from which copy the ETSF variables. !! * dims = !! these dimensions correspond to the source_file ones and are used to allocate !! temporary arrays in memory during the copy. !! * split = (optional) !! if this argument is given, the values in the split definition (e.g. my_kpoints) !! are used to put the data in the destination file in a bigger array at the right !! placed. !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! !! NOTES !! This file has been automatically generated by the autogen_subroutines.py !! script. Any change you would bring to it will systematically be !! overwritten. !! !! SOURCE subroutine etsf_io_data_copy(dest_file, source_file, dims, lstat, error_data, & & split) !Arguments ------------------------------------ character(len=*), intent(in) :: dest_file character(len=*), intent(in) :: source_file type(etsf_dims), intent(in) :: dims logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data type(etsf_split), optional, intent(in) :: split !Local variables------------------------------- character(len=*),parameter :: my_name = 'etsf_io_data_copy' integer :: ncid, i type(etsf_split) :: my_split integer :: ncid_to ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_data_copy : enter' !ENDDEBUG lstat = .false. ! Open destination file for writing call etsf_io_low_open_modify(ncid_to, trim(dest_file), & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if ! Open source file for reading call etsf_io_low_open_read(ncid, trim(source_file), & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if ! We copy all the global attributes (ETSF and non-ETSF). call etsf_io_low_copy_all_att(ncid, ncid_to, etsf_io_low_global_att, etsf_io_low_global_att, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if ! We switch to write mode. call etsf_io_low_set_write_mode(ncid_to, lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if if (present(split)) then call etsf_io_gwdata_copy(ncid_to, ncid, dims, & & lstat, error_data, split) else call etsf_io_gwdata_copy(ncid_to, ncid, dims, & & lstat, error_data) end if if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if if (present(split)) then call etsf_io_geometry_copy(ncid_to, ncid, dims, & & lstat, error_data, split) else call etsf_io_geometry_copy(ncid_to, ncid, dims, & & lstat, error_data) end if if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if if (present(split)) then call etsf_io_kpoints_copy(ncid_to, ncid, dims, & & lstat, error_data, split) else call etsf_io_kpoints_copy(ncid_to, ncid, dims, & & lstat, error_data) end if if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if if (present(split)) then call etsf_io_basisdata_copy(ncid_to, ncid, dims, & & lstat, error_data, split) else call etsf_io_basisdata_copy(ncid_to, ncid, dims, & & lstat, error_data) end if if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if if (present(split)) then call etsf_io_electrons_copy(ncid_to, ncid, dims, & & lstat, error_data, split) else call etsf_io_electrons_copy(ncid_to, ncid, dims, & & lstat, error_data) end if if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if if (present(split)) then call etsf_io_main_copy(ncid_to, ncid, dims, & & lstat, error_data, split) else call etsf_io_main_copy(ncid_to, ncid, dims, & & lstat, error_data) end if if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if if (present(split)) then call etsf_io_dielectric_copy(ncid_to, ncid, dims, & & lstat, error_data, split) else call etsf_io_dielectric_copy(ncid_to, ncid, dims, & & lstat, error_data) end if if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if !Close files. call etsf_io_low_close(ncid_to, lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if call etsf_io_low_close(ncid, lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, my_name) return end if !DEBUG !write (*,*) 'etsf_io_data_copy : exit' !ENDDEBUG end subroutine etsf_io_data_copy !!*** etsf_io-1.0.3/src/utils/0000777000353400050620000000000011354151524012102 500000000000000etsf_io-1.0.3/src/utils/Makefile.am0000644000353400050630000000253311354150413014052 00000000000000vpath %.a $(top_builddir)/src/group_level bin_PROGRAMS = etsf_io lib_LIBRARIES = libetsf_io_utils.a EXTRA_DIST = \ etsf_io_file_check_dielectric_function_data.f90 \ etsf_io_file_check_wavefunctions_data.f90 \ etsf_io_file_check_scalar_field_data.f90 \ etsf_io_file_check_crystallographic_data.f90 \ etsf_io_file_contents.f90 \ etsf_io_file_private.f90 \ etsf_io_file_public.f90 if CAPITALIZE module_DATA = ETSF_IO_FILE.@MODULE_EXT@ ETSF_IO_TOOLS.@MODULE_EXT@ else module_DATA = etsf_io_file.@MODULE_EXT@ etsf_io_tools.@MODULE_EXT@ endif AM_FCFLAGS = -I$(top_builddir)/src/low_level -I$(top_builddir)/src/group_level -I@NETCDF_CFLAGS@ libetsf_io_utils_a_SOURCES = etsf_io_file.f90 \ etsf_io_tools.f90 etsf_io_SOURCES = etsf_io.f90 etsf_io_LDFLAGS = -L$(top_builddir)/src/group_level -L. etsf_io_LDADD = -letsf_io_utils -letsf_io #dependencies etsf_io_file.o: libetsf_io.a \ etsf_io_file_check_dielectric_function_data.f90 \ etsf_io_file_check_wavefunctions_data.f90 \ etsf_io_file_check_scalar_field_data.f90 \ etsf_io_file_check_crystallographic_data.f90 \ etsf_io_file_contents.f90 \ etsf_io_file_private.f90 \ etsf_io_file_public.f90 etsf_io_tools.o: libetsf_io.a etsf_io.o: libetsf_io_utils.a ETSF_IO_FILE.@MODULE_EXT@ etsf_io_file.@MODULE_EXT@: \ etsf_io_file.o ETSF_IO_TOOLS.@MODULE_EXT@ etsf_io_tools.@MODULE_EXT@: \ etsf_io_tools.o etsf_io-1.0.3/src/utils/Makefile.in0000644000353400050620000003710211354150420014060 00000000000000# Makefile.in generated by automake 1.10.1 from Makefile.am. # @configure_input@ # Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, # 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. # This Makefile.in is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY, to the extent permitted by law; without # even the implied warranty of MERCHANTABILITY or FITNESS FOR A # PARTICULAR PURPOSE. @SET_MAKE@ VPATH = @srcdir@ pkgdatadir = $(datadir)/@PACKAGE@ pkglibdir = $(libdir)/@PACKAGE@ pkgincludedir = $(includedir)/@PACKAGE@ am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd install_sh_DATA = $(install_sh) -c -m 644 install_sh_PROGRAM = $(install_sh) -c install_sh_SCRIPT = $(install_sh) -c INSTALL_HEADER = $(INSTALL_DATA) transform = $(program_transform_name) NORMAL_INSTALL = : PRE_INSTALL = : POST_INSTALL = : NORMAL_UNINSTALL = : PRE_UNINSTALL = : POST_UNINSTALL = : bin_PROGRAMS = etsf_io$(EXEEXT) subdir = src/utils DIST_COMMON = $(srcdir)/Makefile.am $(srcdir)/Makefile.in ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 am__aclocal_m4_deps = $(top_srcdir)/config/m4/fortran.m4 \ $(top_srcdir)/configure.ac am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ $(ACLOCAL_M4) mkinstalldirs = $(install_sh) -d CONFIG_CLEAN_FILES = am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; am__vpath_adj = case $$p in \ $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \ *) f=$$p;; \ esac; am__strip_dir = `echo $$p | sed -e 's|^.*/||'`; am__installdirs = "$(DESTDIR)$(libdir)" "$(DESTDIR)$(bindir)" \ "$(DESTDIR)$(moduledir)" libLIBRARIES_INSTALL = $(INSTALL_DATA) LIBRARIES = $(lib_LIBRARIES) ARFLAGS = cru libetsf_io_utils_a_AR = $(AR) $(ARFLAGS) libetsf_io_utils_a_LIBADD = am_libetsf_io_utils_a_OBJECTS = etsf_io_file.$(OBJEXT) \ etsf_io_tools.$(OBJEXT) libetsf_io_utils_a_OBJECTS = $(am_libetsf_io_utils_a_OBJECTS) binPROGRAMS_INSTALL = $(INSTALL_PROGRAM) PROGRAMS = $(bin_PROGRAMS) am_etsf_io_OBJECTS = etsf_io.$(OBJEXT) etsf_io_OBJECTS = $(am_etsf_io_OBJECTS) etsf_io_DEPENDENCIES = etsf_io_LINK = $(FCLD) $(AM_FCFLAGS) $(FCFLAGS) $(etsf_io_LDFLAGS) \ $(LDFLAGS) -o $@ DEFAULT_INCLUDES = -I.@am__isrc@ FCCOMPILE = $(FC) $(AM_FCFLAGS) $(FCFLAGS) FCLD = $(FC) FCLINK = $(FCLD) $(AM_FCFLAGS) $(FCFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o \ $@ SOURCES = $(libetsf_io_utils_a_SOURCES) $(etsf_io_SOURCES) DIST_SOURCES = $(libetsf_io_utils_a_SOURCES) $(etsf_io_SOURCES) moduleDATA_INSTALL = $(INSTALL_DATA) DATA = $(module_DATA) ETAGS = etags CTAGS = ctags DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) ACLOCAL = @ACLOCAL@ AMTAR = @AMTAR@ AR = @AR@ AUTOCONF = @AUTOCONF@ AUTOHEADER = @AUTOHEADER@ AUTOMAKE = @AUTOMAKE@ AWK = @AWK@ CYGPATH_W = @CYGPATH_W@ DEFS = @DEFS@ ECHO_C = @ECHO_C@ ECHO_N = @ECHO_N@ ECHO_T = @ECHO_T@ EXEEXT = @EXEEXT@ FC = @FC@ FCFLAGS = @FCFLAGS@ FCFLAGS_f90 = @FCFLAGS_f90@ FFLAGS = @FFLAGS@ INSTALL = @INSTALL@ INSTALL_DATA = @INSTALL_DATA@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ INSTALL_SCRIPT = @INSTALL_SCRIPT@ INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ LDFLAGS = @LDFLAGS@ LIBOBJS = @LIBOBJS@ LIBS = @LIBS@ LTLIBOBJS = @LTLIBOBJS@ MAKEINFO = @MAKEINFO@ MKDIR_P = @MKDIR_P@ MODULE_EXT = @MODULE_EXT@ NETCDF_CFLAGS = @NETCDF_CFLAGS@ OBJEXT = @OBJEXT@ PACKAGE = @PACKAGE@ PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ PACKAGE_NAME = @PACKAGE_NAME@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_VERSION = @PACKAGE_VERSION@ PATH_SEPARATOR = @PATH_SEPARATOR@ RANLIB = @RANLIB@ SET_MAKE = @SET_MAKE@ SHELL = @SHELL@ STRIP = @STRIP@ VERSION = @VERSION@ abs_builddir = @abs_builddir@ abs_srcdir = @abs_srcdir@ abs_top_builddir = @abs_top_builddir@ abs_top_srcdir = @abs_top_srcdir@ ac_ct_FC = @ac_ct_FC@ am__leading_dot = @am__leading_dot@ am__tar = @am__tar@ am__untar = @am__untar@ bindir = @bindir@ build_alias = @build_alias@ builddir = @builddir@ datadir = @datadir@ datarootdir = @datarootdir@ docdir = @docdir@ dvidir = @dvidir@ exec_prefix = @exec_prefix@ fc_type = @fc_type@ fc_version = @fc_version@ fc_wrap = @fc_wrap@ groupleveldocdir = @groupleveldocdir@ host_alias = @host_alias@ htmldir = @htmldir@ includedir = @includedir@ infodir = @infodir@ install_sh = @install_sh@ libdir = @libdir@ libexecdir = @libexecdir@ localedir = @localedir@ localstatedir = @localstatedir@ lowleveldocdir = @lowleveldocdir@ mandir = @mandir@ mkdir_p = @mkdir_p@ moduledir = @moduledir@ oldincludedir = @oldincludedir@ pdfdir = @pdfdir@ prefix = @prefix@ program_transform_name = @program_transform_name@ psdir = @psdir@ sbindir = @sbindir@ sharedstatedir = @sharedstatedir@ srcdir = @srcdir@ sysconfdir = @sysconfdir@ target_alias = @target_alias@ top_builddir = @top_builddir@ top_srcdir = @top_srcdir@ tutorialsdocdir = @tutorialsdocdir@ utilsdocdir = @utilsdocdir@ lib_LIBRARIES = libetsf_io_utils.a EXTRA_DIST = \ etsf_io_file_check_dielectric_function_data.f90 \ etsf_io_file_check_wavefunctions_data.f90 \ etsf_io_file_check_scalar_field_data.f90 \ etsf_io_file_check_crystallographic_data.f90 \ etsf_io_file_contents.f90 \ etsf_io_file_private.f90 \ etsf_io_file_public.f90 @CAPITALIZE_FALSE@module_DATA = etsf_io_file.@MODULE_EXT@ etsf_io_tools.@MODULE_EXT@ @CAPITALIZE_TRUE@module_DATA = ETSF_IO_FILE.@MODULE_EXT@ ETSF_IO_TOOLS.@MODULE_EXT@ AM_FCFLAGS = -I$(top_builddir)/src/low_level -I$(top_builddir)/src/group_level -I@NETCDF_CFLAGS@ libetsf_io_utils_a_SOURCES = etsf_io_file.f90 \ etsf_io_tools.f90 etsf_io_SOURCES = etsf_io.f90 etsf_io_LDFLAGS = -L$(top_builddir)/src/group_level -L. etsf_io_LDADD = -letsf_io_utils -letsf_io all: all-am .SUFFIXES: .SUFFIXES: .f90 .o .obj $(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) @for dep in $?; do \ case '$(am__configure_deps)' in \ *$$dep*) \ cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh \ && exit 0; \ exit 1;; \ esac; \ done; \ echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu src/utils/Makefile'; \ cd $(top_srcdir) && \ $(AUTOMAKE) --gnu src/utils/Makefile .PRECIOUS: Makefile Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status @case '$?' in \ *config.status*) \ cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ *) \ echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ esac; $(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh $(top_srcdir)/configure: $(am__configure_deps) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh $(ACLOCAL_M4): $(am__aclocal_m4_deps) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh install-libLIBRARIES: $(lib_LIBRARIES) @$(NORMAL_INSTALL) test -z "$(libdir)" || $(MKDIR_P) "$(DESTDIR)$(libdir)" @list='$(lib_LIBRARIES)'; for p in $$list; do \ if test -f $$p; then \ f=$(am__strip_dir) \ echo " $(libLIBRARIES_INSTALL) '$$p' '$(DESTDIR)$(libdir)/$$f'"; \ $(libLIBRARIES_INSTALL) "$$p" "$(DESTDIR)$(libdir)/$$f"; \ else :; fi; \ done @$(POST_INSTALL) @list='$(lib_LIBRARIES)'; for p in $$list; do \ if test -f $$p; then \ p=$(am__strip_dir) \ echo " $(RANLIB) '$(DESTDIR)$(libdir)/$$p'"; \ $(RANLIB) "$(DESTDIR)$(libdir)/$$p"; \ else :; fi; \ done uninstall-libLIBRARIES: @$(NORMAL_UNINSTALL) @list='$(lib_LIBRARIES)'; for p in $$list; do \ p=$(am__strip_dir) \ echo " rm -f '$(DESTDIR)$(libdir)/$$p'"; \ rm -f "$(DESTDIR)$(libdir)/$$p"; \ done clean-libLIBRARIES: -test -z "$(lib_LIBRARIES)" || rm -f $(lib_LIBRARIES) libetsf_io_utils.a: $(libetsf_io_utils_a_OBJECTS) $(libetsf_io_utils_a_DEPENDENCIES) -rm -f libetsf_io_utils.a $(libetsf_io_utils_a_AR) libetsf_io_utils.a $(libetsf_io_utils_a_OBJECTS) $(libetsf_io_utils_a_LIBADD) $(RANLIB) libetsf_io_utils.a install-binPROGRAMS: $(bin_PROGRAMS) @$(NORMAL_INSTALL) test -z "$(bindir)" || $(MKDIR_P) "$(DESTDIR)$(bindir)" @list='$(bin_PROGRAMS)'; for p in $$list; do \ p1=`echo $$p|sed 's/$(EXEEXT)$$//'`; \ if test -f $$p \ ; then \ f=`echo "$$p1" | sed 's,^.*/,,;$(transform);s/$$/$(EXEEXT)/'`; \ echo " $(INSTALL_PROGRAM_ENV) $(binPROGRAMS_INSTALL) '$$p' '$(DESTDIR)$(bindir)/$$f'"; \ $(INSTALL_PROGRAM_ENV) $(binPROGRAMS_INSTALL) "$$p" "$(DESTDIR)$(bindir)/$$f" || exit 1; \ else :; fi; \ done uninstall-binPROGRAMS: @$(NORMAL_UNINSTALL) @list='$(bin_PROGRAMS)'; for p in $$list; do \ f=`echo "$$p" | sed 's,^.*/,,;s/$(EXEEXT)$$//;$(transform);s/$$/$(EXEEXT)/'`; \ echo " rm -f '$(DESTDIR)$(bindir)/$$f'"; \ rm -f "$(DESTDIR)$(bindir)/$$f"; \ done clean-binPROGRAMS: -test -z "$(bin_PROGRAMS)" || rm -f $(bin_PROGRAMS) etsf_io$(EXEEXT): $(etsf_io_OBJECTS) $(etsf_io_DEPENDENCIES) @rm -f etsf_io$(EXEEXT) $(etsf_io_LINK) $(etsf_io_OBJECTS) $(etsf_io_LDADD) $(LIBS) mostlyclean-compile: -rm -f *.$(OBJEXT) distclean-compile: -rm -f *.tab.c .f90.o: $(FCCOMPILE) -c -o $@ $< .f90.obj: $(FCCOMPILE) -c -o $@ `$(CYGPATH_W) '$<'` install-moduleDATA: $(module_DATA) @$(NORMAL_INSTALL) test -z "$(moduledir)" || $(MKDIR_P) "$(DESTDIR)$(moduledir)" @list='$(module_DATA)'; for p in $$list; do \ if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ f=$(am__strip_dir) \ echo " $(moduleDATA_INSTALL) '$$d$$p' '$(DESTDIR)$(moduledir)/$$f'"; \ $(moduleDATA_INSTALL) "$$d$$p" "$(DESTDIR)$(moduledir)/$$f"; \ done uninstall-moduleDATA: @$(NORMAL_UNINSTALL) @list='$(module_DATA)'; for p in $$list; do \ f=$(am__strip_dir) \ echo " rm -f '$(DESTDIR)$(moduledir)/$$f'"; \ rm -f "$(DESTDIR)$(moduledir)/$$f"; \ done ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES) list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ unique=`for i in $$list; do \ if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ done | \ $(AWK) '{ files[$$0] = 1; nonemtpy = 1; } \ END { if (nonempty) { for (i in files) print i; }; }'`; \ mkid -fID $$unique tags: TAGS TAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \ $(TAGS_FILES) $(LISP) tags=; \ here=`pwd`; \ list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ unique=`for i in $$list; do \ if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ done | \ $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ END { if (nonempty) { for (i in files) print i; }; }'`; \ if test -z "$(ETAGS_ARGS)$$tags$$unique"; then :; else \ test -n "$$unique" || unique=$$empty_fix; \ $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ $$tags $$unique; \ fi ctags: CTAGS CTAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \ $(TAGS_FILES) $(LISP) tags=; \ list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ unique=`for i in $$list; do \ if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ done | \ $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ END { if (nonempty) { for (i in files) print i; }; }'`; \ test -z "$(CTAGS_ARGS)$$tags$$unique" \ || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ $$tags $$unique GTAGS: here=`$(am__cd) $(top_builddir) && pwd` \ && cd $(top_srcdir) \ && gtags -i $(GTAGS_ARGS) $$here distclean-tags: -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags distdir: $(DISTFILES) @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ list='$(DISTFILES)'; \ dist_files=`for file in $$list; do echo $$file; done | \ sed -e "s|^$$srcdirstrip/||;t" \ -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ case $$dist_files in \ */*) $(MKDIR_P) `echo "$$dist_files" | \ sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ sort -u` ;; \ esac; \ for file in $$dist_files; do \ if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ if test -d $$d/$$file; then \ dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ cp -pR $(srcdir)/$$file $(distdir)$$dir || exit 1; \ fi; \ cp -pR $$d/$$file $(distdir)$$dir || exit 1; \ else \ test -f $(distdir)/$$file \ || cp -p $$d/$$file $(distdir)/$$file \ || exit 1; \ fi; \ done check-am: all-am check: check-am all-am: Makefile $(LIBRARIES) $(PROGRAMS) $(DATA) installdirs: for dir in "$(DESTDIR)$(libdir)" "$(DESTDIR)$(bindir)" "$(DESTDIR)$(moduledir)"; do \ test -z "$$dir" || $(MKDIR_P) "$$dir"; \ done install: install-am install-exec: install-exec-am install-data: install-data-am uninstall: uninstall-am install-am: all-am @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am installcheck: installcheck-am install-strip: $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ `test -z '$(STRIP)' || \ echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install mostlyclean-generic: clean-generic: distclean-generic: -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) maintainer-clean-generic: @echo "This command is intended for maintainers to use" @echo "it deletes files that may require special tools to rebuild." clean: clean-am clean-am: clean-binPROGRAMS clean-generic clean-libLIBRARIES \ mostlyclean-am distclean: distclean-am -rm -f Makefile distclean-am: clean-am distclean-compile distclean-generic \ distclean-tags dvi: dvi-am dvi-am: html: html-am info: info-am info-am: install-data-am: install-moduleDATA install-dvi: install-dvi-am install-exec-am: install-binPROGRAMS install-libLIBRARIES install-html: install-html-am install-info: install-info-am install-man: install-pdf: install-pdf-am install-ps: install-ps-am installcheck-am: maintainer-clean: maintainer-clean-am -rm -f Makefile maintainer-clean-am: distclean-am maintainer-clean-generic mostlyclean: mostlyclean-am mostlyclean-am: mostlyclean-compile mostlyclean-generic pdf: pdf-am pdf-am: ps: ps-am ps-am: uninstall-am: uninstall-binPROGRAMS uninstall-libLIBRARIES \ uninstall-moduleDATA .MAKE: install-am install-strip .PHONY: CTAGS GTAGS all all-am check check-am clean clean-binPROGRAMS \ clean-generic clean-libLIBRARIES ctags distclean \ distclean-compile distclean-generic distclean-tags distdir dvi \ dvi-am html html-am info info-am install install-am \ install-binPROGRAMS install-data install-data-am install-dvi \ install-dvi-am install-exec install-exec-am install-html \ install-html-am install-info install-info-am \ install-libLIBRARIES install-man install-moduleDATA \ install-pdf install-pdf-am install-ps install-ps-am \ install-strip installcheck installcheck-am installdirs \ maintainer-clean maintainer-clean-generic mostlyclean \ mostlyclean-compile mostlyclean-generic pdf pdf-am ps ps-am \ tags uninstall uninstall-am uninstall-binPROGRAMS \ uninstall-libLIBRARIES uninstall-moduleDATA vpath %.a $(top_builddir)/src/group_level #dependencies etsf_io_file.o: libetsf_io.a \ etsf_io_file_check_dielectric_function_data.f90 \ etsf_io_file_check_wavefunctions_data.f90 \ etsf_io_file_check_scalar_field_data.f90 \ etsf_io_file_check_crystallographic_data.f90 \ etsf_io_file_contents.f90 \ etsf_io_file_private.f90 \ etsf_io_file_public.f90 etsf_io_tools.o: libetsf_io.a etsf_io.o: libetsf_io_utils.a ETSF_IO_FILE.@MODULE_EXT@ etsf_io_file.@MODULE_EXT@: \ etsf_io_file.o ETSF_IO_TOOLS.@MODULE_EXT@ etsf_io_tools.@MODULE_EXT@: \ etsf_io_tools.o # Tell versions [3.59,3.63) of GNU make to not export all variables. # Otherwise a system limit (for SysV at least) may be exceeded. .NOEXPORT: etsf_io-1.0.3/src/utils/etsf_io_file.f900000644000353400050630000000461611354150413014771 00000000000000!!****h* utils/etsf_io_file !! NAME !! etsf_io_file !! !! FUNCTION !! This module contains different high level routines to access ETSF files. It !! actually contains: !! * etsf_io_file_merge(): a routine to read several files and merge their data !! into a single output file. !! * etsf_io_file_contents(): a routine to read a file and get what specifications !! this file is matching (cristallographic data, !! potential...). !! * etsf_io_file_check(): a routine to validate a file against one or several !! specifications. !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! NOTES !! This file has been automatically generated by the autogen_utils.py !! script. Any change you would bring to it will systematically be !! overwritten. !!*** module etsf_io_file use etsf_io_low_level use etsf_io implicit none private !* This type is a private type to store informations about a file. !* These informations are the dims values, the split definitions and !* the list of variable definitions. type file_infos_type !* The path to the file. character(len = 256) :: path !* The ETSF dimensions of the file (including names and values). type(etsf_dims) :: dims !* The ETSF split definitions for the file (allocated arrays). type(etsf_split) :: split !* The comprehensive list of variables of the file (with !* their dimension definitions, names...). type(etsf_vars) :: var_list end type file_infos_type public :: etsf_io_file_merge public :: etsf_io_file_check public :: etsf_io_file_contents public :: etsf_io_file_check_dielectric_function_data public :: etsf_io_file_check_wavefunctions_data public :: etsf_io_file_check_scalar_field_data public :: etsf_io_file_check_crystallographic_data contains include "etsf_io_file_contents.f90" include "etsf_io_file_check_dielectric_function_data.f90" include "etsf_io_file_check_wavefunctions_data.f90" include "etsf_io_file_check_scalar_field_data.f90" include "etsf_io_file_check_crystallographic_data.f90" include "etsf_io_file_private.f90" include "etsf_io_file_public.f90" end module etsf_io_file etsf_io-1.0.3/src/utils/etsf_io_tools.f900000644000353400050630000003231110642663220015207 00000000000000!!****h* utils/etsf_io_tools !! NAME !! etsf_io_tools !! !! FUNCTION !! This module contains different non mandatory routines to handle internals !! from ETSF files. It actually contains: !! * etsf_io_tools_get_atom_names(): a routine to read the three variables defining !! atoms and returning names informations as !! defined in the specifications. !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !!*** module etsf_io_tools use etsf_io_low_level use etsf_io implicit none private public :: etsf_io_tools_get_atom_names public :: etsf_io_tools_set_time_reversal_symmetry public :: etsf_io_tools_get_time_reversal_symmetry contains !!****m* etsf_io_tools/etsf_io_tools_get_atom_names !! NAME !! etsf_io_tools_get_atom_names !! !! FUNCTION !! In the specifications, atom names can be read from these three variables: !! atomic_numbers, atom_species_names and chemical_symbols. The first listed !! variable is prefered. This routine is a convenient way to access to atom !! names directly, following specifications preferences. !! !! The output argument @atom_numbers is set if the NetCDF variable 'atomic_numbers' !! is present, and @atom_names contains 'atom_species_names' or 'chemical_symbols' !! if present or a string equivalent to 'atomic_numbers' if not. Then a string !! representation is always available. !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = !! an opened NetCDF file with read access. !! !! OUTPUT !! * atom_names = an allocated array to store the atom names (indexed by species). !! * lstat = !! return .true. if all the actions succeed. !! * error_data = !! contains the details of the error is @lstat is false. !! * atom_numbers = a pointer to store the atomic numbers, it will be !! associated only if 'atomic_numbers' variable is present. !! !! SOURCE subroutine etsf_io_tools_get_atom_names(ncid, atom_names, lstat, error_data, & & atom_numbers) integer, intent(in) :: ncid character(len = etsf_charlen), intent(out) :: atom_names(:) logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data double precision, pointer, optional :: atom_numbers(:) ! Local variables character(len = *), parameter :: me = "etsf_io_tools_get_atom_names" logical :: valid double precision, pointer :: my_atom_numbers(:) character(len=etsf_chemlen), allocatable :: symbols(:) integer :: number_of_atom_species, i if (present(atom_numbers)) then atom_numbers => null() end if ! Read the array dimension. call etsf_io_low_read_dim(ncid, "number_of_atom_species", & & number_of_atom_species, lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, me) return end if ! Check that argument size matches number_of_atoms. if (size(atom_names) /= number_of_atom_species) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ARG, me, & & tgtname = "atom_names", errmess = "wrong argument size.") lstat = .false. return end if valid = .false. allocate(my_atom_numbers(number_of_atom_species)) call etsf_io_low_read_var(ncid, "atomic_numbers", & & my_atom_numbers, lstat, error_data = error_data) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then ! Case where variable is found but has problems. deallocate(my_atom_numbers) call etsf_io_low_error_update(error_data, me) return end if if (lstat) then ! Ok, we have the informations we were looking for. ! But we will try for better string description than figures. do i = 1, number_of_atom_species, 1 write(atom_names(i), "(F6.2)") my_atom_numbers(i) end do if (present(atom_numbers)) then atom_numbers => my_atom_numbers else deallocate(my_atom_numbers) end if valid = .true. else deallocate(my_atom_numbers) end if ! 'atomic_numbers' was not found, try to fall back to 'atom_species_names' call etsf_io_low_read_var(ncid, "atom_species_names", & & atom_names, etsf_charlen, lstat, error_data = error_data) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then ! Case where variable is found but has problems. call etsf_io_low_error_update(error_data, me) return end if if (lstat) then ! Ok, we have the informations we were looking for. ! But we check that given values are not void. valid = .true. do i = 1, number_of_atom_species, 1 call strip(atom_names(i)) valid = valid .and. (trim(atom_names(i)) /= "") end do if (valid) return end if ! 'atomic_numbers' was not found, try to fall back to 'atom_species_names' allocate(symbols(number_of_atom_species)) call etsf_io_low_read_var(ncid, "chemical_symbols", & & symbols, etsf_chemlen, lstat, error_data = error_data) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then ! Case where variable is found but has problems. deallocate(symbols) call etsf_io_low_error_update(error_data, me) return end if if (lstat) then ! Ok, we have the informations we were looking for. do i = 1, number_of_atom_species, 1 call strip(symbols(i)) write(atom_names(i), "(A)") symbols(i) end do deallocate(symbols) return end if deallocate(symbols) ! If nthing has worked, we raise an error. if (.not. lstat .and. .not. valid) then call etsf_io_low_error_set(error_data, ERROR_MODE_INQ, ERROR_TYPE_VAR, me, & & tgtname = "atomic_numbers, atom_species_names, chemical_symbols", & & errmess = "no variable exists, can't get atom names.") end if end subroutine etsf_io_tools_get_atom_names !!*** !!****m* etsf_io_tools/etsf_io_tools_get_time_reversal_symmetry !! NAME !! etsf_io_tools_get_time_reversal_symmetry !! !! FUNCTION !! In the specifications, an attribute can be set to describe if !! the basis set informations have been reduced using the time reversal symmetry !! at Gamma point in the case of plane wave basis sets. This routine poll the given !! file, check that the basis set is plane waves and check that the attribute is set !! coherently between variables. !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = an opened NetCDF file with read access. !! !! OUTPUT !! * symmetry = .false. if the symmetry is not used. !! * lstat = !! return .true. if all the actions succeed (especially checks). !! * error_data = !! contains the details of the error is @lstat is false. !! !! SOURCE subroutine etsf_io_tools_get_time_reversal_symmetry(ncid, symmetry, & & lstat, error_data) integer, intent(in) :: ncid logical, intent(out) :: lstat, symmetry type(etsf_io_low_error), intent(out) :: error_data ! Local variables character(len = *), parameter :: me = "etsf_io_tools_get_time_reversal_symmetry" character(len = etsf_charlen) :: basis, att1, att2 ! Read the basis set definition. call etsf_io_low_read_var(ncid, "basis_set", & & basis, etsf_charlen, lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, me) return end if call strip(basis) ! Check that basis set is indeed plane waves. if (trim(basis) /= "plane_waves") then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ATT, me, & & tgtname = "basis_set", & & errmess = "time reversal is only associated to plane wave basis sets.") lstat = .false. return end if ! Read the two attributes for reduced_coordinates_of_plane_waves and ! coefficients_of_wavefunctions. call etsf_io_low_read_att(ncid, "reduced_coordinates_of_plane_waves", & & "use_time_reversal_at_gamma", etsf_charlen, att1, lstat, & & error_data = error_data) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ .and. & & error_data%target_type_id /= ERROR_TYPE_ATT) then call etsf_io_low_error_update(error_data, me) return else if (.not.lstat) write(att1, "(A)") "no" end if call etsf_io_low_read_att(ncid, "coefficients_of_wavefunctions", & & "use_time_reversal_at_gamma", etsf_charlen, att2, lstat, & & error_data = error_data) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ .and. & & error_data%target_type_id /= ERROR_TYPE_ATT) then call etsf_io_low_error_update(error_data, me) return else if (.not.lstat) write(att2, "(A)") "no" end if ! Check the consistency of the values. if (.not.(att1(1:1) == "n" .and. att2(1:1) == "n") .and. & & .not.(att1(1:2) == "y" .and. att2(1:1) == "y")) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ATT, me, & & tgtname = "use_time_reversal_at_gamma", & & errmess = "attributes use_time_reversal_at_gamma have wrong values.") lstat = .false. return end if ! Everything is OK, we return. symmetry = (att1(1:1) == "y") lstat =.true. end subroutine etsf_io_tools_get_time_reversal_symmetry !!*** !!****m* etsf_io_tools/etsf_io_tools_set_time_reversal_symmetry !! NAME !! etsf_io_tools_set_time_reversal_symmetry !! !! FUNCTION !! In the specifications, an attribute can be set to describe if !! the basis set informations have been reduced using the time reversal symmetry !! at Gamma point in the case of plane wave basis sets. This routine set the given !! value and check that the basis set is plane waves. !! !! The file will be put in define mode. !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = an opened NetCDF file with write access. !! * symmetry = the symmetry status. !! !! OUTPUT !! * lstat = !! return .true. if all the actions succeed (especially checks). !! * error_data = !! contains the details of the error is @lstat is false. !! !! SOURCE subroutine etsf_io_tools_set_time_reversal_symmetry(ncid, symmetry, & & lstat, error_data) integer, intent(in) :: ncid logical, intent(in) :: symmetry logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data ! Local variables character(len = *), parameter :: me = "etsf_io_tools_set_time_reversal_symmetry" character(len = etsf_charlen) :: basis, att ! Read the basis set definition. call etsf_io_low_read_var(ncid, "basis_set", & & basis, etsf_charlen, lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, me) return end if call strip(basis) ! Check that basis set is indeed plane waves. if (trim(basis) /= "plane_waves") then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ATT, me, & & tgtname = "basis_set", & & errmess = "time reversal is only associated to plane wave basis sets.") lstat = .false. return end if ! We switch to define mode. call etsf_io_low_set_define_mode(ncid, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, me) return end if ! Write the two attributes for reduced_coordinates_of_plane_waves and ! coefficients_of_wavefunctions. if (symmetry) then write(att, "(A)") "yes" else write(att, "(A)") "no" end if call etsf_io_low_write_att(ncid, "reduced_coordinates_of_plane_waves", & & "use_time_reversal_at_gamma", att, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, me) return end if call etsf_io_low_write_att(ncid, "coefficients_of_wavefunctions", & & "use_time_reversal_at_gamma", att, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, me) return end if ! Everything is OK, we return. lstat =.true. end subroutine etsf_io_tools_set_time_reversal_symmetry !!*** end module etsf_io_tools etsf_io-1.0.3/src/utils/etsf_io.f900000644000353400050630000002013210654570236013774 00000000000000program etsf_io_ploumploum use etsf_io_low_level use etsf_io use etsf_io_file implicit none integer :: nArg, iargc, i_arg character(len = 256) :: opt_value logical :: lstat type(etsf_io_low_error) :: error integer :: read_flags, check_flags, i, j type(etsf_io_low_error) :: errors(etsf_nspecs_data) character(len = 80) :: action = "" ! Variables used for the merge action logical :: get_help = .false. integer :: n_input_args = 0 character(len = 256) :: input_args(256) integer :: n_input_files = 0 character(len = 256) :: input_files(256) character(len = 256) :: output_file = "" logical :: get_specs_list = .false. integer :: n_input_flags = 0 character(len = 256) :: input_flags(256) nArg = iargc() i_arg = 1 do if (get_option("a", "action", opt_value, i_arg)) then action = opt_value(1:80) else if (get_option("i", "input-file", opt_value, i_arg)) then n_input_files = n_input_files + 1 input_files(n_input_files) = opt_value else if (get_option("o", "output-file", opt_value, i_arg)) then output_file = opt_value else if (get_option("l", "list", opt_value, i_arg, .false.)) then get_specs_list = .true. else if (get_option("f", "flag", opt_value, i_arg)) then n_input_flags = n_input_flags + 1 input_flags(n_input_flags) = opt_value else if (get_option("h", "help", opt_value, i_arg, .false.)) then get_help = .true. else ! This should be the end of option. call getarg(i_arg, opt_value) if (opt_value(1:2) == "-") then write(*, "(A)") "Error: unknown option or argument '", trim(opt_value), "'" call usage() stop 1 else ! Store remaining argments in an array. n_input_args = 0 do call getarg(i_arg, opt_value) n_input_args = n_input_args + 1 write(input_args(n_input_args), "(A)") adjustl(opt_value) i_arg = i_arg + 1 if (i_arg > narg) then exit end if end do end if end if i_arg = i_arg + 1 if (i_arg > narg) then exit end if end do if (get_help) then call usage() stop end if if (trim(action) == "merge") then if (n_input_files < 2) then write(*, "(A)") "Error: not enough input files for action merge." call usage() stop end if if (trim(output_file) == "") then write(*, "(A)") "Error: no output file for action merge." call usage() stop end if ! write(*,*) "output file: ", trim(output_file) call etsf_io_file_merge(output_file, input_files(1:n_input_files), & & lstat, error) if (.not. lstat) then call etsf_io_low_error_handle(error) stop end if else if (trim(action) == "content") then if (n_input_args /= 1) then write(*, "(A)") "Error: exactly one arguments is required for action content." call usage() stop end if write(*,"(3A)") "Analyse file '", trim(input_args(1)), "'" call etsf_io_file_contents(read_flags, errors, trim(input_args(1)), & & lstat, error) if (.not. lstat) then call etsf_io_low_error_handle(error) stop end if do i = 1, etsf_nspecs_data, 1 if (iand(read_flags, 2 ** (i - 1)) /= 0) then write(*,"(3A)") " - Ok - ", trim(etsf_specs_names(i)), "." else write(*,"(3A)") " - No - ", trim(etsf_specs_names(i)), "." write(*,"(4A)") " given reason, '", trim(errors(i)%target_name), & & "' -> ", trim(errors(i)%error_message) end if end do else if (trim(action) == "check") then if (get_specs_list) then write(*,"(A)") "Available flags for specification checkings:" do i = 1, etsf_nspecs_data, 1 write(*,"(A)") trim(etsf_specs_names(i)) end do stop 1 end if if (n_input_flags < 1) then write(*, "(A)") "Error: not enough flags for action check." call usage() stop 1 end if if (n_input_args /= 1) then write(*, "(A)") "Error: exactly one arguments is required for action check." call usage() stop 1 end if check_flags = 0 do j = 1, n_input_args, 1 do i = 1, etsf_nspecs_data, 1 if (trim(etsf_specs_names(i)) == trim(input_flags(j))) then check_flags = check_flags + 2 ** (i - 1) exit end if end do end do call etsf_io_file_check(trim(input_args(1)), check_flags, lstat, error) if (.not. lstat) then call etsf_io_low_error_handle(error) stop 1 end if else write(*, "(A)") "Error: missing or unknown action, use -a option." call usage() stop 1 end if contains function get_option(code, name, value, i_arg, with_value) implicit none character(len = 1), intent(in) :: code character(len = *), intent(in) :: name character(len = 256), intent(out) :: value integer, intent(inout) :: i_arg logical, intent(in), optional :: with_value logical :: get_option, my_with_value character(len = 256) :: arg_value integer :: start call getarg(i_arg, arg_value) if (arg_value(1:2) == "-"//code) then start = 3 get_option = .true. else if (arg_value(1:len(name) + 2) == "--"//name) then start = len(name) + 3 get_option = .true. else get_option = .false. end if if (present(with_value)) then my_with_value = with_value else my_with_value = .true. end if if (get_option .and. my_with_value) then if (arg_value(start:start) /= " ") then if (arg_value(start:start) == "=") then value = arg_value(start + 1:256) else value = arg_value(start:256) end if else i_arg = i_arg + 1 call getarg(i_arg, arg_value) value = adjustl(arg_value) end if end if end function get_option subroutine usage() write(*, "(A)") "" write(*, "(A)") "Usage: etsf_io [-h | -a action] [[-i file]...] [[-f flag]...]" write(*, "(A)") " [-o file] [arguments]" write(*, "(A)") "" write(*, "(A)") " Handle ETSF files, see --action option." write(*, "(A)") "-h --help : show this little help." write(*, "(A)") "-a --action value : give the action to perform." write(*, "(A)") " Possible action may be:" write(*, "(A)") " * 'merge' to gather several files that" write(*, "(A)") " have been splitted." write(*, "(A)") " * 'content' to get the name of" write(*, "(A)") " specifications the file matches." write(*, "(A)") " * 'check' to check the validity of" write(*, "(A)") " the file against specifications." write(*, "(A)") "-o --output-file file : give the path to the output ETSF file." write(*, "(A)") "-i --input-file file : give the path for an input file. This" write(*, "(A)") " option can be used one or several times." write(*, "(A)") "-l --list : when action is check, it give the list" write(*, "(A)") " of available flags." write(*, "(A)") "-f --flag value : give a flag name (get valid names from" write(*, "(A)") " -l option)." write(*, "(A)") "" write(*, "(A)") " Examples:" write(*, "(A)") "Merge three files, etsf_io -a merge -i file1.nc -i file2.nc" write(*, "(A)") " -i file3.nc -o output.nc" write(*, "(A)") "" write(*, "(A)") "Get the contents of file test.nc, etsf_io -a content test.nc" write(*, "(A)") "" write(*, "(A)") "Get the list of flags for validity checks, etsf_io -a check -l" write(*, "(A)") "" write(*, "(A)") "Checks with two flags, etsf_io -a check -f flag1 -f flag2 test.nc" end subroutine usage end program etsf_io_ploumploum etsf_io-1.0.3/src/utils/etsf_io_file_check_dielectric_function_data.f900000644000353400050620000004721711354150413023216 00000000000000!! NOTES !! This file has been automatically generated by the @SCRIPT@ !! script. Any change you would bring to it will systematically be !! overwritten. See the template file in config/etsf/template.utils_check. !!****m* etsf_io_file/etsf_io_file_check_dielectric_function_data !! NAME !! etsf_io_file_check_dielectric_function_data !! !! FUNCTION !! This is a high level routine to inquire a file about a specifications. !! It returns .true. in lstat if the file is a valid 'dielectric_function_data' file. !! It tests the existence of variables and their definition (type, shape. !! and dimension names). !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = !! an identificator of an opened ETSF file (use etsf_io_low_open_read() !! for instance). !! OUTPUT !! * lstat = !! return .true. if the file matches requirement of 'dielectric_function_data'. !! * error_data = !! contains the details of the error is @lstat is false. !! !! SOURCE subroutine etsf_io_file_check_dielectric_function_data(ncid, lstat, error_data) integer, intent(in) :: ncid logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data character(len = *), parameter :: me = "etsf_io_file_check_dielectric_function_data" type(etsf_io_low_var_infos) :: var_infos logical :: valid character(len = etsf_charlen) :: string_value type(etsf_dims) :: dims type(etsf_split) :: split ! Read the dimensions call etsf_io_dims_get(ncid, dims, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, me) return end if ! Allocate the split and read it (this will verify variable exist. call etsf_io_split_allocate(split, dims) call etsf_io_split_get(ncid, split, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, me) return end if ! Variable basis_set write(var_infos%name, "(A)") "basis_set" var_infos%nctype = etsf_io_low_character var_infos%ncshape = 1 allocate(var_infos%ncdimnames(1)) write(var_infos%ncdimnames(1), "(A)") "character_string_length" call test_var(ncid, var_infos, lstat, error_data) deallocate(var_infos%ncdimnames) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if ! Variable frequencies_dielectric_function write(var_infos%name, "(A)") "frequencies_dielectric_function" var_infos%nctype = etsf_io_low_double var_infos%ncshape = 2 allocate(var_infos%ncdimnames(2)) write(var_infos%ncdimnames(2), "(A)") "number_of_frequencies_dielectric_function" write(var_infos%ncdimnames(1), "(A)") "complex" call test_var(ncid, var_infos, lstat, error_data) deallocate(var_infos%ncdimnames) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if ! Variable qpoints_dielectric_function write(var_infos%name, "(A)") "qpoints_dielectric_function" var_infos%nctype = etsf_io_low_double var_infos%ncshape = 2 allocate(var_infos%ncdimnames(2)) write(var_infos%ncdimnames(2), "(A)") "number_of_qpoints_dielectric_function" write(var_infos%ncdimnames(1), "(A)") "number_of_reduced_dimensions" call test_var(ncid, var_infos, lstat, error_data) deallocate(var_infos%ncdimnames) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if ! Variable qpoints_gamma_limit write(var_infos%name, "(A)") "qpoints_gamma_limit" var_infos%nctype = etsf_io_low_double var_infos%ncshape = 2 allocate(var_infos%ncdimnames(2)) write(var_infos%ncdimnames(2), "(A)") "number_of_qpoints_gamma_limit" write(var_infos%ncdimnames(1), "(A)") "number_of_reduced_dimensions" call test_var(ncid, var_infos, lstat, error_data) deallocate(var_infos%ncdimnames) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if ! Variable reduced_coordinates_of_plane_waves_dielectric_function write(var_infos%name, "(A)") "reduced_coordinates_of_plane_waves_dielectric_function" var_infos%nctype = etsf_io_low_integer var_infos%ncshape = 3 allocate(var_infos%ncdimnames(3)) write(var_infos%ncdimnames(3), "(A)") "number_of_qpoints_dielectric_function" write(var_infos%ncdimnames(2), "(A)") "number_of_coefficients_dielectric_function" write(var_infos%ncdimnames(1), "(A)") "number_of_reduced_dimensions" call test_var(ncid, var_infos, lstat, error_data) deallocate(var_infos%ncdimnames) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if ! Check from a list. lstat = .false. ! Variable dielectric_function write(var_infos%name, "(A)") "dielectric_function" var_infos%nctype = etsf_io_low_double var_infos%ncshape = 7 allocate(var_infos%ncdimnames(7)) write(var_infos%ncdimnames(7), "(A)") "number_of_frequencies_dielectric_function" write(var_infos%ncdimnames(6), "(A)") "number_of_qpoints_dielectric_function" if (associated(split%my_spins)) then write(var_infos%ncdimnames(5), "(A)") "my_number_of_spins" else write(var_infos%ncdimnames(5), "(A)") "number_of_spins" end if if (associated(split%my_spins)) then write(var_infos%ncdimnames(4), "(A)") "my_number_of_spins" else write(var_infos%ncdimnames(4), "(A)") "number_of_spins" end if write(var_infos%ncdimnames(3), "(A)") "number_of_coefficients_dielectric_function" write(var_infos%ncdimnames(2), "(A)") "number_of_coefficients_dielectric_function" write(var_infos%ncdimnames(1), "(A)") "complex" call test_var(ncid, var_infos, valid, error_data) deallocate(var_infos%ncdimnames) if (.not. valid .and. error_data%access_mode_id == ERROR_MODE_SPEC) return lstat = lstat .or. valid ! Variable inverse_dielectric_function write(var_infos%name, "(A)") "inverse_dielectric_function" var_infos%nctype = etsf_io_low_double var_infos%ncshape = 7 allocate(var_infos%ncdimnames(7)) write(var_infos%ncdimnames(7), "(A)") "number_of_frequencies_dielectric_function" write(var_infos%ncdimnames(6), "(A)") "number_of_qpoints_dielectric_function" if (associated(split%my_spins)) then write(var_infos%ncdimnames(5), "(A)") "my_number_of_spins" else write(var_infos%ncdimnames(5), "(A)") "number_of_spins" end if if (associated(split%my_spins)) then write(var_infos%ncdimnames(4), "(A)") "my_number_of_spins" else write(var_infos%ncdimnames(4), "(A)") "number_of_spins" end if write(var_infos%ncdimnames(3), "(A)") "number_of_coefficients_dielectric_function" write(var_infos%ncdimnames(2), "(A)") "number_of_coefficients_dielectric_function" write(var_infos%ncdimnames(1), "(A)") "complex" call test_var(ncid, var_infos, valid, error_data) deallocate(var_infos%ncdimnames) if (.not. valid .and. error_data%access_mode_id == ERROR_MODE_SPEC) return lstat = lstat .or. valid ! Variable polarizability write(var_infos%name, "(A)") "polarizability" var_infos%nctype = etsf_io_low_double var_infos%ncshape = 7 allocate(var_infos%ncdimnames(7)) write(var_infos%ncdimnames(7), "(A)") "number_of_frequencies_dielectric_function" write(var_infos%ncdimnames(6), "(A)") "number_of_qpoints_dielectric_function" if (associated(split%my_spins)) then write(var_infos%ncdimnames(5), "(A)") "my_number_of_spins" else write(var_infos%ncdimnames(5), "(A)") "number_of_spins" end if if (associated(split%my_spins)) then write(var_infos%ncdimnames(4), "(A)") "my_number_of_spins" else write(var_infos%ncdimnames(4), "(A)") "number_of_spins" end if write(var_infos%ncdimnames(3), "(A)") "number_of_coefficients_dielectric_function" write(var_infos%ncdimnames(2), "(A)") "number_of_coefficients_dielectric_function" write(var_infos%ncdimnames(1), "(A)") "complex" call test_var(ncid, var_infos, valid, error_data) deallocate(var_infos%ncdimnames) if (.not. valid .and. error_data%access_mode_id == ERROR_MODE_SPEC) return lstat = lstat .or. valid ! Variable inverse_polarizability write(var_infos%name, "(A)") "inverse_polarizability" var_infos%nctype = etsf_io_low_double var_infos%ncshape = 7 allocate(var_infos%ncdimnames(7)) write(var_infos%ncdimnames(7), "(A)") "number_of_frequencies_dielectric_function" write(var_infos%ncdimnames(6), "(A)") "number_of_qpoints_dielectric_function" if (associated(split%my_spins)) then write(var_infos%ncdimnames(5), "(A)") "my_number_of_spins" else write(var_infos%ncdimnames(5), "(A)") "number_of_spins" end if if (associated(split%my_spins)) then write(var_infos%ncdimnames(4), "(A)") "my_number_of_spins" else write(var_infos%ncdimnames(4), "(A)") "number_of_spins" end if write(var_infos%ncdimnames(3), "(A)") "number_of_coefficients_dielectric_function" write(var_infos%ncdimnames(2), "(A)") "number_of_coefficients_dielectric_function" write(var_infos%ncdimnames(1), "(A)") "complex" call test_var(ncid, var_infos, valid, error_data) deallocate(var_infos%ncdimnames) if (.not. valid .and. error_data%access_mode_id == ERROR_MODE_SPEC) return lstat = lstat .or. valid if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_ARG, me, & & tgtname = "dielectric_function, inverse_dielectric_function, polarizability, inverse_...", & & errmess = "missing one among the list.") return end if ! Check a list of conditions if a variable is set. ! Test the existence of a variable. lstat = .false. call etsf_io_low_read_var_infos(ncid, "dielectric_function", var_infos, & & lstat, error_data = error_data) if (lstat) then ! Apply the conditions since variable exists. ! Variable dielectric_function_head write(var_infos%name, "(A)") "dielectric_function_head" var_infos%nctype = etsf_io_low_double var_infos%ncshape = 5 allocate(var_infos%ncdimnames(5)) write(var_infos%ncdimnames(5), "(A)") "number_of_frequencies_dielectric_function" write(var_infos%ncdimnames(4), "(A)") "number_of_qpoints_dielectric_function" if (associated(split%my_spins)) then write(var_infos%ncdimnames(3), "(A)") "my_number_of_spins" else write(var_infos%ncdimnames(3), "(A)") "number_of_spins" end if if (associated(split%my_spins)) then write(var_infos%ncdimnames(2), "(A)") "my_number_of_spins" else write(var_infos%ncdimnames(2), "(A)") "number_of_spins" end if write(var_infos%ncdimnames(1), "(A)") "complex" call test_var(ncid, var_infos, lstat, error_data) deallocate(var_infos%ncdimnames) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if ! Variable dielectric_function_upper_wing write(var_infos%name, "(A)") "dielectric_function_upper_wing" var_infos%nctype = etsf_io_low_double var_infos%ncshape = 6 allocate(var_infos%ncdimnames(6)) write(var_infos%ncdimnames(6), "(A)") "number_of_frequencies_dielectric_function" write(var_infos%ncdimnames(5), "(A)") "number_of_qpoints_gamma_limit" if (associated(split%my_spins)) then write(var_infos%ncdimnames(4), "(A)") "my_number_of_spins" else write(var_infos%ncdimnames(4), "(A)") "number_of_spins" end if if (associated(split%my_spins)) then write(var_infos%ncdimnames(3), "(A)") "my_number_of_spins" else write(var_infos%ncdimnames(3), "(A)") "number_of_spins" end if write(var_infos%ncdimnames(2), "(A)") "number_of_coefficients_dielectric_function" write(var_infos%ncdimnames(1), "(A)") "complex" call test_var(ncid, var_infos, lstat, error_data) deallocate(var_infos%ncdimnames) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if end if ! Check a list of conditions if a variable is set. ! Test the existence of a variable. lstat = .false. call etsf_io_low_read_var_infos(ncid, "inverse_dielectric_function", var_infos, & & lstat, error_data = error_data) if (lstat) then ! Apply the conditions since variable exists. ! Variable inverse_dielectric_function_head write(var_infos%name, "(A)") "inverse_dielectric_function_head" var_infos%nctype = etsf_io_low_double var_infos%ncshape = 5 allocate(var_infos%ncdimnames(5)) write(var_infos%ncdimnames(5), "(A)") "number_of_frequencies_dielectric_function" write(var_infos%ncdimnames(4), "(A)") "number_of_qpoints_dielectric_function" if (associated(split%my_spins)) then write(var_infos%ncdimnames(3), "(A)") "my_number_of_spins" else write(var_infos%ncdimnames(3), "(A)") "number_of_spins" end if if (associated(split%my_spins)) then write(var_infos%ncdimnames(2), "(A)") "my_number_of_spins" else write(var_infos%ncdimnames(2), "(A)") "number_of_spins" end if write(var_infos%ncdimnames(1), "(A)") "complex" call test_var(ncid, var_infos, lstat, error_data) deallocate(var_infos%ncdimnames) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if ! Variable inverse_dielectric_function_upper_wing write(var_infos%name, "(A)") "inverse_dielectric_function_upper_wing" var_infos%nctype = etsf_io_low_double var_infos%ncshape = 6 allocate(var_infos%ncdimnames(6)) write(var_infos%ncdimnames(6), "(A)") "number_of_frequencies_dielectric_function" write(var_infos%ncdimnames(5), "(A)") "number_of_qpoints_gamma_limit" if (associated(split%my_spins)) then write(var_infos%ncdimnames(4), "(A)") "my_number_of_spins" else write(var_infos%ncdimnames(4), "(A)") "number_of_spins" end if if (associated(split%my_spins)) then write(var_infos%ncdimnames(3), "(A)") "my_number_of_spins" else write(var_infos%ncdimnames(3), "(A)") "number_of_spins" end if write(var_infos%ncdimnames(2), "(A)") "number_of_coefficients_dielectric_function" write(var_infos%ncdimnames(1), "(A)") "complex" call test_var(ncid, var_infos, lstat, error_data) deallocate(var_infos%ncdimnames) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if end if ! Check a list of conditions if a variable is set. ! Test the existence of a variable. lstat = .false. call etsf_io_low_read_var_infos(ncid, "polarizability", var_infos, & & lstat, error_data = error_data) if (lstat) then ! Apply the conditions since variable exists. ! Variable polarizability_head write(var_infos%name, "(A)") "polarizability_head" var_infos%nctype = etsf_io_low_double var_infos%ncshape = 5 allocate(var_infos%ncdimnames(5)) write(var_infos%ncdimnames(5), "(A)") "number_of_frequencies_dielectric_function" write(var_infos%ncdimnames(4), "(A)") "number_of_qpoints_dielectric_function" if (associated(split%my_spins)) then write(var_infos%ncdimnames(3), "(A)") "my_number_of_spins" else write(var_infos%ncdimnames(3), "(A)") "number_of_spins" end if if (associated(split%my_spins)) then write(var_infos%ncdimnames(2), "(A)") "my_number_of_spins" else write(var_infos%ncdimnames(2), "(A)") "number_of_spins" end if write(var_infos%ncdimnames(1), "(A)") "complex" call test_var(ncid, var_infos, lstat, error_data) deallocate(var_infos%ncdimnames) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if ! Variable polarizability_upper_wing write(var_infos%name, "(A)") "polarizability_upper_wing" var_infos%nctype = etsf_io_low_double var_infos%ncshape = 6 allocate(var_infos%ncdimnames(6)) write(var_infos%ncdimnames(6), "(A)") "number_of_frequencies_dielectric_function" write(var_infos%ncdimnames(5), "(A)") "number_of_qpoints_gamma_limit" if (associated(split%my_spins)) then write(var_infos%ncdimnames(4), "(A)") "my_number_of_spins" else write(var_infos%ncdimnames(4), "(A)") "number_of_spins" end if if (associated(split%my_spins)) then write(var_infos%ncdimnames(3), "(A)") "my_number_of_spins" else write(var_infos%ncdimnames(3), "(A)") "number_of_spins" end if write(var_infos%ncdimnames(2), "(A)") "number_of_coefficients_dielectric_function" write(var_infos%ncdimnames(1), "(A)") "complex" call test_var(ncid, var_infos, lstat, error_data) deallocate(var_infos%ncdimnames) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if end if ! Check a list of conditions if a variable is set. ! Test the existence of a variable. lstat = .false. call etsf_io_low_read_var_infos(ncid, "inverse_polarizability", var_infos, & & lstat, error_data = error_data) if (lstat) then ! Apply the conditions since variable exists. ! Variable inverse_polarizability_head write(var_infos%name, "(A)") "inverse_polarizability_head" var_infos%nctype = etsf_io_low_double var_infos%ncshape = 5 allocate(var_infos%ncdimnames(5)) write(var_infos%ncdimnames(5), "(A)") "number_of_frequencies_dielectric_function" write(var_infos%ncdimnames(4), "(A)") "number_of_qpoints_dielectric_function" if (associated(split%my_spins)) then write(var_infos%ncdimnames(3), "(A)") "my_number_of_spins" else write(var_infos%ncdimnames(3), "(A)") "number_of_spins" end if if (associated(split%my_spins)) then write(var_infos%ncdimnames(2), "(A)") "my_number_of_spins" else write(var_infos%ncdimnames(2), "(A)") "number_of_spins" end if write(var_infos%ncdimnames(1), "(A)") "complex" call test_var(ncid, var_infos, lstat, error_data) deallocate(var_infos%ncdimnames) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if ! Variable inverse_polarizability_upper_wing write(var_infos%name, "(A)") "inverse_polarizability_upper_wing" var_infos%nctype = etsf_io_low_double var_infos%ncshape = 6 allocate(var_infos%ncdimnames(6)) write(var_infos%ncdimnames(6), "(A)") "number_of_frequencies_dielectric_function" write(var_infos%ncdimnames(5), "(A)") "number_of_qpoints_gamma_limit" if (associated(split%my_spins)) then write(var_infos%ncdimnames(4), "(A)") "my_number_of_spins" else write(var_infos%ncdimnames(4), "(A)") "number_of_spins" end if if (associated(split%my_spins)) then write(var_infos%ncdimnames(3), "(A)") "my_number_of_spins" else write(var_infos%ncdimnames(3), "(A)") "number_of_spins" end if write(var_infos%ncdimnames(2), "(A)") "number_of_coefficients_dielectric_function" write(var_infos%ncdimnames(1), "(A)") "complex" call test_var(ncid, var_infos, lstat, error_data) deallocate(var_infos%ncdimnames) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if end if ! Deallocate the split data. call etsf_io_split_free(split) lstat = .true. end subroutine etsf_io_file_check_dielectric_function_data !!*** etsf_io-1.0.3/src/utils/etsf_io_file_check_wavefunctions_data.f900000644000353400050630000004053311354150413022070 00000000000000!! NOTES !! This file has been automatically generated by the @SCRIPT@ !! script. Any change you would bring to it will systematically be !! overwritten. See the template file in config/etsf/template.utils_check. !!****m* etsf_io_file/etsf_io_file_check_wavefunctions_data !! NAME !! etsf_io_file_check_wavefunctions_data !! !! FUNCTION !! This is a high level routine to inquire a file about a specifications. !! It returns .true. in lstat if the file is a valid 'wavefunctions_data' file. !! It tests the existence of variables and their definition (type, shape. !! and dimension names). !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = !! an identificator of an opened ETSF file (use etsf_io_low_open_read() !! for instance). !! OUTPUT !! * lstat = !! return .true. if the file matches requirement of 'wavefunctions_data'. !! * error_data = !! contains the details of the error is @lstat is false. !! !! SOURCE subroutine etsf_io_file_check_wavefunctions_data(ncid, lstat, error_data) integer, intent(in) :: ncid logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data character(len = *), parameter :: me = "etsf_io_file_check_wavefunctions_data" type(etsf_io_low_var_infos) :: var_infos logical :: valid character(len = etsf_charlen) :: string_value type(etsf_dims) :: dims type(etsf_split) :: split ! Read the dimensions call etsf_io_dims_get(ncid, dims, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, me) return end if ! Allocate the split and read it (this will verify variable exist. call etsf_io_split_allocate(split, dims) call etsf_io_split_get(ncid, split, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, me) return end if ! Variable primitive_vectors write(var_infos%name, "(A)") "primitive_vectors" var_infos%nctype = etsf_io_low_double var_infos%ncshape = 2 allocate(var_infos%ncdimnames(2)) write(var_infos%ncdimnames(2), "(A)") "number_of_vectors" write(var_infos%ncdimnames(1), "(A)") "number_of_cartesian_directions" call test_var(ncid, var_infos, lstat, error_data) deallocate(var_infos%ncdimnames) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if ! Variable reduced_symmetry_matrices write(var_infos%name, "(A)") "reduced_symmetry_matrices" var_infos%nctype = etsf_io_low_integer var_infos%ncshape = 3 allocate(var_infos%ncdimnames(3)) write(var_infos%ncdimnames(3), "(A)") "number_of_symmetry_operations" write(var_infos%ncdimnames(2), "(A)") "number_of_reduced_dimensions" write(var_infos%ncdimnames(1), "(A)") "number_of_reduced_dimensions" call test_var(ncid, var_infos, lstat, error_data) deallocate(var_infos%ncdimnames) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if ! Variable reduced_symmetry_translations write(var_infos%name, "(A)") "reduced_symmetry_translations" var_infos%nctype = etsf_io_low_double var_infos%ncshape = 2 allocate(var_infos%ncdimnames(2)) write(var_infos%ncdimnames(2), "(A)") "number_of_symmetry_operations" write(var_infos%ncdimnames(1), "(A)") "number_of_reduced_dimensions" call test_var(ncid, var_infos, lstat, error_data) deallocate(var_infos%ncdimnames) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if ! Variable reduced_coordinates_of_kpoints write(var_infos%name, "(A)") "reduced_coordinates_of_kpoints" var_infos%nctype = etsf_io_low_double var_infos%ncshape = 2 allocate(var_infos%ncdimnames(2)) if (associated(split%my_kpoints)) then write(var_infos%ncdimnames(2), "(A)") "my_number_of_kpoints" else write(var_infos%ncdimnames(2), "(A)") "number_of_kpoints" end if write(var_infos%ncdimnames(1), "(A)") "number_of_reduced_dimensions" call test_var(ncid, var_infos, lstat, error_data) deallocate(var_infos%ncdimnames) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if ! Variable kpoint_weights write(var_infos%name, "(A)") "kpoint_weights" var_infos%nctype = etsf_io_low_double var_infos%ncshape = 1 allocate(var_infos%ncdimnames(1)) if (associated(split%my_kpoints)) then write(var_infos%ncdimnames(1), "(A)") "my_number_of_kpoints" else write(var_infos%ncdimnames(1), "(A)") "number_of_kpoints" end if call test_var(ncid, var_infos, lstat, error_data) deallocate(var_infos%ncdimnames) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if ! Variable number_of_states write(var_infos%name, "(A)") "number_of_states" var_infos%nctype = etsf_io_low_integer var_infos%ncshape = 2 allocate(var_infos%ncdimnames(2)) if (associated(split%my_spins)) then write(var_infos%ncdimnames(2), "(A)") "my_number_of_spins" else write(var_infos%ncdimnames(2), "(A)") "number_of_spins" end if if (associated(split%my_kpoints)) then write(var_infos%ncdimnames(1), "(A)") "my_number_of_kpoints" else write(var_infos%ncdimnames(1), "(A)") "number_of_kpoints" end if call test_var(ncid, var_infos, lstat, error_data) deallocate(var_infos%ncdimnames) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if ! Variable eigenvalues write(var_infos%name, "(A)") "eigenvalues" var_infos%nctype = etsf_io_low_double var_infos%ncshape = 3 allocate(var_infos%ncdimnames(3)) if (associated(split%my_spins)) then write(var_infos%ncdimnames(3), "(A)") "my_number_of_spins" else write(var_infos%ncdimnames(3), "(A)") "number_of_spins" end if if (associated(split%my_kpoints)) then write(var_infos%ncdimnames(2), "(A)") "my_number_of_kpoints" else write(var_infos%ncdimnames(2), "(A)") "number_of_kpoints" end if if (associated(split%my_states)) then write(var_infos%ncdimnames(1), "(A)") "my_max_number_of_states" else write(var_infos%ncdimnames(1), "(A)") "max_number_of_states" end if call test_var(ncid, var_infos, lstat, error_data) deallocate(var_infos%ncdimnames) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if ! Variable occupations write(var_infos%name, "(A)") "occupations" var_infos%nctype = etsf_io_low_double var_infos%ncshape = 3 allocate(var_infos%ncdimnames(3)) if (associated(split%my_spins)) then write(var_infos%ncdimnames(3), "(A)") "my_number_of_spins" else write(var_infos%ncdimnames(3), "(A)") "number_of_spins" end if if (associated(split%my_kpoints)) then write(var_infos%ncdimnames(2), "(A)") "my_number_of_kpoints" else write(var_infos%ncdimnames(2), "(A)") "number_of_kpoints" end if if (associated(split%my_states)) then write(var_infos%ncdimnames(1), "(A)") "my_max_number_of_states" else write(var_infos%ncdimnames(1), "(A)") "max_number_of_states" end if call test_var(ncid, var_infos, lstat, error_data) deallocate(var_infos%ncdimnames) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if ! Check from a list. lstat = .false. ! Variable coefficients_of_wavefunctions write(var_infos%name, "(A)") "coefficients_of_wavefunctions" var_infos%nctype = etsf_io_low_double var_infos%ncshape = 6 allocate(var_infos%ncdimnames(6)) if (associated(split%my_spins)) then write(var_infos%ncdimnames(6), "(A)") "my_number_of_spins" else write(var_infos%ncdimnames(6), "(A)") "number_of_spins" end if if (associated(split%my_kpoints)) then write(var_infos%ncdimnames(5), "(A)") "my_number_of_kpoints" else write(var_infos%ncdimnames(5), "(A)") "number_of_kpoints" end if if (associated(split%my_states)) then write(var_infos%ncdimnames(4), "(A)") "my_max_number_of_states" else write(var_infos%ncdimnames(4), "(A)") "max_number_of_states" end if write(var_infos%ncdimnames(3), "(A)") "number_of_spinor_components" if (associated(split%my_coefficients)) then write(var_infos%ncdimnames(2), "(A)") "my_max_number_of_coefficients" else write(var_infos%ncdimnames(2), "(A)") "max_number_of_coefficients" end if write(var_infos%ncdimnames(1), "(A)") "real_or_complex_coefficients" call test_var(ncid, var_infos, valid, error_data) deallocate(var_infos%ncdimnames) if (.not. valid .and. error_data%access_mode_id == ERROR_MODE_SPEC) return lstat = lstat .or. valid ! Variable real_space_wavefunctions write(var_infos%name, "(A)") "real_space_wavefunctions" var_infos%nctype = etsf_io_low_double var_infos%ncshape = 8 allocate(var_infos%ncdimnames(8)) if (associated(split%my_spins)) then write(var_infos%ncdimnames(8), "(A)") "my_number_of_spins" else write(var_infos%ncdimnames(8), "(A)") "number_of_spins" end if if (associated(split%my_kpoints)) then write(var_infos%ncdimnames(7), "(A)") "my_number_of_kpoints" else write(var_infos%ncdimnames(7), "(A)") "number_of_kpoints" end if if (associated(split%my_states)) then write(var_infos%ncdimnames(6), "(A)") "my_max_number_of_states" else write(var_infos%ncdimnames(6), "(A)") "max_number_of_states" end if write(var_infos%ncdimnames(5), "(A)") "number_of_spinor_components" if (associated(split%my_grid_points_vector3)) then write(var_infos%ncdimnames(4), "(A)") "my_number_of_grid_points_vect3" else write(var_infos%ncdimnames(4), "(A)") "number_of_grid_points_vector3" end if if (associated(split%my_grid_points_vector2)) then write(var_infos%ncdimnames(3), "(A)") "my_number_of_grid_points_vect2" else write(var_infos%ncdimnames(3), "(A)") "number_of_grid_points_vector2" end if if (associated(split%my_grid_points_vector1)) then write(var_infos%ncdimnames(2), "(A)") "my_number_of_grid_points_vect1" else write(var_infos%ncdimnames(2), "(A)") "number_of_grid_points_vector1" end if write(var_infos%ncdimnames(1), "(A)") "real_or_complex_wavefunctions" call test_var(ncid, var_infos, valid, error_data) deallocate(var_infos%ncdimnames) if (.not. valid .and. error_data%access_mode_id == ERROR_MODE_SPEC) return lstat = lstat .or. valid if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_ARG, me, & & tgtname = "coefficients_of_wavefunctions, real_space_wavefunctions", & & errmess = "missing one among the list.") return end if ! Check a list of conditions if a variable is set. ! Test the existence of a variable. lstat = .false. call etsf_io_low_read_var_infos(ncid, "coefficients_of_wavefunctions", var_infos, & & lstat, error_data = error_data) if (lstat) then ! Apply the conditions since variable exists. ! Variable basis_set write(var_infos%name, "(A)") "basis_set" var_infos%nctype = etsf_io_low_character var_infos%ncshape = 1 allocate(var_infos%ncdimnames(1)) write(var_infos%ncdimnames(1), "(A)") "character_string_length" call test_var(ncid, var_infos, lstat, error_data) deallocate(var_infos%ncdimnames) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if ! Check these variables depends on the value of another. ! Read the condition value. call etsf_io_low_read_var(ncid, "basis_set", string_value, etsf_charlen, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if call strip(string_value) if (trim(string_value) == "daubechies_wavelets") then ! Variable coordinates_of_basis_grid_points write(var_infos%name, "(A)") "coordinates_of_basis_grid_points" var_infos%nctype = etsf_io_low_integer var_infos%ncshape = 3 allocate(var_infos%ncdimnames(3)) write(var_infos%ncdimnames(3), "(A)") "number_of_localization_regions" write(var_infos%ncdimnames(2), "(A)") "max_number_of_basis_grid_points" write(var_infos%ncdimnames(1), "(A)") "number_of_reduced_dimensions" call test_var(ncid, var_infos, lstat, error_data) deallocate(var_infos%ncdimnames) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if ! Variable number_of_coefficients_per_grid_point write(var_infos%name, "(A)") "number_of_coefficients_per_grid_point" var_infos%nctype = etsf_io_low_integer var_infos%ncshape = 2 allocate(var_infos%ncdimnames(2)) write(var_infos%ncdimnames(2), "(A)") "number_of_localization_regions" write(var_infos%ncdimnames(1), "(A)") "max_number_of_basis_grid_points" call test_var(ncid, var_infos, lstat, error_data) deallocate(var_infos%ncdimnames) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if else if (trim(string_value) == "plane_waves") then ! Variable number_of_coefficients write(var_infos%name, "(A)") "number_of_coefficients" var_infos%nctype = etsf_io_low_integer var_infos%ncshape = 1 allocate(var_infos%ncdimnames(1)) if (associated(split%my_kpoints)) then write(var_infos%ncdimnames(1), "(A)") "my_number_of_kpoints" else write(var_infos%ncdimnames(1), "(A)") "number_of_kpoints" end if call test_var(ncid, var_infos, lstat, error_data) deallocate(var_infos%ncdimnames) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if ! Variable reduced_coordinates_of_plane_waves write(var_infos%name, "(A)") "reduced_coordinates_of_plane_waves" var_infos%nctype = etsf_io_low_integer call etsf_io_low_read_flag(ncid, valid, "reduced_coordinates_of_plane_waves", & & "k_dependent", lstat, error_data = error_data) if (valid) then var_infos%ncshape = 3 allocate(var_infos%ncdimnames(3)) if (associated(split%my_kpoints)) then write(var_infos%ncdimnames(3), "(A)") "my_number_of_kpoints" else write(var_infos%ncdimnames(3), "(A)") "number_of_kpoints" end if if (associated(split%my_coefficients)) then write(var_infos%ncdimnames(2), "(A)") "my_max_number_of_coefficients" else write(var_infos%ncdimnames(2), "(A)") "max_number_of_coefficients" end if write(var_infos%ncdimnames(1), "(A)") "number_of_reduced_dimensions" else var_infos%ncshape = 2 allocate(var_infos%ncdimnames(2)) if (associated(split%my_coefficients)) then write(var_infos%ncdimnames(2), "(A)") "my_max_number_of_coefficients" else write(var_infos%ncdimnames(2), "(A)") "max_number_of_coefficients" end if write(var_infos%ncdimnames(1), "(A)") "number_of_reduced_dimensions" end if call test_var(ncid, var_infos, lstat, error_data) deallocate(var_infos%ncdimnames) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if else call etsf_io_split_free(split) call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_ARG, me, & & tgtname = "basis_set", & & errmess = "Empty or unknown value '"//trim(string_value)//"'.") lstat = .false. return end if end if ! Deallocate the split data. call etsf_io_split_free(split) lstat = .true. end subroutine etsf_io_file_check_wavefunctions_data !!*** etsf_io-1.0.3/src/utils/etsf_io_file_check_scalar_field_data.f900000644000353400050630000002034311354150413021602 00000000000000!! NOTES !! This file has been automatically generated by the @SCRIPT@ !! script. Any change you would bring to it will systematically be !! overwritten. See the template file in config/etsf/template.utils_check. !!****m* etsf_io_file/etsf_io_file_check_scalar_field_data !! NAME !! etsf_io_file_check_scalar_field_data !! !! FUNCTION !! This is a high level routine to inquire a file about a specifications. !! It returns .true. in lstat if the file is a valid 'scalar_field_data' file. !! It tests the existence of variables and their definition (type, shape. !! and dimension names). !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = !! an identificator of an opened ETSF file (use etsf_io_low_open_read() !! for instance). !! OUTPUT !! * lstat = !! return .true. if the file matches requirement of 'scalar_field_data'. !! * error_data = !! contains the details of the error is @lstat is false. !! !! SOURCE subroutine etsf_io_file_check_scalar_field_data(ncid, lstat, error_data) integer, intent(in) :: ncid logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data character(len = *), parameter :: me = "etsf_io_file_check_scalar_field_data" type(etsf_io_low_var_infos) :: var_infos logical :: valid character(len = etsf_charlen) :: string_value type(etsf_dims) :: dims type(etsf_split) :: split ! Read the dimensions call etsf_io_dims_get(ncid, dims, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, me) return end if ! Allocate the split and read it (this will verify variable exist. call etsf_io_split_allocate(split, dims) call etsf_io_split_get(ncid, split, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, me) return end if ! Variable primitive_vectors write(var_infos%name, "(A)") "primitive_vectors" var_infos%nctype = etsf_io_low_double var_infos%ncshape = 2 allocate(var_infos%ncdimnames(2)) write(var_infos%ncdimnames(2), "(A)") "number_of_vectors" write(var_infos%ncdimnames(1), "(A)") "number_of_cartesian_directions" call test_var(ncid, var_infos, lstat, error_data) deallocate(var_infos%ncdimnames) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if ! Check from a list. lstat = .false. ! Variable density write(var_infos%name, "(A)") "density" var_infos%nctype = etsf_io_low_double var_infos%ncshape = 5 allocate(var_infos%ncdimnames(5)) if (associated(split%my_components)) then write(var_infos%ncdimnames(5), "(A)") "my_number_of_components" else write(var_infos%ncdimnames(5), "(A)") "number_of_components" end if if (associated(split%my_grid_points_vector3)) then write(var_infos%ncdimnames(4), "(A)") "my_number_of_grid_points_vect3" else write(var_infos%ncdimnames(4), "(A)") "number_of_grid_points_vector3" end if if (associated(split%my_grid_points_vector2)) then write(var_infos%ncdimnames(3), "(A)") "my_number_of_grid_points_vect2" else write(var_infos%ncdimnames(3), "(A)") "number_of_grid_points_vector2" end if if (associated(split%my_grid_points_vector1)) then write(var_infos%ncdimnames(2), "(A)") "my_number_of_grid_points_vect1" else write(var_infos%ncdimnames(2), "(A)") "number_of_grid_points_vector1" end if write(var_infos%ncdimnames(1), "(A)") "real_or_complex_density" call test_var(ncid, var_infos, valid, error_data) deallocate(var_infos%ncdimnames) if (.not. valid .and. error_data%access_mode_id == ERROR_MODE_SPEC) return lstat = lstat .or. valid ! Variable correlation_potential write(var_infos%name, "(A)") "correlation_potential" var_infos%nctype = etsf_io_low_double var_infos%ncshape = 5 allocate(var_infos%ncdimnames(5)) if (associated(split%my_components)) then write(var_infos%ncdimnames(5), "(A)") "my_number_of_components" else write(var_infos%ncdimnames(5), "(A)") "number_of_components" end if if (associated(split%my_grid_points_vector3)) then write(var_infos%ncdimnames(4), "(A)") "my_number_of_grid_points_vect3" else write(var_infos%ncdimnames(4), "(A)") "number_of_grid_points_vector3" end if if (associated(split%my_grid_points_vector2)) then write(var_infos%ncdimnames(3), "(A)") "my_number_of_grid_points_vect2" else write(var_infos%ncdimnames(3), "(A)") "number_of_grid_points_vector2" end if if (associated(split%my_grid_points_vector1)) then write(var_infos%ncdimnames(2), "(A)") "my_number_of_grid_points_vect1" else write(var_infos%ncdimnames(2), "(A)") "number_of_grid_points_vector1" end if write(var_infos%ncdimnames(1), "(A)") "real_or_complex_potential" call test_var(ncid, var_infos, valid, error_data) deallocate(var_infos%ncdimnames) if (.not. valid .and. error_data%access_mode_id == ERROR_MODE_SPEC) return lstat = lstat .or. valid ! Variable exchange_potential write(var_infos%name, "(A)") "exchange_potential" var_infos%nctype = etsf_io_low_double var_infos%ncshape = 5 allocate(var_infos%ncdimnames(5)) if (associated(split%my_components)) then write(var_infos%ncdimnames(5), "(A)") "my_number_of_components" else write(var_infos%ncdimnames(5), "(A)") "number_of_components" end if if (associated(split%my_grid_points_vector3)) then write(var_infos%ncdimnames(4), "(A)") "my_number_of_grid_points_vect3" else write(var_infos%ncdimnames(4), "(A)") "number_of_grid_points_vector3" end if if (associated(split%my_grid_points_vector2)) then write(var_infos%ncdimnames(3), "(A)") "my_number_of_grid_points_vect2" else write(var_infos%ncdimnames(3), "(A)") "number_of_grid_points_vector2" end if if (associated(split%my_grid_points_vector1)) then write(var_infos%ncdimnames(2), "(A)") "my_number_of_grid_points_vect1" else write(var_infos%ncdimnames(2), "(A)") "number_of_grid_points_vector1" end if write(var_infos%ncdimnames(1), "(A)") "real_or_complex_potential" call test_var(ncid, var_infos, valid, error_data) deallocate(var_infos%ncdimnames) if (.not. valid .and. error_data%access_mode_id == ERROR_MODE_SPEC) return lstat = lstat .or. valid ! Variable exchange_correlation_potential write(var_infos%name, "(A)") "exchange_correlation_potential" var_infos%nctype = etsf_io_low_double var_infos%ncshape = 5 allocate(var_infos%ncdimnames(5)) if (associated(split%my_components)) then write(var_infos%ncdimnames(5), "(A)") "my_number_of_components" else write(var_infos%ncdimnames(5), "(A)") "number_of_components" end if if (associated(split%my_grid_points_vector3)) then write(var_infos%ncdimnames(4), "(A)") "my_number_of_grid_points_vect3" else write(var_infos%ncdimnames(4), "(A)") "number_of_grid_points_vector3" end if if (associated(split%my_grid_points_vector2)) then write(var_infos%ncdimnames(3), "(A)") "my_number_of_grid_points_vect2" else write(var_infos%ncdimnames(3), "(A)") "number_of_grid_points_vector2" end if if (associated(split%my_grid_points_vector1)) then write(var_infos%ncdimnames(2), "(A)") "my_number_of_grid_points_vect1" else write(var_infos%ncdimnames(2), "(A)") "number_of_grid_points_vector1" end if write(var_infos%ncdimnames(1), "(A)") "real_or_complex_potential" call test_var(ncid, var_infos, valid, error_data) deallocate(var_infos%ncdimnames) if (.not. valid .and. error_data%access_mode_id == ERROR_MODE_SPEC) return lstat = lstat .or. valid if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_ARG, me, & & tgtname = "density, correlation_potential, exchange_potential, exchange_correlation_p...", & & errmess = "missing one among the list.") return end if ! Deallocate the split data. call etsf_io_split_free(split) lstat = .true. end subroutine etsf_io_file_check_scalar_field_data !!*** etsf_io-1.0.3/src/utils/etsf_io_file_check_crystallographic_data.f900000644000353400050630000001604511354150413022550 00000000000000!! NOTES !! This file has been automatically generated by the @SCRIPT@ !! script. Any change you would bring to it will systematically be !! overwritten. See the template file in config/etsf/template.utils_check. !!****m* etsf_io_file/etsf_io_file_check_crystallographic_data !! NAME !! etsf_io_file_check_crystallographic_data !! !! FUNCTION !! This is a high level routine to inquire a file about a specifications. !! It returns .true. in lstat if the file is a valid 'crystallographic_data' file. !! It tests the existence of variables and their definition (type, shape. !! and dimension names). !! !! COPYRIGHT !! Copyright (C) 2006-2010 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * ncid = !! an identificator of an opened ETSF file (use etsf_io_low_open_read() !! for instance). !! OUTPUT !! * lstat = !! return .true. if the file matches requirement of 'crystallographic_data'. !! * error_data = !! contains the details of the error is @lstat is false. !! !! SOURCE subroutine etsf_io_file_check_crystallographic_data(ncid, lstat, error_data) integer, intent(in) :: ncid logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data character(len = *), parameter :: me = "etsf_io_file_check_crystallographic_data" type(etsf_io_low_var_infos) :: var_infos logical :: valid character(len = etsf_charlen) :: string_value type(etsf_dims) :: dims type(etsf_split) :: split ! Read the dimensions call etsf_io_dims_get(ncid, dims, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, me) return end if ! Allocate the split and read it (this will verify variable exist. call etsf_io_split_allocate(split, dims) call etsf_io_split_get(ncid, split, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, me) return end if ! Variable primitive_vectors write(var_infos%name, "(A)") "primitive_vectors" var_infos%nctype = etsf_io_low_double var_infos%ncshape = 2 allocate(var_infos%ncdimnames(2)) write(var_infos%ncdimnames(2), "(A)") "number_of_vectors" write(var_infos%ncdimnames(1), "(A)") "number_of_cartesian_directions" call test_var(ncid, var_infos, lstat, error_data) deallocate(var_infos%ncdimnames) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if ! Variable reduced_symmetry_matrices write(var_infos%name, "(A)") "reduced_symmetry_matrices" var_infos%nctype = etsf_io_low_integer var_infos%ncshape = 3 allocate(var_infos%ncdimnames(3)) write(var_infos%ncdimnames(3), "(A)") "number_of_symmetry_operations" write(var_infos%ncdimnames(2), "(A)") "number_of_reduced_dimensions" write(var_infos%ncdimnames(1), "(A)") "number_of_reduced_dimensions" call test_var(ncid, var_infos, lstat, error_data) deallocate(var_infos%ncdimnames) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if ! Variable reduced_symmetry_translations write(var_infos%name, "(A)") "reduced_symmetry_translations" var_infos%nctype = etsf_io_low_double var_infos%ncshape = 2 allocate(var_infos%ncdimnames(2)) write(var_infos%ncdimnames(2), "(A)") "number_of_symmetry_operations" write(var_infos%ncdimnames(1), "(A)") "number_of_reduced_dimensions" call test_var(ncid, var_infos, lstat, error_data) deallocate(var_infos%ncdimnames) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if ! Variable space_group write(var_infos%name, "(A)") "space_group" var_infos%nctype = etsf_io_low_integer var_infos%ncshape = 0 call test_var(ncid, var_infos, lstat, error_data) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if ! Variable atom_species write(var_infos%name, "(A)") "atom_species" var_infos%nctype = etsf_io_low_integer var_infos%ncshape = 1 allocate(var_infos%ncdimnames(1)) write(var_infos%ncdimnames(1), "(A)") "number_of_atoms" call test_var(ncid, var_infos, lstat, error_data) deallocate(var_infos%ncdimnames) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if ! Variable reduced_atom_positions write(var_infos%name, "(A)") "reduced_atom_positions" var_infos%nctype = etsf_io_low_double var_infos%ncshape = 2 allocate(var_infos%ncdimnames(2)) write(var_infos%ncdimnames(2), "(A)") "number_of_atoms" write(var_infos%ncdimnames(1), "(A)") "number_of_reduced_dimensions" call test_var(ncid, var_infos, lstat, error_data) deallocate(var_infos%ncdimnames) if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_update(error_data, me) return end if ! Check from a list. lstat = .false. ! Variable atomic_numbers write(var_infos%name, "(A)") "atomic_numbers" var_infos%nctype = etsf_io_low_double var_infos%ncshape = 1 allocate(var_infos%ncdimnames(1)) write(var_infos%ncdimnames(1), "(A)") "number_of_atom_species" call test_var(ncid, var_infos, valid, error_data) deallocate(var_infos%ncdimnames) if (.not. valid .and. error_data%access_mode_id == ERROR_MODE_SPEC) return lstat = lstat .or. valid ! Variable atom_species_names write(var_infos%name, "(A)") "atom_species_names" var_infos%nctype = etsf_io_low_character var_infos%ncshape = 2 allocate(var_infos%ncdimnames(2)) write(var_infos%ncdimnames(2), "(A)") "number_of_atom_species" write(var_infos%ncdimnames(1), "(A)") "character_string_length" call test_var(ncid, var_infos, valid, error_data) deallocate(var_infos%ncdimnames) if (.not. valid .and. error_data%access_mode_id == ERROR_MODE_SPEC) return lstat = lstat .or. valid ! Variable chemical_symbols write(var_infos%name, "(A)") "chemical_symbols" var_infos%nctype = etsf_io_low_character var_infos%ncshape = 2 allocate(var_infos%ncdimnames(2)) write(var_infos%ncdimnames(2), "(A)") "number_of_atom_species" write(var_infos%ncdimnames(1), "(A)") "symbol_length" call test_var(ncid, var_infos, valid, error_data) deallocate(var_infos%ncdimnames) if (.not. valid .and. error_data%access_mode_id == ERROR_MODE_SPEC) return lstat = lstat .or. valid if (.not. lstat) then call etsf_io_split_free(split) call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_ARG, me, & & tgtname = "atomic_numbers, atom_species_names, chemical_symbols", & & errmess = "missing one among the list.") return end if ! Deallocate the split data. call etsf_io_split_free(split) lstat = .true. end subroutine etsf_io_file_check_crystallographic_data !!*** etsf_io-1.0.3/src/utils/etsf_io_file_contents.f900000644000353400050630000000575011354150413016706 00000000000000!! NOTES !! This file has been automatically generated by the @SCRIPT@ !! script. Any change you would bring to it will systematically be !! overwritten. See the template file in config/etsf/template.utils_contents. !!****m* etsf_io_file/etsf_io_file_contents !! NAME !! etsf_io_file_contents !! !! FUNCTION !! This is a high level routine to inquire a file and get the specifications !! it matches. It is usefull to know if the file is a valid density file... !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * file_name = !! a list of path where input files can be found. !! OUTPUT !! * read_flags = !! a serie of flags the file matches. These flags are defined in the !! module etsf_io (see ETSF_IO_VALIDITY_FLAGS). It is an addition of all !! matching flags. !! * errors = an array of size etsf_nspecs_data. For each flag that missed, !! it gives the error why it missed. !! * lstat = !! return .false. if something make the file unreadable. !! * error_data = !! contains the details of the error is @lstat is false. !! !! SOURCE subroutine etsf_io_file_contents(read_flags, errors, file_name, lstat, error_data) integer, intent(out) :: read_flags type(etsf_io_low_error), intent(out) :: errors(etsf_nspecs_data) character(len = *), intent(in) :: file_name logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data character(len = *), parameter :: me = "etsf_io_file_contents" integer :: ncid read_flags = etsf_specs_none call etsf_io_low_open_read(ncid, trim(file_name), lstat, & & error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, me) return end if call etsf_io_file_check_dielectric_function_data(ncid, lstat, errors(1)) if (lstat) then read_flags = read_flags + etsf_dielectric_function_data else call etsf_io_low_error_update(errors(1), me) end if call etsf_io_file_check_wavefunctions_data(ncid, lstat, errors(2)) if (lstat) then read_flags = read_flags + etsf_wavefunctions_data else call etsf_io_low_error_update(errors(2), me) end if call etsf_io_file_check_scalar_field_data(ncid, lstat, errors(3)) if (lstat) then read_flags = read_flags + etsf_scalar_field_data else call etsf_io_low_error_update(errors(3), me) end if call etsf_io_file_check_crystallographic_data(ncid, lstat, errors(4)) if (lstat) then read_flags = read_flags + etsf_crystallographic_data else call etsf_io_low_error_update(errors(4), me) end if ! We close the file after the definitions. call etsf_io_low_close(ncid, lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, me) return end if end subroutine etsf_io_file_contents !!*** etsf_io-1.0.3/src/utils/etsf_io_file_private.f900000644000353400050630000003422010642470314016521 00000000000000subroutine test_var(ncid, var_infos_ref, lstat, error_data) integer, intent(in) :: ncid type(etsf_io_low_var_infos), intent(in) :: var_infos_ref logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data character(len=*),parameter :: me = 'test_var' character(len = 256) :: errmess type(etsf_io_low_var_infos) :: var_infos integer :: i ! Test variable existence. call etsf_io_low_read_var_infos(ncid, trim(var_infos_ref%name), var_infos, & & lstat, error_data, .true.) if (.not. lstat) then call etsf_io_low_error_update(error_data, me) return end if ! Now test variable definition. ! Type. if (var_infos_ref%nctype /= var_infos%nctype) then call etsf_io_low_free_var_infos(var_infos) lstat = .false. call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_ARG, me, tgtname = trim(var_infos%name), & & errmess = "wrong type.") return end if ! Shape. if (var_infos_ref%ncshape /= var_infos%ncshape) then call etsf_io_low_free_var_infos(var_infos) lstat = .false. write(errmess, "(A,I0,A)") "wrong shape definition, it should be ", & & var_infos_ref%ncshape, "." call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_ARG, me, tgtname = trim(var_infos%name), & & errmess = errmess) return end if ! Dimensions name. do i = 1, var_infos%ncshape, 1 if (trim(var_infos_ref%ncdimnames(i)) /= trim(var_infos%ncdimnames(i))) then call etsf_io_low_free_var_infos(var_infos) lstat = .false. call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, & & ERROR_TYPE_ARG, me, tgtname = trim(var_infos%name), & & errmess = "wrong dimension definition, '" // & & trim(var_infos_ref%ncdimnames(i)) // "' awaited.") return end if end do call etsf_io_low_free_var_infos(var_infos) lstat = .true. end subroutine test_var !* This routine free the nsize first element of the array !* file_infos. subroutine file_infos_free(file_infos, n_size) type(file_infos_type), intent(inout) :: file_infos(:) integer, intent(in) :: n_size integer :: i_file if (n_size > size(file_infos)) then write(0, *) " *** ETSF I/O Internal error ***" write(0, *) " file_infos_free n_size out of range: ", n_size return end if do i_file = 1, n_size, 1 call etsf_io_split_free(file_infos(i_file)%split) call etsf_io_vars_free(file_infos(i_file)%var_list) end do end subroutine file_infos_free !* This routine is a basic implementation of a defining merge for !* non ETSF variables. Given a list of variables and their definitions !* the dimensions are defined variables per variables and then the variables !* themselves are added. subroutine non_etsf_init(ncid, infos_file, lstat, error_data) integer, intent(in) :: ncid type(file_infos_type), intent(in) :: infos_file(:) logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data character(len=*),parameter :: me = 'non_etsf_init' integer :: i_file, i_var, i_dim integer :: dimvalue type(etsf_io_low_var_infos) :: infos_var ! In a merge action, all variables should be the same in the different ! files, then will only define dimensions and variables from the first ! element of array infos_file. We only check that dimensions and variable ! exist for the other elements. lstat = .false. i_file = 1 ! For each file, we read the list of variables do i_var = 1, infos_file(i_file)%var_list%n_vars, 1 ! For each non-ETSF variable, we read the list of dimensions if (infos_file(i_file)%var_list%group(i_var) == etsf_grp_none .and. & & .not. infos_file(i_file)%var_list%split(i_var)) then do i_dim = 1, infos_file(i_file)%var_list%parent(i_var)%ncshape, 1 ! For each dimension, we write it to the destination file. call etsf_io_low_write_dim(ncid, & & infos_file(i_file)%var_list%parent(i_var)%ncdimnames(i_dim), & & infos_file(i_file)%var_list%parent(i_var)%ncdims(i_dim), & & lstat, error_data = error_data) if (.not.lstat) then call etsf_io_low_error_update(error_data, me) return end if end do end if end do ! Now, we define the variables. do i_var = 1, infos_file(i_file)%var_list%n_vars, 1 if (infos_file(i_file)%var_list%group(i_var) == etsf_grp_none .and. & & .not. infos_file(i_file)%var_list%split(i_var)) then if (infos_file(i_file)%var_list%parent(i_var)%ncshape > 0) then call etsf_io_low_def_var(& & ncid, trim(infos_file(i_file)%var_list%parent(i_var)%name), & & infos_file(i_file)%var_list%parent(i_var)%nctype, & & infos_file(i_file)%var_list%parent(i_var)%ncdimnames, lstat, & & error_data = error_data) if (.not.lstat) then call etsf_io_low_error_update(error_data, me) return end if else call etsf_io_low_def_var( & & ncid, trim(infos_file(i_file)%var_list%parent(i_var)%name), & & infos_file(i_file)%var_list%parent(i_var)%nctype, & & lstat, error_data = error_data) if (.not.lstat) then call etsf_io_low_error_update(error_data, me) return end if end if end if end do ! Now we check dimensions and variables for all other elements of input array ! infos_file. do i_file = 2, size(infos_file), 1 do i_var = 1, infos_file(i_file)%var_list%n_vars, 1 if (infos_file(i_file)%var_list%group(i_var) == etsf_grp_none .and. & & .not. infos_file(i_file)%var_list%split(i_var)) then ! We check that dimensions of this variable is in the destination ! file. do i_dim = 1, infos_file(i_file)%var_list%parent(i_var)%ncshape, 1 call etsf_io_low_read_dim(ncid, & & trim(infos_file(i_file)%var_list%parent(i_var)%ncdimnames(i_dim)), & & dimvalue, lstat, error_data = error_data) if (.not. lstat .or. dimvalue /= & & infos_file(i_file)%var_list%parent(i_var)%ncdims(i_dim)) then call etsf_io_low_error_handle(error_data) call etsf_io_low_error_set( & & error_data, ERROR_MODE_SPEC, ERROR_TYPE_ARG, me, & & errmess = "dimension '"// & & trim(infos_file(i_file)%var_list%parent(i_var)%ncdimnames(i_dim)) & & //"' is not present in all files or has different values.") lstat = .false. return end if end do ! We check variables call etsf_io_low_read_var_infos( & & ncid, trim(infos_file(i_file)%var_list%parent(i_var)%name), & & infos_var, lstat, error_data = error_data) if (.not. lstat .or. & & infos_var%nctype /= infos_file(1)%var_list%parent(i_var)%nctype .or. & & infos_var%ncshape /= infos_file(1)%var_list%parent(i_var)%ncshape) then call etsf_io_low_error_set( & & error_data, ERROR_MODE_SPEC, ERROR_TYPE_ARG, me, & & errmess = "variable '"// & & trim(infos_file(i_file)%var_list%parent(i_var)%name) & & //"' is not present in all files or has different definitions.") lstat = .false. return end if end if end do end do lstat = .true. end subroutine non_etsf_init !* Basic implementation of a copy routine for all non-ETSF variables. !* Values are only copied from the first file, and no check is done !* regarding to other files. This is surely crude and may be upgarded !* later. subroutine non_etsf_copy(ncid, infos_file, lstat, error_data) integer, intent(in) :: ncid type(file_infos_type), intent(in) :: infos_file(:) logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data integer, allocatable :: integer_data(:) real, allocatable :: real_data(:) double precision, allocatable :: double_data(:) character(len = 1024), allocatable :: string_data(:) character(len=*),parameter :: me = 'non_etsf_copy' integer :: ncid_from integer, allocatable :: varids_to(:) integer :: i_file, i_var integer :: n_size logical :: lstat_ i_file = 1 call etsf_io_low_open_read(ncid_from, trim(infos_file(i_file)%path), lstat, & & error_data = error_data) if (.not.lstat) then call etsf_io_low_error_update(error_data, me) return end if call etsf_io_low_set_write_mode(ncid, lstat, error_data = error_data) if (.not.lstat) then call etsf_io_low_error_update(error_data, me) return end if allocate(varids_to(infos_file(i_file)%var_list%n_vars)) do i_var = 1, infos_file(i_file)%var_list%n_vars, 1 if (infos_file(i_file)%var_list%group(i_var) == etsf_grp_none .and. & & .not. infos_file(i_file)%var_list%split(i_var)) then ! Read the values if (infos_file(i_file)%var_list%parent(i_var)%ncshape > 0) then n_size = product(infos_file(i_file)%var_list%parent(i_var)%ncdims( & & 1:infos_file(i_file)%var_list%parent(i_var)%ncshape)) else n_size = 1 end if select case (infos_file(i_file)%var_list%parent(i_var)%nctype) ! Case integer values. case (etsf_io_low_integer) allocate(integer_data(n_size)) call etsf_io_low_read_var( & & ncid_from, trim(infos_file(i_file)%var_list%parent(i_var)%name), & & integer_data, lstat, error_data = error_data) if (lstat) then call etsf_io_low_write_var( & & ncid, trim(infos_file(i_file)%var_list%parent(i_var)%name), & & integer_data, lstat, error_data = error_data, & & ncvarid = varids_to(i_var)) end if ! Case real values. case (etsf_io_low_real) write(0, *) " *** ETSF I/O Internal error ***" write(0, *) " real variables not implemented, using double instead." allocate(double_data(n_size)) call etsf_io_low_read_var( & & ncid_from, trim(infos_file(i_file)%var_list%parent(i_var)%name), & & double_data, lstat, error_data = error_data) if (lstat) then call etsf_io_low_write_var( & & ncid, trim(infos_file(i_file)%var_list%parent(i_var)%name), & & double_data, lstat, error_data = error_data, & & ncvarid = varids_to(i_var)) end if ! Case double values. case (etsf_io_low_double) allocate(double_data(n_size)) call etsf_io_low_read_var( & & ncid_from, trim(infos_file(i_file)%var_list%parent(i_var)%name), & & double_data, lstat, error_data = error_data) if (lstat) then call etsf_io_low_write_var( & & ncid, trim(infos_file(i_file)%var_list%parent(i_var)%name), & & double_data, lstat, error_data = error_data, & & ncvarid = varids_to(i_var)) end if ! Case string values. case (etsf_io_low_character) if (infos_file(i_file)%var_list%parent(i_var)%ncshape == 0) then call etsf_io_low_error_set( & & error_data, ERROR_MODE_SPEC, ERROR_TYPE_ARG, me, & & tgtname = trim(infos_file(i_file)%var_list%parent(i_var)%name), & & errmess = "character variables must be arrays.") lstat = .false. exit end if n_size = n_size / infos_file(i_file)%var_list%parent(i_var)%ncdims(1) allocate(string_data(n_size)) call etsf_io_low_read_var( & & ncid_from, trim(infos_file(i_file)%var_list%parent(i_var)%name), & & string_data, infos_file(i_file)%var_list%parent(i_var)%ncdims(1), & & lstat, error_data = error_data) if (lstat) then call etsf_io_low_write_var( & & ncid, trim(infos_file(i_file)%var_list%parent(i_var)%name), & & string_data, infos_file(i_file)%var_list%parent(i_var)%ncdims(1), & & lstat, error_data = error_data, ncvarid = varids_to(i_var)) end if end select ! Deallocate all memory if (allocated(integer_data)) then deallocate(integer_data) end if if (allocated(real_data)) then deallocate(real_data) end if if (allocated(double_data)) then deallocate(double_data) end if if (allocated(string_data)) then deallocate(string_data) end if if (.not.lstat) then call etsf_io_low_error_update(error_data, me) exit end if end if end do call etsf_io_low_set_define_mode(ncid, lstat, error_data = error_data) if (.not. lstat) then deallocate(varids_to) call etsf_io_low_error_update(error_data, me) return end if do i_var = 1, infos_file(i_file)%var_list%n_vars, 1 if (infos_file(i_file)%var_list%group(i_var) == etsf_grp_none .and. & & .not. infos_file(i_file)%var_list%split(i_var)) then ! We copy all the attributes. call etsf_io_low_copy_all_att(ncid_from, ncid, & & infos_file(i_file)%var_list%parent(i_var)%ncid, varids_to(i_var), & & lstat, error_data = error_data) if (.not.lstat) then call etsf_io_low_error_update(error_data, me) exit end if end if end do deallocate(varids_to) ! Notice: we ignore close errors if any. call etsf_io_low_close(ncid_from, lstat_) end subroutine non_etsf_copy etsf_io-1.0.3/src/utils/etsf_io_file_public.f900000644000353400050620000002231210643433517016330 00000000000000!!****m* etsf_io_file/etsf_io_file_merge !! NAME !! etsf_io_file_merge !! !! FUNCTION !! This is a high level routine to merge several files into one single. The files !! to be merged should conform to the ETSF specification on splitted files. The !! given input files must not be necessarily a complete list to create a !! non-splitted file. In the case some arrays are still partial, the created !! output file is a splitted one again, gathering what was possible with respect !! to the given input files. !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * dest_file = !! the path to the file to be created. It must not already exist. !! * source_files = !! a list of path where input files can be found. !! OUTPUT !! * lstat = !! return .true. if all the actions succeed, if not the status !! of the output file is undefined. !! * error_data = !! contains the details of the error is @lstat is false. !! !! SOURCE subroutine etsf_io_file_merge(dest_file, source_files, lstat, error_data) character(len = *), intent(in) :: dest_file character(len = 256), intent(in) :: source_files(:) logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data ! Local variables integer :: ncid_to, n_files, i_file, i, ncid integer :: etsf_main, grp type(file_infos_type), allocatable :: infos_file(:) type(etsf_split) :: output_split type(etsf_dims) :: output_dims type(etsf_groups_flags) :: etsf_variables character(len = *), parameter :: me = "etsf_io_file_merge" lstat = .false. n_files = size(source_files) if (n_files <= 0) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ARG, me, & & errmess = "argument 'source_files' has a wrong size.") return end if ! We allocate the dimension definitions. allocate(infos_file(n_files)) !************************************* ! Read all definitions from all files. !************************************* ! We read the different dimensions. etsf_main = etsf_main_none do i_file = 1, n_files, 1 ! We copy the path. infos_file(i_file)%path = source_files(i_file) ! We get the list of used groups and main variables ! We also get the list of all variables in the files. call etsf_io_data_contents(trim(source_files(i_file)), & & infos_file(i_file)%dims, infos_file(i_file)%split, & & grp, etsf_variables, lstat, error_data, & & vars_infos = infos_file(i_file)%var_list) if (.not. lstat) then call file_infos_free(infos_file, i_file) deallocate(infos_file) call etsf_io_low_error_update(error_data, me) return end if etsf_main = ior(etsf_main, etsf_variables%main) end do !********************************************* ! Merge the dimensions and split informations. !********************************************* ! We merge the dimensions, checking that all no my_something ! are equal and we create an output_split for all not complete ! dimensions after merge. output_dims = infos_file(1)%dims ! Sum all my_something dimensions, to know if the merging is complete or not. do i_file = 2, n_files, 1 call etsf_io_dims_merge(output_dims, infos_file(i_file)%dims, & & lstat, error_data) if (.not. lstat) then call file_infos_free(infos_file, n_files) deallocate(infos_file) call etsf_io_low_error_update(error_data, me) return end if end do call etsf_io_split_allocate(output_split, output_dims) ! We create a new split definition with the split(i) values. do i_file = 1, n_files, 1 call etsf_io_split_merge(output_split, infos_file(i_file)%split, & & lstat, error_data) if (.not. lstat) goto 1000 end do !***************************************************** ! Define all ETSF (non main) variables and dimensions. !***************************************************** ! We create an output file and define all the variables and dimensions. ! All defined dimensions and variables are related to ETSF only, ! all other variables and dimensions are ignored. ! The main group is also ignored at that time to allow to add new ! non ETSF variables. if (etsf_main /= etsf_main_none) then etsf_variables%main = etsf_main_none end if call etsf_io_data_init(trim(dest_file), etsf_variables, output_dims, & & "Merging files", "", lstat, error_data = error_data, & & split_definition = output_split) if (.not. lstat) goto 1000 !****************************************************** ! Treat non-ETSF part, define variables and dimensions. !****************************************************** ! We reopen the destination file to add non ETSF elements ! and to later add the main group. call etsf_io_low_open_modify(ncid_to, trim(dest_file), lstat, & & error_data = error_data) if (.not. lstat) goto 1000 ! We define all dimensions and variables that are non-part of ETSF. call non_etsf_init(ncid_to, infos_file, lstat, error_data) if (.not. lstat) goto 1000 ! We add the main group. if (etsf_main /= etsf_main_none) then call etsf_io_main_def(ncid_to, lstat, error_data, flags = etsf_main, & & split = output_split) if (.not. lstat) goto 1000 end if ! We close the file after the definitions. call etsf_io_low_close(ncid_to, lstat, error_data = error_data) if (.not. lstat) goto 1000 !************************* ! Copy all ETSF variables. !************************* ! We copy all the data from read files to the new output file. do i_file = 1, n_files, 1 call etsf_io_data_copy(trim(dest_file), trim(source_files(i_file)), & & infos_file(i_file)%dims, lstat, error_data, infos_file(i_file)%split) if (.not. lstat) goto 1000 end do !***************************** ! Copy all non-ETSF variables. !***************************** ! We reopen the destination file to copy non ETSF values. call etsf_io_low_open_modify(ncid_to, trim(dest_file), lstat, & & error_data = error_data) if (.not. lstat) goto 1000 call etsf_io_low_set_write_mode(ncid_to, lstat, error_data = error_data) if (.not. lstat) goto 1000 ! We copy all variables that are non-part of ETSF. call non_etsf_copy(ncid_to, infos_file, lstat, error_data) if (.not. lstat) goto 1000 ! We close the file after the copy. call etsf_io_low_close(ncid_to, lstat, error_data = error_data) if (.not. lstat) goto 1000 ! If we arrived there, then everything went right. lstat = .true. ! Last deallocations and/or error freeing before return. 1000 continue call file_infos_free(infos_file, n_files) deallocate(infos_file) call etsf_io_split_free(output_split) if (.not. lstat) call etsf_io_low_error_update(error_data, me) end subroutine etsf_io_file_merge !!*** !!****m* etsf_io_file/etsf_io_file_check !! NAME !! etsf_io_file_check !! !! FUNCTION !! This is a high level routine to check that a file is valid to !! the specifications. This validity is done on presence of required !! variables and on conform variable definition. The presence of attributes !! when required is also done. !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! INPUTS !! * file_name = !! a list of path where input files can be found. !! * file_flags = !! a serie of flags to check the file on. These flags are defined in the !! module etsf_io (see ETSF_IO_VALIDITY_FLAGS). To use several flags, !! simply add each of them. !! OUTPUT !! * lstat = !! return .true. if the file is valid. !! * error_data = !! contains the details of the error is @lstat is false. !! !! SOURCE subroutine etsf_io_file_check(file_name, file_flags, lstat, error_data) character(len = *), intent(in) :: file_name integer, intent(in) :: file_flags logical, intent(out) :: lstat type(etsf_io_low_error), intent(out) :: error_data character(len = *), parameter :: me = "etsf_io_file_check" integer :: read_flags type(etsf_io_low_error), dimension(etsf_nspecs_data) :: errors integer :: i call etsf_io_file_contents(read_flags, errors, file_name, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_update(error_data, me) return end if do i = 1, etsf_nspecs_data if (iand(file_flags, 2 ** (i - 1)) /= 0 .and. & & iand(read_flags, 2 ** (i - 1)) == 0) then lstat = .false. error_data = errors(i) call etsf_io_low_error_update(error_data, me) return end if end do lstat = .true. end subroutine etsf_io_file_check !!*** etsf_io-1.0.3/src/tutorials/0000777000353400050620000000000011354151532012767 500000000000000etsf_io-1.0.3/src/tutorials/Makefile.am0000644000353400050630000000321510656551166014754 00000000000000vpath %.a $(top_builddir)/src/group_level \ $(top_builddir)/src/utils AM_FCFLAGS = -I@NETCDF_CFLAGS@ -I$(top_builddir)/src/low_level -I$(top_builddir)/src/group_level -I$(top_builddir)/src/utils EXTRA_DIST = MPI_output_of_a_density.f90 README.f90 noinst_PROGRAMS = create_a_crystal_den_file \ read_write_sub_access \ convert_to_xyz \ mix_ETSF_and_non_ETSF \ read_a_file create_a_crystal_den_file_SOURCES = create_a_crystal_den_file.f90 create_a_crystal_den_file_LDFLAGS = -L$(top_builddir)/src/group_level create_a_crystal_den_file_LDADD = -letsf_io read_write_sub_access_SOURCES = read_write_sub_access.f90 read_write_sub_access_LDFLAGS = -L$(top_builddir)/src/group_level -L$(top_builddir)/src/utils read_write_sub_access_LDADD = -letsf_io -letsf_io_utils read_a_file_SOURCES = read_a_file.f90 read_a_file_LDFLAGS = -L$(top_builddir)/src/group_level -L$(top_builddir)/src/utils read_a_file_LDADD = -letsf_io -letsf_io_utils convert_to_xyz_SOURCES = convert_to_xyz.f90 convert_to_xyz_LDFLAGS = -L$(top_builddir)/src/utils -L$(top_builddir)/src/group_level convert_to_xyz_LDADD = -letsf_io_utils -letsf_io mix_ETSF_and_non_ETSF_SOURCES = mix_ETSF_and_non_ETSF.f90 mix_ETSF_and_non_ETSF_LDFLAGS = -L$(top_builddir)/src/group_level mix_ETSF_and_non_ETSF_LDADD = -letsf_io #dependencies create_a_crystal_den_file.o: create_a_crystal_den_file.f90 \ libetsf_io.a read_write_sub_access.o: read_write_sub_access.f90 \ libetsf_io.a \ libetsf_io_utils.a read_a_file.o: read_a_file.f90 \ libetsf_io.a \ libetsf_io_utils.a convert_to_xyz.o: convert_to_xyz.f90 \ libetsf_io.a \ libetsf_io_utils.a mix_ETSF_and_non_ETSF.o: mix_ETSF_and_non_ETSF.f90 \ libetsf_io.a etsf_io-1.0.3/src/tutorials/Makefile.in0000644000353400050620000003514711354150420014755 00000000000000# Makefile.in generated by automake 1.10.1 from Makefile.am. # @configure_input@ # Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, # 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. # This Makefile.in is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY, to the extent permitted by law; without # even the implied warranty of MERCHANTABILITY or FITNESS FOR A # PARTICULAR PURPOSE. @SET_MAKE@ VPATH = @srcdir@ pkgdatadir = $(datadir)/@PACKAGE@ pkglibdir = $(libdir)/@PACKAGE@ pkgincludedir = $(includedir)/@PACKAGE@ am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd install_sh_DATA = $(install_sh) -c -m 644 install_sh_PROGRAM = $(install_sh) -c install_sh_SCRIPT = $(install_sh) -c INSTALL_HEADER = $(INSTALL_DATA) transform = $(program_transform_name) NORMAL_INSTALL = : PRE_INSTALL = : POST_INSTALL = : NORMAL_UNINSTALL = : PRE_UNINSTALL = : POST_UNINSTALL = : noinst_PROGRAMS = create_a_crystal_den_file$(EXEEXT) \ read_write_sub_access$(EXEEXT) convert_to_xyz$(EXEEXT) \ mix_ETSF_and_non_ETSF$(EXEEXT) read_a_file$(EXEEXT) subdir = src/tutorials DIST_COMMON = $(srcdir)/Makefile.am $(srcdir)/Makefile.in ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 am__aclocal_m4_deps = $(top_srcdir)/config/m4/fortran.m4 \ $(top_srcdir)/configure.ac am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ $(ACLOCAL_M4) mkinstalldirs = $(install_sh) -d CONFIG_CLEAN_FILES = PROGRAMS = $(noinst_PROGRAMS) am_convert_to_xyz_OBJECTS = convert_to_xyz.$(OBJEXT) convert_to_xyz_OBJECTS = $(am_convert_to_xyz_OBJECTS) convert_to_xyz_DEPENDENCIES = convert_to_xyz_LINK = $(FCLD) $(AM_FCFLAGS) $(FCFLAGS) \ $(convert_to_xyz_LDFLAGS) $(LDFLAGS) -o $@ am_create_a_crystal_den_file_OBJECTS = \ create_a_crystal_den_file.$(OBJEXT) create_a_crystal_den_file_OBJECTS = \ $(am_create_a_crystal_den_file_OBJECTS) create_a_crystal_den_file_DEPENDENCIES = create_a_crystal_den_file_LINK = $(FCLD) $(AM_FCFLAGS) $(FCFLAGS) \ $(create_a_crystal_den_file_LDFLAGS) $(LDFLAGS) -o $@ am_mix_ETSF_and_non_ETSF_OBJECTS = mix_ETSF_and_non_ETSF.$(OBJEXT) mix_ETSF_and_non_ETSF_OBJECTS = $(am_mix_ETSF_and_non_ETSF_OBJECTS) mix_ETSF_and_non_ETSF_DEPENDENCIES = mix_ETSF_and_non_ETSF_LINK = $(FCLD) $(AM_FCFLAGS) $(FCFLAGS) \ $(mix_ETSF_and_non_ETSF_LDFLAGS) $(LDFLAGS) -o $@ am_read_a_file_OBJECTS = read_a_file.$(OBJEXT) read_a_file_OBJECTS = $(am_read_a_file_OBJECTS) read_a_file_DEPENDENCIES = read_a_file_LINK = $(FCLD) $(AM_FCFLAGS) $(FCFLAGS) \ $(read_a_file_LDFLAGS) $(LDFLAGS) -o $@ am_read_write_sub_access_OBJECTS = read_write_sub_access.$(OBJEXT) read_write_sub_access_OBJECTS = $(am_read_write_sub_access_OBJECTS) read_write_sub_access_DEPENDENCIES = read_write_sub_access_LINK = $(FCLD) $(AM_FCFLAGS) $(FCFLAGS) \ $(read_write_sub_access_LDFLAGS) $(LDFLAGS) -o $@ DEFAULT_INCLUDES = -I.@am__isrc@ FCCOMPILE = $(FC) $(AM_FCFLAGS) $(FCFLAGS) FCLD = $(FC) FCLINK = $(FCLD) $(AM_FCFLAGS) $(FCFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o \ $@ SOURCES = $(convert_to_xyz_SOURCES) \ $(create_a_crystal_den_file_SOURCES) \ $(mix_ETSF_and_non_ETSF_SOURCES) $(read_a_file_SOURCES) \ $(read_write_sub_access_SOURCES) DIST_SOURCES = $(convert_to_xyz_SOURCES) \ $(create_a_crystal_den_file_SOURCES) \ $(mix_ETSF_and_non_ETSF_SOURCES) $(read_a_file_SOURCES) \ $(read_write_sub_access_SOURCES) ETAGS = etags CTAGS = ctags DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) ACLOCAL = @ACLOCAL@ AMTAR = @AMTAR@ AR = @AR@ AUTOCONF = @AUTOCONF@ AUTOHEADER = @AUTOHEADER@ AUTOMAKE = @AUTOMAKE@ AWK = @AWK@ CYGPATH_W = @CYGPATH_W@ DEFS = @DEFS@ ECHO_C = @ECHO_C@ ECHO_N = @ECHO_N@ ECHO_T = @ECHO_T@ EXEEXT = @EXEEXT@ FC = @FC@ FCFLAGS = @FCFLAGS@ FCFLAGS_f90 = @FCFLAGS_f90@ FFLAGS = @FFLAGS@ INSTALL = @INSTALL@ INSTALL_DATA = @INSTALL_DATA@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ INSTALL_SCRIPT = @INSTALL_SCRIPT@ INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ LDFLAGS = @LDFLAGS@ LIBOBJS = @LIBOBJS@ LIBS = @LIBS@ LTLIBOBJS = @LTLIBOBJS@ MAKEINFO = @MAKEINFO@ MKDIR_P = @MKDIR_P@ MODULE_EXT = @MODULE_EXT@ NETCDF_CFLAGS = @NETCDF_CFLAGS@ OBJEXT = @OBJEXT@ PACKAGE = @PACKAGE@ PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ PACKAGE_NAME = @PACKAGE_NAME@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_VERSION = @PACKAGE_VERSION@ PATH_SEPARATOR = @PATH_SEPARATOR@ RANLIB = @RANLIB@ SET_MAKE = @SET_MAKE@ SHELL = @SHELL@ STRIP = @STRIP@ VERSION = @VERSION@ abs_builddir = @abs_builddir@ abs_srcdir = @abs_srcdir@ abs_top_builddir = @abs_top_builddir@ abs_top_srcdir = @abs_top_srcdir@ ac_ct_FC = @ac_ct_FC@ am__leading_dot = @am__leading_dot@ am__tar = @am__tar@ am__untar = @am__untar@ bindir = @bindir@ build_alias = @build_alias@ builddir = @builddir@ datadir = @datadir@ datarootdir = @datarootdir@ docdir = @docdir@ dvidir = @dvidir@ exec_prefix = @exec_prefix@ fc_type = @fc_type@ fc_version = @fc_version@ fc_wrap = @fc_wrap@ groupleveldocdir = @groupleveldocdir@ host_alias = @host_alias@ htmldir = @htmldir@ includedir = @includedir@ infodir = @infodir@ install_sh = @install_sh@ libdir = @libdir@ libexecdir = @libexecdir@ localedir = @localedir@ localstatedir = @localstatedir@ lowleveldocdir = @lowleveldocdir@ mandir = @mandir@ mkdir_p = @mkdir_p@ moduledir = @moduledir@ oldincludedir = @oldincludedir@ pdfdir = @pdfdir@ prefix = @prefix@ program_transform_name = @program_transform_name@ psdir = @psdir@ sbindir = @sbindir@ sharedstatedir = @sharedstatedir@ srcdir = @srcdir@ sysconfdir = @sysconfdir@ target_alias = @target_alias@ top_builddir = @top_builddir@ top_srcdir = @top_srcdir@ tutorialsdocdir = @tutorialsdocdir@ utilsdocdir = @utilsdocdir@ AM_FCFLAGS = -I@NETCDF_CFLAGS@ -I$(top_builddir)/src/low_level -I$(top_builddir)/src/group_level -I$(top_builddir)/src/utils EXTRA_DIST = MPI_output_of_a_density.f90 README.f90 create_a_crystal_den_file_SOURCES = create_a_crystal_den_file.f90 create_a_crystal_den_file_LDFLAGS = -L$(top_builddir)/src/group_level create_a_crystal_den_file_LDADD = -letsf_io read_write_sub_access_SOURCES = read_write_sub_access.f90 read_write_sub_access_LDFLAGS = -L$(top_builddir)/src/group_level -L$(top_builddir)/src/utils read_write_sub_access_LDADD = -letsf_io -letsf_io_utils read_a_file_SOURCES = read_a_file.f90 read_a_file_LDFLAGS = -L$(top_builddir)/src/group_level -L$(top_builddir)/src/utils read_a_file_LDADD = -letsf_io -letsf_io_utils convert_to_xyz_SOURCES = convert_to_xyz.f90 convert_to_xyz_LDFLAGS = -L$(top_builddir)/src/utils -L$(top_builddir)/src/group_level convert_to_xyz_LDADD = -letsf_io_utils -letsf_io mix_ETSF_and_non_ETSF_SOURCES = mix_ETSF_and_non_ETSF.f90 mix_ETSF_and_non_ETSF_LDFLAGS = -L$(top_builddir)/src/group_level mix_ETSF_and_non_ETSF_LDADD = -letsf_io all: all-am .SUFFIXES: .SUFFIXES: .f90 .o .obj $(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) @for dep in $?; do \ case '$(am__configure_deps)' in \ *$$dep*) \ cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh \ && exit 0; \ exit 1;; \ esac; \ done; \ echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu src/tutorials/Makefile'; \ cd $(top_srcdir) && \ $(AUTOMAKE) --gnu src/tutorials/Makefile .PRECIOUS: Makefile Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status @case '$?' in \ *config.status*) \ cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ *) \ echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ esac; $(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh $(top_srcdir)/configure: $(am__configure_deps) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh $(ACLOCAL_M4): $(am__aclocal_m4_deps) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh clean-noinstPROGRAMS: -test -z "$(noinst_PROGRAMS)" || rm -f $(noinst_PROGRAMS) convert_to_xyz$(EXEEXT): $(convert_to_xyz_OBJECTS) $(convert_to_xyz_DEPENDENCIES) @rm -f convert_to_xyz$(EXEEXT) $(convert_to_xyz_LINK) $(convert_to_xyz_OBJECTS) $(convert_to_xyz_LDADD) $(LIBS) create_a_crystal_den_file$(EXEEXT): $(create_a_crystal_den_file_OBJECTS) $(create_a_crystal_den_file_DEPENDENCIES) @rm -f create_a_crystal_den_file$(EXEEXT) $(create_a_crystal_den_file_LINK) $(create_a_crystal_den_file_OBJECTS) $(create_a_crystal_den_file_LDADD) $(LIBS) mix_ETSF_and_non_ETSF$(EXEEXT): $(mix_ETSF_and_non_ETSF_OBJECTS) $(mix_ETSF_and_non_ETSF_DEPENDENCIES) @rm -f mix_ETSF_and_non_ETSF$(EXEEXT) $(mix_ETSF_and_non_ETSF_LINK) $(mix_ETSF_and_non_ETSF_OBJECTS) $(mix_ETSF_and_non_ETSF_LDADD) $(LIBS) read_a_file$(EXEEXT): $(read_a_file_OBJECTS) $(read_a_file_DEPENDENCIES) @rm -f read_a_file$(EXEEXT) $(read_a_file_LINK) $(read_a_file_OBJECTS) $(read_a_file_LDADD) $(LIBS) read_write_sub_access$(EXEEXT): $(read_write_sub_access_OBJECTS) $(read_write_sub_access_DEPENDENCIES) @rm -f read_write_sub_access$(EXEEXT) $(read_write_sub_access_LINK) $(read_write_sub_access_OBJECTS) $(read_write_sub_access_LDADD) $(LIBS) mostlyclean-compile: -rm -f *.$(OBJEXT) distclean-compile: -rm -f *.tab.c .f90.o: $(FCCOMPILE) -c -o $@ $< .f90.obj: $(FCCOMPILE) -c -o $@ `$(CYGPATH_W) '$<'` ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES) list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ unique=`for i in $$list; do \ if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ done | \ $(AWK) '{ files[$$0] = 1; nonemtpy = 1; } \ END { if (nonempty) { for (i in files) print i; }; }'`; \ mkid -fID $$unique tags: TAGS TAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \ $(TAGS_FILES) $(LISP) tags=; \ here=`pwd`; \ list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ unique=`for i in $$list; do \ if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ done | \ $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ END { if (nonempty) { for (i in files) print i; }; }'`; \ if test -z "$(ETAGS_ARGS)$$tags$$unique"; then :; else \ test -n "$$unique" || unique=$$empty_fix; \ $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ $$tags $$unique; \ fi ctags: CTAGS CTAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \ $(TAGS_FILES) $(LISP) tags=; \ list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ unique=`for i in $$list; do \ if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ done | \ $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ END { if (nonempty) { for (i in files) print i; }; }'`; \ test -z "$(CTAGS_ARGS)$$tags$$unique" \ || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ $$tags $$unique GTAGS: here=`$(am__cd) $(top_builddir) && pwd` \ && cd $(top_srcdir) \ && gtags -i $(GTAGS_ARGS) $$here distclean-tags: -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags distdir: $(DISTFILES) @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ list='$(DISTFILES)'; \ dist_files=`for file in $$list; do echo $$file; done | \ sed -e "s|^$$srcdirstrip/||;t" \ -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ case $$dist_files in \ */*) $(MKDIR_P) `echo "$$dist_files" | \ sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ sort -u` ;; \ esac; \ for file in $$dist_files; do \ if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ if test -d $$d/$$file; then \ dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ cp -pR $(srcdir)/$$file $(distdir)$$dir || exit 1; \ fi; \ cp -pR $$d/$$file $(distdir)$$dir || exit 1; \ else \ test -f $(distdir)/$$file \ || cp -p $$d/$$file $(distdir)/$$file \ || exit 1; \ fi; \ done check-am: all-am check: check-am all-am: Makefile $(PROGRAMS) installdirs: install: install-am install-exec: install-exec-am install-data: install-data-am uninstall: uninstall-am install-am: all-am @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am installcheck: installcheck-am install-strip: $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ `test -z '$(STRIP)' || \ echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install mostlyclean-generic: clean-generic: distclean-generic: -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) maintainer-clean-generic: @echo "This command is intended for maintainers to use" @echo "it deletes files that may require special tools to rebuild." clean: clean-am clean-am: clean-generic clean-noinstPROGRAMS mostlyclean-am distclean: distclean-am -rm -f Makefile distclean-am: clean-am distclean-compile distclean-generic \ distclean-tags dvi: dvi-am dvi-am: html: html-am info: info-am info-am: install-data-am: install-dvi: install-dvi-am install-exec-am: install-html: install-html-am install-info: install-info-am install-man: install-pdf: install-pdf-am install-ps: install-ps-am installcheck-am: maintainer-clean: maintainer-clean-am -rm -f Makefile maintainer-clean-am: distclean-am maintainer-clean-generic mostlyclean: mostlyclean-am mostlyclean-am: mostlyclean-compile mostlyclean-generic pdf: pdf-am pdf-am: ps: ps-am ps-am: uninstall-am: .MAKE: install-am install-strip .PHONY: CTAGS GTAGS all all-am check check-am clean clean-generic \ clean-noinstPROGRAMS ctags distclean distclean-compile \ distclean-generic distclean-tags distdir dvi dvi-am html \ html-am info info-am install install-am install-data \ install-data-am install-dvi install-dvi-am install-exec \ install-exec-am install-html install-html-am install-info \ install-info-am install-man install-pdf install-pdf-am \ install-ps install-ps-am install-strip installcheck \ installcheck-am installdirs maintainer-clean \ maintainer-clean-generic mostlyclean mostlyclean-compile \ mostlyclean-generic pdf pdf-am ps ps-am tags uninstall \ uninstall-am vpath %.a $(top_builddir)/src/group_level \ $(top_builddir)/src/utils #dependencies create_a_crystal_den_file.o: create_a_crystal_den_file.f90 \ libetsf_io.a read_write_sub_access.o: read_write_sub_access.f90 \ libetsf_io.a \ libetsf_io_utils.a read_a_file.o: read_a_file.f90 \ libetsf_io.a \ libetsf_io_utils.a convert_to_xyz.o: convert_to_xyz.f90 \ libetsf_io.a \ libetsf_io_utils.a mix_ETSF_and_non_ETSF.o: mix_ETSF_and_non_ETSF.f90 \ libetsf_io.a # Tell versions [3.59,3.63) of GNU make to not export all variables. # Otherwise a system limit (for SysV at least) may be exceeded. .NOEXPORT: etsf_io-1.0.3/src/tutorials/convert_to_xyz.f900000644000353400050630000001575610656546431016350 00000000000000!!****e* etsf_io_tutorials/convert_to_xyz !! NAME !! convert_to_xyz !! !! FUNCTION !! In this example, we will describe how to use the high level routines from !! etsf_io_file and etsf_io_tools (from library etsf_io_utils). Doing it, we will !! read a cristallographic file, check its validity and convert it to XYZ file, !! reading the coordinates of atoms and getting their names. !! !! To compile this exemple, use (assuming default installation paths): !! ${F90} -I/opt/include/${F90} -o convert_to_xyz convert_to_xyz.f90 !! -L/opt/lib -letsf_io_utils -letsf_io -L/usr/lib -lnetcdf !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! SOURCE program convert_to_xyz use etsf_io_low_level use etsf_io use etsf_io_file use etsf_io_tools implicit none integer :: iargc character(len = etsf_io_low_error_len) :: filename, error_string logical :: lstat type(etsf_io_low_error) :: error_data integer :: i_atom double precision :: coord(etsf_3dimlen) !! NOTES !! In this tutorial, we will open an ETSF file, and some variable of the !! geometry group (see the first tutorial on how to create_a_crystal_den_file !! for further explanations on groups and especially etsf_geometry). !! !! The required data to create an XYZ file are: !! * primitive_vectors for the box definition, !! * reduced_atom_positions for the atom coordinates, !! * atom_species for the nature of elements. !! !! SOURCE integer :: ncid type(etsf_dims) :: dims_data type(etsf_geometry) :: geometry_data double precision, allocatable, target :: primitive_vectors(:,:) double precision, allocatable, target :: reduced_atom_positions(:,:) integer, allocatable, target :: atom_species(:) !! NOTES !! The names of atoms receives a special treatment since it can be found in several !! variables. The specifications are clear on preference and we will use the !! etsf_io_tools_get_atom_names() routine to handle this preference and read !! the atom names. !! !! SOURCE character(len = etsf_charlen), allocatable :: atom_names(:) !! NOTES !! We read the number of argument and get the input filename from the command line. !! !! SOURCE ! Read number of program argument, should be one. if (iargc() /= 1) then write(0, *) "Error: one argument is required." stop end if ! Read name of input file. call getarg(1, filename) !! NOTES !! Before doing anything else, we check that our file is a valid crystallographic !! file. To do it, we use the module etsf_io_file and its routine !! etsf_io_file_check(). This routine will open the given file and check that it !! machtes one or several requirements (see flags in ETSF_IO_VALIDITY_FLAGS). Flags !! can be added to form a complex validation on several specifications. !! !! If an error occurs, we transform the error data to a string and output it on !! the standard error. !! !! SOURCE call etsf_io_file_check(trim(filename), etsf_crystallographic_data, & & lstat, error_data) if (.not. lstat) then write(0, *) "Error: invalid input file, it does not match crystallographic" write(0, *) " requirements. Given reason:" call etsf_io_low_error_to_str(error_string, error_data) write(0, "(A)") trim(error_string) stop end if !! NOTES !! Now that our file is valid, we will follow a step by step procedure to !! reopen it, read the dimensions, allocate our temporary arrays, read the required !! informations, get the atoms names, close the file and output the informations !! in XYZ format. !! !! SOURCE call etsf_io_low_open_read(ncid, trim(filename), lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_to_str(error_string, error_data) write(0, "(A)") trim(error_string) stop end if !! NOTES !! The dimensions are read and stored into dims_data. !! !! SOURCE call etsf_io_dims_get(ncid, dims_data, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_to_str(error_string, error_data) write(0, "(A)") trim(error_string) stop end if !! NOTES !! We allocate the local arrays where to put the read informations. !! !! SOURCE allocate(primitive_vectors(dims_data%number_of_cartesian_directions, & & dims_data%number_of_vectors)) allocate(reduced_atom_positions(dims_data%number_of_reduced_dimensions, & & dims_data%number_of_atoms)) allocate(atom_species(dims_data%number_of_atoms)) allocate(atom_names(dims_data%number_of_atom_species)) geometry_data%primitive_vectors => primitive_vectors geometry_data%reduced_atom_positions => reduced_atom_positions geometry_data%atom_species => atom_species !! NOTES !! We get the informations from the NetCDF file for the pointers that have been !! associated in geometry_data. !! !! SOURCE call etsf_io_geometry_get(ncid, geometry_data, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_to_str(error_string, error_data) write(0, "(A)") trim(error_string) stop end if !! NOTES !! We use the high level routine that get the names of atoms. If the file is valid, !! it always returns string informations (into @atom_names), but atomic numbers can !! also be returned as double values in an optional array (see @atom_numbers). We !! don't need here the double values, so we don't use the optional argument. !! !! SOURCE call etsf_io_tools_get_atom_names(ncid, atom_names, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_to_str(error_string, error_data) write(0, "(A)") trim(error_string) stop end if !! NOTES !! We don't forget to close the file. !! !! SOURCE call etsf_io_low_close(ncid, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_to_str(error_string, error_data) write(0, "(A)") trim(error_string) stop end if !! NOTES !! Finally we output informations in XYZ format. !! !! SOURCE write(*, "(I0)") dims_data%number_of_atoms write(*, "(3A)") "Converted from '", trim(filename), "'" do i_atom = 1, dims_data%number_of_atoms, 1 coord(1) = primitive_vectors(1, 1) * reduced_atom_positions(1, i_atom) + & & primitive_vectors(2, 1) * reduced_atom_positions(2, i_atom) + & & primitive_vectors(3, 1) * reduced_atom_positions(3, i_atom) coord(2) = primitive_vectors(1, 2) * reduced_atom_positions(1, i_atom) + & & primitive_vectors(2, 2) * reduced_atom_positions(2, i_atom) + & & primitive_vectors(3, 2) * reduced_atom_positions(3, i_atom) coord(3) = primitive_vectors(1, 3) * reduced_atom_positions(1, i_atom) + & & primitive_vectors(2, 3) * reduced_atom_positions(2, i_atom) + & & primitive_vectors(3, 3) * reduced_atom_positions(3, i_atom) write(*, "(A,3E16.6)") trim(atom_names(atom_species(i_atom))), coord end do deallocate(primitive_vectors) deallocate(reduced_atom_positions) deallocate(atom_species) deallocate(atom_names) end program convert_to_xyz !!*** etsf_io-1.0.3/src/tutorials/create_a_crystal_den_file.f900000644000353400050630000002322610656546454020401 00000000000000!!****e* etsf_io_tutorials/create_a_crystal_den_file !! NAME !! create_a_crystal_den_file !! !! FUNCTION !! In this example, we will describe how to use the etsf_io_data_init() routine. !! This routine creates a file, conforming to the ETSF specifications, with !! several uninitialised variables in it. Then we will see how to write values !! into this file, using etsf_io_data_write(). !! !! To compile this exemple, use (assuming default installation paths): !! ${F90} -I/opt/include/${F90} -o create_a_crystal_den_file create_a_crystal_den_file.f90 !! -L/opt/lib -letsf_io -L/usr/lib -lnetcdf !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! SOURCE program create_a_crystal_den_file use etsf_io integer :: i !! NOTES !! All routines from the group level requires two output arguments: !! * lstat which is a logical. When .false. something goes wrong in !! the routine and the action is aborted. No actions are atomic, which !! means that if lstat is .false., the status of the NetCDF file (what !! have been done) is not guarantee. !! * error_data which a of type #etsf_io_low_error. It contains many informations !! about the error if lstat is .false.. One can use etsf_io_low_error_to_str !! to get a character(len = 1024) describing the error, or one can implement !! one itself since the type is public and documented. !! !! SOURCE logical :: lstat type(etsf_io_low_error) :: error_data !! NOTES !! To create a NetCDF, we need to give at creation time all the dimensions that !! define the variables. The file will then be allocated on disk and may be write !! with values later. All dimensions declared in the ETSF specifications are stored !! in a type called etsf_dims. Some of these dimensions are fixed by the specifications !! such as character_string_length and will be set by the etsf_io_data_init() routine itself. !! Other values are free to be chosen. !! !! SOURCE type(etsf_dims) :: dims !! NOTES !! To write values in one call into an already defined ETSF file, the type etsf_groups !! is used as a container for several groups. Here our container will have associated !! pointers on an etsf_geometry and an etsf_main. So we declare them. All the structures !! used in this library are only containers and do not have the allocated memory. This !! is done to avoid memory duplication when using the library with a code with its own !! variables. So we also need some variables (in a real case, they are declared in !! the main program) to stored our density and geometric informations. !! !! SOURCE ! Specific variables required by the library type(etsf_groups_flags) :: flags type(etsf_groups) :: groups type(etsf_geometry), target :: geometry type(etsf_main), target :: main ! Variables that are declared in the main program in a real case double precision, allocatable, target :: density(:) integer, target :: space_group double precision, target :: primitive_vector(3, 3) double precision, allocatable, target :: reduced_atom_positions(:,:) integer, allocatable, target :: atom_species(:) character(len=2), allocatable, target :: chemical_symbols(:) integer, allocatable, target :: reduced_symmetry_matrices(:,:,:) double precision, allocatable, target :: reduced_symmetry_translations(:,:) !! NOTES !! We will create for example a file for the density !! of the silane molecule, without spin nor spin-orbit, 1 k point. !! We imagine that the molecule no symmetry except identity. !! !! SOURCE dims%max_number_of_coefficients = 1400 dims%max_number_of_states = 6 dims%number_of_atoms = 5 dims%number_of_atom_species = 2 dims%number_of_components = 1 dims%number_of_grid_points_vector1 = 36 dims%number_of_grid_points_vector2 = 36 dims%number_of_grid_points_vector3 = 36 dims%number_of_kpoints = 1 dims%number_of_spinor_components = 1 dims%number_of_spins = 1 dims%number_of_symmetry_operations = 1 !! NOTES !! Now that dimensions have been stored in the appropriated structure, we can call the !! etsf_io_data_init() routine itself. The 'groups' argument is very important !! It will tell which variables will we allocated !! on disk. All variables are gathered by groups and one can choose one or several !! groups to be defined. To do it, use the flags from #FLAGS_VARIABLES, !! in a summation for each group in the etsf_groups_flags structure. By default !! no group will be defined, to add the geometry group, we will use the value !! etsf_geometry_all (from #FLAGS_VARIABLES) ; and to add the density variable (from !! the main group), and only this one, we will use etsf_main_denisty. !! !! Other arguments of the routine are quite easy to understand. The optional k_dependent !! argument is here to handle the case of reduced_coordinates_of_plane_waves which !! shape depends on the value of this attribute. If k_dependent is given .false. (default !! is .true.), then all variables with this attribute will be labelled "no" and the !! variable reduced_coordinates_of_plane_waves will be a two dimensional array. !! !! SOURCE flags%geometry = etsf_geometry_all flags%main = etsf_main_density call etsf_io_data_init("create_a_crystal_den_file.nc", flags, dims, & & "Tutorial ETSF_IO, create a density file", & & "Created by the tutorial example of the library", & & lstat, error_data) !! NOTES !! The required variables for a density file are in etsf_geometry and !! in etsf_main, that's why the groups argument is the sum of the two flags. !! !! We can now, handle the error, if one occured. The method etsf_io_low_error_handle() !! is used to print the contains of an error type on the standrard output. If one is !! interested on printing the error on something different than the standard output, !! one should convert the error into a character(len = 1024) with etsf_io_low_error_to_str() !! before. !! SOURCE if (.not. lstat) then call etsf_io_low_error_handle(error_data) stop end if !! NOTES !! At this time of the example, the disk space to store the density and the geometric !! informations has been reserved. In a real case, we let the main program computing !! the density and setting up the geometric informations. !! SOURCE ! The main program allocate memory for its computation. allocate(density(36 * 36 * 36)) allocate(reduced_atom_positions(3,5)) allocate(atom_species(5)) allocate(chemical_symbols(2)) allocate(reduced_symmetry_matrices(3, 3, 1)) allocate(reduced_symmetry_translations(3, 1)) ! The main program compute all symmetries and set up the positions... space_group = 1 primitive_vector = reshape( (/ 10, 0, 0, 0, 10, 0, 0, 0, 10 /), (/ 3, 3 /)) reduced_symmetry_matrices = reshape( (/ 1, 0, 0, 0, 1, 0, 0, 0, 1 /), (/ 3, 3, 1 /)) reduced_symmetry_translations = reshape( (/ 0, 0, 0 /), (/ 3, 1 /)) reduced_atom_positions = reshape( (/ 0.5d0, 0.5d0, 0.5d0, & & 0.6d0, 0.6d0, 0.6d0, & & 0.6d0, 0.4d0, 0.4d0, & & 0.4d0, 0.4d0, 0.6d0, & & 0.4d0, 0.6d0, 0.4d0 /), (/ 3, 5 /)) atom_species = (/ 2, 1, 1, 1, 1 /) chemical_symbols = (/ "H ", "Si" /) ! We compute the density with a powerful algorithm. density = (/ (0.d0 + i, i = 1, 36 * 36 * 36) /) !! NOTES !! Before calling the etsf_io_data_write() routine, we associate the pointers of our !! group types to the main program memory data. Only associated pointers will be written. !! All other defined variables will be let untouched. Some variable are defined with !! a type called etsf_io_low_var_double or etsf_io_low_var_integer. These variables !! are arrays which could have a different shape in the main program and in the !! specifications. For instance, our density is 1D only whereas in the specifications !! the density is 5D. So we use the attribute %data1D of the structure !! etsf_io_low_var_double for the density. This will work because data in the main program !! memory has the same number of elements than the space defined in the ETSF file AND !! data are ordered in the same way (elements along X axis are varying quicker than !! along Y or Z). !! SOURCE ! We associate the geometry geometry%space_group => space_group geometry%primitive_vectors => primitive_vector geometry%reduced_symmetry_matrices => reduced_symmetry_matrices geometry%reduced_symmetry_translations => reduced_symmetry_translations geometry%atom_species => atom_species geometry%reduced_atom_positions => reduced_atom_positions geometry%chemical_symbols => chemical_symbols ! We associate the main data ! We don't want to dupplicate the density data even if ours is 1D ! and ETSF is 5D, so we use the unformatted pointer in the etsf_main ! structure. main%density%data1D => density ! We associate our two group in the container. groups%geometry => geometry groups%main => main ! We write. call etsf_io_data_write("create_a_crystal_den_file.nc", & & groups, lstat, error_data) ! We handle the error if (.not. lstat) then call etsf_io_low_error_handle(error_data) stop end if ! The main program will deallocate its own memory. deallocate(density) deallocate(reduced_atom_positions) deallocate(atom_species) deallocate(chemical_symbols) deallocate(reduced_symmetry_matrices) deallocate(reduced_symmetry_translations) end program create_a_crystal_den_file !!*** etsf_io-1.0.3/src/tutorials/mix_ETSF_and_non_ETSF.f900000644000353400050620000002330510656546465017202 00000000000000!!****e* etsf_io_tutorials/mix_ETSF_and_non_ETSF !! NAME !! mix_ETSF_and_non_ETSF !! !! FUNCTION !! This tutorial is based on the first tutorial that create a density !! file. In this example, we introduce how to mix ETSF variables (the !! density) and non-ETSF variables (user defined, program dependent values...). !! !! The main difference is to use the etsf_io__put() routines instead !! of the all-in-one etsf_io_data_write() as introduced in the first tutorial. !! The changed lines of the first tutorial are kept as commentaries for comparison !! purposes. !! !! To compile this exemple, use (assuming default installation paths): !! ${F90} -I/opt/include/${F90} -o mix_ETSF_and_non_ETSF mix_ETSF_and_non_ETSF.f90 !! -L/opt/lib -letsf_io_utils -letsf_io -L/usr/lib -lnetcdf !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! SOURCE program mix_ETSF_and_non_ETSF use etsf_io_low_level use etsf_io integer :: i !! NOTES !! In the variable declarations relative to ETSF_IO, the etsf_group structure !! is not used anymore, since the def and put actions will be more atomic !! (but not as atomic as handling each variable). !! !! SOURCE integer :: ncid logical :: lstat type(etsf_io_low_error) :: error_data type(etsf_groups_flags) :: flags type(etsf_dims) :: dims ! Specific variables required by the library !FIRST# type(etsf_groups) :: groups type(etsf_geometry), target :: geometry type(etsf_main), target :: main !! NOTES !! The variable declared in the main program are left unchanged. !! !! SOURCE ! Variables that are declared in the main program in a real case double precision, allocatable, target :: density(:) integer, target :: space_group double precision, target :: primitive_vector(3, 3) double precision, allocatable, target :: reduced_atom_positions(:,:) integer, allocatable, target :: atom_species(:) character(len=2), allocatable, target :: chemical_symbols(:) integer, allocatable, target :: reduced_symmetry_matrices(:,:,:) double precision, allocatable, target :: reduced_symmetry_translations(:,:) !! NOTES !! The definition of the dimensions is still the same !! !! SOURCE dims%max_number_of_coefficients = 1400 dims%max_number_of_states = 6 dims%number_of_atoms = 5 dims%number_of_atom_species = 2 dims%number_of_components = 1 dims%number_of_grid_points_vector1 = 36 dims%number_of_grid_points_vector2 = 36 dims%number_of_grid_points_vector3 = 36 dims%number_of_kpoints = 1 dims%number_of_spinor_components = 1 dims%number_of_spins = 1 dims%number_of_symmetry_operations = 1 !! NOTES !! The declaration of the file is almost left unchanged. A file is allocated on disk !! with the given dimensions (see the dims variable). !! !! But, the main group is not defined here. This is done because the main group !! (density, coefficients of wavefunctions...) in the ETSF_IO specifications !! must be declared last. !! !! SOURCE !FIRST# the etsf_grp_main was declared here. flags%geometry = etsf_geometry_all flags%main = etsf_main_none call etsf_io_data_init("mix_ETSF_and_non_ETSF.nc", flags, dims, & & "Tutorial ETSF_IO, create a density file", & & "Created by the tutorial example of the library", & & lstat, error_data, overwrite = .true.) if (.not. lstat) then call etsf_io_low_error_handle(error_data) stop end if !! NOTES !! At this time of the example, the disk space to store the density and the geometric !! informations has been reserved. In a real case, we let the main program computing !! the density and setting up the geometric informations. !! SOURCE ! The main program allocate memory for its computation. allocate(density(36 * 36 * 36)) allocate(reduced_atom_positions(3,5)) allocate(atom_species(5)) allocate(chemical_symbols(2)) allocate(reduced_symmetry_matrices(3, 3, 1)) allocate(reduced_symmetry_translations(3, 1)) ! The main program compute all symmetries and set up the positions... space_group = 1 primitive_vector = reshape( (/ 10, 0, 0, 0, 10, 0, 0, 0, 10 /), (/ 3, 3 /)) reduced_symmetry_matrices = reshape( (/ 1, 0, 0, 0, 1, 0, 0, 0, 1 /), (/ 3, 3, 1 /)) reduced_symmetry_translations = reshape( (/ 0, 0, 0 /), (/ 3, 1 /)) reduced_atom_positions = reshape( (/ 0.5d0, 0.5d0, 0.5d0, & & 0.6d0, 0.6d0, 0.6d0, & & 0.6d0, 0.4d0, 0.4d0, & & 0.4d0, 0.4d0, 0.6d0, & & 0.4d0, 0.6d0, 0.4d0 /), (/ 3, 5 /)) atom_species = (/ 2, 1, 1, 1, 1 /) chemical_symbols = (/ "H ", "Si" /) ! We compute the density with a powerful algorithm. density = (/ (0.d0 + i, i = 1, 36 * 36 * 36) /) !! NOTES !! The associations between the structures used in the group level and !! variable in the main program memory are also kept. Only the gathering of !! all groups in the etsf_groups structure is not done. !! SOURCE ! We associate the geometry geometry%space_group => space_group geometry%primitive_vectors => primitive_vector geometry%reduced_symmetry_matrices => reduced_symmetry_matrices geometry%reduced_symmetry_translations => reduced_symmetry_translations geometry%atom_species => atom_species geometry%reduced_atom_positions => reduced_atom_positions geometry%chemical_symbols => chemical_symbols ! We associate the main data ! We don't want to dupplicate the density data even if ours is 1D ! and ETSF is 5D, so we use the unformatted pointer in the etsf_main ! structure. main%density%data1D => density !FIRST# ! We associate our two group in the container. !FIRST# groups%geometry => geometry !FIRST# groups%main => main !! NOTES !! The write action is modified. We prefer to do it to avoid to open the file !! for the ETSF variables, close it, and reopen it for the non-ETSF variable. !! This is of course possible, but the idea of this tutorial is to show how !! to use a lower level of access for the ETSF variables. !! !! Then, we open the created file with etsf_io_low_open_modify(). !! The file is then in a define mode, so we can easily define the non-ETSF !! variables. !! !! SOURCE ! Open file for writing call etsf_io_low_open_modify(ncid,"mix_ETSF_and_non_ETSF.nc", & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_handle(error_data) stop end if ! We define some private non-ETSF variables (and dimensions if necessary). call etsf_io_low_def_var(ncid, "age_of_captain", etsf_io_low_integer, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_handle(error_data) stop end if call etsf_io_low_write_dim(ncid, "number_of_captains_children", 2, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_handle(error_data) stop end if call etsf_io_low_def_var(ncid, "age_of_captains_children", etsf_io_low_integer, & & (/ "number_of_captains_children" /), lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_handle(error_data) stop end if !! NOTES !! Now that the non-ETSF variables has been added, we can defined the main !! ETSF variables that will be at the end of the file, as required in the !! specifications. !! !! SOURCE call etsf_io_main_def(ncid, lstat, error_data, flags = etsf_main_density) if (.not. lstat) then call etsf_io_low_error_handle(error_data) stop end if !! NOTES !! The all-in-one routine etsf_io_data_write() is replaced here by a group per !! group put action. !! !! SOURCE ! We write the ETSF variable with the group methods. call etsf_io_geometry_put(ncid, geometry, lstat, error_data) !FIRST# call etsf_io_data_write("create_a_crystal_den_file.nc", & !FIRST# & etsf_grp_main + etsf_grp_geometry, & !FIRST# & groups, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_handle(error_data) stop end if call etsf_io_main_put(ncid, main, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_handle(error_data) stop end if !! NOTES !! After that, we change the file status for write access with !! etsf_io_low_set_write_mode() (this is automatically done by the put() !! routines in the group level. The non-ETSF variables are written. !! !! SOURCE ! We switch to write mode. call etsf_io_low_set_write_mode(ncid, lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_handle(error_data) stop end if ! We write the non-ETSF variables by hand. call etsf_io_low_write_var(ncid, "age_of_captain", 42, & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_handle(error_data) stop end if call etsf_io_low_write_var(ncid, "age_of_captains_children", (/ 12, 13 /), & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_handle(error_data) stop end if !! NOTES !! We don't forget to close the file! !! !! SOURCE call etsf_io_low_close(ncid, lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_handle(error_data) stop end if ! The main program will deallocate its own memory. deallocate(density) deallocate(reduced_atom_positions) deallocate(atom_species) deallocate(chemical_symbols) deallocate(reduced_symmetry_matrices) deallocate(reduced_symmetry_translations) end program mix_ETSF_and_non_ETSF !!*** etsf_io-1.0.3/src/tutorials/read_a_file.f900000644000353400050620000002111710656546510015447 00000000000000!!****e* etsf_io_tutorials/read_a_file !! NAME !! read_a_file !! !! FUNCTION !! In this example, we will describe how to read some variables from a file. !! This is a basic tutorial where the common ETSF routines (low level and !! specification level) will be used. We will see how to handle errors. !! !! This tutorial assume that the second tutorial (read_write_sub_access) has been !! done and has produced its file (read_write_sub_access.nc). !! !! To compile this exemple, use (assuming default installation paths): !! ${F90} -I/opt/include/${F90} -o read_a_file read_a_file.f90 !! -L/opt/lib -letsf_io -letsf_io_utils -L/usr/lib -lnetcdf !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! SOURCE program read_a_file use etsf_io_low_level use etsf_io use etsf_io_tools integer :: i, j, k logical :: symmetry ! Variables related to ETSF reading ! --------------------------------- ! An id to access the read file. integer :: ncid ! A flag for all etsf_io routine to know if everything went right. logical :: lstat ! The storage for the detailled error. type(etsf_io_low_error) :: error_data ! The ETSF_IO structure to store all relevant dimensions. type(etsf_dims) :: dims ! The ETSF_IO structure to store all the split definitions. type(etsf_split) :: split ! The ETSF_IO structure to store the basis set and the k points definitions. type(etsf_kpoints) :: kpoints type(etsf_basisdata) :: basisdata type(etsf_main) :: main ! Variables independent from ETSF ! ------------------------------- ! This array will store the wavefunctions. double precision, allocatable, target :: pw_coeff(:, :, :, :) ! Variables that will be used in the basisdata group. integer, allocatable, target :: number_of_coefficients(:) integer, allocatable, target :: red_coord_pw(:, :, :) ! Variables that will be used in the kpoints group. double precision, allocatable, target :: red_coord_kpt(:, :) double precision, allocatable, target :: kpoint_weights(:) ! Variable to store the definition of the basis set character(len = etsf_charlen), target :: basis !! NOTES !! The file is simply open using a low level routine. We simply want to read !! its content so we specify it in the routine we use. !! !! By default, this routine will check that the header is a valid ETSF one, with the !! right Convention global attribute, as for the file_format global attribute. !! !! We also check that the file is at least version 2.1 using the optional argument !! @version_min. !! SOURCE call etsf_io_low_open_read(ncid, "read_write_sub_access.nc", lstat, & & error_data = error_data, version_min = 2.1) if (.not. lstat) then ! We use the default writing of the error to stderr. call etsf_io_low_error_handle(error_data) stop end if !! NOTES !! We consider that the file contains the wavefunction description in plane waves. !! We thus read the dimensions first to allocate the program arrays. !! SOURCE call etsf_io_dims_get(ncid, dims, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_handle(error_data) stop end if !! NOTES !! The coefficients of the wavefunctions may be splitted. We know this, thanks to !! the my_ attributes of the dims structure we have just read. !! !! In the case of splitting, we allocate a new structure called split with !! etsf_io_split_allocate() and we read its contents with etsf_io_split_get(). In !! the case where the file contains no split informations, then all these routines !! will do nothing. !! !! A split that has been allocated must be freed after use with etsf_io_split_free(). !! Since the split informations are not relevent for the purpose of this tutorial !! we will free it just after having output some informations to the user. !! SOURCE call etsf_io_split_allocate(split, dims) call etsf_io_split_get(ncid, split, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_handle(error_data) stop end if ! We warn the user. write(*,"(A,L1)") " Split over kpoints : ", associated(split%my_kpoints) write(*,"(A,L1)") " Split over spins : ", associated(split%my_spins) write(*,"(A,L1)") " Split over states : ", associated(split%my_states) write(*,"(A,L1)") " Split over coefficients: ", associated(split%my_coefficients) ! We don't use the split informations further so we free them. call etsf_io_split_free(split) !! NOTES !! Before reading the coefficients of wavefunctions, we will get the definition !! of the basis set and the kpoints definitions. !! !! This is done using the structure of types etsf_kpoints and etsf_basisdata and !! the etsf_io level etsf_io_kpoints_get() and etsf_io_basisdata_get(). As for the !! put routines, we associate the variables we want to read and only them. !! !! Then we read the coefficients as all other variables, using the main group. !! SOURCE ! The main program allocate memory for storage of the basis set. allocate(pw_coeff(dims%real_or_complex_coefficients, & & dims%max_number_of_coefficients, & & dims%max_number_of_states, & & dims%number_of_spins * & & dims%number_of_kpoints * & & dims%number_of_spinor_components)) allocate(number_of_coefficients(dims%number_of_kpoints)) allocate(red_coord_pw(dims%number_of_reduced_dimensions, & & dims%max_number_of_coefficients, dims%number_of_kpoints)) allocate(red_coord_kpt(dims%number_of_reduced_dimensions, dims%number_of_kpoints)) allocate(kpoint_weights(dims%number_of_kpoints)) ! We set the associations. kpoints%reduced_coordinates_of_kpoints => red_coord_kpt kpoints%kpoint_weights => kpoint_weights basisdata%basis_set => basis basisdata%reduced_coordinates_of_plane_waves%data3D => red_coord_pw basisdata%number_of_coefficients => number_of_coefficients main%coefficients_of_wavefunctions%data4D => pw_coeff ! We call the get routines. call etsf_io_kpoints_get(ncid, kpoints, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_handle(error_data) stop end if call etsf_io_basisdata_get(ncid, basisdata, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_handle(error_data) stop end if call strip(basis) call etsf_io_main_get(ncid, main, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_handle(error_data) stop end if !! NOTES !! We poll the file using an etsf_io_tools routine to know if the number of !! coefficients have been reduced using the time reversal symmetry at Gamma. !! SOURCE call etsf_io_tools_get_time_reversal_symmetry(ncid, symmetry, & & lstat, error_data) if (.not. lstat) then call etsf_io_low_error_handle(error_data) stop end if !! NOTES !! The following is just output on screen. !! SOURCE ! We output the informations to the user. write(*,*) write(*,"(A,I0)") " Number of k points : ", dims%number_of_kpoints write(*,*) "k point weights : ", kpoints%kpoint_weights write(*,"(A)") " k point coordinates : " do i = 1, dims%number_of_kpoints, 1 write(*, "(3F10.5)") red_coord_kpt(:, i) end do write(*,*) write(*,"(A,A)") " Used basis set : ", trim(basis) write(*,"(A,L1)") " Time reversal symmetry : ", symmetry write(*,"(A,I0)") " Max number of coeffs : ", dims%max_number_of_coefficients do i = 1, dims%number_of_kpoints, 1 write(*,*) write(*,"(A,I0)") " Informations at k point: ", i write(*,"(A,I0)") " Number of coefficients : ", number_of_coefficients(i) write(*,"(A)") " Coordinates of g vector: " do j = 1, min(dims%max_number_of_coefficients, 5), 1 write(*, "(3I5,A,I2,A)") red_coord_pw(:, j, i), " (g vector ", j, ")" end do if (j < dims%max_number_of_coefficients) then write(*,*) " ..." end if write(*,"(A)") " Coeffs of wavefunctions: " do k = 1, dims%max_number_of_states, 1 write(*,"(A,I0)") " Band number : ", k do j = 1, min(dims%max_number_of_coefficients, 5), 1 write(*, "(2F12.5,A,I2,A)") pw_coeff(:, j, k, i), " (g vector ", j, ")" end do if (j < dims%max_number_of_coefficients) then write(*,*) " ..." end if end do end do ! We deallocate everything deallocate(pw_coeff) deallocate(number_of_coefficients) deallocate(red_coord_pw) deallocate(kpoint_weights) deallocate(red_coord_kpt) end program read_a_file !!*** etsf_io-1.0.3/src/tutorials/read_write_sub_access.f900000644000353400050630000002422410656546517017566 00000000000000!!****e* etsf_io_tutorials/read_write_sub_access !! NAME !! read_write_sub_access !! !! FUNCTION !! In this example, we will describe how to read or write sub part of arrays. !! For example, to write the wavefunction each k point per k point, we need to !! use the wfs_pw__kpoint_access. This tutorial will show how to use all this !! kind of __something_access attributes existing in the different !! groups (see etsf_main for instance). !! !! To compile this exemple, use (assuming default installation paths): !! ${F90} -I/opt/include/${F90} -o read_write_sub_access read_write_sub_access.f90 !! -L/opt/lib -letsf_io -letsf_io_utils -L/usr/lib -lnetcdf !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! SOURCE program read_write_sub_access use etsf_io use etsf_io_tools integer :: i, i_kpt, ncid !! NOTES !! All groups than contain arrays that can have a sub access (on spin or on k points) !! have attributes built on the following scheme: !! __[spin|kpoint]_access !! When all spin or k points values must be read or write at once, one can let !! the default value (etsf_no_sub_access) ; but if one want to read or write only !! one spin or one k point, one should put the desired value in this attribute. !! !! All this tutorial is oriented for writing, but it can be adapted easily !! for reading. !! !! In the beginning of this tutorial, we define an ETSF file with 2 kpoints. This !! file will contain the kpoints group (etsf_kpoints), the group of wave data !! (etsf_basisdata) and the main group (etsf_main) with only !! the coefficient_of_wavefunctions array. !! !! As shown in the first tutorial (create_a_crystal_den_file), the classical !! status variable lstat and error_data are created. !! SOURCE logical :: lstat type(etsf_io_low_error) :: error_data ! Specific variables required by the library type(etsf_groups_flags) :: flags type(etsf_dims) :: dims type(etsf_kpoints) :: kpoints type(etsf_basisdata) :: basisdata type(etsf_main) :: main !! NOTES !! The following variables are used in the main program to store the informations. !! The pointers in the library will be used to point on them. Only some parts of !! each group will be used. !! * coef_pw: is a two dimensional array that store all the coefficients of !! plane waves, but only for one k point. !! * red_coord_pw_k: is a two dimensional array that stores the coordinates of plane !! waves for each band, but restricted on one k point. !! !! SOURCE ! Variables that are declared in the main program in a real case double precision, allocatable, target :: coef_pw_k(:, :) ! Variables that will be used in the basisdata group. integer, allocatable, target :: number_of_coefficients(:) integer, allocatable, target :: red_coord_pw_k(:, :) ! Variables that will be used in the kpoints group. double precision, allocatable, target :: red_coord_kpt(:, :) double precision, allocatable, target :: kpoint_weights(:) ! Variable to store the definition of the basis set character(len = etsf_charlen), target :: basis !! NOTES !! We set the dimension (2 k points, no spin, 5 bands and 100 planewave !! coefficients). !! !! SOURCE dims%max_number_of_coefficients = 100 dims%max_number_of_states = 5 dims%number_of_kpoints = 2 dims%number_of_spinor_components = 1 dims%number_of_spins = 1 dims%real_or_complex_coefficients = 2 !! NOTES !! As in the first tutorial (create_a_crystal_den_file), we use the high level !! routine etsf_io_data_init to define all dimensions and variables for the file !! we want to create. !! !! In that case, we will use a precise definition of variables, not creating all !! variables of each included groups. For instance, the basis set will be limited !! to the required variables for a plane wave description. !! !! SOURCE flags%basisdata = etsf_basisdata_basis_set + & & etsf_basisdata_red_coord_pw + & & etsf_basisdata_n_coeff flags%kpoints = etsf_kpoints_red_coord_kpt + etsf_kpoints_kpoint_weights flags%main = etsf_main_wfs_coeff call etsf_io_data_init("read_write_sub_access.nc", flags, dims, & & "Tutorial ETSF_IO, use sub access to read or write", & & "Created by the tutorial example of the library", & & lstat, error_data) if (.not. lstat) then call etsf_io_low_error_handle(error_data) stop end if !! NOTES !! At this time of the example, the disk space to store the wave-function !! informations has been reserved. In a real case, we let the main program computing !! the plane waves and the arrays that describe them. !! SOURCE write(basis, "(A)") "plane_waves" ! The main program allocate memory for its computation. allocate(coef_pw_k(2, dims%max_number_of_coefficients * dims%max_number_of_states)) allocate(number_of_coefficients(dims%number_of_kpoints)) allocate(red_coord_pw_k(3, dims%max_number_of_coefficients)) allocate(red_coord_kpt(3, dims%number_of_kpoints)) allocate(kpoint_weights(dims%number_of_kpoints)) ! The main program compute all coordinates for k points and plane waves... red_coord_kpt = reshape( (/ 0.0d0, 0.0d0, 0.0d0, & & 0.5d0, 0.5d0, 0.5d0 /), (/ 3, 2 /)) kpoint_weights = (/ 0.5d0, 0.5d0 /) number_of_coefficients = (/ dims%max_number_of_coefficients, & & dims%max_number_of_coefficients /) !! NOTES !! To read or write with sub access, there is no high level routine such as !! etsf_io_data_write(). Then, we need to open the file and set it a write state. !! The way to open a file for writing is to use the routine etsf_io_low_open_modify() !! and then to call etsf_io_low_set_write_mode(). The first call will check that the !! header is correct. !! !! When the file is not needed anymore, the ncid id must be released and the file !! closed, using etsf_io_low_close(). This is mandatory because without this call !! the write action may be not done. !! SOURCE ! Open file for writing call etsf_io_low_open_modify(ncid, "read_write_sub_access.nc", & & lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_handle(error_data) stop end if ! We switch to write mode. call etsf_io_low_set_write_mode(ncid, lstat, error_data = error_data) if (.not. lstat) then call etsf_io_low_error_handle(error_data) stop end if !! NOTES !! We begin the big loop on k points. In this loop, the main program will compute !! the plane waves and the coordinates of the coefficients. Then, it will use the !! library to write the values for the current k point. !! SOURCE do i_kpt = 1, dims%number_of_kpoints, 1 ! We compute the plane wave coefficient with the famous ! algorithm that works well. do i = 1, dims%max_number_of_coefficients, 1 red_coord_pw_k(:, i) = (/ -i, 0, i /) end do coef_pw_k(1, :) = (/ (i, i = 1, & & dims%max_number_of_coefficients * dims%max_number_of_states) /) coef_pw_k(2, :) = (/ (-i, i = 1, & & dims%max_number_of_coefficients * dims%max_number_of_states) /) !! NOTES !! We associate the pointers of groups we want to write with the data in memory. !! SOURCE ! We associate the data main%coefficients_of_wavefunctions%data2D => coef_pw_k ! We set the sub access. main%wfs_coeff__kpoint_access = i_kpt ! Idem for the reduced coordinates of coefficients. basisdata%reduced_coordinates_of_plane_waves%data2D => red_coord_pw_k basisdata%red_coord_pw__kpoint_access = i_kpt !! NOTES !! Now that all the arrays we want to write are associated, we can call the write !! routine. This routine will read automatically the __kpoint_access attribute !! and will check the dimensions of the associated arrays. !! SOURCE ! We use the group level write routine. call etsf_io_main_put(ncid, main, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_handle(error_data) stop end if call etsf_io_basisdata_put(ncid, basisdata, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_handle(error_data) stop end if ! End of the kpoint big loop. end do !! NOTES !! We write the other data that are independent of the kpoint loop. !! !! WARNINGS !! It is important to associate to nullify the already used pointers !! to avoid to write them again. !! SOURCE ! We set the associations. kpoints%reduced_coordinates_of_kpoints => red_coord_kpt kpoints%kpoint_weights => kpoint_weights basisdata%basis_set => basis basisdata%reduced_coordinates_of_plane_waves%data2D => null() basisdata%number_of_coefficients => number_of_coefficients ! We call the group level write routines. call etsf_io_kpoints_put(ncid, kpoints, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_handle(error_data) stop end if call etsf_io_basisdata_put(ncid, basisdata, lstat, error_data) if (.not. lstat) then call etsf_io_low_error_handle(error_data) stop end if !! NOTES !! We then set the use_time_reversal_at_gamma attribute for this file using !! the etsf_io_tools module. We write it after the other data since the routine !! will check that the basis set is indeed a plane wave one and the two variables !! impacted by this attributes must already exist. !! !! SOURCE call etsf_io_tools_set_time_reversal_symmetry(ncid, .false., lstat, error_data) ! We handle the error if (.not. lstat) then call etsf_io_low_error_handle(error_data) stop end if !! NOTES !! As said before, we need to close the file. !! SOURCE ! We close the file. call etsf_io_low_close(ncid, lstat, error_data) ! We handle the error if (.not. lstat) then call etsf_io_low_error_handle(error_data) stop end if ! The main program will deallocate its own memory. deallocate(coef_pw_k) deallocate(number_of_coefficients) deallocate(red_coord_pw_k) deallocate(red_coord_kpt) deallocate(kpoint_weights) end program read_write_sub_access !!*** etsf_io-1.0.3/src/tutorials/MPI_output_of_a_density.f900000644000353400050630000001575710656546477020057 00000000000000!!****e* etsf_io_tutorials/MPI_output_of_a_density !! NAME !! MPI_output_of_a_density !! !! FUNCTION !! In this example, we run an MPI computation a density (a centered gaussian), !! with a distribution of real space mesh through z planes among processes. The !! ETSF files will have a split definition on number_of_grid_points_vector3. !! !! To do it, almost every steps are the same than for the first tutorial !! (create_a_crystal_den_file), except that we have now an array (my_grid_points) !! that has the definition of the points our part of the density is defined. !! Then, we associate this array into a split (see etsf_split) definition and !! we use this split definition when the ETSF file is initialised with !! etsf_io_data_init(). !! !! To compile this example an MPI wrapper must be installed and assuming default !! installation paths for ETSF_IO, simply use: !! ${MPIF90} -I/opt/include/${F90} -o MPI_output_of_a_density MPI_output_of_a_density.f90 !! -L/opt/lib -letsf_io -L/usr/lib -lnetcdf !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !! SOURCE program MPI_output_of_a_density use etsf_io_low_level use etsf_io implicit none include "mpif.h" integer :: i, j, k, i_proc, n_proc, ierr integer :: my_number_of_planes character(len = 256) :: my_filename real :: x2, y2, z2 logical :: lstat type(etsf_io_low_error) :: error_data !! NOTES !! As explained in previous tutorials, the ETSF_IO library requires to defined some !! variable that are structures of pointers, or that store the dimensions of arrays. !! !! We have here a new structure: etsf_split. This structure acts a bit like group !! structures (like etsf_electrons) since it is a gathering of pointers. These !! pointers can be associated to the arrays that defined a local process definition !! of a split variable as defined in the specifications. !! !! SOURCE ! Specific variables required by the library type(etsf_dims) :: dims type(etsf_groups_flags) :: flags type(etsf_split) :: split type(etsf_groups) :: groups type(etsf_geometry), target :: geometry type(etsf_main), target :: main ! Variables that are declared in the main program in a real case double precision, allocatable, target :: density(:, :, :) integer, allocatable, target :: my_grid_points(:) double precision, target :: primitive_vector(3, 3) call MPI_INIT(ierr) call MPI_COMM_RANK(MPI_COMM_WORLD, i_proc, ierr) call MPI_COMM_SIZE(MPI_COMM_WORLD, n_proc, ierr) !! NOTES !! Here, we put all unused variables to etsf_no_dimension (see ETSF_IO_CONSTANTS) !! then, all these dimensions will not be defined in the output file and all !! depending variables will not be created. This should be used with care since !! all variables that may depend on a dimension that has been set to !! etsf_no_dimension, will silently be ignored by etsf_io_def_. !! !! SOURCE dims%max_number_of_angular_momenta = etsf_no_dimension dims%max_number_of_coefficients = etsf_no_dimension dims%max_number_of_projectors = etsf_no_dimension dims%max_number_of_states = etsf_no_dimension dims%number_of_atoms = etsf_no_dimension dims%number_of_atom_species = etsf_no_dimension dims%number_of_kpoints = etsf_no_dimension dims%number_of_spinor_components = etsf_no_dimension dims%number_of_spins = etsf_no_dimension dims%number_of_symmetry_operations = etsf_no_dimension dims%real_or_complex_coefficients = etsf_no_dimension dims%real_or_complex_gw_corrections = etsf_no_dimension dims%real_or_complex_potential = etsf_no_dimension dims%real_or_complex_wavefunctions = etsf_no_dimension dims%number_of_components = 1 dims%number_of_grid_points_vector1 = 36 dims%number_of_grid_points_vector2 = 36 dims%number_of_grid_points_vector3 = 120 dims%real_or_complex_density = 1 ! We compute here the number of planes my process will focus on. if (i_proc == n_proc - 1) then my_number_of_planes = 120 - 120 / n_proc * (n_proc - 1) else my_number_of_planes = 120 / n_proc end if !! NOTES !! Since we only focus on some z planes and not all, we set the number !! of planes we used, as explained in the specifications. To do it, we use !! the special dimensions my_, here my_number_of_grid_points_vect3. !! !! SOURCE dims%my_number_of_grid_points_vect3 = my_number_of_planes ! We compute the list of plane ids that will be handled by my process. allocate(my_grid_points(my_number_of_planes)) my_grid_points(:) = (/ (i + 1, & & i = i_proc * 120 / n_proc, min((i_proc + 1) * 120 / n_proc, 120)) /) !! NOTES !! The split variable is used by the library (as other groups) with only its !! associated pointers. Here, we split only on the z axis, so we associate !! my_grid_points_vector3. !! !! SOURCE split%my_grid_points_vector3 => my_grid_points !! NOTES !! This is the point where the ETSF file is created. It uses the same routine !! that the one presented in the first tutorial (create_a_crystal_den_file). The !! only difference here is that we pass the optional argument split_definition !! with the list of z planes our process is handling. !! !! SOURCE write(my_filename, "(A,I2.2,A)") "MPI_density_", i_proc, ".nc" flags%geometry = etsf_geometry_primitive_vectors flags%main = etsf_main_density call etsf_io_data_init(trim(my_filename), flags, dims, & & "Tutorial ETSF_IO, create a density file with MPI", & & "Created by the tutorial example of the library", & & lstat, error_data, overwrite = .true., split_definition = split) if (.not. lstat) then call etsf_io_low_error_handle(error_data) stop end if ! Computation of the gaussian density primitive_vector = 0.d0 primitive_vector(1, 1) = 18.d0 primitive_vector(2, 2) = 18.d0 primitive_vector(3, 3) = 60.d0 geometry%primitive_vectors => primitive_vector groups%geometry => geometry allocate(density(36, 36, my_number_of_planes)) main%density%data3D => density groups%main => main ! We put a gaussian in the density do k = 1, my_number_of_planes, 1 z2 = (real(my_grid_points(k) - 60) / 60.) ** 2 do j = 1, 36, 1 y2 = (real(j - 18) / 18.) ** 2 do i = 1, 36, 1 x2 = (real(i - 18) / 18.) ** 2 density(i, j, k) = exp(-(x2 + y2 + z2)) end do end do end do !! NOTES !! The write part is not modified by the usage of split data. !! !! SOURCE call etsf_io_data_write(trim(my_filename), groups, lstat, error_data) ! We handle the error if (.not. lstat) then call etsf_io_low_error_handle(error_data) stop end if ! Finalisation and deallocation. deallocate(my_grid_points) deallocate(density) call MPI_FINALIZE(ierr) end program MPI_output_of_a_density !!*** etsf_io-1.0.3/src/tutorials/README.f900000644000353400050620000000670010656550622014172 00000000000000!!****g* tutorials/etsf_io_tutorials !! NAME !! etsf_io_tutorials -- ESTF I/O examples and tutorials !! !! FUNCTION !! Tutorials are directly Fortran source code, highly commented, located in !! src/tutorials. These codes can be compiled and executed to create example !! files. !! !! The following tutorials are available: !! * Tutorial 1 - basics of file creation !! create_a_crystal_den_file, the first tutorial, is intended to explain the !! basics and the philosophy of this library. It details the first steps !! required to create a density file, using high level routines !! (etsf_io_data_). It shows how to use the pointers and the unformatted !! ones (used to map any shape arrays between the ETSF definition and the main !! program memory). !! * Tutorial 2 - advanced writing, sub-access on k point and spin !! read_write_sub_access, the second tutorial, introduces the group level !! routines and explain how to access only sub part of arrays. This sub access !! is possible when one array has a dimension on spin or k points. Then one can !! access data for one k point or spin at a time. This is controlled by some !! attributes in the concerned groups, called !! __[spin|kpoint]_access. In this tutorial a !! wave-function file is created and the coefficients of wave-functions are !! written for one k point at a time. !! * Tutorial 3 - a converter tool, usage of validity checks !! convert_to_xyz, the third tutorial, shows how to use high level modules !! etsf_io_file and etsf_io_tools to check the conformance of an input ETSF file !! on cristalographic specifications and then to read atomic coordinates and !! names to create a simple XYZ file. !! * Tutorial 4 - how to use split capabilities in conjonction with MPI? !! MPI_output_of_a_density, the fourth tutorial, shows how to use the split !! definitions as defined in the specifications to handle MPI computations. This !! is possible with the help of the etsf_split structure. This tutorial create a !! density file with a paralelisation on z planes. Each process compute a !! gaussian in its own z planes and create an ETSF file with a split on !! number_of_grid_points_vector3. Thanks to etsf_io the created files can be then !! gathered into one unique file. !! * Tutorial 5 - mixing ETSF and non-ETSF variables in file creation (tutorial 1 enhancement) !! mix_ETSF_and_non_ETSF, the fifth tutorial, is not focus on the low level API !! but it uses it in several areas. This tutorial shows how to write an ETSF file !! with additional non-ETSF variables. These variables are defined and written !! directly by using the low level API. Besides it also shows how to use the !! etsf_io__put() methods in the context of a concurrent list of ETSF and !! non-ETSF variables. !! * Tutorial 6 - simple read of a wavefunction file (continuation of tutorial 2) !! read_a_file, the sixth tutorial, introduces the read actions in a simple case. !! Here, we know that the file should contains the variables of a wavefunction !! description. This tutorial uses the file created by tutorial 2 but does not !! read it with sub access. Everything is read once as a bloc. !! !! COPYRIGHT !! Copyright (C) 2006, 2007 (Damien Caliste) !! This file is distributed under the terms of the !! GNU Lesser General Public License, see the COPYING file !! or http://www.gnu.org/copyleft/lesser.txt . !! !!*** etsf_io-1.0.3/tests/0000777000353400050620000000000011354151525011316 500000000000000etsf_io-1.0.3/tests/low_level/0000777000353400050620000000000011354151524013305 500000000000000etsf_io-1.0.3/tests/low_level/Makefile.am0000644000353400050630000000253210656544727015277 00000000000000vpath %.o $(top_builddir)/src/low_level test_dependencies = \ check_att_t01.nc \ check_var_t01.nc \ open_read_t01.nc \ open_read_t02.nc \ open_read_t03.nc \ open_read_t04.nc \ read_dim_t01.nc \ read_var_t01.nc EXTRA_DIST = \ check_att_t01.cdl \ open_read_t01.cdl \ open_read_t02.cdl \ open_read_t03.cdl \ open_read_t04.cdl \ read_var_t01.cdl \ $(test_dependencies) \ tests_run.sh AM_FCFLAGS = -I$(top_builddir)/src/low_level -I@NETCDF_CFLAGS@ check_PROGRAMS = tests_read \ tests_write tests_read_SOURCES = tests_read.f90 tests_read_LDFLAGS = -L$(top_builddir)/src/low_level tests_read_LDADD = -letsf_io_low_level tests_write_SOURCES = tests_write.f90 tests_write_LDFLAGS = -L$(top_builddir)/src/low_level tests_write_LDADD = -letsf_io_low_level TESTS = run CLEANFILES = run tests_read.log tests_write.log #dependencies tests_read.o: tests_read.f90 \ etsf_io_low_level.o tests_write.o: tests_write.f90 \ etsf_io_low_level.o #additional rules run: $(srcdir)/tests_run.sh tests_read.log tests_write.log \cp $(srcdir)/tests_run.sh run run-tests: tests_read.log tests_write.log cat *.log run-tests-read tests_read.log: $(test_dependencies) tests_read ./tests_read $(srcdir) | tee tests_read.log run-tests-write tests_write.log: $(test_dependencies) tests_write \rm -f open_create_t*.nc ./tests_write $(srcdir) | tee tests_write.log etsf_io-1.0.3/tests/low_level/Makefile.in0000644000353400050620000003512311354150420015264 00000000000000# Makefile.in generated by automake 1.10.1 from Makefile.am. # @configure_input@ # Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, # 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. # This Makefile.in is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY, to the extent permitted by law; without # even the implied warranty of MERCHANTABILITY or FITNESS FOR A # PARTICULAR PURPOSE. @SET_MAKE@ VPATH = @srcdir@ pkgdatadir = $(datadir)/@PACKAGE@ pkglibdir = $(libdir)/@PACKAGE@ pkgincludedir = $(includedir)/@PACKAGE@ am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd install_sh_DATA = $(install_sh) -c -m 644 install_sh_PROGRAM = $(install_sh) -c install_sh_SCRIPT = $(install_sh) -c INSTALL_HEADER = $(INSTALL_DATA) transform = $(program_transform_name) NORMAL_INSTALL = : PRE_INSTALL = : POST_INSTALL = : NORMAL_UNINSTALL = : PRE_UNINSTALL = : POST_UNINSTALL = : check_PROGRAMS = tests_read$(EXEEXT) tests_write$(EXEEXT) subdir = tests/low_level DIST_COMMON = $(srcdir)/Makefile.am $(srcdir)/Makefile.in ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 am__aclocal_m4_deps = $(top_srcdir)/config/m4/fortran.m4 \ $(top_srcdir)/configure.ac am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ $(ACLOCAL_M4) mkinstalldirs = $(install_sh) -d CONFIG_CLEAN_FILES = am_tests_read_OBJECTS = tests_read.$(OBJEXT) tests_read_OBJECTS = $(am_tests_read_OBJECTS) tests_read_DEPENDENCIES = tests_read_LINK = $(FCLD) $(AM_FCFLAGS) $(FCFLAGS) \ $(tests_read_LDFLAGS) $(LDFLAGS) -o $@ am_tests_write_OBJECTS = tests_write.$(OBJEXT) tests_write_OBJECTS = $(am_tests_write_OBJECTS) tests_write_DEPENDENCIES = tests_write_LINK = $(FCLD) $(AM_FCFLAGS) $(FCFLAGS) \ $(tests_write_LDFLAGS) $(LDFLAGS) -o $@ DEFAULT_INCLUDES = -I.@am__isrc@ FCCOMPILE = $(FC) $(AM_FCFLAGS) $(FCFLAGS) FCLD = $(FC) FCLINK = $(FCLD) $(AM_FCFLAGS) $(FCFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o \ $@ SOURCES = $(tests_read_SOURCES) $(tests_write_SOURCES) DIST_SOURCES = $(tests_read_SOURCES) $(tests_write_SOURCES) ETAGS = etags CTAGS = ctags DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) ACLOCAL = @ACLOCAL@ AMTAR = @AMTAR@ AR = @AR@ AUTOCONF = @AUTOCONF@ AUTOHEADER = @AUTOHEADER@ AUTOMAKE = @AUTOMAKE@ AWK = @AWK@ CYGPATH_W = @CYGPATH_W@ DEFS = @DEFS@ ECHO_C = @ECHO_C@ ECHO_N = @ECHO_N@ ECHO_T = @ECHO_T@ EXEEXT = @EXEEXT@ FC = @FC@ FCFLAGS = @FCFLAGS@ FCFLAGS_f90 = @FCFLAGS_f90@ FFLAGS = @FFLAGS@ INSTALL = @INSTALL@ INSTALL_DATA = @INSTALL_DATA@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ INSTALL_SCRIPT = @INSTALL_SCRIPT@ INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ LDFLAGS = @LDFLAGS@ LIBOBJS = @LIBOBJS@ LIBS = @LIBS@ LTLIBOBJS = @LTLIBOBJS@ MAKEINFO = @MAKEINFO@ MKDIR_P = @MKDIR_P@ MODULE_EXT = @MODULE_EXT@ NETCDF_CFLAGS = @NETCDF_CFLAGS@ OBJEXT = @OBJEXT@ PACKAGE = @PACKAGE@ PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ PACKAGE_NAME = @PACKAGE_NAME@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_VERSION = @PACKAGE_VERSION@ PATH_SEPARATOR = @PATH_SEPARATOR@ RANLIB = @RANLIB@ SET_MAKE = @SET_MAKE@ SHELL = @SHELL@ STRIP = @STRIP@ VERSION = @VERSION@ abs_builddir = @abs_builddir@ abs_srcdir = @abs_srcdir@ abs_top_builddir = @abs_top_builddir@ abs_top_srcdir = @abs_top_srcdir@ ac_ct_FC = @ac_ct_FC@ am__leading_dot = @am__leading_dot@ am__tar = @am__tar@ am__untar = @am__untar@ bindir = @bindir@ build_alias = @build_alias@ builddir = @builddir@ datadir = @datadir@ datarootdir = @datarootdir@ docdir = @docdir@ dvidir = @dvidir@ exec_prefix = @exec_prefix@ fc_type = @fc_type@ fc_version = @fc_version@ fc_wrap = @fc_wrap@ groupleveldocdir = @groupleveldocdir@ host_alias = @host_alias@ htmldir = @htmldir@ includedir = @includedir@ infodir = @infodir@ install_sh = @install_sh@ libdir = @libdir@ libexecdir = @libexecdir@ localedir = @localedir@ localstatedir = @localstatedir@ lowleveldocdir = @lowleveldocdir@ mandir = @mandir@ mkdir_p = @mkdir_p@ moduledir = @moduledir@ oldincludedir = @oldincludedir@ pdfdir = @pdfdir@ prefix = @prefix@ program_transform_name = @program_transform_name@ psdir = @psdir@ sbindir = @sbindir@ sharedstatedir = @sharedstatedir@ srcdir = @srcdir@ sysconfdir = @sysconfdir@ target_alias = @target_alias@ top_builddir = @top_builddir@ top_srcdir = @top_srcdir@ tutorialsdocdir = @tutorialsdocdir@ utilsdocdir = @utilsdocdir@ test_dependencies = \ check_att_t01.nc \ check_var_t01.nc \ open_read_t01.nc \ open_read_t02.nc \ open_read_t03.nc \ open_read_t04.nc \ read_dim_t01.nc \ read_var_t01.nc EXTRA_DIST = \ check_att_t01.cdl \ open_read_t01.cdl \ open_read_t02.cdl \ open_read_t03.cdl \ open_read_t04.cdl \ read_var_t01.cdl \ $(test_dependencies) \ tests_run.sh AM_FCFLAGS = -I$(top_builddir)/src/low_level -I@NETCDF_CFLAGS@ tests_read_SOURCES = tests_read.f90 tests_read_LDFLAGS = -L$(top_builddir)/src/low_level tests_read_LDADD = -letsf_io_low_level tests_write_SOURCES = tests_write.f90 tests_write_LDFLAGS = -L$(top_builddir)/src/low_level tests_write_LDADD = -letsf_io_low_level TESTS = run CLEANFILES = run tests_read.log tests_write.log all: all-am .SUFFIXES: .SUFFIXES: .f90 .o .obj $(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) @for dep in $?; do \ case '$(am__configure_deps)' in \ *$$dep*) \ cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh \ && exit 0; \ exit 1;; \ esac; \ done; \ echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu tests/low_level/Makefile'; \ cd $(top_srcdir) && \ $(AUTOMAKE) --gnu tests/low_level/Makefile .PRECIOUS: Makefile Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status @case '$?' in \ *config.status*) \ cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ *) \ echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ esac; $(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh $(top_srcdir)/configure: $(am__configure_deps) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh $(ACLOCAL_M4): $(am__aclocal_m4_deps) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh clean-checkPROGRAMS: -test -z "$(check_PROGRAMS)" || rm -f $(check_PROGRAMS) tests_read$(EXEEXT): $(tests_read_OBJECTS) $(tests_read_DEPENDENCIES) @rm -f tests_read$(EXEEXT) $(tests_read_LINK) $(tests_read_OBJECTS) $(tests_read_LDADD) $(LIBS) tests_write$(EXEEXT): $(tests_write_OBJECTS) $(tests_write_DEPENDENCIES) @rm -f tests_write$(EXEEXT) $(tests_write_LINK) $(tests_write_OBJECTS) $(tests_write_LDADD) $(LIBS) mostlyclean-compile: -rm -f *.$(OBJEXT) distclean-compile: -rm -f *.tab.c .f90.o: $(FCCOMPILE) -c -o $@ $< .f90.obj: $(FCCOMPILE) -c -o $@ `$(CYGPATH_W) '$<'` ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES) list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ unique=`for i in $$list; do \ if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ done | \ $(AWK) '{ files[$$0] = 1; nonemtpy = 1; } \ END { if (nonempty) { for (i in files) print i; }; }'`; \ mkid -fID $$unique tags: TAGS TAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \ $(TAGS_FILES) $(LISP) tags=; \ here=`pwd`; \ list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ unique=`for i in $$list; do \ if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ done | \ $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ END { if (nonempty) { for (i in files) print i; }; }'`; \ if test -z "$(ETAGS_ARGS)$$tags$$unique"; then :; else \ test -n "$$unique" || unique=$$empty_fix; \ $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ $$tags $$unique; \ fi ctags: CTAGS CTAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \ $(TAGS_FILES) $(LISP) tags=; \ list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ unique=`for i in $$list; do \ if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ done | \ $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ END { if (nonempty) { for (i in files) print i; }; }'`; \ test -z "$(CTAGS_ARGS)$$tags$$unique" \ || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ $$tags $$unique GTAGS: here=`$(am__cd) $(top_builddir) && pwd` \ && cd $(top_srcdir) \ && gtags -i $(GTAGS_ARGS) $$here distclean-tags: -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags check-TESTS: $(TESTS) @failed=0; all=0; xfail=0; xpass=0; skip=0; ws='[ ]'; \ srcdir=$(srcdir); export srcdir; \ list=' $(TESTS) '; \ if test -n "$$list"; then \ for tst in $$list; do \ if test -f ./$$tst; then dir=./; \ elif test -f $$tst; then dir=; \ else dir="$(srcdir)/"; fi; \ if $(TESTS_ENVIRONMENT) $${dir}$$tst; then \ all=`expr $$all + 1`; \ case " $(XFAIL_TESTS) " in \ *$$ws$$tst$$ws*) \ xpass=`expr $$xpass + 1`; \ failed=`expr $$failed + 1`; \ echo "XPASS: $$tst"; \ ;; \ *) \ echo "PASS: $$tst"; \ ;; \ esac; \ elif test $$? -ne 77; then \ all=`expr $$all + 1`; \ case " $(XFAIL_TESTS) " in \ *$$ws$$tst$$ws*) \ xfail=`expr $$xfail + 1`; \ echo "XFAIL: $$tst"; \ ;; \ *) \ failed=`expr $$failed + 1`; \ echo "FAIL: $$tst"; \ ;; \ esac; \ else \ skip=`expr $$skip + 1`; \ echo "SKIP: $$tst"; \ fi; \ done; \ if test "$$failed" -eq 0; then \ if test "$$xfail" -eq 0; then \ banner="All $$all tests passed"; \ else \ banner="All $$all tests behaved as expected ($$xfail expected failures)"; \ fi; \ else \ if test "$$xpass" -eq 0; then \ banner="$$failed of $$all tests failed"; \ else \ banner="$$failed of $$all tests did not behave as expected ($$xpass unexpected passes)"; \ fi; \ fi; \ dashes="$$banner"; \ skipped=""; \ if test "$$skip" -ne 0; then \ skipped="($$skip tests were not run)"; \ test `echo "$$skipped" | wc -c` -le `echo "$$banner" | wc -c` || \ dashes="$$skipped"; \ fi; \ report=""; \ if test "$$failed" -ne 0 && test -n "$(PACKAGE_BUGREPORT)"; then \ report="Please report to $(PACKAGE_BUGREPORT)"; \ test `echo "$$report" | wc -c` -le `echo "$$banner" | wc -c` || \ dashes="$$report"; \ fi; \ dashes=`echo "$$dashes" | sed s/./=/g`; \ echo "$$dashes"; \ echo "$$banner"; \ test -z "$$skipped" || echo "$$skipped"; \ test -z "$$report" || echo "$$report"; \ echo "$$dashes"; \ test "$$failed" -eq 0; \ else :; fi distdir: $(DISTFILES) @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ list='$(DISTFILES)'; \ dist_files=`for file in $$list; do echo $$file; done | \ sed -e "s|^$$srcdirstrip/||;t" \ -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ case $$dist_files in \ */*) $(MKDIR_P) `echo "$$dist_files" | \ sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ sort -u` ;; \ esac; \ for file in $$dist_files; do \ if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ if test -d $$d/$$file; then \ dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ cp -pR $(srcdir)/$$file $(distdir)$$dir || exit 1; \ fi; \ cp -pR $$d/$$file $(distdir)$$dir || exit 1; \ else \ test -f $(distdir)/$$file \ || cp -p $$d/$$file $(distdir)/$$file \ || exit 1; \ fi; \ done check-am: all-am $(MAKE) $(AM_MAKEFLAGS) $(check_PROGRAMS) $(MAKE) $(AM_MAKEFLAGS) check-TESTS check: check-am all-am: Makefile installdirs: install: install-am install-exec: install-exec-am install-data: install-data-am uninstall: uninstall-am install-am: all-am @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am installcheck: installcheck-am install-strip: $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ `test -z '$(STRIP)' || \ echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install mostlyclean-generic: clean-generic: -test -z "$(CLEANFILES)" || rm -f $(CLEANFILES) distclean-generic: -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) maintainer-clean-generic: @echo "This command is intended for maintainers to use" @echo "it deletes files that may require special tools to rebuild." clean: clean-am clean-am: clean-checkPROGRAMS clean-generic mostlyclean-am distclean: distclean-am -rm -f Makefile distclean-am: clean-am distclean-compile distclean-generic \ distclean-tags dvi: dvi-am dvi-am: html: html-am info: info-am info-am: install-data-am: install-dvi: install-dvi-am install-exec-am: install-html: install-html-am install-info: install-info-am install-man: install-pdf: install-pdf-am install-ps: install-ps-am installcheck-am: maintainer-clean: maintainer-clean-am -rm -f Makefile maintainer-clean-am: distclean-am maintainer-clean-generic mostlyclean: mostlyclean-am mostlyclean-am: mostlyclean-compile mostlyclean-generic pdf: pdf-am pdf-am: ps: ps-am ps-am: uninstall-am: .MAKE: install-am install-strip .PHONY: CTAGS GTAGS all all-am check check-TESTS check-am clean \ clean-checkPROGRAMS clean-generic ctags distclean \ distclean-compile distclean-generic distclean-tags distdir dvi \ dvi-am html html-am info info-am install install-am \ install-data install-data-am install-dvi install-dvi-am \ install-exec install-exec-am install-html install-html-am \ install-info install-info-am install-man install-pdf \ install-pdf-am install-ps install-ps-am install-strip \ installcheck installcheck-am installdirs maintainer-clean \ maintainer-clean-generic mostlyclean mostlyclean-compile \ mostlyclean-generic pdf pdf-am ps ps-am tags uninstall \ uninstall-am vpath %.o $(top_builddir)/src/low_level #dependencies tests_read.o: tests_read.f90 \ etsf_io_low_level.o tests_write.o: tests_write.f90 \ etsf_io_low_level.o #additional rules run: $(srcdir)/tests_run.sh tests_read.log tests_write.log \cp $(srcdir)/tests_run.sh run run-tests: tests_read.log tests_write.log cat *.log run-tests-read tests_read.log: $(test_dependencies) tests_read ./tests_read $(srcdir) | tee tests_read.log run-tests-write tests_write.log: $(test_dependencies) tests_write \rm -f open_create_t*.nc ./tests_write $(srcdir) | tee tests_write.log # Tell versions [3.59,3.63) of GNU make to not export all variables. # Otherwise a system limit (for SysV at least) may be exceeded. .NOEXPORT: etsf_io-1.0.3/tests/low_level/tests_read.f900000644000353400050630000011446010656544763015724 00000000000000program tests_read use etsf_io_low_level implicit none integer :: nArg, iargc character(len = 256) :: path nArg = iargc() if (nArg > 0) then call getarg(1, path) else write(path, "(A)") "." end if call tests_read_open(trim(path)) call tests_read_dim(trim(path)) call tests_read_var_infos(trim(path)) call tests_check_att(trim(path)) call tests_read_att(trim(path)) call tests_read_flag(trim(path)) call tests_check_var(trim(path)) call tests_read_var_integer(trim(path)) call tests_read_var_double(trim(path)) call tests_read_var_character(trim(path)) call tests_read_all_var_infos(trim(path)) contains subroutine tests_read_status(name, lstat, error) character(len = *), intent(in) :: name logical, intent(in) :: lstat type(etsf_io_low_error), intent(in) :: error if (lstat) then write(*, "(A,A,A,A)") "== ", name, repeat(" ", 68 - len(name)), "OK ==" else write(*, "(A,A,A,A)") "== ", name, repeat(" ", 68 - len(name)), "Failed ==" call etsf_io_low_error_handle(error) end if end subroutine tests_read_status subroutine tests_read_open(path) character(len = *), intent(in) :: path integer :: ncid logical :: lstat type(etsf_io_low_error) :: error write(*,*) write(*,*) "Testing etsf_io_low_open_read()..." call etsf_io_low_open_read(ncid, "", lstat, error_data = error) call tests_read_status("argument filename: unknown file", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_IO .and. error%target_type_id == ERROR_TYPE_ORD), error) call etsf_io_low_open_read(ncid, path//"/tests_read.f90", lstat, error_data = error) call tests_read_status("argument filename: text file", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_IO .and. error%target_type_id == ERROR_TYPE_ORD), error) call etsf_io_low_open_read(ncid, path//"/open_read_t01.nc", lstat, error_data = error) call tests_read_status("argument filename: NetCDF without header", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_INQ .and. error%target_type_id == ERROR_TYPE_ATT), error) call etsf_io_low_open_read(ncid, path//"/open_read_t02.nc", lstat, error_data = error) call tests_read_status("argument filename: NetCDF with wrong file_format header", & & (.not. lstat .and. error%access_mode_id == ERROR_MODE_SPEC), error) call etsf_io_low_open_read(ncid, path//"/open_read_t03.nc", lstat, error_data = error) call tests_read_status("argument filename: NetCDF with obsolete file_format_version", & & (.not. lstat .and. error%access_mode_id == ERROR_MODE_SPEC), error) call etsf_io_low_open_read(ncid, path//"/open_read_t03.nc", lstat, version_min = 1.3, & & error_data = error) call tests_read_status("argument version_min: NetCDF with obsolete file_format_version", & & (.not. lstat .and. error%access_mode_id == ERROR_MODE_SPEC), error) call etsf_io_low_open_read(ncid, path//"/open_read_t04.nc", lstat, error_data = error) call tests_read_status("argument filename: NetCDF with a valid header", lstat, error) call etsf_io_low_close(ncid, lstat) write(*,*) end subroutine tests_read_open subroutine tests_read_dim(path) character(len = *), intent(in) :: path integer :: ncid, dimvalue logical :: lstat type(etsf_io_low_error) :: error write(*,*) write(*,*) "Testing etsf_io_low_read_dim()..." call etsf_io_low_read_dim(0, "", dimvalue, lstat, error_data = error) call tests_read_status("argument ncid: wrong value", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_INQ), error) call etsf_io_low_open_read(ncid, path//"/read_dim_t01.nc", lstat) if (.not. lstat) then write(*,*) "Abort, can't open file" return end if call etsf_io_low_read_dim(ncid, "pouet", dimvalue, lstat, error_data = error) call tests_read_status("argument dimname: wrong value", (.not. lstat), error) call etsf_io_low_read_dim(ncid, "number_of_atoms", dimvalue, lstat, error_data = error) call tests_read_status("argument dimname: good value", (lstat .and. (dimvalue == 5)), error) call etsf_io_low_close(ncid, lstat) write(*,*) end subroutine tests_read_dim subroutine tests_read_var_infos(path) character(len = *), intent(in) :: path integer :: ncid, ncvarid, vartype, vardims(2) logical :: lstat type(etsf_io_low_error) :: error type(etsf_io_low_var_infos) :: var_infos write(*,*) write(*,*) "Testing etsf_io_low_read_var_infos()..." call etsf_io_low_read_var_infos(0, "", var_infos, lstat, error_data = error) call tests_read_status("argument ncid: wrong value", (.not. lstat), error) call etsf_io_low_open_read(ncid, path//"/check_var_t01.nc", lstat) if (.not. lstat) then write(*,*) "Abort, can't open file" return end if call etsf_io_low_read_var_infos(ncid, "pouet", var_infos, lstat, error_data = error) call tests_read_status("argument varname: wrong value", (.not. lstat), error) call etsf_io_low_read_var_infos(ncid, "atom_species", var_infos, lstat, error_data = error) call tests_read_status("argument varname: good value", lstat, error) if (.not. (var_infos%nctype == etsf_io_low_integer)) then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_VAR error%error_message = "wrong value" lstat = .false. end if call tests_read_status(" | checking type value", lstat, error) if (.not. (var_infos%ncshape == 1)) then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_VAR error%error_message = "wrong value" lstat = .false. end if call tests_read_status(" | checking shape value", lstat, error) if (.not. (var_infos%ncdims(1) == 5)) then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_VAR error%error_message = "wrong value" lstat = .false. end if call tests_read_status(" | checking dimension values", lstat, error) call etsf_io_low_read_var_infos(ncid, "atom_species_names", var_infos, lstat, & & error_data = error, dim_name = .true., att_name = .false.) call tests_read_status("argument varname: with dim names", lstat, error) write(error%target_name, "(A)") "atom_species_names" if (.not. associated(var_infos%ncdimnames)) then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "dim array not associated" lstat = .false. end if call tests_read_status(" | checking dim array association", lstat, error) if (.not. (size(var_infos%ncdimnames, 1) == 2)) then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "wrong dim array size" lstat = .false. end if call tests_read_status(" | checking dim array size", lstat, error) if (.not. (trim(var_infos%ncdimnames(2)) == "number_of_atom_species") .or. & & .not. (trim(var_infos%ncdimnames(1)) == "character_string_length")) then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "wrong dim array names" lstat = .false. end if call tests_read_status(" | checking dim array names", lstat, error) call etsf_io_low_free_var_infos(var_infos) call etsf_io_low_read_var_infos(ncid, "atom_species_names", var_infos, lstat, & & error_data = error, dim_name = .false., att_name = .true.) call tests_read_status("argument varname: with att names", lstat, error) write(error%target_name, "(A)") "atom_species_names" if (.not. associated(var_infos%ncattnames)) then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "att array not associated" lstat = .false. end if call tests_read_status(" | checking att array association", lstat, error) if (.not. (size(var_infos%ncattnames, 1) == 1)) then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "wrong att array size" lstat = .false. end if call tests_read_status(" | checking att array size", lstat, error) if (.not. (trim(var_infos%ncattnames(1)) == "units")) then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "wrong att array names" lstat = .false. end if call tests_read_status(" | checking att array names", lstat, error) call etsf_io_low_free_var_infos(var_infos) call etsf_io_low_close(ncid, lstat) write(*,*) end subroutine tests_read_var_infos subroutine tests_check_var(path) character(len = *), intent(in) :: path logical :: lstat type(etsf_io_low_error) :: error type(etsf_io_low_var_infos) :: var_from, var_to write(*,*) error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_VAR error%error_message = "wrong value" write(*,*) "Testing etsf_io_low_check_var()..." var_from%nctype = etsf_io_low_character var_to%nctype = etsf_io_low_double call etsf_io_low_check_var(var_from, var_to, (/ 1 /), (/ 1 /), (/ 1 /), & & lstat, error_data = error) call tests_read_status("field nctype: incompatible values", (.not. lstat), error) var_from%ncshape = 0 var_to%ncshape = 0 var_from%nctype = etsf_io_low_double var_to%nctype = etsf_io_low_double call etsf_io_low_check_var(var_from, var_to, (/ 1 /), (/ 1 /), (/ 1 /), & & lstat, error_data = error) call tests_read_status("field nctype: matching values", lstat, error) var_from%ncshape = 4 var_to%ncshape = 2 var_from%ncdims(1:4) = (/ 3, 3, 3, 2 /) var_to%ncdims(1:2) = (/ 25, 3 /) call etsf_io_low_check_var(var_from, var_to, (/ 1, 1, 1, 1 /), (/ 3, 3, 3, 2 /), & & (/ 1, 3, 9, 27 /), lstat, error_data = error) call tests_read_status("field ncshape: uncompatible values", (.not. lstat), error) var_from%ncdims(1:4) = (/ 3, 3, 3, 2 /) var_to%ncdims(1:2) = (/ 27, 2 /) call etsf_io_low_check_var(var_from, var_to, (/ 1, 1, 1, 1 /), (/ 3, 3, 3, 2 /), & & (/ 1, 3, 9, 27 /), lstat, error_data = error) call tests_read_status("field ncshape: compatible values", lstat, error) var_from%ncshape = 4 var_to%ncshape = 4 var_from%ncdims(1:4) = (/ 4, 3, 3, 2 /) var_to%ncdims(1:4) = (/ 4, 3, 3, 2 /) call etsf_io_low_check_var(var_from, var_to, (/ 1, 1, 1, 1 /), (/ 4, 3, 3, 2 /), & & (/ 1, 4, 12, 36 /), lstat, error_data = error) call tests_read_status("field ncshape (nD): matching values", lstat, error) var_from%ncdims(1:4) = (/ 3, 3, 3, 2 /) var_to%ncdims(1:4) = (/ 3, 3, 2, 2 /) call etsf_io_low_check_var(var_from, var_to, (/ 1, 1, 1, 1 /), (/ 3, 3, 3, 1 /), & & (/ 1, 3, 9, 27 /), lstat, error_data = error) call tests_read_status("block%count: incompatible values", (.not. lstat), error) var_from%ncdims(1:4) = (/ 3, 3, 3, 2 /) var_to%ncshape = 2 var_to%ncdims(1:2) = (/ 3, 3 /) call etsf_io_low_check_var(var_from, var_to, (/ 1, 1, 1, 1 /), (/ 3, 3, 1, 1 /), & & (/ 1, 3, 9, 27 /), lstat, error_data = error) call tests_read_status("block%count: compatible values", lstat, error) var_to%ncdims(1:2) = (/ 3, 2 /) call etsf_io_low_check_var(var_from, var_to, (/ 1, 1, 1, 1 /), (/ 3, 2, 1, 1 /), & & (/ 1, 3, 9, 27 /), lstat, error_data = error) call tests_read_status("block%count: subpart compatible values", lstat, error) var_from%ncdims(1:4) = (/ 3, 2, 5, 5 /) var_to%ncshape = 4 var_to%ncdims(1:4) = (/ 3, 2, 5, 5 /) call etsf_io_low_check_var(var_from, var_to, (/ 2, 2, 3, 4 /), (/ 3, 2, 1, 1 /), & & (/ 1, 3, 9, 27 /), lstat, error_data = error) call tests_read_status("block%start: incompatible values", (.not. lstat), error) var_to%ncshape = 2 var_to%ncdims(1:2) = (/ 3, 2 /) call etsf_io_low_check_var(var_from, var_to, (/ 1, 2, 3, 4 /), (/ 3, 2, 1, 1 /), & & (/ 1, 3, 9, 27 /), lstat, error_data = error) call tests_read_status("block%start: compatible values", lstat, error) var_to%ncshape = 4 var_to%ncdims(1:4) = (/ 3, 2, 5, 5 /) call etsf_io_low_check_var(var_from, var_to, (/ 1, 1, 1, 1 /), (/ 3, 2, 5, 5 /), & & (/ 1, 3, 35, 6 /), lstat, error_data = error) call tests_read_status("block%map: incompatible values", (.not. lstat), error) var_to%ncdims(1:4) = (/ 3, 2, 5, 5 /) call etsf_io_low_check_var(var_from, var_to, (/ 1, 1, 1, 1 /), (/ 3, 2, 5, 5 /), & & (/ 1, 3, 30, 6 /), lstat, error_data = error) call tests_read_status("block%map: compatible values", lstat, error) write(*,*) end subroutine tests_check_var subroutine tests_read_att(path) character(len = *), intent(in) :: path integer :: ncid, atttype, attlen, valInt real :: valFloat logical :: lstat character(len = *), parameter :: me = "tests_check_att" character(len = 80) :: valString type(etsf_io_low_error) :: error write(*,*) write(*,*) "Testing etsf_io_low_read_att()..." call etsf_io_low_read_att(0, etsf_io_low_global_att, "toto", valInt, & & lstat, error_data = error) call tests_read_status("argument ncid: wrong value", (.not. lstat), error) call etsf_io_low_open_read(ncid, path//"/check_att_t01.nc", lstat) if (.not. lstat) then write(*,*) "Abort, can't open file" return end if call etsf_io_low_read_att(ncid, -1, "toto", valInt, & & lstat, error_data = error) call tests_read_status("argument ncvarid: wrong value", (.not. lstat), error) call etsf_io_low_read_att(ncid, etsf_io_low_global_att, "toto", valInt, & & lstat, error_data = error) call tests_read_status("argument attname: wrong value", (.not. lstat), error) call etsf_io_low_read_att(ncid, etsf_io_low_global_att, "file_format_version", valInt, & & lstat, error_data = error) call tests_read_status("argument att: wrong type", (.not. lstat), error) call etsf_io_low_read_att(ncid, etsf_io_low_global_att, "file_format_version", valFloat, & & lstat, error_data = error) call tests_read_status("argument att: good type (float)", lstat, error) if (valFloat /= 1.3) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_ATT, me, errmess = "Wrong value") lstat = .false. end if call tests_read_status(" | cheking value", lstat, error) call etsf_io_low_read_att(ncid, etsf_io_low_global_att, "file_format", 80, valString, & & lstat, error_data = error) call tests_read_status("argument att: good type (string)", lstat, error) if (trim(valString) /= "ETSF Nanoquanta") then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_ATT, me, errmess = "Wrong value") lstat = .false. end if call tests_read_status(" | cheking value", lstat, error) call etsf_io_low_read_att(ncid, "atom_species", "mass", valFloat, & & lstat, error_data = error) call tests_read_status("argument varname: accessing variable through its name (float)", lstat, error) if (valFloat /= 1.2) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_ATT, me, errmess = "Wrong value") lstat = .false. end if call tests_read_status(" | cheking value", lstat, error) call etsf_io_low_read_att(ncid, "atom_species", "comment", 80, valString, & & lstat, error_data = error) call tests_read_status("argument varname: accessing variable through its name (string)", lstat, error) if (trim(valString) /= "bonjour") then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_ATT, me, errmess = "Wrong value") lstat = .false. end if call tests_read_status(" | cheking value", lstat, error) call etsf_io_low_close(ncid, lstat) write(*,*) end subroutine tests_read_att subroutine tests_read_flag(path) character(len = *), intent(in) :: path integer :: ncid, atttype, attlen logical :: lstat, flag character(len = *), parameter :: me = "tests_check_flag" character(len = 80) :: valString type(etsf_io_low_error) :: error write(*,*) write(*,*) "Testing etsf_io_low_read_flag()..." call etsf_io_low_read_flag(0, flag, etsf_io_low_global_att, "toto", & & lstat, error_data = error) call tests_read_status("argument ncid: wrong value", (.not. lstat), error) call etsf_io_low_open_read(ncid, path//"/check_att_t01.nc", lstat) if (.not. lstat) then write(*,*) "Abort, can't open file" return end if call etsf_io_low_read_flag(ncid, flag, -1, "toto", & & lstat, error_data = error) call tests_read_status("argument ncvarid: wrong value", (.not. lstat), error) call etsf_io_low_read_flag(ncid, flag, "atom_species", "flag_yes", & & lstat, error_data = error) call tests_read_status("argument varname: accessing variable through its name (yes)", lstat, error) if (lstat .and. .not.flag) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_ATT, me, errmess = "Wrong value") lstat = .false. end if call tests_read_status(" | cheking value", lstat, error) call etsf_io_low_read_flag(ncid, flag, "atom_species", "flag_no", & & lstat, error_data = error) call tests_read_status("argument varname: accessing variable through its name (No)", lstat, error) if (lstat .and. flag) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_ATT, me, errmess = "Wrong value") lstat = .false. end if call tests_read_status(" | cheking value", lstat, error) call etsf_io_low_close(ncid, lstat) write(*,*) end subroutine tests_read_flag subroutine tests_check_att(path) character(len = *), intent(in) :: path integer :: ncid, atttype, attlen logical :: lstat type(etsf_io_low_error) :: error type(etsf_io_low_var_infos) :: var_infos write(*,*) write(*,*) "Testing etsf_io_low_check_att()..." call etsf_io_low_check_att(0, etsf_io_low_global_att, "", atttype, attlen, lstat, error_data = error) call tests_read_status("argument ncid: wrong value", (.not. lstat), error) call etsf_io_low_open_read(ncid, path//"/check_att_t01.nc", lstat) if (.not. lstat) then write(*,*) "Abort, can't open file" return end if call etsf_io_low_read_var_infos(ncid, "atom_species", var_infos, lstat) if (.not. lstat) then write(*,*) "Abort, can't get variable" call etsf_io_low_close(ncid, lstat) return end if call etsf_io_low_check_att(ncid, etsf_io_low_global_att, "file_format", NF90_CHAR, 80, lstat, & & error_data = error) call tests_read_status("argument ncvarid: etsf_io_low_global_att value", lstat, error) call etsf_io_low_check_att(ncid, 0, "comment", NF90_CHAR, 80, lstat, error_data = error) call tests_read_status("argument ncvarid: wrong value", (.not. lstat), error) call etsf_io_low_check_att(ncid, var_infos%ncid, "mass", NF90_FLOAT, 1, lstat, & & error_data = error) call tests_read_status("argument ncvarid: valid variable attribute (0D)", lstat, error) call etsf_io_low_check_att(ncid, var_infos%ncid, "comment", NF90_CHAR, 80, lstat, & & error_data = error) call tests_read_status("argument ncvarid: valid variable attribute (1D)", lstat, error) call etsf_io_low_check_att(ncid, etsf_io_low_global_att, "file_format", NF90_INT, 80, lstat, & & error_data = error) call tests_read_status("argument atttype: wrong type", (.not. lstat), error) call etsf_io_low_check_att(ncid, etsf_io_low_global_att, "file_format_version", NF90_FLOAT, 2, lstat, & & error_data = error) call tests_read_status("argument attlen: wrong dimension", (.not. lstat), error) call etsf_io_low_check_att(ncid, etsf_io_low_global_att, "file_format_version", NF90_FLOAT, 1, lstat, & & error_data = error) call tests_read_status("argument attlen: good value", lstat, error) call etsf_io_low_close(ncid, lstat) write(*,*) end subroutine tests_check_att subroutine tests_read_var_integer(path) character(len = *), intent(in) :: path integer :: ncid, ncvarid integer, target :: var(5), var2d(2, 2), bigvar(4), var2d_snd(2, 3), var2d_trd(3, 2), hugevar(18) character(len = 5) :: varc logical :: lstat type(etsf_io_low_error) :: error type(etsf_io_low_var_integer) :: atom_species write(*,*) write(*,*) "Testing etsf_io_low_read_var_integer()..." call etsf_io_low_read_var(0, "atom_species", var, lstat, error_data = error) call tests_read_status("argument ncid: wrong value", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_INQ), error) call etsf_io_low_open_read(ncid, path//"/read_var_t01.nc", lstat) if (.not. lstat) then write(*,*) "Abort, can't open file" return end if call etsf_io_low_read_var(ncid, "pouet", var, lstat, error_data = error) call tests_read_status("argument varname: wrong value", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_INQ .and. error%target_type_id == ERROR_TYPE_VID), & & error) call etsf_io_low_read_var(ncid, "atom_species", varc, 5, lstat, error_data = error) call tests_read_status("argument var: wrong type", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_SPEC .and. error%target_type_id == ERROR_TYPE_VAR), & & error) call etsf_io_low_read_var(ncid, "atom_species", var(1:4), lstat, error_data = error) call tests_read_status("argument var: wrong dimensions", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_SPEC .and. error%target_type_id == ERROR_TYPE_ARG), & & error) call etsf_io_low_read_var(ncid, "space_group", var(1), lstat, error_data = error) call tests_read_status("argument var: good value (0D)", (lstat .and. & & var(1) == 1), error) call etsf_io_low_read_var(ncid, "atom_species", var, lstat, error_data = error) call tests_read_status("argument var: good value (1D)", (lstat .and. & & var(1) == 1 .and. var(2) == 2 .and. var(3) == 2 .and. & & var(4) == 2 .and. var(5) == 2), error) call etsf_io_low_read_var(ncid, "test_integer_2d", var2d, & & lstat, error_data = error) call tests_read_status("argument var: good value (2D)", (lstat .and. & & var2d(1, 1) == 1 .and. var2d(2, 1) == 2 .and. & & var2d(1, 2) == 3 .and. var2d(2, 2) == 4), error) call etsf_io_low_read_var(ncid, "test_integer_2d", bigvar(1:3), & & lstat, error_data = error) call tests_read_status("argument var: wrong matching (2D <-> 1D)", (.not. lstat), error) call etsf_io_low_read_var(ncid, "test_integer_2d", bigvar, & & lstat, error_data = error) call tests_read_status("argument var: good matching (2D <-> 1D)", (lstat .and. & & bigvar(1) == 1 .and. bigvar(2) == 2 .and. & & bigvar(3) == 3 .and. bigvar(4) == 4), error) call etsf_io_low_read_var(ncid, "test_integer_2d", bigvar(1:2), & & lstat, start = (/ 1, 1, 1 /), error_data = error) call tests_read_status("argument start: wrong size", (.not. lstat), error) call etsf_io_low_read_var(ncid, "test_integer_2d", bigvar(1:2), & & lstat, count = (/ 2, 1, 1 /), error_data = error) call tests_read_status("argument count: wrong size", (.not. lstat), error) call etsf_io_low_read_var(ncid, "test_integer_2d", bigvar(1:2), & & lstat, map = (/ 1, 1, 1 /), error_data = error) call tests_read_status("argument map: wrong size", (.not. lstat), error) call etsf_io_low_read_var(ncid, "test_integer_2d", bigvar(1:2), & & lstat, start = (/ 1, 5 /), error_data = error) call tests_read_status("argument start: out-of-bounds", (.not. lstat), error) call etsf_io_low_read_var(ncid, "test_integer_2d", bigvar(1:2), & & lstat, count = (/ 2, 5 /), error_data = error) call tests_read_status("argument count: out-of-bounds", (.not. lstat), error) call etsf_io_low_read_var(ncid, "test_integer_2d", bigvar(1:3), & & lstat, start = (/ 1, 2 /), count = (/ 2, 1 /), error_data = error) call tests_read_status("argument var + count: wrong number of elements", (.not. lstat), error) call etsf_io_low_read_var(ncid, "test_integer_2d", bigvar(1:2), & & lstat, start = (/ 1, 2 /), count = (/ 2, 1 /), error_data = error) call tests_read_status("argument var + count: good match (sub part)", (lstat .and. & & bigvar(1) == 3 .and. bigvar(2) == 4), error) call etsf_io_low_read_var(ncid, "test_integer_2d", bigvar, & & lstat, error_data = error) call tests_read_status("argument var: transform shape (all reading)", (lstat .and. & & bigvar(1) == 1 .and. bigvar(2) == 2 .and. & & bigvar(3) == 3 .and. bigvar(4) == 4), error) call etsf_io_low_read_var(ncid, "test_integer_2d", bigvar, & & lstat, start = (/ 1, 1 /), count = (/ 2, 2 /), error_data = error) call tests_read_status("argument var + count: good match (all reading)", (lstat .and. & & bigvar(1) == 1 .and. bigvar(2) == 2 .and. & & bigvar(3) == 3 .and. bigvar(4) == 4), error) call etsf_io_low_read_var(ncid, "test_integer_4d", var2d_snd, & & lstat, start = (/ 1, 1, 2, 2 /), & & count = (/ 2, 3, 1, 1 /), error_data = error) call tests_read_status("argument start + count: two sub reading", (lstat .and. & & var2d_snd(1, 1) == -7 .and. var2d_snd(2, 1) == -8), error) call etsf_io_low_read_var(ncid, "test_integer_4d", hugevar, & & lstat, start = (/ 1, 1, 1, 2 /), & & count = (/ 0, 0, 0, 1 /), error_data = error) call tests_read_status("argument start + count: sub access with assumed dimensions", (lstat .and. & & hugevar(1) == -1 .and. hugevar(2) == -2), error) call etsf_io_low_read_var(ncid, "test_integer_4d", var2d_trd, & & lstat, start = (/ 1, 1, 1, 1/), & & count = (/ 0, 0, 1, 1 /), map = (/ 3, 1, 1, 1 /), & & error_data = error) call tests_read_status("argument map: exchanging dimensions", (lstat .and. & & var2d_trd(1, 1) == 1 .and. var2d_trd(2, 1) == 3 .and. & & var2d_trd(3, 1) == 5 .and. var2d_trd(1, 2) == 2), error) atom_species%data1D => var call etsf_io_low_read_var(ncid, "atom_species", atom_species, lstat, error_data = error) call tests_read_status("argument var: generic pointer (1D)", (lstat .and. & & var(1) == 1 .and. var(2) == 2 .and. var(3) == 2 .and. & & var(4) == 2 .and. var(5) == 2), error) atom_species%data1D => null() atom_species%data2D => var2d call etsf_io_low_read_var(ncid, "test_integer_2d", atom_species, lstat, error_data = error) call tests_read_status("argument var: generic pointer (2D)", (lstat .and. & & var2d(1, 1) == 1 .and. var2d(2, 1) == 2 .and. & & var2d(1, 2) == 3 .and. var2d(2, 2) == 4), error) atom_species%data1D => var2d(2, :) call etsf_io_low_read_var(ncid, "test_integer_2d", atom_species, & & lstat, start = (/ 1, 2 /), count = (/ 2, 1 /), error_data = error) call tests_read_status("argument var + count: generic pointer", (lstat .and. & & var2d(2, 1) == 3 .and. var2d(2, 2) == 4), error) call etsf_io_low_close(ncid, lstat) write(*,*) end subroutine tests_read_var_integer subroutine tests_read_var_double(path) character(len = *), intent(in) :: path integer :: ncid, ncvarid double precision, target :: var(3), var2d(3, 3), bigvar(15), density(27) character(len = 3) :: varc logical :: lstat type(etsf_io_low_error) :: error type(etsf_io_low_var_double) :: var_gen write(*,*) write(*,*) "Testing etsf_io_low_read_var_double()..." call etsf_io_low_read_var(0, "test_double_1d", var, lstat, error_data = error) call tests_read_status("argument ncid: wrong value", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_INQ), error) call etsf_io_low_open_read(ncid, path//"/read_var_t01.nc", lstat) if (.not. lstat) then write(*,*) "Abort, can't open file" return end if call etsf_io_low_read_var(ncid, "pouet", var, lstat, error_data = error) call tests_read_status("argument varname: wrong value", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_INQ .and. error%target_type_id == ERROR_TYPE_VID), & & error) call etsf_io_low_read_var(ncid, "test_double_1d", varc, 3, lstat, error_data = error) call tests_read_status("argument var: wrong type", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_SPEC .and. error%target_type_id == ERROR_TYPE_VAR), & & error) call etsf_io_low_read_var(ncid, "test_double_1d", var(1:2), lstat, error_data = error) call tests_read_status("argument var: wrong dimensions", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_SPEC .and. error%target_type_id == ERROR_TYPE_ARG), & & error) call etsf_io_low_read_var(ncid, "test_double_0d", var(1), lstat, error_data = error) call tests_read_status("argument var: good value (0D)", (lstat .and. & & var(1) == 3.14d0), error) call etsf_io_low_read_var(ncid, "test_double_1d", var, lstat, error_data = error) call tests_read_status("argument var: good value (1D)", (lstat .and. & & var(1) == 1. .and. var(2) == 2. .and. var(3) == 3.), error) call etsf_io_low_read_var(ncid, "primitive_vectors", var2d, & & lstat, error_data = error) call tests_read_status("argument var: good value (2D)", (lstat .and. & & var2d(1, 1) == 10. .and. var2d(2, 1) == 0. .and. & & var2d(3, 1) == 0. .and. var2d(1, 2) == 0. .and. & & var2d(2, 2) == 10. .and. var2d(3, 2) == 0. .and. & & var2d(1, 3) == 0. .and. var2d(2, 3) == 0. .and. & & var2d(3, 3) == 10.), error) call etsf_io_low_read_var(ncid, "reduced_atom_positions", bigvar(1:10), & & lstat, error_data = error) call tests_read_status("argument var: wrong matching (2D <-> 1D)", (.not. lstat), error) call etsf_io_low_read_var(ncid, "reduced_atom_positions", bigvar, & & lstat, error_data = error) call tests_read_status("argument var: good matching (2D <-> 1D)", (lstat .and. & & bigvar(1) == 0.5d0 .and. bigvar(2) == 0.5d0 .and. & & bigvar(3) == 0.5d0 .and. bigvar(4) == 0.6d0), error) call etsf_io_low_read_var(ncid, "density", density, & & lstat, start = (/ 1, 1, 1, 2 /), & & count = (/ 3, 3, 3, 1 /), error_data = error) call tests_read_status("argument var + sub: good matching (3D <-> 1D)", (lstat .and. & & density(1) == -0.d0 .and. density(2) == -1.d0 .and. & & density(3) == -0.d0 .and. density(4) == -1.d0 .and. & & density(5) == -2.d0 .and. density(6) == -1.d0 .and. & & density(7) == -0.d0 .and. density(8) == -1.d0 .and. & & density(9) == -0.d0), error) var_gen%data1D => bigvar call etsf_io_low_read_var(ncid, "reduced_atom_positions", var_gen, & & lstat, error_data = error) call tests_read_status("argument var: generic pointer (1D)", (lstat .and. & & bigvar(1) == 0.5d0 .and. bigvar(2) == 0.5d0 .and. & & bigvar(3) == 0.5d0 .and. bigvar(4) == 0.6d0), error) var_gen%data1D => var2d(2, :) call etsf_io_low_read_var(ncid, "primitive_vectors", var_gen, & & lstat, start = (/ 1, 2 /), & & count = (/ 3, 1 /), error_data = error) call tests_read_status("argument var + sub: generic pointer", (lstat .and. & & var2d(2, 1) == 0. .and. var2d(2, 2) == 10. .and. & & var2d(2, 3) == 0.), error) call etsf_io_low_close(ncid, lstat) write(*,*) end subroutine tests_read_var_double subroutine tests_read_var_character(path) character(len = *), intent(in) :: path integer :: ncid, ncvarid character(len = 80) :: var(2) integer :: vari(5) logical :: lstat type(etsf_io_low_error) :: error write(*,*) write(*,*) "Testing etsf_io_low_read_var_character()..." call etsf_io_low_read_var(0, "atom_species_names", var, 80, lstat, error_data = error) call tests_read_status("argument ncid: wrong value", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_INQ), error) call etsf_io_low_open_read(ncid, path//"/read_var_t01.nc", lstat) if (.not. lstat) then write(*,*) "Abort, can't open file" return end if call etsf_io_low_read_var(ncid, "pouet", var, 80, lstat, error_data = error) call tests_read_status("argument varname: wrong value", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_INQ .and. error%target_type_id == ERROR_TYPE_VID), & & error) call etsf_io_low_read_var(ncid, "atom_species_names", vari, lstat, error_data = error) call tests_read_status("argument var: wrong type", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_SPEC .and. error%target_type_id == ERROR_TYPE_VAR), & & error) call etsf_io_low_read_var(ncid, "atom_species_names", var(1:1), 80, lstat, error_data = error) call tests_read_status("argument var: wrong dimensions", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_SPEC .and. error%target_type_id == ERROR_TYPE_ARG), & & error) call etsf_io_low_read_var(ncid, "atom_species_names", var, 80, lstat, error_data = error) call tests_read_status("argument var: good value (1D)", (lstat .and. & & var(1)(1:2) == "Si" .and. var(2)(1:1) == "H"), error) call etsf_io_low_close(ncid, lstat) write(*,*) end subroutine tests_read_var_character subroutine tests_read_all_var_infos(path) character(len = *), intent(in) :: path integer :: ncid, i logical :: lstat type(etsf_io_low_error) :: error type(etsf_io_low_var_infos), pointer :: infos(:) character(len = *), parameter :: me = "tests_read_all_var_infos" integer, parameter :: infos_shapes(10) = (/ 2, 1, 2, 4, 0, 0, 1, 2, 2, 4 /) character(len = 256) :: infos_names(10) infos_names = (/ pad("atom_species_names"), & & pad("atom_species"), pad("test_integer_2d"), pad("test_integer_4d"), & & pad("space_group"), pad("test_double_0d"), pad("test_double_1d"), & & pad("reduced_atom_positions"), pad("primitive_vectors"), pad("density") /) write(*,*) write(*,*) "Testing etsf_io_low_read_all_var_infos()..." ! Testing allocated pointers allocate(infos(1)) call etsf_io_low_read_all_var_infos(0, infos, lstat, error_data = error) call tests_read_status("argument var_infos_array: allocated array", & & (.not. lstat .and. error%access_mode_id == ERROR_MODE_INQ .and. & & error%target_type_id == ERROR_TYPE_ARG), error) deallocate(infos) ! Testing wrong ncid call etsf_io_low_read_all_var_infos(0, infos, lstat, error_data = error) call tests_read_status("argument ncid: wrong value", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_INQ), error) ! Open for read call etsf_io_low_open_read(ncid, path//"/read_var_t01.nc", lstat) if (.not. lstat) then write(*,*) "Abort, can't open file" return end if ! Read all variable descriptions call etsf_io_low_read_all_var_infos(ncid, infos, lstat, error_data = error) call tests_read_status("read all variable descriptions", lstat, error) if (lstat) then ! Check the values call etsf_io_low_error_set(error, ERROR_MODE_INQ, ERROR_TYPE_VAR, me, & & errmess = "wrong number of variables.") call tests_read_status(" - check number of variables", (size(infos) == 10), & & error) do i = 1, size(infos), 1 call etsf_io_low_error_set(error, ERROR_MODE_INQ, ERROR_TYPE_VAR, me, & & errmess = "wrong variable name.") call tests_read_status(" - check variable name '"//trim(infos_names(i))//"'", & & (trim(infos(i)%name) == trim(infos_names(i))), error) call etsf_io_low_error_set(error, ERROR_MODE_INQ, ERROR_TYPE_VAR, me, & & errmess = "wrong variable shape.") call tests_read_status(" - check variable '"//trim(infos_names(i))//"' shape", & & (infos(i)%ncshape == infos_shapes(i)), error) end do ! Deallocate the informations if (associated(infos)) then deallocate(infos) end if end if call etsf_io_low_close(ncid, lstat) if (.not. lstat) then write(*,*) "Abort, can't open file" return end if write(*,*) end subroutine tests_read_all_var_infos end program tests_read etsf_io-1.0.3/tests/low_level/tests_write.f900000644000353400050630000013562610621016456016133 00000000000000program tests_write use etsf_io_low_level implicit none integer :: nArg, iargc character(len = 256) :: path nArg = iargc() if (nArg > 0) then call getarg(1, path) else write(path, "(A)") "." end if call tests_write_create(trim(path)) call tests_write_modify(trim(path)) call tests_write_dim(trim(path)) call tests_write_att_integer(trim(path)) call tests_write_att_real(trim(path)) call tests_write_att_double(trim(path)) call tests_write_att_character(trim(path)) call tests_def_var(trim(path)) call tests_write_var_integer(trim(path)) call tests_write_var_double(trim(path)) call tests_write_var_character(trim(path)) call tests_copy_all_att(trim(path)) contains subroutine tests_write_status(name, lstat, error) character(len = *), intent(in) :: name logical, intent(in) :: lstat type(etsf_io_low_error), intent(in) :: error if (lstat) then write(*, "(A,A,A,A)") "== ", name, repeat(" ", 68 - len(name)), "OK ==" else write(*, "(A,A,A,A)") "== ", name, repeat(" ", 68 - len(name)), "Failed ==" call etsf_io_low_error_handle(error) end if end subroutine tests_write_status subroutine tests_write_create(path) character(len = *), intent(in) :: path integer :: ncid, s logical :: lstat type(etsf_io_low_error) :: error character(len = 80) :: title character(len = 1024) :: history write(*,*) write(*,*) "Testing etsf_io_low_open_create()..." ! We test an IO error, trying to write in a hardly existing place on the disk. call etsf_io_low_open_create(ncid, "/pouet/pouet.nc", 1.3, lstat, error_data = error) call tests_write_status("argument filename: no write access", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_IO .and. error%target_type_id == ERROR_TYPE_OWR), error) ! We create the file with a minimal header, we will test it later. call etsf_io_low_open_create(ncid, "open_create_t01.nc", 1.3, lstat, error_data = error) call tests_write_status("argument filename: creation, minimal header", lstat, error) call etsf_io_low_close(ncid, lstat) if (.not. lstat) then write(*,*) "Abort, can't close file" return end if ! We test the opening of this minimal file. call etsf_io_low_open_read(ncid, "open_create_t01.nc", lstat, error_data = error) call tests_write_status(" | opening test", lstat, error) call etsf_io_low_close(ncid, lstat) if (.not. lstat) then write(*,*) "Abort, can't close file" return end if ! We create a new file with a complete header, we will test it later. call etsf_io_low_open_create(ncid, "open_create_t02.nc", 2.0, lstat, & & title = "Testing header", history = "Testing suite", & & error_data = error) call tests_write_status("argument filename: creation, full header", lstat, error) call etsf_io_low_close(ncid, lstat) if (.not. lstat) then write(*,*) "Abort, can't close file" return end if ! We test the opening of this minimal file. call etsf_io_low_open_read(ncid, "open_create_t02.nc", lstat, error_data = error) call tests_write_status(" | opening test", lstat, error) ! We test the two fields title and history. call etsf_io_low_read_att(ncid, etsf_io_low_global_att, "title", 80, title, & & lstat, error_data = error) call tests_write_status(" | reading title", lstat, error) if (trim(title) /= "Testing header") then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "wrong value" lstat = .false. end if call tests_write_status(" | value title", lstat, error) call etsf_io_low_read_att(ncid, etsf_io_low_global_att, "history", 1024, history, & & lstat, error_data = error) call tests_write_status(" | reading history", lstat, error) if (trim(history) /= "Testing suite") then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "wrong value" lstat = .false. end if call tests_write_status(" | value history", lstat, error) call etsf_io_low_close(ncid, lstat) if (.not. lstat) then write(*,*) "Abort, can't close file" return end if write(*,*) end subroutine tests_write_create subroutine tests_write_modify(path) character(len = *), intent(in) :: path integer :: ncid, s logical :: lstat type(etsf_io_low_error) :: error character(len = 80) :: title character(len = 1024) :: history write(*,*) write(*,*) "Testing etsf_io_low_open_modify()..." ! We test an IO error, trying to modify a none existing file. call etsf_io_low_open_modify(ncid, "pouet.nc", lstat, error_data = error) call tests_write_status("argument filename: wrong filename", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_IO .and. error%target_type_id == ERROR_TYPE_OWR), error) ! We try to open a no valid file. call etsf_io_low_open_modify(ncid, "tests_write", lstat, error_data = error) call tests_write_status("argument filename: wrong file type", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_IO .and. error%target_type_id == ERROR_TYPE_OWR), error) ! We try to open a file without header. call etsf_io_low_open_modify(ncid, path//"/open_read_t01.nc", lstat, error_data = error) call tests_write_status("argument filename: NetCDF without header", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_INQ .and. error%target_type_id == ERROR_TYPE_ATT), error) ! We open a file without header modification. call etsf_io_low_open_modify(ncid, "open_create_t01.nc", lstat, error_data = error) call tests_write_status("argument filename: NetCDF without header modification", lstat, error) call etsf_io_low_close(ncid, lstat) if (.not. lstat) then write(*,*) "Abort, can't close file" return end if ! We open a file with header modification: title creation. call etsf_io_low_open_modify(ncid, "open_create_t01.nc", lstat, & & title = "Testing title" , error_data = error) call tests_write_status("argument filename: NetCDF with title creation", lstat, error) ! We test the title. call etsf_io_low_read_att(ncid, etsf_io_low_global_att, "title", 80, title, & & lstat, error_data = error) call tests_write_status(" | reading title", lstat, error) if (trim(title) /= "Testing title") then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "wrong value" lstat = .false. end if call tests_write_status(" | value title", lstat, error) call etsf_io_low_close(ncid, lstat) if (.not. lstat) then write(*,*) "Abort, can't close file" return end if ! We open a file with header modification: title modification. call etsf_io_low_open_modify(ncid, "open_create_t01.nc", lstat, & & title = "Modifying title" , error_data = error) call tests_write_status("argument filename: NetCDF with title modification", lstat, error) ! We test the title. call etsf_io_low_read_att(ncid, etsf_io_low_global_att, "title", 80, title, & & lstat, error_data = error) call tests_write_status(" | reading title", lstat, error) if (trim(title) /= "Modifying title") then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "wrong value" lstat = .false. end if call tests_write_status(" | value title", lstat, error) call etsf_io_low_close(ncid, lstat) if (.not. lstat) then write(*,*) "Abort, can't close file" return end if ! We open a file with header modification: history creation. call etsf_io_low_open_modify(ncid, "open_create_t01.nc", lstat, & & history = "Testing history" , error_data = error) call tests_write_status("argument filename: NetCDF with history creation", lstat, error) ! We test the title. call etsf_io_low_read_att(ncid, etsf_io_low_global_att, "history", 1024, history, & & lstat, error_data = error) call tests_write_status(" | reading history", lstat, error) if (trim(history) /= "Testing history") then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "wrong value" lstat = .false. end if call tests_write_status(" | value history", lstat, error) call etsf_io_low_close(ncid, lstat) if (.not. lstat) then write(*,*) "Abort, can't close file" return end if ! We open a file with header modification: history appending. call etsf_io_low_open_modify(ncid, "open_create_t01.nc", lstat, & & history = "Modifying history" , error_data = error) call tests_write_status("argument filename: NetCDF with history updating", lstat, error) ! We test the title. call etsf_io_low_read_att(ncid, etsf_io_low_global_att, "history", 1024, history, & & lstat, error_data = error) call tests_write_status(" | reading history", lstat, error) if (trim(history) /= "Testing history"//char(10)//"Modifying history") then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "wrong value: '"//trim(history)//"'" lstat = .false. end if call tests_write_status(" | value history", lstat, error) call etsf_io_low_close(ncid, lstat) if (.not. lstat) then write(*,*) "Abort, can't close file" return end if write(*,*) end subroutine tests_write_modify subroutine tests_write_dim(path) character(len = *), intent(in) :: path logical :: lstat integer :: ncid, value type(etsf_io_low_error) :: error write(*,*) write(*,*) "Testing etsf_io_low_write_dim()..." ! We test an IO error, trying to write a dim in a none existing file. call etsf_io_low_write_dim(0, "pouet", 5, lstat, error_data = error) call tests_write_status("argument ncid: wrong value", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_DEF .and. error%target_type_id == ERROR_TYPE_DIM), error) ! We open a file to write in. call etsf_io_low_open_modify(ncid, "open_create_t01.nc", lstat, error_data = error) if (.not. lstat) then write(*,*) "Abort, can't open file" return end if ! We test the writing action call etsf_io_low_write_dim(ncid, "number_of_atoms", 4, lstat, error_data = error) call tests_write_status("argument dimname: write a new value", lstat, error) ! We test we can read and fetch the right value call etsf_io_low_read_dim(ncid, "number_of_atoms", value, lstat, error_data = error) call tests_write_status(" | reading dimension", lstat, error) if (value /= 4) then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%target_name = "number_of_atoms" error%error_message = "wrong value" lstat = .false. end if call tests_write_status(" | checking value", lstat, error) ! We test the writing action with a bad value call etsf_io_low_write_dim(ncid, "character_string_length", -80, lstat, error_data = error) call tests_write_status("argument value: wrong negative value", (.not. lstat), error) ! We test the over-writing action call etsf_io_low_write_dim(ncid, "character_string_length", 80, lstat, error_data = error) if (.not. lstat) then write(*,*) "Abort, can't add a dimension" return end if call etsf_io_low_write_dim(ncid, "character_string_length", 1, lstat, error_data = error) call tests_write_status("argument dimname: overwriting (should fail)", (.not. lstat), error) call etsf_io_low_write_dim(ncid, "character_string_length", 80, lstat, error_data = error) call tests_write_status("argument dimname: overwriting (same value)", lstat, error) ! We test we can read and fetch the right value call etsf_io_low_read_dim(ncid, "character_string_length", value, lstat, error_data = error) call tests_write_status(" | reading dimension", lstat, error) if (value /= 80) then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "wrong value" lstat = .false. end if call tests_write_status(" | checking value", lstat, error) call etsf_io_low_close(ncid, lstat) if (.not. lstat) then write(*,*) "Abort, can't close file" return end if write(*,*) end subroutine tests_write_dim subroutine tests_write_att_integer(path) character(len = *), intent(in) :: path integer :: ncid, ncvarid, var(3) logical :: lstat type(etsf_io_low_error) :: error write(*,*) write(*,*) "Testing etsf_io_low_write_att_integer()..." call etsf_io_low_write_att(0, etsf_io_low_global_att, "test_att_integer", & & 2, lstat, error_data = error) call tests_write_status("argument ncid: wrong value", (.not. lstat), error) call etsf_io_low_open_modify(ncid, "open_create_t02.nc", lstat) if (.not. lstat) then write(*,*) "Abort, can't open file" return end if call etsf_io_low_write_att(ncid, etsf_io_low_global_att, "test_att_integer", & & 2, lstat, error_data = error) call tests_write_status("argument att: good value (0D)", lstat, error) call etsf_io_low_read_att(ncid, etsf_io_low_global_att, "test_att_integer", & & var(1), lstat, error_data = error) call tests_write_status(" | reading variable", lstat, error) if (.not. (var(1) == 2)) then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "wrong value" lstat = .false. end if call tests_write_status(" | checking values", lstat, error) call etsf_io_low_write_att(ncid, etsf_io_low_global_att, "test_att_integer_1D", & & (/ 2, 3, 4 /), lstat, error_data = error) call tests_write_status("argument att: good value (1D)", lstat, error) call etsf_io_low_read_att(ncid, etsf_io_low_global_att, "test_att_integer_1D", & & 3, var, lstat, error_data = error) call tests_write_status(" | reading variable", lstat, error) if (.not. (var(1) == 2 .and. var(2) == 3 .and. var(3) == 4)) then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "wrong value" lstat = .false. end if call tests_write_status(" | checking values", lstat, error) call etsf_io_low_close(ncid, lstat) if (.not. lstat) then write(*,*) "Abort, can't close file" return end if write(*,*) end subroutine tests_write_att_integer subroutine tests_write_att_real(path) character(len = *), intent(in) :: path integer :: ncid, ncvarid real :: var(3) logical :: lstat type(etsf_io_low_error) :: error write(*,*) write(*,*) "Testing etsf_io_low_write_att_real()..." call etsf_io_low_write_att(0, etsf_io_low_global_att, "test_att_real", & & 2., lstat, error_data = error) call tests_write_status("argument ncid: wrong value", (.not. lstat), error) call etsf_io_low_open_modify(ncid, "open_create_t02.nc", lstat) if (.not. lstat) then write(*,*) "Abort, can't open file" return end if call etsf_io_low_write_att(ncid, etsf_io_low_global_att, "test_att_real", & & 2., lstat, error_data = error) call tests_write_status("argument att: good value (0D)", lstat, error) call etsf_io_low_read_att(ncid, etsf_io_low_global_att, "test_att_real", & & var(1), lstat, error_data = error) call tests_write_status(" | reading variable", lstat, error) if (.not. (var(1) == 2.)) then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "wrong value" lstat = .false. end if call tests_write_status(" | checking values", lstat, error) call etsf_io_low_write_att(ncid, etsf_io_low_global_att, "test_att_real_1D", & & (/ 2., 3., 4. /), lstat, error_data = error) call tests_write_status("argument att: good value (1D)", lstat, error) call etsf_io_low_read_att(ncid, etsf_io_low_global_att, "test_att_real_1D", & & 3, var, lstat, error_data = error) call tests_write_status(" | reading variable", lstat, error) if (.not. (var(1) == 2. .and. var(2) == 3. .and. var(3) == 4.)) then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "wrong value" lstat = .false. end if call tests_write_status(" | checking values", lstat, error) call etsf_io_low_close(ncid, lstat) if (.not. lstat) then write(*,*) "Abort, can't close file" return end if write(*,*) end subroutine tests_write_att_real subroutine tests_write_att_double(path) character(len = *), intent(in) :: path integer :: ncid, ncvarid double precision :: var(3) logical :: lstat type(etsf_io_low_error) :: error write(*,*) write(*,*) "Testing etsf_io_low_write_att_double()..." call etsf_io_low_write_att(0, etsf_io_low_global_att, "test_att_double", & & 2.d0, lstat, error_data = error) call tests_write_status("argument ncid: wrong value", (.not. lstat), error) call etsf_io_low_open_modify(ncid, "open_create_t02.nc", lstat) if (.not. lstat) then write(*,*) "Abort, can't open file" return end if call etsf_io_low_write_att(ncid, etsf_io_low_global_att, "test_att_double", & & 2.d0, lstat, error_data = error) call tests_write_status("argument att: good value (0D)", lstat, error) call etsf_io_low_read_att(ncid, etsf_io_low_global_att, "test_att_double", & & var(1), lstat, error_data = error) call tests_write_status(" | reading variable", lstat, error) if (.not. (var(1) == 2.d0)) then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "wrong value" lstat = .false. end if call tests_write_status(" | checking values", lstat, error) call etsf_io_low_write_att(ncid, etsf_io_low_global_att, "test_att_double_1D", & & (/ 2.d0, 3.d0, 4.d0 /), lstat, error_data = error) call tests_write_status("argument att: good value (1D)", lstat, error) call etsf_io_low_read_att(ncid, etsf_io_low_global_att, "test_att_double_1D", & & 3, var, lstat, error_data = error) call tests_write_status(" | reading variable", lstat, error) if (.not. (var(1) == 2.d0 .and. var(2) == 3.d0 .and. var(3) == 4.d0)) then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "wrong value" lstat = .false. end if call tests_write_status(" | checking values", lstat, error) call etsf_io_low_close(ncid, lstat) if (.not. lstat) then write(*,*) "Abort, can't close file" return end if write(*,*) end subroutine tests_write_att_double subroutine tests_write_att_character(path) character(len = *), intent(in) :: path integer :: ncid, ncvarid character(len = 80) :: var logical :: lstat type(etsf_io_low_error) :: error write(*,*) write(*,*) "Testing etsf_io_low_write_att_character()..." call etsf_io_low_write_att(0, etsf_io_low_global_att, "test_att_character", & & "toto", lstat, error_data = error) call tests_write_status("argument ncid: wrong value", (.not. lstat), error) call etsf_io_low_open_modify(ncid, "open_create_t02.nc", lstat) if (.not. lstat) then write(*,*) "Abort, can't open file" return end if call etsf_io_low_write_att(ncid, etsf_io_low_global_att, "test_att_character", & & "toto", lstat, error_data = error) call tests_write_status("argument att: good value", lstat, error) call etsf_io_low_read_att(ncid, etsf_io_low_global_att, "test_att_character", & & 80, var, lstat, error_data = error) call tests_write_status(" | reading variable", lstat, error) if (.not. (trim(var) == "toto")) then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "wrong value" lstat = .false. end if call tests_write_status(" | checking values", lstat, error) call etsf_io_low_close(ncid, lstat) if (.not. lstat) then write(*,*) "Abort, can't close file" return end if write(*,*) end subroutine tests_write_att_character subroutine tests_def_var(path) character(len = *), intent(in) :: path logical :: lstat integer :: ncid, value, ncvarid, vardims(1) type(etsf_io_low_error) :: error type(etsf_io_low_var_infos) :: infos write(*,*) write(*,*) "Testing etsf_io_low_def_var()..." ! We test an IO error, trying to write a dim in a none existing file. call etsf_io_low_def_var(0, "pouet", NF90_INT, lstat, error_data = error) call tests_write_status("argument ncid: wrong value", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_DEF .and. error%target_type_id == ERROR_TYPE_VAR), error) ! We open a file to write in. call etsf_io_low_open_modify(ncid, "open_create_t01.nc", lstat, error_data = error) if (.not. lstat) then write(*,*) "Abort, can't open file" return end if ! We add a single value as variable, but wrong type call etsf_io_low_def_var(ncid, "number_of_electrons", -2, lstat, error_data = error) call tests_write_status("single value: wrong type", (.not. lstat), error) ! We add a single variable call etsf_io_low_def_var(ncid, "number_of_electrons", NF90_INT, lstat, error_data = error) call tests_write_status("single value: adding a new variable", lstat, error) ! We add single variable, but overwriting is not allowed. call etsf_io_low_def_var(ncid, "number_of_electrons", NF90_DOUBLE, lstat, error_data = error) call tests_write_status("single value: overwriting (should fail)", (.not. lstat), error) ! We add single variable, overwriting, with the same definition. call etsf_io_low_def_var(ncid, "number_of_electrons", NF90_INT, lstat, error_data = error) call tests_write_status("single value: overwriting (matching definition)", lstat, error) ! We check the definition. call etsf_io_low_read_var_infos(ncid, "number_of_electrons", infos, lstat, error_data = error) call tests_write_status("single value: read definition", lstat, error) if (.not. (infos%nctype == etsf_io_low_integer .and. infos%ncshape == 0)) then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_VAR error%error_message = "wrong value" lstat = .false. end if call tests_write_status(" | check definition", lstat, error) ! We add an array as variable, but wrong type call etsf_io_low_def_var(ncid, "atom_species", -2, lstat, error_data = error) call tests_write_status("1D array: wrong type", (.not. lstat), error) ! We add a single variable, but unknown dimension call etsf_io_low_def_var(ncid, "atom_species", NF90_INT, (/ "pouet" /), & & lstat, error_data = error) call tests_write_status("1D array: wrong dimension", (.not. lstat), error) ! We add a single variable call etsf_io_low_def_var(ncid, "atom_species", NF90_INT, (/ "number_of_atoms" /), & & lstat, error_data = error) call tests_write_status("1D array: adding a new variable", lstat, error) ! We add single variable, but overwriting is not allowed. call etsf_io_low_def_var(ncid, "atom_species", NF90_INT, lstat, error_data = error) call tests_write_status("1D array: overwriting (should fail)", (.not. lstat), error) ! We add single variable, overwriting, with the same definition. call etsf_io_low_def_var(ncid, "atom_species", NF90_INT, (/ "number_of_atoms" /), & & lstat, error_data = error) call tests_write_status("1D array: overwriting (matching definition)", lstat, error) ! We check the definition. call etsf_io_low_read_var_infos(ncid, "atom_species", infos, lstat, error_data = error) call tests_write_status("1D array: read definition", lstat, error) if (.not. (infos%nctype == etsf_io_low_integer .and. & & infos%ncshape == 1 .and. infos%ncdims(1) == 4)) then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_VAR error%error_message = "wrong value" lstat = .false. end if call tests_write_status(" | check definition", lstat, error) ! We add a 2D integer array for future testing. call etsf_io_low_def_var(ncid, "test_integer_2d", NF90_INT, & & (/ "number_of_atoms", "number_of_atoms" /), & & lstat, error_data = error) call tests_write_status("2D array: adding a new variable", lstat, error) ! We add a string as variable call etsf_io_low_def_var(ncid, "exchange_functional", NF90_CHAR, & & (/ "character_string_length" /), lstat, error_data = error) call tests_write_status("string: adding a new variable", lstat, error) ! We check the definition. call etsf_io_low_read_var_infos(ncid, "exchange_functional", infos, lstat, error_data = error) call tests_write_status("string: read definition", lstat, error) if (.not. (infos%nctype == etsf_io_low_character .and. & & infos%ncshape == 1 .and. infos%ncdims(1) == 80)) then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_VAR error%error_message = "wrong value" lstat = .false. end if call tests_write_status(" | check definition", lstat, error) call etsf_io_low_write_dim(ncid, "number_of_reduced_dimensions", 3, lstat, error_data = error) ! We add a 2D array as variable call etsf_io_low_def_var(ncid, "reduced_atom_positions", NF90_DOUBLE, & & (/ pad("number_of_reduced_dimensions"), pad("number_of_atoms") /), & & lstat, error_data = error) call tests_write_status("2D array: adding a new variable", lstat, error) ! We check the definition. call etsf_io_low_read_var_infos(ncid, "reduced_atom_positions", infos, lstat, error_data = error) call tests_write_status("2D array: read definition", lstat, error) if (.not. (infos%nctype == etsf_io_low_double .and. & & infos%ncshape == 2 .and. infos%ncdims(1) == 3 .and. & & infos%ncdims(2) == 4)) then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_VAR error%error_message = "wrong value" lstat = .false. end if call tests_write_status(" | check definition", lstat, error) ! We add a 4D array for future testing. call etsf_io_low_def_var(ncid, "density", NF90_DOUBLE, & & (/ "number_of_reduced_dimensions", "number_of_reduced_dimensions", & & "number_of_reduced_dimensions", "number_of_atoms " /), & & lstat, error_data = error) call tests_write_status("4D array: adding a new variable", lstat, error) call etsf_io_low_close(ncid, lstat) if (.not. lstat) then write(*,*) "Abort, can't close file" return end if write(*,*) end subroutine tests_def_var subroutine tests_write_var_integer(path) character(len = *), intent(in) :: path integer :: ncid, ncvarid integer, target :: var(4), var2d(2, 2) character(len = 4) :: varc logical :: lstat type(etsf_io_low_error) :: error type(etsf_io_low_var_integer) :: var_gen write(*,*) write(*,*) "Testing etsf_io_low_write_var_integer()..." call etsf_io_low_write_var(0, "atom_species", var, lstat, error_data = error) call tests_write_status("argument ncid: wrong value", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_INQ), error) call etsf_io_low_open_modify(ncid, "open_create_t01.nc", lstat) if (.not. lstat) then write(*,*) "Abort, can't open file" return end if call etsf_io_low_set_write_mode(ncid, lstat) if (.not. lstat) then write(*,*) "Abort, can't switch to data mode" return end if call etsf_io_low_write_var(ncid, "pouet", var, lstat, error_data = error) call tests_write_status("argument varname: wrong value", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_INQ .and. error%target_type_id == ERROR_TYPE_VID), & & error) call etsf_io_low_write_var(ncid, "atom_species", varc, 4, lstat, error_data = error) call tests_write_status("argument var: wrong type", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_SPEC .and. error%target_type_id == ERROR_TYPE_VAR), & & error) call etsf_io_low_write_var(ncid, "atom_species", var(1:3), lstat, error_data = error) call tests_write_status("argument var: wrong dimensions", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_SPEC .and. error%target_type_id == ERROR_TYPE_ARG), & & error) call etsf_io_low_write_var(ncid, "number_of_electrons", 12, lstat, error_data = error) call tests_write_status("argument var: good value (0D)", lstat, error) call etsf_io_low_read_var(ncid, "number_of_electrons", var(1), lstat, error_data = error) call tests_write_status(" | reading variable", lstat, error) if (.not. (var(1) == 12)) then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "wrong value" lstat = .false. end if call tests_write_status(" | checking values", lstat, error) var(:) = (/ 1, 2, 3, 4 /) call etsf_io_low_write_var(ncid, "atom_species", var, lstat, error_data = error) call tests_write_status("argument var: good value (1D)", lstat, error) call etsf_io_low_read_var(ncid, "atom_species", var, lstat, error_data = error) call tests_write_status(" | reading variable", lstat, error) if (.not. (var(1) == 1 .and. var(2) == 2 .and. var(3) == 3 .and. var(4) == 4)) then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "wrong value" lstat = .false. end if call tests_write_status(" | checking values", lstat, error) var2d = reshape((/ 4, 5, 6, 7 /), (/ 2, 2/)) call etsf_io_low_write_var(ncid, "atom_species", var2d(1:1, :), & & lstat, error_data = error) call tests_write_status("argument var: wrong matching (2D <-> 1D)", (.not. lstat), error) call etsf_io_low_write_var(ncid, "atom_species", var2d, & & lstat, error_data = error) call tests_write_status("argument var: good matching (2D <-> 1D)", lstat, error) call etsf_io_low_read_var(ncid, "atom_species", var, lstat, error_data = error) call tests_write_status(" | reading variable", lstat, error) if (.not. (var(1) == 4 .and. var(2) == 5 .and. var(3) == 6 .and. var(4) == 7)) then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "wrong value" lstat = .false. end if call tests_write_status(" | checking values", lstat, error) var = (/ 7, 5, 3, 9 /) call etsf_io_low_write_var(ncid, "test_integer_2d", var, & & lstat, start = (/ 1, 2, 3 /), count = (/ 0, 1, 1 /), & & error_data = error) call tests_write_status("argument sub: wrong size", (.not. lstat), error) call etsf_io_low_write_var(ncid, "test_integer_2d", var, & & lstat, start = (/ 1, 6 /), count = (/ 0, 1 /), error_data = error) call tests_write_status("argument sub: out-of-bounds", (.not. lstat), error) call etsf_io_low_write_var(ncid, "test_integer_2d", var(1:3), & & lstat, start = (/ 1, 2 /), count = (/ 0, 1 /), error_data = error) call tests_write_status("argument sub: wrong dimensions", (.not. lstat), error) call etsf_io_low_write_var(ncid, "test_integer_2d", var, & & lstat, start = (/ 1, 2 /), count = (/ 0, 1 /), error_data = error) call tests_write_status("argument sub: good dimensions", lstat, error) call etsf_io_low_read_var(ncid, "test_integer_2d", var, lstat, & & start = (/ 1, 2 /), count = (/ 0, 1 /), error_data = error) call tests_write_status(" | reading variable", lstat, error) if (.not. (var(1) == 7 .and. var(2) == 5 .and. var(3) == 3 .and. var(4) == 9)) then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "wrong value" lstat = .false. end if call tests_write_status(" | checking values", lstat, error) var = (/ 1, 2, 3, 4 /) var_gen%data1D => var call etsf_io_low_write_var(ncid, "atom_species", var_gen, lstat, error_data = error) call tests_write_status("argument var: generic pointer (1D)", lstat, error) var(:) = 0 call etsf_io_low_read_var(ncid, "atom_species", var_gen, lstat, error_data = error) call tests_write_status(" | reading variable", lstat, error) if (.not. (var(1) == 1 .and. var(2) == 2 .and. var(3) == 3 .and. var(4) == 4)) then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "wrong value" lstat = .false. end if call tests_write_status(" | checking values", lstat, error) call etsf_io_low_close(ncid, lstat) if (.not. lstat) then write(*,*) "Abort, can't close file" return end if write(*,*) end subroutine tests_write_var_integer subroutine tests_write_var_double(path) character(len = *), intent(in) :: path integer :: ncid, ncvarid, i double precision, target :: var(3, 4), bigvar(12), density(27) character(len = 3) :: varc(4) logical :: lstat type(etsf_io_low_error) :: error type(etsf_io_low_var_double) :: var_gen write(*,*) write(*,*) "Testing etsf_io_low_write_var_double()..." call etsf_io_low_write_var(0, "reduced_atom_positions", var, lstat, error_data = error) call tests_write_status("argument ncid: wrong value", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_INQ), error) call etsf_io_low_open_modify(ncid, "open_create_t01.nc", lstat) if (.not. lstat) then write(*,*) "Abort, can't open file" return end if call etsf_io_low_set_write_mode(ncid, lstat) if (.not. lstat) then write(*,*) "Abort, can't switch to data mode" return end if call etsf_io_low_write_var(ncid, "pouet", var, lstat, error_data = error) call tests_write_status("argument varname: wrong value", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_INQ .and. error%target_type_id == ERROR_TYPE_VID), & & error) call etsf_io_low_write_var(ncid, "reduced_atom_positions", varc, 3, lstat, error_data = error) call tests_write_status("argument var: wrong type", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_SPEC .and. error%target_type_id == ERROR_TYPE_VAR), & & error) call etsf_io_low_write_var(ncid, "reduced_atom_positions", var(:, 1:3), lstat, error_data = error) call tests_write_status("argument var: wrong dimensions", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_SPEC .and. error%target_type_id == ERROR_TYPE_ARG), & & error) var = reshape((/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12 /), (/ 3, 4 /)) call etsf_io_low_write_var(ncid, "reduced_atom_positions", var, lstat, error_data = error) call tests_write_status("argument var: good value (2D)", lstat, error) call etsf_io_low_read_var(ncid, "reduced_atom_positions", var, lstat, error_data = error) call tests_write_status(" | reading variable", lstat, error) if (.not. (var(1, 1) == 1 .and. var(2, 1) == 2 .and. var(3, 1) == 3 .and. & & var(1, 2) == 4 .and. var(2, 2) == 5 .and. var(3, 2) == 6 .and. & & var(1, 3) == 7 .and. var(2, 3) == 8 .and. var(3, 3) == 9 .and. & & var(1, 4) == 10 .and. var(2, 4) == 11 .and. var(3, 4) == 12) ) then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "wrong value" lstat = .false. end if call tests_write_status(" | checking values", lstat, error) bigvar = (/ 1d0, 2d0, 3d0, 4d0, 5d0, 6d0, 7d0, 8d0, 9d0, 10d0, 11d0, 0.5d0 /) call etsf_io_low_write_var(ncid, "reduced_atom_positions", bigvar(1:10), & & lstat, error_data = error) call tests_write_status("argument var: wrong matching (2D <-> 1D)", (.not. lstat), error) call etsf_io_low_write_var(ncid, "reduced_atom_positions", bigvar, & & lstat, error_data = error) call tests_write_status("argument var: good matching (2D <-> 1D)", lstat, error) call etsf_io_low_read_var(ncid, "reduced_atom_positions", var, lstat, error_data = error) call tests_write_status(" | reading variable", lstat, error) if (.not. (var(1, 1) == 1 .and. var(2, 1) == 2 .and. var(3, 1) == 3 .and. & & var(1, 2) == 4 .and. var(2, 2) == 5 .and. var(3, 2) == 6 .and. & & var(1, 3) == 7 .and. var(2, 3) == 8 .and. var(3, 3) == 9 .and. & & var(1, 4) == 10 .and. var(2, 4) == 11 .and. var(3, 4) == 0.5d0) ) then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "wrong value" lstat = .false. end if call tests_write_status(" | checking values", lstat, error) density = (/ (-real(i) / 2.d0, i = 1, 27) /) call etsf_io_low_write_var(ncid, "density", density, & & lstat, start = (/ 1, 1, 1, 2 /), count = (/ 0, 0, 0, 1 /), & & error_data = error) call tests_write_status("argument var + sub: good matching (3D <-> 1D)", lstat, error) call etsf_io_low_read_var(ncid, "density", density, lstat, & & start = (/ 1, 1, 1, 2 /), count = (/ 0, 0, 0, 1 /), & & error_data = error) call tests_write_status(" | reading variable", lstat, error) if (.not. (density(1) == -0.5d0 .and. density(2) == -1.d0 .and. density(3) == -1.5d0) ) then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "wrong value" lstat = .false. end if call tests_write_status(" | checking values", lstat, error) var = reshape((/ (real(i) / 2.d0, i = 1, 12) /), (/ 3, 4 /)) var_gen%data2D => var call etsf_io_low_write_var(ncid, "reduced_atom_positions", var_gen, lstat, error_data = error) call tests_write_status("argument var: generic pointer (2D)", lstat, error) var(:, :) = 0.d0 call etsf_io_low_read_var(ncid, "reduced_atom_positions", var_gen, lstat, error_data = error) call tests_write_status(" | reading variable", lstat, error) if (.not. (var(1, 1) == 0.5d0 .and. var(2, 1) == 1.d0 .and. var(3, 1) == 1.5d0 .and. & & var(1, 2) == 2.d0 .and. var(2, 2) == 2.5d0 .and. var(3, 2) == 3.d0 .and. & & var(1, 3) == 3.5d0 .and. var(2, 3) == 4.d0 .and. var(3, 3) == 4.5d0 .and. & & var(1, 4) == 5.d0 .and. var(2, 4) == 5.5d0 .and. var(3, 4) == 6.d0) ) then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "wrong value" lstat = .false. end if call tests_write_status(" | checking values", lstat, error) call etsf_io_low_close(ncid, lstat) write(*,*) end subroutine tests_write_var_double subroutine tests_write_var_character(path) character(len = *), intent(in) :: path integer :: ncid, ncvarid, pos character(len = 80) :: var integer :: vari(80) logical :: lstat type(etsf_io_low_error) :: error write(*,*) write(*,*) "Testing etsf_io_low_write_var_character()..." call etsf_io_low_write_var(0, "exchange_functional", var, 80, lstat, error_data = error) call tests_write_status("argument ncid: wrong value", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_INQ), error) call etsf_io_low_open_modify(ncid, "open_create_t01.nc", lstat) if (.not. lstat) then write(*,*) "Abort, can't open file" return end if call etsf_io_low_set_write_mode(ncid, lstat) if (.not. lstat) then write(*,*) "Abort, can't switch to data mode" return end if call etsf_io_low_write_var(ncid, "pouet", var, 80, lstat, error_data = error) call tests_write_status("argument varname: wrong value", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_INQ .and. error%target_type_id == ERROR_TYPE_VID), & & error) call etsf_io_low_write_var(ncid, "exchange_functional", vari, lstat, error_data = error) call tests_write_status("argument var: wrong type", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_SPEC .and. error%target_type_id == ERROR_TYPE_VAR), & & error) call etsf_io_low_write_var(ncid, "exchange_functional", var(1:50), 50, lstat, error_data = error) call tests_write_status("argument var: wrong dimensions", (.not. lstat .and. & & error%access_mode_id == ERROR_MODE_SPEC .and. error%target_type_id == ERROR_TYPE_ARG), & & error) write(var, "(A)") "This is a wonderful functional" call etsf_io_low_write_var(ncid, "exchange_functional", var, 80, lstat, error_data = error) call tests_write_status("argument var: good value (one string)", lstat, error) call etsf_io_low_read_var(ncid, "exchange_functional", var, 80, lstat, error_data = error) call tests_write_status(" | reading variable", lstat, error) pos = index(var, char(0)) if (pos > 0) then var(pos:len(var)) = repeat(" ", len(var) - pos + 1) end if if (trim(var) /= "This is a wonderful functional") then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "wrong value" lstat = .false. end if call tests_write_status(" | checking values", lstat, error) call etsf_io_low_close(ncid, lstat) write(*,*) end subroutine tests_write_var_character subroutine tests_copy_all_att(path) character(len = *), intent(in) :: path integer :: ncid_from, ncid_to, ncvarid_from, ncvarid_to1, ncvarid_to2 logical :: lstat type(etsf_io_low_error) :: error type(etsf_io_low_var_infos) :: var_infos character(len = 80) :: title write(*,*) write(*,*) "Testing etsf_io_low_copy_all_att()..." call etsf_io_low_copy_all_att(0, 0, 0, 0, lstat, error_data = error) call tests_write_status("argument ncid_from: wrong value", (.not. lstat), error) call etsf_io_low_open_read(ncid_from, path//"/check_var_t01.nc", lstat) if (.not. lstat) then write(*,*) "Abort, can't open file from" return end if call etsf_io_low_copy_all_att(ncid_from, 0, 0, 0, lstat, error_data = error) call tests_write_status("argument ncid_to: wrong value", (.not. lstat), error) call etsf_io_low_open_modify(ncid_to, "open_create_t01.nc", lstat) if (.not. lstat) then write(*,*) "Abort, can't open file to" return end if call etsf_io_low_copy_all_att(ncid_from, ncid_to, -1, 0, lstat, error_data = error) call tests_write_status("argument ncvarid_from: wrong value", (.not. lstat), error) call etsf_io_low_copy_all_att(ncid_from, ncid_to, etsf_io_low_global_att, & & -1, lstat, error_data = error) call tests_write_status("argument ncvarid_to: wrong value", (.not. lstat), error) call etsf_io_low_copy_all_att(ncid_from, ncid_to, etsf_io_low_global_att, & & etsf_io_low_global_att, lstat, error_data = error) call tests_write_status("global attribute: valid copy", lstat, error) call etsf_io_low_read_att(ncid_to, etsf_io_low_global_att, "title", 80, title, & & lstat, error_data = error) call tests_write_status(" | reading title", lstat, error) if (trim(title) /= "Silane molecule generated by ncgen.") then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "wrong value" lstat = .false. end if call tests_write_status(" | value title", lstat, error) call etsf_io_low_read_var_infos(ncid_from, "atom_species_names", var_infos, lstat, & & error_data = error) if (.not. lstat) then write(*,*) "Abort, can't find variable 'atom_species_names'" return end if ncvarid_from = var_infos%ncid call etsf_io_low_read_var_infos(ncid_to, "exchange_functional", var_infos, lstat, & & error_data = error) if (.not. lstat) then write(*,*) "Abort, can't find variable 'exchange_functional'" return end if ncvarid_to1 = var_infos%ncid call etsf_io_low_read_var_infos(ncid_to, "number_of_electrons", var_infos, lstat, & & error_data = error) if (.not. lstat) then write(*,*) "Abort, can't find variable 'number_of_electrons'" return end if ncvarid_to2 = var_infos%ncid call etsf_io_low_copy_all_att(ncid_from, ncid_to, etsf_io_low_global_att, & & ncvarid_to2, lstat, error_data = error) call tests_write_status("global attribute to variable: valid copy", lstat, error) call etsf_io_low_read_att(ncid_to, etsf_io_low_global_att, "title", 80, title, & & lstat, error_data = error) call tests_write_status(" | reading title", lstat, error) if (trim(title) /= "Silane molecule generated by ncgen.") then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "wrong value" lstat = .false. end if call tests_write_status(" | value title", lstat, error) call etsf_io_low_copy_all_att(ncid_from, ncid_to, ncvarid_from, & & ncvarid_to1, lstat, error_data = error) call tests_write_status("variable attribute to variable: valid copy", lstat, error) call etsf_io_low_read_att(ncid_to, ncvarid_to1, "units", 80, title, & & lstat, error_data = error) call tests_write_status(" | reading attribute", lstat, error) if (trim(title) /= "pouet") then error%access_mode_id = ERROR_MODE_SPEC error%target_type_id = ERROR_TYPE_ATT error%error_message = "wrong value" lstat = .false. end if call tests_write_status(" | value units", lstat, error) call etsf_io_low_close(ncid_from, lstat) call etsf_io_low_close(ncid_to, lstat) write(*,*) end subroutine tests_copy_all_att end program tests_write etsf_io-1.0.3/tests/low_level/check_att_t01.cdl0000644000353400050630000000201610654371171016322 00000000000000netcdf Test { dimensions: number_of_atom_species = 2; number_of_atoms = 5; character_string_length = 80; number_of_reduced_dimensions = 3; number_of_vectors = 3; variables: char atom_species_names(number_of_atom_species, character_string_length); int atom_species(number_of_atoms); double reduced_atom_positions(number_of_atoms, number_of_reduced_dimensions); double primitive_vectors(number_of_vectors, number_of_reduced_dimensions); // Global attributes :file_format = "ETSF Nanoquanta"; :file_format_version = 1.3f; :Conventions = "http://www.etsf.eu/fileformats"; :title = "Silane molecule generated by ncgen."; // Variable attributes atom_species:comment = "bonjour"; atom_species:mass = 1.2f; atom_species:flag_yes="yes"; atom_species:flag_no="no"; data: atom_species_names = "Si", "H"; atom_species = 1, 2, 2, 2, 2; reduced_atom_positions = 0.5, 0.5, 0.5, 0.6, 0.6, 0.6, 0.4, 0.4, 0.6, 0.6, 0.4, 0.4, 0.4, 0.6, 0.4; primitive_vectors = 10., 0., 0., 0., 10., 0., 0., 0., 10.; } etsf_io-1.0.3/tests/low_level/open_read_t01.cdl0000644000353400050630000000157410621016456016335 00000000000000netcdf Test { dimensions: number_of_atom_species = 2; number_of_atoms = 5; character_string_length = 80; number_of_reduced_dimensions = 3; number_of_vectors = 3; variables: char atom_species_names(number_of_atom_species, character_string_length); int atom_species(number_of_atoms); double reduced_atom_positions(number_of_atoms, number_of_reduced_dimensions); double primitive_vectors(number_of_vectors, number_of_reduced_dimensions); // Global attributes // :file_format = "ETSF Nanoquanta"; // :file_format_version = 1.2f; // :Conventions = "http://www.etsf.eu/fileformats"; // :title = "Silane molecule generated by ncgen."; data: atom_species_names = "Si", "H"; atom_species = 1, 2, 2, 2, 2; reduced_atom_positions = 0.5, 0.5, 0.5, 0.6, 0.6, 0.6, 0.4, 0.4, 0.6, 0.6, 0.4, 0.4, 0.4, 0.6, 0.4; primitive_vectors = 10., 0., 0., 0., 10., 0., 0., 0., 10.; } etsf_io-1.0.3/tests/low_level/open_read_t02.cdl0000644000353400050630000000160610621016456016332 00000000000000netcdf Test { dimensions: number_of_atom_species = 2; number_of_atoms = 5; character_string_length = 80; number_of_reduced_dimensions = 3; number_of_vectors = 3; variables: char atom_species_names(number_of_atom_species, character_string_length); int atom_species(number_of_atoms); double reduced_atom_positions(number_of_atoms, number_of_reduced_dimensions); double primitive_vectors(number_of_vectors, number_of_reduced_dimensions); // Global attributes :file_format = "ETSF Nanoquanta pouet-pouet"; // :file_format_version = 1.2f; // :Conventions = "http://www.etsf.eu/fileformats"; // :title = "Silane molecule generated by ncgen."; data: atom_species_names = "Si", "H"; atom_species = 1, 2, 2, 2, 2; reduced_atom_positions = 0.5, 0.5, 0.5, 0.6, 0.6, 0.6, 0.4, 0.4, 0.6, 0.6, 0.4, 0.4, 0.4, 0.6, 0.4; primitive_vectors = 10., 0., 0., 0., 10., 0., 0., 0., 10.; } etsf_io-1.0.3/tests/low_level/open_read_t03.cdl0000644000353400050630000000157010621016456016333 00000000000000netcdf Test { dimensions: number_of_atom_species = 2; number_of_atoms = 5; character_string_length = 80; number_of_reduced_dimensions = 3; number_of_vectors = 3; variables: char atom_species_names(number_of_atom_species, character_string_length); int atom_species(number_of_atoms); double reduced_atom_positions(number_of_atoms, number_of_reduced_dimensions); double primitive_vectors(number_of_vectors, number_of_reduced_dimensions); // Global attributes :file_format = "ETSF Nanoquanta"; :file_format_version = 1.2f; // :Conventions = "http://www.etsf.eu/fileformats"; // :title = "Silane molecule generated by ncgen."; data: atom_species_names = "Si", "H"; atom_species = 1, 2, 2, 2, 2; reduced_atom_positions = 0.5, 0.5, 0.5, 0.6, 0.6, 0.6, 0.4, 0.4, 0.6, 0.6, 0.4, 0.4, 0.4, 0.6, 0.4; primitive_vectors = 10., 0., 0., 0., 10., 0., 0., 0., 10.; } etsf_io-1.0.3/tests/low_level/open_read_t04.cdl0000644000353400050630000000156410621016455016336 00000000000000netcdf Test { dimensions: number_of_atom_species = 2; number_of_atoms = 5; character_string_length = 80; number_of_reduced_dimensions = 3; number_of_vectors = 3; variables: char atom_species_names(number_of_atom_species, character_string_length); int atom_species(number_of_atoms); double reduced_atom_positions(number_of_atoms, number_of_reduced_dimensions); double primitive_vectors(number_of_vectors, number_of_reduced_dimensions); // Global attributes :file_format = "ETSF Nanoquanta"; :file_format_version = 1.3f; :Conventions = "http://www.etsf.eu/fileformats"; :title = "Silane molecule generated by ncgen."; data: atom_species_names = "Si", "H"; atom_species = 1, 2, 2, 2, 2; reduced_atom_positions = 0.5, 0.5, 0.5, 0.6, 0.6, 0.6, 0.4, 0.4, 0.6, 0.6, 0.4, 0.4, 0.4, 0.6, 0.4; primitive_vectors = 10., 0., 0., 0., 10., 0., 0., 0., 10.; } etsf_io-1.0.3/tests/low_level/read_var_t01.cdl0000644000353400050630000000360110621016456016155 00000000000000netcdf Test { dimensions: number_of_atom_species = 2; number_of_atoms = 5; character_string_length = 80; number_of_reduced_dimensions = 3; number_of_vectors = 3; number_of_components = 2; variables: char atom_species_names(number_of_atom_species, character_string_length); int atom_species(number_of_atoms); int test_integer_2d(number_of_atom_species, number_of_atom_species); int test_integer_4d(number_of_components, number_of_vectors, number_of_vectors, number_of_atom_species); int space_group; double test_double_0d; double test_double_1d(number_of_vectors); double reduced_atom_positions(number_of_atoms, number_of_reduced_dimensions); double primitive_vectors(number_of_vectors, number_of_reduced_dimensions); double density(number_of_components, number_of_vectors, number_of_vectors, number_of_vectors); // Global attributes :file_format = "ETSF Nanoquanta"; :file_format_version = 1.3f; :Conventions = "http://www.etsf.eu/fileformats"; :title = "Silane molecule generated by ncgen."; data: space_group = 1; atom_species_names = "Si", "H"; atom_species = 1, 2, 2, 2, 2; test_integer_2d = 1, 2, 3, 4; test_integer_4d = 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, -1, -2, -3, -4, -5, -6, -7, -8, -9, -10, -11, -12, -13, -14, -15, -16, -17, -18; test_double_0d = 3.14; test_double_1d = 1., 2., 3.; reduced_atom_positions = 0.5, 0.5, 0.5, 0.6, 0.6, 0.6, 0.4, 0.4, 0.6, 0.6, 0.4, 0.4, 0.4, 0.6, 0.4; primitive_vectors = 10., 0., 0., 0., 10., 0., 0., 0., 10.; density = 0., 1., 0., 1., 2., 1., 0., 1., 0., 1., 2., 1., 2., 3., 2., 1., 2., 1., 0., 1., 0., 1., 2., 1., 0., 1., 0., -0., -1., -0., -1., -2., -1., -0., -1., -0., -1., -2., -1., -2., -3., -2., -1., -2., -1., -0., -1., -0., -1., -2., -1., -0., -1., -0.; } etsf_io-1.0.3/tests/low_level/check_att_t01.nc0000644000353400050630000000204010654371173016157 00000000000000CDF number_of_atom_speciesnumber_of_atomscharacter_string_lengthPnumber_of_reduced_dimensionsnumber_of_vectors  file_formatETSF Nanoquantafile_format_version?¦ff Conventionshttp://www.etsf.eu/fileformatstitle#Silane molecule generated by ncgen. atom_species_names ¬ atom_species commentbonjourmass?™™šflag_yesyesflag_nonoLreduced_atom_positionsx`primitive_vectorsHØSiH?à?à?à?ã333333?ã333333?ã333333?Ù™™™™™š?Ù™™™™™š?ã333333?ã333333?Ù™™™™™š?Ù™™™™™š?Ù™™™™™š?ã333333?Ù™™™™™š@$@$@$etsf_io-1.0.3/tests/low_level/check_var_t01.nc0000644000353400050630000000173410621016456016162 00000000000000CDF number_of_atom_speciesnumber_of_atomscharacter_string_lengthPnumber_of_reduced_dimensionsnumber_of_vectors  file_formatETSF Nanoquantafile_format_version?¦ff Conventionshttp://www.etsf.eu/fileformatstitle#Silane molecule generated by ncgen. atom_species_names unitspouet h atom_speciesreduced_atom_positionsxprimitive_vectorsH”SiH?à?à?à?ã333333?ã333333?ã333333?Ù™™™™™š?Ù™™™™™š?ã333333?ã333333?Ù™™™™™š?Ù™™™™™š?Ù™™™™™š?ã333333?Ù™™™™™š@$@$@$etsf_io-1.0.3/tests/low_level/open_read_t01.nc0000644000353400050630000000140410621016456016163 00000000000000CDF number_of_atom_speciesnumber_of_atomscharacter_string_lengthPnumber_of_reduced_dimensionsnumber_of_vectors atom_species_names  atom_species0reduced_atom_positionsxDprimitive_vectorsH¼SiH?à?à?à?ã333333?ã333333?ã333333?Ù™™™™™š?Ù™™™™™š?ã333333?ã333333?Ù™™™™™š?Ù™™™™™š?Ù™™™™™š?ã333333?Ù™™™™™š@$@$@$etsf_io-1.0.3/tests/low_level/open_read_t02.nc0000644000353400050630000000147010621016456016167 00000000000000CDF number_of_atom_speciesnumber_of_atomscharacter_string_lengthPnumber_of_reduced_dimensionsnumber_of_vectors  file_formatETSF Nanoquanta pouet-pouet atom_species_names Ä atom_speciesdreduced_atom_positionsxxprimitive_vectorsHðSiH?à?à?à?ã333333?ã333333?ã333333?Ù™™™™™š?Ù™™™™™š?ã333333?ã333333?Ù™™™™™š?Ù™™™™™š?Ù™™™™™š?ã333333?Ù™™™™™š@$@$@$etsf_io-1.0.3/tests/low_level/open_read_t03.nc0000644000353400050630000000152010621016456016164 00000000000000CDF number_of_atom_speciesnumber_of_atomscharacter_string_lengthPnumber_of_reduced_dimensionsnumber_of_vectors  file_formatETSF Nanoquantafile_format_version?™™š atom_species_names Ü atom_species|reduced_atom_positionsxprimitive_vectorsHSiH?à?à?à?ã333333?ã333333?ã333333?Ù™™™™™š?Ù™™™™™š?ã333333?ã333333?Ù™™™™™š?Ù™™™™™š?Ù™™™™™š?ã333333?Ù™™™™™š@$@$@$etsf_io-1.0.3/tests/low_level/open_read_t04.nc0000644000353400050630000000170010621016456016165 00000000000000CDF number_of_atom_speciesnumber_of_atomscharacter_string_lengthPnumber_of_reduced_dimensionsnumber_of_vectors  file_formatETSF Nanoquantafile_format_version?¦ff Conventionshttp://www.etsf.eu/fileformatstitle#Silane molecule generated by ncgen. atom_species_names L atom_speciesìreduced_atom_positionsxprimitive_vectorsHxSiH?à?à?à?ã333333?ã333333?ã333333?Ù™™™™™š?Ù™™™™™š?ã333333?ã333333?Ù™™™™™š?Ù™™™™™š?Ù™™™™™š?ã333333?Ù™™™™™š@$@$@$etsf_io-1.0.3/tests/low_level/read_dim_t01.nc0000644000353400050630000000170010621016456015772 00000000000000CDF number_of_atom_speciesnumber_of_atomscharacter_string_lengthPnumber_of_reduced_dimensionsnumber_of_vectors  file_formatETSF Nanoquantafile_format_version?¦ff Conventionshttp://www.etsf.eu/fileformatstitle#Silane molecule generated by ncgen. atom_species_names L atom_speciesìreduced_atom_positionsxprimitive_vectorsHxSiH?à?à?à?ã333333?ã333333?ã333333?Ù™™™™™š?Ù™™™™™š?ã333333?ã333333?Ù™™™™™š?Ù™™™™™š?Ù™™™™™š?ã333333?Ù™™™™™š@$@$@$etsf_io-1.0.3/tests/low_level/read_var_t01.nc0000644000353400050630000000357010621016456016020 00000000000000CDF number_of_atom_speciesnumber_of_atomscharacter_string_lengthPnumber_of_reduced_dimensionsnumber_of_vectorsnumber_of_components  file_formatETSF Nanoquantafile_format_version?¦ff Conventionshttp://www.etsf.eu/fileformatstitle#Silane molecule generated by ncgen. atom_species_names  atom_species0test_integer_2dDtest_integer_4dT space_groupätest_double_0dètest_double_1dðreduced_atom_positionsxprimitive_vectorsH€density°ÈSiH ÿÿÿÿÿÿÿþÿÿÿýÿÿÿüÿÿÿûÿÿÿúÿÿÿùÿÿÿøÿÿÿ÷ÿÿÿöÿÿÿõÿÿÿôÿÿÿóÿÿÿòÿÿÿñÿÿÿðÿÿÿïÿÿÿî@ ¸Që…?ð@@?à?à?à?ã333333?ã333333?ã333333?Ù™™™™™š?Ù™™™™™š?ã333333?ã333333?Ù™™™™™š?Ù™™™™™š?Ù™™™™™š?ã333333?Ù™™™™™š@$@$@$?ð?ð@?ð?ð?ð@?ð@@@?ð@?ð?ð?ð@?ð?ð€¿ð€¿ðÀ¿ð€¿ð€¿ðÀ¿ðÀÀÀ¿ðÀ¿ð€¿ð€¿ðÀ¿ð€¿ð€etsf_io-1.0.3/tests/low_level/tests_run.sh0000744000353400050620000000014110643437760015611 00000000000000#!/bin/sh if `grep -qs "Failed" tests_write.log tests_read.log`; then exit 1 else exit 0 fi etsf_io-1.0.3/tests/group_level/0000777000353400050620000000000011354151525013641 500000000000000etsf_io-1.0.3/tests/group_level/Makefile.am0000644000353400050630000000411411354117630015611 00000000000000vpath %.a $(top_builddir)/src/group_level AM_FCFLAGS = -I$(top_builddir)/src/low_level -I$(top_builddir)/src/group_level -I@NETCDF_CFLAGS@ EXTRA_DIST = \ test_split_electrons_part1.cdl \ test_split_electrons_part1.nc \ test_split_electrons_part2.cdl \ test_split_electrons_part2.nc \ test_split_electrons_part3.cdl \ test_split_electrons_part3.nc \ tests_run.sh check_PROGRAMS = tests_init tests_write tests_read tests_copy tests_init_SOURCES = tests_init.f90 tests_init_LDFLAGS = -L$(top_builddir)/src/group_level tests_init_LDADD = -letsf_io tests_write_SOURCES = tests_module.f90 tests_write.f90 tests_write_LDFLAGS = -L$(top_builddir)/src/group_level tests_write_LDADD = -letsf_io tests_read_SOURCES = tests_module.f90 tests_read.f90 tests_read_LDFLAGS = -L$(top_builddir)/src/group_level tests_read_LDADD = -letsf_io tests_copy_SOURCES = tests_module.f90 tests_copy.f90 tests_copy_LDFLAGS = -L$(top_builddir)/src/group_level tests_copy_LDADD = -letsf_io TESTS = run CLEANFILES = run tests_init.log tests_write.log tests_read.log tests_copy.log tests.mod tests.MOD TESTS.MOD test_init_*.nc test_write_*.nc test_read_*.nc test_copy_*.nc #dependencies tests_init.o: tests_init.f90 \ libetsf_io.a tests_read.o: tests_read.f90 \ tests_module.o \ libetsf_io.a tests_write.o: tests_write.f90 \ tests_module.o \ libetsf_io.a tests_copy.o: tests_copy.f90 \ tests_module.o \ libetsf_io.a tests_module.o: tests_module.f90 #additional rules run: $(srcdir)/tests_run.sh tests_init.log tests_write.log tests_read.log tests_copy.log \cp $(srcdir)/tests_run.sh run run-tests: tests_init.log tests_write.log tests_read.log tests_copy.log cat *.log run-tests-init tests_init.log: tests_init \rm -f test_init_*.nc ./tests_init | tee tests_init.log run-tests-write tests_write.log: tests_write tests_init.log \rm -f test_write_*.nc ./tests_write | tee tests_write.log run-tests-read tests_read.log: tests_read tests_init.log \rm -f test_read_*.nc ./tests_read | tee tests_read.log run-tests-copy tests_copy.log: tests_copy tests_write.log \rm -f test_copy_*.nc ./tests_copy | tee tests_copy.log etsf_io-1.0.3/tests/group_level/Makefile.in0000644000353400050620000004037711354150420015626 00000000000000# Makefile.in generated by automake 1.10.1 from Makefile.am. # @configure_input@ # Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, # 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. # This Makefile.in is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY, to the extent permitted by law; without # even the implied warranty of MERCHANTABILITY or FITNESS FOR A # PARTICULAR PURPOSE. @SET_MAKE@ VPATH = @srcdir@ pkgdatadir = $(datadir)/@PACKAGE@ pkglibdir = $(libdir)/@PACKAGE@ pkgincludedir = $(includedir)/@PACKAGE@ am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd install_sh_DATA = $(install_sh) -c -m 644 install_sh_PROGRAM = $(install_sh) -c install_sh_SCRIPT = $(install_sh) -c INSTALL_HEADER = $(INSTALL_DATA) transform = $(program_transform_name) NORMAL_INSTALL = : PRE_INSTALL = : POST_INSTALL = : NORMAL_UNINSTALL = : PRE_UNINSTALL = : POST_UNINSTALL = : check_PROGRAMS = tests_init$(EXEEXT) tests_write$(EXEEXT) \ tests_read$(EXEEXT) tests_copy$(EXEEXT) subdir = tests/group_level DIST_COMMON = $(srcdir)/Makefile.am $(srcdir)/Makefile.in ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 am__aclocal_m4_deps = $(top_srcdir)/config/m4/fortran.m4 \ $(top_srcdir)/configure.ac am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ $(ACLOCAL_M4) mkinstalldirs = $(install_sh) -d CONFIG_CLEAN_FILES = am_tests_copy_OBJECTS = tests_module.$(OBJEXT) tests_copy.$(OBJEXT) tests_copy_OBJECTS = $(am_tests_copy_OBJECTS) tests_copy_DEPENDENCIES = tests_copy_LINK = $(FCLD) $(AM_FCFLAGS) $(FCFLAGS) \ $(tests_copy_LDFLAGS) $(LDFLAGS) -o $@ am_tests_init_OBJECTS = tests_init.$(OBJEXT) tests_init_OBJECTS = $(am_tests_init_OBJECTS) tests_init_DEPENDENCIES = tests_init_LINK = $(FCLD) $(AM_FCFLAGS) $(FCFLAGS) \ $(tests_init_LDFLAGS) $(LDFLAGS) -o $@ am_tests_read_OBJECTS = tests_module.$(OBJEXT) tests_read.$(OBJEXT) tests_read_OBJECTS = $(am_tests_read_OBJECTS) tests_read_DEPENDENCIES = tests_read_LINK = $(FCLD) $(AM_FCFLAGS) $(FCFLAGS) \ $(tests_read_LDFLAGS) $(LDFLAGS) -o $@ am_tests_write_OBJECTS = tests_module.$(OBJEXT) tests_write.$(OBJEXT) tests_write_OBJECTS = $(am_tests_write_OBJECTS) tests_write_DEPENDENCIES = tests_write_LINK = $(FCLD) $(AM_FCFLAGS) $(FCFLAGS) \ $(tests_write_LDFLAGS) $(LDFLAGS) -o $@ DEFAULT_INCLUDES = -I.@am__isrc@ FCCOMPILE = $(FC) $(AM_FCFLAGS) $(FCFLAGS) FCLD = $(FC) FCLINK = $(FCLD) $(AM_FCFLAGS) $(FCFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o \ $@ SOURCES = $(tests_copy_SOURCES) $(tests_init_SOURCES) \ $(tests_read_SOURCES) $(tests_write_SOURCES) DIST_SOURCES = $(tests_copy_SOURCES) $(tests_init_SOURCES) \ $(tests_read_SOURCES) $(tests_write_SOURCES) ETAGS = etags CTAGS = ctags DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) ACLOCAL = @ACLOCAL@ AMTAR = @AMTAR@ AR = @AR@ AUTOCONF = @AUTOCONF@ AUTOHEADER = @AUTOHEADER@ AUTOMAKE = @AUTOMAKE@ AWK = @AWK@ CYGPATH_W = @CYGPATH_W@ DEFS = @DEFS@ ECHO_C = @ECHO_C@ ECHO_N = @ECHO_N@ ECHO_T = @ECHO_T@ EXEEXT = @EXEEXT@ FC = @FC@ FCFLAGS = @FCFLAGS@ FCFLAGS_f90 = @FCFLAGS_f90@ FFLAGS = @FFLAGS@ INSTALL = @INSTALL@ INSTALL_DATA = @INSTALL_DATA@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ INSTALL_SCRIPT = @INSTALL_SCRIPT@ INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ LDFLAGS = @LDFLAGS@ LIBOBJS = @LIBOBJS@ LIBS = @LIBS@ LTLIBOBJS = @LTLIBOBJS@ MAKEINFO = @MAKEINFO@ MKDIR_P = @MKDIR_P@ MODULE_EXT = @MODULE_EXT@ NETCDF_CFLAGS = @NETCDF_CFLAGS@ OBJEXT = @OBJEXT@ PACKAGE = @PACKAGE@ PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ PACKAGE_NAME = @PACKAGE_NAME@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_VERSION = @PACKAGE_VERSION@ PATH_SEPARATOR = @PATH_SEPARATOR@ RANLIB = @RANLIB@ SET_MAKE = @SET_MAKE@ SHELL = @SHELL@ STRIP = @STRIP@ VERSION = @VERSION@ abs_builddir = @abs_builddir@ abs_srcdir = @abs_srcdir@ abs_top_builddir = @abs_top_builddir@ abs_top_srcdir = @abs_top_srcdir@ ac_ct_FC = @ac_ct_FC@ am__leading_dot = @am__leading_dot@ am__tar = @am__tar@ am__untar = @am__untar@ bindir = @bindir@ build_alias = @build_alias@ builddir = @builddir@ datadir = @datadir@ datarootdir = @datarootdir@ docdir = @docdir@ dvidir = @dvidir@ exec_prefix = @exec_prefix@ fc_type = @fc_type@ fc_version = @fc_version@ fc_wrap = @fc_wrap@ groupleveldocdir = @groupleveldocdir@ host_alias = @host_alias@ htmldir = @htmldir@ includedir = @includedir@ infodir = @infodir@ install_sh = @install_sh@ libdir = @libdir@ libexecdir = @libexecdir@ localedir = @localedir@ localstatedir = @localstatedir@ lowleveldocdir = @lowleveldocdir@ mandir = @mandir@ mkdir_p = @mkdir_p@ moduledir = @moduledir@ oldincludedir = @oldincludedir@ pdfdir = @pdfdir@ prefix = @prefix@ program_transform_name = @program_transform_name@ psdir = @psdir@ sbindir = @sbindir@ sharedstatedir = @sharedstatedir@ srcdir = @srcdir@ sysconfdir = @sysconfdir@ target_alias = @target_alias@ top_builddir = @top_builddir@ top_srcdir = @top_srcdir@ tutorialsdocdir = @tutorialsdocdir@ utilsdocdir = @utilsdocdir@ AM_FCFLAGS = -I$(top_builddir)/src/low_level -I$(top_builddir)/src/group_level -I@NETCDF_CFLAGS@ EXTRA_DIST = \ test_split_electrons_part1.cdl \ test_split_electrons_part1.nc \ test_split_electrons_part2.cdl \ test_split_electrons_part2.nc \ test_split_electrons_part3.cdl \ test_split_electrons_part3.nc \ tests_run.sh tests_init_SOURCES = tests_init.f90 tests_init_LDFLAGS = -L$(top_builddir)/src/group_level tests_init_LDADD = -letsf_io tests_write_SOURCES = tests_module.f90 tests_write.f90 tests_write_LDFLAGS = -L$(top_builddir)/src/group_level tests_write_LDADD = -letsf_io tests_read_SOURCES = tests_module.f90 tests_read.f90 tests_read_LDFLAGS = -L$(top_builddir)/src/group_level tests_read_LDADD = -letsf_io tests_copy_SOURCES = tests_module.f90 tests_copy.f90 tests_copy_LDFLAGS = -L$(top_builddir)/src/group_level tests_copy_LDADD = -letsf_io TESTS = run CLEANFILES = run tests_init.log tests_write.log tests_read.log tests_copy.log tests.mod tests.MOD TESTS.MOD test_init_*.nc test_write_*.nc test_read_*.nc test_copy_*.nc all: all-am .SUFFIXES: .SUFFIXES: .f90 .o .obj $(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) @for dep in $?; do \ case '$(am__configure_deps)' in \ *$$dep*) \ cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh \ && exit 0; \ exit 1;; \ esac; \ done; \ echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu tests/group_level/Makefile'; \ cd $(top_srcdir) && \ $(AUTOMAKE) --gnu tests/group_level/Makefile .PRECIOUS: Makefile Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status @case '$?' in \ *config.status*) \ cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ *) \ echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ esac; $(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh $(top_srcdir)/configure: $(am__configure_deps) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh $(ACLOCAL_M4): $(am__aclocal_m4_deps) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh clean-checkPROGRAMS: -test -z "$(check_PROGRAMS)" || rm -f $(check_PROGRAMS) tests_copy$(EXEEXT): $(tests_copy_OBJECTS) $(tests_copy_DEPENDENCIES) @rm -f tests_copy$(EXEEXT) $(tests_copy_LINK) $(tests_copy_OBJECTS) $(tests_copy_LDADD) $(LIBS) tests_init$(EXEEXT): $(tests_init_OBJECTS) $(tests_init_DEPENDENCIES) @rm -f tests_init$(EXEEXT) $(tests_init_LINK) $(tests_init_OBJECTS) $(tests_init_LDADD) $(LIBS) tests_read$(EXEEXT): $(tests_read_OBJECTS) $(tests_read_DEPENDENCIES) @rm -f tests_read$(EXEEXT) $(tests_read_LINK) $(tests_read_OBJECTS) $(tests_read_LDADD) $(LIBS) tests_write$(EXEEXT): $(tests_write_OBJECTS) $(tests_write_DEPENDENCIES) @rm -f tests_write$(EXEEXT) $(tests_write_LINK) $(tests_write_OBJECTS) $(tests_write_LDADD) $(LIBS) mostlyclean-compile: -rm -f *.$(OBJEXT) distclean-compile: -rm -f *.tab.c .f90.o: $(FCCOMPILE) -c -o $@ $< .f90.obj: $(FCCOMPILE) -c -o $@ `$(CYGPATH_W) '$<'` ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES) list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ unique=`for i in $$list; do \ if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ done | \ $(AWK) '{ files[$$0] = 1; nonemtpy = 1; } \ END { if (nonempty) { for (i in files) print i; }; }'`; \ mkid -fID $$unique tags: TAGS TAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \ $(TAGS_FILES) $(LISP) tags=; \ here=`pwd`; \ list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ unique=`for i in $$list; do \ if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ done | \ $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ END { if (nonempty) { for (i in files) print i; }; }'`; \ if test -z "$(ETAGS_ARGS)$$tags$$unique"; then :; else \ test -n "$$unique" || unique=$$empty_fix; \ $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ $$tags $$unique; \ fi ctags: CTAGS CTAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \ $(TAGS_FILES) $(LISP) tags=; \ list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ unique=`for i in $$list; do \ if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ done | \ $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ END { if (nonempty) { for (i in files) print i; }; }'`; \ test -z "$(CTAGS_ARGS)$$tags$$unique" \ || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ $$tags $$unique GTAGS: here=`$(am__cd) $(top_builddir) && pwd` \ && cd $(top_srcdir) \ && gtags -i $(GTAGS_ARGS) $$here distclean-tags: -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags check-TESTS: $(TESTS) @failed=0; all=0; xfail=0; xpass=0; skip=0; ws='[ ]'; \ srcdir=$(srcdir); export srcdir; \ list=' $(TESTS) '; \ if test -n "$$list"; then \ for tst in $$list; do \ if test -f ./$$tst; then dir=./; \ elif test -f $$tst; then dir=; \ else dir="$(srcdir)/"; fi; \ if $(TESTS_ENVIRONMENT) $${dir}$$tst; then \ all=`expr $$all + 1`; \ case " $(XFAIL_TESTS) " in \ *$$ws$$tst$$ws*) \ xpass=`expr $$xpass + 1`; \ failed=`expr $$failed + 1`; \ echo "XPASS: $$tst"; \ ;; \ *) \ echo "PASS: $$tst"; \ ;; \ esac; \ elif test $$? -ne 77; then \ all=`expr $$all + 1`; \ case " $(XFAIL_TESTS) " in \ *$$ws$$tst$$ws*) \ xfail=`expr $$xfail + 1`; \ echo "XFAIL: $$tst"; \ ;; \ *) \ failed=`expr $$failed + 1`; \ echo "FAIL: $$tst"; \ ;; \ esac; \ else \ skip=`expr $$skip + 1`; \ echo "SKIP: $$tst"; \ fi; \ done; \ if test "$$failed" -eq 0; then \ if test "$$xfail" -eq 0; then \ banner="All $$all tests passed"; \ else \ banner="All $$all tests behaved as expected ($$xfail expected failures)"; \ fi; \ else \ if test "$$xpass" -eq 0; then \ banner="$$failed of $$all tests failed"; \ else \ banner="$$failed of $$all tests did not behave as expected ($$xpass unexpected passes)"; \ fi; \ fi; \ dashes="$$banner"; \ skipped=""; \ if test "$$skip" -ne 0; then \ skipped="($$skip tests were not run)"; \ test `echo "$$skipped" | wc -c` -le `echo "$$banner" | wc -c` || \ dashes="$$skipped"; \ fi; \ report=""; \ if test "$$failed" -ne 0 && test -n "$(PACKAGE_BUGREPORT)"; then \ report="Please report to $(PACKAGE_BUGREPORT)"; \ test `echo "$$report" | wc -c` -le `echo "$$banner" | wc -c` || \ dashes="$$report"; \ fi; \ dashes=`echo "$$dashes" | sed s/./=/g`; \ echo "$$dashes"; \ echo "$$banner"; \ test -z "$$skipped" || echo "$$skipped"; \ test -z "$$report" || echo "$$report"; \ echo "$$dashes"; \ test "$$failed" -eq 0; \ else :; fi distdir: $(DISTFILES) @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ list='$(DISTFILES)'; \ dist_files=`for file in $$list; do echo $$file; done | \ sed -e "s|^$$srcdirstrip/||;t" \ -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ case $$dist_files in \ */*) $(MKDIR_P) `echo "$$dist_files" | \ sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ sort -u` ;; \ esac; \ for file in $$dist_files; do \ if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ if test -d $$d/$$file; then \ dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ cp -pR $(srcdir)/$$file $(distdir)$$dir || exit 1; \ fi; \ cp -pR $$d/$$file $(distdir)$$dir || exit 1; \ else \ test -f $(distdir)/$$file \ || cp -p $$d/$$file $(distdir)/$$file \ || exit 1; \ fi; \ done check-am: all-am $(MAKE) $(AM_MAKEFLAGS) $(check_PROGRAMS) $(MAKE) $(AM_MAKEFLAGS) check-TESTS check: check-am all-am: Makefile installdirs: install: install-am install-exec: install-exec-am install-data: install-data-am uninstall: uninstall-am install-am: all-am @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am installcheck: installcheck-am install-strip: $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ `test -z '$(STRIP)' || \ echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install mostlyclean-generic: clean-generic: -test -z "$(CLEANFILES)" || rm -f $(CLEANFILES) distclean-generic: -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) maintainer-clean-generic: @echo "This command is intended for maintainers to use" @echo "it deletes files that may require special tools to rebuild." clean: clean-am clean-am: clean-checkPROGRAMS clean-generic mostlyclean-am distclean: distclean-am -rm -f Makefile distclean-am: clean-am distclean-compile distclean-generic \ distclean-tags dvi: dvi-am dvi-am: html: html-am info: info-am info-am: install-data-am: install-dvi: install-dvi-am install-exec-am: install-html: install-html-am install-info: install-info-am install-man: install-pdf: install-pdf-am install-ps: install-ps-am installcheck-am: maintainer-clean: maintainer-clean-am -rm -f Makefile maintainer-clean-am: distclean-am maintainer-clean-generic mostlyclean: mostlyclean-am mostlyclean-am: mostlyclean-compile mostlyclean-generic pdf: pdf-am pdf-am: ps: ps-am ps-am: uninstall-am: .MAKE: install-am install-strip .PHONY: CTAGS GTAGS all all-am check check-TESTS check-am clean \ clean-checkPROGRAMS clean-generic ctags distclean \ distclean-compile distclean-generic distclean-tags distdir dvi \ dvi-am html html-am info info-am install install-am \ install-data install-data-am install-dvi install-dvi-am \ install-exec install-exec-am install-html install-html-am \ install-info install-info-am install-man install-pdf \ install-pdf-am install-ps install-ps-am install-strip \ installcheck installcheck-am installdirs maintainer-clean \ maintainer-clean-generic mostlyclean mostlyclean-compile \ mostlyclean-generic pdf pdf-am ps ps-am tags uninstall \ uninstall-am vpath %.a $(top_builddir)/src/group_level #dependencies tests_init.o: tests_init.f90 \ libetsf_io.a tests_read.o: tests_read.f90 \ tests_module.o \ libetsf_io.a tests_write.o: tests_write.f90 \ tests_module.o \ libetsf_io.a tests_copy.o: tests_copy.f90 \ tests_module.o \ libetsf_io.a tests_module.o: tests_module.f90 #additional rules run: $(srcdir)/tests_run.sh tests_init.log tests_write.log tests_read.log tests_copy.log \cp $(srcdir)/tests_run.sh run run-tests: tests_init.log tests_write.log tests_read.log tests_copy.log cat *.log run-tests-init tests_init.log: tests_init \rm -f test_init_*.nc ./tests_init | tee tests_init.log run-tests-write tests_write.log: tests_write tests_init.log \rm -f test_write_*.nc ./tests_write | tee tests_write.log run-tests-read tests_read.log: tests_read tests_init.log \rm -f test_read_*.nc ./tests_read | tee tests_read.log run-tests-copy tests_copy.log: tests_copy tests_write.log \rm -f test_copy_*.nc ./tests_copy | tee tests_copy.log # Tell versions [3.59,3.63) of GNU make to not export all variables. # Otherwise a system limit (for SysV at least) may be exceeded. .NOEXPORT: etsf_io-1.0.3/tests/group_level/tests_module.f900000644000353400050620000003310211354150301016572 00000000000000module tests use etsf_io_low_level implicit none interface tests_init_variable module procedure allocate_int_0D module procedure allocate_int_1D module procedure allocate_int_2D module procedure allocate_int_3D module procedure allocate_int_4D module procedure allocate_int_5D module procedure allocate_int_6D module procedure allocate_int_7D module procedure allocate_dbl_0D module procedure allocate_dbl_1D module procedure allocate_dbl_2D module procedure allocate_dbl_3D module procedure allocate_dbl_4D module procedure allocate_dbl_5D module procedure allocate_dbl_6D module procedure allocate_dbl_7D module procedure allocate_str_0D module procedure allocate_str_1D end interface interface tests_check_variable module procedure check_read_0D module procedure check_read_nD end interface interface tests_check_values module procedure check_mem_int_0D module procedure check_mem_int_nD module procedure check_mem_dbl_0D module procedure check_mem_dbl_nD module procedure check_mem_str_0D module procedure check_mem_str_1D end interface contains subroutine tests_status(name, lstat, error) character(len = *), intent(in) :: name logical, intent(in) :: lstat type(etsf_io_low_error), intent(in) :: error if (lstat) then write(*, "(A,A,A,A)") "== ", name, repeat(" ", 68 - len(name)), "OK ==" else write(*, "(A,A,A,A)") "== ", name, repeat(" ", 68 - len(name)), "Failed ==" call etsf_io_low_error_handle(error) end if end subroutine tests_status subroutine check_read_0D(ncid, varname, type, lstat, error_data) integer, intent(in) :: ncid character(len = *), intent(in) :: varname character(len = *), intent(in) :: type logical, intent(out) :: lstat type(etsf_io_low_error), intent(inout) :: error_data character(len = *), parameter :: me = "check_read_0D" if (type == "integer") then call check_read_nD(ncid, varname, type, (/ 1 /), lstat, error_data) else if (type == "real double_precision") then call check_read_nD(ncid, varname, type, (/ 1 /), lstat, error_data) else call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ARG, me, & & tgtname = "check_read_0D", errmess = "unknown type") lstat = .false. end if end subroutine check_read_0D subroutine check_read_nD(ncid, varname, type, dims, lstat, error_data) integer, intent(in) :: ncid character(len = *), intent(in) :: varname character(len = *), intent(in) :: type integer, intent(in) :: dims(:) logical, intent(out) :: lstat type(etsf_io_low_error), intent(inout) :: error_data character(len = *), parameter :: me = "check_read_nD" integer, allocatable :: int_array(:) double precision, allocatable :: dbl_array(:) character(len = 256), allocatable :: strings(:) ! Allocate temporary read space if (type == "integer") then allocate(int_array(product(dims))) else if (type == "real double_precision") then allocate(dbl_array(product(dims))) else if (type == "string") then if (size(dims) == 1) then allocate(strings(1)) else allocate(strings(dims(2))) end if else call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ARG, me, & & tgtname = me, errmess = "unknown type") lstat = .false. end if ! Read if (type == "integer") then call etsf_io_low_read_var(ncid, varname, int_array, & & lstat, error_data = error_data) else if (type == "real double_precision") then call etsf_io_low_read_var(ncid, varname, dbl_array, & & lstat, error_data = error_data) else if (type == "string") then call etsf_io_low_read_var(ncid, varname, strings, dims(1), & & lstat, error_data = error_data) end if call tests_status(" | read '"// varname //"' values", lstat, error_data) if (.not. lstat) return ! Check values if (type == "integer") then call check_mem_int_nD(int_array, varname, lstat, error_data) deallocate(int_array) else if (type == "real double_precision") then call check_mem_dbl_nD(dbl_array, varname, lstat, error_data) deallocate(dbl_array) else if (type == "string") then if (size(dims) == 1) then call check_mem_str_0D(strings(1), dims(1), varname, lstat, error_data) else call check_mem_str_1D(strings, dims, varname, lstat, error_data) end if deallocate(strings) end if end subroutine check_read_nD !------------------! ! The integer case ! !------------------! subroutine allocate_int_0D(array) integer, pointer :: array allocate(array) array = 1 end subroutine allocate_int_0D subroutine allocate_int_1D(array, dims) integer, pointer :: array(:) integer, intent(in) :: dims(:) integer :: i allocate(array(dims(1))) array = (/ (i, i = 1, product(dims)) /) end subroutine allocate_int_1D subroutine allocate_int_2D(array, dims) integer, pointer :: array(:, :) integer, intent(in) :: dims(:) integer :: i allocate(array(dims(1), dims(2))) array = reshape( (/ (i, i = 1, product(dims)) /) , dims(1:2) ) end subroutine allocate_int_2D subroutine allocate_int_3D(array, dims) integer, pointer :: array(:, :, :) integer, intent(in) :: dims(:) integer :: i allocate(array(dims(1), dims(2), dims(3))) array = reshape( (/ (i, i = 1, product(dims)) /) , dims(1:3) ) end subroutine allocate_int_3D subroutine allocate_int_4D(array, dims) integer, pointer :: array(:, :, :, :) integer, intent(in) :: dims(:) integer :: i allocate(array(dims(1), dims(2), dims(3), dims(4))) array = reshape( (/ (i, i = 1, product(dims)) /) , dims(1:4) ) end subroutine allocate_int_4D subroutine allocate_int_5D(array, dims) integer, pointer :: array(:, :, :, :, :) integer, intent(in) :: dims(:) integer :: i allocate(array(dims(1), dims(2), dims(3), dims(4), dims(5))) array = reshape( (/ (i, i = 1, product(dims)) /) , dims(1:5) ) end subroutine allocate_int_5D subroutine allocate_int_6D(array, dims) integer, pointer :: array(:, :, :, :, :, :) integer, intent(in) :: dims(:) integer :: i allocate(array(dims(1), dims(2), dims(3), dims(4), dims(5), dims(6))) array = reshape( (/ (i, i = 1, product(dims)) /) , dims(1:6) ) end subroutine allocate_int_6D subroutine allocate_int_7D(array, dims) integer, pointer :: array(:, :, :, :, :, :, :) integer, intent(in) :: dims(:) integer :: i allocate(array(dims(1), dims(2), dims(3), dims(4), dims(5), dims(6), dims(7))) array = reshape( (/ (i, i = 1, product(dims)) /) , dims(1:7) ) end subroutine allocate_int_7D subroutine check_mem_int_0D(value, varname, lstat, error_data) integer, intent(in) :: value character(len = *), intent(in) :: varname logical, intent(out) :: lstat type(etsf_io_low_error), intent(inout) :: error_data call check_mem_int_nD((/ value /), varname, lstat, error_data) end subroutine check_mem_int_0D subroutine check_mem_int_nD(array, varname, lstat, error_data) integer, intent(in) :: array(:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat type(etsf_io_low_error), intent(inout) :: error_data character(len = *), parameter :: me = "check_mem_int_nD" integer, allocatable :: read_array(:) integer :: i ! Check values lstat = .true. do i = 1, size(array), 1 lstat = (array(i) == i) .and. lstat end do if (.not. lstat) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = varname, errmess = "wrong values") lstat = .false. end if call tests_status(" | check '"// varname //"' values", lstat, error_data) end subroutine check_mem_int_nD !-----------------! ! The double case ! !-----------------! subroutine allocate_dbl_0D(array) double precision, pointer :: array allocate(array) array = 1.d0 end subroutine allocate_dbl_0D subroutine allocate_dbl_1D(array, dims) double precision, pointer :: array(:) integer, intent(in) :: dims(:) integer :: i allocate(array(dims(1))) array = (/ (i, i = 1, product(dims)) /) end subroutine allocate_dbl_1D subroutine allocate_dbl_2D(array, dims) double precision, pointer :: array(:, :) integer, intent(in) :: dims(:) integer :: i allocate(array(dims(1), dims(2))) array = reshape( (/ (i, i = 1, product(dims)) /) , dims(1:2) ) end subroutine allocate_dbl_2D subroutine allocate_dbl_3D(array, dims) double precision, pointer :: array(:, :, :) integer, intent(in) :: dims(:) integer :: i allocate(array(dims(1), dims(2), dims(3))) array = reshape( (/ (i, i = 1, product(dims)) /) , dims(1:3) ) end subroutine allocate_dbl_3D subroutine allocate_dbl_4D(array, dims) double precision, pointer :: array(:, :, :, :) integer, intent(in) :: dims(:) integer :: i allocate(array(dims(1), dims(2), dims(3), dims(4))) array = reshape( (/ (i, i = 1, product(dims)) /) , dims(1:4) ) end subroutine allocate_dbl_4D subroutine allocate_dbl_5D(array, dims) double precision, pointer :: array(:, :, :, :, :) integer, intent(in) :: dims(:) integer :: i allocate(array(dims(1), dims(2), dims(3), dims(4), dims(5))) array = reshape( (/ (i, i = 1, product(dims)) /) , dims(1:5) ) end subroutine allocate_dbl_5D subroutine allocate_dbl_6D(array, dims) double precision, pointer :: array(:, :, :, :, :, :) integer, intent(in) :: dims(:) integer :: i allocate(array(dims(1), dims(2), dims(3), dims(4), dims(5), dims(6))) array = reshape( (/ (i, i = 1, product(dims)) /) , dims(1:6) ) end subroutine allocate_dbl_6D subroutine allocate_dbl_7D(array, dims) double precision, pointer :: array(:, :, :, :, :, :, :) integer, intent(in) :: dims(:) integer :: i allocate(array(dims(1), dims(2), dims(3), dims(4), dims(5), dims(6), dims(7))) array = reshape( (/ (i, i = 1, product(dims)) /) , dims(1:7) ) end subroutine allocate_dbl_7D subroutine check_mem_dbl_0D(value, varname, lstat, error_data) double precision, intent(in) :: value character(len = *), intent(in) :: varname logical, intent(out) :: lstat type(etsf_io_low_error), intent(inout) :: error_data call check_mem_dbl_nD((/ value /), varname, lstat, error_data) end subroutine check_mem_dbl_0D subroutine check_mem_dbl_nD(array, varname, lstat, error_data) double precision, intent(in) :: array(:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat type(etsf_io_low_error), intent(inout) :: error_data character(len = *), parameter :: me = "check_mem_dbl_nD" integer :: i ! Check values lstat = .true. do i = 1, size(array), 1 lstat = (array(i) == i) .and. lstat end do if (.not. lstat) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = varname, errmess = "wrong values") lstat = .false. end if call tests_status(" | check '"// varname //"' values", lstat, error_data) end subroutine check_mem_dbl_nD !-----------------! ! The string case ! !-----------------! subroutine allocate_str_0D(string, dims) integer, intent(in) :: dims(:) character(len = dims(1)), pointer :: string allocate(string) write(string, "(A)") repeat("a", dims(1)) end subroutine allocate_str_0D subroutine allocate_str_1D(string, dims) integer, intent(in) :: dims(:) character(len = dims(1)), pointer :: string(:) integer :: i character(len = 1) :: chr allocate(string(dims(2))) do i = 1, dims(2), 1 write(chr, "(A1)") char(97 + modulo(i - 1, 26)) write(string(i), "(A)") repeat(chr, dims(1)) end do end subroutine allocate_str_1D subroutine check_mem_str_0D(string, length, varname, lstat, error_data) character(len = length), intent(in) :: string integer, intent(in) :: length character(len = *), intent(in) :: varname logical, intent(out) :: lstat type(etsf_io_low_error), intent(inout) :: error_data character(len = *), parameter :: me = "check_mem_str" ! Check values lstat = (string == repeat("a", length)) if (.not. lstat) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = varname, errmess = "wrong values") lstat = .false. end if call tests_status(" | check '"// varname //"' values", lstat, error_data) end subroutine check_mem_str_0D subroutine check_mem_str_1D(string, dims, varname, lstat, error_data) integer, intent(in) :: dims(:) character(len = dims(1)), intent(in) :: string(:) character(len = *), intent(in) :: varname logical, intent(out) :: lstat type(etsf_io_low_error), intent(inout) :: error_data character(len = *), parameter :: me = "check_mem_str_1D" character(len = 1) :: chr integer :: i ! Check values lstat = .true. do i = 1, dims(2), 1 write(chr, "(A1)") char(97 + modulo(i - 1, 26)) lstat = lstat .and. (string(i) == repeat(chr, dims(1))) end do if (.not. lstat) then call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = varname, errmess = "wrong values") lstat = .false. end if call tests_status(" | check '"// varname //"' values", lstat, error_data) end subroutine check_mem_str_1D end module tests etsf_io-1.0.3/tests/group_level/tests_copy.f900000644000353400050620000006244611354150413016300 00000000000000!! NOTES !! This file has been automatically generated by the config/scripts/autogen_tests.py !! script. Any change you would bring to it will systematically be !! overwritten. See the template file in config/etsf/template.tests. program tests_copy use etsf_io_low_level use etsf_io use tests implicit none call test_data_copy() call test_copy_geometry() call test_copy_electrons() call test_copy_kpoints() call test_copy_basisdata() call test_copy_gwdata() call test_copy_dielectric() call test_copy_main() contains subroutine test_data_copy() type(etsf_dims) :: dims type(etsf_groups) :: grp integer :: ncid type(etsf_io_low_error) :: error type(etsf_io_low_var_double) :: var character(len = *), parameter :: me = "test_data_copy" logical :: lstat write(*,*) write(*,*) "Testing etsf_io_data_copy()..." call etsf_io_data_copy("Makefile", "pouet", dims, lstat, error) call tests_status("source_file: wrong value (no file)", (.not. lstat), error) call etsf_io_data_copy("Makefile", "Makefile", dims, lstat, error) call tests_status("source_file: wrong value (text file)", (.not. lstat), error) call etsf_io_data_copy("pouet", "test_write_geometry.nc", dims, lstat, error) call tests_status("dest_file: wrong value (no file)", (.not. lstat), error) call etsf_io_data_copy("Makefile", "test_write_geometry.nc", dims, lstat, error) call tests_status("dest_file: wrong value (text file)", (.not. lstat), error) write(*,*) end subroutine test_data_copy subroutine test_copy_geometry() type(etsf_dims) :: dims type(etsf_groups) :: groups type(etsf_groups_flags) :: flags type(etsf_geometry), target :: group logical :: lstat type(etsf_io_low_error) :: error_data character(len = *), parameter :: me = "test_copy_geometry" integer :: ncid groups%geometry => group write(*,*) write(*,*) "Testing etsf_io_data_copy()..." call etsf_io_low_open_read(ncid, "test_write_geometry.nc", lstat, error_data = error_data) call etsf_io_dims_get(ncid, dims, lstat, error_data) call etsf_io_low_close(ncid, lstat, error_data) flags%geometry = etsf_geometry_all call etsf_io_data_init("test_copy_geometry.nc", flags, & & dims, "Test", "", lstat, error_data) call tests_status("Create file test_copy_geometry.nc", lstat, error_data) call etsf_io_data_copy("test_copy_geometry.nc", "test_write_geometry.nc", & & dims, lstat, error_data) call tests_status("copy data to test_copy_geometry.nc", lstat, error_data) ! check informations. call etsf_io_low_open_read(ncid, "test_copy_geometry.nc", lstat, error_data = error_data) call tests_status(" | opening", lstat, error_data) call tests_check_variable(ncid, "space_group", "integer", lstat, error_data) call tests_check_variable(ncid, "primitive_vectors", "real double_precision", (/ & & dims%number_of_cartesian_directions, & & dims%number_of_vectors /), lstat, error_data) call tests_check_variable(ncid, "reduced_symmetry_matrices", "integer", (/ & & dims%number_of_reduced_dimensions, & & dims%number_of_reduced_dimensions, & & dims%number_of_symmetry_operations /), lstat, error_data) call tests_check_variable(ncid, "reduced_symmetry_translations", "real double_precision", (/ & & dims%number_of_reduced_dimensions, & & dims%number_of_symmetry_operations /), lstat, error_data) call tests_check_variable(ncid, "atom_species", "integer", (/ & & dims%number_of_atoms /), lstat, error_data) call tests_check_variable(ncid, "reduced_atom_positions", "real double_precision", (/ & & dims%number_of_reduced_dimensions, & & dims%number_of_atoms /), lstat, error_data) call tests_check_variable(ncid, "valence_charges", "real double_precision", (/ & & dims%number_of_atom_species /), lstat, error_data) call tests_check_variable(ncid, "atomic_numbers", "real double_precision", (/ & & dims%number_of_atom_species /), lstat, error_data) call tests_check_variable(ncid, "atom_species_names", "string", (/ & & dims%character_string_length, & & dims%number_of_atom_species /), lstat, error_data) call tests_check_variable(ncid, "chemical_symbols", "string", (/ & & dims%symbol_length, & & dims%number_of_atom_species /), lstat, error_data) call tests_check_variable(ncid, "pseudopotential_types", "string", (/ & & dims%character_string_length, & & dims%number_of_atom_species /), lstat, error_data) ! close file call etsf_io_low_close(ncid, lstat, error_data = error_data) call tests_status(" | closing", lstat, error_data) write(*,*) end subroutine test_copy_geometry subroutine test_copy_electrons() type(etsf_dims) :: dims type(etsf_groups) :: groups type(etsf_groups_flags) :: flags type(etsf_electrons), target :: group logical :: lstat type(etsf_io_low_error) :: error_data character(len = *), parameter :: me = "test_copy_electrons" integer :: ncid groups%electrons => group write(*,*) write(*,*) "Testing etsf_io_data_copy()..." call etsf_io_low_open_read(ncid, "test_write_electrons.nc", lstat, error_data = error_data) call etsf_io_dims_get(ncid, dims, lstat, error_data) call etsf_io_low_close(ncid, lstat, error_data) flags%electrons = etsf_electrons_all call etsf_io_data_init("test_copy_electrons.nc", flags, & & dims, "Test", "", lstat, error_data) call tests_status("Create file test_copy_electrons.nc", lstat, error_data) call etsf_io_data_copy("test_copy_electrons.nc", "test_write_electrons.nc", & & dims, lstat, error_data) call tests_status("copy data to test_copy_electrons.nc", lstat, error_data) ! check informations. call etsf_io_low_open_read(ncid, "test_copy_electrons.nc", lstat, error_data = error_data) call tests_status(" | opening", lstat, error_data) call tests_check_variable(ncid, "number_of_electrons", "integer", lstat, error_data) call tests_check_variable(ncid, "exchange_functional", "string", (/ & & dims%character_string_length /), lstat, error_data) call tests_check_variable(ncid, "correlation_functional", "string", (/ & & dims%character_string_length /), lstat, error_data) call tests_check_variable(ncid, "fermi_energy", "real double_precision", lstat, error_data) call tests_check_variable(ncid, "smearing_scheme", "string", (/ & & dims%character_string_length /), lstat, error_data) call tests_check_variable(ncid, "smearing_width", "real double_precision", lstat, error_data) call tests_check_variable(ncid, "number_of_states", "integer", (/ & & dims%number_of_kpoints, & & dims%number_of_spins /), lstat, error_data) call tests_check_variable(ncid, "eigenvalues", "real double_precision", (/ & & dims%max_number_of_states, & & dims%number_of_kpoints, & & dims%number_of_spins /), lstat, error_data) call tests_check_variable(ncid, "occupations", "real double_precision", (/ & & dims%max_number_of_states, & & dims%number_of_kpoints, & & dims%number_of_spins /), lstat, error_data) ! close file call etsf_io_low_close(ncid, lstat, error_data = error_data) call tests_status(" | closing", lstat, error_data) write(*,*) end subroutine test_copy_electrons subroutine test_copy_kpoints() type(etsf_dims) :: dims type(etsf_groups) :: groups type(etsf_groups_flags) :: flags type(etsf_kpoints), target :: group logical :: lstat type(etsf_io_low_error) :: error_data character(len = *), parameter :: me = "test_copy_kpoints" integer :: ncid groups%kpoints => group write(*,*) write(*,*) "Testing etsf_io_data_copy()..." call etsf_io_low_open_read(ncid, "test_write_kpoints.nc", lstat, error_data = error_data) call etsf_io_dims_get(ncid, dims, lstat, error_data) call etsf_io_low_close(ncid, lstat, error_data) flags%kpoints = etsf_kpoints_all call etsf_io_data_init("test_copy_kpoints.nc", flags, & & dims, "Test", "", lstat, error_data) call tests_status("Create file test_copy_kpoints.nc", lstat, error_data) call etsf_io_data_copy("test_copy_kpoints.nc", "test_write_kpoints.nc", & & dims, lstat, error_data) call tests_status("copy data to test_copy_kpoints.nc", lstat, error_data) ! check informations. call etsf_io_low_open_read(ncid, "test_copy_kpoints.nc", lstat, error_data = error_data) call tests_status(" | opening", lstat, error_data) call tests_check_variable(ncid, "kpoint_grid_shift", "real double_precision", (/ & & dims%number_of_reduced_dimensions /), lstat, error_data) call tests_check_variable(ncid, "kpoint_grid_vectors", "real double_precision", (/ & & dims%number_of_reduced_dimensions, & & dims%number_of_vectors /), lstat, error_data) call tests_check_variable(ncid, "monkhorst_pack_folding", "integer", (/ & & dims%number_of_vectors /), lstat, error_data) call tests_check_variable(ncid, "reduced_coordinates_of_kpoints", "real double_precision", (/ & & dims%number_of_reduced_dimensions, & & dims%number_of_kpoints /), lstat, error_data) call tests_check_variable(ncid, "kpoint_weights", "real double_precision", (/ & & dims%number_of_kpoints /), lstat, error_data) ! close file call etsf_io_low_close(ncid, lstat, error_data = error_data) call tests_status(" | closing", lstat, error_data) write(*,*) end subroutine test_copy_kpoints subroutine test_copy_basisdata() type(etsf_dims) :: dims type(etsf_groups) :: groups type(etsf_groups_flags) :: flags type(etsf_basisdata), target :: group logical :: lstat type(etsf_io_low_error) :: error_data character(len = *), parameter :: me = "test_copy_basisdata" integer :: ncid groups%basisdata => group write(*,*) write(*,*) "Testing etsf_io_data_copy()..." call etsf_io_low_open_read(ncid, "test_write_basisdata.nc", lstat, error_data = error_data) call etsf_io_dims_get(ncid, dims, lstat, error_data) call etsf_io_low_close(ncid, lstat, error_data) flags%basisdata = etsf_basisdata_all call etsf_io_data_init("test_copy_basisdata.nc", flags, & & dims, "Test", "", lstat, error_data) call tests_status("Create file test_copy_basisdata.nc", lstat, error_data) call etsf_io_data_copy("test_copy_basisdata.nc", "test_write_basisdata.nc", & & dims, lstat, error_data) call tests_status("copy data to test_copy_basisdata.nc", lstat, error_data) ! check informations. call etsf_io_low_open_read(ncid, "test_copy_basisdata.nc", lstat, error_data = error_data) call tests_status(" | opening", lstat, error_data) call tests_check_variable(ncid, "basis_set", "string", (/ & & dims%character_string_length /), lstat, error_data) call tests_check_variable(ncid, "kinetic_energy_cutoff", "real double_precision", lstat, error_data) call tests_check_variable(ncid, "number_of_coefficients", "integer", (/ & & dims%number_of_kpoints /), lstat, error_data) call tests_check_variable(ncid, "reduced_coordinates_of_plane_waves", "integer", (/ & & dims%number_of_reduced_dimensions, & & dims%max_number_of_coefficients, & & dims%number_of_kpoints /), lstat, error_data) call tests_check_variable(ncid, "coordinates_of_basis_grid_points", "integer", (/ & & dims%number_of_reduced_dimensions, & & dims%max_number_of_basis_grid_points, & & dims%number_of_localization_regions /), lstat, error_data) call tests_check_variable(ncid, "number_of_coefficients_per_grid_point", "integer", (/ & & dims%max_number_of_basis_grid_points, & & dims%number_of_localization_regions /), lstat, error_data) ! close file call etsf_io_low_close(ncid, lstat, error_data = error_data) call tests_status(" | closing", lstat, error_data) write(*,*) end subroutine test_copy_basisdata subroutine test_copy_gwdata() type(etsf_dims) :: dims type(etsf_groups) :: groups type(etsf_groups_flags) :: flags type(etsf_gwdata), target :: group logical :: lstat type(etsf_io_low_error) :: error_data character(len = *), parameter :: me = "test_copy_gwdata" integer :: ncid groups%gwdata => group write(*,*) write(*,*) "Testing etsf_io_data_copy()..." call etsf_io_low_open_read(ncid, "test_write_gwdata.nc", lstat, error_data = error_data) call etsf_io_dims_get(ncid, dims, lstat, error_data) call etsf_io_low_close(ncid, lstat, error_data) flags%gwdata = etsf_gwdata_all call etsf_io_data_init("test_copy_gwdata.nc", flags, & & dims, "Test", "", lstat, error_data) call tests_status("Create file test_copy_gwdata.nc", lstat, error_data) call etsf_io_data_copy("test_copy_gwdata.nc", "test_write_gwdata.nc", & & dims, lstat, error_data) call tests_status("copy data to test_copy_gwdata.nc", lstat, error_data) ! check informations. call etsf_io_low_open_read(ncid, "test_copy_gwdata.nc", lstat, error_data = error_data) call tests_status(" | opening", lstat, error_data) call tests_check_variable(ncid, "gw_corrections", "real double_precision", (/ & & dims%real_or_complex_gw_corrections, & & dims%max_number_of_states, & & dims%number_of_kpoints, & & dims%number_of_spins /), lstat, error_data) call tests_check_variable(ncid, "kb_formfactor_sign", "integer", (/ & & dims%max_number_of_projectors, & & dims%max_number_of_angular_momenta, & & dims%number_of_atom_species /), lstat, error_data) call tests_check_variable(ncid, "kb_formfactors", "real double_precision", (/ & & dims%max_number_of_coefficients, & & dims%number_of_kpoints, & & dims%max_number_of_projectors, & & dims%max_number_of_angular_momenta, & & dims%number_of_atom_species /), lstat, error_data) call tests_check_variable(ncid, "kb_formfactor_derivative", "real double_precision", (/ & & dims%max_number_of_coefficients, & & dims%number_of_kpoints, & & dims%max_number_of_projectors, & & dims%max_number_of_angular_momenta, & & dims%number_of_atom_species /), lstat, error_data) ! close file call etsf_io_low_close(ncid, lstat, error_data = error_data) call tests_status(" | closing", lstat, error_data) write(*,*) end subroutine test_copy_gwdata subroutine test_copy_dielectric() type(etsf_dims) :: dims type(etsf_groups) :: groups type(etsf_groups_flags) :: flags type(etsf_dielectric), target :: group logical :: lstat type(etsf_io_low_error) :: error_data character(len = *), parameter :: me = "test_copy_dielectric" integer :: ncid groups%dielectric => group write(*,*) write(*,*) "Testing etsf_io_data_copy()..." call etsf_io_low_open_read(ncid, "test_write_dielectric.nc", lstat, error_data = error_data) call etsf_io_dims_get(ncid, dims, lstat, error_data) call etsf_io_low_close(ncid, lstat, error_data) flags%dielectric = etsf_dielectric_all call etsf_io_data_init("test_copy_dielectric.nc", flags, & & dims, "Test", "", lstat, error_data) call tests_status("Create file test_copy_dielectric.nc", lstat, error_data) call etsf_io_data_copy("test_copy_dielectric.nc", "test_write_dielectric.nc", & & dims, lstat, error_data) call tests_status("copy data to test_copy_dielectric.nc", lstat, error_data) ! check informations. call etsf_io_low_open_read(ncid, "test_copy_dielectric.nc", lstat, error_data = error_data) call tests_status(" | opening", lstat, error_data) call tests_check_variable(ncid, "frequencies_dielectric_function", "real double_precision", (/ & & dims%complex, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "qpoints_dielectric_function", "real double_precision", (/ & & dims%number_of_reduced_dimensions, & & dims%number_of_qpoints_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "qpoints_gamma_limit", "real double_precision", (/ & & dims%number_of_reduced_dimensions, & & dims%number_of_qpoints_gamma_limit /), lstat, error_data) call tests_check_variable(ncid, "dielectric_function", "real double_precision", (/ & & dims%complex, & & dims%number_of_coefficients_dielectric_function, & & dims%number_of_coefficients_dielectric_function, & & dims%number_of_spins, & & dims%number_of_spins, & & dims%number_of_qpoints_dielectric_function, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "dielectric_function_head", "real double_precision", (/ & & dims%complex, & & dims%number_of_spins, & & dims%number_of_spins, & & dims%number_of_qpoints_dielectric_function, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "dielectric_function_lower_wing", "real double_precision", (/ & & dims%complex, & & dims%number_of_coefficients_dielectric_function, & & dims%number_of_spins, & & dims%number_of_spins, & & dims%number_of_qpoints_gamma_limit, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "dielectric_function_upper_wing", "real double_precision", (/ & & dims%complex, & & dims%number_of_coefficients_dielectric_function, & & dims%number_of_spins, & & dims%number_of_spins, & & dims%number_of_qpoints_gamma_limit, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "inverse_dielectric_function", "real double_precision", (/ & & dims%complex, & & dims%number_of_coefficients_dielectric_function, & & dims%number_of_coefficients_dielectric_function, & & dims%number_of_spins, & & dims%number_of_spins, & & dims%number_of_qpoints_dielectric_function, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "inverse_dielectric_function_head", "real double_precision", (/ & & dims%complex, & & dims%number_of_spins, & & dims%number_of_spins, & & dims%number_of_qpoints_dielectric_function, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "inverse_dielectric_function_lower_wing", "real double_precision", (/ & & dims%complex, & & dims%number_of_coefficients_dielectric_function, & & dims%number_of_spins, & & dims%number_of_spins, & & dims%number_of_qpoints_gamma_limit, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "inverse_dielectric_function_upper_wing", "real double_precision", (/ & & dims%complex, & & dims%number_of_coefficients_dielectric_function, & & dims%number_of_spins, & & dims%number_of_spins, & & dims%number_of_qpoints_gamma_limit, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "polarizability", "real double_precision", (/ & & dims%complex, & & dims%number_of_coefficients_dielectric_function, & & dims%number_of_coefficients_dielectric_function, & & dims%number_of_spins, & & dims%number_of_spins, & & dims%number_of_qpoints_dielectric_function, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "polarizability_head", "real double_precision", (/ & & dims%complex, & & dims%number_of_spins, & & dims%number_of_spins, & & dims%number_of_qpoints_dielectric_function, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "polarizability_lower_wing", "real double_precision", (/ & & dims%complex, & & dims%number_of_coefficients_dielectric_function, & & dims%number_of_spins, & & dims%number_of_spins, & & dims%number_of_qpoints_gamma_limit, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "polarizability_upper_wing", "real double_precision", (/ & & dims%complex, & & dims%number_of_coefficients_dielectric_function, & & dims%number_of_spins, & & dims%number_of_spins, & & dims%number_of_qpoints_gamma_limit, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "inverse_polarizability", "real double_precision", (/ & & dims%complex, & & dims%number_of_coefficients_dielectric_function, & & dims%number_of_coefficients_dielectric_function, & & dims%number_of_spins, & & dims%number_of_spins, & & dims%number_of_qpoints_dielectric_function, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "inverse_polarizability_head", "real double_precision", (/ & & dims%complex, & & dims%number_of_spins, & & dims%number_of_spins, & & dims%number_of_qpoints_dielectric_function, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "inverse_polarizability_lower_wing", "real double_precision", (/ & & dims%complex, & & dims%number_of_coefficients_dielectric_function, & & dims%number_of_spins, & & dims%number_of_spins, & & dims%number_of_qpoints_gamma_limit, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "inverse_polarizability_upper_wing", "real double_precision", (/ & & dims%complex, & & dims%number_of_coefficients_dielectric_function, & & dims%number_of_spins, & & dims%number_of_spins, & & dims%number_of_qpoints_gamma_limit, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) ! close file call etsf_io_low_close(ncid, lstat, error_data = error_data) call tests_status(" | closing", lstat, error_data) write(*,*) end subroutine test_copy_dielectric subroutine test_copy_main() type(etsf_dims) :: dims type(etsf_groups) :: groups type(etsf_groups_flags) :: flags type(etsf_main), target :: group logical :: lstat type(etsf_io_low_error) :: error_data character(len = *), parameter :: me = "test_copy_main" integer :: ncid groups%main => group write(*,*) write(*,*) "Testing etsf_io_data_copy()..." call etsf_io_low_open_read(ncid, "test_write_main.nc", lstat, error_data = error_data) call etsf_io_dims_get(ncid, dims, lstat, error_data) call etsf_io_low_close(ncid, lstat, error_data) flags%main = etsf_main_all call etsf_io_data_init("test_copy_main.nc", flags, & & dims, "Test", "", lstat, error_data) call tests_status("Create file test_copy_main.nc", lstat, error_data) call etsf_io_data_copy("test_copy_main.nc", "test_write_main.nc", & & dims, lstat, error_data) call tests_status("copy data to test_copy_main.nc", lstat, error_data) ! check informations. call etsf_io_low_open_read(ncid, "test_copy_main.nc", lstat, error_data = error_data) call tests_status(" | opening", lstat, error_data) call tests_check_variable(ncid, "density", "real double_precision", (/ & & dims%real_or_complex_density, & & dims%number_of_grid_points_vector1, & & dims%number_of_grid_points_vector2, & & dims%number_of_grid_points_vector3, & & dims%number_of_components /), lstat, error_data) call tests_check_variable(ncid, "exchange_potential", "real double_precision", (/ & & dims%real_or_complex_potential, & & dims%number_of_grid_points_vector1, & & dims%number_of_grid_points_vector2, & & dims%number_of_grid_points_vector3, & & dims%number_of_components /), lstat, error_data) call tests_check_variable(ncid, "correlation_potential", "real double_precision", (/ & & dims%real_or_complex_potential, & & dims%number_of_grid_points_vector1, & & dims%number_of_grid_points_vector2, & & dims%number_of_grid_points_vector3, & & dims%number_of_components /), lstat, error_data) call tests_check_variable(ncid, "exchange_correlation_potential", "real double_precision", (/ & & dims%real_or_complex_potential, & & dims%number_of_grid_points_vector1, & & dims%number_of_grid_points_vector2, & & dims%number_of_grid_points_vector3, & & dims%number_of_components /), lstat, error_data) call tests_check_variable(ncid, "coefficients_of_wavefunctions", "real double_precision", (/ & & dims%real_or_complex_coefficients, & & dims%max_number_of_coefficients, & & dims%number_of_spinor_components, & & dims%max_number_of_states, & & dims%number_of_kpoints, & & dims%number_of_spins /), lstat, error_data) call tests_check_variable(ncid, "real_space_wavefunctions", "real double_precision", (/ & & dims%real_or_complex_wavefunctions, & & dims%number_of_grid_points_vector1, & & dims%number_of_grid_points_vector2, & & dims%number_of_grid_points_vector3, & & dims%number_of_spinor_components, & & dims%max_number_of_states, & & dims%number_of_kpoints, & & dims%number_of_spins /), lstat, error_data) ! close file call etsf_io_low_close(ncid, lstat, error_data = error_data) call tests_status(" | closing", lstat, error_data) write(*,*) end subroutine test_copy_main end program tests_copy etsf_io-1.0.3/tests/group_level/tests_init.f900000644000353400050630000050633711354150413016274 00000000000000!! NOTES !! This file has been automatically generated by the config/scripts/autogen_tests.py !! script. Any change you would bring to it will systematically be !! overwritten. See the template file in config/etsf/template.tests_init. program tests_init use etsf_io_low_level use etsf_io implicit none call test_data_init() contains subroutine tests_write_status(name, lstat, error) character(len = *), intent(in) :: name logical, intent(in) :: lstat type(etsf_io_low_error), intent(in) :: error if (lstat) then write(*, "(A,A,A,A)") "== ", name, repeat(" ", 68 - len(name)), "OK ==" else write(*, "(A,A,A,A)") "== ", name, repeat(" ", 68 - len(name)), "Failed ==" call etsf_io_low_error_handle(error) end if end subroutine tests_write_status subroutine test_data_init() type(etsf_dims) :: dims integer :: ncid, dimvalue type(etsf_groups_flags) :: flags type(etsf_io_low_error) :: error type(etsf_io_low_var_infos) :: var_infos character(len = *), parameter :: me = "test_data_init" logical :: lstat write(*,*) write(*,*) "Testing etsf_io_data_init()..." dims%number_of_grid_points_vector3 = 5 dims%number_of_symmetry_operations = 4 dims%max_number_of_coefficients = 6 dims%max_number_of_projectors = 2 dims%max_number_of_states = 8 dims%number_of_atoms = 4 dims%number_of_kpoints = 12 dims%number_of_components = 2 flags%geometry = etsf_geometry_all call etsf_io_data_init("test_init_geometry.nc", flags, & & dims, "Test", "", lstat, error) call tests_write_status("Create file test_init_geometry.nc", lstat, error) flags%geometry = etsf_geometry_none call etsf_io_low_open_read(ncid, "test_init_geometry.nc", lstat, error_data = error) call tests_write_status(" | opening", lstat, error) call etsf_io_low_read_var_infos(ncid, "space_group", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'space_group' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_integer .or. & & var_infos%ncshape /= 0 .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "space_group", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'space_group' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_vectors", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_vectors'", lstat, error) if (dimvalue /= dims%number_of_vectors) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_vectors", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_vectors'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_cartesian_directions", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_cartesian_directions'", lstat, error) if (dimvalue /= dims%number_of_cartesian_directions) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_cartesian_directions", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_cartesian_directions'", lstat, error) call etsf_io_low_read_var_infos(ncid, "primitive_vectors", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'primitive_vectors' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 2 .or. & & var_infos%ncdims(2) /= dims%number_of_vectors .or. & & var_infos%ncdims(1) /= dims%number_of_cartesian_directions .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "primitive_vectors", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'primitive_vectors' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_symmetry_operations", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_symmetry_operations'", lstat, error) if (dimvalue /= dims%number_of_symmetry_operations) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_symmetry_operations", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_symmetry_operations'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_reduced_dimensions", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_reduced_dimensions'", lstat, error) if (dimvalue /= dims%number_of_reduced_dimensions) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_reduced_dimensions", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_reduced_dimensions'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_reduced_dimensions", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_reduced_dimensions'", lstat, error) if (dimvalue /= dims%number_of_reduced_dimensions) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_reduced_dimensions", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_reduced_dimensions'", lstat, error) call etsf_io_low_read_var_infos(ncid, "reduced_symmetry_matrices", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'reduced_symmetry_matrices' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_integer .or. & & var_infos%ncshape /= 3 .or. & & var_infos%ncdims(3) /= dims%number_of_symmetry_operations .or. & & var_infos%ncdims(2) /= dims%number_of_reduced_dimensions .or. & & var_infos%ncdims(1) /= dims%number_of_reduced_dimensions .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "reduced_symmetry_matrices", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'reduced_symmetry_matrices' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_symmetry_operations", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_symmetry_operations'", lstat, error) if (dimvalue /= dims%number_of_symmetry_operations) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_symmetry_operations", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_symmetry_operations'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_reduced_dimensions", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_reduced_dimensions'", lstat, error) if (dimvalue /= dims%number_of_reduced_dimensions) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_reduced_dimensions", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_reduced_dimensions'", lstat, error) call etsf_io_low_read_var_infos(ncid, "reduced_symmetry_translations", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'reduced_symmetry_translations' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 2 .or. & & var_infos%ncdims(2) /= dims%number_of_symmetry_operations .or. & & var_infos%ncdims(1) /= dims%number_of_reduced_dimensions .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "reduced_symmetry_translations", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'reduced_symmetry_translations' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_atoms", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_atoms'", lstat, error) if (dimvalue /= dims%number_of_atoms) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_atoms", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_atoms'", lstat, error) call etsf_io_low_read_var_infos(ncid, "atom_species", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'atom_species' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_integer .or. & & var_infos%ncshape /= 1 .or. & & var_infos%ncdims(1) /= dims%number_of_atoms .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "atom_species", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'atom_species' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_atoms", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_atoms'", lstat, error) if (dimvalue /= dims%number_of_atoms) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_atoms", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_atoms'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_reduced_dimensions", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_reduced_dimensions'", lstat, error) if (dimvalue /= dims%number_of_reduced_dimensions) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_reduced_dimensions", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_reduced_dimensions'", lstat, error) call etsf_io_low_read_var_infos(ncid, "reduced_atom_positions", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'reduced_atom_positions' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 2 .or. & & var_infos%ncdims(2) /= dims%number_of_atoms .or. & & var_infos%ncdims(1) /= dims%number_of_reduced_dimensions .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "reduced_atom_positions", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'reduced_atom_positions' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_atom_species", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_atom_species'", lstat, error) if (dimvalue /= dims%number_of_atom_species) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_atom_species", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_atom_species'", lstat, error) call etsf_io_low_read_var_infos(ncid, "valence_charges", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'valence_charges' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 1 .or. & & var_infos%ncdims(1) /= dims%number_of_atom_species .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "valence_charges", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'valence_charges' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_atom_species", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_atom_species'", lstat, error) if (dimvalue /= dims%number_of_atom_species) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_atom_species", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_atom_species'", lstat, error) call etsf_io_low_read_var_infos(ncid, "atomic_numbers", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'atomic_numbers' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 1 .or. & & var_infos%ncdims(1) /= dims%number_of_atom_species .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "atomic_numbers", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'atomic_numbers' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_atom_species", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_atom_species'", lstat, error) if (dimvalue /= dims%number_of_atom_species) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_atom_species", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_atom_species'", lstat, error) call etsf_io_low_read_dim(ncid, "character_string_length", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'character_string_length'", lstat, error) if (dimvalue /= dims%character_string_length) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "character_string_length", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'character_string_length'", lstat, error) call etsf_io_low_read_var_infos(ncid, "atom_species_names", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'atom_species_names' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_character .or. & & var_infos%ncshape /= 2 .or. & & var_infos%ncdims(2) /= dims%number_of_atom_species .or. & & var_infos%ncdims(1) /= dims%character_string_length .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "atom_species_names", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'atom_species_names' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_atom_species", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_atom_species'", lstat, error) if (dimvalue /= dims%number_of_atom_species) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_atom_species", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_atom_species'", lstat, error) call etsf_io_low_read_dim(ncid, "symbol_length", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'symbol_length'", lstat, error) if (dimvalue /= dims%symbol_length) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "symbol_length", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'symbol_length'", lstat, error) call etsf_io_low_read_var_infos(ncid, "chemical_symbols", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'chemical_symbols' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_character .or. & & var_infos%ncshape /= 2 .or. & & var_infos%ncdims(2) /= dims%number_of_atom_species .or. & & var_infos%ncdims(1) /= dims%symbol_length .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "chemical_symbols", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'chemical_symbols' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_atom_species", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_atom_species'", lstat, error) if (dimvalue /= dims%number_of_atom_species) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_atom_species", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_atom_species'", lstat, error) call etsf_io_low_read_dim(ncid, "character_string_length", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'character_string_length'", lstat, error) if (dimvalue /= dims%character_string_length) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "character_string_length", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'character_string_length'", lstat, error) call etsf_io_low_read_var_infos(ncid, "pseudopotential_types", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'pseudopotential_types' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_character .or. & & var_infos%ncshape /= 2 .or. & & var_infos%ncdims(2) /= dims%number_of_atom_species .or. & & var_infos%ncdims(1) /= dims%character_string_length .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "pseudopotential_types", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'pseudopotential_types' characteristics", lstat, error) call etsf_io_low_close(ncid, lstat, error_data = error) call tests_write_status(" | closing", lstat, error) flags%electrons = etsf_electrons_all call etsf_io_data_init("test_init_electrons.nc", flags, & & dims, "Test", "", lstat, error) call tests_write_status("Create file test_init_electrons.nc", lstat, error) flags%electrons = etsf_electrons_none call etsf_io_low_open_read(ncid, "test_init_electrons.nc", lstat, error_data = error) call tests_write_status(" | opening", lstat, error) call etsf_io_low_read_var_infos(ncid, "number_of_electrons", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'number_of_electrons' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_integer .or. & & var_infos%ncshape /= 0 .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "number_of_electrons", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'number_of_electrons' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "character_string_length", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'character_string_length'", lstat, error) if (dimvalue /= dims%character_string_length) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "character_string_length", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'character_string_length'", lstat, error) call etsf_io_low_read_var_infos(ncid, "exchange_functional", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'exchange_functional' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_character .or. & & var_infos%ncshape /= 1 .or. & & var_infos%ncdims(1) /= dims%character_string_length .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "exchange_functional", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'exchange_functional' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "character_string_length", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'character_string_length'", lstat, error) if (dimvalue /= dims%character_string_length) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "character_string_length", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'character_string_length'", lstat, error) call etsf_io_low_read_var_infos(ncid, "correlation_functional", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'correlation_functional' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_character .or. & & var_infos%ncshape /= 1 .or. & & var_infos%ncdims(1) /= dims%character_string_length .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "correlation_functional", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'correlation_functional' characteristics", lstat, error) call etsf_io_low_read_var_infos(ncid, "fermi_energy", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'fermi_energy' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 0 .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "fermi_energy", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'fermi_energy' characteristics", lstat, error) call etsf_io_low_check_att(ncid, var_infos%ncid, "units", & & etsf_io_low_character, etsf_charlen, & & lstat, error_data = error) call tests_write_status(" | check att 'units'", lstat, error) call etsf_io_low_read_dim(ncid, "character_string_length", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'character_string_length'", lstat, error) if (dimvalue /= dims%character_string_length) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "character_string_length", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'character_string_length'", lstat, error) call etsf_io_low_read_var_infos(ncid, "smearing_scheme", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'smearing_scheme' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_character .or. & & var_infos%ncshape /= 1 .or. & & var_infos%ncdims(1) /= dims%character_string_length .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "smearing_scheme", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'smearing_scheme' characteristics", lstat, error) call etsf_io_low_read_var_infos(ncid, "smearing_width", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'smearing_width' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 0 .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "smearing_width", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'smearing_width' characteristics", lstat, error) call etsf_io_low_check_att(ncid, var_infos%ncid, "units", & & etsf_io_low_character, etsf_charlen, & & lstat, error_data = error) call tests_write_status(" | check att 'units'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_kpoints", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_kpoints'", lstat, error) if (dimvalue /= dims%number_of_kpoints) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_kpoints", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_kpoints'", lstat, error) call etsf_io_low_read_var_infos(ncid, "number_of_states", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'number_of_states' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_integer .or. & & var_infos%ncshape /= 2 .or. & & var_infos%ncdims(2) /= dims%number_of_spins .or. & & var_infos%ncdims(1) /= dims%number_of_kpoints .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "number_of_states", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'number_of_states' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_kpoints", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_kpoints'", lstat, error) if (dimvalue /= dims%number_of_kpoints) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_kpoints", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_kpoints'", lstat, error) call etsf_io_low_read_dim(ncid, "max_number_of_states", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'max_number_of_states'", lstat, error) if (dimvalue /= dims%max_number_of_states) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "max_number_of_states", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'max_number_of_states'", lstat, error) call etsf_io_low_read_var_infos(ncid, "eigenvalues", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'eigenvalues' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 3 .or. & & var_infos%ncdims(3) /= dims%number_of_spins .or. & & var_infos%ncdims(2) /= dims%number_of_kpoints .or. & & var_infos%ncdims(1) /= dims%max_number_of_states .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "eigenvalues", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'eigenvalues' characteristics", lstat, error) call etsf_io_low_check_att(ncid, var_infos%ncid, "units", & & etsf_io_low_character, etsf_charlen, & & lstat, error_data = error) call tests_write_status(" | check att 'units'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_kpoints", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_kpoints'", lstat, error) if (dimvalue /= dims%number_of_kpoints) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_kpoints", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_kpoints'", lstat, error) call etsf_io_low_read_dim(ncid, "max_number_of_states", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'max_number_of_states'", lstat, error) if (dimvalue /= dims%max_number_of_states) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "max_number_of_states", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'max_number_of_states'", lstat, error) call etsf_io_low_read_var_infos(ncid, "occupations", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'occupations' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 3 .or. & & var_infos%ncdims(3) /= dims%number_of_spins .or. & & var_infos%ncdims(2) /= dims%number_of_kpoints .or. & & var_infos%ncdims(1) /= dims%max_number_of_states .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "occupations", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'occupations' characteristics", lstat, error) call etsf_io_low_close(ncid, lstat, error_data = error) call tests_write_status(" | closing", lstat, error) flags%kpoints = etsf_kpoints_all call etsf_io_data_init("test_init_kpoints.nc", flags, & & dims, "Test", "", lstat, error) call tests_write_status("Create file test_init_kpoints.nc", lstat, error) flags%kpoints = etsf_kpoints_none call etsf_io_low_open_read(ncid, "test_init_kpoints.nc", lstat, error_data = error) call tests_write_status(" | opening", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_reduced_dimensions", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_reduced_dimensions'", lstat, error) if (dimvalue /= dims%number_of_reduced_dimensions) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_reduced_dimensions", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_reduced_dimensions'", lstat, error) call etsf_io_low_read_var_infos(ncid, "kpoint_grid_shift", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'kpoint_grid_shift' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 1 .or. & & var_infos%ncdims(1) /= dims%number_of_reduced_dimensions .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "kpoint_grid_shift", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'kpoint_grid_shift' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_vectors", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_vectors'", lstat, error) if (dimvalue /= dims%number_of_vectors) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_vectors", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_vectors'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_reduced_dimensions", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_reduced_dimensions'", lstat, error) if (dimvalue /= dims%number_of_reduced_dimensions) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_reduced_dimensions", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_reduced_dimensions'", lstat, error) call etsf_io_low_read_var_infos(ncid, "kpoint_grid_vectors", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'kpoint_grid_vectors' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 2 .or. & & var_infos%ncdims(2) /= dims%number_of_vectors .or. & & var_infos%ncdims(1) /= dims%number_of_reduced_dimensions .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "kpoint_grid_vectors", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'kpoint_grid_vectors' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_vectors", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_vectors'", lstat, error) if (dimvalue /= dims%number_of_vectors) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_vectors", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_vectors'", lstat, error) call etsf_io_low_read_var_infos(ncid, "monkhorst_pack_folding", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'monkhorst_pack_folding' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_integer .or. & & var_infos%ncshape /= 1 .or. & & var_infos%ncdims(1) /= dims%number_of_vectors .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "monkhorst_pack_folding", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'monkhorst_pack_folding' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_kpoints", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_kpoints'", lstat, error) if (dimvalue /= dims%number_of_kpoints) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_kpoints", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_kpoints'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_reduced_dimensions", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_reduced_dimensions'", lstat, error) if (dimvalue /= dims%number_of_reduced_dimensions) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_reduced_dimensions", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_reduced_dimensions'", lstat, error) call etsf_io_low_read_var_infos(ncid, "reduced_coordinates_of_kpoints", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'reduced_coordinates_of_kpoints' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 2 .or. & & var_infos%ncdims(2) /= dims%number_of_kpoints .or. & & var_infos%ncdims(1) /= dims%number_of_reduced_dimensions .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "reduced_coordinates_of_kpoints", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'reduced_coordinates_of_kpoints' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_kpoints", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_kpoints'", lstat, error) if (dimvalue /= dims%number_of_kpoints) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_kpoints", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_kpoints'", lstat, error) call etsf_io_low_read_var_infos(ncid, "kpoint_weights", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'kpoint_weights' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 1 .or. & & var_infos%ncdims(1) /= dims%number_of_kpoints .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "kpoint_weights", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'kpoint_weights' characteristics", lstat, error) call etsf_io_low_close(ncid, lstat, error_data = error) call tests_write_status(" | closing", lstat, error) flags%basisdata = etsf_basisdata_all call etsf_io_data_init("test_init_basisdata.nc", flags, & & dims, "Test", "", lstat, error) call tests_write_status("Create file test_init_basisdata.nc", lstat, error) flags%basisdata = etsf_basisdata_none call etsf_io_low_open_read(ncid, "test_init_basisdata.nc", lstat, error_data = error) call tests_write_status(" | opening", lstat, error) call etsf_io_low_read_dim(ncid, "character_string_length", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'character_string_length'", lstat, error) if (dimvalue /= dims%character_string_length) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "character_string_length", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'character_string_length'", lstat, error) call etsf_io_low_read_var_infos(ncid, "basis_set", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'basis_set' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_character .or. & & var_infos%ncshape /= 1 .or. & & var_infos%ncdims(1) /= dims%character_string_length .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "basis_set", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'basis_set' characteristics", lstat, error) call etsf_io_low_read_var_infos(ncid, "kinetic_energy_cutoff", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'kinetic_energy_cutoff' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 0 .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "kinetic_energy_cutoff", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'kinetic_energy_cutoff' characteristics", lstat, error) call etsf_io_low_check_att(ncid, var_infos%ncid, "units", & & etsf_io_low_character, etsf_charlen, & & lstat, error_data = error) call tests_write_status(" | check att 'units'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_kpoints", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_kpoints'", lstat, error) if (dimvalue /= dims%number_of_kpoints) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_kpoints", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_kpoints'", lstat, error) call etsf_io_low_read_var_infos(ncid, "number_of_coefficients", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'number_of_coefficients' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_integer .or. & & var_infos%ncshape /= 1 .or. & & var_infos%ncdims(1) /= dims%number_of_kpoints .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "number_of_coefficients", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'number_of_coefficients' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_kpoints", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_kpoints'", lstat, error) if (dimvalue /= dims%number_of_kpoints) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_kpoints", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_kpoints'", lstat, error) call etsf_io_low_read_dim(ncid, "max_number_of_coefficients", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'max_number_of_coefficients'", lstat, error) if (dimvalue /= dims%max_number_of_coefficients) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "max_number_of_coefficients", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'max_number_of_coefficients'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_reduced_dimensions", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_reduced_dimensions'", lstat, error) if (dimvalue /= dims%number_of_reduced_dimensions) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_reduced_dimensions", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_reduced_dimensions'", lstat, error) call etsf_io_low_read_var_infos(ncid, "reduced_coordinates_of_plane_waves", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'reduced_coordinates_of_plane_waves' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_integer .or. & & var_infos%ncshape /= 3 .or. & & var_infos%ncdims(3) /= dims%number_of_kpoints .or. & & var_infos%ncdims(2) /= dims%max_number_of_coefficients .or. & & var_infos%ncdims(1) /= dims%number_of_reduced_dimensions .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "reduced_coordinates_of_plane_waves", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'reduced_coordinates_of_plane_waves' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_localization_regions", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_localization_regions'", lstat, error) if (dimvalue /= dims%number_of_localization_regions) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_localization_regions", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_localization_regions'", lstat, error) call etsf_io_low_read_dim(ncid, "max_number_of_basis_grid_points", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'max_number_of_basis_grid_points'", lstat, error) if (dimvalue /= dims%max_number_of_basis_grid_points) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "max_number_of_basis_grid_points", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'max_number_of_basis_grid_points'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_reduced_dimensions", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_reduced_dimensions'", lstat, error) if (dimvalue /= dims%number_of_reduced_dimensions) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_reduced_dimensions", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_reduced_dimensions'", lstat, error) call etsf_io_low_read_var_infos(ncid, "coordinates_of_basis_grid_points", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'coordinates_of_basis_grid_points' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_integer .or. & & var_infos%ncshape /= 3 .or. & & var_infos%ncdims(3) /= dims%number_of_localization_regions .or. & & var_infos%ncdims(2) /= dims%max_number_of_basis_grid_points .or. & & var_infos%ncdims(1) /= dims%number_of_reduced_dimensions .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "coordinates_of_basis_grid_points", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'coordinates_of_basis_grid_points' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_localization_regions", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_localization_regions'", lstat, error) if (dimvalue /= dims%number_of_localization_regions) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_localization_regions", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_localization_regions'", lstat, error) call etsf_io_low_read_dim(ncid, "max_number_of_basis_grid_points", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'max_number_of_basis_grid_points'", lstat, error) if (dimvalue /= dims%max_number_of_basis_grid_points) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "max_number_of_basis_grid_points", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'max_number_of_basis_grid_points'", lstat, error) call etsf_io_low_read_var_infos(ncid, "number_of_coefficients_per_grid_point", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'number_of_coefficients_per_grid_point' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_integer .or. & & var_infos%ncshape /= 2 .or. & & var_infos%ncdims(2) /= dims%number_of_localization_regions .or. & & var_infos%ncdims(1) /= dims%max_number_of_basis_grid_points .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "number_of_coefficients_per_grid_point", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'number_of_coefficients_per_grid_point' characteristics", lstat, error) call etsf_io_low_close(ncid, lstat, error_data = error) call tests_write_status(" | closing", lstat, error) flags%gwdata = etsf_gwdata_all call etsf_io_data_init("test_init_gwdata.nc", flags, & & dims, "Test", "", lstat, error) call tests_write_status("Create file test_init_gwdata.nc", lstat, error) flags%gwdata = etsf_gwdata_none call etsf_io_low_open_read(ncid, "test_init_gwdata.nc", lstat, error_data = error) call tests_write_status(" | opening", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_kpoints", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_kpoints'", lstat, error) if (dimvalue /= dims%number_of_kpoints) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_kpoints", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_kpoints'", lstat, error) call etsf_io_low_read_dim(ncid, "max_number_of_states", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'max_number_of_states'", lstat, error) if (dimvalue /= dims%max_number_of_states) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "max_number_of_states", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'max_number_of_states'", lstat, error) call etsf_io_low_read_dim(ncid, "real_or_complex_gw_corrections", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'real_or_complex_gw_corrections'", lstat, error) if (dimvalue /= dims%real_or_complex_gw_corrections) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "real_or_complex_gw_corrections", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'real_or_complex_gw_corrections'", lstat, error) call etsf_io_low_read_var_infos(ncid, "gw_corrections", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'gw_corrections' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 4 .or. & & var_infos%ncdims(4) /= dims%number_of_spins .or. & & var_infos%ncdims(3) /= dims%number_of_kpoints .or. & & var_infos%ncdims(2) /= dims%max_number_of_states .or. & & var_infos%ncdims(1) /= dims%real_or_complex_gw_corrections .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "gw_corrections", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'gw_corrections' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_atom_species", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_atom_species'", lstat, error) if (dimvalue /= dims%number_of_atom_species) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_atom_species", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_atom_species'", lstat, error) call etsf_io_low_read_dim(ncid, "max_number_of_angular_momenta", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'max_number_of_angular_momenta'", lstat, error) if (dimvalue /= dims%max_number_of_angular_momenta) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "max_number_of_angular_momenta", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'max_number_of_angular_momenta'", lstat, error) call etsf_io_low_read_dim(ncid, "max_number_of_projectors", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'max_number_of_projectors'", lstat, error) if (dimvalue /= dims%max_number_of_projectors) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "max_number_of_projectors", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'max_number_of_projectors'", lstat, error) call etsf_io_low_read_var_infos(ncid, "kb_formfactor_sign", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'kb_formfactor_sign' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_integer .or. & & var_infos%ncshape /= 3 .or. & & var_infos%ncdims(3) /= dims%number_of_atom_species .or. & & var_infos%ncdims(2) /= dims%max_number_of_angular_momenta .or. & & var_infos%ncdims(1) /= dims%max_number_of_projectors .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "kb_formfactor_sign", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'kb_formfactor_sign' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_atom_species", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_atom_species'", lstat, error) if (dimvalue /= dims%number_of_atom_species) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_atom_species", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_atom_species'", lstat, error) call etsf_io_low_read_dim(ncid, "max_number_of_angular_momenta", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'max_number_of_angular_momenta'", lstat, error) if (dimvalue /= dims%max_number_of_angular_momenta) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "max_number_of_angular_momenta", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'max_number_of_angular_momenta'", lstat, error) call etsf_io_low_read_dim(ncid, "max_number_of_projectors", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'max_number_of_projectors'", lstat, error) if (dimvalue /= dims%max_number_of_projectors) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "max_number_of_projectors", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'max_number_of_projectors'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_kpoints", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_kpoints'", lstat, error) if (dimvalue /= dims%number_of_kpoints) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_kpoints", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_kpoints'", lstat, error) call etsf_io_low_read_dim(ncid, "max_number_of_coefficients", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'max_number_of_coefficients'", lstat, error) if (dimvalue /= dims%max_number_of_coefficients) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "max_number_of_coefficients", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'max_number_of_coefficients'", lstat, error) call etsf_io_low_read_var_infos(ncid, "kb_formfactors", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'kb_formfactors' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 5 .or. & & var_infos%ncdims(5) /= dims%number_of_atom_species .or. & & var_infos%ncdims(4) /= dims%max_number_of_angular_momenta .or. & & var_infos%ncdims(3) /= dims%max_number_of_projectors .or. & & var_infos%ncdims(2) /= dims%number_of_kpoints .or. & & var_infos%ncdims(1) /= dims%max_number_of_coefficients .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "kb_formfactors", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'kb_formfactors' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_atom_species", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_atom_species'", lstat, error) if (dimvalue /= dims%number_of_atom_species) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_atom_species", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_atom_species'", lstat, error) call etsf_io_low_read_dim(ncid, "max_number_of_angular_momenta", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'max_number_of_angular_momenta'", lstat, error) if (dimvalue /= dims%max_number_of_angular_momenta) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "max_number_of_angular_momenta", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'max_number_of_angular_momenta'", lstat, error) call etsf_io_low_read_dim(ncid, "max_number_of_projectors", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'max_number_of_projectors'", lstat, error) if (dimvalue /= dims%max_number_of_projectors) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "max_number_of_projectors", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'max_number_of_projectors'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_kpoints", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_kpoints'", lstat, error) if (dimvalue /= dims%number_of_kpoints) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_kpoints", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_kpoints'", lstat, error) call etsf_io_low_read_dim(ncid, "max_number_of_coefficients", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'max_number_of_coefficients'", lstat, error) if (dimvalue /= dims%max_number_of_coefficients) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "max_number_of_coefficients", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'max_number_of_coefficients'", lstat, error) call etsf_io_low_read_var_infos(ncid, "kb_formfactor_derivative", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'kb_formfactor_derivative' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 5 .or. & & var_infos%ncdims(5) /= dims%number_of_atom_species .or. & & var_infos%ncdims(4) /= dims%max_number_of_angular_momenta .or. & & var_infos%ncdims(3) /= dims%max_number_of_projectors .or. & & var_infos%ncdims(2) /= dims%number_of_kpoints .or. & & var_infos%ncdims(1) /= dims%max_number_of_coefficients .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "kb_formfactor_derivative", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'kb_formfactor_derivative' characteristics", lstat, error) call etsf_io_low_close(ncid, lstat, error_data = error) call tests_write_status(" | closing", lstat, error) flags%dielectric = etsf_dielectric_all call etsf_io_data_init("test_init_dielectric.nc", flags, & & dims, "Test", "", lstat, error) call tests_write_status("Create file test_init_dielectric.nc", lstat, error) flags%dielectric = etsf_dielectric_none call etsf_io_low_open_read(ncid, "test_init_dielectric.nc", lstat, error_data = error) call tests_write_status(" | opening", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_frequencies_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_frequencies_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_frequencies_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_frequencies_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_frequencies_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "complex", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'complex'", lstat, error) if (dimvalue /= dims%complex) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "complex", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'complex'", lstat, error) call etsf_io_low_read_var_infos(ncid, "frequencies_dielectric_function", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'frequencies_dielectric_function' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 2 .or. & & var_infos%ncdims(2) /= dims%number_of_frequencies_dielectric_function .or. & & var_infos%ncdims(1) /= dims%complex .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "frequencies_dielectric_function", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'frequencies_dielectric_function' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_qpoints_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_qpoints_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_qpoints_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_qpoints_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_qpoints_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_reduced_dimensions", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_reduced_dimensions'", lstat, error) if (dimvalue /= dims%number_of_reduced_dimensions) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_reduced_dimensions", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_reduced_dimensions'", lstat, error) call etsf_io_low_read_var_infos(ncid, "qpoints_dielectric_function", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'qpoints_dielectric_function' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 2 .or. & & var_infos%ncdims(2) /= dims%number_of_qpoints_dielectric_function .or. & & var_infos%ncdims(1) /= dims%number_of_reduced_dimensions .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "qpoints_dielectric_function", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'qpoints_dielectric_function' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_qpoints_gamma_limit", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_qpoints_gamma_limit'", lstat, error) if (dimvalue /= dims%number_of_qpoints_gamma_limit) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_qpoints_gamma_limit", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_qpoints_gamma_limit'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_reduced_dimensions", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_reduced_dimensions'", lstat, error) if (dimvalue /= dims%number_of_reduced_dimensions) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_reduced_dimensions", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_reduced_dimensions'", lstat, error) call etsf_io_low_read_var_infos(ncid, "qpoints_gamma_limit", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'qpoints_gamma_limit' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 2 .or. & & var_infos%ncdims(2) /= dims%number_of_qpoints_gamma_limit .or. & & var_infos%ncdims(1) /= dims%number_of_reduced_dimensions .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "qpoints_gamma_limit", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'qpoints_gamma_limit' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_frequencies_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_frequencies_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_frequencies_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_frequencies_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_frequencies_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_qpoints_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_qpoints_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_qpoints_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_qpoints_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_qpoints_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_coefficients_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_coefficients_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_coefficients_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_coefficients_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_coefficients_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_coefficients_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_coefficients_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_coefficients_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_coefficients_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_coefficients_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "complex", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'complex'", lstat, error) if (dimvalue /= dims%complex) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "complex", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'complex'", lstat, error) call etsf_io_low_read_var_infos(ncid, "dielectric_function", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'dielectric_function' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 7 .or. & & var_infos%ncdims(7) /= dims%number_of_frequencies_dielectric_function .or. & & var_infos%ncdims(6) /= dims%number_of_qpoints_dielectric_function .or. & & var_infos%ncdims(5) /= dims%number_of_spins .or. & & var_infos%ncdims(4) /= dims%number_of_spins .or. & & var_infos%ncdims(3) /= dims%number_of_coefficients_dielectric_function .or. & & var_infos%ncdims(2) /= dims%number_of_coefficients_dielectric_function .or. & & var_infos%ncdims(1) /= dims%complex .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "dielectric_function", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'dielectric_function' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_frequencies_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_frequencies_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_frequencies_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_frequencies_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_frequencies_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_qpoints_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_qpoints_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_qpoints_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_qpoints_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_qpoints_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "complex", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'complex'", lstat, error) if (dimvalue /= dims%complex) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "complex", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'complex'", lstat, error) call etsf_io_low_read_var_infos(ncid, "dielectric_function_head", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'dielectric_function_head' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 5 .or. & & var_infos%ncdims(5) /= dims%number_of_frequencies_dielectric_function .or. & & var_infos%ncdims(4) /= dims%number_of_qpoints_dielectric_function .or. & & var_infos%ncdims(3) /= dims%number_of_spins .or. & & var_infos%ncdims(2) /= dims%number_of_spins .or. & & var_infos%ncdims(1) /= dims%complex .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "dielectric_function_head", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'dielectric_function_head' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_frequencies_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_frequencies_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_frequencies_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_frequencies_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_frequencies_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_qpoints_gamma_limit", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_qpoints_gamma_limit'", lstat, error) if (dimvalue /= dims%number_of_qpoints_gamma_limit) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_qpoints_gamma_limit", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_qpoints_gamma_limit'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_coefficients_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_coefficients_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_coefficients_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_coefficients_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_coefficients_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "complex", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'complex'", lstat, error) if (dimvalue /= dims%complex) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "complex", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'complex'", lstat, error) call etsf_io_low_read_var_infos(ncid, "dielectric_function_lower_wing", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'dielectric_function_lower_wing' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 6 .or. & & var_infos%ncdims(6) /= dims%number_of_frequencies_dielectric_function .or. & & var_infos%ncdims(5) /= dims%number_of_qpoints_gamma_limit .or. & & var_infos%ncdims(4) /= dims%number_of_spins .or. & & var_infos%ncdims(3) /= dims%number_of_spins .or. & & var_infos%ncdims(2) /= dims%number_of_coefficients_dielectric_function .or. & & var_infos%ncdims(1) /= dims%complex .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "dielectric_function_lower_wing", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'dielectric_function_lower_wing' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_frequencies_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_frequencies_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_frequencies_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_frequencies_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_frequencies_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_qpoints_gamma_limit", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_qpoints_gamma_limit'", lstat, error) if (dimvalue /= dims%number_of_qpoints_gamma_limit) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_qpoints_gamma_limit", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_qpoints_gamma_limit'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_coefficients_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_coefficients_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_coefficients_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_coefficients_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_coefficients_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "complex", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'complex'", lstat, error) if (dimvalue /= dims%complex) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "complex", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'complex'", lstat, error) call etsf_io_low_read_var_infos(ncid, "dielectric_function_upper_wing", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'dielectric_function_upper_wing' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 6 .or. & & var_infos%ncdims(6) /= dims%number_of_frequencies_dielectric_function .or. & & var_infos%ncdims(5) /= dims%number_of_qpoints_gamma_limit .or. & & var_infos%ncdims(4) /= dims%number_of_spins .or. & & var_infos%ncdims(3) /= dims%number_of_spins .or. & & var_infos%ncdims(2) /= dims%number_of_coefficients_dielectric_function .or. & & var_infos%ncdims(1) /= dims%complex .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "dielectric_function_upper_wing", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'dielectric_function_upper_wing' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_frequencies_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_frequencies_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_frequencies_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_frequencies_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_frequencies_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_qpoints_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_qpoints_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_qpoints_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_qpoints_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_qpoints_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_coefficients_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_coefficients_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_coefficients_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_coefficients_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_coefficients_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_coefficients_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_coefficients_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_coefficients_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_coefficients_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_coefficients_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "complex", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'complex'", lstat, error) if (dimvalue /= dims%complex) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "complex", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'complex'", lstat, error) call etsf_io_low_read_var_infos(ncid, "inverse_dielectric_function", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'inverse_dielectric_function' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 7 .or. & & var_infos%ncdims(7) /= dims%number_of_frequencies_dielectric_function .or. & & var_infos%ncdims(6) /= dims%number_of_qpoints_dielectric_function .or. & & var_infos%ncdims(5) /= dims%number_of_spins .or. & & var_infos%ncdims(4) /= dims%number_of_spins .or. & & var_infos%ncdims(3) /= dims%number_of_coefficients_dielectric_function .or. & & var_infos%ncdims(2) /= dims%number_of_coefficients_dielectric_function .or. & & var_infos%ncdims(1) /= dims%complex .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "inverse_dielectric_function", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'inverse_dielectric_function' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_frequencies_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_frequencies_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_frequencies_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_frequencies_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_frequencies_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_qpoints_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_qpoints_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_qpoints_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_qpoints_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_qpoints_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "complex", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'complex'", lstat, error) if (dimvalue /= dims%complex) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "complex", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'complex'", lstat, error) call etsf_io_low_read_var_infos(ncid, "inverse_dielectric_function_head", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'inverse_dielectric_function_head' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 5 .or. & & var_infos%ncdims(5) /= dims%number_of_frequencies_dielectric_function .or. & & var_infos%ncdims(4) /= dims%number_of_qpoints_dielectric_function .or. & & var_infos%ncdims(3) /= dims%number_of_spins .or. & & var_infos%ncdims(2) /= dims%number_of_spins .or. & & var_infos%ncdims(1) /= dims%complex .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "inverse_dielectric_function_head", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'inverse_dielectric_function_head' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_frequencies_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_frequencies_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_frequencies_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_frequencies_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_frequencies_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_qpoints_gamma_limit", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_qpoints_gamma_limit'", lstat, error) if (dimvalue /= dims%number_of_qpoints_gamma_limit) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_qpoints_gamma_limit", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_qpoints_gamma_limit'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_coefficients_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_coefficients_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_coefficients_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_coefficients_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_coefficients_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "complex", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'complex'", lstat, error) if (dimvalue /= dims%complex) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "complex", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'complex'", lstat, error) call etsf_io_low_read_var_infos(ncid, "inverse_dielectric_function_lower_wing", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'inverse_dielectric_function_lower_wing' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 6 .or. & & var_infos%ncdims(6) /= dims%number_of_frequencies_dielectric_function .or. & & var_infos%ncdims(5) /= dims%number_of_qpoints_gamma_limit .or. & & var_infos%ncdims(4) /= dims%number_of_spins .or. & & var_infos%ncdims(3) /= dims%number_of_spins .or. & & var_infos%ncdims(2) /= dims%number_of_coefficients_dielectric_function .or. & & var_infos%ncdims(1) /= dims%complex .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "inverse_dielectric_function_lower_wing", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'inverse_dielectric_function_lower_wing' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_frequencies_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_frequencies_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_frequencies_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_frequencies_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_frequencies_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_qpoints_gamma_limit", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_qpoints_gamma_limit'", lstat, error) if (dimvalue /= dims%number_of_qpoints_gamma_limit) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_qpoints_gamma_limit", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_qpoints_gamma_limit'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_coefficients_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_coefficients_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_coefficients_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_coefficients_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_coefficients_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "complex", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'complex'", lstat, error) if (dimvalue /= dims%complex) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "complex", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'complex'", lstat, error) call etsf_io_low_read_var_infos(ncid, "inverse_dielectric_function_upper_wing", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'inverse_dielectric_function_upper_wing' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 6 .or. & & var_infos%ncdims(6) /= dims%number_of_frequencies_dielectric_function .or. & & var_infos%ncdims(5) /= dims%number_of_qpoints_gamma_limit .or. & & var_infos%ncdims(4) /= dims%number_of_spins .or. & & var_infos%ncdims(3) /= dims%number_of_spins .or. & & var_infos%ncdims(2) /= dims%number_of_coefficients_dielectric_function .or. & & var_infos%ncdims(1) /= dims%complex .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "inverse_dielectric_function_upper_wing", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'inverse_dielectric_function_upper_wing' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_frequencies_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_frequencies_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_frequencies_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_frequencies_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_frequencies_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_qpoints_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_qpoints_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_qpoints_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_qpoints_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_qpoints_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_coefficients_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_coefficients_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_coefficients_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_coefficients_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_coefficients_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_coefficients_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_coefficients_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_coefficients_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_coefficients_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_coefficients_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "complex", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'complex'", lstat, error) if (dimvalue /= dims%complex) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "complex", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'complex'", lstat, error) call etsf_io_low_read_var_infos(ncid, "polarizability", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'polarizability' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 7 .or. & & var_infos%ncdims(7) /= dims%number_of_frequencies_dielectric_function .or. & & var_infos%ncdims(6) /= dims%number_of_qpoints_dielectric_function .or. & & var_infos%ncdims(5) /= dims%number_of_spins .or. & & var_infos%ncdims(4) /= dims%number_of_spins .or. & & var_infos%ncdims(3) /= dims%number_of_coefficients_dielectric_function .or. & & var_infos%ncdims(2) /= dims%number_of_coefficients_dielectric_function .or. & & var_infos%ncdims(1) /= dims%complex .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "polarizability", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'polarizability' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_frequencies_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_frequencies_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_frequencies_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_frequencies_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_frequencies_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_qpoints_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_qpoints_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_qpoints_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_qpoints_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_qpoints_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "complex", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'complex'", lstat, error) if (dimvalue /= dims%complex) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "complex", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'complex'", lstat, error) call etsf_io_low_read_var_infos(ncid, "polarizability_head", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'polarizability_head' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 5 .or. & & var_infos%ncdims(5) /= dims%number_of_frequencies_dielectric_function .or. & & var_infos%ncdims(4) /= dims%number_of_qpoints_dielectric_function .or. & & var_infos%ncdims(3) /= dims%number_of_spins .or. & & var_infos%ncdims(2) /= dims%number_of_spins .or. & & var_infos%ncdims(1) /= dims%complex .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "polarizability_head", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'polarizability_head' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_frequencies_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_frequencies_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_frequencies_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_frequencies_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_frequencies_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_qpoints_gamma_limit", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_qpoints_gamma_limit'", lstat, error) if (dimvalue /= dims%number_of_qpoints_gamma_limit) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_qpoints_gamma_limit", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_qpoints_gamma_limit'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_coefficients_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_coefficients_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_coefficients_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_coefficients_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_coefficients_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "complex", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'complex'", lstat, error) if (dimvalue /= dims%complex) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "complex", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'complex'", lstat, error) call etsf_io_low_read_var_infos(ncid, "polarizability_lower_wing", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'polarizability_lower_wing' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 6 .or. & & var_infos%ncdims(6) /= dims%number_of_frequencies_dielectric_function .or. & & var_infos%ncdims(5) /= dims%number_of_qpoints_gamma_limit .or. & & var_infos%ncdims(4) /= dims%number_of_spins .or. & & var_infos%ncdims(3) /= dims%number_of_spins .or. & & var_infos%ncdims(2) /= dims%number_of_coefficients_dielectric_function .or. & & var_infos%ncdims(1) /= dims%complex .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "polarizability_lower_wing", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'polarizability_lower_wing' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_frequencies_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_frequencies_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_frequencies_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_frequencies_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_frequencies_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_qpoints_gamma_limit", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_qpoints_gamma_limit'", lstat, error) if (dimvalue /= dims%number_of_qpoints_gamma_limit) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_qpoints_gamma_limit", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_qpoints_gamma_limit'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_coefficients_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_coefficients_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_coefficients_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_coefficients_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_coefficients_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "complex", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'complex'", lstat, error) if (dimvalue /= dims%complex) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "complex", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'complex'", lstat, error) call etsf_io_low_read_var_infos(ncid, "polarizability_upper_wing", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'polarizability_upper_wing' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 6 .or. & & var_infos%ncdims(6) /= dims%number_of_frequencies_dielectric_function .or. & & var_infos%ncdims(5) /= dims%number_of_qpoints_gamma_limit .or. & & var_infos%ncdims(4) /= dims%number_of_spins .or. & & var_infos%ncdims(3) /= dims%number_of_spins .or. & & var_infos%ncdims(2) /= dims%number_of_coefficients_dielectric_function .or. & & var_infos%ncdims(1) /= dims%complex .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "polarizability_upper_wing", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'polarizability_upper_wing' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_frequencies_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_frequencies_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_frequencies_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_frequencies_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_frequencies_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_qpoints_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_qpoints_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_qpoints_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_qpoints_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_qpoints_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_coefficients_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_coefficients_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_coefficients_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_coefficients_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_coefficients_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_coefficients_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_coefficients_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_coefficients_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_coefficients_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_coefficients_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "complex", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'complex'", lstat, error) if (dimvalue /= dims%complex) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "complex", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'complex'", lstat, error) call etsf_io_low_read_var_infos(ncid, "inverse_polarizability", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'inverse_polarizability' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 7 .or. & & var_infos%ncdims(7) /= dims%number_of_frequencies_dielectric_function .or. & & var_infos%ncdims(6) /= dims%number_of_qpoints_dielectric_function .or. & & var_infos%ncdims(5) /= dims%number_of_spins .or. & & var_infos%ncdims(4) /= dims%number_of_spins .or. & & var_infos%ncdims(3) /= dims%number_of_coefficients_dielectric_function .or. & & var_infos%ncdims(2) /= dims%number_of_coefficients_dielectric_function .or. & & var_infos%ncdims(1) /= dims%complex .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "inverse_polarizability", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'inverse_polarizability' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_frequencies_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_frequencies_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_frequencies_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_frequencies_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_frequencies_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_qpoints_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_qpoints_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_qpoints_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_qpoints_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_qpoints_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "complex", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'complex'", lstat, error) if (dimvalue /= dims%complex) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "complex", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'complex'", lstat, error) call etsf_io_low_read_var_infos(ncid, "inverse_polarizability_head", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'inverse_polarizability_head' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 5 .or. & & var_infos%ncdims(5) /= dims%number_of_frequencies_dielectric_function .or. & & var_infos%ncdims(4) /= dims%number_of_qpoints_dielectric_function .or. & & var_infos%ncdims(3) /= dims%number_of_spins .or. & & var_infos%ncdims(2) /= dims%number_of_spins .or. & & var_infos%ncdims(1) /= dims%complex .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "inverse_polarizability_head", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'inverse_polarizability_head' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_frequencies_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_frequencies_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_frequencies_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_frequencies_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_frequencies_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_qpoints_gamma_limit", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_qpoints_gamma_limit'", lstat, error) if (dimvalue /= dims%number_of_qpoints_gamma_limit) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_qpoints_gamma_limit", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_qpoints_gamma_limit'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_coefficients_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_coefficients_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_coefficients_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_coefficients_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_coefficients_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "complex", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'complex'", lstat, error) if (dimvalue /= dims%complex) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "complex", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'complex'", lstat, error) call etsf_io_low_read_var_infos(ncid, "inverse_polarizability_lower_wing", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'inverse_polarizability_lower_wing' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 6 .or. & & var_infos%ncdims(6) /= dims%number_of_frequencies_dielectric_function .or. & & var_infos%ncdims(5) /= dims%number_of_qpoints_gamma_limit .or. & & var_infos%ncdims(4) /= dims%number_of_spins .or. & & var_infos%ncdims(3) /= dims%number_of_spins .or. & & var_infos%ncdims(2) /= dims%number_of_coefficients_dielectric_function .or. & & var_infos%ncdims(1) /= dims%complex .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "inverse_polarizability_lower_wing", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'inverse_polarizability_lower_wing' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_frequencies_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_frequencies_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_frequencies_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_frequencies_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_frequencies_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_qpoints_gamma_limit", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_qpoints_gamma_limit'", lstat, error) if (dimvalue /= dims%number_of_qpoints_gamma_limit) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_qpoints_gamma_limit", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_qpoints_gamma_limit'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_coefficients_dielectric_function", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_coefficients_dielectric_function'", lstat, error) if (dimvalue /= dims%number_of_coefficients_dielectric_function) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_coefficients_dielectric_function", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_coefficients_dielectric_function'", lstat, error) call etsf_io_low_read_dim(ncid, "complex", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'complex'", lstat, error) if (dimvalue /= dims%complex) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "complex", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'complex'", lstat, error) call etsf_io_low_read_var_infos(ncid, "inverse_polarizability_upper_wing", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'inverse_polarizability_upper_wing' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 6 .or. & & var_infos%ncdims(6) /= dims%number_of_frequencies_dielectric_function .or. & & var_infos%ncdims(5) /= dims%number_of_qpoints_gamma_limit .or. & & var_infos%ncdims(4) /= dims%number_of_spins .or. & & var_infos%ncdims(3) /= dims%number_of_spins .or. & & var_infos%ncdims(2) /= dims%number_of_coefficients_dielectric_function .or. & & var_infos%ncdims(1) /= dims%complex .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "inverse_polarizability_upper_wing", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'inverse_polarizability_upper_wing' characteristics", lstat, error) call etsf_io_low_close(ncid, lstat, error_data = error) call tests_write_status(" | closing", lstat, error) flags%main = etsf_main_all call etsf_io_data_init("test_init_main.nc", flags, & & dims, "Test", "", lstat, error) call tests_write_status("Create file test_init_main.nc", lstat, error) flags%main = etsf_main_none call etsf_io_low_open_read(ncid, "test_init_main.nc", lstat, error_data = error) call tests_write_status(" | opening", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_components", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_components'", lstat, error) if (dimvalue /= dims%number_of_components) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_components", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_components'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_grid_points_vector3", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_grid_points_vector3'", lstat, error) if (dimvalue /= dims%number_of_grid_points_vector3) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_grid_points_vector3", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_grid_points_vector3'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_grid_points_vector2", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_grid_points_vector2'", lstat, error) if (dimvalue /= dims%number_of_grid_points_vector2) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_grid_points_vector2", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_grid_points_vector2'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_grid_points_vector1", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_grid_points_vector1'", lstat, error) if (dimvalue /= dims%number_of_grid_points_vector1) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_grid_points_vector1", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_grid_points_vector1'", lstat, error) call etsf_io_low_read_dim(ncid, "real_or_complex_density", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'real_or_complex_density'", lstat, error) if (dimvalue /= dims%real_or_complex_density) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "real_or_complex_density", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'real_or_complex_density'", lstat, error) call etsf_io_low_read_var_infos(ncid, "density", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'density' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 5 .or. & & var_infos%ncdims(5) /= dims%number_of_components .or. & & var_infos%ncdims(4) /= dims%number_of_grid_points_vector3 .or. & & var_infos%ncdims(3) /= dims%number_of_grid_points_vector2 .or. & & var_infos%ncdims(2) /= dims%number_of_grid_points_vector1 .or. & & var_infos%ncdims(1) /= dims%real_or_complex_density .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "density", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'density' characteristics", lstat, error) call etsf_io_low_check_att(ncid, var_infos%ncid, "units", & & etsf_io_low_character, etsf_charlen, & & lstat, error_data = error) call tests_write_status(" | check att 'units'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_components", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_components'", lstat, error) if (dimvalue /= dims%number_of_components) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_components", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_components'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_grid_points_vector3", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_grid_points_vector3'", lstat, error) if (dimvalue /= dims%number_of_grid_points_vector3) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_grid_points_vector3", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_grid_points_vector3'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_grid_points_vector2", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_grid_points_vector2'", lstat, error) if (dimvalue /= dims%number_of_grid_points_vector2) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_grid_points_vector2", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_grid_points_vector2'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_grid_points_vector1", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_grid_points_vector1'", lstat, error) if (dimvalue /= dims%number_of_grid_points_vector1) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_grid_points_vector1", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_grid_points_vector1'", lstat, error) call etsf_io_low_read_dim(ncid, "real_or_complex_potential", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'real_or_complex_potential'", lstat, error) if (dimvalue /= dims%real_or_complex_potential) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "real_or_complex_potential", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'real_or_complex_potential'", lstat, error) call etsf_io_low_read_var_infos(ncid, "exchange_potential", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'exchange_potential' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 5 .or. & & var_infos%ncdims(5) /= dims%number_of_components .or. & & var_infos%ncdims(4) /= dims%number_of_grid_points_vector3 .or. & & var_infos%ncdims(3) /= dims%number_of_grid_points_vector2 .or. & & var_infos%ncdims(2) /= dims%number_of_grid_points_vector1 .or. & & var_infos%ncdims(1) /= dims%real_or_complex_potential .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "exchange_potential", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'exchange_potential' characteristics", lstat, error) call etsf_io_low_check_att(ncid, var_infos%ncid, "units", & & etsf_io_low_character, etsf_charlen, & & lstat, error_data = error) call tests_write_status(" | check att 'units'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_components", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_components'", lstat, error) if (dimvalue /= dims%number_of_components) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_components", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_components'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_grid_points_vector3", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_grid_points_vector3'", lstat, error) if (dimvalue /= dims%number_of_grid_points_vector3) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_grid_points_vector3", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_grid_points_vector3'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_grid_points_vector2", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_grid_points_vector2'", lstat, error) if (dimvalue /= dims%number_of_grid_points_vector2) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_grid_points_vector2", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_grid_points_vector2'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_grid_points_vector1", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_grid_points_vector1'", lstat, error) if (dimvalue /= dims%number_of_grid_points_vector1) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_grid_points_vector1", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_grid_points_vector1'", lstat, error) call etsf_io_low_read_dim(ncid, "real_or_complex_potential", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'real_or_complex_potential'", lstat, error) if (dimvalue /= dims%real_or_complex_potential) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "real_or_complex_potential", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'real_or_complex_potential'", lstat, error) call etsf_io_low_read_var_infos(ncid, "correlation_potential", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'correlation_potential' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 5 .or. & & var_infos%ncdims(5) /= dims%number_of_components .or. & & var_infos%ncdims(4) /= dims%number_of_grid_points_vector3 .or. & & var_infos%ncdims(3) /= dims%number_of_grid_points_vector2 .or. & & var_infos%ncdims(2) /= dims%number_of_grid_points_vector1 .or. & & var_infos%ncdims(1) /= dims%real_or_complex_potential .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "correlation_potential", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'correlation_potential' characteristics", lstat, error) call etsf_io_low_check_att(ncid, var_infos%ncid, "units", & & etsf_io_low_character, etsf_charlen, & & lstat, error_data = error) call tests_write_status(" | check att 'units'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_components", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_components'", lstat, error) if (dimvalue /= dims%number_of_components) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_components", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_components'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_grid_points_vector3", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_grid_points_vector3'", lstat, error) if (dimvalue /= dims%number_of_grid_points_vector3) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_grid_points_vector3", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_grid_points_vector3'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_grid_points_vector2", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_grid_points_vector2'", lstat, error) if (dimvalue /= dims%number_of_grid_points_vector2) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_grid_points_vector2", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_grid_points_vector2'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_grid_points_vector1", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_grid_points_vector1'", lstat, error) if (dimvalue /= dims%number_of_grid_points_vector1) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_grid_points_vector1", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_grid_points_vector1'", lstat, error) call etsf_io_low_read_dim(ncid, "real_or_complex_potential", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'real_or_complex_potential'", lstat, error) if (dimvalue /= dims%real_or_complex_potential) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "real_or_complex_potential", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'real_or_complex_potential'", lstat, error) call etsf_io_low_read_var_infos(ncid, "exchange_correlation_potential", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'exchange_correlation_potential' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 5 .or. & & var_infos%ncdims(5) /= dims%number_of_components .or. & & var_infos%ncdims(4) /= dims%number_of_grid_points_vector3 .or. & & var_infos%ncdims(3) /= dims%number_of_grid_points_vector2 .or. & & var_infos%ncdims(2) /= dims%number_of_grid_points_vector1 .or. & & var_infos%ncdims(1) /= dims%real_or_complex_potential .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "exchange_correlation_potential", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'exchange_correlation_potential' characteristics", lstat, error) call etsf_io_low_check_att(ncid, var_infos%ncid, "units", & & etsf_io_low_character, etsf_charlen, & & lstat, error_data = error) call tests_write_status(" | check att 'units'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_kpoints", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_kpoints'", lstat, error) if (dimvalue /= dims%number_of_kpoints) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_kpoints", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_kpoints'", lstat, error) call etsf_io_low_read_dim(ncid, "max_number_of_states", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'max_number_of_states'", lstat, error) if (dimvalue /= dims%max_number_of_states) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "max_number_of_states", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'max_number_of_states'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spinor_components", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spinor_components'", lstat, error) if (dimvalue /= dims%number_of_spinor_components) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spinor_components", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spinor_components'", lstat, error) call etsf_io_low_read_dim(ncid, "max_number_of_coefficients", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'max_number_of_coefficients'", lstat, error) if (dimvalue /= dims%max_number_of_coefficients) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "max_number_of_coefficients", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'max_number_of_coefficients'", lstat, error) call etsf_io_low_read_dim(ncid, "real_or_complex_coefficients", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'real_or_complex_coefficients'", lstat, error) if (dimvalue /= dims%real_or_complex_coefficients) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "real_or_complex_coefficients", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'real_or_complex_coefficients'", lstat, error) call etsf_io_low_read_var_infos(ncid, "coefficients_of_wavefunctions", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'coefficients_of_wavefunctions' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 6 .or. & & var_infos%ncdims(6) /= dims%number_of_spins .or. & & var_infos%ncdims(5) /= dims%number_of_kpoints .or. & & var_infos%ncdims(4) /= dims%max_number_of_states .or. & & var_infos%ncdims(3) /= dims%number_of_spinor_components .or. & & var_infos%ncdims(2) /= dims%max_number_of_coefficients .or. & & var_infos%ncdims(1) /= dims%real_or_complex_coefficients .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "coefficients_of_wavefunctions", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'coefficients_of_wavefunctions' characteristics", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spins", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spins'", lstat, error) if (dimvalue /= dims%number_of_spins) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spins", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spins'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_kpoints", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_kpoints'", lstat, error) if (dimvalue /= dims%number_of_kpoints) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_kpoints", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_kpoints'", lstat, error) call etsf_io_low_read_dim(ncid, "max_number_of_states", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'max_number_of_states'", lstat, error) if (dimvalue /= dims%max_number_of_states) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "max_number_of_states", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'max_number_of_states'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_spinor_components", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_spinor_components'", lstat, error) if (dimvalue /= dims%number_of_spinor_components) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_spinor_components", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_spinor_components'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_grid_points_vector3", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_grid_points_vector3'", lstat, error) if (dimvalue /= dims%number_of_grid_points_vector3) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_grid_points_vector3", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_grid_points_vector3'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_grid_points_vector2", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_grid_points_vector2'", lstat, error) if (dimvalue /= dims%number_of_grid_points_vector2) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_grid_points_vector2", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_grid_points_vector2'", lstat, error) call etsf_io_low_read_dim(ncid, "number_of_grid_points_vector1", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'number_of_grid_points_vector1'", lstat, error) if (dimvalue /= dims%number_of_grid_points_vector1) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "number_of_grid_points_vector1", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'number_of_grid_points_vector1'", lstat, error) call etsf_io_low_read_dim(ncid, "real_or_complex_wavefunctions", dimvalue, lstat, error_data = error) call tests_write_status(" | read dim 'real_or_complex_wavefunctions'", lstat, error) if (dimvalue /= dims%real_or_complex_wavefunctions) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_DIM, me, & & tgtname = "real_or_complex_wavefunctions", errmess = "Wrong value") lstat = .false. end if call tests_write_status(" | check dim value 'real_or_complex_wavefunctions'", lstat, error) call etsf_io_low_read_var_infos(ncid, "real_space_wavefunctions", var_infos, lstat, error_data = error) call tests_write_status(" | read var 'real_space_wavefunctions' characteristics", lstat, error) if (var_infos%nctype /= etsf_io_low_double .or. & & var_infos%ncshape /= 8 .or. & & var_infos%ncdims(8) /= dims%number_of_spins .or. & & var_infos%ncdims(7) /= dims%number_of_kpoints .or. & & var_infos%ncdims(6) /= dims%max_number_of_states .or. & & var_infos%ncdims(5) /= dims%number_of_spinor_components .or. & & var_infos%ncdims(4) /= dims%number_of_grid_points_vector3 .or. & & var_infos%ncdims(3) /= dims%number_of_grid_points_vector2 .or. & & var_infos%ncdims(2) /= dims%number_of_grid_points_vector1 .or. & & var_infos%ncdims(1) /= dims%real_or_complex_wavefunctions .or. & & .false. ) then call etsf_io_low_error_set(error, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, & & tgtname = "real_space_wavefunctions", errmess = "Wrong characteristic") lstat = .false. end if call tests_write_status(" | check var 'real_space_wavefunctions' characteristics", lstat, error) call etsf_io_low_close(ncid, lstat, error_data = error) call tests_write_status(" | closing", lstat, error) write(*,*) end subroutine test_data_init end program tests_init etsf_io-1.0.3/tests/group_level/tests_read.f900000644000353400050630000011235411354150413016234 00000000000000!! NOTES !! This file has been automatically generated by the config/scripts/autogen_tests.py !! script. Any change you would bring to it will systematically be !! overwritten. See the template file in config/etsf/template.tests. program tests_read use etsf_io_low_level use etsf_io use tests implicit none call test_data_read() call test_read_geometry() call test_read_electrons() call test_read_kpoints() call test_read_basisdata() call test_read_gwdata() call test_read_dielectric() call test_read_main() contains subroutine test_data_read() type(etsf_dims) :: dims type(etsf_groups) :: grp integer :: ncid type(etsf_io_low_error) :: error type(etsf_io_low_var_double) :: var character(len = *), parameter :: me = "test_data_read" logical :: lstat write(*,*) write(*,*) "Testing etsf_io_data_read()..." call etsf_io_data_read("pouet", grp, lstat, error) call tests_status("dest_file: wrong value (no file)", (.not. lstat), error) call etsf_io_data_read("Makefile", grp, lstat, error) call tests_status("dest_file: wrong value (text file)", (.not. lstat), error) write(*,*) end subroutine test_data_read subroutine test_read_geometry() type(etsf_dims) :: dims type(etsf_groups) :: groups type(etsf_groups_flags) :: flags type(etsf_geometry), target :: group logical :: lstat type(etsf_io_low_error) :: error_data character(len = *), parameter :: me = "test_read_geometry" integer :: ncid groups%geometry => group write(*,*) write(*,*) "Testing etsf_io_data_read()..." dims%number_of_grid_points_vector3 = 5 dims%number_of_symmetry_operations = 4 dims%max_number_of_coefficients = 6 dims%max_number_of_projectors = 2 dims%max_number_of_states = 8 dims%number_of_atoms = 5 dims%number_of_atom_species = 3 dims%number_of_kpoints = 12 dims%number_of_components = 2 flags%geometry = etsf_geometry_all call etsf_io_data_init("test_read_geometry.nc", flags, & & dims, "Test", "", lstat, error_data) call tests_status("Create file test_read_geometry.nc", lstat, error_data) ! Allocate and init space_group call tests_init_variable(group%space_group) ! Allocate and init primitive_vectors call tests_init_variable(group%primitive_vectors, (/ & & dims%number_of_cartesian_directions, & & dims%number_of_vectors /)) ! Allocate and init reduced_symmetry_matrices call tests_init_variable(group%reduced_symmetry_matrices, (/ & & dims%number_of_reduced_dimensions, & & dims%number_of_reduced_dimensions, & & dims%number_of_symmetry_operations /)) ! Allocate and init reduced_symmetry_translations call tests_init_variable(group%reduced_symmetry_translations, (/ & & dims%number_of_reduced_dimensions, & & dims%number_of_symmetry_operations /)) ! Allocate and init atom_species call tests_init_variable(group%atom_species, (/ & & dims%number_of_atoms /)) ! Allocate and init reduced_atom_positions call tests_init_variable(group%reduced_atom_positions, (/ & & dims%number_of_reduced_dimensions, & & dims%number_of_atoms /)) ! Allocate and init valence_charges call tests_init_variable(group%valence_charges, (/ & & dims%number_of_atom_species /)) ! Allocate and init atomic_numbers call tests_init_variable(group%atomic_numbers, (/ & & dims%number_of_atom_species /)) ! Allocate and init atom_species_names call tests_init_variable(group%atom_species_names, (/ & & dims%character_string_length, & & dims%number_of_atom_species /)) ! Allocate and init chemical_symbols call tests_init_variable(group%chemical_symbols, (/ & & dims%symbol_length, & & dims%number_of_atom_species /)) ! Allocate and init pseudopotential_types call tests_init_variable(group%pseudopotential_types, (/ & & dims%character_string_length, & & dims%number_of_atom_species /)) call etsf_io_data_write("test_read_geometry.nc", & & groups, lstat, error_data) call tests_status("write data", lstat, error_data) ! check informations. call etsf_io_data_read("test_read_geometry.nc", & & groups, lstat, error_data) call tests_status("read data", lstat, error_data) call tests_check_values(group%space_group, & & "space_group", lstat, error_data) call tests_check_values(reshape(group%primitive_vectors, & & (/ 1 /)), "primitive_vectors", & & lstat, error_data) call tests_check_values(reshape(group%reduced_symmetry_matrices, & & (/ 1 /)), "reduced_symmetry_matrices", & & lstat, error_data) call tests_check_values(reshape(group%reduced_symmetry_translations, & & (/ 1 /)), "reduced_symmetry_translations", & & lstat, error_data) call tests_check_values(group%atom_species, & & "atom_species", lstat, error_data) call tests_check_values(reshape(group%reduced_atom_positions, & & (/ 1 /)), "reduced_atom_positions", & & lstat, error_data) call tests_check_values(group%valence_charges, & & "valence_charges", lstat, error_data) call tests_check_values(group%atomic_numbers, & & "atomic_numbers", lstat, error_data) call tests_check_values(group%atom_species_names, & & (/ dims%character_string_length, dims%number_of_atom_species /), & & "atom_species_names", lstat, error_data) call tests_check_values(group%chemical_symbols, & & (/ dims%symbol_length, dims%number_of_atom_species /), & & "chemical_symbols", lstat, error_data) call tests_check_values(group%pseudopotential_types, & & (/ dims%character_string_length, dims%number_of_atom_species /), & & "pseudopotential_types", lstat, error_data) deallocate(group%space_group) deallocate(group%primitive_vectors) deallocate(group%reduced_symmetry_matrices) deallocate(group%reduced_symmetry_translations) deallocate(group%atom_species) deallocate(group%reduced_atom_positions) deallocate(group%valence_charges) deallocate(group%atomic_numbers) deallocate(group%atom_species_names) deallocate(group%chemical_symbols) deallocate(group%pseudopotential_types) write(*,*) end subroutine test_read_geometry subroutine test_read_electrons() type(etsf_dims) :: dims type(etsf_groups) :: groups type(etsf_groups_flags) :: flags type(etsf_electrons), target :: group logical :: lstat type(etsf_io_low_error) :: error_data character(len = *), parameter :: me = "test_read_electrons" integer :: ncid groups%electrons => group write(*,*) write(*,*) "Testing etsf_io_data_read()..." dims%number_of_grid_points_vector3 = 5 dims%number_of_symmetry_operations = 4 dims%max_number_of_coefficients = 6 dims%max_number_of_projectors = 2 dims%max_number_of_states = 8 dims%number_of_atoms = 5 dims%number_of_atom_species = 3 dims%number_of_kpoints = 12 dims%number_of_components = 2 flags%electrons = etsf_electrons_all call etsf_io_data_init("test_read_electrons.nc", flags, & & dims, "Test", "", lstat, error_data) call tests_status("Create file test_read_electrons.nc", lstat, error_data) ! Allocate and init number_of_electrons call tests_init_variable(group%number_of_electrons) ! Allocate and init exchange_functional call tests_init_variable(group%exchange_functional, (/ & & dims%character_string_length /)) ! Allocate and init correlation_functional call tests_init_variable(group%correlation_functional, (/ & & dims%character_string_length /)) ! Allocate and init fermi_energy call tests_init_variable(group%fermi_energy) ! Allocate and init smearing_scheme call tests_init_variable(group%smearing_scheme, (/ & & dims%character_string_length /)) ! Allocate and init smearing_width call tests_init_variable(group%smearing_width) ! Allocate and init number_of_states call tests_init_variable(group%number_of_states%data1D, (/ & & dims%number_of_spins * & & dims%number_of_kpoints /)) ! Allocate and init eigenvalues call tests_init_variable(group%eigenvalues%data1D, (/ & & dims%number_of_spins * & & dims%number_of_kpoints * & & dims%max_number_of_states /)) ! Allocate and init occupations call tests_init_variable(group%occupations%data1D, (/ & & dims%number_of_spins * & & dims%number_of_kpoints * & & dims%max_number_of_states /)) call etsf_io_data_write("test_read_electrons.nc", & & groups, lstat, error_data) call tests_status("write data", lstat, error_data) ! check informations. call etsf_io_data_read("test_read_electrons.nc", & & groups, lstat, error_data) call tests_status("read data", lstat, error_data) call tests_check_values(group%number_of_electrons, & & "number_of_electrons", lstat, error_data) call tests_check_values(group%exchange_functional, & & dims%character_string_length, "exchange_functional", & & lstat, error_data) call tests_check_values(group%correlation_functional, & & dims%character_string_length, "correlation_functional", & & lstat, error_data) call tests_check_values(group%fermi_energy, & & "fermi_energy", lstat, error_data) call tests_check_values(group%smearing_scheme, & & dims%character_string_length, "smearing_scheme", & & lstat, error_data) call tests_check_values(group%smearing_width, & & "smearing_width", lstat, error_data) call tests_check_values(group%number_of_states%data1D, & & "number_of_states", lstat, error_data) call tests_check_values(group%eigenvalues%data1D, & & "eigenvalues", lstat, error_data) call tests_check_values(group%occupations%data1D, & & "occupations", lstat, error_data) deallocate(group%number_of_electrons) deallocate(group%exchange_functional) deallocate(group%correlation_functional) deallocate(group%fermi_energy) deallocate(group%smearing_scheme) deallocate(group%smearing_width) deallocate(group%number_of_states%data1D) deallocate(group%eigenvalues%data1D) deallocate(group%occupations%data1D) write(*,*) end subroutine test_read_electrons subroutine test_read_kpoints() type(etsf_dims) :: dims type(etsf_groups) :: groups type(etsf_groups_flags) :: flags type(etsf_kpoints), target :: group logical :: lstat type(etsf_io_low_error) :: error_data character(len = *), parameter :: me = "test_read_kpoints" integer :: ncid groups%kpoints => group write(*,*) write(*,*) "Testing etsf_io_data_read()..." dims%number_of_grid_points_vector3 = 5 dims%number_of_symmetry_operations = 4 dims%max_number_of_coefficients = 6 dims%max_number_of_projectors = 2 dims%max_number_of_states = 8 dims%number_of_atoms = 5 dims%number_of_atom_species = 3 dims%number_of_kpoints = 12 dims%number_of_components = 2 flags%kpoints = etsf_kpoints_all call etsf_io_data_init("test_read_kpoints.nc", flags, & & dims, "Test", "", lstat, error_data) call tests_status("Create file test_read_kpoints.nc", lstat, error_data) ! Allocate and init kpoint_grid_shift call tests_init_variable(group%kpoint_grid_shift, (/ & & dims%number_of_reduced_dimensions /)) ! Allocate and init kpoint_grid_vectors call tests_init_variable(group%kpoint_grid_vectors, (/ & & dims%number_of_reduced_dimensions, & & dims%number_of_vectors /)) ! Allocate and init monkhorst_pack_folding call tests_init_variable(group%monkhorst_pack_folding, (/ & & dims%number_of_vectors /)) ! Allocate and init reduced_coordinates_of_kpoints call tests_init_variable(group%reduced_coordinates_of_kpoints, (/ & & dims%number_of_reduced_dimensions, & & dims%number_of_kpoints /)) ! Allocate and init kpoint_weights call tests_init_variable(group%kpoint_weights, (/ & & dims%number_of_kpoints /)) call etsf_io_data_write("test_read_kpoints.nc", & & groups, lstat, error_data) call tests_status("write data", lstat, error_data) ! check informations. call etsf_io_data_read("test_read_kpoints.nc", & & groups, lstat, error_data) call tests_status("read data", lstat, error_data) call tests_check_values(group%kpoint_grid_shift, & & "kpoint_grid_shift", lstat, error_data) call tests_check_values(reshape(group%kpoint_grid_vectors, & & (/ 1 /)), "kpoint_grid_vectors", & & lstat, error_data) call tests_check_values(group%monkhorst_pack_folding, & & "monkhorst_pack_folding", lstat, error_data) call tests_check_values(reshape(group%reduced_coordinates_of_kpoints, & & (/ 1 /)), "reduced_coordinates_of_kpoints", & & lstat, error_data) call tests_check_values(group%kpoint_weights, & & "kpoint_weights", lstat, error_data) deallocate(group%kpoint_grid_shift) deallocate(group%kpoint_grid_vectors) deallocate(group%monkhorst_pack_folding) deallocate(group%reduced_coordinates_of_kpoints) deallocate(group%kpoint_weights) write(*,*) end subroutine test_read_kpoints subroutine test_read_basisdata() type(etsf_dims) :: dims type(etsf_groups) :: groups type(etsf_groups_flags) :: flags type(etsf_basisdata), target :: group logical :: lstat type(etsf_io_low_error) :: error_data character(len = *), parameter :: me = "test_read_basisdata" integer :: ncid groups%basisdata => group write(*,*) write(*,*) "Testing etsf_io_data_read()..." dims%number_of_grid_points_vector3 = 5 dims%number_of_symmetry_operations = 4 dims%max_number_of_coefficients = 6 dims%max_number_of_projectors = 2 dims%max_number_of_states = 8 dims%number_of_atoms = 5 dims%number_of_atom_species = 3 dims%number_of_kpoints = 12 dims%number_of_components = 2 flags%basisdata = etsf_basisdata_all call etsf_io_data_init("test_read_basisdata.nc", flags, & & dims, "Test", "", lstat, error_data) call tests_status("Create file test_read_basisdata.nc", lstat, error_data) ! Allocate and init basis_set call tests_init_variable(group%basis_set, (/ & & dims%character_string_length /)) ! Allocate and init kinetic_energy_cutoff call tests_init_variable(group%kinetic_energy_cutoff) ! Allocate and init number_of_coefficients call tests_init_variable(group%number_of_coefficients, (/ & & dims%number_of_kpoints /)) ! Allocate and init reduced_coordinates_of_plane_waves call tests_init_variable(group%reduced_coordinates_of_plane_waves%data1D, (/ & & dims%number_of_kpoints * & & dims%max_number_of_coefficients * & & dims%number_of_reduced_dimensions /)) ! Allocate and init coordinates_of_basis_grid_points call tests_init_variable(group%coordinates_of_basis_grid_points%data1D, (/ & & dims%number_of_localization_regions * & & dims%max_number_of_basis_grid_points * & & dims%number_of_reduced_dimensions /)) ! Allocate and init number_of_coefficients_per_grid_point call tests_init_variable(group%number_of_coefficients_per_grid_point%data1D, (/ & & dims%number_of_localization_regions * & & dims%max_number_of_basis_grid_points /)) call etsf_io_data_write("test_read_basisdata.nc", & & groups, lstat, error_data) call tests_status("write data", lstat, error_data) ! check informations. call etsf_io_data_read("test_read_basisdata.nc", & & groups, lstat, error_data) call tests_status("read data", lstat, error_data) call tests_check_values(group%basis_set, & & dims%character_string_length, "basis_set", & & lstat, error_data) call tests_check_values(group%kinetic_energy_cutoff, & & "kinetic_energy_cutoff", lstat, error_data) call tests_check_values(group%number_of_coefficients, & & "number_of_coefficients", lstat, error_data) call tests_check_values(group%reduced_coordinates_of_plane_waves%data1D, & & "reduced_coordinates_of_plane_waves", lstat, error_data) call tests_check_values(group%coordinates_of_basis_grid_points%data1D, & & "coordinates_of_basis_grid_points", lstat, error_data) call tests_check_values(group%number_of_coefficients_per_grid_point%data1D, & & "number_of_coefficients_per_grid_point", lstat, error_data) deallocate(group%basis_set) deallocate(group%kinetic_energy_cutoff) deallocate(group%number_of_coefficients) deallocate(group%reduced_coordinates_of_plane_waves%data1D) deallocate(group%coordinates_of_basis_grid_points%data1D) deallocate(group%number_of_coefficients_per_grid_point%data1D) write(*,*) end subroutine test_read_basisdata subroutine test_read_gwdata() type(etsf_dims) :: dims type(etsf_groups) :: groups type(etsf_groups_flags) :: flags type(etsf_gwdata), target :: group logical :: lstat type(etsf_io_low_error) :: error_data character(len = *), parameter :: me = "test_read_gwdata" integer :: ncid groups%gwdata => group write(*,*) write(*,*) "Testing etsf_io_data_read()..." dims%number_of_grid_points_vector3 = 5 dims%number_of_symmetry_operations = 4 dims%max_number_of_coefficients = 6 dims%max_number_of_projectors = 2 dims%max_number_of_states = 8 dims%number_of_atoms = 5 dims%number_of_atom_species = 3 dims%number_of_kpoints = 12 dims%number_of_components = 2 flags%gwdata = etsf_gwdata_all call etsf_io_data_init("test_read_gwdata.nc", flags, & & dims, "Test", "", lstat, error_data) call tests_status("Create file test_read_gwdata.nc", lstat, error_data) ! Allocate and init gw_corrections call tests_init_variable(group%gw_corrections%data1D, (/ & & dims%number_of_spins * & & dims%number_of_kpoints * & & dims%max_number_of_states * & & dims%real_or_complex_gw_corrections /)) ! Allocate and init kb_formfactor_sign call tests_init_variable(group%kb_formfactor_sign%data1D, (/ & & dims%number_of_atom_species * & & dims%max_number_of_angular_momenta * & & dims%max_number_of_projectors /)) ! Allocate and init kb_formfactors call tests_init_variable(group%kb_formfactors%data1D, (/ & & dims%number_of_atom_species * & & dims%max_number_of_angular_momenta * & & dims%max_number_of_projectors * & & dims%number_of_kpoints * & & dims%max_number_of_coefficients /)) ! Allocate and init kb_formfactor_derivative call tests_init_variable(group%kb_formfactor_derivative%data1D, (/ & & dims%number_of_atom_species * & & dims%max_number_of_angular_momenta * & & dims%max_number_of_projectors * & & dims%number_of_kpoints * & & dims%max_number_of_coefficients /)) call etsf_io_data_write("test_read_gwdata.nc", & & groups, lstat, error_data) call tests_status("write data", lstat, error_data) ! check informations. call etsf_io_data_read("test_read_gwdata.nc", & & groups, lstat, error_data) call tests_status("read data", lstat, error_data) call tests_check_values(group%gw_corrections%data1D, & & "gw_corrections", lstat, error_data) call tests_check_values(group%kb_formfactor_sign%data1D, & & "kb_formfactor_sign", lstat, error_data) call tests_check_values(group%kb_formfactors%data1D, & & "kb_formfactors", lstat, error_data) call tests_check_values(group%kb_formfactor_derivative%data1D, & & "kb_formfactor_derivative", lstat, error_data) deallocate(group%gw_corrections%data1D) deallocate(group%kb_formfactor_sign%data1D) deallocate(group%kb_formfactors%data1D) deallocate(group%kb_formfactor_derivative%data1D) write(*,*) end subroutine test_read_gwdata subroutine test_read_dielectric() type(etsf_dims) :: dims type(etsf_groups) :: groups type(etsf_groups_flags) :: flags type(etsf_dielectric), target :: group logical :: lstat type(etsf_io_low_error) :: error_data character(len = *), parameter :: me = "test_read_dielectric" integer :: ncid groups%dielectric => group write(*,*) write(*,*) "Testing etsf_io_data_read()..." dims%number_of_grid_points_vector3 = 5 dims%number_of_symmetry_operations = 4 dims%max_number_of_coefficients = 6 dims%max_number_of_projectors = 2 dims%max_number_of_states = 8 dims%number_of_atoms = 5 dims%number_of_atom_species = 3 dims%number_of_kpoints = 12 dims%number_of_components = 2 flags%dielectric = etsf_dielectric_all call etsf_io_data_init("test_read_dielectric.nc", flags, & & dims, "Test", "", lstat, error_data) call tests_status("Create file test_read_dielectric.nc", lstat, error_data) ! Allocate and init frequencies_dielectric_function call tests_init_variable(group%frequencies_dielectric_function, (/ & & dims%complex, & & dims%number_of_frequencies_dielectric_function /)) ! Allocate and init qpoints_dielectric_function call tests_init_variable(group%qpoints_dielectric_function, (/ & & dims%number_of_reduced_dimensions, & & dims%number_of_qpoints_dielectric_function /)) ! Allocate and init qpoints_gamma_limit call tests_init_variable(group%qpoints_gamma_limit, (/ & & dims%number_of_reduced_dimensions, & & dims%number_of_qpoints_gamma_limit /)) ! Allocate and init dielectric_function call tests_init_variable(group%dielectric_function%data1D, (/ & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_dielectric_function * & & dims%number_of_spins * & & dims%number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%number_of_coefficients_dielectric_function * & & dims%complex /)) ! Allocate and init dielectric_function_head call tests_init_variable(group%dielectric_function_head%data1D, (/ & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_dielectric_function * & & dims%number_of_spins * & & dims%number_of_spins * & & dims%complex /)) ! Allocate and init dielectric_function_lower_wing call tests_init_variable(group%dielectric_function_lower_wing%data1D, (/ & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_gamma_limit * & & dims%number_of_spins * & & dims%number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%complex /)) ! Allocate and init dielectric_function_upper_wing call tests_init_variable(group%dielectric_function_upper_wing%data1D, (/ & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_gamma_limit * & & dims%number_of_spins * & & dims%number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%complex /)) ! Allocate and init inverse_dielectric_function call tests_init_variable(group%inverse_dielectric_function%data1D, (/ & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_dielectric_function * & & dims%number_of_spins * & & dims%number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%number_of_coefficients_dielectric_function * & & dims%complex /)) ! Allocate and init inverse_dielectric_function_head call tests_init_variable(group%inverse_dielectric_function_head%data1D, (/ & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_dielectric_function * & & dims%number_of_spins * & & dims%number_of_spins * & & dims%complex /)) ! Allocate and init inverse_dielectric_function_lower_wing call tests_init_variable(group%inverse_dielectric_function_lower_wing%data1D, (/ & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_gamma_limit * & & dims%number_of_spins * & & dims%number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%complex /)) ! Allocate and init inverse_dielectric_function_upper_wing call tests_init_variable(group%inverse_dielectric_function_upper_wing%data1D, (/ & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_gamma_limit * & & dims%number_of_spins * & & dims%number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%complex /)) ! Allocate and init polarizability call tests_init_variable(group%polarizability%data1D, (/ & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_dielectric_function * & & dims%number_of_spins * & & dims%number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%number_of_coefficients_dielectric_function * & & dims%complex /)) ! Allocate and init polarizability_head call tests_init_variable(group%polarizability_head%data1D, (/ & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_dielectric_function * & & dims%number_of_spins * & & dims%number_of_spins * & & dims%complex /)) ! Allocate and init polarizability_lower_wing call tests_init_variable(group%polarizability_lower_wing%data1D, (/ & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_gamma_limit * & & dims%number_of_spins * & & dims%number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%complex /)) ! Allocate and init polarizability_upper_wing call tests_init_variable(group%polarizability_upper_wing%data1D, (/ & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_gamma_limit * & & dims%number_of_spins * & & dims%number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%complex /)) ! Allocate and init inverse_polarizability call tests_init_variable(group%inverse_polarizability%data1D, (/ & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_dielectric_function * & & dims%number_of_spins * & & dims%number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%number_of_coefficients_dielectric_function * & & dims%complex /)) ! Allocate and init inverse_polarizability_head call tests_init_variable(group%inverse_polarizability_head%data1D, (/ & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_dielectric_function * & & dims%number_of_spins * & & dims%number_of_spins * & & dims%complex /)) ! Allocate and init inverse_polarizability_lower_wing call tests_init_variable(group%inverse_polarizability_lower_wing%data1D, (/ & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_gamma_limit * & & dims%number_of_spins * & & dims%number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%complex /)) ! Allocate and init inverse_polarizability_upper_wing call tests_init_variable(group%inverse_polarizability_upper_wing%data1D, (/ & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_gamma_limit * & & dims%number_of_spins * & & dims%number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%complex /)) call etsf_io_data_write("test_read_dielectric.nc", & & groups, lstat, error_data) call tests_status("write data", lstat, error_data) ! check informations. call etsf_io_data_read("test_read_dielectric.nc", & & groups, lstat, error_data) call tests_status("read data", lstat, error_data) call tests_check_values(reshape(group%frequencies_dielectric_function, & & (/ 1 /)), "frequencies_dielectric_function", & & lstat, error_data) call tests_check_values(reshape(group%qpoints_dielectric_function, & & (/ 1 /)), "qpoints_dielectric_function", & & lstat, error_data) call tests_check_values(reshape(group%qpoints_gamma_limit, & & (/ 1 /)), "qpoints_gamma_limit", & & lstat, error_data) call tests_check_values(group%dielectric_function%data1D, & & "dielectric_function", lstat, error_data) call tests_check_values(group%dielectric_function_head%data1D, & & "dielectric_function_head", lstat, error_data) call tests_check_values(group%dielectric_function_lower_wing%data1D, & & "dielectric_function_lower_wing", lstat, error_data) call tests_check_values(group%dielectric_function_upper_wing%data1D, & & "dielectric_function_upper_wing", lstat, error_data) call tests_check_values(group%inverse_dielectric_function%data1D, & & "inverse_dielectric_function", lstat, error_data) call tests_check_values(group%inverse_dielectric_function_head%data1D, & & "inverse_dielectric_function_head", lstat, error_data) call tests_check_values(group%inverse_dielectric_function_lower_wing%data1D, & & "inverse_dielectric_function_lower_wing", lstat, error_data) call tests_check_values(group%inverse_dielectric_function_upper_wing%data1D, & & "inverse_dielectric_function_upper_wing", lstat, error_data) call tests_check_values(group%polarizability%data1D, & & "polarizability", lstat, error_data) call tests_check_values(group%polarizability_head%data1D, & & "polarizability_head", lstat, error_data) call tests_check_values(group%polarizability_lower_wing%data1D, & & "polarizability_lower_wing", lstat, error_data) call tests_check_values(group%polarizability_upper_wing%data1D, & & "polarizability_upper_wing", lstat, error_data) call tests_check_values(group%inverse_polarizability%data1D, & & "inverse_polarizability", lstat, error_data) call tests_check_values(group%inverse_polarizability_head%data1D, & & "inverse_polarizability_head", lstat, error_data) call tests_check_values(group%inverse_polarizability_lower_wing%data1D, & & "inverse_polarizability_lower_wing", lstat, error_data) call tests_check_values(group%inverse_polarizability_upper_wing%data1D, & & "inverse_polarizability_upper_wing", lstat, error_data) deallocate(group%frequencies_dielectric_function) deallocate(group%qpoints_dielectric_function) deallocate(group%qpoints_gamma_limit) deallocate(group%dielectric_function%data1D) deallocate(group%dielectric_function_head%data1D) deallocate(group%dielectric_function_lower_wing%data1D) deallocate(group%dielectric_function_upper_wing%data1D) deallocate(group%inverse_dielectric_function%data1D) deallocate(group%inverse_dielectric_function_head%data1D) deallocate(group%inverse_dielectric_function_lower_wing%data1D) deallocate(group%inverse_dielectric_function_upper_wing%data1D) deallocate(group%polarizability%data1D) deallocate(group%polarizability_head%data1D) deallocate(group%polarizability_lower_wing%data1D) deallocate(group%polarizability_upper_wing%data1D) deallocate(group%inverse_polarizability%data1D) deallocate(group%inverse_polarizability_head%data1D) deallocate(group%inverse_polarizability_lower_wing%data1D) deallocate(group%inverse_polarizability_upper_wing%data1D) write(*,*) end subroutine test_read_dielectric subroutine test_read_main() type(etsf_dims) :: dims type(etsf_groups) :: groups type(etsf_groups_flags) :: flags type(etsf_main), target :: group logical :: lstat type(etsf_io_low_error) :: error_data character(len = *), parameter :: me = "test_read_main" integer :: ncid groups%main => group write(*,*) write(*,*) "Testing etsf_io_data_read()..." dims%number_of_grid_points_vector3 = 5 dims%number_of_symmetry_operations = 4 dims%max_number_of_coefficients = 6 dims%max_number_of_projectors = 2 dims%max_number_of_states = 8 dims%number_of_atoms = 5 dims%number_of_atom_species = 3 dims%number_of_kpoints = 12 dims%number_of_components = 2 flags%main = etsf_main_all call etsf_io_data_init("test_read_main.nc", flags, & & dims, "Test", "", lstat, error_data) call tests_status("Create file test_read_main.nc", lstat, error_data) ! Allocate and init density call tests_init_variable(group%density%data1D, (/ & & dims%number_of_components * & & dims%number_of_grid_points_vector3 * & & dims%number_of_grid_points_vector2 * & & dims%number_of_grid_points_vector1 * & & dims%real_or_complex_density /)) ! Allocate and init exchange_potential call tests_init_variable(group%exchange_potential%data1D, (/ & & dims%number_of_components * & & dims%number_of_grid_points_vector3 * & & dims%number_of_grid_points_vector2 * & & dims%number_of_grid_points_vector1 * & & dims%real_or_complex_potential /)) ! Allocate and init correlation_potential call tests_init_variable(group%correlation_potential%data1D, (/ & & dims%number_of_components * & & dims%number_of_grid_points_vector3 * & & dims%number_of_grid_points_vector2 * & & dims%number_of_grid_points_vector1 * & & dims%real_or_complex_potential /)) ! Allocate and init exchange_correlation_potential call tests_init_variable(group%exchange_correlation_potential%data1D, (/ & & dims%number_of_components * & & dims%number_of_grid_points_vector3 * & & dims%number_of_grid_points_vector2 * & & dims%number_of_grid_points_vector1 * & & dims%real_or_complex_potential /)) ! Allocate and init coefficients_of_wavefunctions call tests_init_variable(group%coefficients_of_wavefunctions%data1D, (/ & & dims%number_of_spins * & & dims%number_of_kpoints * & & dims%max_number_of_states * & & dims%number_of_spinor_components * & & dims%max_number_of_coefficients * & & dims%real_or_complex_coefficients /)) ! Allocate and init real_space_wavefunctions call tests_init_variable(group%real_space_wavefunctions%data1D, (/ & & dims%number_of_spins * & & dims%number_of_kpoints * & & dims%max_number_of_states * & & dims%number_of_spinor_components * & & dims%number_of_grid_points_vector3 * & & dims%number_of_grid_points_vector2 * & & dims%number_of_grid_points_vector1 * & & dims%real_or_complex_wavefunctions /)) call etsf_io_data_write("test_read_main.nc", & & groups, lstat, error_data) call tests_status("write data", lstat, error_data) ! check informations. call etsf_io_data_read("test_read_main.nc", & & groups, lstat, error_data) call tests_status("read data", lstat, error_data) call tests_check_values(group%density%data1D, & & "density", lstat, error_data) call tests_check_values(group%exchange_potential%data1D, & & "exchange_potential", lstat, error_data) call tests_check_values(group%correlation_potential%data1D, & & "correlation_potential", lstat, error_data) call tests_check_values(group%exchange_correlation_potential%data1D, & & "exchange_correlation_potential", lstat, error_data) call tests_check_values(group%coefficients_of_wavefunctions%data1D, & & "coefficients_of_wavefunctions", lstat, error_data) call tests_check_values(group%real_space_wavefunctions%data1D, & & "real_space_wavefunctions", lstat, error_data) deallocate(group%density%data1D) deallocate(group%exchange_potential%data1D) deallocate(group%correlation_potential%data1D) deallocate(group%exchange_correlation_potential%data1D) deallocate(group%coefficients_of_wavefunctions%data1D) deallocate(group%real_space_wavefunctions%data1D) write(*,*) end subroutine test_read_main end program tests_read etsf_io-1.0.3/tests/group_level/tests_write.f900000644000353400050630000012664011354150413016456 00000000000000!! NOTES !! This file has been automatically generated by the config/scripts/autogen_tests.py !! script. Any change you would bring to it will systematically be !! overwritten. See the template file in config/etsf/template.tests. program tests_write use etsf_io_low_level use etsf_io use tests implicit none call test_data_write() call test_write_geometry() call test_write_electrons() call test_write_kpoints() call test_write_basisdata() call test_write_gwdata() call test_write_dielectric() call test_write_main() contains subroutine test_data_write() type(etsf_dims) :: dims type(etsf_groups) :: grp integer :: ncid type(etsf_io_low_error) :: error type(etsf_io_low_var_double) :: var character(len = *), parameter :: me = "test_data_write" logical :: lstat write(*,*) write(*,*) "Testing etsf_io_data_write()..." call etsf_io_data_write("pouet", grp, lstat, error) call tests_status("dest_file: wrong value (no file)", (.not. lstat), error) call etsf_io_data_write("Makefile", grp, lstat, error) call tests_status("dest_file: wrong value (text file)", (.not. lstat), error) write(*,*) end subroutine test_data_write subroutine test_write_geometry() type(etsf_dims) :: dims type(etsf_groups) :: groups type(etsf_groups_flags) :: flags type(etsf_geometry), target :: group logical :: lstat type(etsf_io_low_error) :: error_data character(len = *), parameter :: me = "test_write_geometry" integer :: ncid groups%geometry => group write(*,*) write(*,*) "Testing etsf_io_data_write()..." dims%number_of_grid_points_vector3 = 5 dims%number_of_symmetry_operations = 4 dims%max_number_of_coefficients = 6 dims%max_number_of_projectors = 2 dims%max_number_of_states = 8 dims%number_of_atoms = 5 dims%number_of_atom_species = 3 dims%number_of_kpoints = 12 dims%number_of_components = 2 flags%geometry = etsf_geometry_all call etsf_io_data_init("test_write_geometry.nc", flags, & & dims, "Test", "", lstat, error_data) call tests_status("Create file test_write_geometry.nc", lstat, error_data) ! Allocate and init space_group call tests_init_variable(group%space_group) ! Allocate and init primitive_vectors call tests_init_variable(group%primitive_vectors, (/ & & dims%number_of_cartesian_directions, & & dims%number_of_vectors /)) ! Allocate and init reduced_symmetry_matrices call tests_init_variable(group%reduced_symmetry_matrices, (/ & & dims%number_of_reduced_dimensions, & & dims%number_of_reduced_dimensions, & & dims%number_of_symmetry_operations /)) ! Allocate and init reduced_symmetry_translations call tests_init_variable(group%reduced_symmetry_translations, (/ & & dims%number_of_reduced_dimensions, & & dims%number_of_symmetry_operations /)) ! Allocate and init atom_species call tests_init_variable(group%atom_species, (/ & & dims%number_of_atoms /)) ! Allocate and init reduced_atom_positions call tests_init_variable(group%reduced_atom_positions, (/ & & dims%number_of_reduced_dimensions, & & dims%number_of_atoms /)) ! Allocate and init valence_charges call tests_init_variable(group%valence_charges, (/ & & dims%number_of_atom_species /)) ! Allocate and init atomic_numbers call tests_init_variable(group%atomic_numbers, (/ & & dims%number_of_atom_species /)) ! Allocate and init atom_species_names call tests_init_variable(group%atom_species_names, (/ & & dims%character_string_length, & & dims%number_of_atom_species /)) ! Allocate and init chemical_symbols call tests_init_variable(group%chemical_symbols, (/ & & dims%symbol_length, & & dims%number_of_atom_species /)) ! Allocate and init pseudopotential_types call tests_init_variable(group%pseudopotential_types, (/ & & dims%character_string_length, & & dims%number_of_atom_species /)) call etsf_io_data_write("test_write_geometry.nc", & & groups, lstat, error_data) call tests_status("write data", lstat, error_data) ! check informations. call etsf_io_low_open_read(ncid, "test_write_geometry.nc", lstat, error_data = error_data) call tests_status(" | opening", lstat, error_data) call tests_check_variable(ncid, "space_group", "integer", lstat, error_data) call tests_check_variable(ncid, "primitive_vectors", "real double_precision", (/ & & dims%number_of_cartesian_directions, & & dims%number_of_vectors /), lstat, error_data) call tests_check_variable(ncid, "reduced_symmetry_matrices", "integer", (/ & & dims%number_of_reduced_dimensions, & & dims%number_of_reduced_dimensions, & & dims%number_of_symmetry_operations /), lstat, error_data) call tests_check_variable(ncid, "reduced_symmetry_translations", "real double_precision", (/ & & dims%number_of_reduced_dimensions, & & dims%number_of_symmetry_operations /), lstat, error_data) call tests_check_variable(ncid, "atom_species", "integer", (/ & & dims%number_of_atoms /), lstat, error_data) call tests_check_variable(ncid, "reduced_atom_positions", "real double_precision", (/ & & dims%number_of_reduced_dimensions, & & dims%number_of_atoms /), lstat, error_data) call tests_check_variable(ncid, "valence_charges", "real double_precision", (/ & & dims%number_of_atom_species /), lstat, error_data) call tests_check_variable(ncid, "atomic_numbers", "real double_precision", (/ & & dims%number_of_atom_species /), lstat, error_data) call tests_check_variable(ncid, "atom_species_names", "string", (/ & & dims%character_string_length, & & dims%number_of_atom_species /), lstat, error_data) call tests_check_variable(ncid, "chemical_symbols", "string", (/ & & dims%symbol_length, & & dims%number_of_atom_species /), lstat, error_data) call tests_check_variable(ncid, "pseudopotential_types", "string", (/ & & dims%character_string_length, & & dims%number_of_atom_species /), lstat, error_data) ! close file call etsf_io_low_close(ncid, lstat, error_data = error_data) call tests_status(" | closing", lstat, error_data) deallocate(group%space_group) deallocate(group%primitive_vectors) deallocate(group%reduced_symmetry_matrices) deallocate(group%reduced_symmetry_translations) deallocate(group%atom_species) deallocate(group%reduced_atom_positions) deallocate(group%valence_charges) deallocate(group%atomic_numbers) deallocate(group%atom_species_names) deallocate(group%chemical_symbols) deallocate(group%pseudopotential_types) write(*,*) end subroutine test_write_geometry subroutine test_write_electrons() type(etsf_dims) :: dims type(etsf_groups) :: groups type(etsf_groups_flags) :: flags type(etsf_electrons), target :: group logical :: lstat type(etsf_io_low_error) :: error_data character(len = *), parameter :: me = "test_write_electrons" integer :: ncid groups%electrons => group write(*,*) write(*,*) "Testing etsf_io_data_write()..." dims%number_of_grid_points_vector3 = 5 dims%number_of_symmetry_operations = 4 dims%max_number_of_coefficients = 6 dims%max_number_of_projectors = 2 dims%max_number_of_states = 8 dims%number_of_atoms = 5 dims%number_of_atom_species = 3 dims%number_of_kpoints = 12 dims%number_of_components = 2 flags%electrons = etsf_electrons_all call etsf_io_data_init("test_write_electrons.nc", flags, & & dims, "Test", "", lstat, error_data) call tests_status("Create file test_write_electrons.nc", lstat, error_data) ! Allocate and init number_of_electrons call tests_init_variable(group%number_of_electrons) ! Allocate and init exchange_functional call tests_init_variable(group%exchange_functional, (/ & & dims%character_string_length /)) ! Allocate and init correlation_functional call tests_init_variable(group%correlation_functional, (/ & & dims%character_string_length /)) ! Allocate and init fermi_energy call tests_init_variable(group%fermi_energy) ! Allocate and init smearing_scheme call tests_init_variable(group%smearing_scheme, (/ & & dims%character_string_length /)) ! Allocate and init smearing_width call tests_init_variable(group%smearing_width) ! Allocate and init number_of_states call tests_init_variable(group%number_of_states%data1D, (/ & & dims%number_of_spins * & & dims%number_of_kpoints /)) ! Allocate and init eigenvalues call tests_init_variable(group%eigenvalues%data1D, (/ & & dims%number_of_spins * & & dims%number_of_kpoints * & & dims%max_number_of_states /)) ! Allocate and init occupations call tests_init_variable(group%occupations%data1D, (/ & & dims%number_of_spins * & & dims%number_of_kpoints * & & dims%max_number_of_states /)) call etsf_io_data_write("test_write_electrons.nc", & & groups, lstat, error_data) call tests_status("write data", lstat, error_data) ! check informations. call etsf_io_low_open_read(ncid, "test_write_electrons.nc", lstat, error_data = error_data) call tests_status(" | opening", lstat, error_data) call tests_check_variable(ncid, "number_of_electrons", "integer", lstat, error_data) call tests_check_variable(ncid, "exchange_functional", "string", (/ & & dims%character_string_length /), lstat, error_data) call tests_check_variable(ncid, "correlation_functional", "string", (/ & & dims%character_string_length /), lstat, error_data) call tests_check_variable(ncid, "fermi_energy", "real double_precision", lstat, error_data) call tests_check_variable(ncid, "smearing_scheme", "string", (/ & & dims%character_string_length /), lstat, error_data) call tests_check_variable(ncid, "smearing_width", "real double_precision", lstat, error_data) call tests_check_variable(ncid, "number_of_states", "integer", (/ & & dims%number_of_kpoints, & & dims%number_of_spins /), lstat, error_data) call tests_check_variable(ncid, "eigenvalues", "real double_precision", (/ & & dims%max_number_of_states, & & dims%number_of_kpoints, & & dims%number_of_spins /), lstat, error_data) call tests_check_variable(ncid, "occupations", "real double_precision", (/ & & dims%max_number_of_states, & & dims%number_of_kpoints, & & dims%number_of_spins /), lstat, error_data) ! close file call etsf_io_low_close(ncid, lstat, error_data = error_data) call tests_status(" | closing", lstat, error_data) deallocate(group%number_of_electrons) deallocate(group%exchange_functional) deallocate(group%correlation_functional) deallocate(group%fermi_energy) deallocate(group%smearing_scheme) deallocate(group%smearing_width) deallocate(group%number_of_states%data1D) deallocate(group%eigenvalues%data1D) deallocate(group%occupations%data1D) write(*,*) end subroutine test_write_electrons subroutine test_write_kpoints() type(etsf_dims) :: dims type(etsf_groups) :: groups type(etsf_groups_flags) :: flags type(etsf_kpoints), target :: group logical :: lstat type(etsf_io_low_error) :: error_data character(len = *), parameter :: me = "test_write_kpoints" integer :: ncid groups%kpoints => group write(*,*) write(*,*) "Testing etsf_io_data_write()..." dims%number_of_grid_points_vector3 = 5 dims%number_of_symmetry_operations = 4 dims%max_number_of_coefficients = 6 dims%max_number_of_projectors = 2 dims%max_number_of_states = 8 dims%number_of_atoms = 5 dims%number_of_atom_species = 3 dims%number_of_kpoints = 12 dims%number_of_components = 2 flags%kpoints = etsf_kpoints_all call etsf_io_data_init("test_write_kpoints.nc", flags, & & dims, "Test", "", lstat, error_data) call tests_status("Create file test_write_kpoints.nc", lstat, error_data) ! Allocate and init kpoint_grid_shift call tests_init_variable(group%kpoint_grid_shift, (/ & & dims%number_of_reduced_dimensions /)) ! Allocate and init kpoint_grid_vectors call tests_init_variable(group%kpoint_grid_vectors, (/ & & dims%number_of_reduced_dimensions, & & dims%number_of_vectors /)) ! Allocate and init monkhorst_pack_folding call tests_init_variable(group%monkhorst_pack_folding, (/ & & dims%number_of_vectors /)) ! Allocate and init reduced_coordinates_of_kpoints call tests_init_variable(group%reduced_coordinates_of_kpoints, (/ & & dims%number_of_reduced_dimensions, & & dims%number_of_kpoints /)) ! Allocate and init kpoint_weights call tests_init_variable(group%kpoint_weights, (/ & & dims%number_of_kpoints /)) call etsf_io_data_write("test_write_kpoints.nc", & & groups, lstat, error_data) call tests_status("write data", lstat, error_data) ! check informations. call etsf_io_low_open_read(ncid, "test_write_kpoints.nc", lstat, error_data = error_data) call tests_status(" | opening", lstat, error_data) call tests_check_variable(ncid, "kpoint_grid_shift", "real double_precision", (/ & & dims%number_of_reduced_dimensions /), lstat, error_data) call tests_check_variable(ncid, "kpoint_grid_vectors", "real double_precision", (/ & & dims%number_of_reduced_dimensions, & & dims%number_of_vectors /), lstat, error_data) call tests_check_variable(ncid, "monkhorst_pack_folding", "integer", (/ & & dims%number_of_vectors /), lstat, error_data) call tests_check_variable(ncid, "reduced_coordinates_of_kpoints", "real double_precision", (/ & & dims%number_of_reduced_dimensions, & & dims%number_of_kpoints /), lstat, error_data) call tests_check_variable(ncid, "kpoint_weights", "real double_precision", (/ & & dims%number_of_kpoints /), lstat, error_data) ! close file call etsf_io_low_close(ncid, lstat, error_data = error_data) call tests_status(" | closing", lstat, error_data) deallocate(group%kpoint_grid_shift) deallocate(group%kpoint_grid_vectors) deallocate(group%monkhorst_pack_folding) deallocate(group%reduced_coordinates_of_kpoints) deallocate(group%kpoint_weights) write(*,*) end subroutine test_write_kpoints subroutine test_write_basisdata() type(etsf_dims) :: dims type(etsf_groups) :: groups type(etsf_groups_flags) :: flags type(etsf_basisdata), target :: group logical :: lstat type(etsf_io_low_error) :: error_data character(len = *), parameter :: me = "test_write_basisdata" integer :: ncid groups%basisdata => group write(*,*) write(*,*) "Testing etsf_io_data_write()..." dims%number_of_grid_points_vector3 = 5 dims%number_of_symmetry_operations = 4 dims%max_number_of_coefficients = 6 dims%max_number_of_projectors = 2 dims%max_number_of_states = 8 dims%number_of_atoms = 5 dims%number_of_atom_species = 3 dims%number_of_kpoints = 12 dims%number_of_components = 2 flags%basisdata = etsf_basisdata_all call etsf_io_data_init("test_write_basisdata.nc", flags, & & dims, "Test", "", lstat, error_data) call tests_status("Create file test_write_basisdata.nc", lstat, error_data) ! Allocate and init basis_set call tests_init_variable(group%basis_set, (/ & & dims%character_string_length /)) ! Allocate and init kinetic_energy_cutoff call tests_init_variable(group%kinetic_energy_cutoff) ! Allocate and init number_of_coefficients call tests_init_variable(group%number_of_coefficients, (/ & & dims%number_of_kpoints /)) ! Allocate and init reduced_coordinates_of_plane_waves call tests_init_variable(group%reduced_coordinates_of_plane_waves%data1D, (/ & & dims%number_of_kpoints * & & dims%max_number_of_coefficients * & & dims%number_of_reduced_dimensions /)) ! Allocate and init coordinates_of_basis_grid_points call tests_init_variable(group%coordinates_of_basis_grid_points%data1D, (/ & & dims%number_of_localization_regions * & & dims%max_number_of_basis_grid_points * & & dims%number_of_reduced_dimensions /)) ! Allocate and init number_of_coefficients_per_grid_point call tests_init_variable(group%number_of_coefficients_per_grid_point%data1D, (/ & & dims%number_of_localization_regions * & & dims%max_number_of_basis_grid_points /)) call etsf_io_data_write("test_write_basisdata.nc", & & groups, lstat, error_data) call tests_status("write data", lstat, error_data) ! check informations. call etsf_io_low_open_read(ncid, "test_write_basisdata.nc", lstat, error_data = error_data) call tests_status(" | opening", lstat, error_data) call tests_check_variable(ncid, "basis_set", "string", (/ & & dims%character_string_length /), lstat, error_data) call tests_check_variable(ncid, "kinetic_energy_cutoff", "real double_precision", lstat, error_data) call tests_check_variable(ncid, "number_of_coefficients", "integer", (/ & & dims%number_of_kpoints /), lstat, error_data) call tests_check_variable(ncid, "reduced_coordinates_of_plane_waves", "integer", (/ & & dims%number_of_reduced_dimensions, & & dims%max_number_of_coefficients, & & dims%number_of_kpoints /), lstat, error_data) call tests_check_variable(ncid, "coordinates_of_basis_grid_points", "integer", (/ & & dims%number_of_reduced_dimensions, & & dims%max_number_of_basis_grid_points, & & dims%number_of_localization_regions /), lstat, error_data) call tests_check_variable(ncid, "number_of_coefficients_per_grid_point", "integer", (/ & & dims%max_number_of_basis_grid_points, & & dims%number_of_localization_regions /), lstat, error_data) ! close file call etsf_io_low_close(ncid, lstat, error_data = error_data) call tests_status(" | closing", lstat, error_data) deallocate(group%basis_set) deallocate(group%kinetic_energy_cutoff) deallocate(group%number_of_coefficients) deallocate(group%reduced_coordinates_of_plane_waves%data1D) deallocate(group%coordinates_of_basis_grid_points%data1D) deallocate(group%number_of_coefficients_per_grid_point%data1D) write(*,*) end subroutine test_write_basisdata subroutine test_write_gwdata() type(etsf_dims) :: dims type(etsf_groups) :: groups type(etsf_groups_flags) :: flags type(etsf_gwdata), target :: group logical :: lstat type(etsf_io_low_error) :: error_data character(len = *), parameter :: me = "test_write_gwdata" integer :: ncid groups%gwdata => group write(*,*) write(*,*) "Testing etsf_io_data_write()..." dims%number_of_grid_points_vector3 = 5 dims%number_of_symmetry_operations = 4 dims%max_number_of_coefficients = 6 dims%max_number_of_projectors = 2 dims%max_number_of_states = 8 dims%number_of_atoms = 5 dims%number_of_atom_species = 3 dims%number_of_kpoints = 12 dims%number_of_components = 2 flags%gwdata = etsf_gwdata_all call etsf_io_data_init("test_write_gwdata.nc", flags, & & dims, "Test", "", lstat, error_data) call tests_status("Create file test_write_gwdata.nc", lstat, error_data) ! Allocate and init gw_corrections call tests_init_variable(group%gw_corrections%data1D, (/ & & dims%number_of_spins * & & dims%number_of_kpoints * & & dims%max_number_of_states * & & dims%real_or_complex_gw_corrections /)) ! Allocate and init kb_formfactor_sign call tests_init_variable(group%kb_formfactor_sign%data1D, (/ & & dims%number_of_atom_species * & & dims%max_number_of_angular_momenta * & & dims%max_number_of_projectors /)) ! Allocate and init kb_formfactors call tests_init_variable(group%kb_formfactors%data1D, (/ & & dims%number_of_atom_species * & & dims%max_number_of_angular_momenta * & & dims%max_number_of_projectors * & & dims%number_of_kpoints * & & dims%max_number_of_coefficients /)) ! Allocate and init kb_formfactor_derivative call tests_init_variable(group%kb_formfactor_derivative%data1D, (/ & & dims%number_of_atom_species * & & dims%max_number_of_angular_momenta * & & dims%max_number_of_projectors * & & dims%number_of_kpoints * & & dims%max_number_of_coefficients /)) call etsf_io_data_write("test_write_gwdata.nc", & & groups, lstat, error_data) call tests_status("write data", lstat, error_data) ! check informations. call etsf_io_low_open_read(ncid, "test_write_gwdata.nc", lstat, error_data = error_data) call tests_status(" | opening", lstat, error_data) call tests_check_variable(ncid, "gw_corrections", "real double_precision", (/ & & dims%real_or_complex_gw_corrections, & & dims%max_number_of_states, & & dims%number_of_kpoints, & & dims%number_of_spins /), lstat, error_data) call tests_check_variable(ncid, "kb_formfactor_sign", "integer", (/ & & dims%max_number_of_projectors, & & dims%max_number_of_angular_momenta, & & dims%number_of_atom_species /), lstat, error_data) call tests_check_variable(ncid, "kb_formfactors", "real double_precision", (/ & & dims%max_number_of_coefficients, & & dims%number_of_kpoints, & & dims%max_number_of_projectors, & & dims%max_number_of_angular_momenta, & & dims%number_of_atom_species /), lstat, error_data) call tests_check_variable(ncid, "kb_formfactor_derivative", "real double_precision", (/ & & dims%max_number_of_coefficients, & & dims%number_of_kpoints, & & dims%max_number_of_projectors, & & dims%max_number_of_angular_momenta, & & dims%number_of_atom_species /), lstat, error_data) ! close file call etsf_io_low_close(ncid, lstat, error_data = error_data) call tests_status(" | closing", lstat, error_data) deallocate(group%gw_corrections%data1D) deallocate(group%kb_formfactor_sign%data1D) deallocate(group%kb_formfactors%data1D) deallocate(group%kb_formfactor_derivative%data1D) write(*,*) end subroutine test_write_gwdata subroutine test_write_dielectric() type(etsf_dims) :: dims type(etsf_groups) :: groups type(etsf_groups_flags) :: flags type(etsf_dielectric), target :: group logical :: lstat type(etsf_io_low_error) :: error_data character(len = *), parameter :: me = "test_write_dielectric" integer :: ncid groups%dielectric => group write(*,*) write(*,*) "Testing etsf_io_data_write()..." dims%number_of_grid_points_vector3 = 5 dims%number_of_symmetry_operations = 4 dims%max_number_of_coefficients = 6 dims%max_number_of_projectors = 2 dims%max_number_of_states = 8 dims%number_of_atoms = 5 dims%number_of_atom_species = 3 dims%number_of_kpoints = 12 dims%number_of_components = 2 flags%dielectric = etsf_dielectric_all call etsf_io_data_init("test_write_dielectric.nc", flags, & & dims, "Test", "", lstat, error_data) call tests_status("Create file test_write_dielectric.nc", lstat, error_data) ! Allocate and init frequencies_dielectric_function call tests_init_variable(group%frequencies_dielectric_function, (/ & & dims%complex, & & dims%number_of_frequencies_dielectric_function /)) ! Allocate and init qpoints_dielectric_function call tests_init_variable(group%qpoints_dielectric_function, (/ & & dims%number_of_reduced_dimensions, & & dims%number_of_qpoints_dielectric_function /)) ! Allocate and init qpoints_gamma_limit call tests_init_variable(group%qpoints_gamma_limit, (/ & & dims%number_of_reduced_dimensions, & & dims%number_of_qpoints_gamma_limit /)) ! Allocate and init dielectric_function call tests_init_variable(group%dielectric_function%data1D, (/ & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_dielectric_function * & & dims%number_of_spins * & & dims%number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%number_of_coefficients_dielectric_function * & & dims%complex /)) ! Allocate and init dielectric_function_head call tests_init_variable(group%dielectric_function_head%data1D, (/ & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_dielectric_function * & & dims%number_of_spins * & & dims%number_of_spins * & & dims%complex /)) ! Allocate and init dielectric_function_lower_wing call tests_init_variable(group%dielectric_function_lower_wing%data1D, (/ & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_gamma_limit * & & dims%number_of_spins * & & dims%number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%complex /)) ! Allocate and init dielectric_function_upper_wing call tests_init_variable(group%dielectric_function_upper_wing%data1D, (/ & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_gamma_limit * & & dims%number_of_spins * & & dims%number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%complex /)) ! Allocate and init inverse_dielectric_function call tests_init_variable(group%inverse_dielectric_function%data1D, (/ & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_dielectric_function * & & dims%number_of_spins * & & dims%number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%number_of_coefficients_dielectric_function * & & dims%complex /)) ! Allocate and init inverse_dielectric_function_head call tests_init_variable(group%inverse_dielectric_function_head%data1D, (/ & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_dielectric_function * & & dims%number_of_spins * & & dims%number_of_spins * & & dims%complex /)) ! Allocate and init inverse_dielectric_function_lower_wing call tests_init_variable(group%inverse_dielectric_function_lower_wing%data1D, (/ & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_gamma_limit * & & dims%number_of_spins * & & dims%number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%complex /)) ! Allocate and init inverse_dielectric_function_upper_wing call tests_init_variable(group%inverse_dielectric_function_upper_wing%data1D, (/ & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_gamma_limit * & & dims%number_of_spins * & & dims%number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%complex /)) ! Allocate and init polarizability call tests_init_variable(group%polarizability%data1D, (/ & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_dielectric_function * & & dims%number_of_spins * & & dims%number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%number_of_coefficients_dielectric_function * & & dims%complex /)) ! Allocate and init polarizability_head call tests_init_variable(group%polarizability_head%data1D, (/ & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_dielectric_function * & & dims%number_of_spins * & & dims%number_of_spins * & & dims%complex /)) ! Allocate and init polarizability_lower_wing call tests_init_variable(group%polarizability_lower_wing%data1D, (/ & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_gamma_limit * & & dims%number_of_spins * & & dims%number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%complex /)) ! Allocate and init polarizability_upper_wing call tests_init_variable(group%polarizability_upper_wing%data1D, (/ & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_gamma_limit * & & dims%number_of_spins * & & dims%number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%complex /)) ! Allocate and init inverse_polarizability call tests_init_variable(group%inverse_polarizability%data1D, (/ & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_dielectric_function * & & dims%number_of_spins * & & dims%number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%number_of_coefficients_dielectric_function * & & dims%complex /)) ! Allocate and init inverse_polarizability_head call tests_init_variable(group%inverse_polarizability_head%data1D, (/ & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_dielectric_function * & & dims%number_of_spins * & & dims%number_of_spins * & & dims%complex /)) ! Allocate and init inverse_polarizability_lower_wing call tests_init_variable(group%inverse_polarizability_lower_wing%data1D, (/ & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_gamma_limit * & & dims%number_of_spins * & & dims%number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%complex /)) ! Allocate and init inverse_polarizability_upper_wing call tests_init_variable(group%inverse_polarizability_upper_wing%data1D, (/ & & dims%number_of_frequencies_dielectric_function * & & dims%number_of_qpoints_gamma_limit * & & dims%number_of_spins * & & dims%number_of_spins * & & dims%number_of_coefficients_dielectric_function * & & dims%complex /)) call etsf_io_data_write("test_write_dielectric.nc", & & groups, lstat, error_data) call tests_status("write data", lstat, error_data) ! check informations. call etsf_io_low_open_read(ncid, "test_write_dielectric.nc", lstat, error_data = error_data) call tests_status(" | opening", lstat, error_data) call tests_check_variable(ncid, "frequencies_dielectric_function", "real double_precision", (/ & & dims%complex, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "qpoints_dielectric_function", "real double_precision", (/ & & dims%number_of_reduced_dimensions, & & dims%number_of_qpoints_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "qpoints_gamma_limit", "real double_precision", (/ & & dims%number_of_reduced_dimensions, & & dims%number_of_qpoints_gamma_limit /), lstat, error_data) call tests_check_variable(ncid, "dielectric_function", "real double_precision", (/ & & dims%complex, & & dims%number_of_coefficients_dielectric_function, & & dims%number_of_coefficients_dielectric_function, & & dims%number_of_spins, & & dims%number_of_spins, & & dims%number_of_qpoints_dielectric_function, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "dielectric_function_head", "real double_precision", (/ & & dims%complex, & & dims%number_of_spins, & & dims%number_of_spins, & & dims%number_of_qpoints_dielectric_function, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "dielectric_function_lower_wing", "real double_precision", (/ & & dims%complex, & & dims%number_of_coefficients_dielectric_function, & & dims%number_of_spins, & & dims%number_of_spins, & & dims%number_of_qpoints_gamma_limit, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "dielectric_function_upper_wing", "real double_precision", (/ & & dims%complex, & & dims%number_of_coefficients_dielectric_function, & & dims%number_of_spins, & & dims%number_of_spins, & & dims%number_of_qpoints_gamma_limit, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "inverse_dielectric_function", "real double_precision", (/ & & dims%complex, & & dims%number_of_coefficients_dielectric_function, & & dims%number_of_coefficients_dielectric_function, & & dims%number_of_spins, & & dims%number_of_spins, & & dims%number_of_qpoints_dielectric_function, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "inverse_dielectric_function_head", "real double_precision", (/ & & dims%complex, & & dims%number_of_spins, & & dims%number_of_spins, & & dims%number_of_qpoints_dielectric_function, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "inverse_dielectric_function_lower_wing", "real double_precision", (/ & & dims%complex, & & dims%number_of_coefficients_dielectric_function, & & dims%number_of_spins, & & dims%number_of_spins, & & dims%number_of_qpoints_gamma_limit, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "inverse_dielectric_function_upper_wing", "real double_precision", (/ & & dims%complex, & & dims%number_of_coefficients_dielectric_function, & & dims%number_of_spins, & & dims%number_of_spins, & & dims%number_of_qpoints_gamma_limit, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "polarizability", "real double_precision", (/ & & dims%complex, & & dims%number_of_coefficients_dielectric_function, & & dims%number_of_coefficients_dielectric_function, & & dims%number_of_spins, & & dims%number_of_spins, & & dims%number_of_qpoints_dielectric_function, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "polarizability_head", "real double_precision", (/ & & dims%complex, & & dims%number_of_spins, & & dims%number_of_spins, & & dims%number_of_qpoints_dielectric_function, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "polarizability_lower_wing", "real double_precision", (/ & & dims%complex, & & dims%number_of_coefficients_dielectric_function, & & dims%number_of_spins, & & dims%number_of_spins, & & dims%number_of_qpoints_gamma_limit, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "polarizability_upper_wing", "real double_precision", (/ & & dims%complex, & & dims%number_of_coefficients_dielectric_function, & & dims%number_of_spins, & & dims%number_of_spins, & & dims%number_of_qpoints_gamma_limit, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "inverse_polarizability", "real double_precision", (/ & & dims%complex, & & dims%number_of_coefficients_dielectric_function, & & dims%number_of_coefficients_dielectric_function, & & dims%number_of_spins, & & dims%number_of_spins, & & dims%number_of_qpoints_dielectric_function, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "inverse_polarizability_head", "real double_precision", (/ & & dims%complex, & & dims%number_of_spins, & & dims%number_of_spins, & & dims%number_of_qpoints_dielectric_function, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "inverse_polarizability_lower_wing", "real double_precision", (/ & & dims%complex, & & dims%number_of_coefficients_dielectric_function, & & dims%number_of_spins, & & dims%number_of_spins, & & dims%number_of_qpoints_gamma_limit, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) call tests_check_variable(ncid, "inverse_polarizability_upper_wing", "real double_precision", (/ & & dims%complex, & & dims%number_of_coefficients_dielectric_function, & & dims%number_of_spins, & & dims%number_of_spins, & & dims%number_of_qpoints_gamma_limit, & & dims%number_of_frequencies_dielectric_function /), lstat, error_data) ! close file call etsf_io_low_close(ncid, lstat, error_data = error_data) call tests_status(" | closing", lstat, error_data) deallocate(group%frequencies_dielectric_function) deallocate(group%qpoints_dielectric_function) deallocate(group%qpoints_gamma_limit) deallocate(group%dielectric_function%data1D) deallocate(group%dielectric_function_head%data1D) deallocate(group%dielectric_function_lower_wing%data1D) deallocate(group%dielectric_function_upper_wing%data1D) deallocate(group%inverse_dielectric_function%data1D) deallocate(group%inverse_dielectric_function_head%data1D) deallocate(group%inverse_dielectric_function_lower_wing%data1D) deallocate(group%inverse_dielectric_function_upper_wing%data1D) deallocate(group%polarizability%data1D) deallocate(group%polarizability_head%data1D) deallocate(group%polarizability_lower_wing%data1D) deallocate(group%polarizability_upper_wing%data1D) deallocate(group%inverse_polarizability%data1D) deallocate(group%inverse_polarizability_head%data1D) deallocate(group%inverse_polarizability_lower_wing%data1D) deallocate(group%inverse_polarizability_upper_wing%data1D) write(*,*) end subroutine test_write_dielectric subroutine test_write_main() type(etsf_dims) :: dims type(etsf_groups) :: groups type(etsf_groups_flags) :: flags type(etsf_main), target :: group logical :: lstat type(etsf_io_low_error) :: error_data character(len = *), parameter :: me = "test_write_main" integer :: ncid groups%main => group write(*,*) write(*,*) "Testing etsf_io_data_write()..." dims%number_of_grid_points_vector3 = 5 dims%number_of_symmetry_operations = 4 dims%max_number_of_coefficients = 6 dims%max_number_of_projectors = 2 dims%max_number_of_states = 8 dims%number_of_atoms = 5 dims%number_of_atom_species = 3 dims%number_of_kpoints = 12 dims%number_of_components = 2 flags%main = etsf_main_all call etsf_io_data_init("test_write_main.nc", flags, & & dims, "Test", "", lstat, error_data) call tests_status("Create file test_write_main.nc", lstat, error_data) ! Allocate and init density call tests_init_variable(group%density%data1D, (/ & & dims%number_of_components * & & dims%number_of_grid_points_vector3 * & & dims%number_of_grid_points_vector2 * & & dims%number_of_grid_points_vector1 * & & dims%real_or_complex_density /)) ! Allocate and init exchange_potential call tests_init_variable(group%exchange_potential%data1D, (/ & & dims%number_of_components * & & dims%number_of_grid_points_vector3 * & & dims%number_of_grid_points_vector2 * & & dims%number_of_grid_points_vector1 * & & dims%real_or_complex_potential /)) ! Allocate and init correlation_potential call tests_init_variable(group%correlation_potential%data1D, (/ & & dims%number_of_components * & & dims%number_of_grid_points_vector3 * & & dims%number_of_grid_points_vector2 * & & dims%number_of_grid_points_vector1 * & & dims%real_or_complex_potential /)) ! Allocate and init exchange_correlation_potential call tests_init_variable(group%exchange_correlation_potential%data1D, (/ & & dims%number_of_components * & & dims%number_of_grid_points_vector3 * & & dims%number_of_grid_points_vector2 * & & dims%number_of_grid_points_vector1 * & & dims%real_or_complex_potential /)) ! Allocate and init coefficients_of_wavefunctions call tests_init_variable(group%coefficients_of_wavefunctions%data1D, (/ & & dims%number_of_spins * & & dims%number_of_kpoints * & & dims%max_number_of_states * & & dims%number_of_spinor_components * & & dims%max_number_of_coefficients * & & dims%real_or_complex_coefficients /)) ! Allocate and init real_space_wavefunctions call tests_init_variable(group%real_space_wavefunctions%data1D, (/ & & dims%number_of_spins * & & dims%number_of_kpoints * & & dims%max_number_of_states * & & dims%number_of_spinor_components * & & dims%number_of_grid_points_vector3 * & & dims%number_of_grid_points_vector2 * & & dims%number_of_grid_points_vector1 * & & dims%real_or_complex_wavefunctions /)) call etsf_io_data_write("test_write_main.nc", & & groups, lstat, error_data) call tests_status("write data", lstat, error_data) ! check informations. call etsf_io_low_open_read(ncid, "test_write_main.nc", lstat, error_data = error_data) call tests_status(" | opening", lstat, error_data) call tests_check_variable(ncid, "density", "real double_precision", (/ & & dims%real_or_complex_density, & & dims%number_of_grid_points_vector1, & & dims%number_of_grid_points_vector2, & & dims%number_of_grid_points_vector3, & & dims%number_of_components /), lstat, error_data) call tests_check_variable(ncid, "exchange_potential", "real double_precision", (/ & & dims%real_or_complex_potential, & & dims%number_of_grid_points_vector1, & & dims%number_of_grid_points_vector2, & & dims%number_of_grid_points_vector3, & & dims%number_of_components /), lstat, error_data) call tests_check_variable(ncid, "correlation_potential", "real double_precision", (/ & & dims%real_or_complex_potential, & & dims%number_of_grid_points_vector1, & & dims%number_of_grid_points_vector2, & & dims%number_of_grid_points_vector3, & & dims%number_of_components /), lstat, error_data) call tests_check_variable(ncid, "exchange_correlation_potential", "real double_precision", (/ & & dims%real_or_complex_potential, & & dims%number_of_grid_points_vector1, & & dims%number_of_grid_points_vector2, & & dims%number_of_grid_points_vector3, & & dims%number_of_components /), lstat, error_data) call tests_check_variable(ncid, "coefficients_of_wavefunctions", "real double_precision", (/ & & dims%real_or_complex_coefficients, & & dims%max_number_of_coefficients, & & dims%number_of_spinor_components, & & dims%max_number_of_states, & & dims%number_of_kpoints, & & dims%number_of_spins /), lstat, error_data) call tests_check_variable(ncid, "real_space_wavefunctions", "real double_precision", (/ & & dims%real_or_complex_wavefunctions, & & dims%number_of_grid_points_vector1, & & dims%number_of_grid_points_vector2, & & dims%number_of_grid_points_vector3, & & dims%number_of_spinor_components, & & dims%max_number_of_states, & & dims%number_of_kpoints, & & dims%number_of_spins /), lstat, error_data) ! close file call etsf_io_low_close(ncid, lstat, error_data = error_data) call tests_status(" | closing", lstat, error_data) deallocate(group%density%data1D) deallocate(group%exchange_potential%data1D) deallocate(group%correlation_potential%data1D) deallocate(group%exchange_correlation_potential%data1D) deallocate(group%coefficients_of_wavefunctions%data1D) deallocate(group%real_space_wavefunctions%data1D) write(*,*) end subroutine test_write_main end program tests_write etsf_io-1.0.3/tests/group_level/test_split_electrons_part1.cdl0000644000353400050630000000433710643425633021634 00000000000000netcdf test_write_electrons { dimensions: character_string_length = 80 ; max_number_of_angular_momenta = 1 ; max_number_of_coefficients = 6 ; max_number_of_projectors = 2 ; max_number_of_states = 8 ; number_of_atoms = 4 ; number_of_atom_species = 1 ; number_of_cartesian_directions = 3 ; number_of_components = 2 ; number_of_grid_points_vector1 = 1 ; number_of_grid_points_vector2 = 1 ; number_of_grid_points_vector3 = 5 ; number_of_kpoints = 12 ; my_number_of_kpoints = 2; number_of_reduced_dimensions = 3 ; number_of_spinor_components = 1 ; number_of_spins = 1 ; number_of_symmetry_operations = 4 ; number_of_vectors = 3 ; real_or_complex = 1 ; symbol_length = 2 ; variables: int my_kpoints(my_number_of_kpoints); int number_of_electrons ; char exchange_functional(character_string_length) ; char correlation_functional(character_string_length) ; double fermi_energy ; fermi_energy:units = "Klingon units" ; fermi_energy:scale_to_atomic_units = 0.123 ; char smearing_scheme(character_string_length) ; double smearing_width ; smearing_width:units = "atomic units" ; smearing_width:scale_to_atomic_units = 1. ; int number_of_states(number_of_spins, my_number_of_kpoints) ; double eigenvalues(number_of_spins, my_number_of_kpoints, max_number_of_states) ; eigenvalues:units = "atomic units" ; eigenvalues:scale_to_atomic_units = 1. ; double occupations(number_of_spins, my_number_of_kpoints, max_number_of_states) ; // global attributes: :file_format = "ETSF Nanoquanta" ; :file_format_version = 1.3f ; :Conventions = "http://www.etsf.eu/fileformats/" ; :title = "Test" ; :history = "" ; data: number_of_electrons = 1 ; exchange_functional = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" ; correlation_functional = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" ; fermi_energy = 1 ; smearing_scheme = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" ; smearing_width = 1 ; my_kpoints = 4, 9 ; number_of_states = 4, 9 ; eigenvalues = 25, 26, 27, 28, 29, 30, 31, 32, 65, 66, 67, 68, 69, 70, 71, 72 ; occupations = 25, 26, 27, 28, 29, 30, 31, 32, 65, 66, 67, 68, 69, 70, 71, 72 ; } etsf_io-1.0.3/tests/group_level/test_split_electrons_part1.nc0000644000353400050630000000414010643425670021463 00000000000000CDF character_string_lengthPmax_number_of_angular_momentamax_number_of_coefficientsmax_number_of_projectorsmax_number_of_statesnumber_of_atomsnumber_of_atom_speciesnumber_of_cartesian_directionsnumber_of_componentsnumber_of_grid_points_vector1number_of_grid_points_vector2number_of_grid_points_vector3number_of_kpoints my_number_of_kpointsnumber_of_reduced_dimensionsnumber_of_spinor_componentsnumber_of_spinsnumber_of_symmetry_operationsnumber_of_vectorsreal_or_complex symbol_length  file_formatETSF Nanoquantafile_format_version?¦ff Conventionshttp://www.etsf.eu/fileformats/titleTesthistory my_kpoints Lnumber_of_electronsTexchange_functionalPXcorrelation_functionalP¨ fermi_energy units Klingon unitsscale_to_atomic_units?¿|í‘hr°øsmearing_schemePsmearing_width units atomic unitsscale_to_atomic_units?ðPnumber_of_states X eigenvalues  units atomic unitsscale_to_atomic_units?ð€` occupations €à aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa?ðaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa?ð @9@:@;@<@=@>@?@@@P@@P€@PÀ@Q@Q@@Q€@QÀ@R@9@:@;@<@=@>@?@@@P@@P€@PÀ@Q@Q@@Q€@QÀ@Retsf_io-1.0.3/tests/group_level/test_split_electrons_part2.cdl0000644000353400050630000000477310643425647021646 00000000000000netcdf test_write_electrons { dimensions: character_string_length = 80 ; max_number_of_angular_momenta = 1 ; max_number_of_coefficients = 6 ; max_number_of_projectors = 2 ; max_number_of_states = 8 ; number_of_atoms = 4 ; number_of_atom_species = 1 ; number_of_cartesian_directions = 3 ; number_of_components = 2 ; number_of_grid_points_vector1 = 1 ; number_of_grid_points_vector2 = 1 ; number_of_grid_points_vector3 = 5 ; number_of_kpoints = 12 ; my_number_of_kpoints = 6; number_of_reduced_dimensions = 3 ; number_of_spinor_components = 1 ; number_of_spins = 1 ; number_of_symmetry_operations = 4 ; number_of_vectors = 3 ; real_or_complex = 1 ; symbol_length = 2 ; variables: int my_kpoints(my_number_of_kpoints); int number_of_electrons ; char exchange_functional(character_string_length) ; char correlation_functional(character_string_length) ; double fermi_energy ; fermi_energy:units = "Klingon units" ; fermi_energy:scale_to_atomic_units = 0.123 ; char smearing_scheme(character_string_length) ; double smearing_width ; smearing_width:units = "atomic units" ; smearing_width:scale_to_atomic_units = 1. ; int number_of_states(number_of_spins, my_number_of_kpoints) ; double eigenvalues(number_of_spins, my_number_of_kpoints, max_number_of_states) ; eigenvalues:units = "atomic units" ; eigenvalues:scale_to_atomic_units = 1. ; double occupations(number_of_spins, my_number_of_kpoints, max_number_of_states) ; // global attributes: :file_format = "ETSF Nanoquanta" ; :file_format_version = 1.3f ; :Conventions = "http://www.etsf.eu/fileformats/" ; :title = "Test" ; :history = "" ; data: number_of_electrons = 1 ; exchange_functional = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" ; correlation_functional = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" ; fermi_energy = 1 ; smearing_scheme = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" ; smearing_width = 1 ; my_kpoints = 1, 3, 5, 7, 11, 12 ; number_of_states = 1, 3, 5, 7, 11, 12 ; eigenvalues = 1, 2, 3, 4, 5, 6, 7, 8, 17, 18, 19, 20, 21, 22, 23, 24, 33, 34, 35, 36, 37, 38, 39, 40, 49, 50, 51, 52, 53, 54, 55, 56, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96 ; occupations = 1, 2, 3, 4, 5, 6, 7, 8, 17, 18, 19, 20, 21, 22, 23, 24, 33, 34, 35, 36, 37, 38, 39, 40, 49, 50, 51, 52, 53, 54, 55, 56, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96 ; } etsf_io-1.0.3/tests/group_level/test_split_electrons_part2.nc0000644000353400050630000000520010643425675021467 00000000000000CDF character_string_lengthPmax_number_of_angular_momentamax_number_of_coefficientsmax_number_of_projectorsmax_number_of_statesnumber_of_atomsnumber_of_atom_speciesnumber_of_cartesian_directionsnumber_of_componentsnumber_of_grid_points_vector1number_of_grid_points_vector2number_of_grid_points_vector3number_of_kpoints my_number_of_kpointsnumber_of_reduced_dimensionsnumber_of_spinor_componentsnumber_of_spinsnumber_of_symmetry_operationsnumber_of_vectorsreal_or_complex symbol_length  file_formatETSF Nanoquantafile_format_version?¦ff Conventionshttp://www.etsf.eu/fileformats/titleTesthistory my_kpoints Lnumber_of_electronsdexchange_functionalPhcorrelation_functionalP¸ fermi_energy units Klingon unitsscale_to_atomic_units?¿|í‘hr°smearing_schemePsmearing_width units atomic unitsscale_to_atomic_units?ð`number_of_states h eigenvalues  units atomic unitsscale_to_atomic_units?ð€€ occupations €  aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa?ðaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa?ð ?ð@@@@@@@ @1@2@3@4@5@6@7@8@@€@A@A€@B@B€@C@C€@D@H€@I@I€@J@J€@K@K€@L@T@@T€@TÀ@U@U@@U€@UÀ@V@V@@V€@VÀ@W@W@@W€@WÀ@X?ð@@@@@@@ @1@2@3@4@5@6@7@8@@€@A@A€@B@B€@C@C€@D@H€@I@I€@J@J€@K@K€@L@T@@T€@TÀ@U@U@@U€@UÀ@V@V@@V€@VÀ@W@W@@W€@WÀ@Xetsf_io-1.0.3/tests/group_level/test_split_electrons_part3.cdl0000644000353400050630000000456310643425664021643 00000000000000netcdf test_write_electrons { dimensions: character_string_length = 80 ; max_number_of_angular_momenta = 1 ; max_number_of_coefficients = 6 ; max_number_of_projectors = 2 ; max_number_of_states = 8 ; number_of_atoms = 4 ; number_of_atom_species = 1 ; number_of_cartesian_directions = 3 ; number_of_components = 2 ; number_of_grid_points_vector1 = 1 ; number_of_grid_points_vector2 = 1 ; number_of_grid_points_vector3 = 5 ; number_of_kpoints = 12 ; my_number_of_kpoints = 4; number_of_reduced_dimensions = 3 ; number_of_spinor_components = 1 ; number_of_spins = 1 ; number_of_symmetry_operations = 4 ; number_of_vectors = 3 ; real_or_complex = 1 ; symbol_length = 2 ; variables: int my_kpoints(my_number_of_kpoints); int number_of_electrons ; char exchange_functional(character_string_length) ; char correlation_functional(character_string_length) ; double fermi_energy ; fermi_energy:units = "Klingon units" ; fermi_energy:scale_to_atomic_units = 0.123 ; char smearing_scheme(character_string_length) ; double smearing_width ; smearing_width:units = "atomic units" ; smearing_width:scale_to_atomic_units = 1. ; int number_of_states(number_of_spins, my_number_of_kpoints) ; double eigenvalues(number_of_spins, my_number_of_kpoints, max_number_of_states) ; eigenvalues:units = "atomic units" ; eigenvalues:scale_to_atomic_units = 1. ; double occupations(number_of_spins, my_number_of_kpoints, max_number_of_states) ; // global attributes: :file_format = "ETSF Nanoquanta" ; :file_format_version = 1.3f ; :Conventions = "http://www.etsf.eu/fileformats/" ; :title = "Test" ; :history = "" ; data: number_of_electrons = 1 ; exchange_functional = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" ; correlation_functional = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" ; fermi_energy = 1 ; smearing_scheme = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" ; smearing_width = 1 ; my_kpoints = 2, 6, 8, 10 ; number_of_states = 2, 6, 8, 10 ; eigenvalues = 9, 10, 11, 12, 13, 14, 15, 16, 41, 42, 43, 44, 45, 46, 47, 48, 57, 58, 59, 60, 61, 62, 63, 64, 73, 74, 75, 76, 77, 78, 79, 80 ; occupations = 9, 10, 11, 12, 13, 14, 15, 16, 41, 42, 43, 44, 45, 46, 47, 48, 57, 58, 59, 60, 61, 62, 63, 64, 73, 74, 75, 76, 77, 78, 79, 80 ; } etsf_io-1.0.3/tests/group_level/test_split_electrons_part3.nc0000644000353400050630000000456010643425702021467 00000000000000CDF character_string_lengthPmax_number_of_angular_momentamax_number_of_coefficientsmax_number_of_projectorsmax_number_of_statesnumber_of_atomsnumber_of_atom_speciesnumber_of_cartesian_directionsnumber_of_componentsnumber_of_grid_points_vector1number_of_grid_points_vector2number_of_grid_points_vector3number_of_kpoints my_number_of_kpointsnumber_of_reduced_dimensionsnumber_of_spinor_componentsnumber_of_spinsnumber_of_symmetry_operationsnumber_of_vectorsreal_or_complex symbol_length  file_formatETSF Nanoquantafile_format_version?¦ff Conventionshttp://www.etsf.eu/fileformats/titleTesthistory my_kpoints Lnumber_of_electrons\exchange_functionalP`correlation_functionalP° fermi_energy units Klingon unitsscale_to_atomic_units?¿|í‘hr°smearing_schemePsmearing_width units atomic unitsscale_to_atomic_units?ðXnumber_of_states ` eigenvalues  units atomic unitsscale_to_atomic_units?ðp occupations p aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa?ðaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa?ð @"@$@&@(@*@,@.@0@D€@E@E€@F@F€@G@G€@H@L€@M@M€@N@N€@O@O€@P@R@@R€@RÀ@S@S@@S€@SÀ@T@"@$@&@(@*@,@.@0@D€@E@E€@F@F€@G@G€@H@L€@M@M€@N@N€@O@O€@P@R@@R€@RÀ@S@S@@S€@SÀ@Tetsf_io-1.0.3/tests/group_level/tests_run.sh0000744000353400050620000000011710643441155016140 00000000000000#!/bin/sh if `grep -qs "Failed" tests_*.log`; then exit 1 else exit 0 fi etsf_io-1.0.3/tests/utils/0000777000353400050620000000000011354151526012457 500000000000000etsf_io-1.0.3/tests/utils/Makefile.am0000644000353400050620000000273411354120503014424 00000000000000EXTRA_DIST = \ si1002x1-o_DS1_DEN-etsf.nc \ si1002x1-o_DS1_DEN-etsf.ref \ wfs_complex-etsf.nc \ wfs_complex-etsf.ref \ wfs_real-etsf.nc \ wfs_real-etsf.ref TESTS = runSi runRspc1 runRspc2 CLEANFILES = si1002x1-o_DS1_DEN-etsf.log wfs_complex-etsf.log wfs_real-etsf.log \ runSi runRspc1 runRspc2 #additional rules runSi: si1002x1-o_DS1_DEN-etsf.nc si1002x1-o_DS1_DEN-etsf.ref echo "#!/bin/sh" > runSi; chmod u+x runSi echo "$(top_builddir)/src/utils/etsf_io -a content $(srcdir)/si1002x1-o_DS1_DEN-etsf.nc | grep '^ - ' > si1002x1-o_DS1_DEN-etsf.log" >> runSi echo 'diff=`diff $(srcdir)/si1002x1-o_DS1_DEN-etsf.ref si1002x1-o_DS1_DEN-etsf.log`' >> runSi echo "if test -z \"\$$diff\" ; then exit 0; else exit 1; fi" >> runSi runRspc1: wfs_complex-etsf.nc wfs_complex-etsf.ref echo "#!/bin/sh" > runRspc1; chmod u+x runRspc1 echo "$(top_builddir)/src/utils/etsf_io -a content $(srcdir)/wfs_complex-etsf.nc | grep '^ - ' > wfs_complex-etsf.log" >> runRspc1 echo 'diff=`diff $(srcdir)/wfs_complex-etsf.ref wfs_complex-etsf.log`' >> runRspc1 echo "if test -z \"\$$diff\" ; then exit 0; else exit 1; fi" >> runRspc1 runRspc2: wfs_real-etsf.nc wfs_real-etsf.ref echo "#!/bin/sh" > runRspc2; chmod u+x runRspc2 echo "$(top_builddir)/src/utils/etsf_io -a content $(srcdir)/wfs_real-etsf.nc | grep '^ - ' > wfs_real-etsf.log" >> runRspc2 echo 'diff=`diff $(srcdir)/wfs_real-etsf.ref wfs_real-etsf.log`' >> runRspc2 echo "if test -z \"\$$diff\" ; then exit 0; else exit 1; fi" >> runRspc2 etsf_io-1.0.3/tests/utils/Makefile.in0000644000353400050620000002722311354150421014437 00000000000000# Makefile.in generated by automake 1.10.1 from Makefile.am. # @configure_input@ # Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, # 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. # This Makefile.in is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY, to the extent permitted by law; without # even the implied warranty of MERCHANTABILITY or FITNESS FOR A # PARTICULAR PURPOSE. @SET_MAKE@ VPATH = @srcdir@ pkgdatadir = $(datadir)/@PACKAGE@ pkglibdir = $(libdir)/@PACKAGE@ pkgincludedir = $(includedir)/@PACKAGE@ am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd install_sh_DATA = $(install_sh) -c -m 644 install_sh_PROGRAM = $(install_sh) -c install_sh_SCRIPT = $(install_sh) -c INSTALL_HEADER = $(INSTALL_DATA) transform = $(program_transform_name) NORMAL_INSTALL = : PRE_INSTALL = : POST_INSTALL = : NORMAL_UNINSTALL = : PRE_UNINSTALL = : POST_UNINSTALL = : subdir = tests/utils DIST_COMMON = $(srcdir)/Makefile.am $(srcdir)/Makefile.in ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 am__aclocal_m4_deps = $(top_srcdir)/config/m4/fortran.m4 \ $(top_srcdir)/configure.ac am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ $(ACLOCAL_M4) mkinstalldirs = $(install_sh) -d CONFIG_CLEAN_FILES = SOURCES = DIST_SOURCES = DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) ACLOCAL = @ACLOCAL@ AMTAR = @AMTAR@ AR = @AR@ AUTOCONF = @AUTOCONF@ AUTOHEADER = @AUTOHEADER@ AUTOMAKE = @AUTOMAKE@ AWK = @AWK@ CYGPATH_W = @CYGPATH_W@ DEFS = @DEFS@ ECHO_C = @ECHO_C@ ECHO_N = @ECHO_N@ ECHO_T = @ECHO_T@ EXEEXT = @EXEEXT@ FC = @FC@ FCFLAGS = @FCFLAGS@ FCFLAGS_f90 = @FCFLAGS_f90@ FFLAGS = @FFLAGS@ INSTALL = @INSTALL@ INSTALL_DATA = @INSTALL_DATA@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ INSTALL_SCRIPT = @INSTALL_SCRIPT@ INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ LDFLAGS = @LDFLAGS@ LIBOBJS = @LIBOBJS@ LIBS = @LIBS@ LTLIBOBJS = @LTLIBOBJS@ MAKEINFO = @MAKEINFO@ MKDIR_P = @MKDIR_P@ MODULE_EXT = @MODULE_EXT@ NETCDF_CFLAGS = @NETCDF_CFLAGS@ OBJEXT = @OBJEXT@ PACKAGE = @PACKAGE@ PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ PACKAGE_NAME = @PACKAGE_NAME@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_VERSION = @PACKAGE_VERSION@ PATH_SEPARATOR = @PATH_SEPARATOR@ RANLIB = @RANLIB@ SET_MAKE = @SET_MAKE@ SHELL = @SHELL@ STRIP = @STRIP@ VERSION = @VERSION@ abs_builddir = @abs_builddir@ abs_srcdir = @abs_srcdir@ abs_top_builddir = @abs_top_builddir@ abs_top_srcdir = @abs_top_srcdir@ ac_ct_FC = @ac_ct_FC@ am__leading_dot = @am__leading_dot@ am__tar = @am__tar@ am__untar = @am__untar@ bindir = @bindir@ build_alias = @build_alias@ builddir = @builddir@ datadir = @datadir@ datarootdir = @datarootdir@ docdir = @docdir@ dvidir = @dvidir@ exec_prefix = @exec_prefix@ fc_type = @fc_type@ fc_version = @fc_version@ fc_wrap = @fc_wrap@ groupleveldocdir = @groupleveldocdir@ host_alias = @host_alias@ htmldir = @htmldir@ includedir = @includedir@ infodir = @infodir@ install_sh = @install_sh@ libdir = @libdir@ libexecdir = @libexecdir@ localedir = @localedir@ localstatedir = @localstatedir@ lowleveldocdir = @lowleveldocdir@ mandir = @mandir@ mkdir_p = @mkdir_p@ moduledir = @moduledir@ oldincludedir = @oldincludedir@ pdfdir = @pdfdir@ prefix = @prefix@ program_transform_name = @program_transform_name@ psdir = @psdir@ sbindir = @sbindir@ sharedstatedir = @sharedstatedir@ srcdir = @srcdir@ sysconfdir = @sysconfdir@ target_alias = @target_alias@ top_builddir = @top_builddir@ top_srcdir = @top_srcdir@ tutorialsdocdir = @tutorialsdocdir@ utilsdocdir = @utilsdocdir@ EXTRA_DIST = \ si1002x1-o_DS1_DEN-etsf.nc \ si1002x1-o_DS1_DEN-etsf.ref \ wfs_complex-etsf.nc \ wfs_complex-etsf.ref \ wfs_real-etsf.nc \ wfs_real-etsf.ref TESTS = runSi runRspc1 runRspc2 CLEANFILES = si1002x1-o_DS1_DEN-etsf.log wfs_complex-etsf.log wfs_real-etsf.log \ runSi runRspc1 runRspc2 all: all-am .SUFFIXES: $(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) @for dep in $?; do \ case '$(am__configure_deps)' in \ *$$dep*) \ cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh \ && exit 0; \ exit 1;; \ esac; \ done; \ echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu tests/utils/Makefile'; \ cd $(top_srcdir) && \ $(AUTOMAKE) --gnu tests/utils/Makefile .PRECIOUS: Makefile Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status @case '$?' in \ *config.status*) \ cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ *) \ echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ esac; $(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh $(top_srcdir)/configure: $(am__configure_deps) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh $(ACLOCAL_M4): $(am__aclocal_m4_deps) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh tags: TAGS TAGS: ctags: CTAGS CTAGS: check-TESTS: $(TESTS) @failed=0; all=0; xfail=0; xpass=0; skip=0; ws='[ ]'; \ srcdir=$(srcdir); export srcdir; \ list=' $(TESTS) '; \ if test -n "$$list"; then \ for tst in $$list; do \ if test -f ./$$tst; then dir=./; \ elif test -f $$tst; then dir=; \ else dir="$(srcdir)/"; fi; \ if $(TESTS_ENVIRONMENT) $${dir}$$tst; then \ all=`expr $$all + 1`; \ case " $(XFAIL_TESTS) " in \ *$$ws$$tst$$ws*) \ xpass=`expr $$xpass + 1`; \ failed=`expr $$failed + 1`; \ echo "XPASS: $$tst"; \ ;; \ *) \ echo "PASS: $$tst"; \ ;; \ esac; \ elif test $$? -ne 77; then \ all=`expr $$all + 1`; \ case " $(XFAIL_TESTS) " in \ *$$ws$$tst$$ws*) \ xfail=`expr $$xfail + 1`; \ echo "XFAIL: $$tst"; \ ;; \ *) \ failed=`expr $$failed + 1`; \ echo "FAIL: $$tst"; \ ;; \ esac; \ else \ skip=`expr $$skip + 1`; \ echo "SKIP: $$tst"; \ fi; \ done; \ if test "$$failed" -eq 0; then \ if test "$$xfail" -eq 0; then \ banner="All $$all tests passed"; \ else \ banner="All $$all tests behaved as expected ($$xfail expected failures)"; \ fi; \ else \ if test "$$xpass" -eq 0; then \ banner="$$failed of $$all tests failed"; \ else \ banner="$$failed of $$all tests did not behave as expected ($$xpass unexpected passes)"; \ fi; \ fi; \ dashes="$$banner"; \ skipped=""; \ if test "$$skip" -ne 0; then \ skipped="($$skip tests were not run)"; \ test `echo "$$skipped" | wc -c` -le `echo "$$banner" | wc -c` || \ dashes="$$skipped"; \ fi; \ report=""; \ if test "$$failed" -ne 0 && test -n "$(PACKAGE_BUGREPORT)"; then \ report="Please report to $(PACKAGE_BUGREPORT)"; \ test `echo "$$report" | wc -c` -le `echo "$$banner" | wc -c` || \ dashes="$$report"; \ fi; \ dashes=`echo "$$dashes" | sed s/./=/g`; \ echo "$$dashes"; \ echo "$$banner"; \ test -z "$$skipped" || echo "$$skipped"; \ test -z "$$report" || echo "$$report"; \ echo "$$dashes"; \ test "$$failed" -eq 0; \ else :; fi distdir: $(DISTFILES) @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ list='$(DISTFILES)'; \ dist_files=`for file in $$list; do echo $$file; done | \ sed -e "s|^$$srcdirstrip/||;t" \ -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ case $$dist_files in \ */*) $(MKDIR_P) `echo "$$dist_files" | \ sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ sort -u` ;; \ esac; \ for file in $$dist_files; do \ if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ if test -d $$d/$$file; then \ dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ cp -pR $(srcdir)/$$file $(distdir)$$dir || exit 1; \ fi; \ cp -pR $$d/$$file $(distdir)$$dir || exit 1; \ else \ test -f $(distdir)/$$file \ || cp -p $$d/$$file $(distdir)/$$file \ || exit 1; \ fi; \ done check-am: all-am $(MAKE) $(AM_MAKEFLAGS) check-TESTS check: check-am all-am: Makefile installdirs: install: install-am install-exec: install-exec-am install-data: install-data-am uninstall: uninstall-am install-am: all-am @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am installcheck: installcheck-am install-strip: $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ `test -z '$(STRIP)' || \ echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install mostlyclean-generic: clean-generic: -test -z "$(CLEANFILES)" || rm -f $(CLEANFILES) distclean-generic: -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) maintainer-clean-generic: @echo "This command is intended for maintainers to use" @echo "it deletes files that may require special tools to rebuild." clean: clean-am clean-am: clean-generic mostlyclean-am distclean: distclean-am -rm -f Makefile distclean-am: clean-am distclean-generic dvi: dvi-am dvi-am: html: html-am info: info-am info-am: install-data-am: install-dvi: install-dvi-am install-exec-am: install-html: install-html-am install-info: install-info-am install-man: install-pdf: install-pdf-am install-ps: install-ps-am installcheck-am: maintainer-clean: maintainer-clean-am -rm -f Makefile maintainer-clean-am: distclean-am maintainer-clean-generic mostlyclean: mostlyclean-am mostlyclean-am: mostlyclean-generic pdf: pdf-am pdf-am: ps: ps-am ps-am: uninstall-am: .MAKE: install-am install-strip .PHONY: all all-am check check-TESTS check-am clean clean-generic \ distclean distclean-generic distdir dvi dvi-am html html-am \ info info-am install install-am install-data install-data-am \ install-dvi install-dvi-am install-exec install-exec-am \ install-html install-html-am install-info install-info-am \ install-man install-pdf install-pdf-am install-ps \ install-ps-am install-strip installcheck installcheck-am \ installdirs maintainer-clean maintainer-clean-generic \ mostlyclean mostlyclean-generic pdf pdf-am ps ps-am uninstall \ uninstall-am #additional rules runSi: si1002x1-o_DS1_DEN-etsf.nc si1002x1-o_DS1_DEN-etsf.ref echo "#!/bin/sh" > runSi; chmod u+x runSi echo "$(top_builddir)/src/utils/etsf_io -a content $(srcdir)/si1002x1-o_DS1_DEN-etsf.nc | grep '^ - ' > si1002x1-o_DS1_DEN-etsf.log" >> runSi echo 'diff=`diff $(srcdir)/si1002x1-o_DS1_DEN-etsf.ref si1002x1-o_DS1_DEN-etsf.log`' >> runSi echo "if test -z \"\$$diff\" ; then exit 0; else exit 1; fi" >> runSi runRspc1: wfs_complex-etsf.nc wfs_complex-etsf.ref echo "#!/bin/sh" > runRspc1; chmod u+x runRspc1 echo "$(top_builddir)/src/utils/etsf_io -a content $(srcdir)/wfs_complex-etsf.nc | grep '^ - ' > wfs_complex-etsf.log" >> runRspc1 echo 'diff=`diff $(srcdir)/wfs_complex-etsf.ref wfs_complex-etsf.log`' >> runRspc1 echo "if test -z \"\$$diff\" ; then exit 0; else exit 1; fi" >> runRspc1 runRspc2: wfs_real-etsf.nc wfs_real-etsf.ref echo "#!/bin/sh" > runRspc2; chmod u+x runRspc2 echo "$(top_builddir)/src/utils/etsf_io -a content $(srcdir)/wfs_real-etsf.nc | grep '^ - ' > wfs_real-etsf.log" >> runRspc2 echo 'diff=`diff $(srcdir)/wfs_real-etsf.ref wfs_real-etsf.log`' >> runRspc2 echo "if test -z \"\$$diff\" ; then exit 0; else exit 1; fi" >> runRspc2 # Tell versions [3.59,3.63) of GNU make to not export all variables. # Otherwise a system limit (for SysV at least) may be exceeded. .NOEXPORT: etsf_io-1.0.3/tests/utils/si1002x1-o_DS1_DEN-etsf.nc0000644000353400050620000022051011211472473016433 00000000000000CDF character_string_lengthPmax_number_of_angular_momentamax_number_of_coefficients¶max_number_of_projectorsmax_number_of_states3number_of_atomsnumber_of_atom_speciesnumber_of_cartesian_directionsnumber_of_componentsnumber_of_grid_points_vector1(number_of_grid_points_vector2number_of_grid_points_vector3 number_of_kpointsnumber_of_localization_regionsnumber_of_reduced_dimensionsnumber_of_spinor_componentsnumber_of_spinsnumber_of_symmetry_operationsnumber_of_vectorsreal_or_complex_density symbol_lengthnpsp codvsnlen rhoijdim1 psptitlen„  file_formatETSF Nanoquantafile_format_version@ff Conventionshttp://www.etsf.eu/fileformats/title Density filehistory%File generated by ABINIT with ETSF_IO 5 space_groupäprimitive_vectorsHèreduced_symmetry_matrices  symmorphicyes0reduced_symmetry_translations`À atom_species` reduced_atom_positions@€valence_chargesÀatomic_numbersÈatom_species_namesPÐchemical_symbols pseudopotential_typesP$number_of_electronst fermi_energy units atomic unitsscale_to_atomic_units?ðxsmearing_schemeP€smearing_width units atomic unitsscale_to_atomic_units?ðÐnumber_of_states Ø eigenvalues  units atomic unitsscale_to_atomic_units?ð`è occupations `Hreduced_coordinates_of_kpoints ` ¨kpoint_weights  ! basis_setP!(kinetic_energy_cutoff units atomic unitsscale_to_atomic_units?ð!xnumber_of_coefficients  k_dependentyes!€date!codvsn!”ecut_eff!œecutsm!¤etot!¬headform!´fform!¸intxc!¼ixc!Àoccopt!Äpertcase!Èresidm!Ìstmbias!Ôtphysel!Ütsmear!äecutdg!ìusepaw!ôpspcod!øpspdat!üpspso"pspxc"qptn"so_psp" symafm"$title„"4znuclpsp"¸lmn_size"Àrhoij€"Äusewvl'Ddensity  units atomic unitsscale_to_atomic_units?ðú'H @>æ$Ý/ @,Ë'»/ì@Ë'»/ìÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ¿¿ ©„×I¿Ø¿¿ ©„×I?À¿¥ÆX†¿Ø?à¿¥ÆX†?À?à?¥ÆX†¿À?à?¥ÆX†?Ø?à?¿ ©„×I¿À?¿ ©„×I?Ø¿Ý…Fuðâ¿ÔQ]»ë¿ÚµñZc(¿ ûÍ>™ÑC¿Ø‡f`-¿×Bc~o?à¿×Ü›Öeâ\?¼¨£¢°‘>?à¿ÒúDyv² ?Ø%²ùç–?à¿Ò ‚däb¿Á[E¥ÚÏé?à¿Êò´rÄ_?×óIÇ ¿ÉÒ ˜SÙq¿¿æYOʯ?Êò´rÄ_¿×óIÇ ?ÉÒ ˜SÙq?¿æYOʯ?ÒúDyv² ¿Ø%²ùç–?à?Ò ‚däb?Á[E¥ÚÏé?à?؇f`-?×Bc~o?à?×Ü›Öeâ\¿¼¨£¢°‘>?à?Ý…Fuðâ?ÔQ]»ë?ÚµñZc(? ûÍ>™ÑC@@,SiSiSilicon, fhi98PP : BHS-type, LDA PZ, l=2 local`?ÍœõëeÝ•none?¤záG®{3333GžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGž@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@?À?À?À?Ø?Ø?À?Ø?Ø?Ð?Ð?Ð?Ðplane_waves@¶°³ª2Žë5.9.0@ÀWLWµ×?’,4>þÔ"áâ?¤záG®{@%œSilicon, fhi98PP : BHS-type, LDA PZ, l=2 local @,GžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGžGž?sõå]Ú?|tÐuƒiå?‹f kxä?—3È&,?¢"óÆCO?®fÚrºò?µq]óá“m?µx'÷z“m?®'P'_?¢@vò¢Ù²?—<èwšØÕ?‹ª_Å2Zl?ñŒ£Át?‹~t¹0®? cüºŽ?¥6-n=4?¤ 4Hpb?¡3‹“àÑÒ?¢U¿ß)¡}?¤ $Ë<°?¤Bæ–×÷ª?¤ $Ë<°?¢U¿ß)¡|?¡3‹“àÑÐ?¤ 4Hpc?¥6-n=3? cüº?‹~t¹0ª?ñŒ£Ásÿ?‹ª_Å2Zg?—<èwšØÓ?¢@vò¢Ù°?®'P'_œ?µx'÷z“n?µq]óá“m?®fÚrºò?¢"óÆCQ?—3È&1?‹f kxí?|tÐuƒiè?vF“­wEÂ?qƒ°lô?yK›Ä³=¦?‡µ’|–g?™3xíüm?©3‹›yp?²Gq>9‚?±fÝ6Ý÷6?¨öõDnÛ?¤pç®êK?¢¤ÉŽTh?™£ž}·¤ž?ŒÀÁ Е¼?Ìbö6·?š­Ím„?8?¢bcJ¡$²?¢ |ÓUþ?¢~2ÿ?¦3¸q§‡?¦±¤½=g¬?£Q´?¡ ÍÉ‚ïI?¡uÛ±áÄ?¤iׇË9g?¨9}[‰‡?¦SÕÛ‡³‘?›ƒ}‰‹Åò?‡#öô`[¾?v8üŘ{?yÈ«´Fv?‡Õ¡)|Œ?™`ÛÀ$~?©\ló¬v?²]Nf5Å?±rù‡ È½?¨àÎfð?¤=+ÿÑå?¢*~œ5?™hÏìÅ8?ˆDäÛ-×?z! ³ûÃ?l°ÿ¹MÆ?l¤s’ÌØ?y_ëNž»?)´¯²/’?¢hðvEd?©òFØ µZ?¦\ø™…S¬? PHg´ª?£œ{½1?§¼¿ãMZ?¡Þj[ó”?’ÐD«ùèé?ŒôêhÈ?—Ì>"õG?¡ýøV  ?§°Øœ›ú†?­” £œ?°:\ïi¯?«4 8•?¢5|–ú…?š^± ;¤²?› ÿœ ÃŽ?¡·ë‚æ?¤k7Ç›Q?¡i¦ôàÁÄ?”- 1šfú?€ûì ë?pä´„±?mÆ·Óu®?zY8„ÆZ?êxæÐÂ?¢E‘#Büz?ª ðå¶C?¦tÍŸ‚³q? ]”=Å$?£kõ)Ô›n?§{™`95;?¡U³SŽÓ?©Ï¸ ?z<½°|D?l»\³•ñ?lÀiÀÒ?yŒ§m“ˆ?HZKfeÞ?¢0¤Ç.X?ª–”öö ?¦cBzá€9? ¼¾ ?£Ì ·âZ?¨&W»ôè2?¢(J]ÊÜ?’Z%4q#?‡—W`cŸ?’ß–qq?¡PòCßù?­.vm£]?³Å/sñÛZ?´Sn‹£!¯?¯Ÿ­v?¢âøõìú¶?–^Ã3â#?’q»Â`ô?”ži" v¾?–ÄŸ`ù@?’þ ϤÄ?†ÇÄÜ‚?vÓw„¼d|?m+š æC˜?p/Ç,m„?})`/ó½ñ?‘ˆ6>q?¢„Ô.Ìž½?©š}ÔdC*?¥­s}£?ª!(ò{¾? Ã½)`-?—(ýXa?Œà:ì?}åÿÜŸŸ?vhMÎtG?ˆK‰­ÿ¤ž?™^ÖkgeG?¢ˆÊ?:_×?¤Px”r¥©?©OMÒE€?±ll+P3?²)ÅhB>?¨Ù1·$ùð?˜òÜvY7?ˆ0J¹f¶?zwm¬£g?qôžÔ_©?tx¥3?…‚«dÏ?™;)¶X"?¤Þ›z¡a…?¥,—-Jçb? Ü»Žv?¤ NxÅ?©[ê1®¢?£ÛŠh[ø?“HÚ™.>¸?| 0„¡@?jû!ªRe`?g©ò2–¥T?nn¥•‡˜â?}/CgHø?Ñ v X?žêщڢù?£óhE?¤fA·Ã•,?ªBȯ•rý?±T ò”?°UѾöÓŒ?¤á†u ?•I¥s|ðI?†CÙ1<ç2?y\6~üIð?q±ƶ”Ê?zA)aœˆè?¶¢ˆˆÍ³?¡œí1jÄF?§sËÿÝ?£rK¦|i ? 2Ên‘?¦bYl=“?©½bÏ3ð?¡ðxÏŠ³?7èÏ»?yøˆLž†{?m7 ¹sy?kBZñhz?t \!3T?†i} U±?™KÍZÕjG?¤²BoÕia?¥³å¤ßO"?¢äþŠMá"?¦wtâ'4Ï?ªC2óõp?£í×g}@Ž?’Ìì”6s?z´¡œ[¤€?iCE¬ÑÐ?fS”58”?pvAhÍQ?‚ë¥ÈŒö?—d;­Ò™?¤Æ$(ßY"?¦Ô\TåÞF?¡J­•b›?¡T3à†À?¨#û2?§É3’âr·?œûÀÕß?‰Ð5Õ£?vH;Ïhd?kþ™=Ý?l·÷²žòo?zaª°$?Þ‰Ñ$”€?¡ÒŒÅ•Ò?§É¾°ƒÙ#?£¡3ƒØÁ?Ÿ…ßL¾‰?¥zCÍquu?©A(ù¹?¢5“ƒæWÔ?‘,¿÷þ‚d?|\±{ŸÇç?o%ÛP{f?já Nsß?ra 'Å&B?‚J“½GØÛ?“ê-Y? ëE®ß3D?¤cY8»ZÏ?¥—®]˜B?§loˆº…±?§†7?zˆ¦? n]€ÙÈ3?Ž›õGæJÊ?wfåaÄH`?h’XžK|p?fÁ°iBv?pÜÆò˜™¨?ƒ'0›G‰?—uQw#î?¤Äp°uŸ ?¦Ôy÷Ú1?¡c(²·¡?¡~ϲmU?¨>.•°-,?§Ê6Ü•2$?œï¼¹éZZ?‰íƒ b?v3Zyþøþ?l#%p磰?lÉSÁ’y?v©m¸½¤×?ˆâL4hÕs?š"Žmæy?£ce‰ÞÞ?¤Íùز?¦ÎrÞÏ÷Ú?¯¡ôB«ëM?±kõJˆ¨?©³¢˜&§‹?›²0¦Ò?‹Ü׃Ζ]?~¡!oË—ó?s%rÌ8‹?qIŽÕÔ?y"_Ye¨?‡T&Ö¥r¸?” CK[3?›‚§@éÚ? k+’?¢å“S{?¡Þ´µS¥d?™aÒ £U?‹7eа¥6?{C¿3äë¢?pvOÂ?k#1Å–G¸?p<ÂÉÒ?}ð´òÚ ?ßÕcÓsÜ?žÌøº@ï—?£mû)d‚?¤w-}vBí?ªm¹ÝŽå?±X]›?°Cz<æa?¤¿ž­#R?•9,-•è?†cùµÂºä?y˜RM?qÎâv}P_?t\#+-0 ?}AïäùË?ŒA˜ZÀ–?—AeÃ]Z? ²;-­ºƒ?©ÞÌ܇ÑP?²úƒM¶}?´|åýda?¯r¤,7?£©ƒªƒp‚?šNŽ3?‘&çaþÜ?‚i°g~ül?tײ­ÀVí?qÚ ÈwýŽ?w~Daü?é¡H[P?‹zˆlF?“{×L Þ?šW®qûÓØ?Ê”yhxP?šW®qûÓÜ?“{×L ã?‹zˆlR?é¡H[c?w~Db?qÚ Èwý?tײ­ÀVÜ?‚i°g~üa?‘&çaþ×?šNŽ3}?£©ƒªƒp€?¯r¤,6?´|åýd`?²úƒM¶}?©ÞÌ܇ÑP? ²;-­º‡?—AeÃ]a?ŒA˜ZÀ¡?}AïäùÒ?v©m¸½¤Ú?qÎâv}P^?y˜R>?†cùµÂºÝ?•9,-•è?¤¿ž­#Q?°Cz<æ`?±X]›?ªm¹ÝŽã?¤w-}vBí?£mû)d‚?žÌøº@ïž?ßÕcÓsâ?}ð´òÚ2?p<ÂÉÐ?k#1Å–G¸?pvOÂt?{C¿3äëˆ?‹7eа¥'?™aÒ £P?¡Þ´µS¥d?¢å“S}? k+’ï™–?›‚§@éÚ–?” CK[3"?‡T&Ö¥rÀ?y"_Ye¸?qIŽÕÐ?s%rÌ8?~¡!oË—î?‹Ü׃ΖV?›²0¦Ì?©³¢˜&§ˆ?±kõJˆ§?¯¡ôB«ëN?¦ÎrÞÏ÷Ù?¤Íùز?£ce‰Þà?š"Žmæ‚?ˆâL4hÕy?zaª°$?lÉSÁ’y?l#%p磰?v3Zyþøý?‰íƒ S?œï¼¹éZY?§Ê6Ü•2"?¨>.•°-,?¡~ϲmU?¡c(²· ?¦Ôy÷Ú2?¤Äp°uŸ ?—uQw#ñ?ƒ'0›G?pÜÆò˜™°?fÁ°iBv?h’XžK|`?wfåaÄHT?Ž›õGæJÊ? n]€ÙÈ2?§†7?zˆ¥?§loˆº…±?¥—®]˜C?¤cY8»ZÐ? ëE®ß3G?“ê-Y?‚J“½GØä?ra 'Å&B?já NsÚ?o%ÛP{r?|\±{ŸÇÖ?‘,¿÷þ‚^?¢5“ƒæWÒ?©A(ù¹?¥zCÍqus?Ÿ…ßL¾‡?£¡3ƒØÂ?§É¾°ƒÙ!?¡ÒŒÅ•Õ?Þ‰Ñ$”ƒ?zA)aœˆì?l·÷²žòƒ?kþ™=î?vH;Ïh`?‰Ð5Õž?œûÀÕÛ?§É3’âr¸?¨#û2?¡T3à†À?¡J­•b›€?¦Ô\TåÞD?¤Æ$(ßY$?—d;­Ò˜?‚ë¥ÈŒö ?pvAhÍQ?fS”58˜?iCE¬ÑÐ?z´¡œ[¤x?’Ìì”6l?£í×g}@Œ?ªC2óõp?¦wtâ'4Î?¢äþŠMá"?¥³å¤ßO#?¤²BoÕib?™KÍZÕjH?†i} U¶?t \!3L?kBZñhx?m7 ¹sg?yøˆLž†?7èÏ»|?¡ðxÏŠ³?©½bÏ3ð?¦bYl=“? 2Ên?£rK¦|i ?§sËÿÝ?¡œí1jÄF?¶¢ˆˆÍµ?vhMÎtG?q±ƶ”Ô?y\6~üIò?†CÙ1<ç5?•I¥s|ðF?¤á†u ?°UѾöÓ‹?±T ò•?ªBȯ•rü?¤fA·Ã•,?£óhC?žêщڢû?Ñ v X?}/CgHø’?nn¥•‡˜â?g©ò2–¥d?jû!ªRe`?| 0„¡P?“HÚ™.>±?£ÛŠh[ø?©[ê1®£?¤ NxÅ? Ü»Žv?¥,—-Jçd?¤Þ›z¡aˆ?™;)¶X"?…‚«dÏ?tx¥3?qôžÔ_©?zwm¬£R?ˆ0J¹fº?˜òÜvY7?¨Ù1·$ùð?²)ÅhB>?±ll+P3?©OMÒE€?¤Px”r¥©?¢ˆÊ?:_Ô?™^ÖkgeG?ˆK‰­ÿ¤œ?t$õý‚‹%?}åÿÜŸ¦?Œà:ë?—(ýXc? Ã½)`.?ª!(ò{¾?³.¥7²>¢?´©Öñ Õç?¯K–¢[*?£Ö‰HüÑ ?š«„[ÉÊ?‘B×ÃÐ"n?‚ÝÞA±?t}¼Ð$—3?p%  ¡4w?pGšµàB?rx§2È?|w1˜0 ?lŸl«b? †ˆ¼šI¦?¦®¸ªâ?§%Í·« ?¨M24,Žv?ªý0òá ¶?¦ž|2b/ ?˜â‡ÍÒMR?„ȱ}v¼Ê?whüHÕ1õ?~œÓ–4k?,¿”¨y?˜'óÖ²­œ?¢4%+ /?­¢nJ Ÿ?µLl‘3»û?µ{¨ãÄ?®@pþ@D?¢FB–/ ?—D˃òo=?‹f•¥û~?|~lQS?vbƒM ?ˆ°$­ã?™ùª‡ó¬y?¢ù=òE ¥?¤ÉÒ7q?§#•6¥þ?° o¯?±«ºUGÇ–?ªmÏ7ž?œ5ãWBác?ŒŽ#áÈ?’‹(uÔ?s»kvl©¾?qàõ„õÔÒ?wñßÓÛ~?€„IxZÙ?ƒ ¨_"ü?„\»œá¶?ŒªMTØ}c?™d(›ˆ&?¤®IEt0?­Zë@`RŽ?²[ø•0Ôç?²”dy×&á?«‚‡ „bD?.³ßô?‰´Ÿ»Ï‘ˆ?€krrP© ?Š{:ŸO¾µ?š¿áŽŸ«?£iÐäç7ý?¤°“»Ù ?¨¶úQ;¿õ?±[ÒŒÁ¤?²f (½Ü¤?©x¼¤žW?™|žÃõˆ?‡é‰œ!~?yh#÷9Êè?qUˆö?z<½°|@?ÆHÙTÛ?¡Å•1¸­ˆ?§Ç)cƒÊÛ?£¤³€?Ÿ›Ù-?¥­s}q?})`/ó½í?p/Ç,m„?m+š æC–?vÓw„¼d‚?†ÇÄÜ…?’þ ϤÅ?–ÄŸ`ùF?”ži" vÀ?’q»Â`ó?–^Ã3â"?¢âøõìú¶?¯Ÿ­t?´Sn‹£!®?³Å/sñÛY?­.vm£]?¡PòCßù?’ß–qt?‡—W`c¤?’Z%4q# ?¢(J]ÊÚ?¨&W»ôè4?£Ì ·âY? ¼¾ ?¦cBzá€7?ª–”öö ?¢0¤Ç.X?HZKfeÚ?yŒ§m“„?lÀiÀÃ?l»\³•é?z! ³û¿?©Ï¸ ?¡U³SŽÐ?§{™`95=?£kõ)Ô›m? ]”=Å%?¦tÍŸ‚³s?ª ðå¶C?¢E‘#Bü|?êxæÐÄ?zY8„Æi?mÆ·ÓuŠ?pä´„±?€ûì ë?”- 1šfø?¡i¦ôàÁÄ?¤k7Ç›T?¡·ë‚ç?› ÿœ ÃŒ?š^± ;¤²?¢5|–ú…?«4 8•?°:\ïi­?­” £š?§°Øœ›ú†?¡ýøV  ?—Ì>"õJ?ŒôêhË?’ÐD«ùèè?¡Þj[ó’?§¼¿ãMY?£œ{½1? PHg´¬?¦\ø™…S®?©òFØ µX?¢hðvEc?)´¯²/•?y_ëNž²?l¤s’ÌØ?l°ÿ¹M±?vF“­wE¿?ˆDäÛ-Ñ?™hÏìÅ8‡?¢*~œ5?¤=+ÿÑå?¨àÎfðŽ?±rù‡ È¾?²]Nf5Æ?©\ló¬w?™`ÛÀ$„?‡Õ¡)|“?yÈ«´Fq?v8üŘ?‡#öô`[»?›ƒ}‰‹Åî?¦SÕÛ‡³“?¨9}[‰‰?¤iׇË9j?¡uÛ±áÅ?¡ ÍÉ‚ïK?£Q²?¦±¤½=gª?¦3¸q§†?¢~2ÿ?¢ |ÓUþ?¢bcJ¡$°?š­Ím„?8?Ìbö6´?ŒÀÁ Е°?™£ž}·¤™?¢¤ÉŽTg?¤pç®êK?¨öõDnÝ?±fÝ6Ý÷8?²Gq>9?©3‹›yp€?™3xíüq?‡µ’|–g?yK›Ä³=³?qƒ°lï?€Vx^¢¬?„dxT—÷¨?¡rq)²?™xª;²?¡ÛÙ\úÉš?ª¾]ùÚæw?²TÚšè?²Z¨ ÷'?ªÒ¨™^’æ?¡Ô¾t„Ã?™ ¿øªo?QʼW¤?‡VŠr2ù?‘Îðÿ?¡`|Êj?©·TÙùV?ªŠKÖþИ?¦Zß¾•×Ó?£¦º˜0Õ?¢H¹Í4Æ?¡æ؃!*?¢H¹Í4Æ?£¦º˜0Õ?¦Zß¾•×Ò?ªŠKÖþЙ?©·TÙùV?¡`|Êl?‘Îðÿ?‡VŠr2ô?QʼW¢?™ ¿øªn?¡Ô¾t„Á?ªÒ¨™^’æ?²Z¨ ÷(?²TÚšè?ª¾]ùÚæx?¡ÛÙ\úÉ›?™xª;²?¡rq)¶?„dxT—÷­?{ÀÆ)‹?yì¼R_,Æ?}û˜žî>?‡Àƒd#1?–ˆïU qÉ?¥~žÒF_)?¯?í÷d)?¯¨ãÍI—?©ƒ¨êt?§Oîr-?¦Ì)?Ÿ ÅUñ(?’Z¯ÕOD¹?‘î%“/s$?¦9wu2%?¤ÛD—á¨?¥Ä#žÎ"?¥Èò~å~?¥ÆÜ(X??¤!¹Á ®? žö5Ü®?Ÿ@6ļÏ?¢×¾@ð ?©\¼ •ç?®žÍ‚W§F?«„'lw#Ä? ÒË]|Ì?ÒT&Z ?}ijÙ7iä?}[¦÷å}.?‡{ûU´]’?–©ýå˜?¥˜rî~U?¯^Ò}1h?¯&L>;°?©þ°†»ì?§?¯iHíG?¦.4$YÄA?Ÿ]«¥ØŒ?‚Aï=$Î?ƒe² û?tÝènV?pžá|”ŸS?wïeÓ?‹Ë^ó]a¦?ž®Â:ó0ï?¦ÊøÉ ÷ì?¦ƒó±m]?¤$h''ck?ªa/®-?­¬o($Çã?¦døÀ?—ápy³?‘GŒs'f?˜š6Ö’†?¡ô5#uý?§16*ty.?««…¾ýB2?¬ÍŒoÙÖZ?§EmÚŽ÷?žÔvàþ–ö?—×L¶Ÿš?Cü²âuX?¥'µHCê?©[üä3uì?¥Âfçç_¢?™ÏñÂñC?‡ÎuŸ?uq'€Xfð?pvæXS–=?x~ “œ(L?Œ`L\#,Ë?žþ w`ƒ?¦ÚÈB?¦ Ì nà?¤ t[€Ÿ?©ÐGbß‹H?­-[EÉc?¥é@1X¿?–8¸ªs\?ƒužŠ4óö?tå2¼ew6?p¬XLRP?x)\h…?‹ýs9ÜE?žâaFâ¿?¦è' è?¦Ýy'"Þ?¤Gš$ît¼?ª?ÙÄAx?®adöq?¦zç=âI?—™þìÌ"?V,¡Ù€U?’ŒL?24? ÉÐY{w?ª‚¡@?±7ù§úÔ?±eGw?ªQ¼@qÂ(?Ÿñ-ÂÊ?“Ê·UD ?’”æåðlÐ?˜}«²7?œè d”î?™»ë¡?ÁXèàO×?€àæ éÒè?sà ì¾N?qˆ~u[Ö?zÍÏÑ A?ñ:,hÁ(?Ÿcœzw×?¦ÛŠ9U?¥iî ¢d„?£Ô‘ZS̪?ª 2¨Ñ±M?­É!€wx>?¦É=i`?–#¶¾K??œºÞói?yÿÏVÐWO?~œ·™p^?‡ê[Æ™é?–ÄGÖµ†?¥¶C5 bÅ?¯pá'È?¯:‡?©;¥ÜŒ@?¨6™ &²f?§p{’yäB? …×Aåü±?‘©”/'ü?†•&zÄFË?Œž6ì€Ò’?›ìÑÈÁê?©FW8?°‹öü8o?°-¶ƒ]?©¹hDŒÐð?¢ Ö$À~?–cqE-þú?‹“¡ÈyT?‡ÁÇYV)ä?‰€tÊ®‘¾?‡úùÕ—R?‚ãöʤæ÷?|¨¢Ú¯?zÒÉF^«?WV‘ÊïÊ?‹un„«a?˜ÅD‰o?¹¿bûƒ?€t:¿­_?„nŸGÚß?£ ‹É<{?™„NAXB?¡÷qA|?ªîLu®fë?²]OúUçÔ?²=ðXïÈ?ª¨‰àŒª?¢WQ¿:¡O?›"ÊêÂ?‘ÒhÃíÆ?…Œ¯(lF?ðš9JH?ŠŠðß­˜á?›C!­@?§XÑ ^P?«Ó¥|¾u?¨ªþï¡‚Ä?¦r=àcÀè?¤Á¨ÐxlÎ?cŽÈxåI?ÛGà´+Ì?}ãM(©\H?wÍiáOä?yªY$€?{>.ÜÑïå?€B¢ÆPĬ?ˆañîÙ`#?“Û©­·?œ4†O*?¢Ùuÿl¡k?«de „Ý?±7fé?°kõ}O|?§’7u«*o? Ïdÿ¢sæ?™Ÿø|~?ðñ"ƒ•?„®„Ò[xø?MѨÏ?‰s9ÿ`?ŸXy;Ïê?¦):À3%ª?§Ké‰2(?©§öC¹8?¯˜®p?¯Ÿ•£¤?¥I¡e}Ãï?–¯¥¼ bÍ?ˆñ*ݵ?§Åƒbƒƒ?yÓæWw«f?€Êô;rå?yi!¸^?ž×Ø÷]ïŽ?¨ÝÚ¯õíâ?ª7zæÛ·é?¥Z«Ý¥qI?¥žÈ:Ž·?§†¸èSXð?¡µ$NZ°(?‘xÚÛm?z´®RWr|?o5pàj?q €òýŽ?x¯Á*êbô?…º¹rÉ?•¶5X®b†?¢–ÔK¿æ?¦Ð#==(?¦rÿ®œ7?©1åÜœU«?®[¿¤tÉÉ?«¿÷¯Þ^?¡ßѸò=y?“a:\à¸ÿ?†¯]8']?~!¨ØÑ\?züÁðæ%?ƒyN>5kg?–¦´ŸUÏ?¥ínÙ|d²?­|VôcÇm?©ÓtÊÍ?¤ °g?¥ý®üæU?¦¡„‹2Ù?ž…Ñ´u?Œ r*”?x V¤?p‰'>­tk?r¶QœÂ?~PB¬ ?ŽÈ8ÍHgœ? &’r<ï?©Õ½]gY?«Ìþ&?§ÂÌÚ¦‰?§ÕE Ïm¯?¨-¯»H?¡­|¹ªí?‰›ˆj*?x†œ¬6Šè?j‡¿øú†h?mÑE_d\?y]Ô/?‹nu³œ%?ž šMå"?©¥IDl¼'?¬ÏiÆ,¼?¦¥·¼&@?£“„Ô^ñº?¦ e> å?¤ŽUž8üh?˜ˆªì^?…ÒÃÌ õ ?uW ÏDÓ?p_W‡JCê?tä-*®’?ƒ‹‚Ü(q?–?¾íÉ?¦!7ÊCÉn?­Ñ|«{Ï\?ª þ•F2$?£ÏO£—?¥Eó+í¶,?¦<ÌÉi·?žêŠ_òÁ(?i]üNÀF?z7§‘âÌ?pÕàçNN8?rŒÃT?|Ò™Ð;ø?Šl œ|?š “û\L?¤ó[é,v…?¨t–¦h¨À?§mÿ3á]ü?§w¤Š§?¥Xÿ[„nz?œÌŸj@¡÷?ŠÑ8eªž˜?u™¨ïD¼?jQ2Wä÷Ð?n¢CTbÐP?z 65Ó©?‹~˜Ùq‚?ž0ƒ„î†?©°¶6É—f?¬ÙdÕt—?¦¼äú’n?£µ-Z*5kj?tä-*®Ž?p_W‡JCð?uW ÏDã?…ÒÃÌ õ ?˜ˆªì[?¤ŽUž8üg?¦ e> ä?£“„Ô^ñº?¦¥·¼&>?¬ÏiÆ,»?©¥IDl¼'?ž šMå"?‹nu³œ#?y]Ô/‹?mÑE_d|?j‡¿øú†ˆ?x†œ¬6ŠÔ?‰›ˆj*?¡­|¹ªì?¨-¯»G?§ÕE Ïm®?§ÂÌÚ¦Š?«Ìþ$?©Õ½]g[? &’r<ï?ŽÈ8ÍHgŸ?~PB¬ ?r¶QœË?p‰'>­tj?x Vª?Œ r*?ž…Ñ´u?¦¡„‹2Û?¥ý®üæU?¤ °f?©ÓtÊË?­|VôcÇn?¥ínÙ|d´?–¦´ŸUÓ?MѨÑ?züÁðæ)?~!¨ØÑb?†¯]8'b?“a:\à¹?¡ßѸò=y?«¿÷¯Þ^?®[¿¤tÉÉ?©1åÜœU¬?¦rÿ®œ6?¦Ð#==&?¢–ÔK¿å?•¶5X®b„?…º¹rÅ?x¯Á*êc?q €òý¢?o5pàj8?z´®RWr?‘xÚÛm?¡µ$NZ°(?§†¸èSXð?¥žÈ:Ž·?¥Z«Ý¥qK?ª7zæÛ·é?¨ÝÚ¯õíä?ž×Ø÷]ï?yi!¸_?€Êô;rä?yÓæWw«e?§Åƒbƒƒ?ˆñ*ݵƒ?–¯¥¼ bÍ?¥I¡e}Ãï?¯Ÿ•£§?¯˜®p?©§öC¹6?§Ké‰2(?¦):À3%©?ŸXy;Ïå?‰s9ÿa?€t:¿­_?„®„Ò[xû?ðñ"ƒ—?™Ÿø|~•? Ïdÿ¢sè?§’7u«*o?°kõ}O|?±7fæ?«de „Þ?¢Ùuÿl¡i?œ4†O'?“Û©­´?ˆañîÙ` ?€B¢ÆPĦ?{>.ÜÑïö?yªY$Š?wÍiáP?}ãM(©\P?ÛGà´+Î?cŽÈxåG?¤Á¨ÐxlÎ?¦r=àcÀê?¨ªþï¡‚Å?«Ó¥|¾u?§XÑ ^P?›C!­>?ŠŠðß­˜à?ðš9JJ?…Œ¯(lE?‘ÒhÃíÉ?›"Êê„?¢WQ¿:¡Q?ª¨‰àŒ©?²=ðXïÉ?²]OúUçÔ?ªîLu®fé?¡÷qA|?™„NAXB ?£ ‹ÉD‰r?¦›VúN¿l?§70PúÄs?§ŽøTd©h?¬Ò; Nj?®.àN5Êv?¦!ª1`O?˜Å;±?¯^Ò}1j?¥˜rî~X?–©ýå˜?‡{ûU´]•?}[¦÷å}#?}ijÙ7iä?ÒT&Z? ÒË]|Ì?«„'lw#Ä?®žÍ‚W§G?©\¼ •ç?¢×¾@ð?Ÿ@6ļÑ? žö5Ü®?¤!¹Á ¬?¥ÆÜ(X??¥Èò~åz?¥Ä#žÎ"?¤ÛD—á§?¦9wu2&?‘î%“/s$?’Z¯ÕOD´?Ÿ ÅUñ'?¦Ì)?§Oîr,?©ƒ¨êu?¯¨ãÍIš?¯?í÷d)?¥~žÒF_)?–ˆïU qÎ?‡Àƒd#3?}û˜žîF?yì¼R_,À?”œ€Ó\£?•@?˜omI·ü?ÍR-òóK? ›ò¸ó;s?£(Ÿ¹PÞR?¦ó|í“ÍÈ?¦øUGDKÇ?£Ù±? Dw˜<ù?œ…\<‹'º?–øò„…)­?”þ¥NÁ³?œÄ=©ø?¦ÙõGx™ ?°«®ñUù?²SõáÝ?8?®b[+÷þ?¤z`™,7?›R»,¬¡?— *(×£?›R»,¬¢?¤z`™,6?®b[+÷ÿ?²SõáÝ?8?°«®ñUùž?¦ÙõGx™!?œÄ=©ø?”þ¥NÁ­?–øò„…)¨?œ…\<‹'¸? Dw˜<ö?£Ù±Œ?¦øUGDKÅ?¦ó|í“ÍÈ?£(Ÿ¹PÞT? ›ò¸ó;v?ÍR-òóT?˜omI¸?•@…?”)awÓy?ÀhþS?‡À³¹d?ˆÇ‰¿?……—õàËÃ?‡wùÍÆ;#?‹Zº'®}?›|Pâ¾’?£ˆ 3 ôQ?¦¯|¥ ?§y:[+dü?«Hç°Ã?¬O€êGÍÁ?¥ªz¤)Q?œ{^zGë?“~$ü04?‡ -@l0?{Nª_e?v½,)wî^?‚˜oDë@Ë?’û¯ÎÂœ,?ž®\$¼¢¶?£d¤˜à,?©ÜÖˆwG®?²3È~ÿ.ï?³¡p<ûü2?­( ûaÞ¶?¡‡ðð¹É?™ªWðnõ?›|Éu\þ†?¡.\aÉ?¤xsóÄHª?¥ÕÉæp=?£å80D Ø?)q3Ò^?“CöžÖw?’b3xW?ŸÃsÛœ€ø?«2Ÿ#Tú?°êyãÇ?­Fý"šk?¢Êaª¨Þ?”d¯Ï€+ö?…!ÉÎr™?xž`$w?uó\søk?‚­5ê¡ýY?“’M$b?ž¨šo¸âo?£bø?¢ï˜†­?©wìN :?²'Q°»Œ?³ÇíéãM?­¨U- ˆ?¡mÝ¡Š?”Cs< ÿ?Û°|´<Þ?‡Öî†ß?ˆäÑÒ”qš?ûŸŽzI?›HÞ.d*?£ ˜ß4‹?¦M\q p5?¨|·ÞÙ­²?­ŠZ|–„\?®5èóFLo?¦­Luf˜?•6’õλq?‘‰ç ¤ ?Š›;¤þ•å?†íLå=‘f?‰\Mi@Ë?‘Uí¥„?›*´Þz'Ú?¢ÇÑ„°dS?¤Ç×ûc?¦Ô´|¡X?«ÍŒ~1l?¬³‘Û#1p?¥æ!“¥ýæ?œ±¾8&þ»?”³ÜD û?•§7ÓÞ?˜x6!**O?ÓßÈË×? ¨gVP??£Bƒ{ƒ º?§˜ÑM›?§-¿5”Ü?£´‚ЯöÆ?¡ï \N+? lÛÕÀP?š3.뺌g?•“0~¾˜á?•L±~®£N?—Æ¡B±8(? ”S`Öò ?¨1î>~?«I²¾§?§Œs|ƒ?£ü«ÖÚ³?žæŽXû?”²4:ûÛ?‡´DëȪŒ?‚>K}[‚ö?…òT†â? r$?‘î`abj8?“¤¨ñÙ*?•\¿q9|¸?™è‹ó7?ž“%ßñ·? ÞF”í\?¢Øßý ²?¥Ï*ýº?¤§½²I?¡yŒ¾Ur? 1U¥H?žÔ›¸þ?˜¹0QÜP?•4 ¿¹U?”9ë“ÜÃ0?œ‹]º„\?¥®GƒÛ-6?¬K°;ïØ&?«ž4ø´t\?§‡}¾Ï‹?¦ /›‚M?£w7`8‡?›I* Ë;?‘ãQdtê¸?‹‰šíõ¹?‰ ^¹N?Œî8U?ä?“ c¡c'?šoáBô8Ž?¥5“¨Ûü?¯šH§NÇ·?±#?pÂ[ð?«å¢Ÿ<¢?¦?5#”L?¢‘Ìx½Uø?Ž>à+ª?~Ž.­îÚÑ?uvö]ìãq?zö–+"X?‡mZËMž?“šçêz?¡ëÖé•z?­—9ÕK{0?³Ñ¡CÞyÒ?²+éÌ˱µ?©{-¿Ôì«?¢ç¾o·?ž@tÕsÿ?“N[$Kc?ƒLzZ=×E?vók—Î-?waßYDÇ?‚‰Õh‚eh?Õ8ïÌb?˜[Í,}P?£vÁ÷|¼.?¬@@£}Cö?¯,]CHl?ª{x’OwÔ?¤ªñ…ù,?ŸJÁVQ¡?“[I?ô ?‚}• Ób?r†«… ) ?qøÔçÊÄ$?†.$ÿº?þ•´î?˜ÏjmÁC?¥¿Ò¹ZI²?±‰’Ÿ±Œ?³Q̈-|è?®õ€ˆžÆÒ?¥ÈúÎPPP?¡„úho=¢?šuÙv>?Ž=ùÝ·•¾?~ f^ëÄV?u’\A_?{ïÆ0Ña?‡(MYÀô?”T~S±È?œÎ /[#?¥ÿíÖ[°?¬ÐlñÈ}'?«ÜDÝ…Ï?¦Ëx!5%l?¤¥z0¶?¢›~:+øL?šæ혜?‘ÁZep?Ž‹Ú´!ql?ÒÂW¼"?›WüͪÍ?ÒÂW¼)?Ž‹Ú´!qv?>ÁZe|?Øx‹–z8?×{W²Èþ?’×]‘iâ?“ÿíyÅJ?•“tN ›?š8M¯‹õò?ž\_ýDÚ°?  n6/y8?¢o‹;žáŠ?¥hÂåÑ?¤‚÷Ú¼†?¡j½7Ì^Ê? <#×@?žHŒÑÅÀ.?˜ÞSò0å_?•Hmár–3?”T~S±É?ûM¼RÑ?ˆÞq¾oÄ?ˆž·‘ À?Ž’–Šü™þ?–Êä(–Ù? ÷X/àˆá?¤H°ºÀ?¥T“QaªM?¨í_8Üç$?¬OHg‹—?¨ª›3é9? õ’æÑôš?—!—d ’?S §šå?…fTð+¦?|íYðx?z([Z†h?ˆà+¦?šryäk>ø?¡{*K=ñ?¥µv·­¢®?®Ûÿ’@œ©?³A©ÆŠkÄ?°ñ2ƃû?¥”Wõ›Ñ6?˜j$J›X?Œ9ÇF–í–?~vë"0 ü?q¸ˆaÒÃ?t~”«h€?†ß¹:üÊÔ?˜l0!‰¬?£ ‘•tnB?¨ YŽSY”?®ýÃÇohà?²èYòpx?±I? à°?¦ßÁ±Òñ?š”móÛ=?w½J‰ì?„tq[•?y}=&¥D;?wú-Ѐ¾=?ƒ71»ÂÁ?“Fýj;U?ž‰pη¸?£?0“g©?©Šÿ!Ò*?² öXjCG?³«VâG?­kòœÔ*?¡Ij± X?”9ë“ÜÃ1?ÛàXs¾?‡á8^ FŸ?ˆmÒcjÖú?Žx´ÆH~?–×Ç#®Þ~?¡ Wl+C?¤I%K‘zç?¥@yê³#Â?¨ÆLèzdT?¬±ñ Ã?¨_yDºˆ? ¦7×ù?–DEËÅ?ŽãtèÞ±J?ƒÃ=oÆÂ?yâ2&ÐÜ?ybñŠì8ˆ?ˆ“g’Ò‚?˜ÖÄlCÏ?¢‘Ìx½U?£w7`8‡?¦ /›‚K?§‡}¾ÏŠ?«ž4ø´tX?¬K°;ïØ$?¥®GƒÛ-4?œ‹]º„]?”³ÜD û?•4 ¿¹W?˜¹0QÜU?žÔ›¹? 1U¥H ?¡yŒ¾Ut?¤§½²I?¥Ï*ýº?¢Øßý ²? ÞF”íY?ž“%ßñµ?™è‹ó7?•\¿q9|·?“¤¨ñÙ(?‘î`abj:? r$¢?…òT†î?‚>K}[‚ü?‡´DëȪ?”²4:ûÜ?žæŽXû?£ü«ÖÚ²?§Œs|ƒ?«I²¾¤?¨1î>~? ”S`Öò?—Æ¡B±8(?•L±~®£P?•“0~¾˜ä?š3.뺌k? lÛÕÀP?¡ï \N.?£´‚ЯöÈ?§-¿5”Ü?§˜ÑMš?£Bƒ{ƒ ¸? ¨gVP;?ÓßÈËÐ?˜x6!**J?•§7ÓÞ‹?”Cs< þ?œ±¾8&þº?¥æ!“¥ýê?¬³‘Û#1r?«ÍŒ~1p?¦Ô´|¡X?¤Ç×ûc?¢ÇÑ„°dS?›*´Þz'Ù?‘Uí¥€?‰\Mi@Ä?†íLå=‘Z?Š›;¤þ•Þ?‘‰ç ¤ ?•6’õλt?–ÖNKíËD?•d&øC®?—ÚÒÝž?Š5[ÆÑÃ`?²…ôm)?˜¢šû?¡JD\îÓK?¦Mwe—[P?§Õ!ªT?£…u’POf?š²zÁ¢LÈ?•IBôí?–SG ÖD?r³¼»^ø?¦­Luf˜>?®5èóFLp?­ŠZ|–„^?¨|·ÞÙ­´?¦M\q p4?£ ˜ß4‹?›HÞ.d)?ûŸŽz@?ˆäÑÒ”q?‡Öî†Ñ?Û°|´<Ø?“ŠDïÓ×Ñ?¡mÝ¡‰?­¨U- Š?³ÇíéãM?²'Q°»Œ?©wìN ;?¢ï˜†­?žHE“>bþ?“A‰5&?ƒf¦¦®Ëž?võ±æ ÛÄ?x<À·s÷?„ikÄà†?‘g_sFuä?›]öæÝ?¢î¶ñ¹®?¤»dò…ÏE? ]¦Fµö?“ß4ÙÆT?9!h?“¦V…³„>?ŸîM÷wí?¥ËHg&N?¦Ðpoëþ?¢³ÿhÔ§”?› •?5?•ÎHÐ.œœ?—pzÊ¥Ê?¡€Ò^?­Ø!b´‘æ?´8‰®ò­?²»Íü/w¿?ª_Ûì?£‰z/}_?žÑpÈ0?“§$Û?‚µm Á ?vÙ –ÙÜÏ?{%ž·S¯ð?‡!‚?Ì?“~$ü04? ök#'ú?­_ôl4g`?³ªm¸‚Ž?² -ìæ´Ã?©€”öΈå?£Ã?™š “Öö?§®Ò ù?²™âøî?´“‹°4Â?°¤“'Ž·Ñ?¤gäÜ«5?˜O€i“6 ?•qÄ….Á?›ö¬z™#w?£‹'-ŽÏ?§Ú*Ú Ð?ª»“Eô?¨¤C´Í¾?¢Š´ÎUÆÓ?›ß -Mé%?:Í2Åvž?¥ Û¥8åa?«¦8¤¡sÐ?«Zxà~ÔÂ?§„ö2Ìóç?¦¢‚·Ø¬?£‚@‰Sõ(?› öÛ°ë?ÚqêÀJ?ˆÇ‰¨1Þ?‹é¼³À?ˆ ²’?‹/ uPÍz?’DŸ5@E?™u …ç?¢^ XËtõ?©Æ•NF½?«ùuSå$È?¨´O#;ˆ?¥œéA0ö?¦\̓¢ò?§I²|<Í"?¨ŸÔ]ÈÒP?¨ÅcŠôƒÔ?¤bé ¹.?š¡y>ë?ŽéjҥȘ?†X,úq?Á¡ Z?¢™™.Š?°°¯‚*]?´mm$ò¬á?±ÚîÐWzö?ªäe[|ü­?¤Hï'nìÑ?œ ŠÆH?‘¡²¾äs*?‰=”P?†ÞÅdÓk?Š½†Nü)4?’-Fib¬?˜äEÆÍ4?¢n¤L«0?ªK»ŽÄ“?¬Ô\oü4§?¨Ã4eS?¥Â@Dô…¢? ìƒÇ*s?˜Î¶f‚-?‰Ž ü©¹?z£h;V¨Ê?w¯½ˆ™?‚tòa­š?øÁÑ“Î?›_Ò‡VŒï?¨SÃE\?²UÇ{Ò³:?³i?Bq·c?­‹-Gf#?¥uF "ƒõ?¢áñ"Ÿ&?¡òÀøš?ží“¤TPú?žq…Pºè?›‡` ­ªz?•BÏ)µ&?‹Â‚É9¸b?ƒJùÕ(|?‹&`¯>¨?Ÿ'–°ðž?¬r¨zÕ^È?±6Ì&û™?­s™¬Šš?¦ÊC¦´‹? TÒ³ ?”“hÂ?: ?„ÜK WmY?waŽãá—µ?vÙô‰Zì”?‚P§s9Út?±ŽÙU r?šàK¹¨&¹?§äzJfÄ?²>Uÿ»I@?³Žal¹Ðž?­¹Šwf¾¾?¤öVJã Î? öñ‘Œ0?˜W|ìàU?‰£‰3¦â?z¿îH8÷T?w͘\$©?‚Šãúi¥?7?Ì}Ù?›ÔNZmt?©WÁÒј?²ùÁԺѾ?³óƒ¨¡71?­ÐŸ+Ú 8?¥)Ï.Å?¢'d•U¿Ù?žSê…ýØä?˜Z®²Ñc?—q 3Š\`?—Ï|¿¸¾?”|akà›?Œã5å/?ƒ…\@áiè?…E`üq-?• Ï:5g?£ò¡öT?§üBB4ë‰?¦–º­a >?£¢ÆŸÈÌ?ŸãIUa?”9øI(€3?„$ˆ‚3ô?vªnÄHå?v²üÂŒ¦ ?‚Kˆ›¿P*?r/Î_2^?š¼!JÄ¿Ì?§ól‡üä³?²T#ï³?³ ÔÅS?­Ìnë?¥š¢…Â?¤õÅÿƒ˜? Q Ãop?”.϶mØ?Œ¹qLÄ?ˆ+7ç²òå?‹aÆ\r?’r´™Èi?™æ}žÇ,¸?£è–KT¿?¬”ÌæÀê·?®¨ß7 ˜U?©Zu*2ɯ?¥ÆWž: ?¥.ž;à­?¢K“õÑò‘?Í'Æ¡à?`)ÜO&z?½͵4?™Rzôe?’2ùe–s˜?‰rr%j†Ð?„Š¹f¨3Ñ?‹sxú_j?–iéÝt?ŸzBSAþz?¢²î'á?¤ƒ#²jD~?¢àqÞ!^å?š¾’°X?¿Í”®ô?ˆ!u½Ö?…Ã]B¢›?‰¶|A?‘qL¸®>?˜«1ß·©?¢VCÑ2?ªŠz™€×?­qç;k/?¨æ¬×^?Ñ?¥×œŽTP@?¦Ã†dX‚«?¤uJ‰Ï„?¡8- 1íÝ?Ÿ¾e„0HA?›óŽõk­$?—R×qD‘´?•Ø+”·—9?–J¾"ûf?™9ùÈwXT?Ÿœ8ø014?¡´p”Í`ã?¡ÿ|½=D?¤dÊBð[‰?§ð?šÕE?¥º=Ñ•?¤i%Ô3?«?¦×ÄMä‚À?§jÑ ëÔn?¢¨(¨œý?špìïî?‘ý¬¦"ø?ˆžå?ƒ^3…¯2µ?‰X \›¼?“ÍÔ0>0?ž[ þ±Þ??¤9mL|j?¥ ìbà"?¢ &Ÿ,…}?Ÿ´Z!j?t¶y£Œ?˜¡ƒù‘Ò?”-¡4ø –?“}—8k“?“Ì©ÚŠGy?–)Á;]X?›â£ûãÿ? ²ïöÐ?¡DVÕz?¤t[2hX?¤‚ù’ŒíM?¥Ë.+êþÿ?¨ÉYx´%Æ?¬Ó‚Эw?ªHê®Õ*?¢sÃ[#o`?˜ö’<½^í?’l3jm­£?Œ½P§z²?‹~òãé?ë›:H}s?•#Jøê?Ÿ-gr_•9?¤$dЛ7B?¥YàX `ú?¨ZÁñÿ`?¯Îdâ€?±yJ\?ª¾0Užâ?¡Ò½£&À?–ÂÔvóš?‹n¦‹ëiF?ëÍ}ãq?|bE?Ò¦?‡B¥4(5?•¼Í6ø? èSbÕÉL?¤¾Ì:?¥ã¸í1àe?ªerXŒ?«¾¨3ÍÈ ?¦,K|ÖñÛ?¡Ï®Ÿ?”àWX9U{? Èx³.?‡ä;œ~tV?‡ ©8 Á|?‹ó@`vü¹?”Ž‚ ~#û?  _‚é_? ôÿ¡9Ó?¥ˆÀ…¡?­ÅDf[Χ?³’^3±?²?B®¡*?§ê¨Ç'b?šôž~ø ?çFdgv?‚ÜÝ‚yvÎ?yžN=Cè:?{܈ˆ¡äê?‡G‡_çx¦?•gªNÀÒ?Ÿ”»èô’?¢à‚ÚXd¤?¨±ö›>›?±k†é@eø?³+”—u®?­ø8l³š?¢øÛHqÕ?—',Âù¨?ŠE«ÍR?{ r=‚Ù2?rÕ‚îh½X?}_ƒ½›ÍL?Ãôw•º?›qÛxÅåß?¢Õ\š¡‹?§è9ùnµö?°øéÍñ¸–?³M`.?®}›Òqƒ?¢OöÙêÀr?•\þ8j;?‰îš?¢à‚ÚXd¦?Ÿ”»èô—?•gªNÀÒ?‡G‡_çx°?{܈ˆ¡å?yžN=Cè8?‚ÜÝ‚yvÒ?çFdgr?šôž~ø †?§ê¨Ç'a?²?B®¡)?³’^3±?­ÅDf[Χ?¥ˆÀ…¤?¤‚ù’ŒíN?  _‚éb?”Ž‚ ~$?‹ó@`vüÈ?‡ ©8 Á‡?‡ä;œ~tV? Èx³'?”àWX9Ux?¡Ï®š?¦,K|ÖñÙ?«¾¨3ÍÈ ?ªerX‰?¥ã¸í1àd?¤¾Ì9? èSbÕÉO?•¼Í7?‡B¥4(K?|bE?Ò¬?ëÍ}ãq?‹n¦‹ëiF?–ÂÔvóš?¡Ò½£&¾?ª¾0Užâ?±yJ\?¯Îdâ?¨ZÁñÿ`Ž?¥YàX `ú?¤$dЛ7E?Ÿ-gr_•??•#Jøî?ë›:H}~?‹~òãñ?Œ½P§z²#?’l3jm­¢?˜ö’<½^é?¢sÃ[#o]?ªHê®Õ%?¬Ó‚Эu?¨ÉYx´%Ç?¥Ë.+êÿ?¦Ã†dX‚«?¤t[2hZ?¡DVÕ}? ²ïöÕ?›â£ûä?–)Á;]X?“Ì©ÚŠGy?“}—8k’?”-¡4ø ’?˜¡ƒù‘Ê?t¶y£Š?Ÿ´Z!j?¢ &Ÿ,…{?¥ ìbà!?¤9mL|j?ž[ þ±ÞB?“ÍÔ0>9?‰X \›È?ƒ^3…¯2¼?ˆžå#?‘ý¬¦"ø?špìïê?¢¨(¨œù?§jÑ ëÔi?¦×ÄM䂼?¤i%Ô3?¨?¥º=Ñ•?§ð?šÕD?¤dÊBð[‹?¡ÿ|½=Dƒ?¡´p”Í`ä?Ÿœ8ø01:?™9ùÈwXZ?–J¾"ûg?•Ø+”·—7?—R×qD‘°?›óŽõk­?Ÿ¾e„0H7?¡8- 1íÚ?¤uJ‰Ï‚?¤õÅÿƒ—?¥×œŽTP??¨æ¬×^?Ò?­qç;k1?ªŠz™€Ü?¢VCÑ2’?˜«1ß·­?‘qL¸®A?‰¶|??…Ã]B¢“?ˆ!u½Í?¿Í”®ì?š¾’°X?¢àqÞ!^â?¤ƒ#²jD~?¢²î'á?ŸzBSAþ€?–iéÝy?‹sxú_t?„Š¹f¨3Õ?‰rr%j†Ó?’2ùe–s—?™Rzô^?½͵4?`)ÜO&r?Í'Æ¡Ü?¢K“õÑò?¥.ž;à¬?¥ÆWž: ?©Zu*2É°?®¨ß7 ˜V?¬”ÌæÀê¹?£è–KTÂ?™æ}žÇ,»?’r´™Èi?‹aÆ\p?ˆ+7ç²òÔ?Œ¹qL³?”.϶mÑ? Q Ãom? öñ‘Œ/?¥š¢…Â?­Ìní?³ ÔÅS?²T#ï´?§ól‡üä´?š¼!JÄ¿Ó?r/Î_2b?‚Kˆ›¿P*?v²üÂŒ¦ž?vªnÄHå?„$ˆ‚3æ?”9øI(€1?ŸãIU\?£¢ÆŸÈÊ?¦–º­a ??§üBB4ëŽ?£ò¡öX?• Ï:5l?…E`üq/?ƒ…\@áiè?Œã5å/?”|akà”?—Ï|¿¸À?—q 3Š\]?˜Z®²Ñc?žSê…ýØß?¢'d•U¿×?¥)Ï.Æ?­ÐŸ+Ú 8?³óƒ¨¡70?²ùÁԺѾ?©WÁÒÑš?›ÔNZmv?7?Ì}Û?‚Šãúi§?w͘\$ˆ?z¿îH8÷G?‰£‰3¦â?˜W|ìàO? ìƒÇ*r?¤öVJã Í?­¹Šwf¾¼?³Žal¹Ð?²>Uÿ»I>?§äzJfÄ?šàK¹¨&½?±ŽÙU r?‚P§s9Ú€?vÙô‰Zì›?waŽãá—¶?„ÜK WmR?”“hÂ?: ? TÒ³?¦ÊC¦´‹?­s™¬Š›?±6Ì&û™?¬r¨zÕ^Í?Ÿ'–°ðŸ?‹&`¯>¨’?ƒJùÕ(|?‹Â‚É9¸e?•BÏ)µ&?›‡` ­ª?žq…Pºò?ží“¤TPú?¡òÀø›?¢áñ"Ÿ&?¥uF "ƒó?­‹-Gf#?³i?Bq·a?²UÇ{Ò³9?¨SÃE[?›_Ò‡VŒî?øÁÑ“Ô?‚tòa­š?w¯½ˆ™…?z£h;V¨Ä?‰Ž ü©¹#?˜Î¶f‚+?¤z³ËÐ Õ?¥Â@Dô… ?¨Ã4eS}?¬Ô\oü4£?ªK»ŽÄ?¢n¤L«/?˜äEÆÍ3?’-Fib­?Š½†Nü)>?†ÞÅdÓk?‰=”P?‘¡²¾äs*?œ ŠÆH‘?¤Hï'nìÑ?ªäe[|ü¬?±ÚîÐWzö?´mm$ò¬à?°°¯‚*]?¢™™.Š?Á¡ Z?†X,úq?ŽéjҥȖ?š¡y>ë?¤bé ¹0?¨ÅcŠôƒØ?¨ŸÔ]ÈÒP?§I²|<Í"?¦\̓¢ò?¥œéA0ó?¨´O#;ˆ?«ùuSå$Æ?©Æ•NF½?¢^ XËtñ?™u …æ?’DŸ5@I?‹/ uPÍ?ˆ ²£?‹é¼³Æ?”…D>¨1ã? «u¬Íá?²…%@ý?¯E@µ‡r?¥XŽm W¹?žm’ûÖç°?•Õ™ç„¶~?‹^m?}Û•«Ü,£?‰À;h?˜Ñ•×C~Ä?¤4½Y=mÖ?§Y(D¨ZÊ?§*$ßÕe„?«}y¬˜æ‚?§(ð¢•?£þzá/ô?”jþê Ý‹?L«™·;?rÛ2a2ÌÊ?rk™õkÔî?}› ÇÈv?Öö0 "?¡{ãÖH~º?«—ª¨ƒÎ?¬KŸm_á?¦òÐq4?¥Sµº²?¨Cp ÍJ?¥¶ˆ~ ?œ&-iîB¤?“Ážiàÿ?CŸ,))?ƒˆaiµT|?xtÚl¯?uˆc%•pv?…Å÷cȦ?›³€ï·^?¨?k@õ?ª^Ñmà—?¤ä\X¼wÃ?¤V.ÝW Ë?¥“©,V„–?  S“î?ôÑ.E?|X–Ù-Â?qL«×9,h?qܶOÔ?|äAúbì‹?QEsö4?¡/&¬U±=?«ªºi4?¬—Ìe?¥™»¼3t?¤>àÖÞ›?§51öÄÔ©?£)ÿ…Þ-¥?”}²IBàš?^B‹¸øæ?rîË–Û/?r~}Í(H?}@g?™ýW€Ù?¢5÷cg¢1?¬™—Ru"?¬£Ïû\Lž?¥DãRæ•?¤S¡é5Ð?§äÞwç?¤Áe8ÛK?™×º¬Bzº?“QŽ4JÖ?‡=Ÿ“»Æí?pÉúÛ™?x ö_@dü?u"ÕôxÙ€?‚8óMÂ?•»|cè?£ðóã?¦³@3˜6?¤Åë‘+§ó?¦’,nÝP?¦ýr¥4?‚? (–mÒ?Žy­èª]?z 6 äâµ?p*(.ÿ‘h?qq”5¢æÀ?|Êî1ó¤?XkÙ®«?¡=_ovú=?«ÁžçG©?¬¦‘î5Ë?¥ž\' ?¤Dü&*Ïã?¯Ìà¬bŒË?ªD-å”Ø¥?žàíƒõrÈ?& oš^?ƒæLŒ(Ì?|èËä?‘I_ÌD?‹2Œzÿa?›žÂ®?–ð?¦·²µ“þ?}ì£è³º—?wÇÉ>3Ž?|…ËdõþY?ˆÎyè<Ž-?˜ñ²s H?¤]Èm¸µ?§uÚf(U?§0B Bõ?«…üZ¢ ?²ŠÏ]¥$Ä?¯VÜþE3é?¥e2^-5¥?žu¹Ô/Èå?•Úù™ ¬?‹süÕÛå?‚«E²Ñ?ƒÅQŸî&l? ¦\ N?™‚÷‰=€? Ú íÎK™?¥¯ëOa’\?®É¯?ôqê?²°Ã Ý ?°[H¬Ki?§ã¤®1?£ä#§?¡‚"Åf…?™ `ª„?R«#­Iâ?­LàYúó?{Ì­ç Í?‚ZÐ3÷éä?mã“‚?Z©”|?¨ÒÍ·=?°£“ž‚pC?°é½Ê(Â?©|Ñ>ã?¡y¦ÉW…È?™{f–?K?‘(iéÖH?„È/ÜêFE?~øãBdÛÄ?5§ý=c·?‹i·¨%?•ù¦•é·Â?žŽþ T?Â?¥V‡ “òO?¯CÐà ’?¯·|ùt‹?«€C\¾:?§+7Oñë?§WT‚>Ù’?¤4LÓ|ë+?˜Ùú½1‡Ì?‰AR µ°?cÈ@]®?Ò ½yM?‡,Bð©v–?’LW5Ξ?ŸVsòÞ?©•ý­ Õ»?°Ì@ñÊ-?¬5ü#8Y¼?¦È¶H6Q?¨ÓšY{¨?ª;üàI2ø?£”™é‘ª§?•¯y©[ª?†—ô<º?{ Õs‹´?w4ºHä†?aó2Ss!?’°uð §?¢&”>Üþ?«dK’vNH?¬„î‰ha?§Þ-‹Tîœ?¦‡ï.â´÷?¦¡Ú™v? MDâ›6?‘Ï|µq31?‚½"¦ô.?yª½î‚HØ?z"ÒyçÌ•?‚àFîÀ?ÞNÍ£|?ž¬¥§Nh?ª"¼ôD´?§+å¹£H?¤?XÏ­C‚?¥›Q¦›Z?¬œÖøÞÃ?«°­F Ã?¡6¶üáÜ?{®ßè?}üÊeæâ?sˆ1Yu?u-ÿ§f¹u?¦û4Ü¡ ?’w©ÊË??¡8™-?§Vkf}}?¥!¾Ð̾?£RÕ­?©†Î6­_g?­OyZƒP?¦8L­GÒ?—ÕuUyEû?‡ðËYb?xÏ/“Ëz˜?píªm¢?t1§ò{Nê?†ovß!?™Ïyÿ‡Ã?¤nlÍØäW?¥‰oÚ-²?£›þ¶< ?¨ÎREo ?­-_æÔG?¦Ûc×O?˜?—‰«È€?…ó/ ÷Ûf?vúR‘˜Ã?p^á?rÈö-¹H?4¹2??”b5/X½/?£ ½vO¢?§<(€ãi?¤JNý³!?¥¨lB‹w?¬»ϲ3C?«Ö {ü¸û?¡LLÐeGé?ŠlþQ¨ô?}9Òg³á?r ÏJ·Ò?qG!+)#?{…ìv=3}?Žkö%z ?ŸXuY ýI?¦¢\Cl?¦Oß{3%Õ?¤U,K¬õ¿?§¡Žï0ŒÐ?¨ê SÐ)?¢ ú“ÂZ9?’Ä·Õl„??ðåÀ… ?t!åÀ‹1•?nPör‘Á?sûmÖ¦¬°?‡tˆ¦l?š–Æœ 6þ?¤èö~嘥?¥m`s¡ó?£³á_oa?¨äØÁZ?­V˜ÿѵ?¦þ‘»‹]?˜^AÌÐá`?†U+ÃóÎ?w K~à!=?p4&ÃllË?r8ñ™N?JÒÎ’ß?”u¡û|?£+µô”ã?¯Ôìs溄?«mÐÐá?§@|´©?Ø?§‘À3j­4?¤{x¹È‚€?™ÈÇSE?ˆø™¢Aý?|Ý»{î‘L?x`<£ú»?JsÓ?ˆÀÈ Bõ?–pÚþÝ›?¤”ÁZ5ºm?­²>—Ð?®PÍ`Wb?¨{Ò™W?¤c5µÂÙ? ­©}ÜmJ?•|‹k¼y?…Þ™µÀ?wët@5?pýƒix«þ?t¡¡Ô-?–HÂ9!ˆ?’ÕXÞ³?£³ÏÚ`?¬iÒ Ú[?­›š²U?¨R¤R¡?¦º‚e\‚?¦m ®Ø? šÁpn—?’ Kì[?‚Ú^yj•·?yÑ)»¾m?zi[ks@?ƒìܬë?6ýØoßl?ž×ímT‰m?ªA3>êÈl?²“šîùÍÿ?¯Y}Ä0 >?¥k¬éà±á?žÁM¾Þ?–*6óâ?‹L¿cÀ‹K?PvÀݺÂ?8h79?…:é…+ö?‘™"ŒZxL?š6ä±W?¡‰õéÕ"F?©OJäè9ë?°ü†§Ž?°øqˆŸÁ‰?¨³úBc(#?žbâ¸[?’-®È¡²?„T‡À‡-ì?vÀh%—Àä?qª? ,Îñ?vÀh%—ÀÙ?„T‡À‡-ì?’-®È¡µ?žbâ¸[?¨³úBc($?°øqˆŸÁ‰?°ü†§Ž?©OJäè9ì?¡‰õéÕ"F?š6ä±U?‘™"ŒZxJ?…:é…+ñ?8h7,?PvÀݺÅ?‹L¿cÀ‹R?–*6óç?žÁM¾ã?¥k¬éà±à?¯Y}Ä0 =?¯Ôìs溄?ªA3>êÈl?ž×ímT‰m?6ýØoßl?ƒìܬá?zi[ks—Î?¤”ÁZ5ºm?–pÚþÝ›?ˆÀÈ Bõ?JsÓ?x`<£ú·?|Ý»{î‘M?ˆø™¢B?™ÈÇSH?¤{x¹È‚‚?§‘À3j­6?§@|´©?Ø?«mÐÐà?§<(€ãi?£+µô”ä?”u¡û}?JÒÎ’Ý?r8ñ™Nö?p4&ÃllÊ?w K~à!Ý?’°uð °?aó2Ss&?w4ºHä‡?{ Õs‹¸?†—ô<º‚?•¯y©[¢?£”™é‘ª¢?ª;üàI2ó?¨ÓšY{§?¦È¶H6Q?¬5ü#8Y¼?°Ì@ñÊ.?©•ý­ Õ¿?ŸVsòâ?’LW5΢?‡,Bð©v ?Ò ½yT?cÈ@]Ÿ?‰AR µŸ?˜Ùú½1‡Ä?¤4LÓ|ë&?§WT‚>Ù‘?§+7Oñë?«€C\¾:?²ŠÏ]¥$Ä?¯CÐà “?¥V‡ “òQ?žŽþ T?É?•ù¦•é·Ë?‹i·¨+?5§ý=c»?~øãBdÛÀ?„È/ÜêF>?‘(iéÖ@?™{f–?H?¡y¦ÉW…Æ?©|Ñ>ã?°é½Ê(Ã?°£“ž‚pC?¨ÒÍ·=?Z©”|?mã“Š?‚ZÐ3÷éì?{Ì­ç á?­LàYúõ?R«#­IÖ?™ `ªƒú?¡‚"Åf}?£ä#¡?§ã¤®/?°[H¬Ki?²°Ã Ý?®É¯?ôqê?¥¯ëOa’^? Ú íÎKš?™‚÷‰=ˆ? ¦\ N ?ƒÅQŸî&p?‚«E²Í?‹süÕÛÝ?•Úù™ ¬?žu¹Ô/ÈÞ?¥e2^-5£?¯VÜþE3è?¯Ìà¬bŒË?«…üZ¢ ?§0B Bõ?§uÚf(V?¤]Èm¸µ ?˜ñ²s P?ˆÎyè<Ž>?|…Ëdõþj?wÇÉ>3“?}ì£è³ºˆ?ˆ>·²µ“ø?–Ý43úÊ?¥GEgêc?®P-®´)f?®wz÷*.?¨{3ÍWw?£¿(ƬŒ?šëJ [ ?p\vT«?~i€Å—T?y^^úôF?,ýŽØ•„?Š`öüm/-?’°‹òQØ?˜j°àûr?¢FËÑ4V¢?«å5@AÆ?° Óg9?ªÑ¨å}$à?¦×ÅǸS?¨^èùê·ê?¦àÖÞœ?¥™»¼3s?¬—Ìe?«ªºi1?¡/&¬U±=?QEsö4?|äAúbì?qܶOÔ?qL«×9,e?|X–Ù-Ë?ôÑ.E?  S“ï?¥“©,V„˜?¤V.ÝW É?¤ä\X¼wÁ?ª^Ñmà”?¨?k@õ?›³€ï·]?…Å÷cȬ?uˆc%•px?xtÚl¯?ƒˆaiµT‚?CŸ,))?“Ážiá?œ&-iîB¤?¥¶ˆ~ ?¨Cp ÍI?¥Sµº±?¦òÐq6?¬KŸm_ß?«—ª¨ƒÎ?¡{ãÖH~¸?Öö0 ?}› ÇÈ{?rk™õkÔñ?rÛ2a2Ìß?L«™·9?”jþê ݈?£þzá/ó?¯¶“§85?«}y¬˜æƒ?§*$ßÕe„?§Y(D¨ZÈ?¤4½Y=mÔ?˜Ñ•×C~¿?‰À;c?}Û•«Ü,¤?zÆNÞ>y?§§¤ ?ŒB.ºTó?™ÔøÝóÃ?¦'÷rUM?¬mŒV?ªa‡= Íf?ª%!P ?­Ë„pŽá?ª·¼7*?[T’¡?†ÿH}æ[?w³¨À÷&c?Oúþ‰áÄ?('`®¾?šî–©Õ9?¡Ô*C°a°?¥‘’Ó·¹"?«ËcbCÿ¥?¯OÖ*l g?«Pi§o?§ äòy¦?¦ÏØ‚H­Ò?£¨„û¨~õ?˜ÉD*Åè?‰1^36‹)?~h·yÚ“M?{ç@ëWx,?ƒ  ©;/?4y÷§œ?ž¹òGßÆS?ª(@ÆÇÐü?µÍWÉÈý.?²̛ƞq?¦üiä‚"?J‹[y??“7qâ?…,’´ú‹?wŒc.Gç?wŠZ)?„4óè1-?’ …5¹‚ï?›…Mcµ(ÿ?¥.d“é‹?°@Æ¥¦?³N­¬°È?°*yž$&?§ñì²Ò¥?¥N|ª…¤B?¡;{Ïízt?’ëM)ðl?—¿¿O–?rS‘ ,H?—¿¿O’?’ëM)ðl?¡;{Ïízv?¥N|ª…¤E?§ñì²Ò¦?°*yž$&?³N­¬°È?°@Æ¥¦?¥.d“é‹?›…Mcµ(ý?’ …5¹‚î?„4óè1+?wŠZ)?wŒc.Gâ?…,’´ú?“7qâ"?J‹[yB?¦üiä‚#?²̛ƞq?²V5!÷’ÿ?®Ø¥’kP?¡¿•6Ä„$?‘!§.†á6?° ?u$v–X¨#?sH²S$kº?œs<;ÿ?¤/;?ª‹Ëœ½°k7?xÖ[½ò?z:ïm³¢®?‰Cmgº0?–”¥ìVàk? !^Ë æ?§®|Wdi?±µ£‘¥Â?µûWÚâG?²ÕþÑà§7?¨­#&²Ö³?¡Â†·Tœ^??"MÛ?“”Su‘ê?„ ¿Íã’”?wZñ¡ßèë?uå÷ ” ?‚„rLt§?’&à@Ò6%? Š[:z"?¬’p?³Ÿ~y™n?³ÐƨøA?¬±SÑ•˜D?¡í Ž»Ê?—‚1u¶äS?Œ—‚ôöµŠ?}ç¦ÖPË[?rår'¸P?vvw—AÞÐ?…6vÊ]7?“=-ôĘt?R‹{,ˆ?¦íGþ1¡!?² ¶¿•m¡?²Sê™R°N?­~÷tý|£?¥w4r¨l?£ÕXšý? ËÓ¼Ç5?“’Ý˧ji?htÕGO?tL®¯ÀÀ&?y'Ÿk3üº?…ëï‰Ü@&?“\í)äÖ¹?¡Ó6E6µ#?®?0HÀn?²²ÃìuT$?®Ì:ýÇ?¥ Ë‹#Š?¤b©m„?¥p³¹¿<á?Ÿ>øs«˜?ñßkÉ=?}Ó½h‡A?r™A¸…§ù?u æ"¸P™?ƒm->*S?•\å‹š?¥r”ŒlÏ?°Rq'!¶?¯ø¾J4£@?§ó®ŽWØ$?£ëÆœÿš?¢¤ÆE0¨_?šîq¦?Š‡.Æó?xI` ?ppÂÃÌT?t‚CÑ\u?«kûõä?‘Þ3õmr?¡±ÜO3–]?®ÍrX¢?©†Õðo5?¢ÅÝòàŸ? F ÒA<Ÿ?¦îì0ç?¦V6‰÷åk?›J^¼6ú?†ºTlý)û?s ú}Ž_¯?n5©½›ž?t¢Ñ)æ…?ƒ¥ÂÊXý?•ÈµçÁ4)?¤¿yìÒž?ª}}þ‚YÝÐ?}Ú8ªë²?p€+Ϻ3?lXUd»??u\Û£2ƒ:?Š4aŸF¥?žl“Øâå:?§?4ì…BM?¥¨>¨c? 7Ÿ~Ã?¢ùZ €8…?§b³CÐ$v?¢rdbôÅ?’o‚ù `„?}£têì1>?ngŠ…4ý~?i¹h§l] ?qÜ…•ó?ƒXšá™‘Þ?˜³c¶“ ?¦Rº™0X²?©™ah¼!:?¢Ïb PÔ? M+”ãv?¦/'»Hê±?¦rÅ桶?›mÕa~›?†Ö`ù«?sZt7Š0?jçð\…àÃ?p/¶QÅ“?~ Ã#}ƒº?‘Ï·3­ˆ?¢y¢ÐÆL?©Ç¤å Fú?§'È@ê%Ú?¡Ù·²Ê8a?£pIºØí?¤ÜéÈn|?¢µÌ³ƒ¢?Œ#TÔ~Ì?wó€"Eü?l`Õ•¬nX?j¬pwë~µ?uj1±ÜŠR?Šóï‡4¸z?ŸN=pT‹°?§ÄXÐ`g4?¥ðé j;ä? ;ý C@jï&?°BnÖl?§òꔉá?£÷˜ôÞ?¢óèœÓ¼H?›7ú8ÎB…?‹d™ãRÂ?xX¹ÔÓÍ?pžš¶ ²$?tÊ*¨ &´?Ý„ô»ŒÕ?‘;ó5ô8?¡ËmU½Ø?®òbž)“?µÚZ¹Ív?²|íÛA×?§Àè@ æ?è"-\É?“ljä%ŸL?…wî×hÁO?v¾DHJG}?s?6Õ"æ?~êÊ”²¢?«êϱs?˜Á¥›Ç?¡ÝL$ñªm?¬Y|gjˆ”?³ØgŠ9þ4?³òΓG ?¬t,àÎ;? š!Ì{r?’w Û¸¼®?‚òWYIÁM?rÈáÇ(?j]÷ÄÙ¿I?rÈáÇ&?‚òWYIÁN?’w Û¸¼³? š!Ì{u?¬t,àÎjï'?¦z‹·ø²?•Ï[t|ß\?ƒ¼Fqkè?s$¾kÕÙ?jº=Þ£c®?pgì© `Ó?MþL ?’•fhÇÀ?ž‡K’h™‚?£³“ä¯6?©úY?ƒ*·?±1Ml1ø?±b [V Z?¨Ö›x«Ž?™&Nx)â?‰¿Í.ÚÃ?{]úÉ»Oó?q•QÒú§?r8œsPH?j\¸þÝO?“ÕAÎöc?¡SN aÑ?£üG‘žÆ??¥‡¥2Õ?­ŠÄdj?©™ah¼!9?¦eÐÑ×ç¾?˜@·¢Ÿ?ƒp–UÍÿŸ?qù§õ?iâ ÉÁ?n‰vY€ÜÈ?}Ä“bS·R?’Žâšc¸÷?¢”¦D·‹£?§ƒ©òͱ?¢üº‚cï? ;ý C@=?¥ðé j;â?§ÄXÐ`g2?ŸN=pT‹±?Šóï‡4¸r?uj1±ÜŠT?j¬pwë~›?l`Õ•¬n\?wó€"Eù?Œ#TÔ~É?¢µÌ³ƒ¡?¤ÜéÈn}?£pIºØí?¡Ù·²Ê8a?§'È@ê%Ù?©Ç¤å Fù?¢y¢ÐÆM?‘Ï·3­ˆ?~ Ã#}ƒ«?p/¶QÅ“4?jçð\…àÆ?sZt7Š8?†Ö`ùª?›mÕa~š?¦rÅ桺?¦/'»Hê²? M+”ãv?¢Ïb PÔ ?©†Õðo4?¦Rº™0X³?˜³c¶“ ?ƒXšá™‘ç?qÜ…–?i¹h§l]?ngŠ…4ýu?}£têì1*?’o‚ù `~?¢rdbôÄ?§b³CÐ$s?¢ùZ €8…? 7Ÿ~Ä?¥¨>¨c?§?4ì…BN?žl“Øâå=?Š4aŸF¥#?u\Û£2ƒ1?lXUd»:?p€+Ϻ2ö?}Ú8ªë®?‘’¹>ÝÍ?¡Ú|#ÕF?§¬Îµ\?£‹EO÷Da?ž´wzäÜ?¥6£Ùb„?ª}}þ‚Y=?¤¿yìÒ¢?•ÈµçÁ4.?ƒ¥ÂÊX?t¢Ñ)æ… ?n5©½› ?s ú}Ž_®?†ºTlý)ð?›J^¼6ø?¦V6‰÷åk?¦îì0ç? F ÒA< ?¢ÅÝòàŸ?²Sê™R°N?®ÍrX¤?¡±ÜO3–^?‘Þ3õmx?«kûõì?t‚CÑ\p?ppÂÃÌK?xI_ð?Š‡.Æó?šîq¢?¢¤ÆE0¨^?£ëÆœÿš?§ó®ŽWØ%?¯ø¾J4£A?°Rq'!·?¥r”ŒlÐ?•\å‹¡?ƒm->*V?u æ"¸P˜?r™A¸…§÷?}Ó½h‡@?ñßkÉ6?Ÿ>øs«“?¥p³¹¿<ß?¤b©m„?¥ Ë‹#Š?®Ì:ýÇ?²²ÃìuT%?®?0HÀq?¡Ó6E6µ&?“\í)äÖ»?…ëï‰Ü@*?y'Ÿk3ü¾?tL®¯ÀÀ-?htÕGC?“’Ý˧jg? ËÓ¼Ç1?£ÕXšû?¥w4r¨l?­~÷tý|¢?µÑG)A´?² ¶¿•m£?¦íGþ1¡"?R‹{,Ž?“=-ôĘy?…6vÊ]7?vvw—AÞÖ?rår'¸>?}ç¦ÖPËM?Œ—‚ôöµ‚?—‚1u¶äQ?¡í Ž»Ê ?¬±SÑ•˜D?³ÐƨøA?³Ÿ~y™n?¬’q? Š[:z&?’&à@Ò6+?‚„rLt«?uå÷ ”)?wZñ¡ßèë?„ ¿Íã’?“”Su‘ê??"MÕ?¡Â†·Tœ\?¨­#&²Ö²?²ÕþÑà§7?µûWÚâG?±µ£‘¥Â?§®|Wdm? !^Ë è?–”¥ìVào?‰Cmgº8?z:ïm³¢Ä?xÖ[½ì?…>°k7?“!†K­¬¼?Pý`Ò„?§Å¡@üE?²$ÿO¤?²akôÙZÄ?­Šó¹?¥re˜_Nà?£âךCjó? æ“±%Ç?“­cë}Æÿ?9Q{] +?qÍ¥ L¡æ?pæo7m ?z*£ OD?ˆ–[ "0è?™µfö®F?¨ðέÅ4?±½ªQ‘‰ò?±U:ÎÈG^?ª‹Ëœ½:?¤/;?œs<;?Ž±“L>kÃ?{çLóô2?roá–¯?wF—Ñs‘?ƒ½(¯ ?ŽZˆMÚê-?—&Ú72˜Z?¤'.—y#?°7LBƒ?²kAÙ¹?¬~bæ@R?¤©|gÛä&?¤`¿,:G?¢XqS?¢ç?–{±à¨?ƒ6{ÛæÖ£?së‹Òq|?uEñ±_ÓM?À÷l*ûØ?‘47ÿ®R?¡ÖS¥£?®ùž"3Œ&?©•_eUþU?¢Îð§˜Ê? I0ŸÁ ?¦qãwÓ?¦\@'QÑ?›M öªyö?†£o¨T¬s?rë:®ÜÅ?i––3Š²?mÉÃw„ßh?|6´Tîn?‘ºªcƒ?¢Ìƒ¿Böh?©è÷ˆ|~¤?§ÿO0Q?¢³?òÎݘ?¤å„ ã‹?¢xĽ'$2?•§WOèyL?«—ö ?pñíZaí?o‚Y1âÌ|?uªrc û?€lÎâÈW?‹6B÷ÔÛ?›jÚcº5è?§së³.€Ï?ª$n+˜nž?¢è]vÙ:3?Ÿ“+/ª?¥À ²þn?¦æêF9-·?œó£‚ÙþT?ˆH«—?s÷i0Ù?kø  oà?rBEê›&5?ƒ†ÊÀt›®?˜,~áæý?¦e¡a¡vl?©ˆG$¢§F?¢Ëã’ž8? K [·‹?¦ g4A?¦NËÂR?›7ïnä‰?†‘Nå|Q?rò"šM?jœjÕÐ]5?pX¾¹Sê?1Ìã|xþ?’ÎÅÒœ?¢º[É£˜?§—rªNÜ?¢z Ýk´?ž¨±…W{J?¤µjŸd?¥fx=ŠÑ?™·À­}8N?„(#QÈgÄ?q‡,[_î?pt¾¨õ º?y+‰ÞÂË®?„ ç¿ÁÓ?ŽÖ‘!RþB?›U¿ä=¾?¦ëœìáÁ†?ªd¨pÞ*Ê?¤R•& b?¡&mt?¥ÚؼÒ†?¦{?`‘?› ÝR·í?‡XùHy1Ë?s¨›ìƒj?kÜ= ?r1ý¨T¡Ò?ƒsªÛ(x?˜öŽï;˜?¦TªuVT?²V5!÷’ÿ?­€È‘Îô?¥z†éîòp?£Ù[³Ð”]? Ëzúkö]?“‰P•Ç?;õrYÛJ?r¶¹Înÿ?sþ˜å×ìý?€A¢®?×öeÙ}š?°V"ù¾–?©ð…`w€û?¯UŽHuÿú?©G*ŽE?¤6PÈÙ–"?§ Ð’¬C?¥©°É ^?˜øŬt?ƒdjcdð1?r,(Td•ç?v!8``/›?†ˆ6ÎÌÐ?”?s‹.×?œO_šX ?£ØGê2}?­Éx¨à#?±¥ÒŸY?­xöͶ Q?¥äÜ Î( ?£‘Ùgûî? IÛø=3a?“'!ä@»¡?Cœ’œé%?sH²S$k?}Û•«Ü,¨?‰À;a?˜Ñ•×C~À?¤4½Y=mÕ?§Y(D¨ZÌ?§*$ßÕe†?«}y¬˜æ‚?§(ð¢•?£þzá/ó?”jþê Ý‹?L«™·;?rÛ2a2ÌÒ?rk™õkÔò?}› ÇÈn?Öö0 !?¡{ãÖH~º?«—ª¨ƒÎ?¬KŸm_á?¦òÐq3?¥Sµº²?¨Cp ÍI?¥¶ˆ~ ?œ&-iîB¤?“Ážiàÿ?CŸ,))?ƒˆaiµT|?xtÚl¯?uˆc%•py?…Å÷cȦ?›³€ï·]?¨?k@õ?ª^Ñmà–?¤ä\X¼wÁ?¤V.ÝW Ë?¥“©,V„˜?  S“î?ôÑ.E?|X–Ù-Á?qL«×9,k?qܶOÔ ?|äAúbì‘?QEsö.?¡/&¬U±àÖÞœ?§51öÄÔ©?£)ÿ…Þ-¤?”}²IBàš?^B‹¸øå?rîË–Û*?r~}Í(L?}@e?™ýW€Ú?¢5÷cg¢0?¬™—Ru"?¬£Ïû\L?¥DãRæ”?¤S¡é5Ð?§äÞwã?¤Áe8ÛK?™×º¬Bz¹?“QŽ4J×?‡=Ÿ“»Æë?pÉúÛœ?x ö_@e?u"ÕôxÙ…?‚8óMÆ?•»|cè?£ðóã?¦³@3˜3?¤Åë‘+§ò?¦’,nÝQ?¦ýr¥4?? (–mÑ?Žy­èª]?z 6 äâ¶?p*(.ÿ‘m?qq”5¢æÅ?|Êî1ó¤?XkÙ®«?¡=_ovú=?«ÁžçG©?¬¦‘î5Ê?¥ž\' ?¤Dü&*Ïâ?¯Ìà¬bŒË?ªD-å”ؤ?žàíƒõrÇ?& oš]?ƒæLŒ(È?|èËê?‘I_ÌC?‹2Œzÿa?›žÂ®?–ò?¦·²µ“þ?}ì£è³º›?wÇÉ>3?|…Ëdõþf?ˆÎyè<Ž,?˜ñ²s J?¤]Èm¸µ?§uÚf(T?§0B Bõ?«…üZ¢ ?²ŠÏ]¥$Ä?¯VÜþE3è?¥e2^-5¥?žu¹Ô/Èâ?•Úù™ ¬?‹süÕÛä?‚«E²Î?ƒÅQŸî&k? ¦\ N?™‚÷‰=‚? Ú íÎK™?¥¯ëOa’[?®É¯?ôqé?²°Ã Ý?°[H¬Kj?§ã¤®/?£ä#¥?¡‚"Åfƒ?™ `ª„?R«#­Iß?­LàYúó?{Ì­ç Ø?‚ZÐ3÷éâ?mã“„?Z©”| ?¨ÒÍ·ã?¡y¦ÉW…È?™{f–?J?‘(iéÖH?„È/ÜêFE?~øãBdÛÌ?5§ý=c²?‹i·¨(?•ù¦•é·Ã?žŽþ T?Â?¥V‡ “òP?¯CÐà ‘?¯·|ùt‹?«€C\¾8?§+7Oñë?§WT‚>Ù’?¤4LÓ|ë)?˜Ùú½1‡È?‰AR µª?cÈ@]¥?Ò ½yM?‡,Bð©v™?’LW5Ξ?ŸVsòÞ?©•ý­ Õ»?°Ì@ñÊ,?¬5ü#8Y»?¦È¶H6Q?¨ÓšY{§?ª;üàI2ø?£”™é‘ª¦?•¯y©[©?†—ô<º?{ Õs‹¼?w4ºHä‚?aó2Ss$?’°uð ª?¢&”>Üþ?«dK’vNK?¬„î‰ha?§Þ-‹Tî?¦‡ï.â´÷?¦¡Ú™v? MDâ›6Ž?‘Ï|µq30?‚½"¦ô.?yª½î‚HÎ?z"ÒyçÌ”?‚àFîÀ?ÞNÍ£~?ž¬¥§Nl?ª"¼ôD´?§+å¹£H?¤?XÏ­C?¥›Q¦›[?¬œÖøÞÂ?«°­F Á?¡6¶üáÜ?{®ßè™?}üÊeæÝ?sˆ1Yq?u-ÿ§f¹v?¦û4Ü¡ ?’w©ÊË??¡8™-?§Vkf}{?¥!¾Ð̾?£RÕ­?©†Î6­_f?­OyZƒO?¦8L­GÐ?—ÕuUyEú?‡ðËYd?xÏ/“Ëzœ?píªm ?t1§ò{Nò?†ovß"?™Ïyÿ‡Ä?¤nlÍØäZ?¥‰oÚ-³?£›þ¶< ?¨ÎREo ?­-_æÔG?¦Ûc×P?˜?—‰«È?…ó/ ÷Ûh?vúR‘˜º?p^á"?rÈö-¹D?4¹2??”b5/X½2?£ ½vO£?§<(€ãi?¤JNý³!?¥¨lB‹v?¬»ϲ3C?«Ö {ü¸ú?¡LLÐeGé?ŠlþQ¨ò?}9Òg³á‹?r ÏJ·Ò{?qG!+)$?{…ìv=3}?Žkö%z ?ŸXuY ýJ?¦¢\Cj?¦Oß{3%Ö?¤U,K¬õ¾?§¡Žï0ŒÑ?¨ê SÐ)?¢ ú“ÂZ9?’Ä·Õl„>?ðåÀ… ?t!åÀ‹1—?nPör‘È?sûmÖ¦¬µ?‡tˆ¦m?š–Æœ 7?¤èö~嘧?¥m`s¡ò?£³á_ob?¨äØÁZ?­V˜ÿѵ?¦þ‘»‹]?˜^AÌÐáa?†U+ÃóÒ?w K~à!:?p4&ÃllË?r8ñ™N?JÒÎ’ã?”u¡û?£+µô”â?¯Ôìs溄?«mÐÐà?§@|´©?Ø?§‘À3j­4?¤{x¹È‚~?™ÈÇSE?ˆø™¢Aú?|Ý»{î‘H?x`<£ú´?JsÓ?ˆÀÈ Bõ?–pÚþÝš?¤”ÁZ5ºm?­²>—Ï?®PÍ`Wd?¨{Ò™V?¤c5µÂÚ? ­©}ÜmJ?•|‹k¼y?…Þ™µÀ?wët@4?pýƒix«ý?t¡¡Ô.?–HÂ9!Š?’ÕXÞ²?£³ÏÚa?¬iÒ Ú]?­›š²U?¨R¤R¡?¦º‚e\‚?¦m ®Ø? šÁpn—?’ Kì[?‚Ú^yj•¾?yÑ)»¾f?zi[ks=?ƒìܬé?6ýØoßn?ž×ímT‰n?ªA3>êÈl?²“šîùÍÿ?¯Y}Ä0 >?¥k¬éà±à?žÁM¾Ü?–*6óà?‹L¿cÀ‹K?PvÀݺ¼?8h7.?…:é…+ñ?‘™"ŒZxK?š6ä±X?¡‰õéÕ"G?©OJäè9ì?°ü†§?°øqˆŸÁŠ?¨³úBc($?žbâ¸[?’-®È¡±?„T‡À‡-ì?vÀh%—Àà?qª? ,Îî?vÀh%—ÀÚ?„T‡À‡-î?’-®È¡·?žbâ¸[?¨³úBc(%?°øqˆŸÁŠ?°ü†§?©OJäè9ì?¡‰õéÕ"F?š6ä±U?‘™"ŒZxJ?…:é…+ò?8h74?PvÀݺ¾?‹L¿cÀ‹O?–*6óæ?žÁM¾ä?¥k¬éà±á?¯Y}Ä0 >?¯Ôìs溄?ªA3>êÈm?ž×ímT‰m?6ýØoßi?ƒìܬà?zi[ks=?yÑ)»¾f?‚Ú^yj•»?’ Kì[? šÁpn—?¦m ®Ù?¦º‚e\‚?¨R¤R¢?­›š²U?¬iÒ Ú\?£³ÏÚ_?’ÕXÞ®?–HÂ9!?t¡¡Ô&?pýƒix«ÿ?wët@/?…Þ™µ»?•|‹k¼z? ­©}ÜmL?¤c5µÂÜ?¨{Ò™V?®PÍ`Wd?­²>—Ð?¤”ÁZ5ºl?–pÚþÝ›?ˆÀÈ Bõ?JsÓ?x`<£úµ?|Ý»{î‘R?ˆø™¢Aý?™ÈÇSF?¤{x¹È‚?§‘À3j­6?§@|´©?Ú?«mÐÐà?§<(€ãi?£+µô”ã?”u¡û}?JÒÎ’Ý?r8ñ™Nþ?p4&ÃllÎ?w K~à!4?†U+ÃóÏ?˜^AÌÐá`?¦þ‘»‹]?­V˜ÿѵŸ?¨äØÁY?£³á_ob?¥m`s¡ñ?¤èö~嘦?š–Æœ 6þ?‡tˆ¦f?sûmÖ¦¬µ?nPör‘®?t!åÀ‹1•?ðåÀ… ?’Ä·Õl„=?¢ ú“ÂZ:?¨ê SÐ*?§¡Žï0ŒÒ?¤U,K¬õ½?¦Oß{3%Õ?¦¢\Cl?ŸXuY ýI?Žkö%z?{…ìv=3w?qG!+)-?r ÏJ·Òz?}9Òg³á?ŠlþQ¨î?¡LLÐeGè?«Ö {ü¸ý?¬»ϲ3C?¥¨lB‹x?¤JNý³!?§+å¹£H?£ ½vO¤?”b5/X½6?4¹2??rÈö-¹V?p^á?vúR‘˜µ?…ó/ ÷Û`?˜?—‰«Èx?¦Ûc×N?­-_æÔG?¨ÎREo ?£›þ¶< ?¥‰oÚ-±?¤nlÍØä[?™Ïyÿ‡Ç?†ovß)?t1§ò{Nê?píªm¤?xÏ/“Ëz’?‡ðËYb?—ÕuUyE÷?¦8L­GÎ?­OyZƒO?©†Î6­_e?£RÕ­?¥!¾Ð̾?§Vkf}?¡8™/?’w©ÊËB?¦û4Ü¡)?u-ÿ§f¹{?sˆ1Ys?}üÊeæß?{®ßè?¡6¶üáÜ?«°­F ¿?¬œÖøÞÂ?¥›Q¦›\?¤?XÏ­C‚?¯·|ùt‹?ª"¼ôD¶?ž¬¥§Nq?ÞNÍ£?‚àFîÀ?z"ÒyçÌ’?yª½î‚HÉ?‚½"¦ô#?‘Ï|µq3(? MDâ›6?¦¡Ú™v?¦‡ï.â´õ?§Þ-‹Tîœ?¬„î‰ha?«dK’vNM?¢&”>Ý?’°uð ¯?aó2Ss*?w4ºHäŒ?{ Õs‹¶?†—ô<º€?•¯y©[¥?£”™é‘ª¢?ª;üàI2ô?¨ÓšY{¦?¦È¶H6Q?¬5ü#8Y¼?°Ì@ñÊ.?©•ý­ Õ¾?ŸVsòâ?’LW5΢?‡,Bð©v¢?Ò ½yW?cÈ@]®?‰AR µž?˜Ùú½1‡Æ?¤4LÓ|ë%?§WT‚>Ù?§+7Oñë?«€C\¾:?²ŠÏ]¥$Ä?¯CÐà ’?¥V‡ “òQ?žŽþ T?È?•ù¦•é·É?‹i·¨,?5§ý=c¶?~øãBdÛ¾?„È/ÜêF=?‘(iéÖB?™{f–?J?¡y¦ÉW…Å?©|Ñ>ã?°é½Ê(Á?°£“ž‚pD?¨ÒÍ·=?Z©”|?mã“Š?‚ZÐ3÷éì?{Ì­ç Ú?­LàYúó?R«#­IÚ?™ `ªƒû?¡‚"Åf?£ä#£?§ã¤®.?°[H¬Kj?²°Ã Ý ?®É¯?ôqê?¥¯ëOa’^? Ú íÎKš?™‚÷‰=ˆ? ¦\ N ?ƒÅQŸî&t?‚«E²È?‹süÕÛà?•Úù™ ¬?žu¹Ô/ÈÞ?¥e2^-5¤?¯VÜþE3ç?¯Ìà¬bŒË?«…üZ¢ ?§0B Bõ?§uÚf(V?¤]Èm¸µ?˜ñ²s L?ˆÎyè<Ž8?|…Ëdõþc?wÇÉ>3‘?}ì£è³ºŽ?ˆ>·²µ“ø?–Ý43úÊ?¥GEgêc?®P-®´)d?®wz÷*/?¨{3ÍWx?£¿(Ƭ?šëJ [!?p\vT«™?~i€Å—L?y^^úôF?,ýŽØ•‡?Š`öüm//?’°‹òQÛ?˜j°àûr?¢FËÑ4V¢?«å5@AÉ?° Óg9?ªÑ¨å}$á?¦×ÅǸS?¨^èùê·ê?¦?XkÙ®·?|Êî1ó¤?qq”5¢æË?p*(.ÿ‘j?z 6 äâ¨?Žy­èªY? (–mÏ?¦ýr¥4??¦’,nÝP?¤Åë‘+§ñ?¦³@3˜6?£ðóå?•»|cè?‚8óMÈ?u"ÕôxÙˆ?x ö_@e?pÉúÛ–?‡=Ÿ“»Æï?“QŽ4JÒ?™×º¬Bz¸?¤Áe8ÛJ?§äÞwå?¤S¡é5Ï?¥DãRæ•?¬£Ïû\L?¬™—Ru$?¢5÷cg¢4?™ýW€Þ?}@n?r~}Í(V?rîË–Û?^B‹¸øä?”}²IBà–?£)ÿ…Þ-£?§(ð¢•?¤>àÖÞ›?¥™»¼3r?¬—Ìe?«ªºi0?¡/&¬U±=?QEsö2?|äAúbì?qܶOÔ?qL«×9,d?|X–Ù-Ë?ôÑ.E?  S“ï?¥“©,V„–?¤V.ÝW Ì?¤ä\X¼wÂ?ª^Ñmà•?¨?k@õ?›³€ï·^?…Å÷cÈ«?uˆc%•p|?xtÚl¯?ƒˆaiµT€?CŸ,))?“Ážiá?œ&-iîB¦?¥¶ˆ~ ?¨Cp ÍJ?¥Sµº²?¦òÐq6?¬KŸm_ß?«—ª¨ƒÎ?¡{ãÖH~¸?Öö0 !?}› ÇÈx?rk™õkÔñ?rÛ2a2ÌÓ?L«™·=?”jþê Ý‹?£þzá/ò?¯¶“§85?«}y¬˜æ‚?§*$ßÕe„?§Y(D¨ZÈ?¤4½Y=mÒ?˜Ñ•×C~¿?‰À;`?}Û•«Ü, ?zÆNÞ>t?§§¤Ÿ?ŒB.ºTó?™ÔøÝóÃ?¦'÷rUM?¬mŒU?ªa‡= Íh?ª%!P ?­Ë„pŽâ?ª·¼7*?[T’£?†ÿH}æ[?w³¨À÷&`?Oúþ‰á¿?('`®»?šî–©Õ8ÿ?¡Ô*C°a¯?¥‘’Ó·¹#?«ËcbCÿ§?¯OÖ*l g?«Pi§o?§ äòy¦?¦ÏØ‚H­Ò?£¨„û¨~õ?˜ÉD*Åè?‰1^36‹0?~h·yÚ“F?{ç@ëWx'?ƒ  ©;-?4y÷§ž?ž¹òGßÆT?ª(@ÆÇÐü?¦´åg ?¤gk7i.r?¡.ME}Lì?Ÿ¶ÙjY²]?›éôÏ‚ìv?—<ãà£?•·¸,¼øv?•­Uíýµt?–Ýüv³zð?šÉÚƒ²ï?ÎLv{ô?Ÿ¦m†ÈŒ?¢éÜdD'?§~GcçW?¬%bñ» ?±‰xÞ°Þ?²? Òôh?­W|›"E“?¡+;gàï?‘OZMG8?ˆ3ªç:Ù™?‘OZMG:?¡+;gàï?­W|›"E–?²? Òôj?±‰xÞ°Þ?¬%bñ» ?§~GcçV?¢éÜdD'?Ÿ¦m†ȉ?ÎLv{ô ?šÉÚƒ²ì?–Ýüv³zì?•­Uíýµr?•·¸,¼øv?—<ãà¦?›éôÏ‚ì€?Ÿ¶ÙjY²f?¡.ME}Lï?¤gk7i.t?¤z³ËÐ Ö? «u¬Íß?”…D>¨1à?‹é¼³¿?ˆ ²’?‹/ uPÍz?’DŸ5@F?™u …è?¢^ XËtô?©Æ•NF½?«ùuSå$È?¨´O#;ˆ?¥œéA0ö?¦\̓¢ò?§I²|<Í"?¨ŸÔ]ÈÒP?¨ÅcŠôƒÓ?¤bé ¹/?š¡y>ë?Žéjҥȗ?†X,úr?Á¡ Z?¢™™.Š?°°¯‚*]?´mm$ò¬á?±ÚîÐWzö?ªäe[|ü­?¤Hï'nìÑ?œ ŠÆH“?‘¡²¾äs*?‰=”P?†ÞÅdÓk?Š½†Nü)2?’-Fib¬?˜äEÆÍ3?¢n¤L«0?ªK»ŽÄ“?¬Ô\oü4¦?¨Ã4eS€?¥Â@Dô…¢? ìƒÇ*s?˜Î¶f‚-?‰Ž ü©¹?z£h;V¨Ñ?w¯½ˆ™~?‚tòa­š?øÁÑ“Î?›_Ò‡VŒî?¨SÃE\?²UÇ{Ò³:?³i?Bq·c?­‹-Gf#?¥uF "ƒõ?¢áñ"Ÿ&?¡òÀø™?ží“¤TPú?žq…Pºé?›‡` ­ª}?•BÏ)µ%?‹Â‚É9¸d?ƒJùÕ(| ?‹&`¯>¨‘?Ÿ'–°ðœ?¬r¨zÕ^È?±6Ì&û™?­s™¬Šš?¦ÊC¦´? TÒ³ ?”“hÂ?:?„ÜK WmY?waŽãá—´?vÙô‰Zì•?‚P§s9Út?±ŽÙU p?šàK¹¨&¸?§äzJfÄ?²>Uÿ»I@?³Žal¹Ðž?­¹Šwf¾¾?¤öVJã Ï? öñ‘Œ0?˜W|ìàT?‰£‰3¦â?z¿îH8÷K?w͘\$¨?‚Šãúi¥?7?Ì}Ù?›ÔNZmu?©WÁÒј?²ùÁԺѾ?³óƒ¨¡71?­ÐŸ+Ú 8?¥)Ï.Å?¢'d•U¿Ú?žSê…ýØã?˜Z®²Ñc?—q 3Š\^?—Ï|¿¸À?”|akà˜?Œã5å/?ƒ…\@áiè?…E`üq-?• Ï:5f?£ò¡öS?§üBB4ë‰?¦–º­a =?£¢ÆŸÈË?ŸãIUa?”9øI(€6?„$ˆ‚3ô?vªnÄHå?v²üÂŒ¦¡?‚Kˆ›¿P*?r/Î_2\?š¼!JÄ¿Í?§ól‡üä³?²T#ï³?³ ÔÅS?­Ìnì?¥š¢…Â?¤õÅÿƒ˜? Q Ãop?”.϶mÖ?Œ¹qLÄ?ˆ+7ç²òå?‹aÆ\r?’r´™Èi?™æ}žÇ,¹?£è–KT¿?¬”ÌæÀê·?®¨ß7 ˜U?©Zu*2ɯ?¥ÆWž: ?¥.ž;à®?¢K“õÑò‘?Í'Æ¡à?`)ÜO&z?½͵4?™Rzôd?’2ùe–s˜?‰rr%j†Ð?„Š¹f¨3Ñ?‹sxú_j?–iéÝu?ŸzBSAþy?¢²î'áþ?¤ƒ#²jD~?¢àqÞ!^å?š¾’°X?¿Í”®ô?ˆ!u½Õ?…Ã]B¢›?‰¶|D?‘qL¸®=?˜«1ß·©?¢VCÑ2?ªŠz™€Ö?­qç;k/?¨æ¬×^?Ð?¥×œŽTP@?¦Ã†dX‚«?¤uJ‰Ï„?¡8- 1íÝ?Ÿ¾e„0HA?›óŽõk­$?—R×qD‘³?•Ø+”·—9?–J¾"ûf?™9ùÈwXS?Ÿœ8ø013?¡´p”Í`ã?¡ÿ|½=D?¤dÊBð[‰?§ð?šÕE?¥º=Ñ•?¤i%Ô3?«?¦×ÄMä‚¿?§jÑ ëÔl?¢¨(¨œü?špìïî?‘ý¬¦"ø?ˆžå?ƒ^3…¯2·?‰X \›À?“ÍÔ0>/?ž[ þ±Þ>?¤9mL|i?¥ ìbà#?¢ &Ÿ,…~?Ÿ´Z!j?t¶y£Œ?˜¡ƒù‘Ò?”-¡4ø –?“}—8k’?“Ì©ÚŠGx?–)Á;]X?›â£ûãÿ? ²ïöÑ?¡DVÕz?¤t[2hX?¤‚ù’ŒíM?¥Ë.+êÿ?¨ÉYx´%È?¬Ó‚Эw?ªHê®Õ+?¢sÃ[#o`?˜ö’<½^î?’l3jm­¤?Œ½P§z²?‹~òãé?ë›:H}t?•#Jøê?Ÿ-gr_•9?¤$dЛ7C?¥YàX `ú?¨ZÁñÿ`?¯Îdâ€?±yJ\?ª¾0Užâ?¡Ò½£&À?–ÂÔvó›?‹n¦‹ëiF?ëÍ}ãq ?|bE?Ò¢?‡B¥4(2?•¼Í6ú? èSbÕÉL?¤¾Ì:?¥ã¸í1àg?ªerXŒ?«¾¨3ÍÈ ?¦,K|ÖñÛ?¡Ï®Ÿ?”àWX9Uy? Èx³.?‡ä;œ~tV?‡ ©8 Á|?‹ó@`vü¾?”Ž‚ ~#þ?  _‚é_? ôÿ¡9Ó?¥ˆÀ…¡?­ÅDf[Χ?³’^3²?²?B®¡*?§ê¨Ç'b?šôž~ø Œ?çFdgz?‚ÜÝ‚yvÌ?yžN=Cè9?{܈ˆ¡äë?‡G‡_çx¦?•gªNÀÒ?Ÿ”»èô“?¢à‚ÚXd¤?¨±ö›>›?±k†é@eø?³+”—u®?­ø8l³™?¢øÛHqÖ?—',Âù§?ŠE«ÍR?{ r=‚Ù4?rÕ‚îh½X?}_ƒ½›ÍH?Ãôw•¸?›qÛxÅåá?¢Õ\š¡‹?§è9ùnµö?°øéÍñ¸–?³M`.?®}›Òqƒ?¢OöÙêÀr?•\þ8j;?‰î›?¢à‚ÚXd¥?Ÿ”»èô—?•gªNÀÒ?‡G‡_çx°?{܈ˆ¡å?yžN=Cè7?‚ÜÝ‚yvÒ?çFdgp?šôž~ø ‡?§ê¨Ç'a?²?B®¡)?³’^3±?­ÅDf[Φ?¥ˆÀ…£?¤‚ù’ŒíN?  _‚éb?”Ž‚ ~$?‹ó@`vüÈ?‡ ©8 Á‡?‡ä;œ~tV? Èx³)?”àWX9Uw?¡Ï®™?¦,K|ÖñÙ?«¾¨3ÍÈ ?ªerX‰?¥ã¸í1àd?¤¾Ì:? èSbÕÉO?•¼Í7?‡B¥4(M?|bE?Ò´?ëÍ}ãq?‹n¦‹ëiE?–ÂÔvóš?¡Ò½£&¾?ª¾0Užâ?±yJ\?¯Îdâ€?¨ZÁñÿ`Ž?¥YàX `ú?¤$dЛ7E?Ÿ-gr_•@?•#Jøî?ë›:H}?‹~òãñ?Œ½P§z²$?’l3jm­¡?˜ö’<½^é?¢sÃ[#o]?ªHê®Õ&?¬Ó‚Эu?¨ÉYx´%Ä?¥Ë.+êÿ?¦Ã†dX‚«?¤t[2hZ?¡DVÕ}? ²ïöÔ?›â£ûä?–)Á;]X?“Ì©ÚŠGy?“}—8k’?”-¡4ø ‘?˜¡ƒù‘Ë?t¶y£Š?Ÿ´Z!j?¢ &Ÿ,…{?¥ ìbà#?¤9mL|k?ž[ þ±ÞC?“ÍÔ0>:?‰X \›Ê?ƒ^3…¯2¼?ˆžå$?‘ý¬¦"ø?špìïë?¢¨(¨œù?§jÑ ëÔi?¦×ÄM䂼?¤i%Ô3?©?¥º=Ñ•?§ð?šÕE?¤dÊBð[Œ?¡ÿ|½=Dƒ?¡´p”Í`ä?Ÿœ8ø01:?™9ùÈwXZ?–J¾"ûf?•Ø+”·—8?—R×qD‘°?›óŽõk­?Ÿ¾e„0H9?¡8- 1íÚ?¤uJ‰Ï‚?¤õÅÿƒ—?¥×œŽTP@?¨æ¬×^?Ô?­qç;k1?ªŠz™€Û?¢VCÑ2’?˜«1ß·®?‘qL¸®@?‰¶|;?…Ã]B¢“?ˆ!u½Ì?¿Í”®ì?š¾’°X?¢àqÞ!^ã?¤ƒ#²jD~?¢²î'á?ŸzBSAþƒ?–iéÝy?‹sxú_r?„Š¹f¨3Ö?‰rr%j†Ò?’2ùe–s—?™Rzô^?½͵4?`)ÜO&s?Í'Æ¡Þ?¢K“õÑò?¥.ž;à¬?¥ÆWž: ?©Zu*2É°?®¨ß7 ˜V?¬”ÌæÀê¹?£è–KTÂ?™æ}žÇ,»?’r´™Èi?‹aÆ\p?ˆ+7ç²òÔ?Œ¹qLº?”.϶mÒ? Q Ãom? öñ‘Œ/?¥š¢…Â?­Ìní?³ ÔÅT?²T#ï´?§ól‡üä´?š¼!JÄ¿Ô?r/Î_2b?‚Kˆ›¿P(?v²üÂŒ¦Ÿ?vªnÄHå?„$ˆ‚3æ?”9øI(€1?ŸãIU]?£¢ÆŸÈÊ?¦–º­a ??§üBB4ëŽ?£ò¡öV?• Ï:5j?…E`üq0?ƒ…\@áiæ?Œã5å/?”|akà“?—Ï|¿¸À?—q 3Š\^?˜Z®²Ñc?žSê…ýØá?¢'d•U¿×?¥)Ï.Æ?­ÐŸ+Ú 8?³óƒ¨¡70?²ùÁԺѾ?©WÁÒÑš?›ÔNZmv?7?Ì}Ú?‚Šãúi§?w͘\$‡?z¿îH8÷J?‰£‰3¦â?˜W|ìàQ? ìƒÇ*r?¤öVJã Í?­¹Šwf¾¼?³Žal¹Ðœ?²>Uÿ»I>?§äzJfÄ?šàK¹¨&½?±ŽÙU r?‚P§s9Ú~?vÙô‰Zìœ?waŽãá—¶?„ÜK WmR?”“hÂ?: ? TÒ³ ?¦ÊC¦´‹?­s™¬Šœ?±6Ì&û™?¬r¨zÕ^Ì?Ÿ'–°ð?‹&`¯>¨“?ƒJùÕ(| ?‹Â‚É9¸d?•BÏ)µ$?›‡` ­ª‚?žq…Pºò?ží“¤TPú?¡òÀøš?¢áñ"Ÿ&?¥uF "ƒô?­‹-Gf#?³i?Bq·a?²UÇ{Ò³9?¨SÃE[?›_Ò‡VŒí?øÁÑ“Õ?‚tòa­š?w¯½ˆ™…?z£h;V¨Ï?‰Ž ü©¹"?˜Î¶f‚)?¤z³ËÐ Õ?¥Â@Dô… ?¨Ã4eS|?¬Ô\oü4£?ªK»ŽÄ?¢n¤L«/?˜äEÆÍ5?’-Fib­?Š½†Nü)>?†ÞÅdÓk?‰=”P?‘¡²¾äs*?œ ŠÆH’?¤Hï'nìÒ?ªäe[|ü¬?±ÚîÐWzö?´mm$ò¬à?°°¯‚*]?¢™™.Š?Á¡ Z?†X,ús?ŽéjҥȖ?š¡y>ë?¤bé ¹0?¨ÅcŠôƒØ?¨ŸÔ]ÈÒP?§I²|<Í"?¦\̓¢ò?¥œéA0õ?¨´O#;ˆ?«ùuSå$Æ?©Æ•NF½?¢^ XËtñ?™u …æ?’DŸ5@I?‹/ uPÍ~?ˆ ²£?‹é¼³Å?”…D>¨1á? «u¬Íá?”œ€Ó\£?•@?˜omI·ü?ÍR-òóN? ›ò¸ó;s?£(Ÿ¹PÞR?¦ó|í“ÍÈ?¦øUGDKÆ?£Ù±? Dw˜<ù?œ…\<‹'º?–øò„…)­?”þ¥NÁ²?œÄ=©ø?¦ÙõGx™ ?°«®ñUù?²SõáÝ?8?®b[+÷þ?¤z`™,7?›R»,¬¢?— *(×£?›R»,¬ ?¤z`™,6?®b[+÷þ?²SõáÝ?8?°«®ñUùž?¦ÙõGx™!?œÄ=©ø?”þ¥NÁ­?–øò„…)¨?œ…\<‹'¸? Dw˜<ö?£Ù±Œ?¦øUGDKÅ?¦ó|í“ÍÈ?£(Ÿ¹PÞT? ›ò¸ó;v?ÍR-òóS?˜omI¸?•@…?”)awÓy?ÀhþS?‡À³¹d?ˆÇ‰Ã?……—õàËÄ?‡wùÍÆ;#?‹Zº'®|?›|Pâ¾’?£ˆ 3 ôP?¦¯|¥ ?§y:[+dü?«Hç°Ã?¬O€êGÍÁ?¥ªz¤)Q?œ{^zGë?“~$ü04?‡ -@l0?{Nª_f?v½,)wî_?‚˜oDë@È?’û¯ÎÂœ-?ž®\$¼¢µ?£d¤˜à+?©ÜÖˆwG­?²3È~ÿ.ï?³¡p<ûü2?­( ûaÞ¶?¡‡ðð¹É?™ªWðnõ?›|Éu\þ‡?¡.\aÉ?¤xsóÄH«?¥ÕÉæp=?£å80D Ø?)q3Ò^?“CöžÖx?’b3xW ?ŸÃsÛœ€ö?«2Ÿ#Tù?°êyãÇ?­Fý"šj?¢Êaª¨Þ?”d¯Ï€+õ?…!ÉÎrœ?xž`$v?uó\søk?‚­5ê¡ýZ?“’M$b?ž¨šo¸âo?£bø?¢ï˜†­?©wìN :?²'Q°»Œ?³ÇíéãM?­¨U- ˆ?¡mÝ¡Š?”Cs< ÿ?Û°|´<Þ?‡Öî†â?ˆäÑÒ”qŸ?ûŸŽzG?›HÞ.d'?£ ˜ß4Œ?¦M\q p5?¨|·ÞÙ­²?­ŠZ|–„\?®5èóFLp?¦­Luf˜~?«I²¾¦?§Œs|ƒ?£ü«ÖÚ²?žæŽXû?”²4:ûÜ?‡´DëȪŒ?‚>K}[‚ð?…òT†â? r$š?‘î`abj6?“¤¨ñÙ)?•\¿q9|¸?™è‹ó7?ž“%ßñ·? ÞF”í\?¢Øßý ²?¥Ï*ýº?¤§½²I?¡yŒ¾Ur? 1U¥H?žÔ›¸þ?˜¹0QÜP?•4 ¿¹U?”9ë“ÜÃ0?œ‹]º„[?¥®GƒÛ-6?¬K°;ïØ(?«ž4ø´t\?§‡}¾Ï‹?¦ /›‚M?£w7`8‡?›I* Ë;?‘ãQdtê¹?‹‰šíõ¹?‰ ^¹R?Œî8U?ç?“ c¡c(?šoáBô8?¥5“¨Ûü?¯šH§NǸ?±#?pÂ[ð?«å¢Ÿ<¢?¦?5#”K?¢‘Ìx½U=?˜ÖÄlCÏ?ˆ“g’Ò†?ybñŠì8€?yâ2&и?ƒÃ=oÆ»?ŽãtèÞ±B?–DEËÃ? ¦7×ù?¨_yDºŠ?¬±ñ Ä?¨ÆLèzdV?¥@yê³#Ä?¤I%K‘zç?¡ Wl+C?–×Ç#®Þ€?Žx´ÆH~ ?ˆmÒcjÖñ?‡á8^ F’?ÛàXsº?“Š«R•k?¡Ij± V?­kòœÔ*?³«VâH?² öXjCI?©Šÿ!Ò*?£?0“gª?ž‰pη¿?“Fýj;T?ƒ71»ÂÁ?wú-Ѐ¾-?y}=&¥DB?„tq[‹?w½J‰ë?š”móÛ=?¦ßÁ±Òñ?±I? à°?²èYòpx?®ýÃÇohâ?¨ YŽSY–?£ ‘•tnB?˜l0!‰°?†ß¹:üÊÖ?t~”«hˆ?q¸ˆaÒÂø?~vë"0 ú?Œ9ÇF–íŠ?˜j$J›V?¥”Wõ›Ñ4?°ñ2ƃû?³A©ÆŠkÅ?®Ûÿ’@œª?¥µv·­¢°?¡{*K=ñ?šryäk>ù?Ž>à+¬?~Ž.­îÚÒ?uvö]ìãr?zö–+"W?‡mZËMŸ?“šçêz?¡ëÖé•z?­—9ÕK{0?³Ñ¡CÞyÓ?²+éÌ˱¶?©{-¿Ôì«?¢ç¾o·?ž@tÕt?“N[$Kc?ƒLzZ=×C?vók—Î-?waßYDÌ?‚‰Õh‚eh?Õ8ïÌc?˜[Í,}R?£vÁ÷|¼.?¬@@£}Cö?¯,]CHl?ª{x’OwÔ?¤ªñ…ù+?ŸJÁVQ¢?“[I?ô ?‚}• Ób?r†«… )?qøÔçÊÄ$?†.$ÿ¼?þ•´î?˜ÏjmÁC?¥¿Ò¹ZI²?±‰’Ÿ±Œ?³Q̈-|è?®õ€ˆžÆÒ?¥ÈúÎPPO?¡„úho=¢?šuÙv>?Ž=ùÝ·•¿?~ f^ëÄX?u’\Aa?{ïÆ0Ñ_?‡(MYÀõ?”T~S±È?œÎ /[#?¥ÿíÖ[±?¬ÐlñÈ}'?«ÜDÝ…Ð?¦Ëx!5%m?¤¥z0·?¢›~:+øL?šæ혜?‘ÁZep?Ž‹Ú´!ql?ÒÂW¼%?›WüͪÍ?ÒÂW¼+?Ž‹Ú´!qw?>ÁZex?Øx‹–z6?×{W²Èþ?’×]‘iâ?“ÿíyÅI?•“tN ›?š8M¯‹õò?ž\_ýDÚ°?  n6/y8?¢o‹;žáŠ?¥hÂåÑ?¤‚÷Ú¼†?¡j½7Ì^Ê? <#×@?žHŒÑÅÀ/?˜ÞSò0å_?•Hmár–3?”T~S±É?ûM¼RÑ?ˆÞq¾oÆ?ˆž·‘ Ã?Ž’–Šü™ü?–Êä(–Ù? ÷X/àˆß?¤H°ºÀ?¥T“QaªM?¨í_8Üç$?¬OHg‹—?¨ª›3é8? õ’æÑôš?—!—d “?S §šæ?…fTð+¤?|íYðx?z([Z†p?ˆ?“N[$K[?ž@tÕs÷?¢ç¾o¶þ?©{-¿Ôì©?²+éÌ˱·?³Ñ¡CÞyÒ?­—9ÕK{6?¡ëÖé•|?“Š«R•m?‡mZËMŸ?zö–+"€?uvö]ìãt?~Ž.­îÚÑ?Ž>à+¦?šryäk>ø?¡{*K=ñ?¥µv·­¢®?®Ûÿ’@œª?³A©ÆŠkÄ?°ñ2ƃú?¥”Wõ›Ñ6?˜j$J›X?Œ9ÇF–í’?~vë"0 ü?q¸ˆaÒÃ?t~”«ht?†ß¹:üÊÔ?˜l0!‰¬?£ ‘•tnB?¨ YŽSY”?®ýÃÇohá?²èYòpx?±I? à°?¦ßÁ±Òñ?š”móÛ=?w½J‰í?„tq[•?y}=&¥D?£w7`8†?¦ /›‚K?§‡}¾Ï‹?«ž4ø´tX?¬K°;ïØ$?¥®GƒÛ-4?œ‹]º„]?”³ÜD û?•4 ¿¹W?˜¹0QÜV?žÔ›¹? 1U¥H ?¡yŒ¾Ut?¤§½²I?¥Ï*ýº?¢Øßý ²? ÞF”íY?ž“%ßñµ?™è‹ó7?•\¿q9|·?“¤¨ñÙ(?‘î`abj:? r$¢?…òT†î?‚>K}[‚ú?‡´DëȪ?”²4:ûÛ?žæŽXû?£ü«ÖÚ±?§Œs|ƒ?«I²¾¤?¨1î>~? ”S`Öò ?—Æ¡B±8&?•L±~®£O?•“0~¾˜ä?š3.뺌k? lÛÕÀP?¡ï \N.?£´‚ЯöÈ?§-¿5”Ü?§˜ÑM™?£Bƒ{ƒ ¸? ¨gVP;?ÓßÈËÐ?˜x6!**J?•§7ÓÞ‹?”Cs< þ?œ±¾8&þ»?¥æ!“¥ýê?¬³‘Û#1t?«ÍŒ~1p?¦Ô´|¡X?¤Ç×ûc?¢ÇÑ„°dS?›*´Þz'Ù?‘Uí¥?‰\Mi@Ã?†íLå=‘^?Š›;¤þ•ß?‘‰ç ¤ ?•6’õλu?–ÖNKíËD?•d&øC¯?—ÚÒÝ?Š5[ÆÑÃ`?²…ôm(?˜¢šû?¡JD\îÓK?¦Mwe—[P?§Õ!ªT?£…u’POf?š²zÁ¢LÈ?•IBôí?–SG ÖE?r³¼»^ø?¦­Luf˜>?®5èóFLp?­ŠZ|–„^?¨|·ÞÙ­´?¦M\q p5?£ ˜ß4‹?›HÞ.d(?ûŸŽz@?ˆäÑÒ”q?‡Öî†Ô?Û°|´<Ú?“ŠDïÓ×Ñ?¡mÝ¡Š?­¨U- Š?³ÇíéãM?²'Q°»Œ?©wìN :?¢ï˜†­?žHE“>bý?“A‰5(?ƒf¦¦®ËŸ?võ±æ ÛÃ?x<À·sö?„ikÄà…?‘g_sFuã?›]öæÞ?¢î¶ñ¹¯?¤»dò…ÏE? ]¦Fµö?“ß4ÙÆU?9!f?“¦V…³„??ŸîM÷wì?¥ËHg&N?¦Ðpoëý?¢³ÿhÔ§“?› •?6?•ÎHÐ.œ?—pzÊ¥Ê?¡€Ò^?­Ø!b´‘æ?´8‰®ò­?²»Íü/w¿?ª_Ûì?£‰z/}_?žÑpÈ/?“§$Ü?‚µm Á?vÙ –ÙÜÎ?{%ž·S¯ñ?‡!‚?Ë?“~$ü04? ök#'ú?­_ôl4g`?³ªm¸‚?² -ìæ´Ä?©€”öΈå?£Á?™š “Öõ?§®Ò ù?²™âøî?´“‹°4Â?°¤“'Ž·Ò?¤gäÜ«5?˜O€i“6?•qÄ….À?›ö¬z™#w?£‹'-ŽÏ?§Ú*Ú Ï?ª»“Eô?¨¤C´Í¾?¢Š´ÎUÆÔ?›ß -Mé&?:Í2Åv›?¥ Û¥8åa?«¦8¤¡sÐ?«Zxà~ÔÂ?§„ö2Ìóç?¦¢‚·Ø­?£‚@‰Sõ(?› öÛ°ë?ÚqêÀJ?ˆÇ‰;°?©þ°†»ì?§?¯iHíH?¦.4$YÄA?Ÿ]«¥Ø?‚Aï=$Î?ƒe² ü?tÝènV ?pžá|”ŸN?wïeÓ?‹Ë^ó]a¦?ž®Â:ó0ï?¦ÊøÉ ÷ë?¦ƒó±m]?¤$h''ck?ªa/®-?­¬o($Çã?¦døÀ?—ápy´?‘GŒs'f?˜š6Ö’…?¡ô5#uþ?§16*ty0?««…¾ýB3?¬ÍŒoÙÖ\?§EmÚŽ÷?žÔvàþ–ö?—×L¶Ÿ›?Cü²âuX?¥'µHCé?©[üä3uì?¥Âfçç_£?™ÏñÂñC?‡Îu ?uq'€Xfì?pvæXS–F?x~ “œ(E?Œ`L\#,Ã?žþ w`„?¦ÚÈAý?¦ Ì nÞ?¤ t[€Ÿ?©ÐGbß‹H?­-[EÉc?¥é@1X¿?–8¸ªs]?ƒužŠ4óö?tå2¼ew4?p¬XLRP?x)\hˆ?‹ýs9ÜF?žâaFâ¾?¦è' è?¦Ýy'"Þ?¤Gš$ît½?ª?ÙÄAx?®adöq?¦zç=âI?—™þìÌ"?V,¡Ù€R?’ŒL?22? ÉÐY{w?ª‚¡@?±7ù§úÔ?±eGw?ªQ¼@qÂ(?Ÿñ-ÂÊ?“Ê·UD ?’”æåðlÒ?˜}«²6?œè d”ë?™»ë¡?ÁXèàOÕ?€àæ éÒè?sà ì¾N?qˆ~u[×?zÍÏÑ A?ñ:,hÁ(?Ÿcœzw×?¦ÛŠ9T?¥iî ¢d„?£Ô‘ZSÌ«?ª 2¨Ñ±O?­É!€wx=?¦É=i]?–#¶¾K??œºÞói?yÿÏVÐWN?~œ·™pW?‡ê[Æ™é?–ÄGÖµ‡?¥¶C5 bÅ?¯pá'È?¯:ˆ?©;¥ÜŒ@?¨6™ &²f?§p{’yäB? …×Aåü°?‘©”/'ú?†•&zÄFÊ?Œž6ì€ÒŒ?›ìÑÈÁê?©FW8?°‹öü8o?°-¶ƒ]?©¹hDŒÐð?¢ Ö$À~?–cqE-þú?‹“¡ÈyS?‡ÁÇYV)ä?‰€tÊ®‘¼?‡úùÕ—N?‚ãöʤæõ?|¨¢Ú¯?zÒÉF^§?WV‘ÊïÊ?‹un„«b?˜ÅD‰m?¹¿bû?€t:¿­a?„nŸGÚà?£ ‹É?§XÑ ^P?«Ó¥|¾t?¨ªþï¡‚Â?¦r=àcÀè?¤Á¨ÐxlÎ?cŽÈxåI?ÛGà´+Ê?}ãM(©\L?wÍiáOì?yªY$~?{>.ÜÑïæ?€B¢ÆPÄ®?ˆañîÙ`$?“Û©­¸?œ4†O)?¢Ùuÿl¡k?«de „Ý?±7fç?°kõ}O|?§’7u«*o? Ïdÿ¢sæ?™Ÿø|~?ðñ"ƒ”?„®„Ò[x÷?MѨÒ?‰s9ÿb?ŸXy;Ïè?¦):À3%«?§Ké‰2(?©§öC¹5?¯˜®o?¯Ÿ•£¤?¥I¡e}Ãð?–¯¥¼ bÌ?ˆñ*ݵ~?§Åƒbƒ†?yÓæWw«i?€Êô;rè?yi!¸a?ž×Ø÷]ïŽ?¨ÝÚ¯õíâ?ª7zæÛ·é?¥Z«Ý¥qH?¥žÈ:Ž¸?§†¸èSXð?¡µ$NZ°(?‘xÚÛo?z´®RWrˆ?o5pàj ?q €òý–?x¯Á*êbû?…º¹rÐ?•¶5X®bˆ?¢–ÔK¿æ?¦Ð#=='?¦rÿ®œ6?©1åÜœUª?®[¿¤tÉÆ?«¿÷¯Þ^?¡ßѸò=y?“a:\à¸ÿ?†¯]8'_?~!¨ØÑX?züÁðæ'?ƒyN>5ki?–¦´ŸUÑ?¥ínÙ|d²?­|VôcÇn?©ÓtÊÎ?¤ °g?¥ý®üæU?¦¡„‹2Ù?ž…Ñ´u?Œ r*‘?x V£?p‰'>­tl?r¶QœÂ?~PB¬ ?ŽÈ8ÍHg›? &’r<î?©Õ½]gZ?«Ìþ$?§ÂÌÚ¦Š?§ÕE Ïm°?¨-¯»H?¡­|¹ªî?‰›ˆj*?x†œ¬6Šì?j‡¿øú†x?mÑE_dd?y]Ô/„?‹nu³œ(?ž šMå#?©¥IDl¼'?¬ÏiÆ,½?¦¥·¼&??£“„Ô^ñº?¦ e> ã?¤ŽUž8üg?˜ˆªì^?…ÒÃÌ õ ?uW ÏDß?p_W‡JCæ?tä-*®?ƒ‹‚Ü(q?–?¾íÉ?¦!7ÊCÉm?­Ñ|«{Ï\?ª þ•F2%?£ÏO£—?¥Eó+í¶-?¦<ÌÉi·?žêŠ_òÁ(?i]üNÀA?z7§‘âÌ?pÕàçNN8?rŒÃP?|Ò™Ð;ø?Šl œ|?š “û\J?¤ó[é,v†?¨t–¦h¨¿?§mÿ3á]þ?§w¤Š§?¥Xÿ[„nz?œÌŸj@¡ö?ŠÑ8eªž˜?u™¨ïDÄ?jQ2Wä÷à?n¢CTbÐP?z 65Ó©?‹~˜Ùq‚?ž0ƒ„î†?©°¶6É—f?¬ÙdÕt—?¦¼äú’n?£µ-Z*5kj?tä-*®?p_W‡JCû?uW ÏDà?…ÒÃÌ õ ?˜ˆªìZ?¤ŽUž8üg?¦ e> ä?£“„Ô^ñ»?¦¥·¼&>?¬ÏiÆ,»?©¥IDl¼'?ž šMå"?‹nu³œ$?y]Ô/Ž?mÑE_dt?j‡¿øú†€?x†œ¬6ŠÐ?‰›ˆj*?¡­|¹ªì?¨-¯»G?§ÕE Ïm­?§ÂÌÚ¦‰?«Ìþ%?©Õ½]gZ? &’r<ï?ŽÈ8ÍHg?~PB¬?r¶QœÀ?p‰'>­ti?x Vª?Œ r*?ž…Ñ´u?¦¡„‹2Ú?¥ý®üæU?¤ °g?©ÓtÊÍ?­|VôcÇm?¥ínÙ|d±?–¦´ŸUÒ?MѨÏ?züÁðæ*?~!¨ØÑi?†¯]8'`?“a:\à¹?¡ßѸò=y?«¿÷¯Þ^?®[¿¤tÉÈ?©1åÜœU¬?¦rÿ®œ6?¦Ð#==&?¢–ÔK¿ä?•¶5X®b„?…º¹rÈ?x¯Á*êc?q €òý¢?o5pàj0?z´®RWrŒ?‘xÚÛm?¡µ$NZ°(?§†¸èSXð?¥žÈ:Ž·?¥Z«Ý¥qJ?ª7zæÛ·é?¨ÝÚ¯õíä?ž×Ø÷]ï?yi!¸]?€Êô;rã?yÓæWw«]?§Åƒbƒ€?ˆñ*ݵ„?–¯¥¼ bÐ?¥I¡e}Ãð?¯Ÿ•£§?¯˜®p?©§öC¹7?§Ké‰2(?¦):À3%©?ŸXy;Ïã?‰s9ÿ_?€t:¿­a?„®„Ò[xü?ðñ"ƒ™?™Ÿø|~“? Ïdÿ¢sè?§’7u«*n?°kõ}O|?±7fæ?«de „Þ?¢Ùuÿl¡i?œ4†O(?“Û©­´?ˆañîÙ`"?€B¢ÆPĪ?{>.ÜÑïø?yªY$Š?wÍiáOü?}ãM(©\H?ÛGà´+È?cŽÈxåD?¤Á¨ÐxlÎ?¦r=àcÀê?¨ªþï¡‚Æ?«Ó¥|¾v?§XÑ ^R?›C!­@?ŠŠðß­˜á?ðš9JL?…Œ¯(lF?‘ÒhÃíÊ?›"Êêƒ?¢WQ¿:¡Q?ª¨‰àŒ©?²=ðXïÉ?²]OúUçÔ?ªîLu®fé?¡÷qA|?™„NAXB ?£ ‹ÉD‰t?¦›VúN¿m?§70PúÄr?§ŽøTd©g?¬Ò; Nk?®.àN5Êv?¦!ª1`P?˜Å?¯:†?¯pá'È?¥¶C5 bÅ?–ÄGÖµ?‡ê[Æ™èý?~œ·™pL?yÿÏVÐWO?ƒužŠ4óõ?–#¶¾K??¦É=i^?­É!€wx>?ª 2¨Ñ±P?£Ô‘ZSÌ«?¥iî ¢dƒ?¦ÛŠ9S?ŸcœzwØ?ñ:,hÁ#?zÍÏÑ A ?qˆ~u[Ì?sà ì¾N ?€àæ éÒê?ÁXèàOá?™»ë¡–?œè d”ù?˜}«²;±?¯^Ò}1j?¥˜rî~X?–©ýå˜?‡{ûU´]–?}[¦÷å} ?}ijÙ7iä?ÒT&Z? ÒË]|Ì?«„'lw#Å?®žÍ‚W§G?©\¼ •ç?¢×¾@ð?Ÿ@6ļÒ? žö5Ü®?¤!¹Á «?¥ÆÜ(X??¥Èò~åy?¥Ä#žÎ!?¤ÛD—á§?¦9wu2$?‘î%“/s%?’Z¯ÕOD´?Ÿ ÅUñ%?¦Ì)?§Oîr-?©ƒ¨êv?¯¨ãÍI›?¯?í÷d)?¥~žÒF_)?–ˆïU qË?‡Àƒd#2?}û˜žî>?yì¼R_,»etsf_io-1.0.3/tests/utils/si1002x1-o_DS1_DEN-etsf.ref0000644000353400050620000000017011354120565016605 00000000000000 - No - dielectric_function_data. - No - wavefunctions_data. - Ok - scalar_field_data. - Ok - crystallographic_data. etsf_io-1.0.3/tests/utils/wfs_complex-etsf.nc0000644000353400050620000012755011211470343016205 00000000000000CDF character_string_lengthPcomplexmax_number_of_angular_momentamax_number_of_basis_grid_pointsmax_number_of_coefficientsmax_number_of_projectorsmax_number_of_statesnumber_of_atomsnumber_of_atom_speciesnumber_of_cartesian_directions*number_of_coefficients_dielectric_functionnumber_of_components)number_of_frequencies_dielectric_functionnumber_of_grid_points_vector1 number_of_grid_points_vector2 number_of_grid_points_vector3 number_of_kpointsnumber_of_localization_regions%number_of_qpoints_dielectric_functionnumber_of_qpoints_gamma_limitnumber_of_reduced_dimensionsnumber_of_spinor_componentsnumber_of_spinsnumber_of_symmetry_operationsnumber_of_vectorsreal_or_complex_coefficientsreal_or_complex_densityreal_or_complex_gw_correctionsreal_or_complex_potentialreal_or_complex_wavefunctions symbol_length  file_formatETSF Nanoquantafile_format_version@ff Conventionshttp://www.etsf.eu/fileformats/titleWavefunctions filehistoryCreated by Octopus 3.2.0pre1 primitive_vectors Hreduced_symmetry_matrices  symmorphicyes$Hreduced_symmetry_translationslnumber_of_states„ eigenvalues units atomic unitsscale_to_atomic_units?ðˆ occupationsreduced_coordinates_of_kpoints˜kpoint_weights° basis_setP¸real_space_wavefunctions ¦` @?¾!íµ{ñÆ?»hÊÜr¿??²Wɧçh? ˜/“f’f?µžä¼€ ?¾!íµ{ñÅ?ÀÖë/ýë?¾!íµ{ñÉ?µžä¼€ ? ˜/“f’h?²Wɧçi?»hÊÜr¿??¾!íµ{ñÅ?»hÊÜr¿@?²Wɧçk?§E)Oe?²Wɧçi?µžä¼€ ?²Wɧçj?§E)Od? ˜/“f’i? ˜/“f’e?­ò“›ãfc?¶Ë½Ü€?»É™s»æS?¶Ë½Ü…?­ò“›ãfb?­ò“›ãff?ÀúÏî G?Åz19íÒ?Çx †ØÓ?Åz19íÑ?ÀúÏî H?­ò“›ãfj?¶Ë½Ü…?Åz19íÑ?ËŠÄlN6G?͈ŽƒóÈ?ËŠÄlN6G?Åz19íÒ?¶Ë½Ü…? ˜/“f’e?»É™s»æV?Çx †ØÔ?͈ŽƒóÊ?ÏãÉT?͈ŽƒóÇ?Çx †ØÔ?»É™s»æY? ˜/“f’f?¶Ë½Ü…?Åz19íÑ?ËŠÄlN6G?͈ŽƒóÉ?ËŠÄlN6G?Åz19íÐ?¶Ë½܆?­ò“›ãfi?ÀúÏî I?Åz19íÑ?Çx †ØÕ?Åz19íÒ?ÀúÏî G?­ò“›ãfd?­ò“›ãfe?¶Ë½Ü…?»É™s»æX?¶Ë½܆?­ò“›ãfc? ˜/“f’e?§E)Oa?²Wɧçg?µžä¼€ ?²Wɧçg?§E)Oa?­ò“›ãfj?ÀúÏî G?Åz19íÒ?Çx †ØÓ?Åz19íÒ?ÀúÏî G?­ò“›ãfi?§E)Oc?ÀúÏî I?É£$$à¨?ÏÑŒI sS?Ð÷ÐdWÈ?ÏÑŒI sQ?É£$$àª?ÀúÏî I?§E)Oc?²Wɧçh?Åz19íÐ?ÏÑŒI sN?Ó+gAƒN†?ÔI‡«I?Ó+gAƒN…?ÏÑŒI sO?Åz19íÔ?²Wɧçj?µžä¼€?Çx †ØÔ?Ð÷ÐdWÈ?ÔI‡«J?ÕgÖÎèĆ?ÔI‡«H?Ð÷ÐdWË?Çx †ØÔ?µžä¼€ ?²Wɧçi?Åz19íÒ?ÏÑŒI sM?Ó+gAƒN†?ÔI‡«J?Ó+gAƒN‡?ÏÑŒI sN?Åz19íÓ?²Wɧçh?§E)Ob?ÀúÏî H?É£$$à«?ÏÑŒI sS?Ð÷ÐdWÊ?ÏÑŒI sR?É£$$àª?ÀúÏî H?§E)Oc?­ò“›ãfj?ÀúÏî K?Åz19íÒ?Çx †ØÖ?Åz19íÒ?ÀúÏî I?­ò“›ãfb?§E)Oe?²Wɧçh?µžä¼€ ?²Wɧçl?§E)Oc?²Wɧçg?»hÊÜr¿??¾!íµ{ñÂ?»hÊÜr¿>?²Wɧçg?¶Ë½Ü„?Åz19íÐ?ËŠÄlN6G?͈ŽƒóÄ?ËŠÄlN6F?Åz19íÐ?¶Ë½Ü„?²Wɧçh?Åz19íÒ?ÏÑŒI sP?Ó+gAƒN‰?ÔI‡«H?Ó+gAƒN†?ÏÑŒI sM?Åz19íÒ?²Wɧçi?»hÊÜr¿<?ËŠÄlN6F?Ó+gAƒN…?Ö•àN°¯¡?×Àäôæ?Ö•àN°¯ž?Ó+gAƒNˆ?ËŠÄlN6F?»hÊÜr¿??¾!íµ{ñÂ?͈ŽƒóÉ?ÔI‡«I?×Àäôæ?Øó㊸S?×Àäôæ?ÔI‡«J?͈ŽƒóÉ?¾!íµ{ñÅ?»hÊÜr¿<?ËŠÄlN6G?Ó+gAƒN…?Ö•àN°¯¡?×Àäôæ?Ö•àN°¯¢?Ó+gAƒN‡?ËŠÄlN6H?»hÊÜr¿@?²Wɧçi?Åz19íÑ?ÏÑŒI sM?Ó+gAƒNˆ?ÔI‡«J?Ó+gAƒN‰?ÏÑŒI sM?Åz19íÑ?²Wɧçi?¶Ë½Ü…?Åz19íÓ?ËŠÄlN6I?͈ŽƒóÉ?ËŠÄlN6G?Åz19íÏ?¶Ë½܆?²Wɧçh?»hÊÜr¿@?¾!íµ{ñÆ?»hÊÜr¿??²Wɧçi?•Õ¦HNR? ˜/“f’f?µžä¼€ ?¾!íµ{ñÄ?ÀÖë/ýê?¾!íµ{ñÄ?µžä¼€? ˜/“f’f? ˜/“f’h?»É™s»æU?Çx †ØÑ?͈ŽƒóÆ?ÏãÉT?͈ŽƒóÆ?Çx †ØÕ?»É™s»æU? ˜/“f’g?µžä¼€?Çx †ØÒ?Ð÷ÐdWÊ?ÔI‡«I?ÕgÖÎèĆ?ÔI‡«I?Ð÷ÐdWÆ?Çx †ØÕ?µžä¼€ ?¾!íµ{ñÃ?͈ŽƒóÈ?ÔI‡«I?×Àäôæ?Øó㊸R?×Àäôæ?ÔI‡«I?͈ŽƒóÉ?¾!íµ{ñÄ?•Õ¦HNP?ÀÖë/ýê?ÏãÉT?ÕgÖÎèĆ?Øó㊸S?Ú)°mòõ?Øó㊸T?ÕgÖÎèĆ?ÏãÉT?ÀÖë/ýë?•Õ¦HNP?¾!íµ{ñÃ?͈ŽƒóÉ?ÔI‡«H?×Àäôæ?Øó㊸S?×Àäôæ?ÔI‡«J?͈ŽƒóÊ?¾!íµ{ñÅ?µžä¼€?Çx †ØÔ?Ð÷ÐdWÉ?ÔI‡«H?ÕgÖÎèĈ?ÔI‡«J?Ð÷ÐdWÊ?Çx †Ø×?µžä¼€ ? ˜/“f’f?»É™s»æW?Çx †ØÔ?͈ŽƒóË?ÏãÉT?͈ŽƒóÈ?Çx †ØÖ?»É™s»æY? ˜/“f’g? ˜/“f’g?µžä¼€?¾!íµ{ñÄ?ÀÖë/ýê?¾!íµ{ñÆ?µžä¼€ ? ˜/“f’g?•Õ¦HNQ?²Wɧçg?»hÊÜr¿>?¾!íµ{ñÃ?»hÊÜr¿=?²Wɧçf?¶Ë½Ü?Åz19íÐ?ËŠÄlN6E?͈ŽƒóÇ?ËŠÄlN6D?Åz19íÎ?¶Ë½܃?²Wɧçf?Åz19íÎ?ÏÑŒI sK?Ó+gAƒN†?ÔI‡«I?Ó+gAƒN…?ÏÑŒI sN?Åz19íÏ?²Wɧçg?»hÊÜr¿>?ËŠÄlN6D?Ó+gAƒN„?Ö•àN°¯ ?×Àäôæ?Ö•àN°¯ ?Ó+gAƒN†?ËŠÄlN6F?»hÊÜr¿>?¾!íµ{ñÁ?͈ŽƒóÈ?ÔI‡«G?×Àäôæ?Øó㊸S?×Àäôæ?ÔI‡«I?͈ŽƒóÈ?¾!íµ{ñÆ?»hÊÜr¿=?ËŠÄlN6G?Ó+gAƒN†?Ö•àN°¯¢?×Àäôæ?Ö•àN°¯ ?Ó+gAƒN‡?ËŠÄlN6G?»hÊÜr¿A?²Wɧçg?Åz19íÐ?ÏÑŒI sM?Ó+gAƒN‡?ÔI‡«I?Ó+gAƒNˆ?ÏÑŒI sN?Åz19íÒ?²Wɧçj?¶Ë½܃?Åz19íÏ?ËŠÄlN6F?͈ŽƒóË?ËŠÄlN6F?Åz19íÐ?¶Ë½Ü…?²Wɧçf?»hÊÜr¿A?¾!íµ{ñÆ?»hÊÜr¿??²Wɧçh?§E)O_?²Wɧçf?µžä¼€?²Wɧçf?§E)O`?­ò“›ãf\?ÀúÏî G?Åz19íÏ?Çx †ØÑ?Åz19íÐ?ÀúÏî G?­ò“›ãfc?§E)O]?ÀúÏî F?É£$$à¦?ÏÑŒI sI?Ð÷ÐdWÉ?ÏÑŒI sL?É£$$àª?ÀúÏî I?§E)O`?²Wɧçf?Åz19íÏ?ÏÑŒI sL?Ó+gAƒN…?ÔI‡«H?Ó+gAƒN†?ÏÑŒI sL?Åz19íÐ?²Wɧçf?µžä¼€?Çx †ØÔ?Ð÷ÐdWÆ?ÔI‡«G?ÕgÖÎèĆ?ÔI‡«J?Ð÷ÐdWÉ?Çx †ØÖ?µžä¼€ ?²Wɧçf?Åz19íÑ?ÏÑŒI sJ?Ó+gAƒN†?ÔI‡«I?Ó+gAƒN‡?ÏÑŒI sO?Åz19íÑ?²Wɧçf?§E)O`?ÀúÏî G?É£$$à«?ÏÑŒI sO?Ð÷ÐdWÊ?ÏÑŒI sP?É£$$à©?ÀúÏî F?§E)Oa?­ò“›ãfc?ÀúÏî G?Åz19íÒ?Çx †ØÕ?Åz19íÒ?ÀúÏî H?­ò“›ãfc?§E)O`?²Wɧçi?µžä¼€ ?²Wɧçh?§E)Ob? ˜/“f’e?­ò“›ãf`?¶Ë½Ü‚?»É™s»æQ?¶Ë½܃?­ò“›ãfc?­ò“›ãf\?ÀúÏî F?Åz19íÎ?Çx †ØÔ?Åz19íÎ?ÀúÏî G?­ò“›ãfd?¶Ë½Ü‚?Åz19íÎ?ËŠÄlN6C?͈ŽƒóÆ?ËŠÄlN6C?Åz19íÑ?¶Ë½Ü„? ˜/“f’f?»É™s»æS?Çx †ØÔ?͈ŽƒóÇ?ÏãÉT?͈ŽƒóÆ?Çx †ØÔ?»É™s»æT? ˜/“f’f?¶Ë½Ü„?Åz19íÐ?ËŠÄlN6G?͈ŽƒóÇ?ËŠÄlN6H?Åz19íÐ?¶Ë½Ü„?­ò“›ãfc?ÀúÏî G?Åz19íÐ?Çx †ØÕ?Åz19íÒ?ÀúÏî H?­ò“›ãfb?­ò“›ãfe?¶Ë½܃?»É™s»æW?¶Ë½Ü„?­ò“›ãfe? ˜/“f’h? ˜/“f’d?§E)O]?²Wɧçf?µžä¼€?²Wɧçe?§E)O^?²Wɧçg?»hÊÜr¿<?¾!íµ{ñÁ?»hÊÜr¿<?²Wɧçf? ˜/“f’f?µžä¼€ ?¾!íµ{ñÄ?ÀÖë/ýê?¾!íµ{ñÅ?µžä¼€? ˜/“f’f?²Wɧçf?»hÊÜr¿>?¾!íµ{ñÂ?»hÊÜr¿>?²Wɧçh?§E)O`?²Wɧçg?µžä¼€ ?²Wɧçg?§E)O`? ˜/“f’e?•Õ¦HNNetsf_io-1.0.3/tests/utils/wfs_complex-etsf.ref0000644000353400050620000000017011354120561016347 00000000000000 - No - dielectric_function_data. - Ok - wavefunctions_data. - No - scalar_field_data. - No - crystallographic_data. etsf_io-1.0.3/tests/utils/wfs_real-etsf.nc0000644000353400050620000003104411211470343015451 00000000000000CDF character_string_lengthPcomplexmax_number_of_angular_momentamax_number_of_basis_grid_pointsmax_number_of_coefficientsmax_number_of_projectorsmax_number_of_statesnumber_of_atomsnumber_of_atom_speciesnumber_of_cartesian_directions*number_of_coefficients_dielectric_functionnumber_of_components)number_of_frequencies_dielectric_functionnumber_of_grid_points_vector1 number_of_grid_points_vector2 number_of_grid_points_vector3 number_of_kpointsnumber_of_localization_regions%number_of_qpoints_dielectric_functionnumber_of_qpoints_gamma_limitnumber_of_reduced_dimensionsnumber_of_spinor_componentsnumber_of_spinsnumber_of_symmetry_operationsnumber_of_vectorsreal_or_complex_coefficientsreal_or_complex_densityreal_or_complex_gw_correctionsreal_or_complex_potentialreal_or_complex_wavefunctions symbol_length  file_formatETSF Nanoquantafile_format_version@ff Conventionshttp://www.etsf.eu/fileformats/titleWavefunctions filehistoryCreated by Octopus 3.2.0pre1 primitive_vectors HÔreduced_symmetry_matrices  symmorphicyes$reduced_symmetry_translations@number_of_statesX eigenvalues units atomic unitsscale_to_atomic_units?ð\ occupationsdreduced_coordinates_of_kpointslkpoint_weights„real_space_wavefunctions )˜Œ@‘Î?ÔM­6' º?Ð÷Öl‘Ú?ÇnÕQ xŠ?µÁ§_E?²Ji.ÙÆ’?Åp¬ñ’Ú?ÏÍ ›Ž’=?Ó-í¶aÑ?ÔM­6' º?Ó-í¶aÑ?ÏÍ ›Ž’>?Åp¬ñ’Ú?²Ji.ÙÆ•?§{øHáö?À`åŸpâ?ÉšðD9Ñã?ÏÍ ›Ž’A?Ð÷Öl‘Û?ÏÍ ›Ž’>?ÉšðD9Ñå?À`åŸpâ?§{øHáö?­ÜE„¼?À`åŸpâ?Åp¬ñ’Ù?ÇnÕQ x‰?Åp¬ñ’Û?À`åŸpã?­ÜE„¿?§{øHáõ?²Ji.ÙÆ’?µÁ§_E?²Ji.ÙÆ–?§{øHáö?²Ji.ÙÆ’?»WÅ‚7Úí?¾·ŒK ?»WÅ‚7Úì?²Ji.ÙÆ’?¶¼iˆ¥Ñ?Åp¬ñ’Ù?˃sËM?Í‚Û1+÷u?˃sËM?Åp¬ñ’Ú?¶¼iˆ¥Ô?²Ji.ÙÆ’?Åp¬ñ’Ø?ÏÍ ›Ž’‘Ì?ÔM­6' ¸?Ð÷Öl‘Û?ÇnÕQ xŠ?µÁ§_E?¾·ŒK?Í‚Û1+÷u?ÔM­6' ·?×ÍÀÅ0?ÙBBT(B?×ÍÀÅ4?ÔM­6' ¸?Í‚Û1+÷v?¾·ŒK?•Å¿$eo?ÀÍ9x¹5ª?Ï‹y¾…Ú¥?ÕnÜG>‘Ì?ÙBBT(A?Ú=`8ì·–?ÙBBT(A?ÕnÜG>‘Î?Ï‹y¾…Ú¤?ÀÍ9x¹5«?•Å¿$eq?¾·ŒK?Í‚Û1+÷v?ÔM­6' º?×ÍÀÅ2?ÙBBT(A?×ÍÀÅ1?ÔM­6' ¹?Í‚Û1+÷w?¾·ŒK?µÁ§_E?ÇnÕQ x‰?Ð÷Öl‘Ù?ÔM­6' ¹?ÕnÜG>‘Î?ÔM­6' ¹?Ð÷Öl‘Ü?ÇnÕQ xŒ?µÁ§_E? Š†^ÌÉ„?»¸4$U?ÇnÕQ x‰?Í‚Û1+÷v?Ï‹y¾…Ú¦?Í‚Û1+÷w?ÇnÕQ xŠ?»¸4$U‚? Š†^ÌÉ‚? Š†^ÌɃ?µÁ§_E?¾·ŒK?ÀÍ9x¹5«?¾·ŒK?µÁ§_E? Š†^ÌɃ?•Å¿$ep?²Ji.ÙÆ?»WÅ‚7Úë?¾·ŒK ?»WÅ‚7Úë?²Ji.ÙÆ”?¶¼iˆ¥Ï?Åp¬ñ’Ø?˃sËM?Í‚Û1+÷r?˃sËM?Åp¬ñ’Ú?¶¼iˆ¥Ò?²Ji.ÙÆ“?Åp¬ñ’Ø?ÏÍ ›Ž’;?Ó-í¶aÐ?ÔM­6' ¸?Ó-í¶aÎ?ÏÍ ›Ž’=?Åp¬ñ’Ú?²Ji.ÙÆ’?»WÅ‚7Úì?˃sËM?Ó-í¶aÍ?ÖŸŸFJ£à?×ÍÀÅ1?ÖŸŸFJ£à?Ó-í¶aÑ?˃sËM?»WÅ‚7Úë?¾·ŒK ?Í‚Û1+÷w?ÔM­6' ¹?×ÍÀÅ1?ÙBBT(@?×ÍÀÅ1?ÔM­6' ¹?Í‚Û1+÷w?¾·ŒK ?»WÅ‚7Úì?˃sËM?Ó-í¶aÏ?ÖŸŸFJ£à?×ÍÀÅ1?ÖŸŸFJ£à?Ó-í¶aÏ?˃sËM?»WÅ‚7Úë?²Ji.ÙÆ‘?Åp¬ñ’Ø?ÏÍ ›Ž’?Åp¬ñ’Ú?²Ji.ÙÆ’?¶¼iˆ¥Ñ?Åp¬ñ’Ú?˃sËM?Í‚Û1+÷x?˃sËM?Åp¬ñ’Ú?¶¼iˆ¥Ò?²Ji.ÙÆ“?»WÅ‚7Úë?¾·ŒK?»WÅ‚7Úë?²Ji.ÙÆ’?§{øHáô?²Ji.ÙÆ‘?µÁ§_E?²Ji.ÙÆ?§{øHáõ?­ÜE„¼?À`åŸpá?Åp¬ñ’×?ÇnÕQ x†?Åp¬ñ’Ø?À`åŸpá?­ÜE„¿?§{øHá÷?À`åŸpá?ÉšðD9Ñâ?ÏÍ ›Ž’?Åp¬ñ’Ø?²Ji.ÙÆ‘?µÁ§_E?ÇnÕQ xˆ?Ð÷Öl‘Ú?ÔM­6' ¸?ÕnÜG>‘Ë?ÔM­6' ¶?Ð÷Öl‘Ù?ÇnÕQ xˆ?µÁ§_E?²Ji.ÙÆ‘?Åp¬ñ’Û?ÏÍ ›Ž’;?Ó-í¶aÐ?ÔM­6' ¹?Ó-í¶aÏ?ÏÍ ›Ž’>?Åp¬ñ’Ú?²Ji.ÙÆ’?§{øHáõ?À`åŸpà?ÉšðD9Ñä?ÏÍ ›Ž’/dev/null 2>&1; then \ include_option=--etags-include; \ empty_fix=.; \ else \ include_option=--include; \ empty_fix=; \ fi; \ list='$(SUBDIRS)'; for subdir in $$list; do \ if test "$$subdir" = .; then :; else \ test ! -f $$subdir/TAGS || \ tags="$$tags $$include_option=$$here/$$subdir/TAGS"; \ fi; \ done; \ list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ unique=`for i in $$list; do \ if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ done | \ $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ END { if (nonempty) { for (i in files) print i; }; }'`; \ if test -z "$(ETAGS_ARGS)$$tags$$unique"; then :; else \ test -n "$$unique" || unique=$$empty_fix; \ $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ $$tags $$unique; \ fi ctags: CTAGS CTAGS: ctags-recursive $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \ $(TAGS_FILES) $(LISP) tags=; \ list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ unique=`for i in $$list; do \ if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ done | \ $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ END { if (nonempty) { for (i in files) print i; }; }'`; \ test -z "$(CTAGS_ARGS)$$tags$$unique" \ || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ $$tags $$unique GTAGS: here=`$(am__cd) $(top_builddir) && pwd` \ && cd $(top_srcdir) \ && gtags -i $(GTAGS_ARGS) $$here distclean-tags: -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags distdir: $(DISTFILES) @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ list='$(DISTFILES)'; \ dist_files=`for file in $$list; do echo $$file; done | \ sed -e "s|^$$srcdirstrip/||;t" \ -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ case $$dist_files in \ */*) $(MKDIR_P) `echo "$$dist_files" | \ sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ sort -u` ;; \ esac; \ for file in $$dist_files; do \ if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ if test -d $$d/$$file; then \ dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ cp -pR $(srcdir)/$$file $(distdir)$$dir || exit 1; \ fi; \ cp -pR $$d/$$file $(distdir)$$dir || exit 1; \ else \ test -f $(distdir)/$$file \ || cp -p $$d/$$file $(distdir)/$$file \ || exit 1; \ fi; \ done list='$(DIST_SUBDIRS)'; for subdir in $$list; do \ if test "$$subdir" = .; then :; else \ test -d "$(distdir)/$$subdir" \ || $(MKDIR_P) "$(distdir)/$$subdir" \ || exit 1; \ distdir=`$(am__cd) $(distdir) && pwd`; \ top_distdir=`$(am__cd) $(top_distdir) && pwd`; \ (cd $$subdir && \ $(MAKE) $(AM_MAKEFLAGS) \ top_distdir="$$top_distdir" \ distdir="$$distdir/$$subdir" \ am__remove_distdir=: \ am__skip_length_check=: \ distdir) \ || exit 1; \ fi; \ done check-am: all-am check: check-recursive all-am: Makefile $(DATA) installdirs: installdirs-recursive installdirs-am: for dir in "$(DESTDIR)$(docdir)"; do \ test -z "$$dir" || $(MKDIR_P) "$$dir"; \ done install: install-recursive install-exec: install-exec-recursive install-data: install-data-recursive uninstall: uninstall-recursive install-am: all-am @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am installcheck: installcheck-recursive install-strip: $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ `test -z '$(STRIP)' || \ echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install mostlyclean-generic: clean-generic: distclean-generic: -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) maintainer-clean-generic: @echo "This command is intended for maintainers to use" @echo "it deletes files that may require special tools to rebuild." clean: clean-recursive clean-am: clean-generic mostlyclean-am distclean: distclean-recursive -rm -f Makefile distclean-am: clean-am distclean-generic distclean-tags dvi: dvi-recursive dvi-am: html: html-recursive info: info-recursive info-am: install-data-am: install-docDATA install-dvi: install-dvi-recursive install-exec-am: install-html: install-html-recursive install-info: install-info-recursive install-man: install-pdf: install-pdf-recursive install-ps: install-ps-recursive installcheck-am: maintainer-clean: maintainer-clean-recursive -rm -f Makefile maintainer-clean-am: distclean-am maintainer-clean-generic mostlyclean: mostlyclean-recursive mostlyclean-am: mostlyclean-generic pdf: pdf-recursive pdf-am: ps: ps-recursive ps-am: uninstall-am: uninstall-docDATA .MAKE: $(RECURSIVE_CLEAN_TARGETS) $(RECURSIVE_TARGETS) install-am \ install-strip .PHONY: $(RECURSIVE_CLEAN_TARGETS) $(RECURSIVE_TARGETS) CTAGS GTAGS \ all all-am check check-am clean clean-generic ctags \ ctags-recursive distclean distclean-generic distclean-tags \ distdir dvi dvi-am html html-am info info-am install \ install-am install-data install-data-am install-docDATA \ install-dvi install-dvi-am install-exec install-exec-am \ install-html install-html-am install-info install-info-am \ install-man install-pdf install-pdf-am install-ps \ install-ps-am install-strip installcheck installcheck-am \ installdirs installdirs-am maintainer-clean \ maintainer-clean-generic mostlyclean mostlyclean-generic pdf \ pdf-am ps ps-am tags tags-recursive uninstall uninstall-am \ uninstall-docDATA # Tell versions [3.59,3.63) of GNU make to not export all variables. # Otherwise a system limit (for SysV at least) may be exceeded. .NOEXPORT: etsf_io-1.0.3/doc/www/index.html0000644000353400050620000002602010656551507013466 00000000000000 ETSF_IO library

What is it?

ETSF_IO is a library build on top of NetCDF that gives easy access to files conforming to the ETSF specifications (see the ETSF specification page). NetCDF files are binary files with key-values access, optimized to store large volume of data. The ETSF specifications define all key-value pairs that are normalized for a file containing informations of an electronic calculation.

License

The library and all its contents (source files and documentation files) is released under the Lesser General Public License as it can be found in the COPYING file of the distribution.

Contents of this documentation

The documentation of the library is made of two parts:

  • One appropriated for beginners who would like to know how to read and write some ETSF files using this library. See the tutorials pages. Several examples are explained step by step.
  • The other is the description of all public routines that can be used. Their functions, their arguments and some examples are given, as much as the code itself when relevant.

The libraries

ETSF_IO is shipped with several libraries. These libraries gives from low-level access to high-level routines on ETSF files. Each library contains one or several modules, as described below.

etsf_io_low_level (libetsf_io_low_level.a)

The library is made of one unique module. This is a wrapper around NetCDF calls to be able to do in one call what requires several NetCDF calls, such as get the id of a variable, check its shape and dimensions definition and read it. This module is not specific to the ETSF specifications and can be used as a stand-alone library to easily handle NetCDF files.

  • Tutorial 5 is not focus on the low level API but it uses it in several areas. This tutorial shows how to write an ETSF file with additional non-ETSF variables. These variables are defined and written directly by using the low level API.

etsf_io (libetsf_io.a)

It is also made of one unique module, called etsf_io, containing specific routines to the ETSF specifications.

Beware that the library built on that module includes the etsf_io_low_level module. This means that linking with libetsf_io.a implies linking with etsf_io_low_level.

This module is the core of ETSF_IO. All variables from the specifications have been gathered into structured called group (see the etsf_groups page and related ones).

For each group, one can define a file with these variables using methods with a name like etsf_io_<group_name>_def(). This will alocate the disk space required to store all the variables of the group. Then, to write data, methods called etsf_io_<group_name>_put() are available. For reading actions, the routines are suffixed with get instead of put. To access several groups at one time a high level routine has been created and is called etsf_io_data_<action>.

There are four tutorials to learn how to use this module:

  • Tutorial 1 is intended to explain the basics and the philosophy of this library. It details the first steps required to create a density file, using high level routines (etsf_io_data_<action>). It shows how to use the pointers and the unformatted ones (used to map any shape arrays between the ETSF definition and the main program memory).
  • Tutorial 2 introduced the group level routines and explain how to access only sub part of arrays. This sub access is possible when one array has a dimension on spin or k points. Then one can access data for one k point or spin at a time. This is controlled by some attributes in the concerned groups, called <short_var_name>__[spin|kpoint]_access. In this tutorial a wave-function file is created and the coefficients of wave-functions are written for one k point at a time.
  • Tutorial 4 shows how to use the split definitions as defined in the specifications to handle MPI computations. This tutorial creates a density file with a paralelisation on z planes.
  • Tutorial 5 shows how to use the etsf_io_<group_name>_put() methods in the context of a concurrent list of ETSF and non-ETSF variables.
  • Tutorial 6 shows how to use the etsf_io_<group_name>_get() methods in the simpliest way, also reading possible split definitions.

etsf_io_file & etsf_io_tools (libetsf_io_utils.a)

This library contains two modules, etsf_io_file which is dedicated to high level actions on ETSF files (merge, check...) and etsf_io_tools which implements some not mandatory routines but convenient to handle data from ETSF files (get element names...).

etsf_io_file is a not mandatory high level module. It contains several routines to do complex action on ETSF files (see the API page):

  • The merge routine can read several ETSF files and create a new one, copying all variables that are not splitted and merging those that have a split definition. If there is not enough input file to create a full unsplitted array, the new file will contains some new split informations resulting from the merge. This routine also copy headers and attributes, as for all none-ETSF variables and dimensions.
  • The contents routine is used to get the specifications the file is matching and reasons why it fails on some.
  • The check routine is used to validate the file on themes as defined in the specifications.

etsf_io_tools is a not mandatory high level module. It contains some tools to do common high-level actions on ETSF data (see the API page):

  • A method to retrieve the names of the element in a crystallographic file, whatever variables are present in the read ETSF file.
  • Two routines to handle the use_time_reversal_at_gamma attribute as defined in the 2.2 specifications.

The usage of these modules is illustrated by several tutorials:

  • Tutorial 3 shows how to use high level modules etsf_io_file and etsf_io_tools to check the conformance of an input ETSF file on cristalographic specifications and then to read atomic coordinates and names to create a simple XYZ file.
  • Previously presented Tutorial 2 has a line on how to write the use_time_reversal_at_gamma attribute (see Tutorial 6 for the read counterpart).

Attributes

The support for attributes as defined in the specifications is transparent for the user of the library:

  • The units attribute is defined by default to "atomic units". When a file is read, all returned values are automatically converted to atomic units when required, thanks to the scale_to-atomic_units attribute. To get the true value from the file, one can give an optional argument to prevent to convert into atomic units, called use_atomic_units (logical).
  • The k_dependent attribute is set to "yes" by default. When a variable with the k_dependent attribute is read, the value from the array is read except if the attribute is "no". Then the fallback value specified in the ETSF specifications is given.
  • The symmorphic attribute is set to "no" automatically as soon as reduced_symmetry_translations is set to non zero values.
  • The time reversal symmetry at Gamma attribute is not handled automatically by the libetsf_io.a library, but two routines (get and set) have been written in the etsf_io_tools module (see libetsf_io_utils.a). These routines check the validity of the presence of the attribute and can write or read its contents easily (see Tutorial 2 or Tutorial 6).
etsf_io-1.0.3/doc/www/masterindex.html0000644000353400050620000006072611354150415014702 00000000000000 Index

Index

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

C

convert_to_xyz convert_to_xyz.f90 create_a_crystal_den_file create_a_crystal_den_file.f90

E

ERROR_MODE ERROR_TYPE etsf_basisdata etsf_dielectric etsf_dims etsf_electrons etsf_geometry etsf_groups etsf_groups_flags etsf_gwdata etsf_io etsf_io.f90 etsf_io_basics_group etsf_io_basisdata_copy etsf_io_basisdata_copy.f90 etsf_io_basisdata_def etsf_io_basisdata_def.f90 etsf_io_basisdata_get etsf_io_basisdata_get.f90 etsf_io_basisdata_put etsf_io_basisdata_put.f90 ETSF_IO_CONSTANTS etsf_io_data_contents etsf_io_data_contents.f90 etsf_io_data_copy etsf_io_data_copy.f90 etsf_io_data_get etsf_io_data_get.f90 etsf_io_data_group etsf_io_data_init etsf_io_data_init.f90 etsf_io_data_read etsf_io_data_read.f90 etsf_io_data_write etsf_io_data_write.f90 etsf_io_dielectric_copy etsf_io_dielectric_copy.f90 etsf_io_dielectric_def etsf_io_dielectric_def.f90 etsf_io_dielectric_get etsf_io_dielectric_get.f90 etsf_io_dielectric_put etsf_io_dielectric_put.f90 etsf_io_dims_def etsf_io_dims_def.f90 etsf_io_dims_get etsf_io_dims_get.f90 etsf_io_dims_merge etsf_io_dims_merge.f90 etsf_io_dims_trace etsf_io_dims_trace.f90 etsf_io_electrons_copy etsf_io_electrons_copy.f90 etsf_io_electrons_def etsf_io_electrons_def.f90 etsf_io_electrons_get etsf_io_electrons_get.f90 etsf_io_electrons_put etsf_io_electrons_put.f90 etsf_io_file etsf_io_file.f90 etsf_io_file_check etsf_io_file_check_crystallographic_data etsf_io_file_check_crystallographic_data.f90 etsf_io_file_check_dielectric_function_data etsf_io_file_check_dielectric_function_data.f90 etsf_io_file_check_scalar_field_data etsf_io_file_check_scalar_field_data.f90 etsf_io_file_check_wavefunctions_data etsf_io_file_check_wavefunctions_data.f90 etsf_io_file_contents etsf_io_file_contents.f90 etsf_io_file_merge etsf_io_file_public.f90 etsf_io_geometry_copy etsf_io_geometry_copy.f90 etsf_io_geometry_def etsf_io_geometry_def.f90 etsf_io_geometry_get etsf_io_geometry_get.f90 etsf_io_geometry_put etsf_io_geometry_put.f90 etsf_io_gwdata_copy etsf_io_gwdata_copy.f90 etsf_io_gwdata_def etsf_io_gwdata_def.f90 etsf_io_gwdata_get etsf_io_gwdata_get.f90 etsf_io_gwdata_put etsf_io_gwdata_put.f90 etsf_io_kpoints_copy etsf_io_kpoints_copy.f90 etsf_io_kpoints_def etsf_io_kpoints_def.f90 etsf_io_kpoints_get etsf_io_kpoints_get.f90 etsf_io_kpoints_put etsf_io_kpoints_put.f90 etsf_io_low_check_att etsf_io_low_check_group etsf_io_low_check_header etsf_io_low_check_var etsf_io_low_close ETSF_IO_LOW_CONSTANTS etsf_io_low_copy_all_att etsf_io_low_def_var etsf_io_low_error etsf_io_low_error_group etsf_io_low_error_handle etsf_io_low_error_len etsf_io_low_error_set etsf_io_low_error_to_str etsf_io_low_error_update etsf_io_low_file_group etsf_io_low_free_all_var_infos etsf_io_low_free_var_infos etsf_io_low_level etsf_io_low_level.f90 etsf_io_low_open_create etsf_io_low_open_modify etsf_io_low_open_read etsf_io_low_read_all_var_infos etsf_io_low_read_att etsf_io_low_read_dim etsf_io_low_read_flag etsf_io_low_read_group etsf_io_low_read_var etsf_io_low_read_var_infos etsf_io_low_set_define_mode etsf_io_low_set_write_mode etsf_io_low_var etsf_io_low_var_associated etsf_io_low_var_double etsf_io_low_var_infos etsf_io_low_var_integer etsf_io_low_var_multiply etsf_io_low_write_att etsf_io_low_write_dim etsf_io_low_write_group etsf_io_low_write_var etsf_io_main_copy etsf_io_main_copy.f90 etsf_io_main_def etsf_io_main_def.f90 etsf_io_main_get etsf_io_main_get.f90 etsf_io_main_put etsf_io_main_put.f90 etsf_io_phonons_copy etsf_io_phonons_copy.f90 etsf_io_phonons_def etsf_io_phonons_def.f90 etsf_io_phonons_get etsf_io_phonons_get.f90 etsf_io_phonons_put etsf_io_phonons_put.f90 etsf_io_split_allocate etsf_io_split_allocate.f90 etsf_io_split_copy etsf_io_split_copy.f90 etsf_io_split_def etsf_io_split_def.f90 etsf_io_split_free etsf_io_split_free.f90 etsf_io_split_get etsf_io_split_get.f90 etsf_io_split_init etsf_io_split_init.f90 etsf_io_split_merge etsf_io_split_merge.f90 etsf_io_split_put etsf_io_split_put.f90 etsf_io_tools etsf_io_tools.f90 etsf_io_tools_get_atom_names etsf_io_tools_get_time_reversal_symmetry etsf_io_tools_set_time_reversal_symmetry etsf_io_tutorials ETSF_IO_VALIDITY_FLAGS etsf_io_vars_free etsf_io_vars_free.f90 etsf_kpoints etsf_main etsf_split etsf_vars

F

FLAGS_GROUPS FLAGS_VARIABLES

M

mix_ETSF_and_non_ETSF mix_ETSF_and_non_ETSF.f90 MPI_output_of_a_density MPI_output_of_a_density.f90

P

pad public_variables.f90

R

read_a_file read_a_file.f90 read_routines.f90 read_write_sub_access read_write_sub_access.f90 README.f90

S

strip

W

write_routines.f90

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

etsf_io-1.0.3/doc/www/robo_definitions.html0000644000353400050620000000761411354150415015710 00000000000000 Definitions

Definitions

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

E

ERROR_MODE ERROR_TYPE ETSF_IO_CONSTANTS ETSF_IO_LOW_CONSTANTS etsf_io_low_error_len ETSF_IO_VALIDITY_FLAGS

F

FLAGS_GROUPS FLAGS_VARIABLES

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

etsf_io-1.0.3/doc/www/robodoc.css0000644000353400050620000001430411354150416013622 00000000000000/****h* ROBODoc/ROBODoc Cascading Style Sheet * FUNCTION * This is the default cascading style sheet for documentation * generated with ROBODoc. * You can edit this file to your own liking and then use * it with the option * --css * * This style-sheet defines the following layout * +----------------------------------------+ * | logo | * +----------------------------------------+ * | extra | * +----------------------------------------+ * | | navi- | * | | gation | * | content | | * | | | * +----------------------------------------+ * | footer | * +----------------------------------------+ * * This style-sheet is based on a style-sheet that was automatically * generated with the Strange Banana stylesheet generator. * See http://www.strangebanana.com/generator.aspx * ****** * $Id: html_generator.c,v 1.83 2006/12/10 12:32:41 thuffir Exp $ */ body { background-color: rgb(255,255,255); color: rgb(98,84,55); font-family: Arial, serif; border-color: rgb(226,199,143); } pre { font-family: monospace; margin: 15px; padding: 5px; white-space: pre; color: #000; } pre.source { background-color: #ffe; border: dashed #aa9 1px; } p { margin:15px; } p.item_name { font-weight: bolder; margin:5px; font-size: 120%; } div.warning { margin-right: 50px; margin-left: 50px; padding-right: 5px; padding-left: 5px; border-left: 5px rgb(250,100,100) solid; background-color: rgb(255,230,230); } #content { font-size: 100%; color: rgb(0,0,0); background-color: rgb(255,255,255); border-left-width: 0px; border-right-width: 0px; border-top-width: 0px; border-bottom-width: 0px; border-left-style: none; border-right-style: none; border-top-style: none; border-bottom-style: none; padding: 40px 31px 14px 17px; border-color: rgb(0,0,0); text-align: justify; } #navigation { background-color: rgb(98,84,55); color: rgb(230,221,202); font-family: "Times New Roman", serif; font-style: normal; border-color: rgb(0,0,0); } #navigation a { font-size: 140%; background-color: rgb(0,0,0); color: rgb(195,165,100); font-variant: normal; text-transform: none; font-weight: normal; padding: 1px 8px 3px 1px; margin-left: 5px; margin-right: 5px; margin-top: 5px; margin-bottom: 5px; border-color: rgb(159,126,57); text-align: right; text-decoration: none; display: block; width: auto; } #navigation a.level2 { font-size: 120%; background-color: rgb(50,50,50); padding-right:20px; } #navigation a:hover { background-color: rgb(195,165,100); color: rgb(0,0,0); } #logo, #logo a { font-size: 130%; background-color: rgb(198,178,135); color: rgb(98,84,55); font-family: Georgia, serif; font-style: normal; font-variant: normal; text-transform: none; font-weight: bold; padding: 20px 18px 20px 18px; border-color: rgb(255,255,255); text-align: right; } #extra, #extra a { font-size: 128%; background-color: rgb(0,0,0); color: rgb(230,221,202); font-style: normal; font-variant: normal; text-transform: none; font-weight: normal; border-left-width: 0px; border-right-width: 0px; border-top-width: 0px; border-bottom-width: 0px; border-left-style: none; border-right-style: none; border-top-style: none; border-bottom-style: none; padding: 12px 12px 12px 12px; border-color: rgb(195,165,100); text-align: center; } #content a { color: rgb(159,126,57); text-decoration: none; } #content a:hover, #content a:active { color: rgb(255,255,255); background-color: rgb(159,126,57); } a.indexitem { display: block; } h1, h2, h3, h4, h5, h6 { background-color: rgb(221,221,221); font-family: Arial, serif; font-style: normal; font-variant: normal; text-transform: none; font-weight: normal; padding-left: 5px; } h1 { font-size: 151%; border-left:5px rgb(159,126,57) solid; } h2 { background-color: rgb(230,230,230); font-size: 142%; padding-left: 20px; border-left:5px rgb(198,178,135) solid; } h3 { background-color: rgb(235,235,235); font-size: 133%; padding-left: 40px; border-left:5px rgb(217,200,173) solid; } h4 { background-color: rgb(240,240,240); font-size: 124%; padding-left: 60px; } h5 { background-color: rgb(245,245,245); font-size: 115%; padding-left: 80px; } h6 { background-color: rgb(250,250,250); font-size: 106%; padding-left: 100px; } #extra a { text-decoration: none; } #logo a { text-decoration: none; } #extra a:hover { } /* layout */ #navigation { width: 22%; position: relative; top: 0; right: 0; float: right; text-align: center; } #content {margin-right: 22%; width: auto} div#footer { background-color: rgb(198,178,135); color: rgb(98,84,55); clear: left; width: 100%; font-size: 71%; } div#footer a { background-color: rgb(198,178,135); color: rgb(98,84,55); } div#footer p { margin:0; padding:5px 10px } span.keyword { color: #00F; } span.comment { color: #080; } span.quote { color: #F00; } span.squote { color: #F0F; } span.sign { color: #008B8B; } @media print { #navigation {display: none;} #content {padding: 0px;} #content a {text-decoration: underline;} } etsf_io-1.0.3/doc/www/robo_functions.html0000644000353400050620000000672311354150415015405 00000000000000 Functions

Functions

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

E

etsf_io_low_var_associated etsf_io_low_var_multiply

P

pad

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

etsf_io-1.0.3/doc/www/robo_methods.html0000644000353400050620000003001411354150415015026 00000000000000 Methods

Methods

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

E

etsf_io_basisdata_copy etsf_io_basisdata_def etsf_io_basisdata_get etsf_io_basisdata_put etsf_io_data_contents etsf_io_data_copy etsf_io_data_get etsf_io_data_init etsf_io_data_read etsf_io_data_write etsf_io_dielectric_copy etsf_io_dielectric_def etsf_io_dielectric_get etsf_io_dielectric_put etsf_io_dims_def etsf_io_dims_get etsf_io_dims_merge etsf_io_dims_trace etsf_io_electrons_copy etsf_io_electrons_def etsf_io_electrons_get etsf_io_electrons_put etsf_io_file_check etsf_io_file_check_crystallographic_data etsf_io_file_check_dielectric_function_data etsf_io_file_check_scalar_field_data etsf_io_file_check_wavefunctions_data etsf_io_file_contents etsf_io_file_merge etsf_io_geometry_copy etsf_io_geometry_def etsf_io_geometry_get etsf_io_geometry_put etsf_io_gwdata_copy etsf_io_gwdata_def etsf_io_gwdata_get etsf_io_gwdata_put etsf_io_kpoints_copy etsf_io_kpoints_def etsf_io_kpoints_get etsf_io_kpoints_put etsf_io_low_check_att etsf_io_low_check_header etsf_io_low_check_var etsf_io_low_close etsf_io_low_copy_all_att etsf_io_low_def_var etsf_io_low_error_handle etsf_io_low_error_set etsf_io_low_error_to_str etsf_io_low_error_update etsf_io_low_free_all_var_infos etsf_io_low_free_var_infos etsf_io_low_open_create etsf_io_low_open_modify etsf_io_low_open_read etsf_io_low_read_att etsf_io_low_read_dim etsf_io_low_read_flag etsf_io_low_read_var etsf_io_low_read_var_infos etsf_io_low_set_define_mode etsf_io_low_set_write_mode etsf_io_low_write_att etsf_io_low_write_dim etsf_io_low_write_var etsf_io_main_copy etsf_io_main_def etsf_io_main_get etsf_io_main_put etsf_io_phonons_copy etsf_io_phonons_def etsf_io_phonons_get etsf_io_phonons_put etsf_io_split_allocate etsf_io_split_copy etsf_io_split_def etsf_io_split_free etsf_io_split_get etsf_io_split_init etsf_io_split_merge etsf_io_split_put etsf_io_tools_get_atom_names etsf_io_tools_get_time_reversal_symmetry etsf_io_tools_set_time_reversal_symmetry etsf_io_vars_free

S

strip

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

etsf_io-1.0.3/doc/www/robo_modules.html0000644000353400050620000000674511354150415015051 00000000000000 Modules

Modules

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

E

etsf_io etsf_io_file etsf_io_low_level etsf_io_tools

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

etsf_io-1.0.3/doc/www/robo_sourcefiles.html0000644000353400050620000002362411354150415015717 00000000000000 Sourcefiles
etsf_io-1.0.3/doc/www/robo_strutures.html0000644000353400050620000001120011354150415015437 00000000000000 Structures

Structures

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

E

etsf_basisdata etsf_dielectric etsf_dims etsf_electrons etsf_geometry etsf_groups etsf_groups_flags etsf_gwdata etsf_io_low_error etsf_io_low_read_all_var_infos etsf_io_low_var_double etsf_io_low_var_infos etsf_io_low_var_integer etsf_kpoints etsf_main etsf_split etsf_vars

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

etsf_io-1.0.3/doc/www/robo_sub_cat.html0000644000353400050620000001001411354150415015001 00000000000000 Sub categories

Sub categories

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

E

etsf_io_basics_group etsf_io_data_group etsf_io_low_check_group etsf_io_low_error_group etsf_io_low_file_group etsf_io_low_read_group etsf_io_low_var etsf_io_low_write_group etsf_io_tutorials

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

etsf_io-1.0.3/doc/www/robo_tuto_cat.html0000644000353400050620000000745211354150415015217 00000000000000 Tutorials

Tutorials

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

C

convert_to_xyz create_a_crystal_den_file

M

mix_ETSF_and_non_ETSF MPI_output_of_a_density

R

read_a_file read_write_sub_access

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

etsf_io-1.0.3/doc/www/toc_index.html0000644000353400050620000003333611354150416014331 00000000000000 toc

TABLE OF CONTENTS

etsf_io-1.0.3/doc/www/low_level/0000777000353400050620000000000011354151527013537 500000000000000etsf_io-1.0.3/doc/www/low_level/Makefile.am0000644000353400050620000000024211354063702015502 00000000000000lowleveldoc_DATA = etsf_io_low_level_f90.html \ public_variables_f90.html \ read_routines_f90.html \ write_routines_f90.html EXTRA_DIST = $(lowleveldoc_DATA) etsf_io-1.0.3/doc/www/low_level/Makefile.in0000644000353400050620000002254411354150417015524 00000000000000# Makefile.in generated by automake 1.10.1 from Makefile.am. # @configure_input@ # Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, # 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. # This Makefile.in is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY, to the extent permitted by law; without # even the implied warranty of MERCHANTABILITY or FITNESS FOR A # PARTICULAR PURPOSE. @SET_MAKE@ VPATH = @srcdir@ pkgdatadir = $(datadir)/@PACKAGE@ pkglibdir = $(libdir)/@PACKAGE@ pkgincludedir = $(includedir)/@PACKAGE@ am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd install_sh_DATA = $(install_sh) -c -m 644 install_sh_PROGRAM = $(install_sh) -c install_sh_SCRIPT = $(install_sh) -c INSTALL_HEADER = $(INSTALL_DATA) transform = $(program_transform_name) NORMAL_INSTALL = : PRE_INSTALL = : POST_INSTALL = : NORMAL_UNINSTALL = : PRE_UNINSTALL = : POST_UNINSTALL = : subdir = doc/www/low_level DIST_COMMON = $(srcdir)/Makefile.am $(srcdir)/Makefile.in ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 am__aclocal_m4_deps = $(top_srcdir)/config/m4/fortran.m4 \ $(top_srcdir)/configure.ac am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ $(ACLOCAL_M4) mkinstalldirs = $(install_sh) -d CONFIG_CLEAN_FILES = SOURCES = DIST_SOURCES = am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; am__vpath_adj = case $$p in \ $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \ *) f=$$p;; \ esac; am__strip_dir = `echo $$p | sed -e 's|^.*/||'`; am__installdirs = "$(DESTDIR)$(lowleveldocdir)" lowleveldocDATA_INSTALL = $(INSTALL_DATA) DATA = $(lowleveldoc_DATA) DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) ACLOCAL = @ACLOCAL@ AMTAR = @AMTAR@ AR = @AR@ AUTOCONF = @AUTOCONF@ AUTOHEADER = @AUTOHEADER@ AUTOMAKE = @AUTOMAKE@ AWK = @AWK@ CYGPATH_W = @CYGPATH_W@ DEFS = @DEFS@ ECHO_C = @ECHO_C@ ECHO_N = @ECHO_N@ ECHO_T = @ECHO_T@ EXEEXT = @EXEEXT@ FC = @FC@ FCFLAGS = @FCFLAGS@ FCFLAGS_f90 = @FCFLAGS_f90@ FFLAGS = @FFLAGS@ INSTALL = @INSTALL@ INSTALL_DATA = @INSTALL_DATA@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ INSTALL_SCRIPT = @INSTALL_SCRIPT@ INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ LDFLAGS = @LDFLAGS@ LIBOBJS = @LIBOBJS@ LIBS = @LIBS@ LTLIBOBJS = @LTLIBOBJS@ MAKEINFO = @MAKEINFO@ MKDIR_P = @MKDIR_P@ MODULE_EXT = @MODULE_EXT@ NETCDF_CFLAGS = @NETCDF_CFLAGS@ OBJEXT = @OBJEXT@ PACKAGE = @PACKAGE@ PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ PACKAGE_NAME = @PACKAGE_NAME@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_VERSION = @PACKAGE_VERSION@ PATH_SEPARATOR = @PATH_SEPARATOR@ RANLIB = @RANLIB@ SET_MAKE = @SET_MAKE@ SHELL = @SHELL@ STRIP = @STRIP@ VERSION = @VERSION@ abs_builddir = @abs_builddir@ abs_srcdir = @abs_srcdir@ abs_top_builddir = @abs_top_builddir@ abs_top_srcdir = @abs_top_srcdir@ ac_ct_FC = @ac_ct_FC@ am__leading_dot = @am__leading_dot@ am__tar = @am__tar@ am__untar = @am__untar@ bindir = @bindir@ build_alias = @build_alias@ builddir = @builddir@ datadir = @datadir@ datarootdir = @datarootdir@ docdir = @docdir@ dvidir = @dvidir@ exec_prefix = @exec_prefix@ fc_type = @fc_type@ fc_version = @fc_version@ fc_wrap = @fc_wrap@ groupleveldocdir = @groupleveldocdir@ host_alias = @host_alias@ htmldir = @htmldir@ includedir = @includedir@ infodir = @infodir@ install_sh = @install_sh@ libdir = @libdir@ libexecdir = @libexecdir@ localedir = @localedir@ localstatedir = @localstatedir@ lowleveldocdir = @lowleveldocdir@ mandir = @mandir@ mkdir_p = @mkdir_p@ moduledir = @moduledir@ oldincludedir = @oldincludedir@ pdfdir = @pdfdir@ prefix = @prefix@ program_transform_name = @program_transform_name@ psdir = @psdir@ sbindir = @sbindir@ sharedstatedir = @sharedstatedir@ srcdir = @srcdir@ sysconfdir = @sysconfdir@ target_alias = @target_alias@ top_builddir = @top_builddir@ top_srcdir = @top_srcdir@ tutorialsdocdir = @tutorialsdocdir@ utilsdocdir = @utilsdocdir@ lowleveldoc_DATA = etsf_io_low_level_f90.html \ public_variables_f90.html \ read_routines_f90.html \ write_routines_f90.html EXTRA_DIST = $(lowleveldoc_DATA) all: all-am .SUFFIXES: $(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) @for dep in $?; do \ case '$(am__configure_deps)' in \ *$$dep*) \ cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh \ && exit 0; \ exit 1;; \ esac; \ done; \ echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu doc/www/low_level/Makefile'; \ cd $(top_srcdir) && \ $(AUTOMAKE) --gnu doc/www/low_level/Makefile .PRECIOUS: Makefile Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status @case '$?' in \ *config.status*) \ cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ *) \ echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ esac; $(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh $(top_srcdir)/configure: $(am__configure_deps) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh $(ACLOCAL_M4): $(am__aclocal_m4_deps) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh install-lowleveldocDATA: $(lowleveldoc_DATA) @$(NORMAL_INSTALL) test -z "$(lowleveldocdir)" || $(MKDIR_P) "$(DESTDIR)$(lowleveldocdir)" @list='$(lowleveldoc_DATA)'; for p in $$list; do \ if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ f=$(am__strip_dir) \ echo " $(lowleveldocDATA_INSTALL) '$$d$$p' '$(DESTDIR)$(lowleveldocdir)/$$f'"; \ $(lowleveldocDATA_INSTALL) "$$d$$p" "$(DESTDIR)$(lowleveldocdir)/$$f"; \ done uninstall-lowleveldocDATA: @$(NORMAL_UNINSTALL) @list='$(lowleveldoc_DATA)'; for p in $$list; do \ f=$(am__strip_dir) \ echo " rm -f '$(DESTDIR)$(lowleveldocdir)/$$f'"; \ rm -f "$(DESTDIR)$(lowleveldocdir)/$$f"; \ done tags: TAGS TAGS: ctags: CTAGS CTAGS: distdir: $(DISTFILES) @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ list='$(DISTFILES)'; \ dist_files=`for file in $$list; do echo $$file; done | \ sed -e "s|^$$srcdirstrip/||;t" \ -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ case $$dist_files in \ */*) $(MKDIR_P) `echo "$$dist_files" | \ sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ sort -u` ;; \ esac; \ for file in $$dist_files; do \ if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ if test -d $$d/$$file; then \ dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ cp -pR $(srcdir)/$$file $(distdir)$$dir || exit 1; \ fi; \ cp -pR $$d/$$file $(distdir)$$dir || exit 1; \ else \ test -f $(distdir)/$$file \ || cp -p $$d/$$file $(distdir)/$$file \ || exit 1; \ fi; \ done check-am: all-am check: check-am all-am: Makefile $(DATA) installdirs: for dir in "$(DESTDIR)$(lowleveldocdir)"; do \ test -z "$$dir" || $(MKDIR_P) "$$dir"; \ done install: install-am install-exec: install-exec-am install-data: install-data-am uninstall: uninstall-am install-am: all-am @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am installcheck: installcheck-am install-strip: $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ `test -z '$(STRIP)' || \ echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install mostlyclean-generic: clean-generic: distclean-generic: -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) maintainer-clean-generic: @echo "This command is intended for maintainers to use" @echo "it deletes files that may require special tools to rebuild." clean: clean-am clean-am: clean-generic mostlyclean-am distclean: distclean-am -rm -f Makefile distclean-am: clean-am distclean-generic dvi: dvi-am dvi-am: html: html-am info: info-am info-am: install-data-am: install-lowleveldocDATA install-dvi: install-dvi-am install-exec-am: install-html: install-html-am install-info: install-info-am install-man: install-pdf: install-pdf-am install-ps: install-ps-am installcheck-am: maintainer-clean: maintainer-clean-am -rm -f Makefile maintainer-clean-am: distclean-am maintainer-clean-generic mostlyclean: mostlyclean-am mostlyclean-am: mostlyclean-generic pdf: pdf-am pdf-am: ps: ps-am ps-am: uninstall-am: uninstall-lowleveldocDATA .MAKE: install-am install-strip .PHONY: all all-am check check-am clean clean-generic distclean \ distclean-generic distdir dvi dvi-am html html-am info info-am \ install install-am install-data install-data-am install-dvi \ install-dvi-am install-exec install-exec-am install-html \ install-html-am install-info install-info-am \ install-lowleveldocDATA install-man install-pdf install-pdf-am \ install-ps install-ps-am install-strip installcheck \ installcheck-am installdirs maintainer-clean \ maintainer-clean-generic mostlyclean mostlyclean-generic pdf \ pdf-am ps ps-am uninstall uninstall-am \ uninstall-lowleveldocDATA # Tell versions [3.59,3.63) of GNU make to not export all variables. # Otherwise a system limit (for SysV at least) may be exceeded. .NOEXPORT: etsf_io-1.0.3/doc/www/low_level/etsf_io_low_level_f90.html0000644000353400050620000027466211354150415020533 00000000000000 ./src/low_level/etsf_io_low_level.f90

TABLE OF CONTENTS

etsf_io_low_level

[ Top ] [ Modules ]

NAME

etsf_io_low_level -- ESTF I/O low level wrapper around NetCDF routines

FUNCTION

This module is used to wrap commonly used NetCDF calls. It gives an API which should be safe with automatic dimensions checks, and easy to use with methods only needed by a parser/writer library focused on the ETSF specifications. Nevertheless, this module can be used for other purpose than only reading/writing files conforming to ETSF specifications.

It also support an optional error handling structure. This structure can be used on any methods to get fine informations about any failure.

All methods have a logical argument that is set to .true. if everything went fine. In that case, all output arguments have relevant values. If @lstat is .false., no output values should be used since their values are not guaranteed.

etsf_io_low_check_group

[ Top ] [ etsf_io_low_level ] [ Sub categories ]

FUNCTION

These routines are used to check informations defined in an openend ETSF file.

SOURCE

  public :: etsf_io_low_check_att
  public :: etsf_io_low_check_header
  public :: etsf_io_low_check_var

etsf_io_low_close

[ Top ] [ etsf_io_low_file_group ] [ Methods ]

NAME

etsf_io_low_close

FUNCTION

This method is used to close an openend NetCDF file.

INPUTS

  • ncid = a NetCDF handler, opened with write access.

OUTPUT

  • lstat = .true. if operation succeed.
  • error_data <type(etsf_io_low_error)> = (optional) location to store error data.

SOURCE

  subroutine etsf_io_low_close(ncid, lstat, error_data)
    integer, intent(intent)                            :: ncid
    logical, intent(out)                           :: lstat
    type(etsf_io_low_error), intent(out), optional :: error_data

    !Local
    character(len = *), parameter :: me = "etsf_io_low_close"
    integer :: select
    
    lstat = .false.
    ! Close file
    select = nf90_close(ncid)
    if (select /= nf90_noerr) then
      if (present(error_data)) then
        call etsf_io_low_error_set(error_data, ERROR_MODE_IO, ERROR_TYPE_CLO, me, &
                     & errid = select, errmess = nf90_strerror(select))
      end if
      return
    end if
    lstat = .true.
  end subroutine etsf_io_low_close

etsf_io_low_def_var

[ Top ] [ etsf_io_low_write_group ] [ Methods ]

NAME

etsf_io_low_def_var

SYNOPSIS

  • call etsf_io_low_def_var(ncid, varname, vartype, vardims, lstat, ncvarid, error_data)
  • call etsf_io_low_def_var(ncid, varname, vartype, lstat, ncvarid, error_data)

FUNCTION

In the contrary of dimensions or attributes, before using a write method on variables they must be defined using such methods. This allow to choose the type, the shape and the size of a new variable. Once defined, a variable can't be changed or removed.

One can add scalars, one dimensional arrays or multi-dimensional arrays (restricted to a maximum of 7 dimensions). See the examples below to know how to use such methods.

As in pure NetCDF, it is impossible to overwrite the definition of a variable. Nevertheless, the method returns .true. in @lstat, if the definition is done a second time with the same type, shape and dimensions.

INPUTS

  • ncid = a NetCDF handler, opened with write access (define mode).
  • varname = the name for the new variable.
  • vartype = the type of the new variable (see #ETSF_IO_LOW_CONSTANTS).
  • vardims = an array with the size for each dimension of the variable. Each size is given by the name of its dimension. Thus dimensions must already exist (see etsf_io_low_write_dim()). When omitted, the variable is considered as a scalar.

OUTPUT

  • lstat = .true. if operation succeed.
  • ncvarid = (optional) the id used by NetCDF to identify the written variable.
  • error_data <type(etsf_io_low_error)> = (optional) location to store error data.

EXAMPLE

Define a string stored as "basis_set" of length "character_string_length": 

   call etsf_io_low_def_var(ncid, "basis_set", etsf_io_low_character, &
                          & (/ "character_string_length" /), lstat)

Define one integer stored as "space_group": 

   call etsf_io_low_def_var(ncid, "space_group", etsf_io_low_integer, lstat)

Define a two dimensional array of double stored as "reduced_symetry_translations": 

   call etsf_io_low_def_var(ncid, "reduced_symetry_translations", etsf_io_low_double, &
                          & (/ "number_of_reduced_dimensions", &
                          &    "number_of_symetry_operations" /), lstat)

etsf_io_low_error_group

[ Top ] [ etsf_io_low_level ] [ Sub categories ]

FUNCTION

These methods are used to handle errors generated by ETSF access. For this a Fortran type is used and called #etsf_io_low_error. It stores several informations such as the name of the method where the error occured or a message describing the error. One can create an error using etsf_io_low_error_set() and then put it into a nice string for future use with etsf_io_low_error_to_str().

SOURCE

  public :: etsf_io_low_error
  public :: etsf_io_low_error_set
  public :: etsf_io_low_error_update
  public :: etsf_io_low_error_to_str
  public :: etsf_io_low_error_handle

etsf_io_low_error_handle

[ Top ] [ etsf_io_low_error_group ] [ Methods ]

NAME

etsf_io_low_error_handle

FUNCTION

This method can be used to output the informations contained in an error structure. The output is done on standard output. Write your own method if custom error handling is required.

INPUTS

SOURCE

  subroutine etsf_io_low_error_handle(error_data)
    type(etsf_io_low_error), intent(intent) :: error_data

    integer :: i
      
    ! Error handling
    write(*,*) 
    write(*,*) "    ***"
    write(*,*) "    *** ETSF I/O ERROR"
    write(*,*) "    ***"
    write(*,*) "    *** Backtrace          : ", &
         & trim(error_data%backtrace(error_data%backtraceId)), "()"
    do i = error_data%backtraceId - 1, 1, -1
       write(*,*) "    ***                      ", trim(error_data%backtrace(i)), "()"
    end do
    write(*,*) "    *** Action performed   : ", trim(error_data%access_mode_str), &
             & " ", trim(error_data%target_type_str)
    if (trim(error_data%target_name) /= "") then
      write(*,*) "    *** Target (name)      : ", trim(error_data%target_name)
    end if
    if (error_data%target_id /= 0) then
      write(*,*) "    *** Target (id)        : ", error_data%target_id
    end if
    if (trim(error_data%error_message) /= "") then
      write(*,*) "    *** Error message      : ", trim(error_data%error_message)
    end if
    if (error_data%error_id /= nf90_noerr) then
      write(*,*) "    *** Error id           : ", error_data%error_id
    end if
    write(*,*) "    ***"
    write(*,*) 
  end subroutine etsf_io_low_error_handle

etsf_io_low_error_set

[ Top ] [ etsf_io_low_error_group ] [ Methods ]

NAME

etsf_io_low_error_set

FUNCTION

This routine is used to initialise a #etsf_io_low_error object with values.

INPUTS

  • mode = a value from #ERROR_MODE, specifying the action when the error occurs.
  • type = a value from #ERROR_TYPE, specifying the kind of target.
  • parent = the name of the routine in which the error occurs.
  • tgtid = (optional) an id representing the target (or -1).
  • tgtname = (optional) a name representing the target (or "").
  • errmess = (optional) a string with an explanation.

OUTPUT

  • error_data <type(etsf_io_low_error)> = the error with sensible values in its fields.

SOURCE

  subroutine etsf_io_low_error_set(error_data, mode, type, parent, tgtid, tgtname, errid, errmess)
    type(etsf_io_low_error), intent(out)     :: error_data
    integer, intent(intent)                      :: mode, type
    character(len = *), intent(intent)           :: parent
    integer, intent(intent), optional            :: tgtid, errid
    character(len = *), intent(intent), optional :: tgtname, errmess

    ! Consistency checkings    
    if (mode < 1 .or. mode > nb_access_mode) then
      write(0, *) "   *** ETSF I/O Internal error ***"
      write(0, *) "   mode argument out of range: ", mode
      return
    end if
    if (type < 1 .or. type > nb_target_type) then
      write(0, *) "   *** ETSF I/O Internal error ***"
      write(0, *) "   type argument out of range: ", type
      return
    end if
    
    ! Storing mandatory informations
    write(error_data%backtrace(1), "(A)") parent(1:min(80, len(parent)))
    error_data%backtraceId    = 1
    error_data%access_mode_id = mode
    write(error_data%access_mode_str, "(A)") etsf_io_low_error_mode(mode)
    error_data%target_type_id = type
    write(error_data%target_type_str, "(A)") etsf_io_low_error_type(type)

    ! Storing possible other informations
    if (present(tgtid)) then
      error_data%target_id = tgtid
    else
      error_data%target_id = -1
    end if
    if (present(tgtname)) then
      write(error_data%target_name, "(A)") trim(tgtname(1:min(80, len(tgtname))))
    else
      write(error_data%target_name, "(A)") ""
    end if
    if (present(errid)) then
      error_data%error_id = errid
    else
      error_data%error_id = nf90_noerr
    end if
    if (present(errmess)) then
      write(error_data%error_message, "(A)") trim(errmess(1:min(256, len(errmess))))
    else
      write(error_data%error_message, "(A)") ""
    end if
  end subroutine etsf_io_low_error_set

etsf_io_low_error_to_str

[ Top ] [ etsf_io_low_error_group ] [ Methods ]

NAME

etsf_io_low_error_to_str

FUNCTION

This method can be used to get a string from the given error.

INPUTS

OUTPUT

  • str = a string to write the error message to.

SOURCE

  subroutine etsf_io_low_error_to_str(str, error_data)
    character(len = etsf_io_low_error_len), intent(out)   :: str
    type(etsf_io_low_error), intent(intent) :: error_data
    
    character(len = 80)  :: line_tgtname, line_tgtid, line_messid
    character(len = 256) :: line_mess
    integer              :: i
    
    if (trim(error_data%target_name) /= "") then
      write(line_tgtname, "(A,A,A)") "  Target (name)      : ", trim(error_data%target_name), char(10)
    else
      write(line_tgtname, "(A)") ""
    end if
    if (error_data%target_id >= 0) then
      write(line_tgtid, "(A,I0,A)") "  Target (id)        : ", error_data%target_id, char(10)
    else
      write(line_tgtid, "(A)") ""
    end if
    if (trim(error_data%error_message) /= "") then
      write(line_mess, "(A,A,A)") "  Error message      : ", trim(error_data%error_message), char(10)
    else
      write(line_mess, "(A)") ""
    end if
    if (error_data%error_id /= nf90_noerr) then
      write(line_messid, "(A,I0,A)") "  Error id           : ", error_data%error_id, char(10)
    else
      write(line_messid, "(A)") ""
    end if

    ! Write the back trace
    write(str, "(A,A,A)") "  Backtrace          : ", &
         & trim(error_data%backtrace(error_data%backtraceId)), "()"
    do i = error_data%backtraceId - 1, 1, -1
       if (len(trim(str)) + 80 + 26 < etsf_io_low_error_len) then
          write(str, "(5A)") trim(str(1:3900)), char(10), &
               & "                       ", trim(error_data%backtrace(i)), "()"
       end if
    end do

    ! Write all the rest.
    write(str, "(11A)") trim(str(1:3000)), char(10),&
               & "  Action performed   : ", trim(error_data%access_mode_str), &
               & " ", trim(error_data%target_type_str), char(10), &
               & trim(line_tgtname), &
               & trim(line_tgtid), &
               & trim(line_mess), &
               & trim(line_messid)
  end subroutine etsf_io_low_error_to_str

etsf_io_low_error_update

[ Top ] [ etsf_io_low_error_group ] [ Methods ]

NAME

etsf_io_low_error_update

FUNCTION

This method must be called when a routine receives an error and need to propagate it further.

INPUTS

  • method = the name of the routine that propagate the error.

SIDE EFFECTS

SOURCE

  subroutine etsf_io_low_error_update(error, method)
    type(etsf_io_low_error), intent(inout) :: error
    character(len = *), intent(intent)         :: method

    if (error%backtraceId == 100) return

    error%backtraceId = error%backtraceId + 1
    write(error%backtrace(error%backtraceId), "(A)") method(1:min(80, len(method)))
  end subroutine etsf_io_low_error_update

etsf_io_low_file_group

[ Top ] [ etsf_io_low_level ] [ Sub categories ]

FUNCTION

When accessing a ETSF file, there is three routines to do that. One can: 

   * create a new file with etsf_io_low_open_create() ;
   * read an already existing file with etsf_io_low_open_read() ;
   * write data to a an already existing file with etsf_io_low_open_modify().

SOURCE

  public :: etsf_io_low_close
  public :: etsf_io_low_open_create
  public :: etsf_io_low_open_modify
  public :: etsf_io_low_open_read

etsf_io_low_free_all_var_infos

[ Top ] [ etsf_io_low_var_infos ] [ Methods ]

NAME

etsf_io_low_free_all_var_infos

FUNCTION

This method is used to free all associated memory in an array of #etsf_io_low_var_infos elements. The array is also deallocated. This routine is convenient after a call to etsf_io_low_read_all_var_infos() with the optional argument @with_dim_name set to true.

SIDE EFFECTS

SOURCE

  subroutine etsf_io_low_free_all_var_infos(var_infos_array)
    type(etsf_io_low_var_infos), pointer :: var_infos_array(:)
    
    integer :: i

    if (associated(var_infos_array)) then
       do i = 1, size(var_infos_array), 1
          call etsf_io_low_free_var_infos(var_infos_array(i))
       end do
       deallocate(var_infos_array)
    end if
  end subroutine etsf_io_low_free_all_var_infos

etsf_io_low_free_var_infos

[ Top ] [ etsf_io_low_var_infos ] [ Methods ]

NAME

etsf_io_low_free_var_infos

FUNCTION

This method free all internal allocated memory of a given #etsf_io_low_var_infos object after use.

SIDE EFFECTS

SOURCE

  subroutine etsf_io_low_free_var_infos(var_infos)
    type(etsf_io_low_var_infos), intent(inout) :: var_infos
    
    if (associated(var_infos%ncdimnames)) then
      deallocate(var_infos%ncdimnames)
    end if
    var_infos%ncdimnames => null()
    if (associated(var_infos%ncattnames)) then
      deallocate(var_infos%ncattnames)
    end if
    var_infos%ncattnames => null()
  end subroutine etsf_io_low_free_var_infos

etsf_io_low_read_att

[ Top ] [ etsf_io_low_read_group ] [ Methods ]

NAME

etsf_io_low_read_att

SYNOPSIS

  • call etsf_io_low_read_att(ncid, ncvarid, attname, attlen, att, lstat, error_data)
  • call etsf_io_low_read_att(ncid, ncvarid, attname, att, lstat, error_data)
  • call etsf_io_low_read_att(ncid, varname, attname, attlen, att, lstat, error_data)
  • call etsf_io_low_read_att(ncid, varname, attname, att, lstat, error_data)

FUNCTION

This is a generic interface to read values of an attribute (either integer, real, double or character). Before puting values in the @att argument, the dimensions of the read data are compared with the given dimensions (@attlen). The type is also checked, based on the type of the @att argument. Using this routine is then a safe way to read attribute data from a NetCDF file. The size and shape of @att can be either a scalar or a one dimensional array. In the former case, the argument @attlen must be omitted. Strings are considered to be one dimensional arrays. See the example below on how to read a string.

INPUTS

  • ncid = a NetCDF handler, opened with read access.
  • ncvarid = the id of the variable the attribute is attached to. in the case of global attributes, use the constance NF90_GLOBAL (when linking against NetCDF) or #etsf_io_low_global_att which is a wrapper exported by this module (see #ETSF_IO_LOW_CONSTANTS).
  • varname = can be used instead of ncvarid to select a variable by its name.
  • attname = a string identifying an attribute.
  • attlen = the size of the array @att (when required).

OUTPUT

  • att = an allocated array to store the read values. When @attlen is omitted, this argument @att must be a scalar, not an array.
  • lstat = .true. if operation succeed.
  • error_data <type(etsf_io_low_error)> = (optional) location to store error data.

EXAMPLE

Read a string stored in "symmorphic" attribute of length 80: 

   character(len = 80) :: att
   call etsf_io_low_read_att(ncid, ncvarid, "symmorphic", 80, att, lstat)

Get one single real stored in "file_format_version" which is a global attribute: 

   real :: version
   call etsf_io_low_read_att(ncid, etsf_io_low_global_att, "file_format_version", version, lstat)

etsf_io_low_read_flag

[ Top ] [ etsf_io_low_read_group ] [ Methods ]

NAME

etsf_io_low_read_flag

SYNOPSIS

  • call etsf_io_low_read_flag(ncid, flag, ncvarid, attname, lstat, error_data)
  • call etsf_io_low_read_flag(ncid, flag, varname, attname, lstat, error_data)

FUNCTION

This method is a specialized version of etsf_io_low_read_att(). It reads the attribute @attname of the given variable and set @flag to .true. if the attribute value is "yes" or "YES" or "Yes", .false. otherwise.

INPUTS

  • ncid = a NetCDF handler, opened with read access.
  • ncvarid = the id of the variable the attribute is attached to. in the case of global attributes, use the constance NF90_GLOBAL (when linking against NetCDF) or #etsf_io_low_global_att which is a wrapper exported by this module (see #ETSF_IO_LOW_CONSTANTS).
  • varname = can be used instead of ncvarid to select a variable by its name.
  • attname = a string identifying an attribute.

OUTPUT

  • flag = .true. if the attribute match "yes" or its variant.
  • lstat = .true. if operation succeed.
  • error_data <type(etsf_io_low_error)> = (optional) location to store error data.

etsf_io_low_read_group

[ Top ] [ etsf_io_low_level ] [ Sub categories ]

FUNCTION

These routines are used read data from an ETSF file. These data can be:

  • dimensions ;
  • attributes (global or not) ;
  • variables.

SOURCE

  public :: etsf_io_low_read_att
  public :: etsf_io_low_read_flag
  public :: etsf_io_low_read_dim
  public :: etsf_io_low_read_var

etsf_io_low_read_var

[ Top ] [ etsf_io_low_read_group ] [ Methods ]

NAME

etsf_io_low_read_var

SYNOPSIS

  • call etsf_io_low_read_var(ncid, varname, var, lstat, ncvarid, start, count, map, error_data)
  • call etsf_io_low_read_var(ncid, varname, var, charlen, lstat, ncvarid, start, count, map, error_data)

FUNCTION

This is a generic interface to read values of a variables (either integer or double or character). Before puting values in the @var argument, the dimensions of the read data are compared with the assumed dimensions of @var. The type is also checked, based on the type of the @var argument. Using this routine is then a safe way to read data from a NetCDF file. The size and shape of @var can be either a scalar, a one dimensional array or a multi dimensional array. Strings should be given with their length. See the example below on how to read a string. @var can also be a #etsf_io_low_var_double, or a #etsf_io_low_var_integer. In this case, the associated pointer is used as the storage area for the read values.

If the shape of the given storage variable (@var) and the definition of the corresponding NetCDF variable differ ; the read is done only if the number of elements are identical. Number of elements is the product over all dimensions of the size (see example below).

It is also possible to read some particular dimensions of one variable using the optional @start, @count and @map arguments. These are identical to their counterpart in NetCDF, with small differences and improvements:

  • start is used to define for each dimensions of the ETSF variable where to start reading. Indexes are numbered from 1 to the size of their dimension.
  • count is used to given the number of elements to be read for each dimenion. The sum start(i) + count(i) - 1 must be lower than the size of the i dimension. As an improvement compared to NetCDF count argument, if one wants to read all values from the dimension i, one can put count(i) = 0 instead of the size of the dimension itself which is not always easily accessible.
  • map is used to describe where to write data in memory when reading an ETSF variable. It gives for each dimension how many elements must be skip in memory. It also can used to switch order of dimensions. For instance, for an ETSF variable etsf_var(3,2) that we want to put in a variable my_var(2,3), we will use a map (/ 2, 1 /) which means that all values from first index of the etsf_var will put put every 2 elements in memory, while values from the second index will be put every single element.

The order of dimensions are given in the Fortran order (inverse of the specification order).

INPUTS

  • ncid = a NetCDF handler, opened with read access.
  • varname = a string identifying a variable.

OUTPUT

  • var = an allocated array to store the read values (or a simple scalar).
  • lstat = .true. if operation succeed.
  • start = (optional) an array, with the same size than the shape of the NetCDF variable to be read. Give the first index to be read for each dimension. By default value is 1 for each dimension.
  • count = (optional) an array, with the same size than the shape of the NetCDF variable to be read. Give the number of indexes to be read for each dimension. By default value is the size for each dimension.
  • map = (optional) an array, with the same size than the shape of the NetCDF variable to be read. Give how values are written into memory. By default map = (/ 1, (product(dims(1:i), i = 1, shape - 1) /)
  • ncvarid = (optional) the id used by NetCDF to identify the read variable.
  • error_data <type(etsf_io_low_error)> = (optional) location to store error data.

EXAMPLE

Read a string stored in "exchange_functional" variable of length 80: 

   character(len = 80) :: var
   call etsf_io_low_read_var(ncid, "exchange_functional", var, 80, lstat)

Get one single integer stored in "space_group": 

   integer :: sp
   call etsf_io_low_read_var(ncid, "space_group", sp, lstat)

Get a 2 dimensional array storing reduced atom coordinates: 

   double precision :: coord(3, 5)
   call etsf_io_low_read_var(ncid, "reduced_atom_positions", coord, lstat)

Get a 2 dimensional array stored as a four dimensional array: 

   NetCDF def: density(2, 3, 3, 3) # dimensions in NetCDF are reverted
                                   # compared to Fortran style
   double precision :: density(27, 2)
   call etsf_io_low_read_var(ncid, "density", density, lstat)

Get the last 3 dimensions of a 4D array: 

   NetCDF def: density(2, 3, 4, 5) # dimensions in NetCDF are reverted
                                   # compared to Fortran style
   double precision :: density_down(5, 4, 3)
   call etsf_io_low_read_var(ncid, "density", density_down, lstat, &
                           & start = (/ 1, 1, 1, 2 /), count = (/ 0, 0, 0, 1 /))

Get the last 3 dimensions of a 4D array and store them into a 1D array: 

   NetCDF def: density(2, 3, 3, 3) # dimensions in NetCDF are reverted
                                   # compared to Fortran style
   double precision :: density_up(27)
   call etsf_io_low_read_var(ncid, "density", density_up, lstat, &
                           & start = (/ 1, 1, 1, 2 /), count = (/ 0, 0, 0, 1 /))

Read data to a dimension stored in the main program, without duplication of data in memory: 

   integer, target :: atom_species(number_of_atoms)
   ...
   type(etsf_io_low_var_integer) :: var
   var%data1D => atom_species
   call etsf_io_low_read_var(ncid, "atom_species", var, lstat)

etsf_io_low_read_var_infos

[ Top ] [ etsf_io_low_var_infos ] [ Methods ]

NAME

etsf_io_low_read_var_infos

FUNCTION

This method is used to retrieve informations about a variable:

  • its NetCDF id or its name ;
  • its type (see #ETSF_IO_LOW_CONSTANTS) ;
  • its shape and length for each dimension.

One can get informations knowing the name or the id of a variable. Using the dim_name argument to .true., the name of each used dimensions are retrieved. In that case, the var_infos should be freed after use, calling etsf_io_low_free_var_infos().

SYNOPSIS

  • call etsf_io_low_read_var_infos(ncid, varname, var_infos, lstat, error_data, dim_name, att_name)
  • call etsf_io_low_read_var_infos(ncid, varid, var_infos, lstat, error_data, dim_name, att_name)

INPUTS

  • ncid = a NetCDF handler, opened with read access.
  • varname = a string identifying a variable.
  • varid = a integer identifying a variable.
  • dim_name = (optional) if .true. retrieve the names of the dimensions, and store them in a newly allocated array in the var_infos structure (see etsf_io_low_free_var_infos()).
  • att_name = (optional) if .true. retrieve the names of the attributes, and store them in a newly allocated array in the var_infos structure (see etsf_io_low_free_var_infos()).

OUTPUT

  • var_infos <type(etsf_io_low_var_infos)> = store, type, shape, dimensions and NetCDF id.
  • lstat = .true. if operation succeed.
  • error_data <type(etsf_io_low_error)> = (optional) location to store error data.

etsf_io_low_set_define_mode

[ Top ] [ etsf_io_low_file_group ] [ Methods ]

NAME

etsf_io_low_set_define_mode

FUNCTION

This method put the given NetCDF file handler in a define mode, by closing a data mode. When opening a file (create or modify), this is the default mode. Use etsf_io_low_set_write_mode() to switch then to data mode to write variable values. But to set attributes, the file must be in define mode again. This method is then usefull.

INPUTS

  • ncid = a NetCDF handler, opened with write access.

OUTPUT

  • lstat = .true. if operation succeed.
  • error_data <type(etsf_io_low_error)> = (optional) location to store error data.

SOURCE

  subroutine etsf_io_low_set_define_mode(ncid, lstat, error_data)
    integer, intent(intent)                            :: ncid
    logical, intent(out)                           :: lstat
    type(etsf_io_low_error), intent(out), optional :: error_data

    !Local
    character(len = *), parameter :: me = "etsf_io_low_set_define_mode"
    integer :: select
    
    lstat = .false.
    ! Change the mode.
    select = nf90_redef(ncid)
    if (select /= nf90_noerr .and. select /= -39) then
      if (present(error_data)) then
        call etsf_io_low_error_set(error_data, ERROR_MODE_IO, ERROR_TYPE_DEF, me, &
                     & errid = select, errmess = nf90_strerror(select))
      end if
      return
    end if
    lstat = .true.
  end subroutine etsf_io_low_set_define_mode

etsf_io_low_set_write_mode

[ Top ] [ etsf_io_low_file_group ] [ Methods ]

NAME

etsf_io_low_set_write_mode

FUNCTION

This method put the given NetCDF file handler in a data mode, by closing a define mode. When a file is opened (see etsf_io_low_open_create() or etsf_io_low_open_modify()), the NetCDF file handler is in a define mode. This is convienient for all write accesses (create new dimensions, modifying attribute values...) ; but when puting values into variables, the handler must be in the data mode.

INPUTS

  • ncid = a NetCDF handler, opened with write access.

OUTPUT

  • lstat = .true. if operation succeed.
  • error_data <type(etsf_io_low_error)> = (optional) location to store error data.

SOURCE

  subroutine etsf_io_low_set_write_mode(ncid, lstat, error_data)
    integer, intent(intent)                            :: ncid
    logical, intent(out)                           :: lstat
    type(etsf_io_low_error), intent(out), optional :: error_data

    !Local
    character(len = *), parameter :: me = "etsf_io_low_set_write_mode"
    integer :: select
    
    lstat = .false.
    ! Change the mode.
    select = nf90_enddef(ncid)
    if (select /= nf90_noerr .and. select /= -38) then
      if (present(error_data)) then
        call etsf_io_low_error_set(error_data, ERROR_MODE_IO, ERROR_TYPE_END, me, &
                     & errid = select, errmess = nf90_strerror(select))
      end if
      return
    end if
    lstat = .true.
  end subroutine etsf_io_low_set_write_mode

etsf_io_low_var

[ Top ] [ etsf_io_low_level ] [ Sub categories ]

FUNCTION

These routines are used to defined an array without predefined shape.

SOURCE

  public :: etsf_io_low_var_integer
  public :: etsf_io_low_var_double
  public :: etsf_io_low_var_multiply
  public :: etsf_io_low_var_associated

etsf_io_low_var_associated

[ Top ] [ etsf_io_low_var ] [ Functions ]

NAME

etsf_io_low_var_associated

FUNCTION

This function works as the associated() intrinsic function but with pointers of undefined shapes (see #etsf_io_low_var_integer and #etsf_io_low_var_double).

SYNOPSIS

call etsf_io_low_var_associated(array)

INPUTS

  • array <type(etsf_io_low_var_*)> = an undefined shape array.

OUTPUT

  • returns .true. if one of the array datanD is associated.

etsf_io_low_var_multiply

[ Top ] [ etsf_io_low_var ] [ Functions ]

NAME

etsf_io_low_var_multiply

FUNCTION

This subroutine is used to multiply the array of an unformatted pointer. The factor must be of the same kind (integer or double) than the array.

SYNOPSIS

call etsf_io_low_var_multiply(array, factor)

INPUTS

  • array <type(etsf_io_low_var_*)> = an undefined shape array.
  • factor = the multiplying factor (either integr or double).

etsf_io_low_write_att

[ Top ] [ etsf_io_low_write_group ] [ Methods ]

NAME

etsf_io_low_write_att

SYNOPSIS

call etsf_io_low_write_att(ncid, ncvarid, attname, att, lstat, error_data)

FUNCTION

When in defined mode, one can add attributes and set then a value in one call using such a method. Attributes can be strings, scalar or one dimensional arrays of integer, real or double precision.

INPUTS

  • ncid = a NetCDF handler, opened with write access (define mode).
  • ncvarid = the id of the variable the attribute is attached to. in the case of global attributes, use the constance NF90_GLOBAL (when linking against NetCDF) or #etsf_io_low_global_att which is a wrapper exported by this module (see #ETSF_IO_LOW_CONSTANTS).
  • attname = the name for the new attribute.
  • att = the value, can be a string a scalar or a one-dimension array.

OUTPUT

  • lstat = .true. if operation succeed.
  • error_data <type(etsf_io_low_error)> = (optional) location to store error data.

EXAMPLE

Write a string stored as "symmorphic", attribute of varaible ncvarid: 

   call etsf_io_low_def_var(ncid, ncvarid, "symmorphic", "Yes", lstat)

Write one real stored as "file_format_version", global attribute: 

   call etsf_io_low_def_var(ncid, etsf_io_low_global_att, "file_format_version", &
                          & 1.3, lstat)

etsf_io_low_write_group

[ Top ] [ etsf_io_low_level ] [ Sub categories ]

FUNCTION

These routines are used write (or define) data from an ETSF file. These data can be:

  • dimensions ;
  • attributes (global or not) ;
  • variables.

SOURCE

  public :: etsf_io_low_def_var
  public :: etsf_io_low_write_att
  public :: etsf_io_low_copy_all_att
  public :: etsf_io_low_write_dim
  public :: etsf_io_low_write_var

etsf_io_low_write_var

[ Top ] [ etsf_io_low_write_group ] [ Methods ]

NAME

etsf_io_low_write_var

SYNOPSIS

  • call etsf_io_low_write_var(ncid, varname, var, lstat, ncvarid, start, count, map, error_data)
  • call etsf_io_low_write_var(ncid, varname, var, charlen, lstat, ncvarid, start, count, map, error_data)

FUNCTION

This is a generic interface to write values of a variables (either integer or double or strings). Before using such methods, variables must have been defined using etsf_io_low_def_var(). Before writting values from the @var argument, the dimensions of the given data are compared with the defined dimensions. The type is also checked, based on the type of the @var argument. Using this routine is then a safe way to write data from a NetCDF file. The size and shape of @var can be either a scalar, a one dimensional array or a multi dimensional array. Strings should be given with their length. See the example below on how to write a string. @var can also be a #etsf_io_low_var_double, or a #etsf_io_low_var_integer. In this case, the associated pointer is used as the storage area for the written values.

If the shape of the input data variable (@var) and the definition of the corresponding NetCDF variable differ ; the write action is performed only if the number of elements are identical. Number of elements is the product over all dimensions of the size (see example below).

It is also possible to write some particular dimensions of one variable using the optional @start, @count and @map arguments. These are identical to their counterpart in NetCDF, with small differences and improvements:

  • start is used to define for each dimensions of the ETSF variable where to start writing. Indexes are numbered from 1 to the size of their dimension.
  • count is used to given the number of elements to be read for each dimenion. The sum start(i) + count(i) - 1 must be lower than the size of the i dimension. As an improvement compared to NetCDF count argument, if one wants to write all values from the dimension i, one can put count(i) = 0 instead of the size of the dimension itself which is not always easily accessible.
  • map is used to describe where to read data in memory when writing an ETSF variable. It gives for each dimension how many elements must be skip in memory. It also can used to switch order of dimensions. For instance, for an ETSF variable etsf_var(3,2) that we want to be put from a variable my_var(2,3), we will use a map (/ 2, 1 /) which means that all values of first index of the etsf_var will read from every 2 elements in memory, while values of the second index will be read from every single element.

The order of dimensions are given in the Fortran order (inverse of the specification order).

INPUTS

  • ncid = a NetCDF handler, opened with read access.
  • varname = a string identifying a variable.
  • var = the values to be written, either a scalar or an array.
  • charlen = when @var is a string or an array of strings, their size must be given.

OUTPUT

  • lstat = .true. if operation succeed.
  • start = (optional) an array, with the same size than the shape of the NetCDF variable to be read. Give the first index to be read for each dimension. By default value is 1 for each dimension.
  • count = (optional) an array, with the same size than the shape of the NetCDF variable to be read. Give the number of indexes to be read for each dimension. By default value is the size for each dimension.
  • map = (optional) an array, with the same size than the shape of the NetCDF variable to be read. Give how values are written into memory. By default map = (/ 1, (product(dims(1:i), i = 1, shape - 1) /)
  • ncvarid = (optional) the id used by NetCDF to identify the written variable.
  • error_data <type(etsf_io_low_error)> = (optional) location to store error data.

EXAMPLE

Write a string stored in "exchange_functional" variable of length 80: 

   call etsf_io_low_read_var(ncid, "exchange_functional", "My functional", 80, lstat)

Write one single integer stored in "space_group": 

   call etsf_io_low_read_var(ncid, "space_group", 156, lstat)

Write a 2 dimensional array storing reduced atom coordinates: 

   double precision :: coord2d(3, 4)
   coord2d = reshape((/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12 /), (/ 3, 4 /))
   call etsf_io_low_read_var(ncid, "reduced_atom_positions", coord2d, lstat)

or, 

   double precision :: coord(12)
   coord = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12 /)
   call etsf_io_low_read_var(ncid, "reduced_atom_positions", coord, lstat)

Write the last 3 dimensions of a 4D array: 

   NetCDF def: density(2, 3, 4, 5) # dimensions in NetCDF are reverted
                                   # compared to Fortran style
   double precision :: density_down(5, 4, 3)
   call etsf_io_low_write_var(ncid, "density", density_down, lstat, &
                            & start = (/ 1, 1, 1, 2 /), count = (/ 0, 0, 0, 1 /))

Write the last 3 dimensions of a 4D array and read them from a 1D array: 

   NetCDF def: density(2, 3, 3, 3) # dimensions in NetCDF are reverted
                                   # compared to Fortran style
   double precision :: density_up(27)
   call etsf_io_low_write_var(ncid, "density", density_up, lstat, &
                            & start = (/ 1, 1, 1, 2 /), count = (/ 0, 0, 0, 1 /))

Write data from a dimension stored in the main program, without duplication of data in memory: 

   integer, target :: atom_species(number_of_atoms)
   ...
   type(etsf_io_low_var_integer) :: var
   var%data1D => atom_species
   call etsf_io_low_write_var(ncid, "atom_species", var, lstat)

pad

[ Top ] [ etsf_io_low_level ] [ Functions ]

NAME

pad

FUNCTION

Little tool to format chains to constant length (256). This is usefull when calling the etsf_io_low_def_var() routine which takes an array of strings as argument. Since not all compilers like to construct static arrays from strings of different lengths, this function can wrap all strings.

INPUTS

  • string = the string to convert to character(len = 256).

OUTPUT

SOURCE

  function pad(string)
    character(len = *), intent(intent) :: string
    character(len = 256)           :: pad
    
    write(pad, "(A)") string(1:min(256, len(string)))
  end function pad

strip

[ Top ] [ etsf_io_low_level ] [ Methods ]

NAME

strip

FUNCTION

Little tool to change all final '\0' (end of string in C) characters to ' ' (space).

SIDE EFFECTS

  • string = the string to convert. It is done in-place.

SOURCE

  subroutine strip(string)
    character(len = *), intent(inout) :: string

    integer :: i, l

    i = index(string, char(0))
    if (i > 0) then
       l = len(string)
       string(i:l) = repeat(" ", l - i + 1)
    end if
  end subroutine strip
etsf_io-1.0.3/doc/www/low_level/public_variables_f90.html0000644000353400050620000006146211354150414020330 00000000000000 ./src/low_level/public_variables.f90

TABLE OF CONTENTS

ERROR_MODE

[ Top ] [ etsf_io_low_error_group ] [ Definitions ]

NAME

ERROR_MODE

FUNCTION

These values are used to index the action done when an error occurs. We found the following values: 

   * ERROR_MODE_DEF  = error when defining a variable or a dimension.
   * ERROR_MODE_GET  = error when read a value for a valid dimension,
                       attribute or variable.
   * ERROR_MODE_IO   = error when accessing one file (opening or closing).
   * ERROR_MODE_INQ  = error when looking in the NetCDF file for informations.
   * ERROR_MODE_PUT  = error when writing a value to a valid target.
   * ERROR_MODE_SPEC = error of match between read value and awaited type or shape.
   * ERROR_MODE_COPY = error when copying a value.

SOURCE

  integer, parameter :: ERROR_MODE_DEF = 1, ERROR_MODE_GET = 2, ERROR_MODE_IO   = 3, &
                      & ERROR_MODE_INQ = 4, ERROR_MODE_PUT = 5, ERROR_MODE_SPEC = 6, &
                      & ERROR_MODE_COPY = 7

ERROR_TYPE

[ Top ] [ etsf_io_low_error_group ] [ Definitions ]

NAME

ERROR_TYPE

FUNCTION

These values are used to index the type of target when an error occurs. We found the following values: 

   * ERROR_TYPE_ATT = error on attributes.
   * ERROR_TYPE_DID = error on dimension ids.
   * ERROR_TYPE_DIM = error on dimensions.
   * ERROR_TYPE_END = error on ending define mode.
   * ERROR_TYPE_DEF = error on switching to define mode.
   * ERROR_TYPE_OCR = .
   * ERROR_TYPE_ORD = error on opening for read access.
   * ERROR_TYPE_OWR = error on opening for write access.
   * ERROR_TYPE_VAR = error on variables.
   * ERROR_TYPE_VID = error on variable ids.
   * ERROR_TYPE_CLO = error on closing.
   * ERROR_TYPE_ARG = error on routine argument.

SOURCE

  integer, parameter :: ERROR_TYPE_ATT =  1, ERROR_TYPE_DID =  2, ERROR_TYPE_DIM =  3, &
                      & ERROR_TYPE_END =  4, ERROR_TYPE_DEF =  5, ERROR_TYPE_OCR =  6, &
                      & ERROR_TYPE_ORD =  7, ERROR_TYPE_OWR =  8, ERROR_TYPE_VAR =  9, &
                      & ERROR_TYPE_VID = 10, ERROR_TYPE_CLO = 11, ERROR_TYPE_ARG = 12

ETSF_IO_LOW_CONSTANTS

[ Top ] [ etsf_io_low_level ] [ Definitions ]

NAME

ETSF_IO_LOW_CONSTANTS

FUNCTION

These values are identical to the ones defined in NetCDF. They are defined to be able to use "implicit none" without linking with NetCDF library.

SOURCE

  integer, parameter :: etsf_io_low_global_att = NF90_GLOBAL
  integer, parameter :: etsf_io_low_integer    = NF90_INT
  integer, parameter :: etsf_io_low_real       = NF90_FLOAT
  integer, parameter :: etsf_io_low_double     = NF90_DOUBLE
  integer, parameter :: etsf_io_low_character  = NF90_CHAR

etsf_io_low_error

[ Top ] [ etsf_io_low_error_group ] [ Structures ]

NAME

etsf_io_low_error

FUNCTION

This structure is used to store error informations. Three fields are mandatory and can always be read: 

   * backtrace, which is a list of strings with the name of the methods where
     the error occurs and come from (the number of relevent names is given
     by @backtraceId) ;
   * access_mode_id, which is a #ERROR_MODE value ;
   * target_type_id, which is a #ERROR_TYPE value.

All other fields may be filled depending on the calling method. When a field is irrelevant, if an id, it is null or negative, and when a string it is void string (trim(string) == "").

SOURCE

  type etsf_io_low_error
     character(len = 80), dimension(100) :: backtrace
     integer :: backtraceId = 0

     integer :: access_mode_id
     character(len = 80) :: access_mode_str
     integer :: target_type_id
     character(len = 80) :: target_type_str

     integer :: target_id
     character(len = 80) :: target_name

     integer :: error_id
     character(len = 256) :: error_message
  end type etsf_io_low_error

etsf_io_low_error_len

[ Top ] [ etsf_io_low_error_group ] [ Definitions ]

NAME

etsf_io_low_error_len

FUNCTION

This value is the length of the strings used to represent errors, see etsf_io_low_error_to_str().

SOURCE

  integer, parameter :: etsf_io_low_error_len  = 4096

etsf_io_low_var_double

[ Top ] [ etsf_io_low_var ] [ Structures ]

NAME

etsf_io_low_var_double

FUNCTION

This structure is used as an abstraction on a storage for a variable. Only one pointer can be associated at a time. The shape of the stored data is then defined by the associated pointer. This structure is used to read or write data when the storage area in memory can have different shapes.

SOURCE

  type etsf_io_low_var_double
    double precision, pointer :: data1D(:) => null()
    double precision, pointer :: data2D(:, :) => null()
    double precision, pointer :: data3D(:, :, :) => null()
    double precision, pointer :: data4D(:, :, :, :) => null()
    double precision, pointer :: data5D(:, :, :, :, :) => null()
    double precision, pointer :: data6D(:, :, :, :, :, :) => null()
    double precision, pointer :: data7D(:, :, :, :, :, :, :) => null()
  end type etsf_io_low_var_double

etsf_io_low_var_infos

[ Top ] [ etsf_io_low_level ] [ Structures ]

NAME

etsf_io_low_var_infos

FUNCTION

This structure is used to store variable informations, such as name, NetCDF id, type, shape and dimensions. It contains the following elements:

  • nctype: the type of the variable, see #ETSF_IO_LOW_CONSTANTS.
  • ncid: the id used by NetCDF to access this variable.
  • name: the variable name.
  • ncshape: the number of dimensions (0 for scalar variable).
  • ncdims: the size for each dimension (only (1:ncshape) are relevent).
  • ncdimnames: the name corresponding to such dimensions (may be unset ; if set, use etsf_io_low_free_var_infos()).
  • ncattnames: the name corresponding to all associated attributes (may be unset ; if set, use etsf_io_low_free_var_infos()).

SOURCE

  type etsf_io_low_var_infos
    character(len = 80) :: name
    integer :: nctype
    integer :: ncid
    integer :: ncshape
    integer :: ncdims(1:16)
    character(len = 80), pointer :: ncdimnames(:) => null()
    character(len = 80), pointer :: ncattnames(:) => null()
  end type etsf_io_low_var_infos

etsf_io_low_var_integer

[ Top ] [ etsf_io_low_var ] [ Structures ]

NAME

etsf_io_low_var_integer

FUNCTION

This structure is used as an abstraction on a storage for a variable. Only one pointer can be associated at a time. The shape of the stored data is then defined by the associated pointer. This structure is used to read or write data when the storage area in memory can have different shapes.

SOURCE

  type etsf_io_low_var_integer
    integer, pointer :: data1D(:) => null()
    integer, pointer :: data2D(:, :) => null()
    integer, pointer :: data3D(:, :, :) => null()
    integer, pointer :: data4D(:, :, :, :) => null()
    integer, pointer :: data5D(:, :, :, :, :) => null()
    integer, pointer :: data6D(:, :, :, :, :, :) => null()
    integer, pointer :: data7D(:, :, :, :, :, :, :) => null()
  end type etsf_io_low_var_integer
etsf_io-1.0.3/doc/www/low_level/read_routines_f90.html0000644000353400050620000024160411354150414017663 00000000000000 ./src/low_level/read_routines.f90

TABLE OF CONTENTS

etsf_io_low_check_att

[ Top ] [ etsf_io_low_check_group ] [ Methods ]

NAME

etsf_io_low_check_att

FUNCTION

This method is used to check that an attribute:

  • exists in the read NetCDF file ;
  • has the right type ;
  • has the right length (1 for scalar, > 1 for arrays).

INPUTS

  • ncid = a NetCDF handler, opened with read access.
  • ncvarid = the id of the variable the attribute is attached to. in the case of global attributes, use the constance NF90_GLOBAL (when linking against NetCDF) or #etsf_io_low_global_att which is a wrapper exported by this module (see #ETSF_IO_LOW_CONSTANTS).
  • attname = a string identifying an attribute.
  • atttype = an integer identifying the type (see #ETSF_IO_LOW_CONSTANTS).
  • attlen = the size of the array, or 1 when the attribute is a scalar.

OUTPUT

  • lstat = .true. if operation succeed.
  • error_data <type(etsf_io_low_error)> = (optional) location to store error data.

ERRORS

  • ERROR_MODE_INQ & ERROR_TYPE_ATT: when the attribute doesn't exist.
  • ERROR_MODE_SPEC & ERROR_TYPE_ATT: when the attribute has a wrong type or dimension.

SOURCE

  subroutine etsf_io_low_check_att(ncid, ncvarid, attname, atttype, attlen, lstat, error_data)
    integer, intent(intent)                            :: ncid
    integer, intent(intent)                            :: ncvarid
    character(len = *), intent(intent)                 :: attname
    integer, intent(intent)                            :: atttype, attlen
    logical, intent(out)                           :: lstat
    type(etsf_io_low_error), intent(out), optional :: error_data
    
    !Local
    character(len = *), parameter :: me = "etsf_io_low_check_att"
    character(len = 80) :: err
    integer :: select, nctype, nclen

    lstat = .false.    
    select = nf90_inquire_attribute(ncid, ncvarid, attname, xtype = nctype, len = nclen) 
    if (select /= nf90_noerr) then
      if (present(error_data)) then
        call etsf_io_low_error_set(error_data, ERROR_MODE_INQ, ERROR_TYPE_ATT, &
             & me, tgtname = attname, errid = select, errmess = nf90_strerror(select))
      end if
      return
    end if
    ! Check the type
    if (nctype /= atttype) then
      write(err, "(A,I5,A,I5,A)") "wrong type (read = ", nctype, &
                                & ", awaited = ", atttype, ")"
      if (present(error_data)) then
        call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ATT, &
             & me, tgtname = attname, errmess = err)
      end if
      return
    end if
    ! Check the dimensions
    if ((atttype == NF90_CHAR .and. nclen > attlen) .or. &
      & (atttype /= NF90_CHAR .and. nclen /= attlen)) then
      write(err, "(A,I5,A,I5,A)") "wrong length (read = ", nclen, &
                                & ", awaited = ", attlen, ")"
      if (present(error_data)) then
        call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ATT, &
             & me, tgtname = attname, errmess = err)
      end if
      return
    end if
    lstat = .true.
  end subroutine etsf_io_low_check_att

etsf_io_low_check_header

[ Top ] [ etsf_io_low_check_group ] [ Methods ]

NAME

etsf_io_low_check_header

FUNCTION

This method is specific to ETSF files. It checks if the header is conform to the specifications, which means having the right "file_format" attribute, the right "file_format_version" one and also an attribute named "Conventions". Moreover, the routine can do a check on the value of the file_format_version to ensure high enough value.

INPUTS

  • ncid = a NetCDF handler, opened with read access.

OUTPUT

  • lstat = .true. if operation succeed.
  • version_min = (optional) the number of minimal version to be read.
  • error_data <type(etsf_io_low_error)> = (optional) location to store error data.

SOURCE

  subroutine etsf_io_low_check_header(ncid, lstat, version_min, error_data)
    integer, intent(intent)                            :: ncid
    logical, intent(out)                           :: lstat
    real, intent(intent), optional                     :: version_min
    type(etsf_io_low_error), intent(out), optional :: error_data

    !Local
    character(len = *), parameter :: me = "etsf_io_low_check_header"
    character(len = 80) :: err, format
    integer :: select
    real :: version_real
    logical :: stat

    lstat = .false.
    ! Check the header
    write(format, "(A80)") " "
    if (present(error_data)) then
      call etsf_io_low_read_att(ncid, NF90_GLOBAL, "file_format", 80, format, &
           & stat, error_data) 
      if (.not. stat) call etsf_io_low_error_update(error_data, me)
    else
      call etsf_io_low_read_att(ncid, NF90_GLOBAL, "file_format", 80, format, stat) 
    end if
    if (.not. stat) then
      call etsf_io_low_close(ncid, stat)
      return
    end if
    if (trim(adjustl(format)) /= "ETSF Nanoquanta") then
      write(err, "(A,A,A)") "wrong value: '", trim(adjustl(format(1:60))), "'"
      if (present(error_data)) then
        call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ATT, &
             & me, tgtname = "file_format", errmess = err)
      end if
      call etsf_io_low_close(ncid, stat)
      return
    end if
    ! Check the version
    if (present(error_data)) then
      call etsf_io_low_read_att(ncid, NF90_GLOBAL, "file_format_version", &
                              & version_real, stat, error_data) 
      if (.not. stat) call etsf_io_low_error_update(error_data, me)
    else
      call etsf_io_low_read_att(ncid, NF90_GLOBAL, "file_format_version", &
                              & version_real, stat)
    end if
    if (.not. stat) then
      call etsf_io_low_close(ncid, stat)
      return
    end if
    if (present(version_min)) then
      stat = (version_real >= version_min)
    else
      stat = (version_real >= 1.3)
    end if
    if (.not. stat) then
      write(err, "(A,F10.5)") "wrong value: ", version_real
      if (present(error_data)) then
        call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ATT, &
             & me, tgtname = "file_format_version", errmess = err)
      end if
      call etsf_io_low_close(ncid, stat)
      return
    end if
    ! Check for the Conventions flag
    if (present(error_data)) then
      call etsf_io_low_check_att(ncid, NF90_GLOBAL, "Conventions", &
                               & NF90_CHAR, 80, stat, error_data) 
      if (.not. stat) call etsf_io_low_error_update(error_data, me)
    else
      call etsf_io_low_check_att(ncid, NF90_GLOBAL, "Conventions", NF90_CHAR, 80, stat) 
    end if
    if (.not. stat) then
      call etsf_io_low_close(ncid, stat)
      return
    end if
    lstat = .true.
  end subroutine etsf_io_low_check_header

etsf_io_low_check_var

[ Top ] [ etsf_io_low_check_group ] [ Methods ]

NAME

etsf_io_low_check_var

FUNCTION

This method is used to compare the informations (type, shape...) of two given variables. It returns .true. if the variables are compatible (data from one can be transfered to the other). It can also say if the match is perfect or if the transfer requires convertion (type or shape).

INPUTS

  • var_ref <type(etsf_io_low_var_infos)> = store, type, shape, dimensions and NetCDF id.
  • var <type(etsf_io_low_var_infos)> = store, type, shape, dimensions and NetCDF id.
  • sub = (optional) restrict the check to the lower dimensions (0 < sub <= var_ref%ncshape).

OUTPUT

  • lstat = .true. if the two variable definitions are compatible.
  • level = (optional) when variables are compatibles (lstat = .true.), this flag gives information on matching (see #FLAGS_MATCHING).
  • error_data <type(etsf_io_low_error)> = (optional) location to store error data.

SOURCE

  subroutine etsf_io_low_check_var(var_ref, var, start, count, map, lstat, error_data)
    type(etsf_io_low_var_infos), intent(intent)        :: var_ref
    type(etsf_io_low_var_infos), intent(intent)        :: var
    integer, intent(intent)                            :: start(:), count(:), map(:)
    logical, intent(out)                           :: lstat
    type(etsf_io_low_error), intent(out), optional :: error_data

    !Local
    character(len = *), parameter :: me = "etsf_io_low_check_var"
    character(len = 80) :: err
    integer :: i, select, nb_ele_ref, nb_ele, sub_shape
    integer :: nclendims(1:7)
    
    lstat = .false.
    ! Check the type, if both numeric or both strings, vars are compatible.
    if ((var_ref%nctype == NF90_CHAR .and. var%nctype /= NF90_CHAR) .or. &
      & (var_ref%nctype /= NF90_CHAR .and. var%nctype == NF90_CHAR)) then
      write(err, "(A)") "incompatible type, both must be either numeric or character."
      if (present(error_data)) then
        call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, &
                     & tgtname = var_ref%name, errmess = err)
      end if
      return
    end if

    ! Size checks.
    if (var_ref%ncshape > 1 .and. (size(start) /= var_ref%ncshape .or. &
      & size(count) /= var_ref%ncshape .or. size(map) /= var_ref%ncshape)) then
      if (present(error_data)) then
        call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ARG, me, &
             & tgtname = trim(var_ref%name) // " (start | count | map)", &
             & errmess = "inconsistent length")
      end if
      return
    end if
    ! Checks on start.
    do i = 1, var_ref%ncshape, 1
      if (start(i) <= 0 .or. start(i) > var_ref%ncdims(i)) then
        if (present(error_data)) then
          write(err, "(A,I0,A,I0,A,I5,A)") "wrong start value for index ", i, &
                                         & " (start(", i, ") = ", start(i), ")"
          call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ARG, &
               & me, tgtname = trim(var_ref%name)//" (start)", errmess = err)
        end if
        return
      end if
    end do
    ! Checks on count.
    do i = 1, var_ref%ncshape, 1
      if (count(i) <= 0 .or. count(i) > var_ref%ncdims(i)) then
        if (present(error_data)) then
          write(err, "(A,I0,A,I0,A,I5,A)") "wrong count value for index ", i, &
                                         & " (count(", i, ") = ", count(i), ")"
          call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ARG, &
               & me, tgtname = trim(var_ref%name)//" (count)", errmess = err)
        end if
        return
      end if
    end do
    ! Checks on map
    ! We get the number of destination elements
    if (var%ncshape == 0) then
      nb_ele = 1
    else
      nb_ele = product(var%ncdims(1:var%ncshape))
    end if
    ! We check that the mapping will not exceed the number of destination elements.
    nb_ele_ref = 1
    if (var%ncshape == 0) then
      ! if the destination variable is a scalar,
      ! we can ignore the map argument.
      nb_ele_ref = 1
    else
      do i = 1, var_ref%ncshape, 1
        nb_ele_ref = nb_ele_ref + map(i) * (count(i) - 1)
      end do
    end if
    if (nb_ele_ref > nb_ele) then
      if (present(error_data)) then
        write(err, "(A,A,I5,A,I5,A)") "wrong map value ", &
                                  & " (map address = ", nb_ele_ref, &
                                  & " & max address = ", nb_ele , ")"
        call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ARG, me, &
             & tgtname = trim(var_ref%name)//" (map)", errmess = err)
      end if
      return
    end if
    
    ! The argument has a different shape that the store variable.
    ! We check the compatibility, product(var_to%ncdims) == product(var_from%ncdims)
    if (var_ref%ncshape == 0 .or. var%ncshape == 0) then
      ! If var shape is scalar, then always one element will be accessed.
      nb_ele_ref = 1
    else
      nb_ele_ref = product(count(1:var_ref%ncshape))
    end if
    if (nb_ele_ref /= nb_ele) then
      write(err, "(A,I5,A,I5,A)") "incompatible number of data (var_ref = ", &
                                & nb_ele_ref, " & var = ", nb_ele, ")"
      if (present(error_data)) then
        call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_VAR, me, &
                      & tgtname = var_ref%name, errmess = err)
      end if
      return
    end if
    lstat = .true.
  end subroutine etsf_io_low_check_var

etsf_io_low_open_read

[ Top ] [ etsf_io_low_file_group ] [ Methods ]

NAME

etsf_io_low_open_read

FUNCTION

This method is used to open a NetCDF file with read access only. Moreover, a check on the header is done to verify that the file is conformed to specifications (see etsf_io_low_check_header()).

INPUTS

  • filename = the path to the file to open.

OUTPUT

  • ncid = the NetCDF handler, opened with read access.
  • lstat = .true. if operation succeed.
  • version_min = (optional) the number of minimal version to be read.
  • error_data <type(etsf_io_low_error)> = (optional) location to store error data.
  • with_etsf_header = (optional) if true, will check that there is a header as defined in the ETSF specifications (default is .true.).

SOURCE

  subroutine etsf_io_low_open_read(ncid, filename, lstat, version_min, &
                                 & error_data, with_etsf_header)
    integer, intent(out)                           :: ncid
    character(len = *), intent(intent)                 :: filename
    logical, intent(out)                           :: lstat
    real, intent(intent), optional                     :: version_min
    type(etsf_io_low_error), intent(out), optional :: error_data
    logical, intent(intent), optional                  :: with_etsf_header

    !Local
    character(len = *), parameter :: me = "etsf_io_low_open_read"
    integer :: select
    logical :: my_with_etsf_header
    
    lstat = .false.
    ! Open file for reading
    select = nf90_open(path = filename, mode = NF90_NOWRITE, ncid = ncid)
    if (select /= nf90_noerr) then
      if (present(error_data)) then
        call etsf_io_low_error_set(error_data, ERROR_MODE_IO, ERROR_TYPE_ORD, &
             & me, tgtname = filename, errid = select, errmess = nf90_strerror(select))
      end if
      return
    end if
    ! From now on the file is open. If an error occur,
    ! we should close it.

    if (present(with_etsf_header)) then
      my_with_etsf_header = with_etsf_header
    else
      my_with_etsf_header = .true.
    end if
    if (my_with_etsf_header) then
      if (present(error_data)) then
        if (present(version_min)) then
          call etsf_io_low_check_header(ncid, lstat, version_min, error_data)
        else
          call etsf_io_low_check_header(ncid, lstat, error_data = error_data)
        end if
        if (.not. lstat) call etsf_io_low_error_update(error_data, me)
      else
        if (present(version_min)) then
          call etsf_io_low_check_header(ncid, lstat, version_min = version_min)
        else
          call etsf_io_low_check_header(ncid, lstat)
        end if
      end if
    else
      lstat = .true.
    end if
  end subroutine etsf_io_low_open_read

etsf_io_low_read_all_var_infos

[ Top ] [ etsf_io_low_var_infos ] [ Structures ]

NAME

etsf_io_low_read_all_var_infos

FUNCTION

Read a NetCDF file and create an array storing all variable informations. These informations are stored in an array allocated in this routine. It must be deallocated after use. The retrieved informations include NetCDF varid, variable name, shape and dimensions. If the with_dim_name is set to .true., the names of dimensions are also stored.

INPUTS

  • ncid = a NetCDF handler, opened with read access.
  • with_dim_name = (optional) if set to .true., the dimension names are also retrieved. In that case, each element of output array @var_infos_array must be freed using etsf_io_low_free_var_infos().
  • with_att_name = (optional) if set to .true., the attribute names are also retrieved. In that case, each element of output array @var_infos_array must be freed using etsf_io_low_free_var_infos().

OUTPUT

  • var_infos_array <type(etsf_io_low_var_infos)> = a pointer on an array to store the informations. This pointer must be null() on enter. If no variables are found or an error occurs, the pointer is let null().
  • lstat = .true. if the file has been read without error.
  • error_data <type(etsf_io_low_error)> = (optional) location to store error data.

SOURCE

  subroutine etsf_io_low_read_all_var_infos(ncid, var_infos_array, lstat, &
       & error_data, with_dim_name, with_att_name)
    integer, intent(intent)                               :: ncid
    type(etsf_io_low_var_infos), pointer              :: var_infos_array(:)
    logical, intent(out)                              :: lstat
    type(etsf_io_low_error), intent(out), optional    :: error_data
    logical, optional, intent(intent)                     :: with_dim_name
    logical, optional, intent(intent)                     :: with_att_name

    !Local
    character(len = *), parameter :: me = "etsf_io_low_read_all_var_infos"
    integer :: i, j, select, nvars
    logical :: my_with_dim_name, my_with_att_name

    lstat = .false.
    if (present(with_dim_name))then
       my_with_dim_name = with_dim_name
    else
       my_with_dim_name = .false.
    end if
    if (present(with_att_name))then
       my_with_att_name = with_att_name
    else
       my_with_att_name = .false.
    end if
    ! Consistency checks...
    if (associated(var_infos_array)) then
       if (present(error_data)) then
          call etsf_io_low_error_set(error_data, ERROR_MODE_INQ, ERROR_TYPE_ARG, me, &
               & tgtname = "var_infos_array", errid = 0, &
               & errmess = "pointer already allocated.")
       end if
       return
    end if
    var_infos_array => null()
    ! Inquire the NetCDF file for number of variables
    select = nf90_inquire(ncid, nVariables = nvars)
    if (select /= nf90_noerr) then
       if (present(error_data)) then
          call etsf_io_low_error_set(error_data, ERROR_MODE_INQ, ERROR_TYPE_VAR, me, &
               & errid = select, errmess = nf90_strerror(select))
       end if
       return
    end if
    if (nvars == 0) then
       ! No variables in the file.
       lstat = .true.
       return
    end if
    ! Allocate the var_infos_array argument and read var_infos for each
    ! variables in the NetCDF file.
    allocate(var_infos_array(nvars))
    do i = 1, nvars, 1
       if (present(error_data))then
          call read_var_infos_id(ncid, i, var_infos_array(i), lstat, error_data, &
               & dim_name = my_with_dim_name, att_name = my_with_att_name)
          if (.not. lstat) call etsf_io_low_error_update(error_data, me)
       else
          call read_var_infos_id(ncid, i, var_infos_array(i), lstat, &
               & dim_name = my_with_dim_name, att_name = my_with_att_name)
       end if
       ! Handle the error, if required.
       if (.not. lstat) then
          ! Free the var_infos_array argument before leaving
          do j = 1, i, 1
             call etsf_io_low_free_var_infos(var_infos_array(i))
          end do
          deallocate(var_infos_array)
          var_infos_array => null()
          return
       end if
    end do
    lstat = .true.
  end subroutine etsf_io_low_read_all_var_infos

etsf_io_low_read_dim

[ Top ] [ etsf_io_low_read_group ] [ Methods ]

NAME

etsf_io_low_read_dim

FUNCTION

This method is a wraper to get in one call the id of one dimension and its value.

INPUTS

  • ncid = a NetCDF handler, opened with read access.
  • dimname = a string identifying a dimension.

OUTPUT

  • dimvalue = a positive integer which is the length of the dimension.
  • lstat = .true. if operation succeed.
  • ncdimid = (optional) the id used by NetCDF to identify the read dimension.
  • error_data <type(etsf_io_low_error)> = (optional) location to store error data.

SOURCE

  subroutine etsf_io_low_read_dim(ncid, dimname, dimvalue, lstat, ncdimid, error_data)
    integer, intent(intent)                            :: ncid
    character(len = *), intent(intent)                 :: dimname
    integer, intent(out)                           :: dimvalue
    logical, intent(out)                           :: lstat
    integer, intent(out), optional                 :: ncdimid
    type(etsf_io_low_error), intent(out), optional :: error_data

    !local
    character(len = *), parameter :: me = "etsf_io_low_read_dim"
    integer :: select, dimid

    lstat = .false.
    ! will inq_dimid() and inq_dimlen() + error handling
    select = nf90_inq_dimid(ncid, dimname, dimid)
    if (select /= nf90_noerr) then
      if (present(error_data)) then
        call etsf_io_low_error_set(error_data, ERROR_MODE_INQ, ERROR_TYPE_DID, me, &
             & tgtname = dimname, errid = select, errmess = nf90_strerror(select))
      end if
      return
    end if
    select = nf90_inquire_dimension(ncid, dimid, len = dimvalue)
    if (select /= nf90_noerr) then
      if (present(error_data)) then
        call etsf_io_low_error_set(error_data, ERROR_MODE_INQ, ERROR_TYPE_DIM, me, &
             & tgtname = dimname, tgtid = dimid, errid = select, errmess = nf90_strerror(select))
      end if
      return
    end if
    if (present(ncdimid)) then
      ncdimid = dimid
    end if
    lstat = .true.    
  end subroutine etsf_io_low_read_dim
etsf_io-1.0.3/doc/www/low_level/write_routines_f90.html0000644000353400050620000022257211354150414020105 00000000000000 ./src/low_level/write_routines.f90

TABLE OF CONTENTS

etsf_io_low_copy_all_att

[ Top ] [ etsf_io_low_write_group ] [ Methods ]

NAME

etsf_io_low_copy_all_att

FUNCTION

Copy all attributes from the given variable of the given file to an other variable (of a different file, but not necessary). The variable ids from and to can be either valid variables or etsf_io_low_global_att.

INPUTS

  • ncid_from = a NetCDF handler, opened with read access.
  • ncid_to = a NetCDF handler, opened with write access.
  • ncvarid_from = a NetCDF variable id with attributes to copy.
  • ncvarid_to = a NetCDF variable id to copy the attributes to.

OUTPUT

  • lstat = .true. if the file has been read without error.
  • error_data <type(etsf_io_low_error)> = (optional) location to store error data.

SOURCE

  subroutine etsf_io_low_copy_all_att(ncid_from, ncid_to, ncvarid_from, &
       & ncvarid_to, lstat, error_data)
    integer, intent(intent)                            :: ncid_from, ncid_to
    integer, intent(intent)                            :: ncvarid_from, ncvarid_to
    logical, intent(out)                           :: lstat
    type(etsf_io_low_error), intent(out), optional :: error_data

    character(len = *), parameter :: me = "etsf_io_low_copy_all_att"
    type(etsf_io_low_var_infos) :: var_infos
    integer :: i, select, n
    character(len = NF90_MAX_NAME) :: ncname    

    lstat = .true.
    if (ncvarid_from /= etsf_io_low_global_att) then
       if (present(error_data)) then
          call read_var_infos_id(ncid_from, ncvarid_from, var_infos, lstat, &
               & error_data = error_data, dim_name = .false., att_name = .true.)
          if (.not. lstat) call etsf_io_low_error_update(error_data, me)
       else
          call read_var_infos_id(ncid_from, ncvarid_from, var_infos, lstat, &
               & dim_name = .false., att_name = .true.)
       end if
       if (.not. lstat) return
    else
       select = nf90_inquire(ncid_from, nAttributes = n)
       if (select /= nf90_noerr) then
          if (present(error_data)) then
             call etsf_io_low_error_set(error_data, ERROR_MODE_INQ, ERROR_TYPE_ATT, &
                  & me, tgtname = "global attributes", errid = select, &
                  & errmess = nf90_strerror(select))
          end if
          lstat = .false.
          return
       end if
       if (n > 0) then
          allocate(var_infos%ncattnames(1:n))
          do i = 1, n, 1
             select = nf90_inq_attname(ncid_from, etsf_io_low_global_att, i, ncname)
             if (select /= nf90_noerr) then
                if (present(error_data)) then
                   call etsf_io_low_error_set(error_data, ERROR_MODE_INQ, &
                        & ERROR_TYPE_ATT, me, tgtid = i, errid = select, &
                        & errmess = nf90_strerror(select))
                end if
                call etsf_io_low_free_var_infos(var_infos)
                lstat = .false.
                return
             end if
             write(var_infos%ncattnames(i), "(A)") ncname(1:min(80, len(ncname)))
          end do
       end if
    end if

    if (associated(var_infos%ncattnames)) then
       do i = 1, size(var_infos%ncattnames, 1), 1
          select = nf90_copy_att(ncid_from, ncvarid_from, trim(var_infos%ncattnames(i)), &
               & ncid_to, ncvarid_to)
          if (select /= nf90_noerr) then
             if (present(error_data)) then
                call etsf_io_low_error_set(error_data, ERROR_MODE_COPY, ERROR_TYPE_ATT, &
                     & me, tgtname = trim(var_infos%ncattnames(i)), errid = select, &
                     & errmess = nf90_strerror(select))
             end if
             lstat = .false.
             exit
          end if
       end do
    end if
    call etsf_io_low_free_var_infos(var_infos)
  end subroutine etsf_io_low_copy_all_att

etsf_io_low_open_create

[ Top ] [ etsf_io_low_file_group ] [ Methods ]

NAME

etsf_io_low_open_create

FUNCTION

This method is used to open a NetCDF file. The file should not already exist. The ETSF header for the created file is automatically added by this method. When finished, the file handled by @ncid, is in define mode, which means that dimensions (see etsf_io_low_write_dim()), variables (see etsf_io_low_def_var()) and attributes (see etsf_io_low_write_att()) can be defined. To use etsf_io_low_write_var(), the file should be switched to data mode using etsf_io_low_set_write_mode().

If title or history are given and are too long, they will be truncated.

If one wants to modify an already existing file, one should use etsf_io_low_open_modify() instead.

INPUTS

  • filename = the path to the file to open.
  • version = the number of version to be created.
  • title = (optional) a title for the file (80 characters max).
  • history = (optional) the first line of history (1024 characters max).
  • with_etsf_header = (optional) if true, will create a header as defined in the ETSF specifications (default is .true.). When value is .false., arguments title, history and version are ignored.
  • overwrite = (optional) if true, an existing file with the same name as @filename would be overwritten. Default is .false., which means that an IO error is raised if a file already exists.

OUTPUT

  • ncid = the NetCDF handler, opened with write access (define mode).
  • lstat = .true. if operation succeed.
  • error_data <type(etsf_io_low_error)> = (optional) location to store error data.

SOURCE

  subroutine etsf_io_low_open_create(ncid, filename, version, lstat, &
                                   & title, history, error_data, with_etsf_header, &
                                   & overwrite)
    integer, intent(out)                           :: ncid
    character(len = *), intent(intent)                 :: filename
    real, intent(intent)                               :: version
    logical, intent(out)                           :: lstat
    character(len = *), intent(intent), optional       :: title
    character(len = *), intent(intent), optional       :: history
    type(etsf_io_low_error), intent(out), optional :: error_data
    logical, intent(intent), optional                  :: with_etsf_header
    logical, intent(intent), optional                  :: overwrite
    
    !Local
    character(len = *), parameter :: me = "etsf_io_low_open_create"
    character(len = 256) :: err
    integer :: select, cmode
    logical :: stat
    
    lstat = .false.
    ! Checking that @version argument is valid.
    if (version < 1.0) then
      if (present(error_data)) then
        write(err, "(A,I0,A)") "Wrong version argument (given: ", version, " ; awaited >= 1.0)"
        call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ATT, me, &
                     & tgtname = "file_format_version", errmess = err)
      end if
      return
    end if
    ! Open file for writing
    cmode = NF90_NOCLOBBER
    if (present(overwrite)) then
      if (overwrite) then
        cmode = NF90_CLOBBER
      end if
    end if
    ! We don't use the 64bits flag since the specifications advice
    ! to split huge quantities of data into several smaller files.
    select = nf90_create(path = filename, cmode = cmode, ncid = ncid)
    if (select /= nf90_noerr) then
      if (present(error_data)) then
        call etsf_io_low_error_set(error_data, ERROR_MODE_IO, ERROR_TYPE_OWR, &
             & me, tgtname = filename, errid = select, errmess = nf90_strerror(select))
      end if
      return
    end if
    ! From now on the file is open. If an error occur,
    ! we should close it.
    
    ! We create the header if required.
    if (present(with_etsf_header)) then
      if (.not. with_etsf_header) then
        lstat = .true.
        return
      end if
    end if
    ! The file format
    select = nf90_put_att(ncid, NF90_GLOBAL, "file_format", etsf_io_low_file_format)
    if (select /= nf90_noerr) then
      if (present(error_data)) then
        call etsf_io_low_error_set(error_data, ERROR_MODE_PUT, ERROR_TYPE_ATT, &
             & me, tgtname = "file_format", errid = select, errmess = nf90_strerror(select))
      end if
      call etsf_io_low_close(ncid, stat)
      return
    end if
    ! The version
    select = nf90_put_att(ncid, NF90_GLOBAL, "file_format_version", version)
    if (select /= nf90_noerr) then
      if (present(error_data)) then
        call etsf_io_low_error_set(error_data, ERROR_MODE_PUT, ERROR_TYPE_ATT, me, &
             & tgtname = "file_format_version", errid = select, errmess = nf90_strerror(select))
      end if
      call etsf_io_low_close(ncid, stat)
      return
    end if
    ! The conventions
    select = nf90_put_att(ncid, NF90_GLOBAL, "Conventions", etsf_io_low_conventions)
    if (select /= nf90_noerr) then
      if (present(error_data)) then
        call etsf_io_low_error_set(error_data, ERROR_MODE_PUT, ERROR_TYPE_ATT, me, &
             & tgtname = "Conventions", errid = select, errmess = nf90_strerror(select))
      end if
      call etsf_io_low_close(ncid, stat)
      return
    end if
    ! The title if present
    if (present(title)) then
      select = nf90_put_att(ncid, NF90_GLOBAL, "title", title(1:min(80, len(title))))
      if (select /= nf90_noerr) then
        if (present(error_data)) then
          call etsf_io_low_error_set(error_data, ERROR_MODE_PUT, ERROR_TYPE_ATT, &
               & me, tgtname = "title", errid = select, errmess = nf90_strerror(select))
        end if
        call etsf_io_low_close(ncid, stat)
        return
      end if
    end if
    ! The history if present
    if (present(history)) then
      select = nf90_put_att(ncid, NF90_GLOBAL, "history", history(1:min(1024, len(history))))
      if (select /= nf90_noerr) then
        if (present(error_data)) then
          call etsf_io_low_error_set(error_data, ERROR_MODE_PUT, ERROR_TYPE_ATT, &
               & me, tgtname = "history", errid = select, errmess = nf90_strerror(select))
        end if
        call etsf_io_low_close(ncid, stat)
        return
      end if
    end if
    
    lstat = .true.
  end subroutine etsf_io_low_open_create

etsf_io_low_open_modify

[ Top ] [ etsf_io_low_file_group ] [ Methods ]

NAME

etsf_io_low_open_modify

FUNCTION

This method is used to open a NetCDF file for modifications. The file should already exist and have a valid ETSF header (if @with_etsf_header is not set to .false.).

When finished, the file handled by @ncid, is in define mode, which means that dimensions (see etsf_io_low_write_dim()), variables (see etsf_io_low_def_var()) and attributes (see etsf_io_low_write_att()) can be defined. To use etsf_io_low_write_var(), the file should be switched to data mode using etsf_io_low_set_write_mode().

If title or history are given and are too long, they will be truncated. Moreover the given history is appended to the already existing history (if enough place exists).

If one wants to create a new file, one should use etsf_io_low_open_create() instead.

INPUTS

  • filename = the path to the file to open.
  • title = (optional) a title for the file (80 characters max).
  • history = (optional) the first line of history (1024 characters max).
  • version = (optional) the number of version to be changed (>= 1.0).

OUTPUT

  • ncid = the NetCDF handler, opened with write access (define mode).
  • lstat = .true. if operation succeed.
  • error_data <type(etsf_io_low_error)> = (optional) location to store error data.
  • with_etsf_header = (optional) if true, will check that there is a header as defined in the ETSF specifications (default is .true.).

SOURCE

  subroutine etsf_io_low_open_modify(ncid, filename, lstat, &
                                   & title, history, version, error_data, with_etsf_header)
    integer, intent(out)                           :: ncid
    character(len = *), intent(intent)                 :: filename
    logical, intent(out)                           :: lstat
    character(len = *), intent(intent), optional       :: title
    character(len = *), intent(intent), optional       :: history
    real, intent(intent), optional                     :: version
    type(etsf_io_low_error), intent(out), optional :: error_data
    logical, intent(intent), optional                  :: with_etsf_header
    
    !Local
    character(len = *), parameter :: me = "etsf_io_low_open_modify"
    character(len = 256) :: err
    character(len = 1024) :: current_history
    integer :: select
    logical :: stat
    logical :: my_with_etsf_header
    
    lstat = .false.
    ! Checking that @version argument is valid.
    if (present(version)) then
      if (version < 1.0) then
        if (present(error_data)) then
          write(err, "(A,I0,A)") "Wrong version argument (given: ", version, " ; awaited >= 1.0)"
          call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ATT, &
               & me, tgtname = "file_format_version", errmess = err)
        end if
        return
      end if
    end if
    ! Open file for writing
    select = nf90_open(path = filename, mode = NF90_WRITE, ncid = ncid)
    if (select /= nf90_noerr) then
      if (present(error_data)) then
        call etsf_io_low_error_set(error_data, ERROR_MODE_IO, ERROR_TYPE_OWR, &
             & me, tgtname = filename, errid = select, errmess = nf90_strerror(select))
      end if
      return
    end if
    ! From now on the file is open. If an error occur,
    ! we should close it.
    
    ! Before according access to modifications, we check
    ! that the header is valid.
    if (present(with_etsf_header)) then
      my_with_etsf_header = with_etsf_header
    else
      my_with_etsf_header = .true.
    end if
    if (my_with_etsf_header) then
      if (present(error_data)) then
        call etsf_io_low_check_header(ncid, stat, error_data = error_data)
        if (.not. stat) call etsf_io_low_error_update(error_data, me)
      else
        call etsf_io_low_check_header(ncid, stat)
      end if
      if (.not. stat) then
        call etsf_io_low_close(ncid, stat)
        return
      end if
    end if

    ! We switch to define mode to set attributes.
    if (present(error_data)) then
      call etsf_io_low_set_define_mode(ncid, stat, error_data = error_data)
      if (.not. stat) call etsf_io_low_error_update(error_data, me)
    else
      call etsf_io_low_set_define_mode(ncid, stat)
    end if
    if (.not. stat) then
      call etsf_io_low_close(ncid, stat)
      return
    end if
    if (.not. my_with_etsf_header) then
      lstat = .true.
      return
    end if

    ! If a title is given, we change it.
    if (present(title)) then
      select = nf90_put_att(ncid, NF90_GLOBAL, "title", title(1:min(80, len(title))))
      if (select /= nf90_noerr) then
        if (present(error_data)) then
          call etsf_io_low_error_set(error_data, ERROR_MODE_PUT, &
                                   & ERROR_TYPE_ATT, me, tgtname = "title", &
                                   & errid = select, errmess = nf90_strerror(select))
        end if
        call etsf_io_low_close(ncid, stat)
        return
      end if
    end if
    ! If a new version is given, we change it.
    if (present(version)) then
      select = nf90_put_att(ncid, NF90_GLOBAL, "file_format_version", version)
      if (select /= nf90_noerr) then
        if (present(error_data)) then
          call etsf_io_low_error_set(error_data, ERROR_MODE_PUT, ERROR_TYPE_ATT, me, &
                       & tgtname = "file_format_version", &
                       & errid = select, errmess = nf90_strerror(select))
        end if
        call etsf_io_low_close(ncid, stat)
        return
      end if
    end if
    ! If an history value is given, we append it.
    if (present(history)) then
      call etsf_io_low_read_att(ncid, NF90_GLOBAL, "history", 1024, &
           & current_history, stat)
      if (stat) then
        ! appending mode
        if (len(trim(current_history)) + len(history) < 1024) then
          current_history = trim(current_history) // char(10) // history
        end if
      else
        ! overwriting mode
        current_history = history
      end if
      select = nf90_put_att(ncid, NF90_GLOBAL, "history", current_history)
      if (select /= nf90_noerr) then
        if (present(error_data)) then
          call etsf_io_low_error_set(error_data, ERROR_MODE_PUT, ERROR_TYPE_ATT, me, &
                       & tgtname = "history", &
                       & errid = select, errmess = nf90_strerror(select))
        end if
        call etsf_io_low_close(ncid, stat)
        return
      end if
    end if
    
    lstat = .true.
  end subroutine etsf_io_low_open_modify

etsf_io_low_write_dim

[ Top ] [ etsf_io_low_write_group ] [ Methods ]

NAME

etsf_io_low_write_dim

FUNCTION

This method is a wraper add a dimension to a NetCDF file. As in pure NetCDF calls, overwriting a value is not permitted. Nevertheless, the method returns .true. in @lstat, if the dimension already exists and has the same value.

INPUTS

  • ncid = a NetCDF handler, opened with write access (define mode).
  • dimname = a string identifying a dimension.
  • dimvalue = a positive integer which is the length of the dimension.

OUTPUT

  • lstat = .true. if operation succeed.
  • ncdimid = (optional) the id used by NetCDF to identify the written dimension.
  • error_data <type(etsf_io_low_error)> = (optional) location to store error data.

SOURCE

  subroutine etsf_io_low_write_dim(ncid, dimname, dimvalue, lstat, ncdimid, error_data)
    integer, intent(intent)                            :: ncid
    character(len = *), intent(intent)                 :: dimname
    integer, intent(intent)                            :: dimvalue
    logical, intent(out)                           :: lstat
    integer, intent(out), optional                 :: ncdimid
    type(etsf_io_low_error), intent(out), optional :: error_data
    
    ! Local
    character(len = *), parameter :: me = "etsf_io_low_write_dim"
    character(len = 500) :: message
    integer :: select, dimid, readvalue
    
    ! Check if dimension already exists.
    call etsf_io_low_read_dim(ncid, dimname, readvalue, lstat)
    if (lstat) then
      ! Dimension already exists.
      if (readvalue /= dimvalue) then
        ! Dimension differs, raise error.
        if (present(error_data)) then
          write(message, "(2A,I0,A,I0,A)") "dimension already exists with a different", &
                                         & " value (read = ", readvalue, " ; write = ", &
                                         & dimvalue, ")."
          call etsf_io_low_error_set(error_data, ERROR_MODE_DEF, ERROR_TYPE_DIM, me, &
                                   & tgtname = dimname, errmess = message)
        end if
        lstat = .false.
        return
      else
        ! Dimension matches, return.
        return
      end if        
    end if
    ! Define dimension since it don't already exist.
    lstat = .false.
    select = nf90_def_dim(ncid, dimname, dimvalue, dimid)
    if (select /= nf90_noerr) then
      if (present(error_data)) then
        call etsf_io_low_error_set(error_data, ERROR_MODE_DEF, ERROR_TYPE_DIM, me, &
                                 & tgtname = dimname, errid = select, errmess = nf90_strerror(select))
      end if
      return
    end if
    if (present(ncdimid)) then
      ncdimid = dimid
    end if    
    lstat = .true.
  end subroutine etsf_io_low_write_dim
etsf_io-1.0.3/doc/www/group_level/0000777000353400050620000000000011354151531014065 500000000000000etsf_io-1.0.3/doc/www/group_level/Makefile.am0000644000353400050620000000305411354150413016035 00000000000000groupleveldoc_DATA = \ etsf_io_dims_def_f90.html \ etsf_io_dims_get_f90.html \ etsf_io_dims_merge_f90.html \ etsf_io_dims_trace_f90.html \ etsf_io_geometry_def_f90.html \ etsf_io_electrons_def_f90.html \ etsf_io_kpoints_def_f90.html \ etsf_io_basisdata_def_f90.html \ etsf_io_gwdata_def_f90.html \ etsf_io_dielectric_def_f90.html \ etsf_io_main_def_f90.html \ etsf_io_geometry_get_f90.html \ etsf_io_electrons_get_f90.html \ etsf_io_kpoints_get_f90.html \ etsf_io_basisdata_get_f90.html \ etsf_io_gwdata_get_f90.html \ etsf_io_dielectric_get_f90.html \ etsf_io_main_get_f90.html \ etsf_io_geometry_put_f90.html \ etsf_io_electrons_put_f90.html \ etsf_io_kpoints_put_f90.html \ etsf_io_basisdata_put_f90.html \ etsf_io_gwdata_put_f90.html \ etsf_io_dielectric_put_f90.html \ etsf_io_main_put_f90.html \ etsf_io_geometry_copy_f90.html \ etsf_io_electrons_copy_f90.html \ etsf_io_kpoints_copy_f90.html \ etsf_io_basisdata_copy_f90.html \ etsf_io_gwdata_copy_f90.html \ etsf_io_dielectric_copy_f90.html \ etsf_io_main_copy_f90.html \ etsf_io_split_init_f90.html \ etsf_io_split_allocate_f90.html \ etsf_io_split_free_f90.html \ etsf_io_split_def_f90.html \ etsf_io_split_get_f90.html \ etsf_io_split_put_f90.html \ etsf_io_split_copy_f90.html \ etsf_io_split_merge_f90.html \ etsf_io_vars_free_f90.html \ etsf_io_data_init_f90.html \ etsf_io_data_read_f90.html \ etsf_io_data_write_f90.html \ etsf_io_data_contents_f90.html \ etsf_io_data_get_f90.html \ etsf_io_data_copy_f90.html \ etsf_io_f90.html EXTRA_DIST = $(groupleveldoc_DATA) etsf_io-1.0.3/doc/www/group_level/Makefile.in0000644000353400050620000002543611354150417016062 00000000000000# Makefile.in generated by automake 1.10.1 from Makefile.am. # @configure_input@ # Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, # 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. # This Makefile.in is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY, to the extent permitted by law; without # even the implied warranty of MERCHANTABILITY or FITNESS FOR A # PARTICULAR PURPOSE. @SET_MAKE@ VPATH = @srcdir@ pkgdatadir = $(datadir)/@PACKAGE@ pkglibdir = $(libdir)/@PACKAGE@ pkgincludedir = $(includedir)/@PACKAGE@ am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd install_sh_DATA = $(install_sh) -c -m 644 install_sh_PROGRAM = $(install_sh) -c install_sh_SCRIPT = $(install_sh) -c INSTALL_HEADER = $(INSTALL_DATA) transform = $(program_transform_name) NORMAL_INSTALL = : PRE_INSTALL = : POST_INSTALL = : NORMAL_UNINSTALL = : PRE_UNINSTALL = : POST_UNINSTALL = : subdir = doc/www/group_level DIST_COMMON = $(srcdir)/Makefile.am $(srcdir)/Makefile.in ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 am__aclocal_m4_deps = $(top_srcdir)/config/m4/fortran.m4 \ $(top_srcdir)/configure.ac am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ $(ACLOCAL_M4) mkinstalldirs = $(install_sh) -d CONFIG_CLEAN_FILES = SOURCES = DIST_SOURCES = am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; am__vpath_adj = case $$p in \ $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \ *) f=$$p;; \ esac; am__strip_dir = `echo $$p | sed -e 's|^.*/||'`; am__installdirs = "$(DESTDIR)$(groupleveldocdir)" groupleveldocDATA_INSTALL = $(INSTALL_DATA) DATA = $(groupleveldoc_DATA) DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) ACLOCAL = @ACLOCAL@ AMTAR = @AMTAR@ AR = @AR@ AUTOCONF = @AUTOCONF@ AUTOHEADER = @AUTOHEADER@ AUTOMAKE = @AUTOMAKE@ AWK = @AWK@ CYGPATH_W = @CYGPATH_W@ DEFS = @DEFS@ ECHO_C = @ECHO_C@ ECHO_N = @ECHO_N@ ECHO_T = @ECHO_T@ EXEEXT = @EXEEXT@ FC = @FC@ FCFLAGS = @FCFLAGS@ FCFLAGS_f90 = @FCFLAGS_f90@ FFLAGS = @FFLAGS@ INSTALL = @INSTALL@ INSTALL_DATA = @INSTALL_DATA@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ INSTALL_SCRIPT = @INSTALL_SCRIPT@ INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ LDFLAGS = @LDFLAGS@ LIBOBJS = @LIBOBJS@ LIBS = @LIBS@ LTLIBOBJS = @LTLIBOBJS@ MAKEINFO = @MAKEINFO@ MKDIR_P = @MKDIR_P@ MODULE_EXT = @MODULE_EXT@ NETCDF_CFLAGS = @NETCDF_CFLAGS@ OBJEXT = @OBJEXT@ PACKAGE = @PACKAGE@ PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ PACKAGE_NAME = @PACKAGE_NAME@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_VERSION = @PACKAGE_VERSION@ PATH_SEPARATOR = @PATH_SEPARATOR@ RANLIB = @RANLIB@ SET_MAKE = @SET_MAKE@ SHELL = @SHELL@ STRIP = @STRIP@ VERSION = @VERSION@ abs_builddir = @abs_builddir@ abs_srcdir = @abs_srcdir@ abs_top_builddir = @abs_top_builddir@ abs_top_srcdir = @abs_top_srcdir@ ac_ct_FC = @ac_ct_FC@ am__leading_dot = @am__leading_dot@ am__tar = @am__tar@ am__untar = @am__untar@ bindir = @bindir@ build_alias = @build_alias@ builddir = @builddir@ datadir = @datadir@ datarootdir = @datarootdir@ docdir = @docdir@ dvidir = @dvidir@ exec_prefix = @exec_prefix@ fc_type = @fc_type@ fc_version = @fc_version@ fc_wrap = @fc_wrap@ groupleveldocdir = @groupleveldocdir@ host_alias = @host_alias@ htmldir = @htmldir@ includedir = @includedir@ infodir = @infodir@ install_sh = @install_sh@ libdir = @libdir@ libexecdir = @libexecdir@ localedir = @localedir@ localstatedir = @localstatedir@ lowleveldocdir = @lowleveldocdir@ mandir = @mandir@ mkdir_p = @mkdir_p@ moduledir = @moduledir@ oldincludedir = @oldincludedir@ pdfdir = @pdfdir@ prefix = @prefix@ program_transform_name = @program_transform_name@ psdir = @psdir@ sbindir = @sbindir@ sharedstatedir = @sharedstatedir@ srcdir = @srcdir@ sysconfdir = @sysconfdir@ target_alias = @target_alias@ top_builddir = @top_builddir@ top_srcdir = @top_srcdir@ tutorialsdocdir = @tutorialsdocdir@ utilsdocdir = @utilsdocdir@ groupleveldoc_DATA = \ etsf_io_dims_def_f90.html \ etsf_io_dims_get_f90.html \ etsf_io_dims_merge_f90.html \ etsf_io_dims_trace_f90.html \ etsf_io_geometry_def_f90.html \ etsf_io_electrons_def_f90.html \ etsf_io_kpoints_def_f90.html \ etsf_io_basisdata_def_f90.html \ etsf_io_gwdata_def_f90.html \ etsf_io_dielectric_def_f90.html \ etsf_io_main_def_f90.html \ etsf_io_geometry_get_f90.html \ etsf_io_electrons_get_f90.html \ etsf_io_kpoints_get_f90.html \ etsf_io_basisdata_get_f90.html \ etsf_io_gwdata_get_f90.html \ etsf_io_dielectric_get_f90.html \ etsf_io_main_get_f90.html \ etsf_io_geometry_put_f90.html \ etsf_io_electrons_put_f90.html \ etsf_io_kpoints_put_f90.html \ etsf_io_basisdata_put_f90.html \ etsf_io_gwdata_put_f90.html \ etsf_io_dielectric_put_f90.html \ etsf_io_main_put_f90.html \ etsf_io_geometry_copy_f90.html \ etsf_io_electrons_copy_f90.html \ etsf_io_kpoints_copy_f90.html \ etsf_io_basisdata_copy_f90.html \ etsf_io_gwdata_copy_f90.html \ etsf_io_dielectric_copy_f90.html \ etsf_io_main_copy_f90.html \ etsf_io_split_init_f90.html \ etsf_io_split_allocate_f90.html \ etsf_io_split_free_f90.html \ etsf_io_split_def_f90.html \ etsf_io_split_get_f90.html \ etsf_io_split_put_f90.html \ etsf_io_split_copy_f90.html \ etsf_io_split_merge_f90.html \ etsf_io_vars_free_f90.html \ etsf_io_data_init_f90.html \ etsf_io_data_read_f90.html \ etsf_io_data_write_f90.html \ etsf_io_data_contents_f90.html \ etsf_io_data_get_f90.html \ etsf_io_data_copy_f90.html \ etsf_io_f90.html EXTRA_DIST = $(groupleveldoc_DATA) all: all-am .SUFFIXES: $(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) @for dep in $?; do \ case '$(am__configure_deps)' in \ *$$dep*) \ cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh \ && exit 0; \ exit 1;; \ esac; \ done; \ echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu doc/www/group_level/Makefile'; \ cd $(top_srcdir) && \ $(AUTOMAKE) --gnu doc/www/group_level/Makefile .PRECIOUS: Makefile Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status @case '$?' in \ *config.status*) \ cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ *) \ echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ esac; $(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh $(top_srcdir)/configure: $(am__configure_deps) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh $(ACLOCAL_M4): $(am__aclocal_m4_deps) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh install-groupleveldocDATA: $(groupleveldoc_DATA) @$(NORMAL_INSTALL) test -z "$(groupleveldocdir)" || $(MKDIR_P) "$(DESTDIR)$(groupleveldocdir)" @list='$(groupleveldoc_DATA)'; for p in $$list; do \ if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ f=$(am__strip_dir) \ echo " $(groupleveldocDATA_INSTALL) '$$d$$p' '$(DESTDIR)$(groupleveldocdir)/$$f'"; \ $(groupleveldocDATA_INSTALL) "$$d$$p" "$(DESTDIR)$(groupleveldocdir)/$$f"; \ done uninstall-groupleveldocDATA: @$(NORMAL_UNINSTALL) @list='$(groupleveldoc_DATA)'; for p in $$list; do \ f=$(am__strip_dir) \ echo " rm -f '$(DESTDIR)$(groupleveldocdir)/$$f'"; \ rm -f "$(DESTDIR)$(groupleveldocdir)/$$f"; \ done tags: TAGS TAGS: ctags: CTAGS CTAGS: distdir: $(DISTFILES) @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ list='$(DISTFILES)'; \ dist_files=`for file in $$list; do echo $$file; done | \ sed -e "s|^$$srcdirstrip/||;t" \ -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ case $$dist_files in \ */*) $(MKDIR_P) `echo "$$dist_files" | \ sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ sort -u` ;; \ esac; \ for file in $$dist_files; do \ if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ if test -d $$d/$$file; then \ dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ cp -pR $(srcdir)/$$file $(distdir)$$dir || exit 1; \ fi; \ cp -pR $$d/$$file $(distdir)$$dir || exit 1; \ else \ test -f $(distdir)/$$file \ || cp -p $$d/$$file $(distdir)/$$file \ || exit 1; \ fi; \ done check-am: all-am check: check-am all-am: Makefile $(DATA) installdirs: for dir in "$(DESTDIR)$(groupleveldocdir)"; do \ test -z "$$dir" || $(MKDIR_P) "$$dir"; \ done install: install-am install-exec: install-exec-am install-data: install-data-am uninstall: uninstall-am install-am: all-am @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am installcheck: installcheck-am install-strip: $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ `test -z '$(STRIP)' || \ echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install mostlyclean-generic: clean-generic: distclean-generic: -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) maintainer-clean-generic: @echo "This command is intended for maintainers to use" @echo "it deletes files that may require special tools to rebuild." clean: clean-am clean-am: clean-generic mostlyclean-am distclean: distclean-am -rm -f Makefile distclean-am: clean-am distclean-generic dvi: dvi-am dvi-am: html: html-am info: info-am info-am: install-data-am: install-groupleveldocDATA install-dvi: install-dvi-am install-exec-am: install-html: install-html-am install-info: install-info-am install-man: install-pdf: install-pdf-am install-ps: install-ps-am installcheck-am: maintainer-clean: maintainer-clean-am -rm -f Makefile maintainer-clean-am: distclean-am maintainer-clean-generic mostlyclean: mostlyclean-am mostlyclean-am: mostlyclean-generic pdf: pdf-am pdf-am: ps: ps-am ps-am: uninstall-am: uninstall-groupleveldocDATA .MAKE: install-am install-strip .PHONY: all all-am check check-am clean clean-generic distclean \ distclean-generic distdir dvi dvi-am html html-am info info-am \ install install-am install-data install-data-am install-dvi \ install-dvi-am install-exec install-exec-am \ install-groupleveldocDATA install-html install-html-am \ install-info install-info-am install-man install-pdf \ install-pdf-am install-ps install-ps-am install-strip \ installcheck installcheck-am installdirs maintainer-clean \ maintainer-clean-generic mostlyclean mostlyclean-generic pdf \ pdf-am ps ps-am uninstall uninstall-am \ uninstall-groupleveldocDATA # Tell versions [3.59,3.63) of GNU make to not export all variables. # Otherwise a system limit (for SysV at least) may be exceeded. .NOEXPORT: etsf_io-1.0.3/doc/www/group_level/etsf_io_dims_def_f90.html0000644000353400050620000020314711354150415020636 00000000000000 ./src/group_level/etsf_io_dims_def.f90

TABLE OF CONTENTS

etsf_io_dims_def

[ Top ] [ etsf_dims ] [ Methods ]

NAME

etsf_io_dims_def

FUNCTION

Create dimensions and set their values. For normal dimensions, their are defined if their values are different from etsf_no_dimension (see ETSF_IO_CONSTANTS). For split dimensions (my_<something>), they are defined only if they are different from etsf_no_dimension or from the value of dimension <something>.

INPUTS

  • ncid = integer returned by an 'open' NetCDF call. The file can be either in define or write mode. This status can be changed by the call.
  • dims <type(etsf_dims)> = contains all the dimensions required by the ETSF file. These values will be used later to allocate the disk space for variables, see etsf_io_electrons_def() or routines of the same kind.

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_dims_def(ncid, dims, lstat, error_data)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid
  type(etsf_dims), intent(intent) :: dims
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_dims_def'


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_dims_def : enter'
!ENDDEBUG

  if (dims%character_string_length /= etsf_no_dimension) then
    call etsf_io_low_write_dim(ncid, "character_string_length", &
                             & dims%character_string_length, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%complex /= etsf_no_dimension) then
    call etsf_io_low_write_dim(ncid, "complex", &
                             & dims%complex, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%max_number_of_angular_momenta /= etsf_no_dimension) then
    call etsf_io_low_write_dim(ncid, "max_number_of_angular_momenta", &
                             & dims%max_number_of_angular_momenta, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%max_number_of_basis_grid_points /= etsf_no_dimension) then
    call etsf_io_low_write_dim(ncid, "max_number_of_basis_grid_points", &
                             & dims%max_number_of_basis_grid_points, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%max_number_of_coefficients /= etsf_no_dimension) then
    call etsf_io_low_write_dim(ncid, "max_number_of_coefficients", &
                             & dims%max_number_of_coefficients, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%max_number_of_projectors /= etsf_no_dimension) then
    call etsf_io_low_write_dim(ncid, "max_number_of_projectors", &
                             & dims%max_number_of_projectors, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%max_number_of_states /= etsf_no_dimension) then
    call etsf_io_low_write_dim(ncid, "max_number_of_states", &
                             & dims%max_number_of_states, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%number_of_atoms /= etsf_no_dimension) then
    call etsf_io_low_write_dim(ncid, "number_of_atoms", &
                             & dims%number_of_atoms, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%number_of_atom_species /= etsf_no_dimension) then
    call etsf_io_low_write_dim(ncid, "number_of_atom_species", &
                             & dims%number_of_atom_species, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%number_of_cartesian_directions /= etsf_no_dimension) then
    call etsf_io_low_write_dim(ncid, "number_of_cartesian_directions", &
                             & dims%number_of_cartesian_directions, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%number_of_coefficients_dielectric_function /= etsf_no_dimension) then
    call etsf_io_low_write_dim(ncid, "number_of_coefficients_dielectric_function", &
                             & dims%number_of_coefficients_dielectric_function, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%number_of_components /= etsf_no_dimension) then
    call etsf_io_low_write_dim(ncid, "number_of_components", &
                             & dims%number_of_components, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%number_of_frequencies_dielectric_function /= etsf_no_dimension) then
    call etsf_io_low_write_dim(ncid, "number_of_frequencies_dielectric_function", &
                             & dims%number_of_frequencies_dielectric_function, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%number_of_grid_points_vector1 /= etsf_no_dimension) then
    call etsf_io_low_write_dim(ncid, "number_of_grid_points_vector1", &
                             & dims%number_of_grid_points_vector1, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%number_of_grid_points_vector2 /= etsf_no_dimension) then
    call etsf_io_low_write_dim(ncid, "number_of_grid_points_vector2", &
                             & dims%number_of_grid_points_vector2, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%number_of_grid_points_vector3 /= etsf_no_dimension) then
    call etsf_io_low_write_dim(ncid, "number_of_grid_points_vector3", &
                             & dims%number_of_grid_points_vector3, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%number_of_kpoints /= etsf_no_dimension) then
    call etsf_io_low_write_dim(ncid, "number_of_kpoints", &
                             & dims%number_of_kpoints, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%number_of_localization_regions /= etsf_no_dimension) then
    call etsf_io_low_write_dim(ncid, "number_of_localization_regions", &
                             & dims%number_of_localization_regions, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%number_of_qpoints_dielectric_function /= etsf_no_dimension) then
    call etsf_io_low_write_dim(ncid, "number_of_qpoints_dielectric_function", &
                             & dims%number_of_qpoints_dielectric_function, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%number_of_qpoints_gamma_limit /= etsf_no_dimension) then
    call etsf_io_low_write_dim(ncid, "number_of_qpoints_gamma_limit", &
                             & dims%number_of_qpoints_gamma_limit, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%number_of_reduced_dimensions /= etsf_no_dimension) then
    call etsf_io_low_write_dim(ncid, "number_of_reduced_dimensions", &
                             & dims%number_of_reduced_dimensions, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%number_of_spinor_components /= etsf_no_dimension) then
    call etsf_io_low_write_dim(ncid, "number_of_spinor_components", &
                             & dims%number_of_spinor_components, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%number_of_spins /= etsf_no_dimension) then
    call etsf_io_low_write_dim(ncid, "number_of_spins", &
                             & dims%number_of_spins, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%number_of_symmetry_operations /= etsf_no_dimension) then
    call etsf_io_low_write_dim(ncid, "number_of_symmetry_operations", &
                             & dims%number_of_symmetry_operations, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%number_of_vectors /= etsf_no_dimension) then
    call etsf_io_low_write_dim(ncid, "number_of_vectors", &
                             & dims%number_of_vectors, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%real_or_complex_coefficients /= etsf_no_dimension) then
    call etsf_io_low_write_dim(ncid, "real_or_complex_coefficients", &
                             & dims%real_or_complex_coefficients, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%real_or_complex_density /= etsf_no_dimension) then
    call etsf_io_low_write_dim(ncid, "real_or_complex_density", &
                             & dims%real_or_complex_density, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%real_or_complex_gw_corrections /= etsf_no_dimension) then
    call etsf_io_low_write_dim(ncid, "real_or_complex_gw_corrections", &
                             & dims%real_or_complex_gw_corrections, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%real_or_complex_potential /= etsf_no_dimension) then
    call etsf_io_low_write_dim(ncid, "real_or_complex_potential", &
                             & dims%real_or_complex_potential, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%real_or_complex_wavefunctions /= etsf_no_dimension) then
    call etsf_io_low_write_dim(ncid, "real_or_complex_wavefunctions", &
                             & dims%real_or_complex_wavefunctions, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%symbol_length /= etsf_no_dimension) then
    call etsf_io_low_write_dim(ncid, "symbol_length", &
                             & dims%symbol_length, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%my_max_number_of_coefficients /= etsf_no_dimension .and. &
      dims%my_max_number_of_coefficients /= dims%max_number_of_coefficients) then
    call etsf_io_low_write_dim(ncid, "my_max_number_of_coefficients", &
                             & dims%my_max_number_of_coefficients, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%my_max_number_of_states /= etsf_no_dimension .and. &
      dims%my_max_number_of_states /= dims%max_number_of_states) then
    call etsf_io_low_write_dim(ncid, "my_max_number_of_states", &
                             & dims%my_max_number_of_states, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%my_number_of_components /= etsf_no_dimension .and. &
      dims%my_number_of_components /= dims%number_of_components) then
    call etsf_io_low_write_dim(ncid, "my_number_of_components", &
                             & dims%my_number_of_components, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%my_number_of_grid_points_vect1 /= etsf_no_dimension .and. &
      dims%my_number_of_grid_points_vect1 /= dims%number_of_grid_points_vector1) then
    call etsf_io_low_write_dim(ncid, "my_number_of_grid_points_vector1", &
                             & dims%my_number_of_grid_points_vect1, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%my_number_of_grid_points_vect2 /= etsf_no_dimension .and. &
      dims%my_number_of_grid_points_vect2 /= dims%number_of_grid_points_vector2) then
    call etsf_io_low_write_dim(ncid, "my_number_of_grid_points_vector2", &
                             & dims%my_number_of_grid_points_vect2, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%my_number_of_grid_points_vect3 /= etsf_no_dimension .and. &
      dims%my_number_of_grid_points_vect3 /= dims%number_of_grid_points_vector3) then
    call etsf_io_low_write_dim(ncid, "my_number_of_grid_points_vector3", &
                             & dims%my_number_of_grid_points_vect3, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%my_number_of_kpoints /= etsf_no_dimension .and. &
      dims%my_number_of_kpoints /= dims%number_of_kpoints) then
    call etsf_io_low_write_dim(ncid, "my_number_of_kpoints", &
                             & dims%my_number_of_kpoints, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (dims%my_number_of_spins /= etsf_no_dimension .and. &
      dims%my_number_of_spins /= dims%number_of_spins) then
    call etsf_io_low_write_dim(ncid, "my_number_of_spins", &
                             & dims%my_number_of_spins, &
                             & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  lstat = .true.


!DEBUG
!write (*,*) 'etsf_io_dims_def : exit'
!ENDDEBUG

end subroutine etsf_io_dims_def
etsf_io-1.0.3/doc/www/group_level/etsf_io_dims_get_f90.html0000644000353400050620000021034111354150415020651 00000000000000 ./src/group_level/etsf_io_dims_get.f90

TABLE OF CONTENTS

etsf_io_dims_get

[ Top ] [ etsf_dims ] [ Methods ]

NAME

etsf_io_dims_get

FUNCTION

Read the dimensions from an ETSF file. If one dimension is not found, its value is put to etsf_no_dimension (see ETSF_IO_CONSTANTS).

INPUTS

  • ncid = integer returned by an 'open' NetCDF call. The file can be either in define or write mode. This status can be changed by the call.

OUTPUT

  • dims <type(etsf_dims)> = an allocated structure to put the read values for all dimensions of the ETSF file pointed by @ncid.
  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_dims_get(ncid, dims, lstat, error_data)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid
  type(etsf_dims), intent(out) :: dims
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_dims_get'


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_dims_get : enter'
!ENDDEBUG

  call etsf_io_low_read_dim(ncid, "character_string_length", &
                          & dims%character_string_length, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%character_string_length = etsf_no_dimension
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "complex", &
                          & dims%complex, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%complex = etsf_no_dimension
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "max_number_of_angular_momenta", &
                          & dims%max_number_of_angular_momenta, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%max_number_of_angular_momenta = etsf_no_dimension
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "max_number_of_basis_grid_points", &
                          & dims%max_number_of_basis_grid_points, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%max_number_of_basis_grid_points = etsf_no_dimension
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "max_number_of_coefficients", &
                          & dims%max_number_of_coefficients, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%max_number_of_coefficients = etsf_no_dimension
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "max_number_of_projectors", &
                          & dims%max_number_of_projectors, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%max_number_of_projectors = etsf_no_dimension
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "max_number_of_states", &
                          & dims%max_number_of_states, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%max_number_of_states = etsf_no_dimension
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "number_of_atoms", &
                          & dims%number_of_atoms, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%number_of_atoms = etsf_no_dimension
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "number_of_atom_species", &
                          & dims%number_of_atom_species, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%number_of_atom_species = etsf_no_dimension
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "number_of_cartesian_directions", &
                          & dims%number_of_cartesian_directions, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%number_of_cartesian_directions = etsf_no_dimension
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "number_of_coefficients_dielectric_function", &
                          & dims%number_of_coefficients_dielectric_function, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%number_of_coefficients_dielectric_function = etsf_no_dimension
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "number_of_components", &
                          & dims%number_of_components, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%number_of_components = etsf_no_dimension
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "number_of_frequencies_dielectric_function", &
                          & dims%number_of_frequencies_dielectric_function, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%number_of_frequencies_dielectric_function = etsf_no_dimension
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "number_of_grid_points_vector1", &
                          & dims%number_of_grid_points_vector1, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%number_of_grid_points_vector1 = etsf_no_dimension
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "number_of_grid_points_vector2", &
                          & dims%number_of_grid_points_vector2, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%number_of_grid_points_vector2 = etsf_no_dimension
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "number_of_grid_points_vector3", &
                          & dims%number_of_grid_points_vector3, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%number_of_grid_points_vector3 = etsf_no_dimension
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "number_of_kpoints", &
                          & dims%number_of_kpoints, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%number_of_kpoints = etsf_no_dimension
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "number_of_localization_regions", &
                          & dims%number_of_localization_regions, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%number_of_localization_regions = etsf_no_dimension
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "number_of_qpoints_dielectric_function", &
                          & dims%number_of_qpoints_dielectric_function, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%number_of_qpoints_dielectric_function = etsf_no_dimension
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "number_of_qpoints_gamma_limit", &
                          & dims%number_of_qpoints_gamma_limit, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%number_of_qpoints_gamma_limit = etsf_no_dimension
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "number_of_reduced_dimensions", &
                          & dims%number_of_reduced_dimensions, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%number_of_reduced_dimensions = etsf_no_dimension
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "number_of_spinor_components", &
                          & dims%number_of_spinor_components, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%number_of_spinor_components = etsf_no_dimension
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "number_of_spins", &
                          & dims%number_of_spins, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%number_of_spins = etsf_no_dimension
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "number_of_symmetry_operations", &
                          & dims%number_of_symmetry_operations, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%number_of_symmetry_operations = etsf_no_dimension
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "number_of_vectors", &
                          & dims%number_of_vectors, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%number_of_vectors = etsf_no_dimension
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "real_or_complex_coefficients", &
                          & dims%real_or_complex_coefficients, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%real_or_complex_coefficients = etsf_no_dimension
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "real_or_complex_density", &
                          & dims%real_or_complex_density, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%real_or_complex_density = etsf_no_dimension
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "real_or_complex_gw_corrections", &
                          & dims%real_or_complex_gw_corrections, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%real_or_complex_gw_corrections = etsf_no_dimension
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "real_or_complex_potential", &
                          & dims%real_or_complex_potential, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%real_or_complex_potential = etsf_no_dimension
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "real_or_complex_wavefunctions", &
                          & dims%real_or_complex_wavefunctions, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%real_or_complex_wavefunctions = etsf_no_dimension
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "symbol_length", &
                          & dims%symbol_length, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%symbol_length = etsf_no_dimension
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "my_max_number_of_coefficients", &
                          & dims%my_max_number_of_coefficients, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%my_max_number_of_coefficients = dims%max_number_of_coefficients
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "my_max_number_of_states", &
                          & dims%my_max_number_of_states, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%my_max_number_of_states = dims%max_number_of_states
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "my_number_of_components", &
                          & dims%my_number_of_components, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%my_number_of_components = dims%number_of_components
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "my_number_of_grid_points_vector1", &
                          & dims%my_number_of_grid_points_vect1, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%my_number_of_grid_points_vect1 = dims%number_of_grid_points_vector1
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "my_number_of_grid_points_vector2", &
                          & dims%my_number_of_grid_points_vect2, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%my_number_of_grid_points_vect2 = dims%number_of_grid_points_vector2
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "my_number_of_grid_points_vector3", &
                          & dims%my_number_of_grid_points_vect3, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%my_number_of_grid_points_vect3 = dims%number_of_grid_points_vector3
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "my_number_of_kpoints", &
                          & dims%my_number_of_kpoints, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%my_number_of_kpoints = dims%number_of_kpoints
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  call etsf_io_low_read_dim(ncid, "my_number_of_spins", &
                          & dims%my_number_of_spins, &
                          & lstat, error_data = error_data)
  if (.not. lstat) then 
    if (error_data%access_mode_id == ERROR_MODE_INQ) then
      dims%my_number_of_spins = dims%number_of_spins
    else
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  lstat = .true.


!DEBUG
!write (*,*) 'etsf_io_dims_get : exit'
!ENDDEBUG

end subroutine etsf_io_dims_get
etsf_io-1.0.3/doc/www/group_level/etsf_io_dims_merge_f90.html0000644000353400050620000012253711354150415021202 00000000000000 ./src/group_level/etsf_io_dims_merge.f90

TABLE OF CONTENTS

etsf_io_dims_merge

[ Top ] [ etsf_dims ] [ Methods ]

NAME

etsf_io_dims_merge

FUNCTION

It is a checking routine. For all variable, it checks that values are the same in source and destination. For my_<something> variables, if values are different then output value is the sum of previous value and input value. This is useful when the dimensions have split definition. In that case, merging all input file dimensions will check classical dimensions and sum all split dimensions. At the end, if my_<something> is equal to <something> then the merging of the files will end up in suppressing the split for the <something> variable. In the other case (my_<something> < <something>), the resulting merge file will still have a split dimension <something> but with more values.

INPUTS

  • dims <type(etsf_dims)> = the dimensions to be merge into argument @output_dims. If the dimension begin with my_something, if the value is different from the something dimension, it is added into @output_dims. If the dimension is a regular one, the equity is only checked between dims and output_dims.

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

SIDE EFFECTS

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_dims_merge(output_dims, dims, lstat, error_data)

  !Arguments ------------------------------------
  type(etsf_dims), intent(inout) :: output_dims
  type(etsf_dims), intent(intent) :: dims
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_dims_merge'


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_dims_merge : enter'
!ENDDEBUG

  lstat = .false.
  
  if (output_dims%character_string_length /= dims%character_string_length) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
      & ERROR_TYPE_DIM, my_name, &
      & errmess = "incompatible dimension for merge.")
    return
  end if
  
  if (output_dims%complex /= dims%complex) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
      & ERROR_TYPE_DIM, my_name, &
      & errmess = "incompatible dimension for merge.")
    return
  end if
  
  if (output_dims%max_number_of_angular_momenta /= dims%max_number_of_angular_momenta) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
      & ERROR_TYPE_DIM, my_name, &
      & errmess = "incompatible dimension for merge.")
    return
  end if
  
  if (output_dims%max_number_of_basis_grid_points /= dims%max_number_of_basis_grid_points) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
      & ERROR_TYPE_DIM, my_name, &
      & errmess = "incompatible dimension for merge.")
    return
  end if
  
  if (output_dims%max_number_of_coefficients /= dims%max_number_of_coefficients) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
      & ERROR_TYPE_DIM, my_name, &
      & errmess = "incompatible dimension for merge.")
    return
  end if
  
  if (output_dims%max_number_of_projectors /= dims%max_number_of_projectors) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
      & ERROR_TYPE_DIM, my_name, &
      & errmess = "incompatible dimension for merge.")
    return
  end if
  
  if (output_dims%max_number_of_states /= dims%max_number_of_states) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
      & ERROR_TYPE_DIM, my_name, &
      & errmess = "incompatible dimension for merge.")
    return
  end if
  
  if (output_dims%number_of_atoms /= dims%number_of_atoms) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
      & ERROR_TYPE_DIM, my_name, &
      & errmess = "incompatible dimension for merge.")
    return
  end if
  
  if (output_dims%number_of_atom_species /= dims%number_of_atom_species) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
      & ERROR_TYPE_DIM, my_name, &
      & errmess = "incompatible dimension for merge.")
    return
  end if
  
  if (output_dims%number_of_cartesian_directions /= dims%number_of_cartesian_directions) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
      & ERROR_TYPE_DIM, my_name, &
      & errmess = "incompatible dimension for merge.")
    return
  end if
  
  if (output_dims%number_of_coefficients_dielectric_function /= dims%number_of_coefficients_dielectric_function) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
      & ERROR_TYPE_DIM, my_name, &
      & errmess = "incompatible dimension for merge.")
    return
  end if
  
  if (output_dims%number_of_components /= dims%number_of_components) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
      & ERROR_TYPE_DIM, my_name, &
      & errmess = "incompatible dimension for merge.")
    return
  end if
  
  if (output_dims%number_of_frequencies_dielectric_function /= dims%number_of_frequencies_dielectric_function) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
      & ERROR_TYPE_DIM, my_name, &
      & errmess = "incompatible dimension for merge.")
    return
  end if
  
  if (output_dims%number_of_grid_points_vector1 /= dims%number_of_grid_points_vector1) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
      & ERROR_TYPE_DIM, my_name, &
      & errmess = "incompatible dimension for merge.")
    return
  end if
  
  if (output_dims%number_of_grid_points_vector2 /= dims%number_of_grid_points_vector2) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
      & ERROR_TYPE_DIM, my_name, &
      & errmess = "incompatible dimension for merge.")
    return
  end if
  
  if (output_dims%number_of_grid_points_vector3 /= dims%number_of_grid_points_vector3) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
      & ERROR_TYPE_DIM, my_name, &
      & errmess = "incompatible dimension for merge.")
    return
  end if
  
  if (output_dims%number_of_kpoints /= dims%number_of_kpoints) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
      & ERROR_TYPE_DIM, my_name, &
      & errmess = "incompatible dimension for merge.")
    return
  end if
  
  if (output_dims%number_of_localization_regions /= dims%number_of_localization_regions) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
      & ERROR_TYPE_DIM, my_name, &
      & errmess = "incompatible dimension for merge.")
    return
  end if
  
  if (output_dims%number_of_qpoints_dielectric_function /= dims%number_of_qpoints_dielectric_function) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
      & ERROR_TYPE_DIM, my_name, &
      & errmess = "incompatible dimension for merge.")
    return
  end if
  
  if (output_dims%number_of_qpoints_gamma_limit /= dims%number_of_qpoints_gamma_limit) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
      & ERROR_TYPE_DIM, my_name, &
      & errmess = "incompatible dimension for merge.")
    return
  end if
  
  if (output_dims%number_of_reduced_dimensions /= dims%number_of_reduced_dimensions) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
      & ERROR_TYPE_DIM, my_name, &
      & errmess = "incompatible dimension for merge.")
    return
  end if
  
  if (output_dims%number_of_spinor_components /= dims%number_of_spinor_components) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
      & ERROR_TYPE_DIM, my_name, &
      & errmess = "incompatible dimension for merge.")
    return
  end if
  
  if (output_dims%number_of_spins /= dims%number_of_spins) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
      & ERROR_TYPE_DIM, my_name, &
      & errmess = "incompatible dimension for merge.")
    return
  end if
  
  if (output_dims%number_of_symmetry_operations /= dims%number_of_symmetry_operations) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
      & ERROR_TYPE_DIM, my_name, &
      & errmess = "incompatible dimension for merge.")
    return
  end if
  
  if (output_dims%number_of_vectors /= dims%number_of_vectors) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
      & ERROR_TYPE_DIM, my_name, &
      & errmess = "incompatible dimension for merge.")
    return
  end if
  
  if (output_dims%real_or_complex_coefficients /= dims%real_or_complex_coefficients) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
      & ERROR_TYPE_DIM, my_name, &
      & errmess = "incompatible dimension for merge.")
    return
  end if
  
  if (output_dims%real_or_complex_density /= dims%real_or_complex_density) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
      & ERROR_TYPE_DIM, my_name, &
      & errmess = "incompatible dimension for merge.")
    return
  end if
  
  if (output_dims%real_or_complex_gw_corrections /= dims%real_or_complex_gw_corrections) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
      & ERROR_TYPE_DIM, my_name, &
      & errmess = "incompatible dimension for merge.")
    return
  end if
  
  if (output_dims%real_or_complex_potential /= dims%real_or_complex_potential) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
      & ERROR_TYPE_DIM, my_name, &
      & errmess = "incompatible dimension for merge.")
    return
  end if
  
  if (output_dims%real_or_complex_wavefunctions /= dims%real_or_complex_wavefunctions) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
      & ERROR_TYPE_DIM, my_name, &
      & errmess = "incompatible dimension for merge.")
    return
  end if
  
  if (output_dims%symbol_length /= dims%symbol_length) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
      & ERROR_TYPE_DIM, my_name, &
      & errmess = "incompatible dimension for merge.")
    return
  end if
  
  if (output_dims%my_max_number_of_coefficients /= output_dims%max_number_of_coefficients) then
    output_dims%my_max_number_of_coefficients = output_dims%my_max_number_of_coefficients + &
      & dims%my_max_number_of_coefficients
  end if
  
  if (output_dims%my_max_number_of_states /= output_dims%max_number_of_states) then
    output_dims%my_max_number_of_states = output_dims%my_max_number_of_states + &
      & dims%my_max_number_of_states
  end if
  
  if (output_dims%my_number_of_components /= output_dims%number_of_components) then
    output_dims%my_number_of_components = output_dims%my_number_of_components + &
      & dims%my_number_of_components
  end if
  
  if (output_dims%my_number_of_grid_points_vect1 /= output_dims%number_of_grid_points_vector1) then
    output_dims%my_number_of_grid_points_vect1 = output_dims%my_number_of_grid_points_vect1 + &
      & dims%my_number_of_grid_points_vect1
  end if
  
  if (output_dims%my_number_of_grid_points_vect2 /= output_dims%number_of_grid_points_vector2) then
    output_dims%my_number_of_grid_points_vect2 = output_dims%my_number_of_grid_points_vect2 + &
      & dims%my_number_of_grid_points_vect2
  end if
  
  if (output_dims%my_number_of_grid_points_vect3 /= output_dims%number_of_grid_points_vector3) then
    output_dims%my_number_of_grid_points_vect3 = output_dims%my_number_of_grid_points_vect3 + &
      & dims%my_number_of_grid_points_vect3
  end if
  
  if (output_dims%my_number_of_kpoints /= output_dims%number_of_kpoints) then
    output_dims%my_number_of_kpoints = output_dims%my_number_of_kpoints + &
      & dims%my_number_of_kpoints
  end if
  
  if (output_dims%my_number_of_spins /= output_dims%number_of_spins) then
    output_dims%my_number_of_spins = output_dims%my_number_of_spins + &
      & dims%my_number_of_spins
  end if
  lstat = .true.


!DEBUG
!write (*,*) 'etsf_io_dims_merge : exit'
!ENDDEBUG

end subroutine etsf_io_dims_merge
etsf_io-1.0.3/doc/www/group_level/etsf_io_dims_trace_f90.html0000644000353400050620000001733511354150415021200 00000000000000 ./src/group_level/etsf_io_dims_trace.f90

TABLE OF CONTENTS

etsf_io_dims_trace

[ Top ] [ etsf_dims ] [ Methods ]

NAME

etsf_io_dims_trace

FUNCTION

Output for each variable its value. Essentially used for debugging.

INPUTS

  • dims <type(etsf_dims)> = the structure that should be output on screen.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_dims_trace(dims)

  !Arguments ------------------------------------
  type(etsf_dims), intent(intent) :: dims

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_dims_trace'


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_dims_trace : enter'
!ENDDEBUG

  write(*, "(A42,A,I6)") "character_string_length", &
    & ": ", dims%character_string_length
  write(*, "(A42,A,I6)") "complex", &
    & ": ", dims%complex
  write(*, "(A42,A,I6)") "max_number_of_angular_momenta", &
    & ": ", dims%max_number_of_angular_momenta
  write(*, "(A42,A,I6)") "max_number_of_basis_grid_points", &
    & ": ", dims%max_number_of_basis_grid_points
  write(*, "(A42,A,I6)") "max_number_of_coefficients", &
    & ": ", dims%max_number_of_coefficients
  write(*, "(A42,A,I6)") "max_number_of_projectors", &
    & ": ", dims%max_number_of_projectors
  write(*, "(A42,A,I6)") "max_number_of_states", &
    & ": ", dims%max_number_of_states
  write(*, "(A42,A,I6)") "number_of_atoms", &
    & ": ", dims%number_of_atoms
  write(*, "(A42,A,I6)") "number_of_atom_species", &
    & ": ", dims%number_of_atom_species
  write(*, "(A42,A,I6)") "number_of_cartesian_directions", &
    & ": ", dims%number_of_cartesian_directions
  write(*, "(A42,A,I6)") "number_of_coefficients_dielectric_function", &
    & ": ", dims%number_of_coefficients_dielectric_function
  write(*, "(A42,A,I6)") "number_of_components", &
    & ": ", dims%number_of_components
  write(*, "(A42,A,I6)") "number_of_frequencies_dielectric_function", &
    & ": ", dims%number_of_frequencies_dielectric_function
  write(*, "(A42,A,I6)") "number_of_grid_points_vector1", &
    & ": ", dims%number_of_grid_points_vector1
  write(*, "(A42,A,I6)") "number_of_grid_points_vector2", &
    & ": ", dims%number_of_grid_points_vector2
  write(*, "(A42,A,I6)") "number_of_grid_points_vector3", &
    & ": ", dims%number_of_grid_points_vector3
  write(*, "(A42,A,I6)") "number_of_kpoints", &
    & ": ", dims%number_of_kpoints
  write(*, "(A42,A,I6)") "number_of_localization_regions", &
    & ": ", dims%number_of_localization_regions
  write(*, "(A42,A,I6)") "number_of_qpoints_dielectric_function", &
    & ": ", dims%number_of_qpoints_dielectric_function
  write(*, "(A42,A,I6)") "number_of_qpoints_gamma_limit", &
    & ": ", dims%number_of_qpoints_gamma_limit
  write(*, "(A42,A,I6)") "number_of_reduced_dimensions", &
    & ": ", dims%number_of_reduced_dimensions
  write(*, "(A42,A,I6)") "number_of_spinor_components", &
    & ": ", dims%number_of_spinor_components
  write(*, "(A42,A,I6)") "number_of_spins", &
    & ": ", dims%number_of_spins
  write(*, "(A42,A,I6)") "number_of_symmetry_operations", &
    & ": ", dims%number_of_symmetry_operations
  write(*, "(A42,A,I6)") "number_of_vectors", &
    & ": ", dims%number_of_vectors
  write(*, "(A42,A,I6)") "real_or_complex_coefficients", &
    & ": ", dims%real_or_complex_coefficients
  write(*, "(A42,A,I6)") "real_or_complex_density", &
    & ": ", dims%real_or_complex_density
  write(*, "(A42,A,I6)") "real_or_complex_gw_corrections", &
    & ": ", dims%real_or_complex_gw_corrections
  write(*, "(A42,A,I6)") "real_or_complex_potential", &
    & ": ", dims%real_or_complex_potential
  write(*, "(A42,A,I6)") "real_or_complex_wavefunctions", &
    & ": ", dims%real_or_complex_wavefunctions
  write(*, "(A42,A,I6)") "symbol_length", &
    & ": ", dims%symbol_length
  write(*, "(A42,A,I6)") "my_max_number_of_coefficients", &
    & ": ", dims%my_max_number_of_coefficients
  write(*, "(A42,A,I6)") "my_max_number_of_states", &
    & ": ", dims%my_max_number_of_states
  write(*, "(A42,A,I6)") "my_number_of_components", &
    & ": ", dims%my_number_of_components
  write(*, "(A42,A,I6)") "my_number_of_grid_points_vect1", &
    & ": ", dims%my_number_of_grid_points_vect1
  write(*, "(A42,A,I6)") "my_number_of_grid_points_vect2", &
    & ": ", dims%my_number_of_grid_points_vect2
  write(*, "(A42,A,I6)") "my_number_of_grid_points_vect3", &
    & ": ", dims%my_number_of_grid_points_vect3
  write(*, "(A42,A,I6)") "my_number_of_kpoints", &
    & ": ", dims%my_number_of_kpoints
  write(*, "(A42,A,I6)") "my_number_of_spins", &
    & ": ", dims%my_number_of_spins

!DEBUG
!write (*,*) 'etsf_io_dims_trace : exit'
!ENDDEBUG

end subroutine etsf_io_dims_trace
etsf_io-1.0.3/doc/www/group_level/etsf_io_geometry_def_f90.html0000644000353400050620000012243011354150415021530 00000000000000 ./src/group_level/etsf_io_geometry_def.f90

TABLE OF CONTENTS

etsf_io_geometry_def

[ Top ] [ etsf_geometry ] [ Methods ]

NAME

etsf_io_geometry_def

FUNCTION

The given ETSF file must be opened and in define state (see etsf_io_low_set_define_mode() to change it). Then, all variable of the group are defined. All required dimensions must have already defined (see etsf_io_dims_def(). If some dimensions are missing, then the variable is not defined and no error are generated.

One can specify which variable may be splitted using the optional argument @split. For each associated array in this structure, variable with appropriated dimensions will use my_<something> instead of <something>.

INPUTS

  • ncid = integer returned by an 'open' NetCDF call. The file can be either in define or write mode. This status can be changed by the call.
  • k_dependent = (optional) use this argument to set the attribute flag 'k_dependent' to 'yes' or 'no' on variables that have it. If no variable in the group has the attribute 'k_dependent', this argument has no effect. The default value is .true. (which puts 'yes' in the file).
  • flags = (optional) One can choose the variables of the group that will be defined (and disk allocated) using this flag. This is a sum of values taken from #FLAGS_VARIABLES.
  • split <type(etsf_split)> = (optional) for each array associated in the type, the dimension used to declared the variables sizes will be 'my_/something/'.

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_geometry_def(ncid, lstat, error_data, k_dependent, flags, &
  & split)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data
  logical, optional, intent(intent) :: k_dependent
  integer, optional, intent(intent) :: flags
  type(etsf_split), optional, intent(intent) :: split

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_geometry_def'
  logical :: my_k_dependent
  integer :: my_flags
  type(etsf_split) :: my_split
  integer :: ivar
  type(split_dim_names) :: split_dims


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_geometry_def : enter'
!ENDDEBUG

  ! Get values for optional arguments, set default.
  if (present(k_dependent)) then
    my_k_dependent = k_dependent
  else
    my_k_dependent = .true.
  end if
  if (present(flags)) then
    my_flags = flags
  else
    my_flags = etsf_geometry_all
  end if
  ! Consistency checks.
  if (my_flags < etsf_geometry_none .or. my_flags > etsf_geometry_all) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_DEF, ERROR_TYPE_ARG, my_name, &
                             & tgtname = "flags", errmess = "value out of bounds")
    lstat = .false.
    return
  end if
  
  
  if (iand(my_flags, etsf_geometry_space_group) /= 0) then
    call etsf_io_low_def_var(ncid, "space_group", &
      & etsf_io_low_integer, &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_geometry_primitive_vectors) /= 0) then
    call etsf_io_low_def_var(ncid, "primitive_vectors", &
      & etsf_io_low_double, &
      & (/ pad("number_of_cartesian_directions"), &
      &    pad("number_of_vectors") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_geometry_red_sym_matrices) /= 0) then
    call etsf_io_low_def_var(ncid, "reduced_symmetry_matrices", &
      & etsf_io_low_integer, &
      & (/ pad("number_of_reduced_dimensions"), &
      &    pad("number_of_reduced_dimensions"), &
      &    pad("number_of_symmetry_operations") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    if (ivar >= 0) then
      ! Handle the symmorphic attribute.
      call etsf_io_low_write_att(ncid, ivar, &
                              & "symmorphic", &
                              & "yes", &
                              & lstat, error_data = error_data)
      if (.not. lstat) then
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
  end if
  
  if (iand(my_flags, etsf_geometry_red_sym_trans) /= 0) then
    call etsf_io_low_def_var(ncid, "reduced_symmetry_translations", &
      & etsf_io_low_double, &
      & (/ pad("number_of_reduced_dimensions"), &
      &    pad("number_of_symmetry_operations") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_geometry_atom_species) /= 0) then
    call etsf_io_low_def_var(ncid, "atom_species", &
      & etsf_io_low_integer, &
      & (/ pad("number_of_atoms") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_geometry_red_at_pos) /= 0) then
    call etsf_io_low_def_var(ncid, "reduced_atom_positions", &
      & etsf_io_low_double, &
      & (/ pad("number_of_reduced_dimensions"), &
      &    pad("number_of_atoms") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_geometry_valence_charges) /= 0) then
    call etsf_io_low_def_var(ncid, "valence_charges", &
      & etsf_io_low_double, &
      & (/ pad("number_of_atom_species") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_geometry_atomic_numbers) /= 0) then
    call etsf_io_low_def_var(ncid, "atomic_numbers", &
      & etsf_io_low_double, &
      & (/ pad("number_of_atom_species") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_geometry_atom_species_names) /= 0) then
    call etsf_io_low_def_var(ncid, "atom_species_names", &
      & etsf_io_low_character, &
      & (/ pad("character_string_length"), &
      &    pad("number_of_atom_species") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_geometry_chemical_symbols) /= 0) then
    call etsf_io_low_def_var(ncid, "chemical_symbols", &
      & etsf_io_low_character, &
      & (/ pad("symbol_length"), &
      &    pad("number_of_atom_species") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_geometry_pseudo_types) /= 0) then
    call etsf_io_low_def_var(ncid, "pseudopotential_types", &
      & etsf_io_low_character, &
      & (/ pad("character_string_length"), &
      &    pad("number_of_atom_species") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  ! If we reach the end, then it should be OK.
  lstat = .true.


!DEBUG
!write (*,*) 'etsf_io_geometry_def : exit'
!ENDDEBUG

end subroutine etsf_io_geometry_def
etsf_io-1.0.3/doc/www/group_level/etsf_io_electrons_def_f90.html0000644000353400050620000012406511354150415021701 00000000000000 ./src/group_level/etsf_io_electrons_def.f90

TABLE OF CONTENTS

etsf_io_electrons_def

[ Top ] [ etsf_electrons ] [ Methods ]

NAME

etsf_io_electrons_def

FUNCTION

The given ETSF file must be opened and in define state (see etsf_io_low_set_define_mode() to change it). Then, all variable of the group are defined. All required dimensions must have already defined (see etsf_io_dims_def(). If some dimensions are missing, then the variable is not defined and no error are generated.

One can specify which variable may be splitted using the optional argument @split. For each associated array in this structure, variable with appropriated dimensions will use my_<something> instead of <something>.

INPUTS

  • ncid = integer returned by an 'open' NetCDF call. The file can be either in define or write mode. This status can be changed by the call.
  • k_dependent = (optional) use this argument to set the attribute flag 'k_dependent' to 'yes' or 'no' on variables that have it. If no variable in the group has the attribute 'k_dependent', this argument has no effect. The default value is .true. (which puts 'yes' in the file).
  • flags = (optional) One can choose the variables of the group that will be defined (and disk allocated) using this flag. This is a sum of values taken from #FLAGS_VARIABLES.
  • split <type(etsf_split)> = (optional) for each array associated in the type, the dimension used to declared the variables sizes will be 'my_/something/'.

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_electrons_def(ncid, lstat, error_data, k_dependent, flags, &
  & split)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data
  logical, optional, intent(intent) :: k_dependent
  integer, optional, intent(intent) :: flags
  type(etsf_split), optional, intent(intent) :: split

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_electrons_def'
  logical :: my_k_dependent
  integer :: my_flags
  type(etsf_split) :: my_split
  integer :: ivar
  type(split_dim_names) :: split_dims


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_electrons_def : enter'
!ENDDEBUG

  ! Get values for optional arguments, set default.
  if (present(k_dependent)) then
    my_k_dependent = k_dependent
  else
    my_k_dependent = .true.
  end if
  if (present(flags)) then
    my_flags = flags
  else
    my_flags = etsf_electrons_all
  end if
  ! Consistency checks.
  if (my_flags < etsf_electrons_none .or. my_flags > etsf_electrons_all) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_DEF, ERROR_TYPE_ARG, my_name, &
                             & tgtname = "flags", errmess = "value out of bounds")
    lstat = .false.
    return
  end if
  
  ! Set the name for dimensions that could be splitted.
  if (present(split)) then
    if (associated(split%my_kpoints)) then
      write(split_dims%number_of_kpoints, "(A)") &
        & "my_number_of_kpoints"
    end if
    if (associated(split%my_spins)) then
      write(split_dims%number_of_spins, "(A)") &
        & "my_number_of_spins"
    end if
    if (associated(split%my_states)) then
      write(split_dims%max_number_of_states, "(A)") &
        & "my_max_number_of_states"
    end if
  end if
  
  if (iand(my_flags, etsf_electrons_number_of_electrons) /= 0) then
    call etsf_io_low_def_var(ncid, "number_of_electrons", &
      & etsf_io_low_integer, &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_electrons_x_functional) /= 0) then
    call etsf_io_low_def_var(ncid, "exchange_functional", &
      & etsf_io_low_character, &
      & (/ pad("character_string_length") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_electrons_c_functional) /= 0) then
    call etsf_io_low_def_var(ncid, "correlation_functional", &
      & etsf_io_low_character, &
      & (/ pad("character_string_length") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_electrons_fermi_energy) /= 0) then
    call etsf_io_low_def_var(ncid, "fermi_energy", &
      & etsf_io_low_double, &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    if (ivar >= 0) then
      ! Handle the units attribute.
      call etsf_io_low_write_att(ncid, ivar, &
                              & "units", &
                              & "atomic units", &
                              & lstat, error_data = error_data)
      if (.not. lstat) return
      call etsf_io_low_write_att(ncid, ivar, &
                              & "scale_to_atomic_units", &
                              & 1.0d0, &
                              & lstat, error_data = error_data)
      if (.not. lstat) then
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
  end if
  
  if (iand(my_flags, etsf_electrons_smearing_scheme) /= 0) then
    call etsf_io_low_def_var(ncid, "smearing_scheme", &
      & etsf_io_low_character, &
      & (/ pad("character_string_length") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_electrons_smearing_width) /= 0) then
    call etsf_io_low_def_var(ncid, "smearing_width", &
      & etsf_io_low_double, &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    if (ivar >= 0) then
      ! Handle the units attribute.
      call etsf_io_low_write_att(ncid, ivar, &
                              & "units", &
                              & "atomic units", &
                              & lstat, error_data = error_data)
      if (.not. lstat) return
      call etsf_io_low_write_att(ncid, ivar, &
                              & "scale_to_atomic_units", &
                              & 1.0d0, &
                              & lstat, error_data = error_data)
      if (.not. lstat) then
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
  end if
  
  if (iand(my_flags, etsf_electrons_number_of_states) /= 0) then
    call etsf_io_low_def_var(ncid, "number_of_states", &
      & etsf_io_low_integer, &
      & (/ split_dims%number_of_kpoints, &
      &    split_dims%number_of_spins /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_electrons_eigenvalues) /= 0) then
    call etsf_io_low_def_var(ncid, "eigenvalues", &
      & etsf_io_low_double, &
      & (/ split_dims%max_number_of_states, &
      &    split_dims%number_of_kpoints, &
      &    split_dims%number_of_spins /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    if (ivar >= 0) then
      ! Handle the units attribute.
      call etsf_io_low_write_att(ncid, ivar, &
                              & "units", &
                              & "atomic units", &
                              & lstat, error_data = error_data)
      if (.not. lstat) return
      call etsf_io_low_write_att(ncid, ivar, &
                              & "scale_to_atomic_units", &
                              & 1.0d0, &
                              & lstat, error_data = error_data)
      if (.not. lstat) then
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
  end if
  
  if (iand(my_flags, etsf_electrons_occupations) /= 0) then
    call etsf_io_low_def_var(ncid, "occupations", &
      & etsf_io_low_double, &
      & (/ split_dims%max_number_of_states, &
      &    split_dims%number_of_kpoints, &
      &    split_dims%number_of_spins /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  ! If we reach the end, then it should be OK.
  lstat = .true.


!DEBUG
!write (*,*) 'etsf_io_electrons_def : exit'
!ENDDEBUG

end subroutine etsf_io_electrons_def
etsf_io-1.0.3/doc/www/group_level/etsf_io_kpoints_def_f90.html0000644000353400050620000006014411354150415021367 00000000000000 ./src/group_level/etsf_io_kpoints_def.f90

TABLE OF CONTENTS

etsf_io_kpoints_def

[ Top ] [ etsf_kpoints ] [ Methods ]

NAME

etsf_io_kpoints_def

FUNCTION

The given ETSF file must be opened and in define state (see etsf_io_low_set_define_mode() to change it). Then, all variable of the group are defined. All required dimensions must have already defined (see etsf_io_dims_def(). If some dimensions are missing, then the variable is not defined and no error are generated.

One can specify which variable may be splitted using the optional argument @split. For each associated array in this structure, variable with appropriated dimensions will use my_<something> instead of <something>.

INPUTS

  • ncid = integer returned by an 'open' NetCDF call. The file can be either in define or write mode. This status can be changed by the call.
  • k_dependent = (optional) use this argument to set the attribute flag 'k_dependent' to 'yes' or 'no' on variables that have it. If no variable in the group has the attribute 'k_dependent', this argument has no effect. The default value is .true. (which puts 'yes' in the file).
  • flags = (optional) One can choose the variables of the group that will be defined (and disk allocated) using this flag. This is a sum of values taken from #FLAGS_VARIABLES.
  • split <type(etsf_split)> = (optional) for each array associated in the type, the dimension used to declared the variables sizes will be 'my_/something/'.

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_kpoints_def(ncid, lstat, error_data, k_dependent, flags, &
  & split)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data
  logical, optional, intent(intent) :: k_dependent
  integer, optional, intent(intent) :: flags
  type(etsf_split), optional, intent(intent) :: split

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_kpoints_def'
  logical :: my_k_dependent
  integer :: my_flags
  type(etsf_split) :: my_split
  integer :: ivar
  type(split_dim_names) :: split_dims


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_kpoints_def : enter'
!ENDDEBUG

  ! Get values for optional arguments, set default.
  if (present(k_dependent)) then
    my_k_dependent = k_dependent
  else
    my_k_dependent = .true.
  end if
  if (present(flags)) then
    my_flags = flags
  else
    my_flags = etsf_kpoints_all
  end if
  ! Consistency checks.
  if (my_flags < etsf_kpoints_none .or. my_flags > etsf_kpoints_all) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_DEF, ERROR_TYPE_ARG, my_name, &
                             & tgtname = "flags", errmess = "value out of bounds")
    lstat = .false.
    return
  end if
  
  ! Set the name for dimensions that could be splitted.
  if (present(split)) then
    if (associated(split%my_kpoints)) then
      write(split_dims%number_of_kpoints, "(A)") &
        & "my_number_of_kpoints"
    end if
  end if
  
  if (iand(my_flags, etsf_kpoints_kpoint_grid_shift) /= 0) then
    call etsf_io_low_def_var(ncid, "kpoint_grid_shift", &
      & etsf_io_low_double, &
      & (/ pad("number_of_reduced_dimensions") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_kpoints_kpoint_grid_vectors) /= 0) then
    call etsf_io_low_def_var(ncid, "kpoint_grid_vectors", &
      & etsf_io_low_double, &
      & (/ pad("number_of_reduced_dimensions"), &
      &    pad("number_of_vectors") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_kpoints_mp_folding) /= 0) then
    call etsf_io_low_def_var(ncid, "monkhorst_pack_folding", &
      & etsf_io_low_integer, &
      & (/ pad("number_of_vectors") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_kpoints_red_coord_kpt) /= 0) then
    call etsf_io_low_def_var(ncid, "reduced_coordinates_of_kpoints", &
      & etsf_io_low_double, &
      & (/ pad("number_of_reduced_dimensions"), &
      &    split_dims%number_of_kpoints /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_kpoints_kpoint_weights) /= 0) then
    call etsf_io_low_def_var(ncid, "kpoint_weights", &
      & etsf_io_low_double, &
      & (/ split_dims%number_of_kpoints /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  ! If we reach the end, then it should be OK.
  lstat = .true.


!DEBUG
!write (*,*) 'etsf_io_kpoints_def : exit'
!ENDDEBUG

end subroutine etsf_io_kpoints_def
etsf_io-1.0.3/doc/www/group_level/etsf_io_basisdata_def_f90.html0000644000353400050620000011154111354150415021631 00000000000000 ./src/group_level/etsf_io_basisdata_def.f90

TABLE OF CONTENTS

etsf_io_basisdata_def

[ Top ] [ etsf_basisdata ] [ Methods ]

NAME

etsf_io_basisdata_def

FUNCTION

The given ETSF file must be opened and in define state (see etsf_io_low_set_define_mode() to change it). Then, all variable of the group are defined. All required dimensions must have already defined (see etsf_io_dims_def(). If some dimensions are missing, then the variable is not defined and no error are generated.

One can specify which variable may be splitted using the optional argument @split. For each associated array in this structure, variable with appropriated dimensions will use my_<something> instead of <something>.

INPUTS

  • ncid = integer returned by an 'open' NetCDF call. The file can be either in define or write mode. This status can be changed by the call.
  • k_dependent = (optional) use this argument to set the attribute flag 'k_dependent' to 'yes' or 'no' on variables that have it. If no variable in the group has the attribute 'k_dependent', this argument has no effect. The default value is .true. (which puts 'yes' in the file).
  • flags = (optional) One can choose the variables of the group that will be defined (and disk allocated) using this flag. This is a sum of values taken from #FLAGS_VARIABLES.
  • split <type(etsf_split)> = (optional) for each array associated in the type, the dimension used to declared the variables sizes will be 'my_/something/'.

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_basisdata_def(ncid, lstat, error_data, k_dependent, flags, &
  & split)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data
  logical, optional, intent(intent) :: k_dependent
  integer, optional, intent(intent) :: flags
  type(etsf_split), optional, intent(intent) :: split

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_basisdata_def'
  logical :: my_k_dependent
  integer :: my_flags
  type(etsf_split) :: my_split
  integer :: ivar
  type(split_dim_names) :: split_dims


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_basisdata_def : enter'
!ENDDEBUG

  ! Get values for optional arguments, set default.
  if (present(k_dependent)) then
    my_k_dependent = k_dependent
  else
    my_k_dependent = .true.
  end if
  if (present(flags)) then
    my_flags = flags
  else
    my_flags = etsf_basisdata_all
  end if
  ! Consistency checks.
  if (my_flags < etsf_basisdata_none .or. my_flags > etsf_basisdata_all) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_DEF, ERROR_TYPE_ARG, my_name, &
                             & tgtname = "flags", errmess = "value out of bounds")
    lstat = .false.
    return
  end if
  
  ! Set the name for dimensions that could be splitted.
  if (present(split)) then
    if (associated(split%my_kpoints)) then
      write(split_dims%number_of_kpoints, "(A)") &
        & "my_number_of_kpoints"
    end if
    if (associated(split%my_coefficients)) then
      write(split_dims%max_number_of_coefficients, "(A)") &
        & "my_max_number_of_coefficients"
    end if
  end if
  
  if (iand(my_flags, etsf_basisdata_basis_set) /= 0) then
    call etsf_io_low_def_var(ncid, "basis_set", &
      & etsf_io_low_character, &
      & (/ pad("character_string_length") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_basisdata_kin_cutoff) /= 0) then
    call etsf_io_low_def_var(ncid, "kinetic_energy_cutoff", &
      & etsf_io_low_double, &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    if (ivar >= 0) then
      ! Handle the units attribute.
      call etsf_io_low_write_att(ncid, ivar, &
                              & "units", &
                              & "atomic units", &
                              & lstat, error_data = error_data)
      if (.not. lstat) return
      call etsf_io_low_write_att(ncid, ivar, &
                              & "scale_to_atomic_units", &
                              & 1.0d0, &
                              & lstat, error_data = error_data)
      if (.not. lstat) then
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
  end if
  
  if (iand(my_flags, etsf_basisdata_n_coeff) /= 0) then
    call etsf_io_low_def_var(ncid, "number_of_coefficients", &
      & etsf_io_low_integer, &
      & (/ split_dims%number_of_kpoints /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    if (ivar >= 0) then
      ! Handle the k_dependent attribute.
      if (my_k_dependent) then
        call etsf_io_low_write_att(ncid, ivar, &
                                & "k_dependent", &
                                & "yes", &
                                & lstat, error_data = error_data)
      else
        call etsf_io_low_write_att(ncid, ivar, &
                                & "k_dependent", &
                                & "no", &
                                & lstat, error_data = error_data)
      end if
      if (.not. lstat) then
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
  end if
  
  if (iand(my_flags, etsf_basisdata_red_coord_pw) /= 0) then
    if (.not. my_k_dependent) then
      call etsf_io_low_def_var(ncid, "reduced_coordinates_of_plane_waves", &
        & etsf_io_low_integer, &
        & (/ pad("number_of_reduced_dimensions"), &
        &    split_dims%max_number_of_coefficients /), &
        & lstat, ncvarid = ivar, error_data = error_data)
    else
      call etsf_io_low_def_var(ncid, "reduced_coordinates_of_plane_waves", &
        & etsf_io_low_integer, &
        & (/ pad("number_of_reduced_dimensions"), &
        &    split_dims%max_number_of_coefficients, &
        &    split_dims%number_of_kpoints /), &
        & lstat, ncvarid = ivar, error_data = error_data)
    end if
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    if (ivar >= 0) then
      ! Handle the k_dependent attribute.
      if (my_k_dependent) then
        call etsf_io_low_write_att(ncid, ivar, &
                                & "k_dependent", &
                                & "yes", &
                                & lstat, error_data = error_data)
      else
        call etsf_io_low_write_att(ncid, ivar, &
                                & "k_dependent", &
                                & "no", &
                                & lstat, error_data = error_data)
      end if
      if (.not. lstat) then
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
  end if
  
  if (iand(my_flags, etsf_basisdata_coord_grid) /= 0) then
    call etsf_io_low_def_var(ncid, "coordinates_of_basis_grid_points", &
      & etsf_io_low_integer, &
      & (/ pad("number_of_reduced_dimensions"), &
      &    pad("max_number_of_basis_grid_points"), &
      &    pad("number_of_localization_regions") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_basisdata_n_coeff_grid) /= 0) then
    call etsf_io_low_def_var(ncid, "number_of_coefficients_per_grid_point", &
      & etsf_io_low_integer, &
      & (/ pad("max_number_of_basis_grid_points"), &
      &    pad("number_of_localization_regions") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  ! If we reach the end, then it should be OK.
  lstat = .true.


!DEBUG
!write (*,*) 'etsf_io_basisdata_def : exit'
!ENDDEBUG

end subroutine etsf_io_basisdata_def
etsf_io-1.0.3/doc/www/group_level/etsf_io_gwdata_def_f90.html0000644000353400050620000006360011354150415021147 00000000000000 ./src/group_level/etsf_io_gwdata_def.f90

TABLE OF CONTENTS

etsf_io_gwdata_def

[ Top ] [ etsf_gwdata ] [ Methods ]

NAME

etsf_io_gwdata_def

FUNCTION

The given ETSF file must be opened and in define state (see etsf_io_low_set_define_mode() to change it). Then, all variable of the group are defined. All required dimensions must have already defined (see etsf_io_dims_def(). If some dimensions are missing, then the variable is not defined and no error are generated.

One can specify which variable may be splitted using the optional argument @split. For each associated array in this structure, variable with appropriated dimensions will use my_<something> instead of <something>.

INPUTS

  • ncid = integer returned by an 'open' NetCDF call. The file can be either in define or write mode. This status can be changed by the call.
  • k_dependent = (optional) use this argument to set the attribute flag 'k_dependent' to 'yes' or 'no' on variables that have it. If no variable in the group has the attribute 'k_dependent', this argument has no effect. The default value is .true. (which puts 'yes' in the file).
  • flags = (optional) One can choose the variables of the group that will be defined (and disk allocated) using this flag. This is a sum of values taken from #FLAGS_VARIABLES.
  • split <type(etsf_split)> = (optional) for each array associated in the type, the dimension used to declared the variables sizes will be 'my_/something/'.

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_gwdata_def(ncid, lstat, error_data, k_dependent, flags, &
  & split)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data
  logical, optional, intent(intent) :: k_dependent
  integer, optional, intent(intent) :: flags
  type(etsf_split), optional, intent(intent) :: split

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_gwdata_def'
  logical :: my_k_dependent
  integer :: my_flags
  type(etsf_split) :: my_split
  integer :: ivar
  type(split_dim_names) :: split_dims


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_gwdata_def : enter'
!ENDDEBUG

  ! Get values for optional arguments, set default.
  if (present(k_dependent)) then
    my_k_dependent = k_dependent
  else
    my_k_dependent = .true.
  end if
  if (present(flags)) then
    my_flags = flags
  else
    my_flags = etsf_gwdata_all
  end if
  ! Consistency checks.
  if (my_flags < etsf_gwdata_none .or. my_flags > etsf_gwdata_all) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_DEF, ERROR_TYPE_ARG, my_name, &
                             & tgtname = "flags", errmess = "value out of bounds")
    lstat = .false.
    return
  end if
  
  ! Set the name for dimensions that could be splitted.
  if (present(split)) then
    if (associated(split%my_kpoints)) then
      write(split_dims%number_of_kpoints, "(A)") &
        & "my_number_of_kpoints"
    end if
    if (associated(split%my_spins)) then
      write(split_dims%number_of_spins, "(A)") &
        & "my_number_of_spins"
    end if
    if (associated(split%my_coefficients)) then
      write(split_dims%max_number_of_coefficients, "(A)") &
        & "my_max_number_of_coefficients"
    end if
    if (associated(split%my_states)) then
      write(split_dims%max_number_of_states, "(A)") &
        & "my_max_number_of_states"
    end if
  end if
  
  if (iand(my_flags, etsf_gwdata_gw_corrections) /= 0) then
    call etsf_io_low_def_var(ncid, "gw_corrections", &
      & etsf_io_low_double, &
      & (/ pad("real_or_complex_gw_corrections"), &
      &    split_dims%max_number_of_states, &
      &    split_dims%number_of_kpoints, &
      &    split_dims%number_of_spins /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_gwdata_kb_coeff_sig) /= 0) then
    call etsf_io_low_def_var(ncid, "kb_formfactor_sign", &
      & etsf_io_low_integer, &
      & (/ pad("max_number_of_projectors"), &
      &    pad("max_number_of_angular_momenta"), &
      &    pad("number_of_atom_species") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_gwdata_kb_coeff) /= 0) then
    call etsf_io_low_def_var(ncid, "kb_formfactors", &
      & etsf_io_low_double, &
      & (/ split_dims%max_number_of_coefficients, &
      &    split_dims%number_of_kpoints, &
      &    pad("max_number_of_projectors"), &
      &    pad("max_number_of_angular_momenta"), &
      &    pad("number_of_atom_species") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_gwdata_kb_coeff_der) /= 0) then
    call etsf_io_low_def_var(ncid, "kb_formfactor_derivative", &
      & etsf_io_low_double, &
      & (/ split_dims%max_number_of_coefficients, &
      &    split_dims%number_of_kpoints, &
      &    pad("max_number_of_projectors"), &
      &    pad("max_number_of_angular_momenta"), &
      &    pad("number_of_atom_species") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  ! If we reach the end, then it should be OK.
  lstat = .true.


!DEBUG
!write (*,*) 'etsf_io_gwdata_def : exit'
!ENDDEBUG

end subroutine etsf_io_gwdata_def
etsf_io-1.0.3/doc/www/group_level/etsf_io_dielectric_def_f90.html0000644000353400050620000023421711354150415022013 00000000000000 ./src/group_level/etsf_io_dielectric_def.f90

TABLE OF CONTENTS

etsf_io_dielectric_def

[ Top ] [ etsf_dielectric ] [ Methods ]

NAME

etsf_io_dielectric_def

FUNCTION

The given ETSF file must be opened and in define state (see etsf_io_low_set_define_mode() to change it). Then, all variable of the group are defined. All required dimensions must have already defined (see etsf_io_dims_def(). If some dimensions are missing, then the variable is not defined and no error are generated.

One can specify which variable may be splitted using the optional argument @split. For each associated array in this structure, variable with appropriated dimensions will use my_<something> instead of <something>.

INPUTS

  • ncid = integer returned by an 'open' NetCDF call. The file can be either in define or write mode. This status can be changed by the call.
  • k_dependent = (optional) use this argument to set the attribute flag 'k_dependent' to 'yes' or 'no' on variables that have it. If no variable in the group has the attribute 'k_dependent', this argument has no effect. The default value is .true. (which puts 'yes' in the file).
  • flags = (optional) One can choose the variables of the group that will be defined (and disk allocated) using this flag. This is a sum of values taken from #FLAGS_VARIABLES.
  • split <type(etsf_split)> = (optional) for each array associated in the type, the dimension used to declared the variables sizes will be 'my_/something/'.

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_dielectric_def(ncid, lstat, error_data, k_dependent, flags, &
  & split)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data
  logical, optional, intent(intent) :: k_dependent
  integer, optional, intent(intent) :: flags
  type(etsf_split), optional, intent(intent) :: split

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_dielectric_def'
  logical :: my_k_dependent
  integer :: my_flags
  type(etsf_split) :: my_split
  integer :: ivar
  type(split_dim_names) :: split_dims


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_dielectric_def : enter'
!ENDDEBUG

  ! Get values for optional arguments, set default.
  if (present(k_dependent)) then
    my_k_dependent = k_dependent
  else
    my_k_dependent = .true.
  end if
  if (present(flags)) then
    my_flags = flags
  else
    my_flags = etsf_dielectric_all
  end if
  ! Consistency checks.
  if (my_flags < etsf_dielectric_none .or. my_flags > etsf_dielectric_all) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_DEF, ERROR_TYPE_ARG, my_name, &
                             & tgtname = "flags", errmess = "value out of bounds")
    lstat = .false.
    return
  end if
  
  ! Set the name for dimensions that could be splitted.
  if (present(split)) then
    if (associated(split%my_spins)) then
      write(split_dims%number_of_spins, "(A)") &
        & "my_number_of_spins"
    end if
  end if
  
  if (iand(my_flags, etsf_dielectric_frequencies) /= 0) then
    call etsf_io_low_def_var(ncid, "frequencies_dielectric_function", &
      & etsf_io_low_double, &
      & (/ pad("complex"), &
      &    pad("number_of_frequencies_dielectric_function") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_dielectric_qpt) /= 0) then
    call etsf_io_low_def_var(ncid, "qpoints_dielectric_function", &
      & etsf_io_low_double, &
      & (/ pad("number_of_reduced_dimensions"), &
      &    pad("number_of_qpoints_dielectric_function") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_dielectric_qpt_g_lim) /= 0) then
    call etsf_io_low_def_var(ncid, "qpoints_gamma_limit", &
      & etsf_io_low_double, &
      & (/ pad("number_of_reduced_dimensions"), &
      &    pad("number_of_qpoints_gamma_limit") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_dielectric_function) /= 0) then
    call etsf_io_low_def_var(ncid, "dielectric_function", &
      & etsf_io_low_double, &
      & (/ pad("complex"), &
      &    pad("number_of_coefficients_dielectric_function"), &
      &    pad("number_of_coefficients_dielectric_function"), &
      &    split_dims%number_of_spins, &
      &    split_dims%number_of_spins, &
      &    pad("number_of_qpoints_dielectric_function"), &
      &    pad("number_of_frequencies_dielectric_function") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_dielectric_function_head) /= 0) then
    call etsf_io_low_def_var(ncid, "dielectric_function_head", &
      & etsf_io_low_double, &
      & (/ pad("complex"), &
      &    split_dims%number_of_spins, &
      &    split_dims%number_of_spins, &
      &    pad("number_of_qpoints_dielectric_function"), &
      &    pad("number_of_frequencies_dielectric_function") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_dielectric_function_lower) /= 0) then
    call etsf_io_low_def_var(ncid, "dielectric_function_lower_wing", &
      & etsf_io_low_double, &
      & (/ pad("complex"), &
      &    pad("number_of_coefficients_dielectric_function"), &
      &    split_dims%number_of_spins, &
      &    split_dims%number_of_spins, &
      &    pad("number_of_qpoints_gamma_limit"), &
      &    pad("number_of_frequencies_dielectric_function") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_dielectric_function_upper) /= 0) then
    call etsf_io_low_def_var(ncid, "dielectric_function_upper_wing", &
      & etsf_io_low_double, &
      & (/ pad("complex"), &
      &    pad("number_of_coefficients_dielectric_function"), &
      &    split_dims%number_of_spins, &
      &    split_dims%number_of_spins, &
      &    pad("number_of_qpoints_gamma_limit"), &
      &    pad("number_of_frequencies_dielectric_function") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_dielectric_function_inv) /= 0) then
    call etsf_io_low_def_var(ncid, "inverse_dielectric_function", &
      & etsf_io_low_double, &
      & (/ pad("complex"), &
      &    pad("number_of_coefficients_dielectric_function"), &
      &    pad("number_of_coefficients_dielectric_function"), &
      &    split_dims%number_of_spins, &
      &    split_dims%number_of_spins, &
      &    pad("number_of_qpoints_dielectric_function"), &
      &    pad("number_of_frequencies_dielectric_function") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_dielectric_function_inv_head) /= 0) then
    call etsf_io_low_def_var(ncid, "inverse_dielectric_function_head", &
      & etsf_io_low_double, &
      & (/ pad("complex"), &
      &    split_dims%number_of_spins, &
      &    split_dims%number_of_spins, &
      &    pad("number_of_qpoints_dielectric_function"), &
      &    pad("number_of_frequencies_dielectric_function") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_dielectric_function_inv_lower) /= 0) then
    call etsf_io_low_def_var(ncid, "inverse_dielectric_function_lower_wing", &
      & etsf_io_low_double, &
      & (/ pad("complex"), &
      &    pad("number_of_coefficients_dielectric_function"), &
      &    split_dims%number_of_spins, &
      &    split_dims%number_of_spins, &
      &    pad("number_of_qpoints_gamma_limit"), &
      &    pad("number_of_frequencies_dielectric_function") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_dielectric_function_inv_upper) /= 0) then
    call etsf_io_low_def_var(ncid, "inverse_dielectric_function_upper_wing", &
      & etsf_io_low_double, &
      & (/ pad("complex"), &
      &    pad("number_of_coefficients_dielectric_function"), &
      &    split_dims%number_of_spins, &
      &    split_dims%number_of_spins, &
      &    pad("number_of_qpoints_gamma_limit"), &
      &    pad("number_of_frequencies_dielectric_function") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_dielectric_polarizability) /= 0) then
    call etsf_io_low_def_var(ncid, "polarizability", &
      & etsf_io_low_double, &
      & (/ pad("complex"), &
      &    pad("number_of_coefficients_dielectric_function"), &
      &    pad("number_of_coefficients_dielectric_function"), &
      &    split_dims%number_of_spins, &
      &    split_dims%number_of_spins, &
      &    pad("number_of_qpoints_dielectric_function"), &
      &    pad("number_of_frequencies_dielectric_function") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_dielectric_pol_head) /= 0) then
    call etsf_io_low_def_var(ncid, "polarizability_head", &
      & etsf_io_low_double, &
      & (/ pad("complex"), &
      &    split_dims%number_of_spins, &
      &    split_dims%number_of_spins, &
      &    pad("number_of_qpoints_dielectric_function"), &
      &    pad("number_of_frequencies_dielectric_function") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_dielectric_pol_lower) /= 0) then
    call etsf_io_low_def_var(ncid, "polarizability_lower_wing", &
      & etsf_io_low_double, &
      & (/ pad("complex"), &
      &    pad("number_of_coefficients_dielectric_function"), &
      &    split_dims%number_of_spins, &
      &    split_dims%number_of_spins, &
      &    pad("number_of_qpoints_gamma_limit"), &
      &    pad("number_of_frequencies_dielectric_function") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_dielectric_pol_upper) /= 0) then
    call etsf_io_low_def_var(ncid, "polarizability_upper_wing", &
      & etsf_io_low_double, &
      & (/ pad("complex"), &
      &    pad("number_of_coefficients_dielectric_function"), &
      &    split_dims%number_of_spins, &
      &    split_dims%number_of_spins, &
      &    pad("number_of_qpoints_gamma_limit"), &
      &    pad("number_of_frequencies_dielectric_function") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_dielectric_polarizability_inv) /= 0) then
    call etsf_io_low_def_var(ncid, "inverse_polarizability", &
      & etsf_io_low_double, &
      & (/ pad("complex"), &
      &    pad("number_of_coefficients_dielectric_function"), &
      &    pad("number_of_coefficients_dielectric_function"), &
      &    split_dims%number_of_spins, &
      &    split_dims%number_of_spins, &
      &    pad("number_of_qpoints_dielectric_function"), &
      &    pad("number_of_frequencies_dielectric_function") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_dielectric_pol_inv_head) /= 0) then
    call etsf_io_low_def_var(ncid, "inverse_polarizability_head", &
      & etsf_io_low_double, &
      & (/ pad("complex"), &
      &    split_dims%number_of_spins, &
      &    split_dims%number_of_spins, &
      &    pad("number_of_qpoints_dielectric_function"), &
      &    pad("number_of_frequencies_dielectric_function") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_dielectric_pol_inv_lower) /= 0) then
    call etsf_io_low_def_var(ncid, "inverse_polarizability_lower_wing", &
      & etsf_io_low_double, &
      & (/ pad("complex"), &
      &    pad("number_of_coefficients_dielectric_function"), &
      &    split_dims%number_of_spins, &
      &    split_dims%number_of_spins, &
      &    pad("number_of_qpoints_gamma_limit"), &
      &    pad("number_of_frequencies_dielectric_function") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_dielectric_pol_inv_upper) /= 0) then
    call etsf_io_low_def_var(ncid, "inverse_polarizability_upper_wing", &
      & etsf_io_low_double, &
      & (/ pad("complex"), &
      &    pad("number_of_coefficients_dielectric_function"), &
      &    split_dims%number_of_spins, &
      &    split_dims%number_of_spins, &
      &    pad("number_of_qpoints_gamma_limit"), &
      &    pad("number_of_frequencies_dielectric_function") /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  ! If we reach the end, then it should be OK.
  lstat = .true.


!DEBUG
!write (*,*) 'etsf_io_dielectric_def : exit'
!ENDDEBUG

end subroutine etsf_io_dielectric_def
etsf_io-1.0.3/doc/www/group_level/etsf_io_main_def_f90.html0000644000353400050620000013312211354150414020620 00000000000000 ./src/group_level/etsf_io_main_def.f90

TABLE OF CONTENTS

etsf_io_main_def

[ Top ] [ etsf_main ] [ Methods ]

NAME

etsf_io_main_def

FUNCTION

The given ETSF file must be opened and in define state (see etsf_io_low_set_define_mode() to change it). Then, all variable of the group are defined. All required dimensions must have already defined (see etsf_io_dims_def(). If some dimensions are missing, then the variable is not defined and no error are generated.

One can specify which variable may be splitted using the optional argument @split. For each associated array in this structure, variable with appropriated dimensions will use my_<something> instead of <something>.

INPUTS

  • ncid = integer returned by an 'open' NetCDF call. The file can be either in define or write mode. This status can be changed by the call.
  • k_dependent = (optional) use this argument to set the attribute flag 'k_dependent' to 'yes' or 'no' on variables that have it. If no variable in the group has the attribute 'k_dependent', this argument has no effect. The default value is .true. (which puts 'yes' in the file).
  • flags = (optional) One can choose the variables of the group that will be defined (and disk allocated) using this flag. This is a sum of values taken from #FLAGS_VARIABLES.
  • split <type(etsf_split)> = (optional) for each array associated in the type, the dimension used to declared the variables sizes will be 'my_/something/'.

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_main_def(ncid, lstat, error_data, k_dependent, flags, split)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data
  logical, optional, intent(intent) :: k_dependent
  integer, optional, intent(intent) :: flags
  type(etsf_split), optional, intent(intent) :: split

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_main_def'
  logical :: my_k_dependent
  integer :: my_flags
  type(etsf_split) :: my_split
  integer :: ivar
  type(split_dim_names) :: split_dims


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_main_def : enter'
!ENDDEBUG

  ! Get values for optional arguments, set default.
  if (present(k_dependent)) then
    my_k_dependent = k_dependent
  else
    my_k_dependent = .true.
  end if
  if (present(flags)) then
    my_flags = flags
  else
    my_flags = etsf_main_all
  end if
  ! Consistency checks.
  if (my_flags < etsf_main_none .or. my_flags > etsf_main_all) then
    call etsf_io_low_error_set(error_data, ERROR_MODE_DEF, ERROR_TYPE_ARG, my_name, &
                             & tgtname = "flags", errmess = "value out of bounds")
    lstat = .false.
    return
  end if
  
  ! Set the name for dimensions that could be splitted.
  if (present(split)) then
    if (associated(split%my_kpoints)) then
      write(split_dims%number_of_kpoints, "(A)") &
        & "my_number_of_kpoints"
    end if
    if (associated(split%my_grid_points_vector3)) then
      write(split_dims%number_of_grid_points_vector3, "(A)") &
        & "my_number_of_grid_points_vector3"
    end if
    if (associated(split%my_spins)) then
      write(split_dims%number_of_spins, "(A)") &
        & "my_number_of_spins"
    end if
    if (associated(split%my_grid_points_vector1)) then
      write(split_dims%number_of_grid_points_vector1, "(A)") &
        & "my_number_of_grid_points_vector1"
    end if
    if (associated(split%my_grid_points_vector2)) then
      write(split_dims%number_of_grid_points_vector2, "(A)") &
        & "my_number_of_grid_points_vector2"
    end if
    if (associated(split%my_coefficients)) then
      write(split_dims%max_number_of_coefficients, "(A)") &
        & "my_max_number_of_coefficients"
    end if
    if (associated(split%my_components)) then
      write(split_dims%number_of_components, "(A)") &
        & "my_number_of_components"
    end if
    if (associated(split%my_states)) then
      write(split_dims%max_number_of_states, "(A)") &
        & "my_max_number_of_states"
    end if
  end if
  
  if (iand(my_flags, etsf_main_density) /= 0) then
    call etsf_io_low_def_var(ncid, "density", &
      & etsf_io_low_double, &
      & (/ pad("real_or_complex_density"), &
      &    split_dims%number_of_grid_points_vector1, &
      &    split_dims%number_of_grid_points_vector2, &
      &    split_dims%number_of_grid_points_vector3, &
      &    split_dims%number_of_components /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    if (ivar >= 0) then
      ! Handle the units attribute.
      call etsf_io_low_write_att(ncid, ivar, &
                              & "units", &
                              & "atomic units", &
                              & lstat, error_data = error_data)
      if (.not. lstat) return
      call etsf_io_low_write_att(ncid, ivar, &
                              & "scale_to_atomic_units", &
                              & 1.0d0, &
                              & lstat, error_data = error_data)
      if (.not. lstat) then
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
  end if
  
  if (iand(my_flags, etsf_main_pot_x_only) /= 0) then
    call etsf_io_low_def_var(ncid, "exchange_potential", &
      & etsf_io_low_double, &
      & (/ pad("real_or_complex_potential"), &
      &    split_dims%number_of_grid_points_vector1, &
      &    split_dims%number_of_grid_points_vector2, &
      &    split_dims%number_of_grid_points_vector3, &
      &    split_dims%number_of_components /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    if (ivar >= 0) then
      ! Handle the units attribute.
      call etsf_io_low_write_att(ncid, ivar, &
                              & "units", &
                              & "atomic units", &
                              & lstat, error_data = error_data)
      if (.not. lstat) return
      call etsf_io_low_write_att(ncid, ivar, &
                              & "scale_to_atomic_units", &
                              & 1.0d0, &
                              & lstat, error_data = error_data)
      if (.not. lstat) then
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
  end if
  
  if (iand(my_flags, etsf_main_pot_c_only) /= 0) then
    call etsf_io_low_def_var(ncid, "correlation_potential", &
      & etsf_io_low_double, &
      & (/ pad("real_or_complex_potential"), &
      &    split_dims%number_of_grid_points_vector1, &
      &    split_dims%number_of_grid_points_vector2, &
      &    split_dims%number_of_grid_points_vector3, &
      &    split_dims%number_of_components /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    if (ivar >= 0) then
      ! Handle the units attribute.
      call etsf_io_low_write_att(ncid, ivar, &
                              & "units", &
                              & "atomic units", &
                              & lstat, error_data = error_data)
      if (.not. lstat) return
      call etsf_io_low_write_att(ncid, ivar, &
                              & "scale_to_atomic_units", &
                              & 1.0d0, &
                              & lstat, error_data = error_data)
      if (.not. lstat) then
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
  end if
  
  if (iand(my_flags, etsf_main_pot_xc) /= 0) then
    call etsf_io_low_def_var(ncid, "exchange_correlation_potential", &
      & etsf_io_low_double, &
      & (/ pad("real_or_complex_potential"), &
      &    split_dims%number_of_grid_points_vector1, &
      &    split_dims%number_of_grid_points_vector2, &
      &    split_dims%number_of_grid_points_vector3, &
      &    split_dims%number_of_components /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    if (ivar >= 0) then
      ! Handle the units attribute.
      call etsf_io_low_write_att(ncid, ivar, &
                              & "units", &
                              & "atomic units", &
                              & lstat, error_data = error_data)
      if (.not. lstat) return
      call etsf_io_low_write_att(ncid, ivar, &
                              & "scale_to_atomic_units", &
                              & 1.0d0, &
                              & lstat, error_data = error_data)
      if (.not. lstat) then
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
  end if
  
  if (iand(my_flags, etsf_main_wfs_coeff) /= 0) then
    call etsf_io_low_def_var(ncid, "coefficients_of_wavefunctions", &
      & etsf_io_low_double, &
      & (/ pad("real_or_complex_coefficients"), &
      &    split_dims%max_number_of_coefficients, &
      &    pad("number_of_spinor_components"), &
      &    split_dims%max_number_of_states, &
      &    split_dims%number_of_kpoints, &
      &    split_dims%number_of_spins /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (iand(my_flags, etsf_main_wfs_rsp) /= 0) then
    call etsf_io_low_def_var(ncid, "real_space_wavefunctions", &
      & etsf_io_low_double, &
      & (/ pad("real_or_complex_wavefunctions"), &
      &    split_dims%number_of_grid_points_vector1, &
      &    split_dims%number_of_grid_points_vector2, &
      &    split_dims%number_of_grid_points_vector3, &
      &    pad("number_of_spinor_components"), &
      &    split_dims%max_number_of_states, &
      &    split_dims%number_of_kpoints, &
      &    split_dims%number_of_spins /), &
      & lstat, ncvarid = ivar, error_data = error_data)
    ! We raise don't raise an error if a dimension is missing.
    if (.not. lstat .and. (error_data%access_mode_id /= ERROR_MODE_INQ .or. &
      & error_data%target_type_id /= ERROR_TYPE_DID)) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  ! If we reach the end, then it should be OK.
  lstat = .true.


!DEBUG
!write (*,*) 'etsf_io_main_def : exit'
!ENDDEBUG

end subroutine etsf_io_main_def
etsf_io-1.0.3/doc/www/group_level/etsf_io_geometry_get_f90.html0000644000353400050620000006643111354150415021561 00000000000000 ./src/group_level/etsf_io_geometry_get.f90

TABLE OF CONTENTS

etsf_io_geometry_get

[ Top ] [ etsf_geometry ] [ Methods ]

NAME

etsf_io_geometry_get

FUNCTION

Read an opened ETSF file to get data related to the given group. Only associated pointers of argument @folder will be accessed. If any accessed variable is missing, this routine returns an error (usually an access_mode_id of argument error_data set to ERROR_MODE_INQ). Any other errors implies a return with @lstat = .false..

INPUTS

  • ncid = integer returned by an 'open' NetCDF call. The file can be either in define or write mode. This status can be changed by the call.
  • use_atomic_units = (optional) set this flag to .true. makes the library use the value of the attribute scale_to_atomic_units to multiply the read variables (that are units dependent) by this factor (if different from 1.0d0).

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

SIDE EFFECTS

  • folder <type(etsf_geometry)> = an allocated structure with pointers on allocated areas in memory. These areas will be read or written if the pointer is associated, if not, the variable will be ignored. It is possible to access to specific dimensions of a variable using the <short_var_name>__kpoint_access or <short_var_name>__spin_access of this @folder structure. The <short_var_name>__number_of_<something> can also been set if only a subpart in one dimension should be accessed (this is possible when the specifications have been declared with a max_number_of_<something>.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_geometry_get(ncid, folder, lstat, error_data, use_atomic_units)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid
  type(etsf_geometry), intent(inout) :: folder
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data
  logical, optional, intent(intent) :: use_atomic_units

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_geometry_get'
  logical :: my_use_atomic_units
  integer,allocatable :: varid(:)
  integer,allocatable :: start(:)
  integer,allocatable :: count(:)
  integer :: len
  character(etsf_charlen) :: flag


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_geometry_get : enter'
!ENDDEBUG

  ! Get values for optional arguments, set default.
  if (present(use_atomic_units)) then
    my_use_atomic_units = use_atomic_units
  else
    my_use_atomic_units = .true.
  end if
  
  allocate(varid(11))
  
  if (associated(folder%space_group)) then
    call etsf_io_low_read_var(ncid, "space_group", &
                            & folder%space_group, &
                            & lstat, ncvarid = varid(1), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%primitive_vectors)) then
    call etsf_io_low_read_var(ncid, "primitive_vectors", &
                            & folder%primitive_vectors, &
                            & lstat, ncvarid = varid(2), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%reduced_symmetry_matrices)) then
    call etsf_io_low_read_var(ncid, "reduced_symmetry_matrices", &
                            & folder%reduced_symmetry_matrices, &
                            & lstat, ncvarid = varid(3), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%reduced_symmetry_translations)) then
    call etsf_io_low_read_var(ncid, "reduced_symmetry_translations", &
                            & folder%reduced_symmetry_translations, &
                            & lstat, ncvarid = varid(4), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%atom_species)) then
    call etsf_io_low_read_var(ncid, "atom_species", &
                            & folder%atom_species, &
                            & lstat, ncvarid = varid(5), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%reduced_atom_positions)) then
    call etsf_io_low_read_var(ncid, "reduced_atom_positions", &
                            & folder%reduced_atom_positions, &
                            & lstat, ncvarid = varid(6), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%valence_charges)) then
    call etsf_io_low_read_var(ncid, "valence_charges", &
                            & folder%valence_charges, &
                            & lstat, ncvarid = varid(7), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%atomic_numbers)) then
    call etsf_io_low_read_var(ncid, "atomic_numbers", &
                            & folder%atomic_numbers, &
                            & lstat, ncvarid = varid(8), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%atom_species_names)) then
    call etsf_io_low_read_var(ncid, "atom_species_names", &
                            & folder%atom_species_names, etsf_charlen, &
                            & lstat, ncvarid = varid(9), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%chemical_symbols)) then
    call etsf_io_low_read_var(ncid, "chemical_symbols", &
                            & folder%chemical_symbols, etsf_chemlen, &
                            & lstat, ncvarid = varid(10), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%pseudopotential_types)) then
    call etsf_io_low_read_var(ncid, "pseudopotential_types", &
                            & folder%pseudopotential_types, etsf_charlen, &
                            & lstat, ncvarid = varid(11), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  deallocate(varid)

!DEBUG
!write (*,*) 'etsf_io_geometry_get : exit'
!ENDDEBUG

end subroutine etsf_io_geometry_get
etsf_io-1.0.3/doc/www/group_level/etsf_io_electrons_get_f90.html0000644000353400050620000012161211354150415021715 00000000000000 ./src/group_level/etsf_io_electrons_get.f90

TABLE OF CONTENTS

etsf_io_electrons_get

[ Top ] [ etsf_electrons ] [ Methods ]

NAME

etsf_io_electrons_get

FUNCTION

Read an opened ETSF file to get data related to the given group. Only associated pointers of argument @folder will be accessed. If any accessed variable is missing, this routine returns an error (usually an access_mode_id of argument error_data set to ERROR_MODE_INQ). Any other errors implies a return with @lstat = .false..

INPUTS

  • ncid = integer returned by an 'open' NetCDF call. The file can be either in define or write mode. This status can be changed by the call.
  • use_atomic_units = (optional) set this flag to .true. makes the library use the value of the attribute scale_to_atomic_units to multiply the read variables (that are units dependent) by this factor (if different from 1.0d0).

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

SIDE EFFECTS

  • folder <type(etsf_electrons)> = an allocated structure with pointers on allocated areas in memory. These areas will be read or written if the pointer is associated, if not, the variable will be ignored. It is possible to access to specific dimensions of a variable using the <short_var_name>__kpoint_access or <short_var_name>__spin_access of this @folder structure. The <short_var_name>__number_of_<something> can also been set if only a subpart in one dimension should be accessed (this is possible when the specifications have been declared with a max_number_of_<something>.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_electrons_get(ncid, folder, lstat, error_data, use_atomic_units)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid
  type(etsf_electrons), intent(inout) :: folder
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data
  logical, optional, intent(intent) :: use_atomic_units

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_electrons_get'
  logical :: my_use_atomic_units
  integer,allocatable :: varid(:)
  integer,allocatable :: start(:)
  integer,allocatable :: count(:)
  integer :: len
  character(etsf_charlen) :: flag


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_electrons_get : enter'
!ENDDEBUG

  ! Get values for optional arguments, set default.
  if (present(use_atomic_units)) then
    my_use_atomic_units = use_atomic_units
  else
    my_use_atomic_units = .true.
  end if
  
  allocate(varid(9))
  
  if (associated(folder%number_of_electrons)) then
    call etsf_io_low_read_var(ncid, "number_of_electrons", &
                            & folder%number_of_electrons, &
                            & lstat, ncvarid = varid(1), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%exchange_functional)) then
    call etsf_io_low_read_var(ncid, "exchange_functional", &
                            & folder%exchange_functional, etsf_charlen, &
                            & lstat, ncvarid = varid(2), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%correlation_functional)) then
    call etsf_io_low_read_var(ncid, "correlation_functional", &
                            & folder%correlation_functional, etsf_charlen, &
                            & lstat, ncvarid = varid(3), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%fermi_energy)) then
    call etsf_io_low_read_var(ncid, "fermi_energy", &
                            & folder%fermi_energy, &
                            & lstat, ncvarid = varid(4), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%smearing_scheme)) then
    call etsf_io_low_read_var(ncid, "smearing_scheme", &
                            & folder%smearing_scheme, etsf_charlen, &
                            & lstat, ncvarid = varid(5), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%smearing_width)) then
    call etsf_io_low_read_var(ncid, "smearing_width", &
                            & folder%smearing_width, &
                            & lstat, ncvarid = varid(6), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%number_of_states)) then
    call etsf_io_low_read_var(ncid, "number_of_states", &
                            & folder%number_of_states, &
                            & lstat, ncvarid = varid(7), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%eigenvalues)) then
    allocate(start(3), count(3))
    start(:) = 1
    count(:) = 0
    if (folder%eigenvalues__spin_access /= etsf_no_sub_access) then
      start(3) = folder%eigenvalues__spin_access
      count(3) = 1
    end if
    if (folder%eigenvalues__kpoint_access /= etsf_no_sub_access) then
      start(2) = folder%eigenvalues__kpoint_access
      count(2) = 1
    end if
    count(1) = folder%eigenvalues__number_of_states
    if (folder%eigenvalues__state_access /= etsf_no_sub_access) then
      start(1) = folder%eigenvalues__state_access
      count(1) = 1
    end if
    call etsf_io_low_read_var(ncid, "eigenvalues", &
                            & folder%eigenvalues, &
                            & lstat, ncvarid = varid(8), &
                            & error_data = error_data, start = start, count = count)
    deallocate(start, count)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%occupations)) then
    allocate(start(3), count(3))
    start(:) = 1
    count(:) = 0
    if (folder%occupations__spin_access /= etsf_no_sub_access) then
      start(3) = folder%occupations__spin_access
      count(3) = 1
    end if
    if (folder%occupations__kpoint_access /= etsf_no_sub_access) then
      start(2) = folder%occupations__kpoint_access
      count(2) = 1
    end if
    count(1) = folder%occupations__number_of_states
    if (folder%occupations__state_access /= etsf_no_sub_access) then
      start(1) = folder%occupations__state_access
      count(1) = 1
    end if
    call etsf_io_low_read_var(ncid, "occupations", &
                            & folder%occupations, &
                            & lstat, ncvarid = varid(9), &
                            & error_data = error_data, start = start, count = count)
    deallocate(start, count)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  ! Handle all attributes for the group.
  if (associated(folder%fermi_energy)) then
    ! Handle the units attribute.
    call etsf_io_low_read_att(ncid, varid(4), &
                            & "units", &
                            & etsf_charlen, folder%fermi_energy__units, &
                            & lstat, error_data = error_data)
    if (.not. lstat) return
    if (trim(folder%fermi_energy__units) /= "atomic units") then
      call etsf_io_low_read_att(ncid, varid(4), &
                              & "scale_to_atomic_units", &
                              & folder%fermi_energy__scale_to_atomic_units, &
                              & lstat, error_data = error_data)
      if (.not. lstat) return
    else
      folder%fermi_energy__scale_to_atomic_units = 1.0d0
    end if
    if (my_use_atomic_units .and. &
      & folder%fermi_energy__scale_to_atomic_units /= 1.0d0) then
      folder%fermi_energy = folder%fermi_energy * &
        & folder%fermi_energy__scale_to_atomic_units
    end if
  end if
  
  if (associated(folder%smearing_width)) then
    ! Handle the units attribute.
    call etsf_io_low_read_att(ncid, varid(6), &
                            & "units", &
                            & etsf_charlen, folder%smearing_width__units, &
                            & lstat, error_data = error_data)
    if (.not. lstat) return
    if (trim(folder%smearing_width__units) /= "atomic units") then
      call etsf_io_low_read_att(ncid, varid(6), &
                              & "scale_to_atomic_units", &
                              & folder%smearing_width__scale_to_atomic_units, &
                              & lstat, error_data = error_data)
      if (.not. lstat) return
    else
      folder%smearing_width__scale_to_atomic_units = 1.0d0
    end if
    if (my_use_atomic_units .and. &
      & folder%smearing_width__scale_to_atomic_units /= 1.0d0) then
      folder%smearing_width = folder%smearing_width * &
        & folder%smearing_width__scale_to_atomic_units
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%eigenvalues)) then
    ! Handle the units attribute.
    call etsf_io_low_read_att(ncid, varid(8), &
                            & "units", &
                            & etsf_charlen, folder%eigenvalues__units, &
                            & lstat, error_data = error_data)
    if (.not. lstat) return
    if (trim(folder%eigenvalues__units) /= "atomic units") then
      call etsf_io_low_read_att(ncid, varid(8), &
                              & "scale_to_atomic_units", &
                              & folder%eigenvalues__scale_to_atomic_units, &
                              & lstat, error_data = error_data)
      if (.not. lstat) return
    else
      folder%eigenvalues__scale_to_atomic_units = 1.0d0
    end if
    if (my_use_atomic_units .and. &
      & folder%eigenvalues__scale_to_atomic_units /= 1.0d0) then
      call etsf_io_low_var_multiply(folder%eigenvalues, &
                                  & folder%eigenvalues__scale_to_atomic_units)
    end if
  end if
  
  
  deallocate(varid)

!DEBUG
!write (*,*) 'etsf_io_electrons_get : exit'
!ENDDEBUG

end subroutine etsf_io_electrons_get
etsf_io-1.0.3/doc/www/group_level/etsf_io_kpoints_get_f90.html0000644000353400050620000004202711354150415021410 00000000000000 ./src/group_level/etsf_io_kpoints_get.f90

TABLE OF CONTENTS

etsf_io_kpoints_get

[ Top ] [ etsf_kpoints ] [ Methods ]

NAME

etsf_io_kpoints_get

FUNCTION

Read an opened ETSF file to get data related to the given group. Only associated pointers of argument @folder will be accessed. If any accessed variable is missing, this routine returns an error (usually an access_mode_id of argument error_data set to ERROR_MODE_INQ). Any other errors implies a return with @lstat = .false..

INPUTS

  • ncid = integer returned by an 'open' NetCDF call. The file can be either in define or write mode. This status can be changed by the call.
  • use_atomic_units = (optional) set this flag to .true. makes the library use the value of the attribute scale_to_atomic_units to multiply the read variables (that are units dependent) by this factor (if different from 1.0d0).

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

SIDE EFFECTS

  • folder <type(etsf_kpoints)> = an allocated structure with pointers on allocated areas in memory. These areas will be read or written if the pointer is associated, if not, the variable will be ignored. It is possible to access to specific dimensions of a variable using the <short_var_name>__kpoint_access or <short_var_name>__spin_access of this @folder structure. The <short_var_name>__number_of_<something> can also been set if only a subpart in one dimension should be accessed (this is possible when the specifications have been declared with a max_number_of_<something>.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_kpoints_get(ncid, folder, lstat, error_data, use_atomic_units)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid
  type(etsf_kpoints), intent(inout) :: folder
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data
  logical, optional, intent(intent) :: use_atomic_units

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_kpoints_get'
  logical :: my_use_atomic_units
  integer,allocatable :: varid(:)
  integer,allocatable :: start(:)
  integer,allocatable :: count(:)
  integer :: len
  character(etsf_charlen) :: flag


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_kpoints_get : enter'
!ENDDEBUG

  ! Get values for optional arguments, set default.
  if (present(use_atomic_units)) then
    my_use_atomic_units = use_atomic_units
  else
    my_use_atomic_units = .true.
  end if
  
  allocate(varid(5))
  
  if (associated(folder%kpoint_grid_shift)) then
    call etsf_io_low_read_var(ncid, "kpoint_grid_shift", &
                            & folder%kpoint_grid_shift, &
                            & lstat, ncvarid = varid(1), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%kpoint_grid_vectors)) then
    call etsf_io_low_read_var(ncid, "kpoint_grid_vectors", &
                            & folder%kpoint_grid_vectors, &
                            & lstat, ncvarid = varid(2), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%monkhorst_pack_folding)) then
    call etsf_io_low_read_var(ncid, "monkhorst_pack_folding", &
                            & folder%monkhorst_pack_folding, &
                            & lstat, ncvarid = varid(3), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%reduced_coordinates_of_kpoints)) then
    call etsf_io_low_read_var(ncid, "reduced_coordinates_of_kpoints", &
                            & folder%reduced_coordinates_of_kpoints, &
                            & lstat, ncvarid = varid(4), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%kpoint_weights)) then
    call etsf_io_low_read_var(ncid, "kpoint_weights", &
                            & folder%kpoint_weights, &
                            & lstat, ncvarid = varid(5), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  deallocate(varid)

!DEBUG
!write (*,*) 'etsf_io_kpoints_get : exit'
!ENDDEBUG

end subroutine etsf_io_kpoints_get
etsf_io-1.0.3/doc/www/group_level/etsf_io_basisdata_get_f90.html0000644000353400050620000007573311354150415021666 00000000000000 ./src/group_level/etsf_io_basisdata_get.f90

TABLE OF CONTENTS

etsf_io_basisdata_get

[ Top ] [ etsf_basisdata ] [ Methods ]

NAME

etsf_io_basisdata_get

FUNCTION

Read an opened ETSF file to get data related to the given group. Only associated pointers of argument @folder will be accessed. If any accessed variable is missing, this routine returns an error (usually an access_mode_id of argument error_data set to ERROR_MODE_INQ). Any other errors implies a return with @lstat = .false..

INPUTS

  • ncid = integer returned by an 'open' NetCDF call. The file can be either in define or write mode. This status can be changed by the call.
  • use_atomic_units = (optional) set this flag to .true. makes the library use the value of the attribute scale_to_atomic_units to multiply the read variables (that are units dependent) by this factor (if different from 1.0d0).

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

SIDE EFFECTS

  • folder <type(etsf_basisdata)> = an allocated structure with pointers on allocated areas in memory. These areas will be read or written if the pointer is associated, if not, the variable will be ignored. It is possible to access to specific dimensions of a variable using the <short_var_name>__kpoint_access or <short_var_name>__spin_access of this @folder structure. The <short_var_name>__number_of_<something> can also been set if only a subpart in one dimension should be accessed (this is possible when the specifications have been declared with a max_number_of_<something>.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_basisdata_get(ncid, folder, lstat, error_data, use_atomic_units)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid
  type(etsf_basisdata), intent(inout) :: folder
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data
  logical, optional, intent(intent) :: use_atomic_units

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_basisdata_get'
  logical :: my_use_atomic_units
  integer,allocatable :: varid(:)
  integer,allocatable :: start(:)
  integer,allocatable :: count(:)
  integer :: len
  character(etsf_charlen) :: flag


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_basisdata_get : enter'
!ENDDEBUG

  ! Get values for optional arguments, set default.
  if (present(use_atomic_units)) then
    my_use_atomic_units = use_atomic_units
  else
    my_use_atomic_units = .true.
  end if
  
  allocate(varid(6))
  
  if (associated(folder%basis_set)) then
    call etsf_io_low_read_var(ncid, "basis_set", &
                            & folder%basis_set, etsf_charlen, &
                            & lstat, ncvarid = varid(1), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%kinetic_energy_cutoff)) then
    call etsf_io_low_read_var(ncid, "kinetic_energy_cutoff", &
                            & folder%kinetic_energy_cutoff, &
                            & lstat, ncvarid = varid(2), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%number_of_coefficients)) then
    ! Handle the k_dependent attribute.
    call etsf_io_low_read_att(ncid, "number_of_coefficients", &
                            & "k_dependent", &
                            & etsf_charlen, flag, &
                            & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    if (flag(1:2) == "no") then
      call etsf_io_low_read_dim(ncid, "max_number_of_coefficients", len, &
                              & lstat, error_data = error_data)
      folder%number_of_coefficients = len
    else
      call etsf_io_low_read_var(ncid, "number_of_coefficients", &
                              & folder%number_of_coefficients, &
                              & lstat, ncvarid = varid(3), &
                              & error_data = error_data)
    end if
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%reduced_coordinates_of_plane_waves)) then
    ! Handle the k_dependent attribute.
    call etsf_io_low_read_att(ncid, "reduced_coordinates_of_plane_waves", &
                            & "k_dependent", &
                            & etsf_charlen, flag, &
                            & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    if (flag(1:2) == "no") then
      allocate(start(2), count(2))
    else
      allocate(start(3), count(3))
    end if
    start(:) = 1
    count(:) = 0
    if (flag(1:3) == "yes" .and. &
      & folder%red_coord_pw__kpoint_access /= etsf_no_sub_access) then
      start(3) = folder%red_coord_pw__kpoint_access
      count(3) = 1
    end if
    count(2) = folder%red_coord_pw__number_of_coefficients
    call etsf_io_low_read_var(ncid, "reduced_coordinates_of_plane_waves", &
                            & folder%reduced_coordinates_of_plane_waves, &
                            & lstat, ncvarid = varid(4), &
                            & error_data = error_data, start = start, count = count)
    deallocate(start, count)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%coordinates_of_basis_grid_points)) then
    allocate(start(3), count(3))
    start(:) = 1
    count(:) = 0
    count(2) = folder%coord_grid__number_of_basis_grid_points
    call etsf_io_low_read_var(ncid, "coordinates_of_basis_grid_points", &
                            & folder%coordinates_of_basis_grid_points, &
                            & lstat, ncvarid = varid(5), &
                            & error_data = error_data, start = start, count = count)
    deallocate(start, count)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%number_of_coefficients_per_grid_point)) then
    allocate(start(2), count(2))
    start(:) = 1
    count(:) = 0
    count(1) = folder%n_coeff_grid__number_of_basis_grid_points
    call etsf_io_low_read_var(ncid, "number_of_coefficients_per_grid_point", &
                            & folder%number_of_coefficients_per_grid_point, &
                            & lstat, ncvarid = varid(6), &
                            & error_data = error_data, start = start, count = count)
    deallocate(start, count)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  ! Handle all attributes for the group.
  if (associated(folder%kinetic_energy_cutoff)) then
    ! Handle the units attribute.
    call etsf_io_low_read_att(ncid, varid(2), &
                            & "units", &
                            & etsf_charlen, folder%kin_cutoff__units, &
                            & lstat, error_data = error_data)
    if (.not. lstat) return
    if (trim(folder%kin_cutoff__units) /= "atomic units") then
      call etsf_io_low_read_att(ncid, varid(2), &
                              & "scale_to_atomic_units", &
                              & folder%kin_cutoff__scale_to_atomic_units, &
                              & lstat, error_data = error_data)
      if (.not. lstat) return
    else
      folder%kin_cutoff__scale_to_atomic_units = 1.0d0
    end if
    if (my_use_atomic_units .and. &
      & folder%kin_cutoff__scale_to_atomic_units /= 1.0d0) then
      folder%kinetic_energy_cutoff = folder%kinetic_energy_cutoff * &
        & folder%kin_cutoff__scale_to_atomic_units
    end if
  end if
  
  
  deallocate(varid)

!DEBUG
!write (*,*) 'etsf_io_basisdata_get : exit'
!ENDDEBUG

end subroutine etsf_io_basisdata_get
etsf_io-1.0.3/doc/www/group_level/etsf_io_gwdata_get_f90.html0000644000353400050620000005525311354150415021175 00000000000000 ./src/group_level/etsf_io_gwdata_get.f90

TABLE OF CONTENTS

etsf_io_gwdata_get

[ Top ] [ etsf_gwdata ] [ Methods ]

NAME

etsf_io_gwdata_get

FUNCTION

Read an opened ETSF file to get data related to the given group. Only associated pointers of argument @folder will be accessed. If any accessed variable is missing, this routine returns an error (usually an access_mode_id of argument error_data set to ERROR_MODE_INQ). Any other errors implies a return with @lstat = .false..

INPUTS

  • ncid = integer returned by an 'open' NetCDF call. The file can be either in define or write mode. This status can be changed by the call.
  • use_atomic_units = (optional) set this flag to .true. makes the library use the value of the attribute scale_to_atomic_units to multiply the read variables (that are units dependent) by this factor (if different from 1.0d0).

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

SIDE EFFECTS

  • folder <type(etsf_gwdata)> = an allocated structure with pointers on allocated areas in memory. These areas will be read or written if the pointer is associated, if not, the variable will be ignored. It is possible to access to specific dimensions of a variable using the <short_var_name>__kpoint_access or <short_var_name>__spin_access of this @folder structure. The <short_var_name>__number_of_<something> can also been set if only a subpart in one dimension should be accessed (this is possible when the specifications have been declared with a max_number_of_<something>.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_gwdata_get(ncid, folder, lstat, error_data, use_atomic_units)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid
  type(etsf_gwdata), intent(inout) :: folder
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data
  logical, optional, intent(intent) :: use_atomic_units

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_gwdata_get'
  logical :: my_use_atomic_units
  integer,allocatable :: varid(:)
  integer,allocatable :: start(:)
  integer,allocatable :: count(:)
  integer :: len
  character(etsf_charlen) :: flag


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_gwdata_get : enter'
!ENDDEBUG

  ! Get values for optional arguments, set default.
  if (present(use_atomic_units)) then
    my_use_atomic_units = use_atomic_units
  else
    my_use_atomic_units = .true.
  end if
  
  allocate(varid(4))
  
  if (etsf_io_low_var_associated(folder%gw_corrections)) then
    allocate(start(4), count(4))
    start(:) = 1
    count(:) = 0
    if (folder%gw_corrections__spin_access /= etsf_no_sub_access) then
      start(4) = folder%gw_corrections__spin_access
      count(4) = 1
    end if
    if (folder%gw_corrections__kpoint_access /= etsf_no_sub_access) then
      start(3) = folder%gw_corrections__kpoint_access
      count(3) = 1
    end if
    count(2) = folder%gw_corrections__number_of_states
    if (folder%gw_corrections__state_access /= etsf_no_sub_access) then
      start(2) = folder%gw_corrections__state_access
      count(2) = 1
    end if
    call etsf_io_low_read_var(ncid, "gw_corrections", &
                            & folder%gw_corrections, &
                            & lstat, ncvarid = varid(1), &
                            & error_data = error_data, start = start, count = count)
    deallocate(start, count)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%kb_formfactor_sign)) then
    allocate(start(3), count(3))
    start(:) = 1
    count(:) = 0
    count(2) = folder%kb_coeff_sig__number_of_angular_momenta
    count(1) = folder%kb_coeff_sig__number_of_projectors
    call etsf_io_low_read_var(ncid, "kb_formfactor_sign", &
                            & folder%kb_formfactor_sign, &
                            & lstat, ncvarid = varid(2), &
                            & error_data = error_data, start = start, count = count)
    deallocate(start, count)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%kb_formfactors)) then
    allocate(start(5), count(5))
    start(:) = 1
    count(:) = 0
    count(4) = folder%kb_coeff__number_of_angular_momenta
    count(3) = folder%kb_coeff__number_of_projectors
    if (folder%kb_coeff__kpoint_access /= etsf_no_sub_access) then
      start(2) = folder%kb_coeff__kpoint_access
      count(2) = 1
    end if
    count(1) = folder%kb_coeff__number_of_coefficients
    call etsf_io_low_read_var(ncid, "kb_formfactors", &
                            & folder%kb_formfactors, &
                            & lstat, ncvarid = varid(3), &
                            & error_data = error_data, start = start, count = count)
    deallocate(start, count)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%kb_formfactor_derivative)) then
    allocate(start(5), count(5))
    start(:) = 1
    count(:) = 0
    count(4) = folder%kb_coeff_der__number_of_angular_momenta
    count(3) = folder%kb_coeff_der__number_of_projectors
    if (folder%kb_coeff_der__kpoint_access /= etsf_no_sub_access) then
      start(2) = folder%kb_coeff_der__kpoint_access
      count(2) = 1
    end if
    count(1) = folder%kb_coeff_der__number_of_coefficients
    call etsf_io_low_read_var(ncid, "kb_formfactor_derivative", &
                            & folder%kb_formfactor_derivative, &
                            & lstat, ncvarid = varid(4), &
                            & error_data = error_data, start = start, count = count)
    deallocate(start, count)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  deallocate(varid)

!DEBUG
!write (*,*) 'etsf_io_gwdata_get : exit'
!ENDDEBUG

end subroutine etsf_io_gwdata_get
etsf_io-1.0.3/doc/www/group_level/etsf_io_dielectric_get_f90.html0000644000353400050620000012374111354150415022033 00000000000000 ./src/group_level/etsf_io_dielectric_get.f90

TABLE OF CONTENTS

etsf_io_dielectric_get

[ Top ] [ etsf_dielectric ] [ Methods ]

NAME

etsf_io_dielectric_get

FUNCTION

Read an opened ETSF file to get data related to the given group. Only associated pointers of argument @folder will be accessed. If any accessed variable is missing, this routine returns an error (usually an access_mode_id of argument error_data set to ERROR_MODE_INQ). Any other errors implies a return with @lstat = .false..

INPUTS

  • ncid = integer returned by an 'open' NetCDF call. The file can be either in define or write mode. This status can be changed by the call.
  • use_atomic_units = (optional) set this flag to .true. makes the library use the value of the attribute scale_to_atomic_units to multiply the read variables (that are units dependent) by this factor (if different from 1.0d0).

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

SIDE EFFECTS

  • folder <type(etsf_dielectric)> = an allocated structure with pointers on allocated areas in memory. These areas will be read or written if the pointer is associated, if not, the variable will be ignored. It is possible to access to specific dimensions of a variable using the <short_var_name>__kpoint_access or <short_var_name>__spin_access of this @folder structure. The <short_var_name>__number_of_<something> can also been set if only a subpart in one dimension should be accessed (this is possible when the specifications have been declared with a max_number_of_<something>.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_dielectric_get(ncid, folder, lstat, error_data, use_atomic_units)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid
  type(etsf_dielectric), intent(inout) :: folder
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data
  logical, optional, intent(intent) :: use_atomic_units

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_dielectric_get'
  logical :: my_use_atomic_units
  integer,allocatable :: varid(:)
  integer,allocatable :: start(:)
  integer,allocatable :: count(:)
  integer :: len
  character(etsf_charlen) :: flag


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_dielectric_get : enter'
!ENDDEBUG

  ! Get values for optional arguments, set default.
  if (present(use_atomic_units)) then
    my_use_atomic_units = use_atomic_units
  else
    my_use_atomic_units = .true.
  end if
  
  allocate(varid(19))
  
  if (associated(folder%frequencies_dielectric_function)) then
    call etsf_io_low_read_var(ncid, "frequencies_dielectric_function", &
                            & folder%frequencies_dielectric_function, &
                            & lstat, ncvarid = varid(1), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%qpoints_dielectric_function)) then
    call etsf_io_low_read_var(ncid, "qpoints_dielectric_function", &
                            & folder%qpoints_dielectric_function, &
                            & lstat, ncvarid = varid(2), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%qpoints_gamma_limit)) then
    call etsf_io_low_read_var(ncid, "qpoints_gamma_limit", &
                            & folder%qpoints_gamma_limit, &
                            & lstat, ncvarid = varid(3), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%dielectric_function)) then
    call etsf_io_low_read_var(ncid, "dielectric_function", &
                            & folder%dielectric_function, &
                            & lstat, ncvarid = varid(4), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%dielectric_function_head)) then
    call etsf_io_low_read_var(ncid, "dielectric_function_head", &
                            & folder%dielectric_function_head, &
                            & lstat, ncvarid = varid(5), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%dielectric_function_lower_wing)) then
    call etsf_io_low_read_var(ncid, "dielectric_function_lower_wing", &
                            & folder%dielectric_function_lower_wing, &
                            & lstat, ncvarid = varid(6), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%dielectric_function_upper_wing)) then
    call etsf_io_low_read_var(ncid, "dielectric_function_upper_wing", &
                            & folder%dielectric_function_upper_wing, &
                            & lstat, ncvarid = varid(7), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%inverse_dielectric_function)) then
    call etsf_io_low_read_var(ncid, "inverse_dielectric_function", &
                            & folder%inverse_dielectric_function, &
                            & lstat, ncvarid = varid(8), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%inverse_dielectric_function_head)) then
    call etsf_io_low_read_var(ncid, "inverse_dielectric_function_head", &
                            & folder%inverse_dielectric_function_head, &
                            & lstat, ncvarid = varid(9), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%inverse_dielectric_function_lower_wing)) then
    call etsf_io_low_read_var(ncid, "inverse_dielectric_function_lower_wing", &
                            & folder%inverse_dielectric_function_lower_wing, &
                            & lstat, ncvarid = varid(10), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%inverse_dielectric_function_upper_wing)) then
    call etsf_io_low_read_var(ncid, "inverse_dielectric_function_upper_wing", &
                            & folder%inverse_dielectric_function_upper_wing, &
                            & lstat, ncvarid = varid(11), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%polarizability)) then
    call etsf_io_low_read_var(ncid, "polarizability", &
                            & folder%polarizability, &
                            & lstat, ncvarid = varid(12), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%polarizability_head)) then
    call etsf_io_low_read_var(ncid, "polarizability_head", &
                            & folder%polarizability_head, &
                            & lstat, ncvarid = varid(13), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%polarizability_lower_wing)) then
    call etsf_io_low_read_var(ncid, "polarizability_lower_wing", &
                            & folder%polarizability_lower_wing, &
                            & lstat, ncvarid = varid(14), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%polarizability_upper_wing)) then
    call etsf_io_low_read_var(ncid, "polarizability_upper_wing", &
                            & folder%polarizability_upper_wing, &
                            & lstat, ncvarid = varid(15), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%inverse_polarizability)) then
    call etsf_io_low_read_var(ncid, "inverse_polarizability", &
                            & folder%inverse_polarizability, &
                            & lstat, ncvarid = varid(16), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%inverse_polarizability_head)) then
    call etsf_io_low_read_var(ncid, "inverse_polarizability_head", &
                            & folder%inverse_polarizability_head, &
                            & lstat, ncvarid = varid(17), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%inverse_polarizability_lower_wing)) then
    call etsf_io_low_read_var(ncid, "inverse_polarizability_lower_wing", &
                            & folder%inverse_polarizability_lower_wing, &
                            & lstat, ncvarid = varid(18), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%inverse_polarizability_upper_wing)) then
    call etsf_io_low_read_var(ncid, "inverse_polarizability_upper_wing", &
                            & folder%inverse_polarizability_upper_wing, &
                            & lstat, ncvarid = varid(19), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  deallocate(varid)

!DEBUG
!write (*,*) 'etsf_io_dielectric_get : exit'
!ENDDEBUG

end subroutine etsf_io_dielectric_get
etsf_io-1.0.3/doc/www/group_level/etsf_io_main_get_f90.html0000644000353400050620000012046311354150414020645 00000000000000 ./src/group_level/etsf_io_main_get.f90

TABLE OF CONTENTS

etsf_io_main_get

[ Top ] [ etsf_main ] [ Methods ]

NAME

etsf_io_main_get

FUNCTION

Read an opened ETSF file to get data related to the given group. Only associated pointers of argument @folder will be accessed. If any accessed variable is missing, this routine returns an error (usually an access_mode_id of argument error_data set to ERROR_MODE_INQ). Any other errors implies a return with @lstat = .false..

INPUTS

  • ncid = integer returned by an 'open' NetCDF call. The file can be either in define or write mode. This status can be changed by the call.
  • use_atomic_units = (optional) set this flag to .true. makes the library use the value of the attribute scale_to_atomic_units to multiply the read variables (that are units dependent) by this factor (if different from 1.0d0).

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

SIDE EFFECTS

  • folder <type(etsf_main)> = an allocated structure with pointers on allocated areas in memory. These areas will be read or written if the pointer is associated, if not, the variable will be ignored. It is possible to access to specific dimensions of a variable using the <short_var_name>__kpoint_access or <short_var_name>__spin_access of this @folder structure. The <short_var_name>__number_of_<something> can also been set if only a subpart in one dimension should be accessed (this is possible when the specifications have been declared with a max_number_of_<something>.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_main_get(ncid, folder, lstat, error_data, use_atomic_units)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid
  type(etsf_main), intent(inout) :: folder
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data
  logical, optional, intent(intent) :: use_atomic_units

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_main_get'
  logical :: my_use_atomic_units
  integer,allocatable :: varid(:)
  integer,allocatable :: start(:)
  integer,allocatable :: count(:)
  integer :: len
  character(etsf_charlen) :: flag


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_main_get : enter'
!ENDDEBUG

  ! Get values for optional arguments, set default.
  if (present(use_atomic_units)) then
    my_use_atomic_units = use_atomic_units
  else
    my_use_atomic_units = .true.
  end if
  
  allocate(varid(6))
  
  if (etsf_io_low_var_associated(folder%density)) then
    call etsf_io_low_read_var(ncid, "density", &
                            & folder%density, &
                            & lstat, ncvarid = varid(1), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%exchange_potential)) then
    call etsf_io_low_read_var(ncid, "exchange_potential", &
                            & folder%exchange_potential, &
                            & lstat, ncvarid = varid(2), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%correlation_potential)) then
    call etsf_io_low_read_var(ncid, "correlation_potential", &
                            & folder%correlation_potential, &
                            & lstat, ncvarid = varid(3), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%exchange_correlation_potential)) then
    call etsf_io_low_read_var(ncid, "exchange_correlation_potential", &
                            & folder%exchange_correlation_potential, &
                            & lstat, ncvarid = varid(4), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%coefficients_of_wavefunctions)) then
    allocate(start(6), count(6))
    start(:) = 1
    count(:) = 0
    if (folder%wfs_coeff__spin_access /= etsf_no_sub_access) then
      start(6) = folder%wfs_coeff__spin_access
      count(6) = 1
    end if
    if (folder%wfs_coeff__kpoint_access /= etsf_no_sub_access) then
      start(5) = folder%wfs_coeff__kpoint_access
      count(5) = 1
    end if
    count(4) = folder%wfs_coeff__number_of_states
    if (folder%wfs_coeff__state_access /= etsf_no_sub_access) then
      start(4) = folder%wfs_coeff__state_access
      count(4) = 1
    end if
    count(2) = folder%wfs_coeff__number_of_coefficients
    call etsf_io_low_read_var(ncid, "coefficients_of_wavefunctions", &
                            & folder%coefficients_of_wavefunctions, &
                            & lstat, ncvarid = varid(5), &
                            & error_data = error_data, start = start, count = count)
    deallocate(start, count)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%real_space_wavefunctions)) then
    allocate(start(8), count(8))
    start(:) = 1
    count(:) = 0
    if (folder%wfs_rsp__spin_access /= etsf_no_sub_access) then
      start(8) = folder%wfs_rsp__spin_access
      count(8) = 1
    end if
    if (folder%wfs_rsp__kpoint_access /= etsf_no_sub_access) then
      start(7) = folder%wfs_rsp__kpoint_access
      count(7) = 1
    end if
    count(6) = folder%wfs_rsp__number_of_states
    if (folder%wfs_rsp__state_access /= etsf_no_sub_access) then
      start(6) = folder%wfs_rsp__state_access
      count(6) = 1
    end if
    call etsf_io_low_read_var(ncid, "real_space_wavefunctions", &
                            & folder%real_space_wavefunctions, &
                            & lstat, ncvarid = varid(6), &
                            & error_data = error_data, start = start, count = count)
    deallocate(start, count)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  ! Handle all attributes for the group.
  if (etsf_io_low_var_associated(folder%density)) then
    ! Handle the units attribute.
    call etsf_io_low_read_att(ncid, varid(1), &
                            & "units", &
                            & etsf_charlen, folder%density__units, &
                            & lstat, error_data = error_data)
    if (.not. lstat) return
    if (trim(folder%density__units) /= "atomic units") then
      call etsf_io_low_read_att(ncid, varid(1), &
                              & "scale_to_atomic_units", &
                              & folder%density__scale_to_atomic_units, &
                              & lstat, error_data = error_data)
      if (.not. lstat) return
    else
      folder%density__scale_to_atomic_units = 1.0d0
    end if
    if (my_use_atomic_units .and. &
      & folder%density__scale_to_atomic_units /= 1.0d0) then
      call etsf_io_low_var_multiply(folder%density, &
                                  & folder%density__scale_to_atomic_units)
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%exchange_potential)) then
    ! Handle the units attribute.
    call etsf_io_low_read_att(ncid, varid(2), &
                            & "units", &
                            & etsf_charlen, folder%pot_x_only__units, &
                            & lstat, error_data = error_data)
    if (.not. lstat) return
    if (trim(folder%pot_x_only__units) /= "atomic units") then
      call etsf_io_low_read_att(ncid, varid(2), &
                              & "scale_to_atomic_units", &
                              & folder%pot_x_only__scale_to_atomic_units, &
                              & lstat, error_data = error_data)
      if (.not. lstat) return
    else
      folder%pot_x_only__scale_to_atomic_units = 1.0d0
    end if
    if (my_use_atomic_units .and. &
      & folder%pot_x_only__scale_to_atomic_units /= 1.0d0) then
      call etsf_io_low_var_multiply(folder%exchange_potential, &
                                  & folder%pot_x_only__scale_to_atomic_units)
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%correlation_potential)) then
    ! Handle the units attribute.
    call etsf_io_low_read_att(ncid, varid(3), &
                            & "units", &
                            & etsf_charlen, folder%pot_c_only__units, &
                            & lstat, error_data = error_data)
    if (.not. lstat) return
    if (trim(folder%pot_c_only__units) /= "atomic units") then
      call etsf_io_low_read_att(ncid, varid(3), &
                              & "scale_to_atomic_units", &
                              & folder%pot_c_only__scale_to_atomic_units, &
                              & lstat, error_data = error_data)
      if (.not. lstat) return
    else
      folder%pot_c_only__scale_to_atomic_units = 1.0d0
    end if
    if (my_use_atomic_units .and. &
      & folder%pot_c_only__scale_to_atomic_units /= 1.0d0) then
      call etsf_io_low_var_multiply(folder%correlation_potential, &
                                  & folder%pot_c_only__scale_to_atomic_units)
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%exchange_correlation_potential)) then
    ! Handle the units attribute.
    call etsf_io_low_read_att(ncid, varid(4), &
                            & "units", &
                            & etsf_charlen, folder%pot_xc__units, &
                            & lstat, error_data = error_data)
    if (.not. lstat) return
    if (trim(folder%pot_xc__units) /= "atomic units") then
      call etsf_io_low_read_att(ncid, varid(4), &
                              & "scale_to_atomic_units", &
                              & folder%pot_xc__scale_to_atomic_units, &
                              & lstat, error_data = error_data)
      if (.not. lstat) return
    else
      folder%pot_xc__scale_to_atomic_units = 1.0d0
    end if
    if (my_use_atomic_units .and. &
      & folder%pot_xc__scale_to_atomic_units /= 1.0d0) then
      call etsf_io_low_var_multiply(folder%exchange_correlation_potential, &
                                  & folder%pot_xc__scale_to_atomic_units)
    end if
  end if
  
  
  deallocate(varid)

!DEBUG
!write (*,*) 'etsf_io_main_get : exit'
!ENDDEBUG

end subroutine etsf_io_main_get
etsf_io-1.0.3/doc/www/group_level/etsf_io_geometry_put_f90.html0000644000353400050620000007643711354150415021621 00000000000000 ./src/group_level/etsf_io_geometry_put.f90

TABLE OF CONTENTS

etsf_io_geometry_put

[ Top ] [ etsf_geometry ] [ Methods ]

NAME

etsf_io_geometry_put

FUNCTION

Write data related to the given group in an opened ETSF file (it must be in write mode, use etsf_io_low_set_write_mode() to change it). Only associated pointers of argument @folder will be accessed. If any errors occurs it returns with @lstat = .false..

INPUTS

  • ncid = integer returned by an 'open' NetCDF call. The file can be either in define or write mode. This status can be changed by the call.
  • folder <type(etsf_geometry)> = an allocated structure with pointers on allocated areas in memory. These areas will be read or written if the pointer is associated, if not, the variable will be ignored. It is possible to access to specific dimensions of a variable using the <short_var_name>__kpoint_access or <short_var_name>__spin_access of this @folder structure. The <short_var_name>__number_of_<something> can also been set if only a subpart in one dimension should be accessed (this is possible when the specifications have been declared with a max_number_of_<something>.

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_geometry_put(ncid, folder, lstat, error_data)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid
  type(etsf_geometry), intent(intent) :: folder
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_geometry_put'
  integer,allocatable :: varid(:)
  integer,allocatable :: start(:)
  integer,allocatable :: count(:)
  integer :: len
  character(etsf_charlen) :: flag


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_geometry_put : enter'
!ENDDEBUG

  
  allocate(varid(11))
  ! Begin by putting the file in write mode.
  call etsf_io_low_set_write_mode(ncid, lstat, error_data = error_data)
  if (.not. lstat) then
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  
  if (associated(folder%space_group)) then
    call etsf_io_low_write_var(ncid, "space_group", &
                            & folder%space_group, &
                            & lstat, ncvarid = varid(1), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%primitive_vectors)) then
    call etsf_io_low_write_var(ncid, "primitive_vectors", &
                            & folder%primitive_vectors, &
                            & lstat, ncvarid = varid(2), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%reduced_symmetry_matrices)) then
    call etsf_io_low_write_var(ncid, "reduced_symmetry_matrices", &
                            & folder%reduced_symmetry_matrices, &
                            & lstat, ncvarid = varid(3), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%reduced_symmetry_translations)) then
    call etsf_io_low_write_var(ncid, "reduced_symmetry_translations", &
                            & folder%reduced_symmetry_translations, &
                            & lstat, ncvarid = varid(4), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%atom_species)) then
    call etsf_io_low_write_var(ncid, "atom_species", &
                            & folder%atom_species, &
                            & lstat, ncvarid = varid(5), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%reduced_atom_positions)) then
    call etsf_io_low_write_var(ncid, "reduced_atom_positions", &
                            & folder%reduced_atom_positions, &
                            & lstat, ncvarid = varid(6), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%valence_charges)) then
    call etsf_io_low_write_var(ncid, "valence_charges", &
                            & folder%valence_charges, &
                            & lstat, ncvarid = varid(7), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%atomic_numbers)) then
    call etsf_io_low_write_var(ncid, "atomic_numbers", &
                            & folder%atomic_numbers, &
                            & lstat, ncvarid = varid(8), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%atom_species_names)) then
    call etsf_io_low_write_var(ncid, "atom_species_names", &
                            & folder%atom_species_names, etsf_charlen, &
                            & lstat, ncvarid = varid(9), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%chemical_symbols)) then
    call etsf_io_low_write_var(ncid, "chemical_symbols", &
                            & folder%chemical_symbols, etsf_chemlen, &
                            & lstat, ncvarid = varid(10), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%pseudopotential_types)) then
    call etsf_io_low_write_var(ncid, "pseudopotential_types", &
                            & folder%pseudopotential_types, etsf_charlen, &
                            & lstat, ncvarid = varid(11), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  ! Handle all attributes for the group.
  call etsf_io_low_set_define_mode(ncid, lstat, error_data = error_data)
  if (.not. lstat) then
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  if (associated(folder%reduced_symmetry_translations)) then
    ! Handle the symmorphic attribute.
    ! We test if translations are not nul
    flag = "yes"
    do len = 1, size(folder%reduced_symmetry_translations, 2), 1
      if (folder%reduced_symmetry_translations(1, len) /= 0.d0 .or. &
        & folder%reduced_symmetry_translations(2, len) /= 0.d0 .or. &
        & folder%reduced_symmetry_translations(3, len) /= 0.d0) then
      flag = "no"
      end if
    end do
    call etsf_io_low_write_att(ncid, varid(3), &
                            & "symmorphic", &
                            & trim(flag), &
                            & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  
  deallocate(varid)

!DEBUG
!write (*,*) 'etsf_io_geometry_put : exit'
!ENDDEBUG

end subroutine etsf_io_geometry_put
etsf_io-1.0.3/doc/www/group_level/etsf_io_electrons_put_f90.html0000644000353400050620000007121311354150415021747 00000000000000 ./src/group_level/etsf_io_electrons_put.f90

TABLE OF CONTENTS

etsf_io_electrons_put

[ Top ] [ etsf_electrons ] [ Methods ]

NAME

etsf_io_electrons_put

FUNCTION

Write data related to the given group in an opened ETSF file (it must be in write mode, use etsf_io_low_set_write_mode() to change it). Only associated pointers of argument @folder will be accessed. If any errors occurs it returns with @lstat = .false..

INPUTS

  • ncid = integer returned by an 'open' NetCDF call. The file can be either in define or write mode. This status can be changed by the call.
  • folder <type(etsf_electrons)> = an allocated structure with pointers on allocated areas in memory. These areas will be read or written if the pointer is associated, if not, the variable will be ignored. It is possible to access to specific dimensions of a variable using the <short_var_name>__kpoint_access or <short_var_name>__spin_access of this @folder structure. The <short_var_name>__number_of_<something> can also been set if only a subpart in one dimension should be accessed (this is possible when the specifications have been declared with a max_number_of_<something>.

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_electrons_put(ncid, folder, lstat, error_data)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid
  type(etsf_electrons), intent(intent) :: folder
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_electrons_put'
  integer,allocatable :: varid(:)
  integer,allocatable :: start(:)
  integer,allocatable :: count(:)
  integer :: len
  character(etsf_charlen) :: flag


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_electrons_put : enter'
!ENDDEBUG

  
  allocate(varid(9))
  ! Begin by putting the file in write mode.
  call etsf_io_low_set_write_mode(ncid, lstat, error_data = error_data)
  if (.not. lstat) then
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  
  if (associated(folder%number_of_electrons)) then
    call etsf_io_low_write_var(ncid, "number_of_electrons", &
                            & folder%number_of_electrons, &
                            & lstat, ncvarid = varid(1), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%exchange_functional)) then
    call etsf_io_low_write_var(ncid, "exchange_functional", &
                            & folder%exchange_functional, etsf_charlen, &
                            & lstat, ncvarid = varid(2), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%correlation_functional)) then
    call etsf_io_low_write_var(ncid, "correlation_functional", &
                            & folder%correlation_functional, etsf_charlen, &
                            & lstat, ncvarid = varid(3), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%fermi_energy)) then
    call etsf_io_low_write_var(ncid, "fermi_energy", &
                            & folder%fermi_energy, &
                            & lstat, ncvarid = varid(4), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%smearing_scheme)) then
    call etsf_io_low_write_var(ncid, "smearing_scheme", &
                            & folder%smearing_scheme, etsf_charlen, &
                            & lstat, ncvarid = varid(5), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%smearing_width)) then
    call etsf_io_low_write_var(ncid, "smearing_width", &
                            & folder%smearing_width, &
                            & lstat, ncvarid = varid(6), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%number_of_states)) then
    call etsf_io_low_write_var(ncid, "number_of_states", &
                            & folder%number_of_states, &
                            & lstat, ncvarid = varid(7), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%eigenvalues)) then
    allocate(start(3), count(3))
    start(:) = 1
    count(:) = 0
    if (folder%eigenvalues__spin_access /= etsf_no_sub_access) then
      start(3) = folder%eigenvalues__spin_access
      count(3) = 1
    end if
    if (folder%eigenvalues__kpoint_access /= etsf_no_sub_access) then
      start(2) = folder%eigenvalues__kpoint_access
      count(2) = 1
    end if
    count(1) = folder%eigenvalues__number_of_states
    if (folder%eigenvalues__state_access /= etsf_no_sub_access) then
      start(1) = folder%eigenvalues__state_access
      count(1) = 1
    end if
    call etsf_io_low_write_var(ncid, "eigenvalues", &
                            & folder%eigenvalues, &
                            & lstat, ncvarid = varid(8), &
                            & error_data = error_data, start = start, count = count)
    deallocate(start, count)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%occupations)) then
    allocate(start(3), count(3))
    start(:) = 1
    count(:) = 0
    if (folder%occupations__spin_access /= etsf_no_sub_access) then
      start(3) = folder%occupations__spin_access
      count(3) = 1
    end if
    if (folder%occupations__kpoint_access /= etsf_no_sub_access) then
      start(2) = folder%occupations__kpoint_access
      count(2) = 1
    end if
    count(1) = folder%occupations__number_of_states
    if (folder%occupations__state_access /= etsf_no_sub_access) then
      start(1) = folder%occupations__state_access
      count(1) = 1
    end if
    call etsf_io_low_write_var(ncid, "occupations", &
                            & folder%occupations, &
                            & lstat, ncvarid = varid(9), &
                            & error_data = error_data, start = start, count = count)
    deallocate(start, count)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  deallocate(varid)

!DEBUG
!write (*,*) 'etsf_io_electrons_put : exit'
!ENDDEBUG

end subroutine etsf_io_electrons_put
etsf_io-1.0.3/doc/www/group_level/etsf_io_kpoints_put_f90.html0000644000353400050620000004102511354150415021436 00000000000000 ./src/group_level/etsf_io_kpoints_put.f90

TABLE OF CONTENTS

etsf_io_kpoints_put

[ Top ] [ etsf_kpoints ] [ Methods ]

NAME

etsf_io_kpoints_put

FUNCTION

Write data related to the given group in an opened ETSF file (it must be in write mode, use etsf_io_low_set_write_mode() to change it). Only associated pointers of argument @folder will be accessed. If any errors occurs it returns with @lstat = .false..

INPUTS

  • ncid = integer returned by an 'open' NetCDF call. The file can be either in define or write mode. This status can be changed by the call.
  • folder <type(etsf_kpoints)> = an allocated structure with pointers on allocated areas in memory. These areas will be read or written if the pointer is associated, if not, the variable will be ignored. It is possible to access to specific dimensions of a variable using the <short_var_name>__kpoint_access or <short_var_name>__spin_access of this @folder structure. The <short_var_name>__number_of_<something> can also been set if only a subpart in one dimension should be accessed (this is possible when the specifications have been declared with a max_number_of_<something>.

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_kpoints_put(ncid, folder, lstat, error_data)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid
  type(etsf_kpoints), intent(intent) :: folder
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_kpoints_put'
  integer,allocatable :: varid(:)
  integer,allocatable :: start(:)
  integer,allocatable :: count(:)
  integer :: len
  character(etsf_charlen) :: flag


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_kpoints_put : enter'
!ENDDEBUG

  
  allocate(varid(5))
  ! Begin by putting the file in write mode.
  call etsf_io_low_set_write_mode(ncid, lstat, error_data = error_data)
  if (.not. lstat) then
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  
  if (associated(folder%kpoint_grid_shift)) then
    call etsf_io_low_write_var(ncid, "kpoint_grid_shift", &
                            & folder%kpoint_grid_shift, &
                            & lstat, ncvarid = varid(1), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%kpoint_grid_vectors)) then
    call etsf_io_low_write_var(ncid, "kpoint_grid_vectors", &
                            & folder%kpoint_grid_vectors, &
                            & lstat, ncvarid = varid(2), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%monkhorst_pack_folding)) then
    call etsf_io_low_write_var(ncid, "monkhorst_pack_folding", &
                            & folder%monkhorst_pack_folding, &
                            & lstat, ncvarid = varid(3), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%reduced_coordinates_of_kpoints)) then
    call etsf_io_low_write_var(ncid, "reduced_coordinates_of_kpoints", &
                            & folder%reduced_coordinates_of_kpoints, &
                            & lstat, ncvarid = varid(4), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%kpoint_weights)) then
    call etsf_io_low_write_var(ncid, "kpoint_weights", &
                            & folder%kpoint_weights, &
                            & lstat, ncvarid = varid(5), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  deallocate(varid)

!DEBUG
!write (*,*) 'etsf_io_kpoints_put : exit'
!ENDDEBUG

end subroutine etsf_io_kpoints_put
etsf_io-1.0.3/doc/www/group_level/etsf_io_basisdata_put_f90.html0000644000353400050620000006021311354150415021702 00000000000000 ./src/group_level/etsf_io_basisdata_put.f90

TABLE OF CONTENTS

etsf_io_basisdata_put

[ Top ] [ etsf_basisdata ] [ Methods ]

NAME

etsf_io_basisdata_put

FUNCTION

Write data related to the given group in an opened ETSF file (it must be in write mode, use etsf_io_low_set_write_mode() to change it). Only associated pointers of argument @folder will be accessed. If any errors occurs it returns with @lstat = .false..

INPUTS

  • ncid = integer returned by an 'open' NetCDF call. The file can be either in define or write mode. This status can be changed by the call.
  • folder <type(etsf_basisdata)> = an allocated structure with pointers on allocated areas in memory. These areas will be read or written if the pointer is associated, if not, the variable will be ignored. It is possible to access to specific dimensions of a variable using the <short_var_name>__kpoint_access or <short_var_name>__spin_access of this @folder structure. The <short_var_name>__number_of_<something> can also been set if only a subpart in one dimension should be accessed (this is possible when the specifications have been declared with a max_number_of_<something>.

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_basisdata_put(ncid, folder, lstat, error_data)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid
  type(etsf_basisdata), intent(intent) :: folder
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_basisdata_put'
  integer,allocatable :: varid(:)
  integer,allocatable :: start(:)
  integer,allocatable :: count(:)
  integer :: len
  character(etsf_charlen) :: flag


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_basisdata_put : enter'
!ENDDEBUG

  
  allocate(varid(6))
  ! Begin by putting the file in write mode.
  call etsf_io_low_set_write_mode(ncid, lstat, error_data = error_data)
  if (.not. lstat) then
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  
  if (associated(folder%basis_set)) then
    call etsf_io_low_write_var(ncid, "basis_set", &
                            & folder%basis_set, etsf_charlen, &
                            & lstat, ncvarid = varid(1), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%kinetic_energy_cutoff)) then
    call etsf_io_low_write_var(ncid, "kinetic_energy_cutoff", &
                            & folder%kinetic_energy_cutoff, &
                            & lstat, ncvarid = varid(2), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%number_of_coefficients)) then
    call etsf_io_low_write_var(ncid, "number_of_coefficients", &
                            & folder%number_of_coefficients, &
                            & lstat, ncvarid = varid(3), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%reduced_coordinates_of_plane_waves)) then
    ! Handle the k_dependent attribute.
    call etsf_io_low_read_att(ncid, "reduced_coordinates_of_plane_waves", &
                            & "k_dependent", &
                            & etsf_charlen, flag, &
                            & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    if (flag(1:2) == "no") then
      allocate(start(2), count(2))
    else
      allocate(start(3), count(3))
    end if
    start(:) = 1
    count(:) = 0
    if (flag(1:3) == "yes" .and. &
      & folder%red_coord_pw__kpoint_access /= etsf_no_sub_access) then
      start(3) = folder%red_coord_pw__kpoint_access
      count(3) = 1
    end if
    count(2) = folder%red_coord_pw__number_of_coefficients
    call etsf_io_low_write_var(ncid, "reduced_coordinates_of_plane_waves", &
                            & folder%reduced_coordinates_of_plane_waves, &
                            & lstat, ncvarid = varid(4), &
                            & error_data = error_data, start = start, count = count)
    deallocate(start, count)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%coordinates_of_basis_grid_points)) then
    allocate(start(3), count(3))
    start(:) = 1
    count(:) = 0
    count(2) = folder%coord_grid__number_of_basis_grid_points
    call etsf_io_low_write_var(ncid, "coordinates_of_basis_grid_points", &
                            & folder%coordinates_of_basis_grid_points, &
                            & lstat, ncvarid = varid(5), &
                            & error_data = error_data, start = start, count = count)
    deallocate(start, count)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%number_of_coefficients_per_grid_point)) then
    allocate(start(2), count(2))
    start(:) = 1
    count(:) = 0
    count(1) = folder%n_coeff_grid__number_of_basis_grid_points
    call etsf_io_low_write_var(ncid, "number_of_coefficients_per_grid_point", &
                            & folder%number_of_coefficients_per_grid_point, &
                            & lstat, ncvarid = varid(6), &
                            & error_data = error_data, start = start, count = count)
    deallocate(start, count)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  deallocate(varid)

!DEBUG
!write (*,*) 'etsf_io_basisdata_put : exit'
!ENDDEBUG

end subroutine etsf_io_basisdata_put
etsf_io-1.0.3/doc/www/group_level/etsf_io_gwdata_put_f90.html0000644000353400050620000005425011354150415021222 00000000000000 ./src/group_level/etsf_io_gwdata_put.f90

TABLE OF CONTENTS

etsf_io_gwdata_put

[ Top ] [ etsf_gwdata ] [ Methods ]

NAME

etsf_io_gwdata_put

FUNCTION

Write data related to the given group in an opened ETSF file (it must be in write mode, use etsf_io_low_set_write_mode() to change it). Only associated pointers of argument @folder will be accessed. If any errors occurs it returns with @lstat = .false..

INPUTS

  • ncid = integer returned by an 'open' NetCDF call. The file can be either in define or write mode. This status can be changed by the call.
  • folder <type(etsf_gwdata)> = an allocated structure with pointers on allocated areas in memory. These areas will be read or written if the pointer is associated, if not, the variable will be ignored. It is possible to access to specific dimensions of a variable using the <short_var_name>__kpoint_access or <short_var_name>__spin_access of this @folder structure. The <short_var_name>__number_of_<something> can also been set if only a subpart in one dimension should be accessed (this is possible when the specifications have been declared with a max_number_of_<something>.

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_gwdata_put(ncid, folder, lstat, error_data)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid
  type(etsf_gwdata), intent(intent) :: folder
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_gwdata_put'
  integer,allocatable :: varid(:)
  integer,allocatable :: start(:)
  integer,allocatable :: count(:)
  integer :: len
  character(etsf_charlen) :: flag


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_gwdata_put : enter'
!ENDDEBUG

  
  allocate(varid(4))
  ! Begin by putting the file in write mode.
  call etsf_io_low_set_write_mode(ncid, lstat, error_data = error_data)
  if (.not. lstat) then
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  
  if (etsf_io_low_var_associated(folder%gw_corrections)) then
    allocate(start(4), count(4))
    start(:) = 1
    count(:) = 0
    if (folder%gw_corrections__spin_access /= etsf_no_sub_access) then
      start(4) = folder%gw_corrections__spin_access
      count(4) = 1
    end if
    if (folder%gw_corrections__kpoint_access /= etsf_no_sub_access) then
      start(3) = folder%gw_corrections__kpoint_access
      count(3) = 1
    end if
    count(2) = folder%gw_corrections__number_of_states
    if (folder%gw_corrections__state_access /= etsf_no_sub_access) then
      start(2) = folder%gw_corrections__state_access
      count(2) = 1
    end if
    call etsf_io_low_write_var(ncid, "gw_corrections", &
                            & folder%gw_corrections, &
                            & lstat, ncvarid = varid(1), &
                            & error_data = error_data, start = start, count = count)
    deallocate(start, count)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%kb_formfactor_sign)) then
    allocate(start(3), count(3))
    start(:) = 1
    count(:) = 0
    count(2) = folder%kb_coeff_sig__number_of_angular_momenta
    count(1) = folder%kb_coeff_sig__number_of_projectors
    call etsf_io_low_write_var(ncid, "kb_formfactor_sign", &
                            & folder%kb_formfactor_sign, &
                            & lstat, ncvarid = varid(2), &
                            & error_data = error_data, start = start, count = count)
    deallocate(start, count)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%kb_formfactors)) then
    allocate(start(5), count(5))
    start(:) = 1
    count(:) = 0
    count(4) = folder%kb_coeff__number_of_angular_momenta
    count(3) = folder%kb_coeff__number_of_projectors
    if (folder%kb_coeff__kpoint_access /= etsf_no_sub_access) then
      start(2) = folder%kb_coeff__kpoint_access
      count(2) = 1
    end if
    count(1) = folder%kb_coeff__number_of_coefficients
    call etsf_io_low_write_var(ncid, "kb_formfactors", &
                            & folder%kb_formfactors, &
                            & lstat, ncvarid = varid(3), &
                            & error_data = error_data, start = start, count = count)
    deallocate(start, count)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%kb_formfactor_derivative)) then
    allocate(start(5), count(5))
    start(:) = 1
    count(:) = 0
    count(4) = folder%kb_coeff_der__number_of_angular_momenta
    count(3) = folder%kb_coeff_der__number_of_projectors
    if (folder%kb_coeff_der__kpoint_access /= etsf_no_sub_access) then
      start(2) = folder%kb_coeff_der__kpoint_access
      count(2) = 1
    end if
    count(1) = folder%kb_coeff_der__number_of_coefficients
    call etsf_io_low_write_var(ncid, "kb_formfactor_derivative", &
                            & folder%kb_formfactor_derivative, &
                            & lstat, ncvarid = varid(4), &
                            & error_data = error_data, start = start, count = count)
    deallocate(start, count)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  deallocate(varid)

!DEBUG
!write (*,*) 'etsf_io_gwdata_put : exit'
!ENDDEBUG

end subroutine etsf_io_gwdata_put
etsf_io-1.0.3/doc/www/group_level/etsf_io_dielectric_put_f90.html0000644000353400050620000012275511354150415022070 00000000000000 ./src/group_level/etsf_io_dielectric_put.f90

TABLE OF CONTENTS

etsf_io_dielectric_put

[ Top ] [ etsf_dielectric ] [ Methods ]

NAME

etsf_io_dielectric_put

FUNCTION

Write data related to the given group in an opened ETSF file (it must be in write mode, use etsf_io_low_set_write_mode() to change it). Only associated pointers of argument @folder will be accessed. If any errors occurs it returns with @lstat = .false..

INPUTS

  • ncid = integer returned by an 'open' NetCDF call. The file can be either in define or write mode. This status can be changed by the call.
  • folder <type(etsf_dielectric)> = an allocated structure with pointers on allocated areas in memory. These areas will be read or written if the pointer is associated, if not, the variable will be ignored. It is possible to access to specific dimensions of a variable using the <short_var_name>__kpoint_access or <short_var_name>__spin_access of this @folder structure. The <short_var_name>__number_of_<something> can also been set if only a subpart in one dimension should be accessed (this is possible when the specifications have been declared with a max_number_of_<something>.

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_dielectric_put(ncid, folder, lstat, error_data)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid
  type(etsf_dielectric), intent(intent) :: folder
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_dielectric_put'
  integer,allocatable :: varid(:)
  integer,allocatable :: start(:)
  integer,allocatable :: count(:)
  integer :: len
  character(etsf_charlen) :: flag


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_dielectric_put : enter'
!ENDDEBUG

  
  allocate(varid(19))
  ! Begin by putting the file in write mode.
  call etsf_io_low_set_write_mode(ncid, lstat, error_data = error_data)
  if (.not. lstat) then
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  
  if (associated(folder%frequencies_dielectric_function)) then
    call etsf_io_low_write_var(ncid, "frequencies_dielectric_function", &
                            & folder%frequencies_dielectric_function, &
                            & lstat, ncvarid = varid(1), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%qpoints_dielectric_function)) then
    call etsf_io_low_write_var(ncid, "qpoints_dielectric_function", &
                            & folder%qpoints_dielectric_function, &
                            & lstat, ncvarid = varid(2), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (associated(folder%qpoints_gamma_limit)) then
    call etsf_io_low_write_var(ncid, "qpoints_gamma_limit", &
                            & folder%qpoints_gamma_limit, &
                            & lstat, ncvarid = varid(3), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%dielectric_function)) then
    call etsf_io_low_write_var(ncid, "dielectric_function", &
                            & folder%dielectric_function, &
                            & lstat, ncvarid = varid(4), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%dielectric_function_head)) then
    call etsf_io_low_write_var(ncid, "dielectric_function_head", &
                            & folder%dielectric_function_head, &
                            & lstat, ncvarid = varid(5), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%dielectric_function_lower_wing)) then
    call etsf_io_low_write_var(ncid, "dielectric_function_lower_wing", &
                            & folder%dielectric_function_lower_wing, &
                            & lstat, ncvarid = varid(6), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%dielectric_function_upper_wing)) then
    call etsf_io_low_write_var(ncid, "dielectric_function_upper_wing", &
                            & folder%dielectric_function_upper_wing, &
                            & lstat, ncvarid = varid(7), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%inverse_dielectric_function)) then
    call etsf_io_low_write_var(ncid, "inverse_dielectric_function", &
                            & folder%inverse_dielectric_function, &
                            & lstat, ncvarid = varid(8), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%inverse_dielectric_function_head)) then
    call etsf_io_low_write_var(ncid, "inverse_dielectric_function_head", &
                            & folder%inverse_dielectric_function_head, &
                            & lstat, ncvarid = varid(9), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%inverse_dielectric_function_lower_wing)) then
    call etsf_io_low_write_var(ncid, "inverse_dielectric_function_lower_wing", &
                            & folder%inverse_dielectric_function_lower_wing, &
                            & lstat, ncvarid = varid(10), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%inverse_dielectric_function_upper_wing)) then
    call etsf_io_low_write_var(ncid, "inverse_dielectric_function_upper_wing", &
                            & folder%inverse_dielectric_function_upper_wing, &
                            & lstat, ncvarid = varid(11), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%polarizability)) then
    call etsf_io_low_write_var(ncid, "polarizability", &
                            & folder%polarizability, &
                            & lstat, ncvarid = varid(12), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%polarizability_head)) then
    call etsf_io_low_write_var(ncid, "polarizability_head", &
                            & folder%polarizability_head, &
                            & lstat, ncvarid = varid(13), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%polarizability_lower_wing)) then
    call etsf_io_low_write_var(ncid, "polarizability_lower_wing", &
                            & folder%polarizability_lower_wing, &
                            & lstat, ncvarid = varid(14), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%polarizability_upper_wing)) then
    call etsf_io_low_write_var(ncid, "polarizability_upper_wing", &
                            & folder%polarizability_upper_wing, &
                            & lstat, ncvarid = varid(15), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%inverse_polarizability)) then
    call etsf_io_low_write_var(ncid, "inverse_polarizability", &
                            & folder%inverse_polarizability, &
                            & lstat, ncvarid = varid(16), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%inverse_polarizability_head)) then
    call etsf_io_low_write_var(ncid, "inverse_polarizability_head", &
                            & folder%inverse_polarizability_head, &
                            & lstat, ncvarid = varid(17), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%inverse_polarizability_lower_wing)) then
    call etsf_io_low_write_var(ncid, "inverse_polarizability_lower_wing", &
                            & folder%inverse_polarizability_lower_wing, &
                            & lstat, ncvarid = varid(18), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%inverse_polarizability_upper_wing)) then
    call etsf_io_low_write_var(ncid, "inverse_polarizability_upper_wing", &
                            & folder%inverse_polarizability_upper_wing, &
                            & lstat, ncvarid = varid(19), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  deallocate(varid)

!DEBUG
!write (*,*) 'etsf_io_dielectric_put : exit'
!ENDDEBUG

end subroutine etsf_io_dielectric_put
etsf_io-1.0.3/doc/www/group_level/etsf_io_main_put_f90.html0000644000353400050620000005740311354150414020701 00000000000000 ./src/group_level/etsf_io_main_put.f90

TABLE OF CONTENTS

etsf_io_main_put

[ Top ] [ etsf_main ] [ Methods ]

NAME

etsf_io_main_put

FUNCTION

Write data related to the given group in an opened ETSF file (it must be in write mode, use etsf_io_low_set_write_mode() to change it). Only associated pointers of argument @folder will be accessed. If any errors occurs it returns with @lstat = .false..

INPUTS

  • ncid = integer returned by an 'open' NetCDF call. The file can be either in define or write mode. This status can be changed by the call.
  • folder <type(etsf_main)> = an allocated structure with pointers on allocated areas in memory. These areas will be read or written if the pointer is associated, if not, the variable will be ignored. It is possible to access to specific dimensions of a variable using the <short_var_name>__kpoint_access or <short_var_name>__spin_access of this @folder structure. The <short_var_name>__number_of_<something> can also been set if only a subpart in one dimension should be accessed (this is possible when the specifications have been declared with a max_number_of_<something>.

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_main_put(ncid, folder, lstat, error_data)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid
  type(etsf_main), intent(intent) :: folder
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_main_put'
  integer,allocatable :: varid(:)
  integer,allocatable :: start(:)
  integer,allocatable :: count(:)
  integer :: len
  character(etsf_charlen) :: flag


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_main_put : enter'
!ENDDEBUG

  
  allocate(varid(6))
  ! Begin by putting the file in write mode.
  call etsf_io_low_set_write_mode(ncid, lstat, error_data = error_data)
  if (.not. lstat) then
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  
  if (etsf_io_low_var_associated(folder%density)) then
    call etsf_io_low_write_var(ncid, "density", &
                            & folder%density, &
                            & lstat, ncvarid = varid(1), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%exchange_potential)) then
    call etsf_io_low_write_var(ncid, "exchange_potential", &
                            & folder%exchange_potential, &
                            & lstat, ncvarid = varid(2), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%correlation_potential)) then
    call etsf_io_low_write_var(ncid, "correlation_potential", &
                            & folder%correlation_potential, &
                            & lstat, ncvarid = varid(3), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%exchange_correlation_potential)) then
    call etsf_io_low_write_var(ncid, "exchange_correlation_potential", &
                            & folder%exchange_correlation_potential, &
                            & lstat, ncvarid = varid(4), &
                            & error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%coefficients_of_wavefunctions)) then
    allocate(start(6), count(6))
    start(:) = 1
    count(:) = 0
    if (folder%wfs_coeff__spin_access /= etsf_no_sub_access) then
      start(6) = folder%wfs_coeff__spin_access
      count(6) = 1
    end if
    if (folder%wfs_coeff__kpoint_access /= etsf_no_sub_access) then
      start(5) = folder%wfs_coeff__kpoint_access
      count(5) = 1
    end if
    count(4) = folder%wfs_coeff__number_of_states
    if (folder%wfs_coeff__state_access /= etsf_no_sub_access) then
      start(4) = folder%wfs_coeff__state_access
      count(4) = 1
    end if
    count(2) = folder%wfs_coeff__number_of_coefficients
    call etsf_io_low_write_var(ncid, "coefficients_of_wavefunctions", &
                            & folder%coefficients_of_wavefunctions, &
                            & lstat, ncvarid = varid(5), &
                            & error_data = error_data, start = start, count = count)
    deallocate(start, count)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  if (etsf_io_low_var_associated(folder%real_space_wavefunctions)) then
    allocate(start(8), count(8))
    start(:) = 1
    count(:) = 0
    if (folder%wfs_rsp__spin_access /= etsf_no_sub_access) then
      start(8) = folder%wfs_rsp__spin_access
      count(8) = 1
    end if
    if (folder%wfs_rsp__kpoint_access /= etsf_no_sub_access) then
      start(7) = folder%wfs_rsp__kpoint_access
      count(7) = 1
    end if
    count(6) = folder%wfs_rsp__number_of_states
    if (folder%wfs_rsp__state_access /= etsf_no_sub_access) then
      start(6) = folder%wfs_rsp__state_access
      count(6) = 1
    end if
    call etsf_io_low_write_var(ncid, "real_space_wavefunctions", &
                            & folder%real_space_wavefunctions, &
                            & lstat, ncvarid = varid(6), &
                            & error_data = error_data, start = start, count = count)
    deallocate(start, count)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  deallocate(varid)

!DEBUG
!write (*,*) 'etsf_io_main_put : exit'
!ENDDEBUG

end subroutine etsf_io_main_put
etsf_io-1.0.3/doc/www/group_level/etsf_io_geometry_copy_f90.html0000644000353400050620000017314511354150415021755 00000000000000 ./src/group_level/etsf_io_geometry_copy.f90

TABLE OF CONTENTS

etsf_io_geometry_copy

[ Top ] [ etsf_geometry ] [ Methods ]

NAME

etsf_io_geometry_copy

FUNCTION

This routine copy all variable of a group from one file @ncid_from to another @ncid_to. If a variable is missing in the source file, this does not raise an error, it is simply skipped. But if a variable in the destination file is not defined, this will raise an error.

The copy is done per variable. This means that memory occupation is reduced during the copy.

Normally, copies are pristine copies. But if optional argument @split is given, then the read values are copied to the specified locations in split arrays. In that case, the destination variable must have a compatible definition with the split values.

INPUTS

  • ncid_to = integer returned by an 'open' NetCDF call. This id must have write access granted. It will be modified by the routine. The file must be in write mode (see etsf_io_low_set_write_mode()).
  • ncid_from = integer returned by an 'open' NetCDF call. This id must have read access granted. It will be left untouched.
  • dims <type(etsf_dims)> = these dimensions correspond to the source_file ones and are used to allocate temporary arrays in memory during the copy.
  • split <type(etsf_split)> = (optional) if this argument is given, the values in the split definition (e.g. my_kpoints) are used to put the data in the destination file in a bigger array at the right placed.

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_geometry_copy(ncid_to, ncid_from, dims, lstat, error_data, &
  & split)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid_to
  integer, intent(intent) :: ncid_from
  type(etsf_dims), intent(intent) :: dims
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data
  type(etsf_split), optional, intent(intent) :: split

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_geometry_copy'
  type(etsf_split) :: my_split
  integer,allocatable :: varids(:,:)
  integer :: nvarids
  integer,allocatable :: start(:)
  integer,allocatable :: count(:)
  integer :: len
  integer :: istart
  integer :: idim1,idim2,idim3,idim4,idim5,idim6,idim7,idim8
  integer,allocatable :: istop(:)
  integer,allocatable :: jstart(:)
  integer,allocatable :: jend(:)
  type(etsf_geometry) :: folder


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_geometry_copy : enter'
!ENDDEBUG

  lstat = .false.
  call etsf_io_low_set_write_mode(ncid_to, lstat, error_data = error_data)
  if (.not. lstat) return
  
  allocate(varids(2,11))
  nvarids = 1
  
  ! Variable 'space_group'
  !  allocate and read data
  allocate(folder%space_group)
  call etsf_io_low_read_var(ncid_from, "space_group", &
                          & folder%space_group, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%space_group)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "space_group", &
                             & folder%space_group, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%space_group)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%space_group)
  
  lstat = .true.
  ! Variable 'primitive_vectors'
  !  allocate and read data
  allocate(folder%primitive_vectors( &
    & dims%number_of_vectors, &
    & dims%number_of_cartesian_directions))
  call etsf_io_low_read_var(ncid_from, "primitive_vectors", &
                          & folder%primitive_vectors, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%primitive_vectors)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "primitive_vectors", &
                             & folder%primitive_vectors, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%primitive_vectors)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%primitive_vectors)
  
  lstat = .true.
  ! Variable 'reduced_symmetry_matrices'
  !  allocate and read data
  allocate(folder%reduced_symmetry_matrices( &
    & dims%number_of_symmetry_operations, &
    & dims%number_of_reduced_dimensions, &
    & dims%number_of_reduced_dimensions))
  call etsf_io_low_read_var(ncid_from, "reduced_symmetry_matrices", &
                          & folder%reduced_symmetry_matrices, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%reduced_symmetry_matrices)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "reduced_symmetry_matrices", &
                             & folder%reduced_symmetry_matrices, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%reduced_symmetry_matrices)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%reduced_symmetry_matrices)
  
  lstat = .true.
  ! Variable 'reduced_symmetry_translations'
  !  allocate and read data
  allocate(folder%reduced_symmetry_translations( &
    & dims%number_of_symmetry_operations, &
    & dims%number_of_reduced_dimensions))
  call etsf_io_low_read_var(ncid_from, "reduced_symmetry_translations", &
                          & folder%reduced_symmetry_translations, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%reduced_symmetry_translations)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "reduced_symmetry_translations", &
                             & folder%reduced_symmetry_translations, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%reduced_symmetry_translations)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%reduced_symmetry_translations)
  
  lstat = .true.
  ! Variable 'atom_species'
  !  allocate and read data
  allocate(folder%atom_species( &
    & dims%number_of_atoms))
  call etsf_io_low_read_var(ncid_from, "atom_species", &
                          & folder%atom_species, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%atom_species)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "atom_species", &
                             & folder%atom_species, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%atom_species)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%atom_species)
  
  lstat = .true.
  ! Variable 'reduced_atom_positions'
  !  allocate and read data
  allocate(folder%reduced_atom_positions( &
    & dims%number_of_atoms, &
    & dims%number_of_reduced_dimensions))
  call etsf_io_low_read_var(ncid_from, "reduced_atom_positions", &
                          & folder%reduced_atom_positions, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%reduced_atom_positions)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "reduced_atom_positions", &
                             & folder%reduced_atom_positions, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%reduced_atom_positions)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%reduced_atom_positions)
  
  lstat = .true.
  ! Variable 'valence_charges'
  !  allocate and read data
  allocate(folder%valence_charges( &
    & dims%number_of_atom_species))
  call etsf_io_low_read_var(ncid_from, "valence_charges", &
                          & folder%valence_charges, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%valence_charges)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "valence_charges", &
                             & folder%valence_charges, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%valence_charges)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%valence_charges)
  
  lstat = .true.
  ! Variable 'atomic_numbers'
  !  allocate and read data
  allocate(folder%atomic_numbers( &
    & dims%number_of_atom_species))
  call etsf_io_low_read_var(ncid_from, "atomic_numbers", &
                          & folder%atomic_numbers, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%atomic_numbers)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "atomic_numbers", &
                             & folder%atomic_numbers, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%atomic_numbers)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%atomic_numbers)
  
  lstat = .true.
  ! Variable 'atom_species_names'
  !  allocate and read data
  allocate(folder%atom_species_names( &
    & dims%number_of_atom_species))
  call etsf_io_low_read_var(ncid_from, "atom_species_names", &
                          & folder%atom_species_names, dims%character_string_length, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%atom_species_names)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "atom_species_names", &
                             & folder%atom_species_names, dims%character_string_length, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%atom_species_names)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%atom_species_names)
  
  lstat = .true.
  ! Variable 'chemical_symbols'
  !  allocate and read data
  allocate(folder%chemical_symbols( &
    & dims%number_of_atom_species))
  call etsf_io_low_read_var(ncid_from, "chemical_symbols", &
                          & folder%chemical_symbols, dims%symbol_length, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%chemical_symbols)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "chemical_symbols", &
                             & folder%chemical_symbols, dims%symbol_length, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%chemical_symbols)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%chemical_symbols)
  
  lstat = .true.
  ! Variable 'pseudopotential_types'
  !  allocate and read data
  allocate(folder%pseudopotential_types( &
    & dims%number_of_atom_species))
  call etsf_io_low_read_var(ncid_from, "pseudopotential_types", &
                          & folder%pseudopotential_types, dims%character_string_length, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%pseudopotential_types)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "pseudopotential_types", &
                             & folder%pseudopotential_types, dims%character_string_length, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%pseudopotential_types)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%pseudopotential_types)
  
  lstat = .true.
  
  ! We copy all the attributes (ETSF and non-ETSF) of the group variables.
  call etsf_io_low_set_define_mode(ncid_to, lstat, error_data = error_data)
  if (.not. lstat) nvarids = 0
  do len = 1, nvarids - 1, 1
    call etsf_io_low_copy_all_att(ncid_from, ncid_to, varids(1, len), varids(2, len), &
                                & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      exit
    end if
  end do
  deallocate(varids)

!DEBUG
!write (*,*) 'etsf_io_geometry_copy : exit'
!ENDDEBUG

end subroutine etsf_io_geometry_copy
etsf_io-1.0.3/doc/www/group_level/etsf_io_electrons_copy_f90.html0000644000353400050620000023530411354150415022114 00000000000000 ./src/group_level/etsf_io_electrons_copy.f90

TABLE OF CONTENTS

etsf_io_electrons_copy

[ Top ] [ etsf_electrons ] [ Methods ]

NAME

etsf_io_electrons_copy

FUNCTION

This routine copy all variable of a group from one file @ncid_from to another @ncid_to. If a variable is missing in the source file, this does not raise an error, it is simply skipped. But if a variable in the destination file is not defined, this will raise an error.

The copy is done per variable. This means that memory occupation is reduced during the copy.

Normally, copies are pristine copies. But if optional argument @split is given, then the read values are copied to the specified locations in split arrays. In that case, the destination variable must have a compatible definition with the split values.

INPUTS

  • ncid_to = integer returned by an 'open' NetCDF call. This id must have write access granted. It will be modified by the routine. The file must be in write mode (see etsf_io_low_set_write_mode()).
  • ncid_from = integer returned by an 'open' NetCDF call. This id must have read access granted. It will be left untouched.
  • dims <type(etsf_dims)> = these dimensions correspond to the source_file ones and are used to allocate temporary arrays in memory during the copy.
  • split <type(etsf_split)> = (optional) if this argument is given, the values in the split definition (e.g. my_kpoints) are used to put the data in the destination file in a bigger array at the right placed.

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_electrons_copy(ncid_to, ncid_from, dims, lstat, error_data, &
  & split)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid_to
  integer, intent(intent) :: ncid_from
  type(etsf_dims), intent(intent) :: dims
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data
  type(etsf_split), optional, intent(intent) :: split

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_electrons_copy'
  type(etsf_split) :: my_split
  integer,allocatable :: varids(:,:)
  integer :: nvarids
  integer,allocatable :: start(:)
  integer,allocatable :: count(:)
  integer :: len
  integer :: istart
  integer :: idim1,idim2,idim3,idim4,idim5,idim6,idim7,idim8
  integer,allocatable :: istop(:)
  integer,allocatable :: jstart(:)
  integer,allocatable :: jend(:)
  type(etsf_electrons) :: folder


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_electrons_copy : enter'
!ENDDEBUG

  lstat = .false.
  call etsf_io_low_set_write_mode(ncid_to, lstat, error_data = error_data)
  if (.not. lstat) return
  
  allocate(varids(2,9))
  nvarids = 1
  
  ! Variable 'number_of_electrons'
  !  allocate and read data
  allocate(folder%number_of_electrons)
  call etsf_io_low_read_var(ncid_from, "number_of_electrons", &
                          & folder%number_of_electrons, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%number_of_electrons)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "number_of_electrons", &
                             & folder%number_of_electrons, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%number_of_electrons)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%number_of_electrons)
  
  lstat = .true.
  ! Variable 'exchange_functional'
  !  allocate and read data
  allocate(folder%exchange_functional)
  call etsf_io_low_read_var(ncid_from, "exchange_functional", &
                          & folder%exchange_functional, dims%character_string_length, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%exchange_functional)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "exchange_functional", &
                             & folder%exchange_functional, dims%character_string_length, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%exchange_functional)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%exchange_functional)
  
  lstat = .true.
  ! Variable 'correlation_functional'
  !  allocate and read data
  allocate(folder%correlation_functional)
  call etsf_io_low_read_var(ncid_from, "correlation_functional", &
                          & folder%correlation_functional, dims%character_string_length, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%correlation_functional)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "correlation_functional", &
                             & folder%correlation_functional, dims%character_string_length, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%correlation_functional)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%correlation_functional)
  
  lstat = .true.
  ! Variable 'fermi_energy'
  !  allocate and read data
  allocate(folder%fermi_energy)
  call etsf_io_low_read_var(ncid_from, "fermi_energy", &
                          & folder%fermi_energy, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%fermi_energy)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "fermi_energy", &
                             & folder%fermi_energy, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%fermi_energy)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%fermi_energy)
  
  lstat = .true.
  ! Variable 'smearing_scheme'
  !  allocate and read data
  allocate(folder%smearing_scheme)
  call etsf_io_low_read_var(ncid_from, "smearing_scheme", &
                          & folder%smearing_scheme, dims%character_string_length, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%smearing_scheme)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "smearing_scheme", &
                             & folder%smearing_scheme, dims%character_string_length, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%smearing_scheme)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%smearing_scheme)
  
  lstat = .true.
  ! Variable 'smearing_width'
  !  allocate and read data
  allocate(folder%smearing_width)
  call etsf_io_low_read_var(ncid_from, "smearing_width", &
                          & folder%smearing_width, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%smearing_width)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "smearing_width", &
                             & folder%smearing_width, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%smearing_width)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%smearing_width)
  
  lstat = .true.
  ! Variable 'number_of_states'
  !  allocate and read data
  allocate(folder%number_of_states%data1D( &
    & dims%my_number_of_spins * &
    & dims%my_number_of_kpoints))
  call etsf_io_low_read_var(ncid_from, "number_of_states", &
                          & folder%number_of_states%data1D, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%number_of_states%data1D)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(2), count(2))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(2))
      istart   = 1
      len      = 1
      if (.not. associated(split%my_spins)) then
        istop(2)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(2) = size(split%my_spins)
        count(2) = 1
      end if
      if (.not. associated(split%my_kpoints)) then
        istop(1)  = 1
        len = len * dims%my_number_of_kpoints
      else
        istop(1) = size(split%my_kpoints)
        count(1) = 1
      end if
      do idim2 = 1, istop(2), 1
        if (associated(split%my_spins)) then
          start(2)  = split%my_spins(idim2)
        end if
        do idim1 = 1, istop(1), 1
          if (associated(split%my_kpoints)) then
            start(1)  = split%my_kpoints(idim1)
          end if
          call etsf_io_low_write_var(ncid_to, "number_of_states", &
                                   & folder%number_of_states%data1D(istart:istart + len - 1), &
                                   & lstat, error_data = error_data, &
                                   & start = start, count = count, ncvarid = varids(2, nvarids))
          if (.not. lstat) then
            deallocate(folder%number_of_states%data1D)
            deallocate(start, count, istop)
            deallocate(varids)
            call etsf_io_low_error_update(error_data, my_name)
            return
          end if
          istart = istart + len
        end do
      end do
      deallocate(start, count, istop)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "number_of_states", &
                               & folder%number_of_states%data1D, lstat, &
                               & error_data = error_data, ncvarid = varids(2, nvarids))
      if (.not. lstat) then
        deallocate(folder%number_of_states%data1D)
        deallocate(varids)
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%number_of_states%data1D)
  
  lstat = .true.
  ! Variable 'eigenvalues'
  !  allocate and read data
  allocate(folder%eigenvalues%data1D( &
    & dims%my_number_of_spins * &
    & dims%my_number_of_kpoints * &
    & dims%my_max_number_of_states))
  call etsf_io_low_read_var(ncid_from, "eigenvalues", &
                          & folder%eigenvalues%data1D, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%eigenvalues%data1D)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(3), count(3))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(3))
      istart   = 1
      len      = 1
      if (.not. associated(split%my_spins)) then
        istop(3)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(3) = size(split%my_spins)
        count(3) = 1
      end if
      if (.not. associated(split%my_kpoints)) then
        istop(2)  = 1
        len = len * dims%my_number_of_kpoints
      else
        istop(2) = size(split%my_kpoints)
        count(2) = 1
      end if
      if (.not. associated(split%my_states)) then
        istop(1)  = 1
        len = len * dims%my_max_number_of_states
      else
        istop(1) = size(split%my_states)
        count(1) = 1
      end if
      do idim3 = 1, istop(3), 1
        if (associated(split%my_spins)) then
          start(3)  = split%my_spins(idim3)
        end if
        do idim2 = 1, istop(2), 1
          if (associated(split%my_kpoints)) then
            start(2)  = split%my_kpoints(idim2)
          end if
          do idim1 = 1, istop(1), 1
            if (associated(split%my_states)) then
              start(1)  = split%my_states(idim1)
            end if
            call etsf_io_low_write_var(ncid_to, "eigenvalues", &
                                     & folder%eigenvalues%data1D(istart:istart + len - 1), &
                                     & lstat, error_data = error_data, &
                                     & start = start, count = count, ncvarid = varids(2, nvarids))
            if (.not. lstat) then
              deallocate(folder%eigenvalues%data1D)
              deallocate(start, count, istop)
              deallocate(varids)
              call etsf_io_low_error_update(error_data, my_name)
              return
            end if
            istart = istart + len
          end do
        end do
      end do
      deallocate(start, count, istop)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "eigenvalues", &
                               & folder%eigenvalues%data1D, lstat, &
                               & error_data = error_data, ncvarid = varids(2, nvarids))
      if (.not. lstat) then
        deallocate(folder%eigenvalues%data1D)
        deallocate(varids)
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%eigenvalues%data1D)
  
  lstat = .true.
  ! Variable 'occupations'
  !  allocate and read data
  allocate(folder%occupations%data1D( &
    & dims%my_number_of_spins * &
    & dims%my_number_of_kpoints * &
    & dims%my_max_number_of_states))
  call etsf_io_low_read_var(ncid_from, "occupations", &
                          & folder%occupations%data1D, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%occupations%data1D)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(3), count(3))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(3))
      istart   = 1
      len      = 1
      if (.not. associated(split%my_spins)) then
        istop(3)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(3) = size(split%my_spins)
        count(3) = 1
      end if
      if (.not. associated(split%my_kpoints)) then
        istop(2)  = 1
        len = len * dims%my_number_of_kpoints
      else
        istop(2) = size(split%my_kpoints)
        count(2) = 1
      end if
      if (.not. associated(split%my_states)) then
        istop(1)  = 1
        len = len * dims%my_max_number_of_states
      else
        istop(1) = size(split%my_states)
        count(1) = 1
      end if
      do idim3 = 1, istop(3), 1
        if (associated(split%my_spins)) then
          start(3)  = split%my_spins(idim3)
        end if
        do idim2 = 1, istop(2), 1
          if (associated(split%my_kpoints)) then
            start(2)  = split%my_kpoints(idim2)
          end if
          do idim1 = 1, istop(1), 1
            if (associated(split%my_states)) then
              start(1)  = split%my_states(idim1)
            end if
            call etsf_io_low_write_var(ncid_to, "occupations", &
                                     & folder%occupations%data1D(istart:istart + len - 1), &
                                     & lstat, error_data = error_data, &
                                     & start = start, count = count, ncvarid = varids(2, nvarids))
            if (.not. lstat) then
              deallocate(folder%occupations%data1D)
              deallocate(start, count, istop)
              deallocate(varids)
              call etsf_io_low_error_update(error_data, my_name)
              return
            end if
            istart = istart + len
          end do
        end do
      end do
      deallocate(start, count, istop)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "occupations", &
                               & folder%occupations%data1D, lstat, &
                               & error_data = error_data, ncvarid = varids(2, nvarids))
      if (.not. lstat) then
        deallocate(folder%occupations%data1D)
        deallocate(varids)
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%occupations%data1D)
  
  lstat = .true.
  
  ! We copy all the attributes (ETSF and non-ETSF) of the group variables.
  call etsf_io_low_set_define_mode(ncid_to, lstat, error_data = error_data)
  if (.not. lstat) nvarids = 0
  do len = 1, nvarids - 1, 1
    call etsf_io_low_copy_all_att(ncid_from, ncid_to, varids(1, len), varids(2, len), &
                                & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      exit
    end if
  end do
  deallocate(varids)

!DEBUG
!write (*,*) 'etsf_io_electrons_copy : exit'
!ENDDEBUG

end subroutine etsf_io_electrons_copy
etsf_io-1.0.3/doc/www/group_level/etsf_io_kpoints_copy_f90.html0000644000353400050620000013740011354150415021603 00000000000000 ./src/group_level/etsf_io_kpoints_copy.f90

TABLE OF CONTENTS

etsf_io_kpoints_copy

[ Top ] [ etsf_kpoints ] [ Methods ]

NAME

etsf_io_kpoints_copy

FUNCTION

This routine copy all variable of a group from one file @ncid_from to another @ncid_to. If a variable is missing in the source file, this does not raise an error, it is simply skipped. But if a variable in the destination file is not defined, this will raise an error.

The copy is done per variable. This means that memory occupation is reduced during the copy.

Normally, copies are pristine copies. But if optional argument @split is given, then the read values are copied to the specified locations in split arrays. In that case, the destination variable must have a compatible definition with the split values.

INPUTS

  • ncid_to = integer returned by an 'open' NetCDF call. This id must have write access granted. It will be modified by the routine. The file must be in write mode (see etsf_io_low_set_write_mode()).
  • ncid_from = integer returned by an 'open' NetCDF call. This id must have read access granted. It will be left untouched.
  • dims <type(etsf_dims)> = these dimensions correspond to the source_file ones and are used to allocate temporary arrays in memory during the copy.
  • split <type(etsf_split)> = (optional) if this argument is given, the values in the split definition (e.g. my_kpoints) are used to put the data in the destination file in a bigger array at the right placed.

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_kpoints_copy(ncid_to, ncid_from, dims, lstat, error_data, &
  & split)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid_to
  integer, intent(intent) :: ncid_from
  type(etsf_dims), intent(intent) :: dims
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data
  type(etsf_split), optional, intent(intent) :: split

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_kpoints_copy'
  type(etsf_split) :: my_split
  integer,allocatable :: varids(:,:)
  integer :: nvarids
  integer,allocatable :: start(:)
  integer,allocatable :: count(:)
  integer :: len
  integer :: istart
  integer :: idim1,idim2,idim3,idim4,idim5,idim6,idim7,idim8
  integer,allocatable :: istop(:)
  integer,allocatable :: jstart(:)
  integer,allocatable :: jend(:)
  type(etsf_kpoints) :: folder


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_kpoints_copy : enter'
!ENDDEBUG

  lstat = .false.
  call etsf_io_low_set_write_mode(ncid_to, lstat, error_data = error_data)
  if (.not. lstat) return
  
  allocate(varids(2,5))
  nvarids = 1
  
  ! Variable 'kpoint_grid_shift'
  !  allocate and read data
  allocate(folder%kpoint_grid_shift( &
    & dims%number_of_reduced_dimensions))
  call etsf_io_low_read_var(ncid_from, "kpoint_grid_shift", &
                          & folder%kpoint_grid_shift, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%kpoint_grid_shift)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "kpoint_grid_shift", &
                             & folder%kpoint_grid_shift, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%kpoint_grid_shift)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%kpoint_grid_shift)
  
  lstat = .true.
  ! Variable 'kpoint_grid_vectors'
  !  allocate and read data
  allocate(folder%kpoint_grid_vectors( &
    & dims%number_of_vectors, &
    & dims%number_of_reduced_dimensions))
  call etsf_io_low_read_var(ncid_from, "kpoint_grid_vectors", &
                          & folder%kpoint_grid_vectors, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%kpoint_grid_vectors)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "kpoint_grid_vectors", &
                             & folder%kpoint_grid_vectors, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%kpoint_grid_vectors)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%kpoint_grid_vectors)
  
  lstat = .true.
  ! Variable 'monkhorst_pack_folding'
  !  allocate and read data
  allocate(folder%monkhorst_pack_folding( &
    & dims%number_of_vectors))
  call etsf_io_low_read_var(ncid_from, "monkhorst_pack_folding", &
                          & folder%monkhorst_pack_folding, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%monkhorst_pack_folding)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "monkhorst_pack_folding", &
                             & folder%monkhorst_pack_folding, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%monkhorst_pack_folding)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%monkhorst_pack_folding)
  
  lstat = .true.
  ! Variable 'reduced_coordinates_of_kpoints'
  !  allocate and read data
  allocate(folder%reduced_coordinates_of_kpoints( &
    & dims%my_number_of_kpoints, &
    & dims%number_of_reduced_dimensions))
  call etsf_io_low_read_var(ncid_from, "reduced_coordinates_of_kpoints", &
                          & folder%reduced_coordinates_of_kpoints, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%reduced_coordinates_of_kpoints)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(2), count(2))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(2))
      allocate(jstart(2), jend(2))
      if (.not. associated(split%my_kpoints)) then
        istop(2)  = 1
        jstart(2) = 1
        jend(2)   = dims%my_number_of_kpoints
      else
        istop(2) = size(split%my_kpoints)
        count(2) = 1
      end if
      do idim2 = 1, istop(2), 1
        if (associated(split%my_kpoints)) then
          start(2)  = split%my_kpoints(idim2)
          jstart(2) = split%my_kpoints(idim2)
          jend(2)   = split%my_kpoints(idim2)
        end if
        call etsf_io_low_write_var(ncid_to, "reduced_coordinates_of_kpoints", &
                                 & folder%reduced_coordinates_of_kpoints(:, jstart(2):jend(2)), &
                                 & lstat, error_data = error_data, &
                                 & start = start, count = count, ncvarid = varids(2, nvarids))
        if (.not. lstat) then
          deallocate(folder%reduced_coordinates_of_kpoints)
          deallocate(start, count, istop)
          deallocate(jstart, jend)
          deallocate(varids)
          call etsf_io_low_error_update(error_data, my_name)
          return
        end if
      end do
      deallocate(start, count, istop)
      deallocate(jstart, jend)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "reduced_coordinates_of_kpoints", &
                               & folder%reduced_coordinates_of_kpoints, lstat, &
                               & error_data = error_data, ncvarid = varids(2, nvarids))
      if (.not. lstat) then
        deallocate(folder%reduced_coordinates_of_kpoints)
        deallocate(varids)
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%reduced_coordinates_of_kpoints)
  
  lstat = .true.
  ! Variable 'kpoint_weights'
  !  allocate and read data
  allocate(folder%kpoint_weights( &
    & dims%my_number_of_kpoints))
  call etsf_io_low_read_var(ncid_from, "kpoint_weights", &
                          & folder%kpoint_weights, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%kpoint_weights)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(1), count(1))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(1))
      allocate(jstart(1), jend(1))
      if (.not. associated(split%my_kpoints)) then
        istop(1)  = 1
        jstart(1) = 1
        jend(1)   = dims%my_number_of_kpoints
      else
        istop(1) = size(split%my_kpoints)
        count(1) = 1
      end if
      do idim1 = 1, istop(1), 1
        if (associated(split%my_kpoints)) then
          start(1)  = split%my_kpoints(idim1)
          jstart(1) = split%my_kpoints(idim1)
          jend(1)   = split%my_kpoints(idim1)
        end if
        call etsf_io_low_write_var(ncid_to, "kpoint_weights", &
                                 & folder%kpoint_weights(jstart(1):jend(1)), &
                                 & lstat, error_data = error_data, &
                                 & start = start, count = count, ncvarid = varids(2, nvarids))
        if (.not. lstat) then
          deallocate(folder%kpoint_weights)
          deallocate(start, count, istop)
          deallocate(jstart, jend)
          deallocate(varids)
          call etsf_io_low_error_update(error_data, my_name)
          return
        end if
      end do
      deallocate(start, count, istop)
      deallocate(jstart, jend)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "kpoint_weights", &
                               & folder%kpoint_weights, lstat, &
                               & error_data = error_data, ncvarid = varids(2, nvarids))
      if (.not. lstat) then
        deallocate(folder%kpoint_weights)
        deallocate(varids)
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%kpoint_weights)
  
  lstat = .true.
  
  ! We copy all the attributes (ETSF and non-ETSF) of the group variables.
  call etsf_io_low_set_define_mode(ncid_to, lstat, error_data = error_data)
  if (.not. lstat) nvarids = 0
  do len = 1, nvarids - 1, 1
    call etsf_io_low_copy_all_att(ncid_from, ncid_to, varids(1, len), varids(2, len), &
                                & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      exit
    end if
  end do
  deallocate(varids)

!DEBUG
!write (*,*) 'etsf_io_kpoints_copy : exit'
!ENDDEBUG

end subroutine etsf_io_kpoints_copy
etsf_io-1.0.3/doc/www/group_level/etsf_io_basisdata_copy_f90.html0000644000353400050620000015522111354150415022050 00000000000000 ./src/group_level/etsf_io_basisdata_copy.f90

TABLE OF CONTENTS

etsf_io_basisdata_copy

[ Top ] [ etsf_basisdata ] [ Methods ]

NAME

etsf_io_basisdata_copy

FUNCTION

This routine copy all variable of a group from one file @ncid_from to another @ncid_to. If a variable is missing in the source file, this does not raise an error, it is simply skipped. But if a variable in the destination file is not defined, this will raise an error.

The copy is done per variable. This means that memory occupation is reduced during the copy.

Normally, copies are pristine copies. But if optional argument @split is given, then the read values are copied to the specified locations in split arrays. In that case, the destination variable must have a compatible definition with the split values.

INPUTS

  • ncid_to = integer returned by an 'open' NetCDF call. This id must have write access granted. It will be modified by the routine. The file must be in write mode (see etsf_io_low_set_write_mode()).
  • ncid_from = integer returned by an 'open' NetCDF call. This id must have read access granted. It will be left untouched.
  • dims <type(etsf_dims)> = these dimensions correspond to the source_file ones and are used to allocate temporary arrays in memory during the copy.
  • split <type(etsf_split)> = (optional) if this argument is given, the values in the split definition (e.g. my_kpoints) are used to put the data in the destination file in a bigger array at the right placed.

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_basisdata_copy(ncid_to, ncid_from, dims, lstat, error_data, &
  & split)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid_to
  integer, intent(intent) :: ncid_from
  type(etsf_dims), intent(intent) :: dims
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data
  type(etsf_split), optional, intent(intent) :: split

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_basisdata_copy'
  type(etsf_split) :: my_split
  integer,allocatable :: varids(:,:)
  integer :: nvarids
  integer,allocatable :: start(:)
  integer,allocatable :: count(:)
  integer :: len
  integer :: istart
  integer :: idim1,idim2,idim3,idim4,idim5,idim6,idim7,idim8
  integer,allocatable :: istop(:)
  integer,allocatable :: jstart(:)
  integer,allocatable :: jend(:)
  type(etsf_basisdata) :: folder


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_basisdata_copy : enter'
!ENDDEBUG

  lstat = .false.
  call etsf_io_low_set_write_mode(ncid_to, lstat, error_data = error_data)
  if (.not. lstat) return
  
  allocate(varids(2,6))
  nvarids = 1
  
  ! Variable 'basis_set'
  !  allocate and read data
  allocate(folder%basis_set)
  call etsf_io_low_read_var(ncid_from, "basis_set", &
                          & folder%basis_set, dims%character_string_length, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%basis_set)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "basis_set", &
                             & folder%basis_set, dims%character_string_length, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%basis_set)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%basis_set)
  
  lstat = .true.
  ! Variable 'kinetic_energy_cutoff'
  !  allocate and read data
  allocate(folder%kinetic_energy_cutoff)
  call etsf_io_low_read_var(ncid_from, "kinetic_energy_cutoff", &
                          & folder%kinetic_energy_cutoff, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%kinetic_energy_cutoff)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "kinetic_energy_cutoff", &
                             & folder%kinetic_energy_cutoff, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%kinetic_energy_cutoff)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%kinetic_energy_cutoff)
  
  lstat = .true.
  ! Variable 'number_of_coefficients'
  !  allocate and read data
  allocate(folder%number_of_coefficients( &
    & dims%my_number_of_kpoints))
  call etsf_io_low_read_var(ncid_from, "number_of_coefficients", &
                          & folder%number_of_coefficients, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%number_of_coefficients)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(1), count(1))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(1))
      allocate(jstart(1), jend(1))
      if (.not. associated(split%my_kpoints)) then
        istop(1)  = 1
        jstart(1) = 1
        jend(1)   = dims%my_number_of_kpoints
      else
        istop(1) = size(split%my_kpoints)
        count(1) = 1
      end if
      do idim1 = 1, istop(1), 1
        if (associated(split%my_kpoints)) then
          start(1)  = split%my_kpoints(idim1)
          jstart(1) = split%my_kpoints(idim1)
          jend(1)   = split%my_kpoints(idim1)
        end if
        call etsf_io_low_write_var(ncid_to, "number_of_coefficients", &
                                 & folder%number_of_coefficients(jstart(1):jend(1)), &
                                 & lstat, error_data = error_data, &
                                 & start = start, count = count, ncvarid = varids(2, nvarids))
        if (.not. lstat) then
          deallocate(folder%number_of_coefficients)
          deallocate(start, count, istop)
          deallocate(jstart, jend)
          deallocate(varids)
          call etsf_io_low_error_update(error_data, my_name)
          return
        end if
      end do
      deallocate(start, count, istop)
      deallocate(jstart, jend)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "number_of_coefficients", &
                               & folder%number_of_coefficients, lstat, &
                               & error_data = error_data, ncvarid = varids(2, nvarids))
      if (.not. lstat) then
        deallocate(folder%number_of_coefficients)
        deallocate(varids)
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%number_of_coefficients)
  
  lstat = .true.
  ! Variable 'reduced_coordinates_of_plane_waves'
  !  allocate and read data
  allocate(folder%reduced_coordinates_of_plane_waves%data1D( &
    & dims%my_number_of_kpoints * &
    & dims%my_max_number_of_coefficients * &
    & dims%number_of_reduced_dimensions))
  call etsf_io_low_read_var(ncid_from, "reduced_coordinates_of_plane_waves", &
                          & folder%reduced_coordinates_of_plane_waves%data1D, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%reduced_coordinates_of_plane_waves%data1D)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(3), count(3))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(3))
      istart   = 1
      len      = 1
      if (.not. associated(split%my_kpoints)) then
        istop(3)  = 1
        len = len * dims%my_number_of_kpoints
      else
        istop(3) = size(split%my_kpoints)
        count(3) = 1
      end if
      if (.not. associated(split%my_coefficients)) then
        istop(2)  = 1
        len = len * dims%my_max_number_of_coefficients
      else
        istop(2) = size(split%my_coefficients)
        count(2) = 1
      end if
      len = len * dims%number_of_reduced_dimensions
      do idim3 = 1, istop(3), 1
        if (associated(split%my_kpoints)) then
          start(3)  = split%my_kpoints(idim3)
        end if
        do idim2 = 1, istop(2), 1
          if (associated(split%my_coefficients)) then
            start(2)  = split%my_coefficients(idim2)
          end if
          call etsf_io_low_write_var(ncid_to, "reduced_coordinates_of_plane_waves", &
                                   & folder%reduced_coordinates_of_plane_waves%data1D(istart:istart + len - 1), &
                                   & lstat, error_data = error_data, &
                                   & start = start, count = count, ncvarid = varids(2, nvarids))
          if (.not. lstat) then
            deallocate(folder%reduced_coordinates_of_plane_waves%data1D)
            deallocate(start, count, istop)
            deallocate(varids)
            call etsf_io_low_error_update(error_data, my_name)
            return
          end if
          istart = istart + len
        end do
      end do
      deallocate(start, count, istop)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "reduced_coordinates_of_plane_waves", &
                               & folder%reduced_coordinates_of_plane_waves%data1D, lstat, &
                               & error_data = error_data, ncvarid = varids(2, nvarids))
      if (.not. lstat) then
        deallocate(folder%reduced_coordinates_of_plane_waves%data1D)
        deallocate(varids)
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%reduced_coordinates_of_plane_waves%data1D)
  
  lstat = .true.
  ! Variable 'coordinates_of_basis_grid_points'
  !  allocate and read data
  allocate(folder%coordinates_of_basis_grid_points%data1D( &
    & dims%number_of_localization_regions * &
    & dims%max_number_of_basis_grid_points * &
    & dims%number_of_reduced_dimensions))
  call etsf_io_low_read_var(ncid_from, "coordinates_of_basis_grid_points", &
                          & folder%coordinates_of_basis_grid_points%data1D, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%coordinates_of_basis_grid_points%data1D)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "coordinates_of_basis_grid_points", &
                             & folder%coordinates_of_basis_grid_points%data1D, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%coordinates_of_basis_grid_points%data1D)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%coordinates_of_basis_grid_points%data1D)
  
  lstat = .true.
  ! Variable 'number_of_coefficients_per_grid_point'
  !  allocate and read data
  allocate(folder%number_of_coefficients_per_grid_point%data1D( &
    & dims%number_of_localization_regions * &
    & dims%max_number_of_basis_grid_points))
  call etsf_io_low_read_var(ncid_from, "number_of_coefficients_per_grid_point", &
                          & folder%number_of_coefficients_per_grid_point%data1D, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%number_of_coefficients_per_grid_point%data1D)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "number_of_coefficients_per_grid_point", &
                             & folder%number_of_coefficients_per_grid_point%data1D, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%number_of_coefficients_per_grid_point%data1D)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%number_of_coefficients_per_grid_point%data1D)
  
  lstat = .true.
  
  ! We copy all the attributes (ETSF and non-ETSF) of the group variables.
  call etsf_io_low_set_define_mode(ncid_to, lstat, error_data = error_data)
  if (.not. lstat) nvarids = 0
  do len = 1, nvarids - 1, 1
    call etsf_io_low_copy_all_att(ncid_from, ncid_to, varids(1, len), varids(2, len), &
                                & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      exit
    end if
  end do
  deallocate(varids)

!DEBUG
!write (*,*) 'etsf_io_basisdata_copy : exit'
!ENDDEBUG

end subroutine etsf_io_basisdata_copy
etsf_io-1.0.3/doc/www/group_level/etsf_io_gwdata_copy_f90.html0000644000353400050620000016511311354150415021365 00000000000000 ./src/group_level/etsf_io_gwdata_copy.f90

TABLE OF CONTENTS

etsf_io_gwdata_copy

[ Top ] [ etsf_gwdata ] [ Methods ]

NAME

etsf_io_gwdata_copy

FUNCTION

This routine copy all variable of a group from one file @ncid_from to another @ncid_to. If a variable is missing in the source file, this does not raise an error, it is simply skipped. But if a variable in the destination file is not defined, this will raise an error.

The copy is done per variable. This means that memory occupation is reduced during the copy.

Normally, copies are pristine copies. But if optional argument @split is given, then the read values are copied to the specified locations in split arrays. In that case, the destination variable must have a compatible definition with the split values.

INPUTS

  • ncid_to = integer returned by an 'open' NetCDF call. This id must have write access granted. It will be modified by the routine. The file must be in write mode (see etsf_io_low_set_write_mode()).
  • ncid_from = integer returned by an 'open' NetCDF call. This id must have read access granted. It will be left untouched.
  • dims <type(etsf_dims)> = these dimensions correspond to the source_file ones and are used to allocate temporary arrays in memory during the copy.
  • split <type(etsf_split)> = (optional) if this argument is given, the values in the split definition (e.g. my_kpoints) are used to put the data in the destination file in a bigger array at the right placed.

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_gwdata_copy(ncid_to, ncid_from, dims, lstat, error_data, &
  & split)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid_to
  integer, intent(intent) :: ncid_from
  type(etsf_dims), intent(intent) :: dims
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data
  type(etsf_split), optional, intent(intent) :: split

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_gwdata_copy'
  type(etsf_split) :: my_split
  integer,allocatable :: varids(:,:)
  integer :: nvarids
  integer,allocatable :: start(:)
  integer,allocatable :: count(:)
  integer :: len
  integer :: istart
  integer :: idim1,idim2,idim3,idim4,idim5,idim6,idim7,idim8
  integer,allocatable :: istop(:)
  integer,allocatable :: jstart(:)
  integer,allocatable :: jend(:)
  type(etsf_gwdata) :: folder


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_gwdata_copy : enter'
!ENDDEBUG

  lstat = .false.
  call etsf_io_low_set_write_mode(ncid_to, lstat, error_data = error_data)
  if (.not. lstat) return
  
  allocate(varids(2,4))
  nvarids = 1
  
  ! Variable 'gw_corrections'
  !  allocate and read data
  allocate(folder%gw_corrections%data1D( &
    & dims%my_number_of_spins * &
    & dims%my_number_of_kpoints * &
    & dims%my_max_number_of_states * &
    & dims%real_or_complex_gw_corrections))
  call etsf_io_low_read_var(ncid_from, "gw_corrections", &
                          & folder%gw_corrections%data1D, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%gw_corrections%data1D)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(4), count(4))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(4))
      istart   = 1
      len      = 1
      if (.not. associated(split%my_spins)) then
        istop(4)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(4) = size(split%my_spins)
        count(4) = 1
      end if
      if (.not. associated(split%my_kpoints)) then
        istop(3)  = 1
        len = len * dims%my_number_of_kpoints
      else
        istop(3) = size(split%my_kpoints)
        count(3) = 1
      end if
      if (.not. associated(split%my_states)) then
        istop(2)  = 1
        len = len * dims%my_max_number_of_states
      else
        istop(2) = size(split%my_states)
        count(2) = 1
      end if
      len = len * dims%real_or_complex_gw_corrections
      do idim4 = 1, istop(4), 1
        if (associated(split%my_spins)) then
          start(4)  = split%my_spins(idim4)
        end if
        do idim3 = 1, istop(3), 1
          if (associated(split%my_kpoints)) then
            start(3)  = split%my_kpoints(idim3)
          end if
          do idim2 = 1, istop(2), 1
            if (associated(split%my_states)) then
              start(2)  = split%my_states(idim2)
            end if
            call etsf_io_low_write_var(ncid_to, "gw_corrections", &
                                     & folder%gw_corrections%data1D(istart:istart + len - 1), &
                                     & lstat, error_data = error_data, &
                                     & start = start, count = count, ncvarid = varids(2, nvarids))
            if (.not. lstat) then
              deallocate(folder%gw_corrections%data1D)
              deallocate(start, count, istop)
              deallocate(varids)
              call etsf_io_low_error_update(error_data, my_name)
              return
            end if
            istart = istart + len
          end do
        end do
      end do
      deallocate(start, count, istop)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "gw_corrections", &
                               & folder%gw_corrections%data1D, lstat, &
                               & error_data = error_data, ncvarid = varids(2, nvarids))
      if (.not. lstat) then
        deallocate(folder%gw_corrections%data1D)
        deallocate(varids)
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%gw_corrections%data1D)
  
  lstat = .true.
  ! Variable 'kb_formfactor_sign'
  !  allocate and read data
  allocate(folder%kb_formfactor_sign%data1D( &
    & dims%number_of_atom_species * &
    & dims%max_number_of_angular_momenta * &
    & dims%max_number_of_projectors))
  call etsf_io_low_read_var(ncid_from, "kb_formfactor_sign", &
                          & folder%kb_formfactor_sign%data1D, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%kb_formfactor_sign%data1D)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "kb_formfactor_sign", &
                             & folder%kb_formfactor_sign%data1D, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%kb_formfactor_sign%data1D)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%kb_formfactor_sign%data1D)
  
  lstat = .true.
  ! Variable 'kb_formfactors'
  !  allocate and read data
  allocate(folder%kb_formfactors%data1D( &
    & dims%number_of_atom_species * &
    & dims%max_number_of_angular_momenta * &
    & dims%max_number_of_projectors * &
    & dims%my_number_of_kpoints * &
    & dims%my_max_number_of_coefficients))
  call etsf_io_low_read_var(ncid_from, "kb_formfactors", &
                          & folder%kb_formfactors%data1D, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%kb_formfactors%data1D)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(5), count(5))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(5))
      istart   = 1
      len      = 1
      len = len * dims%number_of_atom_species
      len = len * dims%max_number_of_angular_momenta
      len = len * dims%max_number_of_projectors
      if (.not. associated(split%my_kpoints)) then
        istop(2)  = 1
        len = len * dims%my_number_of_kpoints
      else
        istop(2) = size(split%my_kpoints)
        count(2) = 1
      end if
      if (.not. associated(split%my_coefficients)) then
        istop(1)  = 1
        len = len * dims%my_max_number_of_coefficients
      else
        istop(1) = size(split%my_coefficients)
        count(1) = 1
      end if
      do idim2 = 1, istop(2), 1
        if (associated(split%my_kpoints)) then
          start(2)  = split%my_kpoints(idim2)
        end if
        do idim1 = 1, istop(1), 1
          if (associated(split%my_coefficients)) then
            start(1)  = split%my_coefficients(idim1)
          end if
          call etsf_io_low_write_var(ncid_to, "kb_formfactors", &
                                   & folder%kb_formfactors%data1D(istart:istart + len - 1), &
                                   & lstat, error_data = error_data, &
                                   & start = start, count = count, ncvarid = varids(2, nvarids))
          if (.not. lstat) then
            deallocate(folder%kb_formfactors%data1D)
            deallocate(start, count, istop)
            deallocate(varids)
            call etsf_io_low_error_update(error_data, my_name)
            return
          end if
          istart = istart + len
        end do
      end do
      deallocate(start, count, istop)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "kb_formfactors", &
                               & folder%kb_formfactors%data1D, lstat, &
                               & error_data = error_data, ncvarid = varids(2, nvarids))
      if (.not. lstat) then
        deallocate(folder%kb_formfactors%data1D)
        deallocate(varids)
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%kb_formfactors%data1D)
  
  lstat = .true.
  ! Variable 'kb_formfactor_derivative'
  !  allocate and read data
  allocate(folder%kb_formfactor_derivative%data1D( &
    & dims%number_of_atom_species * &
    & dims%max_number_of_angular_momenta * &
    & dims%max_number_of_projectors * &
    & dims%my_number_of_kpoints * &
    & dims%my_max_number_of_coefficients))
  call etsf_io_low_read_var(ncid_from, "kb_formfactor_derivative", &
                          & folder%kb_formfactor_derivative%data1D, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%kb_formfactor_derivative%data1D)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(5), count(5))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(5))
      istart   = 1
      len      = 1
      len = len * dims%number_of_atom_species
      len = len * dims%max_number_of_angular_momenta
      len = len * dims%max_number_of_projectors
      if (.not. associated(split%my_kpoints)) then
        istop(2)  = 1
        len = len * dims%my_number_of_kpoints
      else
        istop(2) = size(split%my_kpoints)
        count(2) = 1
      end if
      if (.not. associated(split%my_coefficients)) then
        istop(1)  = 1
        len = len * dims%my_max_number_of_coefficients
      else
        istop(1) = size(split%my_coefficients)
        count(1) = 1
      end if
      do idim2 = 1, istop(2), 1
        if (associated(split%my_kpoints)) then
          start(2)  = split%my_kpoints(idim2)
        end if
        do idim1 = 1, istop(1), 1
          if (associated(split%my_coefficients)) then
            start(1)  = split%my_coefficients(idim1)
          end if
          call etsf_io_low_write_var(ncid_to, "kb_formfactor_derivative", &
                                   & folder%kb_formfactor_derivative%data1D(istart:istart + len - 1), &
                                   & lstat, error_data = error_data, &
                                   & start = start, count = count, ncvarid = varids(2, nvarids))
          if (.not. lstat) then
            deallocate(folder%kb_formfactor_derivative%data1D)
            deallocate(start, count, istop)
            deallocate(varids)
            call etsf_io_low_error_update(error_data, my_name)
            return
          end if
          istart = istart + len
        end do
      end do
      deallocate(start, count, istop)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "kb_formfactor_derivative", &
                               & folder%kb_formfactor_derivative%data1D, lstat, &
                               & error_data = error_data, ncvarid = varids(2, nvarids))
      if (.not. lstat) then
        deallocate(folder%kb_formfactor_derivative%data1D)
        deallocate(varids)
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%kb_formfactor_derivative%data1D)
  
  lstat = .true.
  
  ! We copy all the attributes (ETSF and non-ETSF) of the group variables.
  call etsf_io_low_set_define_mode(ncid_to, lstat, error_data = error_data)
  if (.not. lstat) nvarids = 0
  do len = 1, nvarids - 1, 1
    call etsf_io_low_copy_all_att(ncid_from, ncid_to, varids(1, len), varids(2, len), &
                                & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      exit
    end if
  end do
  deallocate(varids)

!DEBUG
!write (*,*) 'etsf_io_gwdata_copy : exit'
!ENDDEBUG

end subroutine etsf_io_gwdata_copy
etsf_io-1.0.3/doc/www/group_level/etsf_io_dielectric_copy_f90.html0000644000353400050620000075340711354150415022236 00000000000000 ./src/group_level/etsf_io_dielectric_copy.f90

TABLE OF CONTENTS

etsf_io_dielectric_copy

[ Top ] [ etsf_dielectric ] [ Methods ]

NAME

etsf_io_dielectric_copy

FUNCTION

This routine copy all variable of a group from one file @ncid_from to another @ncid_to. If a variable is missing in the source file, this does not raise an error, it is simply skipped. But if a variable in the destination file is not defined, this will raise an error.

The copy is done per variable. This means that memory occupation is reduced during the copy.

Normally, copies are pristine copies. But if optional argument @split is given, then the read values are copied to the specified locations in split arrays. In that case, the destination variable must have a compatible definition with the split values.

INPUTS

  • ncid_to = integer returned by an 'open' NetCDF call. This id must have write access granted. It will be modified by the routine. The file must be in write mode (see etsf_io_low_set_write_mode()).
  • ncid_from = integer returned by an 'open' NetCDF call. This id must have read access granted. It will be left untouched.
  • dims <type(etsf_dims)> = these dimensions correspond to the source_file ones and are used to allocate temporary arrays in memory during the copy.
  • split <type(etsf_split)> = (optional) if this argument is given, the values in the split definition (e.g. my_kpoints) are used to put the data in the destination file in a bigger array at the right placed.

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_dielectric_copy(ncid_to, ncid_from, dims, lstat, error_data, &
  & split)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid_to
  integer, intent(intent) :: ncid_from
  type(etsf_dims), intent(intent) :: dims
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data
  type(etsf_split), optional, intent(intent) :: split

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_dielectric_copy'
  type(etsf_split) :: my_split
  integer,allocatable :: varids(:,:)
  integer :: nvarids
  integer,allocatable :: start(:)
  integer,allocatable :: count(:)
  integer :: len
  integer :: istart
  integer :: idim1,idim2,idim3,idim4,idim5,idim6,idim7,idim8
  integer,allocatable :: istop(:)
  integer,allocatable :: jstart(:)
  integer,allocatable :: jend(:)
  type(etsf_dielectric) :: folder


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_dielectric_copy : enter'
!ENDDEBUG

  lstat = .false.
  call etsf_io_low_set_write_mode(ncid_to, lstat, error_data = error_data)
  if (.not. lstat) return
  
  allocate(varids(2,19))
  nvarids = 1
  
  ! Variable 'frequencies_dielectric_function'
  !  allocate and read data
  allocate(folder%frequencies_dielectric_function( &
    & dims%number_of_frequencies_dielectric_function, &
    & dims%complex))
  call etsf_io_low_read_var(ncid_from, "frequencies_dielectric_function", &
                          & folder%frequencies_dielectric_function, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%frequencies_dielectric_function)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "frequencies_dielectric_function", &
                             & folder%frequencies_dielectric_function, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%frequencies_dielectric_function)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%frequencies_dielectric_function)
  
  lstat = .true.
  ! Variable 'qpoints_dielectric_function'
  !  allocate and read data
  allocate(folder%qpoints_dielectric_function( &
    & dims%number_of_qpoints_dielectric_function, &
    & dims%number_of_reduced_dimensions))
  call etsf_io_low_read_var(ncid_from, "qpoints_dielectric_function", &
                          & folder%qpoints_dielectric_function, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%qpoints_dielectric_function)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "qpoints_dielectric_function", &
                             & folder%qpoints_dielectric_function, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%qpoints_dielectric_function)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%qpoints_dielectric_function)
  
  lstat = .true.
  ! Variable 'qpoints_gamma_limit'
  !  allocate and read data
  allocate(folder%qpoints_gamma_limit( &
    & dims%number_of_qpoints_gamma_limit, &
    & dims%number_of_reduced_dimensions))
  call etsf_io_low_read_var(ncid_from, "qpoints_gamma_limit", &
                          & folder%qpoints_gamma_limit, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%qpoints_gamma_limit)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "qpoints_gamma_limit", &
                             & folder%qpoints_gamma_limit, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%qpoints_gamma_limit)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%qpoints_gamma_limit)
  
  lstat = .true.
  ! Variable 'dielectric_function'
  !  allocate and read data
  allocate(folder%dielectric_function%data1D( &
    & dims%number_of_frequencies_dielectric_function * &
    & dims%number_of_qpoints_dielectric_function * &
    & dims%my_number_of_spins * &
    & dims%my_number_of_spins * &
    & dims%number_of_coefficients_dielectric_function * &
    & dims%number_of_coefficients_dielectric_function * &
    & dims%complex))
  call etsf_io_low_read_var(ncid_from, "dielectric_function", &
                          & folder%dielectric_function%data1D, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%dielectric_function%data1D)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(7), count(7))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(7))
      istart   = 1
      len      = 1
      len = len * dims%number_of_frequencies_dielectric_function
      len = len * dims%number_of_qpoints_dielectric_function
      if (.not. associated(split%my_spins)) then
        istop(5)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(5) = size(split%my_spins)
        count(5) = 1
      end if
      if (.not. associated(split%my_spins)) then
        istop(4)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(4) = size(split%my_spins)
        count(4) = 1
      end if
      len = len * dims%number_of_coefficients_dielectric_function
      len = len * dims%number_of_coefficients_dielectric_function
      len = len * dims%complex
      do idim5 = 1, istop(5), 1
        if (associated(split%my_spins)) then
          start(5)  = split%my_spins(idim5)
        end if
        do idim4 = 1, istop(4), 1
          if (associated(split%my_spins)) then
            start(4)  = split%my_spins(idim4)
          end if
          call etsf_io_low_write_var(ncid_to, "dielectric_function", &
                                   & folder%dielectric_function%data1D(istart:istart + len - 1), &
                                   & lstat, error_data = error_data, &
                                   & start = start, count = count, ncvarid = varids(2, nvarids))
          if (.not. lstat) then
            deallocate(folder%dielectric_function%data1D)
            deallocate(start, count, istop)
            deallocate(varids)
            call etsf_io_low_error_update(error_data, my_name)
            return
          end if
          istart = istart + len
        end do
      end do
      deallocate(start, count, istop)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "dielectric_function", &
                               & folder%dielectric_function%data1D, lstat, &
                               & error_data = error_data, ncvarid = varids(2, nvarids))
      if (.not. lstat) then
        deallocate(folder%dielectric_function%data1D)
        deallocate(varids)
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%dielectric_function%data1D)
  
  lstat = .true.
  ! Variable 'dielectric_function_head'
  !  allocate and read data
  allocate(folder%dielectric_function_head%data1D( &
    & dims%number_of_frequencies_dielectric_function * &
    & dims%number_of_qpoints_dielectric_function * &
    & dims%my_number_of_spins * &
    & dims%my_number_of_spins * &
    & dims%complex))
  call etsf_io_low_read_var(ncid_from, "dielectric_function_head", &
                          & folder%dielectric_function_head%data1D, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%dielectric_function_head%data1D)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(5), count(5))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(5))
      istart   = 1
      len      = 1
      len = len * dims%number_of_frequencies_dielectric_function
      len = len * dims%number_of_qpoints_dielectric_function
      if (.not. associated(split%my_spins)) then
        istop(3)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(3) = size(split%my_spins)
        count(3) = 1
      end if
      if (.not. associated(split%my_spins)) then
        istop(2)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(2) = size(split%my_spins)
        count(2) = 1
      end if
      len = len * dims%complex
      do idim3 = 1, istop(3), 1
        if (associated(split%my_spins)) then
          start(3)  = split%my_spins(idim3)
        end if
        do idim2 = 1, istop(2), 1
          if (associated(split%my_spins)) then
            start(2)  = split%my_spins(idim2)
          end if
          call etsf_io_low_write_var(ncid_to, "dielectric_function_head", &
                                   & folder%dielectric_function_head%data1D(istart:istart + len - 1), &
                                   & lstat, error_data = error_data, &
                                   & start = start, count = count, ncvarid = varids(2, nvarids))
          if (.not. lstat) then
            deallocate(folder%dielectric_function_head%data1D)
            deallocate(start, count, istop)
            deallocate(varids)
            call etsf_io_low_error_update(error_data, my_name)
            return
          end if
          istart = istart + len
        end do
      end do
      deallocate(start, count, istop)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "dielectric_function_head", &
                               & folder%dielectric_function_head%data1D, lstat, &
                               & error_data = error_data, ncvarid = varids(2, nvarids))
      if (.not. lstat) then
        deallocate(folder%dielectric_function_head%data1D)
        deallocate(varids)
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%dielectric_function_head%data1D)
  
  lstat = .true.
  ! Variable 'dielectric_function_lower_wing'
  !  allocate and read data
  allocate(folder%dielectric_function_lower_wing%data1D( &
    & dims%number_of_frequencies_dielectric_function * &
    & dims%number_of_qpoints_gamma_limit * &
    & dims%my_number_of_spins * &
    & dims%my_number_of_spins * &
    & dims%number_of_coefficients_dielectric_function * &
    & dims%complex))
  call etsf_io_low_read_var(ncid_from, "dielectric_function_lower_wing", &
                          & folder%dielectric_function_lower_wing%data1D, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%dielectric_function_lower_wing%data1D)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(6), count(6))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(6))
      istart   = 1
      len      = 1
      len = len * dims%number_of_frequencies_dielectric_function
      len = len * dims%number_of_qpoints_gamma_limit
      if (.not. associated(split%my_spins)) then
        istop(4)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(4) = size(split%my_spins)
        count(4) = 1
      end if
      if (.not. associated(split%my_spins)) then
        istop(3)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(3) = size(split%my_spins)
        count(3) = 1
      end if
      len = len * dims%number_of_coefficients_dielectric_function
      len = len * dims%complex
      do idim4 = 1, istop(4), 1
        if (associated(split%my_spins)) then
          start(4)  = split%my_spins(idim4)
        end if
        do idim3 = 1, istop(3), 1
          if (associated(split%my_spins)) then
            start(3)  = split%my_spins(idim3)
          end if
          call etsf_io_low_write_var(ncid_to, "dielectric_function_lower_wing", &
                                   & folder%dielectric_function_lower_wing%data1D(istart:istart + len - 1), &
                                   & lstat, error_data = error_data, &
                                   & start = start, count = count, ncvarid = varids(2, nvarids))
          if (.not. lstat) then
            deallocate(folder%dielectric_function_lower_wing%data1D)
            deallocate(start, count, istop)
            deallocate(varids)
            call etsf_io_low_error_update(error_data, my_name)
            return
          end if
          istart = istart + len
        end do
      end do
      deallocate(start, count, istop)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "dielectric_function_lower_wing", &
                               & folder%dielectric_function_lower_wing%data1D, lstat, &
                               & error_data = error_data, ncvarid = varids(2, nvarids))
      if (.not. lstat) then
        deallocate(folder%dielectric_function_lower_wing%data1D)
        deallocate(varids)
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%dielectric_function_lower_wing%data1D)
  
  lstat = .true.
  ! Variable 'dielectric_function_upper_wing'
  !  allocate and read data
  allocate(folder%dielectric_function_upper_wing%data1D( &
    & dims%number_of_frequencies_dielectric_function * &
    & dims%number_of_qpoints_gamma_limit * &
    & dims%my_number_of_spins * &
    & dims%my_number_of_spins * &
    & dims%number_of_coefficients_dielectric_function * &
    & dims%complex))
  call etsf_io_low_read_var(ncid_from, "dielectric_function_upper_wing", &
                          & folder%dielectric_function_upper_wing%data1D, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%dielectric_function_upper_wing%data1D)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(6), count(6))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(6))
      istart   = 1
      len      = 1
      len = len * dims%number_of_frequencies_dielectric_function
      len = len * dims%number_of_qpoints_gamma_limit
      if (.not. associated(split%my_spins)) then
        istop(4)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(4) = size(split%my_spins)
        count(4) = 1
      end if
      if (.not. associated(split%my_spins)) then
        istop(3)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(3) = size(split%my_spins)
        count(3) = 1
      end if
      len = len * dims%number_of_coefficients_dielectric_function
      len = len * dims%complex
      do idim4 = 1, istop(4), 1
        if (associated(split%my_spins)) then
          start(4)  = split%my_spins(idim4)
        end if
        do idim3 = 1, istop(3), 1
          if (associated(split%my_spins)) then
            start(3)  = split%my_spins(idim3)
          end if
          call etsf_io_low_write_var(ncid_to, "dielectric_function_upper_wing", &
                                   & folder%dielectric_function_upper_wing%data1D(istart:istart + len - 1), &
                                   & lstat, error_data = error_data, &
                                   & start = start, count = count, ncvarid = varids(2, nvarids))
          if (.not. lstat) then
            deallocate(folder%dielectric_function_upper_wing%data1D)
            deallocate(start, count, istop)
            deallocate(varids)
            call etsf_io_low_error_update(error_data, my_name)
            return
          end if
          istart = istart + len
        end do
      end do
      deallocate(start, count, istop)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "dielectric_function_upper_wing", &
                               & folder%dielectric_function_upper_wing%data1D, lstat, &
                               & error_data = error_data, ncvarid = varids(2, nvarids))
      if (.not. lstat) then
        deallocate(folder%dielectric_function_upper_wing%data1D)
        deallocate(varids)
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%dielectric_function_upper_wing%data1D)
  
  lstat = .true.
  ! Variable 'inverse_dielectric_function'
  !  allocate and read data
  allocate(folder%inverse_dielectric_function%data1D( &
    & dims%number_of_frequencies_dielectric_function * &
    & dims%number_of_qpoints_dielectric_function * &
    & dims%my_number_of_spins * &
    & dims%my_number_of_spins * &
    & dims%number_of_coefficients_dielectric_function * &
    & dims%number_of_coefficients_dielectric_function * &
    & dims%complex))
  call etsf_io_low_read_var(ncid_from, "inverse_dielectric_function", &
                          & folder%inverse_dielectric_function%data1D, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%inverse_dielectric_function%data1D)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(7), count(7))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(7))
      istart   = 1
      len      = 1
      len = len * dims%number_of_frequencies_dielectric_function
      len = len * dims%number_of_qpoints_dielectric_function
      if (.not. associated(split%my_spins)) then
        istop(5)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(5) = size(split%my_spins)
        count(5) = 1
      end if
      if (.not. associated(split%my_spins)) then
        istop(4)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(4) = size(split%my_spins)
        count(4) = 1
      end if
      len = len * dims%number_of_coefficients_dielectric_function
      len = len * dims%number_of_coefficients_dielectric_function
      len = len * dims%complex
      do idim5 = 1, istop(5), 1
        if (associated(split%my_spins)) then
          start(5)  = split%my_spins(idim5)
        end if
        do idim4 = 1, istop(4), 1
          if (associated(split%my_spins)) then
            start(4)  = split%my_spins(idim4)
          end if
          call etsf_io_low_write_var(ncid_to, "inverse_dielectric_function", &
                                   & folder%inverse_dielectric_function%data1D(istart:istart + len - 1), &
                                   & lstat, error_data = error_data, &
                                   & start = start, count = count, ncvarid = varids(2, nvarids))
          if (.not. lstat) then
            deallocate(folder%inverse_dielectric_function%data1D)
            deallocate(start, count, istop)
            deallocate(varids)
            call etsf_io_low_error_update(error_data, my_name)
            return
          end if
          istart = istart + len
        end do
      end do
      deallocate(start, count, istop)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "inverse_dielectric_function", &
                               & folder%inverse_dielectric_function%data1D, lstat, &
                               & error_data = error_data, ncvarid = varids(2, nvarids))
      if (.not. lstat) then
        deallocate(folder%inverse_dielectric_function%data1D)
        deallocate(varids)
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%inverse_dielectric_function%data1D)
  
  lstat = .true.
  ! Variable 'inverse_dielectric_function_head'
  !  allocate and read data
  allocate(folder%inverse_dielectric_function_head%data1D( &
    & dims%number_of_frequencies_dielectric_function * &
    & dims%number_of_qpoints_dielectric_function * &
    & dims%my_number_of_spins * &
    & dims%my_number_of_spins * &
    & dims%complex))
  call etsf_io_low_read_var(ncid_from, "inverse_dielectric_function_head", &
                          & folder%inverse_dielectric_function_head%data1D, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%inverse_dielectric_function_head%data1D)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(5), count(5))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(5))
      istart   = 1
      len      = 1
      len = len * dims%number_of_frequencies_dielectric_function
      len = len * dims%number_of_qpoints_dielectric_function
      if (.not. associated(split%my_spins)) then
        istop(3)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(3) = size(split%my_spins)
        count(3) = 1
      end if
      if (.not. associated(split%my_spins)) then
        istop(2)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(2) = size(split%my_spins)
        count(2) = 1
      end if
      len = len * dims%complex
      do idim3 = 1, istop(3), 1
        if (associated(split%my_spins)) then
          start(3)  = split%my_spins(idim3)
        end if
        do idim2 = 1, istop(2), 1
          if (associated(split%my_spins)) then
            start(2)  = split%my_spins(idim2)
          end if
          call etsf_io_low_write_var(ncid_to, "inverse_dielectric_function_head", &
                                   & folder%inverse_dielectric_function_head%data1D(istart:istart + len - 1), &
                                   & lstat, error_data = error_data, &
                                   & start = start, count = count, ncvarid = varids(2, nvarids))
          if (.not. lstat) then
            deallocate(folder%inverse_dielectric_function_head%data1D)
            deallocate(start, count, istop)
            deallocate(varids)
            call etsf_io_low_error_update(error_data, my_name)
            return
          end if
          istart = istart + len
        end do
      end do
      deallocate(start, count, istop)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "inverse_dielectric_function_head", &
                               & folder%inverse_dielectric_function_head%data1D, lstat, &
                               & error_data = error_data, ncvarid = varids(2, nvarids))
      if (.not. lstat) then
        deallocate(folder%inverse_dielectric_function_head%data1D)
        deallocate(varids)
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%inverse_dielectric_function_head%data1D)
  
  lstat = .true.
  ! Variable 'inverse_dielectric_function_lower_wing'
  !  allocate and read data
  allocate(folder%inverse_dielectric_function_lower_wing%data1D( &
    & dims%number_of_frequencies_dielectric_function * &
    & dims%number_of_qpoints_gamma_limit * &
    & dims%my_number_of_spins * &
    & dims%my_number_of_spins * &
    & dims%number_of_coefficients_dielectric_function * &
    & dims%complex))
  call etsf_io_low_read_var(ncid_from, "inverse_dielectric_function_lower_wing", &
                          & folder%inverse_dielectric_function_lower_wing%data1D, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%inverse_dielectric_function_lower_wing%data1D)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(6), count(6))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(6))
      istart   = 1
      len      = 1
      len = len * dims%number_of_frequencies_dielectric_function
      len = len * dims%number_of_qpoints_gamma_limit
      if (.not. associated(split%my_spins)) then
        istop(4)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(4) = size(split%my_spins)
        count(4) = 1
      end if
      if (.not. associated(split%my_spins)) then
        istop(3)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(3) = size(split%my_spins)
        count(3) = 1
      end if
      len = len * dims%number_of_coefficients_dielectric_function
      len = len * dims%complex
      do idim4 = 1, istop(4), 1
        if (associated(split%my_spins)) then
          start(4)  = split%my_spins(idim4)
        end if
        do idim3 = 1, istop(3), 1
          if (associated(split%my_spins)) then
            start(3)  = split%my_spins(idim3)
          end if
          call etsf_io_low_write_var(ncid_to, "inverse_dielectric_function_lower_wing", &
                                   & folder%inverse_dielectric_function_lower_wing%data1D(istart:istart + len - 1), &
                                   & lstat, error_data = error_data, &
                                   & start = start, count = count, ncvarid = varids(2, nvarids))
          if (.not. lstat) then
            deallocate(folder%inverse_dielectric_function_lower_wing%data1D)
            deallocate(start, count, istop)
            deallocate(varids)
            call etsf_io_low_error_update(error_data, my_name)
            return
          end if
          istart = istart + len
        end do
      end do
      deallocate(start, count, istop)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "inverse_dielectric_function_lower_wing", &
                               & folder%inverse_dielectric_function_lower_wing%data1D, lstat, &
                               & error_data = error_data, ncvarid = varids(2, nvarids))
      if (.not. lstat) then
        deallocate(folder%inverse_dielectric_function_lower_wing%data1D)
        deallocate(varids)
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%inverse_dielectric_function_lower_wing%data1D)
  
  lstat = .true.
  ! Variable 'inverse_dielectric_function_upper_wing'
  !  allocate and read data
  allocate(folder%inverse_dielectric_function_upper_wing%data1D( &
    & dims%number_of_frequencies_dielectric_function * &
    & dims%number_of_qpoints_gamma_limit * &
    & dims%my_number_of_spins * &
    & dims%my_number_of_spins * &
    & dims%number_of_coefficients_dielectric_function * &
    & dims%complex))
  call etsf_io_low_read_var(ncid_from, "inverse_dielectric_function_upper_wing", &
                          & folder%inverse_dielectric_function_upper_wing%data1D, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%inverse_dielectric_function_upper_wing%data1D)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(6), count(6))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(6))
      istart   = 1
      len      = 1
      len = len * dims%number_of_frequencies_dielectric_function
      len = len * dims%number_of_qpoints_gamma_limit
      if (.not. associated(split%my_spins)) then
        istop(4)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(4) = size(split%my_spins)
        count(4) = 1
      end if
      if (.not. associated(split%my_spins)) then
        istop(3)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(3) = size(split%my_spins)
        count(3) = 1
      end if
      len = len * dims%number_of_coefficients_dielectric_function
      len = len * dims%complex
      do idim4 = 1, istop(4), 1
        if (associated(split%my_spins)) then
          start(4)  = split%my_spins(idim4)
        end if
        do idim3 = 1, istop(3), 1
          if (associated(split%my_spins)) then
            start(3)  = split%my_spins(idim3)
          end if
          call etsf_io_low_write_var(ncid_to, "inverse_dielectric_function_upper_wing", &
                                   & folder%inverse_dielectric_function_upper_wing%data1D(istart:istart + len - 1), &
                                   & lstat, error_data = error_data, &
                                   & start = start, count = count, ncvarid = varids(2, nvarids))
          if (.not. lstat) then
            deallocate(folder%inverse_dielectric_function_upper_wing%data1D)
            deallocate(start, count, istop)
            deallocate(varids)
            call etsf_io_low_error_update(error_data, my_name)
            return
          end if
          istart = istart + len
        end do
      end do
      deallocate(start, count, istop)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "inverse_dielectric_function_upper_wing", &
                               & folder%inverse_dielectric_function_upper_wing%data1D, lstat, &
                               & error_data = error_data, ncvarid = varids(2, nvarids))
      if (.not. lstat) then
        deallocate(folder%inverse_dielectric_function_upper_wing%data1D)
        deallocate(varids)
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%inverse_dielectric_function_upper_wing%data1D)
  
  lstat = .true.
  ! Variable 'polarizability'
  !  allocate and read data
  allocate(folder%polarizability%data1D( &
    & dims%number_of_frequencies_dielectric_function * &
    & dims%number_of_qpoints_dielectric_function * &
    & dims%my_number_of_spins * &
    & dims%my_number_of_spins * &
    & dims%number_of_coefficients_dielectric_function * &
    & dims%number_of_coefficients_dielectric_function * &
    & dims%complex))
  call etsf_io_low_read_var(ncid_from, "polarizability", &
                          & folder%polarizability%data1D, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%polarizability%data1D)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(7), count(7))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(7))
      istart   = 1
      len      = 1
      len = len * dims%number_of_frequencies_dielectric_function
      len = len * dims%number_of_qpoints_dielectric_function
      if (.not. associated(split%my_spins)) then
        istop(5)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(5) = size(split%my_spins)
        count(5) = 1
      end if
      if (.not. associated(split%my_spins)) then
        istop(4)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(4) = size(split%my_spins)
        count(4) = 1
      end if
      len = len * dims%number_of_coefficients_dielectric_function
      len = len * dims%number_of_coefficients_dielectric_function
      len = len * dims%complex
      do idim5 = 1, istop(5), 1
        if (associated(split%my_spins)) then
          start(5)  = split%my_spins(idim5)
        end if
        do idim4 = 1, istop(4), 1
          if (associated(split%my_spins)) then
            start(4)  = split%my_spins(idim4)
          end if
          call etsf_io_low_write_var(ncid_to, "polarizability", &
                                   & folder%polarizability%data1D(istart:istart + len - 1), &
                                   & lstat, error_data = error_data, &
                                   & start = start, count = count, ncvarid = varids(2, nvarids))
          if (.not. lstat) then
            deallocate(folder%polarizability%data1D)
            deallocate(start, count, istop)
            deallocate(varids)
            call etsf_io_low_error_update(error_data, my_name)
            return
          end if
          istart = istart + len
        end do
      end do
      deallocate(start, count, istop)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "polarizability", &
                               & folder%polarizability%data1D, lstat, &
                               & error_data = error_data, ncvarid = varids(2, nvarids))
      if (.not. lstat) then
        deallocate(folder%polarizability%data1D)
        deallocate(varids)
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%polarizability%data1D)
  
  lstat = .true.
  ! Variable 'polarizability_head'
  !  allocate and read data
  allocate(folder%polarizability_head%data1D( &
    & dims%number_of_frequencies_dielectric_function * &
    & dims%number_of_qpoints_dielectric_function * &
    & dims%my_number_of_spins * &
    & dims%my_number_of_spins * &
    & dims%complex))
  call etsf_io_low_read_var(ncid_from, "polarizability_head", &
                          & folder%polarizability_head%data1D, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%polarizability_head%data1D)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(5), count(5))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(5))
      istart   = 1
      len      = 1
      len = len * dims%number_of_frequencies_dielectric_function
      len = len * dims%number_of_qpoints_dielectric_function
      if (.not. associated(split%my_spins)) then
        istop(3)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(3) = size(split%my_spins)
        count(3) = 1
      end if
      if (.not. associated(split%my_spins)) then
        istop(2)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(2) = size(split%my_spins)
        count(2) = 1
      end if
      len = len * dims%complex
      do idim3 = 1, istop(3), 1
        if (associated(split%my_spins)) then
          start(3)  = split%my_spins(idim3)
        end if
        do idim2 = 1, istop(2), 1
          if (associated(split%my_spins)) then
            start(2)  = split%my_spins(idim2)
          end if
          call etsf_io_low_write_var(ncid_to, "polarizability_head", &
                                   & folder%polarizability_head%data1D(istart:istart + len - 1), &
                                   & lstat, error_data = error_data, &
                                   & start = start, count = count, ncvarid = varids(2, nvarids))
          if (.not. lstat) then
            deallocate(folder%polarizability_head%data1D)
            deallocate(start, count, istop)
            deallocate(varids)
            call etsf_io_low_error_update(error_data, my_name)
            return
          end if
          istart = istart + len
        end do
      end do
      deallocate(start, count, istop)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "polarizability_head", &
                               & folder%polarizability_head%data1D, lstat, &
                               & error_data = error_data, ncvarid = varids(2, nvarids))
      if (.not. lstat) then
        deallocate(folder%polarizability_head%data1D)
        deallocate(varids)
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%polarizability_head%data1D)
  
  lstat = .true.
  ! Variable 'polarizability_lower_wing'
  !  allocate and read data
  allocate(folder%polarizability_lower_wing%data1D( &
    & dims%number_of_frequencies_dielectric_function * &
    & dims%number_of_qpoints_gamma_limit * &
    & dims%my_number_of_spins * &
    & dims%my_number_of_spins * &
    & dims%number_of_coefficients_dielectric_function * &
    & dims%complex))
  call etsf_io_low_read_var(ncid_from, "polarizability_lower_wing", &
                          & folder%polarizability_lower_wing%data1D, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%polarizability_lower_wing%data1D)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(6), count(6))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(6))
      istart   = 1
      len      = 1
      len = len * dims%number_of_frequencies_dielectric_function
      len = len * dims%number_of_qpoints_gamma_limit
      if (.not. associated(split%my_spins)) then
        istop(4)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(4) = size(split%my_spins)
        count(4) = 1
      end if
      if (.not. associated(split%my_spins)) then
        istop(3)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(3) = size(split%my_spins)
        count(3) = 1
      end if
      len = len * dims%number_of_coefficients_dielectric_function
      len = len * dims%complex
      do idim4 = 1, istop(4), 1
        if (associated(split%my_spins)) then
          start(4)  = split%my_spins(idim4)
        end if
        do idim3 = 1, istop(3), 1
          if (associated(split%my_spins)) then
            start(3)  = split%my_spins(idim3)
          end if
          call etsf_io_low_write_var(ncid_to, "polarizability_lower_wing", &
                                   & folder%polarizability_lower_wing%data1D(istart:istart + len - 1), &
                                   & lstat, error_data = error_data, &
                                   & start = start, count = count, ncvarid = varids(2, nvarids))
          if (.not. lstat) then
            deallocate(folder%polarizability_lower_wing%data1D)
            deallocate(start, count, istop)
            deallocate(varids)
            call etsf_io_low_error_update(error_data, my_name)
            return
          end if
          istart = istart + len
        end do
      end do
      deallocate(start, count, istop)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "polarizability_lower_wing", &
                               & folder%polarizability_lower_wing%data1D, lstat, &
                               & error_data = error_data, ncvarid = varids(2, nvarids))
      if (.not. lstat) then
        deallocate(folder%polarizability_lower_wing%data1D)
        deallocate(varids)
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%polarizability_lower_wing%data1D)
  
  lstat = .true.
  ! Variable 'polarizability_upper_wing'
  !  allocate and read data
  allocate(folder%polarizability_upper_wing%data1D( &
    & dims%number_of_frequencies_dielectric_function * &
    & dims%number_of_qpoints_gamma_limit * &
    & dims%my_number_of_spins * &
    & dims%my_number_of_spins * &
    & dims%number_of_coefficients_dielectric_function * &
    & dims%complex))
  call etsf_io_low_read_var(ncid_from, "polarizability_upper_wing", &
                          & folder%polarizability_upper_wing%data1D, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%polarizability_upper_wing%data1D)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(6), count(6))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(6))
      istart   = 1
      len      = 1
      len = len * dims%number_of_frequencies_dielectric_function
      len = len * dims%number_of_qpoints_gamma_limit
      if (.not. associated(split%my_spins)) then
        istop(4)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(4) = size(split%my_spins)
        count(4) = 1
      end if
      if (.not. associated(split%my_spins)) then
        istop(3)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(3) = size(split%my_spins)
        count(3) = 1
      end if
      len = len * dims%number_of_coefficients_dielectric_function
      len = len * dims%complex
      do idim4 = 1, istop(4), 1
        if (associated(split%my_spins)) then
          start(4)  = split%my_spins(idim4)
        end if
        do idim3 = 1, istop(3), 1
          if (associated(split%my_spins)) then
            start(3)  = split%my_spins(idim3)
          end if
          call etsf_io_low_write_var(ncid_to, "polarizability_upper_wing", &
                                   & folder%polarizability_upper_wing%data1D(istart:istart + len - 1), &
                                   & lstat, error_data = error_data, &
                                   & start = start, count = count, ncvarid = varids(2, nvarids))
          if (.not. lstat) then
            deallocate(folder%polarizability_upper_wing%data1D)
            deallocate(start, count, istop)
            deallocate(varids)
            call etsf_io_low_error_update(error_data, my_name)
            return
          end if
          istart = istart + len
        end do
      end do
      deallocate(start, count, istop)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "polarizability_upper_wing", &
                               & folder%polarizability_upper_wing%data1D, lstat, &
                               & error_data = error_data, ncvarid = varids(2, nvarids))
      if (.not. lstat) then
        deallocate(folder%polarizability_upper_wing%data1D)
        deallocate(varids)
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%polarizability_upper_wing%data1D)
  
  lstat = .true.
  ! Variable 'inverse_polarizability'
  !  allocate and read data
  allocate(folder%inverse_polarizability%data1D( &
    & dims%number_of_frequencies_dielectric_function * &
    & dims%number_of_qpoints_dielectric_function * &
    & dims%my_number_of_spins * &
    & dims%my_number_of_spins * &
    & dims%number_of_coefficients_dielectric_function * &
    & dims%number_of_coefficients_dielectric_function * &
    & dims%complex))
  call etsf_io_low_read_var(ncid_from, "inverse_polarizability", &
                          & folder%inverse_polarizability%data1D, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%inverse_polarizability%data1D)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(7), count(7))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(7))
      istart   = 1
      len      = 1
      len = len * dims%number_of_frequencies_dielectric_function
      len = len * dims%number_of_qpoints_dielectric_function
      if (.not. associated(split%my_spins)) then
        istop(5)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(5) = size(split%my_spins)
        count(5) = 1
      end if
      if (.not. associated(split%my_spins)) then
        istop(4)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(4) = size(split%my_spins)
        count(4) = 1
      end if
      len = len * dims%number_of_coefficients_dielectric_function
      len = len * dims%number_of_coefficients_dielectric_function
      len = len * dims%complex
      do idim5 = 1, istop(5), 1
        if (associated(split%my_spins)) then
          start(5)  = split%my_spins(idim5)
        end if
        do idim4 = 1, istop(4), 1
          if (associated(split%my_spins)) then
            start(4)  = split%my_spins(idim4)
          end if
          call etsf_io_low_write_var(ncid_to, "inverse_polarizability", &
                                   & folder%inverse_polarizability%data1D(istart:istart + len - 1), &
                                   & lstat, error_data = error_data, &
                                   & start = start, count = count, ncvarid = varids(2, nvarids))
          if (.not. lstat) then
            deallocate(folder%inverse_polarizability%data1D)
            deallocate(start, count, istop)
            deallocate(varids)
            call etsf_io_low_error_update(error_data, my_name)
            return
          end if
          istart = istart + len
        end do
      end do
      deallocate(start, count, istop)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "inverse_polarizability", &
                               & folder%inverse_polarizability%data1D, lstat, &
                               & error_data = error_data, ncvarid = varids(2, nvarids))
      if (.not. lstat) then
        deallocate(folder%inverse_polarizability%data1D)
        deallocate(varids)
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%inverse_polarizability%data1D)
  
  lstat = .true.
  ! Variable 'inverse_polarizability_head'
  !  allocate and read data
  allocate(folder%inverse_polarizability_head%data1D( &
    & dims%number_of_frequencies_dielectric_function * &
    & dims%number_of_qpoints_dielectric_function * &
    & dims%my_number_of_spins * &
    & dims%my_number_of_spins * &
    & dims%complex))
  call etsf_io_low_read_var(ncid_from, "inverse_polarizability_head", &
                          & folder%inverse_polarizability_head%data1D, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%inverse_polarizability_head%data1D)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(5), count(5))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(5))
      istart   = 1
      len      = 1
      len = len * dims%number_of_frequencies_dielectric_function
      len = len * dims%number_of_qpoints_dielectric_function
      if (.not. associated(split%my_spins)) then
        istop(3)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(3) = size(split%my_spins)
        count(3) = 1
      end if
      if (.not. associated(split%my_spins)) then
        istop(2)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(2) = size(split%my_spins)
        count(2) = 1
      end if
      len = len * dims%complex
      do idim3 = 1, istop(3), 1
        if (associated(split%my_spins)) then
          start(3)  = split%my_spins(idim3)
        end if
        do idim2 = 1, istop(2), 1
          if (associated(split%my_spins)) then
            start(2)  = split%my_spins(idim2)
          end if
          call etsf_io_low_write_var(ncid_to, "inverse_polarizability_head", &
                                   & folder%inverse_polarizability_head%data1D(istart:istart + len - 1), &
                                   & lstat, error_data = error_data, &
                                   & start = start, count = count, ncvarid = varids(2, nvarids))
          if (.not. lstat) then
            deallocate(folder%inverse_polarizability_head%data1D)
            deallocate(start, count, istop)
            deallocate(varids)
            call etsf_io_low_error_update(error_data, my_name)
            return
          end if
          istart = istart + len
        end do
      end do
      deallocate(start, count, istop)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "inverse_polarizability_head", &
                               & folder%inverse_polarizability_head%data1D, lstat, &
                               & error_data = error_data, ncvarid = varids(2, nvarids))
      if (.not. lstat) then
        deallocate(folder%inverse_polarizability_head%data1D)
        deallocate(varids)
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%inverse_polarizability_head%data1D)
  
  lstat = .true.
  ! Variable 'inverse_polarizability_lower_wing'
  !  allocate and read data
  allocate(folder%inverse_polarizability_lower_wing%data1D( &
    & dims%number_of_frequencies_dielectric_function * &
    & dims%number_of_qpoints_gamma_limit * &
    & dims%my_number_of_spins * &
    & dims%my_number_of_spins * &
    & dims%number_of_coefficients_dielectric_function * &
    & dims%complex))
  call etsf_io_low_read_var(ncid_from, "inverse_polarizability_lower_wing", &
                          & folder%inverse_polarizability_lower_wing%data1D, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%inverse_polarizability_lower_wing%data1D)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(6), count(6))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(6))
      istart   = 1
      len      = 1
      len = len * dims%number_of_frequencies_dielectric_function
      len = len * dims%number_of_qpoints_gamma_limit
      if (.not. associated(split%my_spins)) then
        istop(4)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(4) = size(split%my_spins)
        count(4) = 1
      end if
      if (.not. associated(split%my_spins)) then
        istop(3)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(3) = size(split%my_spins)
        count(3) = 1
      end if
      len = len * dims%number_of_coefficients_dielectric_function
      len = len * dims%complex
      do idim4 = 1, istop(4), 1
        if (associated(split%my_spins)) then
          start(4)  = split%my_spins(idim4)
        end if
        do idim3 = 1, istop(3), 1
          if (associated(split%my_spins)) then
            start(3)  = split%my_spins(idim3)
          end if
          call etsf_io_low_write_var(ncid_to, "inverse_polarizability_lower_wing", &
                                   & folder%inverse_polarizability_lower_wing%data1D(istart:istart + len - 1), &
                                   & lstat, error_data = error_data, &
                                   & start = start, count = count, ncvarid = varids(2, nvarids))
          if (.not. lstat) then
            deallocate(folder%inverse_polarizability_lower_wing%data1D)
            deallocate(start, count, istop)
            deallocate(varids)
            call etsf_io_low_error_update(error_data, my_name)
            return
          end if
          istart = istart + len
        end do
      end do
      deallocate(start, count, istop)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "inverse_polarizability_lower_wing", &
                               & folder%inverse_polarizability_lower_wing%data1D, lstat, &
                               & error_data = error_data, ncvarid = varids(2, nvarids))
      if (.not. lstat) then
        deallocate(folder%inverse_polarizability_lower_wing%data1D)
        deallocate(varids)
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%inverse_polarizability_lower_wing%data1D)
  
  lstat = .true.
  ! Variable 'inverse_polarizability_upper_wing'
  !  allocate and read data
  allocate(folder%inverse_polarizability_upper_wing%data1D( &
    & dims%number_of_frequencies_dielectric_function * &
    & dims%number_of_qpoints_gamma_limit * &
    & dims%my_number_of_spins * &
    & dims%my_number_of_spins * &
    & dims%number_of_coefficients_dielectric_function * &
    & dims%complex))
  call etsf_io_low_read_var(ncid_from, "inverse_polarizability_upper_wing", &
                          & folder%inverse_polarizability_upper_wing%data1D, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%inverse_polarizability_upper_wing%data1D)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(6), count(6))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(6))
      istart   = 1
      len      = 1
      len = len * dims%number_of_frequencies_dielectric_function
      len = len * dims%number_of_qpoints_gamma_limit
      if (.not. associated(split%my_spins)) then
        istop(4)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(4) = size(split%my_spins)
        count(4) = 1
      end if
      if (.not. associated(split%my_spins)) then
        istop(3)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(3) = size(split%my_spins)
        count(3) = 1
      end if
      len = len * dims%number_of_coefficients_dielectric_function
      len = len * dims%complex
      do idim4 = 1, istop(4), 1
        if (associated(split%my_spins)) then
          start(4)  = split%my_spins(idim4)
        end if
        do idim3 = 1, istop(3), 1
          if (associated(split%my_spins)) then
            start(3)  = split%my_spins(idim3)
          end if
          call etsf_io_low_write_var(ncid_to, "inverse_polarizability_upper_wing", &
                                   & folder%inverse_polarizability_upper_wing%data1D(istart:istart + len - 1), &
                                   & lstat, error_data = error_data, &
                                   & start = start, count = count, ncvarid = varids(2, nvarids))
          if (.not. lstat) then
            deallocate(folder%inverse_polarizability_upper_wing%data1D)
            deallocate(start, count, istop)
            deallocate(varids)
            call etsf_io_low_error_update(error_data, my_name)
            return
          end if
          istart = istart + len
        end do
      end do
      deallocate(start, count, istop)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "inverse_polarizability_upper_wing", &
                               & folder%inverse_polarizability_upper_wing%data1D, lstat, &
                               & error_data = error_data, ncvarid = varids(2, nvarids))
      if (.not. lstat) then
        deallocate(folder%inverse_polarizability_upper_wing%data1D)
        deallocate(varids)
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%inverse_polarizability_upper_wing%data1D)
  
  lstat = .true.
  
  ! We copy all the attributes (ETSF and non-ETSF) of the group variables.
  call etsf_io_low_set_define_mode(ncid_to, lstat, error_data = error_data)
  if (.not. lstat) nvarids = 0
  do len = 1, nvarids - 1, 1
    call etsf_io_low_copy_all_att(ncid_from, ncid_to, varids(1, len), varids(2, len), &
                                & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      exit
    end if
  end do
  deallocate(varids)

!DEBUG
!write (*,*) 'etsf_io_dielectric_copy : exit'
!ENDDEBUG

end subroutine etsf_io_dielectric_copy
etsf_io-1.0.3/doc/www/group_level/etsf_io_main_copy_f90.html0000644000353400050620000035370611354150415021051 00000000000000 ./src/group_level/etsf_io_main_copy.f90

TABLE OF CONTENTS

etsf_io_main_copy

[ Top ] [ etsf_main ] [ Methods ]

NAME

etsf_io_main_copy

FUNCTION

This routine copy all variable of a group from one file @ncid_from to another @ncid_to. If a variable is missing in the source file, this does not raise an error, it is simply skipped. But if a variable in the destination file is not defined, this will raise an error.

The copy is done per variable. This means that memory occupation is reduced during the copy.

Normally, copies are pristine copies. But if optional argument @split is given, then the read values are copied to the specified locations in split arrays. In that case, the destination variable must have a compatible definition with the split values.

INPUTS

  • ncid_to = integer returned by an 'open' NetCDF call. This id must have write access granted. It will be modified by the routine. The file must be in write mode (see etsf_io_low_set_write_mode()).
  • ncid_from = integer returned by an 'open' NetCDF call. This id must have read access granted. It will be left untouched.
  • dims <type(etsf_dims)> = these dimensions correspond to the source_file ones and are used to allocate temporary arrays in memory during the copy.
  • split <type(etsf_split)> = (optional) if this argument is given, the values in the split definition (e.g. my_kpoints) are used to put the data in the destination file in a bigger array at the right placed.

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_main_copy(ncid_to, ncid_from, dims, lstat, error_data, split)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid_to
  integer, intent(intent) :: ncid_from
  type(etsf_dims), intent(intent) :: dims
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data
  type(etsf_split), optional, intent(intent) :: split

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_main_copy'
  type(etsf_split) :: my_split
  integer,allocatable :: varids(:,:)
  integer :: nvarids
  integer,allocatable :: start(:)
  integer,allocatable :: count(:)
  integer :: len
  integer :: istart
  integer :: idim1,idim2,idim3,idim4,idim5,idim6,idim7,idim8
  integer,allocatable :: istop(:)
  integer,allocatable :: jstart(:)
  integer,allocatable :: jend(:)
  type(etsf_main) :: folder


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_main_copy : enter'
!ENDDEBUG

  lstat = .false.
  call etsf_io_low_set_write_mode(ncid_to, lstat, error_data = error_data)
  if (.not. lstat) return
  
  allocate(varids(2,6))
  nvarids = 1
  
  ! Variable 'density'
  !  allocate and read data
  allocate(folder%density%data1D( &
    & dims%my_number_of_components * &
    & dims%my_number_of_grid_points_vect3 * &
    & dims%my_number_of_grid_points_vect2 * &
    & dims%my_number_of_grid_points_vect1 * &
    & dims%real_or_complex_density))
  call etsf_io_low_read_var(ncid_from, "density", &
                          & folder%density%data1D, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%density%data1D)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(5), count(5))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(5))
      istart   = 1
      len      = 1
      if (.not. associated(split%my_components)) then
        istop(5)  = 1
        len = len * dims%my_number_of_components
      else
        istop(5) = size(split%my_components)
        count(5) = 1
      end if
      if (.not. associated(split%my_grid_points_vector3)) then
        istop(4)  = 1
        len = len * dims%my_number_of_grid_points_vect3
      else
        istop(4) = size(split%my_grid_points_vector3)
        count(4) = 1
      end if
      if (.not. associated(split%my_grid_points_vector2)) then
        istop(3)  = 1
        len = len * dims%my_number_of_grid_points_vect2
      else
        istop(3) = size(split%my_grid_points_vector2)
        count(3) = 1
      end if
      if (.not. associated(split%my_grid_points_vector1)) then
        istop(2)  = 1
        len = len * dims%my_number_of_grid_points_vect1
      else
        istop(2) = size(split%my_grid_points_vector1)
        count(2) = 1
      end if
      len = len * dims%real_or_complex_density
      do idim5 = 1, istop(5), 1
        if (associated(split%my_components)) then
          start(5)  = split%my_components(idim5)
        end if
        do idim4 = 1, istop(4), 1
          if (associated(split%my_grid_points_vector3)) then
            start(4)  = split%my_grid_points_vector3(idim4)
          end if
          do idim3 = 1, istop(3), 1
            if (associated(split%my_grid_points_vector2)) then
              start(3)  = split%my_grid_points_vector2(idim3)
            end if
            do idim2 = 1, istop(2), 1
              if (associated(split%my_grid_points_vector1)) then
                start(2)  = split%my_grid_points_vector1(idim2)
              end if
              call etsf_io_low_write_var(ncid_to, "density", &
                                       & folder%density%data1D(istart:istart + len - 1), &
                                       & lstat, error_data = error_data, &
                                       & start = start, count = count, ncvarid = varids(2, nvarids))
              if (.not. lstat) then
                deallocate(folder%density%data1D)
                deallocate(start, count, istop)
                deallocate(varids)
                call etsf_io_low_error_update(error_data, my_name)
                return
              end if
              istart = istart + len
            end do
          end do
        end do
      end do
      deallocate(start, count, istop)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "density", &
                               & folder%density%data1D, lstat, &
                               & error_data = error_data, ncvarid = varids(2, nvarids))
      if (.not. lstat) then
        deallocate(folder%density%data1D)
        deallocate(varids)
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%density%data1D)
  
  lstat = .true.
  ! Variable 'exchange_potential'
  !  allocate and read data
  allocate(folder%exchange_potential%data1D( &
    & dims%my_number_of_components * &
    & dims%my_number_of_grid_points_vect3 * &
    & dims%my_number_of_grid_points_vect2 * &
    & dims%my_number_of_grid_points_vect1 * &
    & dims%real_or_complex_potential))
  call etsf_io_low_read_var(ncid_from, "exchange_potential", &
                          & folder%exchange_potential%data1D, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%exchange_potential%data1D)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(5), count(5))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(5))
      istart   = 1
      len      = 1
      if (.not. associated(split%my_components)) then
        istop(5)  = 1
        len = len * dims%my_number_of_components
      else
        istop(5) = size(split%my_components)
        count(5) = 1
      end if
      if (.not. associated(split%my_grid_points_vector3)) then
        istop(4)  = 1
        len = len * dims%my_number_of_grid_points_vect3
      else
        istop(4) = size(split%my_grid_points_vector3)
        count(4) = 1
      end if
      if (.not. associated(split%my_grid_points_vector2)) then
        istop(3)  = 1
        len = len * dims%my_number_of_grid_points_vect2
      else
        istop(3) = size(split%my_grid_points_vector2)
        count(3) = 1
      end if
      if (.not. associated(split%my_grid_points_vector1)) then
        istop(2)  = 1
        len = len * dims%my_number_of_grid_points_vect1
      else
        istop(2) = size(split%my_grid_points_vector1)
        count(2) = 1
      end if
      len = len * dims%real_or_complex_potential
      do idim5 = 1, istop(5), 1
        if (associated(split%my_components)) then
          start(5)  = split%my_components(idim5)
        end if
        do idim4 = 1, istop(4), 1
          if (associated(split%my_grid_points_vector3)) then
            start(4)  = split%my_grid_points_vector3(idim4)
          end if
          do idim3 = 1, istop(3), 1
            if (associated(split%my_grid_points_vector2)) then
              start(3)  = split%my_grid_points_vector2(idim3)
            end if
            do idim2 = 1, istop(2), 1
              if (associated(split%my_grid_points_vector1)) then
                start(2)  = split%my_grid_points_vector1(idim2)
              end if
              call etsf_io_low_write_var(ncid_to, "exchange_potential", &
                                       & folder%exchange_potential%data1D(istart:istart + len - 1), &
                                       & lstat, error_data = error_data, &
                                       & start = start, count = count, ncvarid = varids(2, nvarids))
              if (.not. lstat) then
                deallocate(folder%exchange_potential%data1D)
                deallocate(start, count, istop)
                deallocate(varids)
                call etsf_io_low_error_update(error_data, my_name)
                return
              end if
              istart = istart + len
            end do
          end do
        end do
      end do
      deallocate(start, count, istop)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "exchange_potential", &
                               & folder%exchange_potential%data1D, lstat, &
                               & error_data = error_data, ncvarid = varids(2, nvarids))
      if (.not. lstat) then
        deallocate(folder%exchange_potential%data1D)
        deallocate(varids)
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%exchange_potential%data1D)
  
  lstat = .true.
  ! Variable 'correlation_potential'
  !  allocate and read data
  allocate(folder%correlation_potential%data1D( &
    & dims%my_number_of_components * &
    & dims%my_number_of_grid_points_vect3 * &
    & dims%my_number_of_grid_points_vect2 * &
    & dims%my_number_of_grid_points_vect1 * &
    & dims%real_or_complex_potential))
  call etsf_io_low_read_var(ncid_from, "correlation_potential", &
                          & folder%correlation_potential%data1D, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%correlation_potential%data1D)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(5), count(5))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(5))
      istart   = 1
      len      = 1
      if (.not. associated(split%my_components)) then
        istop(5)  = 1
        len = len * dims%my_number_of_components
      else
        istop(5) = size(split%my_components)
        count(5) = 1
      end if
      if (.not. associated(split%my_grid_points_vector3)) then
        istop(4)  = 1
        len = len * dims%my_number_of_grid_points_vect3
      else
        istop(4) = size(split%my_grid_points_vector3)
        count(4) = 1
      end if
      if (.not. associated(split%my_grid_points_vector2)) then
        istop(3)  = 1
        len = len * dims%my_number_of_grid_points_vect2
      else
        istop(3) = size(split%my_grid_points_vector2)
        count(3) = 1
      end if
      if (.not. associated(split%my_grid_points_vector1)) then
        istop(2)  = 1
        len = len * dims%my_number_of_grid_points_vect1
      else
        istop(2) = size(split%my_grid_points_vector1)
        count(2) = 1
      end if
      len = len * dims%real_or_complex_potential
      do idim5 = 1, istop(5), 1
        if (associated(split%my_components)) then
          start(5)  = split%my_components(idim5)
        end if
        do idim4 = 1, istop(4), 1
          if (associated(split%my_grid_points_vector3)) then
            start(4)  = split%my_grid_points_vector3(idim4)
          end if
          do idim3 = 1, istop(3), 1
            if (associated(split%my_grid_points_vector2)) then
              start(3)  = split%my_grid_points_vector2(idim3)
            end if
            do idim2 = 1, istop(2), 1
              if (associated(split%my_grid_points_vector1)) then
                start(2)  = split%my_grid_points_vector1(idim2)
              end if
              call etsf_io_low_write_var(ncid_to, "correlation_potential", &
                                       & folder%correlation_potential%data1D(istart:istart + len - 1), &
                                       & lstat, error_data = error_data, &
                                       & start = start, count = count, ncvarid = varids(2, nvarids))
              if (.not. lstat) then
                deallocate(folder%correlation_potential%data1D)
                deallocate(start, count, istop)
                deallocate(varids)
                call etsf_io_low_error_update(error_data, my_name)
                return
              end if
              istart = istart + len
            end do
          end do
        end do
      end do
      deallocate(start, count, istop)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "correlation_potential", &
                               & folder%correlation_potential%data1D, lstat, &
                               & error_data = error_data, ncvarid = varids(2, nvarids))
      if (.not. lstat) then
        deallocate(folder%correlation_potential%data1D)
        deallocate(varids)
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%correlation_potential%data1D)
  
  lstat = .true.
  ! Variable 'exchange_correlation_potential'
  !  allocate and read data
  allocate(folder%exchange_correlation_potential%data1D( &
    & dims%my_number_of_components * &
    & dims%my_number_of_grid_points_vect3 * &
    & dims%my_number_of_grid_points_vect2 * &
    & dims%my_number_of_grid_points_vect1 * &
    & dims%real_or_complex_potential))
  call etsf_io_low_read_var(ncid_from, "exchange_correlation_potential", &
                          & folder%exchange_correlation_potential%data1D, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%exchange_correlation_potential%data1D)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(5), count(5))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(5))
      istart   = 1
      len      = 1
      if (.not. associated(split%my_components)) then
        istop(5)  = 1
        len = len * dims%my_number_of_components
      else
        istop(5) = size(split%my_components)
        count(5) = 1
      end if
      if (.not. associated(split%my_grid_points_vector3)) then
        istop(4)  = 1
        len = len * dims%my_number_of_grid_points_vect3
      else
        istop(4) = size(split%my_grid_points_vector3)
        count(4) = 1
      end if
      if (.not. associated(split%my_grid_points_vector2)) then
        istop(3)  = 1
        len = len * dims%my_number_of_grid_points_vect2
      else
        istop(3) = size(split%my_grid_points_vector2)
        count(3) = 1
      end if
      if (.not. associated(split%my_grid_points_vector1)) then
        istop(2)  = 1
        len = len * dims%my_number_of_grid_points_vect1
      else
        istop(2) = size(split%my_grid_points_vector1)
        count(2) = 1
      end if
      len = len * dims%real_or_complex_potential
      do idim5 = 1, istop(5), 1
        if (associated(split%my_components)) then
          start(5)  = split%my_components(idim5)
        end if
        do idim4 = 1, istop(4), 1
          if (associated(split%my_grid_points_vector3)) then
            start(4)  = split%my_grid_points_vector3(idim4)
          end if
          do idim3 = 1, istop(3), 1
            if (associated(split%my_grid_points_vector2)) then
              start(3)  = split%my_grid_points_vector2(idim3)
            end if
            do idim2 = 1, istop(2), 1
              if (associated(split%my_grid_points_vector1)) then
                start(2)  = split%my_grid_points_vector1(idim2)
              end if
              call etsf_io_low_write_var(ncid_to, "exchange_correlation_potential", &
                                       & folder%exchange_correlation_potential%data1D(istart:istart + len - 1), &
                                       & lstat, error_data = error_data, &
                                       & start = start, count = count, ncvarid = varids(2, nvarids))
              if (.not. lstat) then
                deallocate(folder%exchange_correlation_potential%data1D)
                deallocate(start, count, istop)
                deallocate(varids)
                call etsf_io_low_error_update(error_data, my_name)
                return
              end if
              istart = istart + len
            end do
          end do
        end do
      end do
      deallocate(start, count, istop)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "exchange_correlation_potential", &
                               & folder%exchange_correlation_potential%data1D, lstat, &
                               & error_data = error_data, ncvarid = varids(2, nvarids))
      if (.not. lstat) then
        deallocate(folder%exchange_correlation_potential%data1D)
        deallocate(varids)
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%exchange_correlation_potential%data1D)
  
  lstat = .true.
  ! Variable 'coefficients_of_wavefunctions'
  !  allocate and read data
  allocate(folder%coefficients_of_wavefunctions%data1D( &
    & dims%my_number_of_spins * &
    & dims%my_number_of_kpoints * &
    & dims%my_max_number_of_states * &
    & dims%number_of_spinor_components * &
    & dims%my_max_number_of_coefficients * &
    & dims%real_or_complex_coefficients))
  call etsf_io_low_read_var(ncid_from, "coefficients_of_wavefunctions", &
                          & folder%coefficients_of_wavefunctions%data1D, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%coefficients_of_wavefunctions%data1D)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(6), count(6))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(6))
      istart   = 1
      len      = 1
      if (.not. associated(split%my_spins)) then
        istop(6)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(6) = size(split%my_spins)
        count(6) = 1
      end if
      if (.not. associated(split%my_kpoints)) then
        istop(5)  = 1
        len = len * dims%my_number_of_kpoints
      else
        istop(5) = size(split%my_kpoints)
        count(5) = 1
      end if
      if (.not. associated(split%my_states)) then
        istop(4)  = 1
        len = len * dims%my_max_number_of_states
      else
        istop(4) = size(split%my_states)
        count(4) = 1
      end if
      len = len * dims%number_of_spinor_components
      if (.not. associated(split%my_coefficients)) then
        istop(2)  = 1
        len = len * dims%my_max_number_of_coefficients
      else
        istop(2) = size(split%my_coefficients)
        count(2) = 1
      end if
      len = len * dims%real_or_complex_coefficients
      do idim6 = 1, istop(6), 1
        if (associated(split%my_spins)) then
          start(6)  = split%my_spins(idim6)
        end if
        do idim5 = 1, istop(5), 1
          if (associated(split%my_kpoints)) then
            start(5)  = split%my_kpoints(idim5)
          end if
          do idim4 = 1, istop(4), 1
            if (associated(split%my_states)) then
              start(4)  = split%my_states(idim4)
            end if
            do idim2 = 1, istop(2), 1
              if (associated(split%my_coefficients)) then
                start(2)  = split%my_coefficients(idim2)
              end if
              call etsf_io_low_write_var(ncid_to, "coefficients_of_wavefunctions", &
                                       & folder%coefficients_of_wavefunctions%data1D(istart:istart + len - 1), &
                                       & lstat, error_data = error_data, &
                                       & start = start, count = count, ncvarid = varids(2, nvarids))
              if (.not. lstat) then
                deallocate(folder%coefficients_of_wavefunctions%data1D)
                deallocate(start, count, istop)
                deallocate(varids)
                call etsf_io_low_error_update(error_data, my_name)
                return
              end if
              istart = istart + len
            end do
          end do
        end do
      end do
      deallocate(start, count, istop)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "coefficients_of_wavefunctions", &
                               & folder%coefficients_of_wavefunctions%data1D, lstat, &
                               & error_data = error_data, ncvarid = varids(2, nvarids))
      if (.not. lstat) then
        deallocate(folder%coefficients_of_wavefunctions%data1D)
        deallocate(varids)
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%coefficients_of_wavefunctions%data1D)
  
  lstat = .true.
  ! Variable 'real_space_wavefunctions'
  !  allocate and read data
  allocate(folder%real_space_wavefunctions%data1D( &
    & dims%my_number_of_spins * &
    & dims%my_number_of_kpoints * &
    & dims%my_max_number_of_states * &
    & dims%number_of_spinor_components * &
    & dims%my_number_of_grid_points_vect3 * &
    & dims%my_number_of_grid_points_vect2 * &
    & dims%my_number_of_grid_points_vect1 * &
    & dims%real_or_complex_wavefunctions))
  call etsf_io_low_read_var(ncid_from, "real_space_wavefunctions", &
                          & folder%real_space_wavefunctions%data1D, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%real_space_wavefunctions%data1D)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(8), count(8))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(8))
      istart   = 1
      len      = 1
      if (.not. associated(split%my_spins)) then
        istop(8)  = 1
        len = len * dims%my_number_of_spins
      else
        istop(8) = size(split%my_spins)
        count(8) = 1
      end if
      if (.not. associated(split%my_kpoints)) then
        istop(7)  = 1
        len = len * dims%my_number_of_kpoints
      else
        istop(7) = size(split%my_kpoints)
        count(7) = 1
      end if
      if (.not. associated(split%my_states)) then
        istop(6)  = 1
        len = len * dims%my_max_number_of_states
      else
        istop(6) = size(split%my_states)
        count(6) = 1
      end if
      len = len * dims%number_of_spinor_components
      if (.not. associated(split%my_grid_points_vector3)) then
        istop(4)  = 1
        len = len * dims%my_number_of_grid_points_vect3
      else
        istop(4) = size(split%my_grid_points_vector3)
        count(4) = 1
      end if
      if (.not. associated(split%my_grid_points_vector2)) then
        istop(3)  = 1
        len = len * dims%my_number_of_grid_points_vect2
      else
        istop(3) = size(split%my_grid_points_vector2)
        count(3) = 1
      end if
      if (.not. associated(split%my_grid_points_vector1)) then
        istop(2)  = 1
        len = len * dims%my_number_of_grid_points_vect1
      else
        istop(2) = size(split%my_grid_points_vector1)
        count(2) = 1
      end if
      len = len * dims%real_or_complex_wavefunctions
      do idim8 = 1, istop(8), 1
        if (associated(split%my_spins)) then
          start(8)  = split%my_spins(idim8)
        end if
        do idim7 = 1, istop(7), 1
          if (associated(split%my_kpoints)) then
            start(7)  = split%my_kpoints(idim7)
          end if
          do idim6 = 1, istop(6), 1
            if (associated(split%my_states)) then
              start(6)  = split%my_states(idim6)
            end if
            do idim4 = 1, istop(4), 1
              if (associated(split%my_grid_points_vector3)) then
                start(4)  = split%my_grid_points_vector3(idim4)
              end if
              do idim3 = 1, istop(3), 1
                if (associated(split%my_grid_points_vector2)) then
                  start(3)  = split%my_grid_points_vector2(idim3)
                end if
                do idim2 = 1, istop(2), 1
                  if (associated(split%my_grid_points_vector1)) then
                    start(2)  = split%my_grid_points_vector1(idim2)
                  end if
                  call etsf_io_low_write_var(ncid_to, "real_space_wavefunctions", &
                                           & folder%real_space_wavefunctions%data1D(istart:istart + len - 1), &
                                           & lstat, error_data = error_data, &
                                           & start = start, count = count, ncvarid = varids(2, nvarids))
                  if (.not. lstat) then
                    deallocate(folder%real_space_wavefunctions%data1D)
                    deallocate(start, count, istop)
                    deallocate(varids)
                    call etsf_io_low_error_update(error_data, my_name)
                    return
                  end if
                  istart = istart + len
                end do
              end do
            end do
          end do
        end do
      end do
      deallocate(start, count, istop)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "real_space_wavefunctions", &
                               & folder%real_space_wavefunctions%data1D, lstat, &
                               & error_data = error_data, ncvarid = varids(2, nvarids))
      if (.not. lstat) then
        deallocate(folder%real_space_wavefunctions%data1D)
        deallocate(varids)
        call etsf_io_low_error_update(error_data, my_name)
        return
      end if
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%real_space_wavefunctions%data1D)
  
  lstat = .true.
  
  ! We copy all the attributes (ETSF and non-ETSF) of the group variables.
  call etsf_io_low_set_define_mode(ncid_to, lstat, error_data = error_data)
  if (.not. lstat) nvarids = 0
  do len = 1, nvarids - 1, 1
    call etsf_io_low_copy_all_att(ncid_from, ncid_to, varids(1, len), varids(2, len), &
                                & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      exit
    end if
  end do
  deallocate(varids)

!DEBUG
!write (*,*) 'etsf_io_main_copy : exit'
!ENDDEBUG

end subroutine etsf_io_main_copy
etsf_io-1.0.3/doc/www/group_level/etsf_io_split_init_f90.html0000644000353400050620000002643711354150414021246 00000000000000 ./src/group_level/etsf_io_split_init.f90

TABLE OF CONTENTS

etsf_io_split_init

[ Top ] [ etsf_split ] [ Methods ]

NAME

etsf_io_split_init

FUNCTION

This routine is used to set the dimensions from a split defintion. It copies to @dims%my_<something> the size of associated arrays in @split_definition.

INPUTS

  • split_definition <type(etsf_split)> = give for each associated array the number of elements (given by the size) and the values of these elements in a splitted file.

SIDE EFFECTS

  • dims <type(etsf_dims)> = will be changed according to the @split argument. For each allocated array in @split, their corresponding dimension will be put to the array size ; else, the none-split value is used.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_split_init(dims, split_definition)

  !Arguments ------------------------------------
  type(etsf_dims), intent(inout) :: dims
  type(etsf_split), intent(intent) :: split_definition

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_split_init'


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_split_init : enter'
!ENDDEBUG

  if (associated(split_definition%my_kpoints)) then
    dims%my_number_of_kpoints = &
      & size(split_definition%my_kpoints)
  else
    dims%my_number_of_kpoints = &
      & dims%number_of_kpoints
  end if
  if (associated(split_definition%my_grid_points_vector3)) then
    dims%my_number_of_grid_points_vect3 = &
      & size(split_definition%my_grid_points_vector3)
  else
    dims%my_number_of_grid_points_vect3 = &
      & dims%number_of_grid_points_vector3
  end if
  if (associated(split_definition%my_spins)) then
    dims%my_number_of_spins = &
      & size(split_definition%my_spins)
  else
    dims%my_number_of_spins = &
      & dims%number_of_spins
  end if
  if (associated(split_definition%my_grid_points_vector1)) then
    dims%my_number_of_grid_points_vect1 = &
      & size(split_definition%my_grid_points_vector1)
  else
    dims%my_number_of_grid_points_vect1 = &
      & dims%number_of_grid_points_vector1
  end if
  if (associated(split_definition%my_grid_points_vector2)) then
    dims%my_number_of_grid_points_vect2 = &
      & size(split_definition%my_grid_points_vector2)
  else
    dims%my_number_of_grid_points_vect2 = &
      & dims%number_of_grid_points_vector2
  end if
  if (associated(split_definition%my_coefficients)) then
    dims%my_max_number_of_coefficients = &
      & size(split_definition%my_coefficients)
  else
    dims%my_max_number_of_coefficients = &
      & dims%max_number_of_coefficients
  end if
  if (associated(split_definition%my_components)) then
    dims%my_number_of_components = &
      & size(split_definition%my_components)
  else
    dims%my_number_of_components = &
      & dims%number_of_components
  end if
  if (associated(split_definition%my_states)) then
    dims%my_max_number_of_states = &
      & size(split_definition%my_states)
  else
    dims%my_max_number_of_states = &
      & dims%max_number_of_states
  end if


!DEBUG
!write (*,*) 'etsf_io_split_init : exit'
!ENDDEBUG

end subroutine etsf_io_split_init
etsf_io-1.0.3/doc/www/group_level/etsf_io_split_allocate_f90.html0000644000353400050620000003241211354150414022055 00000000000000 ./src/group_level/etsf_io_split_allocate.f90

TABLE OF CONTENTS

etsf_io_split_allocate

[ Top ] [ etsf_split ] [ Methods ]

NAME

etsf_io_split_allocate

FUNCTION

Allocate internal pointers of structure etsf_split given the dimensions in @dims. The split arrays are allocated only if the associated dimensions are different from etsf_no_dimension (see ETSF_IO_CONSTANTS) and from the associated full dimension. To free a split structure, use etsf_io_split_free().

INPUTS

  • dims <type(etsf_dims)> = these dimensions define which arrays of argument @split should be allocated ; it give also the size for these arrays.

OUTPUT

  • split <type(etsf_split)> = read the @dims argument to allocate the required split arrays, use etsf_io_split_free() when the split structure is not needed anymore.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_split_allocate(split, dims)

  !Arguments ------------------------------------
  type(etsf_split), intent(out) :: split
  type(etsf_dims), intent(intent) :: dims

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_split_allocate'


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_split_allocate : enter'
!ENDDEBUG

  if (dims%my_number_of_kpoints /= etsf_no_dimension .and. &
    & dims%my_number_of_kpoints /= dims%number_of_kpoints) then 
    allocate(split%my_kpoints(dims%my_number_of_kpoints))
    split%my_kpoints(:) = -1
  end if
  if (dims%my_number_of_grid_points_vect3 /= etsf_no_dimension .and. &
    & dims%my_number_of_grid_points_vect3 /= dims%number_of_grid_points_vector3) then 
    allocate(split%my_grid_points_vector3(dims%my_number_of_grid_points_vect3))
    split%my_grid_points_vector3(:) = -1
  end if
  if (dims%my_number_of_spins /= etsf_no_dimension .and. &
    & dims%my_number_of_spins /= dims%number_of_spins) then 
    allocate(split%my_spins(dims%my_number_of_spins))
    split%my_spins(:) = -1
  end if
  if (dims%my_number_of_grid_points_vect1 /= etsf_no_dimension .and. &
    & dims%my_number_of_grid_points_vect1 /= dims%number_of_grid_points_vector1) then 
    allocate(split%my_grid_points_vector1(dims%my_number_of_grid_points_vect1))
    split%my_grid_points_vector1(:) = -1
  end if
  if (dims%my_number_of_grid_points_vect2 /= etsf_no_dimension .and. &
    & dims%my_number_of_grid_points_vect2 /= dims%number_of_grid_points_vector2) then 
    allocate(split%my_grid_points_vector2(dims%my_number_of_grid_points_vect2))
    split%my_grid_points_vector2(:) = -1
  end if
  if (dims%my_max_number_of_coefficients /= etsf_no_dimension .and. &
    & dims%my_max_number_of_coefficients /= dims%max_number_of_coefficients) then 
    allocate(split%my_coefficients(dims%my_max_number_of_coefficients))
    split%my_coefficients(:) = -1
  end if
  if (dims%my_number_of_components /= etsf_no_dimension .and. &
    & dims%my_number_of_components /= dims%number_of_components) then 
    allocate(split%my_components(dims%my_number_of_components))
    split%my_components(:) = -1
  end if
  if (dims%my_max_number_of_states /= etsf_no_dimension .and. &
    & dims%my_max_number_of_states /= dims%max_number_of_states) then 
    allocate(split%my_states(dims%my_max_number_of_states))
    split%my_states(:) = -1
  end if


!DEBUG
!write (*,*) 'etsf_io_split_allocate : exit'
!ENDDEBUG

end subroutine etsf_io_split_allocate
etsf_io-1.0.3/doc/www/group_level/etsf_io_split_free_f90.html0000644000353400050620000001660311354150414021216 00000000000000 ./src/group_level/etsf_io_split_free.f90

TABLE OF CONTENTS

etsf_io_split_free

[ Top ] [ etsf_split ] [ Methods ]

NAME

etsf_io_split_free

FUNCTION

Deallocate a split defintions, previously allocated with etsf_io_split_allocate().

SIDE EFFECTS

  • split <type(etsf_split)> = free all associated array in the split definition.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_split_free(split)

  !Arguments ------------------------------------
  type(etsf_split), intent(inout) :: split

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_split_free'


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_split_free : enter'
!ENDDEBUG

  if (associated(split%my_kpoints)) then
    deallocate(split%my_kpoints)
  end if
  if (associated(split%my_grid_points_vector3)) then
    deallocate(split%my_grid_points_vector3)
  end if
  if (associated(split%my_spins)) then
    deallocate(split%my_spins)
  end if
  if (associated(split%my_grid_points_vector1)) then
    deallocate(split%my_grid_points_vector1)
  end if
  if (associated(split%my_grid_points_vector2)) then
    deallocate(split%my_grid_points_vector2)
  end if
  if (associated(split%my_coefficients)) then
    deallocate(split%my_coefficients)
  end if
  if (associated(split%my_components)) then
    deallocate(split%my_components)
  end if
  if (associated(split%my_states)) then
    deallocate(split%my_states)
  end if


!DEBUG
!write (*,*) 'etsf_io_split_free : exit'
!ENDDEBUG

end subroutine etsf_io_split_free
etsf_io-1.0.3/doc/www/group_level/etsf_io_split_def_f90.html0000644000353400050620000004634311354150414021037 00000000000000 ./src/group_level/etsf_io_split_def.f90

TABLE OF CONTENTS

etsf_io_split_def

[ Top ] [ etsf_split ] [ Methods ]

NAME

etsf_io_split_def

FUNCTION

Create arrays for split definitions. They are defined only if their dimensions (my_<something>) are different from etsf_no_dimension (see ETSF_IO_CONSTANTS) or from the value of dimension <something>.

INPUTS

  • ncid = integer returned by an 'open' NetCDF call. The file can be either in define or write mode. This status can be changed by the call.
  • dims <type(etsf_dims)> = contains all the dimensions required by the special my_something arrays.

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_split_def(ncid, dims, lstat, error_data)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid
  type(etsf_dims), intent(intent) :: dims
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_split_def'


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_split_def : enter'
!ENDDEBUG

  if (dims%my_number_of_kpoints /= etsf_no_dimension .and. &
    & dims%my_number_of_kpoints /= dims%number_of_kpoints) then 
    call etsf_io_low_def_var(ncid, "my_kpoints", &
      & etsf_io_low_integer, &
      & (/ pad("my_number_of_kpoints") /), &
      & lstat, error_data = error_data)
    if (.not. lstat) return
  end if
  if (dims%my_number_of_grid_points_vect3 /= etsf_no_dimension .and. &
    & dims%my_number_of_grid_points_vect3 /= dims%number_of_grid_points_vector3) then 
    call etsf_io_low_def_var(ncid, "my_grid_points_vector3", &
      & etsf_io_low_integer, &
      & (/ pad("my_number_of_grid_points_vector3") /), &
      & lstat, error_data = error_data)
    if (.not. lstat) return
  end if
  if (dims%my_number_of_spins /= etsf_no_dimension .and. &
    & dims%my_number_of_spins /= dims%number_of_spins) then 
    call etsf_io_low_def_var(ncid, "my_spins", &
      & etsf_io_low_integer, &
      & (/ pad("my_number_of_spins") /), &
      & lstat, error_data = error_data)
    if (.not. lstat) return
  end if
  if (dims%my_number_of_grid_points_vect1 /= etsf_no_dimension .and. &
    & dims%my_number_of_grid_points_vect1 /= dims%number_of_grid_points_vector1) then 
    call etsf_io_low_def_var(ncid, "my_grid_points_vector1", &
      & etsf_io_low_integer, &
      & (/ pad("my_number_of_grid_points_vector1") /), &
      & lstat, error_data = error_data)
    if (.not. lstat) return
  end if
  if (dims%my_number_of_grid_points_vect2 /= etsf_no_dimension .and. &
    & dims%my_number_of_grid_points_vect2 /= dims%number_of_grid_points_vector2) then 
    call etsf_io_low_def_var(ncid, "my_grid_points_vector2", &
      & etsf_io_low_integer, &
      & (/ pad("my_number_of_grid_points_vector2") /), &
      & lstat, error_data = error_data)
    if (.not. lstat) return
  end if
  if (dims%my_max_number_of_coefficients /= etsf_no_dimension .and. &
    & dims%my_max_number_of_coefficients /= dims%max_number_of_coefficients) then 
    call etsf_io_low_def_var(ncid, "my_coefficients", &
      & etsf_io_low_integer, &
      & (/ pad("my_max_number_of_coefficients") /), &
      & lstat, error_data = error_data)
    if (.not. lstat) return
  end if
  if (dims%my_number_of_components /= etsf_no_dimension .and. &
    & dims%my_number_of_components /= dims%number_of_components) then 
    call etsf_io_low_def_var(ncid, "my_components", &
      & etsf_io_low_integer, &
      & (/ pad("my_number_of_components") /), &
      & lstat, error_data = error_data)
    if (.not. lstat) return
  end if
  if (dims%my_max_number_of_states /= etsf_no_dimension .and. &
    & dims%my_max_number_of_states /= dims%max_number_of_states) then 
    call etsf_io_low_def_var(ncid, "my_states", &
      & etsf_io_low_integer, &
      & (/ pad("my_max_number_of_states") /), &
      & lstat, error_data = error_data)
    if (.not. lstat) return
  end if


!DEBUG
!write (*,*) 'etsf_io_split_def : exit'
!ENDDEBUG

end subroutine etsf_io_split_def
etsf_io-1.0.3/doc/www/group_level/etsf_io_split_get_f90.html0000644000353400050620000003442311354150414021054 00000000000000 ./src/group_level/etsf_io_split_get.f90

TABLE OF CONTENTS

etsf_io_split_get

[ Top ] [ etsf_split ] [ Methods ]

NAME

etsf_io_split_get

FUNCTION

Read the split defintions from a file. Only associated pointers from the @split structure will be read.

INPUTS

  • ncid = integer returned by an 'open' NetCDF call. The file can be either in define or write mode. This status can be changed by the call.

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

SIDE EFFECTS

  • split <type(etsf_split)> = read from the disk the values of each associated array of @split.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_split_get(ncid, split, lstat, error_data)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid
  type(etsf_split), intent(inout) :: split
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_split_get'


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_split_get : enter'
!ENDDEBUG

  if (associated(split%my_kpoints)) then
    call etsf_io_low_read_var(ncid, "my_kpoints", &
                            & split%my_kpoints, &
                            & lstat, error_data = error_data)
    if (.not. lstat) return
  end if
  if (associated(split%my_grid_points_vector3)) then
    call etsf_io_low_read_var(ncid, "my_grid_points_vector3", &
                            & split%my_grid_points_vector3, &
                            & lstat, error_data = error_data)
    if (.not. lstat) return
  end if
  if (associated(split%my_spins)) then
    call etsf_io_low_read_var(ncid, "my_spins", &
                            & split%my_spins, &
                            & lstat, error_data = error_data)
    if (.not. lstat) return
  end if
  if (associated(split%my_grid_points_vector1)) then
    call etsf_io_low_read_var(ncid, "my_grid_points_vector1", &
                            & split%my_grid_points_vector1, &
                            & lstat, error_data = error_data)
    if (.not. lstat) return
  end if
  if (associated(split%my_grid_points_vector2)) then
    call etsf_io_low_read_var(ncid, "my_grid_points_vector2", &
                            & split%my_grid_points_vector2, &
                            & lstat, error_data = error_data)
    if (.not. lstat) return
  end if
  if (associated(split%my_coefficients)) then
    call etsf_io_low_read_var(ncid, "my_coefficients", &
                            & split%my_coefficients, &
                            & lstat, error_data = error_data)
    if (.not. lstat) return
  end if
  if (associated(split%my_components)) then
    call etsf_io_low_read_var(ncid, "my_components", &
                            & split%my_components, &
                            & lstat, error_data = error_data)
    if (.not. lstat) return
  end if
  if (associated(split%my_states)) then
    call etsf_io_low_read_var(ncid, "my_states", &
                            & split%my_states, &
                            & lstat, error_data = error_data)
    if (.not. lstat) return
  end if


!DEBUG
!write (*,*) 'etsf_io_split_get : exit'
!ENDDEBUG

end subroutine etsf_io_split_get
etsf_io-1.0.3/doc/www/group_level/etsf_io_split_put_f90.html0000644000353400050620000003427011354150414021105 00000000000000 ./src/group_level/etsf_io_split_put.f90

TABLE OF CONTENTS

etsf_io_split_put

[ Top ] [ etsf_split ] [ Methods ]

NAME

etsf_io_split_put

FUNCTION

Simply write the split definition (of associated pointers) to the file.

INPUTS

  • ncid = integer returned by an 'open' NetCDF call. The file can be either in define or write mode. This status can be changed by the call.
  • split <type(etsf_split)> = copy the allocated arrays from this argument to the disk.

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_split_put(ncid, split, lstat, error_data)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid
  type(etsf_split), intent(intent) :: split
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_split_put'


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_split_put : enter'
!ENDDEBUG

  if (associated(split%my_kpoints)) then
    call etsf_io_low_write_var(ncid, "my_kpoints", &
                            & split%my_kpoints, &
                            & lstat, error_data = error_data)
    if (.not. lstat) return
  end if
  if (associated(split%my_grid_points_vector3)) then
    call etsf_io_low_write_var(ncid, "my_grid_points_vector3", &
                            & split%my_grid_points_vector3, &
                            & lstat, error_data = error_data)
    if (.not. lstat) return
  end if
  if (associated(split%my_spins)) then
    call etsf_io_low_write_var(ncid, "my_spins", &
                            & split%my_spins, &
                            & lstat, error_data = error_data)
    if (.not. lstat) return
  end if
  if (associated(split%my_grid_points_vector1)) then
    call etsf_io_low_write_var(ncid, "my_grid_points_vector1", &
                            & split%my_grid_points_vector1, &
                            & lstat, error_data = error_data)
    if (.not. lstat) return
  end if
  if (associated(split%my_grid_points_vector2)) then
    call etsf_io_low_write_var(ncid, "my_grid_points_vector2", &
                            & split%my_grid_points_vector2, &
                            & lstat, error_data = error_data)
    if (.not. lstat) return
  end if
  if (associated(split%my_coefficients)) then
    call etsf_io_low_write_var(ncid, "my_coefficients", &
                            & split%my_coefficients, &
                            & lstat, error_data = error_data)
    if (.not. lstat) return
  end if
  if (associated(split%my_components)) then
    call etsf_io_low_write_var(ncid, "my_components", &
                            & split%my_components, &
                            & lstat, error_data = error_data)
    if (.not. lstat) return
  end if
  if (associated(split%my_states)) then
    call etsf_io_low_write_var(ncid, "my_states", &
                            & split%my_states, &
                            & lstat, error_data = error_data)
    if (.not. lstat) return
  end if


!DEBUG
!write (*,*) 'etsf_io_split_put : exit'
!ENDDEBUG

end subroutine etsf_io_split_put
etsf_io-1.0.3/doc/www/group_level/etsf_io_split_copy_f90.html0000644000353400050620000010012511354150414021240 00000000000000 ./src/group_level/etsf_io_split_copy.f90

TABLE OF CONTENTS

etsf_io_split_copy

[ Top ] [ etsf_split ] [ Methods ]

NAME

etsf_io_split_copy

FUNCTION

As for etsf_io_electrons_copy() for instance, it copy all values from split definitions of file @ncid_from to file @ncid_to. Arrays are copied only if their dimensions are neither etsf_no_dimension (see ETSF_IO_CONSTANTS) nor the associated full dimension value. The arrays in @ncid_to must already be defined, use etsf_io_split_def() to do it.

INPUTS

  • ncid_to = integer returned by an 'open' NetCDF call. This id must have write access granted. It will be modified by the routine. The file must be in write mode (see etsf_io_low_set_write_mode()).
  • ncid_from = integer returned by an 'open' NetCDF call. This id must have read access granted. It will be left untouched.
  • dims <type(etsf_dims)> = the special split arrays are copied if their corresponding dimension, read from @dims, are different from etsf_no_dimension and different from their non-split value.

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_split_copy(ncid_to, ncid_from, dims, lstat, error_data)

  !Arguments ------------------------------------
  integer, intent(intent) :: ncid_to
  integer, intent(intent) :: ncid_from
  type(etsf_dims), intent(intent) :: dims
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_split_copy'
  integer,allocatable :: split_array(:)


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_split_copy : enter'
!ENDDEBUG

  if (dims%my_number_of_kpoints /= etsf_no_dimension .and. &
    & dims%my_number_of_kpoints /= dims%number_of_kpoints) then 
    allocate(split_array(dims%my_number_of_kpoints))
    call etsf_io_low_read_var(ncid_from, "my_kpoints", &
                            & split_array, lstat, error_data = error_data)
    if (.not. lstat) then
      deallocate(split_array)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    call etsf_io_low_write_var(ncid_to, "my_kpoints", &
                             & split_array, lstat, error_data = error_data)
    if (.not. lstat) then
      deallocate(split_array)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    deallocate(split_array)
  end if
  if (dims%my_number_of_grid_points_vect3 /= etsf_no_dimension .and. &
    & dims%my_number_of_grid_points_vect3 /= dims%number_of_grid_points_vector3) then 
    allocate(split_array(dims%my_number_of_grid_points_vect3))
    call etsf_io_low_read_var(ncid_from, "my_grid_points_vector3", &
                            & split_array, lstat, error_data = error_data)
    if (.not. lstat) then
      deallocate(split_array)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    call etsf_io_low_write_var(ncid_to, "my_grid_points_vector3", &
                             & split_array, lstat, error_data = error_data)
    if (.not. lstat) then
      deallocate(split_array)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    deallocate(split_array)
  end if
  if (dims%my_number_of_spins /= etsf_no_dimension .and. &
    & dims%my_number_of_spins /= dims%number_of_spins) then 
    allocate(split_array(dims%my_number_of_spins))
    call etsf_io_low_read_var(ncid_from, "my_spins", &
                            & split_array, lstat, error_data = error_data)
    if (.not. lstat) then
      deallocate(split_array)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    call etsf_io_low_write_var(ncid_to, "my_spins", &
                             & split_array, lstat, error_data = error_data)
    if (.not. lstat) then
      deallocate(split_array)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    deallocate(split_array)
  end if
  if (dims%my_number_of_grid_points_vect1 /= etsf_no_dimension .and. &
    & dims%my_number_of_grid_points_vect1 /= dims%number_of_grid_points_vector1) then 
    allocate(split_array(dims%my_number_of_grid_points_vect1))
    call etsf_io_low_read_var(ncid_from, "my_grid_points_vector1", &
                            & split_array, lstat, error_data = error_data)
    if (.not. lstat) then
      deallocate(split_array)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    call etsf_io_low_write_var(ncid_to, "my_grid_points_vector1", &
                             & split_array, lstat, error_data = error_data)
    if (.not. lstat) then
      deallocate(split_array)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    deallocate(split_array)
  end if
  if (dims%my_number_of_grid_points_vect2 /= etsf_no_dimension .and. &
    & dims%my_number_of_grid_points_vect2 /= dims%number_of_grid_points_vector2) then 
    allocate(split_array(dims%my_number_of_grid_points_vect2))
    call etsf_io_low_read_var(ncid_from, "my_grid_points_vector2", &
                            & split_array, lstat, error_data = error_data)
    if (.not. lstat) then
      deallocate(split_array)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    call etsf_io_low_write_var(ncid_to, "my_grid_points_vector2", &
                             & split_array, lstat, error_data = error_data)
    if (.not. lstat) then
      deallocate(split_array)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    deallocate(split_array)
  end if
  if (dims%my_max_number_of_coefficients /= etsf_no_dimension .and. &
    & dims%my_max_number_of_coefficients /= dims%max_number_of_coefficients) then 
    allocate(split_array(dims%my_max_number_of_coefficients))
    call etsf_io_low_read_var(ncid_from, "my_coefficients", &
                            & split_array, lstat, error_data = error_data)
    if (.not. lstat) then
      deallocate(split_array)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    call etsf_io_low_write_var(ncid_to, "my_coefficients", &
                             & split_array, lstat, error_data = error_data)
    if (.not. lstat) then
      deallocate(split_array)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    deallocate(split_array)
  end if
  if (dims%my_number_of_components /= etsf_no_dimension .and. &
    & dims%my_number_of_components /= dims%number_of_components) then 
    allocate(split_array(dims%my_number_of_components))
    call etsf_io_low_read_var(ncid_from, "my_components", &
                            & split_array, lstat, error_data = error_data)
    if (.not. lstat) then
      deallocate(split_array)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    call etsf_io_low_write_var(ncid_to, "my_components", &
                             & split_array, lstat, error_data = error_data)
    if (.not. lstat) then
      deallocate(split_array)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    deallocate(split_array)
  end if
  if (dims%my_max_number_of_states /= etsf_no_dimension .and. &
    & dims%my_max_number_of_states /= dims%max_number_of_states) then 
    allocate(split_array(dims%my_max_number_of_states))
    call etsf_io_low_read_var(ncid_from, "my_states", &
                            & split_array, lstat, error_data = error_data)
    if (.not. lstat) then
      deallocate(split_array)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    call etsf_io_low_write_var(ncid_to, "my_states", &
                             & split_array, lstat, error_data = error_data)
    if (.not. lstat) then
      deallocate(split_array)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    deallocate(split_array)
  end if


!DEBUG
!write (*,*) 'etsf_io_split_copy : exit'
!ENDDEBUG

end subroutine etsf_io_split_copy
etsf_io-1.0.3/doc/www/group_level/etsf_io_split_merge_f90.html0000644000353400050620000012254311354150414021375 00000000000000 ./src/group_level/etsf_io_split_merge.f90

TABLE OF CONTENTS

etsf_io_split_merge

[ Top ] [ etsf_split ] [ Methods ]

NAME

etsf_io_split_merge

FUNCTION

This is a complex routine that create a larger split definition (@output_split) from an input split definition (@split). For each associated array in @split, it copies all values of this array into the corresponding array in @output_split. The position in the corresponding array is the first unused index (i.e. with a negative value).

The input @split definition is then modified to reflect the new position of values in @output_split.

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

SIDE EFFECTS

  • output_split <type(etsf_split)> =
  • split <type(etsf_split)> = the value from this structure are copied into the right arrays in @output_split and the values are changed then to be the indexes used in @output_split.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_split_merge(output_split, split, lstat, error_data)

  !Arguments ------------------------------------
  type(etsf_split), intent(inout) :: output_split
  type(etsf_split), intent(inout) :: split
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_split_merge'
  integer :: ivar
  integer :: len


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_split_merge : enter'
!ENDDEBUG

  lstat = .false.
  if (associated(output_split%my_kpoints)) then
    if (.not. associated(split%my_kpoints)) then
      call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
        & ERROR_TYPE_DIM, my_name, &
        & errmess = "incompatible split for merge (not allocated).")
      return
    end if
    do ivar = 1, size(output_split%my_kpoints), 1
      if (output_split%my_kpoints(ivar) < 0) then
        exit
      end if
    end do
    if ((ivar + size(split%my_kpoints) - 1) > size(output_split%my_kpoints)) then
      call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
        & ERROR_TYPE_DIM, my_name, &
        & errmess = "incompatible split for merge (wrong length).")
      return
    end if
    output_split%my_kpoints(ivar:ivar + size(split%my_kpoints) - 1) = &
      & split%my_kpoints
    ! We modify the split value to be used in accordance with
    ! the new output_split
    split%my_kpoints = &
      & (/ (len, len = ivar, ivar + size(split%my_kpoints) - 1, 1) /)
  end if
  if (associated(output_split%my_grid_points_vector3)) then
    if (.not. associated(split%my_grid_points_vector3)) then
      call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
        & ERROR_TYPE_DIM, my_name, &
        & errmess = "incompatible split for merge (not allocated).")
      return
    end if
    do ivar = 1, size(output_split%my_grid_points_vector3), 1
      if (output_split%my_grid_points_vector3(ivar) < 0) then
        exit
      end if
    end do
    if ((ivar + size(split%my_grid_points_vector3) - 1) > size(output_split%my_grid_points_vector3)) then
      call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
        & ERROR_TYPE_DIM, my_name, &
        & errmess = "incompatible split for merge (wrong length).")
      return
    end if
    output_split%my_grid_points_vector3(ivar:ivar + size(split%my_grid_points_vector3) - 1) = &
      & split%my_grid_points_vector3
    ! We modify the split value to be used in accordance with
    ! the new output_split
    split%my_grid_points_vector3 = &
      & (/ (len, len = ivar, ivar + size(split%my_grid_points_vector3) - 1, 1) /)
  end if
  if (associated(output_split%my_spins)) then
    if (.not. associated(split%my_spins)) then
      call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
        & ERROR_TYPE_DIM, my_name, &
        & errmess = "incompatible split for merge (not allocated).")
      return
    end if
    do ivar = 1, size(output_split%my_spins), 1
      if (output_split%my_spins(ivar) < 0) then
        exit
      end if
    end do
    if ((ivar + size(split%my_spins) - 1) > size(output_split%my_spins)) then
      call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
        & ERROR_TYPE_DIM, my_name, &
        & errmess = "incompatible split for merge (wrong length).")
      return
    end if
    output_split%my_spins(ivar:ivar + size(split%my_spins) - 1) = &
      & split%my_spins
    ! We modify the split value to be used in accordance with
    ! the new output_split
    split%my_spins = &
      & (/ (len, len = ivar, ivar + size(split%my_spins) - 1, 1) /)
  end if
  if (associated(output_split%my_grid_points_vector1)) then
    if (.not. associated(split%my_grid_points_vector1)) then
      call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
        & ERROR_TYPE_DIM, my_name, &
        & errmess = "incompatible split for merge (not allocated).")
      return
    end if
    do ivar = 1, size(output_split%my_grid_points_vector1), 1
      if (output_split%my_grid_points_vector1(ivar) < 0) then
        exit
      end if
    end do
    if ((ivar + size(split%my_grid_points_vector1) - 1) > size(output_split%my_grid_points_vector1)) then
      call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
        & ERROR_TYPE_DIM, my_name, &
        & errmess = "incompatible split for merge (wrong length).")
      return
    end if
    output_split%my_grid_points_vector1(ivar:ivar + size(split%my_grid_points_vector1) - 1) = &
      & split%my_grid_points_vector1
    ! We modify the split value to be used in accordance with
    ! the new output_split
    split%my_grid_points_vector1 = &
      & (/ (len, len = ivar, ivar + size(split%my_grid_points_vector1) - 1, 1) /)
  end if
  if (associated(output_split%my_grid_points_vector2)) then
    if (.not. associated(split%my_grid_points_vector2)) then
      call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
        & ERROR_TYPE_DIM, my_name, &
        & errmess = "incompatible split for merge (not allocated).")
      return
    end if
    do ivar = 1, size(output_split%my_grid_points_vector2), 1
      if (output_split%my_grid_points_vector2(ivar) < 0) then
        exit
      end if
    end do
    if ((ivar + size(split%my_grid_points_vector2) - 1) > size(output_split%my_grid_points_vector2)) then
      call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
        & ERROR_TYPE_DIM, my_name, &
        & errmess = "incompatible split for merge (wrong length).")
      return
    end if
    output_split%my_grid_points_vector2(ivar:ivar + size(split%my_grid_points_vector2) - 1) = &
      & split%my_grid_points_vector2
    ! We modify the split value to be used in accordance with
    ! the new output_split
    split%my_grid_points_vector2 = &
      & (/ (len, len = ivar, ivar + size(split%my_grid_points_vector2) - 1, 1) /)
  end if
  if (associated(output_split%my_coefficients)) then
    if (.not. associated(split%my_coefficients)) then
      call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
        & ERROR_TYPE_DIM, my_name, &
        & errmess = "incompatible split for merge (not allocated).")
      return
    end if
    do ivar = 1, size(output_split%my_coefficients), 1
      if (output_split%my_coefficients(ivar) < 0) then
        exit
      end if
    end do
    if ((ivar + size(split%my_coefficients) - 1) > size(output_split%my_coefficients)) then
      call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
        & ERROR_TYPE_DIM, my_name, &
        & errmess = "incompatible split for merge (wrong length).")
      return
    end if
    output_split%my_coefficients(ivar:ivar + size(split%my_coefficients) - 1) = &
      & split%my_coefficients
    ! We modify the split value to be used in accordance with
    ! the new output_split
    split%my_coefficients = &
      & (/ (len, len = ivar, ivar + size(split%my_coefficients) - 1, 1) /)
  end if
  if (associated(output_split%my_components)) then
    if (.not. associated(split%my_components)) then
      call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
        & ERROR_TYPE_DIM, my_name, &
        & errmess = "incompatible split for merge (not allocated).")
      return
    end if
    do ivar = 1, size(output_split%my_components), 1
      if (output_split%my_components(ivar) < 0) then
        exit
      end if
    end do
    if ((ivar + size(split%my_components) - 1) > size(output_split%my_components)) then
      call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
        & ERROR_TYPE_DIM, my_name, &
        & errmess = "incompatible split for merge (wrong length).")
      return
    end if
    output_split%my_components(ivar:ivar + size(split%my_components) - 1) = &
      & split%my_components
    ! We modify the split value to be used in accordance with
    ! the new output_split
    split%my_components = &
      & (/ (len, len = ivar, ivar + size(split%my_components) - 1, 1) /)
  end if
  if (associated(output_split%my_states)) then
    if (.not. associated(split%my_states)) then
      call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
        & ERROR_TYPE_DIM, my_name, &
        & errmess = "incompatible split for merge (not allocated).")
      return
    end if
    do ivar = 1, size(output_split%my_states), 1
      if (output_split%my_states(ivar) < 0) then
        exit
      end if
    end do
    if ((ivar + size(split%my_states) - 1) > size(output_split%my_states)) then
      call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
        & ERROR_TYPE_DIM, my_name, &
        & errmess = "incompatible split for merge (wrong length).")
      return
    end if
    output_split%my_states(ivar:ivar + size(split%my_states) - 1) = &
      & split%my_states
    ! We modify the split value to be used in accordance with
    ! the new output_split
    split%my_states = &
      & (/ (len, len = ivar, ivar + size(split%my_states) - 1, 1) /)
  end if
  lstat = .true.


!DEBUG
!write (*,*) 'etsf_io_split_merge : exit'
!ENDDEBUG

end subroutine etsf_io_split_merge
etsf_io-1.0.3/doc/www/group_level/etsf_io_vars_free_f90.html0000644000353400050620000001274011354150414021034 00000000000000 ./src/group_level/etsf_io_vars_free.f90

TABLE OF CONTENTS

etsf_io_vars_free

[ Top ] [ etsf_vars ] [ Methods ]

NAME

etsf_io_vars_free

FUNCTION

Free the given variable list.

SIDE EFFECTS

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_vars_free(vars_infos)

  !Arguments ------------------------------------
  type(etsf_vars), intent(inout) :: vars_infos

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_vars_free'


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_vars_free : enter'
!ENDDEBUG

  ! Deallocate all associated pointers.
  if (associated(vars_infos%parent)) then
    call etsf_io_low_free_all_var_infos(vars_infos%parent)
  end if
  if (associated(vars_infos%group)) then
    deallocate(vars_infos%group)
  end if
  if (associated(vars_infos%varid)) then
    deallocate(vars_infos%varid)
  end if
  if (associated(vars_infos%split)) then
    deallocate(vars_infos%split)
  end if


!DEBUG
!write (*,*) 'etsf_io_vars_free : exit'
!ENDDEBUG

end subroutine etsf_io_vars_free
etsf_io-1.0.3/doc/www/group_level/etsf_io_data_init_f90.html0000644000353400050620000007342511354150415021024 00000000000000 ./src/group_level/etsf_io_data_init.f90

TABLE OF CONTENTS

etsf_io_data_init

[ Top ] [ etsf_io_data_group ] [ Methods ]

NAME

etsf_io_data_init

FUNCTION

High-level routine to create an ETSF file.

INPUTS

  • filename = the path to the file to be accessed.
  • groups <type(etsf_groups_flags)> = choose the groups and the variables (from #etsf_groups_flags) that will be used. This is a sum of values taken from #FLAGS_VARIABLES for each group. Let the value to etsf_<grp>_none not to define a wall group.
  • title = the title of the file (maybe null but should not).
  • history = some history information (maybe null).
  • k_dependent = (optional) use this argument to set the attribute flag 'k_dependent' to 'yes' or 'no' on variables that have it. If no variable in the group has the attribute 'k_dependent', this argument has no effect. The default value is .true. (which puts 'yes' in the file).
  • overwrite = (optional) will overwrite an existing file with the same file name (default is .false.).
  • split_definition <type(etsf_split)> = (optional) give for each associated array the number of elements (given by the size) and the values of these elements in a splitted file.

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

SIDE EFFECTS

  • dims <type(etsf_dims)> = contains all the dimensions required by the ETSF file. It will be modify by setting the constant dimensions to their right values, and the my_something dimensions will be set according to the @split optional argument (if not present, they will be put to their none split values).

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_data_init(filename, groups, dims, title, history, lstat, &
  & error_data, k_dependent, overwrite, split_definition)

  !Arguments ------------------------------------
  character(len=*), intent(intent) :: filename
  type(etsf_groups_flags), intent(intent) :: groups
  type(etsf_dims), intent(inout) :: dims
  character(len=*), intent(intent) :: title
  character(len=*), intent(intent) :: history
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data
  logical, optional, intent(intent) :: k_dependent
  logical, optional, intent(intent) :: overwrite
  type(etsf_split), optional, intent(intent) :: split_definition
  !Local variables-------------------------------
  character(len=*),parameter :: my_name = 'etsf_io_data_init'
  integer :: ncid, i
  logical :: my_k_dependent
  logical :: my_overwrite
  type(etsf_split) :: my_split_definition


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_data_init : enter'
!ENDDEBUG

  ! Get values for optional arguments, set default.
  if (present(k_dependent)) then
    my_k_dependent = k_dependent
  else
    my_k_dependent = .true.
  end if
  if (present(overwrite)) then
    my_overwrite = overwrite
  else
    my_overwrite = .false.
  end if
  if (present(split_definition)) then
    my_split_definition = split_definition
  end if
  
  ! Create the NetCDF file
  call etsf_io_low_open_create(ncid, filename, etsf_file_format_version, lstat, &
                             & title = trim(title), history = trim(history), &
                             & error_data = error_data, overwrite = my_overwrite)
  if (.not. lstat) then
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  
  ! Define dimensions
  dims%character_string_length        = etsf_charlen
  dims%number_of_cartesian_directions = etsf_3dimlen
  dims%number_of_reduced_dimensions   = etsf_3dimlen
  dims%number_of_vectors              = etsf_3dimlen
  dims%symbol_length                  = etsf_chemlen
  
  ! We set the size of split arrays, if required.
  if (present(split_definition)) then
    call etsf_io_split_init(dims, split_definition)
  end if
  
  ! We write the dimensions to the file.
  call etsf_io_dims_def(ncid, dims, lstat, error_data)
  if (.not. lstat) then
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  
  ! Define split arrays.
  if (present(split_definition)) then
    call etsf_io_split_def(ncid, dims, lstat, error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  ! Define groups.
  if (groups%geometry /= etsf_geometry_none) then
    call etsf_io_geometry_def(ncid, lstat, error_data, &
                      & k_dependent = my_k_dependent, &
                      & flags = groups%geometry, &
                      & split = my_split_definition)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  if (groups%electrons /= etsf_electrons_none) then
    call etsf_io_electrons_def(ncid, lstat, error_data, &
                      & k_dependent = my_k_dependent, &
                      & flags = groups%electrons, &
                      & split = my_split_definition)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  if (groups%kpoints /= etsf_kpoints_none) then
    call etsf_io_kpoints_def(ncid, lstat, error_data, &
                      & k_dependent = my_k_dependent, &
                      & flags = groups%kpoints, &
                      & split = my_split_definition)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  if (groups%basisdata /= etsf_basisdata_none) then
    call etsf_io_basisdata_def(ncid, lstat, error_data, &
                      & k_dependent = my_k_dependent, &
                      & flags = groups%basisdata, &
                      & split = my_split_definition)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  if (groups%gwdata /= etsf_gwdata_none) then
    call etsf_io_gwdata_def(ncid, lstat, error_data, &
                      & k_dependent = my_k_dependent, &
                      & flags = groups%gwdata, &
                      & split = my_split_definition)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  if (groups%dielectric /= etsf_dielectric_none) then
    call etsf_io_dielectric_def(ncid, lstat, error_data, &
                      & k_dependent = my_k_dependent, &
                      & flags = groups%dielectric, &
                      & split = my_split_definition)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  if (groups%main /= etsf_main_none) then
    call etsf_io_main_def(ncid, lstat, error_data, &
                      & k_dependent = my_k_dependent, &
                      & flags = groups%main, &
                      & split = my_split_definition)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  ! Write the split arrays.
  if (present(split_definition)) then
    ! Begin by putting the file in write mode.
    call etsf_io_low_set_write_mode(ncid, lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    ! Write the arrays.
    call etsf_io_split_put(ncid, split_definition, lstat, error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  ! End definitions and close file
  call etsf_io_low_close(ncid, lstat, error_data = error_data)
  if (.not. lstat) then
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if

!DEBUG
!write (*,*) 'etsf_io_data_init : exit'
!ENDDEBUG

end subroutine etsf_io_data_init
etsf_io-1.0.3/doc/www/group_level/etsf_io_data_read_f90.html0000644000353400050620000004352111354150415020766 00000000000000 ./src/group_level/etsf_io_data_read.f90

TABLE OF CONTENTS

etsf_io_data_read

[ Top ] [ etsf_io_data_group ] [ Methods ]

NAME

etsf_io_data_read

FUNCTION

High-level routine to read a lot of ETSF variable at once.

INPUTS

  • filename = the path to the file to be accessed.
  • use_atomic_units = (optional) set this flag to .true. makes the library use the value of the attribute scale_to_atomic_units to multiply the read variables (that are units dependent) by this factor (if different from 1.0d0).

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

SIDE EFFECTS

  • group_folder <type(etsf_groups)> = a container for different groups. All groups specified in the @groups argument must be associated.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_data_read(filename, group_folder, lstat, error_data, use_atomic_units)

  !Arguments ------------------------------------
  character(len=*), intent(intent) :: filename
  type(etsf_groups), intent(inout) :: group_folder
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data
  logical, optional, intent(intent) :: use_atomic_units
  !Local variables-------------------------------
  character(len=*),parameter :: my_name = 'etsf_io_data_read'
  integer :: ncid, i
  logical :: my_use_atomic_units


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_data_read : enter'
!ENDDEBUG

  ! Get values for optional arguments, set default.
  if (present(use_atomic_units)) then
    my_use_atomic_units = use_atomic_units
  else
    my_use_atomic_units = .true.
  end if
  
  ! Open file for reading
  call etsf_io_low_open_read(ncid, trim(filename), lstat, error_data = error_data)
  if (.not. lstat) then
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  
  ! Get Data
  if (associated(group_folder%geometry)) then
    call etsf_io_geometry_get(ncid, group_folder%geometry, lstat, error_data, &
                         & use_atomic_units = my_use_atomic_units)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  if (associated(group_folder%electrons)) then
    call etsf_io_electrons_get(ncid, group_folder%electrons, lstat, error_data, &
                         & use_atomic_units = my_use_atomic_units)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  if (associated(group_folder%kpoints)) then
    call etsf_io_kpoints_get(ncid, group_folder%kpoints, lstat, error_data, &
                         & use_atomic_units = my_use_atomic_units)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  if (associated(group_folder%basisdata)) then
    call etsf_io_basisdata_get(ncid, group_folder%basisdata, lstat, error_data, &
                         & use_atomic_units = my_use_atomic_units)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  if (associated(group_folder%gwdata)) then
    call etsf_io_gwdata_get(ncid, group_folder%gwdata, lstat, error_data, &
                         & use_atomic_units = my_use_atomic_units)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  if (associated(group_folder%dielectric)) then
    call etsf_io_dielectric_get(ncid, group_folder%dielectric, lstat, error_data, &
                         & use_atomic_units = my_use_atomic_units)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  if (associated(group_folder%main)) then
    call etsf_io_main_get(ncid, group_folder%main, lstat, error_data, &
                         & use_atomic_units = my_use_atomic_units)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  
  ! Close file
  call etsf_io_low_close(ncid, lstat, error_data = error_data)
  if (.not. lstat) call etsf_io_low_error_update(error_data, my_name)

!DEBUG
!write (*,*) 'etsf_io_data_read : exit'
!ENDDEBUG

end subroutine etsf_io_data_read
etsf_io-1.0.3/doc/www/group_level/etsf_io_data_write_f90.html0000644000353400050620000004014611354150415021205 00000000000000 ./src/group_level/etsf_io_data_write.f90

TABLE OF CONTENTS

etsf_io_data_write

[ Top ] [ etsf_io_data_group ] [ Methods ]

NAME

etsf_io_data_write

FUNCTION

High-level routine to write a lot of ETSF variable at once.

INPUTS

  • filename = the path to the file to be accessed.
  • group_folder <type(etsf_groups)> = a container for different groups. All groups specified in the @groups argument must be associated.

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_data_write(filename, group_folder, lstat, error_data)

  !Arguments ------------------------------------
  character(len=*), intent(intent) :: filename
  type(etsf_groups), intent(intent) :: group_folder
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data
  !Local variables-------------------------------
  character(len=*),parameter :: my_name = 'etsf_io_data_write'
  integer :: ncid, i


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_data_write : enter'
!ENDDEBUG

  ! Open file for writing
  call etsf_io_low_open_modify(ncid, trim(filename), lstat, error_data = error_data)
  if (.not. lstat) then
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  
  ! We switch to write mode.
  call etsf_io_low_set_write_mode(ncid, lstat, error_data = error_data)
  if (.not. lstat) then
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  
  ! Put Data
  if (associated(group_folder%geometry)) then
    call etsf_io_geometry_put(ncid, group_folder%geometry, lstat, error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  if (associated(group_folder%electrons)) then
    call etsf_io_electrons_put(ncid, group_folder%electrons, lstat, error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  if (associated(group_folder%kpoints)) then
    call etsf_io_kpoints_put(ncid, group_folder%kpoints, lstat, error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  if (associated(group_folder%basisdata)) then
    call etsf_io_basisdata_put(ncid, group_folder%basisdata, lstat, error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  if (associated(group_folder%gwdata)) then
    call etsf_io_gwdata_put(ncid, group_folder%gwdata, lstat, error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  if (associated(group_folder%dielectric)) then
    call etsf_io_dielectric_put(ncid, group_folder%dielectric, lstat, error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  if (associated(group_folder%main)) then
    call etsf_io_main_put(ncid, group_folder%main, lstat, error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
  end if
  
  
  ! Close file
  call etsf_io_low_close(ncid, lstat, error_data = error_data)
  if (.not. lstat) call etsf_io_low_error_update(error_data, my_name)

!DEBUG
!write (*,*) 'etsf_io_data_write : exit'
!ENDDEBUG

end subroutine etsf_io_data_write
etsf_io-1.0.3/doc/www/group_level/etsf_io_data_contents_f90.html0000644000353400050620000006034611354150415021714 00000000000000 ./src/group_level/etsf_io_data_contents.f90

TABLE OF CONTENTS

etsf_io_data_contents

[ Top ] [ etsf_io_data_group ] [ Methods ]

NAME

etsf_io_data_contents

FUNCTION

High-level routine that get informations from a given @filename. Returned values are the list of dimensions, allocated split definitions (if any), flags for main variables (see FLAGS_VARIABLES) and flags for groups (see FLAGS_GROUPS).

This routine can also be used to get the comprehensive list of read variables with their definitions (name, shape, dimension names...). Use etsf_io_vars_free() to deallocate this list.

INPUTS

  • filename = the path to the file to be accessed.

OUTPUT

  • dims <type(etsf_dims)> = the dimensions will be read and stored, using etsf_io_dims_get().
  • split <type(etsf_split)> = if any, read the split array from the given file and put their values in this argument. If lstat = .true., it may be allocated in output. So, after use, it must be deallocated, using etsf_io_split_free().
  • etsf_groups = an integer which is the sum of all present group ids in the read file (see FLAGS_GROUPS).
  • etsf_variables <type(etsf_groups_flags)> = an integer for each group detailling which ETSF variables are indeed present in the read file (see FLAGS_VARIABLES).
  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

SIDE EFFECTS

  • vars_infos <type(etsf_vars)> = (optional) when reading the file for variable informations, it creates a list of type(etsf_var) that describes all the variables in the file. This list contains non ETSF informations such as variable names, types, shapes, an array of dimension values and an other array of dimension names. It also contains ETSF informations, like group id or if the variable is a split definition. When given, internal pointers are associated in the subroutine. To free them, use etsf_io_vars_free().

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_data_contents(filename, dims, split, etsf_groups, etsf_variables, &
  & lstat, error_data, vars_infos)

  !Arguments ------------------------------------
  character(len=*), intent(intent) :: filename
  type(etsf_dims), intent(out) :: dims
  type(etsf_split), intent(out) :: split
  integer, intent(out) :: etsf_groups
  type(etsf_groups_flags), intent(out) :: etsf_variables
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data
  type(etsf_vars), optional, intent(inout) :: vars_infos
  !Local variables-------------------------------
  character(len=*),parameter :: my_name = 'etsf_io_data_contents'
  integer :: ncid, i
  type(etsf_vars) :: my_vars_infos
  logical :: with_dim_name
  logical :: with_att_name
  integer :: group_id
  integer :: var_id
  logical :: split_id


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_data_contents : enter'
!ENDDEBUG

  lstat = .false.
  if (present(vars_infos)) then
    vars_infos%n_vars = 0
    vars_infos%parent => null()
    with_dim_name = .true.
    with_att_name = .true.
  else
    with_dim_name = .false.
    with_att_name = .false.
  end if
  
  ! Open file for reading
  call etsf_io_low_open_read(ncid, trim(filename), &
    & lstat, error_data = error_data)
  if (.not. lstat) then
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  ! Get the dimensions.
  call etsf_io_dims_get(ncid, dims, lstat, error_data)
  if (.not. lstat) then
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  ! We allocate the split arrays.
  call etsf_io_split_allocate(split, dims)
  ! We read the split informations.
  call etsf_io_split_get(ncid, split, lstat, error_data)
  if (.not. lstat) then
    call etsf_io_split_free(split)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  ! Get all variables definitions.
  ! It will allocate my_vars_infos%parent array.
  call etsf_io_low_read_all_var_infos(ncid, my_vars_infos%parent, &
    & lstat, error_data, with_dim_name = with_dim_name, &
    & with_att_name = with_att_name)
  if (.not. lstat) then
    call etsf_io_split_free(split)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  
  etsf_variables%geometry  = etsf_geometry_none
  etsf_variables%electrons  = etsf_electrons_none
  etsf_variables%kpoints  = etsf_kpoints_none
  etsf_variables%basisdata  = etsf_basisdata_none
  etsf_variables%gwdata  = etsf_gwdata_none
  etsf_variables%dielectric  = etsf_dielectric_none
  etsf_variables%main  = etsf_main_none
  if (associated(my_vars_infos%parent)) then
    my_vars_infos%n_vars = size(my_vars_infos%parent)
    if (present(vars_infos)) then
      ! Allocate vars_infos arrays for future use.
      vars_infos%n_vars = my_vars_infos%n_vars
      allocate(vars_infos%group(vars_infos%n_vars))
      allocate(vars_infos%varid(vars_infos%n_vars))
      allocate(vars_infos%split(vars_infos%n_vars))
    end if
    ! get the main_id and the group_id for all variables.
    do i = 1, my_vars_infos%n_vars, 1
      call etsf_io_data_get(group_id, var_id, &
        & split_id, my_vars_infos%parent(i)%name)
      select case (group_id)
        case (etsf_grp_geometry)
          etsf_variables%geometry = ior(etsf_variables%geometry, var_id)
        case (etsf_grp_electrons)
          etsf_variables%electrons = ior(etsf_variables%electrons, var_id)
        case (etsf_grp_kpoints)
          etsf_variables%kpoints = ior(etsf_variables%kpoints, var_id)
        case (etsf_grp_basisdata)
          etsf_variables%basisdata = ior(etsf_variables%basisdata, var_id)
        case (etsf_grp_gwdata)
          etsf_variables%gwdata = ior(etsf_variables%gwdata, var_id)
        case (etsf_grp_dielectric)
          etsf_variables%dielectric = ior(etsf_variables%dielectric, var_id)
        case (etsf_grp_main)
          etsf_variables%main = ior(etsf_variables%main, var_id)
      end select
      etsf_groups = ior(etsf_groups, group_id)
      if (present(vars_infos)) then
        ! Update vars_infos arrays.
        vars_infos%group(i) = group_id
        vars_infos%varid(i) = var_id
        vars_infos%split(i) = split_id
      end if
    end do
  end if
  if (present(vars_infos)) then
    ! Associate vars_infos%parent to the one computed in my_vars_infos.
    vars_infos%parent => my_vars_infos%parent
  else if (associated(my_vars_infos%parent)) then
    call etsf_io_low_free_all_var_infos(my_vars_infos%parent)
  end if
  
  ! Close file
  call etsf_io_low_close(ncid, lstat, error_data = error_data)
  if (.not. lstat) call etsf_io_low_error_update(error_data, my_name)


!DEBUG
!write (*,*) 'etsf_io_data_contents : exit'
!ENDDEBUG

end subroutine etsf_io_data_contents
etsf_io-1.0.3/doc/www/group_level/etsf_io_data_get_f90.html0000644000353400050620000011450411354150415020632 00000000000000 ./src/group_level/etsf_io_data_get.f90

TABLE OF CONTENTS

etsf_io_data_get

[ Top ] [ etsf_io_data_group ] [ Methods ]

NAME

etsf_io_data_get

FUNCTION

This is a query routine to get informations about a variable when its name is given. It does not interact with any files and is just a Firtran version of the specifications.

INPUTS

  • varname = the name of a variable, to know if it is part of ETSF or not.

OUTPUT

  • etsf_group = this integer is a flag corresponding to the group in which the given @varname is defined.
  • etsf_variable =
  • etsf_split = this logical is .true. if @varname is a valid split name.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_data_get(etsf_group, etsf_variable, etsf_split, varname)

  !Arguments ------------------------------------
  integer, intent(out) :: etsf_group
  integer, intent(out) :: etsf_variable
  logical, intent(out) :: etsf_split
  character(len=*), intent(intent) :: varname
  !Local variables-------------------------------
  character(len=*),parameter :: my_name = 'etsf_io_data_get'
  integer :: ncid, i


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_data_get : enter'
!ENDDEBUG

  etsf_group = etsf_grp_none
  etsf_variable = 0
  etsf_split = .false.
  if (trim(varname) == "gw_corrections") then
    etsf_group = etsf_grp_gwdata
    etsf_variable = etsf_gwdata_gw_corrections
  else if (trim(varname) == "kb_formfactor_sign") then
    etsf_group = etsf_grp_gwdata
    etsf_variable = etsf_gwdata_kb_coeff_sig
  else if (trim(varname) == "kb_formfactors") then
    etsf_group = etsf_grp_gwdata
    etsf_variable = etsf_gwdata_kb_coeff
  else if (trim(varname) == "kb_formfactor_derivative") then
    etsf_group = etsf_grp_gwdata
    etsf_variable = etsf_gwdata_kb_coeff_der
  else if (trim(varname) == "space_group") then
    etsf_group = etsf_grp_geometry
    etsf_variable = etsf_geometry_space_group
  else if (trim(varname) == "primitive_vectors") then
    etsf_group = etsf_grp_geometry
    etsf_variable = etsf_geometry_primitive_vectors
  else if (trim(varname) == "reduced_symmetry_matrices") then
    etsf_group = etsf_grp_geometry
    etsf_variable = etsf_geometry_red_sym_matrices
  else if (trim(varname) == "reduced_symmetry_translations") then
    etsf_group = etsf_grp_geometry
    etsf_variable = etsf_geometry_red_sym_trans
  else if (trim(varname) == "atom_species") then
    etsf_group = etsf_grp_geometry
    etsf_variable = etsf_geometry_atom_species
  else if (trim(varname) == "reduced_atom_positions") then
    etsf_group = etsf_grp_geometry
    etsf_variable = etsf_geometry_red_at_pos
  else if (trim(varname) == "valence_charges") then
    etsf_group = etsf_grp_geometry
    etsf_variable = etsf_geometry_valence_charges
  else if (trim(varname) == "atomic_numbers") then
    etsf_group = etsf_grp_geometry
    etsf_variable = etsf_geometry_atomic_numbers
  else if (trim(varname) == "atom_species_names") then
    etsf_group = etsf_grp_geometry
    etsf_variable = etsf_geometry_atom_species_names
  else if (trim(varname) == "chemical_symbols") then
    etsf_group = etsf_grp_geometry
    etsf_variable = etsf_geometry_chemical_symbols
  else if (trim(varname) == "pseudopotential_types") then
    etsf_group = etsf_grp_geometry
    etsf_variable = etsf_geometry_pseudo_types
  else if (trim(varname) == "kpoint_grid_shift") then
    etsf_group = etsf_grp_kpoints
    etsf_variable = etsf_kpoints_kpoint_grid_shift
  else if (trim(varname) == "kpoint_grid_vectors") then
    etsf_group = etsf_grp_kpoints
    etsf_variable = etsf_kpoints_kpoint_grid_vectors
  else if (trim(varname) == "monkhorst_pack_folding") then
    etsf_group = etsf_grp_kpoints
    etsf_variable = etsf_kpoints_mp_folding
  else if (trim(varname) == "reduced_coordinates_of_kpoints") then
    etsf_group = etsf_grp_kpoints
    etsf_variable = etsf_kpoints_red_coord_kpt
  else if (trim(varname) == "kpoint_weights") then
    etsf_group = etsf_grp_kpoints
    etsf_variable = etsf_kpoints_kpoint_weights
  else if (trim(varname) == "basis_set") then
    etsf_group = etsf_grp_basisdata
    etsf_variable = etsf_basisdata_basis_set
  else if (trim(varname) == "kinetic_energy_cutoff") then
    etsf_group = etsf_grp_basisdata
    etsf_variable = etsf_basisdata_kin_cutoff
  else if (trim(varname) == "number_of_coefficients") then
    etsf_group = etsf_grp_basisdata
    etsf_variable = etsf_basisdata_n_coeff
  else if (trim(varname) == "reduced_coordinates_of_plane_waves") then
    etsf_group = etsf_grp_basisdata
    etsf_variable = etsf_basisdata_red_coord_pw
  else if (trim(varname) == "coordinates_of_basis_grid_points") then
    etsf_group = etsf_grp_basisdata
    etsf_variable = etsf_basisdata_coord_grid
  else if (trim(varname) == "number_of_coefficients_per_grid_point") then
    etsf_group = etsf_grp_basisdata
    etsf_variable = etsf_basisdata_n_coeff_grid
  else if (trim(varname) == "number_of_electrons") then
    etsf_group = etsf_grp_electrons
    etsf_variable = etsf_electrons_number_of_electrons
  else if (trim(varname) == "exchange_functional") then
    etsf_group = etsf_grp_electrons
    etsf_variable = etsf_electrons_x_functional
  else if (trim(varname) == "correlation_functional") then
    etsf_group = etsf_grp_electrons
    etsf_variable = etsf_electrons_c_functional
  else if (trim(varname) == "fermi_energy") then
    etsf_group = etsf_grp_electrons
    etsf_variable = etsf_electrons_fermi_energy
  else if (trim(varname) == "smearing_scheme") then
    etsf_group = etsf_grp_electrons
    etsf_variable = etsf_electrons_smearing_scheme
  else if (trim(varname) == "smearing_width") then
    etsf_group = etsf_grp_electrons
    etsf_variable = etsf_electrons_smearing_width
  else if (trim(varname) == "number_of_states") then
    etsf_group = etsf_grp_electrons
    etsf_variable = etsf_electrons_number_of_states
  else if (trim(varname) == "eigenvalues") then
    etsf_group = etsf_grp_electrons
    etsf_variable = etsf_electrons_eigenvalues
  else if (trim(varname) == "occupations") then
    etsf_group = etsf_grp_electrons
    etsf_variable = etsf_electrons_occupations
  else if (trim(varname) == "density") then
    etsf_group = etsf_grp_main
    etsf_variable = etsf_main_density
  else if (trim(varname) == "exchange_potential") then
    etsf_group = etsf_grp_main
    etsf_variable = etsf_main_pot_x_only
  else if (trim(varname) == "correlation_potential") then
    etsf_group = etsf_grp_main
    etsf_variable = etsf_main_pot_c_only
  else if (trim(varname) == "exchange_correlation_potential") then
    etsf_group = etsf_grp_main
    etsf_variable = etsf_main_pot_xc
  else if (trim(varname) == "coefficients_of_wavefunctions") then
    etsf_group = etsf_grp_main
    etsf_variable = etsf_main_wfs_coeff
  else if (trim(varname) == "real_space_wavefunctions") then
    etsf_group = etsf_grp_main
    etsf_variable = etsf_main_wfs_rsp
  else if (trim(varname) == "frequencies_dielectric_function") then
    etsf_group = etsf_grp_dielectric
    etsf_variable = etsf_dielectric_frequencies
  else if (trim(varname) == "qpoints_dielectric_function") then
    etsf_group = etsf_grp_dielectric
    etsf_variable = etsf_dielectric_qpt
  else if (trim(varname) == "qpoints_gamma_limit") then
    etsf_group = etsf_grp_dielectric
    etsf_variable = etsf_dielectric_qpt_g_lim
  else if (trim(varname) == "dielectric_function") then
    etsf_group = etsf_grp_dielectric
    etsf_variable = etsf_dielectric_function
  else if (trim(varname) == "dielectric_function_head") then
    etsf_group = etsf_grp_dielectric
    etsf_variable = etsf_dielectric_function_head
  else if (trim(varname) == "dielectric_function_lower_wing") then
    etsf_group = etsf_grp_dielectric
    etsf_variable = etsf_dielectric_function_lower
  else if (trim(varname) == "dielectric_function_upper_wing") then
    etsf_group = etsf_grp_dielectric
    etsf_variable = etsf_dielectric_function_upper
  else if (trim(varname) == "inverse_dielectric_function") then
    etsf_group = etsf_grp_dielectric
    etsf_variable = etsf_dielectric_function_inv
  else if (trim(varname) == "inverse_dielectric_function_head") then
    etsf_group = etsf_grp_dielectric
    etsf_variable = etsf_dielectric_function_inv_head
  else if (trim(varname) == "inverse_dielectric_function_lower_wing") then
    etsf_group = etsf_grp_dielectric
    etsf_variable = etsf_dielectric_function_inv_lower
  else if (trim(varname) == "inverse_dielectric_function_upper_wing") then
    etsf_group = etsf_grp_dielectric
    etsf_variable = etsf_dielectric_function_inv_upper
  else if (trim(varname) == "polarizability") then
    etsf_group = etsf_grp_dielectric
    etsf_variable = etsf_dielectric_polarizability
  else if (trim(varname) == "polarizability_head") then
    etsf_group = etsf_grp_dielectric
    etsf_variable = etsf_dielectric_pol_head
  else if (trim(varname) == "polarizability_lower_wing") then
    etsf_group = etsf_grp_dielectric
    etsf_variable = etsf_dielectric_pol_lower
  else if (trim(varname) == "polarizability_upper_wing") then
    etsf_group = etsf_grp_dielectric
    etsf_variable = etsf_dielectric_pol_upper
  else if (trim(varname) == "inverse_polarizability") then
    etsf_group = etsf_grp_dielectric
    etsf_variable = etsf_dielectric_polarizability_inv
  else if (trim(varname) == "inverse_polarizability_head") then
    etsf_group = etsf_grp_dielectric
    etsf_variable = etsf_dielectric_pol_inv_head
  else if (trim(varname) == "inverse_polarizability_lower_wing") then
    etsf_group = etsf_grp_dielectric
    etsf_variable = etsf_dielectric_pol_inv_lower
  else if (trim(varname) == "inverse_polarizability_upper_wing") then
    etsf_group = etsf_grp_dielectric
    etsf_variable = etsf_dielectric_pol_inv_upper
  else if (trim(varname) == "my_kpoints") then
    etsf_split = .true.
  else if (trim(varname) == "my_grid_points_vector3") then
    etsf_split = .true.
  else if (trim(varname) == "my_spins") then
    etsf_split = .true.
  else if (trim(varname) == "my_grid_points_vector1") then
    etsf_split = .true.
  else if (trim(varname) == "my_grid_points_vector2") then
    etsf_split = .true.
  else if (trim(varname) == "my_coefficients") then
    etsf_split = .true.
  else if (trim(varname) == "my_components") then
    etsf_split = .true.
  else if (trim(varname) == "my_states") then
    etsf_split = .true.
  end if


!DEBUG
!write (*,*) 'etsf_io_data_get : exit'
!ENDDEBUG

end subroutine etsf_io_data_get
etsf_io-1.0.3/doc/www/group_level/etsf_io_data_copy_f90.html0000644000353400050620000006021111354150415021020 00000000000000 ./src/group_level/etsf_io_data_copy.f90

TABLE OF CONTENTS

etsf_io_data_copy

[ Top ] [ etsf_io_data_group ] [ Methods ]

NAME

etsf_io_data_copy

FUNCTION

High-level routine that copy all ETSF variables from one file to another.

INPUTS

  • dest_file = the path to the file to be written.
  • source_file = A path to the file from which copy the ETSF variables.
  • dims <type(etsf_dims)> = these dimensions correspond to the source_file ones and are used to allocate temporary arrays in memory during the copy.
  • split <type(etsf_split)> = (optional) if this argument is given, the values in the split definition (e.g. my_kpoints) are used to put the data in the destination file in a bigger array at the right placed.

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_data_copy(dest_file, source_file, dims, lstat, error_data, &
  & split)

  !Arguments ------------------------------------
  character(len=*), intent(intent) :: dest_file
  character(len=*), intent(intent) :: source_file
  type(etsf_dims), intent(intent) :: dims
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data
  type(etsf_split), optional, intent(intent) :: split
  !Local variables-------------------------------
  character(len=*),parameter :: my_name = 'etsf_io_data_copy'
  integer :: ncid, i
  type(etsf_split) :: my_split
  integer :: ncid_to


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_data_copy : enter'
!ENDDEBUG

  lstat = .false.
  
  ! Open destination file for writing
  call etsf_io_low_open_modify(ncid_to, trim(dest_file), &
    & lstat, error_data = error_data)
  if (.not. lstat) then
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  ! Open source file for reading
  call etsf_io_low_open_read(ncid, trim(source_file), &
    & lstat, error_data = error_data)
  if (.not. lstat) then
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  
  ! We copy all the global attributes (ETSF and non-ETSF).
  call etsf_io_low_copy_all_att(ncid, ncid_to, etsf_io_low_global_att, etsf_io_low_global_att, &
                              & lstat, error_data = error_data)
  if (.not. lstat) then
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  
  ! We switch to write mode.
  call etsf_io_low_set_write_mode(ncid_to, lstat, error_data = error_data)
  if (.not. lstat) then
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  if (present(split)) then
    call etsf_io_gwdata_copy(ncid_to, ncid, dims, &
      & lstat, error_data, split)
  else
    call etsf_io_gwdata_copy(ncid_to, ncid, dims, &
      & lstat, error_data)
  end if
  if (.not. lstat) then
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  if (present(split)) then
    call etsf_io_geometry_copy(ncid_to, ncid, dims, &
      & lstat, error_data, split)
  else
    call etsf_io_geometry_copy(ncid_to, ncid, dims, &
      & lstat, error_data)
  end if
  if (.not. lstat) then
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  if (present(split)) then
    call etsf_io_kpoints_copy(ncid_to, ncid, dims, &
      & lstat, error_data, split)
  else
    call etsf_io_kpoints_copy(ncid_to, ncid, dims, &
      & lstat, error_data)
  end if
  if (.not. lstat) then
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  if (present(split)) then
    call etsf_io_basisdata_copy(ncid_to, ncid, dims, &
      & lstat, error_data, split)
  else
    call etsf_io_basisdata_copy(ncid_to, ncid, dims, &
      & lstat, error_data)
  end if
  if (.not. lstat) then
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  if (present(split)) then
    call etsf_io_electrons_copy(ncid_to, ncid, dims, &
      & lstat, error_data, split)
  else
    call etsf_io_electrons_copy(ncid_to, ncid, dims, &
      & lstat, error_data)
  end if
  if (.not. lstat) then
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  if (present(split)) then
    call etsf_io_main_copy(ncid_to, ncid, dims, &
      & lstat, error_data, split)
  else
    call etsf_io_main_copy(ncid_to, ncid, dims, &
      & lstat, error_data)
  end if
  if (.not. lstat) then
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  if (present(split)) then
    call etsf_io_dielectric_copy(ncid_to, ncid, dims, &
      & lstat, error_data, split)
  else
    call etsf_io_dielectric_copy(ncid_to, ncid, dims, &
      & lstat, error_data)
  end if
  if (.not. lstat) then
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !Close files.
  call etsf_io_low_close(ncid_to, lstat, error_data = error_data)
  if (.not. lstat) then
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  call etsf_io_low_close(ncid, lstat, error_data = error_data)
  if (.not. lstat) then
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if


!DEBUG
!write (*,*) 'etsf_io_data_copy : exit'
!ENDDEBUG

end subroutine etsf_io_data_copy
etsf_io-1.0.3/doc/www/group_level/etsf_io_f90.html0000644000353400050620000030034611354150415017003 00000000000000 ./src/group_level/etsf_io.f90

TABLE OF CONTENTS

etsf_io

[ Top ] [ Modules ]

NAME

etsf_io

FUNCTION

This module contains all information required by the ETSF/Nanoquanta file format specifications. See http://www.etsf.eu/fileformats for details.

It contains definitions of:

  • #ETSF_IO_CONSTANTS some constants defined by the specifications ;
  • #FLAGS_GROUPS & #FLAGS_MAIN, public flags to identify specific structures ;
  • the list of all dimensions declared in the specifications, see #etsf_dimensions.
  • several structures to store variable used in a same context, such as geometry informations, k points data...
  • a container (see #etsf_groups) to agregate all previous structures.
  • a container to store the main data (see #etsf_main).

NOTES

This file has been automatically generated by the autogen_module script. Any change you would bring to it will systematically be overwritten.

etsf_basisdata

[ Top ] [ etsf_groups ] [ Structures ]

NAME

etsf_basisdata

FUNCTION

All variables from the specifications have been gathered into types called groups. These groups can be gathered into a container called #etsf_groups. This container is the main argument of the routines etsf_io_data_read() and etsf_io_data_write().

SOURCE

 ! Data type for basisdata
 type etsf_basisdata
  character(len=etsf_charlen), pointer :: basis_set => null()
  double precision, pointer :: kinetic_energy_cutoff => null()
  integer, pointer :: number_of_coefficients(:) => null()
  type(etsf_io_low_var_integer) :: reduced_coordinates_of_plane_waves
  type(etsf_io_low_var_integer) :: coordinates_of_basis_grid_points
  type(etsf_io_low_var_integer) :: number_of_coefficients_per_grid_point

  ! Attributes
  ! Units attributes for variable kinetic_energy_cutoff
  character(len=etsf_charlen) :: kin_cutoff__units = "atomic units"
  double precision :: kin_cutoff__scale_to_atomic_units = 1.0d0

  ! Specific dimensions (etsf_spec_dimension get the value
  !  of the max_number_of_something when the variable is get
  !  or put, change it to a lower value if less values are to
  !  be accessed).
  integer :: red_coord_pw__number_of_coefficients = etsf_spec_dimension
  integer :: red_coord_pw__kpoint_access = etsf_no_sub_access
  integer :: coord_grid__number_of_basis_grid_points = etsf_spec_dimension
  integer :: n_coeff_grid__number_of_basis_grid_points = etsf_spec_dimension
 end type etsf_basisdata

etsf_dielectric

[ Top ] [ etsf_groups ] [ Structures ]

NAME

etsf_dielectric

FUNCTION

All variables from the specifications have been gathered into types called groups. These groups can be gathered into a container called #etsf_groups. This container is the main argument of the routines etsf_io_data_read() and etsf_io_data_write().

SOURCE

 ! Data type for dielectric
 type etsf_dielectric
  double precision, pointer :: frequencies_dielectric_function(:,:) => null()
  double precision, pointer :: qpoints_dielectric_function(:,:) => null()
  double precision, pointer :: qpoints_gamma_limit(:,:) => null()
  type(etsf_io_low_var_double) :: dielectric_function
  type(etsf_io_low_var_double) :: dielectric_function_head
  type(etsf_io_low_var_double) :: dielectric_function_lower_wing
  type(etsf_io_low_var_double) :: dielectric_function_upper_wing
  type(etsf_io_low_var_double) :: inverse_dielectric_function
  type(etsf_io_low_var_double) :: inverse_dielectric_function_head
  type(etsf_io_low_var_double) :: inverse_dielectric_function_lower_wing
  type(etsf_io_low_var_double) :: inverse_dielectric_function_upper_wing
  type(etsf_io_low_var_double) :: polarizability
  type(etsf_io_low_var_double) :: polarizability_head
  type(etsf_io_low_var_double) :: polarizability_lower_wing
  type(etsf_io_low_var_double) :: polarizability_upper_wing
  type(etsf_io_low_var_double) :: inverse_polarizability
  type(etsf_io_low_var_double) :: inverse_polarizability_head
  type(etsf_io_low_var_double) :: inverse_polarizability_lower_wing
  type(etsf_io_low_var_double) :: inverse_polarizability_upper_wing
 end type etsf_dielectric

etsf_dims

[ Top ] [ etsf_io_basics_group ] [ Structures ]

NAME

etsf_dimensions

FUNCTION

This structure is a container that stores all dimensions defined in the specifications. An instance of this structure is required when a new ETSF file is created.

SOURCE

 ! Data type for dimensions
 type etsf_dims
  integer :: character_string_length = etsf_charlen
  integer :: complex = etsf_2dimlen
  integer :: max_number_of_angular_momenta = 1
  integer :: max_number_of_basis_grid_points = 1
  integer :: max_number_of_coefficients = 1
  integer :: max_number_of_projectors = 1
  integer :: max_number_of_states = 1
  integer :: number_of_atoms = 1
  integer :: number_of_atom_species = 1
  integer :: number_of_cartesian_directions = etsf_3dimlen
  integer :: number_of_coefficients_dielectric_function = 1
  integer :: number_of_components = 1
  integer :: number_of_frequencies_dielectric_function = 1
  integer :: number_of_grid_points_vector1 = 1
  integer :: number_of_grid_points_vector2 = 1
  integer :: number_of_grid_points_vector3 = 1
  integer :: number_of_kpoints = 1
  integer :: number_of_localization_regions = 1
  integer :: number_of_qpoints_dielectric_function = 1
  integer :: number_of_qpoints_gamma_limit = 1
  integer :: number_of_reduced_dimensions = etsf_3dimlen
  integer :: number_of_spinor_components = 1
  integer :: number_of_spins = 1
  integer :: number_of_symmetry_operations = 1
  integer :: number_of_vectors = etsf_3dimlen
  integer :: real_or_complex_coefficients = 1
  integer :: real_or_complex_density = 1
  integer :: real_or_complex_gw_corrections = 1
  integer :: real_or_complex_potential = 1
  integer :: real_or_complex_wavefunctions = 1
  integer :: symbol_length = etsf_chemlen

  !Dimensions for variables that can be splitted.
  integer :: my_max_number_of_coefficients = etsf_no_dimension
  integer :: my_max_number_of_states = etsf_no_dimension
  integer :: my_number_of_components = etsf_no_dimension
  integer :: my_number_of_grid_points_vect1 = etsf_no_dimension
  integer :: my_number_of_grid_points_vect2 = etsf_no_dimension
  integer :: my_number_of_grid_points_vect3 = etsf_no_dimension
  integer :: my_number_of_kpoints = etsf_no_dimension
  integer :: my_number_of_spins = etsf_no_dimension
 end type etsf_dims

etsf_electrons

[ Top ] [ etsf_groups ] [ Structures ]

NAME

etsf_electrons

FUNCTION

All variables from the specifications have been gathered into types called groups. These groups can be gathered into a container called #etsf_groups. This container is the main argument of the routines etsf_io_data_read() and etsf_io_data_write().

SOURCE

 ! Data type for electrons
 type etsf_electrons
  integer, pointer :: number_of_electrons => null()
  character(len=etsf_charlen), pointer :: exchange_functional => null()
  character(len=etsf_charlen), pointer :: correlation_functional => null()
  double precision, pointer :: fermi_energy => null()
  character(len=etsf_charlen), pointer :: smearing_scheme => null()
  double precision, pointer :: smearing_width => null()
  type(etsf_io_low_var_integer) :: number_of_states
  type(etsf_io_low_var_double) :: eigenvalues
  type(etsf_io_low_var_double) :: occupations

  ! Attributes
  ! Units attributes for variable fermi_energy
  character(len=etsf_charlen) :: fermi_energy__units = "atomic units"
  double precision :: fermi_energy__scale_to_atomic_units = 1.0d0
  ! Units attributes for variable smearing_width
  character(len=etsf_charlen) :: smearing_width__units = "atomic units"
  double precision :: smearing_width__scale_to_atomic_units = 1.0d0
  ! Units attributes for variable eigenvalues
  character(len=etsf_charlen) :: eigenvalues__units = "atomic units"
  double precision :: eigenvalues__scale_to_atomic_units = 1.0d0

  ! Specific dimensions (etsf_spec_dimension get the value
  !  of the max_number_of_something when the variable is get
  !  or put, change it to a lower value if less values are to
  !  be accessed).
  integer :: eigenvalues__number_of_states = etsf_spec_dimension
  integer :: eigenvalues__spin_access = etsf_no_sub_access
  integer :: eigenvalues__kpoint_access = etsf_no_sub_access
  integer :: eigenvalues__state_access = etsf_no_sub_access
  integer :: occupations__number_of_states = etsf_spec_dimension
  integer :: occupations__spin_access = etsf_no_sub_access
  integer :: occupations__kpoint_access = etsf_no_sub_access
  integer :: occupations__state_access = etsf_no_sub_access
 end type etsf_electrons

etsf_geometry

[ Top ] [ etsf_groups ] [ Structures ]

NAME

etsf_geometry

FUNCTION

All variables from the specifications have been gathered into types called groups. These groups can be gathered into a container called #etsf_groups. This container is the main argument of the routines etsf_io_data_read() and etsf_io_data_write().

SOURCE

 ! Data type for geometry
 type etsf_geometry
  integer, pointer :: space_group => null()
  double precision, pointer :: primitive_vectors(:,:) => null()
  integer, pointer :: reduced_symmetry_matrices(:,:,:) => null()
  double precision, pointer :: reduced_symmetry_translations(:,:) => null()
  integer, pointer :: atom_species(:) => null()
  double precision, pointer :: reduced_atom_positions(:,:) => null()
  double precision, pointer :: valence_charges(:) => null()
  double precision, pointer :: atomic_numbers(:) => null()
  character(len=etsf_charlen), pointer :: atom_species_names(:) => null()
  character(len=etsf_chemlen), pointer :: chemical_symbols(:) => null()
  character(len=etsf_charlen), pointer :: pseudopotential_types(:) => null()
 end type etsf_geometry

etsf_groups

[ Top ] [ etsf_io ] [ Structures ]

NAME

etsf_groups

FUNCTION

This structure is a container for all available groups defined in the specifications. To use this structure, create a group (instanciating a #etsf_basisdata or a #etsf_geometry), and associate this group to its pointer: 

   type(etsf_geometry) :: geometry_data
   type(etsf_groups)   :: my_groups
   ... do something with geometry_data ...
   my_groups%geometry => geometry_data
   ... do something with my_groups ...

Several groups can be associated at a time in #etsf_groups.

SOURCE

 ! Folder for the groups of variables
 type etsf_groups
  type(etsf_geometry), pointer :: geometry => null()
  type(etsf_electrons), pointer :: electrons => null()
  type(etsf_kpoints), pointer :: kpoints => null()
  type(etsf_basisdata), pointer :: basisdata => null()
  type(etsf_gwdata), pointer :: gwdata => null()
  type(etsf_dielectric), pointer :: dielectric => null()
  type(etsf_main), pointer :: main => null()
 end type etsf_groups

etsf_groups_flags

[ Top ] [ etsf_io_basics_group ] [ Structures ]

NAME

etsf_groups_flags

FUNCTION

This structure is a container for each group to specify which variables are required (see etsf_io_data_init()).

SOURCE

 ! Folder for the variable ids in each group
 type etsf_groups_flags
 integer :: geometry         = etsf_geometry_none
 integer :: electrons        = etsf_electrons_none
 integer :: kpoints          = etsf_kpoints_none
 integer :: basisdata        = etsf_basisdata_none
 integer :: gwdata           = etsf_gwdata_none
 integer :: dielectric       = etsf_dielectric_none
 integer :: main             = etsf_main_none
 end type etsf_groups_flags

etsf_gwdata

[ Top ] [ etsf_groups ] [ Structures ]

NAME

etsf_gwdata

FUNCTION

All variables from the specifications have been gathered into types called groups. These groups can be gathered into a container called #etsf_groups. This container is the main argument of the routines etsf_io_data_read() and etsf_io_data_write().

SOURCE

 ! Data type for gwdata
 type etsf_gwdata
  type(etsf_io_low_var_double) :: gw_corrections
  type(etsf_io_low_var_integer) :: kb_formfactor_sign
  type(etsf_io_low_var_double) :: kb_formfactors
  type(etsf_io_low_var_double) :: kb_formfactor_derivative

  ! Specific dimensions (etsf_spec_dimension get the value
  !  of the max_number_of_something when the variable is get
  !  or put, change it to a lower value if less values are to
  !  be accessed).
  integer :: gw_corrections__number_of_states = etsf_spec_dimension
  integer :: gw_corrections__spin_access = etsf_no_sub_access
  integer :: gw_corrections__kpoint_access = etsf_no_sub_access
  integer :: gw_corrections__state_access = etsf_no_sub_access
  integer :: kb_coeff_sig__number_of_angular_momenta = etsf_spec_dimension
  integer :: kb_coeff_sig__number_of_projectors = etsf_spec_dimension
  integer :: kb_coeff__number_of_angular_momenta = etsf_spec_dimension
  integer :: kb_coeff__number_of_projectors = etsf_spec_dimension
  integer :: kb_coeff__number_of_coefficients = etsf_spec_dimension
  integer :: kb_coeff__kpoint_access = etsf_no_sub_access
  integer :: kb_coeff_der__number_of_angular_momenta = etsf_spec_dimension
  integer :: kb_coeff_der__number_of_projectors = etsf_spec_dimension
  integer :: kb_coeff_der__number_of_coefficients = etsf_spec_dimension
  integer :: kb_coeff_der__kpoint_access = etsf_no_sub_access
 end type etsf_gwdata

etsf_io_basics_group

[ Top ] [ etsf_io ] [ Sub categories ]

FUNCTION

These are public parameters or types defined in the ETSF library.

SOURCE

  public :: etsf_dims

ETSF_IO_CONSTANTS

[ Top ] [ etsf_io_basics_group ] [ Definitions ]

NAME

ETSF_IO_CONSTANTS

FUNCTION

These values are fixed by the specifications or are static values. 

   * etsf_spec_dimension = to be used in a count argument (see
                           etsf_io_low_read_var() for instance) when
                           one wants to read all the values of one
                           dimension. For example count = (/ 1, etsf_spec_dimension /)
                           will read one element from the first dimension and
                           all for the second.
   * etsf_no_sub_access = some variable can be accessed only for one index in a
                          specific dimension (usually spin or k points). This
                          value is used to tell the library to access all the values
                          of that dimension.
   * etsf_no_dimension = this value is given to a dimension. It means that
                         the file does not contain that dimension.

SOURCE

  ! Constants for internal dimensions
  integer, parameter :: etsf_charlen = 80
  integer, parameter :: etsf_histlen = 1024
  integer, parameter :: etsf_chemlen = 2
  integer, parameter :: etsf_2dimlen = 2
  integer, parameter :: etsf_3dimlen = 3
  integer, parameter :: etsf_spec_dimension = 0
  integer, parameter :: etsf_no_sub_access = 0
  integer, parameter :: etsf_no_dimension = 0

 ! Global attributes
 character(len=etsf_charlen),parameter :: etsf_file_format = &
  & "ETSF Nanoquanta"
 character(len=etsf_charlen),parameter :: etsf_conventions = &
  & "http://www.etsf.eu/fileformats"
 real,parameter :: etsf_file_format_version = 3.3

etsf_io_data_group

[ Top ] [ etsf_io ] [ Sub categories ]

FUNCTION

These are the most usefull routines of the library etsf_io. They are used to read/write all or some selected variables of the ETSF specifications.

SOURCE

  public :: etsf_groups
  public :: etsf_io_data_init
  public :: etsf_io_data_read
  public :: etsf_io_data_write

ETSF_IO_VALIDITY_FLAGS

[ Top ] [ etsf_io_basics_group ] [ Definitions ]

NAME

ETSF_IO_VALIDITY_FLAGS

FUNCTION

These flags are used to identify a valid file as defined in the specifications. These valid files contains physical informations such as a potential or crystalographic data. Flags are not exclusive.

SOURCE

  integer, parameter :: etsf_specs_none                     = 0
  integer, parameter :: etsf_dielectric_function_data       = 1
  integer, parameter :: etsf_wavefunctions_data             = 2
  integer, parameter :: etsf_scalar_field_data              = 4
  integer, parameter :: etsf_crystallographic_data          = 8
  integer, parameter :: etsf_nspecs_data                    = 4
  character(len = *), parameter :: etsf_specs_names(4) = (/ &
    & "dielectric_function_data ", &
    & "wavefunctions_data       ", &
    & "scalar_field_data        ", &
    & "crystallographic_data    " /)

etsf_kpoints

[ Top ] [ etsf_groups ] [ Structures ]

NAME

etsf_kpoints

FUNCTION

All variables from the specifications have been gathered into types called groups. These groups can be gathered into a container called #etsf_groups. This container is the main argument of the routines etsf_io_data_read() and etsf_io_data_write().

SOURCE

 ! Data type for kpoints
 type etsf_kpoints
  double precision, pointer :: kpoint_grid_shift(:) => null()
  double precision, pointer :: kpoint_grid_vectors(:,:) => null()
  integer, pointer :: monkhorst_pack_folding(:) => null()
  double precision, pointer :: reduced_coordinates_of_kpoints(:,:) => null()
  double precision, pointer :: kpoint_weights(:) => null()
 end type etsf_kpoints

etsf_main

[ Top ] [ etsf_groups ] [ Structures ]

NAME

etsf_main

FUNCTION

All variables from the specifications have been gathered into types called groups. These groups can be gathered into a container called #etsf_groups. This container is the main argument of the routines etsf_io_data_read() and etsf_io_data_write().

SOURCE

 ! Data type for main
 type etsf_main
  type(etsf_io_low_var_double) :: density
  type(etsf_io_low_var_double) :: exchange_potential
  type(etsf_io_low_var_double) :: correlation_potential
  type(etsf_io_low_var_double) :: exchange_correlation_potential
  type(etsf_io_low_var_double) :: coefficients_of_wavefunctions
  type(etsf_io_low_var_double) :: real_space_wavefunctions

  ! Attributes
  ! Units attributes for variable density
  character(len=etsf_charlen) :: density__units = "atomic units"
  double precision :: density__scale_to_atomic_units = 1.0d0
  ! Units attributes for variable exchange_potential
  character(len=etsf_charlen) :: pot_x_only__units = "atomic units"
  double precision :: pot_x_only__scale_to_atomic_units = 1.0d0
  ! Units attributes for variable correlation_potential
  character(len=etsf_charlen) :: pot_c_only__units = "atomic units"
  double precision :: pot_c_only__scale_to_atomic_units = 1.0d0
  ! Units attributes for variable exchange_correlation_potential
  character(len=etsf_charlen) :: pot_xc__units = "atomic units"
  double precision :: pot_xc__scale_to_atomic_units = 1.0d0

  ! Specific dimensions (etsf_spec_dimension get the value
  !  of the max_number_of_something when the variable is get
  !  or put, change it to a lower value if less values are to
  !  be accessed).
  integer :: wfs_coeff__number_of_states = etsf_spec_dimension
  integer :: wfs_coeff__number_of_coefficients = etsf_spec_dimension
  integer :: wfs_coeff__spin_access = etsf_no_sub_access
  integer :: wfs_coeff__kpoint_access = etsf_no_sub_access
  integer :: wfs_coeff__state_access = etsf_no_sub_access
  integer :: wfs_rsp__number_of_states = etsf_spec_dimension
  integer :: wfs_rsp__spin_access = etsf_no_sub_access
  integer :: wfs_rsp__kpoint_access = etsf_no_sub_access
  integer :: wfs_rsp__state_access = etsf_no_sub_access
 end type etsf_main

etsf_split

[ Top ] [ etsf_io_basics_group ] [ Structures ]

FUNCTION

This group is used to store description array in the case of a splitted file.

SOURCE

 type etsf_split
  integer, pointer :: my_kpoints(:) => null()
  integer, pointer :: my_grid_points_vector3(:) => null()
  integer, pointer :: my_spins(:) => null()
  integer, pointer :: my_grid_points_vector1(:) => null()
  integer, pointer :: my_grid_points_vector2(:) => null()
  integer, pointer :: my_coefficients(:) => null()
  integer, pointer :: my_components(:) => null()
  integer, pointer :: my_states(:) => null()
 end type etsf_split

etsf_vars

[ Top ] [ etsf_io_basics_group ] [ Structures ]

NAME

etsf_vars

FUNCTION

This structure contains informations about a list of variables. It inherits from etsf_io_low_var_infos type, but it adds new fields, specific to the ETSF norm. These fields are:

  • @group which is a value in FLAGS_GROUPS ;
  • @varid which is a value in FLAGS_MAIN ;
  • @split which defines if the variable is a split definition array.

This structure is intrinsectly an array for performance reasons since variables are usually handled together. Use etsf_io_vars_free() to deallocate it.

SOURCE

  type etsf_vars
    integer                              :: n_vars    =  0
    type(etsf_io_low_var_infos), pointer :: parent(:) => null()
    integer, pointer                     :: group(:)  => null()
    integer, pointer                     :: varid(:)  => null()
    logical, pointer                     :: split(:)  => null()
  end type etsf_vars

FLAGS_GROUPS

[ Top ] [ etsf_io_basics_group ] [ Definitions ]

NAME

FLAGS_GROUPS

FUNCTION

These flags are used when indicating which groups must be used. If several groups must be accessed, then, simply add the corresponding flags. See etsf_io_data_write() or etsf_io_data_read() for usage.

SOURCE

 ! Constants for groups of variables
 integer, parameter :: etsf_grp_none             = 0
 integer, parameter :: etsf_grp_geometry         = 1
 integer, parameter :: etsf_grp_electrons        = 2
 integer, parameter :: etsf_grp_kpoints          = 4
 integer, parameter :: etsf_grp_basisdata        = 8
 integer, parameter :: etsf_grp_gwdata           = 16
 integer, parameter :: etsf_grp_dielectric       = 32
 integer, parameter :: etsf_grp_main             = 64
 integer, parameter :: etsf_ngroups              = 7

FLAGS_VARIABLES

[ Top ] [ etsf_io_basics_group ] [ Definitions ]

NAME

FLAGS_VARIABLES

FUNCTION

These flags are used on data definition (see etsf_io_data_init()) to specify which variables should be defined in the NetCDF file. They are not exclusive.

SOURCE

 ! 'geometry' variables
 integer, parameter :: etsf_geometry_none                 = 0
 integer, parameter :: etsf_geometry_space_group          = 1
 integer, parameter :: etsf_geometry_primitive_vectors    = 2
 integer, parameter :: etsf_geometry_red_sym_matrices     = 4
 integer, parameter :: etsf_geometry_red_sym_trans        = 8
 integer, parameter :: etsf_geometry_atom_species         = 16
 integer, parameter :: etsf_geometry_red_at_pos           = 32
 integer, parameter :: etsf_geometry_valence_charges      = 64
 integer, parameter :: etsf_geometry_atomic_numbers       = 128
 integer, parameter :: etsf_geometry_atom_species_names   = 256
 integer, parameter :: etsf_geometry_chemical_symbols     = 512
 integer, parameter :: etsf_geometry_pseudo_types         = 1024
 integer, parameter :: etsf_geometry_all                  = 2047
 integer, parameter :: etsf_geometry_nvars                = 11

 ! 'electrons' variables
 integer, parameter :: etsf_electrons_none                 = 0
 integer, parameter :: etsf_electrons_number_of_electrons  = 1
 integer, parameter :: etsf_electrons_x_functional         = 2
 integer, parameter :: etsf_electrons_c_functional         = 4
 integer, parameter :: etsf_electrons_fermi_energy         = 8
 integer, parameter :: etsf_electrons_smearing_scheme      = 16
 integer, parameter :: etsf_electrons_smearing_width       = 32
 integer, parameter :: etsf_electrons_number_of_states     = 64
 integer, parameter :: etsf_electrons_eigenvalues          = 128
 integer, parameter :: etsf_electrons_occupations          = 256
 integer, parameter :: etsf_electrons_all                  = 511
 integer, parameter :: etsf_electrons_nvars                = 9

 ! 'kpoints' variables
 integer, parameter :: etsf_kpoints_none                 = 0
 integer, parameter :: etsf_kpoints_kpoint_grid_shift    = 1
 integer, parameter :: etsf_kpoints_kpoint_grid_vectors  = 2
 integer, parameter :: etsf_kpoints_mp_folding           = 4
 integer, parameter :: etsf_kpoints_red_coord_kpt        = 8
 integer, parameter :: etsf_kpoints_kpoint_weights       = 16
 integer, parameter :: etsf_kpoints_all                  = 31
 integer, parameter :: etsf_kpoints_nvars                = 5

 ! 'basisdata' variables
 integer, parameter :: etsf_basisdata_none                 = 0
 integer, parameter :: etsf_basisdata_basis_set            = 1
 integer, parameter :: etsf_basisdata_kin_cutoff           = 2
 integer, parameter :: etsf_basisdata_n_coeff              = 4
 integer, parameter :: etsf_basisdata_red_coord_pw         = 8
 integer, parameter :: etsf_basisdata_coord_grid           = 16
 integer, parameter :: etsf_basisdata_n_coeff_grid         = 32
 integer, parameter :: etsf_basisdata_all                  = 63
 integer, parameter :: etsf_basisdata_nvars                = 6

 ! 'gwdata' variables
 integer, parameter :: etsf_gwdata_none                 = 0
 integer, parameter :: etsf_gwdata_gw_corrections       = 1
 integer, parameter :: etsf_gwdata_kb_coeff_sig         = 2
 integer, parameter :: etsf_gwdata_kb_coeff             = 4
 integer, parameter :: etsf_gwdata_kb_coeff_der         = 8
 integer, parameter :: etsf_gwdata_all                  = 15
 integer, parameter :: etsf_gwdata_nvars                = 4

 ! 'dielectric' variables
 integer, parameter :: etsf_dielectric_none                 = 0
 integer, parameter :: etsf_dielectric_frequencies          = 1
 integer, parameter :: etsf_dielectric_qpt                  = 2
 integer, parameter :: etsf_dielectric_qpt_g_lim            = 4
 integer, parameter :: etsf_dielectric_function             = 8
 integer, parameter :: etsf_dielectric_function_head        = 16
 integer, parameter :: etsf_dielectric_function_lower       = 32
 integer, parameter :: etsf_dielectric_function_upper       = 64
 integer, parameter :: etsf_dielectric_function_inv         = 128
 integer, parameter :: etsf_dielectric_function_inv_head    = 256
 integer, parameter :: etsf_dielectric_function_inv_lower   = 512
 integer, parameter :: etsf_dielectric_function_inv_upper   = 1024
 integer, parameter :: etsf_dielectric_polarizability       = 2048
 integer, parameter :: etsf_dielectric_pol_head             = 4096
 integer, parameter :: etsf_dielectric_pol_lower            = 8192
 integer, parameter :: etsf_dielectric_pol_upper            = 16384
 integer, parameter :: etsf_dielectric_polarizability_inv   = 32768
 integer, parameter :: etsf_dielectric_pol_inv_head         = 65536
 integer, parameter :: etsf_dielectric_pol_inv_lower        = 131072
 integer, parameter :: etsf_dielectric_pol_inv_upper        = 262144
 integer, parameter :: etsf_dielectric_all                  = 524287
 integer, parameter :: etsf_dielectric_nvars                = 19

 ! 'main' variables
 integer, parameter :: etsf_main_none                 = 0
 integer, parameter :: etsf_main_density              = 1
 integer, parameter :: etsf_main_pot_x_only           = 2
 integer, parameter :: etsf_main_pot_c_only           = 4
 integer, parameter :: etsf_main_pot_xc               = 8
 integer, parameter :: etsf_main_wfs_coeff            = 16
 integer, parameter :: etsf_main_wfs_rsp              = 32
 integer, parameter :: etsf_main_all                  = 63
 integer, parameter :: etsf_main_nvars                = 6
etsf_io-1.0.3/doc/www/tutorials/0000777000353400050620000000000011354151531013570 500000000000000etsf_io-1.0.3/doc/www/tutorials/Makefile.am0000644000353400050620000000043111354063644015545 00000000000000tutorialsdoc_DATA = \ convert_to_xyz_f90.html \ create_a_crystal_den_file_f90.html \ index.html \ mix_ETSF_and_non_ETSF_f90.html \ MPI_output_of_a_density_f90.html \ read_a_file_f90.html \ README_f90.html \ read_write_sub_access_f90.html EXTRA_DIST = $(tutorialsdoc_DATA) etsf_io-1.0.3/doc/www/tutorials/Makefile.in0000644000353400050620000002276011354150420015554 00000000000000# Makefile.in generated by automake 1.10.1 from Makefile.am. # @configure_input@ # Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, # 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. # This Makefile.in is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY, to the extent permitted by law; without # even the implied warranty of MERCHANTABILITY or FITNESS FOR A # PARTICULAR PURPOSE. @SET_MAKE@ VPATH = @srcdir@ pkgdatadir = $(datadir)/@PACKAGE@ pkglibdir = $(libdir)/@PACKAGE@ pkgincludedir = $(includedir)/@PACKAGE@ am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd install_sh_DATA = $(install_sh) -c -m 644 install_sh_PROGRAM = $(install_sh) -c install_sh_SCRIPT = $(install_sh) -c INSTALL_HEADER = $(INSTALL_DATA) transform = $(program_transform_name) NORMAL_INSTALL = : PRE_INSTALL = : POST_INSTALL = : NORMAL_UNINSTALL = : PRE_UNINSTALL = : POST_UNINSTALL = : subdir = doc/www/tutorials DIST_COMMON = $(srcdir)/Makefile.am $(srcdir)/Makefile.in ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 am__aclocal_m4_deps = $(top_srcdir)/config/m4/fortran.m4 \ $(top_srcdir)/configure.ac am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ $(ACLOCAL_M4) mkinstalldirs = $(install_sh) -d CONFIG_CLEAN_FILES = SOURCES = DIST_SOURCES = am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; am__vpath_adj = case $$p in \ $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \ *) f=$$p;; \ esac; am__strip_dir = `echo $$p | sed -e 's|^.*/||'`; am__installdirs = "$(DESTDIR)$(tutorialsdocdir)" tutorialsdocDATA_INSTALL = $(INSTALL_DATA) DATA = $(tutorialsdoc_DATA) DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) ACLOCAL = @ACLOCAL@ AMTAR = @AMTAR@ AR = @AR@ AUTOCONF = @AUTOCONF@ AUTOHEADER = @AUTOHEADER@ AUTOMAKE = @AUTOMAKE@ AWK = @AWK@ CYGPATH_W = @CYGPATH_W@ DEFS = @DEFS@ ECHO_C = @ECHO_C@ ECHO_N = @ECHO_N@ ECHO_T = @ECHO_T@ EXEEXT = @EXEEXT@ FC = @FC@ FCFLAGS = @FCFLAGS@ FCFLAGS_f90 = @FCFLAGS_f90@ FFLAGS = @FFLAGS@ INSTALL = @INSTALL@ INSTALL_DATA = @INSTALL_DATA@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ INSTALL_SCRIPT = @INSTALL_SCRIPT@ INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ LDFLAGS = @LDFLAGS@ LIBOBJS = @LIBOBJS@ LIBS = @LIBS@ LTLIBOBJS = @LTLIBOBJS@ MAKEINFO = @MAKEINFO@ MKDIR_P = @MKDIR_P@ MODULE_EXT = @MODULE_EXT@ NETCDF_CFLAGS = @NETCDF_CFLAGS@ OBJEXT = @OBJEXT@ PACKAGE = @PACKAGE@ PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ PACKAGE_NAME = @PACKAGE_NAME@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_VERSION = @PACKAGE_VERSION@ PATH_SEPARATOR = @PATH_SEPARATOR@ RANLIB = @RANLIB@ SET_MAKE = @SET_MAKE@ SHELL = @SHELL@ STRIP = @STRIP@ VERSION = @VERSION@ abs_builddir = @abs_builddir@ abs_srcdir = @abs_srcdir@ abs_top_builddir = @abs_top_builddir@ abs_top_srcdir = @abs_top_srcdir@ ac_ct_FC = @ac_ct_FC@ am__leading_dot = @am__leading_dot@ am__tar = @am__tar@ am__untar = @am__untar@ bindir = @bindir@ build_alias = @build_alias@ builddir = @builddir@ datadir = @datadir@ datarootdir = @datarootdir@ docdir = @docdir@ dvidir = @dvidir@ exec_prefix = @exec_prefix@ fc_type = @fc_type@ fc_version = @fc_version@ fc_wrap = @fc_wrap@ groupleveldocdir = @groupleveldocdir@ host_alias = @host_alias@ htmldir = @htmldir@ includedir = @includedir@ infodir = @infodir@ install_sh = @install_sh@ libdir = @libdir@ libexecdir = @libexecdir@ localedir = @localedir@ localstatedir = @localstatedir@ lowleveldocdir = @lowleveldocdir@ mandir = @mandir@ mkdir_p = @mkdir_p@ moduledir = @moduledir@ oldincludedir = @oldincludedir@ pdfdir = @pdfdir@ prefix = @prefix@ program_transform_name = @program_transform_name@ psdir = @psdir@ sbindir = @sbindir@ sharedstatedir = @sharedstatedir@ srcdir = @srcdir@ sysconfdir = @sysconfdir@ target_alias = @target_alias@ top_builddir = @top_builddir@ top_srcdir = @top_srcdir@ tutorialsdocdir = @tutorialsdocdir@ utilsdocdir = @utilsdocdir@ tutorialsdoc_DATA = \ convert_to_xyz_f90.html \ create_a_crystal_den_file_f90.html \ index.html \ mix_ETSF_and_non_ETSF_f90.html \ MPI_output_of_a_density_f90.html \ read_a_file_f90.html \ README_f90.html \ read_write_sub_access_f90.html EXTRA_DIST = $(tutorialsdoc_DATA) all: all-am .SUFFIXES: $(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) @for dep in $?; do \ case '$(am__configure_deps)' in \ *$$dep*) \ cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh \ && exit 0; \ exit 1;; \ esac; \ done; \ echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu doc/www/tutorials/Makefile'; \ cd $(top_srcdir) && \ $(AUTOMAKE) --gnu doc/www/tutorials/Makefile .PRECIOUS: Makefile Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status @case '$?' in \ *config.status*) \ cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ *) \ echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ esac; $(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh $(top_srcdir)/configure: $(am__configure_deps) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh $(ACLOCAL_M4): $(am__aclocal_m4_deps) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh install-tutorialsdocDATA: $(tutorialsdoc_DATA) @$(NORMAL_INSTALL) test -z "$(tutorialsdocdir)" || $(MKDIR_P) "$(DESTDIR)$(tutorialsdocdir)" @list='$(tutorialsdoc_DATA)'; for p in $$list; do \ if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ f=$(am__strip_dir) \ echo " $(tutorialsdocDATA_INSTALL) '$$d$$p' '$(DESTDIR)$(tutorialsdocdir)/$$f'"; \ $(tutorialsdocDATA_INSTALL) "$$d$$p" "$(DESTDIR)$(tutorialsdocdir)/$$f"; \ done uninstall-tutorialsdocDATA: @$(NORMAL_UNINSTALL) @list='$(tutorialsdoc_DATA)'; for p in $$list; do \ f=$(am__strip_dir) \ echo " rm -f '$(DESTDIR)$(tutorialsdocdir)/$$f'"; \ rm -f "$(DESTDIR)$(tutorialsdocdir)/$$f"; \ done tags: TAGS TAGS: ctags: CTAGS CTAGS: distdir: $(DISTFILES) @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ list='$(DISTFILES)'; \ dist_files=`for file in $$list; do echo $$file; done | \ sed -e "s|^$$srcdirstrip/||;t" \ -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ case $$dist_files in \ */*) $(MKDIR_P) `echo "$$dist_files" | \ sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ sort -u` ;; \ esac; \ for file in $$dist_files; do \ if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ if test -d $$d/$$file; then \ dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ cp -pR $(srcdir)/$$file $(distdir)$$dir || exit 1; \ fi; \ cp -pR $$d/$$file $(distdir)$$dir || exit 1; \ else \ test -f $(distdir)/$$file \ || cp -p $$d/$$file $(distdir)/$$file \ || exit 1; \ fi; \ done check-am: all-am check: check-am all-am: Makefile $(DATA) installdirs: for dir in "$(DESTDIR)$(tutorialsdocdir)"; do \ test -z "$$dir" || $(MKDIR_P) "$$dir"; \ done install: install-am install-exec: install-exec-am install-data: install-data-am uninstall: uninstall-am install-am: all-am @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am installcheck: installcheck-am install-strip: $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ `test -z '$(STRIP)' || \ echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install mostlyclean-generic: clean-generic: distclean-generic: -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) maintainer-clean-generic: @echo "This command is intended for maintainers to use" @echo "it deletes files that may require special tools to rebuild." clean: clean-am clean-am: clean-generic mostlyclean-am distclean: distclean-am -rm -f Makefile distclean-am: clean-am distclean-generic dvi: dvi-am dvi-am: html: html-am info: info-am info-am: install-data-am: install-tutorialsdocDATA install-dvi: install-dvi-am install-exec-am: install-html: install-html-am install-info: install-info-am install-man: install-pdf: install-pdf-am install-ps: install-ps-am installcheck-am: maintainer-clean: maintainer-clean-am -rm -f Makefile maintainer-clean-am: distclean-am maintainer-clean-generic mostlyclean: mostlyclean-am mostlyclean-am: mostlyclean-generic pdf: pdf-am pdf-am: ps: ps-am ps-am: uninstall-am: uninstall-tutorialsdocDATA .MAKE: install-am install-strip .PHONY: all all-am check check-am clean clean-generic distclean \ distclean-generic distdir dvi dvi-am html html-am info info-am \ install install-am install-data install-data-am install-dvi \ install-dvi-am install-exec install-exec-am install-html \ install-html-am install-info install-info-am install-man \ install-pdf install-pdf-am install-ps install-ps-am \ install-strip install-tutorialsdocDATA installcheck \ installcheck-am installdirs maintainer-clean \ maintainer-clean-generic mostlyclean mostlyclean-generic pdf \ pdf-am ps ps-am uninstall uninstall-am \ uninstall-tutorialsdocDATA # Tell versions [3.59,3.63) of GNU make to not export all variables. # Otherwise a system limit (for SysV at least) may be exceeded. .NOEXPORT: etsf_io-1.0.3/doc/www/tutorials/convert_to_xyz_f90.html0000644000353400050620000004726011354150415020155 00000000000000 ./src/tutorials/convert_to_xyz.f90

TABLE OF CONTENTS

convert_to_xyz

[ Top ] [ etsf_io_tutorials ] [ Tutorials ]

NAME

convert_to_xyz

FUNCTION

In this example, we will describe how to use the high level routines from etsf_io_file and etsf_io_tools (from library etsf_io_utils). Doing it, we will read a cristallographic file, check its validity and convert it to XYZ file, reading the coordinates of atoms and getting their names.

To compile this exemple, use (assuming default installation paths): 

   ${F90} -I/opt/include/${F90} -o convert_to_xyz convert_to_xyz.f90
          -L/opt/lib -letsf_io_utils -letsf_io -L/usr/lib -lnetcdf

SOURCE

program convert_to_xyz

  use etsf_io_low_level
  use etsf_io
  use etsf_io_file
  use etsf_io_tools

  implicit none

  integer :: iargc
  character(len = etsf_io_low_error_len) :: filename, error_string
  logical :: lstat
  type(etsf_io_low_error) :: error_data
  integer :: i_atom
  double precision :: coord(etsf_3dimlen)

NOTES

In this tutorial, we will open an ETSF file, and some variable of the geometry group (see the first tutorial on how to create_a_crystal_den_file for further explanations on groups and especially etsf_geometry).

The required data to create an XYZ file are:

  • primitive_vectors for the box definition,
  • reduced_atom_positions for the atom coordinates,
  • atom_species for the nature of elements.

SOURCE

  integer :: ncid
  type(etsf_dims) :: dims_data
  type(etsf_geometry) :: geometry_data
  double precision, allocatable, target :: primitive_vectors(:,:)
  double precision, allocatable, target :: reduced_atom_positions(:,:)
  integer, allocatable, target :: atom_species(:)

NOTES

The names of atoms receives a special treatment since it can be found in several variables. The specifications are clear on preference and we will use the etsf_io_tools_get_atom_names() routine to handle this preference and read the atom names.

SOURCE

  character(len = etsf_charlen), allocatable :: atom_names(:)

NOTES

We read the number of argument and get the input filename from the command line.

SOURCE

  ! Read number of program argument, should be one.
  if (iargc() /= 1) then
     write(0, *) "Error: one argument is required."
     stop
  end if
  ! Read name of input file.
  call getarg(1, filename)

NOTES

Before doing anything else, we check that our file is a valid crystallographic file. To do it, we use the module etsf_io_file and its routine etsf_io_file_check(). This routine will open the given file and check that it machtes one or several requirements (see flags in ETSF_IO_VALIDITY_FLAGS). Flags can be added to form a complex validation on several specifications.

If an error occurs, we transform the error data to a string and output it on the standard error.

SOURCE

  call etsf_io_file_check(trim(filename), etsf_crystallographic_data, &
       & lstat, error_data)
  if (.not. lstat) then
     write(0, *) "Error: invalid input file, it does not match crystallographic"
     write(0, *) "       requirements. Given reason:"
     call etsf_io_low_error_to_str(error_string, error_data)
     write(0, "(A)") trim(error_string)
     stop
  end if

NOTES

Now that our file is valid, we will follow a step by step procedure to reopen it, read the dimensions, allocate our temporary arrays, read the required informations, get the atoms names, close the file and output the informations in XYZ format.

SOURCE

  call etsf_io_low_open_read(ncid, trim(filename), lstat, error_data = error_data)
  if (.not. lstat) then
     call etsf_io_low_error_to_str(error_string, error_data)
     write(0, "(A)") trim(error_string)
     stop
  end if

NOTES

The dimensions are read and stored into dims_data.

SOURCE

  call etsf_io_dims_get(ncid, dims_data, lstat, error_data)
  if (.not. lstat) then
     call etsf_io_low_error_to_str(error_string, error_data)
     write(0, "(A)") trim(error_string)
     stop
  end if

NOTES

We allocate the local arrays where to put the read informations.

SOURCE

  allocate(primitive_vectors(dims_data%number_of_cartesian_directions, &
       & dims_data%number_of_vectors))
  allocate(reduced_atom_positions(dims_data%number_of_reduced_dimensions, &
       & dims_data%number_of_atoms))
  allocate(atom_species(dims_data%number_of_atoms))
  allocate(atom_names(dims_data%number_of_atom_species))
  geometry_data%primitive_vectors => primitive_vectors
  geometry_data%reduced_atom_positions => reduced_atom_positions
  geometry_data%atom_species => atom_species

NOTES

We get the informations from the NetCDF file for the pointers that have been associated in geometry_data.

SOURCE

  call etsf_io_geometry_get(ncid, geometry_data, lstat, error_data)
  if (.not. lstat) then
     call etsf_io_low_error_to_str(error_string, error_data)
     write(0, "(A)") trim(error_string)
     stop
  end if

NOTES

We use the high level routine that get the names of atoms. If the file is valid, it always returns string informations (into @atom_names), but atomic numbers can also be returned as double values in an optional array (see @atom_numbers). We don't need here the double values, so we don't use the optional argument.

SOURCE

  call etsf_io_tools_get_atom_names(ncid, atom_names, lstat, error_data)
  if (.not. lstat) then
     call etsf_io_low_error_to_str(error_string, error_data)
     write(0, "(A)") trim(error_string)
     stop
  end if

NOTES

We don't forget to close the file.

SOURCE

  call etsf_io_low_close(ncid, lstat, error_data)
  if (.not. lstat) then
     call etsf_io_low_error_to_str(error_string, error_data)
     write(0, "(A)") trim(error_string)
     stop
  end if

NOTES

Finally we output informations in XYZ format.

SOURCE

  write(*, "(I0)") dims_data%number_of_atoms
  write(*, "(3A)") "Converted from '", trim(filename), "'"
  do i_atom = 1, dims_data%number_of_atoms, 1
     coord(1) = primitive_vectors(1, 1) * reduced_atom_positions(1, i_atom) + &
          & primitive_vectors(2, 1) * reduced_atom_positions(2, i_atom) + &
          & primitive_vectors(3, 1) * reduced_atom_positions(3, i_atom)
     coord(2) = primitive_vectors(1, 2) * reduced_atom_positions(1, i_atom) + &
          & primitive_vectors(2, 2) * reduced_atom_positions(2, i_atom) + &
          & primitive_vectors(3, 2) * reduced_atom_positions(3, i_atom)
     coord(3) = primitive_vectors(1, 3) * reduced_atom_positions(1, i_atom) + &
          & primitive_vectors(2, 3) * reduced_atom_positions(2, i_atom) + &
          & primitive_vectors(3, 3) * reduced_atom_positions(3, i_atom)
     write(*, "(A,3E16.6)") trim(atom_names(atom_species(i_atom))), coord
  end do

  deallocate(primitive_vectors)
  deallocate(reduced_atom_positions)
  deallocate(atom_species)
  deallocate(atom_names)
end program convert_to_xyz
etsf_io-1.0.3/doc/www/tutorials/create_a_crystal_den_file_f90.html0000644000353400050620000006165611354150415022217 00000000000000 ./src/tutorials/create_a_crystal_den_file.f90

TABLE OF CONTENTS

create_a_crystal_den_file

[ Top ] [ etsf_io_tutorials ] [ Tutorials ]

NAME

create_a_crystal_den_file

FUNCTION

In this example, we will describe how to use the etsf_io_data_init() routine. This routine creates a file, conforming to the ETSF specifications, with several uninitialised variables in it. Then we will see how to write values into this file, using etsf_io_data_write().

To compile this exemple, use (assuming default installation paths): 

   ${F90} -I/opt/include/${F90} -o create_a_crystal_den_file create_a_crystal_den_file.f90
          -L/opt/lib -letsf_io -L/usr/lib -lnetcdf

SOURCE

program create_a_crystal_den_file

  use etsf_io

  integer :: i

NOTES

All routines from the group level requires two output arguments: 

   * lstat which is a logical. When .false. something goes wrong in
     the routine and the action is aborted. No actions are atomic, which
     means that if lstat is .false., the status of the NetCDF file (what
     have been done) is not guarantee.
   * error_data which a of type #etsf_io_low_error. It contains many informations
     about the error if lstat is .false.. One can use etsf_io_low_error_to_str
     to get a character(len = 1024) describing the error, or one can implement
     one itself since the type is public and documented.

SOURCE

  logical                 :: lstat
  type(etsf_io_low_error) :: error_data

NOTES

To create a NetCDF, we need to give at creation time all the dimensions that define the variables. The file will then be allocated on disk and may be write with values later. All dimensions declared in the ETSF specifications are stored in a type called etsf_dims. Some of these dimensions are fixed by the specifications such as character_string_length and will be set by the etsf_io_data_init() routine itself. Other values are free to be chosen.

SOURCE

  type(etsf_dims)         :: dims

NOTES

To write values in one call into an already defined ETSF file, the type etsf_groups is used as a container for several groups. Here our container will have associated pointers on an etsf_geometry and an etsf_main. So we declare them. All the structures used in this library are only containers and do not have the allocated memory. This is done to avoid memory duplication when using the library with a code with its own variables. So we also need some variables (in a real case, they are declared in the main program) to stored our density and geometric informations.

SOURCE

  ! Specific variables required by the library
  type(etsf_groups_flags)     :: flags
  type(etsf_groups)           :: groups
  type(etsf_geometry), target :: geometry
  type(etsf_main), target     :: main
  ! Variables that are declared in the main program in a real case
  double precision, allocatable, target :: density(:)
  integer, target                       :: space_group
  double precision, target              :: primitive_vector(3, 3)
  double precision, allocatable, target :: reduced_atom_positions(:,:)
  integer, allocatable, target          :: atom_species(:)
  character(len=2), allocatable, target :: chemical_symbols(:)
  integer, allocatable, target          :: reduced_symmetry_matrices(:,:,:)
  double precision, allocatable, target :: reduced_symmetry_translations(:,:)

NOTES

We will create for example a file for the density of the silane molecule, without spin nor spin-orbit, 1 k point. We imagine that the molecule no symmetry except identity.

SOURCE

  dims%max_number_of_coefficients = 1400
  dims%max_number_of_states = 6
  dims%number_of_atoms = 5
  dims%number_of_atom_species = 2
  dims%number_of_components = 1
  dims%number_of_grid_points_vector1 = 36
  dims%number_of_grid_points_vector2 = 36
  dims%number_of_grid_points_vector3 = 36
  dims%number_of_kpoints = 1
  dims%number_of_spinor_components = 1
  dims%number_of_spins = 1
  dims%number_of_symmetry_operations = 1

NOTES

Now that dimensions have been stored in the appropriated structure, we can call the etsf_io_data_init() routine itself. The 'groups' argument is very important It will tell which variables will we allocated on disk. All variables are gathered by groups and one can choose one or several groups to be defined. To do it, use the flags from #FLAGS_VARIABLES, in a summation for each group in the etsf_groups_flags structure. By default no group will be defined, to add the geometry group, we will use the value etsf_geometry_all (from #FLAGS_VARIABLES) ; and to add the density variable (from the main group), and only this one, we will use etsf_main_denisty.

Other arguments of the routine are quite easy to understand. The optional k_dependent argument is here to handle the case of reduced_coordinates_of_plane_waves which shape depends on the value of this attribute. If k_dependent is given .false. (default is .true.), then all variables with this attribute will be labelled "no" and the variable reduced_coordinates_of_plane_waves will be a two dimensional array.

SOURCE

  flags%geometry = etsf_geometry_all
  flags%main     = etsf_main_density
  call etsf_io_data_init("create_a_crystal_den_file.nc", flags, dims, &
                       & "Tutorial ETSF_IO, create a density file", &
                       & "Created by the tutorial example of the library", &
                       & lstat, error_data)

NOTES

The required variables for a density file are in etsf_geometry and in etsf_main, that's why the groups argument is the sum of the two flags.

We can now, handle the error, if one occured. The method etsf_io_low_error_handle() is used to print the contains of an error type on the standrard output. If one is interested on printing the error on something different than the standard output, one should convert the error into a character(len = 1024) with etsf_io_low_error_to_str() before.

SOURCE

  if (.not. lstat) then
    call etsf_io_low_error_handle(error_data)
    stop
  end if

NOTES

At this time of the example, the disk space to store the density and the geometric informations has been reserved. In a real case, we let the main program computing the density and setting up the geometric informations.

SOURCE

  ! The main program allocate memory for its computation.
  allocate(density(36 * 36 * 36))
  allocate(reduced_atom_positions(3,5))
  allocate(atom_species(5))
  allocate(chemical_symbols(2))
  allocate(reduced_symmetry_matrices(3, 3, 1))
  allocate(reduced_symmetry_translations(3, 1))
  
  ! The main program compute all symmetries and set up the positions...
  space_group = 1
  primitive_vector = reshape( (/ 10, 0, 0, 0, 10, 0, 0, 0, 10 /), (/ 3, 3 /))
  reduced_symmetry_matrices = reshape( (/ 1, 0, 0, 0, 1, 0, 0, 0, 1 /), (/ 3, 3, 1 /))
  reduced_symmetry_translations = reshape( (/ 0, 0, 0 /), (/ 3, 1 /))
  reduced_atom_positions = reshape( (/ 0.5d0, 0.5d0, 0.5d0, &
                                     & 0.6d0, 0.6d0, 0.6d0, &
                                     & 0.6d0, 0.4d0, 0.4d0, &
                                     & 0.4d0, 0.4d0, 0.6d0, &
                                     & 0.4d0, 0.6d0, 0.4d0 /), (/ 3, 5 /))
  atom_species = (/ 2, 1, 1, 1, 1 /)
  chemical_symbols = (/ "H ", "Si" /)

  ! We compute the density with a powerful algorithm.
  density = (/ (0.d0 + i, i = 1, 36 * 36 * 36) /)

NOTES

Before calling the etsf_io_data_write() routine, we associate the pointers of our group types to the main program memory data. Only associated pointers will be written. All other defined variables will be let untouched. Some variable are defined with a type called etsf_io_low_var_double or etsf_io_low_var_integer. These variables are arrays which could have a different shape in the main program and in the specifications. For instance, our density is 1D only whereas in the specifications the density is 5D. So we use the attribute %data1D of the structure etsf_io_low_var_double for the density. This will work because data in the main program memory has the same number of elements than the space defined in the ETSF file AND data are ordered in the same way (elements along X axis are varying quicker than along Y or Z).

SOURCE

  ! We associate the geometry
  geometry%space_group => space_group
  geometry%primitive_vectors => primitive_vector
  geometry%reduced_symmetry_matrices => reduced_symmetry_matrices
  geometry%reduced_symmetry_translations => reduced_symmetry_translations
  geometry%atom_species => atom_species
  geometry%reduced_atom_positions => reduced_atom_positions
  geometry%chemical_symbols => chemical_symbols
  ! We associate the main data
  ! We don't want to dupplicate the density data even if ours is 1D
  ! and ETSF is 5D, so we use the unformatted pointer in the etsf_main
  ! structure.
  main%density%data1D => density
  ! We associate our two group in the container.
  groups%geometry => geometry
  groups%main => main

  ! We write.
  call etsf_io_data_write("create_a_crystal_den_file.nc", &
                        & groups, lstat, error_data)
  ! We handle the error
  if (.not. lstat) then
    call etsf_io_low_error_handle(error_data)
    stop
  end if
  
  ! The main program will deallocate its own memory.
  deallocate(density)
  deallocate(reduced_atom_positions)
  deallocate(atom_species)
  deallocate(chemical_symbols)
  deallocate(reduced_symmetry_matrices)
  deallocate(reduced_symmetry_translations)
end program create_a_crystal_den_file
etsf_io-1.0.3/doc/www/tutorials/index.html0000644000353400050630000001214710656547717015532 00000000000000 ETSF_IO tutorials

Tutorials are directly Fortran source code, highly commented, located in src/tutorials. These codes can be compiled and executed to create example files. The HTML tutorials are a pretty printing of these source files. Each HTML file contains a short introduction to explain the objectives of the tutorial and then follow the source code, regularly interrupted by notes and comments.

Tutorial 1 - basics of file creation

The first tutorial is intended to explain the basics and the philosophy of this library. It details the first steps required to create a density file, using high level routines (etsf_io_data_<action>). It shows how to use the pointers and the unformatted ones (used to map any shape arrays between the ETSF definition and the main program memory).

Tutorial 2 - advanced writing, sub-access on k point and spin

The second tutorial introduces the group level routines and explain how to access only sub part of arrays. This sub access is possible when one array has a dimension on spin or k points. Then one can access data for one k point or spin at a time. This is controlled by some attributes in the concerned groups, called <short_var_name>__[spin|kpoint]_access. In this tutorial a wave-function file is created and the coefficients of wave-functions are written for one k point at a time.

Tutorial 3 - a converter tool, usage of validity checks

The third tutorial shows how to use high level modules etsf_io_file and etsf_io_tools to check the conformance of an input ETSF file on cristalographic specifications and then to read atomic coordinates and names to create a simple XYZ file.

Tutorial 4 - how to use split capabilities in conjonction with MPI?

The fourth tutorial shows how to use the split definitions as defined in the specifications to handle MPI computations. This is possible with the help of the etsf_split structure. This tutorial create a density file with a paralelisation on z planes. Each process compute a gaussian in its own z planes and create an ETSF file with a split on number_of_grid_points_vector3. Thanks to etsf_io the created files can be then gathered into one unique file.

Tutorial 5 - mixing ETSF and non-ETSF variables in file creation (tutorial 1 enhancement)

The fifth tutorial is not focus on the low level API but it uses it in several areas. This tutorial shows how to write an ETSF file with additional non-ETSF variables. These variables are defined and written directly by using the low level API. Besides it also shows how to use the etsf_io_<group>_put() methods in the context of a concurrent list of ETSF and non-ETSF variables.

Tutorial 6 - simple read of a wavefunction file (continuation of tutorial 2)

The sixth tutorial introduces the read actions in a simple case. Here, we know that the file should contains the variables of a wavefunction description. This tutorial uses the file created by tutorial 2 but does not read it with sub access. Everything is read once as a bloc.

etsf_io-1.0.3/doc/www/tutorials/mix_ETSF_and_non_ETSF_f90.html0000644000353400050620000007733011354150414021014 00000000000000 ./src/tutorials/mix_ETSF_and_non_ETSF.f90

TABLE OF CONTENTS

mix_ETSF_and_non_ETSF

[ Top ] [ etsf_io_tutorials ] [ Tutorials ]

NAME

mix_ETSF_and_non_ETSF

FUNCTION

This tutorial is based on the first tutorial that create a density file. In this example, we introduce how to mix ETSF variables (the density) and non-ETSF variables (user defined, program dependent values...).

The main difference is to use the etsf_io_<group>_put() routines instead of the all-in-one etsf_io_data_write() as introduced in the first tutorial. The changed lines of the first tutorial are kept as commentaries for comparison purposes.

To compile this exemple, use (assuming default installation paths): 

   ${F90} -I/opt/include/${F90} -o mix_ETSF_and_non_ETSF mix_ETSF_and_non_ETSF.f90
          -L/opt/lib -letsf_io_utils -letsf_io -L/usr/lib -lnetcdf

SOURCE

program mix_ETSF_and_non_ETSF

  use etsf_io_low_level
  use etsf_io

  integer :: i

NOTES

In the variable declarations relative to ETSF_IO, the etsf_group structure is not used anymore, since the def and put actions will be more atomic (but not as atomic as handling each variable).

SOURCE

  integer                 :: ncid
  logical                 :: lstat
  type(etsf_io_low_error) :: error_data
  type(etsf_groups_flags) :: flags
  type(etsf_dims)         :: dims
  ! Specific variables required by the library
  !FIRST# type(etsf_groups)           :: groups
  type(etsf_geometry), target :: geometry
  type(etsf_main), target     :: main

NOTES

The variable declared in the main program are left unchanged.

SOURCE

  ! Variables that are declared in the main program in a real case
  double precision, allocatable, target :: density(:)
  integer, target                       :: space_group
  double precision, target              :: primitive_vector(3, 3)
  double precision, allocatable, target :: reduced_atom_positions(:,:)
  integer, allocatable, target          :: atom_species(:)
  character(len=2), allocatable, target :: chemical_symbols(:)
  integer, allocatable, target          :: reduced_symmetry_matrices(:,:,:)
  double precision, allocatable, target :: reduced_symmetry_translations(:,:)

NOTES

The definition of the dimensions is still the same

SOURCE

  dims%max_number_of_coefficients = 1400
  dims%max_number_of_states = 6
  dims%number_of_atoms = 5
  dims%number_of_atom_species = 2
  dims%number_of_components = 1
  dims%number_of_grid_points_vector1 = 36
  dims%number_of_grid_points_vector2 = 36
  dims%number_of_grid_points_vector3 = 36
  dims%number_of_kpoints = 1
  dims%number_of_spinor_components = 1
  dims%number_of_spins = 1
  dims%number_of_symmetry_operations = 1

NOTES

The declaration of the file is almost left unchanged. A file is allocated on disk with the given dimensions (see the dims variable).

But, the main group is not defined here. This is done because the main group (density, coefficients of wavefunctions...) in the ETSF_IO specifications must be declared last.

SOURCE

  !FIRST# the etsf_grp_main was declared here.
  flags%geometry = etsf_geometry_all
  flags%main     = etsf_main_none
  call etsf_io_data_init("mix_ETSF_and_non_ETSF.nc", flags, dims, &
                       & "Tutorial ETSF_IO, create a density file", &
                       & "Created by the tutorial example of the library", &
                       & lstat, error_data, overwrite = .true.)
  if (.not. lstat) then
    call etsf_io_low_error_handle(error_data)
    stop
  end if

NOTES

At this time of the example, the disk space to store the density and the geometric informations has been reserved. In a real case, we let the main program computing the density and setting up the geometric informations.

SOURCE

  ! The main program allocate memory for its computation.
  allocate(density(36 * 36 * 36))
  allocate(reduced_atom_positions(3,5))
  allocate(atom_species(5))
  allocate(chemical_symbols(2))
  allocate(reduced_symmetry_matrices(3, 3, 1))
  allocate(reduced_symmetry_translations(3, 1))
  
  ! The main program compute all symmetries and set up the positions...
  space_group = 1
  primitive_vector = reshape( (/ 10, 0, 0, 0, 10, 0, 0, 0, 10 /), (/ 3, 3 /))
  reduced_symmetry_matrices = reshape( (/ 1, 0, 0, 0, 1, 0, 0, 0, 1 /), (/ 3, 3, 1 /))
  reduced_symmetry_translations = reshape( (/ 0, 0, 0 /), (/ 3, 1 /))
  reduced_atom_positions = reshape( (/ 0.5d0, 0.5d0, 0.5d0, &
                                     & 0.6d0, 0.6d0, 0.6d0, &
                                     & 0.6d0, 0.4d0, 0.4d0, &
                                     & 0.4d0, 0.4d0, 0.6d0, &
                                     & 0.4d0, 0.6d0, 0.4d0 /), (/ 3, 5 /))
  atom_species = (/ 2, 1, 1, 1, 1 /)
  chemical_symbols = (/ "H ", "Si" /)

  ! We compute the density with a powerful algorithm.
  density = (/ (0.d0 + i, i = 1, 36 * 36 * 36) /)

NOTES

The associations between the structures used in the group level and variable in the main program memory are also kept. Only the gathering of all groups in the etsf_groups structure is not done.

SOURCE

  ! We associate the geometry
  geometry%space_group => space_group
  geometry%primitive_vectors => primitive_vector
  geometry%reduced_symmetry_matrices => reduced_symmetry_matrices
  geometry%reduced_symmetry_translations => reduced_symmetry_translations
  geometry%atom_species => atom_species
  geometry%reduced_atom_positions => reduced_atom_positions
  geometry%chemical_symbols => chemical_symbols
  ! We associate the main data
  ! We don't want to dupplicate the density data even if ours is 1D
  ! and ETSF is 5D, so we use the unformatted pointer in the etsf_main
  ! structure.
  main%density%data1D => density
  !FIRST# ! We associate our two group in the container.
  !FIRST# groups%geometry => geometry
  !FIRST# groups%main => main

NOTES

The write action is modified. We prefer to do it to avoid to open the file for the ETSF variables, close it, and reopen it for the non-ETSF variable. This is of course possible, but the idea of this tutorial is to show how to use a lower level of access for the ETSF variables.

Then, we open the created file with etsf_io_low_open_modify(). The file is then in a define mode, so we can easily define the non-ETSF variables.

SOURCE

  ! Open file for writing
  call etsf_io_low_open_modify(ncid,"mix_ETSF_and_non_ETSF.nc", &
       & lstat, error_data = error_data)
  if (.not. lstat) then
    call etsf_io_low_error_handle(error_data)
    stop
  end if

  ! We define some private non-ETSF variables (and dimensions if necessary).
  call etsf_io_low_def_var(ncid, "age_of_captain", etsf_io_low_integer, &
       & lstat, error_data = error_data)
  if (.not. lstat) then
    call etsf_io_low_error_handle(error_data)
    stop
  end if
  call etsf_io_low_write_dim(ncid, "number_of_captains_children", 2, &
       & lstat, error_data = error_data)
  if (.not. lstat) then
    call etsf_io_low_error_handle(error_data)
    stop
  end if
  call etsf_io_low_def_var(ncid, "age_of_captains_children", etsf_io_low_integer, &
       & (/ "number_of_captains_children" /), lstat, error_data = error_data)
  if (.not. lstat) then
    call etsf_io_low_error_handle(error_data)
    stop
  end if

NOTES

Now that the non-ETSF variables has been added, we can defined the main ETSF variables that will be at the end of the file, as required in the specifications.

SOURCE

  call etsf_io_main_def(ncid, lstat, error_data, flags = etsf_main_density)
  if (.not. lstat) then
    call etsf_io_low_error_handle(error_data)
    stop
  end if

NOTES

The all-in-one routine etsf_io_data_write() is replaced here by a group per group put action.

SOURCE

  ! We write the ETSF variable with the group methods.
  call etsf_io_geometry_put(ncid, geometry, lstat, error_data)
  !FIRST# call etsf_io_data_write("create_a_crystal_den_file.nc", &
  !FIRST#                       & etsf_grp_main + etsf_grp_geometry, &
  !FIRST#                       & groups, lstat, error_data)
  if (.not. lstat) then
    call etsf_io_low_error_handle(error_data)
    stop
  end if
  call etsf_io_main_put(ncid, main, lstat, error_data)
  if (.not. lstat) then
    call etsf_io_low_error_handle(error_data)
    stop
  end if

NOTES

After that, we change the file status for write access with etsf_io_low_set_write_mode() (this is automatically done by the put() routines in the group level. The non-ETSF variables are written.

SOURCE

  ! We switch to write mode.
  call etsf_io_low_set_write_mode(ncid, lstat, error_data = error_data)
  if (.not. lstat) then
    call etsf_io_low_error_handle(error_data)
    stop
  end if

  ! We write the non-ETSF variables by hand.
  call etsf_io_low_write_var(ncid, "age_of_captain", 42, &
       & lstat, error_data = error_data)
  if (.not. lstat) then
    call etsf_io_low_error_handle(error_data)
    stop
  end if
  call etsf_io_low_write_var(ncid, "age_of_captains_children", (/ 12, 13 /), &
       & lstat, error_data = error_data)
  if (.not. lstat) then
    call etsf_io_low_error_handle(error_data)
    stop
  end if

NOTES

We don't forget to close the file!

SOURCE

  call etsf_io_low_close(ncid, lstat, error_data = error_data)
  if (.not. lstat) then
    call etsf_io_low_error_handle(error_data)
    stop
  end if
  
  ! The main program will deallocate its own memory.
  deallocate(density)
  deallocate(reduced_atom_positions)
  deallocate(atom_species)
  deallocate(chemical_symbols)
  deallocate(reduced_symmetry_matrices)
  deallocate(reduced_symmetry_translations)
end program mix_ETSF_and_non_ETSF
etsf_io-1.0.3/doc/www/tutorials/MPI_output_of_a_density_f90.html0000644000353400050620000005035011354150414021642 00000000000000 ./src/tutorials/MPI_output_of_a_density.f90

TABLE OF CONTENTS

MPI_output_of_a_density

[ Top ] [ etsf_io_tutorials ] [ Tutorials ]

NAME

MPI_output_of_a_density

FUNCTION

In this example, we run an MPI computation a density (a centered gaussian), with a distribution of real space mesh through z planes among processes. The ETSF files will have a split definition on number_of_grid_points_vector3.

To do it, almost every steps are the same than for the first tutorial (create_a_crystal_den_file), except that we have now an array (my_grid_points) that has the definition of the points our part of the density is defined. Then, we associate this array into a split (see etsf_split) definition and we use this split definition when the ETSF file is initialised with etsf_io_data_init().

To compile this example an MPI wrapper must be installed and assuming default installation paths for ETSF_IO, simply use: 

   ${MPIF90} -I/opt/include/${F90} -o MPI_output_of_a_density MPI_output_of_a_density.f90
             -L/opt/lib -letsf_io -L/usr/lib -lnetcdf

SOURCE

program MPI_output_of_a_density
  
  use etsf_io_low_level
  use etsf_io

  implicit none

  include "mpif.h"

  integer :: i, j, k, i_proc, n_proc, ierr
  integer :: my_number_of_planes
  character(len = 256) :: my_filename
  real :: x2, y2, z2
  
  logical                 :: lstat
  type(etsf_io_low_error) :: error_data

NOTES

As explained in previous tutorials, the ETSF_IO library requires to defined some variable that are structures of pointers, or that store the dimensions of arrays.

We have here a new structure: etsf_split. This structure acts a bit like group structures (like etsf_electrons) since it is a gathering of pointers. These pointers can be associated to the arrays that defined a local process definition of a split variable as defined in the specifications.

SOURCE

  ! Specific variables required by the library
  type(etsf_dims)             :: dims
  type(etsf_groups_flags)     :: flags
  type(etsf_split)            :: split
  type(etsf_groups)           :: groups
  type(etsf_geometry), target :: geometry
  type(etsf_main), target     :: main

  ! Variables that are declared in the main program in a real case
  double precision, allocatable, target :: density(:, :, :)
  integer, allocatable, target          :: my_grid_points(:)
  double precision, target              :: primitive_vector(3, 3)
  
  call MPI_INIT(ierr)
  call MPI_COMM_RANK(MPI_COMM_WORLD, i_proc, ierr)
  call MPI_COMM_SIZE(MPI_COMM_WORLD, n_proc, ierr)

NOTES

Here, we put all unused variables to etsf_no_dimension (see ETSF_IO_CONSTANTS) then, all these dimensions will not be defined in the output file and all depending variables will not be created. This should be used with care since all variables that may depend on a dimension that has been set to etsf_no_dimension, will silently be ignored by etsf_io_def_<something>.

SOURCE

  dims%max_number_of_angular_momenta  = etsf_no_dimension
  dims%max_number_of_coefficients     = etsf_no_dimension
  dims%max_number_of_projectors       = etsf_no_dimension
  dims%max_number_of_states           = etsf_no_dimension
  dims%number_of_atoms                = etsf_no_dimension
  dims%number_of_atom_species         = etsf_no_dimension
  dims%number_of_kpoints              = etsf_no_dimension
  dims%number_of_spinor_components    = etsf_no_dimension
  dims%number_of_spins                = etsf_no_dimension
  dims%number_of_symmetry_operations  = etsf_no_dimension
  dims%real_or_complex_coefficients   = etsf_no_dimension
  dims%real_or_complex_gw_corrections = etsf_no_dimension
  dims%real_or_complex_potential      = etsf_no_dimension
  dims%real_or_complex_wavefunctions  = etsf_no_dimension

  dims%number_of_components          = 1
  dims%number_of_grid_points_vector1 = 36
  dims%number_of_grid_points_vector2 = 36
  dims%number_of_grid_points_vector3 = 120
  dims%real_or_complex_density       = 1

  ! We compute here the number of planes my process will focus on.
  if (i_proc == n_proc - 1) then
     my_number_of_planes = 120 - 120 / n_proc * (n_proc - 1)
  else
     my_number_of_planes = 120 / n_proc
  end if

NOTES

Since we only focus on some z planes and not all, we set the number of planes we used, as explained in the specifications. To do it, we use the special dimensions my_<something>, here my_number_of_grid_points_vect3.

SOURCE

  dims%my_number_of_grid_points_vect3 = my_number_of_planes

  ! We compute the list of plane ids that will be handled by my process.
  allocate(my_grid_points(my_number_of_planes))
  my_grid_points(:) = (/ (i + 1, &
       & i = i_proc * 120 / n_proc, min((i_proc + 1) * 120 / n_proc, 120)) /)

NOTES

The split variable is used by the library (as other groups) with only its associated pointers. Here, we split only on the z axis, so we associate my_grid_points_vector3.

SOURCE

  split%my_grid_points_vector3 => my_grid_points

NOTES

This is the point where the ETSF file is created. It uses the same routine that the one presented in the first tutorial (create_a_crystal_den_file). The only difference here is that we pass the optional argument split_definition with the list of z planes our process is handling.

SOURCE

  write(my_filename, "(A,I2.2,A)") "MPI_density_", i_proc, ".nc"
  flags%geometry = etsf_geometry_primitive_vectors
  flags%main     = etsf_main_density
  call etsf_io_data_init(trim(my_filename), flags, dims, &
       & "Tutorial ETSF_IO, create a density file with MPI", &
       & "Created by the tutorial example of the library", &
       & lstat, error_data, overwrite = .true., split_definition = split)
  if (.not. lstat) then
     call etsf_io_low_error_handle(error_data)
     stop
  end if

  ! Computation of the gaussian density
  primitive_vector = 0.d0
  primitive_vector(1, 1) = 18.d0
  primitive_vector(2, 2) = 18.d0
  primitive_vector(3, 3) = 60.d0
  geometry%primitive_vectors => primitive_vector
  groups%geometry => geometry

  allocate(density(36, 36, my_number_of_planes))
  main%density%data3D => density
  groups%main => main
  
  ! We put a gaussian in the density
  do k = 1, my_number_of_planes, 1
     z2 = (real(my_grid_points(k) - 60) / 60.) ** 2
     do j = 1, 36, 1
        y2 = (real(j - 18) / 18.) ** 2
        do i = 1, 36, 1
           x2 = (real(i - 18) / 18.) ** 2
           density(i, j, k) = exp(-(x2 + y2 + z2))
        end do
     end do
  end do

NOTES

The write part is not modified by the usage of split data.

SOURCE

  call etsf_io_data_write(trim(my_filename), groups, lstat, error_data)
  ! We handle the error
  if (.not. lstat) then
    call etsf_io_low_error_handle(error_data)
    stop
  end if


  ! Finalisation and deallocation.
  deallocate(my_grid_points)
  deallocate(density)

  call MPI_FINALIZE(ierr)

end program MPI_output_of_a_density
etsf_io-1.0.3/doc/www/tutorials/read_a_file_f90.html0000644000353400050620000005640311354150414017271 00000000000000 ./src/tutorials/read_a_file.f90

TABLE OF CONTENTS

read_a_file

[ Top ] [ etsf_io_tutorials ] [ Tutorials ]

NAME

read_a_file

FUNCTION

In this example, we will describe how to read some variables from a file. This is a basic tutorial where the common ETSF routines (low level and specification level) will be used. We will see how to handle errors.

This tutorial assume that the second tutorial (read_write_sub_access) has been done and has produced its file (read_write_sub_access.nc).

To compile this exemple, use (assuming default installation paths): 

   ${F90} -I/opt/include/${F90} -o read_a_file read_a_file.f90
          -L/opt/lib -letsf_io -letsf_io_utils -L/usr/lib -lnetcdf

SOURCE

program read_a_file

  use etsf_io_low_level
  use etsf_io
  use etsf_io_tools

  integer :: i, j, k
  logical :: symmetry

  ! Variables related to ETSF reading
  ! ---------------------------------
  ! An id to access the read file.
  integer                 :: ncid
  ! A flag for all etsf_io routine to know if everything went right.
  logical                 :: lstat
  ! The storage for the detailled error.
  type(etsf_io_low_error) :: error_data
  ! The ETSF_IO structure to store all relevant dimensions.
  type(etsf_dims)         :: dims
  ! The ETSF_IO structure to store all the split definitions.
  type(etsf_split)        :: split
  ! The ETSF_IO structure to store the basis set and the k points definitions.
  type(etsf_kpoints)      :: kpoints
  type(etsf_basisdata)    :: basisdata
  type(etsf_main)         :: main

  ! Variables independent from ETSF
  ! -------------------------------
  ! This array will store the wavefunctions.
  double precision, allocatable, target :: pw_coeff(:, :, :, :)
  ! Variables that will be used in the basisdata group.
  integer, allocatable, target          :: number_of_coefficients(:)
  integer, allocatable, target          :: red_coord_pw(:, :, :)
  ! Variables that will be used in the kpoints group.
  double precision, allocatable, target :: red_coord_kpt(:, :)
  double precision, allocatable, target :: kpoint_weights(:)
  ! Variable to store the definition of the basis set
  character(len = etsf_charlen), target :: basis

NOTES

The file is simply open using a low level routine. We simply want to read its content so we specify it in the routine we use.

By default, this routine will check that the header is a valid ETSF one, with the right Convention global attribute, as for the file_format global attribute.

We also check that the file is at least version 2.1 using the optional argument @version_min.

SOURCE

  call etsf_io_low_open_read(ncid, "read_write_sub_access.nc", lstat, &
       & error_data = error_data, version_min = 2.1)
  if (.not. lstat) then
     ! We use the default writing of the error to stderr.
     call etsf_io_low_error_handle(error_data)
     stop
  end if

NOTES

We consider that the file contains the wavefunction description in plane waves. We thus read the dimensions first to allocate the program arrays.

SOURCE

  call etsf_io_dims_get(ncid, dims, lstat, error_data)
  if (.not. lstat) then
     call etsf_io_low_error_handle(error_data)
     stop
  end if

NOTES

The coefficients of the wavefunctions may be splitted. We know this, thanks to the my_<something> attributes of the dims structure we have just read.

In the case of splitting, we allocate a new structure called split with etsf_io_split_allocate() and we read its contents with etsf_io_split_get(). In the case where the file contains no split informations, then all these routines will do nothing.

A split that has been allocated must be freed after use with etsf_io_split_free(). Since the split informations are not relevent for the purpose of this tutorial we will free it just after having output some informations to the user.

SOURCE

  call etsf_io_split_allocate(split, dims)
  call etsf_io_split_get(ncid, split, lstat, error_data)
  if (.not. lstat) then
     call etsf_io_low_error_handle(error_data)
     stop
  end if
  ! We warn the user.
  write(*,"(A,L1)") " Split over kpoints     : ", associated(split%my_kpoints)
  write(*,"(A,L1)") " Split over spins       : ", associated(split%my_spins)
  write(*,"(A,L1)") " Split over states      : ", associated(split%my_states)
  write(*,"(A,L1)") " Split over coefficients: ", associated(split%my_coefficients)
  ! We don't use the split informations further so we free them.
  call etsf_io_split_free(split)

NOTES

Before reading the coefficients of wavefunctions, we will get the definition of the basis set and the kpoints definitions.

This is done using the structure of types etsf_kpoints and etsf_basisdata and the etsf_io level etsf_io_kpoints_get() and etsf_io_basisdata_get(). As for the put routines, we associate the variables we want to read and only them.

Then we read the coefficients as all other variables, using the main group.

SOURCE

  ! The main program allocate memory for storage of the basis set.
  allocate(pw_coeff(dims%real_or_complex_coefficients, &
       & dims%max_number_of_coefficients, &
       & dims%max_number_of_states, &
       & dims%number_of_spins * &
       & dims%number_of_kpoints * &
       & dims%number_of_spinor_components))
  allocate(number_of_coefficients(dims%number_of_kpoints))
  allocate(red_coord_pw(dims%number_of_reduced_dimensions, &
       & dims%max_number_of_coefficients, dims%number_of_kpoints))
  allocate(red_coord_kpt(dims%number_of_reduced_dimensions, dims%number_of_kpoints))
  allocate(kpoint_weights(dims%number_of_kpoints))

  ! We set the associations.
  kpoints%reduced_coordinates_of_kpoints => red_coord_kpt
  kpoints%kpoint_weights => kpoint_weights
  basisdata%basis_set => basis
  basisdata%reduced_coordinates_of_plane_waves%data3D => red_coord_pw
  basisdata%number_of_coefficients => number_of_coefficients
  main%coefficients_of_wavefunctions%data4D => pw_coeff

  ! We call the get routines.
  call etsf_io_kpoints_get(ncid, kpoints, lstat, error_data)
  if (.not. lstat) then
     call etsf_io_low_error_handle(error_data)
     stop
  end if
  call etsf_io_basisdata_get(ncid, basisdata, lstat, error_data)
  if (.not. lstat) then
     call etsf_io_low_error_handle(error_data)
     stop
  end if
  call strip(basis)
  call etsf_io_main_get(ncid, main, lstat, error_data)
  if (.not. lstat) then
     call etsf_io_low_error_handle(error_data)
     stop
  end if

NOTES

We poll the file using an etsf_io_tools routine to know if the number of coefficients have been reduced using the time reversal symmetry at Gamma.

SOURCE

  call etsf_io_tools_get_time_reversal_symmetry(ncid, symmetry, &
       & lstat, error_data)
  if (.not. lstat) then
     call etsf_io_low_error_handle(error_data)
     stop
  end if

NOTES

The following is just output on screen.

SOURCE

  ! We output the informations to the user.
  write(*,*)
  write(*,"(A,I0)") " Number of k points     : ", dims%number_of_kpoints
  write(*,*) "k point weights        : ", kpoints%kpoint_weights
  write(*,"(A)") " k point coordinates    : "
  do i = 1, dims%number_of_kpoints, 1
     write(*, "(3F10.5)") red_coord_kpt(:, i)
  end do
  write(*,*)
  write(*,"(A,A)") " Used basis set         : ", trim(basis)
  write(*,"(A,L1)") " Time reversal symmetry : ", symmetry
  write(*,"(A,I0)") " Max number of coeffs   : ", dims%max_number_of_coefficients
  do i = 1, dims%number_of_kpoints, 1
     write(*,*)
     write(*,"(A,I0)") " Informations at k point: ", i
     write(*,"(A,I0)") " Number of coefficients : ", number_of_coefficients(i)
     write(*,"(A)") " Coordinates of g vector: "
     do j = 1, min(dims%max_number_of_coefficients, 5), 1
        write(*, "(3I5,A,I2,A)") red_coord_pw(:, j, i), " (g vector ", j, ")"
     end do
     if (j < dims%max_number_of_coefficients) then
        write(*,*) "   ..."
     end if
     write(*,"(A)") " Coeffs of wavefunctions: "
     do k = 1, dims%max_number_of_states, 1
        write(*,"(A,I0)") " Band number            : ", k
        do j = 1, min(dims%max_number_of_coefficients, 5), 1
           write(*, "(2F12.5,A,I2,A)") pw_coeff(:, j, k, i), " (g vector ", j, ")"
        end do
        if (j < dims%max_number_of_coefficients) then
           write(*,*) "   ..."
        end if
     end do
  end do

  ! We deallocate everything
  deallocate(pw_coeff)
  deallocate(number_of_coefficients)
  deallocate(red_coord_pw)
  deallocate(kpoint_weights)
  deallocate(red_coord_kpt)

end program read_a_file
etsf_io-1.0.3/doc/www/tutorials/README_f90.html0000644000353400050620000001307411354150414016011 00000000000000 ./src/tutorials/README.f90

TABLE OF CONTENTS

etsf_io_tutorials

[ Top ] [ Sub categories ]

NAME

etsf_io_tutorials -- ESTF I/O examples and tutorials

FUNCTION

Tutorials are directly Fortran source code, highly commented, located in src/tutorials. These codes can be compiled and executed to create example files.

The following tutorials are available:

  • Tutorial 1 - basics of file creation create_a_crystal_den_file, the first tutorial, is intended to explain the basics and the philosophy of this library. It details the first steps required to create a density file, using high level routines (etsf_io_data_<action>). It shows how to use the pointers and the unformatted ones (used to map any shape arrays between the ETSF definition and the main program memory).
  • Tutorial 2 - advanced writing, sub-access on k point and spin read_write_sub_access, the second tutorial, introduces the group level routines and explain how to access only sub part of arrays. This sub access is possible when one array has a dimension on spin or k points. Then one can access data for one k point or spin at a time. This is controlled by some attributes in the concerned groups, called <short_var_name>__[spin|kpoint]_access</code>. In this tutorial a wave-function file is created and the coefficients of wave-functions are written for one k point at a time.
  • Tutorial 3 - a converter tool, usage of validity checks convert_to_xyz, the third tutorial, shows how to use high level modules etsf_io_file and etsf_io_tools to check the conformance of an input ETSF file on cristalographic specifications and then to read atomic coordinates and names to create a simple XYZ file.
  • Tutorial 4 - how to use split capabilities in conjonction with MPI? MPI_output_of_a_density, the fourth tutorial, shows how to use the split definitions as defined in the specifications to handle MPI computations. This is possible with the help of the etsf_split structure. This tutorial create a density file with a paralelisation on z planes. Each process compute a gaussian in its own z planes and create an ETSF file with a split on number_of_grid_points_vector3. Thanks to etsf_io the created files can be then gathered into one unique file.
  • Tutorial 5 - mixing ETSF and non-ETSF variables in file creation (tutorial 1 enhancement) mix_ETSF_and_non_ETSF, the fifth tutorial, is not focus on the low level API but it uses it in several areas. This tutorial shows how to write an ETSF file with additional non-ETSF variables. These variables are defined and written directly by using the low level API. Besides it also shows how to use the etsf_io_<group>_put() methods in the context of a concurrent list of ETSF and non-ETSF variables.
  • Tutorial 6 - simple read of a wavefunction file (continuation of tutorial 2) read_a_file, the sixth tutorial, introduces the read actions in a simple case. Here, we know that the file should contains the variables of a wavefunction description. This tutorial uses the file created by tutorial 2 but does not read it with sub access. Everything is read once as a bloc.

etsf_io-1.0.3/doc/www/tutorials/read_write_sub_access_f90.html0000644000353400050620000007100111354150414021365 00000000000000 ./src/tutorials/read_write_sub_access.f90

TABLE OF CONTENTS

read_write_sub_access

[ Top ] [ etsf_io_tutorials ] [ Tutorials ]

NAME

read_write_sub_access

FUNCTION

In this example, we will describe how to read or write sub part of arrays. For example, to write the wavefunction each k point per k point, we need to use the wfs_pw__kpoint_access. This tutorial will show how to use all this kind of <varname>__something_access attributes existing in the different groups (see etsf_main for instance).

To compile this exemple, use (assuming default installation paths): 

   ${F90} -I/opt/include/${F90} -o read_write_sub_access read_write_sub_access.f90
          -L/opt/lib -letsf_io -letsf_io_utils -L/usr/lib -lnetcdf

SOURCE

program read_write_sub_access

  use etsf_io
  use etsf_io_tools

  integer :: i, i_kpt, ncid

NOTES

All groups than contain arrays that can have a sub access (on spin or on k points) have attributes built on the following scheme: 

   <short_variable_name>__[spin|kpoint]_access

When all spin or k points values must be read or write at once, one can let the default value (etsf_no_sub_access) ; but if one want to read or write only one spin or one k point, one should put the desired value in this attribute.

All this tutorial is oriented for writing, but it can be adapted easily for reading.

In the beginning of this tutorial, we define an ETSF file with 2 kpoints. This file will contain the kpoints group (etsf_kpoints), the group of wave data (etsf_basisdata) and the main group (etsf_main) with only the coefficient_of_wavefunctions array.

As shown in the first tutorial (create_a_crystal_den_file), the classical status variable lstat and error_data are created.

SOURCE

  logical                 :: lstat
  type(etsf_io_low_error) :: error_data

  ! Specific variables required by the library
  type(etsf_groups_flags) :: flags
  type(etsf_dims)         :: dims
  type(etsf_kpoints)      :: kpoints
  type(etsf_basisdata)    :: basisdata
  type(etsf_main)         :: main

NOTES

The following variables are used in the main program to store the informations. The pointers in the library will be used to point on them. Only some parts of each group will be used. 

   * coef_pw: is a two dimensional array that store all the coefficients of
   plane waves, but only for one k point.
   * red_coord_pw_k: is a two dimensional array that stores the coordinates of plane
   waves for each band, but restricted on one k point.

SOURCE

  ! Variables that are declared in the main program in a real case
  double precision, allocatable, target :: coef_pw_k(:, :)
  ! Variables that will be used in the basisdata group.
  integer, allocatable, target          :: number_of_coefficients(:)
  integer, allocatable, target          :: red_coord_pw_k(:, :)
  ! Variables that will be used in the kpoints group.
  double precision, allocatable, target :: red_coord_kpt(:, :)
  double precision, allocatable, target :: kpoint_weights(:)
  ! Variable to store the definition of the basis set
  character(len = etsf_charlen), target :: basis

NOTES

We set the dimension (2 k points, no spin, 5 bands and 100 planewave coefficients).

SOURCE

  dims%max_number_of_coefficients = 100
  dims%max_number_of_states = 5
  dims%number_of_kpoints = 2
  dims%number_of_spinor_components = 1
  dims%number_of_spins = 1
  dims%real_or_complex_coefficients = 2

NOTES

As in the first tutorial (create_a_crystal_den_file), we use the high level routine etsf_io_data_init to define all dimensions and variables for the file we want to create.

In that case, we will use a precise definition of variables, not creating all variables of each included groups. For instance, the basis set will be limited to the required variables for a plane wave description.

SOURCE

  flags%basisdata = etsf_basisdata_basis_set + &
       & etsf_basisdata_red_coord_pw + &
       & etsf_basisdata_n_coeff
  flags%kpoints   = etsf_kpoints_red_coord_kpt + etsf_kpoints_kpoint_weights
  flags%main      = etsf_main_wfs_coeff
  call etsf_io_data_init("read_write_sub_access.nc", flags, dims, &
                       & "Tutorial ETSF_IO, use sub access to read or write", &
                       & "Created by the tutorial example of the library", &
                       & lstat, error_data)
  if (.not. lstat) then
    call etsf_io_low_error_handle(error_data)
    stop
  end if

NOTES

At this time of the example, the disk space to store the wave-function informations has been reserved. In a real case, we let the main program computing the plane waves and the arrays that describe them.

SOURCE

  write(basis, "(A)") "plane_waves"

  ! The main program allocate memory for its computation.
  allocate(coef_pw_k(2, dims%max_number_of_coefficients * dims%max_number_of_states))
  allocate(number_of_coefficients(dims%number_of_kpoints))
  allocate(red_coord_pw_k(3, dims%max_number_of_coefficients))
  allocate(red_coord_kpt(3, dims%number_of_kpoints))
  allocate(kpoint_weights(dims%number_of_kpoints))
  
  ! The main program compute all coordinates for k points and plane waves...
  red_coord_kpt = reshape( (/ 0.0d0, 0.0d0, 0.0d0, &
                            & 0.5d0, 0.5d0, 0.5d0 /), (/ 3, 2 /))
  kpoint_weights = (/ 0.5d0, 0.5d0 /)
  number_of_coefficients = (/ dims%max_number_of_coefficients, &
       & dims%max_number_of_coefficients /)

NOTES

To read or write with sub access, there is no high level routine such as etsf_io_data_write(). Then, we need to open the file and set it a write state. The way to open a file for writing is to use the routine etsf_io_low_open_modify() and then to call etsf_io_low_set_write_mode(). The first call will check that the header is correct.

When the file is not needed anymore, the ncid id must be released and the file closed, using etsf_io_low_close(). This is mandatory because without this call the write action may be not done.

SOURCE

  ! Open file for writing
  call etsf_io_low_open_modify(ncid, "read_write_sub_access.nc", &
       & lstat, error_data = error_data)
  if (.not. lstat) then
    call etsf_io_low_error_handle(error_data)
    stop
  end if
  
  ! We switch to write mode.
  call etsf_io_low_set_write_mode(ncid, lstat, error_data = error_data)
  if (.not. lstat) then
    call etsf_io_low_error_handle(error_data)
    stop
  end if

NOTES

We begin the big loop on k points. In this loop, the main program will compute the plane waves and the coordinates of the coefficients. Then, it will use the library to write the values for the current k point.

SOURCE

  do i_kpt = 1, dims%number_of_kpoints, 1
     ! We compute the plane wave coefficient with the famous
     ! algorithm that works well.
     do i = 1, dims%max_number_of_coefficients, 1
        red_coord_pw_k(:, i) = (/ -i, 0, i /)
     end do
     coef_pw_k(1, :) = (/ (i, i = 1, &
          & dims%max_number_of_coefficients * dims%max_number_of_states) /)
     coef_pw_k(2, :) = (/ (-i, i = 1, &
          & dims%max_number_of_coefficients * dims%max_number_of_states) /)

NOTES

We associate the pointers of groups we want to write with the data in memory.

SOURCE

     ! We associate the data
     main%coefficients_of_wavefunctions%data2D => coef_pw_k
     ! We set the sub access.
     main%wfs_coeff__kpoint_access = i_kpt
     ! Idem for the reduced coordinates of coefficients.
     basisdata%reduced_coordinates_of_plane_waves%data2D => red_coord_pw_k
     basisdata%red_coord_pw__kpoint_access = i_kpt

NOTES

Now that all the arrays we want to write are associated, we can call the write routine. This routine will read automatically the <var>__kpoint_access attribute and will check the dimensions of the associated arrays.

SOURCE

     ! We use the group level write routine.
     call etsf_io_main_put(ncid, main, lstat, error_data)
     if (.not. lstat) then
        call etsf_io_low_error_handle(error_data)
        stop
     end if
     call etsf_io_basisdata_put(ncid, basisdata, lstat, error_data)
     if (.not. lstat) then
        call etsf_io_low_error_handle(error_data)
        stop
     end if

     ! End of the kpoint big loop.
  end do

NOTES

We write the other data that are independent of the kpoint loop.

WARNINGS

It is important to associate to nullify the already used pointers to avoid to write them again.

SOURCE

  ! We set the associations.
  kpoints%reduced_coordinates_of_kpoints => red_coord_kpt
  kpoints%kpoint_weights => kpoint_weights
  basisdata%basis_set => basis
  basisdata%reduced_coordinates_of_plane_waves%data2D => null()
  basisdata%number_of_coefficients => number_of_coefficients
  ! We call the group level write routines.
  call etsf_io_kpoints_put(ncid, kpoints, lstat, error_data)
  if (.not. lstat) then
     call etsf_io_low_error_handle(error_data)
     stop
  end if
  call etsf_io_basisdata_put(ncid, basisdata, lstat, error_data)
  if (.not. lstat) then
     call etsf_io_low_error_handle(error_data)
     stop
  end if

NOTES

We then set the use_time_reversal_at_gamma attribute for this file using the etsf_io_tools module. We write it after the other data since the routine will check that the basis set is indeed a plane wave one and the two variables impacted by this attributes must already exist.

SOURCE

  call etsf_io_tools_set_time_reversal_symmetry(ncid, .false., lstat, error_data)
  ! We handle the error
  if (.not. lstat) then
    call etsf_io_low_error_handle(error_data)
    stop
  end if

NOTES

As said before, we need to close the file.

SOURCE

  ! We close the file.
  call etsf_io_low_close(ncid, lstat, error_data)
  ! We handle the error
  if (.not. lstat) then
    call etsf_io_low_error_handle(error_data)
    stop
  end if
  
  ! The main program will deallocate its own memory.
  deallocate(coef_pw_k)
  deallocate(number_of_coefficients)
  deallocate(red_coord_pw_k)
  deallocate(red_coord_kpt)
  deallocate(kpoint_weights)
end program read_write_sub_access
etsf_io-1.0.3/doc/www/utils/0000777000353400050620000000000011354151532012703 500000000000000etsf_io-1.0.3/doc/www/utils/Makefile.am0000644000353400050620000000060311354150413014647 00000000000000utilsdoc_DATA = \ binary.html \ etsf_io_file_check_dielectric_function_data_f90.html \ etsf_io_file_check_wavefunctions_data_f90.html \ etsf_io_file_check_scalar_field_data_f90.html \ etsf_io_file_check_crystallographic_data_f90.html \ etsf_io_file_contents_f90.html \ etsf_io_file_f90.html \ etsf_io_file_public_f90.html \ etsf_io_tools_f90.html EXTRA_DIST = $(utilsdoc_DATA) etsf_io-1.0.3/doc/www/utils/Makefile.in0000644000353400050620000002276711354150420014675 00000000000000# Makefile.in generated by automake 1.10.1 from Makefile.am. # @configure_input@ # Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, # 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. # This Makefile.in is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY, to the extent permitted by law; without # even the implied warranty of MERCHANTABILITY or FITNESS FOR A # PARTICULAR PURPOSE. @SET_MAKE@ VPATH = @srcdir@ pkgdatadir = $(datadir)/@PACKAGE@ pkglibdir = $(libdir)/@PACKAGE@ pkgincludedir = $(includedir)/@PACKAGE@ am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd install_sh_DATA = $(install_sh) -c -m 644 install_sh_PROGRAM = $(install_sh) -c install_sh_SCRIPT = $(install_sh) -c INSTALL_HEADER = $(INSTALL_DATA) transform = $(program_transform_name) NORMAL_INSTALL = : PRE_INSTALL = : POST_INSTALL = : NORMAL_UNINSTALL = : PRE_UNINSTALL = : POST_UNINSTALL = : subdir = doc/www/utils DIST_COMMON = $(srcdir)/Makefile.am $(srcdir)/Makefile.in ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 am__aclocal_m4_deps = $(top_srcdir)/config/m4/fortran.m4 \ $(top_srcdir)/configure.ac am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ $(ACLOCAL_M4) mkinstalldirs = $(install_sh) -d CONFIG_CLEAN_FILES = SOURCES = DIST_SOURCES = am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; am__vpath_adj = case $$p in \ $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \ *) f=$$p;; \ esac; am__strip_dir = `echo $$p | sed -e 's|^.*/||'`; am__installdirs = "$(DESTDIR)$(utilsdocdir)" utilsdocDATA_INSTALL = $(INSTALL_DATA) DATA = $(utilsdoc_DATA) DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) ACLOCAL = @ACLOCAL@ AMTAR = @AMTAR@ AR = @AR@ AUTOCONF = @AUTOCONF@ AUTOHEADER = @AUTOHEADER@ AUTOMAKE = @AUTOMAKE@ AWK = @AWK@ CYGPATH_W = @CYGPATH_W@ DEFS = @DEFS@ ECHO_C = @ECHO_C@ ECHO_N = @ECHO_N@ ECHO_T = @ECHO_T@ EXEEXT = @EXEEXT@ FC = @FC@ FCFLAGS = @FCFLAGS@ FCFLAGS_f90 = @FCFLAGS_f90@ FFLAGS = @FFLAGS@ INSTALL = @INSTALL@ INSTALL_DATA = @INSTALL_DATA@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ INSTALL_SCRIPT = @INSTALL_SCRIPT@ INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ LDFLAGS = @LDFLAGS@ LIBOBJS = @LIBOBJS@ LIBS = @LIBS@ LTLIBOBJS = @LTLIBOBJS@ MAKEINFO = @MAKEINFO@ MKDIR_P = @MKDIR_P@ MODULE_EXT = @MODULE_EXT@ NETCDF_CFLAGS = @NETCDF_CFLAGS@ OBJEXT = @OBJEXT@ PACKAGE = @PACKAGE@ PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ PACKAGE_NAME = @PACKAGE_NAME@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_VERSION = @PACKAGE_VERSION@ PATH_SEPARATOR = @PATH_SEPARATOR@ RANLIB = @RANLIB@ SET_MAKE = @SET_MAKE@ SHELL = @SHELL@ STRIP = @STRIP@ VERSION = @VERSION@ abs_builddir = @abs_builddir@ abs_srcdir = @abs_srcdir@ abs_top_builddir = @abs_top_builddir@ abs_top_srcdir = @abs_top_srcdir@ ac_ct_FC = @ac_ct_FC@ am__leading_dot = @am__leading_dot@ am__tar = @am__tar@ am__untar = @am__untar@ bindir = @bindir@ build_alias = @build_alias@ builddir = @builddir@ datadir = @datadir@ datarootdir = @datarootdir@ docdir = @docdir@ dvidir = @dvidir@ exec_prefix = @exec_prefix@ fc_type = @fc_type@ fc_version = @fc_version@ fc_wrap = @fc_wrap@ groupleveldocdir = @groupleveldocdir@ host_alias = @host_alias@ htmldir = @htmldir@ includedir = @includedir@ infodir = @infodir@ install_sh = @install_sh@ libdir = @libdir@ libexecdir = @libexecdir@ localedir = @localedir@ localstatedir = @localstatedir@ lowleveldocdir = @lowleveldocdir@ mandir = @mandir@ mkdir_p = @mkdir_p@ moduledir = @moduledir@ oldincludedir = @oldincludedir@ pdfdir = @pdfdir@ prefix = @prefix@ program_transform_name = @program_transform_name@ psdir = @psdir@ sbindir = @sbindir@ sharedstatedir = @sharedstatedir@ srcdir = @srcdir@ sysconfdir = @sysconfdir@ target_alias = @target_alias@ top_builddir = @top_builddir@ top_srcdir = @top_srcdir@ tutorialsdocdir = @tutorialsdocdir@ utilsdocdir = @utilsdocdir@ utilsdoc_DATA = \ binary.html \ etsf_io_file_check_dielectric_function_data_f90.html \ etsf_io_file_check_wavefunctions_data_f90.html \ etsf_io_file_check_scalar_field_data_f90.html \ etsf_io_file_check_crystallographic_data_f90.html \ etsf_io_file_contents_f90.html \ etsf_io_file_f90.html \ etsf_io_file_public_f90.html \ etsf_io_tools_f90.html EXTRA_DIST = $(utilsdoc_DATA) all: all-am .SUFFIXES: $(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) @for dep in $?; do \ case '$(am__configure_deps)' in \ *$$dep*) \ cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh \ && exit 0; \ exit 1;; \ esac; \ done; \ echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu doc/www/utils/Makefile'; \ cd $(top_srcdir) && \ $(AUTOMAKE) --gnu doc/www/utils/Makefile .PRECIOUS: Makefile Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status @case '$?' in \ *config.status*) \ cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ *) \ echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ esac; $(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh $(top_srcdir)/configure: $(am__configure_deps) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh $(ACLOCAL_M4): $(am__aclocal_m4_deps) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh install-utilsdocDATA: $(utilsdoc_DATA) @$(NORMAL_INSTALL) test -z "$(utilsdocdir)" || $(MKDIR_P) "$(DESTDIR)$(utilsdocdir)" @list='$(utilsdoc_DATA)'; for p in $$list; do \ if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ f=$(am__strip_dir) \ echo " $(utilsdocDATA_INSTALL) '$$d$$p' '$(DESTDIR)$(utilsdocdir)/$$f'"; \ $(utilsdocDATA_INSTALL) "$$d$$p" "$(DESTDIR)$(utilsdocdir)/$$f"; \ done uninstall-utilsdocDATA: @$(NORMAL_UNINSTALL) @list='$(utilsdoc_DATA)'; for p in $$list; do \ f=$(am__strip_dir) \ echo " rm -f '$(DESTDIR)$(utilsdocdir)/$$f'"; \ rm -f "$(DESTDIR)$(utilsdocdir)/$$f"; \ done tags: TAGS TAGS: ctags: CTAGS CTAGS: distdir: $(DISTFILES) @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ list='$(DISTFILES)'; \ dist_files=`for file in $$list; do echo $$file; done | \ sed -e "s|^$$srcdirstrip/||;t" \ -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ case $$dist_files in \ */*) $(MKDIR_P) `echo "$$dist_files" | \ sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ sort -u` ;; \ esac; \ for file in $$dist_files; do \ if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ if test -d $$d/$$file; then \ dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ cp -pR $(srcdir)/$$file $(distdir)$$dir || exit 1; \ fi; \ cp -pR $$d/$$file $(distdir)$$dir || exit 1; \ else \ test -f $(distdir)/$$file \ || cp -p $$d/$$file $(distdir)/$$file \ || exit 1; \ fi; \ done check-am: all-am check: check-am all-am: Makefile $(DATA) installdirs: for dir in "$(DESTDIR)$(utilsdocdir)"; do \ test -z "$$dir" || $(MKDIR_P) "$$dir"; \ done install: install-am install-exec: install-exec-am install-data: install-data-am uninstall: uninstall-am install-am: all-am @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am installcheck: installcheck-am install-strip: $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ `test -z '$(STRIP)' || \ echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install mostlyclean-generic: clean-generic: distclean-generic: -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) maintainer-clean-generic: @echo "This command is intended for maintainers to use" @echo "it deletes files that may require special tools to rebuild." clean: clean-am clean-am: clean-generic mostlyclean-am distclean: distclean-am -rm -f Makefile distclean-am: clean-am distclean-generic dvi: dvi-am dvi-am: html: html-am info: info-am info-am: install-data-am: install-utilsdocDATA install-dvi: install-dvi-am install-exec-am: install-html: install-html-am install-info: install-info-am install-man: install-pdf: install-pdf-am install-ps: install-ps-am installcheck-am: maintainer-clean: maintainer-clean-am -rm -f Makefile maintainer-clean-am: distclean-am maintainer-clean-generic mostlyclean: mostlyclean-am mostlyclean-am: mostlyclean-generic pdf: pdf-am pdf-am: ps: ps-am ps-am: uninstall-am: uninstall-utilsdocDATA .MAKE: install-am install-strip .PHONY: all all-am check check-am clean clean-generic distclean \ distclean-generic distdir dvi dvi-am html html-am info info-am \ install install-am install-data install-data-am install-dvi \ install-dvi-am install-exec install-exec-am install-html \ install-html-am install-info install-info-am install-man \ install-pdf install-pdf-am install-ps install-ps-am \ install-strip install-utilsdocDATA installcheck \ installcheck-am installdirs maintainer-clean \ maintainer-clean-generic mostlyclean mostlyclean-generic pdf \ pdf-am ps ps-am uninstall uninstall-am uninstall-utilsdocDATA # Tell versions [3.59,3.63) of GNU make to not export all variables. # Otherwise a system limit (for SysV at least) may be exceeded. .NOEXPORT: etsf_io-1.0.3/doc/www/utils/binary.html0000644000353400050630000001137610621021163014772 00000000000000 ETSF_IO binary

As NetCDF is shipped with ncdump and ncgen to handle NetCDF files, ETSF_IO is shipped with its own binary program etsf_io. This utility is made to handle some high level actions on ETSF files.

etsf_io man page

etsf_io is called with the mandatory -a option (or --action) to define what action will be done by the program. Follows the little help returned by etsf_io --help:

Usage: etsf_io [-h | -a action] [[-i file]...] [[-f flag]...]
               [-o file] [arguments]

   Handle ETSF files, see --action option.
-h --help             : show this little help.
-a --action value     : give the action to perform.
                        Possible action may be:
                        * 'merge' to gather several files that
                          have been splitted.
                        * 'content' to get the name of
                          specifications the file matches.
                        * 'check' to check the validity of
                          the file against specifications.
-o --output-file file : give the path to the output ETSF file.
-i --input-file file  : give the path for an input file. This
                        option can be used one or several times.
-l --list             : when action is check, it give the list
                        of available flags.
-f --flag value       : give a flag name (get valid names from
                        -l option).

   Examples:
Merge three files, etsf_io -a merge -i file1.nc -i file2.nc
                   -i file3.nc -o output.nc

Get the contents of file test.nc, etsf_io -a contents test.nc

Get the list of flags for validity checks, etsf_io -a check -l

Checks with two flags, etsf_io -a check -f flag1 -f flag2 test.nc

Action merge

The merge action can read several ETSF files and create a new one, copying all variables that are not splitted and merging those that have a split definition. If there is not enough input file to create a full unsplitted array, the new file will contains some new split informations resulting from the merge. This routine also copy headers and attributes, as for all none-ETSF variables and dimensions.

An example of usage could be:

$ ./etsf_io -a merge -i output_proc1-etsf.nc -i output_proc2-etsf.nc -o output-etsf.nc

where output_proc1-etsf.nc and output_proc2-etsf.nc are two files generated by a distributed run on two processors.

Action content

The file is analised by etsf_io and produce a human readable list of matching specifications for the given file. When a specification is not matched, a reason is given.

An example of usage could be:

$ ./etsf_io -a content output-etsf.nc
Analyse file 'output-etsf.nc'
 - No - wavefunctions_data.
        given reason, 'primitive_vectors' -> Variable not found
 - No - scalar_field_data.
        given reason, 'primitive_vectors' -> Variable not found
 - No - crystallographic_data.
        given reason, 'primitive_vectors' -> Variable not found

Action check

Check if the given file match a given specification. It raise an error if there is an error and return 1 (or should since Fortran has no return value). It returns 0 if the file matches (or shouild because of Fortran). These problems make this action unusable at the present time.

etsf_io-1.0.3/doc/www/utils/etsf_io_file_check_dielectric_function_data_f90.html0000644000353400050620000024455511354150415025052 00000000000000 ./src/utils/etsf_io_file_check_dielectric_function_data.f90

TABLE OF CONTENTS

etsf_io_file_check_dielectric_function_data

[ Top ] [ etsf_io_file ] [ Methods ]

NAME

etsf_io_file_check_dielectric_function_data

FUNCTION

This is a high level routine to inquire a file about a specifications. It returns .true. in lstat if the file is a valid 'dielectric_function_data' file. It tests the existence of variables and their definition (type, shape. and dimension names).

INPUTS

OUTPUT

  • lstat = return .true. if the file matches requirement of 'dielectric_function_data'.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

SOURCE

subroutine etsf_io_file_check_dielectric_function_data(ncid, lstat, error_data)
  integer, intent(intent)                  :: ncid
  logical, intent(out)                 :: lstat
  type(etsf_io_low_error), intent(out) :: error_data

  character(len = *), parameter        :: me = "etsf_io_file_check_dielectric_function_data"
  type(etsf_io_low_var_infos)          :: var_infos
  logical                              :: valid
  character(len = etsf_charlen)        :: string_value
  type(etsf_dims)                      :: dims
  type(etsf_split)                     :: split

  ! Read the dimensions
  call etsf_io_dims_get(ncid, dims, lstat, error_data)
  if (.not. lstat) then
     call etsf_io_low_error_update(error_data, me)
     return
  end if

  ! Allocate the split and read it (this will verify variable exist.
  call etsf_io_split_allocate(split, dims)
  call etsf_io_split_get(ncid, split, lstat, error_data)
  if (.not. lstat) then
     call etsf_io_low_error_update(error_data, me)
     return
  end if

  ! Variable basis_set
  write(var_infos%name, "(A)") "basis_set"
  var_infos%nctype  = etsf_io_low_character
  var_infos%ncshape = 1
  allocate(var_infos%ncdimnames(1))
  write(var_infos%ncdimnames(1), "(A)") "character_string_length"
  call test_var(ncid, var_infos, lstat, error_data)
  deallocate(var_infos%ncdimnames)
  if (.not. lstat) then
    call etsf_io_split_free(split)
    call etsf_io_low_error_update(error_data, me)
    return
  end if
  
  ! Variable frequencies_dielectric_function
  write(var_infos%name, "(A)") "frequencies_dielectric_function"
  var_infos%nctype  = etsf_io_low_double
  var_infos%ncshape = 2
  allocate(var_infos%ncdimnames(2))
  write(var_infos%ncdimnames(2), "(A)") "number_of_frequencies_dielectric_function"
  write(var_infos%ncdimnames(1), "(A)") "complex"
  call test_var(ncid, var_infos, lstat, error_data)
  deallocate(var_infos%ncdimnames)
  if (.not. lstat) then
    call etsf_io_split_free(split)
    call etsf_io_low_error_update(error_data, me)
    return
  end if
  
  ! Variable qpoints_dielectric_function
  write(var_infos%name, "(A)") "qpoints_dielectric_function"
  var_infos%nctype  = etsf_io_low_double
  var_infos%ncshape = 2
  allocate(var_infos%ncdimnames(2))
  write(var_infos%ncdimnames(2), "(A)") "number_of_qpoints_dielectric_function"
  write(var_infos%ncdimnames(1), "(A)") "number_of_reduced_dimensions"
  call test_var(ncid, var_infos, lstat, error_data)
  deallocate(var_infos%ncdimnames)
  if (.not. lstat) then
    call etsf_io_split_free(split)
    call etsf_io_low_error_update(error_data, me)
    return
  end if
  
  ! Variable qpoints_gamma_limit
  write(var_infos%name, "(A)") "qpoints_gamma_limit"
  var_infos%nctype  = etsf_io_low_double
  var_infos%ncshape = 2
  allocate(var_infos%ncdimnames(2))
  write(var_infos%ncdimnames(2), "(A)") "number_of_qpoints_gamma_limit"
  write(var_infos%ncdimnames(1), "(A)") "number_of_reduced_dimensions"
  call test_var(ncid, var_infos, lstat, error_data)
  deallocate(var_infos%ncdimnames)
  if (.not. lstat) then
    call etsf_io_split_free(split)
    call etsf_io_low_error_update(error_data, me)
    return
  end if
  
  ! Variable reduced_coordinates_of_plane_waves_dielectric_function
  write(var_infos%name, "(A)") "reduced_coordinates_of_plane_waves_dielectric_function"
  var_infos%nctype  = etsf_io_low_integer
  var_infos%ncshape = 3
  allocate(var_infos%ncdimnames(3))
  write(var_infos%ncdimnames(3), "(A)") "number_of_qpoints_dielectric_function"
  write(var_infos%ncdimnames(2), "(A)") "number_of_coefficients_dielectric_function"
  write(var_infos%ncdimnames(1), "(A)") "number_of_reduced_dimensions"
  call test_var(ncid, var_infos, lstat, error_data)
  deallocate(var_infos%ncdimnames)
  if (.not. lstat) then
    call etsf_io_split_free(split)
    call etsf_io_low_error_update(error_data, me)
    return
  end if
  
  ! Check from a list.
  lstat = .false.
  ! Variable dielectric_function
  write(var_infos%name, "(A)") "dielectric_function"
  var_infos%nctype  = etsf_io_low_double
  var_infos%ncshape = 7
  allocate(var_infos%ncdimnames(7))
  write(var_infos%ncdimnames(7), "(A)") "number_of_frequencies_dielectric_function"
  write(var_infos%ncdimnames(6), "(A)") "number_of_qpoints_dielectric_function"
  if (associated(split%my_spins)) then
    write(var_infos%ncdimnames(5), "(A)") "my_number_of_spins"
  else
    write(var_infos%ncdimnames(5), "(A)") "number_of_spins"
  end if
  if (associated(split%my_spins)) then
    write(var_infos%ncdimnames(4), "(A)") "my_number_of_spins"
  else
    write(var_infos%ncdimnames(4), "(A)") "number_of_spins"
  end if
  write(var_infos%ncdimnames(3), "(A)") "number_of_coefficients_dielectric_function"
  write(var_infos%ncdimnames(2), "(A)") "number_of_coefficients_dielectric_function"
  write(var_infos%ncdimnames(1), "(A)") "complex"
  call test_var(ncid, var_infos, valid, error_data)
  deallocate(var_infos%ncdimnames)
  if (.not. valid .and. error_data%access_mode_id == ERROR_MODE_SPEC) return
  lstat = lstat .or. valid
  ! Variable inverse_dielectric_function
  write(var_infos%name, "(A)") "inverse_dielectric_function"
  var_infos%nctype  = etsf_io_low_double
  var_infos%ncshape = 7
  allocate(var_infos%ncdimnames(7))
  write(var_infos%ncdimnames(7), "(A)") "number_of_frequencies_dielectric_function"
  write(var_infos%ncdimnames(6), "(A)") "number_of_qpoints_dielectric_function"
  if (associated(split%my_spins)) then
    write(var_infos%ncdimnames(5), "(A)") "my_number_of_spins"
  else
    write(var_infos%ncdimnames(5), "(A)") "number_of_spins"
  end if
  if (associated(split%my_spins)) then
    write(var_infos%ncdimnames(4), "(A)") "my_number_of_spins"
  else
    write(var_infos%ncdimnames(4), "(A)") "number_of_spins"
  end if
  write(var_infos%ncdimnames(3), "(A)") "number_of_coefficients_dielectric_function"
  write(var_infos%ncdimnames(2), "(A)") "number_of_coefficients_dielectric_function"
  write(var_infos%ncdimnames(1), "(A)") "complex"
  call test_var(ncid, var_infos, valid, error_data)
  deallocate(var_infos%ncdimnames)
  if (.not. valid .and. error_data%access_mode_id == ERROR_MODE_SPEC) return
  lstat = lstat .or. valid
  ! Variable polarizability
  write(var_infos%name, "(A)") "polarizability"
  var_infos%nctype  = etsf_io_low_double
  var_infos%ncshape = 7
  allocate(var_infos%ncdimnames(7))
  write(var_infos%ncdimnames(7), "(A)") "number_of_frequencies_dielectric_function"
  write(var_infos%ncdimnames(6), "(A)") "number_of_qpoints_dielectric_function"
  if (associated(split%my_spins)) then
    write(var_infos%ncdimnames(5), "(A)") "my_number_of_spins"
  else
    write(var_infos%ncdimnames(5), "(A)") "number_of_spins"
  end if
  if (associated(split%my_spins)) then
    write(var_infos%ncdimnames(4), "(A)") "my_number_of_spins"
  else
    write(var_infos%ncdimnames(4), "(A)") "number_of_spins"
  end if
  write(var_infos%ncdimnames(3), "(A)") "number_of_coefficients_dielectric_function"
  write(var_infos%ncdimnames(2), "(A)") "number_of_coefficients_dielectric_function"
  write(var_infos%ncdimnames(1), "(A)") "complex"
  call test_var(ncid, var_infos, valid, error_data)
  deallocate(var_infos%ncdimnames)
  if (.not. valid .and. error_data%access_mode_id == ERROR_MODE_SPEC) return
  lstat = lstat .or. valid
  ! Variable inverse_polarizability
  write(var_infos%name, "(A)") "inverse_polarizability"
  var_infos%nctype  = etsf_io_low_double
  var_infos%ncshape = 7
  allocate(var_infos%ncdimnames(7))
  write(var_infos%ncdimnames(7), "(A)") "number_of_frequencies_dielectric_function"
  write(var_infos%ncdimnames(6), "(A)") "number_of_qpoints_dielectric_function"
  if (associated(split%my_spins)) then
    write(var_infos%ncdimnames(5), "(A)") "my_number_of_spins"
  else
    write(var_infos%ncdimnames(5), "(A)") "number_of_spins"
  end if
  if (associated(split%my_spins)) then
    write(var_infos%ncdimnames(4), "(A)") "my_number_of_spins"
  else
    write(var_infos%ncdimnames(4), "(A)") "number_of_spins"
  end if
  write(var_infos%ncdimnames(3), "(A)") "number_of_coefficients_dielectric_function"
  write(var_infos%ncdimnames(2), "(A)") "number_of_coefficients_dielectric_function"
  write(var_infos%ncdimnames(1), "(A)") "complex"
  call test_var(ncid, var_infos, valid, error_data)
  deallocate(var_infos%ncdimnames)
  if (.not. valid .and. error_data%access_mode_id == ERROR_MODE_SPEC) return
  lstat = lstat .or. valid
  if (.not. lstat) then
    call etsf_io_split_free(split)
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
                             & ERROR_TYPE_ARG, me, &
   & tgtname = "dielectric_function, inverse_dielectric_function, polarizability, inverse_...", &
                             & errmess = "missing one among the list.")
    return
  end if
  
  ! Check a list of conditions if a variable is set.
  ! Test the existence of a variable.
  lstat = .false.
  call etsf_io_low_read_var_infos(ncid, "dielectric_function", var_infos, &
                                & lstat, error_data = error_data)
  if (lstat) then
    ! Apply the conditions since variable exists.
    ! Variable dielectric_function_head
    write(var_infos%name, "(A)") "dielectric_function_head"
    var_infos%nctype  = etsf_io_low_double
    var_infos%ncshape = 5
    allocate(var_infos%ncdimnames(5))
    write(var_infos%ncdimnames(5), "(A)") "number_of_frequencies_dielectric_function"
    write(var_infos%ncdimnames(4), "(A)") "number_of_qpoints_dielectric_function"
    if (associated(split%my_spins)) then
      write(var_infos%ncdimnames(3), "(A)") "my_number_of_spins"
    else
      write(var_infos%ncdimnames(3), "(A)") "number_of_spins"
    end if
    if (associated(split%my_spins)) then
      write(var_infos%ncdimnames(2), "(A)") "my_number_of_spins"
    else
      write(var_infos%ncdimnames(2), "(A)") "number_of_spins"
    end if
    write(var_infos%ncdimnames(1), "(A)") "complex"
    call test_var(ncid, var_infos, lstat, error_data)
    deallocate(var_infos%ncdimnames)
    if (.not. lstat) then
      call etsf_io_split_free(split)
      call etsf_io_low_error_update(error_data, me)
      return
    end if
    
    ! Variable dielectric_function_upper_wing
    write(var_infos%name, "(A)") "dielectric_function_upper_wing"
    var_infos%nctype  = etsf_io_low_double
    var_infos%ncshape = 6
    allocate(var_infos%ncdimnames(6))
    write(var_infos%ncdimnames(6), "(A)") "number_of_frequencies_dielectric_function"
    write(var_infos%ncdimnames(5), "(A)") "number_of_qpoints_gamma_limit"
    if (associated(split%my_spins)) then
      write(var_infos%ncdimnames(4), "(A)") "my_number_of_spins"
    else
      write(var_infos%ncdimnames(4), "(A)") "number_of_spins"
    end if
    if (associated(split%my_spins)) then
      write(var_infos%ncdimnames(3), "(A)") "my_number_of_spins"
    else
      write(var_infos%ncdimnames(3), "(A)") "number_of_spins"
    end if
    write(var_infos%ncdimnames(2), "(A)") "number_of_coefficients_dielectric_function"
    write(var_infos%ncdimnames(1), "(A)") "complex"
    call test_var(ncid, var_infos, lstat, error_data)
    deallocate(var_infos%ncdimnames)
    if (.not. lstat) then
      call etsf_io_split_free(split)
      call etsf_io_low_error_update(error_data, me)
      return
    end if
    
  end if
  ! Check a list of conditions if a variable is set.
  ! Test the existence of a variable.
  lstat = .false.
  call etsf_io_low_read_var_infos(ncid, "inverse_dielectric_function", var_infos, &
                                & lstat, error_data = error_data)
  if (lstat) then
    ! Apply the conditions since variable exists.
    ! Variable inverse_dielectric_function_head
    write(var_infos%name, "(A)") "inverse_dielectric_function_head"
    var_infos%nctype  = etsf_io_low_double
    var_infos%ncshape = 5
    allocate(var_infos%ncdimnames(5))
    write(var_infos%ncdimnames(5), "(A)") "number_of_frequencies_dielectric_function"
    write(var_infos%ncdimnames(4), "(A)") "number_of_qpoints_dielectric_function"
    if (associated(split%my_spins)) then
      write(var_infos%ncdimnames(3), "(A)") "my_number_of_spins"
    else
      write(var_infos%ncdimnames(3), "(A)") "number_of_spins"
    end if
    if (associated(split%my_spins)) then
      write(var_infos%ncdimnames(2), "(A)") "my_number_of_spins"
    else
      write(var_infos%ncdimnames(2), "(A)") "number_of_spins"
    end if
    write(var_infos%ncdimnames(1), "(A)") "complex"
    call test_var(ncid, var_infos, lstat, error_data)
    deallocate(var_infos%ncdimnames)
    if (.not. lstat) then
      call etsf_io_split_free(split)
      call etsf_io_low_error_update(error_data, me)
      return
    end if
    
    ! Variable inverse_dielectric_function_upper_wing
    write(var_infos%name, "(A)") "inverse_dielectric_function_upper_wing"
    var_infos%nctype  = etsf_io_low_double
    var_infos%ncshape = 6
    allocate(var_infos%ncdimnames(6))
    write(var_infos%ncdimnames(6), "(A)") "number_of_frequencies_dielectric_function"
    write(var_infos%ncdimnames(5), "(A)") "number_of_qpoints_gamma_limit"
    if (associated(split%my_spins)) then
      write(var_infos%ncdimnames(4), "(A)") "my_number_of_spins"
    else
      write(var_infos%ncdimnames(4), "(A)") "number_of_spins"
    end if
    if (associated(split%my_spins)) then
      write(var_infos%ncdimnames(3), "(A)") "my_number_of_spins"
    else
      write(var_infos%ncdimnames(3), "(A)") "number_of_spins"
    end if
    write(var_infos%ncdimnames(2), "(A)") "number_of_coefficients_dielectric_function"
    write(var_infos%ncdimnames(1), "(A)") "complex"
    call test_var(ncid, var_infos, lstat, error_data)
    deallocate(var_infos%ncdimnames)
    if (.not. lstat) then
      call etsf_io_split_free(split)
      call etsf_io_low_error_update(error_data, me)
      return
    end if
    
  end if
  ! Check a list of conditions if a variable is set.
  ! Test the existence of a variable.
  lstat = .false.
  call etsf_io_low_read_var_infos(ncid, "polarizability", var_infos, &
                                & lstat, error_data = error_data)
  if (lstat) then
    ! Apply the conditions since variable exists.
    ! Variable polarizability_head
    write(var_infos%name, "(A)") "polarizability_head"
    var_infos%nctype  = etsf_io_low_double
    var_infos%ncshape = 5
    allocate(var_infos%ncdimnames(5))
    write(var_infos%ncdimnames(5), "(A)") "number_of_frequencies_dielectric_function"
    write(var_infos%ncdimnames(4), "(A)") "number_of_qpoints_dielectric_function"
    if (associated(split%my_spins)) then
      write(var_infos%ncdimnames(3), "(A)") "my_number_of_spins"
    else
      write(var_infos%ncdimnames(3), "(A)") "number_of_spins"
    end if
    if (associated(split%my_spins)) then
      write(var_infos%ncdimnames(2), "(A)") "my_number_of_spins"
    else
      write(var_infos%ncdimnames(2), "(A)") "number_of_spins"
    end if
    write(var_infos%ncdimnames(1), "(A)") "complex"
    call test_var(ncid, var_infos, lstat, error_data)
    deallocate(var_infos%ncdimnames)
    if (.not. lstat) then
      call etsf_io_split_free(split)
      call etsf_io_low_error_update(error_data, me)
      return
    end if
    
    ! Variable polarizability_upper_wing
    write(var_infos%name, "(A)") "polarizability_upper_wing"
    var_infos%nctype  = etsf_io_low_double
    var_infos%ncshape = 6
    allocate(var_infos%ncdimnames(6))
    write(var_infos%ncdimnames(6), "(A)") "number_of_frequencies_dielectric_function"
    write(var_infos%ncdimnames(5), "(A)") "number_of_qpoints_gamma_limit"
    if (associated(split%my_spins)) then
      write(var_infos%ncdimnames(4), "(A)") "my_number_of_spins"
    else
      write(var_infos%ncdimnames(4), "(A)") "number_of_spins"
    end if
    if (associated(split%my_spins)) then
      write(var_infos%ncdimnames(3), "(A)") "my_number_of_spins"
    else
      write(var_infos%ncdimnames(3), "(A)") "number_of_spins"
    end if
    write(var_infos%ncdimnames(2), "(A)") "number_of_coefficients_dielectric_function"
    write(var_infos%ncdimnames(1), "(A)") "complex"
    call test_var(ncid, var_infos, lstat, error_data)
    deallocate(var_infos%ncdimnames)
    if (.not. lstat) then
      call etsf_io_split_free(split)
      call etsf_io_low_error_update(error_data, me)
      return
    end if
    
  end if
  ! Check a list of conditions if a variable is set.
  ! Test the existence of a variable.
  lstat = .false.
  call etsf_io_low_read_var_infos(ncid, "inverse_polarizability", var_infos, &
                                & lstat, error_data = error_data)
  if (lstat) then
    ! Apply the conditions since variable exists.
    ! Variable inverse_polarizability_head
    write(var_infos%name, "(A)") "inverse_polarizability_head"
    var_infos%nctype  = etsf_io_low_double
    var_infos%ncshape = 5
    allocate(var_infos%ncdimnames(5))
    write(var_infos%ncdimnames(5), "(A)") "number_of_frequencies_dielectric_function"
    write(var_infos%ncdimnames(4), "(A)") "number_of_qpoints_dielectric_function"
    if (associated(split%my_spins)) then
      write(var_infos%ncdimnames(3), "(A)") "my_number_of_spins"
    else
      write(var_infos%ncdimnames(3), "(A)") "number_of_spins"
    end if
    if (associated(split%my_spins)) then
      write(var_infos%ncdimnames(2), "(A)") "my_number_of_spins"
    else
      write(var_infos%ncdimnames(2), "(A)") "number_of_spins"
    end if
    write(var_infos%ncdimnames(1), "(A)") "complex"
    call test_var(ncid, var_infos, lstat, error_data)
    deallocate(var_infos%ncdimnames)
    if (.not. lstat) then
      call etsf_io_split_free(split)
      call etsf_io_low_error_update(error_data, me)
      return
    end if
    
    ! Variable inverse_polarizability_upper_wing
    write(var_infos%name, "(A)") "inverse_polarizability_upper_wing"
    var_infos%nctype  = etsf_io_low_double
    var_infos%ncshape = 6
    allocate(var_infos%ncdimnames(6))
    write(var_infos%ncdimnames(6), "(A)") "number_of_frequencies_dielectric_function"
    write(var_infos%ncdimnames(5), "(A)") "number_of_qpoints_gamma_limit"
    if (associated(split%my_spins)) then
      write(var_infos%ncdimnames(4), "(A)") "my_number_of_spins"
    else
      write(var_infos%ncdimnames(4), "(A)") "number_of_spins"
    end if
    if (associated(split%my_spins)) then
      write(var_infos%ncdimnames(3), "(A)") "my_number_of_spins"
    else
      write(var_infos%ncdimnames(3), "(A)") "number_of_spins"
    end if
    write(var_infos%ncdimnames(2), "(A)") "number_of_coefficients_dielectric_function"
    write(var_infos%ncdimnames(1), "(A)") "complex"
    call test_var(ncid, var_infos, lstat, error_data)
    deallocate(var_infos%ncdimnames)
    if (.not. lstat) then
      call etsf_io_split_free(split)
      call etsf_io_low_error_update(error_data, me)
      return
    end if
    
  end if


  ! Deallocate the split data.
  call etsf_io_split_free(split)

  lstat = .true.
end subroutine etsf_io_file_check_dielectric_function_data
etsf_io-1.0.3/doc/www/utils/etsf_io_file_check_wavefunctions_data_f90.html0000644000353400050620000021250311354150415023715 00000000000000 ./src/utils/etsf_io_file_check_wavefunctions_data.f90

TABLE OF CONTENTS

etsf_io_file_check_wavefunctions_data

[ Top ] [ etsf_io_file ] [ Methods ]

NAME

etsf_io_file_check_wavefunctions_data

FUNCTION

This is a high level routine to inquire a file about a specifications. It returns .true. in lstat if the file is a valid 'wavefunctions_data' file. It tests the existence of variables and their definition (type, shape. and dimension names).

INPUTS

OUTPUT

  • lstat = return .true. if the file matches requirement of 'wavefunctions_data'.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

SOURCE

subroutine etsf_io_file_check_wavefunctions_data(ncid, lstat, error_data)
  integer, intent(intent)                  :: ncid
  logical, intent(out)                 :: lstat
  type(etsf_io_low_error), intent(out) :: error_data

  character(len = *), parameter        :: me = "etsf_io_file_check_wavefunctions_data"
  type(etsf_io_low_var_infos)          :: var_infos
  logical                              :: valid
  character(len = etsf_charlen)        :: string_value
  type(etsf_dims)                      :: dims
  type(etsf_split)                     :: split

  ! Read the dimensions
  call etsf_io_dims_get(ncid, dims, lstat, error_data)
  if (.not. lstat) then
     call etsf_io_low_error_update(error_data, me)
     return
  end if

  ! Allocate the split and read it (this will verify variable exist.
  call etsf_io_split_allocate(split, dims)
  call etsf_io_split_get(ncid, split, lstat, error_data)
  if (.not. lstat) then
     call etsf_io_low_error_update(error_data, me)
     return
  end if

  ! Variable primitive_vectors
  write(var_infos%name, "(A)") "primitive_vectors"
  var_infos%nctype  = etsf_io_low_double
  var_infos%ncshape = 2
  allocate(var_infos%ncdimnames(2))
  write(var_infos%ncdimnames(2), "(A)") "number_of_vectors"
  write(var_infos%ncdimnames(1), "(A)") "number_of_cartesian_directions"
  call test_var(ncid, var_infos, lstat, error_data)
  deallocate(var_infos%ncdimnames)
  if (.not. lstat) then
    call etsf_io_split_free(split)
    call etsf_io_low_error_update(error_data, me)
    return
  end if
  
  ! Variable reduced_symmetry_matrices
  write(var_infos%name, "(A)") "reduced_symmetry_matrices"
  var_infos%nctype  = etsf_io_low_integer
  var_infos%ncshape = 3
  allocate(var_infos%ncdimnames(3))
  write(var_infos%ncdimnames(3), "(A)") "number_of_symmetry_operations"
  write(var_infos%ncdimnames(2), "(A)") "number_of_reduced_dimensions"
  write(var_infos%ncdimnames(1), "(A)") "number_of_reduced_dimensions"
  call test_var(ncid, var_infos, lstat, error_data)
  deallocate(var_infos%ncdimnames)
  if (.not. lstat) then
    call etsf_io_split_free(split)
    call etsf_io_low_error_update(error_data, me)
    return
  end if
  
  ! Variable reduced_symmetry_translations
  write(var_infos%name, "(A)") "reduced_symmetry_translations"
  var_infos%nctype  = etsf_io_low_double
  var_infos%ncshape = 2
  allocate(var_infos%ncdimnames(2))
  write(var_infos%ncdimnames(2), "(A)") "number_of_symmetry_operations"
  write(var_infos%ncdimnames(1), "(A)") "number_of_reduced_dimensions"
  call test_var(ncid, var_infos, lstat, error_data)
  deallocate(var_infos%ncdimnames)
  if (.not. lstat) then
    call etsf_io_split_free(split)
    call etsf_io_low_error_update(error_data, me)
    return
  end if
  
  ! Variable reduced_coordinates_of_kpoints
  write(var_infos%name, "(A)") "reduced_coordinates_of_kpoints"
  var_infos%nctype  = etsf_io_low_double
  var_infos%ncshape = 2
  allocate(var_infos%ncdimnames(2))
  if (associated(split%my_kpoints)) then
    write(var_infos%ncdimnames(2), "(A)") "my_number_of_kpoints"
  else
    write(var_infos%ncdimnames(2), "(A)") "number_of_kpoints"
  end if
  write(var_infos%ncdimnames(1), "(A)") "number_of_reduced_dimensions"
  call test_var(ncid, var_infos, lstat, error_data)
  deallocate(var_infos%ncdimnames)
  if (.not. lstat) then
    call etsf_io_split_free(split)
    call etsf_io_low_error_update(error_data, me)
    return
  end if
  
  ! Variable kpoint_weights
  write(var_infos%name, "(A)") "kpoint_weights"
  var_infos%nctype  = etsf_io_low_double
  var_infos%ncshape = 1
  allocate(var_infos%ncdimnames(1))
  if (associated(split%my_kpoints)) then
    write(var_infos%ncdimnames(1), "(A)") "my_number_of_kpoints"
  else
    write(var_infos%ncdimnames(1), "(A)") "number_of_kpoints"
  end if
  call test_var(ncid, var_infos, lstat, error_data)
  deallocate(var_infos%ncdimnames)
  if (.not. lstat) then
    call etsf_io_split_free(split)
    call etsf_io_low_error_update(error_data, me)
    return
  end if
  
  ! Variable number_of_states
  write(var_infos%name, "(A)") "number_of_states"
  var_infos%nctype  = etsf_io_low_integer
  var_infos%ncshape = 2
  allocate(var_infos%ncdimnames(2))
  if (associated(split%my_spins)) then
    write(var_infos%ncdimnames(2), "(A)") "my_number_of_spins"
  else
    write(var_infos%ncdimnames(2), "(A)") "number_of_spins"
  end if
  if (associated(split%my_kpoints)) then
    write(var_infos%ncdimnames(1), "(A)") "my_number_of_kpoints"
  else
    write(var_infos%ncdimnames(1), "(A)") "number_of_kpoints"
  end if
  call test_var(ncid, var_infos, lstat, error_data)
  deallocate(var_infos%ncdimnames)
  if (.not. lstat) then
    call etsf_io_split_free(split)
    call etsf_io_low_error_update(error_data, me)
    return
  end if
  
  ! Variable eigenvalues
  write(var_infos%name, "(A)") "eigenvalues"
  var_infos%nctype  = etsf_io_low_double
  var_infos%ncshape = 3
  allocate(var_infos%ncdimnames(3))
  if (associated(split%my_spins)) then
    write(var_infos%ncdimnames(3), "(A)") "my_number_of_spins"
  else
    write(var_infos%ncdimnames(3), "(A)") "number_of_spins"
  end if
  if (associated(split%my_kpoints)) then
    write(var_infos%ncdimnames(2), "(A)") "my_number_of_kpoints"
  else
    write(var_infos%ncdimnames(2), "(A)") "number_of_kpoints"
  end if
  if (associated(split%my_states)) then
    write(var_infos%ncdimnames(1), "(A)") "my_max_number_of_states"
  else
    write(var_infos%ncdimnames(1), "(A)") "max_number_of_states"
  end if
  call test_var(ncid, var_infos, lstat, error_data)
  deallocate(var_infos%ncdimnames)
  if (.not. lstat) then
    call etsf_io_split_free(split)
    call etsf_io_low_error_update(error_data, me)
    return
  end if
  
  ! Variable occupations
  write(var_infos%name, "(A)") "occupations"
  var_infos%nctype  = etsf_io_low_double
  var_infos%ncshape = 3
  allocate(var_infos%ncdimnames(3))
  if (associated(split%my_spins)) then
    write(var_infos%ncdimnames(3), "(A)") "my_number_of_spins"
  else
    write(var_infos%ncdimnames(3), "(A)") "number_of_spins"
  end if
  if (associated(split%my_kpoints)) then
    write(var_infos%ncdimnames(2), "(A)") "my_number_of_kpoints"
  else
    write(var_infos%ncdimnames(2), "(A)") "number_of_kpoints"
  end if
  if (associated(split%my_states)) then
    write(var_infos%ncdimnames(1), "(A)") "my_max_number_of_states"
  else
    write(var_infos%ncdimnames(1), "(A)") "max_number_of_states"
  end if
  call test_var(ncid, var_infos, lstat, error_data)
  deallocate(var_infos%ncdimnames)
  if (.not. lstat) then
    call etsf_io_split_free(split)
    call etsf_io_low_error_update(error_data, me)
    return
  end if
  
  ! Check from a list.
  lstat = .false.
  ! Variable coefficients_of_wavefunctions
  write(var_infos%name, "(A)") "coefficients_of_wavefunctions"
  var_infos%nctype  = etsf_io_low_double
  var_infos%ncshape = 6
  allocate(var_infos%ncdimnames(6))
  if (associated(split%my_spins)) then
    write(var_infos%ncdimnames(6), "(A)") "my_number_of_spins"
  else
    write(var_infos%ncdimnames(6), "(A)") "number_of_spins"
  end if
  if (associated(split%my_kpoints)) then
    write(var_infos%ncdimnames(5), "(A)") "my_number_of_kpoints"
  else
    write(var_infos%ncdimnames(5), "(A)") "number_of_kpoints"
  end if
  if (associated(split%my_states)) then
    write(var_infos%ncdimnames(4), "(A)") "my_max_number_of_states"
  else
    write(var_infos%ncdimnames(4), "(A)") "max_number_of_states"
  end if
  write(var_infos%ncdimnames(3), "(A)") "number_of_spinor_components"
  if (associated(split%my_coefficients)) then
    write(var_infos%ncdimnames(2), "(A)") "my_max_number_of_coefficients"
  else
    write(var_infos%ncdimnames(2), "(A)") "max_number_of_coefficients"
  end if
  write(var_infos%ncdimnames(1), "(A)") "real_or_complex_coefficients"
  call test_var(ncid, var_infos, valid, error_data)
  deallocate(var_infos%ncdimnames)
  if (.not. valid .and. error_data%access_mode_id == ERROR_MODE_SPEC) return
  lstat = lstat .or. valid
  ! Variable real_space_wavefunctions
  write(var_infos%name, "(A)") "real_space_wavefunctions"
  var_infos%nctype  = etsf_io_low_double
  var_infos%ncshape = 8
  allocate(var_infos%ncdimnames(8))
  if (associated(split%my_spins)) then
    write(var_infos%ncdimnames(8), "(A)") "my_number_of_spins"
  else
    write(var_infos%ncdimnames(8), "(A)") "number_of_spins"
  end if
  if (associated(split%my_kpoints)) then
    write(var_infos%ncdimnames(7), "(A)") "my_number_of_kpoints"
  else
    write(var_infos%ncdimnames(7), "(A)") "number_of_kpoints"
  end if
  if (associated(split%my_states)) then
    write(var_infos%ncdimnames(6), "(A)") "my_max_number_of_states"
  else
    write(var_infos%ncdimnames(6), "(A)") "max_number_of_states"
  end if
  write(var_infos%ncdimnames(5), "(A)") "number_of_spinor_components"
  if (associated(split%my_grid_points_vector3)) then
    write(var_infos%ncdimnames(4), "(A)") "my_number_of_grid_points_vect3"
  else
    write(var_infos%ncdimnames(4), "(A)") "number_of_grid_points_vector3"
  end if
  if (associated(split%my_grid_points_vector2)) then
    write(var_infos%ncdimnames(3), "(A)") "my_number_of_grid_points_vect2"
  else
    write(var_infos%ncdimnames(3), "(A)") "number_of_grid_points_vector2"
  end if
  if (associated(split%my_grid_points_vector1)) then
    write(var_infos%ncdimnames(2), "(A)") "my_number_of_grid_points_vect1"
  else
    write(var_infos%ncdimnames(2), "(A)") "number_of_grid_points_vector1"
  end if
  write(var_infos%ncdimnames(1), "(A)") "real_or_complex_wavefunctions"
  call test_var(ncid, var_infos, valid, error_data)
  deallocate(var_infos%ncdimnames)
  if (.not. valid .and. error_data%access_mode_id == ERROR_MODE_SPEC) return
  lstat = lstat .or. valid
  if (.not. lstat) then
    call etsf_io_split_free(split)
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
                             & ERROR_TYPE_ARG, me, &
   & tgtname = "coefficients_of_wavefunctions, real_space_wavefunctions", &
                             & errmess = "missing one among the list.")
    return
  end if
  
  ! Check a list of conditions if a variable is set.
  ! Test the existence of a variable.
  lstat = .false.
  call etsf_io_low_read_var_infos(ncid, "coefficients_of_wavefunctions", var_infos, &
                                & lstat, error_data = error_data)
  if (lstat) then
    ! Apply the conditions since variable exists.
    ! Variable basis_set
    write(var_infos%name, "(A)") "basis_set"
    var_infos%nctype  = etsf_io_low_character
    var_infos%ncshape = 1
    allocate(var_infos%ncdimnames(1))
    write(var_infos%ncdimnames(1), "(A)") "character_string_length"
    call test_var(ncid, var_infos, lstat, error_data)
    deallocate(var_infos%ncdimnames)
    if (.not. lstat) then
      call etsf_io_split_free(split)
      call etsf_io_low_error_update(error_data, me)
      return
    end if
    
    ! Check these variables depends on the value of another.
    ! Read the condition value.
    call etsf_io_low_read_var(ncid, "basis_set", string_value, etsf_charlen, &
                            & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_split_free(split)
      call etsf_io_low_error_update(error_data, me)
      return
    end if
    call strip(string_value)
    if (trim(string_value) == "daubechies_wavelets") then
      ! Variable coordinates_of_basis_grid_points
      write(var_infos%name, "(A)") "coordinates_of_basis_grid_points"
      var_infos%nctype  = etsf_io_low_integer
      var_infos%ncshape = 3
      allocate(var_infos%ncdimnames(3))
      write(var_infos%ncdimnames(3), "(A)") "number_of_localization_regions"
      write(var_infos%ncdimnames(2), "(A)") "max_number_of_basis_grid_points"
      write(var_infos%ncdimnames(1), "(A)") "number_of_reduced_dimensions"
      call test_var(ncid, var_infos, lstat, error_data)
      deallocate(var_infos%ncdimnames)
      if (.not. lstat) then
        call etsf_io_split_free(split)
        call etsf_io_low_error_update(error_data, me)
        return
      end if
      
      ! Variable number_of_coefficients_per_grid_point
      write(var_infos%name, "(A)") "number_of_coefficients_per_grid_point"
      var_infos%nctype  = etsf_io_low_integer
      var_infos%ncshape = 2
      allocate(var_infos%ncdimnames(2))
      write(var_infos%ncdimnames(2), "(A)") "number_of_localization_regions"
      write(var_infos%ncdimnames(1), "(A)") "max_number_of_basis_grid_points"
      call test_var(ncid, var_infos, lstat, error_data)
      deallocate(var_infos%ncdimnames)
      if (.not. lstat) then
        call etsf_io_split_free(split)
        call etsf_io_low_error_update(error_data, me)
        return
      end if
      
    else if (trim(string_value) == "plane_waves") then
      ! Variable number_of_coefficients
      write(var_infos%name, "(A)") "number_of_coefficients"
      var_infos%nctype  = etsf_io_low_integer
      var_infos%ncshape = 1
      allocate(var_infos%ncdimnames(1))
      if (associated(split%my_kpoints)) then
        write(var_infos%ncdimnames(1), "(A)") "my_number_of_kpoints"
      else
        write(var_infos%ncdimnames(1), "(A)") "number_of_kpoints"
      end if
      call test_var(ncid, var_infos, lstat, error_data)
      deallocate(var_infos%ncdimnames)
      if (.not. lstat) then
        call etsf_io_split_free(split)
        call etsf_io_low_error_update(error_data, me)
        return
      end if
      
      ! Variable reduced_coordinates_of_plane_waves
      write(var_infos%name, "(A)") "reduced_coordinates_of_plane_waves"
      var_infos%nctype  = etsf_io_low_integer
      call etsf_io_low_read_flag(ncid, valid, "reduced_coordinates_of_plane_waves", &
                               & "k_dependent", lstat, error_data = error_data)
      if (valid) then
        var_infos%ncshape = 3
        allocate(var_infos%ncdimnames(3))
        if (associated(split%my_kpoints)) then
          write(var_infos%ncdimnames(3), "(A)") "my_number_of_kpoints"
        else
          write(var_infos%ncdimnames(3), "(A)") "number_of_kpoints"
        end if
        if (associated(split%my_coefficients)) then
          write(var_infos%ncdimnames(2), "(A)") "my_max_number_of_coefficients"
        else
          write(var_infos%ncdimnames(2), "(A)") "max_number_of_coefficients"
        end if
        write(var_infos%ncdimnames(1), "(A)") "number_of_reduced_dimensions"
      else
        var_infos%ncshape = 2
        allocate(var_infos%ncdimnames(2))
        if (associated(split%my_coefficients)) then
          write(var_infos%ncdimnames(2), "(A)") "my_max_number_of_coefficients"
        else
          write(var_infos%ncdimnames(2), "(A)") "max_number_of_coefficients"
        end if
        write(var_infos%ncdimnames(1), "(A)") "number_of_reduced_dimensions"
      end if
      call test_var(ncid, var_infos, lstat, error_data)
      deallocate(var_infos%ncdimnames)
      if (.not. lstat) then
        call etsf_io_split_free(split)
        call etsf_io_low_error_update(error_data, me)
        return
      end if
      
    else
      call etsf_io_split_free(split)
      call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
                               & ERROR_TYPE_ARG, me, &
                               & tgtname = "basis_set", &
                               & errmess = "Empty or unknown value '"//trim(string_value)//"'.")
      lstat = .false.
      return
    end if
  end if


  ! Deallocate the split data.
  call etsf_io_split_free(split)

  lstat = .true.
end subroutine etsf_io_file_check_wavefunctions_data
etsf_io-1.0.3/doc/www/utils/etsf_io_file_check_scalar_field_data_f90.html0000644000353400050620000010426211354150415023434 00000000000000 ./src/utils/etsf_io_file_check_scalar_field_data.f90

TABLE OF CONTENTS

etsf_io_file_check_scalar_field_data

[ Top ] [ etsf_io_file ] [ Methods ]

NAME

etsf_io_file_check_scalar_field_data

FUNCTION

This is a high level routine to inquire a file about a specifications. It returns .true. in lstat if the file is a valid 'scalar_field_data' file. It tests the existence of variables and their definition (type, shape. and dimension names).

INPUTS

OUTPUT

  • lstat = return .true. if the file matches requirement of 'scalar_field_data'.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

SOURCE

subroutine etsf_io_file_check_scalar_field_data(ncid, lstat, error_data)
  integer, intent(intent)                  :: ncid
  logical, intent(out)                 :: lstat
  type(etsf_io_low_error), intent(out) :: error_data

  character(len = *), parameter        :: me = "etsf_io_file_check_scalar_field_data"
  type(etsf_io_low_var_infos)          :: var_infos
  logical                              :: valid
  character(len = etsf_charlen)        :: string_value
  type(etsf_dims)                      :: dims
  type(etsf_split)                     :: split

  ! Read the dimensions
  call etsf_io_dims_get(ncid, dims, lstat, error_data)
  if (.not. lstat) then
     call etsf_io_low_error_update(error_data, me)
     return
  end if

  ! Allocate the split and read it (this will verify variable exist.
  call etsf_io_split_allocate(split, dims)
  call etsf_io_split_get(ncid, split, lstat, error_data)
  if (.not. lstat) then
     call etsf_io_low_error_update(error_data, me)
     return
  end if

  ! Variable primitive_vectors
  write(var_infos%name, "(A)") "primitive_vectors"
  var_infos%nctype  = etsf_io_low_double
  var_infos%ncshape = 2
  allocate(var_infos%ncdimnames(2))
  write(var_infos%ncdimnames(2), "(A)") "number_of_vectors"
  write(var_infos%ncdimnames(1), "(A)") "number_of_cartesian_directions"
  call test_var(ncid, var_infos, lstat, error_data)
  deallocate(var_infos%ncdimnames)
  if (.not. lstat) then
    call etsf_io_split_free(split)
    call etsf_io_low_error_update(error_data, me)
    return
  end if
  
  ! Check from a list.
  lstat = .false.
  ! Variable density
  write(var_infos%name, "(A)") "density"
  var_infos%nctype  = etsf_io_low_double
  var_infos%ncshape = 5
  allocate(var_infos%ncdimnames(5))
  if (associated(split%my_components)) then
    write(var_infos%ncdimnames(5), "(A)") "my_number_of_components"
  else
    write(var_infos%ncdimnames(5), "(A)") "number_of_components"
  end if
  if (associated(split%my_grid_points_vector3)) then
    write(var_infos%ncdimnames(4), "(A)") "my_number_of_grid_points_vect3"
  else
    write(var_infos%ncdimnames(4), "(A)") "number_of_grid_points_vector3"
  end if
  if (associated(split%my_grid_points_vector2)) then
    write(var_infos%ncdimnames(3), "(A)") "my_number_of_grid_points_vect2"
  else
    write(var_infos%ncdimnames(3), "(A)") "number_of_grid_points_vector2"
  end if
  if (associated(split%my_grid_points_vector1)) then
    write(var_infos%ncdimnames(2), "(A)") "my_number_of_grid_points_vect1"
  else
    write(var_infos%ncdimnames(2), "(A)") "number_of_grid_points_vector1"
  end if
  write(var_infos%ncdimnames(1), "(A)") "real_or_complex_density"
  call test_var(ncid, var_infos, valid, error_data)
  deallocate(var_infos%ncdimnames)
  if (.not. valid .and. error_data%access_mode_id == ERROR_MODE_SPEC) return
  lstat = lstat .or. valid
  ! Variable correlation_potential
  write(var_infos%name, "(A)") "correlation_potential"
  var_infos%nctype  = etsf_io_low_double
  var_infos%ncshape = 5
  allocate(var_infos%ncdimnames(5))
  if (associated(split%my_components)) then
    write(var_infos%ncdimnames(5), "(A)") "my_number_of_components"
  else
    write(var_infos%ncdimnames(5), "(A)") "number_of_components"
  end if
  if (associated(split%my_grid_points_vector3)) then
    write(var_infos%ncdimnames(4), "(A)") "my_number_of_grid_points_vect3"
  else
    write(var_infos%ncdimnames(4), "(A)") "number_of_grid_points_vector3"
  end if
  if (associated(split%my_grid_points_vector2)) then
    write(var_infos%ncdimnames(3), "(A)") "my_number_of_grid_points_vect2"
  else
    write(var_infos%ncdimnames(3), "(A)") "number_of_grid_points_vector2"
  end if
  if (associated(split%my_grid_points_vector1)) then
    write(var_infos%ncdimnames(2), "(A)") "my_number_of_grid_points_vect1"
  else
    write(var_infos%ncdimnames(2), "(A)") "number_of_grid_points_vector1"
  end if
  write(var_infos%ncdimnames(1), "(A)") "real_or_complex_potential"
  call test_var(ncid, var_infos, valid, error_data)
  deallocate(var_infos%ncdimnames)
  if (.not. valid .and. error_data%access_mode_id == ERROR_MODE_SPEC) return
  lstat = lstat .or. valid
  ! Variable exchange_potential
  write(var_infos%name, "(A)") "exchange_potential"
  var_infos%nctype  = etsf_io_low_double
  var_infos%ncshape = 5
  allocate(var_infos%ncdimnames(5))
  if (associated(split%my_components)) then
    write(var_infos%ncdimnames(5), "(A)") "my_number_of_components"
  else
    write(var_infos%ncdimnames(5), "(A)") "number_of_components"
  end if
  if (associated(split%my_grid_points_vector3)) then
    write(var_infos%ncdimnames(4), "(A)") "my_number_of_grid_points_vect3"
  else
    write(var_infos%ncdimnames(4), "(A)") "number_of_grid_points_vector3"
  end if
  if (associated(split%my_grid_points_vector2)) then
    write(var_infos%ncdimnames(3), "(A)") "my_number_of_grid_points_vect2"
  else
    write(var_infos%ncdimnames(3), "(A)") "number_of_grid_points_vector2"
  end if
  if (associated(split%my_grid_points_vector1)) then
    write(var_infos%ncdimnames(2), "(A)") "my_number_of_grid_points_vect1"
  else
    write(var_infos%ncdimnames(2), "(A)") "number_of_grid_points_vector1"
  end if
  write(var_infos%ncdimnames(1), "(A)") "real_or_complex_potential"
  call test_var(ncid, var_infos, valid, error_data)
  deallocate(var_infos%ncdimnames)
  if (.not. valid .and. error_data%access_mode_id == ERROR_MODE_SPEC) return
  lstat = lstat .or. valid
  ! Variable exchange_correlation_potential
  write(var_infos%name, "(A)") "exchange_correlation_potential"
  var_infos%nctype  = etsf_io_low_double
  var_infos%ncshape = 5
  allocate(var_infos%ncdimnames(5))
  if (associated(split%my_components)) then
    write(var_infos%ncdimnames(5), "(A)") "my_number_of_components"
  else
    write(var_infos%ncdimnames(5), "(A)") "number_of_components"
  end if
  if (associated(split%my_grid_points_vector3)) then
    write(var_infos%ncdimnames(4), "(A)") "my_number_of_grid_points_vect3"
  else
    write(var_infos%ncdimnames(4), "(A)") "number_of_grid_points_vector3"
  end if
  if (associated(split%my_grid_points_vector2)) then
    write(var_infos%ncdimnames(3), "(A)") "my_number_of_grid_points_vect2"
  else
    write(var_infos%ncdimnames(3), "(A)") "number_of_grid_points_vector2"
  end if
  if (associated(split%my_grid_points_vector1)) then
    write(var_infos%ncdimnames(2), "(A)") "my_number_of_grid_points_vect1"
  else
    write(var_infos%ncdimnames(2), "(A)") "number_of_grid_points_vector1"
  end if
  write(var_infos%ncdimnames(1), "(A)") "real_or_complex_potential"
  call test_var(ncid, var_infos, valid, error_data)
  deallocate(var_infos%ncdimnames)
  if (.not. valid .and. error_data%access_mode_id == ERROR_MODE_SPEC) return
  lstat = lstat .or. valid
  if (.not. lstat) then
    call etsf_io_split_free(split)
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
                             & ERROR_TYPE_ARG, me, &
   & tgtname = "density, correlation_potential, exchange_potential, exchange_correlation_p...", &
                             & errmess = "missing one among the list.")
    return
  end if
  


  ! Deallocate the split data.
  call etsf_io_split_free(split)

  lstat = .true.
end subroutine etsf_io_file_check_scalar_field_data
etsf_io-1.0.3/doc/www/utils/etsf_io_file_check_crystallographic_data_f90.html0000644000353400050620000006775711354150415024417 00000000000000 ./src/utils/etsf_io_file_check_crystallographic_data.f90

TABLE OF CONTENTS

etsf_io_file_check_crystallographic_data

[ Top ] [ etsf_io_file ] [ Methods ]

NAME

etsf_io_file_check_crystallographic_data

FUNCTION

This is a high level routine to inquire a file about a specifications. It returns .true. in lstat if the file is a valid 'crystallographic_data' file. It tests the existence of variables and their definition (type, shape. and dimension names).

INPUTS

OUTPUT

  • lstat = return .true. if the file matches requirement of 'crystallographic_data'.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

SOURCE

subroutine etsf_io_file_check_crystallographic_data(ncid, lstat, error_data)
  integer, intent(intent)                  :: ncid
  logical, intent(out)                 :: lstat
  type(etsf_io_low_error), intent(out) :: error_data

  character(len = *), parameter        :: me = "etsf_io_file_check_crystallographic_data"
  type(etsf_io_low_var_infos)          :: var_infos
  logical                              :: valid
  character(len = etsf_charlen)        :: string_value
  type(etsf_dims)                      :: dims
  type(etsf_split)                     :: split

  ! Read the dimensions
  call etsf_io_dims_get(ncid, dims, lstat, error_data)
  if (.not. lstat) then
     call etsf_io_low_error_update(error_data, me)
     return
  end if

  ! Allocate the split and read it (this will verify variable exist.
  call etsf_io_split_allocate(split, dims)
  call etsf_io_split_get(ncid, split, lstat, error_data)
  if (.not. lstat) then
     call etsf_io_low_error_update(error_data, me)
     return
  end if

  ! Variable primitive_vectors
  write(var_infos%name, "(A)") "primitive_vectors"
  var_infos%nctype  = etsf_io_low_double
  var_infos%ncshape = 2
  allocate(var_infos%ncdimnames(2))
  write(var_infos%ncdimnames(2), "(A)") "number_of_vectors"
  write(var_infos%ncdimnames(1), "(A)") "number_of_cartesian_directions"
  call test_var(ncid, var_infos, lstat, error_data)
  deallocate(var_infos%ncdimnames)
  if (.not. lstat) then
    call etsf_io_split_free(split)
    call etsf_io_low_error_update(error_data, me)
    return
  end if
  
  ! Variable reduced_symmetry_matrices
  write(var_infos%name, "(A)") "reduced_symmetry_matrices"
  var_infos%nctype  = etsf_io_low_integer
  var_infos%ncshape = 3
  allocate(var_infos%ncdimnames(3))
  write(var_infos%ncdimnames(3), "(A)") "number_of_symmetry_operations"
  write(var_infos%ncdimnames(2), "(A)") "number_of_reduced_dimensions"
  write(var_infos%ncdimnames(1), "(A)") "number_of_reduced_dimensions"
  call test_var(ncid, var_infos, lstat, error_data)
  deallocate(var_infos%ncdimnames)
  if (.not. lstat) then
    call etsf_io_split_free(split)
    call etsf_io_low_error_update(error_data, me)
    return
  end if
  
  ! Variable reduced_symmetry_translations
  write(var_infos%name, "(A)") "reduced_symmetry_translations"
  var_infos%nctype  = etsf_io_low_double
  var_infos%ncshape = 2
  allocate(var_infos%ncdimnames(2))
  write(var_infos%ncdimnames(2), "(A)") "number_of_symmetry_operations"
  write(var_infos%ncdimnames(1), "(A)") "number_of_reduced_dimensions"
  call test_var(ncid, var_infos, lstat, error_data)
  deallocate(var_infos%ncdimnames)
  if (.not. lstat) then
    call etsf_io_split_free(split)
    call etsf_io_low_error_update(error_data, me)
    return
  end if
  
  ! Variable space_group
  write(var_infos%name, "(A)") "space_group"
  var_infos%nctype  = etsf_io_low_integer
  var_infos%ncshape = 0
  call test_var(ncid, var_infos, lstat, error_data)
  if (.not. lstat) then
    call etsf_io_split_free(split)
    call etsf_io_low_error_update(error_data, me)
    return
  end if
  
  ! Variable atom_species
  write(var_infos%name, "(A)") "atom_species"
  var_infos%nctype  = etsf_io_low_integer
  var_infos%ncshape = 1
  allocate(var_infos%ncdimnames(1))
  write(var_infos%ncdimnames(1), "(A)") "number_of_atoms"
  call test_var(ncid, var_infos, lstat, error_data)
  deallocate(var_infos%ncdimnames)
  if (.not. lstat) then
    call etsf_io_split_free(split)
    call etsf_io_low_error_update(error_data, me)
    return
  end if
  
  ! Variable reduced_atom_positions
  write(var_infos%name, "(A)") "reduced_atom_positions"
  var_infos%nctype  = etsf_io_low_double
  var_infos%ncshape = 2
  allocate(var_infos%ncdimnames(2))
  write(var_infos%ncdimnames(2), "(A)") "number_of_atoms"
  write(var_infos%ncdimnames(1), "(A)") "number_of_reduced_dimensions"
  call test_var(ncid, var_infos, lstat, error_data)
  deallocate(var_infos%ncdimnames)
  if (.not. lstat) then
    call etsf_io_split_free(split)
    call etsf_io_low_error_update(error_data, me)
    return
  end if
  
  ! Check from a list.
  lstat = .false.
  ! Variable atomic_numbers
  write(var_infos%name, "(A)") "atomic_numbers"
  var_infos%nctype  = etsf_io_low_double
  var_infos%ncshape = 1
  allocate(var_infos%ncdimnames(1))
  write(var_infos%ncdimnames(1), "(A)") "number_of_atom_species"
  call test_var(ncid, var_infos, valid, error_data)
  deallocate(var_infos%ncdimnames)
  if (.not. valid .and. error_data%access_mode_id == ERROR_MODE_SPEC) return
  lstat = lstat .or. valid
  ! Variable atom_species_names
  write(var_infos%name, "(A)") "atom_species_names"
  var_infos%nctype  = etsf_io_low_character
  var_infos%ncshape = 2
  allocate(var_infos%ncdimnames(2))
  write(var_infos%ncdimnames(2), "(A)") "number_of_atom_species"
  write(var_infos%ncdimnames(1), "(A)") "character_string_length"
  call test_var(ncid, var_infos, valid, error_data)
  deallocate(var_infos%ncdimnames)
  if (.not. valid .and. error_data%access_mode_id == ERROR_MODE_SPEC) return
  lstat = lstat .or. valid
  ! Variable chemical_symbols
  write(var_infos%name, "(A)") "chemical_symbols"
  var_infos%nctype  = etsf_io_low_character
  var_infos%ncshape = 2
  allocate(var_infos%ncdimnames(2))
  write(var_infos%ncdimnames(2), "(A)") "number_of_atom_species"
  write(var_infos%ncdimnames(1), "(A)") "symbol_length"
  call test_var(ncid, var_infos, valid, error_data)
  deallocate(var_infos%ncdimnames)
  if (.not. valid .and. error_data%access_mode_id == ERROR_MODE_SPEC) return
  lstat = lstat .or. valid
  if (.not. lstat) then
    call etsf_io_split_free(split)
    call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, &
                             & ERROR_TYPE_ARG, me, &
   & tgtname = "atomic_numbers, atom_species_names, chemical_symbols", &
                             & errmess = "missing one among the list.")
    return
  end if
  


  ! Deallocate the split data.
  call etsf_io_split_free(split)

  lstat = .true.
end subroutine etsf_io_file_check_crystallographic_data
etsf_io-1.0.3/doc/www/utils/etsf_io_file_contents_f90.html0000644000353400050620000002542011354150415020531 00000000000000 ./src/utils/etsf_io_file_contents.f90

TABLE OF CONTENTS

etsf_io_file_contents

[ Top ] [ etsf_io_file ] [ Methods ]

NAME

etsf_io_file_contents

FUNCTION

This is a high level routine to inquire a file and get the specifications it matches. It is usefull to know if the file is a valid density file...

INPUTS

  • file_name = a list of path where input files can be found.

OUTPUT

  • read_flags = a serie of flags the file matches. These flags are defined in the module etsf_io (see ETSF_IO_VALIDITY_FLAGS). It is an addition of all matching flags.
  • errors = an array of size etsf_nspecs_data. For each flag that missed, it gives the error why it missed.
  • lstat = return .false. if something make the file unreadable.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

SOURCE

subroutine etsf_io_file_contents(read_flags, errors, file_name, lstat, error_data)
  integer, intent(out)                 :: read_flags
  type(etsf_io_low_error), intent(out) :: errors(etsf_nspecs_data)
  character(len = *), intent(intent)       :: file_name
  logical, intent(out)                 :: lstat
  type(etsf_io_low_error), intent(out) :: error_data

  character(len = *), parameter        :: me = "etsf_io_file_contents"
  integer :: ncid

  read_flags = etsf_specs_none

  call etsf_io_low_open_read(ncid, trim(file_name), lstat, &
       & error_data = error_data)
  if (.not. lstat) then
     call etsf_io_low_error_update(error_data, me)
     return
  end if

  call etsf_io_file_check_dielectric_function_data(ncid, lstat, errors(1))
  if (lstat) then
    read_flags = read_flags + etsf_dielectric_function_data
  else
    call etsf_io_low_error_update(errors(1), me)
  end if
  call etsf_io_file_check_wavefunctions_data(ncid, lstat, errors(2))
  if (lstat) then
    read_flags = read_flags + etsf_wavefunctions_data
  else
    call etsf_io_low_error_update(errors(2), me)
  end if
  call etsf_io_file_check_scalar_field_data(ncid, lstat, errors(3))
  if (lstat) then
    read_flags = read_flags + etsf_scalar_field_data
  else
    call etsf_io_low_error_update(errors(3), me)
  end if
  call etsf_io_file_check_crystallographic_data(ncid, lstat, errors(4))
  if (lstat) then
    read_flags = read_flags + etsf_crystallographic_data
  else
    call etsf_io_low_error_update(errors(4), me)
  end if


  ! We close the file after the definitions.
  call etsf_io_low_close(ncid, lstat, error_data = error_data)
  if (.not. lstat) then
     call etsf_io_low_error_update(error_data, me)
     return
  end if

end subroutine etsf_io_file_contents
etsf_io-1.0.3/doc/www/utils/etsf_io_file_f90.html0000644000353400050620000000604211354150415016613 00000000000000 ./src/utils/etsf_io_file.f90

TABLE OF CONTENTS

etsf_io_file

[ Top ] [ Modules ]

NAME

etsf_io_file

FUNCTION

This module contains different high level routines to access ETSF files. It actually contains:

  • etsf_io_file_merge(): a routine to read several files and merge their data into a single output file.
  • etsf_io_file_contents(): a routine to read a file and get what specifications this file is matching (cristallographic data, potential...).
  • etsf_io_file_check(): a routine to validate a file against one or several specifications.

NOTES

This file has been automatically generated by the autogen_utils.py script. Any change you would bring to it will systematically be overwritten.

etsf_io-1.0.3/doc/www/utils/etsf_io_file_public_f90.html0000644000353400050620000007627311354150415020166 00000000000000 ./src/utils/etsf_io_file_public.f90

TABLE OF CONTENTS

etsf_io_file_check

[ Top ] [ etsf_io_file ] [ Methods ]

NAME

etsf_io_file_check

FUNCTION

This is a high level routine to check that a file is valid to the specifications. This validity is done on presence of required variables and on conform variable definition. The presence of attributes when required is also done.

INPUTS

  • file_name = a list of path where input files can be found.
  • file_flags = a serie of flags to check the file on. These flags are defined in the module etsf_io (see ETSF_IO_VALIDITY_FLAGS). To use several flags, simply add each of them.

OUTPUT

  • lstat = return .true. if the file is valid.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

SOURCE

  subroutine etsf_io_file_check(file_name, file_flags, lstat, error_data)
    character(len = *), intent(intent)       :: file_name
    integer, intent(intent)                  :: file_flags
    logical, intent(out)                 :: lstat
    type(etsf_io_low_error), intent(out) :: error_data

    character(len = *), parameter :: me = "etsf_io_file_check"
    integer :: read_flags
    type(etsf_io_low_error), dimension(etsf_nspecs_data) :: errors
    integer :: i
    
    call etsf_io_file_contents(read_flags, errors, file_name, lstat, error_data)
    if (.not. lstat) then
       call etsf_io_low_error_update(error_data, me)
       return
    end if
    
    do i = 1, etsf_nspecs_data
       if (iand(file_flags, 2 ** (i - 1)) /= 0 .and. &
            & iand(read_flags, 2 ** (i - 1)) == 0) then
          lstat = .false.
          error_data = errors(i)
          call etsf_io_low_error_update(error_data, me)
          return
       end if
    end do
    lstat = .true.
  end subroutine etsf_io_file_check

etsf_io_file_merge

[ Top ] [ etsf_io_file ] [ Methods ]

NAME

etsf_io_file_merge

FUNCTION

This is a high level routine to merge several files into one single. The files to be merged should conform to the ETSF specification on splitted files. The given input files must not be necessarily a complete list to create a non-splitted file. In the case some arrays are still partial, the created output file is a splitted one again, gathering what was possible with respect to the given input files.

INPUTS

  • dest_file = the path to the file to be created. It must not already exist.
  • source_files = a list of path where input files can be found.

OUTPUT

  • lstat = return .true. if all the actions succeed, if not the status of the output file is undefined.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

SOURCE

  subroutine etsf_io_file_merge(dest_file, source_files, lstat, error_data)
    character(len = *), intent(intent) :: dest_file
    character(len = 256), intent(intent) :: source_files(:)
    logical, intent(out) :: lstat
    type(etsf_io_low_error), intent(out) :: error_data

    ! Local variables
    integer :: ncid_to, n_files, i_file, i, ncid
    integer :: etsf_main, grp
    type(file_infos_type), allocatable :: infos_file(:)
    type(etsf_split) :: output_split
    type(etsf_dims) :: output_dims
    type(etsf_groups_flags) :: etsf_variables
    character(len = *), parameter :: me = "etsf_io_file_merge"

    lstat = .false.
    n_files = size(source_files)
    if (n_files <= 0) then
       call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ARG, me, &
            & errmess = "argument 'source_files' has a wrong size.")
       return
    end if

    ! We allocate the dimension definitions.
    allocate(infos_file(n_files))

    !*************************************
    ! Read all definitions from all files.
    !*************************************
    ! We read the different dimensions.
    etsf_main  = etsf_main_none
    do i_file = 1, n_files, 1
       ! We copy the path.
       infos_file(i_file)%path = source_files(i_file)
       ! We get the list of used groups and main variables
       ! We also get the list of all variables in the files.
       call etsf_io_data_contents(trim(source_files(i_file)), &
            & infos_file(i_file)%dims, infos_file(i_file)%split, &
            & grp, etsf_variables, lstat, error_data, &
            & vars_infos = infos_file(i_file)%var_list)
       if (.not. lstat) then
          call file_infos_free(infos_file, i_file)
          deallocate(infos_file)
          call etsf_io_low_error_update(error_data, me)
          return
       end if
       etsf_main  = ior(etsf_main, etsf_variables%main)
    end do


    !*********************************************
    ! Merge the dimensions and split informations.
    !*********************************************
    ! We merge the dimensions, checking that all no my_something
    ! are equal and we create an output_split for all not complete
    ! dimensions after merge.
    output_dims = infos_file(1)%dims
    ! Sum all my_something dimensions, to know if the merging is complete or not.
    do i_file = 2, n_files, 1
       call etsf_io_dims_merge(output_dims, infos_file(i_file)%dims, &
            & lstat, error_data)
       if (.not. lstat) then
          call file_infos_free(infos_file, n_files)
          deallocate(infos_file)
          call etsf_io_low_error_update(error_data, me)
          return
       end if
    end do
    call etsf_io_split_allocate(output_split, output_dims)
    ! We create a new split definition with the split(i) values.
    do i_file = 1, n_files, 1
       call etsf_io_split_merge(output_split, infos_file(i_file)%split, &
            & lstat, error_data)
       if (.not. lstat) goto 1000
    end do


    !*****************************************************
    ! Define all ETSF (non main) variables and dimensions.
    !*****************************************************
    ! We create an output file and define all the variables and dimensions.
    ! All defined dimensions and variables are related to ETSF only,
    ! all other variables and dimensions are ignored.
    ! The main group is also ignored at that time to allow to add new
    ! non ETSF variables.
    if (etsf_main /= etsf_main_none) then
       etsf_variables%main = etsf_main_none
    end if
    call etsf_io_data_init(trim(dest_file), etsf_variables, output_dims, &
         & "Merging files", "", lstat, error_data = error_data, &
         & split_definition = output_split) 
    if (.not. lstat) goto 1000


    !******************************************************
    ! Treat non-ETSF part, define variables and dimensions.
    !******************************************************
    ! We reopen the destination file to add non ETSF elements
    ! and to later add the main group.
    call etsf_io_low_open_modify(ncid_to, trim(dest_file), lstat, &
         & error_data = error_data)
    if (.not. lstat) goto 1000

    ! We define all dimensions and variables that are non-part of ETSF.
    call non_etsf_init(ncid_to, infos_file, lstat, error_data)
    if (.not. lstat) goto 1000

    ! We add the main group.
    if (etsf_main /= etsf_main_none) then
       call etsf_io_main_def(ncid_to, lstat, error_data, flags = etsf_main, &
            & split = output_split)
       if (.not. lstat) goto 1000
    end if

    ! We close the file after the definitions.
    call etsf_io_low_close(ncid_to, lstat, error_data = error_data)
    if (.not. lstat) goto 1000


    !*************************
    ! Copy all ETSF variables.
    !*************************
    ! We copy all the data from read files to the new output file.
    do i_file = 1, n_files, 1
       call etsf_io_data_copy(trim(dest_file), trim(source_files(i_file)), &
            & infos_file(i_file)%dims, lstat, error_data, infos_file(i_file)%split)
       if (.not. lstat) goto 1000
    end do


    !*****************************
    ! Copy all non-ETSF variables.
    !*****************************
    ! We reopen the destination file to copy non ETSF values.
    call etsf_io_low_open_modify(ncid_to, trim(dest_file), lstat, &
         & error_data = error_data)
    if (.not. lstat) goto 1000

    call etsf_io_low_set_write_mode(ncid_to, lstat, error_data = error_data)
    if (.not. lstat) goto 1000

    ! We copy all variables that are non-part of ETSF.
    call non_etsf_copy(ncid_to, infos_file, lstat, error_data)
    if (.not. lstat) goto 1000

    ! We close the file after the copy.
    call etsf_io_low_close(ncid_to, lstat, error_data = error_data)
    if (.not. lstat) goto 1000


    ! If we arrived there, then everything went right.
    lstat = .true.

    ! Last deallocations and/or error freeing before return.
    1000 continue
    call file_infos_free(infos_file, n_files)
    deallocate(infos_file)
    call etsf_io_split_free(output_split)
    if (.not. lstat) call etsf_io_low_error_update(error_data, me)
  end subroutine etsf_io_file_merge
etsf_io-1.0.3/doc/www/utils/etsf_io_tools_f90.html0000644000353400050620000012755311354150414017046 00000000000000 ./src/utils/etsf_io_tools.f90

TABLE OF CONTENTS

etsf_io_tools

[ Top ] [ Modules ]

NAME

etsf_io_tools

FUNCTION

This module contains different non mandatory routines to handle internals from ETSF files. It actually contains:

  • etsf_io_tools_get_atom_names(): a routine to read the three variables defining atoms and returning names informations as defined in the specifications.

etsf_io_tools_get_atom_names

[ Top ] [ etsf_io_tools ] [ Methods ]

NAME

etsf_io_tools_get_atom_names

FUNCTION

In the specifications, atom names can be read from these three variables: atomic_numbers, atom_species_names and chemical_symbols. The first listed variable is prefered. This routine is a convenient way to access to atom names directly, following specifications preferences.

The output argument @atom_numbers is set if the NetCDF variable 'atomic_numbers' is present, and @atom_names contains 'atom_species_names' or 'chemical_symbols' if present or a string equivalent to 'atomic_numbers' if not. Then a string representation is always available.

INPUTS

  • ncid = an opened NetCDF file with read access.

OUTPUT

  • atom_names = an allocated array to store the atom names (indexed by species).
  • lstat = return .true. if all the actions succeed.
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.
  • atom_numbers = <optional> a pointer to store the atomic numbers, it will be associated only if 'atomic_numbers' variable is present.

SOURCE

  subroutine etsf_io_tools_get_atom_names(ncid, atom_names, lstat, error_data, &
       & atom_numbers)
    integer, intent(intent)                        :: ncid
    character(len = etsf_charlen), intent(out) :: atom_names(:)
    logical, intent(out)                       :: lstat
    type(etsf_io_low_error), intent(out)       :: error_data
    double precision, pointer, optional        :: atom_numbers(:)

    ! Local variables
    character(len = *), parameter            :: me = "etsf_io_tools_get_atom_names"
    logical                                  :: valid
    double precision, pointer                :: my_atom_numbers(:)
    character(len=etsf_chemlen), allocatable :: symbols(:)
    integer                                  :: number_of_atom_species, i

    if (present(atom_numbers)) then
       atom_numbers => null()
    end if

    ! Read the array dimension.
    call etsf_io_low_read_dim(ncid, "number_of_atom_species", &
         & number_of_atom_species, lstat, error_data = error_data)
    if (.not. lstat) then
       call etsf_io_low_error_update(error_data, me)
       return
    end if

    ! Check that argument size matches number_of_atoms.
    if (size(atom_names) /= number_of_atom_species) then
       call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ARG, me, &
            & tgtname = "atom_names", errmess = "wrong argument size.")
       lstat = .false.
       return
    end if

    valid = .false.
    allocate(my_atom_numbers(number_of_atom_species))
    call etsf_io_low_read_var(ncid, "atomic_numbers", &
         & my_atom_numbers, lstat, error_data = error_data)
    if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
       ! Case where variable is found but has problems.
       deallocate(my_atom_numbers)
       call etsf_io_low_error_update(error_data, me)
       return
    end if
    if (lstat) then
       ! Ok, we have the informations we were looking for.
       ! But we will try for better string description than figures.
       do i = 1, number_of_atom_species, 1
          write(atom_names(i), "(F6.2)") my_atom_numbers(i)
       end do
       if (present(atom_numbers)) then
          atom_numbers => my_atom_numbers
       else
          deallocate(my_atom_numbers)
       end if
       valid = .true.
    else
       deallocate(my_atom_numbers)
    end if

    ! 'atomic_numbers' was not found, try to fall back to 'atom_species_names'
    call etsf_io_low_read_var(ncid, "atom_species_names", &
         & atom_names, etsf_charlen, lstat, error_data = error_data)
    if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
       ! Case where variable is found but has problems.
       call etsf_io_low_error_update(error_data, me)
       return
    end if
    if (lstat) then
       ! Ok, we have the informations we were looking for.
       ! But we check that given values are not void.
       valid = .true.
       do i = 1, number_of_atom_species, 1
          call strip(atom_names(i))
          valid = valid .and. (trim(atom_names(i)) /= "")
       end do
       if (valid) return
    end if

    ! 'atomic_numbers' was not found, try to fall back to 'atom_species_names'
    allocate(symbols(number_of_atom_species))
    call etsf_io_low_read_var(ncid, "chemical_symbols", &
         & symbols, etsf_chemlen, lstat, error_data = error_data)
    if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
       ! Case where variable is found but has problems.
       deallocate(symbols)
       call etsf_io_low_error_update(error_data, me)
       return
    end if
    if (lstat) then
       ! Ok, we have the informations we were looking for.
       do i = 1, number_of_atom_species, 1
          call strip(symbols(i))
          write(atom_names(i), "(A)") symbols(i)
       end do
       deallocate(symbols)
       return
    end if
    deallocate(symbols)
    
    ! If nthing has worked, we raise an error.
    if (.not. lstat .and. .not. valid) then
       call etsf_io_low_error_set(error_data, ERROR_MODE_INQ, ERROR_TYPE_VAR, me, &
            & tgtname = "atomic_numbers, atom_species_names, chemical_symbols", &
            & errmess = "no variable exists, can't get atom names.")
    end if
  end subroutine etsf_io_tools_get_atom_names

etsf_io_tools_get_time_reversal_symmetry

[ Top ] [ etsf_io_tools ] [ Methods ]

NAME

etsf_io_tools_get_time_reversal_symmetry

FUNCTION

In the specifications, an attribute can be set to describe if the basis set informations have been reduced using the time reversal symmetry at Gamma point in the case of plane wave basis sets. This routine poll the given file, check that the basis set is plane waves and check that the attribute is set coherently between variables.

INPUTS

  • ncid = an opened NetCDF file with read access.

OUTPUT

  • symmetry = .false. if the symmetry is not used.
  • lstat = return .true. if all the actions succeed (especially checks).
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

SOURCE

  subroutine etsf_io_tools_get_time_reversal_symmetry(ncid, symmetry, &
       & lstat, error_data)
    integer, intent(intent)                        :: ncid
    logical, intent(out)                       :: lstat, symmetry
    type(etsf_io_low_error), intent(out)       :: error_data

    ! Local variables
    character(len = *), parameter :: me = "etsf_io_tools_get_time_reversal_symmetry"
    character(len = etsf_charlen) :: basis, att1, att2

    ! Read the basis set definition.
    call etsf_io_low_read_var(ncid, "basis_set", &
         & basis, etsf_charlen, lstat, error_data = error_data)
    if (.not. lstat) then
       call etsf_io_low_error_update(error_data, me)
       return
    end if
    call strip(basis)

    ! Check that basis set is indeed plane waves.
    if (trim(basis) /= "plane_waves") then
       call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ATT, me, &
            & tgtname = "basis_set", &
            & errmess = "time reversal is only associated to plane wave basis sets.")
       lstat = .false.
       return
    end if

    ! Read the two attributes for reduced_coordinates_of_plane_waves and
    ! coefficients_of_wavefunctions.
    call etsf_io_low_read_att(ncid, "reduced_coordinates_of_plane_waves", &
         & "use_time_reversal_at_gamma", etsf_charlen, att1, lstat, &
         & error_data = error_data)
    if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ .and. &
         & error_data%target_type_id /= ERROR_TYPE_ATT) then
       call etsf_io_low_error_update(error_data, me)
       return
    else
       if (.not.lstat) write(att1, "(A)") "no"
    end if
    call etsf_io_low_read_att(ncid, "coefficients_of_wavefunctions", &
         & "use_time_reversal_at_gamma", etsf_charlen, att2, lstat, &
         & error_data = error_data)
    if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ .and. &
         & error_data%target_type_id /= ERROR_TYPE_ATT) then
       call etsf_io_low_error_update(error_data, me)
       return
    else
       if (.not.lstat) write(att2, "(A)") "no"
    end if

    ! Check the consistency of the values.
    if (.not.(att1(1:1) == "n" .and. att2(1:1) == "n") .and. &
         & .not.(att1(1:2) == "y" .and. att2(1:1) == "y")) then
       call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ATT, me, &
            & tgtname = "use_time_reversal_at_gamma", &
            & errmess = "attributes use_time_reversal_at_gamma have wrong values.")
       lstat = .false.
       return
    end if

    ! Everything is OK, we return.
    symmetry = (att1(1:1) == "y")
    lstat =.true.
  end subroutine etsf_io_tools_get_time_reversal_symmetry

etsf_io_tools_set_time_reversal_symmetry

[ Top ] [ etsf_io_tools ] [ Methods ]

NAME

etsf_io_tools_set_time_reversal_symmetry

FUNCTION

In the specifications, an attribute can be set to describe if the basis set informations have been reduced using the time reversal symmetry at Gamma point in the case of plane wave basis sets. This routine set the given value and check that the basis set is plane waves.

The file will be put in define mode.

INPUTS

  • ncid = an opened NetCDF file with write access.
  • symmetry = the symmetry status.

OUTPUT

  • lstat = return .true. if all the actions succeed (especially checks).
  • error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.

SOURCE

  subroutine etsf_io_tools_set_time_reversal_symmetry(ncid, symmetry, &
       & lstat, error_data)
    integer, intent(intent)                        :: ncid
    logical, intent(intent)                        :: symmetry
    logical, intent(out)                       :: lstat
    type(etsf_io_low_error), intent(out)       :: error_data

    ! Local variables
    character(len = *), parameter :: me = "etsf_io_tools_set_time_reversal_symmetry"
    character(len = etsf_charlen) :: basis, att

    ! Read the basis set definition.
    call etsf_io_low_read_var(ncid, "basis_set", &
         & basis, etsf_charlen, lstat, error_data = error_data)
    if (.not. lstat) then
       call etsf_io_low_error_update(error_data, me)
       return
    end if
    call strip(basis)

    ! Check that basis set is indeed plane waves.
    if (trim(basis) /= "plane_waves") then
       call etsf_io_low_error_set(error_data, ERROR_MODE_SPEC, ERROR_TYPE_ATT, me, &
            & tgtname = "basis_set", &
            & errmess = "time reversal is only associated to plane wave basis sets.")
       lstat = .false.
       return
    end if

    ! We switch to define mode.
    call etsf_io_low_set_define_mode(ncid, lstat, error_data)
    if (.not. lstat) then
       call etsf_io_low_error_update(error_data, me)
       return
    end if

    ! Write the two attributes for reduced_coordinates_of_plane_waves and
    ! coefficients_of_wavefunctions.
    if (symmetry) then
       write(att, "(A)") "yes"
    else
       write(att, "(A)") "no"
    end if
    call etsf_io_low_write_att(ncid, "reduced_coordinates_of_plane_waves", &
         & "use_time_reversal_at_gamma", att, lstat, error_data)
    if (.not. lstat) then
       call etsf_io_low_error_update(error_data, me)
       return
    end if
    call etsf_io_low_write_att(ncid, "coefficients_of_wavefunctions", &
         & "use_time_reversal_at_gamma", att, lstat, error_data)
    if (.not. lstat) then
       call etsf_io_low_error_update(error_data, me)
       return
    end if

    ! Everything is OK, we return.
    lstat =.true.
  end subroutine etsf_io_tools_set_time_reversal_symmetry