Index: /XMLF90/LICENSE
===================================================================
--- /XMLF90/LICENSE (revision 6)
+++ /XMLF90/LICENSE (revision 6)
@@ -0,0 +1,35 @@
+Copyright (c) 2003, 2004, Alberto Garcia (SAX, XPATH, WXML, Overall design)
+(c) 2003, 2004, Jon Wakelin, Alberto Garcia (DOM subsystem)
+(c) 2003, 2004, Jon Wakelin (CML writing subsystem)
+STRINGS module contributed by Mart Reentmeester. (See strings/m_strings.f90)
+
+All rights reserved.
+
+* Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+* Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+
+* Redistributions in binary form must reproduce the above copyright
+notice, this list of conditions and the following disclaimer in the
+documentation and/or other materials provided with the distribution.
+
+* Neither the name of the copyright holder nor the names of its
+contributors may be used to endorse or promote products derived from
+this software without specific prior written permission.
+
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
Index: /XMLF90/arch/arch-IA64_PLATINE.fcm
===================================================================
--- /XMLF90/arch/arch-IA64_PLATINE.fcm (revision 6)
+++ /XMLF90/arch/arch-IA64_PLATINE.fcm (revision 6)
@@ -0,0 +1,15 @@
+%COMPILER mpif90
+%LINKER mpif90
+%AR ar
+%MAKE gmake
+%FPP_FLAGS -P -traditional
+%FPP_DEF NC_DOUBLE BLAS SGEMV=DGEMV SGEMM=DGEMM FFT_MKL
+%BASE_FFLAGS -i4 -r8 -automatic -align all -I/opt/mpi/current/include
+%PROD_FFLAGS -O3
+%DEV_FFLAGS -O3 -traceback
+%DEBUG_FFLAGS -g -traceback
+%MPI_FFLAGS
+%OMP_FFLAGS -openmp
+%BASE_LD -i4 -r8 -automatic
+%MPI_LD
+%OMP_LD -openmp
Index: /XMLF90/arch/arch-IA64_PLATINE.path
===================================================================
--- /XMLF90/arch/arch-IA64_PLATINE.path (revision 6)
+++ /XMLF90/arch/arch-IA64_PLATINE.path (revision 6)
@@ -0,0 +1,4 @@
+set NETCDF_LIBDIR='/usr/lib -lnetcdff'
+set NETCDF_INCDIR=/usr/include
+set IOIPSL_INCDIR=$WORKDIR/IOIPSL_MPP/src
+set IOIPSL_LIBDIR=$WORKDIR/IOIPSL_MPP/src
Index: /XMLF90/bld.cfg
===================================================================
--- /XMLF90/bld.cfg (revision 6)
+++ /XMLF90/bld.cfg (revision 6)
@@ -0,0 +1,42 @@
+# ----------------------- FCM extract configuration file -----------------------
+cfg::type bld
+cfg::version 1.0
+
+
+# ------------------------------------------------------------------------------
+# Build information
+# ------------------------------------------------------------------------------
+
+inc arch.fcm
+inc config.fcm
+
+dir::root $PWD
+
+search_src 1
+bld::lib xmlf90
+bld::target libxmlf90.a
+
+bld::tool::fc %COMPILER
+bld::tool::ld %LINKER
+bld::tool::ar %AR
+bld::tool::make %MAKE
+bld::tool::fflags %FFLAGS %INCDIR
+bld::tool::ldflags %BASE_LD %LIBDIR
+
+# Pre-process code before analysing dependencies
+bld::pp 1
+
+
+# Ignore the following dependencies
+#bld::excl_dep inc::netcdf.inc
+bld::excl_dep inc::VT.inc
+bld::excl_dep use::histcom
+bld::excl_dep use::ioipsl
+bld::excl_dep use::flib_dom
+bld::excl_dep inc::mpif.h
+bld::excl_dep use::mpi
+# Don't generate interface files
+bld::tool::geninterface none
+
+# Allow ".inc" as an extension for CPP include files
+bld::outfile_ext::mod .mod
Index: /XMLF90/configure
===================================================================
--- /XMLF90/configure (revision 6)
+++ /XMLF90/configure (revision 6)
@@ -0,0 +1,108 @@
+#!/bin/csh
+set verbose echo
+set has_arch_opt = FALSE
+set has_compile_opt = FALSE
+set default_compile_flags = "%PROD_FFLAGS"
+
+top:
+if ($#argv > 0) then
+ switch ($1)
+
+ case -h
+
+########################################################################
+# Manuel en ligne
+########################################################################
+more <> is missing, exiting...."
+ exit
+ endif
+
+ if ( -e arch/arch-${arch}.path ) then
+ rm -f arch.path
+ ln -s arch/arch-${arch}.path arch.path
+ else
+ echo "architecture file : << arch/arch-${arch}.path >> is missing, exiting...."
+ exit
+ endif
+else
+ echo "Warning : architecture not specified, taking default file <> and <>"
+ if ( ! -e arch.fcm ) then
+ echo "architecture file : << arch.fcm >> is missing, exiting...."
+ exit
+ endif
+
+ if ( ! -e arch.fcm ) then
+ echo "architecture file : << arch.path >> is missing, exiting...."
+ exit
+ endif
+endif
+
+# set compiler flags
+set FFLAGS="%BASE_FFLAGS"
+set LD_FFLAGS="%BASE_LD"
+set CPP_KEY="%FPP_DEF"
+
+# set compiler flags for optimisation
+if ( $has_compile_opt == FALSE ) then
+ set compile_flags=$default_compile_flags
+endif
+set FFLAGS=${FFLAGS}" "$compile_flags
+
+
+source ./arch.path
+
+# build config file
+set config_fcm="config.fcm"
+rm -f $config_fcm
+
+echo "%FFLAGS $FFLAGS" > $config_fcm
+echo "%CPP_KEY $CPP_KEY" >> $config_fcm
+echo "%LD_FFLAGS $LD_FFLAGS" >> $config_fcm
+echo "%INCDIR -I$NETCDF_INCDIR -I$IOIPSL_INCDIR" >> $config_fcm
+echo "%LIBDIR -L$NETCDF_LIBDIR -L$IOIPSL_LIBDIR" >> $config_fcm
Index: /XMLF90/doc/Examples/cml/example.f90
===================================================================
--- /XMLF90/doc/Examples/cml/example.f90 (revision 6)
+++ /XMLF90/doc/Examples/cml/example.f90 (revision 6)
@@ -0,0 +1,54 @@
+ program example
+
+ use flib_wxml
+ use flib_cml
+
+ integer, parameter :: sp = selected_real_kind(6,30)
+ integer, parameter :: dp = selected_real_kind(14,100)
+!
+! NB normally you will be writting to the xml file
+! from mulitple fortran files/subroutines, therefore
+! type(xmlf_t) :: myfile (below)
+! would normally need to be treated as a global
+! variable, either in a module or a common block.
+!
+ type(xmlf_t) :: myfile
+!
+
+ integer :: num, na
+ character(len=10) :: jon
+ character(len=2) :: elements(3)
+ real(kind=dp) :: coords(3,3)
+ real(kind=dp) :: adp
+
+ data coords(1:3,1)/0.0, 0.0, 0.0/
+ data coords(1:3,2)/0.5, 0.5, 0.5/
+ data coords(1:3,3)/0.4, 0.4, 0.4/
+
+ adp=1.234567890
+ na=3
+ elements(1) = 'Ca'
+ elements(2) = 'Si'
+ elements(3) = 'O'
+ num = 20
+ jon = ' jon'
+
+ call xml_OpenFile('output.xml', myfile, indent=.true.)
+
+ ! Start element
+ call xml_NewElement(myfile, 'foo')
+
+ ! Add molecule
+ call cmlAddMolecule(xf=myfile, natoms=na,elements=elements,coords=coords)
+
+ ! Add molecule output in short style
+ call cmlAddMolecule(xf=myfile, natoms=na,elements=elements,coords=coords, style='xyz3')
+
+ ! Add molecule output in short style in user supplied format
+ call cmlAddMolecule(xf=myfile, natoms=na,elements=elements,coords=coords, style='xyz3', fmt='(f12.6)')
+
+ ! End and Close
+ call xml_EndElement(myfile, 'foo')
+ call xml_Close(myfile)
+
+end program example
Index: /XMLF90/doc/Examples/cml/i.example.f90
===================================================================
--- /XMLF90/doc/Examples/cml/i.example.f90 (revision 6)
+++ /XMLF90/doc/Examples/cml/i.example.f90 (revision 6)
@@ -0,0 +1,54 @@
+ program example
+
+ use flib_wxml
+ use flib_cml
+
+ integer, parameter :: sp = selected_real_kind(6,30)
+ integer, parameter :: dp = selected_real_kind(14,100)
+!
+! NB normally you will be writting to the xml file
+! from mulitple fortran files/subroutines, therefore
+! type(xmlf_t) :: myfile (below)
+! would normally need to be treated as a global
+! variable, either in a module or a common block.
+!
+ type(xmlf_t) :: myfile
+!
+
+ integer :: num, na
+ character(len=10) :: jon
+ character(len=2) :: elements(3)
+ real(kind=dp) :: coords(3,3)
+ real(kind=dp) :: adp
+
+ data coords(1:3,1)/0.0, 0.0, 0.0/
+ data coords(1:3,2)/0.5, 0.5, 0.5/
+ data coords(1:3,3)/0.4, 0.4, 0.4/
+
+ adp=1.234567890
+ na=3
+ elements(1) = 'Ca'
+ elements(2) = 'Si'
+ elements(3) = 'O'
+ num = 20
+ jon = ' jon'
+
+ call xml_OpenFile('output.xml', myfile, indent=.true.)
+
+ ! Start element
+ call xml_NewElement(myfile, 'foo')
+
+ ! Add molecule
+ call cmlAddMolecule(xf=myfile, natoms=na,elements=elements,coords=coords)
+
+ ! Add molecule output in short style
+ call cmlAddMolecule(xf=myfile, natoms=na,elements=elements,coords=coords, style='xyz3')
+
+ ! Add molecule output in short style in user supplied format
+ call cmlAddMolecule(xf=myfile, natoms=na,elements=elements,coords=coords, style='xyz3', fmt='(f12.6)')
+
+ ! End and Close
+ call xml_EndElement(myfile, 'foo')
+ call xml_Close(myfile)
+
+end program example
Index: /XMLF90/doc/Examples/cml/makefile
===================================================================
--- /XMLF90/doc/Examples/cml/makefile (revision 6)
+++ /XMLF90/doc/Examples/cml/makefile (revision 6)
@@ -0,0 +1,33 @@
+#
+# Makefile for CML examples
+#
+default: all
+all: example
+#
+#---------------------------
+MK=$(FLIB_ROOT)/fortran.mk
+include $(MK)
+#---------------------------
+#
+# Uncomment the following line for debugging support
+#
+#FFLAGS=$(FFLAGS_DEBUG)
+#
+LIBS=$(LIB_PREFIX)$(LIB_STD) -lflib
+#
+example: example.o
+ $(FC) $(LDFLAGS) -o example example.o $(LIBS)
+#
+clean:
+ rm -f example *.o *.$(MOD_EXT)
+#
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/dom/Job_mercure
===================================================================
--- /XMLF90/doc/Examples/dom/Job_mercure (revision 6)
+++ /XMLF90/doc/Examples/dom/Job_mercure (revision 6)
@@ -0,0 +1,20 @@
+#PBS -N TEST # nom de la requete
+#PBS -j o # regroupement des stdout et stderr
+#PBS -S /usr/bin/ksh # shell de soumission
+#PBS -l memsz_job=1gb # Limite memoire a 1 Go
+#PBS -l cputim_job=0:01:00 # Limite temps
+set -xv
+uname
+ncdump --version
+cd /scratchdir/p86caub/XML_SX/xmlf90-1.2g/Examples/dom
+./text
+###cd /home/p86caub/IPSLIO/bin
+###./main.exe
+###export DISPLAY=mercure:38.0
+###totalview opa.xx core.26012
+###cd /scratchdir/p86caub/COUPHR3
+###mcs -p lmdz.x
+###mcs -p oasis
+###mcs -p opa.xx
+###cd /scratchdir/p86caub/TESTNEM2
+###mcs -p oasis1
Index: /XMLF90/doc/Examples/dom/README
===================================================================
--- /XMLF90/doc/Examples/dom/README (revision 6)
+++ /XMLF90/doc/Examples/dom/README (revision 6)
@@ -0,0 +1,16 @@
+DOM examples
+
+features.f90 : Illustrates the types of nodes created for
+ the different parsing events.
+
+data.f90 : Dynamics of the DOM tree: cloning, inserting,
+ destroying, and dumping to XML.
+
+text.f90 : Example of the "normalize" method.
+
+pseudo.f90 : Real-world example of parsing a pseudopotential file.
+
+pseudo_dom.f90 : A more sophisticated, more DOM-like version of
+ pseudo processing (incomplete picture -- more
+ routines need to be written).
+
Index: /XMLF90/doc/Examples/dom/TEST.o78655
===================================================================
--- /XMLF90/doc/Examples/dom/TEST.o78655 (revision 6)
+++ /XMLF90/doc/Examples/dom/TEST.o78655 (revision 6)
@@ -0,0 +1,540 @@
+uname
++ uname
+SUPER-UX
+ncdump --version
++ ncdump --version
+ncdump: ERROR: Illegal option -- -
+ncdump [-c|-h] [-v ...] [[-b|-f] [c|f]] [-l len] [-n name] [-p n[,n]] [-x] file
+ [-c] Coordinate variable data and header information
+ [-h] Header information only, no data
+ [-v var1[,...]] Data for variable(s) ,... only
+ [-b [c|f]] Brief annotations for C or Fortran indices in data
+ [-f [c|f]] Full annotations for C or Fortran indices in data
+ [-l len] Line length maximum in data section (default 80)
+ [-n name] Name for netCDF (default derived from file name)
+ [-p n[,n]] Display floating-point values with less precision
+ [-x] Output XML (NcML) instead of CDL
+ file Name of netCDF file
+netcdf library version 3.6.1 of Nov 29 2006 10:10:15 $
+
+ ****** Program Information ******
+ Real Time (sec) : 0.016739
+ User Time (sec) : 0.000127
+ Sys Time (sec) : 0.006031
+ Vector Time (sec) : 0.000000
+ Inst. Count : 14873
+ V. Inst. Count : 0
+ V. Element Count : 0
+ FLOP Count : 3
+ MOPS : 117.110236
+ MFLOPS : 0.023622
+ A.V. Length : 0.000000
+ V. Op. Ratio (%) : 0.000000
+ Memory Size (MB) : 48.000000
+ MIPS : 117.110236
+ I-Cache (sec) : 0.000065
+ O-Cache (sec) : 0.000045
+ Bank (sec) : 0.000000
+
+ Start Time (date) : 2007/05/24 14:26:40
+ End Time (date) : 2007/05/24 14:26:40
+cd /scratchdir/p86caub/XML_SX/xmlf90-1.2g/Examples/dom
++ cd /scratchdir/p86caub/XML_SX/xmlf90-1.2g/Examples/dom
+./text
++ ./text
+ allocated nodes: 541
+ number of para elements: 35
+ Dumping pure text under them...
+ | Permission is granted to copy, distribute and/or modify this document
+|
+ | under the terms of the GNU Free Documentation License, Version 1.1 or
+|
+ | any later version published by the Free Software Foundation; with no
+|
+ | |
+ |, |
+ | or
+|
+ | |
+ |, each as defined in the license. A copy of
+|
+ | the license can be found in the file |
+ | included with jEdit.
+|
+ | |
+ | The SideKick plugin itself is released under the GNU General Public License.
+|
+ | A copy of the GPL can be found in the jEdit online help.
+|
+ | |
+ | The SideKick plugin provides a dockable window in which other plugins can
+|
+ | display buffer structure.
+|
+ | |
+ | |
+ |>|
+ |>|
+ | displays the current buffer's structure in a
+|
+ | dockable window. This window is floating by
+|
+ | default, but it can be docked into the view in the |
+ | pane of the |
+ | dialog box.
+|
+ | |
+ | The SideKick plugin automatically parses buffers
+|
+ | when they are loaded or saved, where possible.
+|
+ | Optionally, buffers can also be parsed on the fly, but this uses a fair bit of
+|
+ | memory and processor power so it is disabled by default.
+|
+ | |
+ | |
+ |>|
+ |>|
+ | is a checkbox menu item that toggles on-the-fly
+|
+ | parsing, for the current buffer only.
+|
+ | |
+ | The current buffer can be parsed at any other time by clicking the parse
+|
+ | button in the |
+ | window, or by
+|
+ | invoking the
+|
+ | |
+ |>|
+ |>|
+ | command.
+|
+ | |
+ | Any errors found while parsing the buffer are sent to the
+|
+ | |
+ | plugin, which means they are highlighted
+|
+ | in the text area, and shown in the
+|
+ | |
+ |>|
+ |>|
+ | window. See the
+|
+ | documentation for the |
+ | plugin for details.
+|
+ | |
+ | Clicking on a node in the tree will move the caret to its location in the
+|
+ | buffer;
+|
+ | conversely, moving the caret in the buffer will select the corresponding
+|
+ | node.
+|
+ | |
+ | |
+ |-clicking on a node will select that node in the text
+|
+ | area. |
+ |-clicking on a node will narrow the text area
+|
+ | display to that node.
+|
+ | |
+ | If the structure browser window is docked into the current view, hovering the mouse
+|
+ | over a node will display its attributes in the status bar.
+|
+ | |
+ | |
+ |>|
+ |>|
+ | moves the caret to start of the structure
+|
+ | element (|
+ |).
+|
+ | |
+ | |
+ |>|
+ |>|
+ | moves the caret to start of the next asset.
+|
+ | |
+ | |
+ |>|
+ |>|
+ | selects the asset at the caret position.
+|
+ | |
+ | The SideKick plugin adds a new |
+ | fold handler that
+|
+ | folds the buffer according to the structure tree. See the jEdit user's guide
+|
+ | for general details about folding.
+|
+ | |
+ |>|
+ |>|
+ | hides all text except that of the asset at the
+|
+ | caret location. This works in any folding mode, not just the |
+ | mode.
+|
+ | |
+ | A completion popup can be shown at any time
+|
+ | by invoking the
+|
+ | |
+ |>|
+ |>|
+ | command. Each plugin that uses SideKick
+|
+ | implements its own specific completion behavior; see the plugin documentation
+|
+ | for details.
+|
+ | |
+ | By itself the SideKick plugin is not very useful; it relies on other plugins to
+|
+ | provide buffer structure information. This chapter gives a brief overview of
+|
+ | how it's done.
+|
+ | |
+ | First you will also need to add a dependency for the SideKick plugin in your plugin's
+|
+ | property file:
+|
+ | |
+ | Note that you must replace |
+ | with the
+|
+ | appropriate number, as dependency properties must have consecutive numbers.
+|
+ | |
+ | All SideKick plugin classes are in the |
+ | package;
+|
+ | you will need to add |
+ | statements where appropriate.
+|
+ | |
+ | Parser instances must be registered in your plugin's |
+ | method using the following method in the |
+ | class:
+|
+ | |
+ | A corresponding method must be called from your plugin's |
+ | method:
+|
+ | |
+ | |
+ | is an abstract class. The constructor
+|
+ | takes one string parameter. This string is used in several properties:
+|
+ | |
+ | - specifies a human-readable label for the parser, shown in status messages.
+|
+ | |
+ | - properties of this form are used to associate a parser with an edit mode.
+|
+ | |
+ | For example, the XML plugin, which provides two |
+ | implementations, defines these properties:
+|
+ | |
+ | The |
+ | has one abstract method that all
+|
+ | subclasses must implement:
+|
+ | |
+ | The latter parameter is an instance of a class provided by the
+|
+ | |
+ | plugin; consult its documentation for
+|
+ | details.
+|
+ | |
+ | The method is called from a thread, so care must be taken to access the
+|
+ | buffer in a thread-safe manner; the API documentation for the
+|
+ | |
+ | class describes how this is done.
+|
+ | |
+ | The constructor of the |
+ | class takes
+|
+ | one parameter, which is the file name (to be shown at the root of the structure
+|
+ | tree).
+|
+ | |
+ | Your implementation of the |
+ | method should add
+|
+ | structure elements to the |
+ | field of the
+|
+ | |
+ | instance. This field is an
+|
+ | instance of Java's |
+ | class,
+|
+ | and is given a value by the |
+ | constructor.
+|
+ | |
+ | This part has not been written yet. Use the source, Luke!
+|
+ | |
+ | requires
+|
+ | jEdit 4.1pre11.|
+ |Initial release.
+|
+ | |
+ Normalizing...
+ ====================================================
+ allocated nodes: 434
+ number of para elements: 35
+ Dumping pure text under them...
+ | Permission is granted to copy, distribute and/or modify this document
+ under the terms of the GNU Free Documentation License, V
+ ersion 1.1 or
+ any later version published by the Free Software Foundation; with no
+ |
+ |, |
+ | or
+ |
+ |, each as defined in the license. A copy of
+ the license can be found in the file |
+ | included with jEdit.
+ |
+ | The SideKick plugin itself is released under the GNU General Public License.
+ A copy of the GPL can be found in the jEdit onlin
+ e help.
+ |
+ | The SideKick plugin provides a dockable window in which other plugins can
+ display buffer structure.
+ |
+ | |
+ |>|
+ |>|
+ | displays the current buffer's structure in a
+ dockable window. This window is floating by
+ default, but it can be docked into the
+ view in the |
+ | pane of the |
+ | dialog box.
+ |
+ | The SideKick plugin automatically parses buffers
+ when they are loaded or saved, where possible.
+ Optionally, buffers can also b
+ e parsed on the fly, but this uses a fair bit of
+ memory and processor power so it is disabled by default.
+ |
+ | |
+ |>|
+ |>|
+ | is a checkbox menu item that toggles on-the-fly
+ parsing, for the current buffer only.
+ |
+ | The current buffer can be parsed at any other time by clicking the parse
+ button in the |
+ | window, or by
+ invoking the
+ |
+ |>|
+ |>|
+ | command.
+ |
+ | Any errors found while parsing the buffer are sent to the
+ |
+ | plugin, which means they are highlighted
+ in the text area, and shown in the
+ |
+ |>|
+ |>|
+ | window. See the
+ documentation for the |
+ | plugin for details.
+ |
+ | Clicking on a node in the tree will move the caret to its location in the
+ buffer;
+ conversely, moving the caret in the buffer w
+ ill select the corresponding
+ node.
+ |
+ | |
+ |-clicking on a node will select that node in the text
+ area. |
+ |-clicking on a node will narrow the text area
+ display to that node.
+ |
+ | If the structure browser window is docked into the current view, hovering the mouse
+ over a node will display its attributes in t
+ he status bar.
+ |
+ | |
+ |>|
+ |>|
+ | moves the caret to start of the structure
+ element (|
+ |).
+ |
+ | |
+ |>|
+ |>|
+ | moves the caret to start of the next asset.
+ |
+ | |
+ |>|
+ |>|
+ | selects the asset at the caret position.
+ |
+ | The SideKick plugin adds a new |
+ | fold handler that
+ folds the buffer according to the structure tree. See the jEdit user's guide
+ for general details about foldin
+ g.
+|
+ | |
+ |>|
+ |>|
+ | hides all text except that of the asset at the
+ caret location. This works in any folding mode, not just the |
+ | mode.
+ |
+ | A completion popup can be shown at any time
+ by invoking the
+ |
+ |>|
+ |>|
+ | command. Each plugin that uses SideKick
+ implements its own specific completion behavior; see the plugin documentation
+ for detai
+ ls.
+ |
+ | By itself the SideKick plugin is not very useful; it relies on other plugins to
+ provide buffer structure information. This chapt
+ er gives a brief overview of
+ how it's done.
+ |
+ | First you will also need to add a dependency for the SideKick plugin in your plugin's
+ property file:
+ |
+ | Note that you must replace |
+ | with the
+ appropriate number, as dependency properties must have consecutive numbers.
+ |
+ | All SideKick plugin classes are in the |
+ | package;
+ you will need to add |
+ | statements where appropriate.
+ |
+ | Parser instances must be registered in your plugin's |
+ | method using the following method in the |
+ | class:
+ |
+ | A corresponding method must be called from your plugin's |
+ | method:
+ |
+ | |
+ | is an abstract class. The constructor
+ takes one string parameter. This string is used in several properties:
+ |
+ | - specifies a human-readable label for the parser, shown in status messages.
+ |
+ | - properties of this form are used to associate a parser with an edit mode.
+ |
+ | For example, the XML plugin, which provides two |
+ | implementations, defines these properties:
+ |
+ | The |
+ | has one abstract method that all
+ subclasses must implement:
+ |
+ | The latter parameter is an instance of a class provided by the
+ |
+ | plugin; consult its documentation for
+ details.
+ |
+ | The method is called from a thread, so care must be taken to access the
+ buffer in a thread-safe manner; the API documentation fo
+ r the
+ |
+ | class describes how this is done.
+ |
+ | The constructor of the |
+ | class takes
+ one parameter, which is the file name (to be shown at the root of the structure
+ tree).
+ |
+ | Your implementation of the |
+ | method should add
+ structure elements to the |
+ | field of the
+ |
+ | instance. This field is an
+ instance of Java's |
+ | class,
+ and is given a value by the |
+ | constructor.
+ |
+ | This part has not been written yet. Use the source, Luke!
+ |
+ | requires
+ jEdit 4.1pre11.|
+ |Initial release.
+ |
+
+
+ ****** Program Information ******
+ Real Time (sec) : 0.153547
+ User Time (sec) : 0.083368
+ Sys Time (sec) : 0.019501
+ Vector Time (sec) : 0.006893
+ Inst. Count : 19957676.
+ V. Inst. Count : 101299.
+ V. Element Count : 1611884.
+ FLOP Count : 22607.
+ MOPS : 257.510558
+ MFLOPS : 0.271170
+ VLEN : 15.912141
+ V. Op. Ratio (%) : 7.508219
+ Memory Size (MB) : 48.031250
+ MIPS : 239.391178
+ I-Cache (sec) : 0.021848
+ O-Cache (sec) : 0.010598
+ Bank (sec) : 0.000003
+
+ Start Time (date) : 2007/05/24 14:26:40
+ End Time (date) : 2007/05/24 14:26:41
+###cd /home/p86caub/IPSLIO/bin
+###./main.exe
+###export DISPLAY=mercure:38.0
+###totalview opa.xx core.26012
+###cd /scratchdir/p86caub/COUPHR3
+###mcs -p lmdz.x
+###mcs -p oasis
+###mcs -p opa.xx
+###cd /scratchdir/p86caub/TESTNEM2
+###mcs -p oasis1
++ cd /
++ rm -rf /tmpdir/nqs.78655.bt3540 /tmp/nqs.78655.Cd3541
Index: /XMLF90/doc/Examples/dom/big-file.xml
===================================================================
--- /XMLF90/doc/Examples/dom/big-file.xml (revision 6)
+++ /XMLF90/doc/Examples/dom/big-file.xml (revision 6)
@@ -0,0 +1,313 @@
+
+
+
+
+
+
+
+
+
+
+
+
+SideKick plugin user's guide
+
+
+ SlavaPestov
+
+
+ Legal Notice
+
+ Permission is granted to copy, distribute and/or modify this document
+ under the terms of the GNU Free Documentation License, Version 1.1 or
+ any later version published by the Free Software Foundation; with no
+ Invariant Sections
, Front-Cover Texts
or
+ Back-Cover Texts
, each as defined in the license. A copy of
+ the license can be found in the file COPYING.DOC.txt
+ included with jEdit.
+
+
+ The SideKick plugin itself is released under the GNU General Public License.
+ A copy of the GPL can be found in the jEdit online help.
+
+
+
+
+The structure browser window
+
+
+ The SideKick plugin provides a dockable window in which other plugins can
+ display buffer structure.
+
+
+
+ Plugins>SideKick>Structure
+ Browser displays the current buffer's structure in a
+ dockable window. This window is floating by
+ default, but it can be docked into the view in the Docking
+ pane of the Global Options dialog box.
+
+
+
+ The SideKick plugin automatically parses buffers
+ when they are loaded or saved, where possible.
+ Optionally, buffers can also be parsed on the fly, but this uses a fair bit of
+ memory and processor power so it is disabled by default.
+
+
+
+ Plugins>SideKick>Parse
+ on Keystroke is a checkbox menu item that toggles on-the-fly
+ parsing, for the current buffer only.
+
+
+
+ The current buffer can be parsed at any other time by clicking the parse
+ button in the Structure Browser window, or by
+ invoking the
+ Plugins>SideKick>Parse
+ Buffer command.
+
+
+
+ Any errors found while parsing the buffer are sent to the
+ ErrorList plugin, which means they are highlighted
+ in the text area, and shown in the
+ Plugins>Error
+ List>Error List window. See the
+ documentation for the ErrorList plugin for details.
+
+
+
+ Clicking on a node in the tree will move the caret to its location in the
+ buffer;
+ conversely, moving the caret in the buffer will select the corresponding
+ node.
+
+
+
+ Shift-clicking on a node will select that node in the text
+ area. Alt-clicking on a node will narrow the text area
+ display to that node.
+
+
+
+ If the structure browser window is docked into the current view, hovering the mouse
+ over a node will display its attributes in the status bar.
+
+
+
+
+Moving around
+
+
+ Plugins>SideKick>Go
+ to Previous Asset moves the caret to start of the structure
+ element (asset
).
+
+
+
+ Plugins>SideKick>Go
+ to Next Asset moves the caret to start of the next asset.
+
+
+
+ Plugins>SideKick>Select
+ Asset at Caret selects the asset at the caret position.
+
+
+
+
+Folding
+
+
+ The SideKick plugin adds a new sidekick
fold handler that
+ folds the buffer according to the structure tree. See the jEdit user's guide
+ for general details about folding.
+
+
+
+ Plugins>SideKick>Narrow to
+ Asset at Caret hides all text except that of the asset at the
+ caret location. This works in any folding mode, not just the sidekick
+ mode.
+
+
+
+Completion
+
+
+ A completion popup can be shown at any time
+ by invoking the
+ Plugins>SideKick>Show
+ Completion Popup command. Each plugin that uses SideKick
+ implements its own specific completion behavior; see the plugin documentation
+ for details.
+
+
+
+
+Developing SideKick back-ends
+
+
+ By itself the SideKick plugin is not very useful; it relies on other plugins to
+ provide buffer structure information. This chapter gives a brief overview of
+ how it's done.
+
+
+ Preliminaries
+
+
+ First you will also need to add a dependency for the SideKick plugin in your plugin's
+ property file:
+
+
+ plugin.MyPlugin.depend.n=plugin sidekick.SideKickPlugin 0.1
+
+
+ Note that you must replace n with the
+ appropriate number, as dependency properties must have consecutive numbers.
+
+
+
+ All SideKick plugin classes are in the sidekick package;
+ you will need to add import statements where appropriate.
+
+
+
+ Parser instances must be registered in your plugin's start()
+ method using the following method in the SideKickPlugin
+ class:
+
+
+
+
+ public void registerParser
+ SideKickParser parser
+
+
+
+
+ A corresponding method must be called from your plugin's stop()
+ method:
+
+
+
+
+ public void unregisterParser
+ SideKickParser parser
+
+
+
+
+
+ The SideKickParser class
+
+
+ SideKickParser is an abstract class. The constructor
+ takes one string parameter. This string is used in several properties:
+
+
+
+ sidekick.parser.name.label
+ - specifies a human-readable label for the parser, shown in status messages.
+
+ mode.mode.sidekick.parser
+ - properties of this form are used to associate a parser with an edit mode.
+
+
+
+
+ For example, the XML plugin, which provides two SideKickParser
+ implementations, defines these properties:
+
+
+ sidekick.parser.xml.label=XML
+mode.xml.sidekick.parser=xml
+mode.xsl.sidekick.parser=xml
+sidekick.parser.html.label=HTML
+mode.asp.sidekick.parser=html
+mode.coldfusion.sidekick.parser=html
+mode.html.sidekick.parser=html
+mode.jhtml.sidekick.parser=html
+mode.jsp.sidekick.parser=html
+mode.php.sidekick.parser=html
+mode.shtml.sidekick.parser=html
+mode.sgml.sidekick.parser=html
+mode.velocity.sidekick.parser=html
+
+
+
+Implementing a structure tree
+
+
+ The SideKickParser has one abstract method that all
+ subclasses must implement:
+
+
+
+
+ public SideKickParsedData parse
+ Buffer buffer
+ DefaultErrorSource errorSource
+
+
+
+
+ The latter parameter is an instance of a class provided by the
+ ErrorList plugin; consult its documentation for
+ details.
+
+
+
+ The method is called from a thread, so care must be taken to access the
+ buffer in a thread-safe manner; the API documentation for the
+ Buffer class describes how this is done.
+
+
+
+ The constructor of the SideKickParsedData class takes
+ one parameter, which is the file name (to be shown at the root of the structure
+ tree).
+
+
+
+ Your implementation of the parse() method should add
+ structure elements to the root field of the
+ SideKickParsedData instance. This field is an
+ instance of Java's DefaultMutableTreeNode class,
+ and is given a value by the SideKickParsedData constructor.
+
+
+
+
+ Implementing completion popups
+
+
+ This part has not been written yet. Use the source, Luke!
+
+
+
+
+
+
+Change log
+
+
+
+ Version 0.1 requires
+ jEdit 4.1pre11.
+
+
+ Initial release.
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/dom/data.f90
===================================================================
--- /XMLF90/doc/Examples/dom/data.f90 (revision 6)
+++ /XMLF90/doc/Examples/dom/data.f90 (revision 6)
@@ -0,0 +1,44 @@
+program example
+
+ use flib_dom
+
+ type(fnode), pointer :: myDoc
+ type(fnode), pointer :: myNode, temp, refNode
+ type(fnodeList), pointer :: myList
+
+ myDoc => parsefile("pseudo.xml",verbose=.true.)
+ call dumpTree(myDoc)
+ call xmlize(myDoc,"out.xml")
+
+! Get some nodes
+ myList => getChildNodes(myDoc)
+ print *, "Number of children of doc: ", getLength(myList)
+
+ myNode => item(myList, 0)
+ myList => getChildNodes(myNode)
+ print *, "Number of children of first child of doc: ", getLength(myList)
+
+ myNode => item(myList, 2)
+ refNode => getNextSibling(myNode)
+ call xmlize(refNode,"ref.xml")
+
+!
+! Note: a single element dumped
+!
+ call xmlize(myNode,"node.xml")
+ temp => cloneNode(myNode,deep=.true.)
+ call xmlize(temp,"clone.xml")
+
+ call destroyNode(myNode)
+ call xmlize(myDoc,"nosemilocal.xml")
+ myNode => insertBefore(getParentNode(refNode),temp,refNode)
+ call xmlize(myDoc,"all.xml")
+
+ myList => getElementsByTagName(myDoc,"data")
+ print *, "Number of data nodes: ", getLength(myList)
+
+ call destroyNode(myDoc)
+
+ print *, "Number of active nodes at the end: ", getNumberofAllocatedNodes()
+
+end program example
Index: /XMLF90/doc/Examples/dom/dumptext.xml
===================================================================
--- /XMLF90/doc/Examples/dom/dumptext.xml (revision 6)
+++ /XMLF90/doc/Examples/dom/dumptext.xml (revision 6)
@@ -0,0 +1,427 @@
+
+
+
+
+
+
+
+SideKick plugin user's guide
+
+
+
+Slava
+
+Pestov
+
+
+
+
+Legal Notice
+
+ Permission is granted to copy, distribute and/or modify this document
+ under the terms of the GNU Free Documentation License, Version 1.1 or
+ any later version published by the Free Software Foundation; with no
+
+Invariant Sections
+
,
+Front-Cover Texts
+
or
+
+Back-Cover Texts
+
, each as defined in the license. A copy of
+ the license can be found in the file
+COPYING.DOC.txt
+ included with jEdit.
+
+
+ The SideKick plugin itself is released under the GNU General Public License.
+ A copy of the GPL can be found in the jEdit online help.
+
+
+
+
+
+The structure browser window
+
+ The SideKick plugin provides a dockable window in which other plugins can
+ display buffer structure.
+
+
+
+Plugins
+>
+SideKick
+>
+Structure
+ Browser
+ displays the current buffer's structure in a
+ dockable window. This window is floating by
+ default, but it can be docked into the view in the
+Docking
+ pane of the
+Global Options
+ dialog box.
+
+
+ The SideKick plugin automatically parses buffers
+ when they are loaded or saved, where possible.
+ Optionally, buffers can also be parsed on the fly, but this uses a fair bit of
+ memory and processor power so it is disabled by default.
+
+
+
+Plugins
+>
+SideKick
+>
+Parse
+ on Keystroke
+ is a checkbox menu item that toggles on-the-fly
+ parsing, for the current buffer only.
+
+
+ The current buffer can be parsed at any other time by clicking the parse
+ button in the
+Structure Browser
+ window, or by
+ invoking the
+
+Plugins
+>
+SideKick
+>
+Parse
+ Buffer
+ command.
+
+
+ Any errors found while parsing the buffer are sent to the
+
+ErrorList
+ plugin, which means they are highlighted
+ in the text area, and shown in the
+
+Plugins
+>
+Error
+ List
+>
+Error List
+ window. See the
+ documentation for the
+ErrorList
+ plugin for details.
+
+
+ Clicking on a node in the tree will move the caret to its location in the
+ buffer;
+ conversely, moving the caret in the buffer will select the corresponding
+ node.
+
+
+
+Shift
+-clicking on a node will select that node in the text
+ area.
+Alt
+-clicking on a node will narrow the text area
+ display to that node.
+
+
+ If the structure browser window is docked into the current view, hovering the mouse
+ over a node will display its attributes in the status bar.
+
+
+
+
+Moving around
+
+
+Plugins
+>
+SideKick
+>
+Go
+ to Previous Asset
+ moves the caret to start of the structure
+ element (
+asset
+
).
+
+
+
+Plugins
+>
+SideKick
+>
+Go
+ to Next Asset
+ moves the caret to start of the next asset.
+
+
+
+Plugins
+>
+SideKick
+>
+Select
+ Asset at Caret
+ selects the asset at the caret position.
+
+
+
+
+Folding
+
+ The SideKick plugin adds a new
+sidekick
+
fold handler that
+ folds the buffer according to the structure tree. See the jEdit user's guide
+ for general details about folding.
+
+
+
+Plugins
+>
+SideKick
+>
+Narrow to
+ Asset at Caret
+ hides all text except that of the asset at the
+ caret location. This works in any folding mode, not just the
+sidekick
+
mode.
+
+
+
+
+Completion
+
+ A completion popup can be shown at any time
+ by invoking the
+
+Plugins
+>
+SideKick
+>
+Show
+ Completion Popup
+ command. Each plugin that uses SideKick
+ implements its own specific completion behavior; see the plugin documentation
+ for details.
+
+
+
+
+Developing SideKick back-ends
+
+ By itself the SideKick plugin is not very useful; it relies on other plugins to
+ provide buffer structure information. This chapter gives a brief overview of
+ how it's done.
+
+
+
+Preliminaries
+
+ First you will also need to add a dependency for the SideKick plugin in your plugin's
+ property file:
+
+
+plugin.MyPlugin.depend.
+n
+=plugin sidekick.SideKickPlugin 0.1
+
+ Note that you must replace
+n
+ with the
+ appropriate number, as dependency properties must have consecutive numbers.
+
+
+ All SideKick plugin classes are in the
+sidekick
+ package;
+ you will need to add
+import
+ statements where appropriate.
+
+
+ Parser instances must be registered in your plugin's
+start()
+ method using the following method in the
+SideKickPlugin
+ class:
+
+
+
+
+public void
+registerParser
+
+
+SideKickParser
+parser
+
+
+
+
+ A corresponding method must be called from your plugin's
+stop()
+ method:
+
+
+
+
+public void
+unregisterParser
+
+
+SideKickParser
+parser
+
+
+
+
+
+
+The SideKickParser class
+
+
+SideKickParser
+ is an abstract class. The constructor
+ takes one string parameter. This string is used in several properties:
+
+
+
+
+
+sidekick.parser.
+name
+.label
+ - specifies a human-readable label for the parser, shown in status messages.
+
+
+
+
+
+mode.
+mode
+.sidekick.parser
+ - properties of this form are used to associate a parser with an edit mode.
+
+
+
+
+ For example, the XML plugin, which provides two
+SideKickParser
+ implementations, defines these properties:
+
+
+sidekick.parser.xml.label=XML
+mode.xml.sidekick.parser=xml
+mode.xsl.sidekick.parser=xml
+sidekick.parser.html.label=HTML
+mode.asp.sidekick.parser=html
+mode.coldfusion.sidekick.parser=html
+mode.html.sidekick.parser=html
+mode.jhtml.sidekick.parser=html
+mode.jsp.sidekick.parser=html
+mode.php.sidekick.parser=html
+mode.shtml.sidekick.parser=html
+mode.sgml.sidekick.parser=html
+mode.velocity.sidekick.parser=html
+
+
+
+Implementing a structure tree
+
+ The
+SideKickParser
+ has one abstract method that all
+ subclasses must implement:
+
+
+
+
+public SideKickParsedData
+parse
+
+
+Buffer
+buffer
+
+
+DefaultErrorSource
+errorSource
+
+
+
+
+ The latter parameter is an instance of a class provided by the
+
+ErrorList
+ plugin; consult its documentation for
+ details.
+
+
+ The method is called from a thread, so care must be taken to access the
+ buffer in a thread-safe manner; the API documentation for the
+
+Buffer
+ class describes how this is done.
+
+
+ The constructor of the
+SideKickParsedData
+ class takes
+ one parameter, which is the file name (to be shown at the root of the structure
+ tree).
+
+
+ Your implementation of the
+parse()
+ method should add
+ structure elements to the
+root
+ field of the
+
+SideKickParsedData
+ instance. This field is an
+ instance of Java's
+DefaultMutableTreeNode
+ class,
+ and is given a value by the
+SideKickParsedData
+ constructor.
+
+
+
+
+Implementing completion popups
+
+
+ This part has not been written yet. Use the source, Luke!
+
+
+
+
+
+Change log
+
+
+
+
+Version 0.1
+ requires
+ jEdit 4.1pre11.
+
+
+
+Initial release.
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/dom/features.f90
===================================================================
--- /XMLF90/doc/Examples/dom/features.f90 (revision 6)
+++ /XMLF90/doc/Examples/dom/features.f90 (revision 6)
@@ -0,0 +1,14 @@
+program features
+
+ use flib_dom
+
+ implicit none
+
+ type(fnode), pointer :: myDoc
+
+ myDoc => parsefile("test.xml" ) !! , verbose=.true.)
+ print *, getNumberofAllocatedNodes()
+ call dumpTree(myDoc)
+ call xmlize(myDoc,"features.xml")
+ call destroyNode(myDoc)
+end program features
Index: /XMLF90/doc/Examples/dom/i.data.f90
===================================================================
--- /XMLF90/doc/Examples/dom/i.data.f90 (revision 6)
+++ /XMLF90/doc/Examples/dom/i.data.f90 (revision 6)
@@ -0,0 +1,44 @@
+program example
+
+ use flib_dom
+
+ type(fnode), pointer :: myDoc
+ type(fnode), pointer :: myNode, temp, refNode
+ type(fnodeList), pointer :: myList
+
+ myDoc => parsefile("pseudo.xml",verbose=.true.)
+ call dumpTree(myDoc)
+ call xmlize(myDoc,"out.xml")
+
+! Get some nodes
+ myList => getChildNodes(myDoc)
+ print *, "Number of children of doc: ", getLength(myList)
+
+ myNode => item(myList, 0)
+ myList => getChildNodes(myNode)
+ print *, "Number of children of first child of doc: ", getLength(myList)
+
+ myNode => item(myList, 2)
+ refNode => getNextSibling(myNode)
+ call xmlize(refNode,"ref.xml")
+
+!
+! Note: a single element dumped
+!
+ call xmlize(myNode,"node.xml")
+ temp => cloneNode(myNode,deep=.true.)
+ call xmlize(temp,"clone.xml")
+
+ call destroyNode(myNode)
+ call xmlize(myDoc,"nosemilocal.xml")
+ myNode => insertBefore(getParentNode(refNode),temp,refNode)
+ call xmlize(myDoc,"all.xml")
+
+ myList => getElementsByTagName(myDoc,"data")
+ print *, "Number of data nodes: ", getLength(myList)
+
+ call destroyNode(myDoc)
+
+ print *, "Number of active nodes at the end: ", getNumberofAllocatedNodes()
+
+end program example
Index: /XMLF90/doc/Examples/dom/i.features.f90
===================================================================
--- /XMLF90/doc/Examples/dom/i.features.f90 (revision 6)
+++ /XMLF90/doc/Examples/dom/i.features.f90 (revision 6)
@@ -0,0 +1,14 @@
+program features
+
+ use flib_dom
+
+ implicit none
+
+ type(fnode), pointer :: myDoc
+
+ myDoc => parsefile("test.xml" ) !! , verbose=.true.)
+ print *, getNumberofAllocatedNodes()
+ call dumpTree(myDoc)
+ call xmlize(myDoc,"features.xml")
+ call destroyNode(myDoc)
+end program features
Index: /XMLF90/doc/Examples/dom/i.m_psdom.f90
===================================================================
--- /XMLF90/doc/Examples/dom/i.m_psdom.f90 (revision 6)
+++ /XMLF90/doc/Examples/dom/i.m_psdom.f90 (revision 6)
@@ -0,0 +1,135 @@
+module m_psdom
+
+use m_pseudo_types
+use flib_dom
+
+private
+
+public :: getVps
+public :: getRadialFunction
+public :: getGrid
+
+CONTAINS
+
+subroutine getVps(np,global_grid,pp)
+type(fnode), pointer :: np
+type(vps_t), intent(inout) :: pp
+type(grid_t), intent(in) :: global_grid
+
+character(len=200) :: value
+
+ value = getAttribute(np,"l")
+ if (value == "" ) call die("Cannot determine l for Vps")
+ read(unit=value,fmt=*) pp%l
+
+ value = getAttribute(np,"principal-n")
+ if (value == "" ) call die("Cannot determine n for Vps")
+ read(unit=value,fmt=*) pp%n
+
+ value = getAttribute(np,"cutoff")
+ if (value == "" ) call die("Cannot determine cutoff for Vps")
+ read(unit=value,fmt=*) pp%cutoff
+
+ value = getAttribute(np,"occupation")
+ if (value == "" ) call die("Cannot determine occupation for Vps")
+ read(unit=value,fmt=*) pp%occupation
+
+ value = getAttribute(np,"spin")
+ if (value == "" ) call die("Cannot determine spin for Vps")
+ read(unit=value,fmt=*) pp%spin
+
+ call getRadialFunction(np,global_grid,pp%V)
+
+end subroutine getVps
+
+!-----------------------------------------------------------------------
+subroutine getRadialFunction(element,global_grid,rp)
+use m_converters, only: build_data_array
+!
+! Example of routine which packages parsing functionality for a
+! common element. The element can appear under ,
+! , and elements.
+! In all cases the parsing steps are exactly the same.
+! This routine accepts a pointer to the parent element and returns
+! the data structure.
+!
+type(fnode), pointer :: element
+type(grid_t), intent(in) :: global_grid
+type(radfunc_t), intent(out) :: rp
+
+type(fnode), pointer :: np, radfuncp
+type(fnodeList), pointer :: lp
+integer :: ndata
+type(string) :: pcdata, s
+
+ s = getNodeName(element)
+ print *, "Getting radfunc data from element ", char(s)
+ lp => getElementsByTagName(element, "radfunc")
+ radfuncp => item(lp,0)
+ lp => getElementsByTagName(radfuncp, "grid")
+ np => item(lp,0)
+ if (associated(np)) then
+ print *, " >> local grid found"
+ call getGrid(np,rp%grid)
+ else
+ print *, " >> re-using global grid"
+ rp%grid = global_grid
+ endif
+
+ lp => getElementsByTagName(radfuncp, "data")
+ np => item(lp,0)
+ if (associated(np)) then
+ if (rp%grid%npts == 0) call die("Need grid information!")
+ allocate(rp%data(rp%grid%npts))
+ ndata = 0 ! To start the build up
+ np => getFirstChild(np)
+ do
+ if (.not. associated(np)) exit
+ if (getNodeType(np) /= TEXT_NODE) exit
+ pcdata = getNodeValue(np) ! text node
+ call build_data_array(char(pcdata),rp%data,ndata)
+ np => getNextSibling(np)
+ enddo
+ if (ndata /= size(rp%data)) STOP "npts mismatch"
+ else
+ call die("Cannot find data element")
+ endif
+end subroutine getRadialFunction
+
+!-----------------------------------------------------------------------
+subroutine getGrid(element,grid)
+type(fnode), pointer :: element
+type(grid_t), intent(out) :: grid
+
+character(len=200) :: value
+
+ grid%type = getAttribute(element,"type")
+ if (grid%type == "" ) call die("Cannot determine grid type")
+
+ value = getAttribute(element,"npts")
+ if (value == "" ) call die("Cannot determine grid npts")
+ read(unit=value,fmt=*) grid%npts
+
+ value = getAttribute(element,"scale")
+ if (value == "" ) call die("Cannot determine grid scale")
+ read(unit=value,fmt=*) grid%scale
+
+ value = getAttribute(element,"step")
+ if (value == "" ) call die("Cannot determine grid step")
+ read(unit=value,fmt=*) grid%step
+
+end subroutine getGrid
+
+!-----------------------------------------------------------------------
+ subroutine die(str)
+ character(len=*), intent(in), optional :: str
+ if (present(str)) then
+ write(unit=0,fmt="(a)") trim(str)
+ endif
+ write(unit=0,fmt="(a)") "Stopping Program"
+ stop
+ end subroutine die
+
+
+end module m_psdom
+
Index: /XMLF90/doc/Examples/dom/i.m_pseudo_types.f90
===================================================================
--- /XMLF90/doc/Examples/dom/i.m_pseudo_types.f90 (revision 6)
+++ /XMLF90/doc/Examples/dom/i.m_pseudo_types.f90 (revision 6)
@@ -0,0 +1,107 @@
+module m_pseudo_types
+!
+! Data structures for a prototype pseudopotential
+!
+integer, parameter, private :: MAXN_POTS = 8
+integer, parameter, private :: dp = selected_real_kind(14)
+!
+public :: dump_pseudo
+!
+!-----------------------------------------------------------
+type, public :: grid_t
+!
+! It should be possible to represent both log and linear
+! grids with a few parameters here.
+!
+ character(len=20) :: type
+ real(kind=dp) :: scale
+ real(kind=dp) :: step
+ integer :: npts
+end type grid_t
+!
+type, public :: radfunc_t
+ type(grid_t) :: grid
+ real(kind=dp), dimension(:), pointer :: data
+end type radfunc_t
+
+type, public :: vps_t
+ integer :: l
+ integer :: n
+ integer :: spin
+ real(kind=dp) :: occupation
+ real(kind=dp) :: cutoff
+ type(radfunc_t) :: V
+end type vps_t
+
+type, public :: header_t
+ character(len=2) :: symbol
+ real(kind=dp) :: zval
+ character(len=10) :: creator
+ character(len=10) :: date
+ character(len=40) :: flavor
+ logical :: relativistic
+ logical :: polarized
+ character(len=2) :: correlation
+ character(len=4) :: core_corrections
+end type header_t
+
+type, public :: pseudo_t
+ type(header_t) :: header
+ integer :: npots
+ integer :: npots_down
+ integer :: npots_up
+ type(vps_t), dimension(MAXN_POTS) :: pot
+ type(radfunc_t) :: core_charge
+ type(radfunc_t) :: valence_charge
+end type pseudo_t
+
+
+CONTAINS !===============================================
+
+subroutine dump_pseudo(pseudo)
+type(pseudo_t), intent(in), target :: pseudo
+
+integer :: i
+type(vps_t), pointer :: pp
+type(radfunc_t), pointer :: rp
+
+print *, "---PSEUDO data:"
+
+do i = 1, pseudo%npots
+ pp => pseudo%pot(i)
+ rp => pseudo%pot(i)%V
+ print *, "VPS ", i, " angular momentum: ", pp%l
+ print *, " n: ", pp%n
+ print *, " occupation: ", pp%occupation
+ print *, " cutoff: ", pp%cutoff
+ print *, " spin: ", pp%spin
+ print *, "grid data: ", rp%grid%npts, rp%grid%scale
+enddo
+rp => pseudo%valence_charge
+print *, "valence grid data: ", rp%grid%npts, rp%grid%scale
+rp => pseudo%core_charge
+if (associated(rp)) print *, "core grid data: ", rp%grid%npts, rp%grid%scale
+
+end subroutine dump_pseudo
+
+end module m_pseudo_types
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/dom/i.pseudo.f90
===================================================================
--- /XMLF90/doc/Examples/dom/i.pseudo.f90 (revision 6)
+++ /XMLF90/doc/Examples/dom/i.pseudo.f90 (revision 6)
@@ -0,0 +1,283 @@
+program pseudoread
+
+use m_pseudo_types
+
+! Module
+ use flib_dom
+
+type(pseudo_t), target :: pseudo
+type(grid_t) :: global_grid
+!
+type(string) :: s ! to avoid memory leaks
+
+! Pointers to make it easier to manage the data
+!
+type(header_t), pointer :: hp
+type(vps_t), pointer :: pp
+
+ type(fnode), pointer :: myDoc
+ type(fnode), pointer :: myNode, np
+ type(fnodeList), pointer :: myList
+
+ integer :: npseudos, i
+ character(len=200) :: value ! Could be larger, or made into a string
+
+! Parse
+! No constructor method - this is fortran !
+ myDoc => parsefile("pseudo.xml") ! ,verbose=.true.)
+ print *, "Number of active nodes: ", getNumberofAllocatedNodes()
+
+! call dumpTree(myDoc)
+ print *, "Normalizing...(can take long if big file --- not really needed)"
+ call normalize(myDoc)
+! call dumpTree(myDoc)
+
+ print *, "Number of active nodes: ", getNumberofAllocatedNodes()
+
+!----------------------------------------------------------
+
+ myList => getElementsByTagName(myDoc, "pseudo")
+ if (getLength(myList) == 0) then
+ call die("Did not found any pseudo elements...")
+ endif
+ myNode => item(myList, 0)
+
+ value = getAttribute(myNode,"version")
+ if (value == "0.5") then
+ print *, "Processing a PSEUDO version 0.5 XML file"
+ pseudo%npots = 0
+ global_grid%npts = 0
+ else
+ print *, "Can only work with PSEUDO version 0.5 XML files"
+ STOP
+ endif
+
+ global_grid%npts = 0 ! To flag absence of global grid info
+ myList => getChildNodes(myNode)
+ do i=0, getLength(myList) - 1
+ np => item(myList,i)
+ s = getNodeName(np)
+ if (s == "grid") then
+ print *, "This file has a global grid... "
+ call get_grid_data(np,global_grid)
+ exit
+ endif
+ enddo
+!
+! Header
+!
+ myList => getElementsByTagName(myDoc, "header")
+ if (getLength(myList) == 0) then
+ call die("Did not found any header elements...")
+ endif
+ myNode => item(myList, 0)
+ print *, "Processing header..."
+ hp => pseudo%header
+
+ hp%symbol = getAttribute(myNode,"symbol")
+ if (hp%symbol == "" ) call die("Cannot determine atomic symbol")
+
+ value = getAttribute(myNode,"zval")
+ if (value == "") call die("Cannot determine zval")
+ read(unit=value,fmt=*) hp%zval
+!
+ hp%creator = getAttribute(myNode,"creator")
+ if (hp%creator == "" ) hp%creator="unknown"
+
+ hp%flavor = getAttribute(myNode,"flavor")
+ if (hp%flavor == "" ) hp%flavor="unknown"
+
+ value = getAttribute(myNode,"relativistic")
+ if (value == "") hp%relativistic = .false.
+ hp%relativistic = (value == "yes")
+
+ value = getAttribute(myNode,"polarized")
+ if (value == "") hp%polarized = .false.
+ hp%polarized = (value == "yes")
+
+ hp%core_corrections = getAttribute(myNode,"core-corrections")
+ if (hp%core_corrections == "" ) hp%core_corrections="nc"
+
+!
+! Valence charge
+!
+ myList => getElementsByTagName(myDoc, "valence-charge")
+ if (getLength(myList) == 0) then
+ call die("Did not found the valence charge ...")
+ endif
+ np => item(myList,0)
+ if (associated(np)) then
+ print *, "Processing valence charge..."
+ !
+ ! Get the data (and possible private grid)
+ !
+ call get_radfunc_data(np,global_grid,pseudo%valence_charge)
+ endif
+
+! Core charge
+!
+ myList => getElementsByTagName(myDoc, "pseudocore-charge")
+ np => item(myList,0)
+ if (associated(np)) then
+ print *, "Processing core charge..."
+ !
+ ! Get the data (and possible private grid)
+ !
+ call get_radfunc_data(np,global_grid,pseudo%core_charge)
+ endif
+
+!
+! Semilocal Pseudos
+!
+ myList => getElementsByTagName(myDoc, "semilocal")
+ if (getLength(myList) == 0) then
+ call die("Did not found the semilocal element...")
+ endif
+ np => item(myList, 0)
+ if (associated(np)) then
+ print *, "Processing semilocal..."
+
+ value = getAttribute(np,"npots-down")
+ if (value == "" ) call die("Cannot determine npots-down")
+ read(unit=value,fmt=*) pseudo%npots_down
+
+ value = getAttribute(np,"npots-up")
+ if (value == "" ) call die("Cannot determine npots-up")
+ read(unit=value,fmt=*) pseudo%npots_up
+
+ else
+ call die("Cannot find semilocal element")
+ endif
+
+ pseudo%npots = 0
+ myList => getElementsByTagName(np, "vps")
+ if (getLength(myList) == 0) then
+ call die("Did not found any vps elements...")
+ endif
+ npseudos = getLength(myList)
+ do i = 0, npseudos - 1
+ print *, "Processing vps i = ", i , "---------------------"
+ myNode => item(myList, i)
+ pseudo%npots = pseudo%npots + 1
+ pp => pseudo%pot(pseudo%npots)
+
+ value = getAttribute(myNode,"l")
+ if (value == "" ) call die("Cannot determine l for Vps")
+ read(unit=value,fmt=*) pp%l
+
+ value = getAttribute(myNode,"principal-n")
+ if (value == "" ) call die("Cannot determine n for Vps")
+ read(unit=value,fmt=*) pp%n
+
+ value = getAttribute(myNode,"cutoff")
+ if (value == "" ) call die("Cannot determine cutoff for Vps")
+ read(unit=value,fmt=*) pp%cutoff
+
+ value = getAttribute(myNode,"occupation")
+ if (value == "" ) call die("Cannot determine occupation for Vps")
+ read(unit=value,fmt=*) pp%occupation
+
+ value = getAttribute(myNode,"spin")
+ if (value == "" ) call die("Cannot determine spin for Vps")
+ read(unit=value,fmt=*) pp%spin
+
+ call get_radfunc_data(myNode,global_grid,pp%V)
+
+ enddo
+
+!
+! Show some of the information
+!
+call dump_pseudo(pseudo)
+
+CONTAINS
+
+!-----------------------------------------------------------------------
+subroutine get_radfunc_data(element,global_grid,rp)
+use m_converters, only: build_data_array
+!
+! Example of routine which packages parsing functionality for a
+! common element. The element can appear under ,
+! , and elements.
+! In all cases the parsing steps are exactly the same.
+! This routine accepts a pointer to the parent element and returns
+! the data structure.
+!
+type(fnode), pointer :: element
+type(grid_t), intent(in) :: global_grid
+type(radfunc_t), intent(out) :: rp
+
+type(fnode), pointer :: np, radfuncp
+type(fnodeList), pointer :: lp
+integer :: ndata
+type(string) :: pcdata, s
+
+ s = getNodeName(element)
+ print *, "Getting radfunc data from element ", char(s)
+ lp => getElementsByTagName(element, "radfunc")
+ radfuncp => item(lp,0)
+ lp => getElementsByTagName(radfuncp, "grid")
+ np => item(lp,0)
+ if (associated(np)) then
+ print *, " >> local grid found"
+ call get_grid_data(np,rp%grid)
+ else
+ print *, " >> re-using global grid"
+ rp%grid = global_grid
+ endif
+
+ lp => getElementsByTagName(radfuncp, "data")
+ np => item(lp,0)
+ if (associated(np)) then
+ if (rp%grid%npts == 0) call die("Need grid information!")
+ allocate(rp%data(rp%grid%npts))
+ ndata = 0 ! To start the build up
+ np => getFirstChild(np)
+ do
+ if (.not. associated(np)) exit
+ if (getNodeType(np) /= TEXT_NODE) exit
+ pcdata = getNodeValue(np) ! text node
+ call build_data_array(char(pcdata),rp%data,ndata)
+ np => getNextSibling(np)
+ enddo
+ if (ndata /= size(rp%data)) STOP "npts mismatch"
+ else
+ call die("Cannot find data element")
+ endif
+end subroutine get_radfunc_data
+!-----------------------------------------------------------------------
+subroutine get_grid_data(element,grid)
+type(fnode), pointer :: element
+type(grid_t), intent(out) :: grid
+
+character(len=100) :: value
+
+ grid%type = getAttribute(element,"type")
+ if (grid%type == "" ) call die("Cannot determine grid type")
+
+ value = getAttribute(element,"npts")
+ if (value == "" ) call die("Cannot determine grid npts")
+ read(unit=value,fmt=*) grid%npts
+
+ value = getAttribute(element,"scale")
+ if (value == "" ) call die("Cannot determine grid scale")
+ read(unit=value,fmt=*) grid%scale
+
+ value = getAttribute(element,"step")
+ if (value == "" ) call die("Cannot determine grid step")
+ read(unit=value,fmt=*) grid%step
+
+end subroutine get_grid_data
+
+!-----------------------------------------------------------------------
+ subroutine die(str)
+ character(len=*), intent(in), optional :: str
+ if (present(str)) then
+ write(unit=0,fmt="(a)") trim(str)
+ endif
+ write(unit=0,fmt="(a)") "Stopping Program"
+ stop
+ end subroutine die
+
+
+end program pseudoread
Index: /XMLF90/doc/Examples/dom/i.pseudo_dom.f90
===================================================================
--- /XMLF90/doc/Examples/dom/i.pseudo_dom.f90 (revision 6)
+++ /XMLF90/doc/Examples/dom/i.pseudo_dom.f90 (revision 6)
@@ -0,0 +1,189 @@
+program pseudo_dom
+!
+! Move towards DOM-like routines
+! for the pseudo schema
+! See details in m_psdom.f90
+
+use m_pseudo_types
+use m_psdom
+
+! Module
+ use flib_dom
+
+type(pseudo_t), target :: pseudo
+type(grid_t) :: global_grid
+!
+type(string) :: s ! to avoid memory leaks
+
+! Pointers to make it easier to manage the data
+!
+type(header_t), pointer :: hp
+type(vps_t), pointer :: pp
+
+ type(fnode), pointer :: myDoc
+ type(fnode), pointer :: myNode, np
+ type(fnodeList), pointer :: myList
+
+ integer :: npseudos, i
+ character(len=200) :: value ! Could be larger, or made into a string
+
+! Parse
+! No constructor method - this is fortran !
+ myDoc => parsefile("pseudo.xml") ! ,verbose=.true.)
+ print *, "Number of active nodes: ", getNumberofAllocatedNodes()
+
+! call dumpTree(myDoc)
+ print *, "Normalizing...(can take long if big file --- not really needed)"
+ call normalize(myDoc)
+! call dumpTree(myDoc)
+
+ print *, "Number of active nodes: ", getNumberofAllocatedNodes()
+
+!----------------------------------------------------------
+
+ myList => getElementsByTagName(myDoc, "pseudo")
+ if (getLength(myList) == 0) then
+ call die("Did not found any pseudo elements...")
+ endif
+ myNode => item(myList, 0)
+
+ value = getAttribute(myNode,"version")
+ if (value == "0.5") then
+ print *, "Processing a PSEUDO version 0.5 XML file"
+ pseudo%npots = 0
+ global_grid%npts = 0
+ else
+ print *, "Can only work with PSEUDO version 0.5 XML files"
+ STOP
+ endif
+
+ global_grid%npts = 0 ! To flag absence of global grid info
+ myList => getChildNodes(myNode)
+ do i=0, getLength(myList) - 1
+ np => item(myList,i)
+ s = getNodeName(np)
+ if (s == "grid") then
+ print *, "This file has a global grid... "
+ call getGrid(np,global_grid)
+ exit
+ endif
+ enddo
+!
+! Header
+!
+ myList => getElementsByTagName(myDoc, "header")
+ if (getLength(myList) == 0) then
+ call die("Did not found any header elements...")
+ endif
+ myNode => item(myList, 0)
+ print *, "Processing header..."
+ hp => pseudo%header
+
+ hp%symbol = getAttribute(myNode,"symbol")
+ if (hp%symbol == "" ) call die("Cannot determine atomic symbol")
+
+ value = getAttribute(myNode,"zval")
+ if (value == "") call die("Cannot determine zval")
+ read(unit=value,fmt=*) hp%zval
+!
+ hp%creator = getAttribute(myNode,"creator")
+ if (hp%creator == "" ) hp%creator="unknown"
+
+ hp%flavor = getAttribute(myNode,"flavor")
+ if (hp%flavor == "" ) hp%flavor="unknown"
+
+ value = getAttribute(myNode,"relativistic")
+ if (value == "") hp%relativistic = .false.
+ hp%relativistic = (value == "yes")
+
+ value = getAttribute(myNode,"polarized")
+ if (value == "") hp%polarized = .false.
+ hp%polarized = (value == "yes")
+
+ hp%core_corrections = getAttribute(myNode,"core-corrections")
+ if (hp%core_corrections == "" ) hp%core_corrections="nc"
+
+!
+! Valence charge
+!
+ myList => getElementsByTagName(myDoc, "valence-charge")
+ if (getLength(myList) == 0) then
+ call die("Did not found the valence charge ...")
+ endif
+ np => item(myList,0)
+ if (associated(np)) then
+ print *, "Processing valence charge..."
+ !
+ ! Get the data (and possible private grid)
+ !
+ call getRadialFunction(np,global_grid,pseudo%valence_charge)
+ endif
+
+! Core charge
+!
+ myList => getElementsByTagName(myDoc, "pseudocore-charge")
+ np => item(myList,0)
+ if (associated(np)) then
+ print *, "Processing core charge..."
+ !
+ ! Get the data (and possible private grid)
+ !
+ call getRadialFunction(np,global_grid,pseudo%core_charge)
+ endif
+
+!
+! Semilocal Pseudos
+!
+ myList => getElementsByTagName(myDoc, "semilocal")
+ if (getLength(myList) == 0) then
+ call die("Did not found the semilocal element...")
+ endif
+ np => item(myList, 0)
+ if (associated(np)) then
+ print *, "Processing semilocal..."
+
+ value = getAttribute(np,"npots-down")
+ if (value == "" ) call die("Cannot determine npots-down")
+ read(unit=value,fmt=*) pseudo%npots_down
+
+ value = getAttribute(np,"npots-up")
+ if (value == "" ) call die("Cannot determine npots-up")
+ read(unit=value,fmt=*) pseudo%npots_up
+
+ else
+ call die("Cannot find semilocal element")
+ endif
+
+ pseudo%npots = 0
+ myList => getElementsByTagName(np, "vps")
+ if (getLength(myList) == 0) then
+ call die("Did not found any vps elements...")
+ endif
+ npseudos = getLength(myList)
+ do i = 0, npseudos - 1
+ print *, "Processing vps i = ", i , "---------------------"
+ myNode => item(myList, i)
+ pseudo%npots = pseudo%npots + 1
+ pp => pseudo%pot(pseudo%npots)
+ call getVps(myNode,global_grid,pp)
+ enddo
+
+!
+! Show some of the information
+!
+call dump_pseudo(pseudo)
+
+CONTAINS
+
+!-----------------------------------------------------------------------
+ subroutine die(str)
+ character(len=*), intent(in), optional :: str
+ if (present(str)) then
+ write(unit=0,fmt="(a)") trim(str)
+ endif
+ write(unit=0,fmt="(a)") "Stopping Program"
+ stop
+ end subroutine die
+
+
+end program pseudo_dom
Index: /XMLF90/doc/Examples/dom/i.text.f90
===================================================================
--- /XMLF90/doc/Examples/dom/i.text.f90 (revision 6)
+++ /XMLF90/doc/Examples/dom/i.text.f90 (revision 6)
@@ -0,0 +1,56 @@
+program text
+
+ use flib_dom
+
+ implicit none
+
+ type(fnode), pointer :: myDoc, n
+ type(fnodeList), pointer :: myList, childList
+ type(string) :: s
+
+ integer :: i, j, nels
+
+ myDoc => parsefile("big-file.xml")!! , verbose=.true.)
+ print *, "allocated nodes: ", getNumberofAllocatedNodes()
+! call dumpTree(myDoc)
+ call xmlize(myDoc,"dumptext.xml")
+
+ myList => getElementsbyTagName(myDoc, "para")
+ nels = getLength(myList)
+ print *, "number of para elements: ", nels
+ print *, "Dumping pure text under them..."
+ do i = 0, nels - 1
+ n => item(myList,i)
+ childList => getChildNodes(n)
+ do j = 0, getLength(childList) - 1
+ n => item(childList,j)
+ if (getNodeType(n) == TEXT_NODE) then
+ s = getNodeValue(n)
+ print *, "|", char(s), "|"
+ endif
+ enddo
+ enddo
+
+ print *, "Normalizing..."
+ print *, "===================================================="
+ call normalize(myDoc)
+! call dumpTree(myDoc)
+ print *, "allocated nodes: ", getNumberofAllocatedNodes()
+ myList => getElementsbyTagName(myDoc, "para")
+ nels = getLength(myList)
+ print *, "number of para elements: ", nels
+ print *, "Dumping pure text under them..."
+ do i = 0, nels - 1
+ n => item(myList,i)
+ childList => getChildNodes(n)
+ do j = 0, getLength(childList) - 1
+ n => item(childList,j)
+ if (getNodeType(n) == TEXT_NODE) then
+ s = getNodeValue(n)
+ print *, "|", char(s), "|"
+ endif
+ enddo
+ enddo
+
+
+end program text
Index: /XMLF90/doc/Examples/dom/m_psdom.f90
===================================================================
--- /XMLF90/doc/Examples/dom/m_psdom.f90 (revision 6)
+++ /XMLF90/doc/Examples/dom/m_psdom.f90 (revision 6)
@@ -0,0 +1,135 @@
+module m_psdom
+
+use m_pseudo_types
+use flib_dom
+
+private
+
+public :: getVps
+public :: getRadialFunction
+public :: getGrid
+
+CONTAINS
+
+subroutine getVps(np,global_grid,pp)
+type(fnode), pointer :: np
+type(vps_t), intent(inout) :: pp
+type(grid_t), intent(in) :: global_grid
+
+character(len=200) :: value
+
+ value = getAttribute(np,"l")
+ if (value == "" ) call die("Cannot determine l for Vps")
+ read(unit=value,fmt=*) pp%l
+
+ value = getAttribute(np,"principal-n")
+ if (value == "" ) call die("Cannot determine n for Vps")
+ read(unit=value,fmt=*) pp%n
+
+ value = getAttribute(np,"cutoff")
+ if (value == "" ) call die("Cannot determine cutoff for Vps")
+ read(unit=value,fmt=*) pp%cutoff
+
+ value = getAttribute(np,"occupation")
+ if (value == "" ) call die("Cannot determine occupation for Vps")
+ read(unit=value,fmt=*) pp%occupation
+
+ value = getAttribute(np,"spin")
+ if (value == "" ) call die("Cannot determine spin for Vps")
+ read(unit=value,fmt=*) pp%spin
+
+ call getRadialFunction(np,global_grid,pp%V)
+
+end subroutine getVps
+
+!-----------------------------------------------------------------------
+subroutine getRadialFunction(element,global_grid,rp)
+use m_converters, only: build_data_array
+!
+! Example of routine which packages parsing functionality for a
+! common element. The element can appear under ,
+! , and elements.
+! In all cases the parsing steps are exactly the same.
+! This routine accepts a pointer to the parent element and returns
+! the data structure.
+!
+type(fnode), pointer :: element
+type(grid_t), intent(in) :: global_grid
+type(radfunc_t), intent(out) :: rp
+
+type(fnode), pointer :: np, radfuncp
+type(fnodeList), pointer :: lp
+integer :: ndata
+type(string) :: pcdata, s
+
+ s = getNodeName(element)
+ print *, "Getting radfunc data from element ", char(s)
+ lp => getElementsByTagName(element, "radfunc")
+ radfuncp => item(lp,0)
+ lp => getElementsByTagName(radfuncp, "grid")
+ np => item(lp,0)
+ if (associated(np)) then
+ print *, " >> local grid found"
+ call getGrid(np,rp%grid)
+ else
+ print *, " >> re-using global grid"
+ rp%grid = global_grid
+ endif
+
+ lp => getElementsByTagName(radfuncp, "data")
+ np => item(lp,0)
+ if (associated(np)) then
+ if (rp%grid%npts == 0) call die("Need grid information!")
+ allocate(rp%data(rp%grid%npts))
+ ndata = 0 ! To start the build up
+ np => getFirstChild(np)
+ do
+ if (.not. associated(np)) exit
+ if (getNodeType(np) /= TEXT_NODE) exit
+ pcdata = getNodeValue(np) ! text node
+ call build_data_array(char(pcdata),rp%data,ndata)
+ np => getNextSibling(np)
+ enddo
+ if (ndata /= size(rp%data)) STOP "npts mismatch"
+ else
+ call die("Cannot find data element")
+ endif
+end subroutine getRadialFunction
+
+!-----------------------------------------------------------------------
+subroutine getGrid(element,grid)
+type(fnode), pointer :: element
+type(grid_t), intent(out) :: grid
+
+character(len=200) :: value
+
+ grid%type = getAttribute(element,"type")
+ if (grid%type == "" ) call die("Cannot determine grid type")
+
+ value = getAttribute(element,"npts")
+ if (value == "" ) call die("Cannot determine grid npts")
+ read(unit=value,fmt=*) grid%npts
+
+ value = getAttribute(element,"scale")
+ if (value == "" ) call die("Cannot determine grid scale")
+ read(unit=value,fmt=*) grid%scale
+
+ value = getAttribute(element,"step")
+ if (value == "" ) call die("Cannot determine grid step")
+ read(unit=value,fmt=*) grid%step
+
+end subroutine getGrid
+
+!-----------------------------------------------------------------------
+ subroutine die(str)
+ character(len=*), intent(in), optional :: str
+ if (present(str)) then
+ write(unit=0,fmt="(a)") trim(str)
+ endif
+ write(unit=0,fmt="(a)") "Stopping Program"
+ stop
+ end subroutine die
+
+
+end module m_psdom
+
Index: /XMLF90/doc/Examples/dom/m_pseudo_types.f90
===================================================================
--- /XMLF90/doc/Examples/dom/m_pseudo_types.f90 (revision 6)
+++ /XMLF90/doc/Examples/dom/m_pseudo_types.f90 (revision 6)
@@ -0,0 +1,107 @@
+module m_pseudo_types
+!
+! Data structures for a prototype pseudopotential
+!
+integer, parameter, private :: MAXN_POTS = 8
+integer, parameter, private :: dp = selected_real_kind(14)
+!
+public :: dump_pseudo
+!
+!-----------------------------------------------------------
+type, public :: grid_t
+!
+! It should be possible to represent both log and linear
+! grids with a few parameters here.
+!
+ character(len=20) :: type
+ real(kind=dp) :: scale
+ real(kind=dp) :: step
+ integer :: npts
+end type grid_t
+!
+type, public :: radfunc_t
+ type(grid_t) :: grid
+ real(kind=dp), dimension(:), pointer :: data
+end type radfunc_t
+
+type, public :: vps_t
+ integer :: l
+ integer :: n
+ integer :: spin
+ real(kind=dp) :: occupation
+ real(kind=dp) :: cutoff
+ type(radfunc_t) :: V
+end type vps_t
+
+type, public :: header_t
+ character(len=2) :: symbol
+ real(kind=dp) :: zval
+ character(len=10) :: creator
+ character(len=10) :: date
+ character(len=40) :: flavor
+ logical :: relativistic
+ logical :: polarized
+ character(len=2) :: correlation
+ character(len=4) :: core_corrections
+end type header_t
+
+type, public :: pseudo_t
+ type(header_t) :: header
+ integer :: npots
+ integer :: npots_down
+ integer :: npots_up
+ type(vps_t), dimension(MAXN_POTS) :: pot
+ type(radfunc_t) :: core_charge
+ type(radfunc_t) :: valence_charge
+end type pseudo_t
+
+
+CONTAINS !===============================================
+
+subroutine dump_pseudo(pseudo)
+type(pseudo_t), intent(in), target :: pseudo
+
+integer :: i
+type(vps_t), pointer :: pp
+type(radfunc_t), pointer :: rp
+
+print *, "---PSEUDO data:"
+
+do i = 1, pseudo%npots
+ pp => pseudo%pot(i)
+ rp => pseudo%pot(i)%V
+ print *, "VPS ", i, " angular momentum: ", pp%l
+ print *, " n: ", pp%n
+ print *, " occupation: ", pp%occupation
+ print *, " cutoff: ", pp%cutoff
+ print *, " spin: ", pp%spin
+ print *, "grid data: ", rp%grid%npts, rp%grid%scale
+enddo
+rp => pseudo%valence_charge
+print *, "valence grid data: ", rp%grid%npts, rp%grid%scale
+rp => pseudo%core_charge
+if (associated(rp)) print *, "core grid data: ", rp%grid%npts, rp%grid%scale
+
+end subroutine dump_pseudo
+
+end module m_pseudo_types
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/dom/makefile
===================================================================
--- /XMLF90/doc/Examples/dom/makefile (revision 6)
+++ /XMLF90/doc/Examples/dom/makefile (revision 6)
@@ -0,0 +1,42 @@
+#
+# Makefile for DOM examples
+#
+default: all
+all: features data pseudo pseudo_dom text
+#
+#---------------------------
+MK=$(FLIB_ROOT)/fortran.mk
+include $(MK)
+#---------------------------
+#
+# Uncomment the following line for debugging support
+#
+#FFLAGS=$(FFLAGS_DEBUG)
+#FFLAGS=$(FFLAGS_CHECK)
+#
+LIBS=$(LIB_PREFIX)$(LIB_STD) -lflib
+#
+features: features.o
+ $(FC) $(LDFLAGS) -o features features.o $(LIBS)
+data: data.o
+ $(FC) $(LDFLAGS) -o data data.o $(LIBS)
+pseudo: m_pseudo_types.o pseudo.o
+ $(FC) $(LDFLAGS) -o pseudo m_pseudo_types.o pseudo.o $(LIBS)
+pseudo_dom: m_pseudo_types.o m_psdom.o pseudo_dom.o
+ $(FC) $(LDFLAGS) -o pseudo_dom m_pseudo_types.o m_psdom.o pseudo_dom.o $(LIBS)
+text: text.o
+ $(FC) $(LDFLAGS) -o text text.o $(LIBS)
+#
+clean:
+ rm -f features data pseudo pseudo_dom text *.o *.$(MOD_EXT)
+#
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/dom/pseudo.f90
===================================================================
--- /XMLF90/doc/Examples/dom/pseudo.f90 (revision 6)
+++ /XMLF90/doc/Examples/dom/pseudo.f90 (revision 6)
@@ -0,0 +1,283 @@
+program pseudoread
+
+use m_pseudo_types
+
+! Module
+ use flib_dom
+
+type(pseudo_t), target :: pseudo
+type(grid_t) :: global_grid
+!
+type(string) :: s ! to avoid memory leaks
+
+! Pointers to make it easier to manage the data
+!
+type(header_t), pointer :: hp
+type(vps_t), pointer :: pp
+
+ type(fnode), pointer :: myDoc
+ type(fnode), pointer :: myNode, np
+ type(fnodeList), pointer :: myList
+
+ integer :: npseudos, i
+ character(len=200) :: value ! Could be larger, or made into a string
+
+! Parse
+! No constructor method - this is fortran !
+ myDoc => parsefile("pseudo.xml") ! ,verbose=.true.)
+ print *, "Number of active nodes: ", getNumberofAllocatedNodes()
+
+! call dumpTree(myDoc)
+ print *, "Normalizing...(can take long if big file --- not really needed)"
+ call normalize(myDoc)
+! call dumpTree(myDoc)
+
+ print *, "Number of active nodes: ", getNumberofAllocatedNodes()
+
+!----------------------------------------------------------
+
+ myList => getElementsByTagName(myDoc, "pseudo")
+ if (getLength(myList) == 0) then
+ call die("Did not found any pseudo elements...")
+ endif
+ myNode => item(myList, 0)
+
+ value = getAttribute(myNode,"version")
+ if (value == "0.5") then
+ print *, "Processing a PSEUDO version 0.5 XML file"
+ pseudo%npots = 0
+ global_grid%npts = 0
+ else
+ print *, "Can only work with PSEUDO version 0.5 XML files"
+ STOP
+ endif
+
+ global_grid%npts = 0 ! To flag absence of global grid info
+ myList => getChildNodes(myNode)
+ do i=0, getLength(myList) - 1
+ np => item(myList,i)
+ s = getNodeName(np)
+ if (s == "grid") then
+ print *, "This file has a global grid... "
+ call get_grid_data(np,global_grid)
+ exit
+ endif
+ enddo
+!
+! Header
+!
+ myList => getElementsByTagName(myDoc, "header")
+ if (getLength(myList) == 0) then
+ call die("Did not found any header elements...")
+ endif
+ myNode => item(myList, 0)
+ print *, "Processing header..."
+ hp => pseudo%header
+
+ hp%symbol = getAttribute(myNode,"symbol")
+ if (hp%symbol == "" ) call die("Cannot determine atomic symbol")
+
+ value = getAttribute(myNode,"zval")
+ if (value == "") call die("Cannot determine zval")
+ read(unit=value,fmt=*) hp%zval
+!
+ hp%creator = getAttribute(myNode,"creator")
+ if (hp%creator == "" ) hp%creator="unknown"
+
+ hp%flavor = getAttribute(myNode,"flavor")
+ if (hp%flavor == "" ) hp%flavor="unknown"
+
+ value = getAttribute(myNode,"relativistic")
+ if (value == "") hp%relativistic = .false.
+ hp%relativistic = (value == "yes")
+
+ value = getAttribute(myNode,"polarized")
+ if (value == "") hp%polarized = .false.
+ hp%polarized = (value == "yes")
+
+ hp%core_corrections = getAttribute(myNode,"core-corrections")
+ if (hp%core_corrections == "" ) hp%core_corrections="nc"
+
+!
+! Valence charge
+!
+ myList => getElementsByTagName(myDoc, "valence-charge")
+ if (getLength(myList) == 0) then
+ call die("Did not found the valence charge ...")
+ endif
+ np => item(myList,0)
+ if (associated(np)) then
+ print *, "Processing valence charge..."
+ !
+ ! Get the data (and possible private grid)
+ !
+ call get_radfunc_data(np,global_grid,pseudo%valence_charge)
+ endif
+
+! Core charge
+!
+ myList => getElementsByTagName(myDoc, "pseudocore-charge")
+ np => item(myList,0)
+ if (associated(np)) then
+ print *, "Processing core charge..."
+ !
+ ! Get the data (and possible private grid)
+ !
+ call get_radfunc_data(np,global_grid,pseudo%core_charge)
+ endif
+
+!
+! Semilocal Pseudos
+!
+ myList => getElementsByTagName(myDoc, "semilocal")
+ if (getLength(myList) == 0) then
+ call die("Did not found the semilocal element...")
+ endif
+ np => item(myList, 0)
+ if (associated(np)) then
+ print *, "Processing semilocal..."
+
+ value = getAttribute(np,"npots-down")
+ if (value == "" ) call die("Cannot determine npots-down")
+ read(unit=value,fmt=*) pseudo%npots_down
+
+ value = getAttribute(np,"npots-up")
+ if (value == "" ) call die("Cannot determine npots-up")
+ read(unit=value,fmt=*) pseudo%npots_up
+
+ else
+ call die("Cannot find semilocal element")
+ endif
+
+ pseudo%npots = 0
+ myList => getElementsByTagName(np, "vps")
+ if (getLength(myList) == 0) then
+ call die("Did not found any vps elements...")
+ endif
+ npseudos = getLength(myList)
+ do i = 0, npseudos - 1
+ print *, "Processing vps i = ", i , "---------------------"
+ myNode => item(myList, i)
+ pseudo%npots = pseudo%npots + 1
+ pp => pseudo%pot(pseudo%npots)
+
+ value = getAttribute(myNode,"l")
+ if (value == "" ) call die("Cannot determine l for Vps")
+ read(unit=value,fmt=*) pp%l
+
+ value = getAttribute(myNode,"principal-n")
+ if (value == "" ) call die("Cannot determine n for Vps")
+ read(unit=value,fmt=*) pp%n
+
+ value = getAttribute(myNode,"cutoff")
+ if (value == "" ) call die("Cannot determine cutoff for Vps")
+ read(unit=value,fmt=*) pp%cutoff
+
+ value = getAttribute(myNode,"occupation")
+ if (value == "" ) call die("Cannot determine occupation for Vps")
+ read(unit=value,fmt=*) pp%occupation
+
+ value = getAttribute(myNode,"spin")
+ if (value == "" ) call die("Cannot determine spin for Vps")
+ read(unit=value,fmt=*) pp%spin
+
+ call get_radfunc_data(myNode,global_grid,pp%V)
+
+ enddo
+
+!
+! Show some of the information
+!
+call dump_pseudo(pseudo)
+
+CONTAINS
+
+!-----------------------------------------------------------------------
+subroutine get_radfunc_data(element,global_grid,rp)
+use m_converters, only: build_data_array
+!
+! Example of routine which packages parsing functionality for a
+! common element. The element can appear under ,
+! , and elements.
+! In all cases the parsing steps are exactly the same.
+! This routine accepts a pointer to the parent element and returns
+! the data structure.
+!
+type(fnode), pointer :: element
+type(grid_t), intent(in) :: global_grid
+type(radfunc_t), intent(out) :: rp
+
+type(fnode), pointer :: np, radfuncp
+type(fnodeList), pointer :: lp
+integer :: ndata
+type(string) :: pcdata, s
+
+ s = getNodeName(element)
+ print *, "Getting radfunc data from element ", char(s)
+ lp => getElementsByTagName(element, "radfunc")
+ radfuncp => item(lp,0)
+ lp => getElementsByTagName(radfuncp, "grid")
+ np => item(lp,0)
+ if (associated(np)) then
+ print *, " >> local grid found"
+ call get_grid_data(np,rp%grid)
+ else
+ print *, " >> re-using global grid"
+ rp%grid = global_grid
+ endif
+
+ lp => getElementsByTagName(radfuncp, "data")
+ np => item(lp,0)
+ if (associated(np)) then
+ if (rp%grid%npts == 0) call die("Need grid information!")
+ allocate(rp%data(rp%grid%npts))
+ ndata = 0 ! To start the build up
+ np => getFirstChild(np)
+ do
+ if (.not. associated(np)) exit
+ if (getNodeType(np) /= TEXT_NODE) exit
+ pcdata = getNodeValue(np) ! text node
+ call build_data_array(char(pcdata),rp%data,ndata)
+ np => getNextSibling(np)
+ enddo
+ if (ndata /= size(rp%data)) STOP "npts mismatch"
+ else
+ call die("Cannot find data element")
+ endif
+end subroutine get_radfunc_data
+!-----------------------------------------------------------------------
+subroutine get_grid_data(element,grid)
+type(fnode), pointer :: element
+type(grid_t), intent(out) :: grid
+
+character(len=100) :: value
+
+ grid%type = getAttribute(element,"type")
+ if (grid%type == "" ) call die("Cannot determine grid type")
+
+ value = getAttribute(element,"npts")
+ if (value == "" ) call die("Cannot determine grid npts")
+ read(unit=value,fmt=*) grid%npts
+
+ value = getAttribute(element,"scale")
+ if (value == "" ) call die("Cannot determine grid scale")
+ read(unit=value,fmt=*) grid%scale
+
+ value = getAttribute(element,"step")
+ if (value == "" ) call die("Cannot determine grid step")
+ read(unit=value,fmt=*) grid%step
+
+end subroutine get_grid_data
+
+!-----------------------------------------------------------------------
+ subroutine die(str)
+ character(len=*), intent(in), optional :: str
+ if (present(str)) then
+ write(unit=0,fmt="(a)") trim(str)
+ endif
+ write(unit=0,fmt="(a)") "Stopping Program"
+ stop
+ end subroutine die
+
+
+end program pseudoread
Index: /XMLF90/doc/Examples/dom/pseudo.xml
===================================================================
--- /XMLF90/doc/Examples/dom/pseudo.xml (revision 6)
+++ /XMLF90/doc/Examples/dom/pseudo.xml (revision 6)
@@ -0,0 +1,164 @@
+
+
+
+
+
+
+
+
+
+ -0.331900385172E-04 -0.667975563254E-04 -0.100827804667E-03 -0.135286100838E-03
+ -0.170177829017E-03 -0.205508441107E-03 -0.241283457588E-03 -0.277508468378E-03
+
+
+
+
+
+
+ -0.498621054540E-04 -0.100351398985E-03 -0.151475769648E-03 -0.203243205728E-03
+ -0.255661795995E-03 -0.308739730957E-03 -0.362485304152E-03 -0.416906913432E-03
+
+
+
+
+
+
+ -0.864406179730E-04 -0.173968525070E-03 -0.262597397705E-03 -0.352341084318E-03
+ -0.443213607544E-03 -0.535229166399E-03 -0.628402138500E-03 -0.722747082314E-03
+
+
+
+
+
+
+ -0.469203541965E-04 -0.944308937944E-04 -0.142539042412E-03 -0.191252317045E-03
+ -0.240578329241E-03 -0.290524786291E-03 -0.341099492429E-03 -0.392310350056E-03
+
+
+
+
+
+
+
+ 0.277250403619E-06 0.557988188005E-06 0.842257219008E-06 0.113010191424E-05
+ 0.142156725002E-05 0.171669876841E-05 0.201554258430E-05 0.231814539264E-05
+
+
+
+
+
+
+ 0.369459072892E-07 0.743565368829E-07 0.112237734268E-06 0.150595418459E-06
+ 0.189435582921E-06 0.228764296510E-06 0.268587704417E-06 0.308912029131E-06
+
+
+
+
+
+
+ 0.108684130278E-07 0.218735338622E-07 0.330170820757E-07 0.443007988704E-07
+ 0.557264473500E-07 0.672958127953E-07 0.790107029432E-07 0.908729482692E-07
+
+
+
+
+
+
+
+ 0.770415732749E-11 0.312054737246E-10 0.711001067937E-10 0.128001774477E-09
+ 0.202542230650E-09 0.295371753147E-09 0.407159644529E-09 0.538594745943E-09
+
+
+
+
+
+
+
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+
+
+
+
Index: /XMLF90/doc/Examples/dom/pseudo_dom.f90
===================================================================
--- /XMLF90/doc/Examples/dom/pseudo_dom.f90 (revision 6)
+++ /XMLF90/doc/Examples/dom/pseudo_dom.f90 (revision 6)
@@ -0,0 +1,189 @@
+program pseudo_dom
+!
+! Move towards DOM-like routines
+! for the pseudo schema
+! See details in m_psdom.f90
+
+use m_pseudo_types
+use m_psdom
+
+! Module
+ use flib_dom
+
+type(pseudo_t), target :: pseudo
+type(grid_t) :: global_grid
+!
+type(string) :: s ! to avoid memory leaks
+
+! Pointers to make it easier to manage the data
+!
+type(header_t), pointer :: hp
+type(vps_t), pointer :: pp
+
+ type(fnode), pointer :: myDoc
+ type(fnode), pointer :: myNode, np
+ type(fnodeList), pointer :: myList
+
+ integer :: npseudos, i
+ character(len=200) :: value ! Could be larger, or made into a string
+
+! Parse
+! No constructor method - this is fortran !
+ myDoc => parsefile("pseudo.xml") ! ,verbose=.true.)
+ print *, "Number of active nodes: ", getNumberofAllocatedNodes()
+
+! call dumpTree(myDoc)
+ print *, "Normalizing...(can take long if big file --- not really needed)"
+ call normalize(myDoc)
+! call dumpTree(myDoc)
+
+ print *, "Number of active nodes: ", getNumberofAllocatedNodes()
+
+!----------------------------------------------------------
+
+ myList => getElementsByTagName(myDoc, "pseudo")
+ if (getLength(myList) == 0) then
+ call die("Did not found any pseudo elements...")
+ endif
+ myNode => item(myList, 0)
+
+ value = getAttribute(myNode,"version")
+ if (value == "0.5") then
+ print *, "Processing a PSEUDO version 0.5 XML file"
+ pseudo%npots = 0
+ global_grid%npts = 0
+ else
+ print *, "Can only work with PSEUDO version 0.5 XML files"
+ STOP
+ endif
+
+ global_grid%npts = 0 ! To flag absence of global grid info
+ myList => getChildNodes(myNode)
+ do i=0, getLength(myList) - 1
+ np => item(myList,i)
+ s = getNodeName(np)
+ if (s == "grid") then
+ print *, "This file has a global grid... "
+ call getGrid(np,global_grid)
+ exit
+ endif
+ enddo
+!
+! Header
+!
+ myList => getElementsByTagName(myDoc, "header")
+ if (getLength(myList) == 0) then
+ call die("Did not found any header elements...")
+ endif
+ myNode => item(myList, 0)
+ print *, "Processing header..."
+ hp => pseudo%header
+
+ hp%symbol = getAttribute(myNode,"symbol")
+ if (hp%symbol == "" ) call die("Cannot determine atomic symbol")
+
+ value = getAttribute(myNode,"zval")
+ if (value == "") call die("Cannot determine zval")
+ read(unit=value,fmt=*) hp%zval
+!
+ hp%creator = getAttribute(myNode,"creator")
+ if (hp%creator == "" ) hp%creator="unknown"
+
+ hp%flavor = getAttribute(myNode,"flavor")
+ if (hp%flavor == "" ) hp%flavor="unknown"
+
+ value = getAttribute(myNode,"relativistic")
+ if (value == "") hp%relativistic = .false.
+ hp%relativistic = (value == "yes")
+
+ value = getAttribute(myNode,"polarized")
+ if (value == "") hp%polarized = .false.
+ hp%polarized = (value == "yes")
+
+ hp%core_corrections = getAttribute(myNode,"core-corrections")
+ if (hp%core_corrections == "" ) hp%core_corrections="nc"
+
+!
+! Valence charge
+!
+ myList => getElementsByTagName(myDoc, "valence-charge")
+ if (getLength(myList) == 0) then
+ call die("Did not found the valence charge ...")
+ endif
+ np => item(myList,0)
+ if (associated(np)) then
+ print *, "Processing valence charge..."
+ !
+ ! Get the data (and possible private grid)
+ !
+ call getRadialFunction(np,global_grid,pseudo%valence_charge)
+ endif
+
+! Core charge
+!
+ myList => getElementsByTagName(myDoc, "pseudocore-charge")
+ np => item(myList,0)
+ if (associated(np)) then
+ print *, "Processing core charge..."
+ !
+ ! Get the data (and possible private grid)
+ !
+ call getRadialFunction(np,global_grid,pseudo%core_charge)
+ endif
+
+!
+! Semilocal Pseudos
+!
+ myList => getElementsByTagName(myDoc, "semilocal")
+ if (getLength(myList) == 0) then
+ call die("Did not found the semilocal element...")
+ endif
+ np => item(myList, 0)
+ if (associated(np)) then
+ print *, "Processing semilocal..."
+
+ value = getAttribute(np,"npots-down")
+ if (value == "" ) call die("Cannot determine npots-down")
+ read(unit=value,fmt=*) pseudo%npots_down
+
+ value = getAttribute(np,"npots-up")
+ if (value == "" ) call die("Cannot determine npots-up")
+ read(unit=value,fmt=*) pseudo%npots_up
+
+ else
+ call die("Cannot find semilocal element")
+ endif
+
+ pseudo%npots = 0
+ myList => getElementsByTagName(np, "vps")
+ if (getLength(myList) == 0) then
+ call die("Did not found any vps elements...")
+ endif
+ npseudos = getLength(myList)
+ do i = 0, npseudos - 1
+ print *, "Processing vps i = ", i , "---------------------"
+ myNode => item(myList, i)
+ pseudo%npots = pseudo%npots + 1
+ pp => pseudo%pot(pseudo%npots)
+ call getVps(myNode,global_grid,pp)
+ enddo
+
+!
+! Show some of the information
+!
+call dump_pseudo(pseudo)
+
+CONTAINS
+
+!-----------------------------------------------------------------------
+ subroutine die(str)
+ character(len=*), intent(in), optional :: str
+ if (present(str)) then
+ write(unit=0,fmt="(a)") trim(str)
+ endif
+ write(unit=0,fmt="(a)") "Stopping Program"
+ stop
+ end subroutine die
+
+
+end program pseudo_dom
Index: /XMLF90/doc/Examples/dom/test.xml
===================================================================
--- /XMLF90/doc/Examples/dom/test.xml (revision 6)
+++ /XMLF90/doc/Examples/dom/test.xml (revision 6)
@@ -0,0 +1,47 @@
+
+
+
+
+
+
+
+
+
+
+A small file exercising all the features
+ in the parser...
+
+
+Mary had a <little> lamb who liked standard entities
+
+This is some text, with character references (O W)
+and some cdata sections inside to make it more interesting. How about this
+
+ pepe
+ ]]> ?
+
+
+
+
+
+In the next pcdata chunk there is an unknown entity
+1.24 ¬known;3.45
+(It was flagged, but the parser continued)
+
+In the following chunk there is a character reference out of range of the
+char() intrinsic... remove it from test.xml if it gives you trouble.
+
+Offending reference:
+
+2.454 9.455
+>>]]]<<<>!? ]]>
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/dom/text.f90
===================================================================
--- /XMLF90/doc/Examples/dom/text.f90 (revision 6)
+++ /XMLF90/doc/Examples/dom/text.f90 (revision 6)
@@ -0,0 +1,56 @@
+program text
+
+ use flib_dom
+
+ implicit none
+
+ type(fnode), pointer :: myDoc, n
+ type(fnodeList), pointer :: myList, childList
+ type(string) :: s
+
+ integer :: i, j, nels
+
+ myDoc => parsefile("big-file.xml")!! , verbose=.true.)
+ print *, "allocated nodes: ", getNumberofAllocatedNodes()
+! call dumpTree(myDoc)
+ call xmlize(myDoc,"dumptext.xml")
+
+ myList => getElementsbyTagName(myDoc, "para")
+ nels = getLength(myList)
+ print *, "number of para elements: ", nels
+ print *, "Dumping pure text under them..."
+ do i = 0, nels - 1
+ n => item(myList,i)
+ childList => getChildNodes(n)
+ do j = 0, getLength(childList) - 1
+ n => item(childList,j)
+ if (getNodeType(n) == TEXT_NODE) then
+ s = getNodeValue(n)
+ print *, "|", char(s), "|"
+ endif
+ enddo
+ enddo
+
+ print *, "Normalizing..."
+ print *, "===================================================="
+ call normalize(myDoc)
+! call dumpTree(myDoc)
+ print *, "allocated nodes: ", getNumberofAllocatedNodes()
+ myList => getElementsbyTagName(myDoc, "para")
+ nels = getLength(myList)
+ print *, "number of para elements: ", nels
+ print *, "Dumping pure text under them..."
+ do i = 0, nels - 1
+ n => item(myList,i)
+ childList => getChildNodes(n)
+ do j = 0, getLength(childList) - 1
+ n => item(childList,j)
+ if (getNodeType(n) == TEXT_NODE) then
+ s = getNodeValue(n)
+ print *, "|", char(s), "|"
+ endif
+ enddo
+ enddo
+
+
+end program text
Index: /XMLF90/doc/Examples/sax/README
===================================================================
--- /XMLF90/doc/Examples/sax/README (revision 6)
+++ /XMLF90/doc/Examples/sax/README (revision 6)
@@ -0,0 +1,20 @@
+Some examples of the use of the SAX API in Fortran.
+
+Start by looking at the "simple" directory. That will give you a
+feeling for the workings of the parser. Feel free to experiment
+with "malforming" the "test.xml", and to turn on the "verbose"
+flag in the call to "xml_parse" in example.f90.
+
+"Count" contains a simple yet meaningful application of the parser: counting
+the number of elements of different types in an XML file.
+
+"Pseudo" is a scaled-down real-world physics application: reading a
+data file and populating internal structures. It showcases the use of
+"build_data_array" to turn homogeneous PCDATA sections into numerical arrays.
+
+"Features" shows small snippets of all the constructs recognized by the
+parser: treatment of quotes in attributes, standard entities, CDATA sections,
+declarations, comments, etc.
+
+Alberto Garcia
+wdpgaara at lg ehu es
Index: /XMLF90/doc/Examples/sax/build.sh
===================================================================
--- /XMLF90/doc/Examples/sax/build.sh (revision 6)
+++ /XMLF90/doc/Examples/sax/build.sh (revision 6)
@@ -0,0 +1,9 @@
+#!/bin/sh
+
+(cd count ; make)
+(cd features ; make)
+(cd pseudo ; make)
+(cd simple ; make)
+
+
+
Index: /XMLF90/doc/Examples/sax/count/README
===================================================================
--- /XMLF90/doc/Examples/sax/count/README (revision 6)
+++ /XMLF90/doc/Examples/sax/count/README (revision 6)
@@ -0,0 +1,6 @@
+This is a simple XML parsing example contributed by Jon Wakelin
+(jwak02@esc.cam.ac.uk).
+
+It reports the number of appearances in the document of different elements.
+
+
Index: /XMLF90/doc/Examples/sax/count/big-file.xml
===================================================================
--- /XMLF90/doc/Examples/sax/count/big-file.xml (revision 6)
+++ /XMLF90/doc/Examples/sax/count/big-file.xml (revision 6)
@@ -0,0 +1,313 @@
+
+
+
+
+
+
+
+
+
+
+
+
+SideKick plugin user's guide
+
+
+ SlavaPestov
+
+
+ Legal Notice
+
+ Permission is granted to copy, distribute and/or modify this document
+ under the terms of the GNU Free Documentation License, Version 1.1 or
+ any later version published by the Free Software Foundation; with no
+ Invariant Sections
, Front-Cover Texts
or
+ Back-Cover Texts
, each as defined in the license. A copy of
+ the license can be found in the file COPYING.DOC.txt
+ included with jEdit.
+
+
+ The SideKick plugin itself is released under the GNU General Public License.
+ A copy of the GPL can be found in the jEdit online help.
+
+
+
+
+The structure browser window
+
+
+ The SideKick plugin provides a dockable window in which other plugins can
+ display buffer structure.
+
+
+
+ Plugins>SideKick>Structure
+ Browser displays the current buffer's structure in a
+ dockable window. This window is floating by
+ default, but it can be docked into the view in the Docking
+ pane of the Global Options dialog box.
+
+
+
+ The SideKick plugin automatically parses buffers
+ when they are loaded or saved, where possible.
+ Optionally, buffers can also be parsed on the fly, but this uses a fair bit of
+ memory and processor power so it is disabled by default.
+
+
+
+ Plugins>SideKick>Parse
+ on Keystroke is a checkbox menu item that toggles on-the-fly
+ parsing, for the current buffer only.
+
+
+
+ The current buffer can be parsed at any other time by clicking the parse
+ button in the Structure Browser window, or by
+ invoking the
+ Plugins>SideKick>Parse
+ Buffer command.
+
+
+
+ Any errors found while parsing the buffer are sent to the
+ ErrorList plugin, which means they are highlighted
+ in the text area, and shown in the
+ Plugins>Error
+ List>Error List window. See the
+ documentation for the ErrorList plugin for details.
+
+
+
+ Clicking on a node in the tree will move the caret to its location in the
+ buffer;
+ conversely, moving the caret in the buffer will select the corresponding
+ node.
+
+
+
+ Shift-clicking on a node will select that node in the text
+ area. Alt-clicking on a node will narrow the text area
+ display to that node.
+
+
+
+ If the structure browser window is docked into the current view, hovering the mouse
+ over a node will display its attributes in the status bar.
+
+
+
+
+Moving around
+
+
+ Plugins>SideKick>Go
+ to Previous Asset moves the caret to start of the structure
+ element (asset
).
+
+
+
+ Plugins>SideKick>Go
+ to Next Asset moves the caret to start of the next asset.
+
+
+
+ Plugins>SideKick>Select
+ Asset at Caret selects the asset at the caret position.
+
+
+
+
+Folding
+
+
+ The SideKick plugin adds a new sidekick
fold handler that
+ folds the buffer according to the structure tree. See the jEdit user's guide
+ for general details about folding.
+
+
+
+ Plugins>SideKick>Narrow to
+ Asset at Caret hides all text except that of the asset at the
+ caret location. This works in any folding mode, not just the sidekick
+ mode.
+
+
+
+Completion
+
+
+ A completion popup can be shown at any time
+ by invoking the
+ Plugins>SideKick>Show
+ Completion Popup command. Each plugin that uses SideKick
+ implements its own specific completion behavior; see the plugin documentation
+ for details.
+
+
+
+
+Developing SideKick back-ends
+
+
+ By itself the SideKick plugin is not very useful; it relies on other plugins to
+ provide buffer structure information. This chapter gives a brief overview of
+ how it's done.
+
+
+ Preliminaries
+
+
+ First you will also need to add a dependency for the SideKick plugin in your plugin's
+ property file:
+
+
+ plugin.MyPlugin.depend.n=plugin sidekick.SideKickPlugin 0.1
+
+
+ Note that you must replace n with the
+ appropriate number, as dependency properties must have consecutive numbers.
+
+
+
+ All SideKick plugin classes are in the sidekick package;
+ you will need to add import statements where appropriate.
+
+
+
+ Parser instances must be registered in your plugin's start()
+ method using the following method in the SideKickPlugin
+ class:
+
+
+
+
+ public void registerParser
+ SideKickParser parser
+
+
+
+
+ A corresponding method must be called from your plugin's stop()
+ method:
+
+
+
+
+ public void unregisterParser
+ SideKickParser parser
+
+
+
+
+
+ The SideKickParser class
+
+
+ SideKickParser is an abstract class. The constructor
+ takes one string parameter. This string is used in several properties:
+
+
+
+ sidekick.parser.name.label
+ - specifies a human-readable label for the parser, shown in status messages.
+
+ mode.mode.sidekick.parser
+ - properties of this form are used to associate a parser with an edit mode.
+
+
+
+
+ For example, the XML plugin, which provides two SideKickParser
+ implementations, defines these properties:
+
+
+ sidekick.parser.xml.label=XML
+mode.xml.sidekick.parser=xml
+mode.xsl.sidekick.parser=xml
+sidekick.parser.html.label=HTML
+mode.asp.sidekick.parser=html
+mode.coldfusion.sidekick.parser=html
+mode.html.sidekick.parser=html
+mode.jhtml.sidekick.parser=html
+mode.jsp.sidekick.parser=html
+mode.php.sidekick.parser=html
+mode.shtml.sidekick.parser=html
+mode.sgml.sidekick.parser=html
+mode.velocity.sidekick.parser=html
+
+
+
+Implementing a structure tree
+
+
+ The SideKickParser has one abstract method that all
+ subclasses must implement:
+
+
+
+
+ public SideKickParsedData parse
+ Buffer buffer
+ DefaultErrorSource errorSource
+
+
+
+
+ The latter parameter is an instance of a class provided by the
+ ErrorList plugin; consult its documentation for
+ details.
+
+
+
+ The method is called from a thread, so care must be taken to access the
+ buffer in a thread-safe manner; the API documentation for the
+ Buffer class describes how this is done.
+
+
+
+ The constructor of the SideKickParsedData class takes
+ one parameter, which is the file name (to be shown at the root of the structure
+ tree).
+
+
+
+ Your implementation of the parse() method should add
+ structure elements to the root field of the
+ SideKickParsedData instance. This field is an
+ instance of Java's DefaultMutableTreeNode class,
+ and is given a value by the SideKickParsedData constructor.
+
+
+
+
+ Implementing completion popups
+
+
+ This part has not been written yet. Use the source, Luke!
+
+
+
+
+
+
+Change log
+
+
+
+ Version 0.1 requires
+ jEdit 4.1pre11.
+
+
+ Initial release.
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/sax/count/count.f90
===================================================================
--- /XMLF90/doc/Examples/sax/count/count.f90 (revision 6)
+++ /XMLF90/doc/Examples/sax/count/count.f90 (revision 6)
@@ -0,0 +1,22 @@
+program count
+
+ use flib_sax
+ use m_count
+
+ integer :: i, iostat
+ type(xml_t) :: fxml
+
+ call open_xmlfile("big-file.xml",fxml,iostat)
+ if (iostat /= 0) stop "Cannot open file."
+
+ call xml_parse(fxml, &
+ begin_element_handler, &
+ end_element_handler, &
+ pcdata_chunk_handler)
+
+ do i=1,nhash
+ write(unit=*,fmt="(3a,i6)") "Number of ",trim(element_hash(i)%elm), &
+ " elements: ",element_hash(i)%num
+ enddo
+
+end program count
Index: /XMLF90/doc/Examples/sax/count/i.count.f90
===================================================================
--- /XMLF90/doc/Examples/sax/count/i.count.f90 (revision 6)
+++ /XMLF90/doc/Examples/sax/count/i.count.f90 (revision 6)
@@ -0,0 +1,22 @@
+program count
+
+ use flib_sax
+ use m_count
+
+ integer :: i, iostat
+ type(xml_t) :: fxml
+
+ call open_xmlfile("big-file.xml",fxml,iostat)
+ if (iostat /= 0) stop "Cannot open file."
+
+ call xml_parse(fxml, &
+ begin_element_handler, &
+ end_element_handler, &
+ pcdata_chunk_handler)
+
+ do i=1,nhash
+ write(unit=*,fmt="(3a,i6)") "Number of ",trim(element_hash(i)%elm), &
+ " elements: ",element_hash(i)%num
+ enddo
+
+end program count
Index: /XMLF90/doc/Examples/sax/count/i.m_count.f90
===================================================================
--- /XMLF90/doc/Examples/sax/count/i.m_count.f90 (revision 6)
+++ /XMLF90/doc/Examples/sax/count/i.m_count.f90 (revision 6)
@@ -0,0 +1,78 @@
+MODULE m_count
+!
+! Contributed by Jon Wakelin
+!
+
+ USE flib_sax
+
+ IMPLICIT NONE
+
+ private
+ PUBLIC :: begin_element_handler, end_element_handler, pcdata_chunk_handler
+
+ TYPE, public :: hash
+ CHARACTER(len=50) :: elm
+ INTEGER :: num
+ END TYPE hash
+
+ TYPE(hash), DIMENSION(50), public :: element_hash
+ INTEGER, public, save :: nhash = 0
+
+ INTEGER, private, save :: n = 0
+
+!--------------------------------------------------------
+CONTAINS
+
+ SUBROUTINE begin_element_handler(name,attributes)
+ character(len=*), intent(in) :: name
+ TYPE(dictionary_t), INTENT(in) :: attributes
+
+ LOGICAL :: match
+ INTEGER :: pmatch
+ INTEGER :: i
+
+ match = .false.
+
+!!! First time through loop element must be unique...
+ IF (n == 0) THEN
+ element_hash(n+1)%elm = name
+ element_hash(n+1)%num = 1
+ nhash=nhash+1
+ ELSE
+
+!!! ...thereafter we will have to check if it is unique
+ DO i=1,nhash
+ IF (name == element_hash(i)%elm) THEN
+ match = .true. ! set .true. if element already exists
+ pmatch = i ! and record the position at which the match occured
+ ! NB there can only ever be 1 or 0 matches
+ ENDIF
+ ENDDO
+
+!!! If element already exists increment the counter for THIS element
+ IF (match) THEN
+ element_hash(pmatch)%num = element_hash(pmatch)%num + 1
+ ELSE
+!!! Otherwise make a new entry in the hash
+ element_hash(n+1)%elm = name
+ element_hash(n+1)%num = 1
+ nhash=nhash+1
+ ENDIF
+ ENDIF
+ n=nhash
+
+ END SUBROUTINE begin_element_handler
+
+
+!--------------------------------------------------------------------------
+! End tag handler
+ SUBROUTINE end_element_handler(name)
+ character(len=*), intent(in) :: name
+ END SUBROUTINE end_element_handler
+
+ ! PCDATA handler
+ SUBROUTINE pcdata_chunk_handler(chunk)
+ CHARACTER(len=*), INTENT(in) :: chunk
+ END SUBROUTINE pcdata_chunk_handler
+
+END MODULE m_count
Index: /XMLF90/doc/Examples/sax/count/m_count.f90
===================================================================
--- /XMLF90/doc/Examples/sax/count/m_count.f90 (revision 6)
+++ /XMLF90/doc/Examples/sax/count/m_count.f90 (revision 6)
@@ -0,0 +1,78 @@
+MODULE m_count
+!
+! Contributed by Jon Wakelin
+!
+
+ USE flib_sax
+
+ IMPLICIT NONE
+
+ private
+ PUBLIC :: begin_element_handler, end_element_handler, pcdata_chunk_handler
+
+ TYPE, public :: hash
+ CHARACTER(len=50) :: elm
+ INTEGER :: num
+ END TYPE hash
+
+ TYPE(hash), DIMENSION(50), public :: element_hash
+ INTEGER, public, save :: nhash = 0
+
+ INTEGER, private, save :: n = 0
+
+!--------------------------------------------------------
+CONTAINS
+
+ SUBROUTINE begin_element_handler(name,attributes)
+ character(len=*), intent(in) :: name
+ TYPE(dictionary_t), INTENT(in) :: attributes
+
+ LOGICAL :: match
+ INTEGER :: pmatch
+ INTEGER :: i
+
+ match = .false.
+
+!!! First time through loop element must be unique...
+ IF (n == 0) THEN
+ element_hash(n+1)%elm = name
+ element_hash(n+1)%num = 1
+ nhash=nhash+1
+ ELSE
+
+!!! ...thereafter we will have to check if it is unique
+ DO i=1,nhash
+ IF (name == element_hash(i)%elm) THEN
+ match = .true. ! set .true. if element already exists
+ pmatch = i ! and record the position at which the match occured
+ ! NB there can only ever be 1 or 0 matches
+ ENDIF
+ ENDDO
+
+!!! If element already exists increment the counter for THIS element
+ IF (match) THEN
+ element_hash(pmatch)%num = element_hash(pmatch)%num + 1
+ ELSE
+!!! Otherwise make a new entry in the hash
+ element_hash(n+1)%elm = name
+ element_hash(n+1)%num = 1
+ nhash=nhash+1
+ ENDIF
+ ENDIF
+ n=nhash
+
+ END SUBROUTINE begin_element_handler
+
+
+!--------------------------------------------------------------------------
+! End tag handler
+ SUBROUTINE end_element_handler(name)
+ character(len=*), intent(in) :: name
+ END SUBROUTINE end_element_handler
+
+ ! PCDATA handler
+ SUBROUTINE pcdata_chunk_handler(chunk)
+ CHARACTER(len=*), INTENT(in) :: chunk
+ END SUBROUTINE pcdata_chunk_handler
+
+END MODULE m_count
Index: /XMLF90/doc/Examples/sax/count/makefile
===================================================================
--- /XMLF90/doc/Examples/sax/count/makefile (revision 6)
+++ /XMLF90/doc/Examples/sax/count/makefile (revision 6)
@@ -0,0 +1,32 @@
+#
+# Makefile for count (count elements in an xml document)
+#
+#---------------------------
+MK=$(FLIB_ROOT)/fortran.mk
+include $(MK)
+#---------------------------
+#
+# Uncomment the following line for debugging support
+#
+FFLAGS=$(FFLAGS_DEBUG)
+#
+LIBS=$(LIB_PREFIX)$(LIB_STD) -lflib
+#
+OBJS= m_count.o count.o
+#
+count: $(OBJS)
+ $(FC) $(LDFLAGS) -o $@ $(OBJS) $(LIBS)
+#
+clean:
+ rm -f *.o count *.$(MOD_EXT)
+#
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/sax/features/README
===================================================================
--- /XMLF90/doc/Examples/sax/features/README (revision 6)
+++ /XMLF90/doc/Examples/sax/features/README (revision 6)
@@ -0,0 +1,28 @@
+This directory contains a very simple but complete example of the use
+of the XML parser.
+
+The program, in file "example.f90", uses the module "m_handlers", which
+contains the handlers for the basic events: begin_element, end_element, and
+pcdata_chunk, as well as for the other, less useful events: XML and SGML
+declarations, and comments.
+
+The program opens the XML file, obtaining a file object, and calls
+xml_parse with the above handlers.
+
+In this particular case, the handler action is just to print out
+element/attribute information, and to dump any PCDATA sections, comments, and
+declarations, but "test.xml" shows all the constructs that the parser
+recognizes: standard and character entities, CDATA sections, etc.
+
+Turning on the 'verbose' flag in the call to xml_parse will result in a
+more detailed look at the workings of the parser.
+
+Type 'make' to compile, and 'example' to execute.
+
+**
+
+As a trivial example, the program xmlcheck will just check for
+well-formedness and print a count of characters processed. The
+name of the input file is hardwired to "INP" (one should of course
+pick it from the command line, perhaps using the f2kcli module).
+
Index: /XMLF90/doc/Examples/sax/features/example.f90
===================================================================
--- /XMLF90/doc/Examples/sax/features/example.f90 (revision 6)
+++ /XMLF90/doc/Examples/sax/features/example.f90 (revision 6)
@@ -0,0 +1,38 @@
+program example
+!
+! Example driver for a stand-alone parsing of an xml document
+!
+use flib_sax
+use m_handlers ! Defines begin_element, end_element, pcdata_chunk, etc
+
+ integer :: iostat
+ type(xml_t) :: fxml
+
+ call open_xmlfile("test.xml",fxml,iostat)
+ if (iostat /= 0) stop "Cannot open file."
+
+ call xml_parse(fxml, &
+ begin_element_handler = begin_element_handler , &
+ end_element_handler = end_element_handler, &
+ pcdata_chunk_handler = pcdata_chunk_handler, &
+ comment_handler = comment_handler, &
+ xml_declaration_handler = xml_declaration_handler, &
+ sgml_declaration_handler = sgml_declaration_handler, &
+ verbose = .false., &
+ empty_element_handler = empty_element_handler)
+
+end program example
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/sax/features/i.example.f90
===================================================================
--- /XMLF90/doc/Examples/sax/features/i.example.f90 (revision 6)
+++ /XMLF90/doc/Examples/sax/features/i.example.f90 (revision 6)
@@ -0,0 +1,38 @@
+program example
+!
+! Example driver for a stand-alone parsing of an xml document
+!
+use flib_sax
+use m_handlers ! Defines begin_element, end_element, pcdata_chunk, etc
+
+ integer :: iostat
+ type(xml_t) :: fxml
+
+ call open_xmlfile("test.xml",fxml,iostat)
+ if (iostat /= 0) stop "Cannot open file."
+
+ call xml_parse(fxml, &
+ begin_element_handler = begin_element_handler , &
+ end_element_handler = end_element_handler, &
+ pcdata_chunk_handler = pcdata_chunk_handler, &
+ comment_handler = comment_handler, &
+ xml_declaration_handler = xml_declaration_handler, &
+ sgml_declaration_handler = sgml_declaration_handler, &
+ verbose = .false., &
+ empty_element_handler = empty_element_handler)
+
+end program example
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/sax/features/i.m_handlers.f90
===================================================================
--- /XMLF90/doc/Examples/sax/features/i.m_handlers.f90 (revision 6)
+++ /XMLF90/doc/Examples/sax/features/i.m_handlers.f90 (revision 6)
@@ -0,0 +1,105 @@
+module m_handlers
+
+use flib_sax
+
+private
+
+!
+! A prototype of a specific language processor.
+! It defines the routines that are called from xml_parser in response
+! to particular events.
+!
+! In this particular example we just print the names of the elements
+! and the content of the pcdata chunks, as well as any comments, XML
+! and SGML declarations, etc.
+!
+! A module such as this could use "utility routines" to convert pcdata
+! to numerical arrays, and to populate specific data structures.
+!
+public :: begin_element_handler, end_element_handler, pcdata_chunk_handler
+public :: comment_handler, xml_declaration_handler, sgml_declaration_handler
+public :: empty_element_handler
+
+CONTAINS !=============================================================
+
+subroutine begin_element_handler(name,attributes)
+character(len=*), intent(in) :: name
+type(dictionary_t), intent(in) :: attributes
+
+write(unit=*,fmt="(2a)") ">>Begin Element: ", name
+write(unit=*,fmt="(a,i2,a)") "--- ", len(attributes), " attributes:"
+call print_dict(attributes)
+end subroutine begin_element_handler
+
+!--------------------------------------------------
+subroutine end_element_handler(name)
+character(len=*), intent(in) :: name
+
+ write(unit=*,fmt="(/,2a)") ">>-------------End Element: ", trim(name)
+
+end subroutine end_element_handler
+
+!--------------------------------------------------
+subroutine pcdata_chunk_handler(chunk)
+character(len=*), intent(in) :: chunk
+
+write(unit=*,fmt="(a)",advance="no") trim(chunk)
+
+end subroutine pcdata_chunk_handler
+
+!--------------------------------------------------
+subroutine empty_element_handler(name,attributes)
+character(len=*), intent(in) :: name
+type(dictionary_t), intent(in) :: attributes
+
+write(unit=*,fmt="(2a)") ">>Empty Element: ", name
+write(unit=*,fmt="(a,i2,a)") "--- ", len(attributes), " attributes:"
+call print_dict(attributes)
+write(unit=*,fmt="(2a)") ">>-------------End Empty Element: ", trim(name)
+
+end subroutine empty_element_handler
+
+!--------------------------------------------------
+subroutine comment_handler(comment)
+character(len=*), intent(in) :: comment
+
+write(unit=*,fmt="(a)") ">>Comment: "
+write(unit=*,fmt="(a)") trim(comment)
+
+end subroutine comment_handler
+
+!--------------------------------------------------
+subroutine xml_declaration_handler(name,attributes)
+character(len=*), intent(in) :: name
+type(dictionary_t), intent(in) :: attributes
+!
+! Same structure as an element tag
+!
+ write(unit=*,fmt="(2a)") ">>XML declaration: ", name
+ call print_dict(attributes)
+
+end subroutine xml_declaration_handler
+
+!--------------------------------------------------
+subroutine sgml_declaration_handler(sgmldecl)
+character(len=*), intent(in) :: sgmldecl
+!
+write(unit=*,fmt="(a)") ">>SGML declaration: "
+write(unit=*,fmt="(a)") trim(sgmldecl)
+
+end subroutine sgml_declaration_handler
+!--------------------------------------------------
+
+end module m_handlers
+
+
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/sax/features/i.xmlcheck.f90
===================================================================
--- /XMLF90/doc/Examples/sax/features/i.xmlcheck.f90 (revision 6)
+++ /XMLF90/doc/Examples/sax/features/i.xmlcheck.f90 (revision 6)
@@ -0,0 +1,31 @@
+program xmlcheck
+!
+! Checks for well-formedness of an XML file
+!
+use flib_sax
+
+ integer :: iostat
+ type(xml_t) :: fxml
+
+ call open_xmlfile("INP",fxml,iostat)
+ if (iostat /= 0) stop "Cannot open file INP."
+
+ call xml_parse(fxml, verbose = .false.)
+
+ print *, "Characters processed: ", xml_char_count(fxml)
+
+end program xmlcheck
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/sax/features/m_handlers.f90
===================================================================
--- /XMLF90/doc/Examples/sax/features/m_handlers.f90 (revision 6)
+++ /XMLF90/doc/Examples/sax/features/m_handlers.f90 (revision 6)
@@ -0,0 +1,105 @@
+module m_handlers
+
+use flib_sax
+
+private
+
+!
+! A prototype of a specific language processor.
+! It defines the routines that are called from xml_parser in response
+! to particular events.
+!
+! In this particular example we just print the names of the elements
+! and the content of the pcdata chunks, as well as any comments, XML
+! and SGML declarations, etc.
+!
+! A module such as this could use "utility routines" to convert pcdata
+! to numerical arrays, and to populate specific data structures.
+!
+public :: begin_element_handler, end_element_handler, pcdata_chunk_handler
+public :: comment_handler, xml_declaration_handler, sgml_declaration_handler
+public :: empty_element_handler
+
+CONTAINS !=============================================================
+
+subroutine begin_element_handler(name,attributes)
+character(len=*), intent(in) :: name
+type(dictionary_t), intent(in) :: attributes
+
+write(unit=*,fmt="(2a)") ">>Begin Element: ", name
+write(unit=*,fmt="(a,i2,a)") "--- ", len(attributes), " attributes:"
+call print_dict(attributes)
+end subroutine begin_element_handler
+
+!--------------------------------------------------
+subroutine end_element_handler(name)
+character(len=*), intent(in) :: name
+
+ write(unit=*,fmt="(/,2a)") ">>-------------End Element: ", trim(name)
+
+end subroutine end_element_handler
+
+!--------------------------------------------------
+subroutine pcdata_chunk_handler(chunk)
+character(len=*), intent(in) :: chunk
+
+write(unit=*,fmt="(a)",advance="no") trim(chunk)
+
+end subroutine pcdata_chunk_handler
+
+!--------------------------------------------------
+subroutine empty_element_handler(name,attributes)
+character(len=*), intent(in) :: name
+type(dictionary_t), intent(in) :: attributes
+
+write(unit=*,fmt="(2a)") ">>Empty Element: ", name
+write(unit=*,fmt="(a,i2,a)") "--- ", len(attributes), " attributes:"
+call print_dict(attributes)
+write(unit=*,fmt="(2a)") ">>-------------End Empty Element: ", trim(name)
+
+end subroutine empty_element_handler
+
+!--------------------------------------------------
+subroutine comment_handler(comment)
+character(len=*), intent(in) :: comment
+
+write(unit=*,fmt="(a)") ">>Comment: "
+write(unit=*,fmt="(a)") trim(comment)
+
+end subroutine comment_handler
+
+!--------------------------------------------------
+subroutine xml_declaration_handler(name,attributes)
+character(len=*), intent(in) :: name
+type(dictionary_t), intent(in) :: attributes
+!
+! Same structure as an element tag
+!
+ write(unit=*,fmt="(2a)") ">>XML declaration: ", name
+ call print_dict(attributes)
+
+end subroutine xml_declaration_handler
+
+!--------------------------------------------------
+subroutine sgml_declaration_handler(sgmldecl)
+character(len=*), intent(in) :: sgmldecl
+!
+write(unit=*,fmt="(a)") ">>SGML declaration: "
+write(unit=*,fmt="(a)") trim(sgmldecl)
+
+end subroutine sgml_declaration_handler
+!--------------------------------------------------
+
+end module m_handlers
+
+
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/sax/features/makefile
===================================================================
--- /XMLF90/doc/Examples/sax/features/makefile (revision 6)
+++ /XMLF90/doc/Examples/sax/features/makefile (revision 6)
@@ -0,0 +1,37 @@
+#
+# Makefile for example of XML processing with all kinds of handlers
+# and features.
+#
+default: example xmlcheck
+#
+#---------------------------
+MK=$(FLIB_ROOT)/fortran.mk
+include $(MK)
+#---------------------------
+#
+# Uncomment the following line for debugging support
+#
+FFLAGS=$(FFLAGS_DEBUG)
+#
+LIBS=$(LIB_PREFIX)$(LIB_STD) -lflib
+#
+OBJS= m_handlers.o example.o
+
+example: $(OBJS)
+ $(FC) $(LDFLAGS) -o $@ $(OBJS) $(LIBS)
+xmlcheck: xmlcheck.o
+ $(FC) $(LDFLAGS) -o $@ xmlcheck.o $(LIBS)
+#
+clean:
+ rm -f *.o example xmlcheck *.$(MOD_EXT)
+#
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/sax/features/test.xml
===================================================================
--- /XMLF90/doc/Examples/sax/features/test.xml (revision 6)
+++ /XMLF90/doc/Examples/sax/features/test.xml (revision 6)
@@ -0,0 +1,47 @@
+
+
+
+
+
+
+
+
+
+
+A small file exercising all the features
+ in the parser...
+
+
+Mary had a <little> lamb who liked standard entities
+
+This is some text, with character references (O W)
+and some cdata sections inside to make it more interesting. How about this
+
+ pepe
+ ]]> ?
+
+
+
+
+
+In the next pcdata chunk there is an unknown entity
+1.24 ¬known;3.45
+(It was flagged, but the parser continued)
+
+In the following chunk there is a character reference out of range of the
+char() intrinsic... remove it from test.xml if it gives you trouble.
+
+Offending reference:
+
+2.454 9.455
+>>]]]<<<>!? ]]>
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/sax/features/xmlcheck.f90
===================================================================
--- /XMLF90/doc/Examples/sax/features/xmlcheck.f90 (revision 6)
+++ /XMLF90/doc/Examples/sax/features/xmlcheck.f90 (revision 6)
@@ -0,0 +1,31 @@
+program xmlcheck
+!
+! Checks for well-formedness of an XML file
+!
+use flib_sax
+
+ integer :: iostat
+ type(xml_t) :: fxml
+
+ call open_xmlfile("INP",fxml,iostat)
+ if (iostat /= 0) stop "Cannot open file INP."
+
+ call xml_parse(fxml, verbose = .false.)
+
+ print *, "Characters processed: ", xml_char_count(fxml)
+
+end program xmlcheck
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/sax/pseudo/README
===================================================================
--- /XMLF90/doc/Examples/sax/pseudo/README (revision 6)
+++ /XMLF90/doc/Examples/sax/pseudo/README (revision 6)
@@ -0,0 +1,24 @@
+This directory contains a real-world example of processing an XML file.
+
+Pseudo.xml is a prototype XML pseudopotential file, containing, apart
+from identification information, several datasets representing functions
+of a radial coordinate. These functions are given as tables with an underlying
+grid. The grid can be common to all, or each radial function ("radfunc") can
+have its own.
+
+The program reads the XML file and then constructs a data structure
+with all the information in the file, ready to be processed by other
+utilities, such as an electronic-structure program.
+
+Pseudo.xml is just a prototype, and this program is just an illustration
+of the kinds of idioms one can use to process a non-trivial XML file
+using a SAX-like parser.
+
+The basic data structures are defined in module m_pseudo_types, and the
+handlers are in m_pseudo.f90.
+
+Type 'make' to compile, and 'pseudo' to execute.
+(In the interest of simplicity, this program is hardwired to process
+the 'pseudo.xml' file. For command-line control, one could use the
+routines in the f2kcli module.)
+
Index: /XMLF90/doc/Examples/sax/pseudo/i.m_pseudo.f90
===================================================================
--- /XMLF90/doc/Examples/sax/pseudo/i.m_pseudo.f90 (revision 6)
+++ /XMLF90/doc/Examples/sax/pseudo/i.m_pseudo.f90 (revision 6)
@@ -0,0 +1,261 @@
+module m_pseudo
+!
+! PSEUDO version 0.5 processing
+! A full example of the building up of a data structure using
+! the SAX paradigm.
+!
+use flib_sax
+use m_pseudo_types ! Data types
+
+private
+
+!
+! It defines the routines that are called from xml_parser in response
+! to particular events.
+!
+public :: begin_element, end_element, pcdata_chunk
+private :: die
+
+logical, private :: in_vps = .false. , in_radfunc = .false.
+logical, private :: in_semilocal = .false. , in_header = .false.
+logical, private :: in_coreCharge = .false. , in_data = .false.
+logical, private :: in_valenceCharge = .false.
+
+integer, private, save :: ndata
+
+type(pseudo_t), private, target, save :: pseudo
+type(grid_t), private, save :: grid
+type(grid_t), private, save :: global_grid
+!
+! Pointers to make it easier to manage the data
+!
+type(header_t), private, pointer :: hp
+type(vps_t), private, pointer :: pp
+type(radfunc_t), private, pointer :: rp
+
+CONTAINS !===========================================================
+
+!----------------------------------------------------------------------
+subroutine begin_element(name,attributes)
+character(len=*), intent(in) :: name
+type(dictionary_t), intent(in) :: attributes
+
+character(len=100) :: value
+integer :: status
+
+
+select case(name)
+
+ case ("pseudo")
+ call get_value(attributes,"version",value,status)
+ if (value == "0.5") then
+ print *, "Processing a PSEUDO version 0.5 XML file"
+ pseudo%npots = 0
+ global_grid%npts = 0
+ else
+ print *, "Can only work with PSEUDO version 0.5 XML files"
+ STOP
+ endif
+
+ case ("header")
+ in_header = .true.
+ hp => pseudo%header
+
+ call get_value(attributes,"symbol",hp%symbol,status)
+ if (status /= 0 ) call die("Cannot determine atomic symbol")
+
+ call get_value(attributes,"zval",value,status)
+ if (status /= 0 ) call die("Cannot determine zval")
+ read(unit=value,fmt=*) hp%zval
+!
+ call get_value(attributes,"creator",hp%creator,status)
+ if (status /= 0 ) hp%creator="unknown"
+
+ call get_value(attributes,"flavor",hp%flavor,status)
+ if (status /= 0 ) hp%flavor="unknown"
+
+ call get_value(attributes,"relativistic",value,status)
+ if (status /= 0 ) value = "no"
+ hp%relativistic = (value == "yes")
+
+ call get_value(attributes,"polarized",value,status)
+ if (status /= 0 ) value = "no"
+ hp%polarized = (value == "yes")
+
+ call get_value(attributes,"core-corrections", &
+ hp%core_corrections,status)
+ if (status /= 0 ) hp%core_corrections = "nc"
+
+ case ("vps")
+ in_vps = .true.
+
+ pseudo%npots = pseudo%npots + 1
+ pp => pseudo%pot(pseudo%npots)
+ rp => pp%V ! Pointer to radial function
+
+ call get_value(attributes,"l",value,status)
+ if (status /= 0 ) call die("Cannot determine l for Vps")
+ read(unit=value,fmt=*) pp%l
+
+ call get_value(attributes,"principal-n",value,status)
+ if (status /= 0 ) call die("Cannot determine n for Vps")
+ read(unit=value,fmt=*) pp%n
+
+ call get_value(attributes,"cutoff",value,status)
+ if (status /= 0 ) call die("Cannot determine cutoff for Vps")
+ read(unit=value,fmt=*) pp%cutoff
+
+ call get_value(attributes,"occupation",value,status)
+ if (status /= 0 ) call die("Cannot determine occupation for Vps")
+ read(unit=value,fmt=*) pp%occupation
+
+ call get_value(attributes,"spin",value,status)
+ if (status /= 0 ) call die("Cannot determine spin for Vps")
+ read(unit=value,fmt=*) pp%spin
+
+ case ("grid")
+
+ call get_value(attributes,"type",grid%type,status)
+ if (status /= 0 ) call die("Cannot determine grid type")
+
+ call get_value(attributes,"npts",value,status)
+ if (status /= 0 ) call die("Cannot determine grid npts")
+ read(unit=value,fmt=*) grid%npts
+
+ call get_value(attributes,"scale",value,status)
+ if (status /= 0 ) call die("Cannot determine grid scale")
+ read(unit=value,fmt=*) grid%scale
+
+ call get_value(attributes,"step",value,status)
+ if (status /= 0 ) call die("Cannot determine grid step")
+ read(unit=value,fmt=*) grid%step
+
+ !
+ ! In this way we allow for a private grid for each radfunc,
+ ! or for a global grid specification
+ !
+ if (in_radfunc) then
+ rp%grid = grid
+ else
+ global_grid = grid
+ endif
+
+ case ("data")
+ in_data = .true.
+ if (rp%grid%npts == 0) STOP "Grid not specified correctly"
+ allocate(rp%data(rp%grid%npts))
+ ndata = 0 ! To start the build up
+
+ case ("radfunc")
+ in_radfunc = .true.
+ rp%grid = global_grid ! Might be empty
+ ! There should then be a local grid element
+ ! read later
+
+ case ("pseudocore-charge")
+ in_coreCharge = .true.
+ rp => pseudo%core_charge
+
+ case ("valence-charge")
+ in_valenceCharge = .true.
+ rp => pseudo%valence_charge
+
+ case ("semilocal")
+ in_semilocal = .true.
+
+ call get_value(attributes,"npots-down",value,status)
+ if (status /= 0 ) call die("Cannot determine npots-down")
+ read(unit=value,fmt=*) pseudo%npots_down
+
+ call get_value(attributes,"npots-up",value,status)
+ if (status /= 0 ) call die("Cannot determine npots-up")
+ read(unit=value,fmt=*) pseudo%npots_up
+
+end select
+
+end subroutine begin_element
+!----------------------------------------------------------------------
+
+subroutine end_element(name)
+character(len=*), intent(in) :: name
+
+select case(name)
+
+ case ("vps")
+ in_vps = .false.
+
+ case ("radfunc")
+ in_radfunc = .false.
+
+ case ("data")
+ !
+ ! We are done filling up the radfunc data
+ ! Check that we got the advertised number of items
+ !
+ in_data = .false.
+ if (ndata /= size(rp%data)) STOP "npts mismatch"
+
+ case ("pseudocore-charge")
+ in_coreCharge = .false.
+
+ case ("valence-charge")
+ in_valenceCharge = .false.
+
+ case ("semilocal")
+ in_semilocal = .false.
+
+ case ("pseudo")
+ call dump_pseudo(pseudo)
+
+end select
+
+end subroutine end_element
+!----------------------------------------------------------------------
+
+subroutine pcdata_chunk(chunk)
+character(len=*), intent(in) :: chunk
+
+
+if (len_trim(chunk) == 0) RETURN ! skip empty chunk
+
+if (in_data) then
+!
+! Note that we know where we need to put it through the pointer rp...
+!
+ call build_data_array(chunk,rp%data,ndata)
+
+else if (in_header) then
+ !
+ ! There should not be any pcdata in header in this version...
+
+ print *, "Header data:"
+ print *, trim(chunk)
+
+endif
+
+end subroutine pcdata_chunk
+!----------------------------------------------------------------------
+
+ subroutine die(str)
+ character(len=*), intent(in), optional :: str
+ if (present(str)) then
+ write(unit=0,fmt="(a)") trim(str)
+ endif
+ write(unit=0,fmt="(a)") "Stopping Program"
+ stop
+ end subroutine die
+
+
+end module m_pseudo
+
+
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/sax/pseudo/i.m_pseudo_types.f90
===================================================================
--- /XMLF90/doc/Examples/sax/pseudo/i.m_pseudo_types.f90 (revision 6)
+++ /XMLF90/doc/Examples/sax/pseudo/i.m_pseudo_types.f90 (revision 6)
@@ -0,0 +1,107 @@
+module m_pseudo_types
+!
+! Data structures for a prototype pseudopotential
+!
+integer, parameter, private :: MAXN_POTS = 8
+integer, parameter, private :: dp = selected_real_kind(14)
+!
+public :: dump_pseudo
+!
+!-----------------------------------------------------------
+type, public :: grid_t
+!
+! It should be possible to represent both log and linear
+! grids with a few parameters here.
+!
+ character(len=20) :: type
+ real(kind=dp) :: scale
+ real(kind=dp) :: step
+ integer :: npts
+end type grid_t
+!
+type, public :: radfunc_t
+ type(grid_t) :: grid
+ real(kind=dp), dimension(:), pointer :: data
+end type radfunc_t
+
+type, public :: vps_t
+ integer :: l
+ integer :: n
+ integer :: spin
+ real(kind=dp) :: occupation
+ real(kind=dp) :: cutoff
+ type(radfunc_t) :: V
+end type vps_t
+
+type, public :: header_t
+ character(len=2) :: symbol
+ real(kind=dp) :: zval
+ character(len=10) :: creator
+ character(len=10) :: date
+ character(len=40) :: flavor
+ logical :: relativistic
+ logical :: polarized
+ character(len=2) :: correlation
+ character(len=4) :: core_corrections
+end type header_t
+
+type, public :: pseudo_t
+ type(header_t) :: header
+ integer :: npots
+ integer :: npots_down
+ integer :: npots_up
+ type(vps_t), dimension(MAXN_POTS) :: pot
+ type(radfunc_t) :: core_charge
+ type(radfunc_t) :: valence_charge
+end type pseudo_t
+
+
+CONTAINS !===============================================
+
+subroutine dump_pseudo(pseudo)
+type(pseudo_t), intent(in), target :: pseudo
+
+integer :: i
+type(vps_t), pointer :: pp
+type(radfunc_t), pointer :: rp
+
+print *, "---PSEUDO data:"
+
+do i = 1, pseudo%npots
+ pp => pseudo%pot(i)
+ rp => pseudo%pot(i)%V
+ print *, "VPS ", i, " angular momentum: ", pp%l
+ print *, " n: ", pp%n
+ print *, " occupation: ", pp%occupation
+ print *, " cutoff: ", pp%cutoff
+ print *, " spin: ", pp%spin
+ print *, "grid data: ", rp%grid%npts, rp%grid%scale
+enddo
+rp => pseudo%valence_charge
+print *, "grid data: ", rp%grid%npts, rp%grid%scale
+rp => pseudo%core_charge
+print *, "grid data: ", rp%grid%npts, rp%grid%scale
+
+end subroutine dump_pseudo
+
+end module m_pseudo_types
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/sax/pseudo/i.pseudo.f90
===================================================================
--- /XMLF90/doc/Examples/sax/pseudo/i.pseudo.f90 (revision 6)
+++ /XMLF90/doc/Examples/sax/pseudo/i.pseudo.f90 (revision 6)
@@ -0,0 +1,31 @@
+program pseudo
+!
+! Example driver for the construction of data structures from an xml document
+!
+use flib_sax
+use m_pseudo ! Defines begin_element, end_element, pcdata_chunk
+
+integer :: iostat
+type(xml_t) :: fxml
+
+call open_xmlfile("pseudo.xml",fxml,iostat)
+if (iostat /=0) stop "Cannot open file"
+
+call xml_parse(fxml, &
+ begin_element,end_element,pcdata_chunk,verbose=.false.)
+
+end program pseudo
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/sax/pseudo/m_pseudo.f90
===================================================================
--- /XMLF90/doc/Examples/sax/pseudo/m_pseudo.f90 (revision 6)
+++ /XMLF90/doc/Examples/sax/pseudo/m_pseudo.f90 (revision 6)
@@ -0,0 +1,261 @@
+module m_pseudo
+!
+! PSEUDO version 0.5 processing
+! A full example of the building up of a data structure using
+! the SAX paradigm.
+!
+use flib_sax
+use m_pseudo_types ! Data types
+
+private
+
+!
+! It defines the routines that are called from xml_parser in response
+! to particular events.
+!
+public :: begin_element, end_element, pcdata_chunk
+private :: die
+
+logical, private :: in_vps = .false. , in_radfunc = .false.
+logical, private :: in_semilocal = .false. , in_header = .false.
+logical, private :: in_coreCharge = .false. , in_data = .false.
+logical, private :: in_valenceCharge = .false.
+
+integer, private, save :: ndata
+
+type(pseudo_t), private, target, save :: pseudo
+type(grid_t), private, save :: grid
+type(grid_t), private, save :: global_grid
+!
+! Pointers to make it easier to manage the data
+!
+type(header_t), private, pointer :: hp
+type(vps_t), private, pointer :: pp
+type(radfunc_t), private, pointer :: rp
+
+CONTAINS !===========================================================
+
+!----------------------------------------------------------------------
+subroutine begin_element(name,attributes)
+character(len=*), intent(in) :: name
+type(dictionary_t), intent(in) :: attributes
+
+character(len=100) :: value
+integer :: status
+
+
+select case(name)
+
+ case ("pseudo")
+ call get_value(attributes,"version",value,status)
+ if (value == "0.5") then
+ print *, "Processing a PSEUDO version 0.5 XML file"
+ pseudo%npots = 0
+ global_grid%npts = 0
+ else
+ print *, "Can only work with PSEUDO version 0.5 XML files"
+ STOP
+ endif
+
+ case ("header")
+ in_header = .true.
+ hp => pseudo%header
+
+ call get_value(attributes,"symbol",hp%symbol,status)
+ if (status /= 0 ) call die("Cannot determine atomic symbol")
+
+ call get_value(attributes,"zval",value,status)
+ if (status /= 0 ) call die("Cannot determine zval")
+ read(unit=value,fmt=*) hp%zval
+!
+ call get_value(attributes,"creator",hp%creator,status)
+ if (status /= 0 ) hp%creator="unknown"
+
+ call get_value(attributes,"flavor",hp%flavor,status)
+ if (status /= 0 ) hp%flavor="unknown"
+
+ call get_value(attributes,"relativistic",value,status)
+ if (status /= 0 ) value = "no"
+ hp%relativistic = (value == "yes")
+
+ call get_value(attributes,"polarized",value,status)
+ if (status /= 0 ) value = "no"
+ hp%polarized = (value == "yes")
+
+ call get_value(attributes,"core-corrections", &
+ hp%core_corrections,status)
+ if (status /= 0 ) hp%core_corrections = "nc"
+
+ case ("vps")
+ in_vps = .true.
+
+ pseudo%npots = pseudo%npots + 1
+ pp => pseudo%pot(pseudo%npots)
+ rp => pp%V ! Pointer to radial function
+
+ call get_value(attributes,"l",value,status)
+ if (status /= 0 ) call die("Cannot determine l for Vps")
+ read(unit=value,fmt=*) pp%l
+
+ call get_value(attributes,"principal-n",value,status)
+ if (status /= 0 ) call die("Cannot determine n for Vps")
+ read(unit=value,fmt=*) pp%n
+
+ call get_value(attributes,"cutoff",value,status)
+ if (status /= 0 ) call die("Cannot determine cutoff for Vps")
+ read(unit=value,fmt=*) pp%cutoff
+
+ call get_value(attributes,"occupation",value,status)
+ if (status /= 0 ) call die("Cannot determine occupation for Vps")
+ read(unit=value,fmt=*) pp%occupation
+
+ call get_value(attributes,"spin",value,status)
+ if (status /= 0 ) call die("Cannot determine spin for Vps")
+ read(unit=value,fmt=*) pp%spin
+
+ case ("grid")
+
+ call get_value(attributes,"type",grid%type,status)
+ if (status /= 0 ) call die("Cannot determine grid type")
+
+ call get_value(attributes,"npts",value,status)
+ if (status /= 0 ) call die("Cannot determine grid npts")
+ read(unit=value,fmt=*) grid%npts
+
+ call get_value(attributes,"scale",value,status)
+ if (status /= 0 ) call die("Cannot determine grid scale")
+ read(unit=value,fmt=*) grid%scale
+
+ call get_value(attributes,"step",value,status)
+ if (status /= 0 ) call die("Cannot determine grid step")
+ read(unit=value,fmt=*) grid%step
+
+ !
+ ! In this way we allow for a private grid for each radfunc,
+ ! or for a global grid specification
+ !
+ if (in_radfunc) then
+ rp%grid = grid
+ else
+ global_grid = grid
+ endif
+
+ case ("data")
+ in_data = .true.
+ if (rp%grid%npts == 0) STOP "Grid not specified correctly"
+ allocate(rp%data(rp%grid%npts))
+ ndata = 0 ! To start the build up
+
+ case ("radfunc")
+ in_radfunc = .true.
+ rp%grid = global_grid ! Might be empty
+ ! There should then be a local grid element
+ ! read later
+
+ case ("pseudocore-charge")
+ in_coreCharge = .true.
+ rp => pseudo%core_charge
+
+ case ("valence-charge")
+ in_valenceCharge = .true.
+ rp => pseudo%valence_charge
+
+ case ("semilocal")
+ in_semilocal = .true.
+
+ call get_value(attributes,"npots-down",value,status)
+ if (status /= 0 ) call die("Cannot determine npots-down")
+ read(unit=value,fmt=*) pseudo%npots_down
+
+ call get_value(attributes,"npots-up",value,status)
+ if (status /= 0 ) call die("Cannot determine npots-up")
+ read(unit=value,fmt=*) pseudo%npots_up
+
+end select
+
+end subroutine begin_element
+!----------------------------------------------------------------------
+
+subroutine end_element(name)
+character(len=*), intent(in) :: name
+
+select case(name)
+
+ case ("vps")
+ in_vps = .false.
+
+ case ("radfunc")
+ in_radfunc = .false.
+
+ case ("data")
+ !
+ ! We are done filling up the radfunc data
+ ! Check that we got the advertised number of items
+ !
+ in_data = .false.
+ if (ndata /= size(rp%data)) STOP "npts mismatch"
+
+ case ("pseudocore-charge")
+ in_coreCharge = .false.
+
+ case ("valence-charge")
+ in_valenceCharge = .false.
+
+ case ("semilocal")
+ in_semilocal = .false.
+
+ case ("pseudo")
+ call dump_pseudo(pseudo)
+
+end select
+
+end subroutine end_element
+!----------------------------------------------------------------------
+
+subroutine pcdata_chunk(chunk)
+character(len=*), intent(in) :: chunk
+
+
+if (len_trim(chunk) == 0) RETURN ! skip empty chunk
+
+if (in_data) then
+!
+! Note that we know where we need to put it through the pointer rp...
+!
+ call build_data_array(chunk,rp%data,ndata)
+
+else if (in_header) then
+ !
+ ! There should not be any pcdata in header in this version...
+
+ print *, "Header data:"
+ print *, trim(chunk)
+
+endif
+
+end subroutine pcdata_chunk
+!----------------------------------------------------------------------
+
+ subroutine die(str)
+ character(len=*), intent(in), optional :: str
+ if (present(str)) then
+ write(unit=0,fmt="(a)") trim(str)
+ endif
+ write(unit=0,fmt="(a)") "Stopping Program"
+ stop
+ end subroutine die
+
+
+end module m_pseudo
+
+
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/sax/pseudo/m_pseudo_types.f90
===================================================================
--- /XMLF90/doc/Examples/sax/pseudo/m_pseudo_types.f90 (revision 6)
+++ /XMLF90/doc/Examples/sax/pseudo/m_pseudo_types.f90 (revision 6)
@@ -0,0 +1,107 @@
+module m_pseudo_types
+!
+! Data structures for a prototype pseudopotential
+!
+integer, parameter, private :: MAXN_POTS = 8
+integer, parameter, private :: dp = selected_real_kind(14)
+!
+public :: dump_pseudo
+!
+!-----------------------------------------------------------
+type, public :: grid_t
+!
+! It should be possible to represent both log and linear
+! grids with a few parameters here.
+!
+ character(len=20) :: type
+ real(kind=dp) :: scale
+ real(kind=dp) :: step
+ integer :: npts
+end type grid_t
+!
+type, public :: radfunc_t
+ type(grid_t) :: grid
+ real(kind=dp), dimension(:), pointer :: data
+end type radfunc_t
+
+type, public :: vps_t
+ integer :: l
+ integer :: n
+ integer :: spin
+ real(kind=dp) :: occupation
+ real(kind=dp) :: cutoff
+ type(radfunc_t) :: V
+end type vps_t
+
+type, public :: header_t
+ character(len=2) :: symbol
+ real(kind=dp) :: zval
+ character(len=10) :: creator
+ character(len=10) :: date
+ character(len=40) :: flavor
+ logical :: relativistic
+ logical :: polarized
+ character(len=2) :: correlation
+ character(len=4) :: core_corrections
+end type header_t
+
+type, public :: pseudo_t
+ type(header_t) :: header
+ integer :: npots
+ integer :: npots_down
+ integer :: npots_up
+ type(vps_t), dimension(MAXN_POTS) :: pot
+ type(radfunc_t) :: core_charge
+ type(radfunc_t) :: valence_charge
+end type pseudo_t
+
+
+CONTAINS !===============================================
+
+subroutine dump_pseudo(pseudo)
+type(pseudo_t), intent(in), target :: pseudo
+
+integer :: i
+type(vps_t), pointer :: pp
+type(radfunc_t), pointer :: rp
+
+print *, "---PSEUDO data:"
+
+do i = 1, pseudo%npots
+ pp => pseudo%pot(i)
+ rp => pseudo%pot(i)%V
+ print *, "VPS ", i, " angular momentum: ", pp%l
+ print *, " n: ", pp%n
+ print *, " occupation: ", pp%occupation
+ print *, " cutoff: ", pp%cutoff
+ print *, " spin: ", pp%spin
+ print *, "grid data: ", rp%grid%npts, rp%grid%scale
+enddo
+rp => pseudo%valence_charge
+print *, "grid data: ", rp%grid%npts, rp%grid%scale
+rp => pseudo%core_charge
+print *, "grid data: ", rp%grid%npts, rp%grid%scale
+
+end subroutine dump_pseudo
+
+end module m_pseudo_types
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/sax/pseudo/makefile
===================================================================
--- /XMLF90/doc/Examples/sax/pseudo/makefile (revision 6)
+++ /XMLF90/doc/Examples/sax/pseudo/makefile (revision 6)
@@ -0,0 +1,34 @@
+#
+# Makefile for Pseudo XML processing
+#
+default: pseudo
+#
+#---------------------------
+MK=$(FLIB_ROOT)/fortran.mk
+include $(MK)
+#---------------------------
+#
+# Uncomment the following line for debugging support
+#
+FFLAGS=$(FFLAGS_DEBUG)
+#
+LIBS=$(LIB_PREFIX)$(LIB_STD) -lflib
+#
+OBJS= m_pseudo_types.o m_pseudo.o pseudo.o
+
+pseudo: $(OBJS)
+ $(FC) $(LDFLAGS) -o $@ $(OBJS) $(LIBS)
+#
+clean:
+ rm -f *.o pseudo *.$(MOD_EXT)
+#
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/sax/pseudo/pseudo.f90
===================================================================
--- /XMLF90/doc/Examples/sax/pseudo/pseudo.f90 (revision 6)
+++ /XMLF90/doc/Examples/sax/pseudo/pseudo.f90 (revision 6)
@@ -0,0 +1,31 @@
+program pseudo
+!
+! Example driver for the construction of data structures from an xml document
+!
+use flib_sax
+use m_pseudo ! Defines begin_element, end_element, pcdata_chunk
+
+integer :: iostat
+type(xml_t) :: fxml
+
+call open_xmlfile("pseudo.xml",fxml,iostat)
+if (iostat /=0) stop "Cannot open file"
+
+call xml_parse(fxml, &
+ begin_element,end_element,pcdata_chunk,verbose=.false.)
+
+end program pseudo
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/sax/pseudo/pseudo.xml
===================================================================
--- /XMLF90/doc/Examples/sax/pseudo/pseudo.xml (revision 6)
+++ /XMLF90/doc/Examples/sax/pseudo/pseudo.xml (revision 6)
@@ -0,0 +1,164 @@
+
+
+
+
+
+
+
+
+
+ -0.331900385172E-04 -0.667975563254E-04 -0.100827804667E-03 -0.135286100838E-03
+ -0.170177829017E-03 -0.205508441107E-03 -0.241283457588E-03 -0.277508468378E-03
+
+
+
+
+
+
+ -0.498621054540E-04 -0.100351398985E-03 -0.151475769648E-03 -0.203243205728E-03
+ -0.255661795995E-03 -0.308739730957E-03 -0.362485304152E-03 -0.416906913432E-03
+
+
+
+
+
+
+ -0.864406179730E-04 -0.173968525070E-03 -0.262597397705E-03 -0.352341084318E-03
+ -0.443213607544E-03 -0.535229166399E-03 -0.628402138500E-03 -0.722747082314E-03
+
+
+
+
+
+
+ -0.469203541965E-04 -0.944308937944E-04 -0.142539042412E-03 -0.191252317045E-03
+ -0.240578329241E-03 -0.290524786291E-03 -0.341099492429E-03 -0.392310350056E-03
+
+
+
+
+
+
+
+ 0.277250403619E-06 0.557988188005E-06 0.842257219008E-06 0.113010191424E-05
+ 0.142156725002E-05 0.171669876841E-05 0.201554258430E-05 0.231814539264E-05
+
+
+
+
+
+
+ 0.369459072892E-07 0.743565368829E-07 0.112237734268E-06 0.150595418459E-06
+ 0.189435582921E-06 0.228764296510E-06 0.268587704417E-06 0.308912029131E-06
+
+
+
+
+
+
+ 0.108684130278E-07 0.218735338622E-07 0.330170820757E-07 0.443007988704E-07
+ 0.557264473500E-07 0.672958127953E-07 0.790107029432E-07 0.908729482692E-07
+
+
+
+
+
+
+
+ 0.770415732749E-11 0.312054737246E-10 0.711001067937E-10 0.128001774477E-09
+ 0.202542230650E-09 0.295371753147E-09 0.407159644529E-09 0.538594745943E-09
+
+
+
+
+
+
+
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+
+
+
+
Index: /XMLF90/doc/Examples/sax/remove.sh
===================================================================
--- /XMLF90/doc/Examples/sax/remove.sh (revision 6)
+++ /XMLF90/doc/Examples/sax/remove.sh (revision 6)
@@ -0,0 +1,10 @@
+#!/bin/sh
+
+(cd count ; make clean)
+(cd features ; make clean)
+(cd pseudo ; make clean)
+(cd simple ; make clean)
+
+
+
+
Index: /XMLF90/doc/Examples/sax/simple/README
===================================================================
--- /XMLF90/doc/Examples/sax/simple/README (revision 6)
+++ /XMLF90/doc/Examples/sax/simple/README (revision 6)
@@ -0,0 +1,17 @@
+This directory contains a very simple example of the use
+of the XML parser.
+
+The program, in file "example.f90", uses the module "m_handlers", which
+contains the handlers for the basic events: begin_element, end_element, and
+pcdata_chunk.
+
+The program opens the XML file, obtaining a file object, and calls
+xml_parse with the above handlers.
+
+In this particular case, the handlers' action is just to print out
+element/attribute information, and to dump any PCDATA sections.
+
+Turning on the 'verbose' flag in the call to xml_parse will result in a
+more detailed look at the workings of the parser.
+
+Type 'make' to compile, and 'example' to execute.
Index: /XMLF90/doc/Examples/sax/simple/example.f90
===================================================================
--- /XMLF90/doc/Examples/sax/simple/example.f90 (revision 6)
+++ /XMLF90/doc/Examples/sax/simple/example.f90 (revision 6)
@@ -0,0 +1,35 @@
+program example
+!
+! Example driver for a stand-alone parsing of an xml document
+! Very simple version with just the minimal handlers.
+!
+use flib_sax
+use m_handlers ! Defines begin_element, end_element, pcdata_chunk
+
+ integer :: iostat
+ type(xml_t) :: fxml
+
+ call open_xmlfile("test.xml",fxml,iostat)
+ if (iostat /= 0) stop "Cannot open file."
+
+ call xml_parse(fxml, &
+ begin_element_handler = begin_element_handler , &
+ end_element_handler = end_element_handler, &
+ pcdata_chunk_handler = pcdata_chunk_handler, &
+ verbose = .false.)
+
+end program example
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/sax/simple/i.example.f90
===================================================================
--- /XMLF90/doc/Examples/sax/simple/i.example.f90 (revision 6)
+++ /XMLF90/doc/Examples/sax/simple/i.example.f90 (revision 6)
@@ -0,0 +1,35 @@
+program example
+!
+! Example driver for a stand-alone parsing of an xml document
+! Very simple version with just the minimal handlers.
+!
+use flib_sax
+use m_handlers ! Defines begin_element, end_element, pcdata_chunk
+
+ integer :: iostat
+ type(xml_t) :: fxml
+
+ call open_xmlfile("test.xml",fxml,iostat)
+ if (iostat /= 0) stop "Cannot open file."
+
+ call xml_parse(fxml, &
+ begin_element_handler = begin_element_handler , &
+ end_element_handler = end_element_handler, &
+ pcdata_chunk_handler = pcdata_chunk_handler, &
+ verbose = .false.)
+
+end program example
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/sax/simple/i.m_handlers.f90
===================================================================
--- /XMLF90/doc/Examples/sax/simple/i.m_handlers.f90 (revision 6)
+++ /XMLF90/doc/Examples/sax/simple/i.m_handlers.f90 (revision 6)
@@ -0,0 +1,58 @@
+module m_handlers
+
+use flib_sax
+
+private
+
+!
+! It defines the routines that are called by the XML parser in response
+! to particular events.
+!
+! In this particular example we just print the names of the elements,
+! the attribute list, and the content of the pcdata chunks
+!
+! A module such as this could use "utility routines" to convert pcdata
+! to numerical arrays, and to populate specific data structures.
+!
+public :: begin_element_handler, end_element_handler, pcdata_chunk_handler
+
+CONTAINS !=============================================================
+
+subroutine begin_element_handler(name,attributes)
+character(len=*), intent(in) :: name
+type(dictionary_t), intent(in) :: attributes
+
+write(unit=*,fmt="(2a)") ">>Begin Element: ", name
+write(unit=*,fmt="(a,i2,a)") "--- ", len(attributes), " attributes:"
+call print_dict(attributes)
+end subroutine begin_element_handler
+
+!--------------------------------------------------
+subroutine end_element_handler(name)
+character(len=*), intent(in) :: name
+
+ write(unit=*,fmt="(/,2a)") ">>-------------End Element: ", trim(name)
+
+end subroutine end_element_handler
+
+!--------------------------------------------------
+subroutine pcdata_chunk_handler(chunk)
+character(len=*), intent(in) :: chunk
+
+write(unit=*,fmt="(a)",advance="no") trim(chunk)
+
+end subroutine pcdata_chunk_handler
+
+end module m_handlers
+
+
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/sax/simple/m_handlers.f90
===================================================================
--- /XMLF90/doc/Examples/sax/simple/m_handlers.f90 (revision 6)
+++ /XMLF90/doc/Examples/sax/simple/m_handlers.f90 (revision 6)
@@ -0,0 +1,58 @@
+module m_handlers
+
+use flib_sax
+
+private
+
+!
+! It defines the routines that are called by the XML parser in response
+! to particular events.
+!
+! In this particular example we just print the names of the elements,
+! the attribute list, and the content of the pcdata chunks
+!
+! A module such as this could use "utility routines" to convert pcdata
+! to numerical arrays, and to populate specific data structures.
+!
+public :: begin_element_handler, end_element_handler, pcdata_chunk_handler
+
+CONTAINS !=============================================================
+
+subroutine begin_element_handler(name,attributes)
+character(len=*), intent(in) :: name
+type(dictionary_t), intent(in) :: attributes
+
+write(unit=*,fmt="(2a)") ">>Begin Element: ", name
+write(unit=*,fmt="(a,i2,a)") "--- ", len(attributes), " attributes:"
+call print_dict(attributes)
+end subroutine begin_element_handler
+
+!--------------------------------------------------
+subroutine end_element_handler(name)
+character(len=*), intent(in) :: name
+
+ write(unit=*,fmt="(/,2a)") ">>-------------End Element: ", trim(name)
+
+end subroutine end_element_handler
+
+!--------------------------------------------------
+subroutine pcdata_chunk_handler(chunk)
+character(len=*), intent(in) :: chunk
+
+write(unit=*,fmt="(a)",advance="no") trim(chunk)
+
+end subroutine pcdata_chunk_handler
+
+end module m_handlers
+
+
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/sax/simple/makefile
===================================================================
--- /XMLF90/doc/Examples/sax/simple/makefile (revision 6)
+++ /XMLF90/doc/Examples/sax/simple/makefile (revision 6)
@@ -0,0 +1,35 @@
+#
+# Makefile for example of XML processing with all kinds of handlers
+# and features.
+#
+default: example
+#
+#---------------------------
+MK=$(FLIB_ROOT)/fortran.mk
+include $(MK)
+#---------------------------
+#
+# Uncomment the following line for debugging support
+#
+FFLAGS=$(FFLAGS_DEBUG)
+#
+LIBS=$(LIB_PREFIX)$(LIB_STD) -lflib
+#
+OBJS= m_handlers.o example.o
+
+example: $(OBJS)
+ $(FC) $(LDFLAGS) -o $@ $(OBJS) $(LIBS)
+#
+clean:
+ rm -f *.o example *.$(MOD_EXT)
+#
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/sax/simple/test.xml
===================================================================
--- /XMLF90/doc/Examples/sax/simple/test.xml (revision 6)
+++ /XMLF90/doc/Examples/sax/simple/test.xml (revision 6)
@@ -0,0 +1,31 @@
+
+
+
+
+
+
+
+
+A small file to show the
+ parser in action ...
+
+
+Mary had a <little> lamb who liked standard entities
+
+
+
+
+
+ This is some text, split into two lines,
+ which will be passed by means of two calls to the pcdata handler.
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/wxml/C.psf
===================================================================
--- /XMLF90/doc/Examples/wxml/C.psf (revision 6)
+++ /XMLF90/doc/Examples/wxml/C.psf (revision 6)
@@ -0,0 +1,1271 @@
+ C ca nrl nc
+ ATM3 29-MAY-03 Hamann, Schluter, and Chiang
+ 2s 2.00 r= 0.86/2p 2.00 r= 0.82/
+ 2 0 1006 0.413125362778E-03 0.125000000000E-01 4.00000000000
+ Radial grid follows
+ 0.519647735591E-05 0.104583183504E-04 0.157863451569E-04 0.211813902904E-04
+ 0.266442967376E-04 0.321759180888E-04 0.377771186712E-04 0.434487736837E-04
+ 0.491917693339E-04 0.550070029765E-04 0.608953832538E-04 0.668578302370E-04
+ 0.728952755706E-04 0.790086626178E-04 0.851989466078E-04 0.914670947849E-04
+ 0.978140865601E-04 0.104240913664E-03 0.110748580301E-03 0.117338103307E-03
+ 0.124010512309E-03 0.130766849885E-03 0.137608171725E-03 0.144535546801E-03
+ 0.151550057528E-03 0.158652799939E-03 0.165844883850E-03 0.173127433041E-03
+ 0.180501585424E-03 0.187968493225E-03 0.195529323164E-03 0.203185256636E-03
+ 0.210937489896E-03 0.218787234247E-03 0.226735716227E-03 0.234784177802E-03
+ 0.242933876561E-03 0.251186085910E-03 0.259542095276E-03 0.268003210300E-03
+ 0.276570753049E-03 0.285246062220E-03 0.294030493346E-03 0.302925419014E-03
+ 0.311932229074E-03 0.321052330857E-03 0.330287149399E-03 0.339638127658E-03
+ 0.349106726744E-03 0.358694426144E-03 0.368402723958E-03 0.378233137124E-03
+ 0.388187201666E-03 0.398266472927E-03 0.408472525813E-03 0.418806955041E-03
+ 0.429271375385E-03 0.439867421934E-03 0.450596750341E-03 0.461461037086E-03
+ 0.472461979735E-03 0.483601297207E-03 0.494880730045E-03 0.506302040682E-03
+ 0.517867013722E-03 0.529577456214E-03 0.541435197940E-03 0.553442091696E-03
+ 0.565600013583E-03 0.577910863301E-03 0.590376564446E-03 0.602999064808E-03
+ 0.615780336680E-03 0.628722377160E-03 0.641827208470E-03 0.655096878265E-03
+ 0.668533459959E-03 0.682139053044E-03 0.695915783422E-03 0.709865803737E-03
+ 0.723991293705E-03 0.738294460465E-03 0.752777538914E-03 0.767442792064E-03
+ 0.782292511390E-03 0.797329017191E-03 0.812554658952E-03 0.827971815710E-03
+ 0.843582896426E-03 0.859390340366E-03 0.875396617472E-03 0.891604228760E-03
+ 0.908015706701E-03 0.924633615621E-03 0.941460552104E-03 0.958499145392E-03
+ 0.975752057800E-03 0.993221985131E-03 0.101091165710E-02 0.102882383774E-02
+ 0.104696132589E-02 0.106532695554E-02 0.108392359638E-02 0.110275415417E-02
+ 0.112182157122E-02 0.114112882684E-02 0.116067893785E-02 0.118047495898E-02
+ 0.120051998340E-02 0.122081714319E-02 0.124136960982E-02 0.126218059466E-02
+ 0.128325334946E-02 0.130459116689E-02 0.132619738102E-02 0.134807536786E-02
+ 0.137022854591E-02 0.139266037663E-02 0.141537436504E-02 0.143837406026E-02
+ 0.146166305603E-02 0.148524499131E-02 0.150912355081E-02 0.153330246562E-02
+ 0.155778551374E-02 0.158257652069E-02 0.160767936012E-02 0.163309795440E-02
+ 0.165883627524E-02 0.168489834429E-02 0.171128823383E-02 0.173801006730E-02
+ 0.176506802007E-02 0.179246631998E-02 0.182020924808E-02 0.184830113926E-02
+ 0.187674638292E-02 0.190554942371E-02 0.193471476215E-02 0.196424695539E-02
+ 0.199415061789E-02 0.202443042215E-02 0.205509109947E-02 0.208613744064E-02
+ 0.211757429670E-02 0.214940657973E-02 0.218163926359E-02 0.221427738470E-02
+ 0.224732604283E-02 0.228079040192E-02 0.231467569082E-02 0.234898720418E-02
+ 0.238373030326E-02 0.241891041672E-02 0.245453304153E-02 0.249060374380E-02
+ 0.252712815966E-02 0.256411199611E-02 0.260156103195E-02 0.263948111868E-02
+ 0.267787818138E-02 0.271675821967E-02 0.275612730864E-02 0.279599159979E-02
+ 0.283635732199E-02 0.287723078247E-02 0.291861836780E-02 0.296052654486E-02
+ 0.300296186189E-02 0.304593094951E-02 0.308944052171E-02 0.313349737695E-02
+ 0.317810839922E-02 0.322328055906E-02 0.326902091473E-02 0.331533661325E-02
+ 0.336223489154E-02 0.340972307754E-02 0.345780859140E-02 0.350649894656E-02
+ 0.355580175099E-02 0.360572470836E-02 0.365627561923E-02 0.370746238228E-02
+ 0.375929299555E-02 0.381177555768E-02 0.386491826917E-02 0.391872943368E-02
+ 0.397321745932E-02 0.402839085995E-02 0.408425825652E-02 0.414082837844E-02
+ 0.419811006489E-02 0.425611226626E-02 0.431484404551E-02 0.437431457960E-02
+ 0.443453316091E-02 0.449550919874E-02 0.455725222070E-02 0.461977187428E-02
+ 0.468307792828E-02 0.474718027442E-02 0.481208892881E-02 0.487781403357E-02
+ 0.494436585837E-02 0.501175480207E-02 0.507999139434E-02 0.514908629728E-02
+ 0.521905030710E-02 0.528989435583E-02 0.536162951300E-02 0.543426698736E-02
+ 0.550781812868E-02 0.558229442946E-02 0.565770752678E-02 0.573406920410E-02
+ 0.581139139307E-02 0.588968617544E-02 0.596896578495E-02 0.604924260918E-02
+ 0.613052919155E-02 0.621283823326E-02 0.629618259526E-02 0.638057530028E-02
+ 0.646602953486E-02 0.655255865138E-02 0.664017617019E-02 0.672889578173E-02
+ 0.681873134860E-02 0.690969690779E-02 0.700180667286E-02 0.709507503615E-02
+ 0.718951657102E-02 0.728514603417E-02 0.738197836788E-02 0.748002870241E-02
+ 0.757931235832E-02 0.767984484889E-02 0.778164188252E-02 0.788471936520E-02
+ 0.798909340300E-02 0.809478030458E-02 0.820179658373E-02 0.831015896196E-02
+ 0.841988437111E-02 0.853098995601E-02 0.864349307712E-02 0.875741131329E-02
+ 0.887276246447E-02 0.898956455452E-02 0.910783583399E-02 0.922759478303E-02
+ 0.934886011420E-02 0.947165077546E-02 0.959598595311E-02 0.972188507476E-02
+ 0.984936781241E-02 0.997845408550E-02 0.101091640640E-01 0.102415181717E-01
+ 0.103755370891E-01 0.105112417569E-01 0.106486533793E-01 0.107877934272E-01
+ 0.109286836414E-01 0.110713460363E-01 0.112158029033E-01 0.113620768140E-01
+ 0.115101906239E-01 0.116601674763E-01 0.118120308052E-01 0.119658043396E-01
+ 0.121215121070E-01 0.122791784370E-01 0.124388279653E-01 0.126004856374E-01
+ 0.127641767127E-01 0.129299267683E-01 0.130977617030E-01 0.132677077412E-01
+ 0.134397914374E-01 0.136140396801E-01 0.137904796959E-01 0.139691390538E-01
+ 0.141500456698E-01 0.143332278109E-01 0.145187140997E-01 0.147065335188E-01
+ 0.148967154153E-01 0.150892895057E-01 0.152842858799E-01 0.154817350065E-01
+ 0.156816677374E-01 0.158841153124E-01 0.160891093645E-01 0.162966819244E-01
+ 0.165068654256E-01 0.167196927098E-01 0.169351970317E-01 0.171534120642E-01
+ 0.173743719040E-01 0.175981110764E-01 0.178246645411E-01 0.180540676976E-01
+ 0.182863563906E-01 0.185215669157E-01 0.187597360249E-01 0.190009009328E-01
+ 0.192450993218E-01 0.194923693483E-01 0.197427496490E-01 0.199962793461E-01
+ 0.202529980542E-01 0.205129458861E-01 0.207761634592E-01 0.210426919019E-01
+ 0.213125728596E-01 0.215858485019E-01 0.218625615286E-01 0.221427551767E-01
+ 0.224264732270E-01 0.227137600110E-01 0.230046604180E-01 0.232992199016E-01
+ 0.235974844875E-01 0.238995007799E-01 0.242053159697E-01 0.245149778410E-01
+ 0.248285347791E-01 0.251460357780E-01 0.254675304479E-01 0.257930690228E-01
+ 0.261227023690E-01 0.264564819922E-01 0.267944600462E-01 0.271366893408E-01
+ 0.274832233500E-01 0.278341162205E-01 0.281894227799E-01 0.285491985456E-01
+ 0.289134997334E-01 0.292823832660E-01 0.296559067823E-01 0.300341286460E-01
+ 0.304171079551E-01 0.308049045509E-01 0.311975790273E-01 0.315951927407E-01
+ 0.319978078188E-01 0.324054871713E-01 0.328182944986E-01 0.332362943030E-01
+ 0.336595518976E-01 0.340881334174E-01 0.345221058291E-01 0.349615369417E-01
+ 0.354064954172E-01 0.358570507814E-01 0.363132734344E-01 0.367752346620E-01
+ 0.372430066464E-01 0.377166624781E-01 0.381962761667E-01 0.386819226529E-01
+ 0.391736778198E-01 0.396716185053E-01 0.401758225135E-01 0.406863686275E-01
+ 0.412033366210E-01 0.417268072713E-01 0.422568623719E-01 0.427935847449E-01
+ 0.433370582542E-01 0.438873678187E-01 0.444445994254E-01 0.450088401429E-01
+ 0.455801781349E-01 0.461587026741E-01 0.467445041562E-01 0.473376741139E-01
+ 0.479383052312E-01 0.485464913578E-01 0.491623275242E-01 0.497859099559E-01
+ 0.504173360891E-01 0.510567045852E-01 0.517041153470E-01 0.523596695337E-01
+ 0.530234695770E-01 0.536956191969E-01 0.543762234183E-01 0.550653885869E-01
+ 0.557632223862E-01 0.564698338541E-01 0.571853334001E-01 0.579098328224E-01
+ 0.586434453257E-01 0.593862855382E-01 0.601384695304E-01 0.609001148325E-01
+ 0.616713404531E-01 0.624522668977E-01 0.632430161879E-01 0.640437118796E-01
+ 0.648544790834E-01 0.656754444831E-01 0.665067363563E-01 0.673484845940E-01
+ 0.682008207211E-01 0.690638779170E-01 0.699377910359E-01 0.708226966287E-01
+ 0.717187329636E-01 0.726260400480E-01 0.735447596507E-01 0.744750353234E-01
+ 0.754170124236E-01 0.763708381370E-01 0.773366615010E-01 0.783146334274E-01
+ 0.793049067262E-01 0.803076361298E-01 0.813229783165E-01 0.823510919358E-01
+ 0.833921376324E-01 0.844462780718E-01 0.855136779657E-01 0.865945040974E-01
+ 0.876889253482E-01 0.887971127237E-01 0.899192393804E-01 0.910554806529E-01
+ 0.922060140812E-01 0.933710194384E-01 0.945506787590E-01 0.957451763673E-01
+ 0.969546989058E-01 0.981794353650E-01 0.994195771124E-01 0.100675317923
+ 0.101946854008 0.103234384048 0.104538109222 0.105858233241
+ 0.107194962375 0.108548505492 0.109919074086 0.111306882310
+ 0.112712147012 0.114135087769 0.115575926917 0.117034889590
+ 0.118512203755 0.120008100244 0.121522812795 0.123056578084
+ 0.124609635766 0.126182228508 0.127774602032 0.129387005149
+ 0.131019689801 0.132672911097 0.134346927357 0.136042000150
+ 0.137758394334 0.139496378099 0.141256223008 0.143038204041
+ 0.144842599637 0.146669691735 0.148519765822 0.150393110977
+ 0.152290019912 0.154210789025 0.156155718439 0.158125112054
+ 0.160119277591 0.162138526642 0.164183174720 0.166253541304
+ 0.168349949894 0.170472728058 0.172622207484 0.174798724033
+ 0.177002617790 0.179234233118 0.181493918711 0.183782027650
+ 0.186098917456 0.188444950148 0.190820492299 0.193225915092
+ 0.195661594379 0.198127910739 0.200625249541 0.203154000997
+ 0.205714560231 0.208307327336 0.210932707436 0.213591110752
+ 0.216282952665 0.219008653782 0.221768639998 0.224563342567
+ 0.227393198166 0.230258648967 0.233160142703 0.236098132736
+ 0.239073078135 0.242085443740 0.245135700240 0.248224324244
+ 0.251351798355 0.254518611248 0.257725257743 0.260972238886
+ 0.264260062023 0.267589240885 0.270960295661 0.274373753087
+ 0.277830146522 0.281330016034 0.284873908485 0.288462377615
+ 0.292095984131 0.295775295790 0.299500887492 0.303273341369
+ 0.307093246874 0.310961200876 0.314877807750 0.318843679473
+ 0.322859435722 0.326925703966 0.331043119568 0.335212325882
+ 0.339433974357 0.343708724632 0.348037244646 0.352420210739
+ 0.356858307759 0.361352229168 0.365902677149 0.370510362719
+ 0.375176005839 0.379900335525 0.384684089963 0.389528016625
+ 0.394432872383 0.399399423632 0.404428446405 0.409520726497
+ 0.414677059587 0.419898251364 0.425185117648 0.430538484523
+ 0.435959188465 0.441448076468 0.447006006183 0.452633846047
+ 0.458332475423 0.464102784732 0.469945675597 0.475862060981
+ 0.481852865333 0.487919024726 0.494061487012 0.500281211962
+ 0.506579171420 0.512956349457 0.519413742518 0.525952359586
+ 0.532573222331 0.539277365277 0.546065835960 0.552939695093
+ 0.559900016730 0.566947888436 0.574084411454 0.581310700881
+ 0.588627885839 0.596037109654 0.603539530032 0.611136319240
+ 0.618828664294 0.626617767137 0.634504844833 0.642491129753
+ 0.650577869772 0.658766328457 0.667057785274 0.675453535778
+ 0.683954891823 0.692563181763 0.701279750661 0.710105960499
+ 0.719043190389 0.728092836792 0.737256313734 0.746535053027
+ 0.755930504492 0.765444136188 0.775077434640 0.784831905069
+ 0.794709071632 0.804710477656 0.814837685880 0.825092278703
+ 0.835475858425 0.845990047501 0.856636488794 0.867416845834
+ 0.878332803072 0.889386066149 0.900578362161 0.911911439925
+ 0.923387070259 0.935007046253 0.946773183552 0.958687320638
+ 0.970751319121 0.982967064024 0.995336464082 1.00786145204
+ 1.02054398495 1.03338604449 1.04638963725 1.05955679507
+ 1.07288957535 1.08639006136 1.10006036258 1.11390261502
+ 1.12791898156 1.14211165229 1.15648284484 1.17103480474
+ 1.18576980576 1.20069015027 1.21579816962 1.23109622446
+ 1.24658670514 1.26227203208 1.27815465614 1.29423705902
+ 1.31052175363 1.32701128448 1.34370822809 1.36061519340
+ 1.37773482215 1.39506978933 1.41262280354 1.43039660750
+ 1.44839397839 1.46661772834 1.48507070484 1.50375579121
+ 1.52267590704 1.54183400862 1.56123308946 1.58087618070
+ 1.60076635160 1.62090671006 1.64130040305 1.66195061711
+ 1.68286057888 1.70403355560 1.72547285558 1.74718182876
+ 1.76916386720 1.79142240565 1.81396092205 1.83678293808
+ 1.85989201973 1.88329177785 1.90698586869 1.93097799451
+ 1.95527190412 1.97987139349 2.00478030634 2.03000253475
+ 2.05554201974 2.08140275191 2.10758877203 2.13410417175
+ 2.16095309413 2.18813973439 2.21566834048 2.24354321380
+ 2.27176870988 2.30034923898 2.32928926689 2.35859331553
+ 2.38826596373 2.41831184790 2.44873566277 2.47954216212
+ 2.51073615952 2.54232252911 2.57430620632 2.60669218867
+ 2.63948553652 2.67269137391 2.70631488932 2.74036133649
+ 2.77483603524 2.80974437232 2.84509180222 2.88088384807
+ 2.91712610242 2.95382422821 2.99098395961 3.02861110288
+ 3.06671153735 3.10529121629 3.14435616785 3.18391249601
+ 3.22396638153 3.26452408290 3.30559193736 3.34717636184
+ 3.38928385398 3.43192099317 3.47509444155 3.51881094506
+ 3.56307733449 3.60790052656 3.65328752497 3.69924542154
+ 3.74578139729 3.79290272356 3.84061676314 3.88893097146
+ 3.93785289771 3.98739018603 4.03755057674 4.08834190749
+ 4.13977211453 4.19184923394 4.24458140287 4.29797686084
+ 4.35204395098 4.40679112140 4.46222692645 4.51836002808
+ 4.57519919721 4.63275331508 4.69103137463 4.75004248193
+ 4.80979585758 4.87030083818 4.93156687774 4.99360354920
+ 5.05642054594 5.12002768322 5.18443489980 5.24965225943
+ 5.31568995246 5.38255829741 5.45026774259 5.51882886775
+ 5.58825238570 5.65854914401 5.72973012669 5.80180645590
+ 5.87478939374 5.94869034391 6.02352085361 6.09929261525
+ 6.17601746832 6.25370740124 6.33237455321 6.41203121614
+ 6.49268983655 6.57436301750 6.65706352061 6.74080426798
+ 6.82559834429 6.91145899878 6.99839964734 7.08643387465
+ 7.17557543621 7.26583826059 7.35723645153 7.44978429019
+ 7.54349623735 7.63838693569 7.73447121209 7.83176407990
+ 7.93028074133 8.03003658982 8.13104721241 8.23332839223
+ 8.33689611090 8.44176655111 8.54795609907 8.65548134711
+ 8.76435909627 8.87460635893 8.98624036143 9.09927854683
+ 9.21373857756 9.32963833824 9.44699593845 9.56582971554
+ 9.68615823755 9.80800030603 9.93137495907 10.0563014742
+ 10.1827993714 10.3108884164 10.4405886231 10.5719202577
+ 10.7049038408 10.8395601515 10.9759102300 11.1139753815
+ 11.2537771787 11.3953374661 11.5386783626 11.6838222658
+ 11.8307918544 11.9796100929 12.1303002344 12.2828858246
+ 12.4373907052 12.5938390179 12.7522552082 12.9126640288
+ 13.0750905441 13.2395601333 13.4060984954 13.5747316521
+ 13.7454859529 13.9183880783 14.0934650448 14.2707442083
+ 14.4502532693 14.6320202763 14.8160736307 15.0024420914
+ 15.1911547787 15.3822411794 15.5757311512 15.7716549271
+ 15.9700431208 16.1709267308 16.3743371455 16.5803061483
+ 16.7888659222 17.0000490551 17.2138885448 17.4304178042
+ 17.6496706663 17.8716813900 18.0964846648 18.3241156167
+ 18.5546098134 18.7880032703 19.0243324555 19.2636342958
+ 19.5059461828 19.7513059781 19.9997520197 20.2513231278
+ 20.5060586108 20.7639982718 21.0251824144 21.2896518490
+ 21.5574478996 21.8286124098 22.1031877496 22.3812168221
+ 22.6627430698 22.9478104818 23.2364636004 23.5287475282
+ 23.8247079353 24.1243910660 24.4278437464 24.7351133917
+ 25.0462480134 25.3612962267 25.6803072588 26.0033309557
+ 26.3304177905 26.6616188712 26.9969859486 27.3365714246
+ 27.6804283600 28.0286104833 28.3811721985 28.7381685941
+ 29.0996554516 29.4656892540 29.8363271949 30.2116271872
+ 30.5916478722 30.9764486290 31.3660895834 31.7606316177
+ 32.1601363799 32.5646662934 32.9742845668 33.3890552038
+ 33.8090430131 34.2343136188 34.6649334701 35.1009698524
+ 35.5424908972 35.9895655931 36.4422637963 36.9006562420
+ 37.3648145548 37.8348112605 38.3107197970 38.7926145259
+ 39.2805707443 39.7746646964 40.2749735853 40.7815755853
+ 41.2945498541 41.8139765448 42.3399368189 42.8725128589
+ 43.4117878808 43.9578461475 44.5107729815 45.0706547790
+ 45.6375790225 46.2116342952 46.7929102942 47.3814978453
+ 47.9774889163 48.5809766322 49.1920552890 49.8108203691
+ 50.4373685558 51.0717977485 51.7142070781 52.3646969223
+ 53.0233689214 53.6903259944 54.3656723546 55.0495135262
+ 55.7419563609 56.4431090543 57.1530811628 57.8719836211
+ 58.5999287591 59.3370303198 60.0834034767 60.8391648522
+ 61.6044325355 62.3793261013 63.1639666283 63.9584767182
+ 64.7629805146 65.5776037232 66.4024736302 67.2377191234
+ 68.0834707116 68.9398605451 69.8070224367 70.6850918821
+ 71.5742060815 72.4745039607 73.3861261932 74.3092152217
+ 75.2439152809 76.1903724195 77.1487345233 78.1191513384
+ 79.1017744944 80.0967575281 81.1042559077 82.1244270568
+ 83.1574303794 84.2034272841 85.2625812102 86.3350576527
+ 87.4210241881 88.5206505010 89.6341084101 90.7615718956
+ 91.9032171259 93.0592224855 94.2297686024 95.4150383769
+ 96.6152170099 97.8304920316 99.0610533313 100.307093187
+ 101.568806294 102.846389798 104.140043325 105.449969010
+ 106.776371532 108.119458143 109.479438704 110.856525715
+ 112.250934349 113.662882483 115.092590739 116.540282511
+ 118.006184003 119.490524267
+ Down Pseudopotential follows (l on next line)
+ 0
+ -0.268318443310E-04 -0.540011917084E-04 -0.815122873904E-04 -0.109369430033E-03
+ -0.137576972363E-03 -0.166139321857E-03 -0.195060941430E-03 -0.224346350132E-03
+ -0.254000123856E-03 -0.284026896054E-03 -0.314431358455E-03 -0.345218261806E-03
+ -0.376392416606E-03 -0.407958693867E-03 -0.439922025865E-03 -0.472287406919E-03
+ -0.505059894166E-03 -0.538244608355E-03 -0.571846734643E-03 -0.605871523408E-03
+ -0.640324291070E-03 -0.675210420918E-03 -0.710535363954E-03 -0.746304639746E-03
+ -0.782523837285E-03 -0.819198615865E-03 -0.856334705960E-03 -0.893937910127E-03
+ -0.932014103907E-03 -0.970569236743E-03 -0.100960933291E-02 -0.104914049247E-02
+ -0.108916889220E-02 -0.112970078656E-02 -0.117074250870E-02 -0.121230047143E-02
+ -0.125438116820E-02 -0.129699117415E-02 -0.134013714712E-02 -0.138382582869E-02
+ -0.142806404525E-02 -0.147285870904E-02 -0.151821681924E-02 -0.156414546307E-02
+ -0.161065181690E-02 -0.165774314736E-02 -0.170542681247E-02 -0.175371026281E-02
+ -0.180260104268E-02 -0.185210679126E-02 -0.190223524381E-02 -0.195299423290E-02
+ -0.200439168962E-02 -0.205643564479E-02 -0.210913423026E-02 -0.216249568016E-02
+ -0.221652833220E-02 -0.227124062894E-02 -0.232664111912E-02 -0.238273845905E-02
+ -0.243954141387E-02 -0.249705885898E-02 -0.255529978144E-02 -0.261427328130E-02
+ -0.267398857311E-02 -0.273445498729E-02 -0.279568197163E-02 -0.285767909274E-02
+ -0.292045603757E-02 -0.298402261490E-02 -0.304838875688E-02 -0.311356452058E-02
+ -0.317956008957E-02 -0.324638577550E-02 -0.331405201972E-02 -0.338256939490E-02
+ -0.345194860669E-02 -0.352220049538E-02 -0.359333603762E-02 -0.366536634810E-02
+ -0.373830268132E-02 -0.381215643332E-02 -0.388693914347E-02 -0.396266249628E-02
+ -0.403933832321E-02 -0.411697860453E-02 -0.419559547119E-02 -0.427520120672E-02
+ -0.435580824912E-02 -0.443742919284E-02 -0.452007679072E-02 -0.460376395599E-02
+ -0.468850376431E-02 -0.477430945575E-02 -0.486119443695E-02 -0.494917228312E-02
+ -0.503825674021E-02 -0.512846172707E-02 -0.521980133757E-02 -0.531228984287E-02
+ -0.540594169356E-02 -0.550077152202E-02 -0.559679414463E-02 -0.569402456410E-02
+ -0.579247797182E-02 -0.589216975025E-02 -0.599311547528E-02 -0.609533091869E-02
+ -0.619883205061E-02 -0.630363504202E-02 -0.640975626725E-02 -0.651721230656E-02
+ -0.662601994870E-02 -0.673619619359E-02 -0.684775825489E-02 -0.696072356278E-02
+ -0.707510976658E-02 -0.719093473761E-02 -0.730821657188E-02 -0.742697359301E-02
+ -0.754722435499E-02 -0.766898764518E-02 -0.779228248715E-02 -0.791712814371E-02
+ -0.804354411990E-02 -0.817155016602E-02 -0.830116628073E-02 -0.843241271414E-02
+ -0.856530997104E-02 -0.869987881401E-02 -0.883614026672E-02 -0.897411561719E-02
+ -0.911382642113E-02 -0.925529450526E-02 -0.939854197077E-02 -0.954359119673E-02
+ -0.969046484359E-02 -0.983918585673E-02 -0.998977747001E-02 -0.101422632094E-01
+ -0.102966668968E-01 -0.104530126533E-01 -0.106113249036E-01 -0.107716283793E-01
+ -0.109339481230E-01 -0.110983094920E-01 -0.112647381627E-01 -0.114332601339E-01
+ -0.116039017315E-01 -0.117766896124E-01 -0.119516507685E-01 -0.121288125310E-01
+ -0.123082025747E-01 -0.124898489224E-01 -0.126737799490E-01 -0.128600243861E-01
+ -0.130486113267E-01 -0.132395702292E-01 -0.134329309224E-01 -0.136287236100E-01
+ -0.138269788756E-01 -0.140277276867E-01 -0.142310014004E-01 -0.144368317679E-01
+ -0.146452509392E-01 -0.148562914688E-01 -0.150699863198E-01 -0.152863688700E-01
+ -0.155054729165E-01 -0.157273326811E-01 -0.159519828157E-01 -0.161794584076E-01
+ -0.164097949850E-01 -0.166430285226E-01 -0.168791954472E-01 -0.171183326432E-01
+ -0.173604774583E-01 -0.176056677098E-01 -0.178539416897E-01 -0.181053381716E-01
+ -0.183598964158E-01 -0.186176561760E-01 -0.188786577052E-01 -0.191429417623E-01
+ -0.194105496179E-01 -0.196815230611E-01 -0.199559044061E-01 -0.202337364983E-01
+ -0.205150627215E-01 -0.207999270040E-01 -0.210883738262E-01 -0.213804482269E-01
+ -0.216761958105E-01 -0.219756627542E-01 -0.222788958147E-01 -0.225859423362E-01
+ -0.228968502571E-01 -0.232116681178E-01 -0.235304450680E-01 -0.238532308745E-01
+ -0.241800759289E-01 -0.245110312551E-01 -0.248461485177E-01 -0.251854800297E-01
+ -0.255290787607E-01 -0.258769983451E-01 -0.262292930901E-01 -0.265860179848E-01
+ -0.269472287079E-01 -0.273129816371E-01 -0.276833338572E-01 -0.280583431691E-01
+ -0.284380680990E-01 -0.288225679070E-01 -0.292119025968E-01 -0.296061329245E-01
+ -0.300053204080E-01 -0.304095273371E-01 -0.308188167822E-01 -0.312332526047E-01
+ -0.316528994668E-01 -0.320778228410E-01 -0.325080890209E-01 -0.329437651308E-01
+ -0.333849191363E-01 -0.338316198548E-01 -0.342839369659E-01 -0.347419410226E-01
+ -0.352057034616E-01 -0.356752966143E-01 -0.361507937186E-01 -0.366322689293E-01
+ -0.371197973301E-01 -0.376134549447E-01 -0.381133187489E-01 -0.386194666819E-01
+ -0.391319776589E-01 -0.396509315824E-01 -0.401764093551E-01 -0.407084928922E-01
+ -0.412472651334E-01 -0.417928100564E-01 -0.423452126889E-01 -0.429045591223E-01
+ -0.434709365246E-01 -0.440444331533E-01 -0.446251383696E-01 -0.452131426516E-01
+ -0.458085376078E-01 -0.464114159919E-01 -0.470218717159E-01 -0.476399998654E-01
+ -0.482658967130E-01 -0.488996597339E-01 -0.495413876200E-01 -0.501911802953E-01
+ -0.508491389307E-01 -0.515153659596E-01 -0.521899650933E-01 -0.528730413367E-01
+ -0.535647010040E-01 -0.542650517351E-01 -0.549742025115E-01 -0.556922636729E-01
+ -0.564193469338E-01 -0.571555654003E-01 -0.579010335872E-01 -0.586558674348E-01
+ -0.594201843269E-01 -0.601941031080E-01 -0.609777441011E-01 -0.617712291258E-01
+ -0.625746815167E-01 -0.633882261414E-01 -0.642119894194E-01 -0.650460993408E-01
+ -0.658906854856E-01 -0.667458790425E-01 -0.676118128289E-01 -0.684886213101E-01
+ -0.693764406197E-01 -0.702754085792E-01 -0.711856647189E-01 -0.721073502980E-01
+ -0.730406083258E-01 -0.739855835824E-01 -0.749424226402E-01 -0.759112738853E-01
+ -0.768922875393E-01 -0.778856156812E-01 -0.788914122696E-01 -0.799098331651E-01
+ -0.809410361533E-01 -0.819851809671E-01 -0.830424293105E-01 -0.841129448816E-01
+ -0.851968933966E-01 -0.862944426132E-01 -0.874057623554E-01 -0.885310245373E-01
+ -0.896704031882E-01 -0.908240744771E-01 -0.919922167384E-01 -0.931750104969E-01
+ -0.943726384934E-01 -0.955852857111E-01 -0.968131394014E-01 -0.980563891105E-01
+ -0.993152267062E-01 -0.100589846405 -0.101880444798 -0.103187220880
+ -0.104510376079 -0.105850114278 -0.107206641852 -0.108580167687
+ -0.109970903217 -0.111379062450 -0.112804861995 -0.114248521096
+ -0.115710261658 -0.117190308281 -0.118688888286 -0.120206231751
+ -0.121742571537 -0.123298143321 -0.124873185630 -0.126467939868
+ -0.128082650354 -0.129717564349 -0.131372932090 -0.133049006825
+ -0.134746044844 -0.136464305514 -0.138204051309 -0.139965547848
+ -0.141749063930 -0.143554871563 -0.145383246001 -0.147234465784
+ -0.149108812765 -0.151006572150 -0.152928032534 -0.154873485934
+ -0.156843227830 -0.158837557194 -0.160856776535 -0.162901191930
+ -0.164971113062 -0.167066853259 -0.169188729531 -0.171337062607
+ -0.173512176972 -0.175714400910 -0.177944066534 -0.180201509832
+ -0.182487070704 -0.184801092998 -0.187143924551 -0.189515917230
+ -0.191917426969 -0.194348813808 -0.196810441937 -0.199302679731
+ -0.201825899793 -0.204380478992 -0.206966798508 -0.209585243866
+ -0.212236204982 -0.214920076200 -0.217637256336 -0.220388148717
+ -0.223173161221 -0.225992706321 -0.228847201125 -0.231737067415
+ -0.234662731692 -0.237624625216 -0.240623184045 -0.243658849081
+ -0.246732066107 -0.249843285832 -0.252992963932 -0.256181561088
+ -0.259409543032 -0.262677380588 -0.265985549711 -0.269334531530
+ -0.272724812390 -0.276156883894 -0.279631242943 -0.283148391777
+ -0.286708838020 -0.290313094718 -0.293961680380 -0.297655119023
+ -0.301393940210 -0.305178679092 -0.309009876450 -0.312888078737
+ -0.316813838116 -0.320787712504 -0.324810265612 -0.328882066988
+ -0.333003692056 -0.337175722156 -0.341398744590 -0.345673352660
+ -0.350000145708 -0.354379729162 -0.358812714573 -0.363299719660
+ -0.367841368352 -0.372438290827 -0.377091123559 -0.381800509357
+ -0.386567097411 -0.391391543336 -0.396274509211 -0.401216663633
+ -0.406218681754 -0.411281245330 -0.416405042770 -0.421590769183
+ -0.426839126423 -0.432150823147 -0.437526574857 -0.442967103960
+ -0.448473139820 -0.454045418812 -0.459684684382 -0.465391687107
+ -0.471167184753 -0.477011942348 -0.482926732238 -0.488912334167
+ -0.494969535344 -0.501099130522 -0.507301922078 -0.513578720096
+ -0.519930342459 -0.526357614938 -0.532861371294 -0.539442453382
+ -0.546101711258 -0.552840003299 -0.559658196324 -0.566557165725
+ -0.573537795608 -0.580600978938 -0.587747617698 -0.594978623053
+ -0.602294915530 -0.609697425205 -0.617187091905 -0.624764865421
+ -0.632431705739 -0.640188583281 -0.648036479162 -0.655976385473
+ -0.664009305569 -0.672136254389 -0.680358258786 -0.688676357887
+ -0.697091603478 -0.705605060401 -0.714217806998 -0.722930935563
+ -0.731745552845 -0.740662780563 -0.749683755970 -0.758809632452
+ -0.768041580155 -0.777380786669 -0.786828457744 -0.796385818057
+ -0.806054112030 -0.815834604694 -0.825728582620 -0.835737354896
+ -0.845862254174 -0.856104637783 -0.866465888910 -0.876947417852
+ -0.887550663356 -0.898277094033 -0.909128209860 -0.920105543784
+ -0.931210663413 -0.942445172821 -0.953810714453 -0.965308971155
+ -0.976941668318 -0.988710576165 -1.00061751216 -1.01266434356
+ -1.02485299017 -1.03718542714 -1.04966368810 -1.06228986831
+ -1.07506612814 -1.08799469665 -1.10107787541 -1.11431804259
+ -1.12771765723 -1.14127926379 -1.15500549696 -1.16889908672
+ -1.18296286378 -1.19719976519 -1.21161284046 -1.22620525787
+ -1.24098031125 -1.25594142707 -1.27109217206 -1.28643626115
+ -1.30197756593 -1.31772012361 -1.33366814650 -1.34982603198
+ -1.36619837318 -1.38278997016 -1.39960584182 -1.41665123850
+ -1.43393165532 -1.45145284631 -1.46922083941 -1.48724195232
+ -1.50552280935 -1.52407035927 -1.54289189424 -1.56199506988
+ -1.58138792662 -1.60107891226 -1.62107690604 -1.64139124412
+ -1.66203174663 -1.68300874644 -1.70433311973 -1.72601631839
+ -1.74807040451 -1.77050808699 -1.79334276037 -1.81658854616
+ -1.84026033663 -1.86437384127 -1.88894563610 -1.91399321586
+ -1.93953504934 -1.96559063781 -1.99218057680 -2.01932662124
+ -2.04705175400 -2.07538025798 -2.10433779162 -2.13395146786
+ -2.16424993638 -2.19526346907 -2.22702404824 -2.25956545756
+ -2.29292337490 -2.32713546680 -2.36224148367 -2.39828335486
+ -2.43530528270 -2.47335383400 -2.51247802787 -2.55272941794
+ -2.59416216734 -2.63683311408 -2.68080182464 -2.72613063309
+ -2.77288466287 -2.82113182813 -2.87094281122 -2.92239101285
+ -2.97555247087 -3.03050574374 -3.08733175432 -3.14611358932
+ -3.20693624982 -3.26988634763 -3.33505174232 -3.40252111350
+ -3.47238346254 -3.54472753800 -3.61964117865 -3.69721056800
+ -3.77751939424 -3.86064790957 -3.94667188300 -4.03566144143
+ -4.12767979407 -4.22278183637 -4.32101263086 -4.42240576362
+ -4.52698157746 -4.63474528482 -4.74568496668 -4.85976946879
+ -4.97694620533 -5.09716650015 -5.22028245790 -5.34618200459
+ -5.47470389724 -5.60565399954 -5.73880315737 -5.87388525163
+ -6.01059550188 -6.14858909831 -6.28748025026 -6.42684174605
+ -6.56620512742 -6.70506158530 -6.84286368766 -6.97902804906
+ -7.11293904764 -7.24395368560 -7.37140767436 -7.49462280291
+ -7.61291561864 -7.72560741082 -7.83203543982 -7.93156529870
+ -8.02360422853 -8.10761513658 -8.18313098883 -8.24976916838
+ -8.30724531390 -8.35538608188 -8.39414022085 -8.42358731093
+ -8.44394351753 -8.45556374023 -8.45893961475 -8.45469295179
+ -8.44356437383 -8.42639713746 -8.40411639612 -8.37770445451
+ -8.34817287006 -8.31653254526 -8.28376319770 -8.25078376342
+ -8.21842535439 -8.18740833317 -8.15832487387 -8.13162805301
+ -8.10762807432 -8.08649571357 -8.06827252144 -8.05288680185
+ -8.04017394843 -8.02989942483 -8.02178255211 -8.01551933203
+ -8.01080277881 -8.00733961751 -8.00486267972 -8.00313882190
+ -8.00197264219 -8.00120662538 -8.00064890837 -8.00033980817
+ -8.00017386478 -8.00008751162 -8.00004385441 -8.00002229739
+ -8.00001179294 -8.00000664964 -8.00000405005 -8.00000265055
+ -8.00000182975 -8.00000130495 -8.00000094623 -8.00000069071
+ -8.00000050488 -8.00000036860 -8.00000026851 -8.00000019508
+ -8.00000014137 -8.00000010220 -8.00000007373 -8.00000005310
+ -8.00000003820 -8.00000002746 -8.00000001975 -8.00000001421
+ -8.00000001025 -8.00000000742 -8.00000000540 -8.00000000395
+ -8.00000000291 -8.00000000217 -8.00000000163 -8.00000000124
+ -8.00000000095 -8.00000000074 -8.00000000058 -8.00000000047
+ -8.00000000037 -8.00000000030 -8.00000000025 -8.00000000020
+ -8.00000000017 -8.00000000014 -8.00000000012 -8.00000000010
+ -8.00000000008 -8.00000000007 -8.00000000006 -8.00000000005
+ -8.00000000004 -8.00000000003 -8.00000000003 -8.00000000002
+ -8.00000000002 -8.00000000002 -8.00000000001 -8.00000000001
+ -8.00000000001 -8.00000000001 -8.00000000001 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000
+ Down Pseudopotential follows (l on next line)
+ 1
+ -0.699849716764E-04 -0.140850241761E-03 -0.212606892829E-03 -0.285266129565E-03
+ -0.358839304967E-03 -0.433337918874E-03 -0.508773609356E-03 -0.585158164518E-03
+ -0.662503518657E-03 -0.740821757628E-03 -0.820125118999E-03 -0.900425994239E-03
+ -0.981736929962E-03 -0.106407063128E-02 -0.114743996308E-02 -0.123185795232E-02
+ -0.131733778881E-02 -0.140389282970E-02 -0.149153659880E-02 -0.158028279120E-02
+ -0.167014527326E-02 -0.176113808635E-02 -0.185327544802E-02 -0.194657175549E-02
+ -0.204104158601E-02 -0.213669970081E-02 -0.223356104665E-02 -0.233164075866E-02
+ -0.243095416170E-02 -0.253151677367E-02 -0.263334430780E-02 -0.273645267492E-02
+ -0.284085798586E-02 -0.294657655410E-02 -0.305362489862E-02 -0.316201974584E-02
+ -0.327177803267E-02 -0.338291690918E-02 -0.349545374096E-02 -0.360940611220E-02
+ -0.372479182820E-02 -0.384162891820E-02 -0.395993563841E-02 -0.407973047438E-02
+ -0.420103214435E-02 -0.432385960205E-02 -0.444823203937E-02 -0.457416889018E-02
+ -0.470168983199E-02 -0.483081479044E-02 -0.496156394161E-02 -0.509395771542E-02
+ -0.522801679856E-02 -0.536376213815E-02 -0.550121494477E-02 -0.564039669568E-02
+ -0.578132913848E-02 -0.592403429411E-02 -0.606853446062E-02 -0.621485221643E-02
+ -0.636301042430E-02 -0.651303223403E-02 -0.666494108712E-02 -0.681876071962E-02
+ -0.697451516629E-02 -0.713222876405E-02 -0.729192615617E-02 -0.745363229580E-02
+ -0.761737244982E-02 -0.778317220312E-02 -0.795105746240E-02 -0.812105446015E-02
+ -0.829318975883E-02 -0.846749025506E-02 -0.864398318375E-02 -0.882269612252E-02
+ -0.900365699561E-02 -0.918689407872E-02 -0.937243600320E-02 -0.956031176047E-02
+ -0.975055070663E-02 -0.994318256713E-02 -0.101382374412E-01 -0.103357458068E-01
+ -0.105357385251E-01 -0.107382468457E-01 -0.109433024111E-01 -0.111509372618E-01
+ -0.113611838414E-01 -0.115740750016E-01 -0.117896440073E-01 -0.120079245419E-01
+ -0.122289507124E-01 -0.124527570549E-01 -0.126793785398E-01 -0.129088505775E-01
+ -0.131412090238E-01 -0.133764901855E-01 -0.136147308261E-01 -0.138559681715E-01
+ -0.141002399159E-01 -0.143475842276E-01 -0.145980397552E-01 -0.148516456331E-01
+ -0.151084414883E-01 -0.153684674460E-01 -0.156317641364E-01 -0.158983727005E-01
+ -0.161683347970E-01 -0.164416926085E-01 -0.167184888483E-01 -0.169987667670E-01
+ -0.172825701591E-01 -0.175699433700E-01 -0.178609313032E-01 -0.181555794267E-01
+ -0.184539337806E-01 -0.187560409841E-01 -0.190619482429E-01 -0.193717033562E-01
+ -0.196853547249E-01 -0.200029513584E-01 -0.203245428828E-01 -0.206501795483E-01
+ -0.209799122373E-01 -0.213137924721E-01 -0.216518724234E-01 -0.219942049177E-01
+ -0.223408434466E-01 -0.226918421740E-01 -0.230472559456E-01 -0.234071402966E-01
+ -0.237715514611E-01 -0.241405463805E-01 -0.245141827124E-01 -0.248925188398E-01
+ -0.252756138799E-01 -0.256635276939E-01 -0.260563208957E-01 -0.264540548618E-01
+ -0.268567917408E-01 -0.272645944631E-01 -0.276775267506E-01 -0.280956531270E-01
+ -0.285190389274E-01 -0.289477503090E-01 -0.293818542612E-01 -0.298214186161E-01
+ -0.302665120588E-01 -0.307172041389E-01 -0.311735652806E-01 -0.316356667941E-01
+ -0.321035808867E-01 -0.325773806740E-01 -0.330571401913E-01 -0.335429344054E-01
+ -0.340348392261E-01 -0.345329315181E-01 -0.350372891130E-01 -0.355479908218E-01
+ -0.360651164466E-01 -0.365887467936E-01 -0.371189636854E-01 -0.376558499742E-01
+ -0.381994895542E-01 -0.387499673751E-01 -0.393073694555E-01 -0.398717828958E-01
+ -0.404432958924E-01 -0.410219977511E-01 -0.416079789013E-01 -0.422013309100E-01
+ -0.428021464962E-01 -0.434105195452E-01 -0.440265451238E-01 -0.446503194944E-01
+ -0.452819401308E-01 -0.459215057327E-01 -0.465691162421E-01 -0.472248728578E-01
+ -0.478888780521E-01 -0.485612355865E-01 -0.492420505279E-01 -0.499314292650E-01
+ -0.506294795251E-01 -0.513363103909E-01 -0.520520323175E-01 -0.527767571495E-01
+ -0.535105981391E-01 -0.542536699629E-01 -0.550060887409E-01 -0.557679720537E-01
+ -0.565394389614E-01 -0.573206100222E-01 -0.581116073112E-01 -0.589125544395E-01
+ -0.597235765733E-01 -0.605448004541E-01 -0.613763544177E-01 -0.622183684152E-01
+ -0.630709740325E-01 -0.639343045114E-01 -0.648084947703E-01 -0.656936814251E-01
+ -0.665900028112E-01 -0.674975990044E-01 -0.684166118433E-01 -0.693471849514E-01
+ -0.702894637595E-01 -0.712435955285E-01 -0.722097293725E-01 -0.731880162822E-01
+ -0.741786091482E-01 -0.751816627856E-01 -0.761973339574E-01 -0.772257813997E-01
+ -0.782671658465E-01 -0.793216500543E-01 -0.803893988283E-01 -0.814705790480E-01
+ -0.825653596929E-01 -0.836739118696E-01 -0.847964088383E-01 -0.859330260398E-01
+ -0.870839411235E-01 -0.882493339745E-01 -0.894293867425E-01 -0.906242838698E-01
+ -0.918342121208E-01 -0.930593606104E-01 -0.942999208347E-01 -0.955560867001E-01
+ -0.968280545542E-01 -0.981160232166E-01 -0.994201940098E-01 -0.100740770791
+ -0.102077959984 -0.103431970611 -0.104803014328 -0.106191305453
+ -0.107597061005 -0.109020500735 -0.110461847160 -0.111921325601
+ -0.113399164215 -0.114895594034 -0.116410848997 -0.117945165991
+ -0.119498784887 -0.121071948577 -0.122664903010 -0.124277897236
+ -0.125911183442 -0.127565016990 -0.129239656459 -0.130935363689
+ -0.132652403815 -0.134391045314 -0.136151560045 -0.137934223295
+ -0.139739313818 -0.141567113880 -0.143417909306 -0.145291989523
+ -0.147189647605 -0.149111180320 -0.151056888178 -0.153027075477
+ -0.155022050351 -0.157042124817 -0.159087614830 -0.161158840325
+ -0.163256125273 -0.165379797732 -0.167530189895 -0.169707638147
+ -0.171912483115 -0.174145069722 -0.176405747245 -0.178694869365
+ -0.181012794229 -0.183359884501 -0.185736507422 -0.188143034870
+ -0.190579843415 -0.193047314382 -0.195545833911 -0.198075793016
+ -0.200637587649 -0.203231618764 -0.205858292379 -0.208518019640
+ -0.211211216887 -0.213938305724 -0.216699713078 -0.219495871276
+ -0.222327218108 -0.225194196899 -0.228097256579 -0.231036851756
+ -0.234013442788 -0.237027495856 -0.240079483039 -0.243169882390
+ -0.246299178013 -0.249467860140 -0.252676425209 -0.255925375945
+ -0.259215221442 -0.262546477240 -0.265919665415 -0.269335314657
+ -0.272793960360 -0.276296144704 -0.279842416747 -0.283433332511
+ -0.287069455074 -0.290751354659 -0.294479608728 -0.298254802078
+ -0.302077526931 -0.305948383034 -0.309867977757 -0.313836926191
+ -0.317855851250 -0.321925383769 -0.326046162614 -0.330218834781
+ -0.334444055505 -0.338722488368 -0.343054805407 -0.347441687227
+ -0.351883823112 -0.356381911140 -0.360936658297 -0.365548780599
+ -0.370219003206 -0.374948060547 -0.379736696439 -0.384585664216
+ -0.389495726853 -0.394467657093 -0.399502237579 -0.404600260988
+ -0.409762530160 -0.414989858241 -0.420283068815 -0.425642996048
+ -0.431070484828 -0.436566390914 -0.442131581079 -0.447766933260
+ -0.453473336712 -0.459251692158 -0.465102911952 -0.471027920228
+ -0.477027653072 -0.483103058678 -0.489255097522 -0.495484742525
+ -0.501792979228 -0.508180805967 -0.514649234053 -0.521199287948
+ -0.527832005456 -0.534548437903 -0.541349650333 -0.548236721696
+ -0.555210745053 -0.562272827769 -0.569424091718 -0.576665673495
+ -0.583998724623 -0.591424411769 -0.598943916964 -0.606558437824
+ -0.614269187778 -0.622077396299 -0.629984309138 -0.637991188567
+ -0.646099313620 -0.654309980343 -0.662624502049 -0.671044209574
+ -0.679570451542 -0.688204594635 -0.696948023865 -0.705802142856
+ -0.714768374125 -0.723848159377 -0.733042959803 -0.742354256375
+ -0.751783550166 -0.761332362658 -0.771002236067 -0.780794733673
+ -0.790711440157 -0.800753961940 -0.810923927541 -0.821222987929
+ -0.831652816896 -0.842215111428 -0.852911592090 -0.863744003417
+ -0.874714114318 -0.885823718482 -0.897074634802 -0.908468707805
+ -0.920007808088 -0.931693832773 -0.943528705965 -0.955514379228
+ -0.967652832067 -0.979946072424 -0.992396137186 -1.00500509271
+ -1.01777503535 -1.03070809202 -1.04380642073 -1.05707221118
+ -1.07050768537 -1.08411509815 -1.09789673791 -1.11185492717
+ -1.12599202326 -1.14031041899 -1.15481254332 -1.16950086212
+ -1.18437787886 -1.19944613535 -1.21470821256 -1.23016673139
+ -1.24582435344 -1.26168378193 -1.27774776250 -1.29401908412
+ -1.31050057999 -1.32719512850 -1.34410565415 -1.36123512860
+ -1.37858657165 -1.39616305230 -1.41396768985 -1.43200365497
+ -1.45027417090 -1.46878251460 -1.48753201796 -1.50652606906
+ -1.52576811349 -1.54526165560 -1.56501025994 -1.58501755263
+ -1.60528722284 -1.62582302421 -1.64662877649 -1.66770836705
+ -1.68906575250 -1.71070496046 -1.73263009116 -1.75484531933
+ -1.77735489596 -1.80016315024 -1.82327449145 -1.84669341098
+ -1.87042448442 -1.89447237362 -1.91884182888 -1.94353769122
+ -1.96856489465 -1.99392846854 -2.01963354007 -2.04568533670
+ -2.07208918876 -2.09885053206 -2.12597491063 -2.15346797945
+ -2.18133550731 -2.20958337975 -2.23821760198 -2.26724430202
+ -2.29666973375 -2.32650028014 -2.35674245652 -2.38740291388
+ -2.41848844229 -2.45000597436 -2.48196258876 -2.51436551378
+ -2.54722213099 -2.58053997888 -2.61432675666 -2.64859032795
+ -2.68333872463 -2.71858015066 -2.75432298588 -2.79057578993
+ -2.82734730602 -2.86464646483 -2.90248238825 -2.94086439317
+ -2.97980199517 -3.01930491213 -3.05938306773 -3.10004659487
+ -3.14130583889 -3.18317136063 -3.22565393931 -3.26876457511
+ -3.31251449155 -3.35691513746 -3.40197818869 -3.44771554928
+ -3.49413935233 -3.54126196017 -3.58909596409 -3.63765418331
+ -3.68694966332 -3.73699567328 -3.78780570267 -3.83939345685
+ -3.89177285149 -3.94495800594 -3.99896323506 -4.05380303979
+ -4.10949209597 -4.16604524142 -4.22347746119 -4.28180387058
+ -4.34103969592 -4.40120025287 -4.46230092194 -4.52435712106
+ -4.58738427494 -4.65139778092 -4.71641297099 -4.78244506977
+ -4.84950914794 -4.91762007094 -4.98679244240 -5.05704054196
+ -5.12837825709 -5.20081900826 -5.27437566718 -5.34906046740
+ -5.42488490679 -5.50185964128 -5.57999436917 -5.65929770542
+ -5.73977704511 -5.82143841533 -5.90428631472 -5.98832353977
+ -6.07355099696 -6.15996749985 -6.24756955005 -6.33635110104
+ -6.42630330377 -6.51741423279 -6.60966859190 -6.70304739781
+ -6.79752764083 -6.89308192108 -6.98967805899 -7.08727867883
+ -7.18584076391 -7.28531518231 -7.38564618203 -7.48677085447
+ -7.58861856570 -7.69111035471 -7.79415829880 -7.89766484615
+ -8.00152211650 -8.10561117145 -8.20980125671 -8.31394901952
+ -8.41789770577 -8.52147634253 -8.62449891333 -8.72676353527
+ -8.82805164906 -8.92812723532 -9.02673607306 -9.12360505906
+ -9.21844160987 -9.31093317175 -9.40074686735 -9.48752931211
+ -9.57090663744 -9.65048476226 -9.72584995917 -9.79656976613
+ -9.86219429916 -9.92225802616 -9.97628206564 -10.0237770778
+ -10.0642468173 -10.0971924178 -10.1221174769 -10.1385340084
+ -10.1459693154 -10.1440003706 -10.1321658294 -10.1101077528
+ -10.0775031021 -10.0340932840 -9.97969674536 -9.91422224569
+ -9.83768258077 -9.75020847036 -9.65206223989 -9.54365084109
+ -9.42553767076 -9.29845255925 -9.16329922325 -9.02115941389
+ -8.87329295161 -8.72113283372 -8.56627463898 -8.41045954779
+ -8.25555045483 -8.10350088236 -7.95631670794 -7.81601110010
+ -7.68455349736 -7.56381395361 -7.45550467736 -7.36112107749
+ -7.28188504915 -7.21869354169 -7.17207559472 -7.14216096510
+ -7.12866316109 -7.13087913434 -7.14770706151 -7.17768260793
+ -7.21903286679 -7.26974589615 -7.32765253933 -7.39051613230
+ -7.45612489165 -7.52238134432 -7.58738318105 -7.64949042506
+ -7.70737479062 -7.76004849360 -7.80687144535 -7.84753754842
+ -7.88204252834 -7.91063718788 -7.93377099335 -7.95203137954
+ -7.96608404554 -7.97661884378 -7.98430475087 -7.98975602474
+ -7.99351020236 -7.99601727516 -7.99763835849 -7.99865154270
+ -7.99933222624 -7.99968629639 -7.99986245700 -7.99994573184
+ -7.99998268878 -7.99999770304 -8.00000293119 -8.00000412480
+ -8.00000384705 -8.00000315931 -8.00000245748 -8.00000186283
+ -8.00000139353 -8.00000103465 -8.00000076437 -8.00000056249
+ -8.00000041251 -8.00000030154 -8.00000021975 -8.00000015969
+ -8.00000011573 -8.00000008366 -8.00000006036 -8.00000004347
+ -8.00000003127 -8.00000002248 -8.00000001616 -8.00000001164
+ -8.00000000839 -8.00000000608 -8.00000000442 -8.00000000323
+ -8.00000000239 -8.00000000178 -8.00000000133 -8.00000000101
+ -8.00000000078 -8.00000000061 -8.00000000048 -8.00000000038
+ -8.00000000031 -8.00000000025 -8.00000000020 -8.00000000017
+ -8.00000000014 -8.00000000011 -8.00000000010 -8.00000000008
+ -8.00000000007 -8.00000000006 -8.00000000005 -8.00000000004
+ -8.00000000003 -8.00000000003 -8.00000000002 -8.00000000002
+ -8.00000000002 -8.00000000001 -8.00000000001 -8.00000000001
+ -8.00000000001 -8.00000000001 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000 -8.00000000000 -8.00000000000
+ -8.00000000000 -8.00000000000
+ Core charge follows
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000
+ Valence charge follows
+ 0.296484874566E-10 0.120090369063E-09 0.273619883101E-09 0.492598846777E-09
+ 0.779458486501E-09 0.113670131600E-08 0.156690306352E-08 0.207271464930E-08
+ 0.265686421476E-08 0.332215920456E-08 0.407148850300E-08 0.490782462613E-08
+ 0.583422597099E-08 0.685383912342E-08 0.796990122606E-08 0.918574240791E-08
+ 0.105047882772E-07 0.119305624789E-07 0.134666893194E-07 0.151168964583E-07
+ 0.168850176712E-07 0.187749956839E-07 0.207908850802E-07 0.229368552847E-07
+ 0.252171936242E-07 0.276363084674E-07 0.301987324468E-07 0.329091257633E-07
+ 0.357722795775E-07 0.387931194883E-07 0.419767091014E-07 0.453282536908E-07
+ 0.488531039547E-07 0.525567598687E-07 0.564448746390E-07 0.605232587574E-07
+ 0.647978841613E-07 0.692748885016E-07 0.739605795208E-07 0.788614395434E-07
+ 0.839841300842E-07 0.893354965732E-07 0.949225732046E-07 0.100752587910E-06
+ 0.106832967460E-06 0.113171342698E-06 0.119775553907E-06 0.126653656318E-06
+ 0.133813925758E-06 0.141264864447E-06 0.149015206936E-06 0.157073926210E-06
+ 0.165450239938E-06 0.174153616890E-06 0.183193783517E-06 0.192580730699E-06
+ 0.202324720671E-06 0.212436294124E-06 0.222926277485E-06 0.233805790397E-06
+ 0.245086253375E-06 0.256779395670E-06 0.268897263334E-06 0.281452227486E-06
+ 0.294456992797E-06 0.307924606192E-06 0.321868465773E-06 0.336302329970E-06
+ 0.351240326934E-06 0.366696964165E-06 0.382687138386E-06 0.399226145679E-06
+ 0.416329691867E-06 0.434013903182E-06 0.452295337184E-06 0.471190993980E-06
+ 0.490718327717E-06 0.510895258378E-06 0.531740183878E-06 0.553271992464E-06
+ 0.575510075447E-06 0.598474340243E-06 0.622185223763E-06 0.646663706135E-06
+ 0.671931324789E-06 0.698010188887E-06 0.724922994139E-06 0.752693037989E-06
+ 0.781344235190E-06 0.810901133780E-06 0.841388931469E-06 0.872833492440E-06
+ 0.905261364584E-06 0.938699797173E-06 0.973176758991E-06 0.100872095692E-05
+ 0.104536185500E-05 0.108312969401E-05 0.112205551149E-05 0.116217116232E-05
+ 0.120350933980E-05 0.124610359732E-05 0.128998837050E-05 0.133519899995E-05
+ 0.138177175464E-05 0.142974385578E-05 0.147915350139E-05 0.153003989143E-05
+ 0.158244325369E-05 0.163640487017E-05 0.169196710426E-05 0.174917342861E-05
+ 0.180806845364E-05 0.186869795681E-05 0.193110891269E-05 0.199534952372E-05
+ 0.206146925181E-05 0.212951885069E-05 0.219955039916E-05 0.227161733514E-05
+ 0.234577449057E-05 0.242207812726E-05 0.250058597362E-05 0.258135726233E-05
+ 0.266445276894E-05 0.274993485155E-05 0.283786749138E-05 0.292831633445E-05
+ 0.302134873434E-05 0.311703379595E-05 0.321544242049E-05 0.331664735153E-05
+ 0.342072322223E-05 0.352774660388E-05 0.363779605549E-05 0.375095217487E-05
+ 0.386729765077E-05 0.398691731657E-05 0.410989820521E-05 0.423632960553E-05
+ 0.436630312010E-05 0.449991272446E-05 0.463725482795E-05 0.477842833599E-05
+ 0.492353471403E-05 0.507267805311E-05 0.522596513704E-05 0.538350551138E-05
+ 0.554541155409E-05 0.571179854806E-05 0.588278475541E-05 0.605849149376E-05
+ 0.623904321438E-05 0.642456758237E-05 0.661519555887E-05 0.681106148537E-05
+ 0.701230317015E-05 0.721906197694E-05 0.743148291587E-05 0.764971473664E-05
+ 0.787391002419E-05 0.810422529670E-05 0.834082110617E-05 0.858386214148E-05
+ 0.883351733418E-05 0.908995996684E-05 0.935336778432E-05 0.962392310773E-05
+ 0.990181295140E-05 0.101872291428E-04 0.104803684453E-04 0.107814326847E-04
+ 0.110906288780E-04 0.114081693666E-04 0.117342719517E-04 0.120691600341E-04
+ 0.124130627572E-04 0.127662151534E-04 0.131288582948E-04 0.135012394472E-04
+ 0.138836122285E-04 0.142762367704E-04 0.146793798854E-04 0.150933152366E-04
+ 0.155183235133E-04 0.159546926101E-04 0.164027178104E-04 0.168627019760E-04
+ 0.173349557395E-04 0.178197977034E-04 0.183175546432E-04 0.188285617162E-04
+ 0.193531626754E-04 0.198917100887E-04 0.204445655642E-04 0.210120999808E-04
+ 0.215946937248E-04 0.221927369327E-04 0.228066297399E-04 0.234367825363E-04
+ 0.240836162273E-04 0.247475625031E-04 0.254290641133E-04 0.261285751495E-04
+ 0.268465613348E-04 0.275835003208E-04 0.283398819918E-04 0.291162087774E-04
+ 0.299129959724E-04 0.307307720658E-04 0.315700790772E-04 0.324314729022E-04
+ 0.333155236671E-04 0.342228160919E-04 0.351539498631E-04 0.361095400158E-04
+ 0.370902173259E-04 0.380966287118E-04 0.391294376467E-04 0.401893245818E-04
+ 0.412769873795E-04 0.423931417586E-04 0.435385217504E-04 0.447138801661E-04
+ 0.459199890776E-04 0.471576403086E-04 0.484276459405E-04 0.497308388292E-04
+ 0.510680731366E-04 0.524402248755E-04 0.538481924675E-04 0.552928973170E-04
+ 0.567752843979E-04 0.582963228573E-04 0.598570066333E-04 0.614583550895E-04
+ 0.631014136652E-04 0.647872545432E-04 0.665169773337E-04 0.682917097769E-04
+ 0.701126084628E-04 0.719808595701E-04 0.738976796240E-04 0.758643162732E-04
+ 0.778820490879E-04 0.799521903770E-04 0.820760860278E-04 0.842551163664E-04
+ 0.864906970409E-04 0.887842799270E-04 0.911373540574E-04 0.935514465751E-04
+ 0.960281237114E-04 0.985689917894E-04 0.101175698253E-03 0.103849932723E-03
+ 0.106593428080E-03 0.109407961579E-03 0.112295355984E-03 0.115257480745E-03
+ 0.118296253192E-03 0.121413639772E-03 0.124611657310E-03 0.127892374305E-03
+ 0.131257912266E-03 0.134710447068E-03 0.138252210363E-03 0.141885491010E-03
+ 0.145612636554E-03 0.149436054740E-03 0.153358215062E-03 0.157381650364E-03
+ 0.161508958470E-03 0.165742803865E-03 0.170085919421E-03 0.174541108158E-03
+ 0.179111245067E-03 0.183799278967E-03 0.188608234420E-03 0.193541213690E-03
+ 0.198601398760E-03 0.203792053399E-03 0.209116525282E-03 0.214578248169E-03
+ 0.220180744143E-03 0.225927625904E-03 0.231822599123E-03 0.237869464866E-03
+ 0.244072122073E-03 0.250434570110E-03 0.256960911389E-03 0.263655354050E-03
+ 0.270522214726E-03 0.277565921375E-03 0.284791016191E-03 0.292202158589E-03
+ 0.299804128276E-03 0.307601828404E-03 0.315600288800E-03 0.323804669296E-03
+ 0.332220263141E-03 0.340852500503E-03 0.349706952076E-03 0.358789332775E-03
+ 0.368105505540E-03 0.377661485236E-03 0.387463442662E-03 0.397517708678E-03
+ 0.407830778430E-03 0.418409315703E-03 0.429260157391E-03 0.440390318085E-03
+ 0.451806994796E-03 0.463517571800E-03 0.475529625627E-03 0.487850930177E-03
+ 0.500489461989E-03 0.513453405653E-03 0.526751159367E-03 0.540391340663E-03
+ 0.554382792278E-03 0.568734588206E-03 0.583456039904E-03 0.598556702690E-03
+ 0.614046382309E-03 0.629935141691E-03 0.646233307902E-03 0.662951479289E-03
+ 0.680100532837E-03 0.697691631724E-03 0.715736233107E-03 0.734246096125E-03
+ 0.753233290131E-03 0.772710203166E-03 0.792689550681E-03 0.813184384507E-03
+ 0.834208102091E-03 0.855774456002E-03 0.877897563712E-03 0.900591917671E-03
+ 0.923872395674E-03 0.947754271542E-03 0.972253226107E-03 0.997385358539E-03
+ 0.102316719800E-02 0.104961571567E-02 0.107674833708E-02 0.110458295489E-02
+ 0.113313794199E-02 0.116243216505E-02 0.119248499844E-02 0.122331633861E-02
+ 0.125494661885E-02 0.128739682463E-02 0.132068850925E-02 0.135484381010E-02
+ 0.138988546536E-02 0.142583683127E-02 0.146272189989E-02 0.150056531743E-02
+ 0.153939240320E-02 0.157922916911E-02 0.162010233980E-02 0.166203937344E-02
+ 0.170506848314E-02 0.174921865910E-02 0.179451969147E-02 0.184100219391E-02
+ 0.188869762793E-02 0.193763832807E-02 0.198785752781E-02 0.203938938646E-02
+ 0.209226901677E-02 0.214653251365E-02 0.220221698365E-02 0.225936057555E-02
+ 0.231800251197E-02 0.237818312194E-02 0.243994387471E-02 0.250332741458E-02
+ 0.256837759703E-02 0.263513952593E-02 0.270365959224E-02 0.277398551381E-02
+ 0.284616637674E-02 0.292025267806E-02 0.299629636997E-02 0.307435090556E-02
+ 0.315447128620E-02 0.323671411056E-02 0.332113762534E-02 0.340780177791E-02
+ 0.349676827066E-02 0.358810061748E-02 0.368186420209E-02 0.377812633861E-02
+ 0.387695633429E-02 0.397842555445E-02 0.408260748986E-02 0.418957782661E-02
+ 0.429941451844E-02 0.441219786184E-02 0.452801057393E-02 0.464693787310E-02
+ 0.476906756287E-02 0.489449011868E-02 0.502329877810E-02 0.515558963432E-02
+ 0.529146173327E-02 0.543101717436E-02 0.557436121506E-02 0.572160237954E-02
+ 0.587285257137E-02 0.602822719065E-02 0.618784525560E-02 0.635182952885E-02
+ 0.652030664865E-02 0.669340726523E-02 0.687126618238E-02 0.705402250465E-02
+ 0.724181979031E-02 0.743480621032E-02 0.763313471359E-02 0.783696319878E-02
+ 0.804645469289E-02 0.826177753697E-02 0.848310557928E-02 0.871061837607E-02
+ 0.894450140049E-02 0.918494625987E-02 0.943215092168E-02 0.968631994871E-02
+ 0.994766474363E-02 0.102164038035E-01 0.104927629848E-01 0.107769757787E-01
+ 0.110692835979E-01 0.113699360756E-01 0.116791913756E-01 0.119973165157E-01
+ 0.123245877048E-01 0.126612906927E-01 0.130077211352E-01 0.133641849737E-01
+ 0.137309988303E-01 0.141084904198E-01 0.144969989780E-01 0.148968757076E-01
+ 0.153084842431E-01 0.157322011340E-01 0.161684163489E-01 0.166175337992E-01
+ 0.170799718857E-01 0.175561640662E-01 0.180465594480E-01 0.185516234036E-01
+ 0.190718382126E-01 0.196077037291E-01 0.201597380775E-01 0.207284783758E-01
+ 0.213144814895E-01 0.219183248158E-01 0.225406070998E-01 0.231819492843E-01
+ 0.238429953939E-01 0.245244134553E-01 0.252268964546E-01 0.259511633333E-01
+ 0.266979600247E-01 0.274680605321E-01 0.282622680494E-01 0.290814161271E-01
+ 0.299263698848E-01 0.307980272711E-01 0.316973203738E-01 0.326252167813E-01
+ 0.335827209968E-01 0.345708759085E-01 0.355907643154E-01 0.366435105128E-01
+ 0.377302819374E-01 0.388522908756E-01 0.400107962357E-01 0.412071053861E-01
+ 0.424425760622E-01 0.437186183428E-01 0.450366966987E-01 0.463983321151E-01
+ 0.478051042894E-01 0.492586539070E-01 0.507606849957E-01 0.523129673613E-01
+ 0.539173391058E-01 0.555757092295E-01 0.572900603190E-01 0.590624513212E-01
+ 0.608950204056E-01 0.627899879160E-01 0.647496594109E-01 0.667764287948E-01
+ 0.688727815394E-01 0.710412979959E-01 0.732846567971E-01 0.756056383494E-01
+ 0.780071284125E-01 0.804921217672E-01 0.830637259671E-01 0.857251651736E-01
+ 0.884797840696E-01 0.913310518494E-01 0.942825662787E-01 0.973380578216E-01
+ 0.100501393826 0.103776582763 0.107167778509 0.110679284661
+ 0.114315558887 0.118081217273 0.121981038682 0.126019969094
+ 0.130203125916 0.134535802238 0.139023471024 0.143671789207
+ 0.148486601672 0.153473945090 0.158640051586 0.163991352194
+ 0.169534480076 0.175276273469 0.181223778300 0.187384250447
+ 0.193765157585 0.200374180566 0.207219214275 0.214308367915
+ 0.221649964634 0.229252540442 0.237124842340 0.245275825580
+ 0.253714649965 0.262450675121 0.271493454626 0.280852728901
+ 0.290538416775 0.300560605585 0.310929539731 0.321655607532
+ 0.332749326294 0.344221325429 0.356082327520 0.368343127180
+ 0.381014567581 0.394107514501 0.407632827761 0.421601329911
+ 0.436023772021 0.450910796458 0.466272896505 0.482120372723
+ 0.498463285922 0.515311406668 0.532674161222 0.550560573866
+ 0.568979205569 0.587938088970 0.607444659710 0.627505684155
+ 0.648127183595 0.669314355073 0.691071489016 0.713401883913
+ 0.736307758355 0.759790160795 0.783848877487 0.808482339122
+ 0.833687526775 0.859459877858 0.885793192866 0.912679543816
+ 0.940109185346 0.968070469561 0.996549765799 1.02553138658
+ 1.05499752107 1.08492817751 1.11530113604 1.14609191346
+ 1.17727374142 1.20881755965 1.24069202553 1.27286354158
+ 1.30529630206 1.33795235976 1.37079171389 1.40377241980
+ 1.43685072068 1.46998120124 1.50311696292 1.53620981959
+ 1.56921051229 1.60206893970 1.63473439962 1.66715585014
+ 1.69928218518 1.73106248558 1.76244629710 1.79338388470
+ 1.82382648204 1.85372652138 1.88303784093 1.91171586408
+ 1.93971774568 1.96700248133 1.99353097651 2.01926607324
+ 2.04417253362 2.06821698063 2.09136779846 2.11359499591
+ 2.13487003826 2.15516565443 2.17445562743 2.19271457766
+ 2.20991774887 2.22604080775 2.24105966757 2.25495034638
+ 2.26768886936 2.27925122343 2.28961337086 2.29875132623
+ 2.30664129855 2.31325989772 2.31858440129 2.32259307437
+ 2.32526553257 2.32658313478 2.32652939047 2.32509036431
+ 2.32225506006 2.31801576611 2.31236834626 2.30531246215
+ 2.29685171758 2.28699371943 2.27575005537 2.26313619345
+ 2.24917131380 2.23387808617 2.21728240977 2.19941313236
+ 2.18030176531 2.15998220837 2.13849049512 2.11586456567
+ 2.09214406939 2.06737019652 2.04158553499 2.01483394681
+ 1.98716045400 1.95861112377 1.92923299193 1.89907401090
+ 1.86818285940 1.83660881990 1.80440171945 1.77161177937
+ 1.73828950996 1.70448558304 1.67025070844 1.63563551019
+ 1.60069040453 1.56546548019 1.53001038179 1.49437419646
+ 1.45860534446 1.42275147380 1.38685935932 1.35097480656
+ 1.31514256051 1.27940621955 1.24380815482 1.20838943504
+ 1.17318975712 1.13824738245 1.10359907917 1.06928007035
+ 1.03532398813 1.00176283395 0.968626944652 0.935944964617
+ 0.903743823778 0.872048721439 0.840883115819 0.810268719193
+ 0.780225498484 0.750771681157 0.721923766233 0.693696540241
+ 0.666103097896 0.639154867291 0.612861639365 0.587231601425
+ 0.562271374444 0.537986053908 0.514379253926 0.491453154345
+ 0.469208550593 0.447644905969 0.426760406116 0.406552015385
+ 0.387015534823 0.368145661505 0.349936048941 0.332379368300
+ 0.315467370176 0.299190946653 0.283540193426 0.268504471728
+ 0.254072469851 0.240232264036 0.226971378524 0.214276844584
+ 0.202135258328 0.190532837146 0.179455474606 0.168888793681
+ 0.158818198173 0.149228922209 0.140106077735 0.131434699887
+ 0.123199790204 0.115386357592 0.107979457014 0.100964225870
+ 0.943259180405E-01 0.880499355970E-01 0.821218581725E-01 0.765274700191E-01
+ 0.712527847693E-01 0.662840679420E-01 0.616078572346E-01 0.572109806560E-01
+ 0.530805725596E-01 0.492040876436E-01 0.455693129906E-01 0.421643782254E-01
+ 0.389777638724E-01 0.359983079981E-01 0.332152112273E-01 0.306180402238E-01
+ 0.281967297273E-01 0.259415832377E-01 0.238432724423E-01 0.218928354747E-01
+ 0.200816740993E-01 0.184015499093E-01 0.168445796261E-01 0.154032295868E-01
+ 0.140703095004E-01 0.128389655542E-01 0.117026729460E-01 0.106552279156E-01
+ 0.969073934530E-02 0.880361999506E-02 0.798857743500E-02 0.724060473348E-02
+ 0.655497095567E-02 0.592721152358E-02 0.535311848500E-02 0.482873073511E-02
+ 0.435032423107E-02 0.391440223647E-02 0.351768562937E-02 0.315710330442E-02
+ 0.282978269662E-02 0.253304045145E-02 0.226437326352E-02 0.202144890311E-02
+ 0.180209744783E-02 0.160430273432E-02 0.142619404273E-02 0.126603802495E-02
+ 0.112223088553E-02 0.993290822597E-03 0.877850734653E-03 0.774651197438E-03
+ 0.682533713785E-03 0.600434238168E-03 0.527376976408E-03 0.462468459963E-03
+ 0.404891893214E-03 0.353901771257E-03 0.308818764854E-03 0.269024868448E-03
+ 0.233958806427E-03 0.203111692184E-03 0.176022933987E-03 0.152276381105E-03
+ 0.131496703223E-03 0.113345995796E-03 0.975206035973E-04 0.837481545132E-04
+ 0.717847953350E-04 0.614126211675E-04 0.524372899229E-04 0.446858132957E-04
+ 0.380045155784E-04 0.322571516847E-04 0.273231758023E-04 0.230961521809E-04
+ 0.194822996915E-04 0.163991619495E-04 0.137743949853E-04 0.115446646610E-04
+ 0.965464627688E-05 0.805611906842E-05 0.670714858066E-05 0.557135019708E-05
+ 0.461722740970E-05 0.381757873129E-05 0.314896747183E-05 0.259124892537E-05
+ 0.212714983775E-05 0.174189534790E-05 0.142287891382E-05 0.115937104561E-05
+ 0.942262972570E-06 0.763841665095E-06 0.617592916269E-06 0.498029459350E-06
+ 0.400541356623E-06 0.321266140588E-06 0.256976420281E-06 0.204982883168E-06
+ 0.163050826592E-06 0.129328542050E-06 0.102286050966E-06 0.806628523764E-07
+ 0.634234914208E-07 0.497198932798E-07 0.388595307892E-07 0.302786059440E-07
+ 0.235195266172E-07 0.182120506836E-07 0.140575510842E-07 0.108159278744E-07
+ 0.829475767375E-08 0.634032784953E-08 0.483025287891E-08 0.366741428110E-08
+ 0.277500389056E-08 0.209248362372E-08 0.157230380718E-08 0.117724707979E-08
+ 0.878286311383E-09 0.652863316544E-09 0.483510764135E-09 0.356752939809E-09
+ 0.262232219477E-09 0.192017536847E-09 0.140059025183E-09 0.101759602404E-09
+ 0.736397425584E-10 0.530762049628E-10 0.380992218880E-10 0.272357042526E-10
+ 0.193885219816E-10 0.137439455799E-10 0.970097813726E-11 0.681763032847E-11
+ 0.477025223790E-11 0.332288304189E-11 0.230425277821E-11 0.159060287511E-11
+ 0.109291125071E-11 0.747436175738E-12 0.508749137097E-12 0.344625618034E-12
+ 0.232316120685E-12 0.155837630354E-12 0.104015837370E-12 0.690769817107E-13
+ 0.456400639753E-13 0.299992262504E-13 0.196153623442E-13 0.127578146023E-13
+ 0.825316909147E-14 0.531006909421E-14 0.339769718498E-14 0.216194160025E-14
+ 0.136787803551E-14 0.860525764904E-15 0.538222722918E-15 0.334664771544E-15
+ 0.206859541235E-15 0.127094298785E-15 0.776119312929E-16 0.471030859819E-16
+ 0.284089250553E-16 0.170259167379E-16 0.101386875045E-16 0.599837102548E-17
+ 0.352557253930E-17 0.205842318387E-17 0.119374575603E-17 0.687581542188E-18
+ 0.393309407806E-18 0.223410874105E-18 0.126007311336E-18 0.705618209651E-19
+ 0.392271772593E-19 0.216474990596E-19 0.118574538780E-19 0.644610453353E-20
+ 0.347763547755E-20 0.186169997687E-20 0.988853219946E-21 0.521083739614E-21
+ 0.272391322283E-21 0.141235877180E-21 0.726303634425E-22 0.370397177793E-22
+ 0.187304262714E-22 0.939100114026E-23 0.466781333798E-23 0.229987879029E-23
+ 0.112315119156E-23 0.543581444073E-24 0.260696293853E-24 0.123879375992E-24
+ 0.583185253254E-25 0.271960761050E-25 0.125616394071E-25 0.574611447546E-26
+ 0.260277697140E-26 0.116729479664E-26 0.518263421532E-27 0.227767520167E-27
+ 0.990714162433E-28 0.426445661110E-28 0.181627025979E-28 0.765315754181E-29
+ 0.318996176468E-29 0.131508986913E-29 0.536154865501E-30 0.216136893983E-30
+ 0.861409373105E-31 0.339367091031E-31 0.132143536037E-31 0.508480149347E-32
+ 0.193325420860E-32 0.726147729127E-33 0.269411047838E-33 0.987171731207E-34
+ 0.357181163393E-34 0.127595006922E-34 0.449943512836E-35 0.156599542225E-35
+ 0.537847623148E-36 0.182260043781E-36 0.609275045192E-37 0.200886304445E-37
+ 0.653170635008E-38 0.209394736070E-38 0.661744106653E-39 0.206120439807E-39
+ 0.632672761023E-40 0.191330295397E-40 0.569971686246E-41 0.167226510271E-41
+ 0.483120643337E-42 0.137410507239E-42 0.384691287917E-43 0.105985367771E-43
+ 0.287298006846E-44 0.766096240783E-45 0.200912895330E-45 0.518101275040E-46
+ 0.131344329632E-46 0.327268417666E-47 0.801305398078E-48 0.192751227196E-48
+ 0.455411557681E-49 0.105662343662E-49 0.240683309551E-50 0.538121393506E-51
+ 0.118064908889E-51 0.254134827111E-52 0.536544195335E-53 0.111080719010E-53
+ 0.225453159239E-54 0.448486844315E-55 0.874195935449E-56 0.166925298972E-56
+ 0.312159888239E-57 0.571556854830E-58 0.102436443153E-58 0.179657252591E-59
+ 0.308243509167E-60 0.517367574380E-61 0.850989519458E-62 0.136831323036E-62
+ 0.215010231634E-63 0.330080166782E-64
Index: /XMLF90/doc/Examples/wxml/Fe.psf
===================================================================
--- /XMLF90/doc/Examples/wxml/Fe.psf (revision 6)
+++ /XMLF90/doc/Examples/wxml/Fe.psf (revision 6)
@@ -0,0 +1,3114 @@
+ Fe pb isp pcec
+ ATM3 29-MAY-03 Troullier-Martins
+ 4s1.00,1.00s2.00/4p0.00,0.00s2.00/3d5.00,1.00s2.00/4f0.00,0.00s2.00/
+ 4 4 1123 0.953366221795E-04 0.125000000000E-01 8.00000000000
+ Radial grid follows
+ 0.119918708213E-05 0.241345808087E-05 0.364300272851E-05 0.488801314393E-05
+ 0.614868386252E-05 0.742521186666E-05 0.871779661643E-05 0.100266400808E-04
+ 0.113519467694E-04 0.126939237638E-04 0.140527807509E-04 0.154287300547E-04
+ 0.168219866701E-04 0.182327682964E-04 0.196612953710E-04 0.211077911042E-04
+ 0.225724815139E-04 0.240555954609E-04 0.255573646848E-04 0.270780238401E-04
+ 0.286178105329E-04 0.301769653581E-04 0.317557319366E-04 0.333543569540E-04
+ 0.349730901988E-04 0.366121846012E-04 0.382718962731E-04 0.399524845479E-04
+ 0.416542120209E-04 0.433773445904E-04 0.451221514994E-04 0.468889053776E-04
+ 0.486778822838E-04 0.504893617493E-04 0.523236268215E-04 0.541809641081E-04
+ 0.560616638217E-04 0.579660198255E-04 0.598943296790E-04 0.618468946845E-04
+ 0.638240199344E-04 0.658260143584E-04 0.678531907722E-04 0.699058659264E-04
+ 0.719843605555E-04 0.740889994285E-04 0.762201113997E-04 0.783780294595E-04
+ 0.805630907870E-04 0.827756368026E-04 0.850160132210E-04 0.872845701056E-04
+ 0.895816619230E-04 0.919076475986E-04 0.942628905723E-04 0.966477588555E-04
+ 0.990626250889E-04 0.101507866600E-03 0.103983865463E-03 0.106491008558E-03
+ 0.109029687631E-03 0.111600299356E-03 0.114203245395E-03 0.116838932465E-03
+ 0.119507772397E-03 0.122210182203E-03 0.124946584140E-03 0.127717405776E-03
+ 0.130523080058E-03 0.133364045377E-03 0.136240745641E-03 0.139153630340E-03
+ 0.142103154618E-03 0.145089779345E-03 0.148113971185E-03 0.151176202677E-03
+ 0.154276952298E-03 0.157416704549E-03 0.160595950021E-03 0.163815185478E-03
+ 0.167074913932E-03 0.170375644723E-03 0.173717893596E-03 0.177102182784E-03
+ 0.180529041090E-03 0.183999003967E-03 0.187512613604E-03 0.191070419010E-03
+ 0.194672976098E-03 0.198320847777E-03 0.202014604032E-03 0.205754822022E-03
+ 0.209542086162E-03 0.213376988220E-03 0.217260127409E-03 0.221192110475E-03
+ 0.225173551800E-03 0.229205073492E-03 0.233287305484E-03 0.237420885633E-03
+ 0.241606459820E-03 0.245844682049E-03 0.250136214550E-03 0.254481727886E-03
+ 0.258881901050E-03 0.263337421579E-03 0.267848985658E-03 0.272417298226E-03
+ 0.277043073093E-03 0.281727033044E-03 0.286469909959E-03 0.291272444922E-03
+ 0.296135388338E-03 0.301059500051E-03 0.306045549466E-03 0.311094315661E-03
+ 0.316206587517E-03 0.321383163837E-03 0.326624853472E-03 0.331932475445E-03
+ 0.337306859085E-03 0.342748844148E-03 0.348259280957E-03 0.353839030528E-03
+ 0.359488964709E-03 0.365209966313E-03 0.371002929259E-03 0.376868758708E-03
+ 0.382808371208E-03 0.388822694837E-03 0.394912669344E-03 0.401079246301E-03
+ 0.407323389246E-03 0.413646073841E-03 0.420048288018E-03 0.426531032136E-03
+ 0.433095319136E-03 0.439742174703E-03 0.446472637420E-03 0.453287758936E-03
+ 0.460188604128E-03 0.467176251266E-03 0.474251792186E-03 0.481416332454E-03
+ 0.488670991545E-03 0.496016903014E-03 0.503455214674E-03 0.510987088776E-03
+ 0.518613702193E-03 0.526336246596E-03 0.534155928650E-03 0.542073970196E-03
+ 0.550091608444E-03 0.558210096165E-03 0.566430701892E-03 0.574754710109E-03
+ 0.583183421460E-03 0.591718152948E-03 0.600360238143E-03 0.609111027387E-03
+ 0.617971888010E-03 0.626944204539E-03 0.636029378917E-03 0.645228830720E-03
+ 0.654543997382E-03 0.663976334416E-03 0.673527315645E-03 0.683198433428E-03
+ 0.692991198898E-03 0.702907142194E-03 0.712947812701E-03 0.723114779297E-03
+ 0.733409630588E-03 0.743833975168E-03 0.754389441861E-03 0.765077679981E-03
+ 0.775900359585E-03 0.786859171741E-03 0.797955828784E-03 0.809192064590E-03
+ 0.820569634844E-03 0.832090317313E-03 0.843755912129E-03 0.855568242064E-03
+ 0.867529152819E-03 0.879640513310E-03 0.891904215962E-03 0.904322177003E-03
+ 0.916896336766E-03 0.929628659988E-03 0.942521136121E-03 0.955575779639E-03
+ 0.968794630359E-03 0.982179753752E-03 0.995733241271E-03 0.100945721068E-02
+ 0.102335380636E-02 0.103742519971E-02 0.105167358939E-02 0.106610120176E-02
+ 0.108071029114E-02 0.109550314025E-02 0.111048206049E-02 0.112564939236E-02
+ 0.114100750578E-02 0.115655880048E-02 0.117230570639E-02 0.118825068399E-02
+ 0.120439622472E-02 0.122074485135E-02 0.123729911838E-02 0.125406161247E-02
+ 0.127103495277E-02 0.128822179141E-02 0.130562481387E-02 0.132324673941E-02
+ 0.134109032148E-02 0.135915834818E-02 0.137745364268E-02 0.139597906366E-02
+ 0.141473750574E-02 0.143373189998E-02 0.145296521429E-02 0.147244045391E-02
+ 0.149216066189E-02 0.151212891955E-02 0.153234834697E-02 0.155282210348E-02
+ 0.157355338814E-02 0.159454544026E-02 0.161580153989E-02 0.163732500834E-02
+ 0.165911920870E-02 0.168118754635E-02 0.170353346951E-02 0.172616046979E-02
+ 0.174907208269E-02 0.177227188821E-02 0.179576351135E-02 0.181955062274E-02
+ 0.184363693915E-02 0.186802622413E-02 0.189272228855E-02 0.191772899122E-02
+ 0.194305023949E-02 0.196868998985E-02 0.199465224857E-02 0.202094107230E-02
+ 0.204756056872E-02 0.207451489720E-02 0.210180826938E-02 0.212944494993E-02
+ 0.215742925712E-02 0.218576556357E-02 0.221445829687E-02 0.224351194033E-02
+ 0.227293103363E-02 0.230272017358E-02 0.233288401477E-02 0.236342727039E-02
+ 0.239435471286E-02 0.242567117467E-02 0.245738154907E-02 0.248949079089E-02
+ 0.252200391724E-02 0.255492600838E-02 0.258826220845E-02 0.262201772630E-02
+ 0.265619783629E-02 0.269080787914E-02 0.272585326273E-02 0.276133946299E-02
+ 0.279727202469E-02 0.283365656238E-02 0.287049876122E-02 0.290780437786E-02
+ 0.294557924140E-02 0.298382925423E-02 0.302256039299E-02 0.306177870951E-02
+ 0.310149033172E-02 0.314170146464E-02 0.318241839135E-02 0.322364747395E-02
+ 0.326539515457E-02 0.330766795636E-02 0.335047248455E-02 0.339381542741E-02
+ 0.343770355739E-02 0.348214373208E-02 0.352714289535E-02 0.357270807842E-02
+ 0.361884640093E-02 0.366556507210E-02 0.371287139181E-02 0.376077275177E-02
+ 0.380927663667E-02 0.385839062533E-02 0.390812239192E-02 0.395847970712E-02
+ 0.400947043938E-02 0.406110255608E-02 0.411338412487E-02 0.416632331483E-02
+ 0.421992839783E-02 0.427420774977E-02 0.432916985191E-02 0.438482329219E-02
+ 0.444117676656E-02 0.449823908039E-02 0.455601914976E-02 0.461452600294E-02
+ 0.467376878173E-02 0.473375674294E-02 0.479449925982E-02 0.485600582351E-02
+ 0.491828604452E-02 0.498134965428E-02 0.504520650659E-02 0.510986657923E-02
+ 0.517533997546E-02 0.524163692563E-02 0.530876778877E-02 0.537674305422E-02
+ 0.544557334326E-02 0.551526941075E-02 0.558584214685E-02 0.565730257869E-02
+ 0.572966187211E-02 0.580293133339E-02 0.587712241105E-02 0.595224669758E-02
+ 0.602831593130E-02 0.610534199820E-02 0.618333693374E-02 0.626231292480E-02
+ 0.634228231154E-02 0.642325758934E-02 0.650525141074E-02 0.658827658745E-02
+ 0.667234609233E-02 0.675747306139E-02 0.684367079592E-02 0.693095276446E-02
+ 0.701933260502E-02 0.710882412713E-02 0.719944131400E-02 0.729119832477E-02
+ 0.738410949666E-02 0.747818934721E-02 0.757345257661E-02 0.766991406992E-02
+ 0.776758889945E-02 0.786649232710E-02 0.796663980671E-02 0.806804698654E-02
+ 0.817072971167E-02 0.827470402648E-02 0.837998617718E-02 0.848659261430E-02
+ 0.859453999532E-02 0.870384518725E-02 0.881452526924E-02 0.892659753527E-02
+ 0.904007949688E-02 0.915498888583E-02 0.927134365697E-02 0.938916199096E-02
+ 0.950846229715E-02 0.962926321646E-02 0.975158362429E-02 0.987544263343E-02
+ 0.100008595971E-01 0.101278541120E-01 0.102564460213E-01 0.103866554176E-01
+ 0.105185026465E-01 0.106520083094E-01 0.107871932668E-01 0.109240786417E-01
+ 0.110626858226E-01 0.112030364672E-01 0.113451525056E-01 0.114890561437E-01
+ 0.116347698667E-01 0.117823164427E-01 0.119317189262E-01 0.120830006616E-01
+ 0.122361852870E-01 0.123912967378E-01 0.125483592504E-01 0.127073973662E-01
+ 0.128684359353E-01 0.130315001202E-01 0.131966154000E-01 0.133638075744E-01
+ 0.135331027675E-01 0.137045274319E-01 0.138781083532E-01 0.140538726536E-01
+ 0.142318477969E-01 0.144120615918E-01 0.145945421972E-01 0.147793181261E-01
+ 0.149664182500E-01 0.151558718038E-01 0.153477083899E-01 0.155419579832E-01
+ 0.157386509356E-01 0.159378179808E-01 0.161394902391E-01 0.163436992220E-01
+ 0.165504768377E-01 0.167598553957E-01 0.169718676117E-01 0.171865466131E-01
+ 0.174039259439E-01 0.176240395701E-01 0.178469218849E-01 0.180726077140E-01
+ 0.183011323214E-01 0.185325314146E-01 0.187668411500E-01 0.190040981390E-01
+ 0.192443394536E-01 0.194876026320E-01 0.197339256844E-01 0.199833470994E-01
+ 0.202359058496E-01 0.204916413978E-01 0.207505937032E-01 0.210128032276E-01
+ 0.212783109418E-01 0.215471583319E-01 0.218193874059E-01 0.220950407001E-01
+ 0.223741612860E-01 0.226567927765E-01 0.229429793336E-01 0.232327656745E-01
+ 0.235261970787E-01 0.238233193957E-01 0.241241790513E-01 0.244288230556E-01
+ 0.247372990097E-01 0.250496551136E-01 0.253659401736E-01 0.256862036100E-01
+ 0.260104954644E-01 0.263388664082E-01 0.266713677501E-01 0.270080514439E-01
+ 0.273489700973E-01 0.276941769794E-01 0.280437260296E-01 0.283976718656E-01
+ 0.287560697921E-01 0.291189758096E-01 0.294864466228E-01 0.298585396498E-01
+ 0.302353130309E-01 0.306168256378E-01 0.310031370825E-01 0.313943077270E-01
+ 0.317903986925E-01 0.321914718689E-01 0.325975899250E-01 0.330088163172E-01
+ 0.334252153008E-01 0.338468519388E-01 0.342737921128E-01 0.347061025330E-01
+ 0.351438507490E-01 0.355871051597E-01 0.360359350245E-01 0.364904104740E-01
+ 0.369506025209E-01 0.374165830712E-01 0.378884249353E-01 0.383662018394E-01
+ 0.388499884371E-01 0.393398603211E-01 0.398358940348E-01 0.403381670846E-01
+ 0.408467579516E-01 0.413617461042E-01 0.418832120102E-01 0.424112371500E-01
+ 0.429459040283E-01 0.434872961881E-01 0.440354982229E-01 0.445905957904E-01
+ 0.451526756258E-01 0.457218255552E-01 0.462981345094E-01 0.468816925378E-01
+ 0.474725908226E-01 0.480709216929E-01 0.486767786390E-01 0.492902563273E-01
+ 0.499114506151E-01 0.505404585650E-01 0.511773784610E-01 0.518223098231E-01
+ 0.524753534230E-01 0.531366113002E-01 0.538061867775E-01 0.544841844776E-01
+ 0.551707103388E-01 0.558658716324E-01 0.565697769786E-01 0.572825363640E-01
+ 0.580042611589E-01 0.587350641341E-01 0.594750594791E-01 0.602243628198E-01
+ 0.609830912361E-01 0.617513632811E-01 0.625292989988E-01 0.633170199432E-01
+ 0.641146491973E-01 0.649223113924E-01 0.657401327272E-01 0.665682409881E-01
+ 0.674067655686E-01 0.682558374899E-01 0.691155894212E-01 0.699861557005E-01
+ 0.708676723556E-01 0.717602771252E-01 0.726641094807E-01 0.735793106476E-01
+ 0.745060236280E-01 0.754443932228E-01 0.763945660541E-01 0.773566905882E-01
+ 0.783309171592E-01 0.793173979919E-01 0.803162872260E-01 0.813277409398E-01
+ 0.823519171752E-01 0.833889759618E-01 0.844390793420E-01 0.855023913968E-01
+ 0.865790782706E-01 0.876693081982E-01 0.887732515300E-01 0.898910807596E-01
+ 0.910229705499E-01 0.921690977612E-01 0.933296414780E-01 0.945047830377E-01
+ 0.956947060586E-01 0.968995964685E-01 0.981196425341E-01 0.993550348900E-01
+ 0.100605966569 0.101872633031 0.103155232196 0.104453964472
+ 0.105769032790 0.107100642630 0.108449002061 0.109814321765
+ 0.111196815077 0.112596698014 0.114014189310 0.115449510453
+ 0.116902885712 0.118374542182 0.119864709812 0.121373621443
+ 0.122901512846 0.124448622756 0.126015192914 0.127601468098
+ 0.129207696169 0.130834128101 0.132481018028 0.134148623280
+ 0.135837204424 0.137547025305 0.139278353084 0.141031458286
+ 0.142806614837 0.144604100109 0.146424194961 0.148267183789
+ 0.150133354563 0.152022998875 0.153936411986 0.155873892872
+ 0.157835744267 0.159822272715 0.161833788614 0.163870606269
+ 0.165933043936 0.168021423875 0.170136072400 0.172277319929
+ 0.174445501037 0.176640954505 0.178864023378 0.181115055016
+ 0.183394401146 0.185702417921 0.188039465972 0.190405910470
+ 0.192802121175 0.195228472500 0.197685343568 0.200173118269
+ 0.202692185324 0.205242938342 0.207825775883 0.210441101521
+ 0.213089323906 0.215770856828 0.218486119281 0.221235535532
+ 0.224019535182 0.226838553236 0.229693030173 0.232583412009
+ 0.235510150373 0.238473702574 0.241474531673 0.244513106555
+ 0.247589902004 0.250705398775 0.253860083672 0.257054449619
+ 0.260288995744 0.263564227451 0.266880656501 0.270238801093
+ 0.273639185944 0.277082342371 0.280568808374 0.284099128721
+ 0.287673855032 0.291293545864 0.294958766802 0.298670090543
+ 0.302428096991 0.306233373341 0.310086514174 0.313988121553
+ 0.317938805112 0.321939182152 0.325989877741 0.330091524808
+ 0.334244764244 0.338450245000 0.342708624193 0.347020567202
+ 0.351386747777 0.355807848143 0.360284559106 0.364817580161
+ 0.369407619601 0.374055394630 0.378761631472 0.383527065486
+ 0.388352441281 0.393238512831 0.398186043596 0.403195806637
+ 0.408268584739 0.413405170535 0.418606366626 0.423872985710
+ 0.429205850707 0.434605794889 0.440073662006 0.445610306425
+ 0.451216593257 0.456893398497 0.462641609156 0.468462123405
+ 0.474355850710 0.480323711978 0.486366639700 0.492485578096
+ 0.498681483261 0.504955323320 0.511308078571 0.517740741647
+ 0.524254317664 0.530849824380 0.537528292359 0.544290765123
+ 0.551138299323 0.558071964901 0.565092845254 0.572202037411
+ 0.579400652198 0.586689814411 0.594070662998 0.601544351231
+ 0.609112046890 0.616774932442 0.624534205228 0.632391077651
+ 0.640346777363 0.648402547458 0.656559646667 0.664819349553
+ 0.673182946712 0.681651744972 0.690227067601 0.698910254510
+ 0.707702662465 0.716605665297 0.725620654119 0.734749037541
+ 0.743992241891 0.753351711439 0.762828908622 0.772425314270
+ 0.782142427841 0.791981767655 0.801944871127 0.812033295014
+ 0.822248615652 0.832592429205 0.843066351916 0.853672020356
+ 0.864411091683 0.875285243898 0.886296176110 0.897445608799
+ 0.908735284086 0.920166966008 0.931742440786 0.943463517113
+ 0.955332026430 0.967349823217 0.979518785278 0.991840814039
+ 1.00431783484 1.01695179725 1.02974467533 1.04269846802
+ 1.05581519936 1.06909691887 1.08254570184 1.09616364968
+ 1.10995289021 1.12391557804 1.13805389486 1.15237004982
+ 1.16686627983 1.18154484997 1.19640805380 1.21145821371
+ 1.22669768134 1.24212883786 1.25775409444 1.27357589256
+ 1.28959670439 1.30581903323 1.32224541385 1.33887841290
+ 1.35572062932 1.37277469475 1.39004327391 1.40752906506
+ 1.42523480038 1.44316324644 1.46131720459 1.47969951142
+ 1.49831303920 1.51716069635 1.53624542783 1.55557021569
+ 1.57513807945 1.59495207664 1.61501530323 1.63533089415
+ 1.65590202374 1.67673190629 1.69782379651 1.71918099004
+ 1.74080682400 1.76270467747 1.78487797202 1.80733017228
+ 1.83006478646 1.85308536688 1.87639551056 1.89999885974
+ 1.92389910252 1.94809997333 1.97260525363 1.99741877241
+ 2.02254440683 2.04798608283 2.07374777572 2.09983351081
+ 2.12624736405 2.15299346267 2.18007598580 2.20749916513
+ 2.23526728559 2.26338468601 2.29185575978 2.32068495558
+ 2.34987677803 2.37943578839 2.40936660534 2.43967390561
+ 2.47036242480 2.50143695803 2.53290236078 2.56476354957
+ 2.59702550278 2.62969326140 2.66277192984 2.69626667671
+ 2.73018273563 2.76452540606 2.79930005410 2.83451211336
+ 2.87016708581 2.90627054260 2.94282812497 2.97984554512
+ 3.01732858709 3.05528310770 3.09371503740 3.13263038126
+ 3.17203521989 3.21193571038 3.25233808725 3.29324866346
+ 3.33467383137 3.37662006375 3.41909391478 3.46210202109
+ 3.50565110278 3.54974796448 3.59439949642 3.63961267549
+ 3.68539456634 3.73175232249 3.77869318743 3.82622449576
+ 3.87435367435 3.92308824348 3.97243581803 4.02240410865
+ 4.07300092300 4.12423416692 4.17611184572 4.22864206538
+ 4.28183303387 4.33569306238 4.39023056665 4.44545406827
+ 4.50137219603 4.55799368725 4.61532738916 4.67338226025
+ 4.73216737173 4.79169190889 4.85196517255 4.91299658053
+ 4.97479566913 5.03737209456 5.10073563453 5.16489618972
+ 5.22986378534 5.29564857272 5.36226083085 5.42971096805
+ 5.49800952353 5.56716716908 5.63719471072 5.70810309040
+ 5.77990338770 5.85260682156 5.92622475204 6.00076868209
+ 6.07625025935 6.15268127797 6.23007368046 6.30843955953
+ 6.38779116001 6.46814088076 6.54950127657 6.63188506018
+ 6.71530510422 6.79977444324 6.88530627575 6.97191396627
+ 7.05961104743 7.14841122207 7.23832836540 7.32937652717
+ 7.42156993383 7.51492299078 7.60945028464 7.70516658549
+ 7.80208684918 7.90022621972 7.99960003157 8.10022381210
+ 8.20211328397 8.30528436763 8.40975318377 8.51553605585
+ 8.62264951265 8.73111029089 8.84093533777 8.95214181367
+ 9.06474709485 9.17876877610 9.29422467354 9.41113282739
+ 9.52951150479 9.64937920264 9.77075465053 9.89365681360
+ 10.0181048956 10.1441183417 10.2717168419 10.4009203336
+ 10.5317490052 10.6642232989 10.7983639141 10.9341918105
+ 11.0717282115 11.2109946074 11.3520127590 11.4948047006
+ 11.6393927437 11.7857994804 11.9340477872 12.0841608282
+ 12.2361620588 12.3900752295 12.5459243895 12.7037338907
+ 12.8635283910 13.0253328587 13.1891725760 13.3550731433
+ 13.5230604829 13.6931608430 13.8654008023 14.0398072736
+ 14.2164075082 14.3952291003 14.5762999912 14.7596484734
+ 14.9453031957 15.1332931669 15.3236477608 15.5163967208
+ 15.7115701642 15.9091985873 16.1093128700 16.3119442805
+ 16.5171244803 16.7248855294 16.9352598907 17.1482804358
+ 17.3639804494 17.5823936353 17.8035541208 18.0274964627
+ 18.2542556525 18.4838671219 18.7163667479 18.9517908593
+ 19.1901762414 19.4315601425 19.6759802793 19.9234748429
+ 20.1740825049 20.4278424233 20.6847942485 20.9449781298
+ 21.2084347214 21.4752051890 21.7453312159 22.0188550101
+ 22.2958193100 22.5762673919 22.8602430764 23.1477907354
+ 23.4389552986 23.7337822612 24.0323176904 24.3346082331
+ 24.6407011227 24.9506441869 25.2644858549 25.5822751651
+ 25.9040617727 26.2298959576 26.5598286320 26.8939113486
+ 27.2321963084 27.5747363692 27.9215850536 28.2727965573
+ 28.6284257579 28.9885282232 29.3531602198 29.7223787224
+ 30.0962414220 30.4748067355 30.8581338144 31.2462825544
+ 31.6393136046 32.0372883767 32.4402690552 32.8483186067
+ 33.2615007897 33.6798801647 34.1035221044 34.5324928038
+ 34.9668592903 35.4066894346 35.8520519610 36.3030164584
+ 36.7596533909 37.2220341089 37.6902308604 38.1643168020
+ 38.6443660107 39.1304534951 39.6226552073 40.1210480549
+ 40.6257099128 41.1367196355 41.6541570691 42.1781030645
+ 42.7086394891 43.2458492405 43.7898162587 44.3406255397
+ 44.8983631485 45.4631162328 46.0349730364 46.6140229131
+ 47.2003563406 47.7940649347 48.3952414636 49.0039798624
+ 49.6203752475 50.2445239322 50.8765234409 51.5164725247
+ 52.1644711771 52.8206206491 53.4850234655 54.1577834405
+ 54.8390056942 55.5287966691 56.2272641463 56.9345172628
+ 57.6506665283 58.3758238427 59.1101025133 59.8536172725
+ 60.6064842961 61.3688212210 62.1407471641 62.9223827401
+ 63.7138500814 64.5152728564 65.3267762888 66.1484871778
+ 66.9805339175 67.8230465167 68.6761566198 69.5399975271
+ 70.4147042153 71.3004133592 72.1972633527 73.1053943303
+ 74.0249481894 74.9560686122 75.8989010881 76.8535929366
+ 77.8202933303 78.7991533180 79.7903258486 80.7939657949
+ 81.8102299776 82.8392771901 83.8812682231 84.9363658898
+ 86.0047350514 87.0865426427 88.1819576983 89.2911513792
+ 90.4142969990 91.5515700516 92.7031482381 93.8692114951
+ 95.0499420222 96.2455243111 97.4561451738 98.6819937724
+ 99.9232616482 101.180142752 102.452833473 103.741532674
+ 105.046441714 106.367764490 107.705707460 109.060479682
+ 110.432292839 111.821361283 113.227902056 114.652134934
+ 116.094282457 117.554569962 119.033225623
+ Down Pseudopotential follows (l on next line)
+ 0
+ -0.933476879495E-05 -0.187869545244E-04 -0.283580341184E-04 -0.380495030692E-04
+ -0.478628756951E-04 -0.577996853514E-04 -0.678614846879E-04 -0.780498458792E-04
+ -0.883663608778E-04 -0.988126416613E-04 -0.109390320481E-03 -0.120101050121E-03
+ -0.130946504156E-03 -0.141928377209E-03 -0.153048385220E-03 -0.164308265712E-03
+ -0.175709778066E-03 -0.187254703793E-03 -0.198944846807E-03 -0.210782033718E-03
+ -0.222768114114E-03 -0.234904960840E-03 -0.247194470305E-03 -0.259638562770E-03
+ -0.272239182649E-03 -0.284998298817E-03 -0.297917904908E-03 -0.311000019639E-03
+ -0.324246687117E-03 -0.337659977161E-03 -0.351241985626E-03 -0.364994834724E-03
+ -0.378920673372E-03 -0.393021677506E-03 -0.407300050437E-03 -0.421758023193E-03
+ -0.436397854859E-03 -0.451221832940E-03 -0.466232273712E-03 -0.481431522586E-03
+ -0.496821954478E-03 -0.512405974173E-03 -0.528186016707E-03 -0.544164547741E-03
+ -0.560344063956E-03 -0.576727093435E-03 -0.593316196056E-03 -0.610113963905E-03
+ -0.627123021663E-03 -0.644346027033E-03 -0.661785671144E-03 -0.679444678975E-03
+ -0.697325809784E-03 -0.715431857533E-03 -0.733765651328E-03 -0.752330055863E-03
+ -0.771127971867E-03 -0.790162336548E-03 -0.809436124066E-03 -0.828952345990E-03
+ -0.848714051771E-03 -0.868724329214E-03 -0.888986304966E-03 -0.909503145004E-03
+ -0.930278055125E-03 -0.951314281450E-03 -0.972615110935E-03 -0.994183871877E-03
+ -0.101602393444E-02 -0.103813871118E-02 -0.106053165757E-02 -0.108320627255E-02
+ -0.110616609910E-02 -0.112941472471E-02 -0.115295578204E-02 -0.117679294943E-02
+ -0.120092995149E-02 -0.122537055966E-02 -0.125011859285E-02 -0.127517791798E-02
+ -0.130055245063E-02 -0.132624615562E-02 -0.135226304765E-02 -0.137860719190E-02
+ -0.140528270470E-02 -0.143229375417E-02 -0.145964456082E-02 -0.148733939829E-02
+ -0.151538259394E-02 -0.154377852958E-02 -0.157253164214E-02 -0.160164642435E-02
+ -0.163112742545E-02 -0.166097925191E-02 -0.169120656815E-02 -0.172181409724E-02
+ -0.175280662167E-02 -0.178418898409E-02 -0.181596608805E-02 -0.184814289880E-02
+ -0.188072444403E-02 -0.191371581468E-02 -0.194712216570E-02 -0.198094871693E-02
+ -0.201520075382E-02 -0.204988362832E-02 -0.208500275971E-02 -0.212056363543E-02
+ -0.215657181193E-02 -0.219303291557E-02 -0.222995264347E-02 -0.226733676443E-02
+ -0.230519111977E-02 -0.234352162433E-02 -0.238233426733E-02 -0.242163511333E-02
+ -0.246143030316E-02 -0.250172605490E-02 -0.254252866486E-02 -0.258384450853E-02
+ -0.262568004159E-02 -0.266804180093E-02 -0.271093640567E-02 -0.275437055818E-02
+ -0.279835104514E-02 -0.284288473860E-02 -0.288797859703E-02 -0.293363966645E-02
+ -0.297987508150E-02 -0.302669206655E-02 -0.307409793687E-02 -0.312210009972E-02
+ -0.317070605554E-02 -0.321992339911E-02 -0.326975982076E-02 -0.332022310753E-02
+ -0.337132114441E-02 -0.342306191558E-02 -0.347545350565E-02 -0.352850410092E-02
+ -0.358222199067E-02 -0.363661556841E-02 -0.369169333328E-02 -0.374746389128E-02
+ -0.380393595670E-02 -0.386111835341E-02 -0.391902001628E-02 -0.397764999259E-02
+ -0.403701744338E-02 -0.409713164496E-02 -0.415800199030E-02 -0.421963799053E-02
+ -0.428204927640E-02 -0.434524559982E-02 -0.440923683536E-02 -0.447403298178E-02
+ -0.453964416363E-02 -0.460608063280E-02 -0.467335277014E-02 -0.474147108706E-02
+ -0.481044622722E-02 -0.488028896813E-02 -0.495101022287E-02 -0.502262104181E-02
+ -0.509513261429E-02 -0.516855627042E-02 -0.524290348280E-02 -0.531818586836E-02
+ -0.539441519014E-02 -0.547160335916E-02 -0.554976243623E-02 -0.562890463390E-02
+ -0.570904231832E-02 -0.579018801119E-02 -0.587235439171E-02 -0.595555429858E-02
+ -0.603980073197E-02 -0.612510685558E-02 -0.621148599871E-02 -0.629895165830E-02
+ -0.638751750106E-02 -0.647719736562E-02 -0.656800526468E-02 -0.665995538719E-02
+ -0.675306210058E-02 -0.684733995301E-02 -0.694280367560E-02 -0.703946818482E-02
+ -0.713734858472E-02 -0.723646016936E-02 -0.733681842517E-02 -0.743843903339E-02
+ -0.754133787249E-02 -0.764553102066E-02 -0.775103475836E-02 -0.785786557082E-02
+ -0.796604015062E-02 -0.807557540032E-02 -0.818648843510E-02 -0.829879658539E-02
+ -0.841251739964E-02 -0.852766864704E-02 -0.864426832027E-02 -0.876233463834E-02
+ -0.888188604943E-02 -0.900294123378E-02 -0.912551910658E-02 -0.924963882097E-02
+ -0.937531977099E-02 -0.950258159464E-02 -0.963144417694E-02 -0.976192765304E-02
+ -0.989405241134E-02 -0.100278390967E-01 -0.101633086137E-01 -0.103004821299E-01
+ -0.104393810789E-01 -0.105800271643E-01 -0.107224423622E-01 -0.108666489256E-01
+ -0.110126693872E-01 -0.111605265631E-01 -0.113102435564E-01 -0.114618437609E-01
+ -0.116153508646E-01 -0.117707888535E-01 -0.119281820152E-01 -0.120875549429E-01
+ -0.122489325392E-01 -0.124123400199E-01 -0.125778029178E-01 -0.127453470873E-01
+ -0.129149987075E-01 -0.130867842871E-01 -0.132607306683E-01 -0.134368650307E-01
+ -0.136152148960E-01 -0.137958081320E-01 -0.139786729570E-01 -0.141638379443E-01
+ -0.143513320266E-01 -0.145411845006E-01 -0.147334250315E-01 -0.149280836575E-01
+ -0.151251907948E-01 -0.153247772422E-01 -0.155268741859E-01 -0.157315132043E-01
+ -0.159387262731E-01 -0.161485457702E-01 -0.163610044808E-01 -0.165761356024E-01
+ -0.167939727501E-01 -0.170145499621E-01 -0.172379017044E-01 -0.174640628768E-01
+ -0.176930688180E-01 -0.179249553111E-01 -0.181597585896E-01 -0.183975153425E-01
+ -0.186382627206E-01 -0.188820383416E-01 -0.191288802969E-01 -0.193788271566E-01
+ -0.196319179762E-01 -0.198881923025E-01 -0.201476901798E-01 -0.204104521558E-01
+ -0.206765192886E-01 -0.209459331527E-01 -0.212187358454E-01 -0.214949699938E-01
+ -0.217746787610E-01 -0.220579058531E-01 -0.223446955261E-01 -0.226350925926E-01
+ -0.229291424290E-01 -0.232268909822E-01 -0.235283847776E-01 -0.238336709253E-01
+ -0.241427971285E-01 -0.244558116902E-01 -0.247727635209E-01 -0.250937021467E-01
+ -0.254186777165E-01 -0.257477410101E-01 -0.260809434460E-01 -0.264183370895E-01
+ -0.267599746612E-01 -0.271059095443E-01 -0.274561957941E-01 -0.278108881456E-01
+ -0.281700420223E-01 -0.285337135452E-01 -0.289019595408E-01 -0.292748375510E-01
+ -0.296524058412E-01 -0.300347234098E-01 -0.304218499976E-01 -0.308138460966E-01
+ -0.312107729601E-01 -0.316126926118E-01 -0.320196678556E-01 -0.324317622855E-01
+ -0.328490402957E-01 -0.332715670901E-01 -0.336994086933E-01 -0.341326319602E-01
+ -0.345713045869E-01 -0.350154951209E-01 -0.354652729723E-01 -0.359207084244E-01
+ -0.363818726444E-01 -0.368488376950E-01 -0.373216765457E-01 -0.378004630835E-01
+ -0.382852721253E-01 -0.387761794291E-01 -0.392732617061E-01 -0.397765966325E-01
+ -0.402862628615E-01 -0.408023400363E-01 -0.413249088017E-01 -0.418540508171E-01
+ -0.423898487696E-01 -0.429323863860E-01 -0.434817484471E-01 -0.440380207999E-01
+ -0.446012903717E-01 -0.451716451833E-01 -0.457491743631E-01 -0.463339681606E-01
+ -0.469261179610E-01 -0.475257162992E-01 -0.481328568743E-01 -0.487476345645E-01
+ -0.493701454414E-01 -0.500004867857E-01 -0.506387571019E-01 -0.512850561338E-01
+ -0.519394848805E-01 -0.526021456117E-01 -0.532731418839E-01 -0.539525785566E-01
+ -0.546405618087E-01 -0.553371991553E-01 -0.560425994640E-01 -0.567568729726E-01
+ -0.574801313058E-01 -0.582124874929E-01 -0.589540559858E-01 -0.597049526761E-01
+ -0.604652949141E-01 -0.612352015265E-01 -0.620147928357E-01 -0.628041906777E-01
+ -0.636035184222E-01 -0.644129009910E-01 -0.652324648781E-01 -0.660623381696E-01
+ -0.669026505630E-01 -0.677535333886E-01 -0.686151196290E-01 -0.694875439407E-01
+ -0.703709426747E-01 -0.712654538982E-01 -0.721712174160E-01 -0.730883747924E-01
+ -0.740170693734E-01 -0.749574463095E-01 -0.759096525776E-01 -0.768738370049E-01
+ -0.778501502918E-01 -0.788387450355E-01 -0.798397757540E-01 -0.808533989103E-01
+ -0.818797729369E-01 -0.829190582606E-01 -0.839714173276E-01 -0.850370146294E-01
+ -0.861160167277E-01 -0.872085922814E-01 -0.883149120725E-01 -0.894351490331E-01
+ -0.905694782725E-01 -0.917180771045E-01 -0.928811250755E-01 -0.940588039924E-01
+ -0.952512979511E-01 -0.964587933657E-01 -0.976814789975E-01 -0.989195459844E-01
+ -0.100173187871 -0.101442600641 -0.102727982743 -0.104029535126
+ -0.105347461271 -0.106681967220 -0.108033261611 -0.109401555708
+ -0.110787063439 -0.112190001424 -0.113610589012 -0.115049048316
+ -0.116505604246 -0.117980484545 -0.119473919826 -0.120986143607
+ -0.122517392349 -0.124067905490 -0.125637925487 -0.127227697851
+ -0.128837471188 -0.130467497234 -0.132118030901 -0.133789330311
+ -0.135481656840 -0.137195275158 -0.138930453273 -0.140687462569
+ -0.142466577851 -0.144268077391 -0.146092242966 -0.147939359909
+ -0.149809717147 -0.151703607253 -0.153621326489 -0.155563174853
+ -0.157529456125 -0.159520477919 -0.161536551729 -0.163577992975
+ -0.165645121061 -0.167738259417 -0.169857735556 -0.172003881123
+ -0.174177031946 -0.176377528096 -0.178605713931 -0.180861938159
+ -0.183146553890 -0.185459918689 -0.187802394638 -0.190174348391
+ -0.192576151231 -0.195008179131 -0.197470812812 -0.199964437805
+ -0.202489444510 -0.205046228263 -0.207635189391 -0.210256733284
+ -0.212911270454 -0.215599216601 -0.218320992681 -0.221077024975
+ -0.223867745150 -0.226693590335 -0.229555003187 -0.232452431963
+ -0.235386330592 -0.238357158745 -0.241365381912 -0.244411471475
+ -0.247495904782 -0.250619165226 -0.253781742321 -0.256984131782
+ -0.260226835601 -0.263510362132 -0.266835226171 -0.270201949038
+ -0.273611058661 -0.277063089663 -0.280558583445 -0.284098088278
+ -0.287682159384 -0.291311359035 -0.294986256635 -0.298707428820
+ -0.302475459544 -0.306290940180 -0.310154469613 -0.314066654334
+ -0.318028108547 -0.322039454259 -0.326101321390 -0.330214347868
+ -0.334379179738 -0.338596471268 -0.342866885050 -0.347191092115
+ -0.351569772039 -0.356003613057 -0.360493312170 -0.365039575269
+ -0.369643117242 -0.374304662097 -0.379024943078 -0.383804702790
+ -0.388644693317 -0.393545676348 -0.398508423305 -0.403533715469
+ -0.408622344109 -0.413775110613 -0.418992826625 -0.424276314176
+ -0.429626405824 -0.435043944788 -0.440529785096 -0.446084791723
+ -0.451709840737 -0.457405819447 -0.463173626550 -0.469014172285
+ -0.474928378583 -0.480917179227 -0.486981520003 -0.493122358868
+ -0.499340666107 -0.505637424497 -0.512013629479 -0.518470289323
+ -0.525008425299 -0.531629071855 -0.538333276793 -0.545122101443
+ -0.551996620854 -0.558957923968 -0.566007113817 -0.573145307704
+ -0.580373637402 -0.587693249347 -0.595105304831 -0.602610980213
+ -0.610211467113 -0.617907972623 -0.625701719517 -0.633593946461
+ -0.641585908228 -0.649678875920 -0.657874137187 -0.666172996449
+ -0.674576775129 -0.683086811878 -0.691704462815 -0.700431101758
+ -0.709268120467 -0.718216928888 -0.727278955399 -0.736455647060
+ -0.745748469865 -0.755158909000 -0.764688469103 -0.774338674523
+ -0.784111069593 -0.794007218894 -0.804028707528 -0.814177141397
+ -0.824454147481 -0.834861374117 -0.845400491290 -0.856073190915
+ -0.866881187136 -0.877826216613 -0.888910038824 -0.900134436364
+ -0.911501215246 -0.923012205211 -0.934669260031 -0.946474257821
+ -0.958429101354 -0.970535718372 -0.982796061906 -0.995212110591
+ -1.00778586899 -1.02051936791 -1.03341466473 -1.04647384372
+ -1.05969901638 -1.07309232172 -1.08665592664 -1.10039202623
+ -1.11430284409 -1.12839063264 -1.14265767348 -1.15710627766
+ -1.17173878604 -1.18655756959 -1.20156502967 -1.21676359840
+ -1.23215573891 -1.24774394564 -1.26353074468 -1.27951869400
+ -1.29571038376 -1.31210843659 -1.32871550782 -1.34553428578
+ -1.36256749202 -1.37981788154 -1.39728824303 -1.41498139910
+ -1.43290020643 -1.45104755600 -1.46942637328 -1.48803961832
+ -1.50689028596 -1.52598140593 -1.54531604295 -1.56489729685
+ -1.58472830261 -1.60481223043 -1.62515228576 -1.64575170931
+ -1.66661377706 -1.68774180017 -1.70913912500 -1.73080913296
+ -1.75275524048 -1.77498089879 -1.79748959388 -1.82028484621
+ -1.84337021059 -1.86674927591 -1.89042566491 -1.91440303387
+ -1.93868507231 -1.96327550269 -1.98817807997 -2.01339659133
+ -2.03893485563 -2.06479672308 -2.09098607465 -2.11750682166
+ -2.14436290519 -2.17155829549 -2.19909699141 -2.22698301974
+ -2.25522043450 -2.28381331620 -2.31276577107 -2.34208193019
+ -2.37176594860 -2.40182200425 -2.43225429700 -2.46306704739
+ -2.49426449535 -2.52585089885 -2.55783053223 -2.59020768456
+ -2.62298665766 -2.65617176393 -2.68976732397 -2.72377766381
+ -2.75820711191 -2.79305999567 -2.82834063754 -2.86405335067
+ -2.90020243391 -2.93679216625 -2.97382680046 -3.01131055604
+ -3.04924761118 -3.08764209374 -3.12649807124 -3.16581953954
+ -3.20561041031 -3.24587449705 -3.28661549970 -3.32783698759
+ -3.36954238080 -3.41173492984 -3.45441769361 -3.49759351572
+ -3.54126499917 -3.58543447964 -3.63010399757 -3.67527526934
+ -3.72094965800 -3.76712814424 -3.81381129815 -3.86099925286
+ -3.90869168113 -3.95688777615 -4.00558623820 -4.05478526892
+ -4.10448257519 -4.15467538488 -4.20536047692 -4.25653422823
+ -4.30819268016 -4.36033162728 -4.41294673090 -4.46603365992
+ -4.51958826096 -4.57360675948 -4.62808599261 -4.68302367415
+ -4.73841869071 -4.79427142729 -4.85058411949 -4.90736122556
+ -4.96460984309 -5.02233995396 -5.08056554050 -5.13930338572
+ -5.19856956577 -5.25842718242 -5.31878699581 -5.38003342163
+ -5.44283920248 -5.50687927202 -5.57183869828 -5.63784619544
+ -5.70489189639 -5.77299627417 -5.84217893296 -5.91245822505
+ -5.98385479459 -6.05639128408 -6.13009311275 -6.20498896157
+ -6.28111122448 -6.35849639429 -6.43718539071 -6.51722383457
+ -6.59866227206 -6.68155635259 -6.76596696275 -6.85196031852
+ -6.93960801687 -7.02898704738 -7.12017976371 -7.21327381418
+ -7.30836203018 -7.40554227052 -7.50491721967 -7.60659413652
+ -7.71068455261 -7.81730391173 -7.92657115514 -8.03860824397
+ -8.15353960375 -8.27149151608 -8.39259142625 -8.51696715957
+ -8.64474607205 -8.77605409831 -8.91101469981 -9.04974771276
+ -9.19236807641 -9.33898443641 -9.48969760751 -9.64459888072
+ -9.80376815633 -9.96727188173 -10.1351607706 -10.3074672772
+ -10.4842027999 -10.6653545836 -10.8508822980 -11.0407142633
+ -11.2347433087 -11.4328222475 -11.6347589719 -11.8403111766
+ -12.0491807460 -12.2610078570 -12.4753648824 -12.6917502130
+ -12.9095821633 -13.1281931757 -13.3468246068 -13.5646224528
+ -13.7806344643 -13.9938092013 -14.2029976918 -14.4069584734
+ -14.6043669090 -14.7938297604 -14.9739060676 -15.1431353923
+ -15.3000744410 -15.4433429777 -15.5716797912 -15.6840093501
+ -15.7795197041 -15.8577523926 -15.9187046804 -15.9629496955
+ -15.9917583134 -16.0072921513 -16.0126929003 -16.0124102174
+ -16.0112484929 -16.0101099843 -16.0090535970 -16.0081083861
+ -16.0072198119 -16.0064090410 -16.0056639531 -16.0049838108
+ -16.0043652543 -16.0038054416 -16.0033013627 -16.0028498870
+ -16.0024477486 -16.0020915680 -16.0017778896 -16.0015032285
+ -16.0012641204 -16.0010571695 -16.0007511183 -16.0005295126
+ -16.0003702996 -16.0002568184 -16.0001765870 -16.0001203334
+ -16.0000812281 -16.0000542836 -16.0000358887 -16.0000234515
+ -16.0000151281 -16.0000096182 -16.0000060138 -16.0000036863
+ -16.0000022049 -16.0000012777 -16.0000007086 -16.0000003676
+ -16.0000001695 -16.0000000592 -16.0000000015 -15.9999999744
+ -15.9999999645 -15.9999999637 -15.9999999671 -15.9999999721
+ -15.9999999774 -15.9999999822 -15.9999999863 -15.9999999896
+ -15.9999999923 -15.9999999943 -15.9999999959 -15.9999999970
+ -15.9999999979 -15.9999999985 -15.9999999990 -15.9999999993
+ -15.9999999995 -15.9999999997 -15.9999999998 -15.9999999999
+ -15.9999999999 -15.9999999999 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000
+ Down Pseudopotential follows (l on next line)
+ 1
+ -0.225318212913E-04 -0.453470580023E-04 -0.684492750671E-04 -0.918420822457E-04
+ -0.115529134718E-03 -0.139514133631E-03 -0.163800826692E-03 -0.188393008743E-03
+ -0.213294522365E-03 -0.238509258470E-03 -0.264041156912E-03 -0.289894207100E-03
+ -0.316072448628E-03 -0.342579971898E-03 -0.369420918766E-03 -0.396599483183E-03
+ -0.424119911855E-03 -0.451986504908E-03 -0.480203616550E-03 -0.508775655764E-03
+ -0.537707086989E-03 -0.567002430820E-03 -0.596666264715E-03 -0.626703223707E-03
+ -0.657118001132E-03 -0.687915349364E-03 -0.719100080546E-03 -0.750677067360E-03
+ -0.782651243773E-03 -0.815027605815E-03 -0.847811212360E-03 -0.881007185909E-03
+ -0.914620713407E-03 -0.948657047031E-03 -0.983121505029E-03 -0.101801947254E-02
+ -0.105335640245E-02 -0.108913781622E-02 -0.112536930477E-02 -0.116205652935E-02
+ -0.119920522240E-02 -0.123682118849E-02 -0.127491030519E-02 -0.131347852400E-02
+ -0.135253187128E-02 -0.139207644920E-02 -0.143211843668E-02 -0.147266409036E-02
+ -0.151371974558E-02 -0.155529181737E-02 -0.159738680146E-02 -0.164001127527E-02
+ -0.168317189895E-02 -0.172687541646E-02 -0.177112865654E-02 -0.181593853387E-02
+ -0.186131205006E-02 -0.190725629484E-02 -0.195377844708E-02 -0.200088577595E-02
+ -0.204858564209E-02 -0.209688549868E-02 -0.214579289268E-02 -0.219531546598E-02
+ -0.224546095656E-02 -0.229623719978E-02 -0.234765212951E-02 -0.239971377945E-02
+ -0.245243028434E-02 -0.250580988124E-02 -0.255986091082E-02 -0.261459181866E-02
+ -0.267001115658E-02 -0.272612758396E-02 -0.278294986912E-02 -0.284048689064E-02
+ -0.289874763880E-02 -0.295774121698E-02 -0.301747684303E-02 -0.307796385076E-02
+ -0.313921169140E-02 -0.320122993505E-02 -0.326402827218E-02 -0.332761651516E-02
+ -0.339200459979E-02 -0.345720258683E-02 -0.352322066361E-02 -0.359006914558E-02
+ -0.365775847795E-02 -0.372629923733E-02 -0.379570213334E-02 -0.386597801034E-02
+ -0.393713784906E-02 -0.400919276839E-02 -0.408215402705E-02 -0.415603302538E-02
+ -0.423084130713E-02 -0.430659056125E-02 -0.438329262372E-02 -0.446095947939E-02
+ -0.453960326386E-02 -0.461923626538E-02 -0.469987092679E-02 -0.478151984740E-02
+ -0.486419578504E-02 -0.494791165798E-02 -0.503268054700E-02 -0.511851569742E-02
+ -0.520543052115E-02 -0.529343859881E-02 -0.538255368186E-02 -0.547278969469E-02
+ -0.556416073688E-02 -0.565668108534E-02 -0.575036519657E-02 -0.584522770889E-02
+ -0.594128344477E-02 -0.603854741313E-02 -0.613703481164E-02 -0.623676102919E-02
+ -0.633774164818E-02 -0.643999244705E-02 -0.654352940270E-02 -0.664836869300E-02
+ -0.675452669930E-02 -0.686202000900E-02 -0.697086541816E-02 -0.708107993410E-02
+ -0.719268077807E-02 -0.730568538792E-02 -0.742011142087E-02 -0.753597675622E-02
+ -0.765329949817E-02 -0.777209797864E-02 -0.789239076013E-02 -0.801419663866E-02
+ -0.813753464663E-02 -0.826242405587E-02 -0.838888438061E-02 -0.851693538053E-02
+ -0.864659706388E-02 -0.877788969057E-02 -0.891083377533E-02 -0.904545009097E-02
+ -0.918175967156E-02 -0.931978381575E-02 -0.945954409012E-02 -0.960106233249E-02
+ -0.974436065539E-02 -0.988946144949E-02 -0.100363873871E-01 -0.101851614257E-01
+ -0.103358068115E-01 -0.104883470832E-01 -0.106428060755E-01 -0.107992079231E-01
+ -0.109575770639E-01 -0.111179382435E-01 -0.112803165188E-01 -0.114447372615E-01
+ -0.116112261629E-01 -0.117798092372E-01 -0.119505128258E-01 -0.121233636015E-01
+ -0.122983885727E-01 -0.124756150873E-01 -0.126550708374E-01 -0.128367838634E-01
+ -0.130207825582E-01 -0.132070956720E-01 -0.133957523168E-01 -0.135867819705E-01
+ -0.137802144818E-01 -0.139760800752E-01 -0.141744093548E-01 -0.143752333102E-01
+ -0.145785833205E-01 -0.147844911596E-01 -0.149929890011E-01 -0.152041094232E-01
+ -0.154178854138E-01 -0.156343503761E-01 -0.158535381330E-01 -0.160754829332E-01
+ -0.163002194561E-01 -0.165277828172E-01 -0.167582085737E-01 -0.169915327303E-01
+ -0.172277917443E-01 -0.174670225317E-01 -0.177092624730E-01 -0.179545494185E-01
+ -0.182029216949E-01 -0.184544181111E-01 -0.187090779638E-01 -0.189669410441E-01
+ -0.192280476439E-01 -0.194924385616E-01 -0.197601551089E-01 -0.200312391171E-01
+ -0.203057329437E-01 -0.205836794790E-01 -0.208651221527E-01 -0.211501049410E-01
+ -0.214386723730E-01 -0.217308695382E-01 -0.220267420929E-01 -0.223263362679E-01
+ -0.226296988755E-01 -0.229368773170E-01 -0.232479195895E-01 -0.235628742942E-01
+ -0.238817906435E-01 -0.242047184689E-01 -0.245317082286E-01 -0.248628110155E-01
+ -0.251980785653E-01 -0.255375632642E-01 -0.258813181577E-01 -0.262293969582E-01
+ -0.265818540539E-01 -0.269387445171E-01 -0.273001241129E-01 -0.276660493076E-01
+ -0.280365772780E-01 -0.284117659200E-01 -0.287916738578E-01 -0.291763604530E-01
+ -0.295658858138E-01 -0.299603108045E-01 -0.303596970552E-01 -0.307641069708E-01
+ -0.311736037415E-01 -0.315882513522E-01 -0.320081145928E-01 -0.324332590679E-01
+ -0.328637512075E-01 -0.332996582772E-01 -0.337410483886E-01 -0.341879905101E-01
+ -0.346405544775E-01 -0.350988110054E-01 -0.355628316975E-01 -0.360326890584E-01
+ -0.365084565045E-01 -0.369902083759E-01 -0.374780199477E-01 -0.379719674418E-01
+ -0.384721280389E-01 -0.389785798906E-01 -0.394914021315E-01 -0.400106748915E-01
+ -0.405364793085E-01 -0.410688975412E-01 -0.416080127813E-01 -0.421539092673E-01
+ -0.427066722973E-01 -0.432663882421E-01 -0.438331445591E-01 -0.444070298058E-01
+ -0.449881336535E-01 -0.455765469016E-01 -0.461723614916E-01 -0.467756705214E-01
+ -0.473865682601E-01 -0.480051501624E-01 -0.486315128839E-01 -0.492657542959E-01
+ -0.499079735008E-01 -0.505582708475E-01 -0.512167479473E-01 -0.518835076895E-01
+ -0.525586542579E-01 -0.532422931463E-01 -0.539345311760E-01 -0.546354765117E-01
+ -0.553452386788E-01 -0.560639285801E-01 -0.567916585139E-01 -0.575285421907E-01
+ -0.582746947515E-01 -0.590302327856E-01 -0.597952743488E-01 -0.605699389821E-01
+ -0.613543477299E-01 -0.621486231594E-01 -0.629528893796E-01 -0.637672720604E-01
+ -0.645918984527E-01 -0.654268974080E-01 -0.662723993986E-01 -0.671285365380E-01
+ -0.679954426017E-01 -0.688732530477E-01 -0.697621050380E-01 -0.706621374601E-01
+ -0.715734909483E-01 -0.724963079062E-01 -0.734307325285E-01 -0.743769108239E-01
+ -0.753349906376E-01 -0.763051216746E-01 -0.772874555230E-01 -0.782821456778E-01
+ -0.792893475648E-01 -0.803092185650E-01 -0.813419180389E-01 -0.823876073519E-01
+ -0.834464498990E-01 -0.845186111307E-01 -0.856042585787E-01 -0.867035618820E-01
+ -0.878166928138E-01 -0.889438253078E-01 -0.900851354858E-01 -0.912408016850E-01
+ -0.924110044861E-01 -0.935959267413E-01 -0.947957536028E-01 -0.960106725522E-01
+ -0.972408734293E-01 -0.984865484620E-01 -0.997478922963E-01 -0.101025102027
+ -0.102318377228 -0.103627919983 -0.104953934920 -0.106296629239
+ -0.107656212746 -0.109032897890 -0.110426899788 -0.111838436267
+ -0.113267727890 -0.114714997999 -0.116180472742 -0.117664381114
+ -0.119166954991 -0.120688429165 -0.122229041381 -0.123789032375
+ -0.125368645914 -0.126968128829 -0.128587731056 -0.130227705677
+ -0.131888308956 -0.133569800383 -0.135272442710 -0.136996501996
+ -0.138742247647 -0.140509952458 -0.142299892656 -0.144112347943
+ -0.145947601538 -0.147805940228 -0.149687654402 -0.151593038106
+ -0.153522389085 -0.155476008828 -0.157454202619 -0.159457279583
+ -0.161485552731 -0.163539339015 -0.165618959374 -0.167724738785
+ -0.169857006312 -0.172016095160 -0.174202342727 -0.176416090655
+ -0.178657684886 -0.180927475711 -0.183225817831 -0.185553070410
+ -0.187909597130 -0.190295766249 -0.192711950658 -0.195158527940
+ -0.197635880429 -0.200144395270 -0.202684464479 -0.205256485004
+ -0.207860858787 -0.210497992830 -0.213168299255 -0.215872195368
+ -0.218610103728 -0.221382452210 -0.224189674075 -0.227032208033
+ -0.229910498316 -0.232824994746 -0.235776152806 -0.238764433709
+ -0.241790304475 -0.244854237997 -0.247956713122 -0.251098214721
+ -0.254279233770 -0.257500267419 -0.260761819080 -0.264064398496
+ -0.267408521827 -0.270794711730 -0.274223497438 -0.277695414846
+ -0.281211006592 -0.284770822147 -0.288375417894 -0.292025357221
+ -0.295721210608 -0.299463555712 -0.303252977464 -0.307090068157
+ -0.310975427540 -0.314909662908 -0.318893389206 -0.322927229115
+ -0.327011813157 -0.331147779791 -0.335335775513 -0.339576454959
+ -0.343870481004 -0.348218524870 -0.352621266229 -0.357079393310
+ -0.361593603008 -0.366164600990 -0.370793101811 -0.375479829020
+ -0.380225515278 -0.385030902473 -0.389896741831 -0.394823794042
+ -0.399812829372 -0.404864627787 -0.409979979078 -0.415159682980
+ -0.420404549301 -0.425715398047 -0.431093059551 -0.436538374608
+ -0.442052194599 -0.447635381630 -0.453288808667 -0.459013359672
+ -0.464809929742 -0.470679425250 -0.476622763988 -0.482640875309
+ -0.488734700277 -0.494905191809 -0.501153314832 -0.507480046429
+ -0.513886375994 -0.520373305391 -0.526941849105 -0.533593034409
+ -0.540327901519 -0.547147503763 -0.554052907743 -0.561045193505
+ -0.568125454707 -0.575294798793 -0.582554347168 -0.589905235370
+ -0.597348613255 -0.604885645175 -0.612517510158 -0.620245402102
+ -0.628070529954 -0.635994117907 -0.644017405590 -0.652141648265
+ -0.660368117021 -0.668698098979 -0.677132897494 -0.685673832355
+ -0.694322240003 -0.703079473732 -0.711946903908 -0.720925918184
+ -0.730017921717 -0.739224337392 -0.748546606045 -0.757986186690
+ -0.767544556751 -0.777223212293 -0.787023668258 -0.796947458705
+ -0.806996137053 -0.817171276321 -0.827474469383 -0.837907329213
+ -0.848471489144 -0.859168603123 -0.870000345972 -0.880968413651
+ -0.892074523530 -0.903320414652 -0.914707848013 -0.926238606838
+ -0.937914496860 -0.949737346606 -0.961709007684 -0.973831355073
+ -0.986106287422 -0.998535727343 -1.01112162172 -1.02386594200
+ -1.03677068452 -1.04983787082 -1.06306954794 -1.07646778875
+ -1.09003469229 -1.10377238409 -1.11768301648 -1.13176876894
+ -1.14603184847 -1.16047448988 -1.17509895618 -1.18990753891
+ -1.20490255850 -1.22008636463 -1.23546133660 -1.25102988367
+ -1.26679444548 -1.28275749237 -1.29892152581 -1.31528907873
+ -1.33186271596 -1.34864503458 -1.36563866434 -1.38284626803
+ -1.40027054191 -1.41791421610 -1.43578005500 -1.45387085769
+ -1.47218945835 -1.49073872667 -1.50952156831 -1.52854092527
+ -1.54779977637 -1.56730113764 -1.58704806277 -1.60704364358
+ -1.62729101039 -1.64779333252 -1.66855381872 -1.68957571758
+ -1.71086231805 -1.73241694979 -1.75424298371 -1.77634383237
+ -1.79872295042 -1.82138383511 -1.84433002666 -1.86756510877
+ -1.89109270903 -1.91491649937 -1.93904019654 -1.96346756248
+ -1.98820240481 -2.01324857726 -2.03860998004 -2.06429056032
+ -2.09029431264 -2.11662527926 -2.14328755061 -2.17028526567
+ -2.19762261231 -2.22530382771 -2.25333319864 -2.28171506189
+ -2.31045380449 -2.33955386408 -2.36901972919 -2.39885593946
+ -2.42906708594 -2.45965781123 -2.49063280976 -2.52199682788
+ -2.55375466403 -2.58591116879 -2.61847124500 -2.65143984774
+ -2.68482198430 -2.71862271414 -2.75284714877 -2.78750045156
+ -2.82258783752 -2.85811457305 -2.89408597553 -2.93050741295
+ -2.96738430341 -3.00472211453 -3.04252636280 -3.08080261286
+ -3.11955647662 -3.15879361235 -3.19851972363 -3.23874055815
+ -3.27946190647 -3.32068960055 -3.36242951224 -3.40468755154
+ -3.44746966477 -3.49078183250 -3.53463006740 -3.57902041180
+ -3.62395893515 -3.66945173119 -3.71550491496 -3.76212461953
+ -3.80931699250 -3.85708819228 -3.90544438400 -3.95439173525
+ -4.00393641137 -4.05408457059 -4.10484235862 -4.15621590309
+ -4.20821130747 -4.26083464460 -4.31409194991 -4.36798921403
+ -4.42253237511 -4.47772731048 -4.53357982794 -4.59009565641
+ -4.64728043607 -4.70513970785 -4.76367890236 -4.82290332810
+ -4.88281815901 -4.94342842129 -5.00473897945 -5.06675452158
+ -5.12947954376 -5.19291833363 -5.25707495300 -5.32195321953
+ -5.38755668734 -5.45388862670 -5.52095200240 -5.58874945120
+ -5.65728325785 -5.72655532999 -5.79656717162 -5.86731985523
+ -5.93881399246 -6.01104970318 -6.08402658304 -6.15774366930
+ -6.23219940489 -6.30739160067 -6.38331739575 -6.45997321574
+ -6.53735472902 -6.61545680067 -6.69427344415 -6.77379777060
+ -6.85402193557 -6.93493708315 -7.01653328732 -7.09879949051
+ -7.18172343911 -7.26529161595 -7.34948916955 -7.43429984004
+ -7.51970588175 -7.60568798222 -7.69222517771 -7.77929476507
+ -7.86687221001 -7.95493105173 -8.04344280402 -8.13237685303
+ -8.22170035168 -8.31137811133 -8.40137249078 -8.49164328339
+ -8.58214760274 -8.67283976788 -8.76367118904 -8.85459025507
+ -8.94554222410 -9.03646911906 -9.12730963011 -9.21799902618
+ -9.30846907811 -9.39864799626 -9.48846038551 -9.57782722093
+ -9.66666584745 -9.75489000696 -9.84240989623 -9.92913225888
+ -10.0149605143 -10.0997949264 -10.1835328129 -10.2660687988
+ -10.3472951109 -10.4271019162 -10.5053776995 -10.5820096767
+ -10.6568842691 -10.7298874227 -10.8009058180 -10.8698257839
+ -10.9365299248 -11.0009450097 -11.0628427861 -11.1224661820
+ -11.1803442086 -11.2360060824 -11.2889894541 -11.3392742351
+ -11.3867007139 -11.4311388522 -11.4724574808 -11.5105243534
+ -11.5452101591 -11.5763887298 -11.6039383518 -11.6277428181
+ -11.6476924786 -11.6636852600 -11.6756276613 -11.6834357302
+ -11.6870360255 -11.6863665700 -11.6813777988 -11.6720335062
+ -11.6583117980 -11.6402060511 -11.6177258885 -11.5908981734
+ -11.5597680305 -11.5243999027 -11.4848786522 -11.4413107176
+ -11.3938253419 -11.3425758811 -11.2877412195 -11.2295273057
+ -11.1681688192 -11.1039310180 -11.0371117648 -10.9680437501
+ -10.8970969631 -10.8246813974 -10.7512500098 -10.6773019427
+ -10.6033859898 -10.5301042832 -10.4581161532 -10.3881420881
+ -10.3209676874 -10.2574474673 -10.1985083296 -10.1451524568
+ -10.0984593388 -10.0595865755 -10.0297690313 -10.0103158514
+ -10.0026047811 -10.0080731635 -10.0282049370 -10.0645129125
+ -10.1185155898 -10.1917077861 -10.2855244020 -10.4012967595
+ -10.5402011242 -10.7031992837 -10.8909714197 -11.1038419875
+ -11.3416999274 -11.6039152847 -11.8892552112 -12.1958033628
+ -12.5208878784 -12.8610244007 -13.2118819421 -13.5682807647
+ -13.9242327841 -14.2730362922 -14.6074380115 -14.9198767023
+ -15.2028238452 -15.4492386367 -15.6531560106 -15.8104342994
+ -15.9196713475 -15.9833892396 -16.0093520568 -16.0124094156
+ -16.0112484929 -16.0101099843 -16.0090535970 -16.0081083861
+ -16.0072198119 -16.0064090410 -16.0056639531 -16.0049838108
+ -16.0043652543 -16.0038054416 -16.0033013627 -16.0028498870
+ -16.0024477486 -16.0020915680 -16.0017778896 -16.0015032285
+ -16.0012641204 -16.0010571695 -16.0007511183 -16.0005295126
+ -16.0003702996 -16.0002568184 -16.0001765870 -16.0001203334
+ -16.0000812281 -16.0000542836 -16.0000358887 -16.0000234515
+ -16.0000151281 -16.0000096182 -16.0000060138 -16.0000036863
+ -16.0000022049 -16.0000012777 -16.0000007086 -16.0000003676
+ -16.0000001695 -16.0000000592 -16.0000000015 -15.9999999744
+ -15.9999999645 -15.9999999637 -15.9999999671 -15.9999999721
+ -15.9999999774 -15.9999999822 -15.9999999863 -15.9999999896
+ -15.9999999923 -15.9999999943 -15.9999999959 -15.9999999970
+ -15.9999999979 -15.9999999985 -15.9999999990 -15.9999999993
+ -15.9999999995 -15.9999999997 -15.9999999998 -15.9999999999
+ -15.9999999999 -15.9999999999 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000
+ Down Pseudopotential follows (l on next line)
+ 2
+ -0.441752231935E-04 -0.889061320046E-04 -0.134199633660E-03 -0.180062906881E-03
+ -0.226503038806E-03 -0.273527335848E-03 -0.321143108697E-03 -0.369357823054E-03
+ -0.418179006756E-03 -0.467614276487E-03 -0.517671368911E-03 -0.568358107916E-03
+ -0.619682399017E-03 -0.671652269860E-03 -0.724275846226E-03 -0.777561348261E-03
+ -0.831517098496E-03 -0.886151516113E-03 -0.941473160292E-03 -0.997490673044E-03
+ -0.105421278486E-02 -0.111164838054E-02 -0.116980642221E-02 -0.122869600879E-02
+ -0.128832633440E-02 -0.134870670208E-02 -0.140984658148E-02 -0.147175549858E-02
+ -0.153444313604E-02 -0.159791928166E-02 -0.166219385440E-02 -0.172727692285E-02
+ -0.179317860612E-02 -0.185990925217E-02 -0.192747926936E-02 -0.199589919406E-02
+ -0.206517975311E-02 -0.213533173903E-02 -0.220636613615E-02 -0.227829404106E-02
+ -0.235112668616E-02 -0.242487544409E-02 -0.249955184686E-02 -0.257516758074E-02
+ -0.265173443297E-02 -0.272926437152E-02 -0.280776953167E-02 -0.288726214785E-02
+ -0.296775467580E-02 -0.304925966092E-02 -0.313178985471E-02 -0.321535816028E-02
+ -0.329997762022E-02 -0.338566145930E-02 -0.347242307470E-02 -0.356027602668E-02
+ -0.364923400660E-02 -0.373931094651E-02 -0.383052093000E-02 -0.392287819653E-02
+ -0.401639716260E-02 -0.411109244925E-02 -0.420697887655E-02 -0.430407138470E-02
+ -0.440238516636E-02 -0.450193561046E-02 -0.460273821468E-02 -0.470480877637E-02
+ -0.480816323072E-02 -0.491281770218E-02 -0.501878859340E-02 -0.512609242383E-02
+ -0.523474596370E-02 -0.534476621316E-02 -0.545617032078E-02 -0.556897574178E-02
+ -0.568320008354E-02 -0.579886117063E-02 -0.591597711412E-02 -0.603456618570E-02
+ -0.615464692146E-02 -0.627623810556E-02 -0.639935869396E-02 -0.652402795869E-02
+ -0.665026538657E-02 -0.677809065382E-02 -0.690752378798E-02 -0.703858499419E-02
+ -0.717129473106E-02 -0.730567375698E-02 -0.744174306816E-02 -0.757952391573E-02
+ -0.771903783808E-02 -0.786030662394E-02 -0.800335234902E-02 -0.814819738628E-02
+ -0.829486432528E-02 -0.844337611524E-02 -0.859375597095E-02 -0.874602735528E-02
+ -0.890021407615E-02 -0.905634023726E-02 -0.921443022463E-02 -0.937450872426E-02
+ -0.953660077132E-02 -0.970073169083E-02 -0.986692712098E-02 -0.100352130324E-01
+ -0.102056157194E-01 -0.103781618007E-01 -0.105528782477E-01 -0.107297923661E-01
+ -0.109089317885E-01 -0.110903244971E-01 -0.112739988511E-01 -0.114599835416E-01
+ -0.116483076372E-01 -0.118390005560E-01 -0.120320920930E-01 -0.122276124296E-01
+ -0.124255920987E-01 -0.126260620495E-01 -0.128290536121E-01 -0.130345984769E-01
+ -0.132427287845E-01 -0.134534770643E-01 -0.136668762052E-01 -0.138829595882E-01
+ -0.141017609788E-01 -0.143233145361E-01 -0.145476548952E-01 -0.147748171102E-01
+ -0.150048366727E-01 -0.152377495407E-01 -0.154735920728E-01 -0.157124011344E-01
+ -0.159542140698E-01 -0.161990686211E-01 -0.164470030568E-01 -0.166980561407E-01
+ -0.169522670703E-01 -0.172096755844E-01 -0.174703219036E-01 -0.177342467424E-01
+ -0.180014913532E-01 -0.182720974867E-01 -0.185461074243E-01 -0.188235639827E-01
+ -0.191045105123E-01 -0.193889909187E-01 -0.196770496547E-01 -0.199687317113E-01
+ -0.202640826817E-01 -0.205631487135E-01 -0.208659765256E-01 -0.211726134544E-01
+ -0.214831073931E-01 -0.217975068599E-01 -0.221158609938E-01 -0.224382195336E-01
+ -0.227646328380E-01 -0.230951519163E-01 -0.234298284149E-01 -0.237687146274E-01
+ -0.241118635082E-01 -0.244593286638E-01 -0.248111643936E-01 -0.251674256772E-01
+ -0.255281681759E-01 -0.258934482481E-01 -0.262633229919E-01 -0.266378501873E-01
+ -0.270170883424E-01 -0.274010967347E-01 -0.277899353633E-01 -0.281836649748E-01
+ -0.285823470964E-01 -0.289860440260E-01 -0.293948188318E-01 -0.298087353980E-01
+ -0.302278583976E-01 -0.306522533085E-01 -0.310819864551E-01 -0.315171249855E-01
+ -0.319577368758E-01 -0.324038909866E-01 -0.328556570315E-01 -0.333131055875E-01
+ -0.337763081463E-01 -0.342453370730E-01 -0.347202656544E-01 -0.352011681152E-01
+ -0.356881195784E-01 -0.361811961362E-01 -0.366804748405E-01 -0.371860336952E-01
+ -0.376979517023E-01 -0.382163088480E-01 -0.387411861245E-01 -0.392726655447E-01
+ -0.398108301571E-01 -0.403557640481E-01 -0.409075523664E-01 -0.414662813301E-01
+ -0.420320382412E-01 -0.426049115012E-01 -0.431849906177E-01 -0.437723662444E-01
+ -0.443671301438E-01 -0.449693752469E-01 -0.455791956773E-01 -0.461966867058E-01
+ -0.468219448087E-01 -0.474550677022E-01 -0.480961543046E-01 -0.487453047856E-01
+ -0.494026205797E-01 -0.500682043901E-01 -0.507421602213E-01 -0.514245933753E-01
+ -0.521156104884E-01 -0.528153195317E-01 -0.535238298359E-01 -0.542412521037E-01
+ -0.549676984421E-01 -0.557032823608E-01 -0.564481187821E-01 -0.572023241015E-01
+ -0.579660161659E-01 -0.587393142998E-01 -0.595223393307E-01 -0.603152136089E-01
+ -0.611180610319E-01 -0.619310070353E-01 -0.627541786473E-01 -0.635877044975E-01
+ -0.644317148165E-01 -0.652863414841E-01 -0.661517180489E-01 -0.670279797164E-01
+ -0.679152634029E-01 -0.688137077646E-01 -0.697234531716E-01 -0.706446417752E-01
+ -0.715774175210E-01 -0.725219261507E-01 -0.734783152514E-01 -0.744467342569E-01
+ -0.754273344859E-01 -0.764202691640E-01 -0.774256934361E-01 -0.784437644043E-01
+ -0.794746411440E-01 -0.805184847345E-01 -0.815754582751E-01 -0.826457269257E-01
+ -0.837294579182E-01 -0.848268205829E-01 -0.859379863927E-01 -0.870631289711E-01
+ -0.882024241189E-01 -0.893560498559E-01 -0.905241864446E-01 -0.917070164047E-01
+ -0.929047245601E-01 -0.941174980551E-01 -0.953455263880E-01 -0.965890014428E-01
+ -0.978481175190E-01 -0.991230713554E-01 -0.100414062166 -0.101721291677
+ -0.103044964142 -0.104385286392 -0.105742467857 -0.107116720601
+ -0.108508259356 -0.109917301553 -0.111344067359 -0.112788779718
+ -0.114251664364 -0.115732949879 -0.117232867724 -0.118751652261
+ -0.120289540809 -0.121846773670 -0.123423594164 -0.125020248676
+ -0.126636986694 -0.128274060836 -0.129931726898 -0.131610243904
+ -0.133309874125 -0.135030883138 -0.136773539855 -0.138538116574
+ -0.140324889020 -0.142134136382 -0.143966141363 -0.145821190224
+ -0.147699572823 -0.149601582667 -0.151527516953 -0.153477676618
+ -0.155452366385 -0.157451894806 -0.159476574321 -0.161526721294
+ -0.163602656072 -0.165704703031 -0.167833190624 -0.169988451442
+ -0.172170822257 -0.174380644073 -0.176618262189 -0.178884026248
+ -0.181178290285 -0.183501412794 -0.185853756777 -0.188235689802
+ -0.190647584062 -0.193089816428 -0.195562768517 -0.198066826746
+ -0.200602382384 -0.203169831636 -0.205769575681 -0.208402020745
+ -0.211067578170 -0.213766664467 -0.216499701389 -0.219267115993
+ -0.222069340710 -0.224906813409 -0.227779977466 -0.230689281841
+ -0.233635181133 -0.236618135664 -0.239638611549 -0.242697080760
+ -0.245794021214 -0.248929916835 -0.252105257636 -0.255320539793
+ -0.258576265727 -0.261872944176 -0.265211090279 -0.268591225658
+ -0.272013878492 -0.275479583609 -0.278988882562 -0.282542323719
+ -0.286140462347 -0.289783860693 -0.293473088085 -0.297208721009
+ -0.300991343202 -0.304821545748 -0.308699927166 -0.312627093503
+ -0.316603658431 -0.320630243345 -0.324707477455 -0.328835997886
+ -0.333016449780 -0.337249486396 -0.341535769211 -0.345875968022
+ -0.350270761056 -0.354720835069 -0.359226885462 -0.363789616381
+ -0.368409740831 -0.373087980790 -0.377825067318 -0.382621740672
+ -0.387478750424 -0.392396855575 -0.397376824679 -0.402419435956
+ -0.407525477417 -0.412695746992 -0.417931052647 -0.423232212514
+ -0.428600055021 -0.434035419016 -0.439539153905 -0.445112119781
+ -0.450755187556 -0.456469239104 -0.462255167394 -0.468113876631
+ -0.474046282396 -0.480053311795 -0.486135903595 -0.492295008378
+ -0.498531588688 -0.504846619181 -0.511241086776 -0.517715990812
+ -0.524272343204 -0.530911168601 -0.537633504546 -0.544440401637
+ -0.551332923696 -0.558312147932 -0.565379165107 -0.572535079713
+ -0.579781010144 -0.587118088863 -0.594547462591 -0.602070292478
+ -0.609687754289 -0.617401038585 -0.625211350913 -0.633119911994
+ -0.641127957909 -0.649236740302 -0.657447526568 -0.665761600054
+ -0.674180260263 -0.682704823052 -0.691336620843 -0.700077002830
+ -0.708927335190 -0.717889001296 -0.726963401938 -0.736151955536
+ -0.745456098370 -0.754877284798 -0.764416987488 -0.774076697649
+ -0.783857925261 -0.793762199317 -0.803791068058 -0.813946099219
+ -0.824228880274 -0.834641018683 -0.845184142145 -0.855859898858
+ -0.866669957768 -0.877616008839 -0.888699763316 -0.899922953990
+ -0.911287335474 -0.922794684477 -0.934446800082 -0.946245504029
+ -0.958192641000 -0.970290078910 -0.982539709198 -0.994943447128
+ -1.00750323208 -1.02022102788 -1.03309882305 -1.04613863121
+ -1.05934249131 -1.07271246799 -1.08625065191 -1.09995916004
+ -1.11384013605 -1.12789575060 -1.14212820169 -1.15653971503
+ -1.17113254436 -1.18590897181 -1.20087130827 -1.21602189374
+ -1.23136309773 -1.24689731956 -1.26262698883 -1.27855456572
+ -1.29468254144 -1.31101343856 -1.32754981148 -1.34429424674
+ -1.36124936353 -1.37841781401 -1.39580228377 -1.41340549226
+ -1.43123019319 -1.44927917499 -1.46755526122 -1.48606131103
+ -1.50480021960 -1.52377491862 -1.54298837671 -1.56244359991
+ -1.58214363216 -1.60209155574 -1.62229049181 -1.64274360084
+ -1.66345408315 -1.68442517938 -1.70566017102 -1.72716238093
+ -1.74893517381 -1.77098195680 -1.79330617994 -1.81591133678
+ -1.83880096487 -1.86197864632 -1.88544800839 -1.90921272404
+ -1.93327651247 -1.95764313977 -1.98231641942 -2.00730021297
+ -2.03259843055 -2.05821503156 -2.08415402522 -2.11041947125
+ -2.13701548042 -2.16394621526 -2.19121589066 -2.21882877454
+ -2.24678918847 -2.27510150839 -2.30377016523 -2.33279964561
+ -2.36219449251 -2.39195930599 -2.42209874385 -2.45261752239
+ -2.48352041704 -2.51481226317 -2.54649795676 -2.57858245513
+ -2.61107077773 -2.64396800682 -2.67727928828 -2.71100983235
+ -2.74516491436 -2.77974987556 -2.81477012387 -2.85023113464
+ -2.88613845149 -2.92249768705 -2.95931452380 -2.99659471486
+ -3.03434408477 -3.07256853034 -3.11127402146 -3.15046660190
+ -3.19015239012 -3.23033758014 -3.27102844232 -3.31223132420
+ -3.35395265134 -3.39619892813 -3.43897673860 -3.48229274727
+ -3.52615369999 -3.57056642468 -3.61553783223 -3.66107491724
+ -3.70718475887 -3.75387452160 -3.80115145602 -3.84902289961
+ -3.89749627750 -3.94657910322 -3.99627897942 -4.04660359857
+ -4.09756074372 -4.14915828910 -4.20140420081 -4.25430653743
+ -4.30787345064 -4.36211318576 -4.41703408229 -4.47264457443
+ -4.52895319148 -4.58596855831 -4.64369939568 -4.70215452060
+ -4.76134284654 -4.82127338365 -4.88195523888 -4.94339761608
+ -5.00560981595 -5.06860123594 -5.13238137012 -5.19695980886
+ -5.26234623850 -5.32855044080 -5.39558229245 -5.46345176427
+ -5.53216892037 -5.60174391722 -5.67218700244 -5.74350851357
+ -5.81571887652 -5.88882860401 -5.96284829366 -6.03778862595
+ -6.11366036196 -6.19047434088 -6.26824147720 -6.34697275777
+ -6.42667923841 -6.50737204039 -6.58906234645 -6.67176139659
+ -6.75548048344 -6.84023094728 -6.92602417066 -7.01287157255
+ -7.10078460213 -7.18977473204 -7.27985345110 -7.37103225661
+ -7.46332264597 -7.55673610778 -7.65128411229 -7.74697810119
+ -7.84382947672 -7.94184959003 -8.04104972877 -8.14144110388
+ -8.24303483549 -8.34584193797 -8.44987330398 -8.55513968756
+ -8.66165168615 -8.76941972151 -8.87845401948 -8.98876458858
+ -9.10036119721 -9.21325334967 -9.32745026063 -9.44296082824
+ -9.55979360564 -9.67795677085 -9.79745809501 -9.91830490883
+ -10.0405040671 -10.1640619115 -10.2889842311 -10.4152762207
+ -10.5429424374 -10.6719867543 -10.8024123122 -10.9342214684
+ -11.0674157431 -11.2019957626 -11.3379612006 -11.4753107151
+ -11.6140418834 -11.7541511328 -11.8956336683 -12.0384833969
+ -12.1826928478 -12.3282530887 -12.4751536383 -12.6233823737
+ -12.7729254350 -12.9237671233 -13.0758897953 -13.2292737522
+ -13.3838971238 -13.5397357468 -13.6967630379 -13.8549498604
+ -14.0142643859 -14.1746719488 -14.3361348950 -14.4986124236
+ -14.6620604224 -14.8264312966 -14.9916737897 -15.1577327989
+ -15.3245491821 -15.4920595587 -15.6601961039 -15.8288863351
+ -15.9980528940 -16.1676133205 -16.3374798236 -16.5075590457
+ -16.6777518250 -16.8479529542 -17.0180509386 -17.1879277548
+ -17.3574586122 -17.5265117185 -17.6949480532 -17.8626211518
+ -18.0293769033 -18.1950533652 -18.3594806002 -18.5224805389
+ -18.6838668726 -18.8434449819 -19.0010119052 -19.1563563523
+ -19.3092587683 -19.4594914511 -19.6068187279 -19.7509971931
+ -19.8917760111 -20.0288972847 -20.1620964917 -20.2911029867
+ -20.4156405889 -20.5354280999 -20.6501805261 -20.7596086741
+ -20.8634167301 -20.9613402127 -21.0529916789 -21.1383471424
+ -21.2176208595 -21.2902500204 -21.3556621754 -21.4136289534
+ -21.4638141758 -21.5059066008 -21.5395975708 -21.5645822234
+ -21.5805641612 -21.5872571321 -21.5843876781 -21.5716976529
+ -21.5489468144 -21.5159154623 -21.4724071231 -21.4182512754
+ -21.3533061122 -21.2774613301 -21.1906409327 -21.0928060347
+ -20.9839576483 -20.8641394288 -20.7334403573 -20.5919973308
+ -20.4399976303 -20.2776812323 -20.1053429292 -19.9233342198
+ -19.7320649316 -19.5320045313 -19.3236830889 -19.1076918512
+ -18.8846833750 -18.6553712101 -18.4205290730 -18.1809894781
+ -17.9376418294 -17.6914299248 -17.4433488662 -17.1944413769
+ -16.9457935157 -16.6985298020 -16.4538077636 -16.2128119287
+ -15.9767472885 -15.7468322620 -15.5242911925 -15.3103464103
+ -15.1062098857 -14.9130744935 -14.7321048943 -14.5644280216
+ -14.4111231410 -14.2732114212 -14.1516449208 -14.0472948665
+ -13.9609390558 -13.8932481917 -13.8447709307 -13.8159174183
+ -13.8069411040 -13.8179186774 -13.8487280642 -13.8990245689
+ -13.9682154663 -14.0554336256 -14.1595111034 -14.2789540622
+ -14.4119208516 -14.5562056316 -14.7092305167 -14.8680498921
+ -15.0293713266 -15.1895984108 -15.3449019308 -15.4913270746
+ -15.6249458643 -15.7420658373 -15.8395070994 -15.9149670708
+ -15.9674702785 -15.9979949694 -16.0101059503 -16.0109894380
+ -16.0098872132 -16.0088178249 -16.0078414807 -16.0069876789
+ -16.0061963147 -16.0054875513 -16.0048462399 -16.0042693984
+ -16.0037515085 -16.0032879100 -16.0028741195 -16.0025058936
+ -16.0021792033 -16.0018902285 -16.0016353580 -16.0014111939
+ -16.0012145560 -16.0010424862 -16.0007623617 -16.0005547138
+ -16.0004014734 -16.0002888936 -16.0002065673 -16.0001466542
+ -16.0001032750 -16.0000720402 -16.0000496871 -16.0000338000
+ -16.0000225979 -16.0000147727 -16.0000093673 -16.0000056847
+ -16.0000032193 -16.0000016059 -16.0000005825 -15.9999999619
+ -15.9999996116 -15.9999994386 -15.9999993782 -15.9999993860
+ -15.9999994324 -15.9999994976 -15.9999995692 -15.9999996396
+ -15.9999997045 -15.9999997618 -15.9999998109 -15.9999998519
+ -15.9999998854 -15.9999999124 -15.9999999337 -15.9999999504
+ -15.9999999632 -15.9999999730 -15.9999999804 -15.9999999859
+ -15.9999999899 -15.9999999929 -15.9999999950 -15.9999999965
+ -15.9999999976 -15.9999999984 -15.9999999989 -15.9999999993
+ -15.9999999995 -15.9999999997 -15.9999999998 -15.9999999999
+ -15.9999999999 -15.9999999999 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000
+ Down Pseudopotential follows (l on next line)
+ 3
+ -0.252941192202E-04 -0.509063992908E-04 -0.768408421895E-04 -0.103101500217E-03
+ -0.129692476662E-03 -0.156617926414E-03 -0.183882056632E-03 -0.211489127391E-03
+ -0.239443452351E-03 -0.267749399434E-03 -0.296411391500E-03 -0.325433907044E-03
+ -0.354821480894E-03 -0.384578704919E-03 -0.414710228743E-03 -0.445220760480E-03
+ -0.476115067462E-03 -0.507397976988E-03 -0.539074377076E-03 -0.571149217227E-03
+ -0.603627509201E-03 -0.636514327798E-03 -0.669814811649E-03 -0.703534164023E-03
+ -0.737677653637E-03 -0.772250615482E-03 -0.807258451651E-03 -0.842706632193E-03
+ -0.878600695956E-03 -0.914946251462E-03 -0.951748977778E-03 -0.989014625402E-03
+ -0.102674901717E-02 -0.106495804916E-02 -0.110364769161E-02 -0.114282398985E-02
+ -0.118249306526E-02 -0.122266111621E-02 -0.126333441905E-02 -0.130451932906E-02
+ -0.134622228146E-02 -0.138844979244E-02 -0.143120846011E-02 -0.147450496561E-02
+ -0.151834607412E-02 -0.156273863588E-02 -0.160768958733E-02 -0.165320595215E-02
+ -0.169929484236E-02 -0.174596345945E-02 -0.179321909547E-02 -0.184106913423E-02
+ -0.188952105238E-02 -0.193858242064E-02 -0.198826090495E-02 -0.203856426766E-02
+ -0.208950036880E-02 -0.214107716721E-02 -0.219330272189E-02 -0.224618519317E-02
+ -0.229973284407E-02 -0.235395404150E-02 -0.240885725764E-02 -0.246445107123E-02
+ -0.252074416892E-02 -0.257774534661E-02 -0.263546351085E-02 -0.269390768024E-02
+ -0.275308698678E-02 -0.281301067737E-02 -0.287368811520E-02 -0.293512878126E-02
+ -0.299734227575E-02 -0.306033831969E-02 -0.312412675631E-02 -0.318871755271E-02
+ -0.325412080131E-02 -0.332034672152E-02 -0.338740566126E-02 -0.345530809864E-02
+ -0.352406464354E-02 -0.359368603933E-02 -0.366418316448E-02 -0.373556703431E-02
+ -0.380784880270E-02 -0.388103976383E-02 -0.395515135392E-02 -0.403019515308E-02
+ -0.410618288704E-02 -0.418312642905E-02 -0.426103780168E-02 -0.433992917876E-02
+ -0.441981288722E-02 -0.450070140905E-02 -0.458260738326E-02 -0.466554360781E-02
+ -0.474952304166E-02 -0.483455880678E-02 -0.492066419016E-02 -0.500785264596E-02
+ -0.509613779756E-02 -0.518553343968E-02 -0.527605354057E-02 -0.536771224420E-02
+ -0.546052387242E-02 -0.555450292724E-02 -0.564966409308E-02 -0.574602223906E-02
+ -0.584359242135E-02 -0.594238988548E-02 -0.604243006876E-02 -0.614372860268E-02
+ -0.624630131534E-02 -0.635016423394E-02 -0.645533358727E-02 -0.656182580826E-02
+ -0.666965753654E-02 -0.677884562104E-02 -0.688940712262E-02 -0.700135931675E-02
+ -0.711471969618E-02 -0.722950597370E-02 -0.734573608492E-02 -0.746342819102E-02
+ -0.758260068165E-02 -0.770327217774E-02 -0.782546153447E-02 -0.794918784417E-02
+ -0.807447043935E-02 -0.820132889566E-02 -0.832978303499E-02 -0.845985292859E-02
+ -0.859155890013E-02 -0.872492152894E-02 -0.885996165322E-02 -0.899670037326E-02
+ -0.913515905478E-02 -0.927535933222E-02 -0.941732311218E-02 -0.956107257678E-02
+ -0.970663018719E-02 -0.985401868707E-02 -0.100032611062E-01 -0.101543807640E-01
+ -0.103074012733E-01 -0.104623465437E-01 -0.106192407859E-01 -0.107781085149E-01
+ -0.109389745541E-01 -0.111018640392E-01 -0.112668024219E-01 -0.114338154743E-01
+ -0.116029292925E-01 -0.117741703008E-01 -0.119475652562E-01 -0.121231412517E-01
+ -0.123009257217E-01 -0.124809464453E-01 -0.126632315511E-01 -0.128478095215E-01
+ -0.130347091972E-01 -0.132239597818E-01 -0.134155908460E-01 -0.136096323325E-01
+ -0.138061145608E-01 -0.140050682316E-01 -0.142065244319E-01 -0.144105146397E-01
+ -0.146170707287E-01 -0.148262249739E-01 -0.150380100561E-01 -0.152524590671E-01
+ -0.154696055150E-01 -0.156894833295E-01 -0.159121268669E-01 -0.161375709157E-01
+ -0.163658507021E-01 -0.165970018953E-01 -0.168310606132E-01 -0.170680634279E-01
+ -0.173080473716E-01 -0.175510499423E-01 -0.177971091098E-01 -0.180462633213E-01
+ -0.182985515077E-01 -0.185540130896E-01 -0.188126879834E-01 -0.190746166076E-01
+ -0.193398398891E-01 -0.196083992697E-01 -0.198803367124E-01 -0.201556947080E-01
+ -0.204345162817E-01 -0.207168450001E-01 -0.210027249777E-01 -0.212922008839E-01
+ -0.215853179498E-01 -0.218821219758E-01 -0.221826593380E-01 -0.224869769962E-01
+ -0.227951225006E-01 -0.231071439997E-01 -0.234230902476E-01 -0.237430106115E-01
+ -0.240669550798E-01 -0.243949742695E-01 -0.247271194344E-01 -0.250634424729E-01
+ -0.254039959362E-01 -0.257488330367E-01 -0.260980076559E-01 -0.264515743532E-01
+ -0.268095883742E-01 -0.271721056594E-01 -0.275391828529E-01 -0.279108773116E-01
+ -0.282872471135E-01 -0.286683510673E-01 -0.290542487213E-01 -0.294450003731E-01
+ -0.298406670785E-01 -0.302413106613E-01 -0.306469937232E-01 -0.310577796531E-01
+ -0.314737326372E-01 -0.318949176693E-01 -0.323214005605E-01 -0.327532479499E-01
+ -0.331905273147E-01 -0.336333069808E-01 -0.340816561338E-01 -0.345356448293E-01
+ -0.349953440041E-01 -0.354608254875E-01 -0.359321620121E-01 -0.364094272254E-01
+ -0.368926957015E-01 -0.373820429522E-01 -0.378775454393E-01 -0.383792805864E-01
+ -0.388873267909E-01 -0.394017634365E-01 -0.399226709052E-01 -0.404501305902E-01
+ -0.409842249085E-01 -0.415250373138E-01 -0.420726523096E-01 -0.426271554621E-01
+ -0.431886334141E-01 -0.437571738981E-01 -0.443328657501E-01 -0.449157989235E-01
+ -0.455060645035E-01 -0.461037547206E-01 -0.467089629658E-01 -0.473217838045E-01
+ -0.479423129918E-01 -0.485706474873E-01 -0.492068854702E-01 -0.498511263545E-01
+ -0.505034708048E-01 -0.511640207520E-01 -0.518328794090E-01 -0.525101512871E-01
+ -0.531959422122E-01 -0.538903593412E-01 -0.545935111792E-01 -0.553055075958E-01
+ -0.560264598429E-01 -0.567564805716E-01 -0.574956838500E-01 -0.582441851813E-01
+ -0.590021015212E-01 -0.597695512969E-01 -0.605466544249E-01 -0.613335323305E-01
+ -0.621303079661E-01 -0.629371058308E-01 -0.637540519896E-01 -0.645812740934E-01
+ -0.654189013988E-01 -0.662670647880E-01 -0.671258967900E-01 -0.679955316005E-01
+ -0.688761051034E-01 -0.697677548917E-01 -0.706706202893E-01 -0.715848423725E-01
+ -0.725105639923E-01 -0.734479297965E-01 -0.743970862526E-01 -0.753581816702E-01
+ -0.763313662246E-01 -0.773167919802E-01 -0.783146129141E-01 -0.793249849403E-01
+ -0.803480659342E-01 -0.813840157567E-01 -0.824329962799E-01 -0.834951714121E-01
+ -0.845707071232E-01 -0.856597714709E-01 -0.867625346270E-01 -0.878791689038E-01
+ -0.890098487810E-01 -0.901547509334E-01 -0.913140542579E-01 -0.924879399018E-01
+ -0.936765912913E-01 -0.948801941596E-01 -0.960989365766E-01 -0.973330089776E-01
+ -0.985826041936E-01 -0.998479174814E-01 -0.101129146554 -0.102426491610
+ -0.103740155369 -0.105070343100 -0.106417262651 -0.107781124488
+ -0.109162141725 -0.110560530153 -0.111976508281 -0.113410297365
+ -0.114862121446 -0.116332207381 -0.117820784882 -0.119328086550
+ -0.120854347913 -0.122399807462 -0.123964706686 -0.125549290114
+ -0.127153805350 -0.128778503114 -0.130423637277 -0.132089464908
+ -0.133776246305 -0.135484245045 -0.137213728018 -0.138964965472
+ -0.140738231055 -0.142533801856 -0.144351958453 -0.146192984951
+ -0.148057169029 -0.149944801986 -0.151856178785 -0.153791598100
+ -0.155751362363 -0.157735777809 -0.159745154527 -0.161779806506
+ -0.163840051686 -0.165926212006 -0.168038613455 -0.170177586124
+ -0.172343464257 -0.174536586300 -0.176757294961 -0.179005937256
+ -0.181282864570 -0.183588432706 -0.185923001944 -0.188286937097
+ -0.190680607568 -0.193104387407 -0.195558655370 -0.198043794977
+ -0.200560194576 -0.203108247399 -0.205688351625 -0.208300910443
+ -0.210946332116 -0.213625030043 -0.216337422822 -0.219083934321
+ -0.221864993740 -0.224681035677 -0.227532500202 -0.230419832918
+ -0.233343485038 -0.236303913449 -0.239301580791 -0.242336955520
+ -0.245410511991 -0.248522730525 -0.251674097488 -0.254865105365
+ -0.258096252838 -0.261368044864 -0.264680992755 -0.268035614256
+ -0.271432433627 -0.274871981726 -0.278354796090 -0.281881421021
+ -0.285452407669 -0.289068314124 -0.292729705493 -0.296437154000
+ -0.300191239066 -0.303992547407 -0.307841673121 -0.311739217783
+ -0.315685790540 -0.319682008204 -0.323728495349 -0.327825884413
+ -0.331974815790 -0.336175937938 -0.340429907472 -0.344737389276
+ -0.349099056599 -0.353515591167 -0.357987683284 -0.362516031946
+ -0.367101344945 -0.371744338984 -0.376445739788 -0.381206282216
+ -0.386026710379 -0.390907777755 -0.395850247307 -0.400854891604
+ -0.405922492939 -0.411053843458 -0.416249745275 -0.421511010606
+ -0.426838461892 -0.432232931931 -0.437695264003 -0.443226312010
+ -0.448826940604 -0.454498025326 -0.460240452739 -0.466055120575
+ -0.471942937867 -0.477904825098 -0.483941714342 -0.490054549414
+ -0.496244286012 -0.502511891874 -0.508858346926 -0.515284643436
+ -0.521791786171 -0.528380792556 -0.535052692831 -0.541808530213
+ -0.548649361063 -0.555576255050 -0.562590295320 -0.569692578663
+ -0.576884215692 -0.584166331010 -0.591540063393 -0.599006565967
+ -0.606567006389 -0.614222567028 -0.621974445160 -0.629823853145
+ -0.637772018626 -0.645820184720 -0.653969610212 -0.662221569756
+ -0.670577354075 -0.679038270161 -0.687605641487 -0.696280808212
+ -0.705065127391 -0.713959973193 -0.722966737113 -0.732086828195
+ -0.741321673254 -0.750672717100 -0.760141422764 -0.769729271734
+ -0.779437764186 -0.789268419220 -0.799222775100 -0.809302389499
+ -0.819508839746 -0.829843723069 -0.840308656856 -0.850905278903
+ -0.861635247679 -0.872500242584 -0.883501964217 -0.894642134644
+ -0.905922497672 -0.917344819123 -0.928910887114 -0.940622512342
+ -0.952481528368 -0.964489791908 -0.976649183131 -0.988961605951
+ -1.00142898833 -1.01405328260 -1.02683646572 -1.03978053968
+ -1.05288753172 -1.06615949472 -1.07959850750 -1.09320667515
+ -1.10698612936 -1.12093902878 -1.13506755934 -1.14937393459
+ -1.16386039609 -1.17852921373 -1.19338268610 -1.20842314085
+ -1.22365293508 -1.23907445570 -1.25469011980 -1.27050237504
+ -1.28651370006 -1.30272660482 -1.31914363107 -1.33576735270
+ -1.35260037616 -1.36964534087 -1.38690491967 -1.40438181919
+ -1.42207878033 -1.43999857867 -1.45814402490 -1.47651796526
+ -1.49512328205 -1.51396289401 -1.53303975680 -1.55235686350
+ -1.57191724505 -1.59172397074 -1.61178014868 -1.63208892630
+ -1.65265349084 -1.67347706985 -1.69456293171 -1.71591438609
+ -1.73753478454 -1.75942752093 -1.78159603207 -1.80404379815
+ -1.82677434334 -1.84979123632 -1.87309809081 -1.89669856614
+ -1.92059636783 -1.94479524810 -1.96929900649 -1.99411149043
+ -2.01923659579 -2.04467826749 -2.07044050009 -2.09652733836
+ -2.12294287793 -2.14969126581 -2.17677670110 -2.20420343549
+ -2.23197577399 -2.26009807543 -2.28857475317 -2.31741027568
+ -2.34660916716 -2.37617600821 -2.40611543641 -2.43643214695
+ -2.46713089329 -2.49821648779 -2.52969380229 -2.56156776879
+ -2.59384338004 -2.62652569020 -2.65961981541 -2.69313093443
+ -2.72706428927 -2.76142518576 -2.79621899414 -2.83145114969
+ -2.86712715328 -2.90325257193 -2.93983303938 -2.97687425665
+ -3.01438199252 -3.05236208407 -3.09082043720 -3.12976302704
+ -3.16919589845 -3.20912516643 -3.24955701653 -3.29049770520
+ -3.33195356015 -3.37393098066 -3.41643643784 -3.45947647486
+ -3.50305770718 -3.54718682261 -3.59187058151 -3.63711581676
+ -3.68292943376 -3.72931841038 -3.77628979680 -3.82385071533
+ -3.87200836009 -3.92076999667 -3.97014296172 -4.02013466235
+ -4.07075257556 -4.12200424749 -4.17389729257 -4.22643939260
+ -4.27963829567 -4.33350181492 -4.38803782728 -4.44325427191
+ -4.49915914862 -4.55576051607 -4.61306648978 -4.67108523999
+ -4.72982498936 -4.78929401038 -4.84950062265 -4.91045318989
+ -4.97216011674 -5.03462984528 -5.09787085131 -5.16189164034
+ -5.22670074331 -5.29230671194 -5.35871811382 -5.42594352713
+ -5.49399153497 -5.56287071936 -5.63258965475 -5.70315690123
+ -5.77458099716 -5.84687045138 -5.92003373492 -5.99407927216
+ -6.06901543145 -6.14485051508 -6.22159274865 -6.29925026980
+ -6.37783111616 -6.45734321259 -6.53779435760 -6.61919220891
+ -6.70154426815 -6.78485786451 -6.86914013743 -6.95439801817
+ -7.04063821022 -7.12786716843 -7.21609107689 -7.30531582526
+ -7.39554698371 -7.48678977618 -7.57904905187 -7.67232925495
+ -7.76663439225 -7.86196799879 -7.95833310117 -8.05573217836
+ -8.15416712012 -8.25363918251 -8.35414894059 -8.45569623798
+ -8.55828013317 -8.66189884235 -8.76654967870 -8.87222898782
+ -8.97893207923 -9.08665315391 -9.19538522760 -9.30512004992
+ -9.41584801938 -9.52755809419 -9.64023769915 -9.75387262887
+ -9.86844694759 -9.98394288636 -10.1003407380 -10.2176187507
+ -10.3357530218 -10.4547173926 -10.5744833454 -10.6950199055
+ -10.8162935495 -10.9382681222 -11.0609047645 -11.1841618554
+ -11.3079949706 -11.4323568594 -11.5571974447 -11.6824638469
+ -11.8081004349 -11.9340489047 -12.0602483885 -12.1866355939
+ -12.3131449715 -12.4397089117 -12.5662579667 -12.6927210915
+ -12.8190259294 -12.9450989265 -13.0708663176 -13.1962527987
+ -13.3211778929 -13.4456035600 -13.5693347098 -13.6926450848
+ -13.8160918227 -13.9392292185 -14.0616165736 -14.1832516227
+ -14.3039882323 -14.4237052592 -14.5422752939 -14.6595642430
+ -14.7754348579 -14.8897464435 -15.0023556609 -15.1131170599
+ -15.2218836032 -15.3285071539 -15.4328389360 -15.5347299745
+ -15.6340315231 -15.7305954847 -15.8242748318 -15.9149240329
+ -16.0023994878 -16.0865599797 -16.1672671446 -16.2443859657
+ -16.3177852931 -16.3873383939 -16.4529235361 -16.5144246077
+ -16.5717317770 -16.6247421925 -16.6733607326 -16.7175008047
+ -16.7570851858 -16.7920469369 -16.8223303687 -16.8478920594
+ -16.8687019575 -16.8847445415 -16.8960200478 -16.9025457716
+ -16.9043574304 -16.9015105882 -16.8940821294 -16.8821717681
+ -16.8659035739 -16.8454274866 -16.8209207860 -16.7925894772
+ -16.7606695376 -16.7254279692 -16.6871635841 -16.6462074466
+ -16.6029228819 -16.5577049544 -16.5109793098 -16.4632002675
+ -16.4148480451 -16.3664249949 -16.3184507319 -16.2714560423
+ -16.2259754748 -16.1825385434 -16.1416595069 -16.1038257474
+ -16.0694848413 -16.0390305129 -16.0127877760 -15.9909977041
+ -15.9738024217 -15.9612310662 -15.9531876231 -15.9494416774
+ -15.9496232418 -15.9532229256 -15.9595988161 -15.9679916126
+ -15.9775498371 -15.9873675533 -15.9965370541 -16.0042247578
+ -16.0097574286 -16.0127920495 -16.0133993738 -16.0124092103
+ -16.0112484929 -16.0101099843 -16.0090535970 -16.0081083861
+ -16.0072198119 -16.0064090410 -16.0056639531 -16.0049838108
+ -16.0043652543 -16.0038054416 -16.0033013627 -16.0028498870
+ -16.0024477486 -16.0020915680 -16.0017778896 -16.0015032285
+ -16.0012641204 -16.0010571695 -16.0007511183 -16.0005295126
+ -16.0003702996 -16.0002568184 -16.0001765870 -16.0001203334
+ -16.0000812281 -16.0000542836 -16.0000358887 -16.0000234515
+ -16.0000151281 -16.0000096182 -16.0000060138 -16.0000036863
+ -16.0000022049 -16.0000012777 -16.0000007086 -16.0000003676
+ -16.0000001695 -16.0000000592 -16.0000000015 -15.9999999744
+ -15.9999999645 -15.9999999637 -15.9999999671 -15.9999999721
+ -15.9999999774 -15.9999999822 -15.9999999863 -15.9999999896
+ -15.9999999923 -15.9999999943 -15.9999999959 -15.9999999970
+ -15.9999999979 -15.9999999985 -15.9999999990 -15.9999999993
+ -15.9999999995 -15.9999999997 -15.9999999998 -15.9999999999
+ -15.9999999999 -15.9999999999 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000
+ Up Pseudopotential follows (l on next line)
+ 0
+ -0.933476879495E-05 -0.187869545244E-04 -0.283580341184E-04 -0.380495030692E-04
+ -0.478628756951E-04 -0.577996853514E-04 -0.678614846879E-04 -0.780498458792E-04
+ -0.883663608778E-04 -0.988126416613E-04 -0.109390320481E-03 -0.120101050121E-03
+ -0.130946504156E-03 -0.141928377209E-03 -0.153048385220E-03 -0.164308265712E-03
+ -0.175709778066E-03 -0.187254703793E-03 -0.198944846807E-03 -0.210782033718E-03
+ -0.222768114114E-03 -0.234904960840E-03 -0.247194470305E-03 -0.259638562770E-03
+ -0.272239182649E-03 -0.284998298817E-03 -0.297917904908E-03 -0.311000019639E-03
+ -0.324246687117E-03 -0.337659977161E-03 -0.351241985626E-03 -0.364994834724E-03
+ -0.378920673372E-03 -0.393021677506E-03 -0.407300050437E-03 -0.421758023193E-03
+ -0.436397854859E-03 -0.451221832940E-03 -0.466232273712E-03 -0.481431522586E-03
+ -0.496821954478E-03 -0.512405974173E-03 -0.528186016707E-03 -0.544164547741E-03
+ -0.560344063956E-03 -0.576727093435E-03 -0.593316196056E-03 -0.610113963905E-03
+ -0.627123021663E-03 -0.644346027033E-03 -0.661785671144E-03 -0.679444678975E-03
+ -0.697325809784E-03 -0.715431857533E-03 -0.733765651328E-03 -0.752330055863E-03
+ -0.771127971867E-03 -0.790162336548E-03 -0.809436124066E-03 -0.828952345990E-03
+ -0.848714051771E-03 -0.868724329214E-03 -0.888986304966E-03 -0.909503145004E-03
+ -0.930278055125E-03 -0.951314281450E-03 -0.972615110935E-03 -0.994183871877E-03
+ -0.101602393444E-02 -0.103813871118E-02 -0.106053165757E-02 -0.108320627255E-02
+ -0.110616609910E-02 -0.112941472471E-02 -0.115295578204E-02 -0.117679294943E-02
+ -0.120092995149E-02 -0.122537055966E-02 -0.125011859285E-02 -0.127517791798E-02
+ -0.130055245063E-02 -0.132624615562E-02 -0.135226304765E-02 -0.137860719190E-02
+ -0.140528270470E-02 -0.143229375417E-02 -0.145964456082E-02 -0.148733939829E-02
+ -0.151538259394E-02 -0.154377852958E-02 -0.157253164214E-02 -0.160164642435E-02
+ -0.163112742545E-02 -0.166097925191E-02 -0.169120656815E-02 -0.172181409724E-02
+ -0.175280662167E-02 -0.178418898409E-02 -0.181596608805E-02 -0.184814289880E-02
+ -0.188072444403E-02 -0.191371581468E-02 -0.194712216570E-02 -0.198094871693E-02
+ -0.201520075382E-02 -0.204988362832E-02 -0.208500275971E-02 -0.212056363543E-02
+ -0.215657181193E-02 -0.219303291557E-02 -0.222995264347E-02 -0.226733676443E-02
+ -0.230519111977E-02 -0.234352162433E-02 -0.238233426733E-02 -0.242163511333E-02
+ -0.246143030316E-02 -0.250172605490E-02 -0.254252866486E-02 -0.258384450853E-02
+ -0.262568004159E-02 -0.266804180093E-02 -0.271093640567E-02 -0.275437055818E-02
+ -0.279835104514E-02 -0.284288473860E-02 -0.288797859703E-02 -0.293363966645E-02
+ -0.297987508150E-02 -0.302669206655E-02 -0.307409793687E-02 -0.312210009972E-02
+ -0.317070605554E-02 -0.321992339911E-02 -0.326975982076E-02 -0.332022310753E-02
+ -0.337132114441E-02 -0.342306191558E-02 -0.347545350565E-02 -0.352850410092E-02
+ -0.358222199067E-02 -0.363661556841E-02 -0.369169333328E-02 -0.374746389128E-02
+ -0.380393595670E-02 -0.386111835341E-02 -0.391902001628E-02 -0.397764999259E-02
+ -0.403701744338E-02 -0.409713164496E-02 -0.415800199030E-02 -0.421963799053E-02
+ -0.428204927640E-02 -0.434524559982E-02 -0.440923683536E-02 -0.447403298178E-02
+ -0.453964416363E-02 -0.460608063280E-02 -0.467335277014E-02 -0.474147108706E-02
+ -0.481044622722E-02 -0.488028896813E-02 -0.495101022287E-02 -0.502262104181E-02
+ -0.509513261429E-02 -0.516855627042E-02 -0.524290348280E-02 -0.531818586836E-02
+ -0.539441519014E-02 -0.547160335916E-02 -0.554976243623E-02 -0.562890463390E-02
+ -0.570904231832E-02 -0.579018801119E-02 -0.587235439171E-02 -0.595555429858E-02
+ -0.603980073197E-02 -0.612510685558E-02 -0.621148599871E-02 -0.629895165830E-02
+ -0.638751750106E-02 -0.647719736562E-02 -0.656800526468E-02 -0.665995538719E-02
+ -0.675306210058E-02 -0.684733995301E-02 -0.694280367560E-02 -0.703946818482E-02
+ -0.713734858472E-02 -0.723646016936E-02 -0.733681842517E-02 -0.743843903339E-02
+ -0.754133787249E-02 -0.764553102066E-02 -0.775103475836E-02 -0.785786557082E-02
+ -0.796604015062E-02 -0.807557540032E-02 -0.818648843510E-02 -0.829879658539E-02
+ -0.841251739964E-02 -0.852766864704E-02 -0.864426832027E-02 -0.876233463834E-02
+ -0.888188604943E-02 -0.900294123378E-02 -0.912551910658E-02 -0.924963882097E-02
+ -0.937531977099E-02 -0.950258159464E-02 -0.963144417694E-02 -0.976192765304E-02
+ -0.989405241134E-02 -0.100278390967E-01 -0.101633086137E-01 -0.103004821299E-01
+ -0.104393810789E-01 -0.105800271643E-01 -0.107224423622E-01 -0.108666489256E-01
+ -0.110126693872E-01 -0.111605265631E-01 -0.113102435564E-01 -0.114618437609E-01
+ -0.116153508646E-01 -0.117707888535E-01 -0.119281820152E-01 -0.120875549429E-01
+ -0.122489325392E-01 -0.124123400199E-01 -0.125778029178E-01 -0.127453470873E-01
+ -0.129149987075E-01 -0.130867842871E-01 -0.132607306683E-01 -0.134368650307E-01
+ -0.136152148960E-01 -0.137958081320E-01 -0.139786729570E-01 -0.141638379443E-01
+ -0.143513320266E-01 -0.145411845006E-01 -0.147334250315E-01 -0.149280836575E-01
+ -0.151251907948E-01 -0.153247772422E-01 -0.155268741859E-01 -0.157315132043E-01
+ -0.159387262731E-01 -0.161485457702E-01 -0.163610044808E-01 -0.165761356024E-01
+ -0.167939727501E-01 -0.170145499621E-01 -0.172379017044E-01 -0.174640628768E-01
+ -0.176930688180E-01 -0.179249553111E-01 -0.181597585896E-01 -0.183975153425E-01
+ -0.186382627206E-01 -0.188820383416E-01 -0.191288802969E-01 -0.193788271566E-01
+ -0.196319179762E-01 -0.198881923025E-01 -0.201476901798E-01 -0.204104521558E-01
+ -0.206765192886E-01 -0.209459331527E-01 -0.212187358454E-01 -0.214949699938E-01
+ -0.217746787610E-01 -0.220579058531E-01 -0.223446955261E-01 -0.226350925926E-01
+ -0.229291424290E-01 -0.232268909822E-01 -0.235283847776E-01 -0.238336709253E-01
+ -0.241427971285E-01 -0.244558116902E-01 -0.247727635209E-01 -0.250937021467E-01
+ -0.254186777165E-01 -0.257477410101E-01 -0.260809434460E-01 -0.264183370895E-01
+ -0.267599746612E-01 -0.271059095443E-01 -0.274561957941E-01 -0.278108881456E-01
+ -0.281700420223E-01 -0.285337135452E-01 -0.289019595408E-01 -0.292748375510E-01
+ -0.296524058412E-01 -0.300347234098E-01 -0.304218499976E-01 -0.308138460966E-01
+ -0.312107729601E-01 -0.316126926118E-01 -0.320196678556E-01 -0.324317622855E-01
+ -0.328490402957E-01 -0.332715670901E-01 -0.336994086933E-01 -0.341326319602E-01
+ -0.345713045869E-01 -0.350154951209E-01 -0.354652729723E-01 -0.359207084244E-01
+ -0.363818726444E-01 -0.368488376950E-01 -0.373216765457E-01 -0.378004630835E-01
+ -0.382852721253E-01 -0.387761794291E-01 -0.392732617061E-01 -0.397765966325E-01
+ -0.402862628615E-01 -0.408023400363E-01 -0.413249088017E-01 -0.418540508171E-01
+ -0.423898487696E-01 -0.429323863860E-01 -0.434817484471E-01 -0.440380207999E-01
+ -0.446012903717E-01 -0.451716451833E-01 -0.457491743631E-01 -0.463339681606E-01
+ -0.469261179610E-01 -0.475257162992E-01 -0.481328568743E-01 -0.487476345645E-01
+ -0.493701454414E-01 -0.500004867857E-01 -0.506387571019E-01 -0.512850561338E-01
+ -0.519394848805E-01 -0.526021456117E-01 -0.532731418839E-01 -0.539525785566E-01
+ -0.546405618087E-01 -0.553371991553E-01 -0.560425994640E-01 -0.567568729726E-01
+ -0.574801313058E-01 -0.582124874929E-01 -0.589540559858E-01 -0.597049526761E-01
+ -0.604652949141E-01 -0.612352015265E-01 -0.620147928357E-01 -0.628041906777E-01
+ -0.636035184222E-01 -0.644129009910E-01 -0.652324648781E-01 -0.660623381696E-01
+ -0.669026505630E-01 -0.677535333886E-01 -0.686151196290E-01 -0.694875439407E-01
+ -0.703709426747E-01 -0.712654538982E-01 -0.721712174160E-01 -0.730883747924E-01
+ -0.740170693734E-01 -0.749574463095E-01 -0.759096525776E-01 -0.768738370049E-01
+ -0.778501502918E-01 -0.788387450355E-01 -0.798397757540E-01 -0.808533989103E-01
+ -0.818797729369E-01 -0.829190582606E-01 -0.839714173276E-01 -0.850370146294E-01
+ -0.861160167277E-01 -0.872085922814E-01 -0.883149120725E-01 -0.894351490331E-01
+ -0.905694782725E-01 -0.917180771045E-01 -0.928811250755E-01 -0.940588039924E-01
+ -0.952512979511E-01 -0.964587933657E-01 -0.976814789975E-01 -0.989195459844E-01
+ -0.100173187871 -0.101442600641 -0.102727982743 -0.104029535126
+ -0.105347461271 -0.106681967220 -0.108033261611 -0.109401555708
+ -0.110787063439 -0.112190001424 -0.113610589012 -0.115049048316
+ -0.116505604246 -0.117980484545 -0.119473919826 -0.120986143607
+ -0.122517392349 -0.124067905490 -0.125637925487 -0.127227697851
+ -0.128837471188 -0.130467497234 -0.132118030901 -0.133789330311
+ -0.135481656840 -0.137195275158 -0.138930453273 -0.140687462569
+ -0.142466577851 -0.144268077391 -0.146092242966 -0.147939359909
+ -0.149809717147 -0.151703607253 -0.153621326489 -0.155563174853
+ -0.157529456125 -0.159520477919 -0.161536551729 -0.163577992975
+ -0.165645121061 -0.167738259417 -0.169857735556 -0.172003881123
+ -0.174177031946 -0.176377528096 -0.178605713931 -0.180861938159
+ -0.183146553890 -0.185459918689 -0.187802394638 -0.190174348391
+ -0.192576151231 -0.195008179131 -0.197470812812 -0.199964437805
+ -0.202489444510 -0.205046228263 -0.207635189391 -0.210256733284
+ -0.212911270454 -0.215599216601 -0.218320992681 -0.221077024975
+ -0.223867745150 -0.226693590335 -0.229555003187 -0.232452431963
+ -0.235386330592 -0.238357158745 -0.241365381912 -0.244411471475
+ -0.247495904782 -0.250619165226 -0.253781742321 -0.256984131782
+ -0.260226835601 -0.263510362132 -0.266835226171 -0.270201949038
+ -0.273611058661 -0.277063089663 -0.280558583445 -0.284098088278
+ -0.287682159384 -0.291311359035 -0.294986256635 -0.298707428820
+ -0.302475459544 -0.306290940180 -0.310154469613 -0.314066654334
+ -0.318028108547 -0.322039454259 -0.326101321390 -0.330214347868
+ -0.334379179738 -0.338596471268 -0.342866885050 -0.347191092115
+ -0.351569772039 -0.356003613057 -0.360493312170 -0.365039575269
+ -0.369643117242 -0.374304662097 -0.379024943078 -0.383804702790
+ -0.388644693317 -0.393545676348 -0.398508423305 -0.403533715469
+ -0.408622344109 -0.413775110613 -0.418992826625 -0.424276314176
+ -0.429626405824 -0.435043944788 -0.440529785096 -0.446084791723
+ -0.451709840737 -0.457405819447 -0.463173626550 -0.469014172285
+ -0.474928378583 -0.480917179227 -0.486981520003 -0.493122358868
+ -0.499340666107 -0.505637424497 -0.512013629479 -0.518470289323
+ -0.525008425299 -0.531629071855 -0.538333276793 -0.545122101443
+ -0.551996620854 -0.558957923968 -0.566007113817 -0.573145307704
+ -0.580373637402 -0.587693249347 -0.595105304831 -0.602610980213
+ -0.610211467113 -0.617907972623 -0.625701719517 -0.633593946461
+ -0.641585908228 -0.649678875920 -0.657874137187 -0.666172996449
+ -0.674576775129 -0.683086811878 -0.691704462815 -0.700431101758
+ -0.709268120467 -0.718216928888 -0.727278955399 -0.736455647060
+ -0.745748469865 -0.755158909000 -0.764688469103 -0.774338674523
+ -0.784111069593 -0.794007218894 -0.804028707528 -0.814177141397
+ -0.824454147481 -0.834861374117 -0.845400491290 -0.856073190915
+ -0.866881187136 -0.877826216613 -0.888910038824 -0.900134436364
+ -0.911501215246 -0.923012205211 -0.934669260031 -0.946474257821
+ -0.958429101354 -0.970535718372 -0.982796061906 -0.995212110591
+ -1.00778586899 -1.02051936791 -1.03341466473 -1.04647384372
+ -1.05969901638 -1.07309232172 -1.08665592664 -1.10039202623
+ -1.11430284409 -1.12839063264 -1.14265767348 -1.15710627766
+ -1.17173878604 -1.18655756959 -1.20156502967 -1.21676359840
+ -1.23215573891 -1.24774394564 -1.26353074468 -1.27951869400
+ -1.29571038376 -1.31210843659 -1.32871550782 -1.34553428578
+ -1.36256749202 -1.37981788154 -1.39728824303 -1.41498139910
+ -1.43290020643 -1.45104755600 -1.46942637328 -1.48803961832
+ -1.50689028596 -1.52598140593 -1.54531604295 -1.56489729685
+ -1.58472830261 -1.60481223043 -1.62515228576 -1.64575170931
+ -1.66661377706 -1.68774180017 -1.70913912500 -1.73080913296
+ -1.75275524048 -1.77498089879 -1.79748959388 -1.82028484621
+ -1.84337021059 -1.86674927591 -1.89042566491 -1.91440303387
+ -1.93868507231 -1.96327550269 -1.98817807997 -2.01339659133
+ -2.03893485563 -2.06479672308 -2.09098607465 -2.11750682166
+ -2.14436290519 -2.17155829549 -2.19909699141 -2.22698301974
+ -2.25522043450 -2.28381331620 -2.31276577107 -2.34208193019
+ -2.37176594860 -2.40182200425 -2.43225429700 -2.46306704739
+ -2.49426449535 -2.52585089885 -2.55783053223 -2.59020768456
+ -2.62298665766 -2.65617176393 -2.68976732397 -2.72377766381
+ -2.75820711191 -2.79305999567 -2.82834063754 -2.86405335067
+ -2.90020243391 -2.93679216625 -2.97382680046 -3.01131055604
+ -3.04924761118 -3.08764209374 -3.12649807124 -3.16581953954
+ -3.20561041031 -3.24587449705 -3.28661549970 -3.32783698759
+ -3.36954238080 -3.41173492984 -3.45441769361 -3.49759351572
+ -3.54126499917 -3.58543447964 -3.63010399757 -3.67527526934
+ -3.72094965800 -3.76712814424 -3.81381129815 -3.86099925286
+ -3.90869168113 -3.95688777615 -4.00558623820 -4.05478526892
+ -4.10448257519 -4.15467538488 -4.20536047692 -4.25653422823
+ -4.30819268016 -4.36033162728 -4.41294673090 -4.46603365992
+ -4.51958826096 -4.57360675948 -4.62808599261 -4.68302367415
+ -4.73841869071 -4.79427142729 -4.85058411949 -4.90736122556
+ -4.96460984309 -5.02233995396 -5.08056554050 -5.13930338572
+ -5.19856956577 -5.25842718242 -5.31878699581 -5.38003342163
+ -5.44283920248 -5.50687927202 -5.57183869828 -5.63784619544
+ -5.70489189639 -5.77299627417 -5.84217893296 -5.91245822505
+ -5.98385479459 -6.05639128408 -6.13009311275 -6.20498896157
+ -6.28111122448 -6.35849639429 -6.43718539071 -6.51722383457
+ -6.59866227206 -6.68155635259 -6.76596696275 -6.85196031852
+ -6.93960801687 -7.02898704738 -7.12017976371 -7.21327381418
+ -7.30836203018 -7.40554227052 -7.50491721967 -7.60659413652
+ -7.71068455261 -7.81730391173 -7.92657115514 -8.03860824397
+ -8.15353960375 -8.27149151608 -8.39259142625 -8.51696715957
+ -8.64474607205 -8.77605409831 -8.91101469981 -9.04974771276
+ -9.19236807641 -9.33898443641 -9.48969760751 -9.64459888072
+ -9.80376815633 -9.96727188173 -10.1351607706 -10.3074672772
+ -10.4842027999 -10.6653545836 -10.8508822980 -11.0407142633
+ -11.2347433087 -11.4328222475 -11.6347589719 -11.8403111766
+ -12.0491807460 -12.2610078570 -12.4753648824 -12.6917502130
+ -12.9095821633 -13.1281931757 -13.3468246068 -13.5646224528
+ -13.7806344643 -13.9938092013 -14.2029976918 -14.4069584734
+ -14.6043669090 -14.7938297604 -14.9739060676 -15.1431353923
+ -15.3000744410 -15.4433429777 -15.5716797912 -15.6840093501
+ -15.7795197041 -15.8577523926 -15.9187046804 -15.9629496955
+ -15.9917583134 -16.0072921513 -16.0126929003 -16.0124102174
+ -16.0112484929 -16.0101099843 -16.0090535970 -16.0081083861
+ -16.0072198119 -16.0064090410 -16.0056639531 -16.0049838108
+ -16.0043652543 -16.0038054416 -16.0033013627 -16.0028498870
+ -16.0024477486 -16.0020915680 -16.0017778896 -16.0015032285
+ -16.0012641204 -16.0010571695 -16.0007511183 -16.0005295126
+ -16.0003702996 -16.0002568184 -16.0001765870 -16.0001203334
+ -16.0000812281 -16.0000542836 -16.0000358887 -16.0000234515
+ -16.0000151281 -16.0000096182 -16.0000060138 -16.0000036863
+ -16.0000022049 -16.0000012777 -16.0000007086 -16.0000003676
+ -16.0000001695 -16.0000000592 -16.0000000015 -15.9999999744
+ -15.9999999645 -15.9999999637 -15.9999999671 -15.9999999721
+ -15.9999999774 -15.9999999822 -15.9999999863 -15.9999999896
+ -15.9999999923 -15.9999999943 -15.9999999959 -15.9999999970
+ -15.9999999979 -15.9999999985 -15.9999999990 -15.9999999993
+ -15.9999999995 -15.9999999997 -15.9999999998 -15.9999999999
+ -15.9999999999 -15.9999999999 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000
+ Up Pseudopotential follows (l on next line)
+ 1
+ -0.225318212913E-04 -0.453470580023E-04 -0.684492750671E-04 -0.918420822457E-04
+ -0.115529134718E-03 -0.139514133631E-03 -0.163800826692E-03 -0.188393008743E-03
+ -0.213294522365E-03 -0.238509258470E-03 -0.264041156912E-03 -0.289894207100E-03
+ -0.316072448628E-03 -0.342579971898E-03 -0.369420918766E-03 -0.396599483183E-03
+ -0.424119911855E-03 -0.451986504908E-03 -0.480203616550E-03 -0.508775655764E-03
+ -0.537707086989E-03 -0.567002430820E-03 -0.596666264715E-03 -0.626703223707E-03
+ -0.657118001132E-03 -0.687915349364E-03 -0.719100080546E-03 -0.750677067360E-03
+ -0.782651243773E-03 -0.815027605815E-03 -0.847811212360E-03 -0.881007185909E-03
+ -0.914620713407E-03 -0.948657047031E-03 -0.983121505029E-03 -0.101801947254E-02
+ -0.105335640245E-02 -0.108913781622E-02 -0.112536930477E-02 -0.116205652935E-02
+ -0.119920522240E-02 -0.123682118849E-02 -0.127491030519E-02 -0.131347852400E-02
+ -0.135253187128E-02 -0.139207644920E-02 -0.143211843668E-02 -0.147266409036E-02
+ -0.151371974558E-02 -0.155529181737E-02 -0.159738680146E-02 -0.164001127527E-02
+ -0.168317189895E-02 -0.172687541646E-02 -0.177112865654E-02 -0.181593853387E-02
+ -0.186131205006E-02 -0.190725629484E-02 -0.195377844708E-02 -0.200088577595E-02
+ -0.204858564209E-02 -0.209688549868E-02 -0.214579289268E-02 -0.219531546598E-02
+ -0.224546095656E-02 -0.229623719978E-02 -0.234765212951E-02 -0.239971377945E-02
+ -0.245243028434E-02 -0.250580988124E-02 -0.255986091082E-02 -0.261459181866E-02
+ -0.267001115658E-02 -0.272612758396E-02 -0.278294986912E-02 -0.284048689064E-02
+ -0.289874763880E-02 -0.295774121698E-02 -0.301747684303E-02 -0.307796385076E-02
+ -0.313921169140E-02 -0.320122993505E-02 -0.326402827218E-02 -0.332761651516E-02
+ -0.339200459979E-02 -0.345720258683E-02 -0.352322066361E-02 -0.359006914558E-02
+ -0.365775847795E-02 -0.372629923733E-02 -0.379570213334E-02 -0.386597801034E-02
+ -0.393713784906E-02 -0.400919276839E-02 -0.408215402705E-02 -0.415603302538E-02
+ -0.423084130713E-02 -0.430659056125E-02 -0.438329262372E-02 -0.446095947939E-02
+ -0.453960326386E-02 -0.461923626538E-02 -0.469987092679E-02 -0.478151984740E-02
+ -0.486419578504E-02 -0.494791165798E-02 -0.503268054700E-02 -0.511851569742E-02
+ -0.520543052115E-02 -0.529343859881E-02 -0.538255368186E-02 -0.547278969469E-02
+ -0.556416073688E-02 -0.565668108534E-02 -0.575036519657E-02 -0.584522770889E-02
+ -0.594128344477E-02 -0.603854741313E-02 -0.613703481164E-02 -0.623676102919E-02
+ -0.633774164818E-02 -0.643999244705E-02 -0.654352940270E-02 -0.664836869300E-02
+ -0.675452669930E-02 -0.686202000900E-02 -0.697086541816E-02 -0.708107993410E-02
+ -0.719268077807E-02 -0.730568538792E-02 -0.742011142087E-02 -0.753597675622E-02
+ -0.765329949817E-02 -0.777209797864E-02 -0.789239076013E-02 -0.801419663866E-02
+ -0.813753464663E-02 -0.826242405587E-02 -0.838888438061E-02 -0.851693538053E-02
+ -0.864659706388E-02 -0.877788969057E-02 -0.891083377533E-02 -0.904545009097E-02
+ -0.918175967156E-02 -0.931978381575E-02 -0.945954409012E-02 -0.960106233249E-02
+ -0.974436065539E-02 -0.988946144949E-02 -0.100363873871E-01 -0.101851614257E-01
+ -0.103358068115E-01 -0.104883470832E-01 -0.106428060755E-01 -0.107992079231E-01
+ -0.109575770639E-01 -0.111179382435E-01 -0.112803165188E-01 -0.114447372615E-01
+ -0.116112261629E-01 -0.117798092372E-01 -0.119505128258E-01 -0.121233636015E-01
+ -0.122983885727E-01 -0.124756150873E-01 -0.126550708374E-01 -0.128367838634E-01
+ -0.130207825582E-01 -0.132070956720E-01 -0.133957523168E-01 -0.135867819705E-01
+ -0.137802144818E-01 -0.139760800752E-01 -0.141744093548E-01 -0.143752333102E-01
+ -0.145785833205E-01 -0.147844911596E-01 -0.149929890011E-01 -0.152041094232E-01
+ -0.154178854138E-01 -0.156343503761E-01 -0.158535381330E-01 -0.160754829332E-01
+ -0.163002194561E-01 -0.165277828172E-01 -0.167582085737E-01 -0.169915327303E-01
+ -0.172277917443E-01 -0.174670225317E-01 -0.177092624730E-01 -0.179545494185E-01
+ -0.182029216949E-01 -0.184544181111E-01 -0.187090779638E-01 -0.189669410441E-01
+ -0.192280476439E-01 -0.194924385616E-01 -0.197601551089E-01 -0.200312391171E-01
+ -0.203057329437E-01 -0.205836794790E-01 -0.208651221527E-01 -0.211501049410E-01
+ -0.214386723730E-01 -0.217308695382E-01 -0.220267420929E-01 -0.223263362679E-01
+ -0.226296988755E-01 -0.229368773170E-01 -0.232479195895E-01 -0.235628742942E-01
+ -0.238817906435E-01 -0.242047184689E-01 -0.245317082286E-01 -0.248628110155E-01
+ -0.251980785653E-01 -0.255375632642E-01 -0.258813181577E-01 -0.262293969582E-01
+ -0.265818540539E-01 -0.269387445171E-01 -0.273001241129E-01 -0.276660493076E-01
+ -0.280365772780E-01 -0.284117659200E-01 -0.287916738578E-01 -0.291763604530E-01
+ -0.295658858138E-01 -0.299603108045E-01 -0.303596970552E-01 -0.307641069708E-01
+ -0.311736037415E-01 -0.315882513522E-01 -0.320081145928E-01 -0.324332590679E-01
+ -0.328637512075E-01 -0.332996582772E-01 -0.337410483886E-01 -0.341879905101E-01
+ -0.346405544775E-01 -0.350988110054E-01 -0.355628316975E-01 -0.360326890584E-01
+ -0.365084565045E-01 -0.369902083759E-01 -0.374780199477E-01 -0.379719674418E-01
+ -0.384721280389E-01 -0.389785798906E-01 -0.394914021315E-01 -0.400106748915E-01
+ -0.405364793085E-01 -0.410688975412E-01 -0.416080127813E-01 -0.421539092673E-01
+ -0.427066722973E-01 -0.432663882421E-01 -0.438331445591E-01 -0.444070298058E-01
+ -0.449881336535E-01 -0.455765469016E-01 -0.461723614916E-01 -0.467756705214E-01
+ -0.473865682601E-01 -0.480051501624E-01 -0.486315128839E-01 -0.492657542959E-01
+ -0.499079735008E-01 -0.505582708475E-01 -0.512167479473E-01 -0.518835076895E-01
+ -0.525586542579E-01 -0.532422931463E-01 -0.539345311760E-01 -0.546354765117E-01
+ -0.553452386788E-01 -0.560639285801E-01 -0.567916585139E-01 -0.575285421907E-01
+ -0.582746947515E-01 -0.590302327856E-01 -0.597952743488E-01 -0.605699389821E-01
+ -0.613543477299E-01 -0.621486231594E-01 -0.629528893796E-01 -0.637672720604E-01
+ -0.645918984527E-01 -0.654268974080E-01 -0.662723993986E-01 -0.671285365380E-01
+ -0.679954426017E-01 -0.688732530477E-01 -0.697621050380E-01 -0.706621374601E-01
+ -0.715734909483E-01 -0.724963079062E-01 -0.734307325285E-01 -0.743769108239E-01
+ -0.753349906376E-01 -0.763051216746E-01 -0.772874555230E-01 -0.782821456778E-01
+ -0.792893475648E-01 -0.803092185650E-01 -0.813419180389E-01 -0.823876073519E-01
+ -0.834464498990E-01 -0.845186111307E-01 -0.856042585787E-01 -0.867035618820E-01
+ -0.878166928138E-01 -0.889438253078E-01 -0.900851354858E-01 -0.912408016850E-01
+ -0.924110044861E-01 -0.935959267413E-01 -0.947957536028E-01 -0.960106725522E-01
+ -0.972408734293E-01 -0.984865484620E-01 -0.997478922963E-01 -0.101025102027
+ -0.102318377228 -0.103627919983 -0.104953934920 -0.106296629239
+ -0.107656212746 -0.109032897890 -0.110426899788 -0.111838436267
+ -0.113267727890 -0.114714997999 -0.116180472742 -0.117664381114
+ -0.119166954991 -0.120688429165 -0.122229041381 -0.123789032375
+ -0.125368645914 -0.126968128829 -0.128587731056 -0.130227705677
+ -0.131888308956 -0.133569800383 -0.135272442710 -0.136996501996
+ -0.138742247647 -0.140509952458 -0.142299892656 -0.144112347943
+ -0.145947601538 -0.147805940228 -0.149687654402 -0.151593038106
+ -0.153522389085 -0.155476008828 -0.157454202619 -0.159457279583
+ -0.161485552731 -0.163539339015 -0.165618959374 -0.167724738785
+ -0.169857006312 -0.172016095160 -0.174202342727 -0.176416090655
+ -0.178657684886 -0.180927475711 -0.183225817831 -0.185553070410
+ -0.187909597130 -0.190295766249 -0.192711950658 -0.195158527940
+ -0.197635880429 -0.200144395270 -0.202684464479 -0.205256485004
+ -0.207860858787 -0.210497992830 -0.213168299255 -0.215872195368
+ -0.218610103728 -0.221382452210 -0.224189674075 -0.227032208033
+ -0.229910498316 -0.232824994746 -0.235776152806 -0.238764433709
+ -0.241790304475 -0.244854237997 -0.247956713122 -0.251098214721
+ -0.254279233770 -0.257500267419 -0.260761819080 -0.264064398496
+ -0.267408521827 -0.270794711730 -0.274223497438 -0.277695414846
+ -0.281211006592 -0.284770822147 -0.288375417894 -0.292025357221
+ -0.295721210608 -0.299463555712 -0.303252977464 -0.307090068157
+ -0.310975427540 -0.314909662908 -0.318893389206 -0.322927229115
+ -0.327011813157 -0.331147779791 -0.335335775513 -0.339576454959
+ -0.343870481004 -0.348218524870 -0.352621266229 -0.357079393310
+ -0.361593603008 -0.366164600990 -0.370793101811 -0.375479829020
+ -0.380225515278 -0.385030902473 -0.389896741831 -0.394823794042
+ -0.399812829372 -0.404864627787 -0.409979979078 -0.415159682980
+ -0.420404549301 -0.425715398047 -0.431093059551 -0.436538374608
+ -0.442052194599 -0.447635381630 -0.453288808667 -0.459013359672
+ -0.464809929742 -0.470679425250 -0.476622763988 -0.482640875309
+ -0.488734700277 -0.494905191809 -0.501153314832 -0.507480046429
+ -0.513886375994 -0.520373305391 -0.526941849105 -0.533593034409
+ -0.540327901519 -0.547147503763 -0.554052907743 -0.561045193505
+ -0.568125454707 -0.575294798793 -0.582554347168 -0.589905235370
+ -0.597348613255 -0.604885645175 -0.612517510158 -0.620245402102
+ -0.628070529954 -0.635994117907 -0.644017405590 -0.652141648265
+ -0.660368117021 -0.668698098979 -0.677132897494 -0.685673832355
+ -0.694322240003 -0.703079473732 -0.711946903908 -0.720925918184
+ -0.730017921717 -0.739224337392 -0.748546606045 -0.757986186690
+ -0.767544556751 -0.777223212293 -0.787023668258 -0.796947458705
+ -0.806996137053 -0.817171276321 -0.827474469383 -0.837907329213
+ -0.848471489144 -0.859168603123 -0.870000345972 -0.880968413651
+ -0.892074523530 -0.903320414652 -0.914707848013 -0.926238606838
+ -0.937914496860 -0.949737346606 -0.961709007684 -0.973831355073
+ -0.986106287422 -0.998535727343 -1.01112162172 -1.02386594200
+ -1.03677068452 -1.04983787082 -1.06306954794 -1.07646778875
+ -1.09003469229 -1.10377238409 -1.11768301648 -1.13176876894
+ -1.14603184847 -1.16047448988 -1.17509895618 -1.18990753891
+ -1.20490255850 -1.22008636463 -1.23546133660 -1.25102988367
+ -1.26679444548 -1.28275749237 -1.29892152581 -1.31528907873
+ -1.33186271596 -1.34864503458 -1.36563866434 -1.38284626803
+ -1.40027054191 -1.41791421610 -1.43578005500 -1.45387085769
+ -1.47218945835 -1.49073872667 -1.50952156831 -1.52854092527
+ -1.54779977637 -1.56730113764 -1.58704806277 -1.60704364358
+ -1.62729101039 -1.64779333252 -1.66855381872 -1.68957571758
+ -1.71086231805 -1.73241694979 -1.75424298371 -1.77634383237
+ -1.79872295042 -1.82138383511 -1.84433002666 -1.86756510877
+ -1.89109270903 -1.91491649937 -1.93904019654 -1.96346756248
+ -1.98820240481 -2.01324857726 -2.03860998004 -2.06429056032
+ -2.09029431264 -2.11662527926 -2.14328755061 -2.17028526567
+ -2.19762261231 -2.22530382771 -2.25333319864 -2.28171506189
+ -2.31045380449 -2.33955386408 -2.36901972919 -2.39885593946
+ -2.42906708594 -2.45965781123 -2.49063280976 -2.52199682788
+ -2.55375466403 -2.58591116879 -2.61847124500 -2.65143984774
+ -2.68482198430 -2.71862271414 -2.75284714877 -2.78750045156
+ -2.82258783752 -2.85811457305 -2.89408597553 -2.93050741295
+ -2.96738430341 -3.00472211453 -3.04252636280 -3.08080261286
+ -3.11955647662 -3.15879361235 -3.19851972363 -3.23874055815
+ -3.27946190647 -3.32068960055 -3.36242951224 -3.40468755154
+ -3.44746966477 -3.49078183250 -3.53463006740 -3.57902041180
+ -3.62395893515 -3.66945173119 -3.71550491496 -3.76212461953
+ -3.80931699250 -3.85708819228 -3.90544438400 -3.95439173525
+ -4.00393641137 -4.05408457059 -4.10484235862 -4.15621590309
+ -4.20821130747 -4.26083464460 -4.31409194991 -4.36798921403
+ -4.42253237511 -4.47772731048 -4.53357982794 -4.59009565641
+ -4.64728043607 -4.70513970785 -4.76367890236 -4.82290332810
+ -4.88281815901 -4.94342842129 -5.00473897945 -5.06675452158
+ -5.12947954376 -5.19291833363 -5.25707495300 -5.32195321953
+ -5.38755668734 -5.45388862670 -5.52095200240 -5.58874945120
+ -5.65728325785 -5.72655532999 -5.79656717162 -5.86731985523
+ -5.93881399246 -6.01104970318 -6.08402658304 -6.15774366930
+ -6.23219940489 -6.30739160067 -6.38331739575 -6.45997321574
+ -6.53735472902 -6.61545680067 -6.69427344415 -6.77379777060
+ -6.85402193557 -6.93493708315 -7.01653328732 -7.09879949051
+ -7.18172343911 -7.26529161595 -7.34948916955 -7.43429984004
+ -7.51970588175 -7.60568798222 -7.69222517771 -7.77929476507
+ -7.86687221001 -7.95493105173 -8.04344280402 -8.13237685303
+ -8.22170035168 -8.31137811133 -8.40137249078 -8.49164328339
+ -8.58214760274 -8.67283976788 -8.76367118904 -8.85459025507
+ -8.94554222410 -9.03646911906 -9.12730963011 -9.21799902618
+ -9.30846907811 -9.39864799626 -9.48846038551 -9.57782722093
+ -9.66666584745 -9.75489000696 -9.84240989623 -9.92913225888
+ -10.0149605143 -10.0997949264 -10.1835328129 -10.2660687988
+ -10.3472951109 -10.4271019162 -10.5053776995 -10.5820096767
+ -10.6568842691 -10.7298874227 -10.8009058180 -10.8698257839
+ -10.9365299248 -11.0009450097 -11.0628427861 -11.1224661820
+ -11.1803442086 -11.2360060824 -11.2889894541 -11.3392742351
+ -11.3867007139 -11.4311388522 -11.4724574808 -11.5105243534
+ -11.5452101591 -11.5763887298 -11.6039383518 -11.6277428181
+ -11.6476924786 -11.6636852600 -11.6756276613 -11.6834357302
+ -11.6870360255 -11.6863665700 -11.6813777988 -11.6720335062
+ -11.6583117980 -11.6402060511 -11.6177258885 -11.5908981734
+ -11.5597680305 -11.5243999027 -11.4848786522 -11.4413107176
+ -11.3938253419 -11.3425758811 -11.2877412195 -11.2295273057
+ -11.1681688192 -11.1039310180 -11.0371117648 -10.9680437501
+ -10.8970969631 -10.8246813974 -10.7512500098 -10.6773019427
+ -10.6033859898 -10.5301042832 -10.4581161532 -10.3881420881
+ -10.3209676874 -10.2574474673 -10.1985083296 -10.1451524568
+ -10.0984593388 -10.0595865755 -10.0297690313 -10.0103158514
+ -10.0026047811 -10.0080731635 -10.0282049370 -10.0645129125
+ -10.1185155898 -10.1917077861 -10.2855244020 -10.4012967595
+ -10.5402011242 -10.7031992837 -10.8909714197 -11.1038419875
+ -11.3416999274 -11.6039152847 -11.8892552112 -12.1958033628
+ -12.5208878784 -12.8610244007 -13.2118819421 -13.5682807647
+ -13.9242327841 -14.2730362922 -14.6074380115 -14.9198767023
+ -15.2028238452 -15.4492386367 -15.6531560106 -15.8104342994
+ -15.9196713475 -15.9833892396 -16.0093520568 -16.0124094156
+ -16.0112484929 -16.0101099843 -16.0090535970 -16.0081083861
+ -16.0072198119 -16.0064090410 -16.0056639531 -16.0049838108
+ -16.0043652543 -16.0038054416 -16.0033013627 -16.0028498870
+ -16.0024477486 -16.0020915680 -16.0017778896 -16.0015032285
+ -16.0012641204 -16.0010571695 -16.0007511183 -16.0005295126
+ -16.0003702996 -16.0002568184 -16.0001765870 -16.0001203334
+ -16.0000812281 -16.0000542836 -16.0000358887 -16.0000234515
+ -16.0000151281 -16.0000096182 -16.0000060138 -16.0000036863
+ -16.0000022049 -16.0000012777 -16.0000007086 -16.0000003676
+ -16.0000001695 -16.0000000592 -16.0000000015 -15.9999999744
+ -15.9999999645 -15.9999999637 -15.9999999671 -15.9999999721
+ -15.9999999774 -15.9999999822 -15.9999999863 -15.9999999896
+ -15.9999999923 -15.9999999943 -15.9999999959 -15.9999999970
+ -15.9999999979 -15.9999999985 -15.9999999990 -15.9999999993
+ -15.9999999995 -15.9999999997 -15.9999999998 -15.9999999999
+ -15.9999999999 -15.9999999999 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000
+ Up Pseudopotential follows (l on next line)
+ 2
+ -0.441752231935E-04 -0.889061320046E-04 -0.134199633660E-03 -0.180062906881E-03
+ -0.226503038806E-03 -0.273527335848E-03 -0.321143108697E-03 -0.369357823054E-03
+ -0.418179006756E-03 -0.467614276487E-03 -0.517671368911E-03 -0.568358107916E-03
+ -0.619682399017E-03 -0.671652269860E-03 -0.724275846226E-03 -0.777561348261E-03
+ -0.831517098496E-03 -0.886151516113E-03 -0.941473160292E-03 -0.997490673044E-03
+ -0.105421278486E-02 -0.111164838054E-02 -0.116980642221E-02 -0.122869600879E-02
+ -0.128832633440E-02 -0.134870670208E-02 -0.140984658148E-02 -0.147175549858E-02
+ -0.153444313604E-02 -0.159791928166E-02 -0.166219385440E-02 -0.172727692285E-02
+ -0.179317860612E-02 -0.185990925217E-02 -0.192747926936E-02 -0.199589919406E-02
+ -0.206517975311E-02 -0.213533173903E-02 -0.220636613615E-02 -0.227829404106E-02
+ -0.235112668616E-02 -0.242487544409E-02 -0.249955184686E-02 -0.257516758074E-02
+ -0.265173443297E-02 -0.272926437152E-02 -0.280776953167E-02 -0.288726214785E-02
+ -0.296775467580E-02 -0.304925966092E-02 -0.313178985471E-02 -0.321535816028E-02
+ -0.329997762022E-02 -0.338566145930E-02 -0.347242307470E-02 -0.356027602668E-02
+ -0.364923400660E-02 -0.373931094651E-02 -0.383052093000E-02 -0.392287819653E-02
+ -0.401639716260E-02 -0.411109244925E-02 -0.420697887655E-02 -0.430407138470E-02
+ -0.440238516636E-02 -0.450193561046E-02 -0.460273821468E-02 -0.470480877637E-02
+ -0.480816323072E-02 -0.491281770218E-02 -0.501878859340E-02 -0.512609242383E-02
+ -0.523474596370E-02 -0.534476621316E-02 -0.545617032078E-02 -0.556897574178E-02
+ -0.568320008354E-02 -0.579886117063E-02 -0.591597711412E-02 -0.603456618570E-02
+ -0.615464692146E-02 -0.627623810556E-02 -0.639935869396E-02 -0.652402795869E-02
+ -0.665026538657E-02 -0.677809065382E-02 -0.690752378798E-02 -0.703858499419E-02
+ -0.717129473106E-02 -0.730567375698E-02 -0.744174306816E-02 -0.757952391573E-02
+ -0.771903783808E-02 -0.786030662394E-02 -0.800335234902E-02 -0.814819738628E-02
+ -0.829486432528E-02 -0.844337611524E-02 -0.859375597095E-02 -0.874602735528E-02
+ -0.890021407615E-02 -0.905634023726E-02 -0.921443022463E-02 -0.937450872426E-02
+ -0.953660077132E-02 -0.970073169083E-02 -0.986692712098E-02 -0.100352130324E-01
+ -0.102056157194E-01 -0.103781618007E-01 -0.105528782477E-01 -0.107297923661E-01
+ -0.109089317885E-01 -0.110903244971E-01 -0.112739988511E-01 -0.114599835416E-01
+ -0.116483076372E-01 -0.118390005560E-01 -0.120320920930E-01 -0.122276124296E-01
+ -0.124255920987E-01 -0.126260620495E-01 -0.128290536121E-01 -0.130345984769E-01
+ -0.132427287845E-01 -0.134534770643E-01 -0.136668762052E-01 -0.138829595882E-01
+ -0.141017609788E-01 -0.143233145361E-01 -0.145476548952E-01 -0.147748171102E-01
+ -0.150048366727E-01 -0.152377495407E-01 -0.154735920728E-01 -0.157124011344E-01
+ -0.159542140698E-01 -0.161990686211E-01 -0.164470030568E-01 -0.166980561407E-01
+ -0.169522670703E-01 -0.172096755844E-01 -0.174703219036E-01 -0.177342467424E-01
+ -0.180014913532E-01 -0.182720974867E-01 -0.185461074243E-01 -0.188235639827E-01
+ -0.191045105123E-01 -0.193889909187E-01 -0.196770496547E-01 -0.199687317113E-01
+ -0.202640826817E-01 -0.205631487135E-01 -0.208659765256E-01 -0.211726134544E-01
+ -0.214831073931E-01 -0.217975068599E-01 -0.221158609938E-01 -0.224382195336E-01
+ -0.227646328380E-01 -0.230951519163E-01 -0.234298284149E-01 -0.237687146274E-01
+ -0.241118635082E-01 -0.244593286638E-01 -0.248111643936E-01 -0.251674256772E-01
+ -0.255281681759E-01 -0.258934482481E-01 -0.262633229919E-01 -0.266378501873E-01
+ -0.270170883424E-01 -0.274010967347E-01 -0.277899353633E-01 -0.281836649748E-01
+ -0.285823470964E-01 -0.289860440260E-01 -0.293948188318E-01 -0.298087353980E-01
+ -0.302278583976E-01 -0.306522533085E-01 -0.310819864551E-01 -0.315171249855E-01
+ -0.319577368758E-01 -0.324038909866E-01 -0.328556570315E-01 -0.333131055875E-01
+ -0.337763081463E-01 -0.342453370730E-01 -0.347202656544E-01 -0.352011681152E-01
+ -0.356881195784E-01 -0.361811961362E-01 -0.366804748405E-01 -0.371860336952E-01
+ -0.376979517023E-01 -0.382163088480E-01 -0.387411861245E-01 -0.392726655447E-01
+ -0.398108301571E-01 -0.403557640481E-01 -0.409075523664E-01 -0.414662813301E-01
+ -0.420320382412E-01 -0.426049115012E-01 -0.431849906177E-01 -0.437723662444E-01
+ -0.443671301438E-01 -0.449693752469E-01 -0.455791956773E-01 -0.461966867058E-01
+ -0.468219448087E-01 -0.474550677022E-01 -0.480961543046E-01 -0.487453047856E-01
+ -0.494026205797E-01 -0.500682043901E-01 -0.507421602213E-01 -0.514245933753E-01
+ -0.521156104884E-01 -0.528153195317E-01 -0.535238298359E-01 -0.542412521037E-01
+ -0.549676984421E-01 -0.557032823608E-01 -0.564481187821E-01 -0.572023241015E-01
+ -0.579660161659E-01 -0.587393142998E-01 -0.595223393307E-01 -0.603152136089E-01
+ -0.611180610319E-01 -0.619310070353E-01 -0.627541786473E-01 -0.635877044975E-01
+ -0.644317148165E-01 -0.652863414841E-01 -0.661517180489E-01 -0.670279797164E-01
+ -0.679152634029E-01 -0.688137077646E-01 -0.697234531716E-01 -0.706446417752E-01
+ -0.715774175210E-01 -0.725219261507E-01 -0.734783152514E-01 -0.744467342569E-01
+ -0.754273344859E-01 -0.764202691640E-01 -0.774256934361E-01 -0.784437644043E-01
+ -0.794746411440E-01 -0.805184847345E-01 -0.815754582751E-01 -0.826457269257E-01
+ -0.837294579182E-01 -0.848268205829E-01 -0.859379863927E-01 -0.870631289711E-01
+ -0.882024241189E-01 -0.893560498559E-01 -0.905241864446E-01 -0.917070164047E-01
+ -0.929047245601E-01 -0.941174980551E-01 -0.953455263880E-01 -0.965890014428E-01
+ -0.978481175190E-01 -0.991230713554E-01 -0.100414062166 -0.101721291677
+ -0.103044964142 -0.104385286392 -0.105742467857 -0.107116720601
+ -0.108508259356 -0.109917301553 -0.111344067359 -0.112788779718
+ -0.114251664364 -0.115732949879 -0.117232867724 -0.118751652261
+ -0.120289540809 -0.121846773670 -0.123423594164 -0.125020248676
+ -0.126636986694 -0.128274060836 -0.129931726898 -0.131610243904
+ -0.133309874125 -0.135030883138 -0.136773539855 -0.138538116574
+ -0.140324889020 -0.142134136382 -0.143966141363 -0.145821190224
+ -0.147699572823 -0.149601582667 -0.151527516953 -0.153477676618
+ -0.155452366385 -0.157451894806 -0.159476574321 -0.161526721294
+ -0.163602656072 -0.165704703031 -0.167833190624 -0.169988451442
+ -0.172170822257 -0.174380644073 -0.176618262189 -0.178884026248
+ -0.181178290285 -0.183501412794 -0.185853756777 -0.188235689802
+ -0.190647584062 -0.193089816428 -0.195562768517 -0.198066826746
+ -0.200602382384 -0.203169831636 -0.205769575681 -0.208402020745
+ -0.211067578170 -0.213766664467 -0.216499701389 -0.219267115993
+ -0.222069340710 -0.224906813409 -0.227779977466 -0.230689281841
+ -0.233635181133 -0.236618135664 -0.239638611549 -0.242697080760
+ -0.245794021214 -0.248929916835 -0.252105257636 -0.255320539793
+ -0.258576265727 -0.261872944176 -0.265211090279 -0.268591225658
+ -0.272013878492 -0.275479583609 -0.278988882562 -0.282542323719
+ -0.286140462347 -0.289783860693 -0.293473088085 -0.297208721009
+ -0.300991343202 -0.304821545748 -0.308699927166 -0.312627093503
+ -0.316603658431 -0.320630243345 -0.324707477455 -0.328835997886
+ -0.333016449780 -0.337249486396 -0.341535769211 -0.345875968022
+ -0.350270761056 -0.354720835069 -0.359226885462 -0.363789616381
+ -0.368409740831 -0.373087980790 -0.377825067318 -0.382621740672
+ -0.387478750424 -0.392396855575 -0.397376824679 -0.402419435956
+ -0.407525477417 -0.412695746992 -0.417931052647 -0.423232212514
+ -0.428600055021 -0.434035419016 -0.439539153905 -0.445112119781
+ -0.450755187556 -0.456469239104 -0.462255167394 -0.468113876631
+ -0.474046282396 -0.480053311795 -0.486135903595 -0.492295008378
+ -0.498531588688 -0.504846619181 -0.511241086776 -0.517715990812
+ -0.524272343204 -0.530911168601 -0.537633504546 -0.544440401637
+ -0.551332923696 -0.558312147932 -0.565379165107 -0.572535079713
+ -0.579781010144 -0.587118088863 -0.594547462591 -0.602070292478
+ -0.609687754289 -0.617401038585 -0.625211350913 -0.633119911994
+ -0.641127957909 -0.649236740302 -0.657447526568 -0.665761600054
+ -0.674180260263 -0.682704823052 -0.691336620843 -0.700077002830
+ -0.708927335190 -0.717889001296 -0.726963401938 -0.736151955536
+ -0.745456098370 -0.754877284798 -0.764416987488 -0.774076697649
+ -0.783857925261 -0.793762199317 -0.803791068058 -0.813946099219
+ -0.824228880274 -0.834641018683 -0.845184142145 -0.855859898858
+ -0.866669957768 -0.877616008839 -0.888699763316 -0.899922953990
+ -0.911287335474 -0.922794684477 -0.934446800082 -0.946245504029
+ -0.958192641000 -0.970290078910 -0.982539709198 -0.994943447128
+ -1.00750323208 -1.02022102788 -1.03309882305 -1.04613863121
+ -1.05934249131 -1.07271246799 -1.08625065191 -1.09995916004
+ -1.11384013605 -1.12789575060 -1.14212820169 -1.15653971503
+ -1.17113254436 -1.18590897181 -1.20087130827 -1.21602189374
+ -1.23136309773 -1.24689731956 -1.26262698883 -1.27855456572
+ -1.29468254144 -1.31101343856 -1.32754981148 -1.34429424674
+ -1.36124936353 -1.37841781401 -1.39580228377 -1.41340549226
+ -1.43123019319 -1.44927917499 -1.46755526122 -1.48606131103
+ -1.50480021960 -1.52377491862 -1.54298837671 -1.56244359991
+ -1.58214363216 -1.60209155574 -1.62229049181 -1.64274360084
+ -1.66345408315 -1.68442517938 -1.70566017102 -1.72716238093
+ -1.74893517381 -1.77098195680 -1.79330617994 -1.81591133678
+ -1.83880096487 -1.86197864632 -1.88544800839 -1.90921272404
+ -1.93327651247 -1.95764313977 -1.98231641942 -2.00730021297
+ -2.03259843055 -2.05821503156 -2.08415402522 -2.11041947125
+ -2.13701548042 -2.16394621526 -2.19121589066 -2.21882877454
+ -2.24678918847 -2.27510150839 -2.30377016523 -2.33279964561
+ -2.36219449251 -2.39195930599 -2.42209874385 -2.45261752239
+ -2.48352041704 -2.51481226317 -2.54649795676 -2.57858245513
+ -2.61107077773 -2.64396800682 -2.67727928828 -2.71100983235
+ -2.74516491436 -2.77974987556 -2.81477012387 -2.85023113464
+ -2.88613845149 -2.92249768705 -2.95931452380 -2.99659471486
+ -3.03434408477 -3.07256853034 -3.11127402146 -3.15046660190
+ -3.19015239012 -3.23033758014 -3.27102844232 -3.31223132420
+ -3.35395265134 -3.39619892813 -3.43897673860 -3.48229274727
+ -3.52615369999 -3.57056642468 -3.61553783223 -3.66107491724
+ -3.70718475887 -3.75387452160 -3.80115145602 -3.84902289961
+ -3.89749627750 -3.94657910322 -3.99627897942 -4.04660359857
+ -4.09756074372 -4.14915828910 -4.20140420081 -4.25430653743
+ -4.30787345064 -4.36211318576 -4.41703408229 -4.47264457443
+ -4.52895319148 -4.58596855831 -4.64369939568 -4.70215452060
+ -4.76134284654 -4.82127338365 -4.88195523888 -4.94339761608
+ -5.00560981595 -5.06860123594 -5.13238137012 -5.19695980886
+ -5.26234623850 -5.32855044080 -5.39558229245 -5.46345176427
+ -5.53216892037 -5.60174391722 -5.67218700244 -5.74350851357
+ -5.81571887652 -5.88882860401 -5.96284829366 -6.03778862595
+ -6.11366036196 -6.19047434088 -6.26824147720 -6.34697275777
+ -6.42667923841 -6.50737204039 -6.58906234645 -6.67176139659
+ -6.75548048344 -6.84023094728 -6.92602417066 -7.01287157255
+ -7.10078460213 -7.18977473204 -7.27985345110 -7.37103225661
+ -7.46332264597 -7.55673610778 -7.65128411229 -7.74697810119
+ -7.84382947672 -7.94184959003 -8.04104972877 -8.14144110388
+ -8.24303483549 -8.34584193797 -8.44987330398 -8.55513968756
+ -8.66165168615 -8.76941972151 -8.87845401948 -8.98876458858
+ -9.10036119721 -9.21325334967 -9.32745026063 -9.44296082824
+ -9.55979360564 -9.67795677085 -9.79745809501 -9.91830490883
+ -10.0405040671 -10.1640619115 -10.2889842311 -10.4152762207
+ -10.5429424374 -10.6719867543 -10.8024123122 -10.9342214684
+ -11.0674157431 -11.2019957626 -11.3379612006 -11.4753107151
+ -11.6140418834 -11.7541511328 -11.8956336683 -12.0384833969
+ -12.1826928478 -12.3282530887 -12.4751536383 -12.6233823737
+ -12.7729254350 -12.9237671233 -13.0758897953 -13.2292737522
+ -13.3838971238 -13.5397357468 -13.6967630379 -13.8549498604
+ -14.0142643859 -14.1746719488 -14.3361348950 -14.4986124236
+ -14.6620604224 -14.8264312966 -14.9916737897 -15.1577327989
+ -15.3245491821 -15.4920595587 -15.6601961039 -15.8288863351
+ -15.9980528940 -16.1676133205 -16.3374798236 -16.5075590457
+ -16.6777518250 -16.8479529542 -17.0180509386 -17.1879277548
+ -17.3574586122 -17.5265117185 -17.6949480532 -17.8626211518
+ -18.0293769033 -18.1950533652 -18.3594806002 -18.5224805389
+ -18.6838668726 -18.8434449819 -19.0010119052 -19.1563563523
+ -19.3092587683 -19.4594914511 -19.6068187279 -19.7509971931
+ -19.8917760111 -20.0288972847 -20.1620964917 -20.2911029867
+ -20.4156405889 -20.5354280999 -20.6501805261 -20.7596086741
+ -20.8634167301 -20.9613402127 -21.0529916789 -21.1383471424
+ -21.2176208595 -21.2902500204 -21.3556621754 -21.4136289534
+ -21.4638141758 -21.5059066008 -21.5395975708 -21.5645822234
+ -21.5805641612 -21.5872571321 -21.5843876781 -21.5716976529
+ -21.5489468144 -21.5159154623 -21.4724071231 -21.4182512754
+ -21.3533061122 -21.2774613301 -21.1906409327 -21.0928060347
+ -20.9839576483 -20.8641394288 -20.7334403573 -20.5919973308
+ -20.4399976303 -20.2776812323 -20.1053429292 -19.9233342198
+ -19.7320649316 -19.5320045313 -19.3236830889 -19.1076918512
+ -18.8846833750 -18.6553712101 -18.4205290730 -18.1809894781
+ -17.9376418294 -17.6914299248 -17.4433488662 -17.1944413769
+ -16.9457935157 -16.6985298020 -16.4538077636 -16.2128119287
+ -15.9767472885 -15.7468322620 -15.5242911925 -15.3103464103
+ -15.1062098857 -14.9130744935 -14.7321048943 -14.5644280216
+ -14.4111231410 -14.2732114212 -14.1516449208 -14.0472948665
+ -13.9609390558 -13.8932481917 -13.8447709307 -13.8159174183
+ -13.8069411040 -13.8179186774 -13.8487280642 -13.8990245689
+ -13.9682154663 -14.0554336256 -14.1595111034 -14.2789540622
+ -14.4119208516 -14.5562056316 -14.7092305167 -14.8680498921
+ -15.0293713266 -15.1895984108 -15.3449019308 -15.4913270746
+ -15.6249458643 -15.7420658373 -15.8395070994 -15.9149670708
+ -15.9674702785 -15.9979949694 -16.0101059503 -16.0109894380
+ -16.0098872132 -16.0088178249 -16.0078414807 -16.0069876789
+ -16.0061963147 -16.0054875513 -16.0048462399 -16.0042693984
+ -16.0037515085 -16.0032879100 -16.0028741195 -16.0025058936
+ -16.0021792033 -16.0018902285 -16.0016353580 -16.0014111939
+ -16.0012145560 -16.0010424862 -16.0007623617 -16.0005547138
+ -16.0004014734 -16.0002888936 -16.0002065673 -16.0001466542
+ -16.0001032750 -16.0000720402 -16.0000496871 -16.0000338000
+ -16.0000225979 -16.0000147727 -16.0000093673 -16.0000056847
+ -16.0000032193 -16.0000016059 -16.0000005825 -15.9999999619
+ -15.9999996116 -15.9999994386 -15.9999993782 -15.9999993860
+ -15.9999994324 -15.9999994976 -15.9999995692 -15.9999996396
+ -15.9999997045 -15.9999997618 -15.9999998109 -15.9999998519
+ -15.9999998854 -15.9999999124 -15.9999999337 -15.9999999504
+ -15.9999999632 -15.9999999730 -15.9999999804 -15.9999999859
+ -15.9999999899 -15.9999999929 -15.9999999950 -15.9999999965
+ -15.9999999976 -15.9999999984 -15.9999999989 -15.9999999993
+ -15.9999999995 -15.9999999997 -15.9999999998 -15.9999999999
+ -15.9999999999 -15.9999999999 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000
+ Up Pseudopotential follows (l on next line)
+ 3
+ -0.252941192202E-04 -0.509063992908E-04 -0.768408421895E-04 -0.103101500217E-03
+ -0.129692476662E-03 -0.156617926414E-03 -0.183882056632E-03 -0.211489127391E-03
+ -0.239443452351E-03 -0.267749399434E-03 -0.296411391500E-03 -0.325433907044E-03
+ -0.354821480894E-03 -0.384578704919E-03 -0.414710228743E-03 -0.445220760480E-03
+ -0.476115067462E-03 -0.507397976988E-03 -0.539074377076E-03 -0.571149217227E-03
+ -0.603627509201E-03 -0.636514327798E-03 -0.669814811649E-03 -0.703534164023E-03
+ -0.737677653637E-03 -0.772250615482E-03 -0.807258451651E-03 -0.842706632193E-03
+ -0.878600695956E-03 -0.914946251462E-03 -0.951748977778E-03 -0.989014625402E-03
+ -0.102674901717E-02 -0.106495804916E-02 -0.110364769161E-02 -0.114282398985E-02
+ -0.118249306526E-02 -0.122266111621E-02 -0.126333441905E-02 -0.130451932906E-02
+ -0.134622228146E-02 -0.138844979244E-02 -0.143120846011E-02 -0.147450496561E-02
+ -0.151834607412E-02 -0.156273863588E-02 -0.160768958733E-02 -0.165320595215E-02
+ -0.169929484236E-02 -0.174596345945E-02 -0.179321909547E-02 -0.184106913423E-02
+ -0.188952105238E-02 -0.193858242064E-02 -0.198826090495E-02 -0.203856426766E-02
+ -0.208950036880E-02 -0.214107716721E-02 -0.219330272189E-02 -0.224618519317E-02
+ -0.229973284407E-02 -0.235395404150E-02 -0.240885725764E-02 -0.246445107123E-02
+ -0.252074416892E-02 -0.257774534661E-02 -0.263546351085E-02 -0.269390768024E-02
+ -0.275308698678E-02 -0.281301067737E-02 -0.287368811520E-02 -0.293512878126E-02
+ -0.299734227575E-02 -0.306033831969E-02 -0.312412675631E-02 -0.318871755271E-02
+ -0.325412080131E-02 -0.332034672152E-02 -0.338740566126E-02 -0.345530809864E-02
+ -0.352406464354E-02 -0.359368603933E-02 -0.366418316448E-02 -0.373556703431E-02
+ -0.380784880270E-02 -0.388103976383E-02 -0.395515135392E-02 -0.403019515308E-02
+ -0.410618288704E-02 -0.418312642905E-02 -0.426103780168E-02 -0.433992917876E-02
+ -0.441981288722E-02 -0.450070140905E-02 -0.458260738326E-02 -0.466554360781E-02
+ -0.474952304166E-02 -0.483455880678E-02 -0.492066419016E-02 -0.500785264596E-02
+ -0.509613779756E-02 -0.518553343968E-02 -0.527605354057E-02 -0.536771224420E-02
+ -0.546052387242E-02 -0.555450292724E-02 -0.564966409308E-02 -0.574602223906E-02
+ -0.584359242135E-02 -0.594238988548E-02 -0.604243006876E-02 -0.614372860268E-02
+ -0.624630131534E-02 -0.635016423394E-02 -0.645533358727E-02 -0.656182580826E-02
+ -0.666965753654E-02 -0.677884562104E-02 -0.688940712262E-02 -0.700135931675E-02
+ -0.711471969618E-02 -0.722950597370E-02 -0.734573608492E-02 -0.746342819102E-02
+ -0.758260068165E-02 -0.770327217774E-02 -0.782546153447E-02 -0.794918784417E-02
+ -0.807447043935E-02 -0.820132889566E-02 -0.832978303499E-02 -0.845985292859E-02
+ -0.859155890013E-02 -0.872492152894E-02 -0.885996165322E-02 -0.899670037326E-02
+ -0.913515905478E-02 -0.927535933222E-02 -0.941732311218E-02 -0.956107257678E-02
+ -0.970663018719E-02 -0.985401868707E-02 -0.100032611062E-01 -0.101543807640E-01
+ -0.103074012733E-01 -0.104623465437E-01 -0.106192407859E-01 -0.107781085149E-01
+ -0.109389745541E-01 -0.111018640392E-01 -0.112668024219E-01 -0.114338154743E-01
+ -0.116029292925E-01 -0.117741703008E-01 -0.119475652562E-01 -0.121231412517E-01
+ -0.123009257217E-01 -0.124809464453E-01 -0.126632315511E-01 -0.128478095215E-01
+ -0.130347091972E-01 -0.132239597818E-01 -0.134155908460E-01 -0.136096323325E-01
+ -0.138061145608E-01 -0.140050682316E-01 -0.142065244319E-01 -0.144105146397E-01
+ -0.146170707287E-01 -0.148262249739E-01 -0.150380100561E-01 -0.152524590671E-01
+ -0.154696055150E-01 -0.156894833295E-01 -0.159121268669E-01 -0.161375709157E-01
+ -0.163658507021E-01 -0.165970018953E-01 -0.168310606132E-01 -0.170680634279E-01
+ -0.173080473716E-01 -0.175510499423E-01 -0.177971091098E-01 -0.180462633213E-01
+ -0.182985515077E-01 -0.185540130896E-01 -0.188126879834E-01 -0.190746166076E-01
+ -0.193398398891E-01 -0.196083992697E-01 -0.198803367124E-01 -0.201556947080E-01
+ -0.204345162817E-01 -0.207168450001E-01 -0.210027249777E-01 -0.212922008839E-01
+ -0.215853179498E-01 -0.218821219758E-01 -0.221826593380E-01 -0.224869769962E-01
+ -0.227951225006E-01 -0.231071439997E-01 -0.234230902476E-01 -0.237430106115E-01
+ -0.240669550798E-01 -0.243949742695E-01 -0.247271194344E-01 -0.250634424729E-01
+ -0.254039959362E-01 -0.257488330367E-01 -0.260980076559E-01 -0.264515743532E-01
+ -0.268095883742E-01 -0.271721056594E-01 -0.275391828529E-01 -0.279108773116E-01
+ -0.282872471135E-01 -0.286683510673E-01 -0.290542487213E-01 -0.294450003731E-01
+ -0.298406670785E-01 -0.302413106613E-01 -0.306469937232E-01 -0.310577796531E-01
+ -0.314737326372E-01 -0.318949176693E-01 -0.323214005605E-01 -0.327532479499E-01
+ -0.331905273147E-01 -0.336333069808E-01 -0.340816561338E-01 -0.345356448293E-01
+ -0.349953440041E-01 -0.354608254875E-01 -0.359321620121E-01 -0.364094272254E-01
+ -0.368926957015E-01 -0.373820429522E-01 -0.378775454393E-01 -0.383792805864E-01
+ -0.388873267909E-01 -0.394017634365E-01 -0.399226709052E-01 -0.404501305902E-01
+ -0.409842249085E-01 -0.415250373138E-01 -0.420726523096E-01 -0.426271554621E-01
+ -0.431886334141E-01 -0.437571738981E-01 -0.443328657501E-01 -0.449157989235E-01
+ -0.455060645035E-01 -0.461037547206E-01 -0.467089629658E-01 -0.473217838045E-01
+ -0.479423129918E-01 -0.485706474873E-01 -0.492068854702E-01 -0.498511263545E-01
+ -0.505034708048E-01 -0.511640207520E-01 -0.518328794090E-01 -0.525101512871E-01
+ -0.531959422122E-01 -0.538903593412E-01 -0.545935111792E-01 -0.553055075958E-01
+ -0.560264598429E-01 -0.567564805716E-01 -0.574956838500E-01 -0.582441851813E-01
+ -0.590021015212E-01 -0.597695512969E-01 -0.605466544249E-01 -0.613335323305E-01
+ -0.621303079661E-01 -0.629371058308E-01 -0.637540519896E-01 -0.645812740934E-01
+ -0.654189013988E-01 -0.662670647880E-01 -0.671258967900E-01 -0.679955316005E-01
+ -0.688761051034E-01 -0.697677548917E-01 -0.706706202893E-01 -0.715848423725E-01
+ -0.725105639923E-01 -0.734479297965E-01 -0.743970862526E-01 -0.753581816702E-01
+ -0.763313662246E-01 -0.773167919802E-01 -0.783146129141E-01 -0.793249849403E-01
+ -0.803480659342E-01 -0.813840157567E-01 -0.824329962799E-01 -0.834951714121E-01
+ -0.845707071232E-01 -0.856597714709E-01 -0.867625346270E-01 -0.878791689038E-01
+ -0.890098487810E-01 -0.901547509334E-01 -0.913140542579E-01 -0.924879399018E-01
+ -0.936765912913E-01 -0.948801941596E-01 -0.960989365766E-01 -0.973330089776E-01
+ -0.985826041936E-01 -0.998479174814E-01 -0.101129146554 -0.102426491610
+ -0.103740155369 -0.105070343100 -0.106417262651 -0.107781124488
+ -0.109162141725 -0.110560530153 -0.111976508281 -0.113410297365
+ -0.114862121446 -0.116332207381 -0.117820784882 -0.119328086550
+ -0.120854347913 -0.122399807462 -0.123964706686 -0.125549290114
+ -0.127153805350 -0.128778503114 -0.130423637277 -0.132089464908
+ -0.133776246305 -0.135484245045 -0.137213728018 -0.138964965472
+ -0.140738231055 -0.142533801856 -0.144351958453 -0.146192984951
+ -0.148057169029 -0.149944801986 -0.151856178785 -0.153791598100
+ -0.155751362363 -0.157735777809 -0.159745154527 -0.161779806506
+ -0.163840051686 -0.165926212006 -0.168038613455 -0.170177586124
+ -0.172343464257 -0.174536586300 -0.176757294961 -0.179005937256
+ -0.181282864570 -0.183588432706 -0.185923001944 -0.188286937097
+ -0.190680607568 -0.193104387407 -0.195558655370 -0.198043794977
+ -0.200560194576 -0.203108247399 -0.205688351625 -0.208300910443
+ -0.210946332116 -0.213625030043 -0.216337422822 -0.219083934321
+ -0.221864993740 -0.224681035677 -0.227532500202 -0.230419832918
+ -0.233343485038 -0.236303913449 -0.239301580791 -0.242336955520
+ -0.245410511991 -0.248522730525 -0.251674097488 -0.254865105365
+ -0.258096252838 -0.261368044864 -0.264680992755 -0.268035614256
+ -0.271432433627 -0.274871981726 -0.278354796090 -0.281881421021
+ -0.285452407669 -0.289068314124 -0.292729705493 -0.296437154000
+ -0.300191239066 -0.303992547407 -0.307841673121 -0.311739217783
+ -0.315685790540 -0.319682008204 -0.323728495349 -0.327825884413
+ -0.331974815790 -0.336175937938 -0.340429907472 -0.344737389276
+ -0.349099056599 -0.353515591167 -0.357987683284 -0.362516031946
+ -0.367101344945 -0.371744338984 -0.376445739788 -0.381206282216
+ -0.386026710379 -0.390907777755 -0.395850247307 -0.400854891604
+ -0.405922492939 -0.411053843458 -0.416249745275 -0.421511010606
+ -0.426838461892 -0.432232931931 -0.437695264003 -0.443226312010
+ -0.448826940604 -0.454498025326 -0.460240452739 -0.466055120575
+ -0.471942937867 -0.477904825098 -0.483941714342 -0.490054549414
+ -0.496244286012 -0.502511891874 -0.508858346926 -0.515284643436
+ -0.521791786171 -0.528380792556 -0.535052692831 -0.541808530213
+ -0.548649361063 -0.555576255050 -0.562590295320 -0.569692578663
+ -0.576884215692 -0.584166331010 -0.591540063393 -0.599006565967
+ -0.606567006389 -0.614222567028 -0.621974445160 -0.629823853145
+ -0.637772018626 -0.645820184720 -0.653969610212 -0.662221569756
+ -0.670577354075 -0.679038270161 -0.687605641487 -0.696280808212
+ -0.705065127391 -0.713959973193 -0.722966737113 -0.732086828195
+ -0.741321673254 -0.750672717100 -0.760141422764 -0.769729271734
+ -0.779437764186 -0.789268419220 -0.799222775100 -0.809302389499
+ -0.819508839746 -0.829843723069 -0.840308656856 -0.850905278903
+ -0.861635247679 -0.872500242584 -0.883501964217 -0.894642134644
+ -0.905922497672 -0.917344819123 -0.928910887114 -0.940622512342
+ -0.952481528368 -0.964489791908 -0.976649183131 -0.988961605951
+ -1.00142898833 -1.01405328260 -1.02683646572 -1.03978053968
+ -1.05288753172 -1.06615949472 -1.07959850750 -1.09320667515
+ -1.10698612936 -1.12093902878 -1.13506755934 -1.14937393459
+ -1.16386039609 -1.17852921373 -1.19338268610 -1.20842314085
+ -1.22365293508 -1.23907445570 -1.25469011980 -1.27050237504
+ -1.28651370006 -1.30272660482 -1.31914363107 -1.33576735270
+ -1.35260037616 -1.36964534087 -1.38690491967 -1.40438181919
+ -1.42207878033 -1.43999857867 -1.45814402490 -1.47651796526
+ -1.49512328205 -1.51396289401 -1.53303975680 -1.55235686350
+ -1.57191724505 -1.59172397074 -1.61178014868 -1.63208892630
+ -1.65265349084 -1.67347706985 -1.69456293171 -1.71591438609
+ -1.73753478454 -1.75942752093 -1.78159603207 -1.80404379815
+ -1.82677434334 -1.84979123632 -1.87309809081 -1.89669856614
+ -1.92059636783 -1.94479524810 -1.96929900649 -1.99411149043
+ -2.01923659579 -2.04467826749 -2.07044050009 -2.09652733836
+ -2.12294287793 -2.14969126581 -2.17677670110 -2.20420343549
+ -2.23197577399 -2.26009807543 -2.28857475317 -2.31741027568
+ -2.34660916716 -2.37617600821 -2.40611543641 -2.43643214695
+ -2.46713089329 -2.49821648779 -2.52969380229 -2.56156776879
+ -2.59384338004 -2.62652569020 -2.65961981541 -2.69313093443
+ -2.72706428927 -2.76142518576 -2.79621899414 -2.83145114969
+ -2.86712715328 -2.90325257193 -2.93983303938 -2.97687425665
+ -3.01438199252 -3.05236208407 -3.09082043720 -3.12976302704
+ -3.16919589845 -3.20912516643 -3.24955701653 -3.29049770520
+ -3.33195356015 -3.37393098066 -3.41643643784 -3.45947647486
+ -3.50305770718 -3.54718682261 -3.59187058151 -3.63711581676
+ -3.68292943376 -3.72931841038 -3.77628979680 -3.82385071533
+ -3.87200836009 -3.92076999667 -3.97014296172 -4.02013466235
+ -4.07075257556 -4.12200424749 -4.17389729257 -4.22643939260
+ -4.27963829567 -4.33350181492 -4.38803782728 -4.44325427191
+ -4.49915914862 -4.55576051607 -4.61306648978 -4.67108523999
+ -4.72982498936 -4.78929401038 -4.84950062265 -4.91045318989
+ -4.97216011674 -5.03462984528 -5.09787085131 -5.16189164034
+ -5.22670074331 -5.29230671194 -5.35871811382 -5.42594352713
+ -5.49399153497 -5.56287071936 -5.63258965475 -5.70315690123
+ -5.77458099716 -5.84687045138 -5.92003373492 -5.99407927216
+ -6.06901543145 -6.14485051508 -6.22159274865 -6.29925026980
+ -6.37783111616 -6.45734321259 -6.53779435760 -6.61919220891
+ -6.70154426815 -6.78485786451 -6.86914013743 -6.95439801817
+ -7.04063821022 -7.12786716843 -7.21609107689 -7.30531582526
+ -7.39554698371 -7.48678977618 -7.57904905187 -7.67232925495
+ -7.76663439225 -7.86196799879 -7.95833310117 -8.05573217836
+ -8.15416712012 -8.25363918251 -8.35414894059 -8.45569623798
+ -8.55828013317 -8.66189884235 -8.76654967870 -8.87222898782
+ -8.97893207923 -9.08665315391 -9.19538522760 -9.30512004992
+ -9.41584801938 -9.52755809419 -9.64023769915 -9.75387262887
+ -9.86844694759 -9.98394288636 -10.1003407380 -10.2176187507
+ -10.3357530218 -10.4547173926 -10.5744833454 -10.6950199055
+ -10.8162935495 -10.9382681222 -11.0609047645 -11.1841618554
+ -11.3079949706 -11.4323568594 -11.5571974447 -11.6824638469
+ -11.8081004349 -11.9340489047 -12.0602483885 -12.1866355939
+ -12.3131449715 -12.4397089117 -12.5662579667 -12.6927210915
+ -12.8190259294 -12.9450989265 -13.0708663176 -13.1962527987
+ -13.3211778929 -13.4456035600 -13.5693347098 -13.6926450848
+ -13.8160918227 -13.9392292185 -14.0616165736 -14.1832516227
+ -14.3039882323 -14.4237052592 -14.5422752939 -14.6595642430
+ -14.7754348579 -14.8897464435 -15.0023556609 -15.1131170599
+ -15.2218836032 -15.3285071539 -15.4328389360 -15.5347299745
+ -15.6340315231 -15.7305954847 -15.8242748318 -15.9149240329
+ -16.0023994878 -16.0865599797 -16.1672671446 -16.2443859657
+ -16.3177852931 -16.3873383939 -16.4529235361 -16.5144246077
+ -16.5717317770 -16.6247421925 -16.6733607326 -16.7175008047
+ -16.7570851858 -16.7920469369 -16.8223303687 -16.8478920594
+ -16.8687019575 -16.8847445415 -16.8960200478 -16.9025457716
+ -16.9043574304 -16.9015105882 -16.8940821294 -16.8821717681
+ -16.8659035739 -16.8454274866 -16.8209207860 -16.7925894772
+ -16.7606695376 -16.7254279692 -16.6871635841 -16.6462074466
+ -16.6029228819 -16.5577049544 -16.5109793098 -16.4632002675
+ -16.4148480451 -16.3664249949 -16.3184507319 -16.2714560423
+ -16.2259754748 -16.1825385434 -16.1416595069 -16.1038257474
+ -16.0694848413 -16.0390305129 -16.0127877760 -15.9909977041
+ -15.9738024217 -15.9612310662 -15.9531876231 -15.9494416774
+ -15.9496232418 -15.9532229256 -15.9595988161 -15.9679916126
+ -15.9775498371 -15.9873675533 -15.9965370541 -16.0042247578
+ -16.0097574286 -16.0127920495 -16.0133993738 -16.0124092103
+ -16.0112484929 -16.0101099843 -16.0090535970 -16.0081083861
+ -16.0072198119 -16.0064090410 -16.0056639531 -16.0049838108
+ -16.0043652543 -16.0038054416 -16.0033013627 -16.0028498870
+ -16.0024477486 -16.0020915680 -16.0017778896 -16.0015032285
+ -16.0012641204 -16.0010571695 -16.0007511183 -16.0005295126
+ -16.0003702996 -16.0002568184 -16.0001765870 -16.0001203334
+ -16.0000812281 -16.0000542836 -16.0000358887 -16.0000234515
+ -16.0000151281 -16.0000096182 -16.0000060138 -16.0000036863
+ -16.0000022049 -16.0000012777 -16.0000007086 -16.0000003676
+ -16.0000001695 -16.0000000592 -16.0000000015 -15.9999999744
+ -15.9999999645 -15.9999999637 -15.9999999671 -15.9999999721
+ -15.9999999774 -15.9999999822 -15.9999999863 -15.9999999896
+ -15.9999999923 -15.9999999943 -15.9999999959 -15.9999999970
+ -15.9999999979 -15.9999999985 -15.9999999990 -15.9999999993
+ -15.9999999995 -15.9999999997 -15.9999999998 -15.9999999999
+ -15.9999999999 -15.9999999999 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000 -16.0000000000
+ -16.0000000000 -16.0000000000 -16.0000000000
+ Core charge follows
+ 0.706664436794E-10 0.286232453130E-09 0.652166288522E-09 0.117409728229E-08
+ 0.185782020149E-08 0.270929972422E-08 0.373467503292E-08 0.494026452770E-08
+ 0.633257066261E-08 0.791828490823E-08 0.970429284362E-08 0.116976793810E-07
+ 0.139057341267E-07 0.163359568819E-07 0.189960632859E-07 0.218939906077E-07
+ 0.250379036868E-07 0.284362010297E-07 0.320975210640E-07 0.360307485562E-07
+ 0.402450211951E-07 0.447497363469E-07 0.495545579862E-07 0.546694238055E-07
+ 0.601045525107E-07 0.658704513052E-07 0.719779235681E-07 0.784380767316E-07
+ 0.852623303626E-07 0.924624244538E-07 0.100050427929E-06 0.108038747371E-06
+ 0.116440135971E-06 0.125267702714E-06 0.134534921798E-06 0.144255642304E-06
+ 0.154444098105E-06 0.165114918042E-06 0.176283136355E-06 0.187964203388E-06
+ 0.200173996571E-06 0.212928831682E-06 0.226245474403E-06 0.240141152170E-06
+ 0.254633566338E-06 0.269740904648E-06 0.285481854025E-06 0.301875613699E-06
+ 0.318941908672E-06 0.336701003524E-06 0.355173716582E-06 0.374381434447E-06
+ 0.394346126901E-06 0.415090362196E-06 0.436637322737E-06 0.459010821165E-06
+ 0.482235316862E-06 0.506335932868E-06 0.531338473252E-06 0.557269440907E-06
+ 0.584156055825E-06 0.612026273821E-06 0.640908805758E-06 0.670833137249E-06
+ 0.701829548878E-06 0.733929136932E-06 0.767163834672E-06 0.801566434142E-06
+ 0.837170608549E-06 0.874010935208E-06 0.912122919080E-06 0.951543016913E-06
+ 0.992308662006E-06 0.103445828960E-05 0.107803136293E-05 0.112306839994E-05
+ 0.116961100068E-05 0.121770187542E-05 0.126738487344E-05 0.131870501266E-05
+ 0.137170850987E-05 0.142644281191E-05 0.148295662750E-05 0.154129996000E-05
+ 0.160152414090E-05 0.166368186430E-05 0.172782722212E-05 0.179401574035E-05
+ 0.186230441615E-05 0.193275175589E-05 0.200541781422E-05 0.208036423412E-05
+ 0.215765428793E-05 0.223735291947E-05 0.231952678726E-05 0.240424430879E-05
+ 0.249157570595E-05 0.258159305165E-05 0.267437031753E-05 0.276998342304E-05
+ 0.286851028566E-05 0.297003087242E-05 0.307462725278E-05 0.318238365284E-05
+ 0.329338651090E-05 0.340772453448E-05 0.352548875882E-05 0.364677260678E-05
+ 0.377167195036E-05 0.390028517377E-05 0.403271323807E-05 0.416905974751E-05
+ 0.430943101751E-05 0.445393614447E-05 0.460268707721E-05 0.475579869040E-05
+ 0.491338885972E-05 0.507557853905E-05 0.524249183956E-05 0.541425611080E-05
+ 0.559100202397E-05 0.577286365716E-05 0.595997858291E-05 0.615248795786E-05
+ 0.635053661482E-05 0.655427315710E-05 0.676385005526E-05 0.697942374636E-05
+ 0.720115473568E-05 0.742920770109E-05 0.766375160007E-05 0.790495977938E-05
+ 0.815301008768E-05 0.840808499083E-05 0.867037169027E-05 0.894006224438E-05
+ 0.921735369286E-05 0.950244818440E-05 0.979555310748E-05 0.100968812246E-04
+ 0.104066508098E-04 0.107250857900E-04 0.110524158892E-04 0.113888767776E-04
+ 0.117347102229E-04 0.120901642471E-04 0.124554932861E-04 0.128309583536E-04
+ 0.132168272100E-04 0.136133745341E-04 0.140208821007E-04 0.144396389617E-04
+ 0.148699416319E-04 0.153120942805E-04 0.157664089260E-04 0.162332056370E-04
+ 0.167128127380E-04 0.172055670203E-04 0.177118139582E-04 0.182319079310E-04
+ 0.187662124501E-04 0.193151003923E-04 0.198789542393E-04 0.204581663223E-04
+ 0.210531390742E-04 0.216642852866E-04 0.222920283750E-04 0.229368026493E-04
+ 0.235990535921E-04 0.242792381439E-04 0.249778249950E-04 0.256952948857E-04
+ 0.264321409134E-04 0.271888688479E-04 0.279659974543E-04 0.287640588250E-04
+ 0.295835987189E-04 0.304251769100E-04 0.312893675450E-04 0.321767595092E-04
+ 0.330879568027E-04 0.340235789253E-04 0.349842612714E-04 0.359706555353E-04
+ 0.369834301266E-04 0.380232705958E-04 0.390908800709E-04 0.401869797058E-04
+ 0.413123091388E-04 0.424676269636E-04 0.436537112123E-04 0.448713598500E-04
+ 0.461213912829E-04 0.474046448783E-04 0.487219814987E-04 0.500742840485E-04
+ 0.514624580359E-04 0.528874321475E-04 0.543501588388E-04 0.558516149390E-04
+ 0.573928022711E-04 0.589747482883E-04 0.605985067262E-04 0.622651582710E-04
+ 0.639758112460E-04 0.657316023141E-04 0.675336971991E-04 0.693832914249E-04
+ 0.712816110735E-04 0.732299135622E-04 0.752294884406E-04 0.772816582079E-04
+ 0.793877791508E-04 0.815492422025E-04 0.837674738241E-04 0.860439369074E-04
+ 0.883801317016E-04 0.907775967630E-04 0.932379099285E-04 0.957626893147E-04
+ 0.983535943413E-04 0.101012326781E-03 0.103740631837E-03 0.106540299244E-03
+ 0.109413164404E-03 0.112361109544E-03 0.115386064905E-03 0.118490009967E-03
+ 0.121674974694E-03 0.124943040820E-03 0.128296343164E-03 0.131737070980E-03
+ 0.135267469336E-03 0.138889840535E-03 0.142606545569E-03 0.146420005607E-03
+ 0.150332703527E-03 0.154347185482E-03 0.158466062505E-03 0.162692012160E-03
+ 0.167027780229E-03 0.171476182445E-03 0.176040106271E-03 0.180722512716E-03
+ 0.185526438208E-03 0.190454996505E-03 0.195511380662E-03 0.200698865038E-03
+ 0.206020807367E-03 0.211480650873E-03 0.217081926435E-03 0.222828254819E-03
+ 0.228723348956E-03 0.234771016281E-03 0.240975161134E-03 0.247339787218E-03
+ 0.253869000121E-03 0.260567009900E-03 0.267438133737E-03 0.274486798654E-03
+ 0.281717544299E-03 0.289135025807E-03 0.296744016731E-03 0.304549412042E-03
+ 0.312556231215E-03 0.320769621385E-03 0.329194860587E-03 0.337837361076E-03
+ 0.346702672734E-03 0.355796486560E-03 0.365124638250E-03 0.374693111866E-03
+ 0.384508043605E-03 0.394575725652E-03 0.404902610139E-03 0.415495313203E-03
+ 0.426360619144E-03 0.437505484693E-03 0.448937043381E-03 0.460662610025E-03
+ 0.472689685327E-03 0.485025960586E-03 0.497679322533E-03 0.510657858285E-03
+ 0.523969860427E-03 0.537623832225E-03 0.551628492963E-03 0.565992783424E-03
+ 0.580725871507E-03 0.595837157980E-03 0.611336282390E-03 0.627233129116E-03
+ 0.643537833571E-03 0.660260788574E-03 0.677412650868E-03 0.695004347816E-03
+ 0.713047084258E-03 0.731552349548E-03 0.750531924762E-03 0.769997890097E-03
+ 0.789962632449E-03 0.810438853188E-03 0.831439576131E-03 0.852978155711E-03
+ 0.875068285359E-03 0.897724006096E-03 0.920959715337E-03 0.944790175931E-03
+ 0.969230525417E-03 0.994296285517E-03 0.102000337188E-02 0.104636810405E-02
+ 0.107340721573E-02 0.110113786522E-02 0.112957764625E-02 0.115874459896E-02
+ 0.118865722121E-02 0.121933448021E-02 0.125079582440E-02 0.128306119561E-02
+ 0.131615104161E-02 0.135008632890E-02 0.138488855583E-02 0.142057976614E-02
+ 0.145718256270E-02 0.149472012172E-02 0.153321620726E-02 0.157269518611E-02
+ 0.161318204309E-02 0.165470239667E-02 0.169728251502E-02 0.174094933249E-02
+ 0.178573046647E-02 0.183165423468E-02 0.187874967292E-02 0.192704655323E-02
+ 0.197657540259E-02 0.202736752196E-02 0.207945500595E-02 0.213287076288E-02
+ 0.218764853538E-02 0.224382292154E-02 0.230142939655E-02 0.236050433492E-02
+ 0.242108503324E-02 0.248320973352E-02 0.254691764714E-02 0.261224897939E-02
+ 0.267924495463E-02 0.274794784205E-02 0.281840098218E-02 0.289064881398E-02
+ 0.296473690262E-02 0.304071196803E-02 0.311862191410E-02 0.319851585865E-02
+ 0.328044416414E-02 0.336445846921E-02 0.345061172093E-02 0.353895820793E-02
+ 0.362955359435E-02 0.372245495465E-02 0.381772080929E-02 0.391541116129E-02
+ 0.401558753381E-02 0.411831300853E-02 0.422365226513E-02 0.433167162169E-02
+ 0.444243907617E-02 0.455602434885E-02 0.467249892594E-02 0.479193610425E-02
+ 0.491441103694E-02 0.504000078052E-02 0.516878434295E-02 0.530084273300E-02
+ 0.543625901086E-02 0.557511833999E-02 0.571750804033E-02 0.586351764278E-02
+ 0.601323894515E-02 0.616676606944E-02 0.632419552057E-02 0.648562624670E-02
+ 0.665115970087E-02 0.682089990443E-02 0.699495351186E-02 0.717342987737E-02
+ 0.735644112307E-02 0.754410220899E-02 0.773653100472E-02 0.793384836293E-02
+ 0.813617819478E-02 0.834364754712E-02 0.855638668177E-02 0.877452915664E-02
+ 0.899821190906E-02 0.922757534108E-02 0.946276340697E-02 0.970392370292E-02
+ 0.995120755900E-02 0.102047701334E-01 0.104647705092E-01 0.107313717931E-01
+ 0.110047412175E-01 0.112850502440E-01 0.115724746708E-01 0.118671947416E-01
+ 0.121693952579E-01 0.124792656940E-01 0.127970003152E-01 0.131227982980E-01
+ 0.134568638544E-01 0.137994063588E-01 0.141506404781E-01 0.145107863054E-01
+ 0.148800694962E-01 0.152587214091E-01 0.156469792495E-01 0.160450862168E-01
+ 0.164532916552E-01 0.168718512091E-01 0.173010269812E-01 0.177410876955E-01
+ 0.181923088637E-01 0.186549729567E-01 0.191293695791E-01 0.196157956492E-01
+ 0.201145555828E-01 0.206259614823E-01 0.211503333293E-01 0.216879991836E-01
+ 0.222392953858E-01 0.228045667659E-01 0.233841668562E-01 0.239784581107E-01
+ 0.245878121288E-01 0.252126098853E-01 0.258532419660E-01 0.265101088085E-01
+ 0.271836209506E-01 0.278741992827E-01 0.285822753087E-01 0.293082914113E-01
+ 0.300527011258E-01 0.308159694193E-01 0.315985729773E-01 0.324010004980E-01
+ 0.332237529927E-01 0.340673440944E-01 0.349323003744E-01 0.358191616660E-01
+ 0.367284813960E-01 0.376608269260E-01 0.386167798997E-01 0.395969366012E-01
+ 0.406019083204E-01 0.416323217281E-01 0.426888192608E-01 0.437720595135E-01
+ 0.448827176442E-01 0.460214857866E-01 0.471890734737E-01 0.483862080719E-01
+ 0.496136352256E-01 0.508721193123E-01 0.521624439097E-01 0.534854122733E-01
+ 0.548418478264E-01 0.562325946616E-01 0.576585180549E-01 0.591205049921E-01
+ 0.606194647076E-01 0.621563292377E-01 0.637320539854E-01 0.653476183007E-01
+ 0.670040260737E-01 0.687023063426E-01 0.704435139167E-01 0.722287300136E-01
+ 0.740590629125E-01 0.759356486231E-01 0.778596515703E-01 0.798322652955E-01
+ 0.818547131750E-01 0.839282491550E-01 0.860541585047E-01 0.882337585876E-01
+ 0.904683996499E-01 0.927594656295E-01 0.951083749827E-01 0.975165815310E-01
+ 0.999855753287E-01 0.102516883549 0.105112071395 0.107772743025
+ 0.110500542508 0.113297154795 0.116164306719 0.119103768010
+ 0.122117352342 0.125206918397 0.128374370965 0.131621662053
+ 0.134950792033 0.138363810811 0.141862819023 0.145449969260
+ 0.149127467316 0.152897573473 0.156762603806 0.160724931523
+ 0.164786988333 0.168951265846 0.173220317000 0.177596757528
+ 0.182083267447 0.186682592588 0.191397546157 0.196231010326
+ 0.201185937867 0.206265353812 0.211472357155 0.216810122590
+ 0.222281902279 0.227891027668 0.233640911334 0.239535048872
+ 0.245577020818 0.251770494621 0.258119226646 0.264627064221
+ 0.271297947723 0.278135912710 0.285145092095 0.292329718354
+ 0.299694125787 0.307242752820 0.314980144348 0.322910954121
+ 0.331039947181 0.339372002338 0.347912114691 0.356665398200
+ 0.365637088294 0.374832544533 0.384257253311 0.393916830606
+ 0.403817024772 0.413963719384 0.424362936118 0.435020837686
+ 0.445943730806 0.457138069222 0.468610456766 0.480367650464
+ 0.492416563678 0.504764269299 0.517418002971 0.530385166359
+ 0.543673330453 0.557290238909 0.571243811425 0.585542147144
+ 0.600193528102 0.615206422685 0.630589489133 0.646351579046
+ 0.662501740933 0.679049223760 0.696003480524 0.713374171831
+ 0.731171169484 0.749404560070 0.768084648550 0.787221961834
+ 0.806827252347 0.826911501577 0.847485923592 0.868561968534
+ 0.890151326059 0.912265928749 0.934917955446 0.958119834536
+ 0.981884247156 1.00622413031 1.03115267988 1.05668335357
+ 1.08282987366 1.10960622970 1.13702668098 1.16510575890
+ 1.19385826913 1.22329929354 1.25344419200 1.28430860381
+ 1.31590844902 1.34825992934 1.38137952882 1.41528401416
+ 1.44999043470 1.48551612196 1.52187868882 1.55909602823
+ 1.59718631141 1.63616798555 1.67605977094 1.71688065750
+ 1.75864990067 1.80138701658 1.84511177647 1.88984420039
+ 1.93560454993 1.98241332014 2.03029123043 2.07925921443
+ 2.12933840878 2.18055014069 2.23291591427 2.28645739553
+ 2.34119639596 2.39715485453 2.45435481817 2.51281842046
+ 2.57256785857 2.63362536822 2.69601319657 2.75975357304
+ 2.82486867769 2.89138060728 2.95931133867 3.02868268950
+ 3.09951627602 3.17183346778 3.24565533918 3.32100261752
+ 3.39789562749 3.47635423189 3.55639776824 3.63804498129
+ 3.72131395095 3.80622201565 3.89278569074 3.98102058164
+ 4.07094129170 4.16256132421 4.25589297855 4.35094723996
+ 4.44773366290 4.54626024741 4.64653330839 4.74855733743
+ 4.85233485675 4.95786626520 5.06514967567 5.17418074387
+ 5.28495248802 5.39745509916 5.51167574175 5.62759834440
+ 5.74520338018 5.86446763654 5.98536397439 6.10786107617
+ 6.23192318280 6.35750981922 6.48457550850 6.61306947450
+ 6.74293533296 6.87411077123 7.00652721664 7.14010949390
+ 7.27477547183 7.41043569976 7.54699303434 7.68434225753
+ 7.82236968639 7.96095277612 8.09995971735 8.23924902934
+ 8.37866915077 8.51805803015 8.65724271819 8.79603896479
+ 8.93425082358 9.07167026740 9.20807681854 9.34323719798
+ 9.47690499822 9.60882038506 9.73870983392 9.86628590717
+ 9.99124707916 10.1132776167 10.2320475232 10.3472125545
+ 10.4584143175 10.5652804599 10.6674249631 10.7644485495
+ 10.8559392162 10.9414729070 11.0206143378 11.0929179867
+ 11.1579292645 11.2151858787 11.2642194051 11.3045570814
+ 11.3357238355 11.3572445620 11.3686466577 11.3694628262
+ 11.3592801146 11.3378954419 11.3052043050 11.2611575719
+ 11.2057601675 11.1390695067 11.0611936915 10.9722894905
+ 10.8725601189 10.7622528403 10.6416564092 10.5110983755
+ 10.3709422721 10.2215847053 10.0634523701 9.89699901008
+ 9.72270234172 9.54106096286 9.35259126402 9.15782436042
+ 8.95730306186 8.75157889647 8.54120920357 8.32675430946
+ 8.10877479920 7.88782889596 7.66446995846 7.43924410593
+ 7.21268797855 6.98532664039 6.75767163064 6.53021916734
+ 6.30344850818 6.07782046874 5.85377610118 5.63173553381
+ 5.41209696885 5.19523583896 4.98150411904 4.77122979022
+ 4.56471645213 4.36224307857 4.16406391144 3.97040848682
+ 3.78148178691 3.59746451087 3.41851345713 3.24476200966
+ 3.07632072019 2.91327797808 2.75570075959 2.60363544800
+ 2.45710871608 2.31612846230 2.18068479242 2.05075103791
+ 1.92628480334 1.80722903446 1.69351309956 1.58505387668
+ 1.48175683971 1.38351713688 1.29022065548 1.20174506721
+ 1.11796084899 1.03873227448 0.963918372293 0.893373847115
+ 0.826949960710 0.764495370132 0.705856921099 0.650880394935
+ 0.599411208039 0.551295063290 0.506378553306 0.464509715872
+ 0.425538542248 0.389317439363 0.355701647155 0.324549612450
+ 0.295723320865 0.269088588207 0.244515312802 0.221877690117
+ 0.201054390972 0.181928704587 0.164388647719 0.148327041228
+ 0.133641555504 0.120234726365 0.108013943241 0.968914116463E-01
+ 0.867840921115E-01 0.776136179216E-01 0.693061940619E-01 0.617924798331E-01
+ 0.550074575664E-01 0.488902897943E-01 0.433841671212E-01 0.384361488855E-01
+ 0.339969985399E-01 0.300210154954E-01 0.264658649923E-01 0.232924073862E-01
+ 0.204645280659E-01 0.179489690649E-01 0.157151632809E-01 0.137350720875E-01
+ 0.119830270043E-01 0.104355759791E-01 0.907133474475E-02 0.787084362157E-02
+ 0.681643005804E-02 0.589207713229E-02 0.508329817054E-02 0.437701758110E-02
+ 0.376145794947E-02 0.322603339245E-02 0.276124912674E-02 0.235860716941E-02
+ 0.201051805438E-02 0.171021841965E-02 0.145169429511E-02 0.122960989930E-02
+ 0.103924173600E-02 0.876417767638E-03 0.737461431163E-03 0.619140254814E-03
+ 0.518618828758E-03 0.433415880377E-03 0.361365204820E-03 0.300580203386E-03
+ 0.249421786176E-03 0.206469400854E-03 0.170494956167E-03 0.140439416855E-03
+ 0.115391855473E-03 0.945707563091E-04 0.773073768046E-04 0.630309824754E-04
+ 0.512557821974E-04 0.415694016459E-04 0.336227436055E-04 0.271210946493E-04
+ 0.218163482494E-04 0.175002246372E-04 0.139983776282E-04 0.111652880987E-04
+ 0.887985282248E-05 0.704158590727E-05 0.556735809681E-05 0.438860671578E-05
+ 0.344895602354E-05 0.270219421507E-05 0.211055927094E-05 0.164329132476E-05
+ 0.127541420546E-05 0.986713341073E-06 0.760881304489E-06 0.584805964217E-06
+ 0.447979499882E-06 0.342009480319E-06 0.260215808184E-06 0.197299635956E-06
+ 0.149072380395E-06 0.112234731531E-06 0.841970927055E-07 0.629342234307E-07
+ 0.468680089120E-07 0.347732695860E-07 0.257023700181E-07 0.189251064864E-07
+ 0.138809625338E-07 0.101413361523E-07 0.737977406809E-08 0.534860942613E-08
+ 0.386069931547E-08 0.277520709558E-08 0.198657931446E-08 0.141603505550E-08
+ 0.100502278080E-08 0.710211286263E-09 0.499671633490E-09 0.349979599047E-09
+ 0.244026432120E-09 0.169372177528E-09 0.117012711299E-09 0.804607829451E-10
+ 0.550642763197E-10 0.375028330220E-10 0.254179442190E-10 0.171424336364E-10
+ 0.115035926751E-10 0.768062361120E-11 0.510192638525E-11 0.337146843547E-11
+ 0.221627391003E-11 0.144916935908E-11 0.942492474665E-12 0.609636636093E-12
+ 0.392165808366E-12 0.250867658115E-12 0.159575558766E-12 0.100926443212E-12
+ 0.634644145469E-13 0.396745294170E-13 0.246557729528E-13 0.152306897638E-13
+ 0.935153816582E-14 0.570659566874E-14 0.346074333059E-14 0.208558161007E-14
+ 0.124887039869E-14 0.743030101587E-15 0.439197996595E-15 0.257896131158E-15
+ 0.150426736836E-15 0.871496662842E-16 0.501454133101E-16 0.286540057843E-16
+ 0.162589127047E-16 0.916036103453E-17 0.512402272334E-17 0.284543590283E-17
+ 0.156851007121E-17 0.858197995686E-18 0.466025607410E-18 0.251138945738E-18
+ 0.134294962494E-18 0.712533978430E-19 0.375067923124E-19 0.195853116821E-19
+ 0.101443550363E-19 0.521132769489E-20 0.265496216955E-20 0.134125001243E-20
+ 0.671826963446E-21 0.333622743668E-21 0.164232092477E-21 0.801341379938E-22
+ 0.387513343889E-22 0.185702200450E-22 0.881779171493E-23 0.414825524221E-23
+ 0.193323096350E-23 0.892408648240E-24 0.407994205594E-24 0.184715002620E-24
+ 0.828047696534E-25 0.367502160405E-25 0.161458695076E-25 0.702109571853E-26
+ 0.302158243113E-26 0.128674810816E-26 0.542156738578E-27 0.225980175959E-27
+ 0.931689383209E-28 0.379898566265E-28 0.153179080717E-28 0.610668269948E-29
+ 0.240670758632E-29 0.937541611648E-30 0.360946941208E-30 0.137314788011E-30
+ 0.516115728534E-31 0.191631317334E-31 0.702762426781E-32 0.254510196698E-32
+ 0.910098136906E-33 0.321283657412E-33 0.111953050250E-33 0.384997960635E-34
+ 0.130642203244E-34 0.437358487255E-35 0.144426236012E-35 0.470363498253E-36
+ 0.151051016857E-36 0.478232150159E-37 0.149245248052E-37 0.459017691215E-38
+ 0.139105731407E-38 0.415303695033E-39 0.122126292484E-39 0.353664552507E-40
+ 0.100838918251E-40 0.283030556907E-41 0.781843979518E-42 0.212520338461E-42
+ 0.568310160280E-43 0.149480524194E-43 0.386639906430E-44 0.983238911547E-45
+ 0.245780838830E-45 0.603779904396E-46 0.145731970990E-46 0.345524819769E-47
+ 0.804550550707E-48 0.183940480306E-48 0.412809949866E-49 0.909221226358E-50
+ 0.196486167970E-50 0.416516837040E-51 0.865894865331E-52 0.176490911795E-52
+ 0.352610588697E-53 0.690357564326E-54 0.132418035096E-54 0.248772136799E-55
+ 0.457639768144E-56 0.824133776794E-57 0.145246858771E-57 0.250456682037E-58
+ 0.422430931432E-59 0.696714731529E-60 0.112333179848E-60 0.177007254638E-61
+ 0.272507715656E-62 0.409774209237E-63 0.601672915972E-64 0.862376383838E-65
+ 0.120620995714E-65 0.164591089657E-66 0.219034925543E-67 0.284190087562E-68
+ 0.359382108146E-69 0.442810599802E-70 0.531440025435E-71 0.621047025556E-72
+ 0.706458389400E-73 0.781982613356E-74 0.841998266668E-75 0.881622630314E-76
+ 0.897354843074E-77 0.887578664109E-78 0.852826297341E-79 0.795745258870E-80
+ 0.720766676867E-81 0.633532214427E-82 0.540183206515E-83 0.446638001418E-84
+ 0.357977059052E-85 0.278023345547E-86 0.209157974387E-87 0.152361135472E-88
+ 0.107428401046E-89 0.732903398546E-91 0.483608289503E-92 0.308528943692E-93
+ 0.190234043540E-94 0.113319570232E-95 0.651897666474E-97 0.362030001126E-98
+ 0.194013745286E-99 0.100293974871-100 0.499922497439-102 0.240185418300-103
+ 0.111182627828-104 0.495682339620-106 0.212753032433-107 0.878786207034-109
+ 0.349184578463-110 0.133419808156-111 0.490013493443-113 0.172920821570-114
+ 0.586093891151-116 0.190720344227-117 0.595615843405-119 0.178445082886-120
+ 0.512674962566-122 0.141191726619-123 0.372594886067-125 0.941795074750-127
+ 0.227929096978-128 0.527958174154-130 0.117000817874-131 0.247971560166-133
+ 0.502427263713-135 0.972833352449-137 0.179942646619-138 0.317831953860-140
+ 0.535879566503-142 0.862149207536-144 0.132307282059-145 0.193603290174-147
+ 0.270030076647-149 0.358860697647-151 0.454254439269-153 0.547492773913-155
+ 0.628074682796-157 0.685562148588-159 0.711763243097-161 0.702633668960-163
+ 0.659296414086-165 0.587820123507-167 0.497826505322-169 0.400346005993-171
+ 0.305620334121-173 0.221394500013-175 0.152150493558-177 0.991571803244-180
+ 0.612717994914-182 0.358763219882-184 0.199110983060-186 0.104594996069-188
+ 0.520983347545-191 0.245073530534-193 0.107741716024-195 0.317300805046-198
+ 0.868405039689-201 0.220666769312-203 0.520127129092-206
+ Valence charge follows
+ 0.466631559622E-13 0.189007807759E-12 0.430644810334E-12 0.775291379443E-12
+ 0.122677397226E-11 0.178903124327E-11 0.246611707738E-11 0.326220370225E-11
+ 0.418158488188E-11 0.522867919347E-11 0.640803338986E-11 0.772432584952E-11
+ 0.918237011654E-11 0.107871185329E-10 0.125436659650E-10 0.144572536278E-10
+ 0.165332730081E-10 0.187772698897E-10 0.211949484837E-10 0.237921756660E-10
+ 0.265749853245E-10 0.295495828203E-10 0.327223495634E-10 0.360998477082E-10
+ 0.396888249708E-10 0.434962195706E-10 0.475291653005E-10 0.517949967291E-10
+ 0.563012545367E-10 0.610556909903E-10 0.660662755602E-10 0.713412006823E-10
+ 0.768888876690E-10 0.827179927738E-10 0.888374134124E-10 0.952562945446E-10
+ 0.101984035222E-09 0.109030295304E-09 0.116405002347E-09 0.124118358676E-09
+ 0.132180848631E-09 0.140603246006E-09 0.149396621681E-09 0.158572351448E-09
+ 0.168142124038E-09 0.178117949360E-09 0.188512166948E-09 0.199337454629E-09
+ 0.210606837408E-09 0.222333696595E-09 0.234531779151E-09 0.247215207288E-09
+ 0.260398488311E-09 0.274096524711E-09 0.288324624522E-09 0.303098511943E-09
+ 0.318434338236E-09 0.334348692896E-09 0.350858615120E-09 0.367981605564E-09
+ 0.385735638401E-09 0.404139173695E-09 0.423211170086E-09 0.442971097809E-09
+ 0.463438952040E-09 0.484635266590E-09 0.506581127948E-09 0.529298189684E-09
+ 0.552808687226E-09 0.577135453013E-09 0.602301932036E-09 0.628332197780E-09
+ 0.655250968577E-09 0.683083624371E-09 0.711856223922E-09 0.741595522445E-09
+ 0.772328989706E-09 0.804084828577E-09 0.836891994068E-09 0.870780212850E-09
+ 0.905780003277E-09 0.941922695916E-09 0.979240454611E-09 0.101776629808E-08
+ 0.105753412206E-08 0.109857872206E-08 0.114093581660E-08 0.118464207118E-08
+ 0.122973512273E-08 0.127625360479E-08 0.132423717326E-08 0.137372653287E-08
+ 0.142476346424E-08 0.147739085177E-08 0.153165271210E-08 0.158759422336E-08
+ 0.164526175522E-08 0.170470289958E-08 0.176596650219E-08 0.182910269497E-08
+ 0.189416292919E-08 0.196120000953E-08 0.203026812896E-08 0.210142290453E-08
+ 0.217472141410E-08 0.225022223397E-08 0.232798547747E-08 0.240807283459E-08
+ 0.249054761255E-08 0.257547477746E-08 0.266292099700E-08 0.275295468426E-08
+ 0.284564604257E-08 0.294106711164E-08 0.303929181475E-08 0.314039600716E-08
+ 0.324445752584E-08 0.335155624039E-08 0.346177410523E-08 0.357519521325E-08
+ 0.369190585068E-08 0.381199455346E-08 0.393555216501E-08 0.406267189548E-08
+ 0.419344938247E-08 0.432798275341E-08 0.446637268937E-08 0.460872249065E-08
+ 0.475513814393E-08 0.490572839118E-08 0.506060480034E-08 0.521988183777E-08
+ 0.538367694253E-08 0.555211060262E-08 0.572530643308E-08 0.590339125616E-08
+ 0.608649518345E-08 0.627475170017E-08 0.646829775156E-08 0.666727383152E-08
+ 0.687182407341E-08 0.708209634331E-08 0.729824233549E-08 0.752041767046E-08
+ 0.774878199538E-08 0.798349908717E-08 0.822473695807E-08 0.847266796408E-08
+ 0.872746891597E-08 0.898932119328E-08 0.925841086110E-08 0.953492878990E-08
+ 0.981907077833E-08 0.101110376792E-07 0.104110355288E-07 0.107192756791E-07
+ 0.110359749337E-07 0.113613556872E-07 0.116956460679E-07 0.120390800844E-07
+ 0.123918977755E-07 0.127543453646E-07 0.131266754173E-07 0.135091470033E-07
+ 0.139020258628E-07 0.143055845765E-07 0.147201027401E-07 0.151458671437E-07
+ 0.155831719548E-07 0.160323189074E-07 0.164936174940E-07 0.169673851646E-07
+ 0.174539475288E-07 0.179536385643E-07 0.184668008305E-07 0.189937856869E-07
+ 0.195349535180E-07 0.200906739628E-07 0.206613261514E-07 0.212472989463E-07
+ 0.218489911910E-07 0.224668119642E-07 0.231011808406E-07 0.237525281584E-07
+ 0.244212952934E-07 0.251079349407E-07 0.258129114027E-07 0.265367008848E-07
+ 0.272797917988E-07 0.280426850735E-07 0.288258944740E-07 0.296299469281E-07
+ 0.304553828618E-07 0.313027565427E-07 0.321726364330E-07 0.330656055503E-07
+ 0.339822618383E-07 0.349232185471E-07 0.358891046224E-07 0.368805651051E-07
+ 0.378982615413E-07 0.389428724017E-07 0.400150935128E-07 0.411156384983E-07
+ 0.422452392323E-07 0.434046463029E-07 0.445946294891E-07 0.458159782486E-07
+ 0.470695022184E-07 0.483560317283E-07 0.496764183270E-07 0.510315353218E-07
+ 0.524222783321E-07 0.538495658569E-07 0.553143398562E-07 0.568175663480E-07
+ 0.583602360198E-07 0.599433648559E-07 0.615679947804E-07 0.632351943169E-07
+ 0.649460592645E-07 0.667017133913E-07 0.685033091452E-07 0.703520283827E-07
+ 0.722490831171E-07 0.741957162837E-07 0.761932025270E-07 0.782428490055E-07
+ 0.803459962184E-07 0.825040188526E-07 0.847183266516E-07 0.869903653060E-07
+ 0.893216173670E-07 0.917136031826E-07 0.941678818582E-07 0.966860522408E-07
+ 0.992697539289E-07 0.101920668307E-06 0.104640519608E-06 0.107431076002E-06
+ 0.110294150708E-06 0.113231603144E-06 0.116245340098E-06 0.119337316928E-06
+ 0.122509538801E-06 0.125764061953E-06 0.129102994987E-06 0.132528500205E-06
+ 0.136042794970E-06 0.139648153102E-06 0.143346906316E-06 0.147141445687E-06
+ 0.151034223159E-06 0.155027753093E-06 0.159124613847E-06 0.163327449404E-06
+ 0.167638971034E-06 0.172061959008E-06 0.176599264344E-06 0.181253810606E-06
+ 0.186028595742E-06 0.190926693978E-06 0.195951257747E-06 0.201105519678E-06
+ 0.206392794631E-06 0.211816481782E-06 0.217380066766E-06 0.223087123868E-06
+ 0.228941318274E-06 0.234946408378E-06 0.241106248147E-06 0.247424789546E-06
+ 0.253906085026E-06 0.260554290071E-06 0.267373665813E-06 0.274368581718E-06
+ 0.281543518326E-06 0.288903070076E-06 0.296451948193E-06 0.304194983651E-06
+ 0.312137130212E-06 0.320283467543E-06 0.328639204407E-06 0.337209681938E-06
+ 0.346000377003E-06 0.355016905644E-06 0.364265026606E-06 0.373750644961E-06
+ 0.383479815819E-06 0.393458748134E-06 0.403693808605E-06 0.414191525682E-06
+ 0.424958593667E-06 0.436001876919E-06 0.447328414174E-06 0.458945422962E-06
+ 0.470860304148E-06 0.483080646581E-06 0.495614231860E-06 0.508469039229E-06
+ 0.521653250589E-06 0.535175255635E-06 0.549043657133E-06 0.563267276325E-06
+ 0.577855158468E-06 0.592816578519E-06 0.608161046963E-06 0.623898315789E-06
+ 0.640038384614E-06 0.656591506970E-06 0.673568196741E-06 0.690979234774E-06
+ 0.708835675650E-06 0.727148854627E-06 0.745930394768E-06 0.765192214237E-06
+ 0.784946533794E-06 0.805205884467E-06 0.825983115434E-06 0.847291402087E-06
+ 0.869144254320E-06 0.891555525015E-06 0.914539418746E-06 0.938110500711E-06
+ 0.962283705880E-06 0.987074348386E-06 0.101249813115E-05 0.103857115575E-05
+ 0.106530993256E-05 0.109273139108E-05 0.112085289066E-05 0.114969223133E-05
+ 0.117926766507E-05 0.120959790722E-05 0.124070214832E-05 0.127260006612E-05
+ 0.130531183801E-05 0.133885815367E-05 0.137326022813E-05 0.140853981512E-05
+ 0.144471922071E-05 0.148182131744E-05 0.151986955866E-05 0.155888799331E-05
+ 0.159890128110E-05 0.163993470801E-05 0.168201420227E-05 0.172516635065E-05
+ 0.176941841528E-05 0.181479835079E-05 0.186133482201E-05 0.190905722199E-05
+ 0.195799569062E-05 0.200818113359E-05 0.205964524201E-05 0.211242051232E-05
+ 0.216654026693E-05 0.222203867525E-05 0.227895077531E-05 0.233731249595E-05
+ 0.239716067954E-05 0.245853310536E-05 0.252146851355E-05 0.258600662964E-05
+ 0.265218818979E-05 0.272005496666E-05 0.278964979592E-05 0.286101660354E-05
+ 0.293420043367E-05 0.300924747738E-05 0.308620510207E-05 0.316512188165E-05
+ 0.324604762760E-05 0.332903342074E-05 0.341413164393E-05 0.350139601558E-05
+ 0.359088162407E-05 0.368264496308E-05 0.377674396789E-05 0.387323805262E-05
+ 0.397218814845E-05 0.407365674295E-05 0.417770792036E-05 0.428440740305E-05
+ 0.439382259405E-05 0.450602262079E-05 0.462107837996E-05 0.473906258365E-05
+ 0.486004980678E-05 0.498411653578E-05 0.511134121864E-05 0.524180431639E-05
+ 0.537558835596E-05 0.551277798457E-05 0.565346002564E-05 0.579772353626E-05
+ 0.594565986632E-05 0.609736271936E-05 0.625292821510E-05 0.641245495385E-05
+ 0.657604408275E-05 0.674379936396E-05 0.691582724489E-05 0.709223693047E-05
+ 0.727314045761E-05 0.745865277186E-05 0.764889180646E-05 0.784397856369E-05
+ 0.804403719890E-05 0.824919510691E-05 0.845958301134E-05 0.867533505658E-05
+ 0.889658890280E-05 0.912348582392E-05 0.935617080882E-05 0.959479266580E-05
+ 0.983950413055E-05 0.100904619776E-04 0.103478271358E-04 0.106117648071E-04
+ 0.108824445903E-04 0.111600406086E-04 0.114447316412E-04 0.117367012605E-04
+ 0.120361379736E-04 0.123432353693E-04 0.126581922699E-04 0.129812128895E-04
+ 0.133125069977E-04 0.136522900896E-04 0.140007835626E-04 0.143582149001E-04
+ 0.147248178620E-04 0.151008326835E-04 0.154865062818E-04 0.158820924710E-04
+ 0.162878521864E-04 0.167040537180E-04 0.171309729547E-04 0.175688936375E-04
+ 0.180181076262E-04 0.184789151758E-04 0.189516252270E-04 0.194365557092E-04
+ 0.199340338579E-04 0.204443965469E-04 0.209679906368E-04 0.215051733396E-04
+ 0.220563126020E-04 0.226217875075E-04 0.232019886981E-04 0.237973188185E-04
+ 0.244081929828E-04 0.250350392652E-04 0.256782992172E-04 0.263384284125E-04
+ 0.270158970208E-04 0.277111904139E-04 0.284248098046E-04 0.291572729219E-04
+ 0.299091147246E-04 0.306808881552E-04 0.314731649376E-04 0.322865364222E-04
+ 0.331216144795E-04 0.339790324485E-04 0.348594461410E-04 0.357635349077E-04
+ 0.366920027692E-04 0.376455796169E-04 0.386250224895E-04 0.396311169289E-04
+ 0.406646784222E-04 0.417265539366E-04 0.428176235518E-04 0.439388021992E-04
+ 0.450910415142E-04 0.462753318101E-04 0.474927041830E-04 0.487442327559E-04
+ 0.500310370741E-04 0.513542846609E-04 0.527151937472E-04 0.541150361860E-04
+ 0.555551405674E-04 0.570368955464E-04 0.585617534021E-04 0.601312338429E-04
+ 0.617469280773E-04 0.634105031693E-04 0.651237067003E-04 0.668883717601E-04
+ 0.687064222899E-04 0.705798788069E-04 0.725108645350E-04 0.745016119752E-04
+ 0.765544699469E-04 0.786719111354E-04 0.808565401840E-04 0.831111023710E-04
+ 0.854384929165E-04 0.878417669639E-04 0.903241502901E-04 0.928890507955E-04
+ 0.955400708354E-04 0.982810204539E-04 0.101115931589E-03 0.104049073323E-03
+ 0.107084968254E-03 0.110228410073E-03 0.113484482443E-03 0.116858579272E-03
+ 0.120356426482E-03 0.123984105396E-03 0.127748077859E-03 0.131655213220E-03
+ 0.135712817321E-03 0.139928663644E-03 0.144311026772E-03 0.148868718341E-03
+ 0.153611125671E-03 0.158548253281E-03 0.163690767492E-03 0.169050044366E-03
+ 0.174638221209E-03 0.180468251938E-03 0.186553966560E-03 0.192910135111E-03
+ 0.199552536354E-03 0.206498031622E-03 0.213764644165E-03 0.221371644422E-03
+ 0.229339641672E-03 0.237690682508E-03 0.246448356683E-03 0.255637910831E-03
+ 0.265286370692E-03 0.275422672435E-03 0.286077803781E-03 0.297284955633E-03
+ 0.309079685002E-03 0.321500090054E-03 0.334586998185E-03 0.348384168071E-03
+ 0.362938506727E-03 0.378300302682E-03 0.394523476449E-03 0.411665849553E-03
+ 0.429789433484E-03 0.448960740028E-03 0.469251114527E-03 0.490737093755E-03
+ 0.513500790176E-03 0.537630304525E-03 0.563220168736E-03 0.590371821435E-03
+ 0.619194118328E-03 0.649803880010E-03 0.682326479873E-03 0.716896474991E-03
+ 0.753658283060E-03 0.792766908666E-03 0.834388722405E-03 0.878702296597E-03
+ 0.925899301607E-03 0.976185467042E-03 0.102978161240E-02 0.108692475206E-02
+ 0.114786927975E-02 0.121288823815E-02 0.128227467945E-02 0.135634312319E-02
+ 0.143543111812E-02 0.151990091527E-02 0.161014125974E-02 0.170656930943E-02
+ 0.180963268928E-02 0.191981169024E-02 0.203762162264E-02 0.216361533448E-02
+ 0.229838590542E-02 0.244256952846E-02 0.259684859136E-02 0.276195497124E-02
+ 0.293867355619E-02 0.312784600857E-02 0.333037478576E-02 0.354722743483E-02
+ 0.377944117859E-02 0.402812781156E-02 0.429447892524E-02 0.457977148336E-02
+ 0.488537376878E-02 0.521275172474E-02 0.556347571471E-02 0.593922772588E-02
+ 0.634180904303E-02 0.677314842037E-02 0.723531078082E-02 0.773050647299E-02
+ 0.826110111798E-02 0.882962607921E-02 0.943878959018E-02 0.100914885762E-01
+ 0.107908212076E-01 0.115401002240E-01 0.123428670695E-01 0.132029068800E-01
+ 0.141242643679E-01 0.151112606457E-01 0.161685110358E-01 0.173009439126E-01
+ 0.185138206245E-01 0.198127565428E-01 0.212037432887E-01 0.226931721853E-01
+ 0.242878589850E-01 0.259950699214E-01 0.278225491350E-01 0.297785475186E-01
+ 0.318718530320E-01 0.341118225277E-01 0.365084151331E-01 0.390722272264E-01
+ 0.418145290441E-01 0.447473029513E-01 0.478832834012E-01 0.512359986050E-01
+ 0.548198139255E-01 0.586499769997E-01 0.627426645870E-01 0.671150311271E-01
+ 0.717852589821E-01 0.767726103209E-01 0.820974805907E-01 0.877814535011E-01
+ 0.938473574288E-01 0.100319323129 0.107222842614 0.114584829037
+ 0.122433677384 0.130799325757 0.139713316982 0.149208860248
+ 0.159320892444 0.170086138805 0.181543172452 0.193732472328
+ 0.206696479020 0.220479647855 0.235128498629 0.250691661247
+ 0.267219916492 0.284766231053 0.303385785893 0.323135996928
+ 0.344076526938 0.366269287529 0.389778429880 0.414670322935
+ 0.441013517603 0.468878695462 0.498338600347 0.529467951157
+ 0.562343334120 0.597043072701 0.633647073246 0.672236644448
+ 0.712894288642 0.755703462933 0.800748308145 0.848113343595
+ 0.897883125729 0.950141868720 1.00497302521 1.06245882554
+ 1.12267977391 1.18571410018 1.25163716624 1.32052082615
+ 1.39243273972 1.46743563938 1.54558655088 1.62693596889
+ 1.71152698881 1.79939439735 1.89056372460 1.98505026147
+ 2.08285804706 2.18397883153 2.28839102098 2.39605861185
+ 2.50693012349 2.62093753867 2.73799526281 2.85799911392
+ 2.98082535643 3.10632979303 3.23434692971 3.36468923030
+ 3.49714647731 3.63148525688 3.76744858596 3.90475570021
+ 4.04310202126 4.18215932145 4.32157610392 4.46097821503
+ 4.59996970438 4.73813394668 4.87503503689 5.01021946821
+ 5.14321809717 5.27354839717 5.40071700816 5.52422257447
+ 5.64355885075 5.75821806910 5.86769454592 5.97148849981
+ 6.06911005168 6.16008336863 6.24395090975 6.32027772654
+ 6.38865576588 6.44870811995 6.50009316392 6.54250852016
+ 6.57569478634 6.59943896471 6.61357753102 6.61799908393
+ 6.61264651971 6.59751868230 6.57267144535 6.53821819073
+ 6.49432965737 6.44123314401 6.37921106072 6.30859883532
+ 6.22978219292 6.14319383829 6.04930958280 5.94864396796
+ 5.84174544836 5.72919120474 5.61158166588 5.48953482307
+ 5.36368042471 5.23465414009 5.10309178086 4.96962366604
+ 4.83486921190 4.69943182118 4.56389413837 4.42881372553
+ 4.29471921436 4.16210695399 4.03143818892 3.90313677425
+ 3.77758742823 3.65513451068 3.53608130618 3.42068978221
+ 3.30918078543 3.20173463380 3.09849205844 2.99955544750
+ 2.90499034399 2.81482715146 2.72906300450 2.64766376604
+ 2.57056611957 2.49767973108 2.42888946408 2.36405763851
+ 2.30302633300 2.24561973749 2.19164656980 2.14090257490
+ 2.09317312837 2.04823596541 2.00586405296 1.96582861434
+ 1.92790230245 1.89186249921 1.85749469414 1.82459586519
+ 1.79297774926 1.76246985042 1.73292199180 1.70420616228
+ 1.67621739134 1.64887334246 1.62211179478 1.59588744168
+ 1.57016418328 1.54490835811 1.52008653743 1.49566581494
+ 1.47161365214 1.44789806337 1.42448774193 1.40135218183
+ 1.37846180794 1.35578810291 1.33330373136 1.31098265873
+ 1.28880026273 1.26673343522 1.24476067625 1.22286216410
+ 1.20101985020 1.17921746464 1.15744062748 1.13567690182
+ 1.11391575398 1.09214846182 1.07036821460 1.04857004995
+ 1.02675085522 1.00490933128 0.983045952332 0.961162915754
+ 0.939264083871 0.917354918349 0.895442407953 0.873534990276
+ 0.851642467999 0.829775920191 0.807947609116 0.786170882986
+ 0.764460075087 0.742830399689 0.721297845141 0.699879064595
+ 0.678591264769 0.657452093230 0.636479524670 0.615691746720
+ 0.595107045855 0.574743694002 0.554619836508 0.534753382169
+ 0.515161896049 0.495862495749 0.476871752153 0.458205595141
+ 0.439879225185 0.421907031534 0.404302517609 0.387078234361
+ 0.370245721951 0.353815460254 0.337796828499 0.322198074203
+ 0.307026291467 0.292287408552 0.277986184537 0.264126214721
+ 0.250709944344 0.237738690090 0.225212668754 0.213131032383
+ 0.201491909169 0.190292449310 0.179528875078 0.169196534291
+ 0.159289956436 0.149802910693 0.140728465169 0.132059046677
+ 0.123786500469 0.115902149379 0.108396851910 0.101261058850
+ 0.944848680732E-01 0.880580772608E-01 0.819702343135E-01 0.762106853110E-01
+ 0.707686199143E-01 0.656331141605E-01 0.607931706441E-01 0.562377561142E-01
+ 0.519558365489E-01 0.479364097923E-01 0.441685358556E-01 0.406413649967E-01
+ 0.373441636965E-01 0.342663386510E-01 0.313974588936E-01 0.287272761535E-01
+ 0.262457435454E-01 0.239430326726E-01 0.218095492121E-01 0.198359470357E-01
+ 0.180131409079E-01 0.163323177918E-01 0.147849467800E-01 0.133627876640E-01
+ 0.120578981491E-01 0.108626397201E-01 0.976968216122E-02 0.877200674165E-02
+ 0.786290807721E-02 0.703599468980E-02 0.628518829248E-02 0.560472183750E-02
+ 0.498913637438E-02 0.443327677439E-02 0.393228638718E-02 0.348160070379E-02
+ 0.307694010755E-02 0.271430180102E-02 0.238995100156E-02 0.210041150200E-02
+ 0.184245569453E-02 0.161309415637E-02 0.140956489502E-02 0.122932234836E-02
+ 0.107002623149E-02 0.929530317711E-03 0.805871235447E-03 0.697257357048E-03
+ 0.602057848445E-03 0.518791941769E-03 0.446118485691E-03 0.382825820857E-03
+ 0.327822020517E-03 0.280125529262E-03 0.238856225935E-03 0.203226930222E-03
+ 0.172535366324E-03 0.146156591455E-03 0.123535891756E-03 0.104182143596E-03
+ 0.876616341219E-04 0.735923313718E-04 0.616385912174E-04 0.515062858717E-04
+ 0.429383366381E-04 0.357106319748E-04 0.296283107600E-04 0.245223898317E-04
+ 0.202467144163E-04 0.166752098941E-04 0.136994134611E-04 0.112262645778E-04
+ 0.917613363014E-05 0.748106891285E-05 0.608324286575E-05 0.493357941061E-05
+ 0.399054522455E-05 0.321908882531E-05 0.258971240954E-05 0.207766246102E-05
+ 0.166222621479E-05 0.132612211278E-05 0.105497340562E-05 0.836855034999E-06
+ 0.661904864443E-06 0.521991209077E-06 0.410429442649E-06 0.321741231634E-06
+ 0.251450660112E-06 0.195912165813E-06 0.152165808222E-06 0.117815935535E-06
+ 0.909298109190E-07 0.699532025183E-07 0.536403388586E-07 0.409959853634E-07
+ 0.312277094530E-07 0.237066840043E-07 0.179356033276E-07 0.135225388026E-07
+ 0.101596752883E-07 0.760611120285E-08 0.567399145567E-08 0.421734605306E-08
+ 0.312317563415E-08 0.230431377842E-08 0.169377276273E-08 0.124027138634E-08
+ 0.904702530908E-09 0.657357422179E-09 0.475754533275E-09 0.342948208475E-09
+ 0.246216267658E-09 0.176045785326E-09 0.125352500145E-09 0.888825191554E-10
+ 0.627556612587E-10 0.441183824965E-10 0.308811158286E-10 0.215203548092E-10
+ 0.149301753975E-10 0.103113402248E-10 0.708884392808E-11 0.485088353591E-11
+ 0.330389420855E-11 0.223957522482E-11 0.151082256492E-11 0.101424591192E-11
+ 0.677529841336E-12 0.450341493542E-12 0.297821833534E-12 0.195949625270E-12
+ 0.128255977383E-12 0.835079139182E-13 0.540836128243E-13 0.348387540350E-13
+ 0.223197245324E-13 0.142204844453E-13 0.900967148801E-14 0.567599211404E-14
+ 0.355534485460E-14 0.221410010549E-14 0.137074409628E-14 0.843580919056E-15
+ 0.516030704172E-15 0.313739746825E-15 0.189572388739E-15 0.113830348787E-15
+ 0.679178534901E-16 0.402640769640E-16 0.237150480692E-16 0.138760812206E-16
+ 0.806510174927E-17 0.465603486030E-17 0.266961501319E-17 0.152008996874E-17
+ 0.859488185775E-18 0.482527106417E-18 0.268952403895E-18 0.148819992400E-18
+ 0.817408161002E-19 0.445623104006E-19 0.241104957811E-19 0.129453094987E-19
+ 0.689674551717E-20 0.364551172800E-20 0.191166529529E-20 0.994397992863E-21
+ 0.513049251415E-21 0.262520460053E-21 0.133206925381E-21 0.670198870145E-22
+ 0.334308117352E-22 0.165313760894E-22 0.810292566017E-23 0.393637775906E-23
+ 0.189506643056E-23 0.904013524882E-24 0.427265349851E-24 0.200051345274E-24
+ 0.927800258573E-25 0.426171315885E-25 0.193855218788E-25 0.873133211815E-26
+ 0.389348714744E-26 0.171868791015E-26 0.750930004123E-27 0.324705368646E-27
+ 0.138934392170E-27 0.588169275302E-28 0.246324968486E-28 0.102039563895E-28
+ 0.418044568038E-29 0.169359448004E-29 0.678371172039E-30 0.268617268521E-30
+ 0.105134622422E-30 0.406666855038E-31 0.155434735328E-31 0.586959238709E-32
+ 0.218953467076E-32 0.806700540760E-33 0.293508902952E-33 0.105441004257E-33
+ 0.373944505486E-34 0.130901104772E-34 0.452216363581E-35 0.154149958002E-35
+ 0.518395447905E-36 0.171959077951E-36 0.562548260918E-37 0.181463321138E-37
+ 0.577078628087E-38 0.180892222686E-38 0.558810146093E-39 0.170093558869E-39
+ 0.510046007068E-40 0.150642117129E-40 0.438142801787E-41 0.125467934656E-41
+ 0.353681330494E-42 0.981222016227E-43 0.267861654464E-43 0.719371407622E-44
+ 0.190022615095E-44 0.493600853335E-45 0.126058710910E-45 0.316448373830E-46
+ 0.780677115859E-47 0.189226931651E-47 0.450547422133E-48 0.105352797110E-48
+ 0.241880213738E-49 0.545133417028E-50 0.120573448142E-50 0.261663978615E-51
+ 0.557025744497E-52 0.116289386615E-52 0.238029832629E-53 0.477575011722E-54
+ 0.938989128168E-55 0.180870040321E-55 0.341281449525E-56 0.631412047503E-57
+ 0.114365716876E-57 0.202742918768E-58 0.351677801357E-59
Index: /XMLF90/doc/Examples/wxml/README
===================================================================
--- /XMLF90/doc/Examples/wxml/README (revision 6)
+++ /XMLF90/doc/Examples/wxml/README (revision 6)
@@ -0,0 +1,5 @@
+Two examples of the use of the WXML library.
+
+simple.f90 : Basic syntax and features
+
+pseudo.f90 : A real-life example. Converts a legacy file into a XML format.
Index: /XMLF90/doc/Examples/wxml/i.m_pseudo_utils.f90
===================================================================
--- /XMLF90/doc/Examples/wxml/i.m_pseudo_utils.f90 (revision 6)
+++ /XMLF90/doc/Examples/wxml/i.m_pseudo_utils.f90 (revision 6)
@@ -0,0 +1,363 @@
+
+ module m_pseudo_utils
+!
+! Main module for ps input and output, based on
+! a derived type representation closely resembling
+! the Froyen data structures.
+!
+!
+! The radial coordinate is reparametrized to allow a more
+! precise sampling of the area near the origin.
+
+! r: 0->...
+! x: 0->...
+! i: 1->...
+
+! r(x) = grid_scale * [ exp( grid_step*x) - 1 ]
+!
+! **** WARNING *****
+! In SIESTA, grid_scale = b, grid_step = a
+! In ATOM, grid_scale = a, grid_step = b
+! ******************
+!
+! pseudo%nr and pseudo%nrval are identical
+! (for ATOM and SIESTA use)
+!
+! Working precision should be double precision
+! for backwards binary compatibility
+!
+ private
+
+ public :: pseudo_read_formatted
+ public :: pseudo_header_print
+ public :: pseudo_write_xml
+ public :: pseudo_complete
+ private :: get_unit
+
+ integer, private, parameter :: dp = selected_real_kind(14)
+
+ type, public :: pseudopotential_t
+ character(len=2) :: name
+ integer :: nr
+ integer :: nrval
+ real(dp) :: zval
+ logical :: relativistic
+ character(len=2) :: icorr
+ character(len=3) :: irel
+ character(len=4) :: nicore
+ real(dp) :: grid_scale
+ real(dp) :: grid_step
+ character(len=10) :: method(6)
+ character(len=70) :: text
+ integer :: npotu
+ integer :: npotd
+ real(dp), pointer :: r(:)
+ real(dp), pointer :: chcore(:)
+ real(dp), pointer :: chval(:)
+ real(dp), pointer :: vdown(:,:)
+ real(dp), pointer :: vup(:,:)
+ integer, pointer :: ldown(:)
+ integer, pointer :: lup(:)
+!
+! Extra fields for more functionality
+!
+ character(len=10) :: creator
+ character(len=10) :: date
+ character(len=40) :: flavor
+ integer :: lmax
+ integer, pointer :: principal_n(:)
+ real(dp), pointer :: occupation(:)
+ real(dp), pointer :: cutoff(:)
+ end type pseudopotential_t
+!
+! These determine the format for ASCII files
+!
+ character(len=*), parameter, private :: &
+ fmt_int = "(tr1,i2)" , &
+ fmt_nam = "(tr1,a2,tr1,a2,tr1,a3,tr1,a4)", &
+ fmt_met = "(tr1,6a10,/,tr1,a70)" , &
+ fmt_pot= "(tr1,2i3,i5,3es20.12)" , &
+ fmt_rad = "(4(es20.12))" , &
+ fmt_txt = "(tr1,a)"
+
+ CONTAINS
+
+!----
+ subroutine pseudo_read_formatted(fname,p)
+ character(len=*), intent(in) :: fname
+ type(pseudopotential_t) :: p
+
+ integer :: io_ps, i, j, status
+ character(len=70) :: dummy
+ real(kind=dp) :: r2
+
+ call get_unit(io_ps,status)
+ if (status /= 0) stop "cannot get unit number"
+ open(unit=io_ps,file=fname,form="formatted",status="old",&
+ action="read",position="rewind")
+ write(6,"(3a)") "Reading pseudopotential information ", &
+ "in formatted form from ", trim(fname)
+
+
+ read(io_ps,fmt=fmt_nam) p%name, p%icorr, p%irel, p%nicore
+ read(io_ps,fmt_met) (p%method(i),i=1,6), p%text
+ read(io_ps,fmt=fmt_pot) p%npotd, p%npotu, p%nr, &
+ p%grid_scale, p%grid_step, p%zval
+
+ p%nrval = p%nr + 1
+ p%nr = p%nr + 1
+ allocate(p%r(1:p%nrval))
+ read(io_ps,fmt=fmt_txt) dummy
+ read(io_ps,fmt=fmt_rad) (p%r(j),j=2,p%nrval)
+ p%r(1) = 0.d0
+ r2=p%r(2)/(p%r(3)-p%r(2))
+
+ if (p%npotd.gt.0) then
+ allocate(p%vdown(1:p%npotd,1:p%nrval))
+ allocate(p%ldown(1:p%npotd))
+ endif
+ do i=1,p%npotd
+ read(io_ps,fmt=fmt_txt) dummy
+ read(io_ps,fmt=fmt_int) p%ldown(i)
+ read(io_ps,fmt=fmt_rad) (p%vdown(i,j), j=2,p%nrval)
+ p%vdown(i,1) = p%vdown(i,2) - r2*(p%vdown(i,3)-p%vdown(i,2))
+ enddo
+
+ if (p%npotu.gt.0) then
+ allocate(p%vup(1:p%npotu,1:p%nrval))
+ allocate(p%lup(1:p%npotu))
+ endif
+ do i=1,p%npotu
+ read(io_ps,fmt=fmt_txt) dummy
+ read(io_ps,fmt=fmt_int) p%lup(i)
+ read(io_ps,fmt=fmt_rad) (p%vup(i,j), j=2,p%nrval)
+ p%vup(i,1) = p%vup(i,2) - r2*(p%vup(i,3)-p%vup(i,2))
+ enddo
+
+ allocate(p%chcore(1:p%nrval))
+ allocate(p%chval(1:p%nrval))
+
+ read(io_ps,fmt=fmt_txt) dummy
+ read(io_ps,fmt=fmt_rad) (p%chcore(j),j=2,p%nrval)
+ p%chcore(1) = p%chcore(2) - r2*(p%chcore(3)-p%chcore(2))
+
+ read(io_ps,fmt=fmt_txt) dummy
+ read(io_ps,fmt=fmt_rad) (p%chval(j),j=2,p%nrval)
+ p%chval(1) = p%chval(2) - r2*(p%chval(3)-p%chval(2))
+
+ close(io_ps)
+ end subroutine pseudo_read_formatted
+!------
+
+ subroutine vps_init(p)
+ type(pseudopotential_t) :: p
+ nullify(p%lup,p%ldown,p%r,p%chcore,p%chval,p%vdown,p%vup)
+ end subroutine vps_init
+
+!-------
+ subroutine pseudo_header_print(lun,p)
+ integer, intent(in) :: lun
+ type(pseudopotential_t) :: p
+
+ integer :: i
+
+ write(lun,"(a)") ""
+ write(lun,fmt=fmt_nam) p%name, p%icorr, p%irel, p%nicore
+ write(lun,fmt_met) (p%method(i),i=1,6), p%text
+ write(lun,"(a)") ""
+
+ end subroutine pseudo_header_print
+!--------
+subroutine pseudo_write_xml(fname,p)
+use flib_wxml
+
+character(len=*), intent(in) :: fname
+type(pseudopotential_t) :: p
+
+integer :: i
+type(xmlf_t) :: xf
+
+call xml_OpenFile(fname,xf,indent=.true.)
+call xml_AddXMLDeclaration(xf)
+call xml_NewElement(xf,"pseudo")
+call xml_AddAttribute(xf,"version","0.5")
+call xml_NewElement(xf,"header")
+call xml_AddAttribute(xf,"symbol",trim(p%name))
+call xml_AddAttribute(xf,"zval",trim(str(p%zval)))
+call xml_AddAttribute(xf,"creator",trim(p%creator))
+call xml_AddAttribute(xf,"date",trim(p%date))
+call xml_AddAttribute(xf,"flavor",trim(p%flavor))
+call xml_AddAttribute(xf,"correlation",trim(p%icorr))
+
+ select case (trim(p%irel))
+ case ("isp")
+ call xml_AddAttribute(xf,"relativistic","no")
+ call xml_AddAttribute(xf,"polarized","yes")
+ case ("nrl")
+ call xml_AddAttribute(xf,"relativistic","no")
+ call xml_AddAttribute(xf,"polarized","no")
+ case ("rel")
+ call xml_AddAttribute(xf,"relativistic","yes")
+ call xml_AddAttribute(xf,"polarized","no")
+ end select
+ call xml_AddAttribute(xf,"core-corrections",trim(p%nicore))
+call xml_EndElement(xf,"header")
+
+call xml_NewElement(xf,"grid")
+ call xml_AddAttribute(xf,"type","log")
+ call xml_AddAttribute(xf,"units","bohr")
+ call xml_AddAttribute(xf,"scale",trim(str(p%grid_scale)))
+ call xml_AddAttribute(xf,"step",trim(str(p%grid_step)))
+ call xml_AddAttribute(xf,"npts",trim(str(p%nr-1)))
+call xml_EndElement(xf,"grid")
+
+call xml_NewElement(xf,"semilocal")
+
+ call xml_AddAttribute(xf,"units","rydberg")
+ call xml_AddAttribute(xf,"format","r*V")
+ call xml_AddAttribute(xf,"npots-down",trim(str(p%npotd)))
+ call xml_AddAttribute(xf,"npots-up",trim(str(p%npotu)))
+
+ do i=1,p%npotd
+ call xml_NewElement(xf,"vps")
+ call xml_AddAttribute(xf,"principal-n", &
+ trim(str(p%principal_n(p%ldown(i)))))
+ call xml_AddAttribute(xf,"l",trim(str(p%ldown(i))))
+ call xml_AddAttribute(xf,"cutoff", &
+ trim(str(p%cutoff(p%ldown(i)))))
+ call xml_AddAttribute(xf,"occupation", &
+ trim(str(p%occupation(p%ldown(i)))))
+ call xml_AddAttribute(xf,"spin","-1")
+
+ call xml_NewElement(xf,"radfunc")
+ call xml_NewElement(xf,"data")
+ call xml_AddArray(xf,p%vdown(i,2:p%nr),fmt_rad)
+ call xml_EndElement(xf,"data")
+ call xml_EndElement(xf,"radfunc")
+ call xml_EndElement(xf,"vps")
+ enddo
+
+ do i=1,p%npotu
+ call xml_NewElement(xf,"vps")
+ call xml_AddAttribute(xf,"principal-n", &
+ trim(str(p%principal_n(p%lup(i)))))
+ call xml_AddAttribute(xf,"l",trim(str(p%lup(i))))
+ call xml_AddAttribute(xf,"cutoff", &
+ trim(str(p%cutoff(p%lup(i)))))
+ call xml_AddAttribute(xf,"occupation", &
+ trim(str(p%occupation(p%lup(i)))))
+ call xml_AddAttribute(xf,"spin","-1")
+
+ call xml_NewElement(xf,"radfunc")
+ call xml_NewElement(xf,"data")
+ call xml_AddArray(xf,p%vup(i,2:p%nr),fmt_rad)
+ call xml_EndElement(xf,"data")
+ call xml_EndElement(xf,"radfunc")
+ call xml_EndElement(xf,"vps")
+ enddo
+
+ call xml_EndElement(xf,"semilocal")
+
+ call xml_NewElement(xf,"valence-charge")
+ call xml_NewElement(xf,"radfunc")
+ call xml_NewElement(xf,"data")
+ call xml_AddArray(xf,p%chval(2:p%nr),fmt_rad)
+ call xml_EndElement(xf,"data")
+ call xml_EndElement(xf,"radfunc")
+ call xml_EndElement(xf,"valence-charge")
+
+ call xml_NewElement(xf,"pseudocore-charge")
+ call xml_NewElement(xf,"radfunc")
+ call xml_NewElement(xf,"data")
+ call xml_AddArray(xf,p%chcore(2:p%nr),fmt_rad)
+ call xml_EndElement(xf,"data")
+ call xml_EndElement(xf,"radfunc")
+ call xml_EndElement(xf,"pseudocore-charge")
+
+ call xml_EndElement(xf,"pseudo")
+
+ call xml_Close(xf)
+
+end subroutine pseudo_write_xml
+
+!
+! Experimental routine to extract information from "text" field.
+! and to set up more rational fields.
+!
+subroutine pseudo_complete(p)
+type(pseudopotential_t), intent(inout) :: p
+
+integer :: i, lmax, l, itext, n, status
+real(dp) :: zup, zdown, ztot, rc_read
+
+p%creator = p%method(1)
+p%date = p%method(2)
+p%flavor = p%method(3) // p%method(4) // p%method(5) // p%method(6)
+
+lmax = 0
+do i = 1, p%npotd
+ lmax = max(lmax,p%ldown(i))
+enddo
+p%lmax = lmax
+allocate(p%principal_n(0:lmax))
+allocate(p%occupation(0:lmax))
+allocate(p%cutoff(0:lmax))
+!
+! Decode text into useful information. Assumes l's are increasing from 0
+!
+if (p%irel=="isp") then
+ print *, "Polarized........*************"
+ print *, "|", p%text, "|"
+ do l=0,min(lmax,3)
+ itext=l*17
+ read(p%text(itext+1:),iostat=status, &
+ fmt="(i1,tr1,f4.2,tr1,f4.2,tr1,f4.2)") &
+ n, zdown, zup, rc_read
+ if (status /=0) STOP "fallo text"
+ p%principal_n(l) = n
+ p%occupation(l) = zdown+zup
+ p%cutoff(l) = rc_read
+ enddo
+else
+ do l=0,min(lmax,3)
+ itext=l*17
+ read(p%text(itext+1:),iostat=status,fmt="(i1,tr1,f5.2,tr4,f5.2)") &
+ n, ztot, rc_read
+ if (status /=0) STOP "fallo text"
+ p%principal_n(l) = n
+ p%occupation(l) = ztot
+ p%cutoff(l) = rc_read
+ enddo
+
+endif
+
+end subroutine pseudo_complete
+
+
+! ----------------------------------------------------------------------
+subroutine get_unit(lun,iostat)
+
+! Get an available Fortran unit number
+
+integer, intent(out) :: lun
+integer, intent(out) :: iostat
+
+integer :: i
+logical :: unit_used
+
+do i = 10, 99
+ lun = i
+ inquire(unit=lun,opened=unit_used)
+ if (.not. unit_used) then
+ iostat = 0
+ return
+ endif
+enddo
+iostat = -1
+lun = -1
+end subroutine get_unit
+
+end module m_pseudo_utils
+
+
+
Index: /XMLF90/doc/Examples/wxml/i.pseudo.f90
===================================================================
--- /XMLF90/doc/Examples/wxml/i.pseudo.f90 (revision 6)
+++ /XMLF90/doc/Examples/wxml/i.pseudo.f90 (revision 6)
@@ -0,0 +1,23 @@
+program pseudoxml
+!
+! Converts legacy Froyen-style pseudo files to XML
+!
+use m_pseudo_utils
+
+type(pseudopotential_t) :: pseudo
+
+call pseudo_read_formatted("PSF",pseudo)
+!
+! Complete the information in the data structures if possible
+!
+call pseudo_complete(pseudo)
+call pseudo_header_print(6,pseudo)
+!
+! Output XML
+!
+call pseudo_write_xml("PSXML",pseudo)
+
+end program pseudoxml
+
+
+
Index: /XMLF90/doc/Examples/wxml/i.simple.f90
===================================================================
--- /XMLF90/doc/Examples/wxml/i.simple.f90 (revision 6)
+++ /XMLF90/doc/Examples/wxml/i.simple.f90 (revision 6)
@@ -0,0 +1,37 @@
+program simple
+
+use flib_wxml
+
+type(xmlf_t) :: xf
+
+integer :: age = 34
+real, dimension(20) :: x
+real, dimension(20,20) :: y
+
+call xml_OpenFile("simple.xml",xf, indent=.true.)
+
+call xml_AddXMLDeclaration(xf,"UTF-8")
+call xml_NewElement(xf,"john")
+call xml_AddAttribute(xf,"age",str(age))
+call xml_NewElement(xf,"peter")
+call xml_NewElement(xf,"tim")
+call xml_AddAttribute(xf,"age","37")
+call xml_AddAttribute(xf,"weight",str(123.45,"(f7.3)"))
+call xml_AddAttribute(xf,"cholesterol",str(167.0,format="(f8.0)"))
+call xml_EndElement(xf,"tim")
+call xml_AddPcdata(xf,"Ping-pong")
+call xml_AddPcdata(xf,"champion", line_feed=.false.)
+call xml_AddPcdata(xf," in 2004", space=.false., line_feed=.false.)
+call xml_NewElement(xf,"data")
+call xml_AddAttribute(xf,"units","eV")
+call random_number(x)
+call random_number(y)
+call xml_AddArray(xf,x)
+call xml_AddArray(xf,reshape(y,(/ 400 /)))
+call xml_EndElement(xf,"data")
+call xml_EndElement(xf,"peter")
+call xml_EndElement(xf,"john")
+
+call xml_Close(xf)
+
+end program simple
Index: /XMLF90/doc/Examples/wxml/m_pseudo_utils.f90
===================================================================
--- /XMLF90/doc/Examples/wxml/m_pseudo_utils.f90 (revision 6)
+++ /XMLF90/doc/Examples/wxml/m_pseudo_utils.f90 (revision 6)
@@ -0,0 +1,363 @@
+
+ module m_pseudo_utils
+!
+! Main module for ps input and output, based on
+! a derived type representation closely resembling
+! the Froyen data structures.
+!
+!
+! The radial coordinate is reparametrized to allow a more
+! precise sampling of the area near the origin.
+
+! r: 0->...
+! x: 0->...
+! i: 1->...
+
+! r(x) = grid_scale * [ exp( grid_step*x) - 1 ]
+!
+! **** WARNING *****
+! In SIESTA, grid_scale = b, grid_step = a
+! In ATOM, grid_scale = a, grid_step = b
+! ******************
+!
+! pseudo%nr and pseudo%nrval are identical
+! (for ATOM and SIESTA use)
+!
+! Working precision should be double precision
+! for backwards binary compatibility
+!
+ private
+
+ public :: pseudo_read_formatted
+ public :: pseudo_header_print
+ public :: pseudo_write_xml
+ public :: pseudo_complete
+ private :: get_unit
+
+ integer, private, parameter :: dp = selected_real_kind(14)
+
+ type, public :: pseudopotential_t
+ character(len=2) :: name
+ integer :: nr
+ integer :: nrval
+ real(dp) :: zval
+ logical :: relativistic
+ character(len=2) :: icorr
+ character(len=3) :: irel
+ character(len=4) :: nicore
+ real(dp) :: grid_scale
+ real(dp) :: grid_step
+ character(len=10) :: method(6)
+ character(len=70) :: text
+ integer :: npotu
+ integer :: npotd
+ real(dp), pointer :: r(:)
+ real(dp), pointer :: chcore(:)
+ real(dp), pointer :: chval(:)
+ real(dp), pointer :: vdown(:,:)
+ real(dp), pointer :: vup(:,:)
+ integer, pointer :: ldown(:)
+ integer, pointer :: lup(:)
+!
+! Extra fields for more functionality
+!
+ character(len=10) :: creator
+ character(len=10) :: date
+ character(len=40) :: flavor
+ integer :: lmax
+ integer, pointer :: principal_n(:)
+ real(dp), pointer :: occupation(:)
+ real(dp), pointer :: cutoff(:)
+ end type pseudopotential_t
+!
+! These determine the format for ASCII files
+!
+ character(len=*), parameter, private :: &
+ fmt_int = "(tr1,i2)" , &
+ fmt_nam = "(tr1,a2,tr1,a2,tr1,a3,tr1,a4)", &
+ fmt_met = "(tr1,6a10,/,tr1,a70)" , &
+ fmt_pot= "(tr1,2i3,i5,3es20.12)" , &
+ fmt_rad = "(4(es20.12))" , &
+ fmt_txt = "(tr1,a)"
+
+ CONTAINS
+
+!----
+ subroutine pseudo_read_formatted(fname,p)
+ character(len=*), intent(in) :: fname
+ type(pseudopotential_t) :: p
+
+ integer :: io_ps, i, j, status
+ character(len=70) :: dummy
+ real(kind=dp) :: r2
+
+ call get_unit(io_ps,status)
+ if (status /= 0) stop "cannot get unit number"
+ open(unit=io_ps,file=fname,form="formatted",status="old",&
+ action="read",position="rewind")
+ write(6,"(3a)") "Reading pseudopotential information ", &
+ "in formatted form from ", trim(fname)
+
+
+ read(io_ps,fmt=fmt_nam) p%name, p%icorr, p%irel, p%nicore
+ read(io_ps,fmt_met) (p%method(i),i=1,6), p%text
+ read(io_ps,fmt=fmt_pot) p%npotd, p%npotu, p%nr, &
+ p%grid_scale, p%grid_step, p%zval
+
+ p%nrval = p%nr + 1
+ p%nr = p%nr + 1
+ allocate(p%r(1:p%nrval))
+ read(io_ps,fmt=fmt_txt) dummy
+ read(io_ps,fmt=fmt_rad) (p%r(j),j=2,p%nrval)
+ p%r(1) = 0.d0
+ r2=p%r(2)/(p%r(3)-p%r(2))
+
+ if (p%npotd.gt.0) then
+ allocate(p%vdown(1:p%npotd,1:p%nrval))
+ allocate(p%ldown(1:p%npotd))
+ endif
+ do i=1,p%npotd
+ read(io_ps,fmt=fmt_txt) dummy
+ read(io_ps,fmt=fmt_int) p%ldown(i)
+ read(io_ps,fmt=fmt_rad) (p%vdown(i,j), j=2,p%nrval)
+ p%vdown(i,1) = p%vdown(i,2) - r2*(p%vdown(i,3)-p%vdown(i,2))
+ enddo
+
+ if (p%npotu.gt.0) then
+ allocate(p%vup(1:p%npotu,1:p%nrval))
+ allocate(p%lup(1:p%npotu))
+ endif
+ do i=1,p%npotu
+ read(io_ps,fmt=fmt_txt) dummy
+ read(io_ps,fmt=fmt_int) p%lup(i)
+ read(io_ps,fmt=fmt_rad) (p%vup(i,j), j=2,p%nrval)
+ p%vup(i,1) = p%vup(i,2) - r2*(p%vup(i,3)-p%vup(i,2))
+ enddo
+
+ allocate(p%chcore(1:p%nrval))
+ allocate(p%chval(1:p%nrval))
+
+ read(io_ps,fmt=fmt_txt) dummy
+ read(io_ps,fmt=fmt_rad) (p%chcore(j),j=2,p%nrval)
+ p%chcore(1) = p%chcore(2) - r2*(p%chcore(3)-p%chcore(2))
+
+ read(io_ps,fmt=fmt_txt) dummy
+ read(io_ps,fmt=fmt_rad) (p%chval(j),j=2,p%nrval)
+ p%chval(1) = p%chval(2) - r2*(p%chval(3)-p%chval(2))
+
+ close(io_ps)
+ end subroutine pseudo_read_formatted
+!------
+
+ subroutine vps_init(p)
+ type(pseudopotential_t) :: p
+ nullify(p%lup,p%ldown,p%r,p%chcore,p%chval,p%vdown,p%vup)
+ end subroutine vps_init
+
+!-------
+ subroutine pseudo_header_print(lun,p)
+ integer, intent(in) :: lun
+ type(pseudopotential_t) :: p
+
+ integer :: i
+
+ write(lun,"(a)") ""
+ write(lun,fmt=fmt_nam) p%name, p%icorr, p%irel, p%nicore
+ write(lun,fmt_met) (p%method(i),i=1,6), p%text
+ write(lun,"(a)") ""
+
+ end subroutine pseudo_header_print
+!--------
+subroutine pseudo_write_xml(fname,p)
+use flib_wxml
+
+character(len=*), intent(in) :: fname
+type(pseudopotential_t) :: p
+
+integer :: i
+type(xmlf_t) :: xf
+
+call xml_OpenFile(fname,xf,indent=.true.)
+call xml_AddXMLDeclaration(xf)
+call xml_NewElement(xf,"pseudo")
+call xml_AddAttribute(xf,"version","0.5")
+call xml_NewElement(xf,"header")
+call xml_AddAttribute(xf,"symbol",trim(p%name))
+call xml_AddAttribute(xf,"zval",trim(str(p%zval)))
+call xml_AddAttribute(xf,"creator",trim(p%creator))
+call xml_AddAttribute(xf,"date",trim(p%date))
+call xml_AddAttribute(xf,"flavor",trim(p%flavor))
+call xml_AddAttribute(xf,"correlation",trim(p%icorr))
+
+ select case (trim(p%irel))
+ case ("isp")
+ call xml_AddAttribute(xf,"relativistic","no")
+ call xml_AddAttribute(xf,"polarized","yes")
+ case ("nrl")
+ call xml_AddAttribute(xf,"relativistic","no")
+ call xml_AddAttribute(xf,"polarized","no")
+ case ("rel")
+ call xml_AddAttribute(xf,"relativistic","yes")
+ call xml_AddAttribute(xf,"polarized","no")
+ end select
+ call xml_AddAttribute(xf,"core-corrections",trim(p%nicore))
+call xml_EndElement(xf,"header")
+
+call xml_NewElement(xf,"grid")
+ call xml_AddAttribute(xf,"type","log")
+ call xml_AddAttribute(xf,"units","bohr")
+ call xml_AddAttribute(xf,"scale",trim(str(p%grid_scale)))
+ call xml_AddAttribute(xf,"step",trim(str(p%grid_step)))
+ call xml_AddAttribute(xf,"npts",trim(str(p%nr-1)))
+call xml_EndElement(xf,"grid")
+
+call xml_NewElement(xf,"semilocal")
+
+ call xml_AddAttribute(xf,"units","rydberg")
+ call xml_AddAttribute(xf,"format","r*V")
+ call xml_AddAttribute(xf,"npots-down",trim(str(p%npotd)))
+ call xml_AddAttribute(xf,"npots-up",trim(str(p%npotu)))
+
+ do i=1,p%npotd
+ call xml_NewElement(xf,"vps")
+ call xml_AddAttribute(xf,"principal-n", &
+ trim(str(p%principal_n(p%ldown(i)))))
+ call xml_AddAttribute(xf,"l",trim(str(p%ldown(i))))
+ call xml_AddAttribute(xf,"cutoff", &
+ trim(str(p%cutoff(p%ldown(i)))))
+ call xml_AddAttribute(xf,"occupation", &
+ trim(str(p%occupation(p%ldown(i)))))
+ call xml_AddAttribute(xf,"spin","-1")
+
+ call xml_NewElement(xf,"radfunc")
+ call xml_NewElement(xf,"data")
+ call xml_AddArray(xf,p%vdown(i,2:p%nr),fmt_rad)
+ call xml_EndElement(xf,"data")
+ call xml_EndElement(xf,"radfunc")
+ call xml_EndElement(xf,"vps")
+ enddo
+
+ do i=1,p%npotu
+ call xml_NewElement(xf,"vps")
+ call xml_AddAttribute(xf,"principal-n", &
+ trim(str(p%principal_n(p%lup(i)))))
+ call xml_AddAttribute(xf,"l",trim(str(p%lup(i))))
+ call xml_AddAttribute(xf,"cutoff", &
+ trim(str(p%cutoff(p%lup(i)))))
+ call xml_AddAttribute(xf,"occupation", &
+ trim(str(p%occupation(p%lup(i)))))
+ call xml_AddAttribute(xf,"spin","-1")
+
+ call xml_NewElement(xf,"radfunc")
+ call xml_NewElement(xf,"data")
+ call xml_AddArray(xf,p%vup(i,2:p%nr),fmt_rad)
+ call xml_EndElement(xf,"data")
+ call xml_EndElement(xf,"radfunc")
+ call xml_EndElement(xf,"vps")
+ enddo
+
+ call xml_EndElement(xf,"semilocal")
+
+ call xml_NewElement(xf,"valence-charge")
+ call xml_NewElement(xf,"radfunc")
+ call xml_NewElement(xf,"data")
+ call xml_AddArray(xf,p%chval(2:p%nr),fmt_rad)
+ call xml_EndElement(xf,"data")
+ call xml_EndElement(xf,"radfunc")
+ call xml_EndElement(xf,"valence-charge")
+
+ call xml_NewElement(xf,"pseudocore-charge")
+ call xml_NewElement(xf,"radfunc")
+ call xml_NewElement(xf,"data")
+ call xml_AddArray(xf,p%chcore(2:p%nr),fmt_rad)
+ call xml_EndElement(xf,"data")
+ call xml_EndElement(xf,"radfunc")
+ call xml_EndElement(xf,"pseudocore-charge")
+
+ call xml_EndElement(xf,"pseudo")
+
+ call xml_Close(xf)
+
+end subroutine pseudo_write_xml
+
+!
+! Experimental routine to extract information from "text" field.
+! and to set up more rational fields.
+!
+subroutine pseudo_complete(p)
+type(pseudopotential_t), intent(inout) :: p
+
+integer :: i, lmax, l, itext, n, status
+real(dp) :: zup, zdown, ztot, rc_read
+
+p%creator = p%method(1)
+p%date = p%method(2)
+p%flavor = p%method(3) // p%method(4) // p%method(5) // p%method(6)
+
+lmax = 0
+do i = 1, p%npotd
+ lmax = max(lmax,p%ldown(i))
+enddo
+p%lmax = lmax
+allocate(p%principal_n(0:lmax))
+allocate(p%occupation(0:lmax))
+allocate(p%cutoff(0:lmax))
+!
+! Decode text into useful information. Assumes l's are increasing from 0
+!
+if (p%irel=="isp") then
+ print *, "Polarized........*************"
+ print *, "|", p%text, "|"
+ do l=0,min(lmax,3)
+ itext=l*17
+ read(p%text(itext+1:),iostat=status, &
+ fmt="(i1,tr1,f4.2,tr1,f4.2,tr1,f4.2)") &
+ n, zdown, zup, rc_read
+ if (status /=0) STOP "fallo text"
+ p%principal_n(l) = n
+ p%occupation(l) = zdown+zup
+ p%cutoff(l) = rc_read
+ enddo
+else
+ do l=0,min(lmax,3)
+ itext=l*17
+ read(p%text(itext+1:),iostat=status,fmt="(i1,tr1,f5.2,tr4,f5.2)") &
+ n, ztot, rc_read
+ if (status /=0) STOP "fallo text"
+ p%principal_n(l) = n
+ p%occupation(l) = ztot
+ p%cutoff(l) = rc_read
+ enddo
+
+endif
+
+end subroutine pseudo_complete
+
+
+! ----------------------------------------------------------------------
+subroutine get_unit(lun,iostat)
+
+! Get an available Fortran unit number
+
+integer, intent(out) :: lun
+integer, intent(out) :: iostat
+
+integer :: i
+logical :: unit_used
+
+do i = 10, 99
+ lun = i
+ inquire(unit=lun,opened=unit_used)
+ if (.not. unit_used) then
+ iostat = 0
+ return
+ endif
+enddo
+iostat = -1
+lun = -1
+end subroutine get_unit
+
+end module m_pseudo_utils
+
+
+
Index: /XMLF90/doc/Examples/wxml/makefile
===================================================================
--- /XMLF90/doc/Examples/wxml/makefile (revision 6)
+++ /XMLF90/doc/Examples/wxml/makefile (revision 6)
@@ -0,0 +1,36 @@
+#
+# Makefile for WXML examples
+#
+default: all
+all: simple pseudo
+#
+#---------------------------
+MK=$(FLIB_ROOT)/fortran.mk
+include $(MK)
+#---------------------------
+#
+# Uncomment the following line for debugging support
+#
+#FFLAGS=$(FFLAGS_DEBUG)
+#
+LIBS=$(LIB_PREFIX)$(LIB_STD) -lflib
+#
+simple: simple.o
+ $(FC) $(LDFLAGS) -o simple simple.o $(LIBS)
+#
+pseudo: m_pseudo_utils.o pseudo.o
+ $(FC) $(LDFLAGS) -o pseudo m_pseudo_utils.o pseudo.o $(LIBS)
+#
+clean:
+ rm -f simple pseudo *.o *.$(MOD_EXT)
+#
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/wxml/pseudo.f90
===================================================================
--- /XMLF90/doc/Examples/wxml/pseudo.f90 (revision 6)
+++ /XMLF90/doc/Examples/wxml/pseudo.f90 (revision 6)
@@ -0,0 +1,23 @@
+program pseudoxml
+!
+! Converts legacy Froyen-style pseudo files to XML
+!
+use m_pseudo_utils
+
+type(pseudopotential_t) :: pseudo
+
+call pseudo_read_formatted("PSF",pseudo)
+!
+! Complete the information in the data structures if possible
+!
+call pseudo_complete(pseudo)
+call pseudo_header_print(6,pseudo)
+!
+! Output XML
+!
+call pseudo_write_xml("PSXML",pseudo)
+
+end program pseudoxml
+
+
+
Index: /XMLF90/doc/Examples/wxml/simple.f90
===================================================================
--- /XMLF90/doc/Examples/wxml/simple.f90 (revision 6)
+++ /XMLF90/doc/Examples/wxml/simple.f90 (revision 6)
@@ -0,0 +1,37 @@
+program simple
+
+use flib_wxml
+
+type(xmlf_t) :: xf
+
+integer :: age = 34
+real, dimension(20) :: x
+real, dimension(20,20) :: y
+
+call xml_OpenFile("simple.xml",xf, indent=.true.)
+
+call xml_AddXMLDeclaration(xf,"UTF-8")
+call xml_NewElement(xf,"john")
+call xml_AddAttribute(xf,"age",str(age))
+call xml_NewElement(xf,"peter")
+call xml_NewElement(xf,"tim")
+call xml_AddAttribute(xf,"age","37")
+call xml_AddAttribute(xf,"weight",str(123.45,"(f7.3)"))
+call xml_AddAttribute(xf,"cholesterol",str(167.0,format="(f8.0)"))
+call xml_EndElement(xf,"tim")
+call xml_AddPcdata(xf,"Ping-pong")
+call xml_AddPcdata(xf,"champion", line_feed=.false.)
+call xml_AddPcdata(xf," in 2004", space=.false., line_feed=.false.)
+call xml_NewElement(xf,"data")
+call xml_AddAttribute(xf,"units","eV")
+call random_number(x)
+call random_number(y)
+call xml_AddArray(xf,x)
+call xml_AddArray(xf,reshape(y,(/ 400 /)))
+call xml_EndElement(xf,"data")
+call xml_EndElement(xf,"peter")
+call xml_EndElement(xf,"john")
+
+call xml_Close(xf)
+
+end program simple
Index: /XMLF90/doc/Examples/xpath/Ba.xml
===================================================================
--- /XMLF90/doc/Examples/xpath/Ba.xml (revision 6)
+++ /XMLF90/doc/Examples/xpath/Ba.xml (revision 6)
@@ -0,0 +1,48 @@
+
+
+
+
+ Ba all-electron calculation
+ Ba
+
+
+
+
+
+
+
+
+
+
+ Ba pseudopotential whith semicore
+ Ba
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ test Ba 5s2 5p5 5d1
+ Ba
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/xpath/README
===================================================================
--- /XMLF90/doc/Examples/xpath/README (revision 6)
+++ /XMLF90/doc/Examples/xpath/README (revision 6)
@@ -0,0 +1,10 @@
+Examples of use of the XPATH API for XML parsing.
+
+text : Extracts text from an element.
+relative : Illustrates relative searches.
+pseudo : A more complete example of the use of the XPATH API. It
+ replicates the functionality of the SAX example of the
+ same name, illustrating in particular the concept of
+ context delegation.
+
+Just type "make" to build all three examples.
Index: /XMLF90/doc/Examples/xpath/i.m_pseudo_types.f90
===================================================================
--- /XMLF90/doc/Examples/xpath/i.m_pseudo_types.f90 (revision 6)
+++ /XMLF90/doc/Examples/xpath/i.m_pseudo_types.f90 (revision 6)
@@ -0,0 +1,107 @@
+module m_pseudo_types
+!
+! Data structures for a prototype pseudopotential
+!
+integer, parameter, private :: MAXN_POTS = 8
+integer, parameter, private :: dp = selected_real_kind(14)
+!
+public :: dump_pseudo
+!
+!-----------------------------------------------------------
+type, public :: grid_t
+!
+! It should be possible to represent both log and linear
+! grids with a few parameters here.
+!
+ character(len=20) :: type
+ real(kind=dp) :: scale
+ real(kind=dp) :: step
+ integer :: npts
+end type grid_t
+!
+type, public :: radfunc_t
+ type(grid_t) :: grid
+ real(kind=dp), dimension(:), pointer :: data
+end type radfunc_t
+
+type, public :: vps_t
+ integer :: l
+ integer :: n
+ integer :: spin
+ real(kind=dp) :: occupation
+ real(kind=dp) :: cutoff
+ type(radfunc_t) :: V
+end type vps_t
+
+type, public :: header_t
+ character(len=2) :: symbol
+ real(kind=dp) :: zval
+ character(len=10) :: creator
+ character(len=10) :: date
+ character(len=40) :: flavor
+ logical :: relativistic
+ logical :: polarized
+ character(len=2) :: correlation
+ character(len=4) :: core_corrections
+end type header_t
+
+type, public :: pseudo_t
+ type(header_t) :: header
+ integer :: npots
+ integer :: npots_down
+ integer :: npots_up
+ type(vps_t), dimension(MAXN_POTS) :: pot
+ type(radfunc_t) :: core_charge
+ type(radfunc_t) :: valence_charge
+end type pseudo_t
+
+
+CONTAINS !===============================================
+
+subroutine dump_pseudo(pseudo)
+type(pseudo_t), intent(in), target :: pseudo
+
+integer :: i
+type(vps_t), pointer :: pp
+type(radfunc_t), pointer :: rp
+
+print *, "---PSEUDO data:"
+
+do i = 1, pseudo%npots
+ pp => pseudo%pot(i)
+ rp => pseudo%pot(i)%V
+ print *, "VPS ", i, " angular momentum: ", pp%l
+ print *, " n: ", pp%n
+ print *, " occupation: ", pp%occupation
+ print *, " cutoff: ", pp%cutoff
+ print *, " spin: ", pp%spin
+ print *, "grid data: ", rp%grid%npts, rp%grid%scale
+enddo
+rp => pseudo%valence_charge
+print *, "grid data: ", rp%grid%npts, rp%grid%scale
+rp => pseudo%core_charge
+print *, "grid data: ", rp%grid%npts, rp%grid%scale
+
+end subroutine dump_pseudo
+
+end module m_pseudo_types
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/xpath/i.pseudo.f90
===================================================================
--- /XMLF90/doc/Examples/xpath/i.pseudo.f90 (revision 6)
+++ /XMLF90/doc/Examples/xpath/i.pseudo.f90 (revision 6)
@@ -0,0 +1,277 @@
+program pseudo_read
+!
+! Example of XPATH-lite processing for pseudo xml file
+! Shows the use of constrained searches, context delegation, etc.
+!
+use flib_xpath
+use m_pseudo_types
+
+type(dictionary_t) :: attributes
+type(xml_t) :: fxml
+
+type(pseudo_t), target, save :: pseudo
+type(grid_t), save :: global_grid
+!
+! Pointers to make it easier to manage the data
+!
+type(header_t), pointer :: hp
+type(vps_t), pointer :: pp
+
+integer :: status, ndata
+character(len=200) :: value
+
+!-----------------------------------------------------------------
+call open_xmlfile("pseudo.xml",fxml,status)
+if (status /=0) call die("Cannot open file.")
+
+!call enable_debug(sax=.false.)
+
+!
+!------------------------------------------------------------
+! Root element with version information
+!
+call get_node(fxml,path="/pseudo",attributes=attributes,status=status)
+if (status /= 0) call die("Cannot find pseudo element")
+
+ call get_value(attributes,"version",value,status)
+ if (value == "0.5") then
+ print *, "Processing a PSEUDO version 0.5 XML file"
+ else
+ call die("Can only work with PSEUDO version 0.5 XML files")
+ endif
+
+!------------------------------------------------------------
+! Header
+!
+call get_node(fxml,path="/pseudo/header", &
+ attributes=attributes,status=status)
+if (status /= 0) call die("Cannot find /pseudo/header")
+
+ hp => pseudo%header
+
+ call get_value(attributes,"symbol",hp%symbol,status)
+ if (status /= 0 ) call die("Cannot determine atomic symbol")
+
+ call get_value(attributes,"zval",value,status)
+ if (status /= 0 ) call die("Cannot determine zval")
+ read(unit=value,fmt=*) hp%zval
+!
+ call get_value(attributes,"creator",hp%creator,status)
+ if (status /= 0 ) hp%creator="unknown"
+
+ call get_value(attributes,"flavor",hp%flavor,status)
+ if (status /= 0 ) hp%flavor="unknown"
+
+ call get_value(attributes,"relativistic",value,status)
+ if (status /= 0 ) value = "no"
+ hp%relativistic = (value == "yes")
+
+ call get_value(attributes,"polarized",value,status)
+ if (status /= 0 ) value = "no"
+ hp%polarized = (value == "yes")
+
+ call get_value(attributes,"core-corrections", &
+ hp%core_corrections,status)
+ if (status /= 0 ) hp%core_corrections = "nc"
+
+
+!------------------------------------------------------------
+! Global grid information
+!
+call rewind_xmlfile(fxml)
+call get_node(fxml,path="/pseudo/grid", &
+ attributes=attributes,status=status)
+
+if (status == 0) then
+ print *, "This file has a global grid... "
+ call get_grid_data(attributes,global_grid)
+else
+ global_grid%npts = 0 ! To flag absence of global grid info
+endif
+!
+!------------------------------------------------------------
+! Valence charge
+!
+call rewind_xmlfile(fxml)
+!
+call mark_node(fxml,path="/pseudo/valence-charge", &
+ attributes=attributes,status=status)
+if (status == 0) then
+ !
+ ! Get the data (and possible private grid)
+ !
+ call get_radfunc_data(fxml,global_grid,pseudo%valence_charge)
+endif
+!
+!------------------------------------------------------------
+! Core charge
+!
+call rewind_xmlfile(fxml)
+!
+call mark_node(fxml,path="/pseudo/pseudocore-charge", &
+ attributes=attributes,status=status)
+if (status == 0) then
+ !
+ ! Get the data (and possible private grid)
+ !
+ call get_radfunc_data(fxml,global_grid,pseudo%core_charge)
+endif
+!
+!------------------------------------------------------------
+! Semilocal pseudopotentials
+!
+call rewind_xmlfile(fxml)
+!
+call get_node(fxml,path="//semilocal", &
+ attributes=attributes,status=status)
+if (status /= 0) call die("Cannot find semilocal element")
+
+ call get_value(attributes,"npots-down",value,status)
+ if (status /= 0 ) call die("Cannot determine npots-down")
+ read(unit=value,fmt=*) pseudo%npots_down
+
+ call get_value(attributes,"npots-up",value,status)
+ if (status /= 0 ) call die("Cannot determine npots-up")
+ read(unit=value,fmt=*) pseudo%npots_up
+
+!
+! Loop over pseudopotentials
+!
+pseudo%npots = 0
+do
+ !
+ ! This will search for all the 'vps' elements, marking the context
+ ! in turn
+ !
+ call mark_node(fxml,path="//vps",attributes=attributes,status=status)
+ if (status /= 0) exit ! exit loop
+
+ pseudo%npots = pseudo%npots + 1
+ pp => pseudo%pot(pseudo%npots)
+
+ call get_value(attributes,"l",value,status)
+ if (status /= 0 ) call die("Cannot determine l for Vps")
+ read(unit=value,fmt=*) pp%l
+
+ call get_value(attributes,"principal-n",value,status)
+ if (status /= 0 ) call die("Cannot determine n for Vps")
+ read(unit=value,fmt=*) pp%n
+
+ call get_value(attributes,"cutoff",value,status)
+ if (status /= 0 ) call die("Cannot determine cutoff for Vps")
+ read(unit=value,fmt=*) pp%cutoff
+
+ call get_value(attributes,"occupation",value,status)
+ if (status /= 0 ) call die("Cannot determine occupation for Vps")
+ read(unit=value,fmt=*) pp%occupation
+
+ call get_value(attributes,"spin",value,status)
+ if (status /= 0 ) call die("Cannot determine spin for Vps")
+ read(unit=value,fmt=*) pp%spin
+
+ !
+ ! Get the data (and possible private grid)
+ !
+ call get_radfunc_data(fxml,global_grid,pp%V)
+ !
+ ! After context delegation it is essential to sync the handle
+ ! (or to rewind it)
+ !
+ call sync_xmlfile(fxml,status)
+enddo
+
+!
+! Show some of the information
+!
+call dump_pseudo(pseudo)
+
+!=======================================================================
+CONTAINS
+
+!-----------------------------------------------------------------------
+subroutine get_radfunc_data(context,global_grid,rp)
+!
+! Example of routine which packages parsing functionality for a
+! common element. The element can appear under ,
+! , and elements.
+! In all cases the parsing steps are exactly the same.
+! This routine accepts the appropriate context handle and returns
+! the data structure.
+!
+type(xml_t), intent(in) :: context
+type(grid_t), intent(in) :: global_grid
+type(radfunc_t), intent(out) :: rp
+
+type(xml_t) :: ff
+character(len=2000) :: pcdata
+
+ff = context ! It inherits the "ancestor element" markings, etc
+
+ call get_node(ff,path="./radfunc/grid", &
+ attributes=attributes,status=status)
+ if (status == 0) then
+ print *, " >> local grid found"
+ call get_grid_data(attributes,rp%grid)
+ else
+ rp%grid = global_grid
+ endif
+
+ ff = context
+ call sync_xmlfile(ff,status) ! Go back to beginning of context
+
+ call get_node(ff,path="./radfunc/data", &
+ pcdata=pcdata,status=status)
+ if (status < 0) call die("Cannot find data element")
+ if (status > 0) call die("Not enough space for pcdata")
+ if (rp%grid%npts == 0) call die("Need grid information!")
+ allocate(rp%data(rp%grid%npts))
+ ndata = 0 ! To start the build up
+ call build_data_array(pcdata,rp%data,ndata)
+ if (ndata /= size(rp%data)) STOP "npts mismatch"
+end subroutine get_radfunc_data
+!-----------------------------------------------------------------------
+subroutine get_grid_data(attributes,grid)
+type(dictionary_t), intent(in) :: attributes
+type(grid_t), intent(out) :: grid
+
+ call get_value(attributes,"type",grid%type,status)
+ if (status /= 0 ) call die("Cannot determine grid type")
+
+ call get_value(attributes,"npts",value,status)
+ if (status /= 0 ) call die("Cannot determine grid npts")
+ read(unit=value,fmt=*) grid%npts
+
+ call get_value(attributes,"scale",value,status)
+ if (status /= 0 ) call die("Cannot determine grid scale")
+ read(unit=value,fmt=*) grid%scale
+
+ call get_value(attributes,"step",value,status)
+ if (status /= 0 ) call die("Cannot determine grid step")
+ read(unit=value,fmt=*) grid%step
+
+end subroutine get_grid_data
+
+!-----------------------------------------------------------------------
+ subroutine die(str)
+ character(len=*), intent(in), optional :: str
+ if (present(str)) then
+ write(unit=0,fmt="(a)") trim(str)
+ endif
+ write(unit=0,fmt="(a)") "Stopping Program"
+ stop
+ end subroutine die
+
+end program pseudo_read
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/xpath/i.relative.f90
===================================================================
--- /XMLF90/doc/Examples/xpath/i.relative.f90 (revision 6)
+++ /XMLF90/doc/Examples/xpath/i.relative.f90 (revision 6)
@@ -0,0 +1,67 @@
+program relative
+!
+! Example of XPATH-lite processing
+!
+use flib_xpath
+
+type(dictionary_t) :: attributes
+type(xml_t) :: fxml
+
+integer :: status
+
+call open_xmlfile("Ba.xml",fxml,status)
+if (status /=0) then
+ print * , "Cannot open file."
+ stop
+endif
+
+!call enable_debug(sax=.false.)
+
+!
+job_search: do
+ !
+ ! This will search for all the 'job' elements and all the
+ ! 'shell' elements with l=0 contained in them at any depth
+ ! (relative search).
+
+ call mark_node(fxml,path="/atom/job",attributes=attributes,status=status)
+ if (status /= 0) then
+ print *, "No more 'job' elements"
+ exit job_search
+ else
+ print *, ">>>>>>>>>>> New job: "
+ call print_dict(attributes)
+ endif
+
+ shell_search: do
+ !
+ ! The initial dot (.) signals a relative search
+ !
+ call get_node(fxml,path=".//shell",att_name="l", &
+ att_value="0",attributes=attributes,status=status)
+ if (status /= 0) then
+ print *, "end of job"
+ exit shell_search
+ endif
+ print *, " Found Shell with l=0: "
+ call print_dict(attributes)
+ print *, "------------------------------------***"
+ enddo shell_search
+
+enddo job_search
+
+end program relative
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/xpath/i.text.f90
===================================================================
--- /XMLF90/doc/Examples/xpath/i.text.f90 (revision 6)
+++ /XMLF90/doc/Examples/xpath/i.text.f90 (revision 6)
@@ -0,0 +1,46 @@
+program text
+!
+! Example of XPATH-lite processing
+!
+use flib_xpath
+
+type(xml_t) :: fxml
+
+integer :: status
+character(len=100) :: title
+
+call open_xmlfile("Ba.xml",fxml,status)
+if (status /=0) then
+ print * , "Cannot open file."
+ stop
+endif
+
+!call enable_debug(sax=.false.)
+
+!
+! Search for and print all "title" elements
+!
+do
+ call get_node(fxml,path="//title",pcdata=title,status=status)
+ if (status /= 0) then
+ exit
+ else
+ print *, "Title found: ", trim(title)
+ endif
+enddo
+
+end program text
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/xpath/m_pseudo_types.f90
===================================================================
--- /XMLF90/doc/Examples/xpath/m_pseudo_types.f90 (revision 6)
+++ /XMLF90/doc/Examples/xpath/m_pseudo_types.f90 (revision 6)
@@ -0,0 +1,107 @@
+module m_pseudo_types
+!
+! Data structures for a prototype pseudopotential
+!
+integer, parameter, private :: MAXN_POTS = 8
+integer, parameter, private :: dp = selected_real_kind(14)
+!
+public :: dump_pseudo
+!
+!-----------------------------------------------------------
+type, public :: grid_t
+!
+! It should be possible to represent both log and linear
+! grids with a few parameters here.
+!
+ character(len=20) :: type
+ real(kind=dp) :: scale
+ real(kind=dp) :: step
+ integer :: npts
+end type grid_t
+!
+type, public :: radfunc_t
+ type(grid_t) :: grid
+ real(kind=dp), dimension(:), pointer :: data
+end type radfunc_t
+
+type, public :: vps_t
+ integer :: l
+ integer :: n
+ integer :: spin
+ real(kind=dp) :: occupation
+ real(kind=dp) :: cutoff
+ type(radfunc_t) :: V
+end type vps_t
+
+type, public :: header_t
+ character(len=2) :: symbol
+ real(kind=dp) :: zval
+ character(len=10) :: creator
+ character(len=10) :: date
+ character(len=40) :: flavor
+ logical :: relativistic
+ logical :: polarized
+ character(len=2) :: correlation
+ character(len=4) :: core_corrections
+end type header_t
+
+type, public :: pseudo_t
+ type(header_t) :: header
+ integer :: npots
+ integer :: npots_down
+ integer :: npots_up
+ type(vps_t), dimension(MAXN_POTS) :: pot
+ type(radfunc_t) :: core_charge
+ type(radfunc_t) :: valence_charge
+end type pseudo_t
+
+
+CONTAINS !===============================================
+
+subroutine dump_pseudo(pseudo)
+type(pseudo_t), intent(in), target :: pseudo
+
+integer :: i
+type(vps_t), pointer :: pp
+type(radfunc_t), pointer :: rp
+
+print *, "---PSEUDO data:"
+
+do i = 1, pseudo%npots
+ pp => pseudo%pot(i)
+ rp => pseudo%pot(i)%V
+ print *, "VPS ", i, " angular momentum: ", pp%l
+ print *, " n: ", pp%n
+ print *, " occupation: ", pp%occupation
+ print *, " cutoff: ", pp%cutoff
+ print *, " spin: ", pp%spin
+ print *, "grid data: ", rp%grid%npts, rp%grid%scale
+enddo
+rp => pseudo%valence_charge
+print *, "grid data: ", rp%grid%npts, rp%grid%scale
+rp => pseudo%core_charge
+print *, "grid data: ", rp%grid%npts, rp%grid%scale
+
+end subroutine dump_pseudo
+
+end module m_pseudo_types
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/xpath/makefile
===================================================================
--- /XMLF90/doc/Examples/xpath/makefile (revision 6)
+++ /XMLF90/doc/Examples/xpath/makefile (revision 6)
@@ -0,0 +1,37 @@
+#
+# Makefile for Xpath examples
+#
+default: all
+all: relative pseudo text
+#
+#---------------------------
+MK=$(FLIB_ROOT)/fortran.mk
+include $(MK)
+#---------------------------
+#
+# Uncomment the following line for debugging support
+#
+FFLAGS=$(FFLAGS_DEBUG)
+#
+LIBS=$(LIB_PREFIX)$(LIB_STD) -lflib
+#
+relative: relative.o
+ $(FC) $(LDFLAGS) -o relative relative.o $(LIBS)
+pseudo: m_pseudo_types.o pseudo.o
+ $(FC) $(LDFLAGS) -o pseudo m_pseudo_types.o pseudo.o $(LIBS)
+text: text.o
+ $(FC) $(LDFLAGS) -o text text.o $(LIBS)
+#
+clean:
+ rm -f relative pseudo text *.o *.$(MOD_EXT)
+#
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/xpath/pseudo.f90
===================================================================
--- /XMLF90/doc/Examples/xpath/pseudo.f90 (revision 6)
+++ /XMLF90/doc/Examples/xpath/pseudo.f90 (revision 6)
@@ -0,0 +1,277 @@
+program pseudo_read
+!
+! Example of XPATH-lite processing for pseudo xml file
+! Shows the use of constrained searches, context delegation, etc.
+!
+use flib_xpath
+use m_pseudo_types
+
+type(dictionary_t) :: attributes
+type(xml_t) :: fxml
+
+type(pseudo_t), target, save :: pseudo
+type(grid_t), save :: global_grid
+!
+! Pointers to make it easier to manage the data
+!
+type(header_t), pointer :: hp
+type(vps_t), pointer :: pp
+
+integer :: status, ndata
+character(len=200) :: value
+
+!-----------------------------------------------------------------
+call open_xmlfile("pseudo.xml",fxml,status)
+if (status /=0) call die("Cannot open file.")
+
+!call enable_debug(sax=.false.)
+
+!
+!------------------------------------------------------------
+! Root element with version information
+!
+call get_node(fxml,path="/pseudo",attributes=attributes,status=status)
+if (status /= 0) call die("Cannot find pseudo element")
+
+ call get_value(attributes,"version",value,status)
+ if (value == "0.5") then
+ print *, "Processing a PSEUDO version 0.5 XML file"
+ else
+ call die("Can only work with PSEUDO version 0.5 XML files")
+ endif
+
+!------------------------------------------------------------
+! Header
+!
+call get_node(fxml,path="/pseudo/header", &
+ attributes=attributes,status=status)
+if (status /= 0) call die("Cannot find /pseudo/header")
+
+ hp => pseudo%header
+
+ call get_value(attributes,"symbol",hp%symbol,status)
+ if (status /= 0 ) call die("Cannot determine atomic symbol")
+
+ call get_value(attributes,"zval",value,status)
+ if (status /= 0 ) call die("Cannot determine zval")
+ read(unit=value,fmt=*) hp%zval
+!
+ call get_value(attributes,"creator",hp%creator,status)
+ if (status /= 0 ) hp%creator="unknown"
+
+ call get_value(attributes,"flavor",hp%flavor,status)
+ if (status /= 0 ) hp%flavor="unknown"
+
+ call get_value(attributes,"relativistic",value,status)
+ if (status /= 0 ) value = "no"
+ hp%relativistic = (value == "yes")
+
+ call get_value(attributes,"polarized",value,status)
+ if (status /= 0 ) value = "no"
+ hp%polarized = (value == "yes")
+
+ call get_value(attributes,"core-corrections", &
+ hp%core_corrections,status)
+ if (status /= 0 ) hp%core_corrections = "nc"
+
+
+!------------------------------------------------------------
+! Global grid information
+!
+call rewind_xmlfile(fxml)
+call get_node(fxml,path="/pseudo/grid", &
+ attributes=attributes,status=status)
+
+if (status == 0) then
+ print *, "This file has a global grid... "
+ call get_grid_data(attributes,global_grid)
+else
+ global_grid%npts = 0 ! To flag absence of global grid info
+endif
+!
+!------------------------------------------------------------
+! Valence charge
+!
+call rewind_xmlfile(fxml)
+!
+call mark_node(fxml,path="/pseudo/valence-charge", &
+ attributes=attributes,status=status)
+if (status == 0) then
+ !
+ ! Get the data (and possible private grid)
+ !
+ call get_radfunc_data(fxml,global_grid,pseudo%valence_charge)
+endif
+!
+!------------------------------------------------------------
+! Core charge
+!
+call rewind_xmlfile(fxml)
+!
+call mark_node(fxml,path="/pseudo/pseudocore-charge", &
+ attributes=attributes,status=status)
+if (status == 0) then
+ !
+ ! Get the data (and possible private grid)
+ !
+ call get_radfunc_data(fxml,global_grid,pseudo%core_charge)
+endif
+!
+!------------------------------------------------------------
+! Semilocal pseudopotentials
+!
+call rewind_xmlfile(fxml)
+!
+call get_node(fxml,path="//semilocal", &
+ attributes=attributes,status=status)
+if (status /= 0) call die("Cannot find semilocal element")
+
+ call get_value(attributes,"npots-down",value,status)
+ if (status /= 0 ) call die("Cannot determine npots-down")
+ read(unit=value,fmt=*) pseudo%npots_down
+
+ call get_value(attributes,"npots-up",value,status)
+ if (status /= 0 ) call die("Cannot determine npots-up")
+ read(unit=value,fmt=*) pseudo%npots_up
+
+!
+! Loop over pseudopotentials
+!
+pseudo%npots = 0
+do
+ !
+ ! This will search for all the 'vps' elements, marking the context
+ ! in turn
+ !
+ call mark_node(fxml,path="//vps",attributes=attributes,status=status)
+ if (status /= 0) exit ! exit loop
+
+ pseudo%npots = pseudo%npots + 1
+ pp => pseudo%pot(pseudo%npots)
+
+ call get_value(attributes,"l",value,status)
+ if (status /= 0 ) call die("Cannot determine l for Vps")
+ read(unit=value,fmt=*) pp%l
+
+ call get_value(attributes,"principal-n",value,status)
+ if (status /= 0 ) call die("Cannot determine n for Vps")
+ read(unit=value,fmt=*) pp%n
+
+ call get_value(attributes,"cutoff",value,status)
+ if (status /= 0 ) call die("Cannot determine cutoff for Vps")
+ read(unit=value,fmt=*) pp%cutoff
+
+ call get_value(attributes,"occupation",value,status)
+ if (status /= 0 ) call die("Cannot determine occupation for Vps")
+ read(unit=value,fmt=*) pp%occupation
+
+ call get_value(attributes,"spin",value,status)
+ if (status /= 0 ) call die("Cannot determine spin for Vps")
+ read(unit=value,fmt=*) pp%spin
+
+ !
+ ! Get the data (and possible private grid)
+ !
+ call get_radfunc_data(fxml,global_grid,pp%V)
+ !
+ ! After context delegation it is essential to sync the handle
+ ! (or to rewind it)
+ !
+ call sync_xmlfile(fxml,status)
+enddo
+
+!
+! Show some of the information
+!
+call dump_pseudo(pseudo)
+
+!=======================================================================
+CONTAINS
+
+!-----------------------------------------------------------------------
+subroutine get_radfunc_data(context,global_grid,rp)
+!
+! Example of routine which packages parsing functionality for a
+! common element. The element can appear under ,
+! , and elements.
+! In all cases the parsing steps are exactly the same.
+! This routine accepts the appropriate context handle and returns
+! the data structure.
+!
+type(xml_t), intent(in) :: context
+type(grid_t), intent(in) :: global_grid
+type(radfunc_t), intent(out) :: rp
+
+type(xml_t) :: ff
+character(len=2000) :: pcdata
+
+ff = context ! It inherits the "ancestor element" markings, etc
+
+ call get_node(ff,path="./radfunc/grid", &
+ attributes=attributes,status=status)
+ if (status == 0) then
+ print *, " >> local grid found"
+ call get_grid_data(attributes,rp%grid)
+ else
+ rp%grid = global_grid
+ endif
+
+ ff = context
+ call sync_xmlfile(ff,status) ! Go back to beginning of context
+
+ call get_node(ff,path="./radfunc/data", &
+ pcdata=pcdata,status=status)
+ if (status < 0) call die("Cannot find data element")
+ if (status > 0) call die("Not enough space for pcdata")
+ if (rp%grid%npts == 0) call die("Need grid information!")
+ allocate(rp%data(rp%grid%npts))
+ ndata = 0 ! To start the build up
+ call build_data_array(pcdata,rp%data,ndata)
+ if (ndata /= size(rp%data)) STOP "npts mismatch"
+end subroutine get_radfunc_data
+!-----------------------------------------------------------------------
+subroutine get_grid_data(attributes,grid)
+type(dictionary_t), intent(in) :: attributes
+type(grid_t), intent(out) :: grid
+
+ call get_value(attributes,"type",grid%type,status)
+ if (status /= 0 ) call die("Cannot determine grid type")
+
+ call get_value(attributes,"npts",value,status)
+ if (status /= 0 ) call die("Cannot determine grid npts")
+ read(unit=value,fmt=*) grid%npts
+
+ call get_value(attributes,"scale",value,status)
+ if (status /= 0 ) call die("Cannot determine grid scale")
+ read(unit=value,fmt=*) grid%scale
+
+ call get_value(attributes,"step",value,status)
+ if (status /= 0 ) call die("Cannot determine grid step")
+ read(unit=value,fmt=*) grid%step
+
+end subroutine get_grid_data
+
+!-----------------------------------------------------------------------
+ subroutine die(str)
+ character(len=*), intent(in), optional :: str
+ if (present(str)) then
+ write(unit=0,fmt="(a)") trim(str)
+ endif
+ write(unit=0,fmt="(a)") "Stopping Program"
+ stop
+ end subroutine die
+
+end program pseudo_read
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/xpath/pseudo.xml
===================================================================
--- /XMLF90/doc/Examples/xpath/pseudo.xml (revision 6)
+++ /XMLF90/doc/Examples/xpath/pseudo.xml (revision 6)
@@ -0,0 +1,164 @@
+
+
+
+
+
+
+
+
+
+ -0.331900385172E-04 -0.667975563254E-04 -0.100827804667E-03 -0.135286100838E-03
+ -0.170177829017E-03 -0.205508441107E-03 -0.241283457588E-03 -0.277508468378E-03
+
+
+
+
+
+
+ -0.498621054540E-04 -0.100351398985E-03 -0.151475769648E-03 -0.203243205728E-03
+ -0.255661795995E-03 -0.308739730957E-03 -0.362485304152E-03 -0.416906913432E-03
+
+
+
+
+
+
+ -0.864406179730E-04 -0.173968525070E-03 -0.262597397705E-03 -0.352341084318E-03
+ -0.443213607544E-03 -0.535229166399E-03 -0.628402138500E-03 -0.722747082314E-03
+
+
+
+
+
+
+ -0.469203541965E-04 -0.944308937944E-04 -0.142539042412E-03 -0.191252317045E-03
+ -0.240578329241E-03 -0.290524786291E-03 -0.341099492429E-03 -0.392310350056E-03
+
+
+
+
+
+
+
+ 0.277250403619E-06 0.557988188005E-06 0.842257219008E-06 0.113010191424E-05
+ 0.142156725002E-05 0.171669876841E-05 0.201554258430E-05 0.231814539264E-05
+
+
+
+
+
+
+ 0.369459072892E-07 0.743565368829E-07 0.112237734268E-06 0.150595418459E-06
+ 0.189435582921E-06 0.228764296510E-06 0.268587704417E-06 0.308912029131E-06
+
+
+
+
+
+
+ 0.108684130278E-07 0.218735338622E-07 0.330170820757E-07 0.443007988704E-07
+ 0.557264473500E-07 0.672958127953E-07 0.790107029432E-07 0.908729482692E-07
+
+
+
+
+
+
+
+ 0.770415732749E-11 0.312054737246E-10 0.711001067937E-10 0.128001774477E-09
+ 0.202542230650E-09 0.295371753147E-09 0.407159644529E-09 0.538594745943E-09
+
+
+
+
+
+
+
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+ 0.00000000000 0.00000000000 0.00000000000 0.00000000000
+
+
+
+
Index: /XMLF90/doc/Examples/xpath/relative.f90
===================================================================
--- /XMLF90/doc/Examples/xpath/relative.f90 (revision 6)
+++ /XMLF90/doc/Examples/xpath/relative.f90 (revision 6)
@@ -0,0 +1,67 @@
+program relative
+!
+! Example of XPATH-lite processing
+!
+use flib_xpath
+
+type(dictionary_t) :: attributes
+type(xml_t) :: fxml
+
+integer :: status
+
+call open_xmlfile("Ba.xml",fxml,status)
+if (status /=0) then
+ print * , "Cannot open file."
+ stop
+endif
+
+!call enable_debug(sax=.false.)
+
+!
+job_search: do
+ !
+ ! This will search for all the 'job' elements and all the
+ ! 'shell' elements with l=0 contained in them at any depth
+ ! (relative search).
+
+ call mark_node(fxml,path="/atom/job",attributes=attributes,status=status)
+ if (status /= 0) then
+ print *, "No more 'job' elements"
+ exit job_search
+ else
+ print *, ">>>>>>>>>>> New job: "
+ call print_dict(attributes)
+ endif
+
+ shell_search: do
+ !
+ ! The initial dot (.) signals a relative search
+ !
+ call get_node(fxml,path=".//shell",att_name="l", &
+ att_value="0",attributes=attributes,status=status)
+ if (status /= 0) then
+ print *, "end of job"
+ exit shell_search
+ endif
+ print *, " Found Shell with l=0: "
+ call print_dict(attributes)
+ print *, "------------------------------------***"
+ enddo shell_search
+
+enddo job_search
+
+end program relative
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Examples/xpath/text.f90
===================================================================
--- /XMLF90/doc/Examples/xpath/text.f90 (revision 6)
+++ /XMLF90/doc/Examples/xpath/text.f90 (revision 6)
@@ -0,0 +1,46 @@
+program text
+!
+! Example of XPATH-lite processing
+!
+use flib_xpath
+
+type(xml_t) :: fxml
+
+integer :: status
+character(len=100) :: title
+
+call open_xmlfile("Ba.xml",fxml,status)
+if (status /=0) then
+ print * , "Cannot open file."
+ stop
+endif
+
+!call enable_debug(sax=.false.)
+
+!
+! Search for and print all "title" elements
+!
+do
+ call get_node(fxml,path="//title",pcdata=title,status=status)
+ if (status /= 0) then
+ exit
+ else
+ print *, "Title found: ", trim(title)
+ endif
+enddo
+
+end program text
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/KNOWN_ISSUES
===================================================================
--- /XMLF90/doc/KNOWN_ISSUES (revision 6)
+++ /XMLF90/doc/KNOWN_ISSUES (revision 6)
@@ -0,0 +1,23 @@
+KNOWN ISSUES as of version 1.1.
+
+** CHARACTER ENCODINGS
+
+Only single-byte encodings are supported at this time.
+
+** XPATH API.
+
+This API is not solid yet, particularly in the area of contexts handling.
+A new one is coming based on the DOM, but, not being stream-oriented, it
+will loose its small memory footprint and speed.
+
+** COMPILER SUPPORT.
+
+The parser will not work with the (very old) PGI compiler pgf90 Version 3.2
+due to a bug in their I/O. It runs well with Version 5.0.
+
+You need a F95 compiler to process the DOM subsystem.
+
+
+
+
+
Index: /XMLF90/doc/README
===================================================================
--- /XMLF90/doc/README (revision 6)
+++ /XMLF90/doc/README (revision 6)
@@ -0,0 +1,14 @@
+This is a beta version of xmlf90-1.2, which contains significant
+new features. Please see the file Tutorial/Guide.html and
+the ReleaseNotes-1.2 file.
+
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/ReleaseNotes-1.1
===================================================================
--- /XMLF90/doc/ReleaseNotes-1.1 (revision 6)
+++ /XMLF90/doc/ReleaseNotes-1.1 (revision 6)
@@ -0,0 +1,19 @@
+Release Notes for Version 1.1
+30 January 2004
+
+1. Added support for character references of the form dd; and hh;
+where dd is a decimal number and hh a hexadecimal number.
+
+2. Revamped the reader module to perform a cleaner processing of
+characters and line/column accounting, even with non-Unix end of
+lines.
+
+3. Added routine xml_char_count to request the value of the character
+counter.
+
+4. Initialize explicitly all components of derived-type variables at
+run time (Fortran90 does not allow to do this at compile time).
+
+5. Proper echo of the XML declarations when they
+contain [, ], <, and > characters.
+
Index: /XMLF90/doc/ReleaseNotes-1.2
===================================================================
--- /XMLF90/doc/ReleaseNotes-1.2 (revision 6)
+++ /XMLF90/doc/ReleaseNotes-1.2 (revision 6)
@@ -0,0 +1,58 @@
+Beta-Release Notes for Version 1.2
+Beta version
+
+April 2004
+
+Very many changes:
+
+New DOM API, conceived by Jon Wakelin and implemented by Jon and
+Alberto Garcia.
+
+New WXML API to write well-formed XML, by Alberto Garcia
+
+New CML (writing) API, built on top of WXML, contributed by Jon Wakelin.
+
+Documentation for the new features is still quite sparse.
+---------------------------------------------------------------
+
+Changes for 1.2g: (April 28, 2004)
+
+SAX
+
+* New optional argument "record_size" in open_xmlfile. The default record
+length is 65536, but for overly long lines it might be necessary to specify
+a larger size.
+
+* Wrote "init_" routines to avoid undefined status for the components
+of the buffer, dictionary, and elstack derived types (Fortran90 restriction).
+They are called just once at the beginning of execution.
+
+The "reset_" routines just zero out the counters in the derived
+types. This leads to substantial savings in overhead.
+
+* Avoided when possible the allocation of temporaries (mostly strings) by
+the compilers. This was particularly acute in the "action" records. The
+typical idiom:
+
+ action =trim("Reading character in name: " // c)
+
+forced the allocation of a temporary. The number of compiler allocations
+(at least with NAG) has dropped down to just those needed in the processing
+of entities.
+
+* Put the explicit module dependencies in the makefile.
+
+* Increased the standard size of the buffers and dictionaries.
+***** The program now stops when those sizes are not enough.
+
+DOM
+
+Some bug fixes
+
+STRINGS
+
+Fix assign_s_to_s (it could be that source is not allocated)
+
+-------------------------------------------------------------------------
+
+
Index: /XMLF90/doc/Tutorial/DOM.html
===================================================================
--- /XMLF90/doc/Tutorial/DOM.html (revision 6)
+++ /XMLF90/doc/Tutorial/DOM.html (revision 6)
@@ -0,0 +1,158 @@
+
+
+
+
+
+
+
+ FDOM
+ The FDOM is a DOM level 1.0 implementation written in F95. There are two "gotchas"
+ that the Fortran programmer should be aware of, and I can't stress either strongly enough.
+ Firstly the DOM, like many programming languages, starts counting from 0, and not 1, for this reason all do loops should run from 0 to length - 1.
+ Secondly, we while we can not return an object in Fortran per se,
+ we can return a pointer to an arbitrary structure containing mulitple members, including substructures (which is very much like returning an object).
+ Therefore, you must use the pointer syntax:
+
+program main
+
+ use flib_dom
+
+ type(fnode), pointer :: object
+ type(fnode), pointer :: myNode
+
+ object => getParentNode(myNode)
+
+ and not
+
+program main
+
+ use flib_dom
+
+ type(fnode) :: object
+ type(fnode) :: myNode
+
+ object = getParentNode(myNode)
+
+
+ I can anticipate that these two issues (over running lists by
+ counting beyond the last item and trying to assign a pointer with =)
+ will be the cause of most programming errors using FDOM. But fairly
+ soon you get used to it, if you already program in other languages,
+ or already use pointers in Fortran there shouldn't be any problem at
+ all.
+
+Here is a list of the the methods implemented:
+
+
+
+
+ (Generic) Node Interface
+
+ - getNodeName(node)
+ - getNodevalue)
+ - getNodeType(node)
+ - hasChildNodes(node)
+ - hasAttributes(node)
+ - getParentNode(node)
+ - getFirstChild(node)
+ - getLastChild(node)
+ - getNextSibling(node)
+ - getPreviousSibling(node)
+ - getOwnerDocument(node)
+ - getAttributes(node)
+ - getChildNodes(node)
+ - setNodeValue(node, value)
+ - appendChild(node, newChild)
+ - removeChild(node, oldChild)
+ - replaceChild(node, newChild, oldChild)
+ - cloneNode(node, [deep])
+ - isSameNode(node, node2)
+ - insertBefore(node, newChild, refChild)
+
+ element Node Interface
+
+ - getTagName(element)
+ - getElementsByTagName(elment, tag)
+ - getAttribute(element, name)
+ - getAttributeNode(element, name)
+ - setAttribute(element, name, value)
+ - setAttributeNode(element, newAttribute)
+ - removeAttribute(element, name)
+
+ document Node Interface
+
+ - createTextNode(text)
+ - createAttribute(name)
+ - createElement(name)
+ - createComment(data)
+ - getElementsByTagName(document, tag)
+
+ attribute Node Interface
+
+ - getName(attr)
+ - getValue(attr)
+ - setValue(attr, value)
+
+ nodeList Interface
+
+ - item(nodeList, i)
+ - getLength(nodeList)
+
+ namedNodeMap Interface
+
+ - item(namedNodeMap, i)
+ - getLength(namedNodeMap)
+ - getNamedItem(namedNodeMap, name)
+ - setNamedItem(namedNodeMap, name)
+ - removeNamedItem(namedNodeMap, name)
+
+
+
+
+
+ A partial list of the interfaces of the methods implemented
+ follows. For a full listing, please see the code in subdirectory
+ dom of the main distribution.
+
+
+ -
+
+ method | arguments | returns | DOM Level |
+ getNodeName(node) | type(fnode) :: node | string | 1.0 |
+ getNodeValue(node) | type(fnode) :: node | string | 1.0 |
+ getNodeType(node) | type(fnode) ::
+ node | (integer code) | 1.0 |
+ getParentNode(node) | type(fnode) :: node | type(fnode) | 1.0 |
+ getFirstChild(node) | type(fnode) :: node | type(fnode) | 1.0 |
+ getLastChild(node) | type(fnode) :: node | type(fnode) | 1.0 |
+ getPreviousSibling(node) | type(fnode) :: node | type(fnode) | 1.0 |
+ getNextSibling(node) | type(fnode) :: node | type(fnode) | 1.0 |
+ getOwnerDocument(node) | type(fnode) :: node | type(fnode) | 1.0 |
+ getAttributes(node) | type(fnode) :: node | type(fnamedNodeMap) | 1.0 |
+ getChildNodes(node) | type(fnode) :: node | type(fnodeList) | 1.0 |
+ getOwnerDocument(node) | type(fnode) :: node | type(fnode) | 1.0 |
+
+ appendChild(node, newChild) | type(fnode) :: node type(fnode) :: newChild | type(fnode) | 1.0 |
+ removeChild(node, oldChild) | type(fnode) :: node type(fnode) :: oldChild | type(fnode) | 1.0 |
+ replaceChild(node, newChild, oldChild) | type(fnode) :: node type(fnode) :: newChild type(fnode) :: oldChild | type(fnode) | 1.0 |
+ replaceChild(node, refChild, oldChild) | type(fnode) :: node type(fnode) :: refChild type(fnode) :: oldChild | type(fnode) | 1.0 |
+ hasChildren(node) | type(fnode) :: node | logical | 1.0 |
+ hasAttributes | type(fnode) :: node | logical | 2.0 |
+ isSameNode(node, node2) | type(fnode) :: node type(fnode) :: node2 | logical | 3.0 |
+
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Tutorial/Guide.html
===================================================================
--- /XMLF90/doc/Tutorial/Guide.html (revision 6)
+++ /XMLF90/doc/Tutorial/Guide.html (revision 6)
@@ -0,0 +1,74 @@
+
+
+
+
+
+
+
+ Fortran XML Tools
+
+ SAX
+ Flib SAX is a SAX level 1.0 implementation in Fortran 90.
+ A PDF Tutorial and UserGuide is available here
+
+
+ Stream Xpath
+ Stream Xpath is a library that emulates some of the features of
+ the Xpath standard, but working within the stream model of
+ SAX.
+ Its small memory footprint makes it quite useful to process large
+ datafiles, for which the standard Xpath (built on top of the
+ memory-intensive DOM) would not be appropriate. However, the
+ stream paradigm forces the user to be careful about controlling
+ the state of the parser.
+ A PDF Tutorial and UserGuide is available here
+
+
+ WXML
+ WXML is a library that facilitates the writing of well-formed
+ XML, including such features as automatic start-tag completion,
+ attribute pretty-printing, and element indentation. There are also
+ helper routines to handle the output of numerical arrays.
+
+ Desription of the routines
+
+ See also the examples in the Examples/wxml
+ subdirectory of the main distribution.
+
+ Jon Wakelin has written a CML-formatting library on top of
+ a slightly modified WXML.
+ Documentation is available here.
+ For examples of CML-formatting in strict WXML, see the Examples/cml
+ subdirectory of the main xmlf90 distribution. The two strands of
+ WXML will be merged very soon.
+
+ FDOM
+ FDOM is a a DOM level 1.0 implementation in Fortran 95.
+ We have implemented almost all the instance methods,
+ although it is unlikely that any of the class methods
+ will ever be implemented.
+ The FDOM is still evolving but is already in a usable state.
+ More importantly, as all of the interfaces are standard,
+ changes to the code will only take place behind the scenes.
+
+ A page containing a breakdown of the
+ FDOM methods is available here
+ See also the examples in the Examples/dom
+ subdirectory of the main distribution.
+
+
+
+
+ Jon Wakelin, Alberto Garcia, April 2004
+
+
+
Index: /XMLF90/doc/Tutorial/README
===================================================================
--- /XMLF90/doc/Tutorial/README (revision 6)
+++ /XMLF90/doc/Tutorial/README (revision 6)
@@ -0,0 +1,55 @@
+See the UserGuide for a tutorial and a reference to the
+SAX and stream XPATH parser APIs.
+
+The sax and xpath directories contain the source for the exercises in
+the User Guide.
+
+The new DOM interface is documented in file DOM.html.
+The WXML writing library and the "Jumbo90" (CML writer by Jon Wakelin)
+are documented in WXML.html
+
+
+GETTING STARTED QUICKLY
+
+You should really read the User Guide, but if you insist, here is the
+*minimum* you can do to get the parser working:
+
+ * Define the environment variable FLIB_ROOT to point to the macros
+ directory in the xmlf90 distribution
+ (You could make it point anywhere, but this is the simplest setup,
+ as you have everything under the same tree)
+
+ FLIB_ROOT=/somewhere/xmlf90/macros ; export FLIB_ROOT (sh-like shells)
+ setenv FLIB_ROOT /somewhere/xmlf90/macros (csh-like shells)
+
+ * Go into macros, look through the fortran-XXXX.mk files,
+ and see if one of them applies to your computer/compiler combination.
+ If so, copy it or make a (symbolic) link to 'fortran.mk':
+
+ ln -sf fortran-lf95.mk fortran.mk
+
+ If none of the .mk files look useful, write your own, using the
+ files provided as a guide. Basically you need to figure out the
+ name and options for the compiler, the extension assigned to
+ module files, and the flag used to identify the module search path.
+
+ The above steps need only be done once.
+
+ Go back to the top directory.
+
+ If you have a Fortran95 compiler, simply type "sh build.sh"
+ If not, edit build.sh and comment out the DOM sections as directed.
+
+ * Go into subdirectory 'Examples' and explore.
+
+ * Go into subdirectory 'Tutorial' and try the exercises in the User Guide
+ (see the next section for compilation details).
+
+** Compiling user programs
+
+After installation, the appropriate modules and library files should
+already be in $FLIB_ROOT/modules and
+$FLIB_ROOT/lib, respectively. To compile user programs, it
+is suggested that the user create a separate directory to hold the
+program files and prepare a Makefile following the templates in the
+Examples/ directory.
Index: /XMLF90/doc/Tutorial/UserGuide.tex
===================================================================
--- /XMLF90/doc/Tutorial/UserGuide.tex (revision 6)
+++ /XMLF90/doc/Tutorial/UserGuide.tex (revision 6)
@@ -0,0 +1,1334 @@
+\documentclass[11pt]{article}
+%\decimalpoint
+\tolerance 10000
+\textheight 24cm
+\textwidth 16cm
+\oddsidemargin 1mm
+\topmargin -20mm
+\parindent 0mm
+\begin{document}\title{xmlf90: A parser for XML in Fortran90}
+\author{Alberto Garc\'{\i}a \\
+ Departamento de F\'{\i}sica de la Materia Condensada \\
+ Facultad de Ciencia y Tecnolog\'{\i}a \\
+ Universidad del Pa\'{\i}s Vasco\\
+ Apartado 644 , 48080 Bilbao, Spain\\
+ http://lcdx00.wm.lc.ehu.es/ag/xml/}
+\date{30 January 2004 --- xmlf90 Version 1.1}
+
+\maketitle\section{Introduction}
+
+{\bf NOTE: This version of the User Guide and Tutorial does not
+cover either the WXML printing library or the new DOM API
+conceived by Jon Wakelin. See the html reference material and the
+relevant example subdirectories.}
+\bigskip
+
+This tutorial documents the user interface of \texttt{xmlf90}, a
+native Fortran90 XML parser. The parser was designed to be a useful
+tool in the extraction and analysis of data in the context of
+scientific computing, and thus the priorities were efficiency and the
+ability to deal with very large XML files while maintaining a small
+memory footprint. There are two programming interfaces. The first is
+based on the very successful SAX (Simple API for XML) model: the
+parser calls routines provided by the user to handle certain events,
+such as the encounter of the beginning of an element, or the end of an
+element, or the reading of character data. The other is based on the
+XPATH standard. Only a very limited set of the full XPATH
+specification is offered, but it is already quite useful.
+
+Some familiarity of XML is assumed. Apart from the examples discussed
+in this tutorial (chosen for their simplicity), the interested reader
+can refer to the \texttt{Examples/} directory in the \texttt{xmlf90}
+distribution.
+
+
+
+\section{The SAX interface}
+\subsection{A simple example}
+
+To illustrate the working of the SAX interface, consider the following
+XML snippet
+
+\begin{verbatim}
+ -
+ Washing machine
+ 1500.00
+
+\end{verbatim}
+%
+When the parser processes this snippet, it carries out the sequence of calls:
+
+\begin{enumerate}
+\item call to \texttt{begin\_element\_handler} with name="item" and
+ attributes=(Dictionary with the pair (id,003))
+\item call to \texttt{begin\_element\_handler} with name="description" and an
+ empty attribute dictionary.
+\item call to \texttt{pcdata\_chunk\_handler} with pcdata="Washing machine"
+\item call to \texttt{end\_element\_handler} with name="description"
+\item call to \texttt{begin\_element\_handler} with name="price" and
+ attributes=(Dictionary with the pair (currency,euro))
+\item call to \texttt{pcdata\_chunk\_handler} with pcdata="1500.00"
+\item call to \texttt{end\_element\_handler} with name="price"
+\item call to \texttt{end\_element\_handler} with name="item"
+\end{enumerate}
+
+The handler routines are written by the user and passed to the parser
+as procedure arguments. A simple program that parses the above XML
+fragment (assuming it resides in file \textsl{inventory.xml}) and
+prints out the names of the elements and any \textsl{id} attributes as
+they are found, is:
+
+\begin{verbatim}
+program simple
+use flib_sax
+
+type(xml_t) :: fxml ! XML file object (opaque)
+integer :: iostat ! Return code (0 if OK)
+
+call open_xmlfile("inventory.xml",fxml,iostat)
+if (iostat /= 0) stop "cannot open xml file"
+
+call xml_parse(fxml, begin_element_handler=begin_element_print)
+
+contains !---------------- handler subroutine follows
+
+subroutine begin_element_print(name,attributes)
+ character(len=*), intent(in) :: name
+ type(dictionary_t), intent(in) :: attributes
+
+ character(len=3) :: id
+ integer :: status
+
+ print *, "Start of element: ", name
+ if (has_key(attributes,"id")) then
+ call get_value(attributes,"id",id,status)
+ print *, " Id attribute: ", id
+ endif
+end subroutine begin_element_print
+
+end program simple
+\end{verbatim}
+%
+To access the XML parsing functionality, the user only needs to \texttt{use}
+the module \texttt{flib\_sax}, open the XML file, and call the main routine
+\texttt{xml\_parse}, providing it with the appropriate event handlers.
+
+The subroutine interfaces are:
+
+\begin{verbatim}
+subroutine open_xmlfile(fname,fxml,iostat)
+character(len=*), intent(in) :: fname ! File name
+type(xml_t), intent(out) :: fxml ! XML file object (opaque)
+integer, intent(out ) :: iostat ! Return code (0 if OK)
+
+
+subroutine xml_parse(fxml, &
+ begin_element_handler, &
+ end_element_handler, &
+ pcdata_chunk_handler ....
+ .... MORE OPTIONAL HANDLERS )
+
+\end{verbatim}
+
+The handlers are OPTIONAL arguments (in the above example we just
+specify \texttt{begin\_element\_handler}). If no handlers are given,
+nothing useful will happen, except that any errors are detected and
+reported. The interfaces for the most useful handlers are:
+
+\begin{verbatim}
+ subroutine begin_element_handler(name,attributes)
+ character(len=*), intent(in) :: name
+ type(dictionary_t), intent(in) :: attributes
+ end subroutine begin_element_handler
+
+ subroutine end_element_handler(name)
+ character(len=*), intent(in) :: name
+ end subroutine end_element_handler
+
+ subroutine pcdata_chunk_handler(chunk)
+ character(len=*), intent(in) :: chunk
+ end subroutine pcdata_chunk_handler
+\end{verbatim}
+
+The attribute information in an element tag is represented as a
+dictionary of name/value pairs, held in a \texttt{dictionary\_t}
+abstract type. The information in it can be accessed through a set of
+dictionary methods such as \texttt{has\_key} and \texttt{get\_value}
+(full interfaces to be found in Sect.~\ref{sec:reference}).
+
+\subsection{Monitoring the sequence of events}
+The above example is too simple and not very useful if what we want is
+to extract information in a coherent manner. For example, assume we
+have a more complete inventory of appliances such as
+%
+\begin{verbatim}
+
+ -
+ Washing machine
+ 1500.00
+
+ -
+ Microwave oven
+ 300.00
+
+ -
+ Dishwasher
+ 10000.00
+
+
+\end{verbatim}
+%
+and we want to print the items with their prices in the form:
+%
+\begin{verbatim}
+003 Washing machine : 1500.00 euro
+007 Microwave oven : 300.00 euro
+011 Dishwasher : 10000.00 swedish crown
+\end{verbatim}
+
+We begin by writing the following module
+
+\begin{verbatim}
+module m_handlers
+use flib_sax
+private
+public :: begin_element, end_element, pcdata_chunk
+!
+logical, private :: in_item, in_description, in_price
+character(len=40), private :: what, price, currency, id
+!
+contains !-----------------------------------------
+!
+subroutine begin_element(name,attributes)
+ character(len=*), intent(in) :: name
+ type(dictionary_t), intent(in) :: attributes
+
+ integer :: status
+
+ select case(name)
+ case("item")
+ in_item = .true.
+ call get_value(attributes,"id",id,status)
+
+ case("description")
+ in_description = .true.
+
+ case("price")
+ in_price = .true.
+ call get_value(attributes,"currency",currency,status)
+
+ end select
+
+end subroutine begin_element
+!---------------------------------------------------------------
+subroutine pcdata_chunk_handler(chunk)
+ character(len=*), intent(in) :: chunk
+
+ if (in_description) what = chunk
+ if (in_price) price = chunk
+
+end subroutine pcdata_chunk_handler
+!---------------------------------------------------------------
+subroutine end_element(name)
+ character(len=*), intent(in) :: name
+
+ select case(name)
+ case("item")
+ in_item = .false.
+ write(unit=*,fmt="(5(a,1x))") trim(id), trim(what), ":", &
+ trim(price), trim(currency)
+
+ case("description")
+ in_description = .false.
+
+ case("price")
+ in_price = .false.
+
+ end select
+
+end subroutine end_element
+!---------------------------------------------------------------
+end module m_handlers
+\end{verbatim}
+%
+PCDATA chunks are passed back as simple fortran character variables,
+and we assign them to \texttt{what} or \texttt{price} depending on the
+context, which we monitor through the logical variables
+\texttt{in\_description, in\_price}, updated as we enter and leave
+different elements. (The variable \texttt{in\_item} is not strictly
+necessary.)
+
+The program to parse the file just needs to use the functionality in
+the module \texttt{m\_handlers}:
+%
+\begin{verbatim}
+program inventory
+use flib_sax
+use m_handlers
+
+type(xml_t) :: fxml ! XML file object (opaque)
+integer :: iostat
+
+call open_xmlfile("inventory.xml",fxml,iostat)
+if (iostat /= 0) stop "cannot open xml file"
+
+call xml_parse(fxml, begin_element_handler=begin_element, &
+ end_element_handler=end_element, &
+ pcdata_chunk_handler=pcdata_chunk )
+
+end program inventory
+
+\end{verbatim}
+%
+\subsubsection{Exercises}
+\begin{enumerate}
+\item Code the above fortran files and the XML file in your
+computer. Compile and run the program and check that the output is
+correct. (Compilation instructions are provided in
+Sect.~\ref{sec:compiling}).
+\item Edit the XML file and remove one of the \texttt{}
+lines. What happens? This is an example of a \textsl{mal-formed} XML
+file. The parser can detect it and complain about it.
+\item Edit the XML file and remove the \texttt{currency} attribute
+from one of the elements. What happens? In this case, the parser
+cannot detect the missing attribute (it is not a \textsl{validating
+parser}). However, it could be possible for the user to detect early
+that something is wrong by checking the value of the \texttt{status}
+variable after the call to \texttt{get\_value}.
+\item Modify the program to print the prices in euros (1 euro buys
+approximately 9.2 swedish crowns).
+\end{enumerate}
+
+\subsection{Other tags and their handlers}
+
+The parser can also process comments, XML declarations (formally known
+as ``processing instructions"), and SGML declarations, although the
+latter two are not acted upon in any way (in particular, no attempt at
+validation of the XML document is done).
+
+\begin{itemize}
+
+\item
+An \textbf{empty element} tag of the form
+%
+\begin{verbatim}
+
+\end{verbatim}
+%
+can be handled as successive calls to \texttt{begin\_element\_handler}
+and \texttt{end\_element\_handler}. However, if the optional handler
+\texttt{empty\_element\_handler} is present, it is called instead. Its
+interface is exactly the same as that of
+\texttt{begin\_element\_handler}:
+%
+\begin{verbatim}
+ subroutine empty_element_handler(name,attributes)
+ character(len=*), intent(in) :: name
+ type(dictionary_t), intent(in) :: attributes
+ end subroutine empty_element_handler
+\end{verbatim}
+%
+\item
+\textbf{Comments} are sections of the XML file contained between the markup
+\texttt{},
+and are handled by the optional argument \texttt{comment\_handler}
+%
+\begin{verbatim}
+ subroutine comment_handler(comment)
+ character(len=*), intent(in) :: comment
+ end subroutine comment_handler
+\end{verbatim}
+%
+\item
+\textbf{XML declarations} can be processed
+in the same way as elements, with the ``target" being the element name, etc.
+For example, in
+%
+\begin{verbatim}
+
+\end{verbatim}
+%
+\textsl{xml} would be the ``element name", \textsl{version} an
+attribute name, and \textsl{1.0} its value. The optional handler
+interface is:
+%
+\begin{verbatim}
+ subroutine xml_declaration_handler(name,attributes)
+ character(len=*), intent(in) :: name
+ type(dictionary_t), intent(in) :: attributes
+ end subroutine xml_declaration_handler
+\end{verbatim}
+%
+\item
+\textbf{SGML declarations} such as entity declarations or doctype
+specifications are treated basically as comments. Interface:
+%
+\begin{verbatim}
+ subroutine sgml_declaration_handler(sgml_declaration)
+ character(len=*), intent(in) :: sgml_declaration
+ end subroutine sgml_declaration_handler
+\end{verbatim}
+%
+\end{itemize}
+In the current version of the parser, overly long comments and SGML
+declarations might be truncated.
+
+
+\section{The XPATH interface}
+
+\textsl{NOTE: The current implementation gets its inspiration from
+XPATH, but by no means it is a complete, or even a subset,
+implementation of the standard. Since it is built on top of the SAX
+interface, it uses a ``stream" paradigm which is completely alien to
+the XPATH specification. It is nevertheless still quite useful. The
+author is open to suggestions to refine the interface.}
+
+\bigskip
+
+This API is based on the concept of an XML path. For example:
+%
+\begin{verbatim}
+/inventory/item
+\end{verbatim}
+%
+represents a 'item' element which is a child of the root element
+'inventory'. Paths can contain special wildcard markers such as
+\texttt{//} and \texttt{*}. The following are examples of valid paths:
+%
+\begin{verbatim}
+ //a : Any occurrence of element 'a', at any depth.
+ /a/*/b : Any 'b' which is a grand-child of 'a'
+ ./a : A relative path (with respect to the current path)
+ a : (same as above)
+ /a/b/./c : Same as /a/b/c (the dot (.) is a dummy)
+ //* : Any element.
+ //a/*//b : Any 'b' under any children of 'a'.
+
+\end{verbatim}
+%
+\subsection{Simple example}
+Using the XPATH interface it is possible to search for any element
+directly, and to recover its attributes or character content. For
+example, to print the names of all the appliances in the inventory:
+%
+\begin{verbatim}
+program simple
+use flib_xpath
+
+type(xml_t) :: fxml
+
+integer :: status
+character(len=100) :: what
+
+call open_xmlfile("inventory.xml",fxml,status)
+!
+do
+ call get_node(fxml,path="//description",pcdata=what,status=status)
+ if (status < 0) exit
+ print *, "Appliance: ", trim(what)
+enddo
+end program simple
+\end{verbatim}
+%
+Repeated calls to \texttt{get\_node} return the character content of
+the 'description' elements (at any depth). We exit the loop when the
+\texttt{status} variable is negative on return from the call. This
+indicates that there are no more elements matching the
+\texttt{//description} path pattern.\footnote{Returning a negative
+value for an end-of-file or end-or-record condition follows the
+standard practice. Positive return values signal malfunctions}
+
+Apart from path patterns, we can narrow our search by specifying
+conditions on the attribute list of the element. For example, to print
+only the prices which are given in euros we can use the
+\texttt{att\_name} and \texttt{att\_value} optional arguments:
+%
+\begin{verbatim}
+program euros
+use flib_xpath
+
+type(xml_t) :: fxml
+
+integer :: status
+character(len=100) :: price
+
+call open_xmlfile("inventory.xml",fxml,status)
+!
+do
+ call get_node(fxml,path="//price", &
+ att_name="currency",att_value="euro", &
+ pcdata=price,status=status)
+ if (status < 0) exit
+ print *, "Price (euro): ", trim(price)
+enddo
+end program euros
+\end{verbatim}
+%
+We can zero in on any element in this fashion, but we apparently give
+up the all-important context. What happens if we want to print
+\textsl{both} the appliance description and its price?
+%
+\begin{verbatim}
+program twoelements
+use flib_xpath
+
+type(xml_t) :: fxml
+
+integer :: status
+character(len=100) :: what, price, currency
+
+call open_xmlfile("inventory.xml",fxml,status)
+!
+do
+ call get_node(fxml,path="//description", &
+ pcdata=what,status=status)
+ if (status < 0) exit ! No more items
+ !
+ ! Price comes right after description...
+ !
+ call get_node(fxml,path="//price", &
+ attributes=attributes,pcdata=price,status=status)
+ if (status /= 0) stop "missing price element!"
+
+ call get_value(attributes,"currency",currency,status)
+ if (status /= 0) stop "missing currency attribute!"
+
+ write(unit=*,fmt="(6a)") "Appliance: ", trim(what), &
+ ". Price: ", trim(price), " ", trim(currency)
+enddo
+end program twoelements
+\end{verbatim}
+%
+\subsubsection{Exercises}
+\begin{enumerate}
+\item Modify the above programs to print only the appliances priced in
+euros.
+\item Modify the order of the 'description' and 'price' elements in a
+item. What happens to the 'twoelements' program output?
+\item The full XPATH specification allows the query for a particular
+element among a set of elements with the same path, based on the
+ordering of the element. For example, "/inventory/item[2]" will refer
+to the second 'item' element in the XML file. Write a routine that
+implements this feature and returns the element's attribute
+dictionary.
+\item Queries for paths can be issued in any order, and so some
+mechanism for "rewinding" the XML file is necessary. It is provided by
+the appropriately named \texttt{rewind\_xmlfile} subroutine (see full
+interface in the Reference section). Use it to implement a silly
+program that prints items from the inventory at random. (Extra points
+for including logic to minimize the number of rewinds.)
+\end{enumerate}
+%
+
+\subsection{Contexts and restricted searches}
+
+The logic of the \texttt{twoelements} program in the previous section
+ follows from the assumption that the 'price' element follows the
+ 'description' element in a typical 'item'. If the DTD says so, and
+ the XML file is valid (in the technical sense of conforming to the
+ DTD), the assumption should be correct. However, since the parser is
+ non-validating, it might be unreasonable to expect the proper
+ ordering in all cases. What we should expect (as a minimum) is that
+ both the price and description elements are children of the 'item'
+ element. In the following version we make use of the \textbf{context}
+ concept to achieve a more robust solution.
+%
+\begin{verbatim}
+program item_context
+use flib_xpath
+
+type(xml_t) :: fxml, contex
+
+integer :: status
+character(len=100) :: what, price, currency
+
+call open_xmlfile("inventory.xml",fxml,status)
+!
+do
+ call mark_node(fxml,path="//item",status=status)
+ if (status < 0) exit ! No more items
+ context = fxml ! Save item context
+ !
+ ! Search relative to context
+ !
+ call get_node(fxml,path="price", &
+ attributes=attributes,pcdata=price,status=status)
+ call get_value(attributes,"currency",currency,status)
+ if (status /= 0) stop "missing currency attribute!"
+ !
+ ! Rewind to beginning of context
+ !
+ fxml = context
+ call sync_xmlfile(fxml)
+ !
+ ! Search relative to context
+ !
+ call get_node(fxml,path="description",pcdata=what,status=status)
+ write(unit=*,fmt="(6a)") "Appliance: ", trim(what), &
+ ". Price: ", trim(price), " ", trim(currency)
+enddo
+end program item_context
+\end{verbatim}
+%
+The call to \texttt{mark\_node} positions the parser's file handle
+\texttt{fxml} right after the end of the starting tag of the next
+'item' element. We save that position as a ``context marker" to which
+we can return later on. The calls to \texttt{get\_node} use path
+patterns that do not start with a \texttt{/}: they are
+\textbf{searches relative to the current context}. After getting the
+information about the 'price' element, we restore the parser's file
+handle to the appropriate position at the beginning of the 'item'
+context, and search for the 'description' element. In the following
+iteration of the loop, the parser will find the next 'item' element,
+and the process will be repeated until there are no more 'item's.
+
+
+Contexts come in handy to encapsulate parsing tasks in re-usable
+subroutines. Suppose you are going to find the basic 'item' element
+content in a whole lot of different XML files. The following
+subroutine extracts the description and price information:
+%
+\begin{verbatim}
+subroutine get_item_info(context,what,price,currency)
+type(xml_t), intent(in) :: contex
+character(len=*), intent(out) :: what, price, currency
+
+!
+! Local variables
+!
+type(xml_t) :: ff
+integer :: status
+type(dictionary_t) :: attributes
+
+ !
+ ! context is read-only, so make a copy and sync just in case
+ !
+ ff = context
+ call sync_xmlfile(ff)
+ !
+ call get_node(ff,path="price", &
+ attributes=attributes,pcdata=price,status=status)
+ call get_value(attributes,"currency",currency,status)
+ if (status /= 0) stop "missing currency attribute!"
+ !
+ ! Rewind to beginning of context
+ !
+ ff = context
+ call sync_xmlfile(ff)
+ !
+ call get_node(ff,path="description",pcdata=what,status=status)
+
+end subroutine get_item_info
+\end{verbatim}
+%
+Using this routine, the parsing is much more compact:
+%
+\begin{verbatim}
+program item_context
+use flib_xpath
+
+type(xml_t) :: fxml
+
+integer :: status
+character(len=100) :: what, price, currency
+
+call open_xmlfile("inventory.xml",fxml,status)
+!
+do
+ call mark_node(fxml,path="//item",status=status)
+ if (status /= 0) exit ! No more items
+ call get_item_info(fxml,what,price,currency)
+ write(unit=*,fmt="(6a)") "Appliance: ", trim(what), &
+ ". Price: ", trim(price), " ", trim(currency)
+ call sync_xmlfile(fxml)
+enddo
+end program item_context
+\end{verbatim}
+%
+It is extremely important to understand the meaning of the call to
+\texttt{sync\_xmlfile}. The file handle \texttt{fxml} holds parsing
+context \textbf{and} a physical pointer to the file position
+(basically a variable counting the number of characters read so
+far). When the context is passed to the subroutine and the parsing
+carried out, the context and the file position get out of
+sync. Synchronization means to re-position the physical file pointer
+to the place where it was when the context was first created.
+
+
+\subsubsection{Exercises}
+\begin{enumerate}
+\item Modify the above programs to print only the appliances priced in
+euros.
+\item Write a program that prints only the most expensive
+item. (Assume that the inventory is very large and it is not feasible
+to hold everything in memory...)
+\item Use the \texttt{get\_item\_info} subroutine to print
+descriptions and price information from the following XML file:
+%
+\begin{verbatim}
+
+
+ Mediterranean cruise
+ 1500.00
+
+
+ Week in Majorca
+ 300.00
+
+
+ Wilderness Route
+ 10000.00
+
+
+\end{verbatim}
+%
+(Note that the routine does not care what the context name is (it
+could be 'item' or 'trip'). It is only the fact that the children
+('description' and 'price') are the same that matters.
+\end{enumerate}
+
+\section{Handling of scientific data}
+
+\subsection{Numerical datasets}
+
+While the ASCII form is not the most efficient for the storage of
+numerical data, the portability and flexibility offered by the XML
+format makes it attractive for the interchange of scientific
+datasets. There are a number of efforts under way to standardize this
+area, and presumably we will have nifty tools for the creation and
+visualization of files in the near future. Even then, however, it will
+be necessary to be able to read numerical information into fortran
+programs. The \texttt{xmlf90} package offers limited but useful
+functionality in this regard, making it possible to build numerical
+arrays on the fly as the XML file containing the data is parsed. As an
+example, consider the dataset:
+%
+\begin{verbatim}
+
+ 8.90679398599 8.90729421510 8.90780189594 8.90831710494
+ 8.90883991832 8.90937041202 8.90990866166 8.91045474255
+ 8.91100872963 8.91157069732 8.91214071958 8.91271886986
+ 8.91330522098 8.91389984506 8.91450281355 8.91511419713
+ 8.91573406560 8.91636248785 8.91699953183 8.91764526444
+ 8.91829975142 8.91896305734 8.91963524555 8.92031637799
+ 8.92100651514 8.92170571605 8.92241403816 8.92313153711
+ 8.92385826683 8.92459427943 8.92533962491 8.92609435120
+ 8.92685850416 8.92763212726 8.92841526149 8.92920794545
+
+\end{verbatim}
+%
+and the following fragment of a \texttt{m\_handlers} module for SAX parsing:
+%
+\begin{verbatim}
+
+real, dimension(1000) :: x ! numerical array to hold data
+
+subroutine begin_element(name,attributes)
+ ...
+ select case(name)
+ case("data")
+ in_data = .true.
+ ndata = 0
+ ...
+ end select
+
+end subroutine begin_element
+!---------------------------------------------------------------
+subroutine pcdata_chunk_handler(chunk)
+ character(len=*), intent(in) :: chunk
+
+ if (in_data) call build_data_array(chunk,x,ndata)
+ ...
+
+end subroutine pcdata_chunk_handler
+!-------------------------------------------------------------
+subroutine end_element(name)
+ ...
+ select case(name)
+ case("data")
+ in_data = .false.
+ print *, "Read ", ndata, " data elements."
+ print *, "X: ", x(1:ndata)
+ ...
+ end select
+
+end subroutine end_element
+\end{verbatim}
+%
+When the \texttt{} tag is encountered by the parser, the
+variable \texttt{ndata} is initialized. Any PCDATA chunks found from
+then on and until the \texttt{} tag is seen are passed to the
+\texttt{build\_data\_array} generic subroutine, which converts the
+character data to the numerical format (integer, default real, double
+precision) implied by the array \texttt{x}. The array is filled with
+data and the \texttt{ndata} variable increased accordingly.
+
+If the data is known to represent a multi-dimensional array (something
+that could be encoded in the XML as attributes to the 'data' element,
+for example), the user can employ the fortran \texttt{reshape}
+intrinsic to obtain the final form.
+
+There is absolutely no limit to the size of the data (apart from
+filesystem size and total memory constraints) since the parser only
+holds in memory at any given time a small chunk of character data (the
+default is to split the character data stream and call the
+\texttt{pcdata\_chunk\_handler} routine at the end of a line, or at
+the end of a token if the line is too long). This is one of the most
+useful features of the SAX approach to XML parsing.
+
+In order to read numerical data with the XPATH interface in its
+current implementation, one must first read the PCDATA into the
+\texttt{pcdata} optional argument of \texttt{get\_node}, and then call
+\texttt{build\_data\_array}. However, there is an internal limit to
+the size of the PCDATA buffer, so this method cannot be safely used
+for large datasets at this point. In a forthcoming version there will
+be a generic subroutine \texttt{get\_node} with a \texttt{data}
+numerical array optional argument which will be filled by the parser
+on the fly.
+
+
+
+
+\subsubsection{Exercises}
+\begin{enumerate}
+\item Generate an XML file containing a large dataset, and write a
+program to read the information back. You might want to include
+somewhere in the XML file information about the number of data
+elements, so that an array of the proper size can be used.
+\item Devise a strategy to read a dataset without knowing in advance
+the number of data elements. (Some possibilities: re-sizable
+allocatable arrays, two-pass parsing...).
+\item Suggest a possible encoding for the storage of two-dimensional
+arrays, and write a program to read the information from the XML file
+and create the appropriate array.
+\item Write a program that could read a 10Gb Monte Carlo simulation
+dataset and print the average and standard deviation of the data. (We
+are not advocating the use of XML for such large datasets. NetCDF
+would be much more efficient in this case).
+\end{enumerate}
+
+\subsection{Mapping of XML elements to derived types}
+
+After the parsing, the data has to be put somewhere. A good strategy
+to handle structured content is to try to replicate it within data
+structures inside the user program. For example, an element of the
+form
+%
+\begin{verbatim}
+
+Cluster diameters
+
+2.3 4.5 5.6 3.4 2.3 1.2 ...
+...
+...
+
+
+\end{verbatim}
+%
+could be mapped onto a derived type of the form:
+%
+\begin{verbatim}
+type :: table
+ character(len=50) :: description
+ character(len=20) :: units
+ integer :: npts
+ real, dimension(:), pointer :: data
+end type table
+\end{verbatim}
+%
+There could even be parsing and output subroutines associated to this
+derived type, so that the user can handle the XML production and
+reading transparently. Directory \texttt{Examples/} in the
+\texttt{xmlf90} distribution contains some code along these lines.
+
+\subsubsection{Exercises}
+%
+\begin{enumerate}
+\item Study the \texttt{pseudo} example in \texttt{Examples/sax/} and
+\texttt{Examples/xpath/}. Now, with your own application in mind,
+write derived-type definitions and parsing routines to handle your XML
+data (which would also need to be \textsl{designed} somehow).
+
+\end{enumerate}
+%
+
+
+\section{REFERENCE: Subroutine interfaces}
+\label{sec:reference}
+
+\subsection{Dictionary handling}
+
+Attribute lists are handled as instances of a derived type
+\texttt{dictionary\_t}, loosely inspired by the Python type. The
+terminology is more general: keys and entries instead of names and
+attributes.
+
+\begin{itemize}
+\item
+%
+\begin{verbatim}
+function number_of_entries(dict) result(n)
+!
+! Returns the number of entries in the dictionary
+!
+type(dictionary_t), intent(in) :: dict
+integer :: n
+\end{verbatim}
+%
+\item
+%
+\begin{verbatim}
+function has_key(dict,key) result(found)
+!
+! Checks whether there is an entry with
+! the given key in the dictionary
+!
+type(dictionary_t), intent(in) :: dict
+character(len=*), intent(in) :: key
+logical :: found
+\end{verbatim}
+\item
+%
+\begin{verbatim}
+subroutine get_value(dict,key,value,status)
+!
+! Gets values by key
+!
+type(dictionary_t), intent(in) :: dict
+character(len=*), intent(in) :: key
+character(len=*), intent(out) :: value
+integer, intent(out) :: status
+\end{verbatim}
+%
+\item
+%
+\begin{verbatim}
+subroutine get_key(dict,i,key,status)
+!
+! Gets keys by their order in the dictionary
+!
+type(dictionary_t), intent(in) :: dict
+integer, intent(in) :: i
+character(len=*), intent(out) :: key
+integer, intent(out) :: status
+
+\end{verbatim}
+%
+\item
+%
+\begin{verbatim}
+subroutine print_dict(dict)
+!
+! Prints the contents of the dictionary to stdout
+!
+type(dictionary_t), intent(in) :: dict
+\end{verbatim}
+\end{itemize}
+
+\subsection{SAX interface}
+
+\begin{itemize}
+\item
+\begin{verbatim}
+subroutine open_xmlfile(fname,fxml,iostat)
+!
+! Opens the file "fname" and creates an xml handle fxml
+! iostat /= 0 on error.
+!
+character(len=*), intent(in) :: fname
+integer, intent(out) :: iostat
+type(xml_t), intent(out) :: fxml
+\end{verbatim}
+\item
+\begin{verbatim}
+subroutine xml_parse(fxml, begin_element_handler, &
+ end_element_handler, &
+ pcdata_chunk_handler, &
+ comment_handler, &
+ xml_declaration_handler, &
+ sgml_declaration_handler, &
+ error_handler, &
+ signal_handler, &
+ verbose, &
+ empty_element_handler)
+
+type(xml_t), intent(inout), target :: fxml
+
+optional :: begin_element_handler
+optional :: end_element_handler
+optional :: pcdata_chunk_handler
+optional :: comment_handler
+optional :: xml_declaration_handler
+optional :: sgml_declaration_handler
+optional :: error_handler
+optional :: signal_handler ! see XPATH code
+logical, intent(in), optional :: verbose
+optional :: empty_element_handler
+
+\end{verbatim}
+\item Interfaces for handlers follow:
+
+\begin{verbatim}
+ subroutine begin_element_handler(name,attributes)
+ character(len=*), intent(in) :: name
+ type(dictionary_t), intent(in) :: attributes
+ end subroutine begin_element_handler
+
+ subroutine end_element_handler(name)
+ character(len=*), intent(in) :: name
+ end subroutine end_element_handler
+
+ subroutine pcdata_chunk_handler(chunk)
+ character(len=*), intent(in) :: chunk
+ end subroutine pcdata_chunk_handler
+
+ subroutine comment_handler(comment)
+ character(len=*), intent(in) :: comment
+ end subroutine comment_handler
+
+ subroutine xml_declaration_handler(name,attributes)
+ character(len=*), intent(in) :: name
+ type(dictionary_t), intent(in) :: attributes
+ end subroutine xml_declaration_handler
+
+ subroutine sgml_declaration_handler(sgml_declaration)
+ character(len=*), intent(in) :: sgml_declaration
+ end subroutine sgml_declaration_handler
+
+ subroutine error_handler(error_info)
+ type(xml_error_t), intent(in) :: error_info
+ end subroutine error_handler
+
+ subroutine signal_handler(code)
+ logical, intent(out) :: code
+ end subroutine signal_handler
+
+ subroutine empty_element_handler(name,attributes)
+ character(len=*), intent(in) :: name
+ type(dictionary_t), intent(in) :: attributes
+ end subroutine empty_element_handler
+\end{verbatim}
+\end{itemize}
+
+Other file handling routines (some of them really only useful within
+the XPATH interface):
+
+\begin{itemize}
+\item
+\begin{verbatim}
+subroutine REWIND_XMLFILE(fxml)
+!
+! Rewinds the physical file associated to fxml and clears the data
+! structures used in parsing.
+!
+type(xml_t), intent(inout) :: fxml
+\end{verbatim}
+
+\item
+\begin{verbatim}
+subroutine SYNC_XMLFILE(fxml,status)
+!
+! Synchronizes the physical file associated to fxml so that reading
+! can resume at the exact point in the parsing saved in fxml.
+!
+type(xml_t), intent(inout) :: fxml
+integer, intent(out) :: status
+
+\end{verbatim}
+\item
+\begin{verbatim}
+subroutine CLOSE_XMLFILE(fxml)
+!
+! Closes the file handle fmxl (and the associated OS file object)
+!
+type(xml_t), intent(inout) :: fxml
+\end{verbatim}
+\end{itemize}
+
+\subsection{XPATH interface}
+%
+\begin{itemize}
+\item
+\begin{verbatim}
+subroutine MARK_NODE(fxml,path,att_name,att_value,attributes,status)
+!
+! Performs a search of a given element (by path, and/or presence of
+! a given attribute and/or value of that attribute), returning optionally
+! the element's attribute dictionary, and leaving the file handle fxml
+! ready to process the rest of the element's contents (child elements
+! and/or pcdata).
+!
+! Side effects: it sets a "path_mark" in fxml to enable its use as a
+! context.
+!
+! If the argument "path" is present and evaluates to a relative path (a
+! string not beginning with "/"), the search is interrupted after the end
+! of the "ancestor_element" set by a previous call to "mark_node".
+! If not earlier, the search ends at the end of the file.
+!
+! The status argument, if present, will hold a return value,
+! which will be:
+!
+! 0 on success,
+! negative in case of end-of-file or end-of-ancestor-element, or
+! positive in case of other malfunction
+!
+type(xml_t), intent(inout), target :: fxml
+character(len=*), intent(in), optional :: path
+character(len=*), intent(in), optional :: att_name
+character(len=*), intent(in), optional :: att_value
+type(dictionary_t), intent(out), optional :: attributes
+integer, intent(out), optional :: status
+\end{verbatim}
+
+\item
+\begin{verbatim}
+subroutine GET_NODE(fxml,path,att_name,att_value,attributes,pcdata,status)
+!
+! Performs a search of a given element (by path, and/or presence of
+! a given attribute and/or value of that attribute), returning optionally
+! the element's attribute dictionary and any PCDATA characters contained
+! in the element's scope (but not child elements). It leaves the file handle
+! physically and logically positioned:
+!
+! after the end of the element's start tag if 'pcdata' is not present
+! after the end of the element's end tag if 'pcdata' is present
+!
+! If the argument "path" is present and evaluates to a relative path (a
+! string not beginning with "/"), the search is interrupted after the end
+! of the "ancestor_element" set by a previous call to "mark_node".
+! If not earlier, the search ends at the end of the file.
+!
+! The status argument, if present, will hold a return value,
+! which will be:
+!
+! 0 on success,
+! negative in case of end-of-file or end-of-ancestor-element, or
+! positive in case of a malfunction (such as the overflow of the
+! user's pcdata buffer).
+!
+type(xml_t), intent(inout), target :: fxml
+character(len=*), intent(in), optional :: path
+character(len=*), intent(in), optional :: att_name
+character(len=*), intent(in), optional :: att_value
+type(dictionary_t), intent(out), optional :: attributes
+character(len=*), intent(out), optional :: pcdata
+integer, intent(out), optional :: status
+\end{verbatim}
+\end{itemize}
+%
+\subsection{PCDATA conversion routines}
+\begin{itemize}
+\item
+
+\begin{verbatim}
+subroutine build_data_array(str,x,n)
+!
+! Incrementally builds the data array x from
+! character data contained in str. n holds
+! the number of entries of x set so far.
+!
+character(len=*), intent(in) :: str
+NUMERIC TYPE, dimension(:), intent(inout) :: x
+integer, intent(inout) :: n
+!
+! NUMERIC TYPE can be any of:
+! integer
+! real
+! real(kind=selected_real_kind(14))
+!
+\end{verbatim}
+\end{itemize}
+
+\subsection{Other utility routines}
+\begin{itemize}
+\item
+
+\begin{verbatim}
+function xml_char_count(fxml) result (nc)
+!
+! Provides the value of the processed-characters counter
+!
+type(xml_t), intent(in) :: fxml
+integer :: nc
+
+nc = nchars_processed(fxml%fb)
+
+end function xml_char_count
+\end{verbatim}
+\end{itemize}
+
+\section{Other parser features, limitations, and design issues}
+
+\subsection{Features}
+\begin{itemize}
+\item
+The parser can detect badly formed documents, giving by default an
+error report including the line and column where it happened. It also
+will accept an \texttt{error\_handler} routine as another optional
+argument, for finer control by the user. In the SAX interface, if the
+optional logical argument "verbose" is present and it is ".true.", the
+parser will offer detailed information about its inner workings. In
+the XPATH interface, there are a pair of routines,
+\texttt{enable\_debug} and \texttt{disable\_debug}, to control
+verbosity. See \texttt{Examples/xpath/} for examples.
+
+\item
+It ignores PCDATA outside of element context (and warns about it)
+
+\item
+Attribute values can be specified using both single and double
+quotes (as per the XML specs).
+
+\item
+It processes the default entities: \> \& \< \' and
+\" and decimal and hex character entities (for example: \&\#123;
+\&\#4E;). The processing is not
+"on the fly", but after reading chunks of PCDATA.
+
+\item
+Understands and processes CDATA sections (transparently passed as
+PCDATA to the handler).
+
+\end{itemize}
+
+See \texttt{Examples/sax/features} for an illustration of the above
+features.
+
+\subsection{Limitations}
+\begin{itemize}
+
+\item It is not a validating parser.
+
+\item It accepts only single-byte encodings for characters.
+
+\item Currently, there are hard-wired limits on the length of element
+ and attribute identifiers, and the length of attribute values and
+ unbroken (i.e., without whitespace) PCDATA sections. The limit is
+ set in \texttt{sax/m\_buffer.f90} to \texttt{MAX\_BUFF\_SIZE=300}.
+
+\item Overly long comments and SGML declarations can also be
+truncated, but the effect is currently harmless since the parser does
+not make use of that information. In a future version there could be a
+more robust retrieval mechanism.
+
+\item The number of attributes is limited to \texttt{MAX\_ITEMS=20}
+ in \texttt{sax/m\_dictionary.f90}:
+
+
+ \item In the XPATH interface, returned PCDATA character buffers
+ cannot be larger than an internal size of
+ \texttt{MAX\_PCDATA\_SIZE=65536} set in \texttt{xpath/m\_path.f90}
+
+
+\end{itemize}
+
+\subsection{Design Issues}
+
+See \texttt{\{sax,xpath\}/Developer.Guide}.
+
+The parser is actually written in the \texttt{F} subset of Fortran90,
+for which inexpensive compilers are available. (See
+\texttt{http://fortran.com/imagine1/}).
+
+There are two other projects aimed at parsing XML in Fortran: those of
+Mart Rentmeester (\texttt{http://nn-online.sci.kun.nl/fortran/}) and
+Arjen Markus (\texttt{http://xml-fortran.sourceforge.net/}). Up to
+this point the three projects have progressed independently, but it is
+anticipated that there will be a pooling of efforts in the near
+future.
+
+\newpage
+\section{Installation Instructions}
+%
+There is extensible built-in support for arbitrary compilers. The
+setup discussed below is taken from the author's \texttt{flib}
+project\footnote{There seems to be other projects with that very obvious
+name...} The idea is to have a configurable repository of useful
+modules and library objects which can be accessed by fortran
+programs. Different compilers are supported by tailored macros.
+
+\texttt{xmlf90} is just one of several packages in \texttt{flib},
+hence the \texttt{flib\_} prefix in the package's visible module
+names.
+
+To install the package, follow this steps:
+
+\begin{verbatim}
+
+ * Create a directory somewhere containing a copy of the stuff in the
+ subdirectory 'macros':
+
+ cp -rp macros $HOME/flib
+
+ * Define the environment variable FLIB_ROOT to point to that directory.
+
+ FLIB_ROOT=$HOME/flib ; export FLIB_ROOT (sh-like shells)
+ setenv FLIB_ROOT $HOME/flib (csh-like shells)
+
+
+ * Go into $FLIB_ROOT, look through the fortran-XXXX.mk files,
+ and see if one of them applies to your computer/compiler combination.
+ If so, copy it or make a (symbolic) link to 'fortran.mk':
+
+ ln -sf fortran-lf95.mk fortran.mk
+
+ If none of the .mk files look useful, write your own, using the
+ files provided as a guide. Basically you need to figure out the
+ name and options for the compiler, the extension assigned to
+ module files, and the flag used to identify the module search path.
+
+ The above steps need only be done once.
+
+ * Go into subdirectory 'sax' and type 'make'.
+ * Go into subdirectory 'xpath' and type 'make'.
+ * Go into subdirectory 'Tutorial' and try the exercises in this guide
+ (see the next section for compilation details).
+ * Go into subdirectory 'Examples' and explore.
+
+\end{verbatim}
+%
+\section{Compiling user programs}
+\label{sec:compiling}
+
+After installation, the appropriate modules and library files should
+already be in \texttt{\$FLIB\_ROOT/modules} and
+\texttt{\$FLIB\_ROOT/lib}, respectively. To compile user programs, it
+is suggested that the user create a separate directory to hold the
+program files and prepare a \texttt{Makefile} following the template
+(taken from \texttt{Examples/sax/simple/}):
+
+\begin{verbatim}
+#---------------------------------------------------------------
+#
+default: example
+#
+#---------------------------
+MK=$(FLIB_ROOT)/fortran.mk
+include $(MK)
+#---------------------------
+#
+# Uncomment the following line for debugging support
+#
+FFLAGS=$(FFLAGS_DEBUG)
+#
+LIBS=$(LIB_PREFIX)$(LIB_STD) -lflib
+#
+OBJS= m_handlers.o example.o
+
+example: $(OBJS)
+ $(FC) $(LDFLAGS) -o $@ $(OBJS) $(LIBS)
+#
+clean:
+ rm -f *.o example *$(MOD_EXT)
+#
+#---------------------------------------------------------------
+\end{verbatim}
+%
+Here it is assumed that the user has two source files,
+\texttt{example.f90} and \texttt{m\_handlers.f90}. Simply typing
+\texttt{make} will compile \texttt{example}, pulling in all the needed
+modules and library objects.
+
+
+\end{document}
Index: /XMLF90/doc/Tutorial/WXML.html
===================================================================
--- /XMLF90/doc/Tutorial/WXML.html (revision 6)
+++ /XMLF90/doc/Tutorial/WXML.html (revision 6)
@@ -0,0 +1,114 @@
+
+
+
+
+
+
+WXML Library
+
+Routines
+General routines
+
+- xml_OpenFile - Mandatory Initialization routine
+- xml_Close - Mandatory finalization routine, closes channels, etc
+- str - utility to convert reals and integers to character strings
+
+
+XML routines
+
+- xml_NewElement - writes an xml start tag
+- xml_AddAttribute - adds an attribute to a tag
+- xml_AddPcdata - adds text to an xml element
+- xml_AddArray - dumps the contents of an array
+as pcdata
+- xml_EndElement - writes an xml end tag
+
+
+Subroutine Guide
+
+
+
+ -
+
+
+argument | role | type | optional | default |
+filename | xml filename | character(len=*) | no | |
+ind | controls indentation of output | logical | yes | .true. |
+xf | xml filename | type(xmlf_t) | no | |
+
+
+ -
+
+
+argument | role | type | optional | default |
+xf | xml filehandle | type(xmlf_t) | no | |
+
+
+ -
+
+
+
+argument | role | type | optional | default |
+value | value to convert to string | real*8,
+real*4, integer, logical | no | |
+format | format for reals | character(len=*) | yes | g22.12 |
+
+
+
+
+
+
+
+ -
+
+
+argument | role | type | optional | default |
+xf | xml filehandle | type(xmlf_t) | no | |
+name | name of tag to add | character(len=*) | no | |
+
+
+ -
+
+
+argument | role | type | optional | default |
+xf | xml filehandle | type(xmlf_t) | no | |
+attname | attribute name | character(len=*) | no | |
+value | attribute value | character(len=*)
+(convert using str()) | no | |
+
+
+ -
+
+
+argument | role | type | optional | default |
+xf | xml filehandle | type(xmlf_t) | no | |
+pcdata | string to add | character(len=*) (convert numbers
+using str()) | no | |
+
+
+-
+
+
+argument | role | type | optional | default |
+xf | xml filehandle | type(xmlf_t) | no | |
+a | array (:) | integer, real, double | no | |
+format | format
+ | character(len=*) | yes | 6(i12) / 4(es20.12) |
+
+
+ -
+
+
+argument | role | type | optional | default |
+xf | xml filehandle | type(xmlf_t) | no | |
+name | name of element to close | character(len=*) | no | |
+
+
+
+
Index: /XMLF90/doc/Tutorial/jumbo.html
===================================================================
--- /XMLF90/doc/Tutorial/jumbo.html (revision 6)
+++ /XMLF90/doc/Tutorial/jumbo.html (revision 6)
@@ -0,0 +1,59 @@
+
+
+
+
+
+
+ Jumbo90
+
+ Jumbo90 is a library written in Fortran for creating CML
+ documents. Actually, Jumbo allows you to create XML, CML and STMML
+ (another markup language closely related to CML). After a moments
+ thought you may ask why do we need a library to write things? I mean,
+ you can always type
write(*,*)
+ "<cml>stuff</cml>"
+
+ Well, while in theory it is a fairly simply task to write CML, or
+ indeed any XML, in any language, in practice it's not quite that
+ easy. Balancing tags that are opened at one end of a 2000 line
+ source file and closed at the other or even opened and closed in
+ different source files, is an unnecessary memory exercise, and
+ balancing them in the right order a pain. More importantly,
+ you'll probably only spot your mistake when you try to process the
+ file, and given that XML is case sensitive it's a pretty easy to make
+ a mistake. Furthermore, CML elements will often be built up in a
+ standard manner using a large number of tags - and it can be fairly
+ tedious typing in all of these. Add to this the fact that it is
+ extremely difficult to correctly indent an XML document whose
+ structure is as dynamic as that of the underlying program [1] (just
+ using write statements). So, we decided that it was probably worth
+ our while to create a library for handling the more tedious or tricky
+ elements of creating a CML document. We also added functionality to
+ check the well-formedness of all XML. In fact, most programming
+ languages provide utilties for performing these seemingly simple
+ tasks
+
+The original idea for Jumbo90 came from Peter Murray-Rust, who has
+a similar but much more rounded suite of tools written in Java, called
+Jumbo. I then converted Peter's original F77 code into F90, but it
+suffered a little from its F77 inheritance, so now the base XML
+formatting layer of Jumbo is provided by Alberto Garcia's WXML
+library.
+
+The Jumbo90 README containing a breakdown of all Jumbo90
+subroutines is available here
+
+
+
+Jon Wakelin, March 2004
+ [1] It's only a cosmetic feature but it's very useful when you
+need someone to read the file, of course, there's nothing wrong with
+writing a 12M XML file in a single line.
+
+
Index: /XMLF90/doc/Tutorial/jumbodocs.html
===================================================================
--- /XMLF90/doc/Tutorial/jumbodocs.html (revision 6)
+++ /XMLF90/doc/Tutorial/jumbodocs.html (revision 6)
@@ -0,0 +1,410 @@
+
+
+
+
+
+
+Jumbo90
+
+
+- What is Jumbo90?
+
+ - Jumbo90 is a CML formatting Library for Fortran, it provides:
+ - Convenience routines to write complete CML elements
+ - Convenience routines to write complete STMML elements
+ - Optional Indentation of output
+ - Checks that tags are properly balanced
+ - Checks that attribute names are well formed (i.e. contain only [A-Z a-z 0-9 _ -] and start with [A-Z a-z _]).
+
+ - The colon is allowed but should be reserved for namespacing so an error is flagged if more than one colon is present in attribute name
+
+ - Checks if attribute values contain predefined entities (<, >, &, ', ")
+ - Checks for duplicate attribute names
+
+
+- How to use Jumbo90
+Jumbo covers CML, STMML and basic XML. Below is the full list of subroutine names, followed by the arguments they take. Whenever writing a real*8 or real*4 you can always pass an optional format argument, e.g.
+
+ call xml_AddAttribute(file, 'martin','height', 32.1285)
+ call xml_AddAttribute(file, 'martin','height', 32.1285, '(f6.2)')
+
+
+would add an "height" attribute with a value of "32.1285" to a "martin" element . In the first case the default format '(f8.3)' would be used, in the second case the user supplied format '(f6.2)' would be used. Many subroutines can take a number of optional arguments (reflecting the CML schema) therefore the longer 'argument=value' format should be use when calling these subroutines, e.g.,
+
+ call xml_OpenFile('myFile.xml', file)
+
+
+
+
+Notes:
+Jumbo90 is based on an earlier fortran 77 program called Jumbo77, which was itself based on an existing Java CML parser called JUMBO written by Peter Murray-Rust. Jumbo90 is now built in a modular fashion allowing output of basic XML, STMML and CML. The STMML layer builds on the XML. The CML layer, in turn, builds on the STMML layer. The base XML writing utilities are now provided by FLIB_XMLWRITE, a set of F90 modules written by Alberto Garcia.
+
+
+- Routines
+General routines
+
+- xml_OpenFile - Mandatory Initialization routine
+- xml_Close - Mandatory finalization routine, closes channels, etc
+- str - utility to convert, floats and integers to character strings
+
+
+XML routines
+
+- xml_NewElement - writes an xml start tag
+- xml_AddAttribute - adds an attribute to a tag
+- xml_AddPcdata - adds text to an xml element
+- xml_EndElement - writes an xml end tag
+
+
+
+STMML routines
+
+- stmAddStartTag
+- stmAddScalar
+- stmAddArray
+- stmAddMatrix
+- stmAddTriangle
+- stmError
+- stmMessage
+- stmWarning
+
+
+CMLCore routines
+
+- cmlAddMolecule - adds a complete CML <molecule> element
+- cmlAddAtom - adds a CML <atom> start tag
+- cmlAddCoordinates - adds coordinate attributes to an <atom> tag
+- cmlAddCrystal - adds a complete CML <crystal> element
+- cmlAddMetadata - adds a complete CML <metadata> element
+- cmlAddLength(length, id, atomRef1, atomRef2, fmt)
+- cmlAddAngle(angle, id, atomRef1, atomRef2, atomRef3, fmt)
+- cmlAddTorsion(torsion, id, atomRef1, atomRef2, atomRef3, atomRef4, fmt)
+- cmlAddEigenvalue(n, dim, eigvec, eigval, id, title, dictRef, fmt)
+
+
+CMLComa routines (Condensed Matter)
+
+- cmlAddLattice - write a complete lattice element
+- cmlAddProperty - write a complete property element, containing scalar, array (vector) or matrix value (i.e. it has several interfaces)
+- cmlAddParameter - adds a complete CML <parameter> element
+
+
+- Subroutine Guide
+
+
+
+ -
+
+
+argument | role | type | optional | default |
+filename | xml filename | character(len=*) | no | |
+ind | controls indentation of output | logical | yes | .true. |
+xf | xml filename | type(xmlf_t) | no | |
+
+
+ -
+
+
+argument | role | type | optional | default |
+xf | xml filehandle | type(xmlf_t) | no | |
+
+
+ -
+
+
+
+argument | role | type | optional | default |
+value | value to convert to string | real*8, real*4, integer | no | |
+format | format for reals | character(len=*) | yes | g22.12 |
+
+
+
+
+
+
+
+ -
+
+
+argument | role | type | optional | default |
+xf | xml filehandle | type(xmlf_t) | no | |
+name | name of tag to add | character(len=*) | no | |
+
+
+ -
+
+
+argument | role | type | optional | default |
+xf | xml filehandle | type(xmlf_t) | no | |
+name | name of tag | character(len=*) | no | |
+attname | attribute name | character(len=*) | no | |
+value | attribute value | character(len=*) | integer | real*8 | real*4 | no | |
+fmt | format for reals | character(len=*) | yes | f8.3 |
+
+
+ -
+
+
+argument | role | type | optional | default |
+xf | xml filehandle | type(xmlf_t) | no | |
+value | string to add | character(len=*) | integer | real*8 | real*4 | no | |
+fmt | format for reals | character(len=*) | yes | f8.3 |
+
+
+ -
+
+
+argument | role | type | optional | default |
+xf | xml filehandle | type(xmlf_t) | no | |
+name | name of element to close | character(len=*) | no | |
+
+
+
+
+
+
+
+ -
+
+
+argument | role | type | optional | default |
+xf | xml filehandle | type(xmlf_t) | no | |
+name | tag name | character(len=*) | no | |
+id | unique id | character(len=*) | yes | |
+title | tag description | character(len=*) | yes | |
+dictref | dictionary reference | character(len=*) | yes | |
+
+
+ -
+
+
+argument | role | type | optional | default |
+xf | xml filehandle | type(xmlf_t) | no | |
+value | the scalar value | character(len=*) | integer | real*8 | real*4 | no | |
+id | unique id | character(len=*) | yes | |
+title | tag description | character(len=*) | yes | |
+dictref | dictionary reference | character(len=*) | yes | |
+fmt | format for reals | character(len=*) | yes | f8.3 |
+
+
+ -
+
+
+argument | role | type | optional | default |
+xf | xml filehandle | type(xmlf_t) | no | |
+nvalue | length of array | integer | no | |
+array | the array | character(len=*) | integer | real*8 | real*4 | no | |
+id | unique id | character(len=*) | yes | |
+title | tag description | character(len=*) | yes | |
+dictref | dictionary reference | character(len=*) | yes | |
+fmt | format for reals | character(len=*) | yes | f8.3 |
+
+
+ -
+
+
+argument | role | type | optional | default |
+xf | xml filehandle | type(xmlf_t) | no | |
+nrows | number of rows | integer | no | |
+ncols | number of columns | integer | no | |
+dim | fastest dimension | integer | no | |
+matrix | the matrix | character(len=*) | integer | real*8 | real*4 | no | |
+id | unique id | character(len=*) | yes | |
+title | tag description | character(len=*) | yes | |
+dictref | dictionary reference | character(len=*) | yes | |
+fmt | format for reals | character(len=*) | yes | f8.3 |
+
+
+ -
+
+
+argument | role | type | optional | default |
+xf | xml filehandle | type(xmlf_t) | no | |
+nvalue | length of array | integer | no | |
+array | the array | character(len=*) | integer | real*8 | real*4 | no | |
+id | unique id | character(len=*) | yes | |
+title | tag description | character(len=*) | yes | |
+dictref | dictionary reference | character(len=*) | yes | |
+fmt | format for reals | character(len=*) | yes | f8.3 |
+
+
+ -
+
+
+argument | role | type | optional | default |
+xf | xml filehandle | type(xmlf_t) | no | |
+msg | length of array | character(len=*) | no | |
+id | unique id | character(len=*) | yes | |
+title | tag description | character(len=*) | yes | |
+dictref | dictionary reference | character(len=*) | yes | |
+
+
+ -
+
+
+argument | role | type | optional | default |
+xf | xml filehandle | type(xmlf_t) | no | |
+msg | length of array | character(len=*) | no | |
+id | unique id | character(len=*) | yes | |
+title | tag description | character(len=*) | yes | |
+dictref | dictionary reference | character(len=*) | yes | |
+
+
+ -
+
+
+argument | role | type | optional | default |
+xf | xml filehandle | type(xmlf_t) | no | |
+msg | length of array | character(len=*) | no | |
+id | unique id | character(len=*) | yes | |
+title | tag description | character(len=*) | yes | |
+dictref | dictionary reference | character(len=*) | yes | |
+
+
+
+
+
+
+
+ -
+
+
+argument | role | type | optional | default |
+xf | xml filehandle | type(xmlf_t) | no | |
+natoms | number of atoms | integer | no | |
+elements(natoms) | list of atomic symbols | character(len=2) | no | |
+coords(3, natoms) | atomic coordinates | real*8 | real*4 | no | |
+style | CML output style (x3 | xFrac | xyz3 | xyzFrac) | character(len=*) | yes | x3 |
+id | unique id | character(len=*) | yes | |
+title | tag description | character(len=*) | yes | |
+dictref | dictionary reference | character(len=*) | yes | |
+fmt | format for reals | character(len=*) | yes | f8.3 |
+
+
+ -
+
+
+argument | role | type | optional | default |
+xf | xml filehandle | type(xmlf_t) | no | |
+elem | atomic symbol | character(len=2) | yes | |
+id | unique id | character(len=*) | yes | |
+charge | formal charge | integer | no | |
+hCount | hydrogen count | integer | no | |
+occupancy | site occupancy | real*8 | real*4 | no | |
+fmt | format for occupancy | character(len=*) | yes | f8.3 |
+
+
+ -
+
+
+argument | role | type | optional | default |
+xf | xml filehandle | type(xmlf_t) | no | |
+x | x coordinate in cartesian format | real*8 | real*4 | no | |
+y | y coordinate in cartesian format | real*8 | real*4 | no | |
+z | z coordinate in cartesian format | real*8 | real*4 | yes | |
+style | CML output style (x3 | xFrac | xyz3 | xyzFrac | xy2) | character(len=*) | yes | x3 |
+fmt | format for coordinates | character(len=*) | yes | f8.3 |
+
+
+ -
+
+
+argument | role | type | optional | default |
+xf | xml filehandle | type(xmlf_t) | no | |
+a | lattice parameter a | real*8 | real*4 | no | |
+b | lattice parameter b | real*8 | real*4 | no | |
+c | lattice parameter c | real*8 | real*4 | no | |
+alpha | lattice angle alpha | real*8 | real*4 | no | |
+beta | lattice angle beta | real*8 | real*4 | no | |
+gamma | lattice angle gamma | real*8 | real*4 | no | |
+lenunits | units for lattice parameters | character(len=*) | yes | angstrom |
+angunits | units for lattice angles | character(len=*) | yes | degree |
+id | unique id | character(len=*) | yes | |
+title | tag description | character(len=*) | yes | |
+dictref | dictionary reference | character(len=*) | yes | |
+fmt | format for reals | character(len=*) | yes | f8.3 |
+
+
+ -
+
+
+argument | role | type | optional | default |
+xf | xml filehandle | type(xmlf_t) | no | |
+name | name (eg author) | character(len=*) | no | |
+content | value (eg Jon Wakelin) | character(len=*) | no | |
+conv | a convention | character(len=*) | yes | |
+
+
+ -
+
+
+argument | role | type | optional | default |
+xf | xml filehandle | type(xmlf_t) | no | |
+cell(3,3) | the lattice vectors | real*8 | real*4 | no | |
+units | units for lattice vectors | character(len=*) | yes | |
+title | tag description | character(len=*) | yes | |
+id | unique id | character(len=*) | yes | |
+dictref | dictionary reference | character(len=*) | yes | |
+conv | a convention | character(len=*) | yes | f8.3 |
+lattType | lattice type (primitive |full) | character(len=*) | yes | |
+spaceType | space type (real | reciprocal) | character(len=*) | yes | |
+
+
+ -
+
+
+argument | role | type | optional | default |
+xf | xml filehandle | type(xmlf_t) | no | |
+property | a scalar, array or matrix property. Yes it takes all three, but see next three arguments. | charcter(len=*) | integer | real*8 | real*4 | no | |
+nvalue | number of value for vector | integer | no if writing a vector | |
+ncols | number of rows for matrix | integer | no if writing a matrix | |
+nrows | number of rows for matrix | integer | no if writing a matrix | |
+dim | number of the fastest growing dimension in the matrix | integer | yes | |
+id | unique id | character(len=*) | yes | |
+title | tag description | character(len=*) | yes | |
+conv | a convention | character(len=*) | yes | |
+dictref | dictionary reference | character(len=*) | yes | |
+ref | refernce to an atom (via the atom 'id' attribute) | character(len=*) | yes | |
+units | units for the property | character(len=*) | yes | |
+fmt | format for reals | character(len=*) | yes | f8.3 |
+
+
+
+ -
+
+
+argument | role | type | optional | default |
+xf | xml filehandle | type(xmlf_t) | no | |
+value | the parameter | charcter(len=*) | integer | real*8 | real*4 | logical | no | |
+id | unique id | character(len=*) | yes | |
+title | tag description | character(len=*) | yes | |
+conv | a convention | character(len=*) | yes | |
+cons | a constraint | character(len=*) | yes | |
+role | the role of the parameter | character(len=*) | yes | |
+dictref | dictionary reference | character(len=*) | yes | |
+ref | refernce to an atom (via the atom 'id' attribute) | character(len=*) | yes | |
+units | units for the parameter | character(len=*) | yes | |
+fmt | format for reals | character(len=*) | yes | f8.3 |
+
+
+
+
+
+
+
+x3 = 3D Cartesian coordinates long format
+xyz3 = 3D Cartesian coordinates short format
+xFrac = 3D fractional coordinates long format
+xyzFrac = 3D fractional coordinates short format
+xy2 = 2d Cartesian coordinates long format
+
+
+
+
+
Index: /XMLF90/doc/Tutorial/sax/README
===================================================================
--- /XMLF90/doc/Tutorial/sax/README (revision 6)
+++ /XMLF90/doc/Tutorial/sax/README (revision 6)
@@ -0,0 +1,13 @@
+This directory contains the source for the SAX examples in the User Guide.
+
+
+Release Notes:
+
+Changes with respect to the text in the User Guide:
+
+* Obvious typos and missing declarations have been corrected.
+
+* Subroutine begin_element_print in simple.f90
+ cannot apparently be both an internal subprogram and an actual argument.
+ It has been put in a module.
+
Index: /XMLF90/doc/Tutorial/sax/i.inventory.f90
===================================================================
--- /XMLF90/doc/Tutorial/sax/i.inventory.f90 (revision 6)
+++ /XMLF90/doc/Tutorial/sax/i.inventory.f90 (revision 6)
@@ -0,0 +1,15 @@
+program inventory
+use flib_sax
+use m_handlers
+
+type(xml_t) :: fxml ! XML file object (opaque)
+integer :: iostat
+
+call open_xmlfile("inventory.xml",fxml,iostat)
+if (iostat /= 0) stop "cannot open xml file"
+
+call xml_parse(fxml, begin_element_handler=begin_element, &
+ end_element_handler=end_element, &
+ pcdata_chunk_handler=pcdata_chunk )
+
+end program inventory
Index: /XMLF90/doc/Tutorial/sax/i.m_handlers.f90
===================================================================
--- /XMLF90/doc/Tutorial/sax/i.m_handlers.f90 (revision 6)
+++ /XMLF90/doc/Tutorial/sax/i.m_handlers.f90 (revision 6)
@@ -0,0 +1,60 @@
+module m_handlers
+use flib_sax
+private
+public :: begin_element, end_element, pcdata_chunk
+!
+logical, private :: in_item, in_description, in_price
+character(len=40), private :: what, price, currency, id
+!
+contains !-----------------------------------------
+!
+subroutine begin_element(name,attributes)
+ character(len=*), intent(in) :: name
+ type(dictionary_t), intent(in) :: attributes
+
+ integer :: status
+
+ select case(name)
+ case("item")
+ in_item = .true.
+ call get_value(attributes,"id",id,status)
+
+ case("description")
+ in_description = .true.
+
+ case("price")
+ in_price = .true.
+ call get_value(attributes,"currency",currency,status)
+
+ end select
+
+end subroutine begin_element
+!---------------------------------------------------------------
+subroutine pcdata_chunk(chunk)
+ character(len=*), intent(in) :: chunk
+
+ if (in_description) what = chunk
+ if (in_price) price = chunk
+
+end subroutine pcdata_chunk
+!---------------------------------------------------------------
+subroutine end_element(name)
+ character(len=*), intent(in) :: name
+
+ select case(name)
+ case("item")
+ in_item = .false.
+ write(unit=*,fmt="(5(a,tr1))") trim(id), trim(what), ":", &
+ trim(price), trim(currency)
+
+ case("description")
+ in_description = .false.
+
+ case("price")
+ in_price = .false.
+
+ end select
+
+end subroutine end_element
+!---------------------------------------------------------------
+end module m_handlers
Index: /XMLF90/doc/Tutorial/sax/i.simple.f90
===================================================================
--- /XMLF90/doc/Tutorial/sax/i.simple.f90 (revision 6)
+++ /XMLF90/doc/Tutorial/sax/i.simple.f90 (revision 6)
@@ -0,0 +1,37 @@
+module m_aux
+use flib_sax
+private
+public :: begin_element_print
+
+contains !---------------- handler subroutine follows
+
+subroutine begin_element_print(name,attributes)
+ character(len=*), intent(in) :: name
+ type(dictionary_t), intent(in) :: attributes
+
+ character(len=3) :: id
+ integer :: status
+
+ print *, "Start of element: ", name
+ if (has_key(attributes,"id")) then
+ call get_value(attributes,"id",id,status)
+ print *, " Id attribute: ", id
+ endif
+end subroutine begin_element_print
+
+end module m_aux
+
+program simple
+use flib_sax
+use m_aux
+
+type(xml_t) :: fxml ! XML file object (opaque)
+integer :: iostat ! Return code (0 if OK)
+
+call open_xmlfile("inventory.xml",fxml,iostat)
+if (iostat /= 0) stop "cannot open xml file"
+
+call xml_parse(fxml, begin_element_handler=begin_element_print)
+
+
+end program simple
Index: /XMLF90/doc/Tutorial/sax/inventory.f90
===================================================================
--- /XMLF90/doc/Tutorial/sax/inventory.f90 (revision 6)
+++ /XMLF90/doc/Tutorial/sax/inventory.f90 (revision 6)
@@ -0,0 +1,15 @@
+program inventory
+use flib_sax
+use m_handlers
+
+type(xml_t) :: fxml ! XML file object (opaque)
+integer :: iostat
+
+call open_xmlfile("inventory.xml",fxml,iostat)
+if (iostat /= 0) stop "cannot open xml file"
+
+call xml_parse(fxml, begin_element_handler=begin_element, &
+ end_element_handler=end_element, &
+ pcdata_chunk_handler=pcdata_chunk )
+
+end program inventory
Index: /XMLF90/doc/Tutorial/sax/inventory.xml
===================================================================
--- /XMLF90/doc/Tutorial/sax/inventory.xml (revision 6)
+++ /XMLF90/doc/Tutorial/sax/inventory.xml (revision 6)
@@ -0,0 +1,14 @@
+
+-
+Washing machine
+1500.00
+
+-
+Microwave oven
+300.00
+
+-
+Dishwasher
+10000.00
+
+
Index: /XMLF90/doc/Tutorial/sax/m_handlers.f90
===================================================================
--- /XMLF90/doc/Tutorial/sax/m_handlers.f90 (revision 6)
+++ /XMLF90/doc/Tutorial/sax/m_handlers.f90 (revision 6)
@@ -0,0 +1,60 @@
+module m_handlers
+use flib_sax
+private
+public :: begin_element, end_element, pcdata_chunk
+!
+logical, private :: in_item, in_description, in_price
+character(len=40), private :: what, price, currency, id
+!
+contains !-----------------------------------------
+!
+subroutine begin_element(name,attributes)
+ character(len=*), intent(in) :: name
+ type(dictionary_t), intent(in) :: attributes
+
+ integer :: status
+
+ select case(name)
+ case("item")
+ in_item = .true.
+ call get_value(attributes,"id",id,status)
+
+ case("description")
+ in_description = .true.
+
+ case("price")
+ in_price = .true.
+ call get_value(attributes,"currency",currency,status)
+
+ end select
+
+end subroutine begin_element
+!---------------------------------------------------------------
+subroutine pcdata_chunk(chunk)
+ character(len=*), intent(in) :: chunk
+
+ if (in_description) what = chunk
+ if (in_price) price = chunk
+
+end subroutine pcdata_chunk
+!---------------------------------------------------------------
+subroutine end_element(name)
+ character(len=*), intent(in) :: name
+
+ select case(name)
+ case("item")
+ in_item = .false.
+ write(unit=*,fmt="(5(a,tr1))") trim(id), trim(what), ":", &
+ trim(price), trim(currency)
+
+ case("description")
+ in_description = .false.
+
+ case("price")
+ in_price = .false.
+
+ end select
+
+end subroutine end_element
+!---------------------------------------------------------------
+end module m_handlers
Index: /XMLF90/doc/Tutorial/sax/makefile
===================================================================
--- /XMLF90/doc/Tutorial/sax/makefile (revision 6)
+++ /XMLF90/doc/Tutorial/sax/makefile (revision 6)
@@ -0,0 +1,35 @@
+#
+# Makefile for SAX exercises
+#
+default: all
+all: simple inventory
+#
+#---------------------------
+MK=$(FLIB_ROOT)/fortran.mk
+include $(MK)
+#---------------------------
+#
+# Uncomment the following line for debugging support
+#
+FFLAGS=$(FFLAGS_DEBUG)
+#
+LIBS=$(LIB_PREFIX)$(LIB_STD) -lflib
+#
+simple: simple.o
+ $(FC) $(LDFLAGS) -o simple simple.o $(LIBS)
+inventory: m_handlers.o inventory.o
+ $(FC) $(LDFLAGS) -o inventory m_handlers.o inventory.o $(LIBS)
+#
+clean:
+ rm -f simple inventory *.o *.$(MOD_EXT)
+#
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Tutorial/sax/simple.f90
===================================================================
--- /XMLF90/doc/Tutorial/sax/simple.f90 (revision 6)
+++ /XMLF90/doc/Tutorial/sax/simple.f90 (revision 6)
@@ -0,0 +1,37 @@
+module m_aux
+use flib_sax
+private
+public :: begin_element_print
+
+contains !---------------- handler subroutine follows
+
+subroutine begin_element_print(name,attributes)
+ character(len=*), intent(in) :: name
+ type(dictionary_t), intent(in) :: attributes
+
+ character(len=3) :: id
+ integer :: status
+
+ print *, "Start of element: ", name
+ if (has_key(attributes,"id")) then
+ call get_value(attributes,"id",id,status)
+ print *, " Id attribute: ", id
+ endif
+end subroutine begin_element_print
+
+end module m_aux
+
+program simple
+use flib_sax
+use m_aux
+
+type(xml_t) :: fxml ! XML file object (opaque)
+integer :: iostat ! Return code (0 if OK)
+
+call open_xmlfile("inventory.xml",fxml,iostat)
+if (iostat /= 0) stop "cannot open xml file"
+
+call xml_parse(fxml, begin_element_handler=begin_element_print)
+
+
+end program simple
Index: /XMLF90/doc/Tutorial/xpath/README
===================================================================
--- /XMLF90/doc/Tutorial/xpath/README (revision 6)
+++ /XMLF90/doc/Tutorial/xpath/README (revision 6)
@@ -0,0 +1,12 @@
+This directory contains the source for the XPATH examples in the User Guide.
+
+
+Release Notes:
+
+Changes with respect to the text in the User Guide:
+
+* Obvious typos and missing declarations have been corrected.
+
+* Due to a bug in xmlf90 Version 0.9.8, it is necessary to add an "attributes"
+argument in the call to "get_node" in euros.f90.
+
Index: /XMLF90/doc/Tutorial/xpath/context.f90
===================================================================
--- /XMLF90/doc/Tutorial/xpath/context.f90 (revision 6)
+++ /XMLF90/doc/Tutorial/xpath/context.f90 (revision 6)
@@ -0,0 +1,39 @@
+program item_context
+use flib_xpath
+type(xml_t) :: fxml, context
+integer :: status
+character(len=100) :: what, price, currency
+type(dictionary_t) :: attributes
+
+call open_xmlfile("inventory.xml",fxml,status)
+!
+do
+ call mark_node(fxml,path="//item",status=status)
+ if (status < 0) exit ! No more items
+ context = fxml ! Save item context
+!
+! Search relative to context
+!
+ call get_node(fxml,path="price", &
+ attributes=attributes,pcdata=price,status=status)
+ call get_value(attributes,"currency",currency,status)
+ if (status /= 0) stop "missing currency attribute!"
+!
+! Rewind to beginning of context
+
+ call sync_to_context(fxml,context)
+!
+! Search relative to context
+!
+ call get_node(fxml,path="description",pcdata=what,status=status)
+ write(unit=*,fmt="(6a))") "Appliance: ", trim(what), &
+ ". Price: ", trim(price), " ", trim(currency)
+enddo
+end program item_context
+
+
+
+
+
+
+
Index: /XMLF90/doc/Tutorial/xpath/euros.f90
===================================================================
--- /XMLF90/doc/Tutorial/xpath/euros.f90 (revision 6)
+++ /XMLF90/doc/Tutorial/xpath/euros.f90 (revision 6)
@@ -0,0 +1,21 @@
+program euros
+use flib_xpath
+!
+type(xml_t) :: fxml
+
+integer :: status
+character(len=100) :: price
+
+!call enable_debug(sax=.false.)
+
+call open_xmlfile("inventory.xml",fxml,status)
+!
+do
+ call get_node(fxml,path="//price", &
+ att_name="currency",att_value="euro", &
+ pcdata=price,status=status)
+ if (status < 0) exit
+ print *, "Price (euro): ", trim(price)
+enddo
+end program euros
+
Index: /XMLF90/doc/Tutorial/xpath/get_item_info.f90
===================================================================
--- /XMLF90/doc/Tutorial/xpath/get_item_info.f90 (revision 6)
+++ /XMLF90/doc/Tutorial/xpath/get_item_info.f90 (revision 6)
@@ -0,0 +1,30 @@
+subroutine get_item_info(context,what,price,currency)
+type(xml_t), intent(in) :: contex
+character(len=*), intent(out) :: what, price, currency
+
+!
+! Local variables
+!
+type(xml_t) :: ff
+integer :: status
+type(dictionary_t) :: attributes
+
+ !
+ ! context is read-only, so make a copy and sync just in case
+ !
+ ff = context
+ call sync_xmlfile(ff)
+ !
+ call get_node(ff,path="price", &
+ attributes=attributes,pcdata=price,status=status)
+ call get_value(attributes,"currency",currency,status)
+ if (status /= 0) stop "missing currency attribute!"
+ !
+ ! Rewind to beginning of context
+ !
+ ff = context
+ call sync_xmlfile(ff)
+ !
+ call get_node(ff,path="description",pcdata=what,status=status)
+
+end subroutine get_item_info
Index: /XMLF90/doc/Tutorial/xpath/i.euros.f90
===================================================================
--- /XMLF90/doc/Tutorial/xpath/i.euros.f90 (revision 6)
+++ /XMLF90/doc/Tutorial/xpath/i.euros.f90 (revision 6)
@@ -0,0 +1,21 @@
+program euros
+use flib_xpath
+!
+type(xml_t) :: fxml
+
+integer :: status
+character(len=100) :: price
+
+!call enable_debug(sax=.false.)
+
+call open_xmlfile("inventory.xml",fxml,status)
+!
+do
+ call get_node(fxml,path="//price", &
+ att_name="currency",att_value="euro", &
+ pcdata=price,status=status)
+ if (status < 0) exit
+ print *, "Price (euro): ", trim(price)
+enddo
+end program euros
+
Index: /XMLF90/doc/Tutorial/xpath/i.item_context.f90
===================================================================
--- /XMLF90/doc/Tutorial/xpath/i.item_context.f90 (revision 6)
+++ /XMLF90/doc/Tutorial/xpath/i.item_context.f90 (revision 6)
@@ -0,0 +1,35 @@
+program item_context
+use flib_xpath
+
+type(xml_t) :: fxml, context
+
+integer :: status
+character(len=100) :: what, price, currency
+type(dictionary_t) :: attributes
+
+call open_xmlfile("inventory.xml",fxml,status)
+!
+do
+ call mark_node(fxml,path="//item",status=status)
+ if (status < 0) exit ! No more items
+ context = fxml ! Save item context
+ !
+ ! Search relative to context
+ !
+ call get_node(fxml,path="price", &
+ attributes=attributes,pcdata=price,status=status)
+ call get_value(attributes,"currency",currency,status)
+ if (status /= 0) stop "missing currency attribute!"
+ !
+ ! Rewind to beginning of context
+ !
+ fxml = context
+ call sync_xmlfile(fxml,status)
+ !
+ ! Search relative to context
+ !
+ call get_node(fxml,path="description",pcdata=what,status=status)
+ write(unit=*,fmt="(6a)") "Appliance: ", trim(what), &
+ ". Price: ", trim(price), " ", trim(currency)
+enddo
+end program item_context
Index: /XMLF90/doc/Tutorial/xpath/i.item_context2.f90
===================================================================
--- /XMLF90/doc/Tutorial/xpath/i.item_context2.f90 (revision 6)
+++ /XMLF90/doc/Tutorial/xpath/i.item_context2.f90 (revision 6)
@@ -0,0 +1,63 @@
+module m_aux
+
+use flib_xpath
+private
+public :: get_item_info
+
+CONTAINS
+
+subroutine get_item_info(context,what,price,currency)
+
+type(xml_t), intent(in) :: context
+character(len=*), intent(out) :: what, price, currency
+
+!
+! Local variables
+!
+type(xml_t) :: ff
+integer :: status
+type(dictionary_t) :: attributes
+
+ !
+ ! context is read-only, so make a copy and sync just in case
+ !
+ ff = context
+ call sync_xmlfile(ff,status)
+ !
+ call get_node(ff,path="price", &
+ attributes=attributes,pcdata=price,status=status)
+ call get_value(attributes,"currency",currency,status)
+ if (status /= 0) stop "missing currency attribute!"
+ !
+ ! Rewind to beginning of context
+ !
+ ff = context
+ call sync_xmlfile(ff,status)
+ !
+ call get_node(ff,path="description",pcdata=what,status=status)
+
+end subroutine get_item_info
+
+end module m_aux
+!-----------------------------------------------------------------
+!-----------------------------------------------------------------
+program item_context2
+use flib_xpath
+use m_aux ! To access the subroutine
+
+type(xml_t) :: fxml
+
+integer :: status
+character(len=100) :: what, price, currency
+
+call open_xmlfile("inventory.xml",fxml,status)
+!
+do
+ call mark_node(fxml,path="//item",status=status)
+ if (status /= 0) exit ! No more items
+ call get_item_info(fxml,what,price,currency)
+ write(unit=*,fmt="(6a)") "Appliance: ", trim(what), &
+ ". Price: ", trim(price), " ", trim(currency)
+ call sync_xmlfile(fxml,status)
+enddo
+end program item_context2
Index: /XMLF90/doc/Tutorial/xpath/i.mixing.f90
===================================================================
--- /XMLF90/doc/Tutorial/xpath/i.mixing.f90 (revision 6)
+++ /XMLF90/doc/Tutorial/xpath/i.mixing.f90 (revision 6)
@@ -0,0 +1,18 @@
+program self
+use flib_xpath
+!
+type(xml_t) :: fxml
+
+integer :: status
+character(len=100) :: pcdata
+
+call open_xmlfile("inventory_text.xml",fxml,status)
+!
+do
+ call get_node(fxml,path="//item",pcdata=pcdata,status=status)
+ if (status < 0) exit
+ !
+ print *, "PCDATA retrieved from item element: ", trim(pcdata)
+
+enddo
+end program self
Index: /XMLF90/doc/Tutorial/xpath/i.self.f90
===================================================================
--- /XMLF90/doc/Tutorial/xpath/i.self.f90 (revision 6)
+++ /XMLF90/doc/Tutorial/xpath/i.self.f90 (revision 6)
@@ -0,0 +1,43 @@
+program self
+use flib_xpath
+!
+! Example of re-scanning of an element
+!
+type(xml_t) :: fxml
+type(dictionary_t) :: attributes
+
+integer :: status
+character(len=100) :: id, currency, price
+
+call open_xmlfile("inventory.xml",fxml,status)
+!
+do
+ call mark_node(fxml,path="//item",status=status)
+ if (status < 0) exit
+ !
+ ! Pretend we forgot to get the id attribute...
+ !
+ call get_node(fxml,path=".",attributes=attributes,status=status)
+ if (status < 0) exit
+ call get_value(attributes,"id",id,status)
+ if (status /= 0) stop "missing id attribute!"
+ print *, "Id: ", trim(id)
+ !
+ ! Now perform a relative search in two stages:
+ ! First the attributes...
+ !
+ call get_node(fxml,path="price",attributes=attributes,status=status)
+ if (status < 0) exit
+ call get_value(attributes,"currency",currency,status)
+ if (status /= 0) stop "missing currency attribute!"
+ print *, "Currency: ", trim(id)
+
+ ! And then the pcdata. Note that "." refers now to the /item/price
+ ! element, since fxml has been running through the file and we
+ ! have not saved any context to get back to.
+ !
+ call get_node(fxml,path=".",pcdata=price,status=status)
+ if (status /= 0) stop "error in retrieving price data"
+ print *, "Price: ", trim(price)
+enddo
+end program self
Index: /XMLF90/doc/Tutorial/xpath/i.simple.f90
===================================================================
--- /XMLF90/doc/Tutorial/xpath/i.simple.f90 (revision 6)
+++ /XMLF90/doc/Tutorial/xpath/i.simple.f90 (revision 6)
@@ -0,0 +1,16 @@
+program simple
+use flib_xpath
+
+type(xml_t) :: fxml
+
+integer :: status
+character(len=100) :: what
+
+call open_xmlfile("inventory.xml",fxml,status)
+!
+do
+ call get_node(fxml,path="//description",pcdata=what,status=status)
+ if (status < 0) exit
+ print *, "Appliance: ", trim(what)
+enddo
+end program simple
Index: /XMLF90/doc/Tutorial/xpath/i.twoelements.f90
===================================================================
--- /XMLF90/doc/Tutorial/xpath/i.twoelements.f90 (revision 6)
+++ /XMLF90/doc/Tutorial/xpath/i.twoelements.f90 (revision 6)
@@ -0,0 +1,29 @@
+program twoelements
+use flib_xpath
+
+type(xml_t) :: fxml
+
+integer :: status
+character(len=100) :: what, price, currency
+type(dictionary_t) :: attributes
+
+call open_xmlfile("inventory.xml",fxml,status)
+!
+do
+ call get_node(fxml,path="//description", &
+ pcdata=what,status=status)
+ if (status < 0) exit ! No more items
+ !
+ ! Price comes right after description...
+ !
+ call get_node(fxml,path="//price", &
+ attributes=attributes,pcdata=price,status=status)
+ if (status /= 0) stop "missing price element!"
+
+ call get_value(attributes,"currency",currency,status)
+ if (status /= 0) stop "missing currency attribute!"
+
+ write(unit=*,fmt="(6a)") "Appliance: ", trim(what), &
+ ". Price: ", trim(price), " ", trim(currency)
+enddo
+end program twoelements
Index: /XMLF90/doc/Tutorial/xpath/inventory.xml
===================================================================
--- /XMLF90/doc/Tutorial/xpath/inventory.xml (revision 6)
+++ /XMLF90/doc/Tutorial/xpath/inventory.xml (revision 6)
@@ -0,0 +1,14 @@
+
+-
+Washing machine
+1500.00
+
+-
+Microwave oven
+300.00
+
+-
+Dishwasher
+10000.00
+
+
Index: /XMLF90/doc/Tutorial/xpath/inventory_text.xml
===================================================================
--- /XMLF90/doc/Tutorial/xpath/inventory_text.xml (revision 6)
+++ /XMLF90/doc/Tutorial/xpath/inventory_text.xml (revision 6)
@@ -0,0 +1,17 @@
+
+-
+Some random text.
+Washing machine
+1500.00
+
+-
+Microwave oven
+More text.
+300.00
+
+-
+Dishwasher
+10000.00
+Still more text.
+
+
Index: /XMLF90/doc/Tutorial/xpath/item_context.f90
===================================================================
--- /XMLF90/doc/Tutorial/xpath/item_context.f90 (revision 6)
+++ /XMLF90/doc/Tutorial/xpath/item_context.f90 (revision 6)
@@ -0,0 +1,35 @@
+program item_context
+use flib_xpath
+
+type(xml_t) :: fxml, context
+
+integer :: status
+character(len=100) :: what, price, currency
+type(dictionary_t) :: attributes
+
+call open_xmlfile("inventory.xml",fxml,status)
+!
+do
+ call mark_node(fxml,path="//item",status=status)
+ if (status < 0) exit ! No more items
+ context = fxml ! Save item context
+ !
+ ! Search relative to context
+ !
+ call get_node(fxml,path="price", &
+ attributes=attributes,pcdata=price,status=status)
+ call get_value(attributes,"currency",currency,status)
+ if (status /= 0) stop "missing currency attribute!"
+ !
+ ! Rewind to beginning of context
+ !
+ fxml = context
+ call sync_xmlfile(fxml,status)
+ !
+ ! Search relative to context
+ !
+ call get_node(fxml,path="description",pcdata=what,status=status)
+ write(unit=*,fmt="(6a)") "Appliance: ", trim(what), &
+ ". Price: ", trim(price), " ", trim(currency)
+enddo
+end program item_context
Index: /XMLF90/doc/Tutorial/xpath/item_context2.f90
===================================================================
--- /XMLF90/doc/Tutorial/xpath/item_context2.f90 (revision 6)
+++ /XMLF90/doc/Tutorial/xpath/item_context2.f90 (revision 6)
@@ -0,0 +1,63 @@
+module m_aux
+
+use flib_xpath
+private
+public :: get_item_info
+
+CONTAINS
+
+subroutine get_item_info(context,what,price,currency)
+
+type(xml_t), intent(in) :: context
+character(len=*), intent(out) :: what, price, currency
+
+!
+! Local variables
+!
+type(xml_t) :: ff
+integer :: status
+type(dictionary_t) :: attributes
+
+ !
+ ! context is read-only, so make a copy and sync just in case
+ !
+ ff = context
+ call sync_xmlfile(ff,status)
+ !
+ call get_node(ff,path="price", &
+ attributes=attributes,pcdata=price,status=status)
+ call get_value(attributes,"currency",currency,status)
+ if (status /= 0) stop "missing currency attribute!"
+ !
+ ! Rewind to beginning of context
+ !
+ ff = context
+ call sync_xmlfile(ff,status)
+ !
+ call get_node(ff,path="description",pcdata=what,status=status)
+
+end subroutine get_item_info
+
+end module m_aux
+!-----------------------------------------------------------------
+!-----------------------------------------------------------------
+program item_context2
+use flib_xpath
+use m_aux ! To access the subroutine
+
+type(xml_t) :: fxml
+
+integer :: status
+character(len=100) :: what, price, currency
+
+call open_xmlfile("inventory.xml",fxml,status)
+!
+do
+ call mark_node(fxml,path="//item",status=status)
+ if (status /= 0) exit ! No more items
+ call get_item_info(fxml,what,price,currency)
+ write(unit=*,fmt="(6a)") "Appliance: ", trim(what), &
+ ". Price: ", trim(price), " ", trim(currency)
+ call sync_xmlfile(fxml,status)
+enddo
+end program item_context2
Index: /XMLF90/doc/Tutorial/xpath/makefile
===================================================================
--- /XMLF90/doc/Tutorial/xpath/makefile (revision 6)
+++ /XMLF90/doc/Tutorial/xpath/makefile (revision 6)
@@ -0,0 +1,46 @@
+#
+# Makefile for Xpath examples
+#
+default: all
+all: simple euros twoelements item_context item_context2 self mixing
+#
+#---------------------------
+MK=$(FLIB_ROOT)/fortran.mk
+include $(MK)
+#---------------------------
+#
+# Uncomment the following line for debugging support
+#
+FFLAGS=$(FFLAGS_DEBUG)
+#
+LIBS=$(LIB_PREFIX)$(LIB_STD) -lflib
+#
+simple: simple.o
+ $(FC) $(LDFLAGS) -o simple simple.o $(LIBS)
+euros: euros.o
+ $(FC) $(LDFLAGS) -o euros euros.o $(LIBS)
+twoelements: twoelements.o
+ $(FC) $(LDFLAGS) -o twoelements twoelements.o $(LIBS)
+item_context: item_context.o
+ $(FC) $(LDFLAGS) -o item_context item_context.o $(LIBS)
+item_context2: item_context2.o
+ $(FC) $(LDFLAGS) -o item_context2 item_context2.o $(LIBS)
+self: self.o
+ $(FC) $(LDFLAGS) -o self self.o $(LIBS)
+mixing: mixing.o
+ $(FC) $(LDFLAGS) -o mixing mixing.o $(LIBS)
+#
+clean:
+ rm -f simple euros twoelements item_context item_context2
+ rm -f self mixing *.o *.$(MOD_EXT)
+#
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/doc/Tutorial/xpath/mixing.f90
===================================================================
--- /XMLF90/doc/Tutorial/xpath/mixing.f90 (revision 6)
+++ /XMLF90/doc/Tutorial/xpath/mixing.f90 (revision 6)
@@ -0,0 +1,18 @@
+program self
+use flib_xpath
+!
+type(xml_t) :: fxml
+
+integer :: status
+character(len=100) :: pcdata
+
+call open_xmlfile("inventory_text.xml",fxml,status)
+!
+do
+ call get_node(fxml,path="//item",pcdata=pcdata,status=status)
+ if (status < 0) exit
+ !
+ print *, "PCDATA retrieved from item element: ", trim(pcdata)
+
+enddo
+end program self
Index: /XMLF90/doc/Tutorial/xpath/self.f90
===================================================================
--- /XMLF90/doc/Tutorial/xpath/self.f90 (revision 6)
+++ /XMLF90/doc/Tutorial/xpath/self.f90 (revision 6)
@@ -0,0 +1,43 @@
+program self
+use flib_xpath
+!
+! Example of re-scanning of an element
+!
+type(xml_t) :: fxml
+type(dictionary_t) :: attributes
+
+integer :: status
+character(len=100) :: id, currency, price
+
+call open_xmlfile("inventory.xml",fxml,status)
+!
+do
+ call mark_node(fxml,path="//item",status=status)
+ if (status < 0) exit
+ !
+ ! Pretend we forgot to get the id attribute...
+ !
+ call get_node(fxml,path=".",attributes=attributes,status=status)
+ if (status < 0) exit
+ call get_value(attributes,"id",id,status)
+ if (status /= 0) stop "missing id attribute!"
+ print *, "Id: ", trim(id)
+ !
+ ! Now perform a relative search in two stages:
+ ! First the attributes...
+ !
+ call get_node(fxml,path="price",attributes=attributes,status=status)
+ if (status < 0) exit
+ call get_value(attributes,"currency",currency,status)
+ if (status /= 0) stop "missing currency attribute!"
+ print *, "Currency: ", trim(id)
+
+ ! And then the pcdata. Note that "." refers now to the /item/price
+ ! element, since fxml has been running through the file and we
+ ! have not saved any context to get back to.
+ !
+ call get_node(fxml,path=".",pcdata=price,status=status)
+ if (status /= 0) stop "error in retrieving price data"
+ print *, "Price: ", trim(price)
+enddo
+end program self
Index: /XMLF90/doc/Tutorial/xpath/simple.f90
===================================================================
--- /XMLF90/doc/Tutorial/xpath/simple.f90 (revision 6)
+++ /XMLF90/doc/Tutorial/xpath/simple.f90 (revision 6)
@@ -0,0 +1,16 @@
+program simple
+use flib_xpath
+
+type(xml_t) :: fxml
+
+integer :: status
+character(len=100) :: what
+
+call open_xmlfile("inventory.xml",fxml,status)
+!
+do
+ call get_node(fxml,path="//description",pcdata=what,status=status)
+ if (status < 0) exit
+ print *, "Appliance: ", trim(what)
+enddo
+end program simple
Index: /XMLF90/doc/Tutorial/xpath/twoelements.f90
===================================================================
--- /XMLF90/doc/Tutorial/xpath/twoelements.f90 (revision 6)
+++ /XMLF90/doc/Tutorial/xpath/twoelements.f90 (revision 6)
@@ -0,0 +1,29 @@
+program twoelements
+use flib_xpath
+
+type(xml_t) :: fxml
+
+integer :: status
+character(len=100) :: what, price, currency
+type(dictionary_t) :: attributes
+
+call open_xmlfile("inventory.xml",fxml,status)
+!
+do
+ call get_node(fxml,path="//description", &
+ pcdata=what,status=status)
+ if (status < 0) exit ! No more items
+ !
+ ! Price comes right after description...
+ !
+ call get_node(fxml,path="//price", &
+ attributes=attributes,pcdata=price,status=status)
+ if (status /= 0) stop "missing price element!"
+
+ call get_value(attributes,"currency",currency,status)
+ if (status /= 0) stop "missing currency attribute!"
+
+ write(unit=*,fmt="(6a)") "Appliance: ", trim(what), &
+ ". Price: ", trim(price), " ", trim(currency)
+enddo
+end program twoelements
Index: /XMLF90/src/cml/flib_cml.f90
===================================================================
--- /XMLF90/src/cml/flib_cml.f90 (revision 6)
+++ /XMLF90/src/cml/flib_cml.f90 (revision 6)
@@ -0,0 +1,7 @@
+module flib_cml
+ use m_stmw
+ use m_cmlw
+
+ public
+
+end module flib_cml
Index: /XMLF90/src/cml/m_cmlw.f90
===================================================================
--- /XMLF90/src/cml/m_cmlw.f90 (revision 6)
+++ /XMLF90/src/cml/m_cmlw.f90 (revision 6)
@@ -0,0 +1,1846 @@
+module m_cmlw
+
+ use flib_wxml
+ use m_stmw
+
+ private
+
+ integer, private, parameter :: sp = selected_real_kind(6,30)
+ integer, private, parameter :: dp = selected_real_kind(14,100)
+
+
+! CMLUnits
+ character(len=40), parameter :: U_ANGSTR = 'units:angstrom'
+ character(len=40), parameter :: U_PMETER = 'units:pm'
+ character(len=40), parameter :: U_DEGREE = 'units:degree'
+ character(len=40), parameter :: U_RADIAN = 'units:radian'
+ character(len=40), parameter :: U_INVCM = 'units:cm-1'
+ character(len=40), parameter :: U_KCALMO = 'units:kcal-mole'
+ character(len=40), parameter :: U_EVOLT = 'units:ev'
+ character(len=40), parameter :: U_SECOND = 'units:second'
+ character(len=40), parameter :: U_VOLT = 'units:volt'
+
+! CMLCore
+ PUBLIC :: cmlAddCoordinates
+ PUBLIC :: cmlAddCrystal
+ PUBLIC :: cmlAddAngle
+ PUBLIC :: cmlAddLength
+ PUBLIC :: cmlAddEigenvalue
+ PUBLIC :: cmlAddProperty
+ PUBLIC :: cmlAddPropertyList
+ PUBLIC :: cmlAddMolecule
+ PUBLIC :: cmlAddMetadata
+
+! CMLComp
+ PUBLIC :: cmlAddLattice
+ PUBLIC :: cmlAddLatticeVector
+ PUBLIC :: cmlAddParameter
+
+! CMLCore
+ INTERFACE cmlAddCoordinates
+ MODULE PROCEDURE cmlAddCoordinatesSP, cmlAddCoordinatesDP
+ END INTERFACE
+
+ INTERFACE cmlAddCrystal
+ MODULE PROCEDURE cmlAddCrystalSP, cmlAddCrystalDP
+ END INTERFACE
+
+ INTERFACE cmlAddAngle
+ MODULE PROCEDURE cmlAddAngleSP, cmlAddAngleDP
+ END INTERFACE
+
+ INTERFACE cmlAddLength
+ MODULE PROCEDURE cmlAddLengthSP, cmlAddLengthDP
+ END INTERFACE
+
+ INTERFACE cmlAddEigenvalue
+ MODULE PROCEDURE cmlAddEigenvalueSP, cmlAddEigenvalueDP
+ END INTERFACE
+
+ INTERFACE cmlAddMolecule
+ MODULE PROCEDURE cmlAddMoleculeSP, cmlAddMoleculeDP, cmlAddMolecule3SP, &
+ cmlAddMolecule3DP
+ END INTERFACE
+
+! CMLComa
+ INTERFACE cmlAddLattice
+ MODULE PROCEDURE cmlAddLatticeSP, cmlAddLatticeDP
+ END INTERFACE
+
+ INTERFACE cmlAddLatticeVector
+ MODULE PROCEDURE cmlAddLatticeVectorSP, cmlAddLatticeVectorDP
+ END INTERFACE
+
+ INTERFACE cmlAddProperty
+ MODULE PROCEDURE &
+ cmlAddPropScalarDP, cmlAddPropScalarSP, cmlAddPropScalarI, &
+ cmlAddPropMatrixDP, cmlAddPropMatrixSP, cmlAddPropMatrixI, &
+ cmlAddPropArrayDP, cmlAddPropArraySP, cmlAddPropArrayI
+ END INTERFACE
+
+ INTERFACE cmlAddParameter
+ MODULE PROCEDURE &
+ cmlAddParameterCH, cmlAddParameterI, &
+ cmlAddParameterSP, cmlAddParameterDP, &
+ cmlAddParameterLG
+ END INTERFACE
+
+
+CONTAINS
+
+ ! =================================================
+ ! convenience CML routines
+ ! =================================================
+
+ ! -------------------------------------------------
+ ! writes a propertyList start Tag to xml channel
+ ! -------------------------------------------------
+
+ SUBROUTINE cmlAddPropertyList(xf, id, title, conv, dictref, ref, role)
+
+ implicit none
+ type(xmlf_t) :: xf
+ character(len=*), intent(in), optional :: id
+ character(len=*), intent(in), optional :: title
+ character(len=*), intent(in), optional :: conv
+ character(len=*), intent(in), optional :: dictref
+ character(len=*), intent(in), optional :: ref
+ character(len=*), intent(in), optional :: role
+
+ call xml_NewElement(xf, 'propertyList')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+ if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+ if (present(role)) call xml_AddAttribute(xf, 'role', role)
+
+ END SUBROUTINE cmlAddPropertyList
+
+
+ ! -------------------------------------------------
+ ! 1. writes a DP property to xml channel
+ ! -------------------------------------------------
+
+ SUBROUTINE cmlAddPropScalarDP(xf, property, id, title, conv, dictref, ref, units, fmt)
+
+ implicit none
+ type(xmlf_t) :: xf
+ real(kind=dp), intent(in) :: property
+ character(len=*), intent(in), optional :: id
+ character(len=*), intent(in), optional :: title
+ character(len=*), intent(in), optional :: dictref
+ character(len=*), intent(in), optional :: conv
+ character(len=*), intent(in), optional :: ref
+ character(len=*), intent(in), optional :: fmt
+ character(len=*), intent(in), optional :: units
+
+ call xml_NewElement(xf, 'property')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+ if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+ call stmAddScalar(xf=xf, value=property, units=units, fmt=fmt)
+ call xml_EndElement(xf, 'property')
+
+ END SUBROUTINE cmlAddPropScalarDP
+
+ ! -------------------------------------------------
+ ! 2. writes a Scalar SP property to xml channel
+ ! -------------------------------------------------
+
+ SUBROUTINE cmlAddPropScalarSP(xf, property, id, title, conv, dictref, ref, units, fmt)
+
+ implicit none
+ type(xmlf_t) :: xf
+ real(kind=sp), intent(in) :: property
+ character(len=*), intent(in), optional :: id
+ character(len=*), intent(in), optional :: title
+ character(len=*), intent(in), optional :: dictref
+ character(len=*), intent(in), optional :: conv
+ character(len=*), intent(in), optional :: ref
+ character(len=*), intent(in), optional :: fmt
+ character(len=*), intent(in), optional :: units
+
+ call xml_NewElement(xf, 'property')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+ if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+ call stmAddScalar(xf=xf, value=property, units=units, fmt=fmt)
+ call xml_EndElement(xf, 'property')
+ END SUBROUTINE cmlAddPropScalarSP
+
+ ! -------------------------------------------------
+ ! 3. writes a Scalar integer property to xml channel
+ ! -------------------------------------------------
+
+ SUBROUTINE cmlAddPropScalarI(xf, property, id, title, conv, dictref, ref, units)
+
+ implicit none
+ type(xmlf_t) :: xf
+ integer, intent(in) :: property
+ character(len=*), intent(in), optional :: id
+ character(len=*), intent(in), optional :: title
+ character(len=*), intent(in), optional :: dictref
+ character(len=*), intent(in), optional :: conv
+ character(len=*), intent(in), optional :: ref
+ character(len=*), intent(in), optional :: units
+
+ call xml_NewElement(xf, 'property')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+ if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+ call stmAddScalar(xf=xf, value=property, units=units)
+ call xml_EndElement(xf, 'property')
+ END SUBROUTINE cmlAddPropScalarI
+
+ ! -------------------------------------------------
+ ! 4. writes an Float matrix property to xml channel
+ ! -------------------------------------------------
+
+ SUBROUTINE cmlAddPropMatrixDP(xf, property, nrows, ncols, dim, id, title, conv, dictref, ref, units, fmt)
+
+ implicit none
+ type(xmlf_t) :: xf
+ integer, intent(in) :: nrows
+ integer, intent(in) :: ncols
+ integer, intent(in) :: dim
+ real(kind=dp), intent(in) :: property(nrows,ncols)
+ character(len=*), intent(in), optional :: id
+ character(len=*), intent(in), optional :: title
+ character(len=*), intent(in), optional :: dictref
+ character(len=*), intent(in), optional :: conv
+ character(len=*), intent(in), optional :: ref
+ character(len=*), intent(in), optional :: fmt
+ character(len=*), intent(in), optional :: units
+
+ call xml_NewElement(xf, 'property')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+ if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+ call stmAddMatrix(xf=xf, matrix=property, dim=dim, ncols=ncols, nrows=nrows, units=units, fmt=fmt)
+ call xml_EndElement(xf, 'property')
+ END SUBROUTINE cmlAddPropMatrixDP
+
+ ! -------------------------------------------------
+ ! 5. writes an SP Float matrix property to xml channel
+ ! -------------------------------------------------
+
+ SUBROUTINE cmlAddPropMatrixSP(xf, property, nrows, ncols, dim, id, title, conv, dictref, ref, units, fmt)
+
+ implicit none
+ type(xmlf_t) :: xf
+ integer, intent(in) :: nrows
+ integer, intent(in) :: ncols
+ integer, intent(in) :: dim
+ real(kind=sp), intent(in) :: property(nrows,ncols)
+ character(len=*), intent(in), optional :: id
+ character(len=*), intent(in), optional :: title
+ character(len=*), intent(in), optional :: dictref
+ character(len=*), intent(in), optional :: conv
+ character(len=*), intent(in), optional :: ref
+ character(len=*), intent(in), optional :: fmt
+ character(len=*), intent(in), optional :: units
+
+ call xml_NewElement(xf, 'property')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+ if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+ call stmAddMatrix(xf=xf,matrix=property, dim=dim, ncols=ncols, nrows=nrows, units=units, fmt=fmt)
+ call xml_EndElement(xf, 'property')
+ END SUBROUTINE cmlAddPropMatrixSP
+
+
+ ! -------------------------------------------------
+ ! 6. writes an Integer matrix property to xml channel
+ ! -------------------------------------------------
+
+ SUBROUTINE cmlAddPropMatrixI(xf, property, nrows, ncols, dim, id, title, conv, dictref, ref, units, fmt)
+
+ implicit none
+ type(xmlf_t) :: xf
+
+ integer, intent(in) :: nrows
+ integer, intent(in) :: ncols
+ integer, intent(in), optional :: dim
+ integer, intent(in) :: property(nrows,ncols)
+ character(len=*), intent(in), optional :: id
+ character(len=*), intent(in), optional :: title
+ character(len=*), intent(in), optional :: dictref
+ character(len=*), intent(in), optional :: conv
+ character(len=*), intent(in), optional :: ref
+ character(len=*), intent(in), optional :: fmt
+ character(len=*), intent(in), optional :: units
+
+ call xml_NewElement(xf, 'property')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+ if (present(conv)) call xml_AddAttribute(xf, 'ref', ref)
+ call stmAddMatrix(xf=xf, matrix=property, dim=dim, ncols=ncols, nrows=nrows, units=units)
+ call xml_EndElement(xf, 'property')
+ END SUBROUTINE cmlAddPropMatrixI
+
+
+ ! -------------------------------------------------
+ ! 7. writes an Array DP property to xml channel
+ ! -------------------------------------------------
+
+ SUBROUTINE cmlAddPropArrayDP(xf, property, nvalue, id, title, conv, dictref, ref, units, fmt)
+
+ implicit none
+ type(xmlf_t) :: xf
+ real(kind=dp), intent(in) :: property(*)
+ integer, intent(in) :: nvalue
+ character(len=*), intent(in), optional :: id
+ character(len=*), intent(in), optional :: title
+ character(len=*), intent(in), optional :: dictref
+ character(len=*), intent(in), optional :: conv
+ character(len=*), intent(in), optional :: ref
+ character(len=*), intent(in), optional :: fmt
+ character(len=*), intent(in), optional :: units
+
+ call xml_NewElement(xf, 'property')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+ if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+ call stmAddArray(xf=xf, array=property, nvalue=nvalue, units=units, fmt=fmt)
+ call xml_EndElement(xf, 'property')
+ END SUBROUTINE cmlAddPropArrayDP
+
+ ! -------------------------------------------------
+ ! 8. writes an Array SP property to xml channel
+ ! -------------------------------------------------
+
+ SUBROUTINE cmlAddPropArraySP(xf, property, nvalue, id, title, conv, dictref, ref, units, fmt)
+
+ implicit none
+ type(xmlf_t) :: xf
+ real(kind=sp), intent(in) :: property(*)
+ integer, intent(in) :: nvalue
+ character(len=*), intent(in), optional :: id
+ character(len=*), intent(in), optional :: title
+ character(len=*), intent(in), optional :: dictref
+ character(len=*), intent(in), optional :: conv
+ character(len=*), intent(in), optional :: ref
+ character(len=*), intent(in), optional :: fmt
+ character(len=*), intent(in), optional :: units
+
+ call xml_NewElement(xf, 'property')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+ if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+ call stmAddArray(xf=xf, array=property, nvalue=nvalue, units=units, fmt=fmt)
+ call xml_EndElement(xf, 'property')
+ END SUBROUTINE cmlAddPropArraySP
+
+ ! -------------------------------------------------
+ ! 9. writes an Array integer property to xml channel
+ ! -------------------------------------------------
+
+ SUBROUTINE cmlAddPropArrayI(xf, property, nvalue, id, title, conv, dictref, ref, units)
+
+ implicit none
+ type(xmlf_t) :: xf
+ integer, intent(in) :: property(*)
+ integer, intent(in) :: nvalue
+ character(len=*), intent(in), optional :: id
+ character(len=*), intent(in), optional :: title
+ character(len=*), intent(in), optional :: dictref
+ character(len=*), intent(in), optional :: conv
+ character(len=*), intent(in), optional :: ref
+ character(len=*), intent(in), optional :: units
+
+ call xml_NewElement(xf, 'property')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+ if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+ call stmAddArray(xf, array=property, nvalue=nvalue, units=units)
+ call xml_EndElement(xf, 'property')
+ END SUBROUTINE cmlAddPropArrayI
+
+ !------------------------------------------------------------
+ ! END OF PROPERTIES
+ !------------------------------------------------------------
+
+
+ ! -------------------------------------------------
+ ! 1. writes complete DP molecule to xml channel
+ ! -------------------------------------------------
+
+ SUBROUTINE cmlAddMoleculeDP(xf, natoms, elements, coords, style, id, title, dictref, fmt)
+
+ implicit none
+ type(xmlf_t) :: xf
+ integer, intent(in) :: natoms ! number of atoms
+ real(kind=dp), intent(in) :: coords(3, natoms) ! atomic coordinates
+ character(len=*), intent(in) :: elements(natoms) ! chemical element types
+ character(len=*), intent(in), optional :: id ! id
+ character(len=*), intent(in), optional :: title ! the title
+ character(len=*), intent(in), optional :: dictref ! the dictionary reference
+ character(len=*), intent(in), optional :: fmt ! format for coords
+ character(len=*), intent(in), optional :: style ! type of coordinates
+
+ ! 'x3' for Cartesians,
+ ! 'xFrac' for fractionals
+ ! default => cartesians
+
+ ! Internal Variables
+ character(len=6) :: id1, id0
+ character(len=10):: formt, stylei
+ integer :: i
+
+ if (present(fmt)) then
+ formt = fmt
+ else
+ formt = '(f8.3)'
+ endif
+ if (present(style)) then
+ stylei = style
+ else
+ stylei = 'x3'
+ endif
+
+ call stmAddStartTag(xf, 'molecule', id, title, dictref)
+ call xml_NewElement(xf, 'atomArray')
+ do i = 1, natoms
+ write(id0, '(i4)') i
+ id0 = adjustl(id0)
+ id1 = 'a'
+ id1(2:) = id0
+ call cmlAddAtom(xf=xf, elem=elements(i), id=id1)
+ if (stylei .eq. 'x3') then
+ call CMLATX39DP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
+ elseif (stylei .eq. 'xFrac') then
+ call CMLATXF9DP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
+ elseif (stylei .eq. 'xyz3') then
+ call CMLATXYZ39DP(xf, coords(1, i), coords (2, i), coords(3, i), formt)
+ elseif (stylei .eq. 'xyzFrac') then
+ call CMLATXYZFRACT9DP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
+ endif
+ call xml_EndElement(xf, 'atom')
+ enddo
+
+ call xml_EndElement(xf, 'atomArray')
+ call xml_EndElement(xf, 'molecule')
+
+ END SUBROUTINE cmlAddMoleculeDP
+
+
+ ! -------------------------------------------------
+ ! 2. writes complete SP molecule to xml channel
+ ! -------------------------------------------------
+
+ SUBROUTINE cmlAddMoleculeSP(xf, natoms, elements, coords, style, id, title, dictref, fmt)
+ implicit none
+ type(xmlf_t) :: xf
+ integer, intent(in) :: natoms ! number of atoms
+ character(len=*), intent(in) :: elements(*) ! chemical element types
+ real(kind=sp), intent(in) :: coords(3, *) ! atomic coordinates
+ character(len=*), intent(in), optional :: id ! id
+ character(len=*), intent(in), optional :: title ! the title
+ character(len=*), intent(in), optional :: dictref ! the dictionary reference
+ character(len=*), intent(in), optional :: fmt ! format for coords
+ character(len=*), intent(in), optional :: style ! type of coordinates ('x3'for Cartesians, 'xFrac'
+ ! for fractionals; ' ' = default => cartesians)
+ ! Flush on entry and exit
+ character(len=6) :: id1, id0
+ integer :: i
+ character(len=10):: formt, stylei
+
+ if (present(fmt)) then
+ formt = fmt
+ else
+ formt = '(f8.3)'
+ endif
+ if (present(style)) then
+ stylei = style
+ else
+ stylei = 'x3'
+ endif
+
+ call stmAddStartTag(xf, 'molecule', id, title, dictref)
+ call xml_NewElement(xf, 'atomArray')
+ do i = 1, natoms
+ write(id0, '(i4)') i
+ id0 = adjustl(id0)
+ id1 = 'a'
+ id1(2:) = id0
+ call cmlAddAtom(xf=xf, elem=elements(i), id=id1)
+ if (stylei .eq. 'x3') then
+ call CMLATX39SP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
+ elseif (stylei .eq. 'xFrac') then
+ call CMLATXF9SP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
+ elseif (stylei .eq. 'xyz3') then
+ call CMLATXYZ39SP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
+ elseif (stylei .eq. 'xyzFrac') then
+ call CMLATXYZFRACT9SP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
+ endif
+ call xml_EndElement(xf, 'atom')
+ enddo
+
+ call xml_EndElement(xf, 'atomArray')
+ call xml_EndElement(xf, 'molecule')
+
+
+ END SUBROUTINE cmlAddMoleculeSP
+
+
+ ! -------------------------------------------------
+ ! 1. writes complete DP molecule to xml channel (No. 2)
+ ! -------------------------------------------------
+
+ SUBROUTINE cmlAddMolecule3DP(xf, natoms, elements, x, y, z, style, id, title, dictref, fmt)
+ implicit none
+ type(xmlf_t) :: xf
+ integer, intent(in) :: natoms ! number of atoms
+ real(kind=dp), intent(in) :: x(*)
+ real(kind=dp), intent(in) :: y(*)
+ real(kind=dp), intent(in) :: z(*)
+ character(len=*), intent(in) :: elements(*) ! chemical element types
+ character(len=*), intent(in), optional :: id ! id
+ character(len=*), intent(in), optional :: title ! the title
+ character(len=*), intent(in), optional :: dictref ! the dictionary reference
+ character(len=*), intent(in), optional :: fmt ! format for coords
+ character(len=*), intent(in), optional :: style ! type of coordinates ('x3'for Cartesians, 'xFrac'
+ ! for fractionals; ' ' = default => cartesians)
+ character(len=6) :: id1, id0
+ integer :: i, l
+ character(len=10) :: formt, stylei
+
+ if (present(fmt)) then
+ formt = fmt
+ else
+ formt = '(f8.3)'
+ endif
+ if (present(style)) then
+ stylei = trim(style)
+ else
+ stylei = 'x3'
+ endif
+
+ call stmAddStartTag(xf=xf, name='molecule', id=id, title=title, dictref=dictref)
+ call xml_NewElement(xf, 'atomArray')
+
+ do i = 1, natoms
+ write(id0, '(i4)') i
+ id0 = adjustl(id0)
+ id1 = 'a'
+ id1(2:) = id0
+ call cmlAddAtom(xf=xf, elem=elements(i), id=id1)
+ if (trim(stylei) .eq. 'x3') then
+ call CMLATX39DP(xf, x(i), y(i), z(i), formt)
+ elseif (stylei .eq. 'xFrac') then
+ call CMLATXF9DP(xf, x(i), y(i), z(i), formt)
+ elseif (stylei .eq. 'xyz3') then
+ call CMLATXYZ39DP(xf, x(i), y(i), z(i), formt)
+ elseif (stylei .eq. 'xyzFrac') then
+ call CMLATXYZFRACT9DP(xf, x(i), y(i), z(i), formt)
+ endif
+ call xml_EndElement(xf, 'atom')
+ enddo
+
+ call xml_EndElement(xf, 'atomArray')
+ call xml_EndElement(xf, 'molecule')
+
+ END SUBROUTINE cmlAddMolecule3DP
+
+
+ ! -------------------------------------------------
+ ! 2. writes complete SP molecule to xml channel (No. 2)
+ ! -------------------------------------------------
+
+ SUBROUTINE cmlAddMolecule3SP(xf, natoms, elements, x, y, z, style, id, title, dictref, fmt)
+
+
+ implicit none
+ type(xmlf_t) :: xf
+ ! 10 Arguments
+ integer, intent(in) :: natoms ! number of atoms
+ real(kind=sp), intent(in) :: x(*)
+ real(kind=sp), intent(in) :: y(*)
+ real(kind=sp), intent(in) :: z(*)
+ character(len=*), intent(in) :: elements(*) ! chemical element types
+ character(len=*), intent(in), optional :: id ! id
+ character(len=*), intent(in), optional :: title ! the title
+ character(len=*), intent(in), optional :: dictref ! the dictionary reference
+ character(len=*), intent(in), optional :: fmt ! format for coords
+ character(len=*), intent(in), optional :: style ! type of coordinates ('x3' for Cartesians, 'xFrac'
+ ! for fractionals; ' ' = default => cartesians)
+ ! Internal variables
+ character(len=6) :: id1, id0
+ integer :: i, l
+ character(len=10) :: formt, stylei
+
+ if (present(fmt)) then
+ formt = fmt
+ else
+ formt = '(f8.3)'
+ endif
+ if (present(style)) then
+ stylei = style
+ else
+ stylei = 'x3'
+ endif
+
+ call xml_NewElement(xf, 'molecule')
+ call xml_AddAttribute(xf, 'id', id)
+ call xml_AddAttribute(xf, 'title', title)
+ call xml_AddAttribute(xf, 'dictref', dictref)
+ call xml_NewElement(xf, 'atomArray')
+ do i = 1, natoms
+ write(id0, '(i4)') i
+ id0 = adjustl(id0)
+ id1 = 'a'
+ id1(2:) = id0
+ call cmlAddAtom(xf=xf, elem=elements(i), id=id1)
+ if (stylei .eq. 'x3') then
+ call CMLATX39SP(xf, x(i), y(i), z(i), formt)
+ else if (stylei .eq. 'xFrac') then
+ call CMLATXF9SP(xf, x(i), y(i), z(i), formt)
+ else if (stylei .eq. 'xyz3') then
+ call CMLATXYZ39SP(xf, x(i), y(i), z(i), formt)
+ else if (stylei .eq. 'xyzFrac') then
+ call CMLATXYZFRACT9SP(xf, x(i), y(i), z(i), formt)
+ endif
+ call xml_EndElement(xf, 'atom')
+ enddo
+
+ call xml_EndElement(xf, 'atomArray')
+ call xml_EndElement(xf, 'molecule')
+
+ END SUBROUTINE cmlAddMolecule3SP
+
+ ! -------------------------------------------------
+ ! writes an start tag
+ ! -------------------------------------------------
+
+ SUBROUTINE cmlAddAtom(xf, elem, id, charge, hCount, occupancy, fmt)
+
+
+ implicit none
+ type(xmlf_t) :: xf
+ integer, intent(in), optional :: charge ! formalCharge
+ integer, intent(in), optional :: hCount ! hydrogenCount
+ real(kind=sp), intent(in), optional :: occupancy ! hydrogenCount
+ character(len=*), intent(in), optional :: elem ! chemical element name
+ character(len=*), intent(in), optional :: id ! atom id
+ character(len=*), intent(in), optional :: fmt ! format
+
+ ! internal Variable
+ character(len=10):: formt
+ if (present(fmt)) then
+ formt = fmt
+ else
+ formt = '(f8.3)'
+ endif
+
+ call xml_NewElement(xf, 'atom')
+ if (present(elem)) call xml_AddAttribute(xf, 'elementType', elem)
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(charge)) call xml_AddAttribute(xf, 'formalCharge', str(charge))
+ if (present(hCount)) call xml_AddAttribute(xf, 'hydrogenCount', str(hCount))
+ if (present(occupancy)) call xml_AddAttribute(xf, 'occupancy', str(occupancy,formt))
+
+ END SUBROUTINE cmlAddAtom
+
+
+ ! -------------------------------------------------
+ ! 1. append SP coordinates to atom tag
+ ! -------------------------------------------------
+
+ SUBROUTINE cmlAddCoordinatesSP(xf, x, y, z, style, fmt)
+ implicit none
+ type(xmlf_t) :: xf
+ real(kind=sp), intent(in) :: x, y
+ real(kind=sp), intent(in), optional :: z
+ character(len=*), intent(in), optional :: style
+ character(len=*), intent(in), optional :: fmt
+
+ ! Internal variable
+ character(len=10):: formt
+ character(len=10):: stylei
+ if (present(fmt)) then
+ formt = fmt
+ else
+ formt = '(f8.3)'
+ endif
+ if (present(style)) then
+ stylei = style
+ else
+ stylei = 'x3'
+ endif
+
+ if (present(z) .and. stylei .eq. 'x3') then
+ call CMLATX39SP(xf, x, y, z, formt)
+ else if (present(z) .and. stylei .eq. 'xFrac') then
+ call CMLATXF9SP(xf, x, y, z, formt)
+ else if (present(z) .and. stylei .eq. 'xyz3') then
+ call CMLATXYZ39SP(xf, x, y, z, formt)
+ else if (present(z) .and. stylei .eq. 'xyzFrac') then
+ call CMLATXYZFRACT9SP(xf, x, y, z, formt)
+ elseif (.not. present(z) .and. stylei .eq. 'xy2') then
+ call CMLATXY9SP(xf, x, y, formt)
+ endif
+
+ END SUBROUTINE cmlAddCoordinatesSP
+
+ ! -------------------------------------------------
+ ! 2. append DP coordinates to atom tag
+ ! -------------------------------------------------
+
+ SUBROUTINE cmlAddCoordinatesDP(xf, x, y, z, style, fmt)
+ implicit none
+ type(xmlf_t) :: xf
+ real(kind=dp), intent(in) :: x, y
+ real(kind=dp), intent(in), optional :: z
+ character(len=*), intent(in), optional :: style
+ character(len=*), intent(in), optional :: fmt
+
+ ! Internal variable
+ character(len=10):: formt
+ character(len=10):: stylei
+ if (present(fmt)) then
+ formt = fmt
+ else
+ formt = '(f8.3)'
+ endif
+ if (present(style)) then
+ stylei = style
+ else
+ stylei = 'x3'
+ endif
+
+ if (present(z) .and. stylei .eq. 'x3') then
+ call CMLATX39DP(xf, x, y, z, formt)
+ else if (present(z) .and. stylei .eq. 'xFrac') then
+ call CMLATXF9DP(xf, x, y, z, formt)
+ else if (present(z) .and. stylei .eq. 'xyz3') then
+ call CMLATXYZ39DP(xf, x, y, z, formt)
+ else if (present(z) .and. stylei .eq. 'xyzFrac') then
+ call CMLATXYZFRACT9DP(xf, x, y, z, formt)
+ else if (.not. present(z) .and. stylei .eq. 'xy2') then
+ call CMLATXY9DP(xf, x, y, formt)
+ endif
+
+ END SUBROUTINE cmlAddCoordinatesDP
+
+
+ ! -------------------------------------------------
+ ! 1. writes a DP element to output channel
+ ! -------------------------------------------------
+
+ SUBROUTINE cmlAddLengthDP(xf, length, id, atomRef1, atomRef2, fmt)
+ implicit none
+ type(xmlf_t) :: xf
+ real(kind=dp), intent(in) :: length ! length
+ character(len=*), intent(in) :: id ! length id
+ character(len=*), intent(in) :: atomRef1 ! ref to first atom
+ character(len=*), intent(in) :: atomRef2 ! ref to second atom
+ character(len=*), intent(in) :: fmt ! format
+
+ optional :: fmt
+ character(len=10):: formt
+
+ if (present(fmt)) then
+ formt = fmt
+ else
+ formt = '(f8.3)'
+ endif
+
+ ! Flush on entry and exit
+ call CMLLEN9DP(xf, id, atomRef1, atomRef2, length, formt)
+ END SUBROUTINE cmlAddLengthDP
+
+ ! -------------------------------------------------
+ ! 2. writes a SP element to output channel
+ ! -------------------------------------------------
+
+ SUBROUTINE cmlAddLengthSP(xf, length, id, atomRef1, atomRef2, fmt)
+
+ implicit none
+ type(xmlf_t) :: xf
+ real(kind=sp), intent(in) :: length ! the length
+ character(len=*), intent(in) :: id ! length id
+ character(len=*), intent(in) :: atomRef1 ! ref to first atom
+ character(len=*), intent(in) :: atomRef2 ! ref to second atom
+ character(len=*), intent(in) :: fmt ! format
+
+ optional :: fmt
+ character(len=10):: formt
+
+ if (present(fmt)) then
+ formt = fmt
+ else
+ formt = '(f8.3)'
+ endif
+
+ ! Flush on entry and exit
+ call CMLLEN9SP(xf, id, atomRef1, atomRef2, length, formt)
+ END SUBROUTINE cmlAddLengthSP
+
+
+ ! -------------------------------------------------
+ ! 1. writes an DP element to output channel
+ ! -------------------------------------------------
+
+ SUBROUTINE cmlAddAngleDP(xf, angle, id, atomRef1, atomRef2, atomRef3, fmt)
+
+ implicit none
+ type(xmlf_t) :: xf
+ real(kind=dp), intent(in) :: angle ! the angle
+ character(len=*), intent(in) :: id ! angle id
+ character(len=*), intent(in) :: atomRef1 ! ref to first atom
+ character(len=*), intent(in) :: atomRef2 ! ref to second atom
+ character(len=*), intent(in) :: atomRef3 ! ref to third atom
+ character(len=*), intent(in) :: fmt ! format
+
+ optional :: fmt
+ character(len=10):: formt
+
+ if (present(fmt)) then
+ formt = fmt
+ else
+ formt = '(f8.3)'
+ endif
+
+ ! Flush on entry and exit
+ call CMLANG9DP(xf, id, atomRef1, atomRef2, atomRef3, angle, formt)
+ END SUBROUTINE cmlAddAngleDP
+
+ ! -------------------------------------------------
+ ! 2. writes an SP element to output channel
+ ! -------------------------------------------------
+
+ SUBROUTINE cmlAddAngleSP(xf, angle, id, atomRef1, atomRef2, atomRef3, fmt)
+
+
+ implicit none
+ type(xmlf_t) :: xf
+ real(kind=sp), intent(in) :: angle ! the angle
+ character(len=*), intent(in) :: id ! angle id
+ character(len=*), intent(in) :: atomRef1 ! ref to first atom
+ character(len=*), intent(in) :: atomRef2 ! ref to second atom
+ character(len=*), intent(in) :: atomRef3 ! ref to third atom
+ character(len=*), intent(in) :: fmt ! format
+
+ optional :: fmt
+ character(len=10):: formt
+
+ if (present(fmt)) then
+ formt = fmt
+ else
+ formt = '(f8.3)'
+ endif
+
+ ! Flush on entry and exit
+ call CMLANG9SP(xf, id, atomRef1, atomRef2, atomRef3, angle, formt)
+ END SUBROUTINE cmlAddAngleSP
+
+
+ ! -------------------------------------------------
+ ! 1. creates and writes a DP element
+ ! -------------------------------------------------
+
+ SUBROUTINE cmlAddTorsionDP(xf, torsion, id, atomRef1, atomRef2, atomRef3, atomRef4, fmt)
+
+
+ implicit none
+ type(xmlf_t) :: xf
+ real(kind=dp), intent(in) :: torsion ! the torsion
+ character(len=*), intent(in) :: id ! torsion id
+ character(len=*), intent(in) :: atomRef1 ! ref to first atom
+ character(len=*), intent(in) :: atomRef2 ! ref to second atom
+ character(len=*), intent(in) :: atomRef3 ! ref to third atom
+ character(len=*), intent(in) :: atomRef4 ! ref to fourth atom
+ character(len=*), intent(in) :: fmt ! format
+
+ optional :: fmt
+ character(len=10):: formt
+
+ if (present(fmt)) then
+ formt = fmt
+ else
+ formt = '(f8.3)'
+ endif
+
+ ! Flush on entry and exit
+ call CMLTOR9DP(xf, id, atomRef1, atomRef2, atomRef3, atomRef4, torsion, formt)
+ END SUBROUTINE cmlAddTorsionDP
+
+ ! -------------------------------------------------
+ ! 2. creates and writes a SP element
+ ! -------------------------------------------------
+
+ SUBROUTINE cmlAddTorsionSP(xf, torsion, id, atomRef1, atomRef2, atomRef3, atomRef4, fmt)
+
+
+ implicit none
+ type(xmlf_t) :: xf
+ real(kind=sp), intent(in) :: torsion ! the torsion
+ character(len=*), intent(in) :: id ! torsion id
+ character(len=*), intent(in) :: atomRef1 ! ref to first atom
+ character(len=*), intent(in) :: atomRef2 ! ref to second atom
+ character(len=*), intent(in) :: atomRef3 ! ref to third atom
+ character(len=*), intent(in) :: atomRef4 ! ref to fourth atom
+ character(len=*), intent(in) :: fmt ! format
+
+ optional :: fmt
+ character(len=10):: formt
+
+ if (present(fmt)) then
+ formt = fmt
+ else
+ formt = '(f8.3)'
+ endif
+
+ ! Flush on entry and exit
+ call CMLTOR9SP(xf, id, atomRef1, atomRef2, atomRef3, atomRef4, torsion, formt)
+ END SUBROUTINE cmlAddTorsionSP
+
+
+ ! -------------------------------------------------
+ ! 1. creates and writes an SP Lattice element
+ ! -------------------------------------------------
+
+ SUBROUTINE cmlAddLatticeSP(xf, cell, units, title, id, dictref, conv, lattType, spaceType, fmt)
+
+ implicit none
+ type(xmlf_t) :: xf
+ real(kind=sp), intent(in) :: cell(3,3)
+ character(len=*), intent(in), optional :: units
+ character(len=*), intent(in), optional :: id ! id
+ character(len=*), intent(in), optional :: title ! title
+ character(len=*), intent(in), optional :: dictref ! dictref
+ character(len=*), intent(in), optional :: conv ! format
+ character(len=*), intent(in), optional :: lattType !
+ character(len=*), intent(in), optional :: spaceType !
+ character(len=*), intent(in), optional :: fmt
+
+ ! Internal Variables
+ integer :: i
+ character(len=10) :: formt
+
+ if (present(fmt)) then
+ formt = fmt
+ else
+ formt = '(f8.3)'
+ endif
+
+ call xml_NewElement(xf, 'lattice')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+ if (present(lattType)) call xml_AddAttribute(xf, 'latticeType', lattType)
+ if (present(spaceType)) call xml_AddAttribute(xf, 'spaceType', spaceType)
+
+ do i = 1,3
+ call xml_NewElement(xf, 'latticeVector')
+ if (present(units)) call xml_AddAttribute(xf, 'units', units)
+ call xml_AddAttribute(xf, 'dictRef', 'cml:latticeVector')
+ call xml_AddPcdata(xf, str(cell(1,i), formt))
+ call xml_AddPcdata(xf, str(cell(2,i), formt))
+ call xml_AddPcdata(xf, str(cell(3,i), formt))
+ call xml_EndElement(xf, 'latticeVector')
+ enddo
+ call xml_EndElement(xf, 'lattice')
+
+ END SUBROUTINE cmlAddLatticeSP
+
+
+ ! -------------------------------------------------
+ ! 2. creates and writes DP Lattice element
+ ! -------------------------------------------------
+
+ SUBROUTINE cmlAddLatticeDP(xf, cell, units, title, id, dictref, conv, lattType, spaceType, fmt)
+
+ implicit none
+ type(xmlf_t) :: xf
+ real(kind=dp), intent(in) :: cell(3,3)
+ character(len=*), intent(in), optional :: units
+ character(len=*), intent(in), optional :: id ! id
+ character(len=*), intent(in), optional :: title ! title
+ character(len=*), intent(in), optional :: dictref ! dictref
+ character(len=*), intent(in), optional :: conv ! format
+ character(len=*), intent(in), optional :: lattType !
+ character(len=*), intent(in), optional :: spaceType !
+ character(len=*), intent(in), optional :: fmt
+
+ ! Internal Variables
+ integer :: i
+ character(len=10) :: formt
+
+ if (present(fmt)) then
+ formt = fmt
+ else
+ formt = '(f8.3)'
+ endif
+
+ call xml_NewElement(xf, 'lattice')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+ if (present(lattType)) call xml_AddAttribute(xf, 'latticeType', lattType)
+ if (present(spaceType)) call xml_AddAttribute(xf, 'spaceType', spaceType)
+
+ do i = 1,3
+ call xml_NewElement(xf, 'latticeVector')
+ if (present(units)) call xml_AddAttribute(xf, 'units', units)
+ call xml_AddAttribute(xf, 'dictRef', 'cml:latticeVector')
+ call xml_AddPcdata(xf, str(cell(1,i), formt))
+ call xml_AddPcdata(xf, str(cell(2,i), formt))
+ call xml_AddPcdata(xf, str(cell(3,i), formt))
+ call xml_EndElement(xf, 'latticeVector')
+ enddo
+
+ call xml_EndElement(xf, 'lattice')
+
+ END SUBROUTINE cmlAddLatticeDP
+
+
+ ! -------------------------------------------------
+ ! 1. creates a DP Lattice Vector element
+ ! -------------------------------------------------
+
+ SUBROUTINE cmlAddLatticeVectorDP(xf, vector, title, id, dictref, conv, units, periodic, fmt)
+ implicit none
+ type(xmlf_t) :: xf
+ real(kind=dp), intent(in) :: vector(3)
+ character(len=*), intent(in), optional :: title
+ character(len=*), intent(in), optional :: id
+ character(len=*), intent(in), optional :: dictref
+ character(len=*), intent(in), optional :: conv
+ character(len=*), intent(in), optional :: units
+ character(len=*), intent(in), optional :: periodic
+ character(len=*), intent(in), optional :: fmt
+
+ ! Deal with optional things
+ ! that have defaults
+ character(len=10) :: formt
+ if (present(fmt)) then
+ formt = fmt
+ else
+ formt = '(f8.3)'
+ endif
+
+ call xml_NewElement(xf, 'latticeVector')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+ if (present(units)) call xml_AddAttribute(xf, 'units', units)
+ if (present(periodic)) call xml_AddAttribute(xf, 'periodic', periodic)
+ call xml_AddPcdata(xf, str(vector(1), formt))
+ call xml_AddPcdata(xf, str(vector(2), formt))
+ call xml_AddPcdata(xf, str(vector(3), formt))
+ call xml_EndElement(xf, 'latticeVector')
+
+ END SUBROUTINE cmlAddLatticeVectorDP
+
+
+ ! -------------------------------------------------
+ ! 2. creates a SP Lattice Vector element
+ ! -------------------------------------------------
+
+ SUBROUTINE cmlAddLatticeVectorSP(xf, vector, title, id, dictref, conv, units, periodic, fmt)
+ implicit none
+ type(xmlf_t) :: xf
+ real(kind=sp), intent(in) :: vector(3)
+ character(len=*), intent(in), optional :: title
+ character(len=*), intent(in), optional :: id
+ character(len=*), intent(in), optional :: dictref
+ character(len=*), intent(in), optional :: conv
+ character(len=*), intent(in), optional :: units ! should this be optional
+ character(len=*), intent(in), optional :: periodic
+ character(len=*), intent(in), optional :: fmt
+
+ ! Deal with optional things
+ ! that have defaults
+ character(len=10) :: formt
+ if (present(fmt)) then
+ formt = fmt
+ else
+ formt = '(f8.3)'
+ endif
+
+ call xml_NewElement(xf, 'latticeVector')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+ if (present(units)) call xml_AddAttribute(xf, 'units', units)
+ if (present(units)) call xml_AddAttribute(xf, 'periodic', periodic)
+ call xml_AddPcdata(xf, str(vector(1), formt))
+ call xml_AddPcdata(xf, str(vector(2), formt))
+ call xml_AddPcdata(xf, str(vector(3), formt))
+ call xml_EndElement(xf, 'latticeVector')
+
+ END SUBROUTINE cmlAddLatticeVectorSP
+
+ ! -------------------------------------------------
+ ! 1. creates and writes a DP element
+ ! -------------------------------------------------
+
+ SUBROUTINE cmlAddCrystalDP(xf, a, b, c, alpha, beta, gamma, id, title, dictref, lenunits, angunits, fmt)
+ implicit none
+ type(xmlf_t) :: xf
+ real(kind=dp), intent(in) :: a, b, c ! cell parameters
+ real(kind=dp), intent(in) :: alpha ! alpha cell parameter
+ real(kind=dp), intent(in) :: beta ! beta cell parameter
+ real(kind=dp), intent(in) :: gamma ! gamma cell parameter
+ character(len=*), intent(in), optional :: id ! id
+ character(len=*), intent(in), optional :: title ! title
+ character(len=*), intent(in), optional :: dictref ! dictref
+ character(len=*), intent(in), optional :: lenunits ! units for length (default = angstrom)
+ character(len=*), intent(in), optional :: angunits ! units for angles (default = degree)
+ character(len=*), intent(in), optional :: fmt ! format
+
+ ! Flush on entry and exit
+ character(len=30) :: lunits, aunits
+ character(len=10) :: formt
+
+ if (present(fmt)) then
+ formt = fmt
+ else
+ formt = '(f8.3)'
+ endif
+ if (present(lenunits)) then
+ lunits = lenunits
+ else
+ lunits = 'units:angstrom'
+ endif
+ if (present(angunits)) then
+ aunits = angunits
+ else
+ aunits = 'units:degree'
+ endif
+
+ call stmAddStartTag(xf=xf, name='crystal', id=id, title=title, dictref=dictref)
+ call stmAddScalar(xf=xf, value=a, title='a', dictref='cml:a', units=lunits, fmt=formt)
+ call stmAddScalar(xf=xf, value=b, title='b', dictref='cml:b', units=lunits, fmt=formt)
+ call stmAddScalar(xf=xf, value=c, title='c', dictref='cml:c', units=lunits, fmt=formt)
+ call stmAddScalar(xf=xf, value=alpha, title='alpha', dictref='cml:alpha', units=aunits, fmt=formt)
+ call stmAddScalar(xf=xf, value=beta, title='beta', dictref='cml:beta', units=aunits, fmt=formt)
+ call stmAddScalar(xf=xf, value=gamma, title='gamma', dictref='cml:gamma', units=aunits, fmt=formt)
+ call xml_EndElement(xf, 'crystal')
+
+ END SUBROUTINE cmlAddCrystalDP
+
+ ! -------------------------------------------------
+ ! 2. creates and writes a SP element
+ ! -------------------------------------------------
+
+ SUBROUTINE cmlAddCrystalSP(xf, a, b, c, alpha, beta, gamma, id, title, dictref, lenunits, angunits, fmt)
+ implicit none
+ type(xmlf_t) :: xf
+ real(kind=sp), intent(in) :: a, b, c ! cell parameters
+ real(kind=sp), intent(in) :: alpha ! alpha cell parameter
+ real(kind=sp), intent(in) :: beta ! beta cell parameter
+ real(kind=sp), intent(in) :: gamma ! gamma cell parameter
+ character(len=*), intent(in), optional :: id ! id
+ character(len=*), intent(in), optional :: title ! title
+ character(len=*), intent(in), optional :: dictref ! dictref
+ character(len=*), intent(in), optional :: lenunits ! units for length (' ' = angstrom)
+ character(len=*), intent(in), optional :: angunits ! units for angles (' ' = degree)
+ character(len=*), intent(in), optional :: fmt ! format
+
+ ! Flush on entry and exit
+ character(len=30) :: lunits, aunits
+ character(len=10) :: formt
+
+ if (present(fmt)) then
+ formt = fmt
+ else
+ formt = '(f8.3)'
+ endif
+ if (present(lenunits)) then
+ lunits = lenunits
+ else
+ lunits = U_ANGSTR
+ endif
+ if (present(angunits)) then
+ aunits = angunits
+ else
+ aunits = U_DEGREE
+ endif
+
+ call stmAddStartTag(xf, 'crystal', id, title, dictref)
+ call stmAddScalar(xf, a, ' ', 'a', 'cml:a', lunits, formt)
+ call stmAddScalar(xf, b, ' ', 'b', 'cml:b', lunits, formt)
+ call stmAddScalar(xf, c, ' ', 'c', 'cml:c', lunits, formt)
+ call stmAddScalar(xf, alpha, ' ', 'alpha', 'cml:alpha', aunits, formt)
+ call stmAddScalar(xf, beta, ' ', 'beta', 'cml:beta', aunits, formt)
+ call stmAddScalar(xf, gamma, ' ', 'gamma', 'cml:gamma', aunits, formt)
+ call xml_EndElement(xf, 'crystal')
+
+ END SUBROUTINE cmlAddCrystalSP
+
+
+ ! -------------------------------------------------
+ ! 1. creates and writes an DP element
+ ! -------------------------------------------------
+
+ SUBROUTINE cmlAddEigenvalueDP(xf, n, dim, eigvec, eigval, id, title, dictref, fmt)
+
+
+ implicit none
+ type(xmlf_t) :: xf
+ integer, intent(in) :: n ! number of elements
+ integer, intent(in) :: dim ! dimension of matrix
+ real(kind=dp), intent(in) :: eigvec(dim, *) ! eigenvectors
+ real(kind=dp), intent(in) :: eigval(*) ! eigenvalues
+ character(len=*), intent(in), optional :: id ! id
+ character(len=*), intent(in), optional :: title ! title
+ character(len=*), intent(in), optional :: dictref ! dictionary reference
+ character(len=*), intent(in), optional :: fmt ! format
+ character(len=10):: formt
+ integer :: i, j
+
+ if (present(fmt)) then
+ formt = fmt
+ else
+ formt = '(f8.3)'
+ endif
+
+ ! Flush on entry and exit
+ call xml_NewElement(xf, 'eigen')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(title)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ if (present(dictref)) call xml_AddAttribute(xf, 'title', title)
+ call stmAddArray(xf=xf, nvalue=n, array=eigval, title='eigenvalues', dictref=dictRef, fmt=fmt)
+ call stmAddMatrix(xf=xf, ncols=n, nrows=n, dim=dim, matrix=eigvec, title='eigenvectors', fmt=fmt)
+ call xml_EndElement(xf, 'eigen')
+
+ END SUBROUTINE cmlAddEigenvalueDP
+
+
+
+ ! -------------------------------------------------
+ ! 2. creates and writes an SP element
+ ! -------------------------------------------------
+
+ SUBROUTINE cmlAddEigenvalueSP(xf, n, dim, eigvec, eigval, id, title, dictref, fmt)
+
+
+ implicit none
+ type(xmlf_t) :: xf
+ integer, intent(in) :: n ! number of elements
+ integer, intent(in) :: dim ! dimension of matrix
+ real(kind=sp), intent(in) :: eigvec(dim, *) ! eigenvectors
+ real(kind=sp), intent(in) :: eigval(*) ! eigenvalues
+ character(len=*), intent(in), optional :: id ! id
+ character(len=*), intent(in), optional :: title ! title
+ character(len=*), intent(in), optional :: dictref ! dictionary reference
+ character(len=*), intent(in), optional :: fmt ! format
+ character(len=10):: formt
+ integer :: i, j
+
+ if (present(fmt)) then
+ formt = fmt
+ else
+ formt = '(f8.3)'
+ endif
+
+ ! Flush on entry and exit
+ call xml_NewElement(xf, 'eigen')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(title)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ if (present(dictref)) call xml_AddAttribute(xf, 'title', title)
+ call stmAddArray(xf=xf, nvalue=n, array=eigval, title='eigenvalues', dictref=dictRef, fmt=fmt)
+ call stmAddMatrix(xf=xf, ncols=n, nrows=n, dim=dim, matrix=eigvec, title='eigenvectors', fmt=fmt)
+ call xml_EndElement(xf, 'eigen')
+
+ END SUBROUTINE cmlAddEigenvalueSP
+
+
+ SUBROUTINE cmlAddMetadata(xf, name, content, conv)
+
+ implicit none
+ type(xmlf_t) :: xf
+ character(len=*) :: name
+ character(len=*) :: content
+ character(len=*), optional :: conv
+
+ call xml_NewElement(xf, 'metadata')
+ call xml_AddAttribute(xf, 'name', name)
+ call xml_AddAttribute(xf, 'content', content)
+ if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+ call xml_EndElement(xf, 'metadata')
+
+ END SUBROUTINE cmlAddMetadata
+
+
+ ! -------------------------------------------------
+ ! 1. creates and writes an Char element
+ ! -------------------------------------------------
+
+
+ SUBROUTINE cmlAddParameterCh(xf, value, ref, id, title, conv, &
+ cons, units, name, role)
+
+ implicit none
+ type(xmlf_t) :: xf
+ character(len=*) :: value
+ character(len=*), optional :: ref
+ character(len=*), optional :: title
+ character(len=*), optional :: id
+ character(len=*), optional :: conv
+ character(len=*), optional :: cons
+ character(len=*), optional :: units
+ character(len=*), optional :: name
+ character(len=*), optional :: role
+
+ call xml_NewElement(xf, 'parameter')
+ if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+ if (present(cons)) call xml_AddAttribute(xf, 'constraint', cons)
+ if (present(name)) call xml_AddAttribute(xf, 'name', name)
+ if (present(role)) call xml_AddAttribute(xf, 'role', role)
+ if (present(units)) then
+ call xml_NewElement(xf, 'scalar')
+ call xml_AddAttribute(xf, 'units', units)
+ call xml_AddPcdata(xf, value)
+ call xml_EndElement(xf, 'scalar')
+ else
+ call xml_AddAttribute(xf, 'value', value)
+ endif
+ call xml_EndElement(xf, 'parameter')
+
+ END SUBROUTINE CMLADDPARAMETERCH
+
+
+ ! -------------------------------------------------
+ ! 2. creates and writes an SP element
+ ! -------------------------------------------------
+
+
+ SUBROUTINE cmlAddParameterSP(xf, value, ref, title, id, conv, &
+ cons, units, name, role, fmt)
+
+ implicit none
+ type(xmlf_t) :: xf
+ real(kind=sp) :: value
+ character(len=*), optional :: ref
+ character(len=*), optional :: title
+ character(len=*), optional :: id
+ character(len=*), optional :: conv
+ character(len=*), optional :: cons
+ character(len=*), optional :: units
+ character(len=*), optional :: name
+ character(len=*), optional :: role
+ character(len=*), optional :: fmt
+
+ character(len=10) :: formt
+
+ if (present(fmt)) then
+ formt = fmt
+ else
+ formt = '(f8.3)'
+ endif
+
+ call xml_NewElement(xf, 'parameter')
+ if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+ if (present(cons)) call xml_AddAttribute(xf, 'constraint', cons)
+ if (present(name)) call xml_AddAttribute(xf, 'name', name)
+ if (present(role)) call xml_AddAttribute(xf, 'role', role)
+ if (present(units)) then
+ call xml_NewElement(xf, 'scalar')
+ call xml_AddAttribute(xf, 'units', units)
+ call xml_AddPcdata(xf, str(value))
+ call xml_EndElement(xf, 'scalar')
+ else
+ call xml_AddAttribute(xf, 'value', str(value,formt))
+ endif
+ call xml_EndElement(xf, 'parameter')
+
+ END SUBROUTINE CMLADDPARAMETERSP
+
+
+ ! -------------------------------------------------
+ ! 3. creates and writes an DP element
+ ! -------------------------------------------------
+
+
+ SUBROUTINE cmlAddParameterDP(xf, value, ref, title, id, conv, &
+ cons, units, name, role, fmt)
+
+ implicit none
+ type(xmlf_t) :: xf
+ real(kind=dp) :: value
+ character(len=*), optional :: ref
+ character(len=*), optional :: title
+ character(len=*), optional :: id
+ character(len=*), optional :: conv
+ character(len=*), optional :: cons
+ character(len=*), optional :: units
+ character(len=*), optional :: name
+ character(len=*), optional :: role
+ character(len=*), optional :: fmt
+
+ character(len=10) :: formt
+
+ if (present(fmt)) then
+ formt = fmt
+ else
+ formt = '(f8.3)'
+ endif
+
+ call xml_NewElement(xf, 'parameter')
+ if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+ if (present(cons)) call xml_AddAttribute(xf, 'constraint', cons)
+ if (present(name)) call xml_AddAttribute(xf, 'name', name)
+ if (present(role)) call xml_AddAttribute(xf, 'role', role)
+ if (present(units)) then
+ call xml_NewElement(xf, 'scalar')
+ call xml_AddAttribute(xf, 'units', units)
+ call xml_AddPcdata(xf, str(value))
+ call xml_EndElement(xf, 'scalar')
+ else
+ call xml_AddAttribute(xf, 'value', str(value))
+ endif
+ call xml_EndElement(xf, 'parameter')
+
+ END SUBROUTINE CMLADDPARAMETERDP
+
+
+ ! -------------------------------------------------
+ ! 4. creates and writes an Integer element
+ ! -------------------------------------------------
+
+
+ SUBROUTINE cmlAddParameterI(xf, value, ref, id, title, conv, &
+ cons, units, name, role)
+
+ implicit none
+ type(xmlf_t) :: xf
+ integer :: value
+ character(len=*), optional :: ref
+ character(len=*), optional :: title
+ character(len=*), optional :: id
+ character(len=*), optional :: conv
+ character(len=*), optional :: cons
+ character(len=*), optional :: units
+ character(len=*), optional :: name
+ character(len=*), optional :: role
+
+ call xml_NewElement(xf, 'parameter')
+ if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+ if (present(cons)) call xml_AddAttribute(xf, 'constraint', cons)
+ if (present(name)) call xml_AddAttribute(xf, 'name', name)
+ if (present(role)) call xml_AddAttribute(xf, 'role', role)
+ if (present(units)) then
+ call xml_NewElement(xf, 'scalar')
+ call xml_AddAttribute(xf, 'units', units)
+ call xml_AddPcdata(xf, str(value))
+ call xml_EndElement(xf, 'scalar')
+ else
+ call xml_AddAttribute(xf, 'value', str(value))
+ endif
+ call xml_EndElement(xf, 'parameter')
+
+ END SUBROUTINE CMLADDPARAMETERI
+
+ SUBROUTINE cmlAddParameterLG(xf, value, ref, id, title, conv, &
+ cons, units, name, role)
+
+ implicit none
+ type(xmlf_t) :: xf
+ logical :: value
+ character(len=*), optional :: ref
+ character(len=*), optional :: title
+ character(len=*), optional :: id
+ character(len=*), optional :: conv
+ character(len=*), optional :: cons
+ character(len=*), optional :: units
+ character(len=*), optional :: name
+ character(len=*), optional :: role
+
+ call xml_NewElement(xf, 'parameter')
+ if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+ if (present(cons)) call xml_AddAttribute(xf, 'constraint', cons)
+ if (present(name)) call xml_AddAttribute(xf, 'name', name)
+ if (present(role)) call xml_AddAttribute(xf, 'role', role)
+ if (present(units)) then
+ call xml_NewElement(xf, 'scalar')
+ call xml_AddAttribute(xf, 'units', units)
+ call xml_AddPcdata(xf, str(value))
+ call xml_EndElement(xf, 'scalar')
+ else
+ call xml_AddAttribute(xf, 'value', str(value))
+ endif
+ call xml_EndElement(xf, 'parameter')
+
+ END SUBROUTINE CMLADDPARAMETERLG
+
+
+
+! =================================================
+! basic CML routines
+! =================================================
+
+
+ ! -------------------------------------------------
+ ! 1. adds DP xyz3 to start tag
+ ! -------------------------------------------------
+
+ SUBROUTINE CMLATXYZ39DP(xf, x3, y3, z3, fmt)
+ implicit none
+ type(xmlf_t) :: xf
+ real(kind=dp) :: x3, y3, z3 ! coordinates
+ character(len=*) :: fmt ! format (default '(f8.3)')
+ character(len=45) :: x, y, z
+
+ write(x,fmt) x3
+ write(y,fmt) y3
+ write(z,fmt) z3
+
+ call xml_AddAttribute(xf, 'xyz3', trim(x)//' '//trim(adjustl(y))//' '//trim(adjustl(z)) )
+
+ END SUBROUTINE CMLATXYZ39DP
+
+
+ ! -------------------------------------------------
+ ! 2. adds SP xyz3 to start tag
+ ! -------------------------------------------------
+
+ SUBROUTINE CMLATXYZ39SP(xf, x3, y3, z3, fmt)
+ implicit none
+ type(xmlf_t) :: xf
+ real(kind=sp) :: x3, y3, z3 ! coordinates
+ character(len=*) :: fmt ! format (default '(f8.3)')
+
+ character(len=45) :: x, y, z
+
+ write(x,fmt) x3
+ write(y,fmt) y3
+ write(z,fmt) z3
+
+ call xml_AddAttribute(xf, 'xyz3', trim(x)//' '//trim(adjustl(y))//' '//trim(adjustl(z)) )
+
+ END SUBROUTINE CMLATXYZ39SP
+
+ ! -------------------------------------------------
+ ! 1. adds DP xyzFrac to start tag
+ ! -------------------------------------------------
+
+ SUBROUTINE CMLATXYZFRACT9DP(xf, x3, y3, z3, fmt)
+ implicit none
+ type(xmlf_t) :: xf
+ real(kind=dp) :: x3, y3, z3 ! coordinates
+ character(len=*) :: fmt ! format (default '(f8.3)')
+
+ character(len=45) :: x, y, z
+
+ write(x,fmt) x3
+ write(y,fmt) y3
+ write(z,fmt) z3
+
+ call xml_AddAttribute(xf, 'xyzFrac', trim(x)//' '//trim(adjustl(y))//' '//trim(adjustl(z)) )
+
+ END SUBROUTINE CMLATXYZFRACT9DP
+
+ ! -------------------------------------------------
+ ! 2. adds SP xyzFrac to start tag
+ ! -------------------------------------------------
+
+ SUBROUTINE CMLATXYZFRACT9SP(xf, x3, y3, z3, fmt)
+ implicit none
+ type(xmlf_t) :: xf
+ real(kind=sp), intent(in) :: x3, y3, z3 ! coordinates
+ character(len=*), intent(in) :: fmt ! format (default '(f8.3)')
+
+ character(len=45) :: x, y, z
+
+ write(x,fmt) x3
+ write(y,fmt) y3
+ write(z,fmt) z3
+
+ call xml_AddAttribute(xf, 'xyzFrac', trim(x)//' '//trim(y)//' '//trim(z))
+
+ END SUBROUTINE CMLATXYZFRACT9SP
+
+
+ ! -------------------------------------------------
+ ! 1. adds DP x3, y3, z3 to start tag
+ ! -------------------------------------------------
+
+ SUBROUTINE CMLATX39DP(xf, x3, y3, z3, fmt)
+ implicit none
+ type(xmlf_t) :: xf
+ real(kind=dp), intent(in) :: x3, y3, z3 ! coordinates
+ character(len=*), intent(in) :: fmt ! format (default '(f8.3)')
+
+ call xml_AddAttribute(xf, 'x3', str(x3, fmt))
+ call xml_AddAttribute(xf, 'y3', str(y3, fmt))
+ call xml_AddAttribute(xf, 'z3', str(z3, fmt))
+
+ END SUBROUTINE CMLATX39DP
+
+ ! -------------------------------------------------
+ ! 2. adds SP x3, y3, z3 to start tag
+ ! -------------------------------------------------
+
+ SUBROUTINE CMLATX39SP(xf, x3, y3, z3, fmt)
+ implicit none
+ type(xmlf_t) :: xf
+ real(kind=sp), intent(in) :: x3, y3, z3 ! coordinates
+ character(len=*), intent(in) :: fmt ! format (default '(f8.3)')
+
+ call xml_AddAttribute(xf, 'x3', str(x3, fmt))
+ call xml_AddAttribute(xf, 'y3', str(y3, fmt))
+ call xml_AddAttribute(xf, 'z3', str(z3, fmt))
+
+ END SUBROUTINE CMLATX39SP
+
+
+ ! -------------------------------------------------
+ ! 1. adds DP xFract, yFract, zFract to start tag
+ ! -------------------------------------------------
+
+ SUBROUTINE CMLATXF9DP(xf, xFract, yFract, zFract, fmt)
+ implicit none
+ type(xmlf_t) :: xf
+ real(kind=dp), intent(in) :: xFract, yFract, zFract ! coordinates
+ character(len=*), intent(in) :: fmt ! format (default '(f8.3)')
+
+ call xml_AddAttribute(xf, 'xFract', str(xFract, fmt))
+ call xml_AddAttribute(xf, 'yFract', str(yFract, fmt))
+ call xml_AddAttribute(xf, 'zFract', str(zFract, fmt))
+
+ END SUBROUTINE CMLATXF9DP
+
+ ! -------------------------------------------------
+ ! 2. adds SP xfrac, yFractractrac, zFractrac to start tag
+ ! -------------------------------------------------
+
+ SUBROUTINE CMLATXF9SP(xf, xFract, yFract, zFract, fmt)
+ implicit none
+ type(xmlf_t) :: xf
+ real(kind=sp) :: xFract, yFract, zFract ! fractional coordinates
+ character(len=*) :: fmt ! format (default '(f8.3)')
+
+ call xml_AddAttribute(xf, 'xFract', str(xFract, fmt))
+ call xml_AddAttribute(xf, 'yFract', str(yFract, fmt))
+ call xml_AddAttribute(xf, 'zFract', str(zFract, fmt))
+
+ END SUBROUTINE CMLATXF9SP
+
+
+ ! -------------------------------------------------
+ ! 1. adds DP x2, y2 to start tag
+ ! -------------------------------------------------
+
+ SUBROUTINE CMLATXY9DP(xf, x2, y2, fmt)
+ implicit none
+ type(xmlf_t) :: xf
+ real(kind=dp) :: x2, y2 ! coordinates
+ character(len=*) :: fmt ! format (default f8.3)
+
+ call xml_AddAttribute(xf, 'x2', str(x2, fmt))
+ call xml_AddAttribute(xf, 'y2', str(y2, fmt))
+ call xml_AddPcdata(xf, '>') !!! AG****
+
+ END SUBROUTINE CMLATXY9DP
+
+ ! -------------------------------------------------
+ ! 2. adds SP x2, y2 to start tag
+ ! -------------------------------------------------
+
+ SUBROUTINE CMLATXY9SP(xf, x2, y2, fmt)
+ implicit none
+ type(xmlf_t) :: xf
+ real(kind=sp) :: x2, y2 ! coordinates
+ character(len=*) :: fmt ! format (default f8.3)
+
+ call xml_AddAttribute(xf, 'x2', str(x2, fmt))
+ call xml_AddAttribute(xf, 'y2', str(y2, fmt))
+ call xml_AddPcdata(xf, '>') !!AG***
+
+ END SUBROUTINE CMLATXY9SP
+
+
+ ! -------------------------------------------------
+ ! 1. creates a DP element
+ ! -------------------------------------------------
+
+ SUBROUTINE CMLLEN9DP(xf, id, atomRef1, atomRef2, length, fmt)
+ implicit none
+ type(xmlf_t) :: xf
+ character(len=*) :: id ! length id
+ character(len=*) :: atomRef1 ! ref to first atom
+ character(len=*) :: atomRef2 ! ref to second atom
+ real(kind=dp) :: length ! the length
+ character(len=*) :: fmt ! format
+ character(len=20) :: temp
+
+ temp = atomRef1//' '//adjustl(atomRef2)
+
+ call xml_NewElement(xf, 'length')
+ call xml_AddAttribute(xf, 'id', id)
+ call xml_AddAttribute(xf, 'atomRefs2', temp)
+ call xml_AddPcdata(xf, str(length, fmt))
+ call xml_EndElement(xf, 'length')
+
+ END SUBROUTINE CMLLEN9DP
+
+ ! -------------------------------------------------
+ ! 2. creates a SP element
+ ! -------------------------------------------------
+
+ SUBROUTINE CMLLEN9SP(xf, id, atomRef1, atomRef2, length, fmt)
+ implicit none
+ type(xmlf_t) :: xf
+ character(len=*) :: id ! length id
+ character(len=*) :: atomRef1 ! ref to first atom
+ character(len=*) :: atomRef2 ! ref to second atom
+ real(kind=sp) :: length ! the length
+ character(len=*) :: fmt ! format
+ character(len=20) :: temp
+
+ temp = atomRef1//' '//adjustl(atomRef2)
+
+ call xml_NewElement(xf, 'length')
+ call xml_AddAttribute(xf, 'id', id)
+ call xml_AddAttribute(xf, 'atomRefs2', temp)
+ call xml_AddPcdata(xf, str(length, fmt))
+ call xml_EndElement(xf, 'length')
+
+ END SUBROUTINE CMLLEN9SP
+
+
+ ! -------------------------------------------------
+ ! 1. creates a DP element
+ ! -------------------------------------------------
+
+ SUBROUTINE CMLANG9DP(xf, id, atomRef1, atomRef2, atomRef3, angle, fmt)
+ implicit none
+ type(xmlf_t) :: xf
+ character(len=*) :: id ! angle id
+ character(len=*) :: atomRef1 ! ref to first atom
+ character(len=*) :: atomRef2 ! ref to second atom
+ character(len=*) :: atomRef3 ! ref to third atom
+ real(kind=dp) :: angle ! the angle
+ character(len=*) :: fmt ! format
+ character(len=20) :: temp
+
+ temp = atomRef1//' '//adjustl(atomRef2)//' '//adjustl(atomRef3)
+
+ call xml_NewElement(xf, 'angle')
+ call xml_AddAttribute(xf, 'id', id)
+ call xml_AddAttribute(xf, 'atomRefs3', temp)
+ call xml_AddPcdata(xf, str(angle, fmt))
+ call xml_EndElement(xf, 'angle')
+
+ END SUBROUTINE CMLANG9DP
+
+ ! -------------------------------------------------
+ ! 2. creates a SP element
+ ! -------------------------------------------------
+
+ SUBROUTINE CMLANG9SP(xf, id, atomRef1, atomRef2, atomRef3, angle, fmt)
+ implicit none
+ type(xmlf_t) :: xf
+ character(len=*) :: id ! angle id
+ character(len=*) :: atomRef1 ! ref to first atom
+ character(len=*) :: atomRef2 ! ref to second atom
+ character(len=*) :: atomRef3 ! ref to third atom
+ real(kind=sp) :: angle ! the angle
+ character(len=*) :: fmt ! format
+ character(len=20) :: temp
+
+ temp = atomRef1//' '//adjustl(atomRef2)//' '//adjustl(atomRef3)
+
+ call xml_NewElement(xf, 'angle')
+ call xml_AddAttribute(xf, 'id', id)
+ call xml_AddAttribute(xf, 'atomRefs3', temp)
+ call xml_AddPcdata(xf, str(angle, fmt))
+ call xml_EndElement(xf, 'angle')
+
+ END SUBROUTINE CMLANG9SP
+
+
+ ! -------------------------------------------------
+ ! 1. creates a DP element
+ ! -------------------------------------------------
+
+ SUBROUTINE CMLTOR9DP(xf, id, atomRef1, atomRef2, atomRef3, atomRef4, torsion, fmt)
+ implicit none
+ type(xmlf_t) :: xf
+ character(len=*) :: id ! torsion id
+ character(len=*) :: atomRef1 ! ref to first atom
+ character(len=*) :: atomRef2 ! ref to second atom
+ character(len=*) :: atomRef3 ! ref to third atom
+ character(len=*) :: atomRef4 ! ref to fourth atom
+ real(kind=dp) :: torsion ! the torsion
+ character(len=*) :: fmt ! format
+ character(len=20) :: temp
+
+ temp = atomRef1//' '//adjustl(atomRef2)//' '//adjustl(atomRef3)//' '//adjustl(atomRef4)
+
+ call xml_NewElement(xf, 'torsion')
+ call xml_AddAttribute(xf, 'id', id)
+ call xml_AddAttribute(xf, 'atomRefs4', temp)
+ call xml_AddPcdata(xf, str(torsion, fmt))
+ call xml_EndElement(xf, 'torsion')
+
+ END SUBROUTINE CMLTOR9DP
+
+ ! -------------------------------------------------
+ ! 2. creates a SP element
+ ! -------------------------------------------------
+
+ SUBROUTINE CMLTOR9SP(xf, id, atomRef1, atomRef2, atomRef3, atomRef4, torsion, fmt)
+ implicit none
+ type(xmlf_t) :: xf
+ character(len=*) :: id ! torsion id
+ character(len=*) :: atomRef1 ! ref to first atom
+ character(len=*) :: atomRef2 ! ref to second atom
+ character(len=*) :: atomRef3 ! ref to third atom
+ character(len=*) :: atomRef4 ! ref to fourth atom
+ real(kind=sp) :: torsion ! the torsion
+ character(len=*) :: fmt ! format
+ character(len=20) :: temp
+
+ temp = atomRef1//' '//adjustl(atomRef2)//' '//adjustl(atomRef3)//' '//adjustl(atomRef4)
+
+ call xml_NewElement(xf, 'torsion')
+ call xml_AddAttribute(xf, 'id', id)
+ call xml_AddAttribute(xf, 'atomRefs4', temp)
+ call xml_AddPcdata(xf, str(torsion, fmt))
+ call xml_EndElement(xf, 'torsion')
+
+ END SUBROUTINE CMLTOR9SP
+
+end module m_cmlw
Index: /XMLF90/src/cml/m_stmw.f90
===================================================================
--- /XMLF90/src/cml/m_stmw.f90 (revision 6)
+++ /XMLF90/src/cml/m_stmw.f90 (revision 6)
@@ -0,0 +1,875 @@
+module m_stmw
+
+ use flib_wxml
+
+ private
+
+ integer, private, parameter :: sp = selected_real_kind(6,30)
+ integer, private, parameter :: dp = selected_real_kind(14,100)
+
+! TYPE(xmlf_t), save, :: xf
+
+ PUBLIC :: stmAddScalar
+ PUBLIC :: stmAddArray
+ PUBLIC :: stmAddMatrix
+ PUBLIC :: stmAddTriangle
+ PUBLIC :: stmAddStartTag
+
+ INTERFACE stmAddScalar
+ MODULE PROCEDURE stmAddString, stmAddInteger, stmAddFloatSP, stmAddFloatDP
+ END INTERFACE
+
+ INTERFACE stmAddArray
+ MODULE PROCEDURE stmAddFloatArraySP, stmAddFloatArrayDP, stmAddStringArray, &
+ stmAddIntegerArray
+ END INTERFACE
+
+ INTERFACE stmAddMatrix
+ MODULE PROCEDURE stmAddFloatMatrixSP, stmAddFloatMatrixDP, stmAddIntegerMatrix
+ END INTERFACE
+
+ INTERFACE stmAddTriangle
+ MODULE PROCEDURE stmAddTriangleSP, stmAddTriangleDP
+ END INTERFACE
+
+
+CONTAINS
+
+
+ ! =================================================
+ ! STMML convenience routines
+ ! =================================================
+
+ ! -------------------------------------------------
+ ! create STMML start tag in xml channel
+ ! -------------------------------------------------
+
+ SUBROUTINE stmAddStartTag(xf, name, id, title, dictref, dataType, &
+ convention, errorValue, errorBasis, min, max, units)
+
+ implicit none
+ type(xmlf_t) :: xf
+ character(len=*), intent(in) :: name ! the element name
+ character(len=*), intent(in), optional :: id ! the element id; if whitespace, is omitted
+ character(len=*), intent(in), optional :: title ! the title; if whitespace, is omitted
+ character(len=*), intent(in), optional :: dictref ! the dictionary reference; if whitespace, is omitted
+ character(len=*), intent(in), optional :: dataType
+ character(len=*), intent(in), optional :: convention
+ character(len=*), intent(in), optional :: errorValue
+ character(len=*), intent(in), optional :: errorBasis
+ character(len=*), intent(in), optional :: min
+ character(len=*), intent(in), optional :: max
+ character(len=*), intent(in), optional :: units
+
+! call XMLCHKN9(name)
+ call xml_NewElement(xf, name)
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ if (present(dataType)) call xml_AddAttribute(xf, 'dataType', dataType)
+ if (present(convention)) call xml_AddAttribute(xf, 'convention', convention)
+ if (present(errorValue)) call xml_AddAttribute(xf, 'errorValue', errorValue)
+ if (present(errorBasis)) call xml_AddAttribute(xf, 'errorBasis', errorBasis)
+ if (present(min)) call xml_AddAttribute(xf, 'min', min)
+ if (present(max)) call xml_AddAttribute(xf, 'max', max)
+ if (present(units)) call xml_AddAttribute(xf, 'units', units)
+
+ END SUBROUTINE stmAddStartTag
+
+
+ ! -------------------------------------------------
+ ! outputs STMML scalar in xml channel
+ ! -------------------------------------------------
+
+ SUBROUTINE stmAddString(xf, value, id, title, dictref, dataType, &
+ convention, errorValue, errorBasis, min, max, units)
+
+ implicit none
+ type(xmlf_t) :: xf
+ character(len=*), intent(in) :: value ! the value to be output
+ character(len=*), intent(in), optional :: id ! the id
+ character(len=*), intent(in), optional :: title ! the title
+ character(len=*), intent(in), optional :: dictref ! the dictionary reference
+ character(len=*), intent(in), optional :: dataType
+ character(len=*), intent(in), optional :: convention
+ character(len=*), intent(in), optional :: errorValue
+ character(len=*), intent(in), optional :: errorBasis
+ character(len=*), intent(in), optional :: min
+ character(len=*), intent(in), optional :: max
+ character(len=*), intent(in), optional :: units
+
+ ! Internal variables
+ character(len=20) :: temp
+
+! if (XMLCHKS9(value)) then
+ call xml_AddPcdata(xf, ' '//value)
+
+ call xml_NewElement(xf, 'scalar')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ if (present(dataType)) call xml_AddAttribute(xf, 'dataType', dataType)
+ if (present(convention)) call xml_AddAttribute(xf, 'convention', convention)
+ if (present(errorValue)) call xml_AddAttribute(xf, 'errorValue', errorValue)
+ if (present(errorBasis)) call xml_AddAttribute(xf, 'errorBasis', errorBasis)
+ if (present(min)) call xml_AddAttribute(xf, 'min', min)
+ if (present(max)) call xml_AddAttribute(xf, 'max', max)
+ if (present(units)) call xml_AddAttribute(xf, 'units', units)
+ call xml_EndElement(xf, 'scalar')
+
+ END SUBROUTINE stmAddString
+
+
+ ! -------------------------------------------------
+ ! outputs STMML integer in xml channel
+ ! -------------------------------------------------
+
+ SUBROUTINE stmAddInteger(xf, value, id, title, dictref, dataType, &
+ convention, errorValue, errorBasis, min, max, units)
+
+ implicit none
+ type(xmlf_t) :: xf
+ integer, intent(in) :: value ! the value to be output
+ character(len=*), intent(in), optional :: id ! the id
+ character(len=*), intent(in), optional :: title ! the title
+ character(len=*), intent(in), optional :: dictref ! the dictionary reference
+ character(len=*), intent(in), optional :: dataType
+ character(len=*), intent(in), optional :: convention
+ character(len=*), intent(in), optional :: errorValue
+ character(len=*), intent(in), optional :: errorBasis
+ character(len=*), intent(in), optional :: min
+ character(len=*), intent(in), optional :: max
+ character(len=*), intent(in), optional :: units ! units (default = none)
+
+
+ ! Flush on entry and exit
+ call xml_NewElement(xf, 'scalar')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(title)) call xml_AddAttribute(xf, 'dictRef', title)
+ if (present(dictref)) call xml_AddAttribute(xf, 'title', dictref)
+ if (present(dataType)) call xml_AddAttribute(xf, 'dataType', dataType)
+ if (present(convention)) call xml_AddAttribute(xf, 'convention', convention)
+ if (present(errorValue)) call xml_AddAttribute(xf, 'errorValue', errorValue)
+ if (present(errorBasis)) call xml_AddAttribute(xf, 'errorBasis', errorBasis)
+ if (present(min)) call xml_AddAttribute(xf, 'min', min)
+ if (present(max)) call xml_AddAttribute(xf, 'max', max)
+ if (present(units)) call xml_AddAttribute(xf, 'units', units)
+ call xml_AddPcdata(xf, str(value))
+ call xml_EndElement(xf, 'scalar')
+
+ END SUBROUTINE stmAddInteger
+
+
+ ! -------------------------------------------------
+ ! 1. create an STMML DP float in xml channel
+ ! -------------------------------------------------
+
+ SUBROUTINE stmAddFloatDP(xf, value, id, title, dictref, dataType, &
+ convention, errorValue, errorBasis, min, max, units, fmt)
+
+ implicit none
+ type(xmlf_t) :: xf
+ real(kind=dp), intent(in) :: value ! the value to be output
+ character(len=*), intent(in), optional :: id ! id
+ character(len=*), intent(in), optional :: title ! the title
+ character(len=*), intent(in), optional :: dictref ! the dictionary reference
+ character(len=*), intent(in), optional :: dataType
+ character(len=*), intent(in), optional :: convention
+ character(len=*), intent(in), optional :: errorValue
+ character(len=*), intent(in), optional :: errorBasis
+ character(len=*), intent(in), optional :: min
+ character(len=*), intent(in), optional :: max
+ character(len=*), intent(in), optional :: units ! units
+ character(len=*), intent(in), optional :: fmt ! the format (default 'f10.4')
+
+ ! Internal Vaiable
+ character(len=10) :: formt
+
+ if (present(fmt)) then
+ formt = fmt
+ else
+ formt = '(f10.4)'
+ endif
+
+
+ ! Flushes on entry and exit
+ call xml_NewElement(xf, 'scalar')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ if (present(dataType)) call xml_AddAttribute(xf, 'dataType', dataType)
+ if (present(convention)) call xml_AddAttribute(xf, 'convention', convention)
+ if (present(errorValue)) call xml_AddAttribute(xf, 'errorValue', errorValue)
+ if (present(errorBasis)) call xml_AddAttribute(xf, 'errorBasis', errorBasis)
+ if (present(min)) call xml_AddAttribute(xf, 'min', min)
+ if (present(max)) call xml_AddAttribute(xf, 'max', max)
+ if (present(units)) call xml_AddAttribute(xf, 'units', units)
+
+ call xml_AddPcdata(xf, str(value))
+ call xml_EndElement(xf, 'scalar')
+
+ END SUBROUTINE stmAddFloatDP
+
+ ! -------------------------------------------------
+ ! 2. create an STMML SP float in xml channel
+ ! -------------------------------------------------
+
+ SUBROUTINE stmAddFloatSP(xf, value, id, title, dictref, dataType, &
+ convention, errorValue, errorBasis, min, max, units, fmt)
+
+ implicit none
+ type(xmlf_t) :: xf
+ real(kind=sp), intent(in) :: value ! the value to be output
+ character(len=*), intent(in), optional :: id ! id
+ character(len=*), intent(in), optional :: title ! the title
+ character(len=*), intent(in), optional :: dictref ! the dictionary reference
+ character(len=*), intent(in), optional :: units ! units (' ' = none)
+ character(len=*), intent(in), optional :: dataType
+ character(len=*), intent(in), optional :: convention
+ character(len=*), intent(in), optional :: errorValue
+ character(len=*), intent(in), optional :: errorBasis
+ character(len=*), intent(in), optional :: min
+ character(len=*), intent(in), optional :: max
+ character(len=*), intent(in), optional :: fmt ! the format (default 'f10.4')
+
+ ! Internal Variable
+ character(len=10) :: formt
+
+ if (present(fmt)) then
+ formt = fmt
+ else
+ formt = '(f10.4)'
+ endif
+
+ ! Flushes on entry and exit
+ call xml_NewElement(xf, 'scalar')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(title)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ if (present(dictref)) call xml_AddAttribute(xf, 'title', title)
+ if (present(dataType)) call xml_AddAttribute(xf, 'dataType', dataType)
+ if (present(convention)) call xml_AddAttribute(xf, 'convention', convention)
+ if (present(errorValue)) call xml_AddAttribute(xf, 'errorValue', errorValue)
+ if (present(errorBasis)) call xml_AddAttribute(xf, 'errorBasis', errorBasis)
+ if (present(min)) call xml_AddAttribute(xf, 'min', min)
+ if (present(max)) call xml_AddAttribute(xf, 'max', max)
+ if (present(units)) call xml_AddAttribute(xf, 'units', units)
+ call xml_AddPcdata(xf, str(value))
+ call xml_EndElement(xf, 'scalar')
+
+ END SUBROUTINE stmAddFloatSP
+
+
+ ! -------------------------------------------------
+ ! outputs string array to xml channel
+ ! -------------------------------------------------
+
+ SUBROUTINE stmAddStringArray(xf, nvalue, array, id, title, dictref, type, delim, ref)
+
+ implicit none
+ type(xmlf_t) :: xf
+ integer, intent(in) :: nvalue ! number of values to be output
+ character(len=*), intent(in) :: array(*) ! the values to be output
+ character(len=*), intent(in), optional :: id ! the id
+ character(len=*), intent(in), optional :: title ! the title
+ character(len=*), intent(in), optional :: dictref ! the dictionary reference
+ character(len=*), intent(in), optional :: type ! the dataType
+ character(len=*), intent(in), optional :: delim ! delimiter
+ character(len=*), intent(in), optional :: ref ! delimiter
+
+ ! splits data into lines whenever it overflows workspace/linelength
+ ! Flush on entry and exit
+ character(len=1) :: delim1
+ integer :: i
+
+
+ if (present(delim)) then
+ delim1 = delim
+ else
+ delim1 = ' '
+ endif
+
+ call xml_NewElement(xf, 'array')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(type)) call xml_AddAttribute(xf, 'type', type)
+ if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+ call xml_AddAttribute(xf, 'delimiter', delim1)
+ call xml_AddAttribute(xf, 'size', str(nvalue))
+
+ call xml_AddPcdata(xf, array(1))
+ do i = 2, nvalue
+ if (delim1 .eq. ' ') then
+ call xml_AddPcdata(xf, ' '//array(i))
+ else
+ call xml_AddPcdata(xf, delim1//array(i))
+ endif
+ enddo
+ call xml_EndElement(xf, 'array')
+
+ END SUBROUTINE stmAddStringArray
+
+
+ ! -------------------------------------------------
+ ! outputs integer array to xml channel
+ ! -------------------------------------------------
+
+ SUBROUTINE stmAddIntegerArray(xf, nvalue, array, id, title, dictref, ref, units)
+
+ implicit none
+ type(xmlf_t) :: xf
+ integer, intent(in) :: nvalue ! the number of values to be output
+ integer, intent(in) :: array(*) ! the values to be output
+ character(len=*), intent(in), optional :: id ! the id
+ character(len=*), intent(in), optional :: title ! the title
+ character(len=*), intent(in), optional :: dictref ! the dictionary reference
+ character(len=*), intent(in), optional :: units ! scienitific units (default ' ')
+ character(len=*), intent(in), optional :: ref ! scienitific units (default ' ')
+
+ ! splits data into lines wherever it overflows the workspace
+ integer :: i
+
+ ! Flush on entry and exit
+
+ call xml_NewElement(xf, 'array')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(units)) call xml_AddAttribute(xf, 'units', units)
+ if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+ call xml_AddAttribute(xf, 'size', str(nvalue))
+
+
+ call xml_AddPcdata(xf, str(array(1)))
+ do i = 2, nvalue
+ call xml_AddPcdata(xf, str(array(i)))
+ enddo
+ call xml_EndElement(xf, 'array')
+
+ END SUBROUTINE stmAddIntegerArray
+
+
+ ! -------------------------------------------------
+ ! 1. outputs DP float array to xml channel
+ ! -------------------------------------------------
+
+ SUBROUTINE stmAddFloatArrayDP(xf, nvalue, array, id, title, dictref, units, ref, fmt)
+
+ implicit none
+ type(xmlf_t) :: xf
+ integer, intent(in) :: nvalue ! number of values to be output
+ real(kind=dp), intent(in) :: array(*) ! the values to be output
+ character(len=*), intent(in), optional :: id ! the id
+ character(len=*), intent(in), optional :: title ! the title
+ character(len=*), intent(in), optional :: dictref ! the dictionary reference
+ character(len=*), intent(in), optional :: units ! scienitific units (default ' ')
+ character(len=*), intent(in), optional :: ref !
+ character(len=*), intent(in), optional :: fmt ! the output format
+
+ ! Internal Variable
+ character(len=10) :: formt
+
+ if (present(fmt)) then
+ formt = fmt
+ else
+ formt = '(f8.3)'
+ endif
+
+ ! splits data into lines whenever it overflows workspace/linelength
+ ! Flush on entry and exit
+
+ call xml_NewElement(xf, 'array')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(units)) call xml_AddAttribute(xf, 'units', units)
+ if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+ call xml_AddAttribute(xf, 'size', str(nvalue))
+ call STMARCF9DP(xf, nvalue, array, fmt)
+ call xml_EndElement(xf, 'array')
+
+ END SUBROUTINE stmAddFloatArrayDP
+
+ ! -------------------------------------------------
+ ! 2. outputs SP float array to xml channel
+ ! -------------------------------------------------
+
+ SUBROUTINE stmAddFloatArraySP(xf, nvalue, array, id, title, dictref, units, ref, fmt)
+
+ implicit none
+ type(xmlf_t) :: xf
+ integer, intent(in) :: nvalue ! number of values to be output
+ real(kind=sp), intent(in) :: array(*) ! the values to be output
+ character(len=*), intent(in), optional :: id ! the id
+ character(len=*), intent(in), optional :: title ! the title
+ character(len=*), intent(in), optional :: dictref ! the dictionary reference
+ character(len=*), intent(in), optional :: units ! scienitific units (default ' ')
+ character(len=*), intent(in), optional :: fmt ! the output format
+ character(len=*), intent(in), optional :: ref ! the output format
+
+ ! Internal Variable
+ character(len=10) :: formt
+
+ if (present(fmt)) then
+ formt = fmt
+ else
+ formt = '(f8.3)'
+ endif
+
+ ! splits data into lines whenever it overflows workspace/linelength
+ ! Flush on entry and exit
+
+ call xml_NewElement(xf, 'array')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(units)) call xml_AddAttribute(xf, 'units', units)
+ if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+ call xml_AddAttribute(xf, 'size', str(nvalue))
+ call STMARCF9SP(xf, nvalue, array, fmt)
+ call xml_EndElement(xf, 'array')
+
+ END SUBROUTINE stmAddFloatArraySP
+
+
+ ! -------------------------------------------------
+ ! outputs integer matrix to xml channel
+ ! -------------------------------------------------
+
+ SUBROUTINE stmAddIntegerMatrix(xf, nrows, ncols, dim, matrix, id, title, dictref, units)
+
+ implicit none
+ type(xmlf_t) :: xf
+ integer, intent(in) :: nrows ! the number of rows to be output
+ integer, intent(in) :: ncols ! the number of rows to be output
+ integer, intent(in) :: dim ! the range of the fastest index
+ integer, intent(in) :: matrix(nrows,ncols) ! the values to be output
+ character(len=*), intent(in), optional :: id ! the id
+ character(len=*), intent(in), optional :: title ! the title
+ character(len=*), intent(in), optional :: dictref ! the dictionary reference
+ character(len=*), intent(in), optional :: units ! scienitific units (default ' ')
+
+ ! splits data into lines wherever it overflows the workspace
+ ! Flush on entry and exit
+ integer :: i, j
+
+
+
+ call xml_NewElement(xf, 'matrix')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(units)) call xml_AddAttribute(xf, 'units', units)
+ call xml_AddAttribute(xf, 'cols', str(ncols))
+ call xml_AddAttribute(xf, 'rows', str(nrows))
+
+!
+! Try addArray...
+!
+ do i = 1, ncols
+ do j = 1, nrows
+ call xml_AddPcdata(xf, str(matrix(j, i)))
+ enddo
+ enddo
+ call xml_EndElement(xf, 'matrix')
+
+ END SUBROUTINE stmAddIntegerMatrix
+
+
+ ! -------------------------------------------------
+ ! 1. outputs DP float matrix to xml channel
+ ! -------------------------------------------------
+
+ SUBROUTINE stmAddFloatMatrixDP(xf, ncols, nrows, dim, matrix, id, title, dictref, units, fmt)
+
+ implicit none
+ type(xmlf_t) :: xf
+ integer, intent(in) :: ncols ! the number of cols to be output
+ integer, intent(in) :: nrows ! the number of rows to be output
+ integer, intent(in) :: dim ! the range of the fastest index
+ real(kind=dp), intent(in) :: matrix(ncols,nrows) ! the values to be output
+ character(len=*), intent(in), optional :: id ! the id
+ character(len=*), intent(in), optional :: title ! the title
+ character(len=*), intent(in), optional :: dictref ! the dictionary reference
+ character(len=*), intent(in), optional :: units ! scienitific units (default ' ')
+ character(len=*), intent(in), optional :: fmt ! format
+
+ ! internal variable
+ character(len=10) :: formt
+ integer :: i, j
+
+ if (present(fmt)) then
+ formt = fmt
+ else
+ formt = '(f8.3)'
+ endif
+
+ ! splits data into lines wherever it overflows the workspace
+ ! Flush on entry and exit
+ !-------------
+ call xml_NewElement(xf, 'matrix')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ if (present(units)) call xml_AddAttribute(xf, 'units', units)
+ call xml_AddAttribute(xf, 'cols', str(ncols))
+ call xml_AddAttribute(xf, 'rows', str(nrows))
+ !-------------
+ do i = 1, nrows
+ do j = 1, ncols
+ ! write(*,*) ">>> 1", i, j
+ call xml_AddPcdata(xf, str(matrix(j, i)))
+ enddo
+ enddo
+ call xml_EndElement(xf, 'matrix')
+
+ END SUBROUTINE stmAddFloatMatrixDP
+
+ ! -------------------------------------------------
+ ! 2. outputs SP float matrix to xml channel
+ ! -------------------------------------------------
+
+ SUBROUTINE stmAddFloatMatrixSP(xf, ncols, nrows, dim, matrix, id, title, dictref, units, fmt)
+
+ implicit none
+ type(xmlf_t) :: xf
+ integer, intent(in) :: ncols ! the number of cols to be output
+ integer, intent(in) :: nrows ! the number of rows to be output
+ integer, intent(in) :: dim ! the range of the fastest index
+ real(kind=sp), intent(in) :: matrix(ncols,nrows) ! the values to be output
+ character(len=*), intent(in), optional :: id ! the id
+ character(len=*), intent(in), optional :: title ! the title
+ character(len=*), intent(in), optional :: dictref ! the dictionary reference
+ character(len=*), intent(in), optional :: units ! scienitific units (default ' ')
+ character(len=*), intent(in), optional :: fmt ! format
+
+ ! internal variable
+ character(len=10) :: formt
+ integer :: i, j
+
+ if (present(fmt)) then
+ formt = fmt
+ else
+ formt = '(f8.3)'
+ endif
+
+ ! splits data into lines wherever it overflows the workspace
+ ! Flush on entry and exit
+ !
+ call xml_NewElement(xf, 'matrix')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ if (present(units)) call xml_AddAttribute(xf, 'units', units)
+ call xml_AddAttribute(xf, 'cols', str(ncols))
+ call xml_AddAttribute(xf, 'rows', str(nrows))
+ do i = 1, nrows
+ do j = 1, ncols
+ call xml_AddPcdata(xf, str(matrix(j, i)))
+ enddo
+ enddo
+ call xml_EndElement(xf, 'matrix')
+
+ END SUBROUTINE stmAddFloatMatrixSP
+
+
+ ! -------------------------------------------------
+ ! 1. outputs DP lower triangle array to xml channel
+ ! -------------------------------------------------
+
+ SUBROUTINE stmAddTriangleDP(xf, nvalue, array, id, title, dictref, units, fmt)
+
+ implicit none
+ type(xmlf_t) :: xf
+ integer, intent(in) :: nvalue ! number of values to be output
+ real(kind=dp), intent(in) :: array(*) ! the values to be output
+ character(len=*), intent(in), optional :: id ! the id
+ character(len=*), intent(in), optional :: title ! the title
+ character(len=*), intent(in), optional :: dictref ! the dictionary reference
+ character(len=*), intent(in), optional :: units ! units (' ' = none)
+ character(len=*), intent(in), optional :: fmt ! the output format
+
+ ! splits data into lines whenever it overflows workspace/linelength
+ ! Flush on entry and exit
+ integer :: size
+ character(len=10) :: formt
+
+ if (present(fmt)) then
+ formt = fmt
+ else
+ formt = '(f8.3)'
+ endif
+
+ size = (nvalue*(nvalue+1))/2
+ call xml_NewElement(xf, 'array')
+ call xml_AddAttribute(xf, 'size', str(size))
+ call xml_AddAttribute(xf, 'rows', str(nvalue))
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ if (present(units)) call xml_AddAttribute(xf, 'units', units)
+ call STMARCF9DP(xf, size, array, formt)
+ call xml_EndElement(xf, 'matrix')
+
+ END SUBROUTINE stmAddTriangleDP
+
+ ! -------------------------------------------------
+ ! 2. outputs SP lower triangle array to xml channel
+ ! -------------------------------------------------
+
+ SUBROUTINE stmAddTriangleSP(xf, nvalue, array, id, title, dictref, units, fmt)
+
+ implicit none
+ type(xmlf_t) :: xf
+ integer, intent(in) :: nvalue ! number of values to be output
+ real(kind=sp), intent(in) :: array(*) ! the values to be output
+ character(len=*), intent(in), optional :: id ! the id
+ character(len=*), intent(in), optional :: title ! the title
+ character(len=*), intent(in), optional :: dictref ! the dictionary reference
+ character(len=*), intent(in), optional :: units ! units (' ' = none)
+ character(len=*), intent(in), optional :: fmt ! the output format
+
+ ! splits data into lines whenever it overflows workspace/linelength
+ ! Flush on entry and exit
+ integer :: size
+ character(len=10) :: formt
+
+ if (present(fmt)) then
+ formt = fmt
+ else
+ formt = '(f8.3)'
+ endif
+
+ size = (nvalue*(nvalue+1))/2
+ call xml_NewElement(xf, 'array')
+ call xml_AddAttribute(xf, 'size', str(size))
+ call xml_AddAttribute(xf, 'rows', str(nvalue))
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ if (present(units)) call xml_AddAttribute(xf, 'units', units)
+ call STMARCF9SP(xf, size, array, formt)
+ call xml_EndElement(xf, 'matrix')
+
+ END SUBROUTINE stmAddTriangleSP
+
+
+ ! -------------------------------------------------
+ ! outputs fatal error message
+ ! -------------------------------------------------
+
+ SUBROUTINE stmErrorMessage(xf, msg, id, title, dictref)
+
+ implicit none
+ type(xmlf_t) :: xf
+ character(len=*), intent(in) :: msg ! the message
+ character(len=*), intent(in), optional :: id ! the id
+ character(len=*), intent(in), optional :: title ! the title
+ character(len=*), intent(in), optional :: dictref ! the dictionary reference
+
+ call xml_NewElement(xf, 'message')
+ call xml_AddAttribute(xf, 'severity', 'fatal')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ call xml_AddPcdata(xf, msg)
+ call xml_EndElement(xf, 'message')
+
+ END SUBROUTINE stmErrorMessage
+
+
+ ! -------------------------------------------------
+ ! outputs informational message
+ ! -------------------------------------------------
+
+ SUBROUTINE stmInfoMessage(xf, msg, id, title, dictref)
+
+ implicit none
+ type(xmlf_t) :: xf
+ character(len=*), intent(in) :: msg ! the message
+ character(len=*), intent(in), optional :: id ! the id
+ character(len=*), intent(in), optional :: title ! the title
+ character(len=*), intent(in), optional :: dictref ! the dictionary reference
+
+ call xml_NewElement(xf, 'message')
+ call xml_AddAttribute(xf, 'severity', 'warning')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ call xml_AddPcdata(xf, msg)
+ call xml_EndElement(xf, 'message')
+
+ END SUBROUTINE stmInfoMessage
+
+
+ ! -------------------------------------------------
+ ! outputs warning message
+ ! -------------------------------------------------
+
+ SUBROUTINE stmWarningMessage(xf, msg, id, title, dictref)
+
+ implicit none
+ type(xmlf_t) :: xf
+ character(len=*), intent(in) :: msg ! the message
+ character(len=*), intent(in), optional :: id ! the id
+ character(len=*), intent(in), optional :: title ! the title
+ character(len=*), intent(in), optional :: dictref ! the dictionary reference
+
+ call xml_NewElement(xf, 'message')
+ call xml_AddAttribute(xf, 'severity', 'info')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(title)) call xml_AddAttribute(xf, 'title', title)
+ if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ call xml_AddPcdata(xf, msg)
+ call xml_EndElement(xf, 'message')
+
+ END SUBROUTINE stmWarningMessage
+
+
+
+ ! =================================================
+ ! basic STMML routines
+ ! =================================================
+
+
+ ! -------------------------------------------------
+ ! creates STMML string
+ ! -------------------------------------------------
+
+ SUBROUTINE STMSCAS9(xf, value, id, title, dictref, type)
+
+ implicit none
+ type(xmlf_t) :: xf
+ character(len=*), intent(in) :: value ! the value to be output
+ character(len=*), intent(in), optional :: id ! the id
+ character(len=*), intent(in), optional :: title ! the title
+ character(len=*), intent(in), optional :: dictref ! the dictionary reference
+ character(len=*), intent(in), optional :: type ! the data type (default 'xsd:string')
+
+ ! Internal variables
+ character(len=20) :: temp
+
+ call xml_NewElement(xf, 'scalar')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(title)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ if (present(dictref)) call xml_AddAttribute(xf, 'title', title)
+ if (present(type)) call xml_AddAttribute(xf, 'dataType', type)
+
+! if (XMLCHKS9(value)) then
+ call xml_AddPcdata(xf, value)
+ call xml_EndElement(xf, 'scalar')
+
+ END SUBROUTINE STMSCAS9
+
+
+
+ ! -------------------------------------------------
+ ! output start tag for an STMML array
+ ! -------------------------------------------------
+
+ SUBROUTINE STMARST9(xf, nvalue, id, title, dictref, typunt, tuval, delim)
+
+ implicit none
+ type(xmlf_t) :: xf
+ integer, intent(in) :: nvalue ! the number of values to be output
+ character(len=*), intent(in), optional :: id ! the id
+ character(len=*), intent(in), optional :: title ! the title
+ character(len=*), intent(in), optional :: dictref ! the dictionary reference
+ character(len=*), intent(in), optional :: typunt ! 'type' (for strings) or 'unit' (for numeric)
+ character(len=*), intent(in), optional :: tuval ! data type (default 'xsd:string') or units (' ' = none)
+ character(len=*), intent(in), optional :: delim ! the delimiter (default ' ')
+
+ ! Internal Variables
+ character(len=1) :: delim1
+
+ if (present(delim)) then
+ delim1 = delim
+ else
+ delim1 = ' '
+ endif
+
+ call xml_NewElement(xf, 'array')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(title)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ if (present(dictref)) call xml_AddAttribute(xf, 'title', title)
+ if (present(tuval)) call xml_AddAttribute(xf, 'type', tuval)
+ call xml_AddAttribute(xf, 'delimiter', delim1)
+ call xml_AddAttribute(xf, 'size', str(nvalue))
+ call xml_EndElement(xf, 'array')
+
+ END SUBROUTINE STMARST9
+
+
+
+ ! -------------------------------------------------
+ ! 2. outputs SP float array to channel
+ ! -------------------------------------------------
+
+ SUBROUTINE STMARF9SP(xf, nvalue, arrf, id, title, dictref, units, fmt)
+
+ implicit none
+ type(xmlf_t) :: xf
+ integer, intent(in) :: nvalue ! the number of values to be output
+ real(kind=sp), intent(in) :: arrf(*) ! the values to be output
+ character(len=*), intent(in), optional :: id ! the id
+ character(len=*), intent(in), optional :: title ! the title
+ character(len=*), intent(in), optional :: dictref ! the dictionary reference
+ character(len=*), intent(in), optional :: units ! units (' ' = none)
+ character(len=*) :: fmt ! the output format
+
+ call xml_NewElement(xf, 'scalar')
+ if (present(id)) call xml_AddAttribute(xf, 'id', id)
+ if (present(title)) call xml_AddAttribute(xf, 'dictRef', dictref)
+ if (present(dictref)) call xml_AddAttribute(xf, 'title', title)
+ if (present(units)) call xml_AddAttribute(xf, 'units', units)
+ call xml_AddAttribute(xf, 'size', str(nvalue))
+ call STMARCF9SP(xf, nvalue, arrf, fmt)
+ call xml_NewElement(xf, 'scalar')
+
+ END SUBROUTINE STMARF9SP
+
+
+ ! -------------------------------------------------
+ ! 1. outputs content of DP float array to channel
+ ! -------------------------------------------------
+
+ SUBROUTINE STMARCF9DP(xf, nvalue, arrf, fmt)
+
+ implicit none
+ type(xmlf_t) :: xf
+ integer, intent(in) :: nvalue ! the number of values to be output
+ real(kind=dp), intent(in) :: arrf(*) ! the values to be output
+ character(len=*), intent(in) :: fmt ! the output format
+
+ ! splits data into lines whenever it overflows workspace/linelength
+ integer :: i
+
+ call xml_AddPcdata(xf, str(arrf(1)))
+ do i = 2, nvalue
+ call xml_AddPcdata(xf, str(arrf(i)))
+ enddo
+ END SUBROUTINE STMARCF9DP
+
+
+ ! -------------------------------------------------
+ ! 2. outputs content of SP float array to channel
+ ! -------------------------------------------------
+
+ SUBROUTINE STMARCF9SP(xf, nvalue, arrf, fmt)
+
+ implicit none
+ type(xmlf_t) :: xf
+ integer :: nvalue ! the number of values to be output
+ real(kind=sp) :: arrf(*) ! the values to be output
+ character(len=*) :: fmt ! the output format
+
+ ! splits data into lines whenever it overflows workspace/linelength
+ integer :: i
+
+ call xml_AddPcdata(xf, str(arrf(1)))
+ do i = 2, nvalue
+ call xml_AddPcdata(xf, str(arrf(i)))
+ enddo
+ END SUBROUTINE STMARCF9SP
+
+end module m_stmw
Index: /XMLF90/src/dom/flib_dom.f90
===================================================================
--- /XMLF90/src/dom/flib_dom.f90 (revision 6)
+++ /XMLF90/src/dom/flib_dom.f90 (revision 6)
@@ -0,0 +1,17 @@
+module flib_dom
+
+ use m_dom_types
+ use m_dom_namednodemap
+ use m_dom_nodelist
+ use m_dom_attribute
+ use m_dom_document
+ use m_dom_node
+ use m_dom_element
+ use m_dom_parse
+ use m_dom_utils
+
+ use m_strings
+
+ public
+
+end module flib_dom
Index: /XMLF90/src/dom/m_dom_attribute.f90
===================================================================
--- /XMLF90/src/dom/m_dom_attribute.f90 (revision 6)
+++ /XMLF90/src/dom/m_dom_attribute.f90 (revision 6)
@@ -0,0 +1,86 @@
+module m_dom_attribute
+
+use m_dom_types
+use m_dom_node
+use m_strings
+
+private
+ !-------------------------------------------------------
+ ! METHODS FOR ATTRIBUTE NODES
+ !-------------------------------------------------------
+
+ public :: getName
+ public :: getValue
+ public :: setValue
+
+CONTAINS
+
+ function getName(attribute)
+
+ type(fnode), intent(in) :: attribute
+ type(string) :: getName
+
+ if (attribute % nodeType == ATTRIBUTE_NODE) then
+ getName = attribute%nodeName
+ else
+ getName = ''
+ endif
+
+ end function getName
+
+ !-----------------------------------------------------------
+
+ function getValue(attribute)
+
+ type(fnode), intent(in) :: attribute
+ type(string) :: getValue
+
+ if (attribute % nodeType == ATTRIBUTE_NODE) then
+ getValue = attribute%nodeValue
+ else
+ getValue = ''
+ endif
+
+ end function getValue
+
+ !-----------------------------------------------------------
+
+ subroutine setValue(attribute, value)
+
+ character(len=*), intent(in) :: value
+ type(fnode), pointer :: attribute
+
+ if (attribute % nodeType == ATTRIBUTE_NODE) then
+ call setNodeValue(attribute,value)
+ endif
+
+ end subroutine setValue
+
+ !-----------------------------------------------------------
+
+
+!!! NB Is this a good idea?
+!!! NB pure functions have no side effects
+
+ pure function attr_name_len(attribute)
+ type(fnode), intent(in) :: attribute
+ integer :: attr_name_len
+ if (attribute % nodeType == ATTRIBUTE_NODE) then
+ attr_name_len = len_trim(attribute % nodeName)
+ else
+ attr_name_len = 0
+ end if
+ end function attr_name_len
+
+ pure function attr_val_len(attribute)
+ type(fnode), intent(in) :: attribute
+ integer :: attr_val_len
+ if (attribute % nodeType == ATTRIBUTE_NODE) then
+ attr_val_len = len_trim(attribute % nodeValue)
+ else
+ attr_val_len = 0
+ end if
+ end function attr_val_len
+
+
+end module m_dom_attribute
Index: /XMLF90/src/dom/m_dom_debug.f90
===================================================================
--- /XMLF90/src/dom/m_dom_debug.f90 (revision 6)
+++ /XMLF90/src/dom/m_dom_debug.f90 (revision 6)
@@ -0,0 +1,5 @@
+module m_dom_debug
+
+ logical, save, public :: dom_debug = .false.
+
+end module m_dom_debug
Index: /XMLF90/src/dom/m_dom_document.f90
===================================================================
--- /XMLF90/src/dom/m_dom_document.f90 (revision 6)
+++ /XMLF90/src/dom/m_dom_document.f90 (revision 6)
@@ -0,0 +1,113 @@
+module m_dom_document
+
+use m_dom_types
+use m_strings
+
+private
+
+ !-------------------------------------------------------
+ ! METHODS FOR DOCUMENT NODES
+ !-------------------------------------------------------
+ public :: createDocumentNode
+ public :: createDocumentFragment
+ public :: createTextNode
+ public :: createAttribute
+ public :: createElement
+ public :: createComment
+ public :: createCdataSection
+
+CONTAINS
+
+ !-----------------------------------------------------------
+ ! METHODS FOR DOCUMENT NODES
+ !-----------------------------------------------------------
+
+ function createDocumentNode()
+
+ type(fnode), pointer :: createDocumentNode
+
+ createDocumentNode => createNode()
+ createDocumentNode % nodeType = DOCUMENT_NODE
+ createDocumentNode % nodeName = "#document"
+
+ end function createDocumentNode
+!-------------------------------------------------------------------
+ function createDocumentFragment()
+
+ type(fnode), pointer :: createDocumentFragment
+
+ createDocumentFragment => createNode()
+ createDocumentFragment % nodeType = DOCUMENT_FRAGMENT_NODE
+ createDocumentFragment % nodeName = "#document-fragment"
+
+ end function createDocumentFragment
+!-------------------------------------------------------------------
+ function createTextNode(data)
+
+ character(len=*), intent(in) :: data
+ type(fnode), pointer :: createTextNode
+
+ createTextNode => createNode()
+ createTextNode % nodeType = TEXT_NODE
+ createTextNode % nodeName = "#text"
+ createTextNode % nodeValue = data ! NB need to split this string
+ ! across several nodes
+
+ end function createTextNode
+
+ !-----------------------------------------------------------
+
+ function createAttribute(name)
+
+ character(len=*), intent(in) :: name
+ type(fnode), pointer :: createAttribute
+
+ createAttribute => createNode()
+ createAttribute % nodeName = name
+ createAttribute % nodeType = ATTRIBUTE_NODE
+
+ end function createAttribute
+
+ !-----------------------------------------------------------
+
+ function createElement(tagName)
+
+ character(len=*), intent(in) :: tagName
+ type(fnode), pointer :: createElement
+
+ createElement => createNode()
+ createElement % nodeName = tagName
+ createElement % nodeType = ELEMENT_NODE
+
+ end function createElement
+
+ !-----------------------------------------------------------
+
+ function createComment(data)
+
+ character(len=*), intent(in) :: data
+ type(fnode), pointer :: createComment
+
+ createComment => createNode()
+ createComment % nodeName = "#comment"
+ createComment % nodeValue = data
+ createComment % nodeType = COMMENT_NODE
+
+ end function createComment
+
+ !-----------------------------------------------------------
+
+ function createCdataSection(data)
+
+ character(len=*), intent(in) :: data
+ type(fnode), pointer :: createCdataSection
+
+ createCdataSection => createNode()
+ createCdataSection % nodeName = "#cdata-section"
+ createCdataSection % nodeValue = data
+ createCdataSection % nodeType = CDATA_SECTION_NODE
+
+ end function createCdataSection
+
+
+end module m_dom_document
Index: /XMLF90/src/dom/m_dom_element.f90
===================================================================
--- /XMLF90/src/dom/m_dom_element.f90 (revision 6)
+++ /XMLF90/src/dom/m_dom_element.f90 (revision 6)
@@ -0,0 +1,242 @@
+module m_dom_element
+
+use m_dom_types
+use m_dom_namednodemap
+use m_dom_nodelist
+use m_dom_attribute
+use m_dom_document
+use m_dom_debug
+use m_dom_node
+use m_strings
+
+private
+
+ !-------------------------------------------------------
+ ! METHODS FOR ELEMENT NODES
+ !-------------------------------------------------------
+ public :: getTagName
+ public :: getElementsByTagName
+ public :: getAttribute
+ public :: getAttributeNode
+ public :: setAttribute
+ public :: setAttributeNode
+ public :: removeAttribute
+ public :: normalize !--- combines adjacent text nodes ---!
+
+CONTAINS
+
+ !-----------------------------------------------------------
+ ! METHODS FOR ELEMENT NODES
+ !-----------------------------------------------------------
+ function getTagName(element)
+
+ type(fnode), intent(in) :: element
+ type(string) :: getTagName
+
+ if (element % nodeType == ELEMENT_NODE) then
+ getTagName = element % nodeName
+ else
+ getTagName = ''
+ endif
+
+ end function getTagName
+
+ !-----------------------------------------------------------
+ function getElementsByTagName(element, tag) result(nodelist)
+ type(fnode), pointer :: element
+ character(len=*), intent(in) :: tag
+ type(fnodeList), pointer :: nodelist
+
+ type(fnode), pointer :: np
+
+ nodelist => null()
+
+ np => element
+ if (dom_debug) print *, "Going into search for tag: ", trim(tag)
+ call search(np)
+
+ CONTAINS
+
+ recursive subroutine search(np)
+ type(fnode), pointer :: np
+
+ type(string) :: name
+
+ !
+ ! Could replace the calls to helper methods by direct lookups of node
+ ! components to make it faster.
+ !
+ do
+ if (.not. associated(np)) exit
+ select case(np%nodeType)
+
+ case(DOCUMENT_NODE)
+ ! special case ... search its children
+ if (hasChildNodes(np)) call search(getFirstChild(np))
+ ! will exit for lack of siblings
+ case(ELEMENT_NODE)
+
+ name = getNodeName(np)
+ if (dom_debug) print *, "exploring node: ", char(name)
+ if ((tag == "*") .or. (tag == name)) then
+ call append(nodelist,np)
+ if (dom_debug) print *, "found match ", nodelist%length
+ endif
+ if (hasChildNodes(np)) call search(getFirstChild(np))
+
+ case default
+
+ ! do nothing
+
+ end select
+
+ if (associated(np,element)) exit ! no siblings of element...
+ np => getNextSibling(np)
+
+ enddo
+
+ end subroutine search
+
+ end function getElementsByTagName
+
+ !-----------------------------------------------------------
+
+ function getAttribute(element, name)
+
+ type(fnode), intent(in) :: element
+ character(len=*), intent(in) :: name
+ type(string) :: getAttribute
+
+ type(fnode), pointer :: nn
+
+ getAttribute = "" ! as per specs, if not found
+ if (element % nodeType /= ELEMENT_NODE) RETURN
+ nn => getNamedItem(element%attributes,name)
+ if (.not. associated(nn)) RETURN
+
+ getAttribute = nn%nodeValue
+
+
+ end function getAttribute
+
+ !-----------------------------------------------------------
+
+ function getAttributeNode(element, name)
+
+ type(fnode), intent(in) :: element
+ type(fnode), pointer :: getAttributeNode
+ character(len=*), intent(in) :: name
+
+ getAttributeNode => null() ! as per specs, if not found
+ if (element % nodeType /= ELEMENT_NODE) RETURN
+ getAttributeNode => getNamedItem(element%attributes,name)
+
+ end function getAttributeNode
+
+ !-----------------------------------------------------------
+
+ subroutine setAttributeNode(element, newattr)
+ type(fnode), pointer :: element
+ type(fnode), pointer :: newattr
+
+ type(fnode), pointer :: dummy
+
+ if (element % nodeType /= ELEMENT_NODE) then
+ if (dom_debug) print *, "not an element node in setAttributeNode..."
+ RETURN
+ endif
+
+ dummy => setNamedItem(element%attributes,newattr)
+
+ end subroutine setAttributeNode
+
+!-------------------------------------------------------------------
+ subroutine setAttribute(element, name, value)
+ type(fnode), pointer :: element
+ character(len=*), intent(in) :: name
+ character(len=*), intent(in) :: value
+
+ type(fnode), pointer :: newattr
+
+ newattr => createAttribute(name)
+ call setValue(newattr,value)
+ call setAttributeNode(element,newattr)
+
+ end subroutine setAttribute
+
+ !-----------------------------------------------------------
+
+ subroutine removeAttribute(element, name)
+ type(fnode), pointer :: element
+ character(len=*), intent(in) :: name
+
+ type(fnode), pointer :: dummy
+
+ if (element % nodeType /= ELEMENT_NODE) RETURN
+ if (.not. associated(element%attributes)) RETURN
+
+ dummy => removeNamedItem(element%attributes,name)
+
+ end subroutine removeAttribute
+
+ !-----------------------------------------------------------
+ recursive subroutine normalize(element)
+ type(fnode), pointer :: element
+
+ type(fnode), pointer :: np, ghost
+ logical :: first
+
+ type(fnode), pointer :: head
+
+ first = .true. ! next Text node will be first
+
+ if (dom_debug) print *, "Normalizing: ", trim(element%nodeName)
+ np => element%firstChild
+ !
+ do
+ if (.not. associated(np)) exit
+ select case(np%nodeType)
+
+ case(TEXT_NODE)
+ if (first) then
+ if (dom_debug) print *, "normalize: found first in chain"
+ head => np
+ first = .false.
+ np => getNextSibling(np)
+ else ! a contiguous text node
+ if (dom_debug) print *, "normalize: found second in chain"
+ head%nodeValue = head%nodeValue // np%nodeValue
+ head%nextSibling => np%nextSibling
+ if (associated(np,np%parentNode%lastChild)) then
+ np%parentNode%lastChild => head
+ head%nextSibling => null()
+ else
+ np%nextSibling%previousSibling => head
+ endif
+ ghost => np
+ np => getNextSibling(np)
+ call destroyNode(ghost)
+ endif
+
+ case(ELEMENT_NODE)
+
+ first = .true.
+ if (dom_debug) print *, "element sibling: ", trim(np%nodeName)
+ if (hasChildNodes(np)) call normalize(np)
+ np => getNextSibling(np)
+
+ case default
+
+ ! do nothing, just mark that we break the chain of text nodes
+ if (dom_debug) print *, "other sibling: ", trim(np%nodeName)
+ first = .true.
+ np => getNextSibling(np)
+
+ end select
+
+ enddo
+
+ end subroutine normalize
+
+
+end module m_dom_element
Index: /XMLF90/src/dom/m_dom_error.f90
===================================================================
--- /XMLF90/src/dom/m_dom_error.f90 (revision 6)
+++ /XMLF90/src/dom/m_dom_error.f90 (revision 6)
@@ -0,0 +1,35 @@
+module m_dom_error
+
+ !-------------------------------------------------------
+ ! EXCEPTION CODES
+ !-------------------------------------------------------
+ integer, parameter, public :: INDEX_SIZE_ERR = 1
+ integer, parameter, public :: DOMSTRING_SIZE_ERR = 2
+ integer, parameter, public :: HIERARCHY_REQUEST_ERR = 3
+ integer, parameter, public :: WRONG_DOCUMENT_ERR = 4
+ integer, parameter, public :: INVALID_CHARACTER_ERR = 5
+ integer, parameter, public :: NO_DATA_ALLOWED_ERR = 6
+ integer, parameter, public :: NO_MODIFICATION_ALLOWED_ERR = 7
+ integer, parameter, public :: NOT_FOUND_ERR = 8
+ integer, parameter, public :: NOT_SUPPORTED_ERR = 9
+ integer, parameter, public :: INUSE_ATTRIBUTE_ERR = 10
+ integer, parameter, public :: INVALID_STATE_ERR = 11
+ integer, parameter, public :: SYNTAX_ERR = 12
+ integer, parameter, public :: INVALID_MODIFICATION_ERR = 13
+ integer, parameter, public :: NAMESPACE_ERR = 14
+ integer, parameter, public :: INVALID_ACCESS_ERR = 15
+ integer, parameter, public :: VALIDATION_ERR = 16
+ integer, parameter, public :: TYPE_MISMATCH_ERR = 17
+
+CONTAINS
+
+ subroutine dom_error(name,code,msg)
+ character(len=*), intent(in) :: name, msg
+ integer, intent(in) :: code
+
+ print *, "***ERROR***"
+ print *, "Routine ", trim(name), ":", trim(msg)
+ print *, 1.0 / sin(3.141592654)
+ end subroutine dom_error
+
+end module m_dom_error
Index: /XMLF90/src/dom/m_dom_namednodemap.f90
===================================================================
--- /XMLF90/src/dom/m_dom_namednodemap.f90 (revision 6)
+++ /XMLF90/src/dom/m_dom_namednodemap.f90 (revision 6)
@@ -0,0 +1,203 @@
+module m_dom_namednodemap
+!
+! This is basically a dictionary module, but written with the
+! DOM node structure in mind.
+!
+use m_dom_types
+use m_strings
+
+private
+ !-------------------------------------------------------
+ ! METHODS FOR NAMEDNODEMAPS
+ !-------------------------------------------------------
+ public :: getNamedItem
+ public :: setNamedItem
+ public :: removeNamedItem
+
+ public :: item
+ public :: getLength
+ public :: append
+
+ interface append
+ module procedure append_nnm
+ end interface
+
+ interface item
+ module procedure item_nnm
+ end interface
+
+ interface getLength
+ module procedure getLength_nnm
+ end interface
+
+CONTAINS
+
+ function item_nnm(namedNodeMap, i)
+
+ integer, intent(in) :: i
+ type(fnamedNodeMap), pointer :: namedNodeMap
+ type(fnode), pointer :: item_nnm
+
+ type(fnamedNode), pointer :: nnp
+
+ integer :: n
+
+ item_nnm => null() ! In case there is no such item
+ if (.not. associated(namedNodeMap)) RETURN
+
+ nnp => namedNodeMap%head
+ n = -1
+ do
+ if (.not. associated(nnp)) exit
+ n = n + 1
+ if (n == i) then
+ item_nnm => nnp%node
+ exit
+ endif
+ nnp => nnp%next
+ enddo
+
+ end function item_nnm
+
+ !-----------------------------------------------------------
+
+ function getLength_nnm(namedNodeMap)
+
+ type(fnamedNodeMap), pointer :: namedNodeMap
+ integer :: getLength_nnm
+
+ getLength_nnm = 0
+ if (.not. associated(namedNodeMap)) return
+
+ getLength_nnm = namedNodeMap % length
+
+ end function getLength_nnm
+
+ !-----------------------------------------------------------
+
+
+ subroutine append_nnm(nodeMap,node)
+ type(fnamednodeMap), pointer :: nodeMap
+ type(fnode), pointer :: node
+
+ if (.not. associated(nodeMap)) then
+ allocate(nodeMap)
+ nodeMap%length = 1
+ allocate(nodeMap%head)
+ nodeMap%head%name = node%nodeName
+ nodeMap%head%node => node
+ nodeMap%tail => nodeMap%head
+ else
+ allocate(nodeMap%tail%next)
+ nodeMap%tail%next%node => node
+ nodeMap%tail%next%name = node%nodeName
+ nodeMap%tail => nodeMap%tail%next
+ nodeMap%length = nodeMap%length + 1
+ endif
+
+ end subroutine append_nnm
+
+ !-----------------------------------------------------------
+
+ function getNamedItem(namedNodeMap, name)
+
+ type(fnamedNodeMap), pointer :: namedNodeMap
+ character(len=*), intent(in) :: name
+ type(fnode), pointer :: getNamedItem
+
+ type(fnamedNode), pointer :: nnp
+
+ getNamedItem => null()
+ if (.not. associated(namedNodeMap)) return
+
+ nnp => namedNodeMap%head
+ do while (associated(nnp))
+ if (nnp%name == name) then
+ getNamedItem => nnp%node
+ exit ! one or zero nodes with a given name
+ endif
+ nnp => nnp%next
+ enddo
+
+ end function getNamedItem
+
+
+ function setNamedItem(namedNodeMap, node)
+
+!!AG: Do we need to clone the node ?
+
+ type(fnamedNodeMap), pointer :: namedNodeMap
+ type(fnode), pointer :: node
+ type(fnode), pointer :: setNamedItem
+
+ type(fnamedNode), pointer :: nnp
+
+ if (.not. associated(namedNodeMap)) then
+
+ call append(namedNodeMap,node)
+ setNamedItem => node
+
+ else
+
+ nnp => namedNodeMap%head
+ do while (associated(nnp))
+ if (nnp%name == node%nodeName) then
+ setNamedItem => nnp%node
+ nnp%node => node
+ setNamedItem => node
+ return
+ endif
+ nnp => nnp%next
+ enddo
+
+ ! If not found, insert it at the end of the linked list
+
+ call append(namedNodeMap,node)
+ setNamedItem => node
+ endif
+
+ end function setNamedItem
+
+!------------------------------------------------------------
+ function removeNamedItem(namedNodeMap, name)
+
+ type(fnamedNodeMap), pointer :: namedNodeMap
+ character(len=*), intent(in) :: name
+ type(fnode), pointer :: removeNamedItem
+
+ type(fnamedNode), pointer :: nnp, previous
+
+ removeNamedItem => null()
+ if (.not. associated(namedNodeMap)) return
+
+ previous => null()
+ nnp => namedNodeMap%head
+ do while (associated(nnp))
+ if (nnp%name == name) then
+ removeNamedItem => nnp%node
+ if (associated(nnp,namedNodeMap%head)) then
+ ! we remove the first fnamedNode in the chain...
+ namedNodeMap%head => nnp%next
+ else if (.not. associated(nnp%next)) then
+ ! we remove the last fnamedNode in the chain
+ previous%next => null()
+ namedNodeMap%tail => previous
+ else
+ ! we remove a link in the middle of the chain
+ previous%next => nnp%next
+ endif
+ namedNodeMap%length = namedNodeMap%length - 1
+ call unstring(nnp%name)
+ deallocate(nnp)
+ EXIT ! one or zero nodes with a given name
+ endif
+ previous => nnp
+ nnp => nnp%next
+ enddo
+
+ end function removeNamedItem
+
+
+
+end module m_dom_namednodemap
+
Index: /XMLF90/src/dom/m_dom_node.f90
===================================================================
--- /XMLF90/src/dom/m_dom_node.f90 (revision 6)
+++ /XMLF90/src/dom/m_dom_node.f90 (revision 6)
@@ -0,0 +1,560 @@
+module m_dom_node
+
+use m_dom_types
+use m_dom_nodelist
+use m_dom_namednodemap
+use m_dom_debug
+use m_dom_error
+
+use m_strings
+
+private
+
+ !-------------------------------------------------------
+ ! METHODS FOR NODES
+ !-------------------------------------------------------
+
+ public :: getNodeName
+ public :: getNodevalue
+ public :: getNodeType
+ public :: hasChildNodes
+ public :: hasAttributes
+ public :: getParentNode
+ public :: getFirstChild
+ public :: getLastChild
+ public :: getNextSibling
+ public :: getPreviousSibling
+ public :: getOwnerDocument
+ public :: getAttributes
+ public :: getChildNodes
+ public :: setNodeValue
+ public :: appendChild
+ public :: removeChild
+ public :: replaceChild
+ public :: cloneNode
+ public :: isSameNode
+ public :: insertBefore
+
+ private :: name_len, value_len
+
+CONTAINS
+
+ pure function name_len(node)
+ type(fnode), pointer :: node
+ integer :: name_len
+
+ name_len = len_trim(node % nodeName)
+
+ end function name_len
+
+ pure function value_len(node)
+ type(fnode), pointer :: node
+ integer :: value_len
+
+ value_len = len_trim(node % nodeValue)
+
+ end function value_len
+
+ !-----------------------------------------------------------
+ ! METHODS FOR NODES
+ !-----------------------------------------------------------
+ function getNodeName(node)
+
+ type(fnode), pointer :: node
+! character(len=len_trim(node%nodeName)) :: getNodeName
+ type(string) :: getNodeName
+ if (.not. associated(node)) &
+ call dom_error("getNodeName",0,"Node not allocated")
+ getNodeName = node % nodeName
+
+ end function getNodeName
+
+ !-----------------------------------------------------------
+
+ function getNodeValue(node)
+
+ type(fnode), pointer :: node
+! character(len=len_trim(node%nodeValue)) :: getNodeValue
+ type(string) :: getNodeValue
+
+ if (.not. associated(node)) &
+ call dom_error("getNodeValue",0,"Node not allocated")
+ getNodeValue = node % nodeValue
+
+ end function getNodeValue
+
+ !-----------------------------------------------------------
+
+ function getNodeType(node)
+
+ type(fnode), pointer :: node
+ integer :: getNodeType
+
+ if (.not. associated(node)) call dom_error("getNodeType",0,"Node not allocated")
+ getNodeType = node % nodeType
+
+ end function getNodeTYpe
+
+ !-----------------------------------------------------------
+
+ function hasChildNodes(node)
+
+ type(fnode), pointer :: node
+ logical :: hasChildNodes
+
+ if (.not. associated(node)) call dom_error("hasChildNodes",0,"Node not allocated")
+ hasChildNodes = associated(node % firstChild)
+
+ end function hasChildNodes
+
+ !-----------------------------------------------------------
+
+ function hasAttributes(node)
+
+ type(fnode), pointer :: node
+ logical :: hasAttributes
+
+ hasAttributes = .false.
+ if (.not. associated(node)) call dom_error("hasAttributes",0,"Node not allocated")
+ if (node % nodeType /= ELEMENT_NODE) RETURN
+ if ( getLength(node%attributes) > 0) hasAttributes = .true.
+
+ end function hasAttributes
+
+ !-----------------------------------------------------------
+
+ function getParentNode(node)
+
+ type(fnode), pointer :: node
+ type(fnode), pointer :: getParentNode
+
+ if (.not. associated(node)) call dom_error("getParentNode",0,"Node not allocated")
+ getParentNode => node % parentNode
+
+ end function getParentNode
+
+ !-----------------------------------------------------------
+
+ function getFirstChild(node)
+
+ type(fnode), pointer :: node
+ type(fnode), pointer :: getFirstChild
+
+ if (.not. associated(node)) call dom_error("getFirstChild",0,"Node not allocated")
+ getFirstChild => node % firstChild
+
+ end function getFirstChild
+
+ !-----------------------------------------------------------
+
+ function getLastChild(node)
+
+ type(fnode), pointer :: node
+ type(fnode), pointer :: getLastChild
+
+ if (.not. associated(node)) call dom_error("getLastChild",0,"Node not allocated")
+ getLastChild => node % lastChild
+
+ end function getLastChild
+
+ !-----------------------------------------------------------
+
+ function getNextSibling(node)
+
+ type(fnode), pointer :: node
+ type(fnode), pointer :: getNextSibling
+
+ if (.not. associated(node)) call dom_error("getNextSibling",0,"Node not allocated")
+ getNextSibling => node % nextSibling
+
+ end function getNextSibling
+
+ !-----------------------------------------------------------
+
+ function getPreviousSibling(node)
+
+ type(fnode), pointer :: node
+ type(fnode), pointer :: getPreviousSibling
+
+ if (.not. associated(node)) call dom_error("getPreviousSibling",0,"Node not allocated")
+ getPreviousSibling => node % previousSibling
+
+ end function getPreviousSibling
+
+ !-----------------------------------------------------------
+
+ function getOwnerDocument(node)
+
+ type(fnode), pointer :: node
+ type(fnode), pointer :: getOwnerDocument
+
+ if (.not. associated(node)) call dom_error("getOwnerDocument",0,"Node not allocated")
+ getOwnerDocument => node % ownerDocument
+
+ end function getOwnerDocument
+
+ !-----------------------------------------------------------
+
+ function getChildNodes(node) result(nodelist)
+
+ type(fnode), pointer :: node
+ type(fnodeList), pointer :: nodelist !!! NB nodeList
+
+ type(fnode), pointer :: np
+
+ if (.not. associated(node)) call dom_error("getChildNodes",0,"Node not allocated")
+ nodelist => null()
+ np => node%firstChild
+ do
+ if (.not. associated(np)) exit
+ call append(nodelist,np)
+ np => np%nextSibling
+ enddo
+
+ end function getChildNodes
+
+ !-----------------------------------------------------------
+
+ function getAttributes(node)
+
+ type(fnode), pointer :: node
+ type(fnamedNodeMap), pointer :: getAttributes !!! NB namedNodeMap
+
+ if (.not. associated(node)) &
+ call dom_error("getAttributes",0,"Node not allocated")
+ getAttributes => node % attributes
+
+ end function getAttributes
+
+ !-----------------------------------------------------------
+
+ subroutine setNodeValue(node, value)
+
+ type(fnode), pointer :: node
+ character(len=*), intent(in) :: value
+
+ if (.not. associated(node)) &
+ call dom_error("setNodeValue",0,"Node not allocated")
+
+ select case(node % nodeType)
+
+ case(ATTRIBUTE_NODE)
+ node % nodeValue = trim(value) !!AG: use just value ??
+
+ case(COMMENT_NODE)
+ node % nodeValue = value
+
+ case(TEXT_NODE)
+ node % nodeValue = value
+
+ case(PROCESSING_INSTRUCTION_NODE)
+ node % nodeValue = value
+
+ case(CDATA_SECTION_NODE)
+ node % nodeValue = value
+
+ end select
+
+ end subroutine setNodeValue
+
+ !-----------------------------------------------------------
+
+ function appendChild(node, newChild)
+ type(fnode), pointer :: node
+ type(fnode), pointer :: newChild
+ type(fnode), pointer :: appendChild
+
+ if (.not. associated(node)) &
+ call dom_error("appendChild",0,"Node not allocated")
+
+ if ((node%nodeType /= ELEMENT_NODE) .and. &
+ (node%nodeType /= DOCUMENT_NODE)) &
+ call dom_error("appendChild",HIERARCHY_REQUEST_ERR, &
+ "this node cannot have children")
+
+ if (.not.(associated(node % firstChild))) then
+ node % firstChild => newChild
+ else
+ newChild % previousSibling => node % lastChild
+ node % lastChild % nextSibling => newChild
+ endif
+
+ node % lastChild => newChild
+ newChild % parentNode => node
+ newChild % ownerDocument => node % ownerDocument
+ node%nc = node%nc + 1
+
+ appendChild => newChild
+
+ end function appendChild
+
+ !-----------------------------------------------------------
+
+ function removeChild(node, oldChild)
+
+ type(fnode), pointer :: removeChild
+ type(fnode), pointer :: node
+ type(fnode), pointer :: oldChild
+ type(fnode), pointer :: np
+
+ if (.not. associated(node)) call dom_error("removeChild",0,"Node not allocated")
+ np => node % firstChild
+
+ do while (associated(np))
+ if (associated(np, oldChild)) then ! Two argument form
+ ! of associated()
+ if (associated(np,node%firstChild)) then
+ node%firstChild => np%nextSibling
+ if (associated(np % nextSibling)) then
+ np%nextSibling % previousSibling => null()
+ else
+ node%lastChild => null() ! there was just 1 node
+ endif
+ else if (associated(np,node%lastChild)) then
+ ! one-node-only case covered above
+ node%lastChild => np%previousSibling
+ np%previousSibling%nextSibling => null()
+ else
+ np % previousSibling % nextSibling => np % nextSibling
+ np % nextSibling % previousSibling => np % previousSibling
+ endif
+ node%nc = node%nc -1
+ np % previousSibling => null() ! Are these necessary?
+ np % nextSibling => null()
+ np % parentNode => null()
+ removeChild => oldChild
+ RETURN
+ endif
+ np => np % nextSibling
+ enddo
+
+ call dom_error("removeChild",NOT_FOUND_ERR,"oldChild not found")
+
+ end function removeChild
+
+ !-----------------------------------------------------------
+
+ function replaceChild(node, newChild, oldChild)
+
+ type(fnode), pointer :: replaceChild
+ type(fnode), pointer :: node
+ type(fnode), pointer :: newChild
+ type(fnode), pointer :: oldChild
+
+ type(fnode), pointer :: np
+
+ if (.not. associated(node)) call dom_error("replaceChild",0,"Node not allocated")
+ if ((node%nodeType /= ELEMENT_NODE) .and. &
+ (node%nodeType /= DOCUMENT_NODE)) &
+ call dom_error("replaceChild",HIERARCHY_REQUEST_ERR, &
+ "this node cannot have children")
+
+ np => node % firstChild
+
+ do while (associated(np))
+ if (associated(np, oldChild)) then
+ if (associated(np,node%firstChild)) then
+ node%firstChild => newChild
+ if (associated(np % nextSibling)) then
+ oldChild%nextSibling % previousSibling => newChild
+ else
+ node%lastChild => newChild ! there was just 1 node
+ endif
+ else if (associated(np,node%lastChild)) then
+ ! one-node-only case covered above
+ node%lastChild => newChild
+ oldChild%previousSibling%nextSibling => newChild
+ else
+ oldChild % previousSibling % nextSibling => newChild
+ oldChild % nextSibling % previousSibling => newChild
+ endif
+
+ newChild % parentNode => oldChild % parentNode
+ newChild % nextSibling => oldChild % nextSibling
+ newChild % previousSibling => oldChild % previousSibling
+ replaceChild => oldChild
+ RETURN
+ endif
+ np => np % nextSibling
+ enddo
+
+ call dom_error("replaceChild",NOT_FOUND_ERR,"oldChild not found")
+
+ end function replaceChild
+
+ !-----------------------------------------------------------
+
+ function cloneNode(node, deep)
+ type(fnode), pointer :: cloneNode
+ type(fnode), pointer :: node
+
+ logical, optional :: deep
+ logical :: do_children
+
+ type(fnode), pointer :: original
+ type(fnode), pointer :: parent_clone
+
+ if (.not. associated(node)) call dom_error("cloneNode",0,"Node not allocated")
+
+ do_children = .false.
+ if (present(deep)) then
+ do_children = deep
+ endif
+
+ original => node ! Keep node
+ cloneNode => null()
+ parent_clone => null()
+ call recursive_clone(original, cloneNode)
+ cloneNode%parentNode => null() ! as per specs , superfÃluous
+
+ Contains
+
+ recursive subroutine recursive_clone(original, cloneNode)
+ type(fnode), pointer :: original ! node to clone
+ type(fnode), pointer :: cloneNode ! new node
+
+ type(fnode), pointer :: np, clone
+ type(fnode), pointer :: previous_clone, attr, newattr
+ type(string) :: name
+ logical :: first_sibling
+ integer :: i
+
+ np => original
+ previous_clone => null()
+ first_sibling = .true.
+ do
+
+ ! Keep going across siblings
+ ! (2nd and lower levels only)
+
+ if (.not.(associated(np))) EXIT
+
+
+ !----------------------------------------------------!
+ clone => createNode()
+ if (first_sibling) then
+ cloneNode => clone ! Rest of siblings are chained
+ ! automatically, but must not
+ ! be aliases of cloneNode !!
+ first_sibling = .false.
+ endif
+ clone % nodeName = np % nodeName
+ name = np%nodeName
+ if (dom_debug) print *, "Cloning ", char(name)
+ clone % nodeValue = np % nodeValue
+ clone % nodeType = np % nodeType
+ clone % ownerDocument => np % ownerDocument
+ clone % parentNode => parent_clone
+ !
+ ! always deep copy attributes, as per specs
+ ! Note that this will not work for "deep" attributes, with
+ ! hanging entity nodes, etc
+ if (associated(np % attributes)) then
+ do i = 0, getLength(np%attributes) - 1
+ attr => item(np%attributes,i)
+ newattr => createNode()
+ newattr%nodeName = getNodeName(attr)
+ newattr%nodeValue = getNodeValue(attr)
+ newattr%nodeType = ATTRIBUTE_NODE
+ call append(clone%attributes, newattr)
+ enddo
+ endif
+
+ ! Deal with first sibling
+ if (associated(previous_clone)) then
+ if (dom_debug) print *, "linking to previous sibling"
+ previous_clone%nextSibling => clone
+ clone%previousSibling => previous_clone
+ else
+ if (dom_debug) print *, "marking as first child of parent"
+ if (associated(parent_clone)) &
+ parent_clone%firstChild => clone
+ endif
+
+ ! Deal with last sibling
+ if (.not. associated(np%nextSibling)) then
+ if (dom_debug) print *, "this is the last sibling"
+ if (associated(parent_clone)) then
+ if (dom_debug) print *, "marking as last child of parent"
+ parent_clone%lastChild => clone
+ endif
+ endif
+
+ if (do_children .and. associated(np%firstChild)) then
+ parent_clone => clone
+ if (dom_debug) print *, ".... going for its children"
+ call recursive_clone(np%firstChild,clone%firstChild)
+ parent_clone => clone%parentNode
+ endif
+
+ if (associated(np,node)) then
+ if (dom_debug) print *, "No more siblings of ", char(name)
+ EXIT ! no siblings of master node
+ endif
+ np => np % nextSibling
+ previous_clone => clone
+
+ enddo
+
+ end subroutine recursive_clone
+
+ end function cloneNode
+
+ !-----------------------------------------------------------
+
+ function isSameNode(node1, node2) ! DOM 3.0
+ type(fnode), pointer :: node1
+ type(fnode), pointer :: node2
+ logical :: isSameNode
+
+ isSameNode = associated(node1, node2)
+
+ end function isSameNode
+
+ !-----------------------------------------------------------
+
+ function insertBefore(node, newChild, refChild)
+ type(fnode), pointer :: insertBefore
+ type(fnode), pointer :: node
+ type(fnode), pointer :: newChild
+ type(fnode), pointer :: refChild
+ type(fnode), pointer :: np
+
+ if (.not. associated(node)) call dom_error("insertBefore",0,"Node not allocated")
+ if ((node%nodeType /= ELEMENT_NODE) .and. &
+ (node%nodeType /= DOCUMENT_NODE)) &
+ call dom_error("insertBefore",HIERARCHY_REQUEST_ERR, &
+ "cannot insert node here")
+
+ if (.not.associated(refChild)) then
+ insertBefore => appendChild(node, newChild)
+ RETURN
+ endif
+
+ np => node % firstChild
+ do while (associated(np))
+ if (associated(np, refChild)) then
+ if (associated(np,node%firstChild)) then
+ node%firstChild => newChild
+ else
+ refChild%previousSibling%nextSibling => newChild
+ endif
+
+ refChild % previousSibling => newChild
+ newChild % nextSibling => refChild
+ newChild % parentNode => node
+ newChild % ownerDocument => refChild % ownerDocument
+ insertBefore => newChild
+ RETURN
+ endif
+ np => np % nextSibling
+ enddo
+
+ call dom_error("insertBefore",NOT_FOUND_ERR,"refChild not found")
+
+ end function insertBefore
+
+!----------------------------------------------------------------------
+
+end module m_dom_node
+
Index: /XMLF90/src/dom/m_dom_nodelist.f90
===================================================================
--- /XMLF90/src/dom/m_dom_nodelist.f90 (revision 6)
+++ /XMLF90/src/dom/m_dom_nodelist.f90 (revision 6)
@@ -0,0 +1,89 @@
+module m_dom_nodelist
+
+use m_dom_types
+
+private
+
+public :: item
+public :: getLength
+public :: append
+
+interface append
+ module procedure append_nl
+end interface
+
+interface item
+ module procedure item_nl
+end interface
+
+interface getLength
+ module procedure getLength_nl
+end interface
+
+CONTAINS
+
+ !-----------------------------------------------------------
+ ! METHODS FOR NODELISTS
+ !-----------------------------------------------------------
+ function item_nl(nodeList, i)
+
+ integer, intent(in) :: i
+ type(fnodeList), pointer :: nodeList
+ type(fnode), pointer :: item_nl
+
+ type(flistNode), pointer :: lp
+ integer :: n
+
+ item_nl => null() ! In case there is no such item
+ if (.not. associated(nodeList)) RETURN
+
+ lp => nodeList%head
+ n = -1
+ do
+ if (.not. associated(lp)) exit
+ n = n + 1
+ if (n == i) then
+ item_nl => lp%node
+ exit
+ endif
+ lp => lp%next
+ enddo
+
+ end function item_nl
+
+ !-----------------------------------------------------------
+
+ function getLength_nl(nodeList)
+
+ type(fnodeList), pointer :: nodeList
+ integer :: getLength_nl
+
+ if (.not. associated(nodeList)) then
+ getLength_nl = 0
+ else
+ getLength_nl = nodeList % length
+ endif
+
+ end function getLength_nl
+
+ subroutine append_nl(nodeList,node)
+ type(fnodeList), pointer :: nodeList
+ type(fnode), pointer :: node
+
+ if (.not. associated(nodeList)) then
+ allocate(nodeList)
+ nodelist%length = 1
+ allocate(nodelist%head)
+ nodelist%head%node => node
+ nodelist%tail => nodelist%head
+ else
+ allocate(nodelist%tail%next)
+ nodelist%tail%next%node => node
+ nodelist%tail => nodelist%tail%next
+ nodelist%length = nodelist%length + 1
+ endif
+
+ end subroutine append_nl
+
+end module m_dom_nodelist
+
Index: /XMLF90/src/dom/m_dom_parse.f90
===================================================================
--- /XMLF90/src/dom/m_dom_parse.f90 (revision 6)
+++ /XMLF90/src/dom/m_dom_parse.f90 (revision 6)
@@ -0,0 +1,152 @@
+module m_dom_parse
+
+ use m_dom_types
+ use m_dom_element
+ use m_dom_document
+ use m_dom_node
+! use m_dom_namednodemap
+ use m_dom_debug
+
+ use flib_sax
+
+ implicit none
+
+ private
+
+ public :: parsefile
+
+ type(fnode), pointer, private, save :: main
+ type(fnode), pointer, private, save :: current
+
+
+CONTAINS
+
+ subroutine begin_element_handler(name,attrs)
+
+ character(len=*), intent(in) :: name
+ type(dictionary_t), intent(in) :: attrs
+
+ type(fnode), pointer :: temp
+ character(len=400) :: attr_name, attr_value
+ integer :: status
+ integer :: i
+
+ if (dom_debug) print *, "Adding node for element: ", name
+
+ temp => createElement(name)
+ current => appendChild(current,temp)
+!
+! Add attributes
+!
+ do i = 1, len(attrs)
+ call get_name(attrs, i, attr_name, status)
+ call get_value(attrs, attr_name, attr_value, status)
+ if (dom_debug) print *, "Adding attribute: ", &
+ trim(attr_name), ":",trim(attr_value)
+ call setAttribute(current,attr_name,attr_value)
+ enddo
+
+ end subroutine begin_element_handler
+
+!---------------------------------------------------------
+
+ subroutine end_element_handler(name)
+ character(len=*), intent(in) :: name
+
+!!AG for IBM type(fnode), pointer :: np
+
+ if (dom_debug) print *, "End of element: ", name
+!!AG for IBM np => getParentNode(current)
+!!AG for IBM current => np
+ current => getParentNode(current)
+ end subroutine end_element_handler
+
+!---------------------------------------------------------
+
+ subroutine pcdata_chunk_handler(chunk)
+ character(len=*), intent(in) :: chunk
+
+ type(fnode), pointer :: temp, dummy
+
+ if (dom_debug) print *, "Got PCDATA: |", chunk, "|"
+
+ temp => createTextNode(chunk)
+ dummy => appendChild(current,temp)
+
+ end subroutine pcdata_chunk_handler
+
+!---------------------------------------------------------
+
+ subroutine comment_handler(comment)
+ character(len=*), intent(in) :: comment
+
+ type(fnode), pointer :: temp, dummy
+
+ if (dom_debug) print *, "Got COMMENT: |", comment, "|"
+
+ temp => createComment(comment)
+ dummy => appendChild(current,temp)
+
+ end subroutine comment_handler
+!---------------------------------------------------------
+ subroutine cdata_section_handler(chunk)
+ character(len=*), intent(in) :: chunk
+
+ type(fnode), pointer :: temp, dummy
+
+ if (dom_debug) print *, "Got CDATA_SECTION: |", chunk, "|"
+
+ temp => createCdataSection(chunk)
+ dummy => appendChild(current,temp)
+
+ end subroutine cdata_section_handler
+
+!***************************************************
+! PUBLIC PROCEDURES
+!***************************************************
+
+
+ function parsefile(filename, verbose, sax_verbose)
+
+ character(len=*), intent(in) :: filename
+ logical, intent(in), optional :: verbose
+ logical, intent(in), optional :: sax_verbose
+
+ type(fnode), pointer :: parsefile
+
+ logical :: sax_debug = .false.
+
+ type(xml_t) :: fxml
+ integer :: iostat
+
+ if (present(verbose)) then
+ dom_debug = verbose
+ endif
+
+ if (present(sax_verbose)) then
+ sax_debug = sax_verbose
+ endif
+
+ call open_xmlfile(filename, fxml, iostat)
+
+ PRINT *,'filename : ',filename
+ if (iostat /= 0) then
+ stop "Cannot open file."
+ endif
+
+ main => createDocumentNode()
+ current => main
+
+ call xml_parse(fxml, &
+ begin_element_handler, end_element_handler, pcdata_chunk_handler, &
+ comment_handler, cdata_section_handler=cdata_section_handler, &
+ verbose = sax_debug)
+ call close_xmlfile(fxml)
+
+ parsefile => main
+ if (dom_debug) print *, "Number of allocated nodes: ", getNumberofAllocatedNodes()
+
+ end function parsefile
+
+
+END MODULE m_dom_parse
Index: /XMLF90/src/dom/m_dom_types.f90
===================================================================
--- /XMLF90/src/dom/m_dom_types.f90 (revision 6)
+++ /XMLF90/src/dom/m_dom_types.f90 (revision 6)
@@ -0,0 +1,195 @@
+Module m_dom_types
+
+ use m_strings
+
+ implicit none
+
+ private
+
+ !-------------------------------------------------------
+ ! A GENERIC NODE
+ !-------------------------------------------------------
+ type, public :: fnode
+ type(string) :: nodeName
+ type(string) :: nodeValue
+!!! character(len=200) :: nodeName = ""
+!!! character(len=200) :: nodeValue = ""
+ integer :: nc = 0
+ integer :: nodeType = 0
+ type(fnode), pointer :: parentNode => null()
+ type(fnodeList), pointer :: childNodes => null() ! New
+ type(fnode), pointer :: firstChild => null()
+ type(fnode), pointer :: lastChild => null()
+ type(fnode), pointer :: previousSibling => null()
+ type(fnode), pointer :: nextSibling => null()
+ type(fnode), pointer :: ownerDocument => null()
+ type(fnamedNodeMap), pointer :: attributes => null()
+ end type fnode
+
+ !-----------------------------------------------------------
+ ! ONE WAY TO IMPLEMENT A NAMEDNODEMAP (dictionary)
+ !-----------------------------------------------------------
+
+ ! Linked list of name/node pairs, with overall length variable
+
+ type, public :: fnamedNode
+ type(string) :: name
+!!! character(len=100) :: name
+ type(fnode), pointer :: node => null()
+ type(fnamedNode), pointer :: next => null()
+ end type fnamedNode
+
+ type, public :: fnamedNodeMap
+ integer :: length = 0
+ type(fnamedNode), pointer :: head => null()
+ type(fnamedNode), pointer :: tail => null()
+ end type fnamedNodeMap
+
+ !-----------------------------------------------------------
+ ! ONE WAY TO IMPLEMENT A NODELIST
+ !-----------------------------------------------------------
+
+ type, public :: flistNode
+ type(fnode), pointer :: node => null()
+ type(flistNode), pointer :: next => null()
+ end type flistNode
+
+ type, public :: fnodeList
+ integer :: length = 0
+ type(flistNode), pointer :: head => null()
+ type(flistNode), pointer :: tail => null()
+ end type fnodeList
+
+!========================================================================
+ integer, save, private :: allocated_nodes = 0
+!========================================================================
+
+ !-------------------------------------------------------
+ ! NODETYPES
+ !-------------------------------------------------------
+ integer, parameter, public :: ELEMENT_NODE = 1
+ integer, parameter, public :: ATTRIBUTE_NODE = 2
+ integer, parameter, public :: TEXT_NODE = 3
+ integer, parameter, public :: CDATA_SECTION_NODE = 4
+ integer, parameter, public :: ENTITY_REFERENCE_NODE = 5
+ integer, parameter, public :: ENTITY_NODE = 6
+ integer, parameter, public :: PROCESSING_INSTRUCTION_NODE = 7
+ integer, parameter, public :: COMMENT_NODE = 8
+ integer, parameter, public :: DOCUMENT_NODE = 9
+ integer, parameter, public :: DOCUMENT_TYPE_NODE = 10
+ integer, parameter, public :: DOCUMENT_FRAGMENT_NODE = 11
+ integer, parameter, public :: NOTATION_NODE = 12
+
+ public :: node_class
+ public :: createNode
+ public :: destroyNode
+ public :: destroyNamedNodeMap
+ public :: destroyNodeList
+ public :: getNumberofAllocatedNodes
+
+CONTAINS
+
+ function getNumberofAllocatedNodes() result(n)
+ integer :: n
+
+ n = allocated_nodes
+ end function getNumberofAllocatedNodes
+
+!--------------------------------------------------------------
+ function createNode() result(node)
+ type(fnode), pointer :: node
+
+ allocate(node)
+ allocated_nodes = allocated_nodes + 1
+
+ end function createNode
+!--------------------------------------------------------------
+
+ function node_class(nodetype) result(class)
+ integer, intent(in) :: nodetype
+ character(len=10) :: class
+
+ select case(nodetype)
+ case(ELEMENT_NODE)
+ class = "element"
+ case(ATTRIBUTE_NODE)
+ class = "attribute"
+ case(TEXT_NODE)
+ class = "text"
+ case(COMMENT_NODE)
+ class = "comment"
+ case(DOCUMENT_NODE)
+ class = "document"
+ end select
+ end function node_class
+
+ subroutine destroyNamedNodeMap(nodemap)
+ type(fnamedNodeMap), pointer :: nodemap
+
+ type(fnamednode), pointer :: nnp
+ type(fnode), pointer :: ghost
+
+ if (.not. associated(nodemap)) return
+ nnp => nodemap%head
+ do while (associated(nnp))
+ call unstring(nnp%name)
+ ghost => nnp%node
+ nnp => nnp%next
+ call destroyNode(ghost) ! We might not want to really destroy
+ enddo
+ end subroutine destroyNamedNodeMap
+
+ subroutine destroyNodeList(nodelist)
+ type(fnodeList), pointer :: nodelist
+
+ type(flistnode), pointer :: p
+ type(fnode), pointer :: ghost
+
+ if (.not. associated(nodelist)) return
+ p => nodelist%head
+ do while (associated(p))
+ ghost => p%node
+ p => p%next
+ call destroyNode(ghost) ! We might not want to really destroy
+ enddo
+ end subroutine destroyNodeList
+
+ recursive subroutine destroyNode(node)
+ type(fnode), pointer :: node
+
+ type(fnode), pointer :: np, ghost
+
+ np => node
+ do while (associated(np))
+ if (associated(np%firstChild)) then
+ call destroyNode(np%firstChild)
+ endif
+ if (associated(np%attributes)) call destroyNamedNodeMap(np%attributes)
+ call unstring(np%nodeName)
+ call unstring(np%nodeValue)
+ if (associated(np%previousSibling)) &
+ np%previousSibling%nextSibling => np%nextSibling
+ if (associated(np%nextSibling)) &
+ np%nextSibling%previousSibling => np%previousSibling
+ if (associated(np%parentNode)) then
+ if (associated(np%parentNode%firstChild,np)) &
+ np%parentNode%firstChild => null()
+ if (associated(np%parentNode%lastChild,np)) &
+ np%parentNode%lastChild => null()
+ endif
+ if (associated(np,node)) then
+ deallocate(np)
+ allocated_nodes = allocated_nodes - 1
+ EXIT ! do not destroy siblings
+ else
+ ghost => np
+ np => np%nextSibling
+ deallocate(ghost)
+ allocated_nodes = allocated_nodes - 1
+ endif
+ enddo
+ node => null() ! superfluous ?
+ end subroutine destroyNode
+
+end module m_dom_types
+
Index: /XMLF90/src/dom/m_dom_utils.f90
===================================================================
--- /XMLF90/src/dom/m_dom_utils.f90 (revision 6)
+++ /XMLF90/src/dom/m_dom_utils.f90 (revision 6)
@@ -0,0 +1,131 @@
+module m_dom_utils
+
+ use m_dom_types
+ use m_dom_element
+ use m_dom_document
+ use m_dom_node
+ use m_dom_namednodemap
+ use m_dom_debug
+ use m_strings
+
+ use flib_wxml
+
+ public :: dumpTree
+ public :: xmlize
+
+ private
+
+CONTAINS
+
+ subroutine dumpTree(startNode)
+
+ type(fnode), pointer :: startNode
+
+ character(len=50) :: indent = " "
+ integer :: indent_level
+ type(string) :: s
+
+ indent_level = 0
+
+ call dump2(startNode)
+
+ contains
+
+ recursive subroutine dump2(input)
+ type(fnode), pointer :: input
+ type(fnode), pointer :: temp
+ temp => input
+ do while(associated(temp))
+ s = getNodeName(temp)
+ write(*,'(3a,i3)') indent(1:indent_level), &
+ char(s), " of type ", &
+ getNodeType(temp)
+ if (hasChildNodes(temp)) then
+ indent_level = indent_level + 3
+ call dump2(getFirstChild(temp))
+ indent_level = indent_level - 3
+ endif
+ temp => getNextSibling(temp)
+ enddo
+
+ end subroutine dump2
+
+ end subroutine dumpTree
+!----------------------------------------------------------------
+
+ subroutine xmlize(startNode,fname)
+
+ type(fnode), pointer :: startNode
+ character(len=*), intent(in) :: fname
+
+ type(xmlf_t) :: xf
+ type(string) :: s, sv, sn ! to avoid memory leaks
+
+ call xml_OpenFile(fname,xf)
+ call dump_xml(startNode)
+ call xml_Close(xf)
+
+ contains
+
+ recursive subroutine dump_xml(input)
+ type(fnode), pointer :: input
+!
+! Just this node and its descendants, no siblings.
+! Of course, the document node has only children...
+!
+ type(fnode), pointer :: node, attr
+ type(fnamedNodeMap), pointer :: attr_map
+ integer :: i
+
+ node => input
+ do
+ if (.not. associated(node)) exit
+ select case (getNodeType(node))
+
+ case (DOCUMENT_NODE)
+
+ call xml_AddXMLDeclaration(xf)
+ if (hasChildNodes(node)) call dump_xml(getFirstChild(node))
+
+ case (ELEMENT_NODE)
+
+ s = getNodeName(node)
+ call xml_NewElement(xf,char(s))
+ attr_map => getAttributes(node)
+ do i = 0, getLength(attr_map) - 1
+ attr => item(attr_map,i)
+ sn = getNodeName(attr)
+ sv = getNodeValue(attr)
+ call xml_AddAttribute(xf, char(sn),char(sv))
+ enddo
+ if (hasChildNodes(node)) call dump_xml(getFirstChild(node))
+ s = getNodeName(node)
+ call xml_EndElement(xf,char(s))
+
+ case (TEXT_NODE)
+
+ s = getNodeValue(node)
+ call xml_AddPcdata(xf,char(s))
+
+ case (CDATA_SECTION_NODE)
+
+ s = getNodeValue(node)
+ call xml_AddCdataSection(xf,char(s))
+
+ case (COMMENT_NODE)
+
+ s = getNodeValue(node)
+ call xml_AddComment(xf,char(s))
+
+ end select
+ if (associated(node,StartNode)) exit ! In case we request the
+ ! dumping of a single element,
+ ! do not do siblings
+ node => getNextSibling(node)
+ enddo
+
+ end subroutine dump_xml
+
+ end subroutine xmlize
+
+end module m_dom_utils
Index: /XMLF90/src/sax/CHANGES
===================================================================
--- /XMLF90/src/sax/CHANGES (revision 6)
+++ /XMLF90/src/sax/CHANGES (revision 6)
@@ -0,0 +1,28 @@
+April 28, 2004
+
+* New optional argument "record_size" in open_xmlfile. The default record
+length is 65536, but for overly long lines it might be necessary to specify
+a larger size.
+
+* Wrote "init_" routines to avoid undefined status for the components
+of the buffer, dictionary, and elstack derived types (Fortran90 restriction).
+They are called just once at the beginning of execution.
+
+The "reset_" routines just zero out the counters in the derived
+types. This leads to substantial savings in overhead.
+
+* Avoided when possible the allocation of temporaries (mostly strings) by
+the compilers. This was particularly acute in the "action" records. The
+typical idiom:
+
+ action =trim("Reading character in name: " // c)
+
+forced the allocation of a temporary. The number of compiler allocations
+(at least with NAG) has dropped down to just those needed in the processing
+of entities.
+
+* Put the explicit module dependencies in the makefile.
+
+* Increased the standard size of the buffers and dictionaries.
+***** The program now stops when those sizes are not enough.
+
Index: /XMLF90/src/sax/Developer.Guide
===================================================================
--- /XMLF90/src/sax/Developer.Guide (revision 6)
+++ /XMLF90/src/sax/Developer.Guide (revision 6)
@@ -0,0 +1,61 @@
+Developer Notes:
+
+The parser is built on several levels:
+
+1. The closest to the user.
+
+ Modules: m_xml_parser: The main module
+ m_error : Basic error handling
+
+2. An intermediate layer.
+
+ Modules: m_fsm (A finite-state machine to parse the input)
+
+3. A layer defining basic data structures and file interfaces:
+
+ Modules: m_reader: File interface and character handling as per XML specs.
+ m_buffer: Basic homemade "variable length string", with some
+ limitations (size, of course), but avoiding the
+ use of dynamic structures for now.
+ m_dictionary: Simple, not dynamic.
+ m_charset: A simple hashing method for sets of characters.
+ m_elstack: Simple stack to check well-formedness.
+ m_entities: Entity replacement utilities.
+
+4. Something which does not really belong in the parser but which
+ is useful to massage the data extracted from the file:
+
+ m_converters: Routines to turn pcdata chunks into numerical arrays
+
+
+There are obviously a number of hardwired limitations, which should be
+removed in a later version:
+
+* Buffer size in buffer_t definition. This is not as serious as it
+ looks. Only long unbroken pcdata sections and overly long attribute
+ names or values will be affected. Long SGML declarations and comments
+ might be truncated, but they are not relevant anyway.
+
+* Maximum number of attributes in an element tag (set in m_dictionary)
+
+While the parser does not use any variable-length strings (to keep it
+compatible with existing Fortran90 compilers) or dynamical data
+structures for attribute dictionaries, etc, such improvements could be
+incorporated almost as drop-in replacements for existing sub-modules.
+
+
+The coding style is that of the F subset of Fortran90. I strongly
+believe that it makes for better coding and fewer errors.
+Go to http://www.fortran.com/imagine1/ and get a feel for it. You can
+download free implementations for Linux and Windows, or get an
+inexpensive CD+Book combination to help support the project. Of course,
+F *is* Fortran, so you can always compile it with a Fortran compiler.
+
+
+
+
+
+
+
+
+
Index: /XMLF90/src/sax/TODO
===================================================================
--- /XMLF90/src/sax/TODO (revision 6)
+++ /XMLF90/src/sax/TODO (revision 6)
@@ -0,0 +1,7 @@
+Things to do:
+
+* Make buffer pseudo-dynamical to avoid limitations.
+* Insert code to deal with XML declarations (really processing instructions)
+ which are not of the form
+
+
Index: /XMLF90/src/sax/flib_sax.f90
===================================================================
--- /XMLF90/src/sax/flib_sax.f90 (revision 6)
+++ /XMLF90/src/sax/flib_sax.f90 (revision 6)
@@ -0,0 +1,19 @@
+module flib_sax
+
+!
+! Stub module to gather all the functionality needed by the user
+!
+! In future m_dictionary and m_converters could be exported by
+! other parts of a more general fortran library.
+!
+! m_xml_error is necessary in order to use a custom error handler.
+!
+use m_dictionary
+use m_xml_parser
+use m_converters
+use m_xml_error
+
+public
+
+end module flib_sax
+
Index: /XMLF90/src/sax/m_buffer.f90
===================================================================
--- /XMLF90/src/sax/m_buffer.f90 (revision 6)
+++ /XMLF90/src/sax/m_buffer.f90 (revision 6)
@@ -0,0 +1,200 @@
+module m_buffer
+
+!
+! At this point we use a fixed-size buffer.
+! Note however that buffer overflows will only be
+! triggered by overly long *unbroken* pcdata values, or
+! by overly long attribute values. Hopefully
+! element or attribute names are "short enough".
+! There is code in m_fsm to avoid buffer overflows
+! caused by pcdata with whitespace.
+!
+! In a forthcoming implementation it could be made dynamical...
+!
+integer, parameter, public :: MAX_BUFF_SIZE = 10000
+integer, parameter, private :: BUFF_SIZE_WARNING = 900
+
+!
+
+type, public :: buffer_t
+private
+ integer :: size
+ character(len=MAX_BUFF_SIZE) :: str
+end type buffer_t
+
+public :: add_to_buffer
+public :: print_buffer, str, len !! , char
+public :: operator (.equal.)
+public :: buffer_nearly_full, reset_buffer, init_buffer
+public :: buffer_to_character
+
+
+!----------------------------------------------------------------
+interface add_to_buffer
+ module procedure add_str_to_buffer
+end interface
+private :: add_char_to_buffer, add_str_to_buffer
+
+interface operator (.equal.)
+ module procedure compare_buffers, compare_buffer_str, &
+ compare_str_buffer
+end interface
+private :: compare_buffers, compare_buffer_str, compare_str_buffer
+
+interface str
+ module procedure buffer_to_str
+end interface
+interface char ! Experimental
+ module procedure buffer_to_str
+end interface
+private :: buffer_to_str
+
+interface len
+ module procedure buffer_length
+end interface
+private :: buffer_length
+
+CONTAINS
+!==================================================================
+
+!----------------------------------------------------------------
+function compare_buffers(a,b) result(equal) ! .equal. generic
+type(buffer_t), intent(in) :: a
+type(buffer_t), intent(in) :: b
+logical :: equal
+
+equal = ((a%size == b%size) .and. (a%str(1:a%size) == b%str(1:b%size)))
+
+end function compare_buffers
+
+!----------------------------------------------------------------
+function compare_buffer_str(buffer,str) result(equal) ! .equal. generic
+type(buffer_t), intent(in) :: buffer
+character(len=*), intent(in) :: str
+logical :: equal
+
+equal = (buffer%str(1:buffer%size) == trim(str))
+
+end function compare_buffer_str
+
+!----------------------------------------------------------------
+function compare_str_buffer(str,buffer) result(equal) ! .equal. generic
+character(len=*), intent(in) :: str
+type(buffer_t), intent(in) :: buffer
+logical :: equal
+
+equal = (buffer%str(1:buffer%size) == trim(str))
+
+end function compare_str_buffer
+
+!----------------------------------------------------------------
+subroutine add_char_to_buffer(c,buffer)
+character(len=1), intent(in) :: c
+type(buffer_t), intent(inout) :: buffer
+
+integer :: n
+buffer%size = buffer%size + 1
+n = buffer%size
+
+if (n> MAX_BUFF_SIZE) then
+!! RETURN
+!
+! It will only affect long comments and sgml declarations
+ STOP "sax 1 Buffer overflow: long unbroken string of pcdata or attribute value..."
+endif
+
+buffer%str(n:n) = c
+end subroutine add_char_to_buffer
+
+!----------------------------------------------------------------
+subroutine add_str_to_buffer(s,buffer)
+character(len=*), intent(in) :: s
+type(buffer_t), intent(inout) :: buffer
+
+integer :: n, len_s, last_pos
+
+len_s = len(s)
+last_pos = buffer%size
+buffer%size = buffer%size + len_s
+n = buffer%size
+
+if (n> MAX_BUFF_SIZE) then
+!! RETURN
+!
+! It will only affect long comments and sgml declarations
+ STOP "sax 2 Buffer overflow: long unbroken string of pcdata or attribute value..."
+endif
+
+buffer%str(last_pos+1:n) = s
+end subroutine add_str_to_buffer
+
+!----------------------------------------------------------------
+subroutine init_buffer(buffer)
+type(buffer_t), intent(inout) :: buffer
+
+buffer%size = 0
+buffer%str="" ! To avoid "undefined" status
+
+end subroutine init_buffer
+!----------------------------------------------------------------
+subroutine reset_buffer(buffer)
+type(buffer_t), intent(inout) :: buffer
+ buffer%size = 0
+end subroutine reset_buffer
+!----------------------------------------------------------------
+subroutine print_buffer(buffer)
+type(buffer_t), intent(in) :: buffer
+
+integer :: i
+
+do i = 1, buffer%size
+ write(unit=6,fmt="(a1)",advance="no") buffer%str(i:i)
+enddo
+
+end subroutine print_buffer
+!----------------------------------------------------------------
+! This is better... but could it lead to memory leaks?
+!
+function buffer_to_str(buffer) result(str)
+type(buffer_t), intent(in) :: buffer
+character(len=buffer%size) :: str
+
+str = buffer%str(1:buffer%size)
+end function buffer_to_str
+
+!----------------------------------------------------------------
+!
+subroutine buffer_to_character(buffer,str)
+type(buffer_t), intent(in) :: buffer
+character(len=*), intent(out) :: str
+
+str = buffer%str(1:buffer%size)
+end subroutine buffer_to_character
+
+!----------------------------------------------------------------
+function buffer_nearly_full(buffer) result(warn)
+type(buffer_t), intent(in) :: buffer
+logical :: warn
+
+warn = buffer%size > BUFF_SIZE_WARNING
+
+end function buffer_nearly_full
+
+!----------------------------------------------------------------
+function buffer_length(buffer) result(length)
+type(buffer_t), intent(in) :: buffer
+integer :: length
+
+length = buffer%size
+
+end function buffer_length
+
+
+end module m_buffer
+
+
+
+
+
+
+
Index: /XMLF90/src/sax/m_charset.f90
===================================================================
--- /XMLF90/src/sax/m_charset.f90 (revision 6)
+++ /XMLF90/src/sax/m_charset.f90 (revision 6)
@@ -0,0 +1,203 @@
+module m_charset
+!
+! One-byte only, sorry
+!
+private
+
+integer, parameter, private :: small_int = selected_int_kind(1)
+
+!--------------------------------------------------------------------------
+type, public :: charset_t
+! private
+ integer(kind=small_int), dimension(0:255) :: mask
+end type charset_t
+
+
+public :: operator(.in.), operator(+)
+public :: assignment(=)
+public :: print_charset, reset_charset
+
+interface operator(.in.)
+ module procedure belongs
+end interface
+private :: belongs
+
+interface assignment(=)
+ module procedure set_string_to_charset, set_codes_to_charset
+end interface
+private :: set_string_to_charset, set_codes_to_charset
+
+interface operator(+)
+ module procedure add_string_to_charset, &
+ add_code_to_charset, add_codes_to_charset
+end interface
+private :: add_string_to_charset, add_code_to_charset, add_codes_to_charset
+
+!--------------------------------------------------------------------------
+
+character(len=*), parameter, private :: &
+ lowercase = "abcdefghijklmnopqrstuvwxyz", &
+ uppercase = "ABCDEFGHIJKLMNOPQRSTUVWXYZ", &
+ digits = "0123456789"
+
+integer, parameter, public :: SPACE = 32
+integer, parameter, public :: NEWLINE = 10
+integer, parameter, public :: CARRIAGE_RETURN = 13
+integer, parameter, public :: TAB = 9
+
+type(charset_t), public :: initial_name_chars
+type(charset_t), public :: name_chars
+type(charset_t), public :: whitespace
+type(charset_t), public :: valid_chars
+type(charset_t), public :: uppercase_chars
+
+public :: setup_xml_charsets
+
+
+CONTAINS !==========================================================
+
+!--------------------------------------------------------------
+function belongs(c,charset) result(res)
+character(len=1), intent(in) :: c
+type(charset_t), intent(in) :: charset
+logical :: res
+
+integer :: code
+
+code = ichar(c)
+res = (charset%mask(code) == 1)
+
+end function belongs
+
+!--------------------------------------------------------------
+
+function add_string_to_charset(charset,str) result (sum)
+type(charset_t), intent(in) :: charset
+character(len=*), intent(in) :: str
+type(charset_t) :: sum
+
+integer :: length, code, i
+
+sum%mask = charset%mask
+
+length = len_trim(str)
+do i = 1, length
+ code = ichar(str(i:i))
+ sum%mask(code) = 1
+enddo
+end function add_string_to_charset
+
+!--------------------------------------------------------------
+
+function add_code_to_charset(charset,code) result(sum)
+type(charset_t), intent(in) :: charset
+integer, intent(in) :: code
+type(charset_t) :: sum
+
+if ((code > 255) .or. (code < 0)) return
+sum%mask = charset%mask
+sum%mask(code) = 1
+
+end function add_code_to_charset
+
+!--------------------------------------------------------------
+function add_codes_to_charset(charset,codes) result(sum)
+type(charset_t), intent(in) :: charset
+integer, dimension(:), intent(in) :: codes
+type(charset_t) :: sum
+
+integer :: i
+
+sum%mask = charset%mask
+do i = 1, size(codes)
+ if ((codes(i) > 255) .or. (codes(i) < 0)) cycle
+ sum%mask(codes(i)) = 1
+enddo
+end function add_codes_to_charset
+
+!--------------------------------------------------------------
+
+subroutine set_string_to_charset(charset,str)
+type(charset_t), intent(out) :: charset
+character(len=*), intent(in) :: str
+
+
+integer :: length, code, i
+
+charset%mask = 0
+
+length = len_trim(str)
+do i = 1, length
+ code = ichar(str(i:i))
+ charset%mask(code) = 1
+enddo
+
+end subroutine set_string_to_charset
+
+!--------------------------------------------------------------
+
+subroutine set_codes_to_charset(charset,codes)
+type(charset_t), intent(out) :: charset
+integer, dimension(:), intent(in) :: codes
+
+integer :: i
+
+charset%mask = 0
+
+do i = 1, size(codes)
+ charset%mask(codes(i)) = 1
+enddo
+
+end subroutine set_codes_to_charset
+
+
+!--------------------------------------------------------------
+subroutine print_charset(charset)
+type(charset_t), intent(in) :: charset
+
+integer :: i
+
+do i = 0, 255
+ if (charset%mask(i) == 1) print *, "Code: ", i
+enddo
+end subroutine print_charset
+
+!--------------------------------------------------------------
+
+subroutine reset_charset(charset)
+type(charset_t), intent(inout) :: charset
+
+integer :: i
+
+do i = 0, 255
+ charset%mask(i) = 0
+enddo
+end subroutine reset_charset
+
+!--------------------------------------------------------------
+
+!--------------------------------------------------------
+subroutine setup_xml_charsets()
+
+integer :: i
+
+uppercase_chars = uppercase
+initial_name_chars = (lowercase // uppercase // "_:" )
+name_chars = initial_name_chars + ( digits // ".-")
+whitespace = (/ SPACE, NEWLINE, TAB, CARRIAGE_RETURN /)
+
+valid_chars = whitespace + (/ (i, i=33,255) /)
+
+end subroutine setup_xml_charsets
+!--------------------------------------------------------
+
+end module m_charset
+
+
+
+
+
+
+
+
+
Index: /XMLF90/src/sax/m_converters.f90
===================================================================
--- /XMLF90/src/sax/m_converters.f90 (revision 6)
+++ /XMLF90/src/sax/m_converters.f90 (revision 6)
@@ -0,0 +1,180 @@
+module m_converters
+
+use m_debug
+
+private
+!
+! Takes a string and turns it into useful data structures,
+! such as numerical arrays.
+!
+! NOTE: The string must contain *homogeneous* data, i.e.: all real numbers,
+! all integers, etc.
+!
+public :: build_data_array
+
+interface build_data_array
+ module procedure build_data_array_real_sp, &
+ build_data_array_real_dp, &
+ build_data_array_integer
+end interface
+private :: build_data_array_real_sp
+private :: build_data_array_real_dp
+private :: build_data_array_integer
+
+private :: token_analysis, is_separator, is_CR_or_LF
+
+CONTAINS
+
+!---------------------------------------------------------------
+subroutine build_data_array_real_dp(str,x,n)
+integer, parameter :: dp = selected_real_kind(14)
+!
+character(len=*), intent(in) :: str
+real(kind=dp), dimension(:), intent(inout) :: x
+integer, intent(inout) :: n
+
+integer :: ntokens, status, last_pos
+character(len=len(str)) :: s
+
+s = str
+call token_analysis(s,ntokens,last_pos)
+if (debug) print *, "ntokens, last_pos ", ntokens, last_pos
+if (debug) print *, s
+if ((n + ntokens) > size(x)) STOP "data array full"
+read(unit=s(1:last_pos),fmt=*,iostat=status) x(n+1:n+ntokens)
+if (status /= 0) STOP "real conversion error"
+n = n + ntokens
+
+end subroutine build_data_array_real_dp
+!---------------------------------------------------------------
+
+subroutine build_data_array_real_sp(str,x,n)
+integer, parameter :: sp = selected_real_kind(6)
+!
+character(len=*), intent(in) :: str
+real(kind=sp), dimension(:), intent(inout) :: x
+integer, intent(inout) :: n
+
+integer :: ntokens, status, last_pos
+character(len=len(str)) :: s
+
+s = str
+call token_analysis(s,ntokens,last_pos)
+if (debug) print *, "ntokens, last_pos ", ntokens, last_pos
+if (debug) print *, s
+if ((n + ntokens) > size(x)) STOP "data array full"
+read(unit=s(1:last_pos),fmt=*,iostat=status) x(n+1:n+ntokens)
+if (status /= 0) STOP "real conversion error"
+n = n + ntokens
+
+end subroutine build_data_array_real_sp
+
+!---------------------------------------------------------------
+subroutine build_data_array_integer(str,x,n)
+integer, parameter :: sp = selected_real_kind(14)
+!
+character(len=*), intent(in) :: str
+integer, dimension(:), intent(inout) :: x
+integer, intent(inout) :: n
+
+integer :: ntokens, status, last_pos
+character(len=len(str)) :: s
+
+s = str
+call token_analysis(s,ntokens,last_pos)
+if (debug) print *, "ntokens, last_pos ", ntokens, last_pos
+if (debug) print *, s
+if ((n + ntokens) > size(x)) STOP "data array full"
+read(unit=s(1:last_pos),fmt=*,iostat=status) x(n+1:n+ntokens)
+if (status /= 0) STOP "integer conversion error"
+n = n + ntokens
+
+end subroutine build_data_array_integer
+
+
+!==================================================================
+
+function is_separator(c) result(sep)
+character(len=1), intent(in) :: c
+logical :: sep
+
+ sep = ((c == char(32)) .or. (c == char(10)) &
+ .or. (c == char(9)) .or. (c == char(13)))
+
+end function is_separator
+!----------------------------------------------------------------
+function is_CR_or_LF(c) result(res)
+character(len=1), intent(in) :: c
+logical :: res
+
+ res = ((c == char(10)) .or. (c == char(13)))
+
+end function is_CR_or_LF
+
+!==================================================================
+
+subroutine token_analysis(str,ntokens,last_pos)
+!
+character(len=*), intent(inout) :: str
+integer, intent(out) :: ntokens, last_pos
+!
+!
+! Checks the contents of a string and finds the number of tokens it contains
+! The standard separator is generalized whitespace (space, tab, CR, or LF)
+! It also returns the last useful position in the string (excluding
+! separator characters which are not blanks, and thus not caught by the
+! (len_)trim fortran intrinsic). This is necessary to perform list-directed
+! I/O in the string as an internal file.
+!
+! Also, replace on the fly CR and LF by blanks. This is necessary if
+! str spans more than one record. In that case, internal reads only
+! look at the first record.
+! -- ** Compiler limits on size of internal record??
+!
+integer :: i, str_length
+logical :: in_token
+character(len=1) :: c
+
+in_token = .false.
+ntokens = 0
+last_pos = 0
+
+str_length = len_trim(str)
+!print *, "string length: ", str_length
+
+do i = 1, str_length
+ c = str(i:i)
+
+ if (in_token) then
+ if (is_separator(c)) then
+ in_token = .false.
+ if (is_CR_or_LF(c)) str(i:i) = " "
+ else
+ last_pos = i
+ endif
+
+ else ! not in token
+
+ if (is_separator(c)) then
+ if (is_CR_or_LF(c)) str(i:i) = " "
+ ! do nothing
+ else
+ in_token = .true.
+ last_pos = i
+ ntokens = ntokens + 1
+ endif
+ endif
+enddo
+!print *, "ntokens, last_pos: ", ntokens, last_pos
+
+end subroutine token_analysis
+
+
+end module m_converters
+
+
+
+
+
+
+
Index: /XMLF90/src/sax/m_debug.f90
===================================================================
--- /XMLF90/src/sax/m_debug.f90 (revision 6)
+++ /XMLF90/src/sax/m_debug.f90 (revision 6)
@@ -0,0 +1,5 @@
+module m_debug
+
+logical, public, save :: debug = .false.
+
+end module m_debug
Index: /XMLF90/src/sax/m_dictionary.f90
===================================================================
--- /XMLF90/src/sax/m_dictionary.f90 (revision 6)
+++ /XMLF90/src/sax/m_dictionary.f90 (revision 6)
@@ -0,0 +1,183 @@
+module m_dictionary
+
+use m_buffer
+private
+!
+! A very rough implementation for now
+! It uses fixed-length buffers for key/value pairs,
+! and the maximum number of dictionary items is hardwired.
+
+integer, parameter, private :: MAX_ITEMS = 64
+type, public :: dictionary_t
+private
+ integer :: number_of_items
+ type(buffer_t), dimension(MAX_ITEMS) :: key
+ type(buffer_t), dimension(MAX_ITEMS) :: value
+end type dictionary_t
+
+!
+! Building procedures
+!
+public :: add_key_to_dict, add_value_to_dict, init_dict, reset_dict
+
+!
+! Query and extraction procedures
+!
+public :: len
+interface len
+ module procedure number_of_entries
+end interface
+public :: number_of_entries
+public :: get_key
+public :: get_value
+public :: has_key
+public :: print_dict
+!
+public :: get_name
+
+interface get_name
+ module procedure get_key
+end interface
+
+interface get_value
+ module procedure sax_get_value
+end interface
+private :: sax_get_value
+
+CONTAINS
+
+!------------------------------------------------------
+function number_of_entries(dict) result(n)
+type(dictionary_t), intent(in) :: dict
+integer :: n
+
+n = dict%number_of_items
+
+end function number_of_entries
+
+!------------------------------------------------------
+function has_key(dict,key) result(found)
+type(dictionary_t), intent(in) :: dict
+character(len=*), intent(in) :: key
+logical :: found
+
+integer :: n, i
+found = .false.
+n = dict%number_of_items
+do i = 1, n
+ if (dict%key(i) .EQUAL. key) then
+ found = .true.
+ exit
+ endif
+enddo
+end function has_key
+
+!------------------------------------------------------
+subroutine sax_get_value(dict,key,value,status)
+type(dictionary_t), intent(in) :: dict
+character(len=*), intent(in) :: key
+character(len=*), intent(out) :: value
+integer, intent(out) :: status
+!
+integer :: n, i
+
+status = -1
+n = dict%number_of_items
+do i = 1, n
+ if (dict%key(i) .EQUAL. key) then
+ value = str(dict%value(i))
+ status = 0
+ RETURN
+ endif
+enddo
+
+end subroutine sax_get_value
+
+!------------------------------------------------------
+subroutine get_key(dict,i,key,status)
+!
+! Get the i'th key
+!
+type(dictionary_t), intent(in) :: dict
+integer, intent(in) :: i
+character(len=*), intent(out) :: key
+integer, intent(out) :: status
+
+if (i <= dict%number_of_items) then
+ key = str(dict%key(i))
+ status = 0
+else
+ key = ""
+ status = -1
+endif
+
+end subroutine get_key
+
+!------------------------------------------------------
+subroutine add_key_to_dict(key,dict)
+type(buffer_t), intent(in) :: key
+type(dictionary_t), intent(inout) :: dict
+
+integer :: n
+
+n = dict%number_of_items
+if (n == MAX_ITEMS) then
+ write(unit=0,fmt=*) "Dictionary capacity exceeded ! size= ", max_items
+ RETURN
+endif
+
+n = n + 1
+dict%key(n) = key
+dict%number_of_items = n
+
+end subroutine add_key_to_dict
+
+!------------------------------------------------------
+! Assumes we build the dictionary in an orderly fashion,
+! so one adds first the key and then immediately afterwards the value.
+!
+subroutine add_value_to_dict(value,dict)
+type(buffer_t), intent(in) :: value
+type(dictionary_t), intent(inout) :: dict
+
+integer :: n
+
+n = dict%number_of_items
+dict%value(n) = value
+
+end subroutine add_value_to_dict
+
+!------------------------------------------------------
+subroutine init_dict(dict)
+type(dictionary_t), intent(inout) :: dict
+
+integer :: i
+
+dict%number_of_items = 0
+do i=1, MAX_ITEMS ! To avoid "undefined" status
+ call init_buffer(dict%key(i)) ! (Fortran90 restriction)
+ call init_buffer(dict%value(i))
+enddo
+end subroutine init_dict
+!------------------------------------------------------
+subroutine reset_dict(dict)
+type(dictionary_t), intent(inout) :: dict
+
+dict%number_of_items = 0
+
+end subroutine reset_dict
+
+!------------------------------------------------------
+subroutine print_dict(dict)
+type(dictionary_t), intent(in) :: dict
+
+integer :: i
+
+do i = 1, dict%number_of_items
+ print *, trim(str(dict%key(i))), " = ", trim(str(dict%value(i)))
+enddo
+
+end subroutine print_dict
+
+
+end module m_dictionary
Index: /XMLF90/src/sax/m_elstack.f90
===================================================================
--- /XMLF90/src/sax/m_elstack.f90 (revision 6)
+++ /XMLF90/src/sax/m_elstack.f90 (revision 6)
@@ -0,0 +1,153 @@
+module m_elstack
+
+use m_buffer
+
+private
+
+!
+! Simple stack to keep track of which elements have appeared so far
+!
+integer, parameter, private :: STACK_SIZE = 40
+
+type, public :: elstack_t
+private
+ integer :: n_items
+ type(buffer_t), dimension(STACK_SIZE) :: data
+end type elstack_t
+
+public :: push_elstack, pop_elstack, reset_elstack, print_elstack
+public :: init_elstack
+public :: get_top_elstack, is_empty, get_elstack_signature
+
+interface is_empty
+ module procedure is_empty_elstack
+end interface
+private :: is_empty_elstack
+
+CONTAINS
+
+!-----------------------------------------------------------------
+subroutine init_elstack(elstack)
+type(elstack_t), intent(inout) :: elstack
+
+integer :: i
+
+elstack%n_items = 0
+do i = 1, STACK_SIZE ! to avoid "undefined status"
+ call init_buffer(elstack%data(i))
+enddo
+end subroutine init_elstack
+
+!-----------------------------------------------------------------
+subroutine reset_elstack(elstack)
+type(elstack_t), intent(inout) :: elstack
+
+integer :: i
+
+elstack%n_items = 0
+do i = 1, STACK_SIZE
+ call reset_buffer(elstack%data(i))
+enddo
+end subroutine reset_elstack
+
+!-----------------------------------------------------------------
+function is_empty_elstack(elstack) result(answer)
+type(elstack_t), intent(in) :: elstack
+logical :: answer
+
+answer = (elstack%n_items == 0)
+end function is_empty_elstack
+
+!-----------------------------------------------------------------
+subroutine push_elstack(item,elstack)
+type(buffer_t), intent(in) :: item
+type(elstack_t), intent(inout) :: elstack
+
+integer :: n
+
+n = elstack%n_items
+if (n == STACK_SIZE) then
+ stop "*Element stack full"
+endif
+n = n + 1
+elstack%data(n) = item
+elstack%n_items = n
+
+end subroutine push_elstack
+
+!-----------------------------------------------------------------
+subroutine pop_elstack(elstack,item)
+type(elstack_t), intent(inout) :: elstack
+type(buffer_t), intent(out) :: item
+
+!
+! We assume the elstack is not empty... (the user has called is_empty first)
+!
+integer :: n
+
+n = elstack%n_items
+if (n == 0) then
+ stop "*********Element stack empty"
+endif
+item = elstack%data(n)
+elstack%n_items = n - 1
+
+end subroutine pop_elstack
+
+!-----------------------------------------------------------------
+subroutine get_top_elstack(elstack,item)
+!
+! Get the top element of the stack, *without popping it*.
+!
+type(elstack_t), intent(in) :: elstack
+type(buffer_t), intent(out) :: item
+
+!
+! We assume the elstack is not empty... (the user has called is_empty first)
+!
+integer :: n
+
+n = elstack%n_items
+if (n == 0) then
+ stop "*********Element stack empty"
+endif
+item = elstack%data(n)
+
+end subroutine get_top_elstack
+
+!-----------------------------------------------------------------
+subroutine print_elstack(elstack,unit)
+type(elstack_t), intent(in) :: elstack
+integer, intent(in) :: unit
+integer :: i
+
+do i = elstack%n_items, 1, -1
+ write(unit=unit,fmt=*) str(elstack%data(i))
+enddo
+
+end subroutine print_elstack
+
+!-------------------------------------------------------------
+subroutine get_elstack_signature(elstack,string)
+type(elstack_t), intent(in) :: elstack
+character(len=*), intent(out) :: string
+integer :: i, length, j
+
+string = ""
+j = 0
+do i = 1, elstack%n_items
+ length = len(elstack%data(i))
+ string(j+1:j+1) = "/"
+ j = j+1
+ string(j+1:j+length) = str(elstack%data(i))
+ j = j + length
+enddo
+
+end subroutine get_elstack_signature
+
+end module m_elstack
+
+
+
+
+
Index: /XMLF90/src/sax/m_entities.f90
===================================================================
--- /XMLF90/src/sax/m_entities.f90 (revision 6)
+++ /XMLF90/src/sax/m_entities.f90 (revision 6)
@@ -0,0 +1,134 @@
+module m_entities
+!
+! Entity management
+!
+! It deals with:
+! 1. The five standard entities (gt,lt,amp,apos,quot)
+! 2. Character entities (but only within the range of the char intrinsic)
+!
+use m_buffer
+private
+
+integer, parameter, private :: MAX_REPLACEMENT_SIZE = 200
+!
+type, private :: entity_t
+ character(len=40) :: code
+ character(len=MAX_REPLACEMENT_SIZE) :: replacement
+end type entity_t
+
+integer, parameter, private :: N_ENTITIES = 5
+
+type(entity_t), private, dimension(N_ENTITIES), save :: predefined_ent = &
+ (/ &
+ entity_t("gt",">"), &
+ entity_t("lt","<"), &
+ entity_t("amp","&"), &
+ entity_t("apos","'"), &
+ entity_t("quot","""") &
+ /)
+
+public :: code_to_str , entity_filter
+
+CONTAINS
+
+subroutine code_to_str(code,str,status)
+character(len=*), intent(in) :: code
+character(len=*), intent(out) :: str
+integer, intent(out) :: status
+integer :: i
+
+integer :: number, ll
+character(len=4) :: fmtstr
+
+status = -1
+do i = 1, N_ENTITIES
+ if (code == predefined_ent(i)%code) then
+ str = predefined_ent(i)%replacement
+ status = 0
+ return
+ endif
+enddo
+!
+! Replace character references (but only within the range of the
+! char intrinsic !!)
+!
+if (code(1:1) == "#") then
+ if (code(2:2) == "x") then ! hex character reference
+ ll = len_trim(code(3:))
+ write(unit=fmtstr,fmt="(a2,i1,a1)") "(Z", ll,")"
+ read(unit=code(3:),fmt=fmtstr) number
+ str = char(number)
+ status = 0
+ return
+ else ! decimal character reference
+ read(unit=code(2:),fmt=*) number
+ str = char(number)
+ status = 0
+ return
+ endif
+endif
+
+end subroutine code_to_str
+
+!----------------------------------------------------------------
+!
+! Replaces entity references in buf1 and creates a new buffer buf2.
+!
+subroutine entity_filter(buf1,buf2,status,message)
+type(buffer_t), intent(in) :: buf1
+type(buffer_t), intent(out) :: buf2
+integer, intent(out) :: status
+character(len=*), intent(out) :: message
+!
+! Replaces entity references by their value
+!
+integer :: i, k, len1
+character(len=MAX_BUFF_SIZE) :: s1
+character(len=1) :: c
+character(len=MAX_REPLACEMENT_SIZE) :: repl
+
+call buffer_to_character(buf1,s1) !! Avoid allocation of temporary
+len1 = len(buf1)
+
+i = 1
+status = 0
+
+call reset_buffer(buf2)
+
+do
+ if (i > len1) exit
+ c = s1(i:i)
+ if (c == "&") then
+ if (i+1 > len1) then
+ status = -i
+ message= " Unmatched & in entity reference"
+ return
+ endif
+ k = index(s1(i+1:),";")
+ if (k == 0) then
+ status = -i
+ message= " Unmatched & in entity reference"
+ return
+ endif
+ call code_to_str(s1(i+1:i+k-1),repl,status)
+ if (status /= 0) then
+ status = i ! Could let it continue
+ message= "Ignored unknown entity: &" // s1(i+1:i+k-1) // ";"
+ else
+ call add_to_buffer(trim(repl),buf2)
+ endif
+ i = i + k + 1
+ else
+ call add_to_buffer(c,buf2)
+ i = i + 1
+ endif
+enddo
+
+end subroutine entity_filter
+
+end module m_entities
+
+
+
+
+
Index: /XMLF90/src/sax/m_fsm.f90
===================================================================
--- /XMLF90/src/sax/m_fsm.f90 (revision 6)
+++ /XMLF90/src/sax/m_fsm.f90 (revision 6)
@@ -0,0 +1,745 @@
+module m_fsm
+!
+use m_buffer
+use m_dictionary
+use m_charset
+use m_entities
+use m_elstack
+
+private
+
+type, public :: fsm_t
+ !
+ ! Contains information about the "finite state machine"
+ ! Some of the components (marked *) could at this point be made into
+ ! saved module variables.
+ !
+ !
+ integer :: state
+ integer :: context
+ integer :: nbrackets !*
+ integer :: nlts !*
+ character(len=1) :: quote_char !*
+ type(buffer_t) :: buffer !*
+ type(buffer_t) :: element_name
+ type(dictionary_t) :: attributes
+ type(buffer_t) :: pcdata
+ type(elstack_t) :: element_stack
+ logical :: root_element_seen
+ type(buffer_t) :: root_element_name
+ character(len=150) :: action
+ logical :: debug
+end type fsm_t
+
+public :: init_fsm, reset_fsm, evolve_fsm
+
+!
+! State parameters
+!
+integer, parameter, public :: ERROR = -1
+integer, parameter, public :: INIT = 1
+integer, parameter, private :: START_TAG_MARKER = 2
+integer, parameter, private :: END_TAG_MARKER = 3
+integer, parameter, private :: IN_NAME = 4
+integer, parameter, private :: WHITESPACE_IN_TAG = 5
+integer, parameter, private :: IN_PCDATA = 6
+integer, parameter, private :: SINGLETAG_MARKER = 7
+integer, parameter, private :: CLOSINGTAG_MARKER = 8
+integer, parameter, private :: IN_COMMENT = 9
+integer, parameter, private :: IN_ATT_NAME = 10
+integer, parameter, private :: IN_ATT_VALUE = 11
+integer, parameter, private :: EQUAL = 12
+integer, parameter, private :: SPACE_AFTER_EQUAL = 13
+integer, parameter, private :: SPACE_BEFORE_EQUAL = 14
+integer, parameter, private :: START_QUOTE = 15
+integer, parameter, private :: END_QUOTE = 16
+integer, parameter, private :: BANG = 17
+integer, parameter, private :: BANG_HYPHEN = 18
+integer, parameter, private :: ONE_HYPHEN = 19
+integer, parameter, private :: TWO_HYPHEN = 20
+integer, parameter, private :: QUESTION_MARK = 21
+integer, parameter, private :: START_XML_DECLARATION = 22
+integer, parameter, private :: IN_SGML_DECLARATION = 23
+integer, parameter, private :: IN_CDATA_SECTION = 24
+integer, parameter, private :: ONE_BRACKET = 25
+integer, parameter, private :: TWO_BRACKET = 26
+integer, parameter, private :: CDATA_PREAMBLE = 27
+integer, parameter, private :: IN_PCDATA_AT_EOL = 30
+!
+! Context parameters
+!
+integer, parameter, public :: OPENING_TAG = 100
+integer, parameter, public :: CLOSING_TAG = 110
+integer, parameter, public :: SINGLE_TAG = 120
+integer, parameter, public :: COMMENT_TAG = 130
+integer, parameter, public :: XML_DECLARATION_TAG = 140
+integer, parameter, public :: SGML_DECLARATION_TAG = 150
+integer, parameter, public :: CDATA_SECTION_TAG = 160
+integer, parameter, public :: NULL_CONTEXT = 200
+!
+! Signal parameters
+!
+integer, parameter, public :: QUIET = 1000
+integer, parameter, public :: END_OF_TAG = 1100
+integer, parameter, public :: CHUNK_OF_PCDATA = 1200
+integer, parameter, public :: EXCEPTION = 1500
+
+CONTAINS
+
+!------------------------------------------------------------
+! Initialize once and for all the derived types (Fortran90 restriction)
+!
+subroutine init_fsm(fx)
+type(fsm_t), intent(inout) :: fx
+
+ fx%state = INIT
+ call setup_xml_charsets()
+ fx%context = NULL_CONTEXT
+ call init_elstack(fx%element_stack)
+ fx%root_element_seen = .false.
+ fx%debug = .false.
+ fx%action = ""
+ call init_buffer(fx%buffer)
+ call init_buffer(fx%element_name)
+ call init_buffer(fx%pcdata)
+ call init_buffer(fx%root_element_name)
+ call init_dict(fx%attributes)
+end subroutine init_fsm
+!------------------------------------------------------------
+subroutine reset_fsm(fx)
+type(fsm_t), intent(inout) :: fx
+
+ fx%state = INIT
+ call setup_xml_charsets()
+ fx%context = NULL_CONTEXT
+ call reset_elstack(fx%element_stack)
+ fx%action = ""
+ fx%root_element_seen = .false.
+ call reset_buffer(fx%buffer)
+ call reset_buffer(fx%element_name)
+ call reset_buffer(fx%pcdata)
+ call reset_buffer(fx%root_element_name)
+ call reset_dict(fx%attributes)
+end subroutine reset_fsm
+
+!------------------------------------------------------------
+subroutine evolve_fsm(fx,c,signal)
+!
+! Finite-state machine evolution rules for XML parsing.
+!
+type(fsm_t), intent(inout) :: fx ! Internal state
+character(len=1), intent(in) :: c
+integer, intent(out) :: signal
+
+!
+! Reset signal
+!
+signal = QUIET
+!
+
+if (.not. (c .in. valid_chars)) then
+!
+! Let it pass (in case the underlying encoding is UTF-8)
+! But this chars in a name will cause havoc
+!
+! signal = EXCEPTION
+! fx%state = ERROR
+! fx%action = trim("Not a valid character in simple encoding: "//c)
+! RETURN
+endif
+
+select case(fx%state)
+
+ case (INIT)
+ if (c == "<") then
+ fx%state = START_TAG_MARKER
+ if (fx%debug) fx%action = ("Starting tag")
+ else if (c == ">") then
+ fx%state = ERROR
+ fx%action = ("Ending tag without being in one!")
+ else
+ if (fx%debug) fx%action = ("Reading garbage chars")
+ endif
+
+ case (START_TAG_MARKER)
+ if (c == ">") then
+ fx%state = ERROR
+ fx%action = ("Tag empty!")
+ else if (c == "<") then
+ fx%state = ERROR
+ fx%action = ("Double opening of tag!!")
+ else if (c == "/") then
+ fx%state = CLOSINGTAG_MARKER
+ if (fx%debug) fx%action = ("Starting endtag: ")
+ fx%context = CLOSING_TAG
+ else if (c == "?") then
+ fx%state = START_XML_DECLARATION
+ if (fx%debug) fx%action = ("Starting XML declaration ")
+ fx%context = XML_DECLARATION_TAG
+ else if (c == "!") then
+ fx%state = BANG
+ if (fx%debug) fx%action = ("Saw ! -- comment or SGML declaration expected...")
+ else if (c .in. whitespace) then
+ fx%state = ERROR
+ fx%action = ("Cannot have whitespace after <")
+ else if (c .in. initial_name_chars) then
+ fx%context = OPENING_TAG
+ fx%state = IN_NAME
+ call add_to_buffer(c,fx%buffer)
+ if (fx%debug) fx%action = ("Starting to read name in tag")
+ else
+ fx%state = ERROR
+ fx%action = ("Illegal initial character for name")
+ endif
+
+
+ case (BANG)
+ if (c == "-") then
+ fx%state = BANG_HYPHEN
+ if (fx%debug) fx%action = ("Almost ready to start comment ")
+ else if (c .in. uppercase_chars) then
+ fx%state = IN_SGML_DECLARATION
+ fx%nlts = 0
+ fx%nbrackets = 0
+ if (fx%debug) fx%action = ("SGML declaration ")
+ fx%context = SGML_DECLARATION_TAG
+ call add_to_buffer(c,fx%buffer)
+ else if (c == "[") then
+ fx%state = CDATA_PREAMBLE
+ if (fx%debug) fx%action = ("Declaration with [ ")
+ fx%context = CDATA_SECTION_TAG
+ else
+ fx%state = ERROR
+ fx%action = ("Wrong character after ! ")
+ endif
+
+ case (CDATA_PREAMBLE)
+ ! We assume a CDATA[ is forthcoming, we do not check
+ if (c == "[") then
+ fx%state = IN_CDATA_SECTION
+ if (fx%debug) fx%action = ("About to start reading CDATA contents")
+ else if (c == "]") then
+ fx%state = ERROR
+ fx%action = ("Unexpected ] in CDATA preamble")
+ else
+ if (fx%debug) fx%action = ("Reading CDATA preamble")
+ endif
+
+ case (IN_CDATA_SECTION)
+ if (c == "]") then
+ fx%state = ONE_BRACKET
+ if (fx%debug) fx%action = ("Saw a ] in CDATA section")
+ else
+ call add_to_buffer(c,fx%buffer)
+ if (fx%debug) fx%action = ("Reading contents of CDATA section")
+ endif
+
+ case (ONE_BRACKET)
+ if (c == "]") then
+ fx%state = TWO_BRACKET
+ if (fx%debug) fx%action = ("Maybe finish a CDATA section")
+ else
+ fx%state = IN_CDATA_SECTION
+ call add_to_buffer("]",fx%buffer)
+ if (fx%debug) fx%action = ("Continue reading contents of CDATA section")
+ endif
+
+ case (TWO_BRACKET)
+ if (c == ">") then
+ fx%state = END_TAG_MARKER
+ signal = END_OF_TAG
+ if (fx%debug) fx%action = ("End of CDATA section")
+ fx%pcdata = fx%buffer ! Not quite the same behavior
+ ! as pcdata... (not filtered)
+ call reset_buffer(fx%buffer)
+ else
+ fx%state = IN_CDATA_SECTION
+ call add_to_buffer("]",fx%buffer)
+ if (fx%debug) fx%action = ("Continue reading contents of CDATA section")
+ endif
+
+ case (IN_SGML_DECLARATION)
+ if (c == "<") then
+ fx%nlts = fx%nlts + 1
+ call add_to_buffer("<",fx%buffer)
+ fx%action = "Read an intermediate < in SGML declaration"
+ else if (c == "[") then
+ fx%nbrackets = fx%nbrackets + 1
+ call add_to_buffer("[",fx%buffer)
+ fx%action = "Read a [ in SGML declaration"
+ else if (c == "]") then
+ fx%nbrackets = fx%nbrackets - 1
+ call add_to_buffer("]",fx%buffer)
+ fx%action = "Read a ] in SGML declaration"
+ else if (c == ">") then
+ if (fx%nlts == 0) then
+ if (fx%nbrackets == 0) then
+ fx%state = END_TAG_MARKER
+ signal = END_OF_TAG
+ if (fx%debug) fx%action = ("Ending SGML declaration tag")
+ fx%pcdata = fx%buffer ! Same behavior as pcdata
+ call reset_buffer(fx%buffer)
+ else
+ fx%state = ERROR
+ fx%action = ("Unmatched ] in SGML declaration")
+ endif
+ else
+ fx%nlts = fx%nlts -1
+ call add_to_buffer(">",fx%buffer)
+ fx%action = "Read an intermediate > in SGML declaration"
+ endif
+ else
+ if (fx%debug) fx%action = ("Keep reading SGML declaration")
+ call add_to_buffer(c,fx%buffer)
+ endif
+
+ case (BANG_HYPHEN)
+ if (c == "-") then
+ fx%state = IN_COMMENT
+ fx%context = COMMENT_TAG
+ if (fx%debug) fx%action = ("In comment ")
+ else
+ fx%state = ERROR
+ fx%action = ("Wrong character after ") then
+ fx%state = ERROR
+ fx%action = ("Closing tag empty!")
+ else if (c == "<") then
+ fx%state = ERROR
+ fx%action = ("Double opening of closing tag!!")
+ else if (c == "/") then
+ fx%state = ERROR
+ fx%action = ("Syntax error (/)")
+ else if (c .in. whitespace) then
+ fx%state = ERROR
+ fx%action = ("Cannot have whitespace after ")
+ else if (c .in. initial_name_chars) then
+ fx%state = IN_NAME
+ if (fx%debug) fx%action = ("Starting to read name inside endtag")
+ call add_to_buffer(c,fx%buffer)
+ else
+ fx%state = ERROR
+ fx%action = ("Illegal initial character for name")
+ endif
+
+ case (IN_NAME)
+ if (c == "<") then
+ fx%state = ERROR
+ fx%action = ("Starting tag within tag")
+ else if (c == ">") then
+ fx%state = END_TAG_MARKER
+ signal = END_OF_TAG
+ if (fx%debug) fx%action = ("Ending tag")
+! call set_element_name(fx%buffer,fx%element)
+ fx%element_name = fx%buffer
+ call reset_buffer(fx%buffer)
+ call reset_dict(fx%attributes)
+ else if (c == "/") then
+ if (fx%context /= OPENING_TAG) then
+ fx%state = ERROR
+ fx%action = ("Single tag did not open as start tag")
+ else
+ fx%state = SINGLETAG_MARKER
+ fx%context = SINGLE_TAG
+ if (fx%debug) fx%action = ("Almost ending single tag")
+! call set_element_name(fx%buffer,fx%element)
+ fx%element_name = fx%buffer
+ call reset_buffer(fx%buffer)
+ call reset_dict(fx%attributes)
+ endif
+ else if (c .in. whitespace) then
+ fx%state = WHITESPACE_IN_TAG
+ if (fx%debug) fx%action = ("Ending name chars")
+! call set_element_name(fx%buffer,fx%element)
+ fx%element_name = fx%buffer
+ call reset_buffer(fx%buffer)
+ call reset_dict(fx%attributes)
+ else if (c .in. name_chars) then
+ if (fx%debug) fx%action = ("Reading name chars in tag")
+ call add_to_buffer(c,fx%buffer)
+ else
+ fx%state = ERROR
+ fx%action = ("Illegal character for name")
+ endif
+
+ case (IN_ATT_NAME)
+ if (c == "<") then
+ fx%state = ERROR
+ fx%action = ("Starting tag within tag")
+ else if (c == ">") then
+ fx%state = ERROR
+ fx%action = ("Ending tag in the middle of an attribute")
+ else if (c == "/") then
+ fx%state = ERROR
+ fx%action = ("Ending tag in the middle of an attribute")
+ else if (c .in. whitespace) then
+ fx%state = SPACE_BEFORE_EQUAL
+ if (fx%debug) fx%action = ("Whitespace after attr. name (specs?)")
+ call add_key_to_dict(fx%buffer,fx%attributes)
+ call reset_buffer(fx%buffer)
+ else if ( c == "=" ) then
+ fx%state = EQUAL
+ if (fx%debug) fx%action = ("End of attr. name")
+ call add_key_to_dict(fx%buffer,fx%attributes)
+ call reset_buffer(fx%buffer)
+ else if (c .in. name_chars) then
+ if (fx%debug) fx%action = ("Reading attribute name chars")
+ call add_to_buffer(c,fx%buffer)
+ else
+ fx%state = ERROR
+ fx%action = ("Illegal character for attribute name")
+ endif
+
+ case (EQUAL)
+ if ( (c == """") .or. (c == "'") ) then
+ fx%state = START_QUOTE
+ if (fx%debug) fx%action = ("Found beginning quote")
+ fx%quote_char = c
+ else if (c .in. whitespace) then
+ fx%state = SPACE_AFTER_EQUAL
+ if (fx%debug) fx%action = ("Whitespace after equal sign...")
+ else
+ fx%state = ERROR
+ fx%action = ("Must use quotes for attribute values")
+ endif
+
+ case (SPACE_BEFORE_EQUAL)
+ if ( c == "=" ) then
+ fx%state = EQUAL
+ if (fx%debug) fx%action = ("Equal sign")
+ else if (c .in. whitespace) then
+ if (fx%debug) fx%action = ("More whitespace before equal sign...")
+ else
+ fx%state = ERROR
+ fx%action = ("Must use equal sign for attribute values")
+ endif
+
+ case (SPACE_AFTER_EQUAL)
+ if ( c == "=" ) then
+ fx%state = ERROR
+ fx%action = ("Duplicate Equal sign")
+ else if (c .in. whitespace) then
+ if (fx%debug) fx%action = ("More whitespace after equal sign...")
+ else if ( (c == """") .or. (c == "'") ) then
+ fx%state = START_QUOTE
+ fx%quote_char = c
+ if (fx%debug) fx%action = ("Found beginning quote")
+ else
+ fx%state = ERROR
+ fx%action = ("Must use quotes for attribute values")
+ endif
+
+ case (START_QUOTE)
+ if (c == fx%quote_char) then
+ fx%state = END_QUOTE
+ if (fx%debug) fx%action = ("Emtpy attribute value...")
+ call add_value_to_dict(fx%buffer,fx%attributes)
+ call reset_buffer(fx%buffer)
+ else if (c == "<") then
+ fx%state = ERROR
+ fx%action = ("Attribute value cannot contain <")
+ else ! actually allowed chars in att values... Specs: No "<"
+ fx%state = IN_ATT_VALUE
+ if (fx%debug) fx%action = ("Starting to read attribute value")
+ call add_to_buffer(c,fx%buffer)
+ endif
+
+ case (IN_ATT_VALUE)
+ if (c == fx%quote_char) then
+ fx%state = END_QUOTE
+ if (fx%debug) fx%action = ("End of attribute value")
+ call add_value_to_dict(fx%buffer,fx%attributes)
+ call reset_buffer(fx%buffer)
+ else if (c == "<") then
+ fx%state = ERROR
+ fx%action = ("Attribute value cannot contain <")
+ else if ( (c == char(10)) ) then
+ fx%state = ERROR
+!
+! Aparently other whitespace is allowed...
+!
+ fx%action = ("No newline allowed in attr. value (specs?)")
+ else ! all other chars allowed in attr value
+ if (fx%debug) fx%action = ("Reading attribute value chars")
+ call add_to_buffer(c,fx%buffer)
+ endif
+
+ case (END_QUOTE)
+ if ((c == """") .or. (c == "'")) then
+ fx%state = ERROR
+ fx%action = ("Duplicate end quote")
+ else if (c .in. whitespace) then
+ fx%state = WHITESPACE_IN_TAG
+ if (fx%debug) fx%action = ("Space in between attributes or to end of tag")
+ else if (c == "<") then
+ fx%state = ERROR
+ fx%action = ("Starting tag within tag")
+ else if (c == ">") then
+ if (fx%context == XML_DECLARATION_TAG) then
+ fx%state = ERROR
+ fx%action = "End of XML declaration without ?"
+ else
+ fx%state = END_TAG_MARKER
+ signal = END_OF_TAG
+ if (fx%debug) fx%action = ("Ending tag after some attributes")
+ endif
+ else if (c == "/") then
+ if (fx%context /= OPENING_TAG) then
+ fx%state = ERROR
+ fx%action = ("Single tag did not open as start tag")
+ else
+ fx%state = SINGLETAG_MARKER
+ fx%context = SINGLE_TAG
+ if (fx%debug) fx%action = ("Almost ending single tag after some attributes")
+ endif
+ else if (c == "?") then
+ if (fx%context /= XML_DECLARATION_TAG) then
+ fx%state = ERROR
+ fx%action = "Wrong lone ? in tag"
+ else
+ fx%state = QUESTION_MARK
+ if (fx%debug) fx%action = ("About to end XML declaration")
+ endif
+ else
+ fx%state = ERROR
+ fx%action = ("Must have some whitespace after att. value")
+ endif
+
+
+ case (WHITESPACE_IN_TAG)
+ if ( c .in. whitespace) then
+ if (fx%debug) fx%action = ("Reading whitespace in tag")
+ else if (c == "<") then
+ fx%state = ERROR
+ fx%action = ("Starting tag within tag")
+ else if (c == ">") then
+ if (fx%context == XML_DECLARATION_TAG) then
+ fx%state = ERROR
+ fx%action = "End of XML declaration without ?"
+ else
+ fx%state = END_TAG_MARKER
+ signal = END_OF_TAG
+ if (fx%debug) fx%action = ("End whitespace in tag")
+ endif
+ else if (c == "/") then
+ if (fx%context /= OPENING_TAG) then
+ fx%state = ERROR
+ fx%action = ("Single tag did not open as start tag")
+ else
+ fx%state = SINGLETAG_MARKER
+ fx%context = SINGLE_TAG
+ if (fx%debug) fx%action = ("End whitespace in single tag")
+ endif
+ else if (c .in. initial_name_chars) then
+ fx%state = IN_ATT_NAME
+ if (fx%debug) fx%action = ("Starting Attribute name in tag")
+ call add_to_buffer(c,fx%buffer)
+ else if (c == "?") then
+ if (fx%context /= XML_DECLARATION_TAG) then
+ fx%state = ERROR
+ fx%action = "Wrong lone ? in tag"
+ else
+ fx%state = QUESTION_MARK
+ if (fx%debug) fx%action = ("About to end XML declaration after whitespace")
+ endif
+ else
+ fx%state = ERROR
+ fx%action = ("Illegal initial character for attribute")
+ endif
+
+ case (QUESTION_MARK)
+ if (c == ">") then
+ fx%state = END_TAG_MARKER
+ signal = END_OF_TAG
+ if (fx%debug) fx%action = ("End of XML declaration tag")
+ else
+ fx%state = ERROR
+ fx%action = "No > after ? in XML declaration tag"
+ endif
+
+ case (IN_COMMENT)
+ !
+ ! End of comment is "-->", and ">" can appear inside comments
+ !
+ if (c == "-") then
+ fx%state = ONE_HYPHEN
+ if (fx%debug) fx%action = ("Saw - in Comment")
+ else
+ if (fx%debug) fx%action = ("Reading comment")
+ call add_to_buffer(c,fx%buffer)
+ endif
+
+ case (ONE_HYPHEN)
+ if (c == "-") then
+ fx%state = TWO_HYPHEN
+ if (fx%debug) fx%action = ("About to end comment")
+ else
+ fx%state = IN_COMMENT
+ if (fx%debug) fx%action = ("Keep reading comment after -: ")
+ call add_to_buffer("-",fx%buffer)
+ call add_to_buffer(c,fx%buffer)
+ endif
+
+ case (TWO_HYPHEN)
+ if (c == ">") then
+ fx%state = END_TAG_MARKER
+ signal = END_OF_TAG
+ if (fx%debug) fx%action = ("End of Comment")
+ fx%pcdata = fx%buffer ! Same behavior as pcdata
+ call reset_buffer(fx%buffer)
+ else
+ fx%state = ERROR
+ fx%action = ("Cannot have -- in comment")
+ endif
+
+ case (SINGLETAG_MARKER)
+
+ if (c == ">") then
+ fx%state = END_TAG_MARKER
+ signal = END_OF_TAG
+ if (fx%debug) fx%action = ("Ending tag")
+ ! We have to call begin_element AND end_element
+ else
+ fx%state = ERROR
+ fx%action = ("Wrong ending of single tag")
+ endif
+
+ case (IN_PCDATA)
+ if (c == "<") then
+ fx%state = START_TAG_MARKER
+ signal = CHUNK_OF_PCDATA
+ if (fx%debug) fx%action = ("End of pcdata -- Starting tag")
+ fx%pcdata = fx%buffer
+ call reset_buffer(fx%buffer)
+ else if (c == ">") then
+ fx%state = ERROR
+ fx%action = ("Ending tag without starting it!")
+ else if (c == char(10)) then
+ fx%state = IN_PCDATA_AT_EOL
+ signal = CHUNK_OF_PCDATA
+ if (fx%debug) fx%action = ("Resetting PCDATA buffer at newline")
+ call add_to_buffer(c,fx%buffer)
+ fx%pcdata = fx%buffer
+ call reset_buffer(fx%buffer)
+ else
+ call add_to_buffer(c,fx%buffer)
+ if (fx%debug) fx%action = ("Reading chars outside tags")
+ !
+ ! Check whether we are close to the end of the buffer.
+ ! If so, make a chunk and reset the buffer
+ if (c .in. whitespace) then
+ if (buffer_nearly_full(fx%buffer)) then
+ signal = CHUNK_OF_PCDATA
+ if (fx%debug) fx%action = ("Resetting almost full PCDATA buffer")
+ fx%pcdata = fx%buffer
+ call reset_buffer(fx%buffer)
+ endif
+ endif
+ endif
+
+ case (IN_PCDATA_AT_EOL)
+ !
+ ! Avoid triggering an extra pcdata event
+ !
+ if (c == "<") then
+ fx%state = START_TAG_MARKER
+ if (fx%debug) fx%action = ("No more pcdata after eol-- Starting tag")
+ else if (c == ">") then
+ fx%state = ERROR
+ fx%action = ("Ending tag without starting it!")
+ else if (c == char(10)) then
+ fx%state = IN_PCDATA_AT_EOL
+ signal = CHUNK_OF_PCDATA
+ if (fx%debug) fx%action = ("Resetting PCDATA buffer at repeated newline")
+ call add_to_buffer(c,fx%buffer)
+ fx%pcdata = fx%buffer
+ call reset_buffer(fx%buffer)
+ else
+ fx%state = IN_PCDATA
+ call add_to_buffer(c,fx%buffer)
+ if (fx%debug) fx%action = ("Reading chars outside tags")
+ !
+ ! Check whether we are close to the end of the buffer.
+ ! If so, make a chunk and reset the buffer
+ if (c .in. whitespace) then
+ if (buffer_nearly_full(fx%buffer)) then
+ signal = CHUNK_OF_PCDATA
+ if (fx%debug) fx%action = ("Resetting almost full PCDATA buffer")
+ fx%pcdata = fx%buffer
+ call reset_buffer(fx%buffer)
+ endif
+ endif
+ endif
+
+
+
+ case (END_TAG_MARKER)
+!
+ if (c == "<") then
+ fx%state = START_TAG_MARKER
+ if (fx%debug) fx%action = ("Starting tag")
+ else if (c == ">") then
+ fx%state = ERROR
+ fx%action = ("Double ending of tag!")
+!
+! We should make this whitespace in general (maybe not?
+! how about indentation in text chunks?)
+! See specs.
+!
+ else if (c == char(10)) then
+ ! Ignoring LF after end of tag is probably non standard...
+
+ if (fx%debug) &
+ fx%action = ("---------Discarding newline after end of tag")
+
+ !!! New code for full compliance
+ ! fx%state = IN_PCDATA_AT_EOL
+ ! call add_to_buffer(c,fx%buffer)
+ ! if (fx%debug) &
+ ! fx%action = ("Found LF after end of tag. Emitting PCDATA event")
+ ! signal = CHUNK_OF_PCDATA
+ ! fx%pcdata = fx%buffer
+ ! call reset_buffer(fx%buffer)
+ else
+ fx%state = IN_PCDATA
+ call add_to_buffer(c,fx%buffer)
+ if (fx%debug) fx%action = ("End of Tag. Starting to read PCDATA")
+ endif
+
+ case (ERROR)
+
+ stop "Cannot continue after parsing errors!"
+
+ end select
+
+if (fx%state == ERROR) signal = EXCEPTION
+
+end subroutine evolve_fsm
+
+end module m_fsm
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/src/sax/m_io.f90
===================================================================
--- /XMLF90/src/sax/m_io.f90 (revision 6)
+++ /XMLF90/src/sax/m_io.f90 (revision 6)
@@ -0,0 +1,94 @@
+module m_io
+
+!
+! Basic I/O tools
+!
+integer, public, save :: io_eor, io_eof
+
+public :: get_unit, setup_io
+private :: find_eor_eof
+
+CONTAINS
+
+! ----------------------------------------------------------------------
+subroutine setup_io()
+ call find_eor_eof(io_eor, io_eof)
+end subroutine setup_io
+
+! ----------------------------------------------------------------------
+subroutine get_unit(lun,iostat)
+
+! Get an available Fortran unit number
+
+integer, intent(out) :: lun
+integer, intent(out) :: iostat
+
+integer :: i
+logical :: unit_used
+
+do i = 10, 99
+ lun = i
+ inquire(unit=lun,opened=unit_used)
+ if (.not. unit_used) then
+ iostat = 0
+ return
+ endif
+enddo
+iostat = -1
+lun = -1
+end subroutine get_unit
+! ----------------------------------------------------------------------
+
+subroutine find_eor_eof(io_eor,io_eof)
+!
+! Determines the values of the iostat values for End of File and
+! End of Record (in non-advancing I/O)
+!
+integer, intent(out) :: io_eor
+integer, intent(out) :: io_eof
+
+integer :: lun, iostat
+character(len=1) :: c
+
+call get_unit(lun,iostat)
+
+if (iostat /= 0) stop "Out of unit numbers"
+
+open(unit=lun,status="scratch",form="formatted", &
+ action="readwrite",position="rewind",iostat=iostat)
+if (iostat /= 0) stop "Cannot open test file"
+
+write(unit=lun,fmt=*) "a"
+write(unit=lun,fmt=*) "b"
+
+rewind(unit=lun)
+
+io_eor = 0
+do
+ read(unit=lun,fmt="(a1)",advance="NO",iostat=io_eor) c
+ if (io_eor /= 0) exit
+enddo
+
+io_eof = 0
+do
+ read(unit=lun,fmt=*,iostat=io_eof)
+ if (io_eof /= 0) exit
+enddo
+
+!!!!!!!!print *, "IO_EOR, IO_EOF: ", io_eor, io_eof
+
+close(unit=lun,status="delete")
+
+end subroutine find_eor_eof
+
+! ----------------------------------------------------------------------
+end module m_io
+
+
+
+
+
+
+
+
+
Index: /XMLF90/src/sax/m_reader.f90
===================================================================
--- /XMLF90/src/sax/m_reader.f90 (revision 6)
+++ /XMLF90/src/sax/m_reader.f90 (revision 6)
@@ -0,0 +1,298 @@
+module m_reader
+
+use m_io
+
+private
+
+integer, parameter, public :: BUFFER_NOT_CONNECTED = -2048
+integer, private, parameter :: MAXLENGTH = 1024
+
+type, public :: file_buffer_t
+private
+ logical :: connected
+ logical :: eof
+ integer :: lun
+ character(len=50) :: filename
+ integer :: counter
+ character(len=MAXLENGTH) :: buffer
+ integer :: line
+ integer :: col
+ integer :: pos
+ integer :: nchars
+ logical :: debug
+end type file_buffer_t
+
+public :: get_character, sync_file
+public :: line, column, nchars_processed
+public :: open_file, close_file_buffer, rewind_file, mark_eof_file
+public :: eof_file
+
+private :: fill_buffer
+
+CONTAINS
+
+!-----------------------------------------
+!
+subroutine open_file(fname,fb,iostat,record_size,verbose)
+character(len=*), intent(in) :: fname
+type(file_buffer_t), intent(out) :: fb
+integer, intent(out) :: iostat
+integer, intent(in), optional :: record_size
+logical, intent(in), optional :: verbose
+
+iostat = 0
+
+call setup_io()
+
+fb%connected = .false.
+
+call get_unit(fb%lun,iostat)
+if (iostat /= 0) then
+ if (fb%debug) print *, "Cannot get unit"
+ return
+endif
+
+if (present(verbose)) then
+ fb%debug = verbose
+else
+ fb%debug = .false.
+endif
+
+if (present(record_size)) then
+ open(unit=fb%lun,file=fname,form="formatted",status="old", &
+ action="read",position="rewind",recl=record_size,iostat=iostat)
+else
+ open(unit=fb%lun,file=fname,form="formatted",status="old", &
+ action="read",position="rewind",recl=65536,iostat=iostat)
+endif
+if (iostat /= 0) then
+ if (fb%debug) print *, "Cannot open file ", trim(fname), " iostat: ", iostat
+ return
+endif
+
+fb%connected = .true.
+fb%counter = 0
+fb%eof = .false.
+fb%line = 1
+fb%col = 0
+fb%filename = fname
+fb%pos = 0
+fb%nchars = 0
+fb%buffer = ""
+
+end subroutine open_file
+
+!-------------------------------------------------
+subroutine rewind_file(fb)
+type(file_buffer_t), intent(inout) :: fb
+
+fb%eof = .false.
+fb%counter = 0
+fb%line = 1
+fb%col = 0
+fb%pos = 0
+fb%nchars = 0
+fb%buffer = ""
+
+rewind(unit=fb%lun)
+
+end subroutine rewind_file
+!-----------------------------------------
+subroutine mark_eof_file(fb)
+type(file_buffer_t), intent(inout) :: fb
+
+fb%eof = .true.
+
+end subroutine mark_eof_file
+
+!-----------------------------------------
+subroutine close_file_buffer(fb)
+type(file_buffer_t), intent(inout) :: fb
+
+if (fb%connected) then
+ close(unit=fb%lun)
+ fb%connected = .false.
+endif
+
+end subroutine close_file_buffer
+
+!-------------------------------------------------
+function eof_file(fb) result (res)
+type(file_buffer_t), intent(in) :: fb
+logical :: res
+
+res = fb%eof
+
+end function eof_file
+!-----------------------------------------
+!-----------------------------------------
+! New version, able to cope with arbitrarily long lines
+! (still need to specify a big enough record_size if necessary)
+!
+subroutine fill_buffer(fb,iostat)
+type(file_buffer_t), intent(inout) :: fb
+integer, intent(out) :: iostat
+!
+!
+character(len=41) :: str ! 40 seems like a good compromise?
+ ! (1 extra for added newline, see below)
+integer :: len
+!
+read(unit=fb%lun,iostat=iostat,advance="no",size=len,fmt="(a40)") str
+
+if (iostat == io_eof) then
+
+ ! End of file
+ if (fb%debug) print *, "End of file."
+ return
+
+else if (iostat > 0) then
+
+ ! Hard i/o error
+ if (fb%debug) print *, "Hard i/o error. iostat:", iostat
+ RETURN
+
+else
+!
+ if (fb%debug) then
+ print *, "Buffer: len, iostat", len, iostat
+ print *, trim(str)
+ endif
+
+ fb%pos = 0
+
+ if (iostat == 0) then
+
+ ! Normal read, with more stuff left on the line
+ !
+ fb%buffer = str(1:len)
+ fb%nchars = len
+
+ else ! (end of record)
+ !
+ ! End of record. We mark it with an LF, whatever it is the native marker.
+ !
+!! fb%buffer = str(1:len) // char(10)
+ fb%buffer = str(1:len) !! Avoid allocation of string
+ len = len + 1 !! by compiler
+ fb%buffer(len:len) = char(10)
+ fb%nchars = len
+ iostat = 0
+ endif
+
+endif
+
+end subroutine fill_buffer
+
+!---------------------------------------------------------------
+subroutine get_character(fb,c,iostat)
+character(len=1), intent(out) :: c
+type(file_buffer_t), intent(inout) :: fb
+integer, intent(out) :: iostat
+
+character(len=1) :: c_next
+
+if (.not. fb%connected) then
+ iostat = BUFFER_NOT_CONNECTED
+ return
+endif
+
+if (fb%pos >= fb%nchars) then
+ call fill_buffer(fb,iostat)
+ if (iostat /= 0) return
+endif
+fb%pos = fb%pos + 1
+c = fb%buffer(fb%pos:fb%pos)
+fb%counter = fb%counter + 1 ! Raw counter
+fb%col = fb%col + 1
+!
+! Deal with end-of-line handling on the processor...
+!
+if (c == char(10)) then
+ ! Our own marker for end of line
+ fb%line = fb%line + 1
+ fb%col = 0
+endif
+if (c == char(13)) then
+ c_next = fb%buffer(fb%pos+1:fb%pos+1)
+ if (c_next == char(10)) then
+ !
+ ! Found CRLF. We replace it by LF, as per specs.
+ c = c_next
+ fb%pos = fb%pos + 1
+ if (fb%debug) print *, "-/-> Removed CR before LF in get_character"
+ else
+ ! Replace single CR by LF
+ c = char(10)
+ if (fb%debug) print *, "-/-> Changed CR to LF in get_character -- line++"
+ !
+ endif
+ ! In both cases we increase the line counter and reset the column
+ !
+ fb%line = fb%line + 1
+ fb%col = 0
+endif
+
+iostat = 0
+
+end subroutine get_character
+
+!----------------------------------------------------
+!----------------------------------------------------
+! Error Location functions
+!
+function line(fb) result (ll)
+type(file_buffer_t), intent(in) :: fb
+integer :: ll
+
+ll = fb%line
+end function line
+
+!----------------------------------------------------
+function column(fb) result (col)
+type(file_buffer_t), intent(in) :: fb
+integer :: col
+
+col = fb%col
+end function column
+!----------------------------------------------------
+!----------------------------------------------------
+function nchars_processed(fb) result (nc)
+type(file_buffer_t), intent(in) :: fb
+integer :: nc
+
+nc = fb%counter
+end function nchars_processed
+!----------------------------------------------------
+
+subroutine sync_file(fb,iostat)
+type(file_buffer_t), intent(inout) :: fb
+integer, intent(out) :: iostat
+!
+! Repositions the file so that it matches with
+! the stored file_buffer information
+!
+integer :: target_counter
+character(len=1) :: c
+
+target_counter = fb%counter
+call rewind_file(fb)
+iostat = 0
+do
+ if (fb%counter == target_counter) exit
+ call get_character(fb,c,iostat)
+ if (iostat /= 0) return
+enddo
+
+end subroutine sync_file
+
+end module m_reader
+
+
+
+
+
+
+
+
+
Index: /XMLF90/src/sax/m_xml_error.f90
===================================================================
--- /XMLF90/src/sax/m_xml_error.f90 (revision 6)
+++ /XMLF90/src/sax/m_xml_error.f90 (revision 6)
@@ -0,0 +1,84 @@
+module m_xml_error
+!
+! Error handling
+!
+use m_elstack
+private
+
+type, public :: xml_error_t
+ character(len=100) :: message
+ integer :: line
+ integer :: column
+ type(elstack_t) :: stack
+ integer :: severity
+end type xml_error_t
+
+integer, public :: xml_stderr = 0 ! Unit for error info
+integer, public, parameter :: SEVERE_ERROR_CODE=0, WARNING_CODE=1
+
+public :: build_error_info, default_error_handler
+public :: set_xml_stderr
+
+CONTAINS
+
+!-------------------------------------------------------------------------
+subroutine build_error_info(error_info,message,line,column,stack,severity)
+type(xml_error_t), intent(out) :: error_info
+integer, intent(in) :: line, column
+character(len=*), intent(in) :: message
+type(elstack_t), intent(in) :: stack
+integer, intent(in) :: severity
+
+error_info%message = message
+error_info%line = line
+error_info%column = column
+error_info%stack = stack
+error_info%severity = severity
+
+end subroutine build_error_info
+
+!--------------------------------------------------
+
+subroutine default_error_handler(error_info)
+type(xml_error_t), intent(in) :: error_info
+!
+! Default error handling
+!
+if (error_info%severity == SEVERE_ERROR_CODE) then
+ write(unit=xml_stderr,fmt="(a)") "*** XML parsing Error:"
+else if (error_info%severity == WARNING_CODE) then
+ write(unit=xml_stderr,fmt="(a)") "*** XML parsing Warning:"
+endif
+write(unit=xml_stderr,fmt="(a)") trim(error_info%message)
+write(unit=xml_stderr,fmt="(a,i8,a,i4)") "Line: ", &
+ error_info%line, &
+ " Column: ", &
+ error_info%column
+write(unit=xml_stderr,fmt="(a)") "Element traceback:"
+call print_elstack(error_info%stack,unit=xml_stderr)
+!
+! If there is a severe error the program should stop...
+!
+if (error_info%severity == SEVERE_ERROR_CODE) then
+ STOP
+else if (error_info%severity == WARNING_CODE) then
+ write(unit=xml_stderr,fmt="(a)") "*** Continuing after Warning..."
+endif
+
+end subroutine default_error_handler
+
+!-------------------------------------------------------------------------
+subroutine set_xml_stderr(unit)
+integer, intent(in) :: unit
+
+xml_stderr = unit
+
+end subroutine set_xml_stderr
+
+end module m_xml_error
+
+
+
+
+
+
Index: /XMLF90/src/sax/m_xml_parser.f90
===================================================================
--- /XMLF90/src/sax/m_xml_parser.f90 (revision 6)
+++ /XMLF90/src/sax/m_xml_parser.f90 (revision 6)
@@ -0,0 +1,506 @@
+module m_xml_parser
+
+!
+! Basic module to parse XML in the SAX spirit.
+!
+
+use m_buffer
+use m_reader
+use m_fsm
+use m_dictionary
+use m_debug
+use m_xml_error
+use m_elstack ! For element nesting checks
+use m_entities
+!
+private
+
+!
+! XML file handle
+!
+type, public :: xml_t
+private
+ type(file_buffer_t) :: fb
+ type(fsm_t) :: fx
+ character(len=200) :: path_mark
+end type xml_t
+
+!
+public :: xml_parse
+public :: open_xmlfile, close_xmlfile
+public :: endfile_xmlfile, rewind_xmlfile
+public :: eof_xmlfile, sync_xmlfile
+public :: xml_char_count
+public :: xml_path, xml_mark_path, xml_get_path_mark
+public :: xml_name, xml_attributes
+
+CONTAINS !=============================================================
+
+subroutine open_xmlfile(fname,fxml,iostat,record_size)
+character(len=*), intent(in) :: fname
+integer, intent(out) :: iostat
+type(xml_t), intent(out) :: fxml
+integer, intent(in), optional :: record_size
+
+call open_file(fname,fxml%fb,iostat,record_size)
+call init_fsm(fxml%fx)
+fxml%path_mark = ""
+
+end subroutine open_xmlfile
+!-------------------------------------------------------------------------
+
+subroutine rewind_xmlfile(fxml)
+type(xml_t), intent(inout) :: fxml
+
+call rewind_file(fxml%fb)
+call reset_fsm(fxml%fx)
+fxml%path_mark = ""
+
+end subroutine rewind_xmlfile
+
+!-----------------------------------------
+subroutine endfile_xmlfile(fxml)
+type(xml_t), intent(inout) :: fxml
+
+call mark_eof_file(fxml%fb)
+
+end subroutine endfile_xmlfile
+
+!-----------------------------------------
+subroutine close_xmlfile(fxml)
+type(xml_t), intent(inout) :: fxml
+
+call close_file_buffer(fxml%fb)
+call reset_fsm(fxml%fx) ! just in case
+fxml%path_mark = "" ! ""
+
+end subroutine close_xmlfile
+
+!-----------------------------------------
+subroutine sync_xmlfile(fxml,iostat)
+type(xml_t), intent(inout) :: fxml
+integer, intent(out) :: iostat
+
+call sync_file(fxml%fb,iostat)
+! Do not reset fx: that's the whole point of synching.
+
+end subroutine sync_xmlfile
+
+!----------------------------------------------------
+function eof_xmlfile(fxml) result (res)
+type(xml_t), intent(in) :: fxml
+logical :: res
+
+res = eof_file(fxml%fb)
+
+end function eof_xmlfile
+!
+!----------------------------------------------------
+!----------------------------------------------------
+function xml_char_count(fxml) result (nc)
+type(xml_t), intent(in) :: fxml
+integer :: nc
+
+nc = nchars_processed(fxml%fb)
+
+end function xml_char_count
+!
+!----------------------------------------------------
+!
+
+subroutine xml_parse(fxml, begin_element_handler, &
+ end_element_handler, &
+ pcdata_chunk_handler, &
+ comment_handler, &
+ xml_declaration_handler, &
+ cdata_section_handler, &
+ sgml_declaration_handler, &
+ error_handler, &
+ signal_handler, &
+ verbose, &
+ empty_element_handler)
+
+type(xml_t), intent(inout), target :: fxml
+
+optional :: begin_element_handler
+optional :: end_element_handler
+optional :: pcdata_chunk_handler
+optional :: comment_handler
+optional :: xml_declaration_handler
+optional :: sgml_declaration_handler
+optional :: cdata_section_handler
+optional :: error_handler
+optional :: signal_handler
+logical, intent(in), optional :: verbose
+optional :: empty_element_handler
+
+interface
+ subroutine begin_element_handler(name,attributes)
+ use m_dictionary
+ character(len=*), intent(in) :: name
+ type(dictionary_t), intent(in) :: attributes
+ end subroutine begin_element_handler
+
+ subroutine end_element_handler(name)
+ character(len=*), intent(in) :: name
+ end subroutine end_element_handler
+
+ subroutine pcdata_chunk_handler(chunk)
+ character(len=*), intent(in) :: chunk
+ end subroutine pcdata_chunk_handler
+
+ subroutine comment_handler(comment)
+ character(len=*), intent(in) :: comment
+ end subroutine comment_handler
+
+ subroutine xml_declaration_handler(name,attributes)
+ use m_dictionary
+ character(len=*), intent(in) :: name
+ type(dictionary_t), intent(in) :: attributes
+ end subroutine xml_declaration_handler
+
+ subroutine sgml_declaration_handler(sgml_declaration)
+ character(len=*), intent(in) :: sgml_declaration
+ end subroutine sgml_declaration_handler
+
+ subroutine cdata_section_handler(cdata)
+ character(len=*), intent(in) :: cdata
+ end subroutine cdata_section_handler
+
+ subroutine error_handler(error_info)
+ use m_xml_error
+ type(xml_error_t), intent(in) :: error_info
+ end subroutine error_handler
+
+ subroutine signal_handler(code)
+ logical, intent(out) :: code
+ end subroutine signal_handler
+
+ subroutine empty_element_handler(name,attributes)
+ use m_dictionary
+ character(len=*), intent(in) :: name
+ type(dictionary_t), intent(in) :: attributes
+ end subroutine empty_element_handler
+
+end interface
+
+character(len=1) :: c
+integer :: iostat, status
+
+character(len=150) :: message
+integer :: signal
+
+type(buffer_t) :: translated_pcdata
+type(buffer_t) :: name, oldname, dummy
+
+logical :: have_begin_handler, have_end_handler, &
+ have_pcdata_handler, have_comment_handler, &
+ have_xml_declaration_handler, &
+ have_sgml_declaration_handler, &
+ have_cdata_section_handler, have_empty_handler, &
+ have_error_handler, have_signal_handler
+
+logical :: pause_signal
+
+type(xml_error_t) :: error_info
+type(file_buffer_t), pointer :: fb
+type(fsm_t), pointer :: fx
+
+have_begin_handler = present(begin_element_handler)
+have_end_handler = present(end_element_handler)
+have_pcdata_handler = present(pcdata_chunk_handler)
+have_comment_handler = present(comment_handler)
+have_xml_declaration_handler = present(xml_declaration_handler)
+have_sgml_declaration_handler = present(sgml_declaration_handler)
+have_cdata_section_handler = present(cdata_section_handler)
+have_error_handler = present(error_handler)
+have_signal_handler = present(signal_handler)
+have_empty_handler = present(empty_element_handler)
+
+fb => fxml%fb
+fx => fxml%fx
+if (present(verbose)) then
+ debug = verbose ! For m_converters
+ fx%debug = verbose ! job-specific flag
+endif
+
+if (fx%debug) print *, " Entering xml_parse..."
+
+!---------------------------------------------------------------------
+do
+ call get_character(fb,c,iostat)
+
+ if (iostat /= 0) then ! End of file...
+ if (.not. is_empty(fx%element_stack)) then
+ call build_error_info(error_info, &
+ "Early end of file.", &
+ line(fb),column(fb),fx%element_stack,SEVERE_ERROR_CODE)
+ if (have_error_handler) then
+ call error_handler(error_info)
+ else
+ call default_error_handler(error_info)
+ endif
+ endif
+ call endfile_xmlfile(fxml) ! Mark it as eof
+ EXIT
+ endif
+
+ call evolve_fsm(fx,c,signal)
+
+ if (fx%debug) print *, c, " ::: ", trim(fx%action)
+
+ if (signal == END_OF_TAG) then
+ !
+ ! We decide whether we have ended an opening tag or a closing tag
+ !
+ if (fx%context == OPENING_TAG) then
+ name = fx%element_name
+
+ if (fx%debug) print *, "We have found an opening tag"
+ if (fx%root_element_seen) then
+ if (name .equal. fx%root_element_name) then
+ call build_error_info(error_info, &
+ "Duplicate root element: " // str(name), &
+ line(fb),column(fb),fx%element_stack,SEVERE_ERROR_CODE)
+ if (have_error_handler) then
+ call error_handler(error_info)
+ else
+ call default_error_handler(error_info)
+ endif
+ endif
+ if (is_empty(fx%element_stack)) then
+ call build_error_info(error_info, &
+ "Opening tag beyond root context: " // str(name), &
+ line(fb),column(fb),fx%element_stack,SEVERE_ERROR_CODE)
+ if (have_error_handler) then
+ call error_handler(error_info)
+ else
+ call default_error_handler(error_info)
+ endif
+ endif
+ else
+ fx%root_element_name = name
+ fx%root_element_seen = .true.
+ endif
+ call push_elstack(name,fx%element_stack)
+ if (have_begin_handler) &
+ call begin_element_handler(str(name),fx%attributes)
+
+ else if (fx%context == CLOSING_TAG) then
+ name = fx%element_name
+
+ if (fx%debug) print *, "We have found a closing tag"
+ if (is_empty(fx%element_stack)) then
+ call build_error_info(error_info, &
+ "Nesting error: End tag: " // str(name) // &
+ " does not match -- too many end tags", &
+ line(fb),column(fb),fx%element_stack,SEVERE_ERROR_CODE)
+ if (have_error_handler) then
+ call error_handler(error_info)
+ else
+ call default_error_handler(error_info)
+ endif
+ else
+ call get_top_elstack(fx%element_stack,oldname)
+ if (oldname .equal. name) then
+ call pop_elstack(fx%element_stack,oldname)
+ if (have_end_handler) call end_element_handler(str(name))
+!! call pop_elstack(fx%element_stack,oldname)
+ else
+ call build_error_info(error_info, &
+ "Nesting error: End tag: " // str(name) // &
+ ". Expecting end of : " // str(oldname), &
+ line(fb),column(fb),fx%element_stack,SEVERE_ERROR_CODE)
+ if (have_error_handler) then
+ call error_handler(error_info)
+ else
+ call default_error_handler(error_info)
+ endif
+ endif
+ endif
+ else if (fx%context == SINGLE_TAG) then
+ name = fx%element_name
+
+ if (fx%debug) print *, "We have found a single (empty) tag: ", &
+ char(name)
+ !
+ ! Push name on to stack to reveal true xpath
+ !
+ call push_elstack(name,fx%element_stack)
+ if (have_empty_handler) then
+ if (fx%debug) print *, "--> calling empty_element_handler."
+ call empty_element_handler(str(name),fx%attributes)
+ call pop_elstack(fx%element_stack,dummy)
+ else
+ if (have_begin_handler) then
+ if (fx%debug) print *, "--> calling begin_element_handler..."
+ call begin_element_handler(str(name),fx%attributes)
+ endif
+ call pop_elstack(fx%element_stack,dummy)
+ if (have_end_handler) then
+ if (fx%debug) print *, "--> ... and end_element_handler."
+ call end_element_handler(str(name))
+ endif
+ endif
+!! call pop_elstack(fx%element_stack,dummy)
+
+ else if (fx%context == CDATA_SECTION_TAG) then
+
+ if (fx%debug) print *, "We found a CDATA section"
+ if (is_empty(fx%element_stack)) then
+ if (fx%debug) print *, &
+ "... Warning: CDATA section outside element context"
+ else
+ if (have_cdata_section_handler) then
+ call cdata_section_handler(str(fx%pcdata))
+ else
+ if (have_pcdata_handler) &
+ call pcdata_chunk_handler(str(fx%pcdata))
+ endif
+ endif
+
+ else if (fx%context == COMMENT_TAG) then
+
+ if (fx%debug) print *, "We found a comment tag"
+ if (have_comment_handler) &
+ call comment_handler(str(fx%pcdata))
+
+ else if (fx%context == SGML_DECLARATION_TAG) then
+
+ if (fx%debug) print *, "We found an sgml declaration"
+ if (have_sgml_declaration_handler) &
+ call sgml_declaration_handler(str(fx%pcdata))
+
+ else if (fx%context == XML_DECLARATION_TAG) then
+
+ if (fx%debug) print *, "We found an XML declaration"
+ name = fx%element_name
+ if (have_xml_declaration_handler) &
+ call xml_declaration_handler(str(name),fx%attributes)
+
+ else
+
+ ! do nothing
+
+ endif
+
+ else if (signal == CHUNK_OF_PCDATA) then
+
+ if (fx%debug) print *, "We found a chunk of PCDATA"
+ if (is_empty(fx%element_stack)) then
+ if (fx%debug) print *, "... Warning: PCDATA outside element context"
+ ! Just a warning
+ call build_error_info(error_info, &
+ "PCDATA outside of element context", &
+ line(fb),column(fb),fx%element_stack,WARNING_CODE)
+ if (have_error_handler) then
+ call error_handler(error_info)
+ else
+ call default_error_handler(error_info)
+ endif
+ else
+ !
+ ! Replace entities by their value
+ !
+ call entity_filter(fx%pcdata,translated_pcdata,status,message)
+ if (status < 0) then
+ call build_error_info(error_info, message, &
+ line(fb),-status,fx%element_stack,SEVERE_ERROR_CODE)
+ if (have_error_handler) then
+ call error_handler(error_info)
+ else
+ call default_error_handler(error_info)
+ endif
+ else if (status > 0) then
+ ! Just a warning
+ call build_error_info(error_info, message, &
+ line(fb),status,fx%element_stack,WARNING_CODE)
+ if (have_error_handler) then
+ call error_handler(error_info)
+ else
+ call default_error_handler(error_info)
+ endif
+ else
+ if (have_pcdata_handler) &
+ call pcdata_chunk_handler(str(translated_pcdata))
+ endif
+ endif
+
+ else if (signal == EXCEPTION) then
+ call build_error_info(error_info, fx%action, &
+ line(fb),column(fb),fx%element_stack,SEVERE_ERROR_CODE)
+ if (have_error_handler) then
+ call error_handler(error_info)
+ else
+ call default_error_handler(error_info)
+ endif
+ else
+ ! QUIET, do nothing
+ endif
+ if (signal /= QUIET) then
+ if (have_signal_handler) then
+ call signal_handler(pause_signal)
+ if (pause_signal) exit
+ endif
+ endif
+
+enddo
+
+end subroutine xml_parse
+
+!-----------------------------------------
+subroutine xml_path(fxml,path)
+type(xml_t), intent(in) :: fxml
+character(len=*), intent(out) :: path
+
+call get_elstack_signature(fxml%fx%element_stack,path)
+
+end subroutine xml_path
+
+!-----------------------------------------
+subroutine xml_mark_path(fxml,path)
+!
+! Marks the current path
+!
+type(xml_t), intent(inout) :: fxml
+character(len=*), intent(out) :: path
+
+call get_elstack_signature(fxml%fx%element_stack,fxml%path_mark)
+path = fxml%path_mark
+
+end subroutine xml_mark_path
+
+!-----------------------------------------
+subroutine xml_get_path_mark(fxml,path)
+!
+! Returns the currently markd path (or an empty string if there are no marks)
+!
+type(xml_t), intent(in) :: fxml
+character(len=*), intent(out) :: path
+
+path = fxml%path_mark
+
+end subroutine xml_get_path_mark
+
+!-----------------------------------------
+subroutine xml_name(fxml,name)
+type(xml_t), intent(in) :: fxml
+character(len=*), intent(out) :: name
+
+name = char(fxml%fx%element_name)
+
+end subroutine xml_name
+!-----------------------------------------
+subroutine xml_attributes(fxml,attributes)
+type(xml_t), intent(in) :: fxml
+type(dictionary_t), intent(out) :: attributes
+
+attributes = fxml%fx%attributes
+
+end subroutine xml_attributes
+
+end module m_xml_parser
+
+
+
+
Index: /XMLF90/src/strings/m_strings.f90
===================================================================
--- /XMLF90/src/strings/m_strings.f90 (revision 6)
+++ /XMLF90/src/strings/m_strings.f90 (revision 6)
@@ -0,0 +1,6323 @@
+!*******************************************************************************
+! module STRINGS
+! Mart Rentmeester, Mart.Rentmeester@sci.kun.nl
+! http://nn-online.sci.kun.nl/fortran
+! Version 1.0
+!*******************************************************************************
+
+ module m_strings
+
+ private
+
+ type string
+ private
+ integer :: len = 0
+ integer :: size = 0
+
+ character, pointer :: chars(:) => null()
+
+ end type string
+
+ character, parameter :: blank = ' '
+
+! GENERIC PROCEDURE INTERFACE DEFINITIONS
+
+!---- LEN interface
+ interface len
+ module procedure len_s
+ end interface
+
+!---- Conversion (to CHAR) procedure interfaces
+ interface char
+ module procedure s_to_c, &! string to character
+ s_to_slc ! string to specified length character
+ end interface
+
+!---- ASSIGNMENT interfaces
+ interface assignment(=)
+ module procedure assign_s_to_s, &! string = string
+ assign_s_to_c, &! character = string
+ assign_c_to_s ! string = character
+ end interface
+
+!---- // operator interfaces
+ interface operator(//)
+ module procedure s_concat_s, &! string // string
+ s_concat_c, &! string // character
+ c_concat_s ! character // string
+ end interface
+
+!---- INSERT_IN_STRING interface
+ interface insert_in_string
+ module procedure insert_in_string_c, insert_in_string_s
+ end interface
+
+!---- PREPEND_TO_STRING interface
+ interface prepend_to_string
+ module procedure prepend_to_string_c, prepend_to_string_s
+ end interface
+
+!---- APPEND_TO_STRING interface
+ interface append_to_string
+ module procedure append_to_string_c, append_to_string_s
+ end interface
+
+!---- REPLACE_IN_STRING interface
+ interface replace_in_string
+ module procedure replace_in_string_sc_s, replace_in_string_ss_s, &
+ replace_in_string_sc_sf, replace_in_string_ss_sf, &
+ replace_in_string_scc, replace_in_string_ssc, &
+ replace_in_string_scs, replace_in_string_sss, &
+ replace_in_string_scc_f, replace_in_string_ssc_f, &
+ replace_in_string_scs_f, replace_in_string_sss_f
+ end interface
+
+
+!---- REPEAT interface
+ interface repeat
+ module procedure repeat_s
+ end interface
+
+!---- == .eq. comparison operator interfaces
+ interface operator(==)
+ module procedure s_eq_s, &! string == string
+ s_eq_c, &! string == character
+ c_eq_s ! character == string
+ end interface
+
+!---- /= .ne. comparison operator interfaces
+ interface operator(/=)
+ module procedure s_ne_s, &! string /= string
+ s_ne_c, &! string /= character
+ c_ne_s ! character /= string
+ end interface
+
+!---- < .lt. comparison operator interfaces
+ interface operator(<)
+ module procedure s_lt_s, &! string < string
+ s_lt_c, &! string < character
+ c_lt_s ! character < string
+ end interface
+
+!---- <= .le. comparison operator interfaces
+ interface operator(<=)
+ module procedure s_le_s, &! string <= string
+ s_le_c, &! string <= character
+ c_le_s ! character <= string
+ end interface
+
+!---- >= .ge. comparison operator interfaces
+ interface operator(>=)
+ module procedure s_ge_s, &! string >= string
+ s_ge_c, &! string >= character
+ c_ge_s ! character >= string
+ end interface
+
+!---- > .gt. comparison operator interfaces
+ interface operator(>)
+ module procedure s_gt_s, &! string > string
+ s_gt_c, &! string > character
+ c_gt_s ! character > string
+ end interface
+
+!---- .aeq. comparison operator interfaces
+ interface operator(.aeq.)
+ module procedure a_eq_a, &! array == array
+ a_eq_c, &! array == character
+ c_eq_a ! character == array
+ end interface
+
+!---- .ane. comparison operator interfaces
+ interface operator(.ane.)
+ module procedure a_ne_a, &! array /= array
+ a_ne_c, &! array /= character
+ c_ne_a ! character /= array
+ end interface
+
+!---- .alt. comparison operator interfaces
+ interface operator(.alt.)
+ module procedure a_lt_a, &! array < array
+ a_lt_c, &! array < character
+ c_lt_a ! character < array
+ end interface
+
+!---- .ale. comparison operator interfaces
+ interface operator(.ale.)
+ module procedure a_le_a, &! array <= array
+ a_le_c, &! array <= character
+ c_le_a ! character <= array
+ end interface
+
+!---- .age. comparison operator interfaces
+ interface operator(.age.)
+ module procedure a_ge_a, &! array >= array
+ a_ge_c, &! array >= character
+ c_ge_a ! character >= array
+ end interface
+
+!---- .agt. comparison operator interfaces
+ interface operator(.agt.)
+ module procedure a_gt_a, &! array > array
+ a_gt_c, &! array > character
+ c_gt_a ! character > array
+ end interface
+
+!---- LLT comparison function interfaces
+ interface llt
+ module procedure s_llt_s, &! llt(string,string)
+ s_llt_c, &! llt(string,character)
+ c_llt_s ! llt(character,string)
+ end interface
+
+!---- LLE comparison function interfaces
+ interface lle
+ module procedure s_lle_s, &! lle(string,string)
+ s_lle_c, &! lle(string,character)
+ c_lle_s ! lle(character,string)
+ end interface
+
+!---- LGE comparison function interfaces
+ interface lge
+ module procedure s_lge_s, &! lge(string,string)
+ s_lge_c, &! lge(string,character)
+ c_lge_s ! lge(character,string)
+ end interface
+
+!---- LGT comparison function interfaces
+ interface lgt
+ module procedure s_lgt_s, &! lgt(string,string)
+ s_lgt_c, &! lgt(string,character)
+ c_lgt_s ! lgt(character,string)
+ end interface
+
+!---- ALLT comparison function interfaces
+ interface allt
+ module procedure a_allt_a, &! allt(array,array)
+ a_allt_c, &! allt(array,character)
+ c_allt_a ! allt(character,array)
+ end interface
+
+!---- ALLE comparison function interfaces
+ interface alle
+ module procedure a_alle_a, &! alle(array,array)
+ a_alle_c, &! alle(array,character)
+ c_alle_a ! alle(character,array)
+ end interface
+
+!---- ALGE comparison function interfaces
+ interface alge
+ module procedure a_alge_a, &! alge(array,array)
+ a_alge_c, &! alge(array,character)
+ c_alge_a ! alge(character,array)
+ end interface
+
+!---- ALGT comparison function interfaces
+ interface algt
+ module procedure a_algt_a, &! algt(array,array)
+ a_algt_c, &! algt(array,character)
+ c_algt_a ! algt(character,array)
+ end interface
+
+!---- INDEX procedure
+ interface index
+ module procedure index_ss, index_sc, index_cs
+ end interface
+
+!---- AINDEX procedure
+ interface aindex
+ module procedure aindex_aa, aindex_ac, aindex_ca
+ end interface
+
+!---- SCAN procedure
+ interface scan
+ module procedure scan_ss, scan_sc, scan_cs
+ end interface
+
+!---- ASCAN procedure
+ interface ascan
+ module procedure ascan_aa, ascan_ac, ascan_ca
+ end interface
+
+!---- VERIFY procedure
+ interface verify
+ module procedure verify_ss, verify_sc, verify_cs
+ end interface
+
+!---- AVERIFY procedure
+ interface averify
+ module procedure averify_aa, averify_ac, averify_ca
+ end interface
+
+!---- TRIM interface
+ interface len_trim
+ module procedure len_trim_s
+ end interface
+
+!---- LEN_TRIM interface
+ interface trim
+ module procedure trim_s
+ end interface
+
+!---- IACHAR interface
+ interface iachar
+ module procedure iachar_s
+ end interface
+
+!---- ICHAR interface
+ interface ichar
+ module procedure ichar_s
+ end interface
+
+!---- ADJUSTL interface
+ interface adjustl
+ module procedure adjustl_s
+ end interface
+
+!---- ADJUSTR interface
+ interface adjustr
+ module procedure adjustr_s
+ end interface
+
+!---- LEN_STRIP interface
+ interface len_strip
+ module procedure len_strip_c, len_strip_s
+ end interface
+
+!---- STRIP interface
+ interface strip
+ module procedure strip_c, strip_s
+ end interface
+
+!---- UPPERCASE interface
+ interface uppercase
+ module procedure uppercase_s, uppercase_c
+ end interface
+
+!---- TO_UPPERCASE interface
+ interface to_uppercase
+ module procedure to_uppercase_s, to_uppercase_c
+ end interface
+
+!---- LOWERCASE interface
+ interface lowercase
+ module procedure lowercase_s, lowercase_c
+ end interface
+
+!---- TO_LOWERCASE interface
+ interface to_lowercase
+ module procedure to_lowercase_s, to_lowercase_c
+ end interface
+
+!---- EXTRACT interface
+ interface extract
+ module procedure extract_s, extract_c
+ end interface
+
+!---- SUBSTRING interface
+ interface substring
+ module procedure extract_s, extract_c
+ end interface
+
+!---- REMOVE interface
+ interface remove
+ module procedure remove_s, remove_c
+ end interface
+
+!---- INSERT interface
+ interface insert
+ module procedure insert_ss, insert_cs, insert_sc, insert_cc
+ end interface
+
+!---- REPLACE interface
+ interface replace
+ module procedure replace_cc_s, replace_cs_s, &
+ replace_sc_s, replace_ss_s, &
+ replace_cc_sf, replace_cs_sf, &
+ replace_sc_sf, replace_ss_sf, &
+ replace_ccc, replace_csc, &
+ replace_ccs, replace_css, &
+ replace_scc, replace_ssc, &
+ replace_scs, replace_sss, &
+ replace_ccc_f, replace_csc_f, &
+ replace_ccs_f, replace_css_f, &
+ replace_scc_f, replace_ssc_f, &
+ replace_scs_f, replace_sss_f
+ end interface
+
+!---- SORT interface
+ interface sort
+ module procedure sort_c, sort_s
+ end interface
+
+!---- LSORT interface
+ interface lsort
+ module procedure lsort_c, lsort_s
+ end interface
+
+!---- RANK interface
+ interface rank
+ module procedure rank_c, rank_s
+ end interface
+
+!---- LRANK interface
+ interface lrank
+ module procedure lrank_c, lrank_s
+ end interface
+
+
+
+!---- Publically accessible entities
+ public :: string
+ public :: assignment(=),unstring
+ public :: insert,replace,remove,extract,substring
+ public :: repeat,index,scan,verify
+ public :: operator(//)
+ public :: operator(==),operator(/=)
+ public :: operator(<),operator(<=)
+ public :: operator(>),operator(>=)
+ public :: llt,lle,lge,lgt
+ public :: char,len,len_trim,trim,iachar,ichar,adjustl,adjustr
+ public :: lowercase,to_lowercase,uppercase,to_uppercase
+ public :: strip,len_strip
+ public :: sort,rank,lsort,lrank
+
+ public :: resize_string,string_size,swap_strings
+ public :: trim_string,strip_string
+ public :: adjustl_string,adjustr_string
+ public :: insert_in_string,remove_from_string
+ public :: prepend_to_string,append_to_string
+ public :: replace_in_string
+
+
+
+
+ contains
+
+!*******************************************************************************
+! LEN
+!*******************************************************************************
+
+ elemental function len_s(s)
+
+ implicit none
+ type(string), intent(in) :: s
+ integer :: len_s
+
+
+ len_s = s%len
+
+ end function len_s
+
+!*******************************************************************************
+! STRING_SIZE
+!*******************************************************************************
+
+ elemental function string_size(s)
+
+ implicit none
+ type(string), intent(in) :: s
+ integer :: string_size
+
+
+ string_size = s%size
+
+ end function string_size
+
+!*******************************************************************************
+! CHAR
+!*******************************************************************************
+! Returns the characters of string as an automatically sized character
+
+ pure function s_to_c(s)
+
+ implicit none
+ type(string),intent(in) :: s
+ character(len(s)) :: s_to_c
+
+
+ s_to_c = transfer(s%chars(1:len(s)),s_to_c)
+
+ end function s_to_c
+
+!*******************************************************************************
+! Returns the character of fixed length, length, containing the characters
+! of string either padded with blanks or truncated on the right to fit
+
+ pure function s_to_slc(s,length)
+
+ implicit none
+ type(string),intent(in) :: s
+ integer, intent(in) :: length
+ character(length) :: s_to_slc
+ integer :: i,lc
+
+
+ lc = min(len(s),length)
+ s_to_slc(1:lc) = transfer(s%chars(1:lc),s_to_slc)
+
+! Result longer than string: padding needed
+ if (lc < length) s_to_slc(lc+1:length) = blank
+
+ end function s_to_slc
+
+!*******************************************************************************
+! Assign a string value to a string variable overriding default assignement.
+! Reallocates string variable to size of string value and copies characters.
+
+ elemental subroutine assign_s_to_s(var,expr)
+
+ implicit none
+ type(string), intent(out) :: var
+ type(string), intent(in) :: expr
+
+
+
+ if (associated(var%chars,expr%chars)) then
+! Identity assignment: nothing to be done
+ continue
+ else
+ if (associated(var%chars)) deallocate(var%chars)
+
+ var%size = expr%size
+ var%len = expr%len
+!AG
+ if (associated(expr%chars)) then
+ allocate(var%chars(1:var%size))
+ var%chars(1:var%len) = expr%chars(1:var%len)
+ endif
+ endif
+
+
+ end subroutine assign_s_to_s
+
+!*******************************************************************************
+! Assign a string value to a character variable.
+! If the string is longer than the character truncate the string on the right.
+! If the string is shorter the character is blank padded on the right.
+
+ elemental subroutine assign_s_to_c(var,expr)
+
+ implicit none
+ character(*), intent(out) :: var
+ type(string), intent(in) :: expr
+ integer :: i,lc,ls
+
+
+ lc = len(var);
+ ls = min(len(expr),lc)
+
+ var(1:ls) = transfer(expr%chars(1:ls),var(1:ls))
+
+ do i=ls+1,lc
+ var(i:i) = blank
+ enddo
+
+ end subroutine assign_s_to_c
+
+!*******************************************************************************
+! Assign a character value to a string variable.
+! Disassociates the string variable from its current value, allocates new
+! space to hold the characters and copies them from the character value
+! into this space.
+
+ elemental subroutine assign_c_to_s(var,expr)
+
+ implicit none
+ type(string), intent(out) :: var
+ character(*), intent(in) :: expr
+ integer :: i,lc
+
+
+
+ if (associated(var%chars)) deallocate(var%chars)
+
+
+ lc = len(expr)
+ var%len = lc
+ var%size = lc
+ allocate(var%chars(1:lc))
+!!AG: NAG compiler uses temporaries here:
+ var%chars(:) = (/ (expr(i:i), i=1,lc) /)
+
+ endsubroutine assign_c_to_s
+
+!*******************************************************************************
+! RESIZE_STRING procedure
+!*******************************************************************************
+
+!*** return code
+!*** n < 0 --> deallocate?
+
+! pure subroutine resize_string(s,newsize,status)
+ pure subroutine resize_string(s,newsize)
+
+ implicit none
+ type(string), intent(inout) :: s
+ integer, intent(in) :: newsize
+! integer, intent(out), optional :: status
+
+ character, pointer :: c(:)
+
+ integer :: i
+
+
+ if (newsize <= 0) return
+
+
+ if (associated(s%chars)) then
+
+ i = min(newsize,s%len)
+ allocate(c(i))
+ c(:) = s%chars(1:i)
+ deallocate(s%chars)
+
+ s%chars => c
+
+ s%len = i
+ s%size = newsize
+ else
+ s%size = newsize
+ s%len = 0
+ allocate(s%chars(s%size))
+ endif
+
+ end subroutine resize_string
+
+!*******************************************************************************
+! SWAP_STRINGS
+!*******************************************************************************
+ subroutine swap_strings(s1,s2)
+
+
+ implicit none
+ type(string), intent(inout) :: s1,s2
+ integer :: l,s
+ character, pointer :: c(:)
+
+
+ l = s1%len
+ s = s1%size
+ c => s1%chars
+ s1%len = s2%len
+ s1%size = s2%size
+ s1%chars => s2%chars
+ s2%len = l
+ s2%size = s
+ s2%chars => c
+
+ end subroutine swap_strings
+
+!*******************************************************************************
+! TRIM_STRINGSIZE
+!*******************************************************************************
+
+ subroutine trim_stringsize(s)
+
+ implicit none
+ type(string), intent(inout) :: s
+
+
+ call resize_string(s,len(s))
+
+ end subroutine trim_stringsize
+
+!*******************************************************************************
+! TRIM_STRING
+!*******************************************************************************
+
+ subroutine trim_string(s)
+
+ implicit none
+ type(string), intent(inout) :: s
+
+
+ s%len = len_trim(s)
+
+ end subroutine trim_string
+
+!*******************************************************************************
+! STRIP
+!*******************************************************************************
+
+ pure subroutine strip_string(s)
+
+ implicit none
+ type(string), intent(inout) :: s
+ integer :: i,i1,i2
+
+
+ do i1=1,len(s)
+ if (s%chars(i1) /= blank) exit
+ enddo
+ do i2=len(s),1,-1
+ if (s%chars(i2) /= blank) exit
+ enddo
+ do i=i1,i2
+ s%chars(i-i1+1) = s%chars(i)
+ enddo
+ s%len = i2 - i1 + 1
+
+ end subroutine strip_string
+
+!*******************************************************************************
+! ADJUSTL_STRING
+!*******************************************************************************
+! Returns as a character variable the string adjusted to the left,
+! removing leading blanks and inserting trailing blanks.
+
+ pure subroutine adjustl_string(s)
+
+ implicit none
+ type(string), intent(inout) :: s
+ integer :: i,j
+
+
+ do i=1,len(s)
+ if (s%chars(i) /= blank) exit
+ enddo
+ do j=i,len(s)
+ s%chars(j-i:j-i) = s%chars(j)
+ enddo
+ s%chars(j+1:) = blank
+
+ end subroutine adjustl_string
+
+!*******************************************************************************
+! ADJUSTR_STRING
+!*******************************************************************************
+! Returns as a character variable the string adjusted to the right,
+! removing trailing blanks and inserting leading blanks.
+
+ pure subroutine adjustr_string(s)
+
+ implicit none
+ type(string), intent(inout) :: s
+ integer :: i,j,l,lt
+
+
+ l = len(s)
+ lt = len_trim(s)
+
+ i = l - lt
+
+ do j=1,lt
+ s%chars(j+i:j+i) = s%chars(j)
+ enddo
+ s%chars(1:i) = blank
+
+
+ end subroutine adjustr_string
+
+!*******************************************************************************
+! PREPEND_TO_STRING
+!*******************************************************************************
+
+ pure subroutine prepend_to_string_s(s1,s2)
+
+ implicit none
+ type(string), intent(inout) :: s1
+ type(string), intent(in) :: s2
+ integer :: i,ls1,ls2
+
+ character, pointer :: ss(:)
+
+
+ ls1 = len(s1)
+ ls2 = len(s2)
+ if (ls2 == 0) return
+ if (ls1+ls2 > string_size(s1)) then
+ allocate(ss(ls1+ls2))
+ do i=1,ls2
+ ss(i) = s2%chars(i)
+ enddo
+ do i=1,ls1
+ ss(ls2+i) = s1%chars(i)
+ enddo
+ deallocate(s1%chars)
+
+ s1%chars => ss
+
+ s1%len = ls1 + ls2
+ s1%size = s1%len
+ else
+ do i=ls1,1,-1
+ s1%chars(ls2+i) = s1%chars(i)
+ enddo
+ do i=1,ls2
+ s1%chars(i) = s2%chars(i)
+ enddo
+ s1%len = ls1 + ls2
+ endif
+
+ end subroutine prepend_to_string_s
+
+!*******************************************************************************
+
+ pure subroutine prepend_to_string_c(s,c)
+
+ implicit none
+ type(string), intent(inout) :: s
+ character(*), intent(in) :: c
+ integer :: i,ls,lc
+
+ character, pointer :: ss(:)
+
+
+
+ ls = len(s)
+ lc = len(c)
+ if (lc == 0) return
+ if (ls+lc > string_size(s)) then
+ allocate(ss(ls+lc))
+ do i=1,lc
+ ss(i) = c(i:i)
+ enddo
+ do i=1,ls
+ ss(lc+i) = s%chars(i)
+ enddo
+ deallocate(s%chars)
+
+ s%chars => ss
+
+ s%len = ls + lc
+ s%size = s%len
+ else
+ do i=ls,1,-1
+ s%chars(lc+i) = s%chars(i)
+ enddo
+ do i=1,lc
+ s%chars(i) = c(i:i)
+ enddo
+ s%len = ls + lc
+ endif
+
+ end subroutine prepend_to_string_c
+
+!*******************************************************************************
+! APPEND_TO_STRING
+!*******************************************************************************
+
+ pure subroutine append_to_string_s(s1,s2)
+
+ implicit none
+ type(string), intent(inout) :: s1
+ type(string), intent(in) :: s2
+ integer :: i,ls1,ls2
+
+ character, pointer :: ss(:)
+
+
+ ls1 = len(s1)
+ ls2 = len(s2)
+ if (ls2 == 0) return
+ if (ls1+ls2 > string_size(s1)) then
+ allocate(ss(ls1+ls2))
+ do i=1,ls1
+ ss(i) = s1%chars(i)
+ enddo
+ do i=ls1+1,ls1+ls2
+ ss(i) = s2%chars(i-ls1)
+ enddo
+ deallocate(s1%chars)
+
+ s1%chars => ss
+
+ s1%len = ls1 + ls2
+ s1%size = s1%len
+ else
+ do i=ls1+1,ls1+ls2
+ s1%chars(i) = s2%chars(i-ls1)
+ enddo
+ s1%len = ls1 + ls2
+ endif
+
+ end subroutine append_to_string_s
+
+!*******************************************************************************
+
+ pure subroutine append_to_string_c(s,c)
+
+ implicit none
+ type(string), intent(inout) :: s
+ character(*), intent(in) :: c
+ integer :: i,ls,lc
+
+ character, pointer :: ss(:)
+
+
+
+ ls = len(s)
+ lc = len(c)
+ if (lc == 0) return
+ if (ls+lc > string_size(s)) then
+ allocate(ss(ls+lc))
+ do i=1,ls
+ ss(i) = s%chars(i)
+ enddo
+ do i=ls+1,ls+lc
+ ss(i) = c(i-ls:i-ls)
+ enddo
+ deallocate(s%chars)
+
+ s%chars => ss
+
+ s%len = ls + lc
+ s%size = s%len
+ else
+ do i=ls+1,ls+lc
+ s%chars(i) = c(i-ls:i-ls)
+ enddo
+ s%len = ls + lc
+ endif
+
+ end subroutine append_to_string_c
+
+!*******************************************************************************
+! INSERT_IN_STRING
+!*******************************************************************************
+
+ pure subroutine insert_in_string_s(s1,start,s2)
+
+ implicit none
+ type(string), intent(inout) :: s1
+ type(string), intent(in) :: s2
+ integer, intent(in) :: start
+ integer :: i,ip,is,ls1,ls2
+
+ character, pointer :: ss(:)
+
+
+ ls1 = len(s1)
+ ls2 = len(s2)
+ if (ls2 == 0) return
+ if (ls1+ls2 > string_size(s1)) then
+ allocate(ss(ls1+ls2))
+ is = max(start,1)
+ ip = min(ls1+1,is)
+ do i=1,ip-1
+ ss(i) = s1%chars(i)
+ enddo
+ do i=ip,ip+ls2-1
+ ss(i) = s2%chars(i-ip+1)
+ enddo
+ do i=ip+ls2,ls1+ls2
+ ss(i) = s1%chars(i-ls2)
+ enddo
+ deallocate(s1%chars)
+
+ s1%chars => ss
+
+ s1%len = ls1 + ls2
+ s1%size = s1%len
+ else
+ is = max(start,1)
+ ip = min(ls1+1,is)
+ do i=ls1+ls2,ip+ls2,-1
+ s1%chars(i) = s1%chars(i-ls2)
+ enddo
+ do i=ip,ip+ls2-1
+ s1%chars(i) = s2%chars(i-ip+1)
+ enddo
+ s1%len = ls1 + ls2
+ endif
+
+ end subroutine insert_in_string_s
+
+!*******************************************************************************
+
+ pure subroutine insert_in_string_c(s,start,c)
+
+ implicit none
+ type(string), intent(inout) :: s
+ character(*), intent(in) :: c
+ integer, intent(in) :: start
+ integer :: i,ip,is,ls,lc
+
+ character, pointer :: ss(:)
+
+
+
+ ls = len(s)
+ lc = len(c)
+ if (lc == 0) return
+ if (ls+lc > string_size(s)) then
+ allocate(ss(ls+lc))
+ is = max(start,1)
+ ip = min(ls+1,is)
+ do i=1,ip-1
+ ss(i) = s%chars(i)
+ enddo
+ do i=ip,ip+lc-1
+ ss(i) = c(i-ip+1:i-ip+1)
+ enddo
+ do i=ip+lc,ls+lc
+ ss(i) = s%chars(i-lc)
+ enddo
+ deallocate(s%chars)
+
+ s%chars => ss
+
+ s%len = ls + lc
+ s%size = s%len
+ else
+ is = max(start,1)
+ ip = min(ls+1,is)
+ do i=ls+lc,ip+lc,-1
+ s%chars(i) = s%chars(i-lc)
+ enddo
+ do i=ip,ip+lc-1
+ s%chars(i) = c(i-ip+1:i-ip+1)
+ enddo
+ s%len = ls + lc
+ endif
+
+ end subroutine insert_in_string_c
+
+!*******************************************************************************
+! REPLACE_IN_STRING
+!*******************************************************************************
+! pure subroutine replace_in_string_ss_s(s,start,ss)
+!
+! implicit none
+! type(string), intent(inout) :: s
+! type(string), intent(in) :: ss
+! integer, intent(in) :: start
+!
+!
+! call replace_in_string_sc_s(s,start,char(ss))
+!
+! end subroutine replace_in_string_ss_s
+!*******************************************************************************
+
+!*******************************************************************************
+
+ pure subroutine replace_in_string_ss_s(s,start,ss)
+
+ implicit none
+ type(string), intent(inout) :: s
+ type(string), intent(in) :: ss
+ integer, intent(in) :: start
+ integer :: i,ip,is,lr,lss,ls
+ character, pointer :: rs(:)
+ logical :: new
+
+
+ lr = lr_ss_s(s,start,ss)
+ lss = len(ss)
+ ls = len(s)
+ is = max(start,1)
+ ip = min(ls+1,is)
+
+ new = lr > string_size(s)
+
+ if (new) then
+ allocate(rs(lr))
+ else
+ rs => s%chars
+ endif
+
+ do i=lr,ip+lss,-1
+ rs(i) = s%chars(i)
+ enddo
+ do i=lss,1,-1
+ rs(ip-1+i) = ss%chars(i)
+ enddo
+ if (new) then
+ do i=1,ip-1
+ rs(i) = s%chars(i)
+ enddo
+ endif
+
+ if (new) then
+ deallocate(s%chars)
+ s%chars => rs
+ s%size = lr
+ else
+ nullify(rs)
+ endif
+ s%len = lr
+
+ end subroutine replace_in_string_ss_s
+
+!*******************************************************************************
+! pure subroutine replace_in_string_ss_sf(s,start,finish,ss)
+!
+! implicit none
+! type(string), intent(inout) :: s
+! type(string), intent(in) :: ss
+! integer, intent(in) :: start,finish
+!
+!
+! call replace_in_string_sc_sf(s,start,finish,char(ss))
+!
+! end subroutine replace_in_string_ss_sf
+!*******************************************************************************
+
+!*******************************************************************************
+
+ pure subroutine replace_in_string_ss_sf(s,start,finish,ss)
+
+ implicit none
+ type(string), intent(inout) :: s
+ type(string), intent(in) :: ss
+ integer, intent(in) :: start,finish
+ integer :: i,if,ip,is,lr,ls,lss
+ character, pointer :: rs(:)
+ logical :: new
+
+
+ lr = lr_ss_sf(s,start,finish,ss)
+ lss = len(ss)
+ ls = len(s)
+ is = max(start,1)
+ ip = min(ls+1,is)
+ if = max(ip-1,min(finish,ls))
+
+ new = lr > string_size(s)
+
+ if (new) then
+ allocate(rs(lr))
+ else
+ rs => s%chars
+ endif
+
+ do i=1,lr-ip-lss+1
+ rs(i+ip+lss-1) = s%chars(if+i)
+ enddo
+ do i=lss,1,-1
+ rs(i+ip-1) = ss%chars(i)
+ enddo
+ if (new) then
+ do i=1,ip-1
+ rs(i) = s%chars(i)
+ enddo
+ endif
+
+ if (new) then
+ deallocate(s%chars)
+ s%chars => rs
+ s%size = lr
+ else
+ nullify(rs)
+ endif
+ s%len = lr
+
+ end subroutine replace_in_string_ss_sf
+
+!*******************************************************************************
+
+!*******************************************************************************
+
+ pure subroutine replace_in_string_sc_s(s,start,c)
+
+ implicit none
+ type(string), intent(inout) :: s
+ character(*), intent(in) :: c
+ integer, intent(in) :: start
+ integer :: i,ip,is,lc,lr,ls
+ character, pointer :: rs(:)
+ logical :: new
+
+
+ lr = lr_sc_s(s,start,c)
+ lc = len(c)
+ ls = len(s)
+ is = max(start,1)
+ ip = min(ls+1,is)
+
+ new = lr > string_size(s)
+
+ if (new) then
+ allocate(rs(lr))
+ else
+ rs => s%chars
+ endif
+
+ do i=lr,ip+lc,-1
+ rs(i) = s%chars(i)
+ enddo
+ do i=lc,1,-1
+ rs(ip-1+i) = c(i:i)
+ enddo
+ if (new) then
+ do i=1,ip-1
+ rs(i) = s%chars(i)
+ enddo
+ endif
+
+ if (new) then
+ deallocate(s%chars)
+ s%chars => rs
+ s%size = lr
+ else
+ nullify(rs)
+ endif
+ s%len = lr
+
+ end subroutine replace_in_string_sc_s
+
+!*******************************************************************************
+
+!*******************************************************************************
+
+ pure subroutine replace_in_string_sc_sf(s,start,finish,c)
+
+ implicit none
+ type(string), intent(inout) :: s
+ character(*), intent(in) :: c
+ integer, intent(in) :: start,finish
+ integer :: i,if,ip,is,lc,lr,ls
+ character, pointer :: rs(:)
+ logical :: new
+
+
+ lr = lr_sc_sf(s,start,finish,c)
+ lc = len(c)
+ ls = len(s)
+ is = max(start,1)
+ ip = min(ls+1,is)
+ if = max(ip-1,min(finish,ls))
+
+ new = lr > string_size(s)
+
+ if (new) then
+ allocate(rs(lr))
+ else
+ rs => s%chars
+ endif
+
+ do i=1,lr-ip-lc+1
+ rs(i+ip+lc-1) = s%chars(if+i)
+ enddo
+ do i=lc,1,-1
+ rs(i+ip-1) = c(i:i)
+ enddo
+ if (new) then
+ do i=1,ip-1
+ rs(i) = s%chars(i)
+ enddo
+ endif
+
+ if (new) then
+ deallocate(s%chars)
+ s%chars => rs
+ s%size = lr
+ else
+ nullify(rs)
+ endif
+ s%len = lr
+
+ end subroutine replace_in_string_sc_sf
+
+!*******************************************************************************
+!*******************************************************************************
+!*******************************************************************************
+
+ pure subroutine replace_in_string_scc(s,target,ss)
+
+ implicit none
+ type(string), intent(inout) :: s
+ character(*), intent(in) :: target,ss
+
+
+ call x_replace_in_string_scc(s,target,ss,'first')
+
+
+ end subroutine replace_in_string_scc
+
+!*******************************************************************************
+
+ pure subroutine replace_in_string_scc_f(s,target,ss,action)
+
+ implicit none
+ type(string), intent(inout) :: s
+ character(*), intent(in) :: target,ss,action
+
+
+ call x_replace_in_string_scc(s,target,ss,action)
+
+ end subroutine replace_in_string_scc_f
+
+!*******************************************************************************
+
+ pure subroutine x_replace_in_string_scc(s,target,ss,action)
+
+ implicit none
+ type(string), intent(inout) :: s
+ character(*), intent(in) :: target,ss,action
+ logical :: every,back
+ integer :: lr,ls,lt,lss
+ integer :: i,i1,i2,k1,k2,m1,m2
+
+ character, pointer :: rs(:)
+
+
+
+ lr = lr_scc(s,target,ss,action)
+ ls = len(s)
+ lt = len(target)
+ lss = len(ss)
+
+ if (lt == 0) then
+ if (ls == 0) then
+ do i=1,lss
+ s%chars(i) = ss(i:i)
+ enddo
+ s%len = lss
+ endif
+ return
+ endif
+
+ select case(uppercase(action))
+ case('FIRST')
+ back = .false.
+ every = .false.
+ case('LAST')
+ back = .true.
+ every = .false.
+ case('ALL')
+ back = .false.
+ every = .true.
+ case default
+ back = .false.
+ every = .false.
+ end select
+
+ allocate(rs(lr))
+
+ if (back) then
+! Backwards search
+
+! k2 points to the absolute position one before the target in string
+ k2 = ls
+ m2 = lr
+ do
+! find the next occurrence of target
+ i1 = aindex(s%chars(:k2),target,back)
+ if (i1 == 0) then
+! fill up to the end
+ rs(:m2) = s%chars(:k2)
+ exit
+ endif
+! i1 points to the absolute position of the first
+! letter of target in string
+! i2 points to the absolute position of the last
+! letter of target in string
+ i2 = i1 + lt - 1
+
+! copy the unaffected text string chunk after it
+! k1 points to the absolute position one after target in string
+ k1 = i2 + 1
+ m1 = m2 + k1 - k2
+ rs(m1:m2) = s%chars(k1:k2)
+ m2 = m1 - 1
+ m1 = m2 - lss + 1
+! copy the replacement substring for target
+ do i=1,lss
+ rs(m1+i-1) = ss(i:i)
+ enddo
+
+! k2 points to the absolute position one before the target in string
+ k2 = i1 - 1
+ m2 = m1 - 1
+ if (.not.every) then
+ rs(:m2) = s%chars(:k2)
+ exit
+ endif
+ enddo
+ else
+! Forward search
+
+! k1 points to the absolute position one after target in string
+ k1 = 1
+ m1 = 1
+ do
+! find the next occurrence of target
+ i1 = aindex(s%chars(k1:),target)
+ if (i1 == 0) then
+! fill up to the end
+ rs(m1:lr) = s%chars(k1:ls)
+ exit
+ endif
+! i1 points to the absolute position of the first
+! letter of target in string
+ i1 = k1 + (i1 - 1)
+! i2 points to the absolute position of the last
+! letter of target in string
+ i2 = i1 + lt - 1
+
+! copy the unaffected text string chunk before it
+! k2 points to the absolute position one before the target in string
+ k2 = i1 - 1
+ m2 = m1 + k2 - k1
+ rs(m1:m2) = s%chars(k1:k2)
+ m1 = m2 + 1
+ m2 = m1 + lss - 1
+! copy the replacement substring for target
+ do i=1,lss
+ rs(m1+i-1) = ss(i:i)
+ enddo
+
+! k1 points to the absolute position one after target in string
+ k1 = i2 + 1
+ m1 = m2 + 1
+ if (.not.every) then
+ rs(m1:lr) = s%chars(k1:ls)
+ exit
+ endif
+ enddo
+ endif
+
+
+ if (associated(s%chars)) deallocate(s%chars)
+ s%chars => rs
+
+ s%len = lr
+ s%size = size(s%chars)
+
+ end subroutine x_replace_in_string_scc
+
+!*******************************************************************************
+
+ pure subroutine replace_in_string_ssc(s,target,ss)
+
+ implicit none
+ type(string), intent(inout) :: s
+ type(string), intent(in) :: target
+ character(*), intent(in) :: ss
+
+
+ call x_replace_in_string_scc(s,char(target),ss,'first')
+
+ end subroutine replace_in_string_ssc
+
+!*******************************************************************************
+
+ pure subroutine replace_in_string_ssc_f(s,target,ss,action)
+
+ implicit none
+ type(string), intent(inout) :: s
+ type(string), intent(in) :: target
+ character(*), intent(in) :: ss,action
+
+
+ call x_replace_in_string_scc(s,char(target),ss,action)
+
+ end subroutine replace_in_string_ssc_f
+
+!*******************************************************************************
+
+ pure subroutine replace_in_string_scs(s,target,ss)
+
+ implicit none
+ type(string), intent(inout) :: s
+ type(string), intent(in) :: ss
+ character(*), intent(in) :: target
+
+
+ call x_replace_in_string_scc(s,target,char(ss),'first')
+
+ end subroutine replace_in_string_scs
+
+!*******************************************************************************
+
+ pure subroutine replace_in_string_scs_f(s,target,ss,action)
+
+ implicit none
+ type(string), intent(inout) :: s
+ type(string), intent(in) :: ss
+ character(*), intent(in) :: target,action
+
+
+ call x_replace_in_string_scc(s,target,char(ss),action)
+
+ end subroutine replace_in_string_scs_f
+
+!*******************************************************************************
+
+ pure subroutine replace_in_string_sss(s,target,ss)
+
+ implicit none
+ type(string), intent(inout) :: s
+ type(string), intent(in) :: ss,target
+
+
+ call x_replace_in_string_scc(s,char(target),char(ss),'first')
+
+ end subroutine replace_in_string_sss
+
+!*******************************************************************************
+
+ pure subroutine replace_in_string_sss_f(s,target,ss,action)
+
+ implicit none
+ type(string), intent(inout) :: s
+ type(string), intent(in) :: ss,target
+ character(*), intent(in) :: action
+
+
+ call x_replace_in_string_scc(s,char(target),char(ss),action)
+
+ end subroutine replace_in_string_sss_f
+
+!*******************************************************************************
+! REMOVE_FROM_STRING
+!*******************************************************************************
+
+ pure subroutine remove_from_string(s,start,finish)
+
+ implicit none
+ type(string), intent(inout) :: s
+ integer, intent(in) :: start,finish
+ integer :: i,if,is,le,ls
+
+
+ is = max(1,start)
+ ls = len(s)
+ if = min(ls,finish)
+ if (if < is) return
+
+ le = if - is + 1 ! = len_extract
+ do i=if+1,ls
+ s%chars(i-le) = s%chars(i)
+ enddo
+ s%len = s%len - le
+
+ end subroutine remove_from_string
+
+!*******************************************************************************
+! UNSTRING procedure
+!*******************************************************************************
+! Deallocate the chars in the string to avoid leaking of memory
+! Use this in functions and subroutines on locally declared variables
+! of type string after their use. (I.e. garbage collecting).
+
+ elemental subroutine unstring(s)
+
+ implicit none
+ type(string), intent(inout) :: s
+
+
+
+ if (associated(s%chars)) deallocate(s%chars)
+ nullify(s%chars)
+
+ s%size = 0
+ s%len = 0
+
+ end subroutine unstring
+
+!*******************************************************************************
+! //
+!*******************************************************************************
+! string // string
+
+ pure function s_concat_s(s1,s2)
+
+ implicit none
+ type(string), intent(in) :: s1,s2
+ character(len(s1)+len(s2)) :: s_concat_s
+ integer :: l1,l2
+
+
+ l1 = len(s1)
+ l2 = len(s2)
+ s_concat_s(1:l1) = s1
+ s_concat_s(1+l1:l1+l2) = s2
+
+ end function s_concat_s
+
+!*******************************************************************************
+! string // character
+
+ pure function s_concat_c(s,c)
+
+ implicit none
+ type(string), intent(in) :: s
+ character(*), intent(in) :: c
+ character(len(s)+len(c)) :: s_concat_c
+ integer :: ls,lc
+
+
+ ls = len(s)
+ lc = len(c)
+ s_concat_c(1:ls) = s
+ s_concat_c(1+ls:ls+lc) = c
+
+ end function s_concat_c
+
+!*******************************************************************************
+! character // string
+
+ pure function c_concat_s(c,s)
+
+ implicit none
+ character(*), intent(in) :: c
+ type(string), intent(in) :: s
+ character(len(s)+len(c)) :: c_concat_s
+ integer :: lc,ls
+
+
+ lc = len(c)
+ ls = len(s)
+ c_concat_s(1:lc) = c
+ c_concat_s(1+lc:lc+ls) = s
+
+ end function c_concat_s
+
+!*******************************************************************************
+! REPEAT
+!*******************************************************************************
+
+ function repeat_s(s,ncopies)
+
+ implicit none
+ type(string), intent(in) :: s
+ integer, intent(in) :: ncopies
+ character(ncopies*len(s)) :: repeat_s
+
+
+ if (ncopies < 0) stop 'Negative ncopies requested in REPEAT'
+ repeat_s = repeat(char(s),ncopies)
+
+ end function repeat_s
+
+!*******************************************************************************
+! LEN_TRIM
+!*******************************************************************************
+
+ elemental function len_trim_s(s)
+
+ implicit none
+ type(string), intent(in) :: s
+ integer :: len_trim_s
+
+ if (len(s) == 0) then
+ len_trim_s = 0
+ return
+ endif
+ do len_trim_s = len(s),1,-1
+ if (s%chars(len_trim_s) /= blank) return
+ end do
+
+ end function len_trim_s
+
+!*******************************************************************************
+! TRIM
+!*******************************************************************************
+
+ pure function trim_s(s)
+
+ implicit none
+ type(string), intent(in) :: s
+ character(len_trim(s)) :: trim_s
+ integer :: i
+
+
+ do i=1,len(trim_s)
+ trim_s(i:i) = s%chars(i)
+ enddo
+
+ end function trim_s
+
+!*******************************************************************************
+! IACHAR
+!*******************************************************************************
+! Returns the position of the character string in the ISO 646 collating
+! sequence. String must be of length one, otherwise result is as for
+! intrinsic iachar.
+
+ elemental function iachar_s(s)
+
+ implicit none
+ type(string), intent(in) :: s
+ integer :: iachar_s
+
+
+ iachar_s = iachar(char(s))
+
+ end function iachar_s
+
+!*******************************************************************************
+! ICHAR
+!*******************************************************************************
+! Returns the position of character from string in the processor collating
+! sequence. String must be of length one, otherwise it will behave as the
+! intrinsic ichar with the equivalent character string.
+
+ elemental function ichar_s(s)
+
+ implicit none
+ type(string), intent(in) :: s
+ integer :: ichar_s
+
+
+ ichar_s = ichar(char(s))
+
+ end function ichar_s
+
+!*******************************************************************************
+! ADJUSTL
+!*******************************************************************************
+! Returns as a character variable the string adjusted to the left,
+! removing leading blanks and inserting trailing blanks.
+
+ pure function adjustl_s(s)
+
+ implicit none
+ type(string), intent(in) :: s
+ character(len(s)) :: adjustl_s
+
+
+ adjustl_s = adjustl(char(s))
+
+ end function adjustl_s
+
+!*******************************************************************************
+! ADJUSTR
+!*******************************************************************************
+! Returns as a character variable the string adjusted to the right,
+! removing trailing blanks and inserting leading blanks.
+
+ pure function adjustr_s(s)
+
+ implicit none
+ type(string), intent(in) :: s
+ character(len(s)) :: adjustr_s
+
+
+ adjustr_s = adjustr(char(s))
+
+ end function adjustr_s
+
+!*******************************************************************************
+! LEN_STRIP
+!*******************************************************************************
+
+ elemental function len_strip_s(s)
+
+ implicit none
+ type(string), intent(in) :: s
+ integer :: len_strip_s
+ integer :: i1,i2
+
+
+ do i1=1,len(s)
+ if (s%chars(i1) /= blank) exit
+ enddo
+ do i2=len(s),1,-1
+ if (s%chars(i2) /= blank) exit
+ enddo
+ len_strip_s = max(0,i2-i1+1)
+
+ end function len_strip_s
+
+!*******************************************************************************
+! STRIP
+!*******************************************************************************
+
+ pure function strip_s(s)
+
+ implicit none
+ type(string), intent(in) :: s
+ character(len_strip(s)) :: strip_s
+ integer :: i,j
+
+
+ do i=1,len(s)
+ if (s%chars(i) /= blank) exit
+ enddo
+ do j=1,len(strip_s)
+ strip_s(j:j) = s%chars(i+j-1)
+ enddo
+
+ end function strip_s
+
+!*******************************************************************************
+
+ elemental function len_strip_c(c)
+
+ implicit none
+ character(*), intent(in) :: c
+ integer :: len_strip_c
+ integer :: i1,i2
+
+
+ do i1=1,len(c)
+ if (c(i1:i1) /= blank) exit
+ enddo
+ i2 = len_trim(c)
+ len_strip_c = max(0,i2-i1+1)
+
+ end function len_strip_c
+
+!*******************************************************************************
+
+ pure function strip_c(c)
+
+ implicit none
+ character(*), intent(in) :: c
+ character(len_strip(c)) :: strip_c
+ integer :: i
+
+
+ do i=1,len(c)
+ if (c(i:i) /= blank) exit
+ enddo
+ strip_c(1:) = c(i:)
+
+ end function strip_c
+
+!*******************************************************************************
+! EXTRACT
+!*******************************************************************************
+ elemental FUNCTION len_extract_s(s,start,finish)
+
+ implicit none
+ type(string), intent(in) :: s
+ integer, intent(in) :: start,finish
+ integer :: len_extract_s
+ integer :: is,if
+
+
+ is = max(1,start)
+ if = min(len(s),finish)
+ if (if < is) then
+ len_extract_s = 0
+ else
+ len_extract_s = max(0,if-is) + 1
+ endif
+
+ end function len_extract_s
+
+!*****************************************************
+ pure function extract_s(s,start,finish)
+
+ implicit none
+ type(string), intent(in) :: s
+ integer, intent(in) :: start,finish
+ character(len_extract_s(s,start,finish)) :: extract_s
+ integer :: i,is,if
+
+
+ is = max(1,start)
+ if = min(len(s),finish)
+ if (if < is) then
+ extract_s = ''
+ else
+ do i=1,max(0,if-is+1)
+ extract_s(i:i) = s%chars(is+i-1)
+ enddo
+ endif
+
+ end function extract_s
+
+!*******************************************************************************
+
+! elemental FUNCTION len_extract_s(s,start,finish)
+
+! implicit none
+! type(string), intent(in) :: s
+! integer, intent(in) :: start,finish
+! integer :: len_extract_s
+! integer :: is,if
+
+
+! is = max(1,start)
+! if = min(len(s),finish)
+! if (if < is) then
+! len_extract_s = 0
+! else
+! len_extract_s = max(0,if-is) + 1
+! endif
+
+! end function len_extract_s
+
+!*******************************************************************************
+
+ elemental function len_extract_c(c,start,finish)
+
+ implicit none
+ character(*), intent(in) :: c
+ integer, intent(in) :: start,finish
+ integer :: len_extract_c
+ integer :: is,if
+
+
+ is = max(1,start)
+ if = min(len(c),finish)
+ if (if < is) then
+ len_extract_c = 0
+ else
+ len_extract_c = max(0,if-is) + 1
+ endif
+
+ end function len_extract_c
+
+!*******************************************************************************
+
+ pure function extract_c(c,start,finish)
+
+ implicit none
+ character(*), intent(in) :: c
+ integer, intent(in) :: start,finish
+ character(len_extract_c(c,start,finish)) :: extract_c
+ integer :: is,if
+
+
+ is = max(1,start)
+ if = min(len(c),finish)
+ if (if < is) then
+ extract_c = ''
+ else
+ extract_c(1:if-is+1) = c(is:if)
+ endif
+
+ end function extract_c
+
+!*******************************************************************************
+
+! elemental function len_extract_c(c,start,finish)
+
+! implicit none
+! character(*), intent(in) :: c
+! integer, intent(in) :: start,finish
+! integer :: len_extract_c
+! integer :: is,if
+
+
+! is = max(1,start)
+! if = min(len(c),finish)
+! if (if < is) then
+! len_extract_c = 0
+! else
+! len_extract_c = max(0,if-is) + 1
+! endif
+
+! end function len_extract_c
+
+!*******************************************************************************
+! INSERT
+!*******************************************************************************
+
+ pure function insert_ss(s1,start,s2)
+
+ implicit none
+ type(string), intent(in) :: s1,s2
+ integer, intent(in) :: start
+ character(len(s1)+len(s2)) :: insert_ss
+ integer :: i,ip,is,ls1,ls2
+
+
+ ls1 = len(s1)
+ ls2 = len(s2)
+ is = max(start,1)
+ ip = min(ls1+1,is)
+ do i=1,ip-1
+ insert_ss(i:i) = s1%chars(i)
+ enddo
+ do i=ip,ip+ls2-1
+ insert_ss(i:i) = s2%chars(i-ip+1)
+ enddo
+ do i=ip+ls2,ls1+ls2
+ insert_ss(i:i) = s1%chars(i-ls2)
+ enddo
+
+ end function insert_ss
+
+!*******************************************************************************
+
+ pure function insert_sc(s1,start,c2)
+
+ implicit none
+ type(string), intent(in) :: s1
+ character(*), intent(in) :: c2
+ integer, intent(in) :: start
+ character(len(s1)+len(c2)) :: insert_sc
+ integer :: i,ip,is,ls1,ls2
+
+
+ ls1 = len(s1)
+ ls2 = len(c2)
+ is = max(start,1)
+ ip = min(ls1+1,is)
+ do i=1,ip-1
+ insert_sc(i:i) = s1%chars(i)
+ enddo
+ insert_sc(ip:ip+ls2-1) = c2
+ do i=ip+ls2,ls1+ls2
+ insert_sc(i:i) = s1%chars(i-ls2)
+ enddo
+
+ end function insert_sc
+
+!*******************************************************************************
+
+ pure function insert_cs(c1,start,s2)
+
+ implicit none
+ character(*), intent(in) :: c1
+ type(string), intent(in) :: s2
+ integer, intent(in) :: start
+ character(len(c1)+len(s2)) :: insert_cs
+ integer :: i,ip,is,ls1,ls2
+
+
+ ls1 = len(c1)
+ ls2 = len(s2)
+ is = max(start,1)
+ ip = min(ls1+1,is)
+ insert_cs(1:ip-1) = c1(1:ip-1)
+ do i=ip,ip+ls2-1
+ insert_cs(i:i) = s2%chars(i-ip+1)
+ enddo
+ insert_cs(ip+ls2:ls1+ls2) = c1(ip:ls1)
+
+ end function insert_cs
+
+!*******************************************************************************
+
+ pure function insert_cc(c1,start,c2)
+
+ implicit none
+ character(*), intent(in) :: c1,c2
+ integer, intent(in) :: start
+ character(len(c1)+len(c2)) :: insert_cc
+ integer :: ip,is,ls1,ls2
+
+
+ ls1 = len(c1)
+ ls2 = len(c2)
+ is = max(start,1)
+ ip = min(ls1+1,is)
+ insert_cc(1:ip-1) = c1(1:ip-1)
+ insert_cc(ip:ip+ls2-1) = c2
+ insert_cc(ip+ls2:ls1+ls2) = c1(ip:ls1)
+
+ end function insert_cc
+
+!*******************************************************************************
+! REMOVE
+!*******************************************************************************
+
+ pure function remove_c(c,start,finish)
+
+ implicit none
+ character(*), intent(in) :: c
+ integer, intent(in) :: start,finish
+ character(len(c)-len_extract_c(c,start,finish)) :: remove_c
+ integer :: if,is,ls
+
+
+ is = max(1,start)
+ ls = len(c)
+ if = min(ls,finish)
+ if (if < is) then
+ remove_c = c
+ else
+ remove_c = c(1:is-1) // c(if+1:)
+ endif
+
+ end function remove_c
+
+!*******************************************************************************
+
+ pure function remove_s(s,start,finish)
+
+ implicit none
+ type(string), intent(in) :: s
+ integer, intent(in) :: start,finish
+ character(len(s)-len_extract_s(s,start,finish)) :: remove_s
+ integer :: i,if,is,le,ls
+
+
+ is = max(1,start)
+ ls = len(s)
+ if = min(ls,finish)
+ if (if < is) then
+ remove_s = s
+ else
+ le = if - is + 1
+ do i=1,is-1
+ remove_s(i:i) = s%chars(i)
+ enddo
+ do i=if+1,ls
+ remove_s(i-le:i-le) = s%chars(i)
+ enddo
+ endif
+
+ end function remove_s
+
+!*******************************************************************************
+! REPLACE
+!*******************************************************************************
+
+ pure function lr_cc_s(s,start,ss) result(l)
+
+ implicit none
+ character(*), intent(in) :: s,ss
+ integer, intent(in) :: start
+ integer :: l
+ integer :: ip,is,ls,lss
+
+
+ l = max(len(s),min(len(s)+1,max(start,1)+len(ss)-1))
+
+ end function lr_cc_s
+
+!*******************************************************************************
+! Calculate the result string by the following actions:
+! Insert the characters from substring SS into string STR beginning
+! at position START replacing the following LEN(SUBSTRING) characters of
+! the string and enlarging string if necessary. If START is greater than
+! LEN(STRING) substring is simply appended to string by concatenation.
+! If START is less than 1, substring replaces characters in string
+! starting at 1
+
+ function replace_cc_s(s,start,ss) result(r)
+
+ implicit none
+ character(*), intent(in) :: s,ss
+ integer, intent(in) :: start
+ character(lr_cc_s(s,start,ss)) :: r
+ integer :: ip,is,l,lss,ls
+
+
+ lss = len(ss)
+ ls = len(s)
+ is = max(start,1)
+ ip = min(ls+1,is)
+ l = len(r)
+
+ r(1:ip-1) = s(1:ip-1)
+ r(ip:ip+lss-1) = ss
+ r(ip+lss:l) = s(ip+lss:ls)
+
+ end function replace_cc_s
+
+!*******************************************************************************
+
+ pure function lr_cc_sf(s,start,finish,ss) result(l)
+
+ implicit none
+ character(*), intent(in) :: s,ss
+ integer, intent(in) :: start,finish
+ integer :: l
+ integer :: if,ip,is,ls,lss
+
+
+ lss = len(ss)
+ ls = len(s)
+ is = max(start,1)
+ ip = min(ls+1,is)
+ if = max(ip-1,min(finish,ls))
+ l = lss + ls - if+ip-1
+
+ end function lr_cc_sf
+
+!*******************************************************************************
+! Calculates the result string by the following actions:
+! Insert the substring SS into string STR beginning at position
+! START replacing the following FINISH-START+1 characters of the string
+! and enlarging or shrinking the string if necessary.
+! If start is greater than LEN(STRING) substring is simply appended to
+! string by concatenation. If START is less than 1, START = 1 is used.
+! If FINISH is greater than LEN(STRING), FINISH = LEN(STRING) is used.
+! If FINISH is less than START, substring is inserted before START.
+
+ function replace_cc_sf(s,start,finish,ss) result(r)
+
+ implicit none
+ character(*), intent(in) :: s,ss
+ integer, intent(in) :: start,finish
+ character(lr_cc_sf(s,start,finish,ss)) :: r
+ integer :: i,if,ip,is,l,ls,lss
+
+
+ lss = len(ss)
+ ls = len(s)
+ is = max(start,1)
+ ip = min(ls+1,is)
+ if = max(ip-1,min(finish,ls))
+ l = len(r)
+
+ r(1:ip-1) = s(1:ip-1)
+ do i=1,lss
+ r(i+ip-1:i+ip-1) = ss(i:i)
+ enddo
+ do i=1,l-ip-lss+1
+ r(i+ip+lss-1:i+ip+lss-1) = s(if+i:if+i)
+ enddo
+
+ end function replace_cc_sf
+
+!*******************************************************************************
+
+ pure function lr_cs_s(s,start,ss) result(l)
+
+ implicit none
+ character(*), intent(in) :: s
+ type(string), intent(in) :: ss
+ integer, intent(in) :: start
+ integer :: l
+ integer :: ip,is,ls,lss
+
+
+ l = max(len(s),min(len(s)+1,max(start,1)+len(ss)-1))
+
+ end function lr_cs_s
+
+!*******************************************************************************
+! Calculate the result string by the following actions:
+! Insert the characters from substring SS into string STR beginning
+! at position START replacing the following LEN(SUBSTRING) characters of
+! the string and enlarging string if necessary. If START is greater than
+! LEN(STRING) substring is simply appended to string by concatenation.
+! If START is less than 1, substring replaces characters in string
+! starting at 1
+
+ function replace_cs_s(s,start,ss) result(r)
+
+ implicit none
+ character(*), intent(in) :: s
+ type(string), intent(in) :: ss
+ integer, intent(in) :: start
+ character(lr_cs_s(s,start,ss)) :: r
+ integer :: i,ip,is,l,lss,ls
+
+
+ lss = len(ss)
+ ls = len(s)
+ is = max(start,1)
+ ip = min(ls+1,is)
+ l = len(r)
+
+ r(1:ip-1) = s(1:ip-1)
+ r(ip:ip+lss-1) = transfer(ss%chars(1:lss),r(1:lss))
+ r(ip+lss:l) = s(ip+lss:ls)
+
+ end function replace_cs_s
+
+!*******************************************************************************
+
+ pure function lr_cs_sf(s,start,finish,ss) result(l)
+
+ implicit none
+ character(*), intent(in) :: s
+ type(string), intent(in) :: ss
+ integer, intent(in) :: start,finish
+ integer :: l
+ integer :: if,ip,is,ls,lss
+
+
+ lss = len(ss)
+ ls = len(s)
+ is = max(start,1)
+ ip = min(ls+1,is)
+ if = max(ip-1,min(finish,ls))
+ l = lss + ls - if+ip-1
+
+ end function lr_cs_sf
+
+!*******************************************************************************
+! Calculates the result string by the following actions:
+! Insert the substring SS into string STR beginning at position
+! START replacing the following FINISH-START+1 characters of the string
+! and enlarging or shrinking the string if necessary.
+! If start is greater than LEN(STRING) substring is simply appended to
+! string by concatenation. If START is less than 1, START = 1 is used.
+! If FINISH is greater than LEN(STRING), FINISH = LEN(STRING) is used.
+! If FINISH is less than START, substring is inserted before START.
+
+ function replace_cs_sf(s,start,finish,ss) result(r)
+
+ implicit none
+ character(*), intent(in) :: s
+ type(string), intent(in) :: ss
+ integer, intent(in) :: start,finish
+ character(lr_cs_sf(s,start,finish,ss)) :: r
+ integer :: i,if,ip,is,l,ls,lss
+
+
+ lss = len(ss)
+ ls = len(s)
+ is = max(start,1)
+ ip = min(ls+1,is)
+ if = max(ip-1,min(finish,ls))
+ l = len(r)
+
+ r(1:ip-1) = s(1:ip-1)
+
+ r(i+ip:i+ip+lss-1) = transfer(ss%chars(1:lss),r(1:lss))
+
+ do i=1,lss
+ r(i+ip-1:i+ip-1) = ss%chars(i)
+ enddo
+
+ do i=1,l-ip-lss+1
+ r(i+ip+lss-1:i+ip+lss-1) = s(if+i:if+i)
+ enddo
+
+ end function replace_cs_sf
+
+!*******************************************************************************
+
+ pure function lr_sc_s(s,start,ss) result(l)
+
+ implicit none
+ type(string), intent(in) :: s
+ character(*), intent(in) :: ss
+ integer, intent(in) :: start
+ integer :: l
+ integer :: ip,is,ls,lss
+
+
+ l = max(len(s),min(len(s)+1,max(start,1)+len(ss)-1))
+
+ end function lr_sc_s
+
+!*******************************************************************************
+! Calculate the result string by the following actions:
+! Insert the characters from substring SS into string STR beginning
+! at position START replacing the following LEN(SUBSTRING) characters of
+! the string and enlarging string if necessary. If START is greater than
+! LEN(STRING) substring is simply appended to string by concatenation.
+! If START is less than 1, substring replaces characters in string
+! starting at 1
+
+ function replace_sc_s(s,start,ss) result(r)
+
+ implicit none
+ type(string), intent(in) :: s
+ character(*), intent(in) :: ss
+ integer, intent(in) :: start
+ character(lr_sc_s(s,start,ss)) :: r
+ integer :: i,ip,is,l,lss,ls
+
+
+ lss = len(ss)
+ ls = len(s)
+ is = max(start,1)
+ ip = min(ls+1,is)
+ l = len(r)
+
+ do i=1,ip-1
+ r(i:i) = s%chars(i)
+ enddo
+
+ do i=1,lss
+ r(i+ip-1:i+ip-1) = ss(i:i)
+ enddo
+
+ do i=ip+lss,l
+ r(i:i) = s%chars(i)
+ enddo
+
+ end function replace_sc_s
+
+!*******************************************************************************
+
+ pure function lr_sc_sf(s,start,finish,ss) result(l)
+
+ implicit none
+ type(string), intent(in) :: s
+ character(*), intent(in) :: ss
+ integer, intent(in) :: start,finish
+ integer :: l
+ integer :: if,ip,is,ls,lss
+
+
+ lss = len(ss)
+ ls = len(s)
+ is = max(start,1)
+ ip = min(ls+1,is)
+ if = max(ip-1,min(finish,ls))
+ l = lss + ls - if+ip-1
+
+ end function lr_sc_sf
+
+!*******************************************************************************
+! Calculates the result string by the following actions:
+! Insert the substring SS into string STR beginning at position
+! START replacing the following FINISH-START+1 characters of the string
+! and enlarging or shrinking the string if necessary.
+! If start is greater than LEN(STRING) substring is simply appended to
+! string by concatenation. If START is less than 1, START = 1 is used.
+! If FINISH is greater than LEN(STRING), FINISH = LEN(STRING) is used.
+! If FINISH is less than START, substring is inserted before START.
+
+ function replace_sc_sf(s,start,finish,ss) result(r)
+
+ implicit none
+ type(string), intent(in) :: s
+ character(*), intent(in) :: ss
+ integer, intent(in) :: start,finish
+ character(lr_sc_sf(s,start,finish,ss)) :: r
+ integer :: i,if,ip,is,l,ls,lss
+
+
+ lss = len(ss)
+ ls = len(s)
+ is = max(start,1)
+ ip = min(ls+1,is)
+ if = max(ip-1,min(finish,ls))
+ l = len(r)
+
+ do i=1,ip-1
+ r(i:i) = s%chars(i)
+ enddo
+
+ r(ip:ip+lss-1) = ss
+
+ do i=1,l-ip-lss+1
+ r(i+ip+lss-1:i+ip+lss-1) = s%chars(if+i)
+ enddo
+
+ end function replace_sc_sf
+
+!*******************************************************************************
+
+ pure function lr_ss_s(s,start,ss) result(l)
+
+ implicit none
+ type(string), intent(in) :: s,ss
+ integer, intent(in) :: start
+ integer :: l
+ integer :: ip,is,ls,lss
+
+
+ l = max(len(s),min(len(s)+1,max(start,1)+len(ss)-1))
+
+ end function lr_ss_s
+
+!*******************************************************************************
+! Calculate the result string by the following actions:
+! Insert the characters from substring SS into string STR beginning
+! at position START replacing the following LEN(SUBSTRING) characters of
+! the string and enlarging string if necessary. If START is greater than
+! LEN(STRING) substring is simply appended to string by concatenation.
+! If START is less than 1, substring replaces characters in string
+! starting at 1
+
+ function replace_ss_s(s,start,ss) result(r)
+
+ implicit none
+ type(string), intent(in) :: s,ss
+ integer, intent(in) :: start
+ character(lr_ss_s(s,start,ss)) :: r
+ integer :: i,ip,is,l,lss,ls
+
+
+ lss = len(ss)
+ ls = len(s)
+ is = max(start,1)
+ ip = min(ls+1,is)
+ l = len(r)
+
+ do i=1,ip-1
+ r(i:i) = s%chars(i)
+ enddo
+
+ do i=1,lss
+ r(ip-1+i:ip-1+i) = ss%chars(i)
+ enddo
+
+ do i=ip+lss,l
+ r(i:i) = s%chars(i)
+ enddo
+
+ end function replace_ss_s
+
+!*******************************************************************************
+
+ pure function lr_ss_sf(s,start,finish,ss) result(l)
+
+ implicit none
+ type(string), intent(in) :: s,ss
+ integer, intent(in) :: start,finish
+ integer :: l
+ integer :: if,ip,is,ls,lss
+
+
+ lss = len(ss)
+ ls = len(s)
+ is = max(start,1)
+ ip = min(ls+1,is)
+ if = max(ip-1,min(finish,ls))
+ l = lss + ls - if+ip-1
+
+ end function lr_ss_sf
+
+!*******************************************************************************
+! Calculates the result string by the following actions:
+! Insert the substring SS into string STR beginning at position
+! START replacing the following FINISH-START+1 characters of the string
+! and enlarging or shrinking the string if necessary.
+! If start is greater than LEN(STRING) substring is simply appended to
+! string by concatenation. If START is less than 1, START = 1 is used.
+! If FINISH is greater than LEN(STRING), FINISH = LEN(STRING) is used.
+! If FINISH is less than START, substring is inserted before START.
+
+ function replace_ss_sf(s,start,finish,ss) result(r)
+
+ implicit none
+ type(string), intent(in) :: s,ss
+ integer, intent(in) :: start,finish
+ character(lr_ss_sf(s,start,finish,ss)) :: r
+ integer :: i,if,ip,is,l,ls,lss
+
+
+ lss = len(ss)
+ ls = len(s)
+ is = max(start,1)
+ ip = min(ls+1,is)
+ if = max(ip-1,min(finish,ls))
+ l = len(r)
+
+ do i=1,ip-1
+ r(i:i) = s%chars(i)
+ enddo
+
+ do i=1,lss
+ r(i+ip-1:i+ip-1) = ss%chars(i)
+ enddo
+
+ do i=1,l-ip-lss+1
+ r(i+ip+lss-1:i+ip+lss-1) = s%chars(if+i)
+ enddo
+
+ end function replace_ss_sf
+
+!*******************************************************************************
+
+ pure function lr_ccc(s,target,ss,action) result(l)
+
+ implicit none
+ character(*), intent(in) :: s,target,ss,action
+ integer :: l
+ logical :: every,back
+ integer :: ls,lt,lss,ipos,nr
+
+
+ ls = len(s)
+ lt = len(target)
+ lss = len(ss)
+
+ if (lt == 0) then
+ if (ls == 0) then
+ l = lss
+ else
+ l = ls
+ endif
+ return
+ endif
+
+ if (lt == lss) then
+ l = ls
+ return
+ endif
+
+ select case(uppercase(action))
+ case('FIRST')
+ back = .false.
+ every = .false.
+ case('LAST')
+ back = .true.
+ every = .false.
+ case('ALL')
+ back = .false.
+ every = .true.
+ case default
+ back = .false.
+ every = .false.
+ end select
+
+ nr = 0
+ if (back) then
+ ipos = ls
+ do while (ipos > 0)
+ ipos = index(s(:ipos),target,back)
+ if (ipos == 0) exit
+ nr = nr + 1
+ if (.not. every) exit
+ ipos = ipos - 1
+ enddo
+ else
+ ipos = 1
+ do while (ipos <= ls-lt+1)
+ l = index(s(ipos:),target)
+ if (l == 0) exit
+ nr = nr + 1
+ if (.not. every) exit
+ ipos = ipos + l + 1
+ ipos = ipos + 1
+ enddo
+ endif
+ l = ls + nr*(lss-lt)
+
+ end function lr_ccc
+
+!*******************************************************************************
+
+ function replace_ccc(s,target,ss) result(r)
+
+ implicit none
+ character(*), intent(in) :: s,target,ss
+ character(lr_ccc(s,target,ss,'first')) :: r
+
+
+ call x_replace_ccc(s,target,ss,'first',r)
+
+ end function replace_ccc
+
+!*******************************************************************************
+
+ function replace_ccc_f(s,target,ss,action) result(r)
+
+ implicit none
+ character(*), intent(in) :: s,target,ss,action
+ character(lr_ccc(s,target,ss,action)) :: r
+
+
+ call x_replace_ccc(s,target,ss,action,r)
+
+ end function replace_ccc_f
+
+!*******************************************************************************
+! Calculate the result string by the following actions:
+! Search for occurences of TARGET in string S, and replaces these with
+! substring SS. If BACK present with value true search is backward otherwise
+! search is done forward. If EVERY present with value true all accurences
+! of TARGET in S are replaced, otherwise only the first found is
+! replaced. If TARGET is not found the result is the same as S.
+
+ subroutine x_replace_ccc(s,target,ss,action,r)
+
+ implicit none
+ character(*), intent(in) :: s,target,ss,action
+ character(*), intent(inout) :: r
+ logical :: every,back
+ integer :: lr,ls,lt,lss
+ integer :: i1,i2,k1,k2,m1,m2
+
+
+ lr = len(r)
+ ls = len(s)
+ lt = len(target)
+ lss = len(ss)
+
+ if (lt == 0) then
+ if (ls == 0) then
+ r = ss
+ else
+ r = s
+ endif
+ return
+ endif
+
+ select case(uppercase(action))
+ case('FIRST')
+ back = .false.
+ every = .false.
+ case('LAST')
+ back = .true.
+ every = .false.
+ case('ALL')
+ back = .false.
+ every = .true.
+ case default
+ back = .false.
+ every = .false.
+ end select
+
+ if (back) then
+ k2 = ls
+ m2 = lr
+ do
+ i1 = index(s(:k2),target,back)
+ if (i1 == 0) then
+ r(:m2) = s(:k2)
+ return
+ endif
+ i2 = i1 + lt - 1
+ k1 = i2 + 1
+ m1 = m2 + k1 - k2
+ r(m1:m2) = s(k1:k2)
+ m2 = m1 - 1
+ m1 = m2 - lss + 1
+ r(m1:m2) = ss
+ k2 = i1 - 1
+ m2 = m1 - 1
+ if (.not. every) then
+ r(:m2) = s(:k2)
+ return
+ endif
+ enddo
+ else
+ k1 = 1
+ m1 = 1
+ do
+ i1 = index(s(k1:),target)
+ if (i1 == 0) then
+ r(m1:) = s(k1:)
+ return
+ endif
+ i1 = k1 + (i1 - 1)
+ i2 = i1 + lt - 1
+ k2 = i1 - 1
+ m2 = m1 + k2 - k1
+ r(m1:m2) = s(k1:k2)
+ m1 = m2 + 1
+ m2 = m1 + lss - 1
+ r(m1:m2) = ss
+ k1 = i2 + 1
+ m1 = m2 + 1
+ if (.not. every) then
+ r(m1:) = s(k1:)
+ return
+ endif
+ enddo
+ endif
+
+ end subroutine x_replace_ccc
+
+!*******************************************************************************
+
+ function replace_csc(s,target,ss) result(r)
+
+ implicit none
+ character(*), intent(in) :: s,ss
+ type(string), intent(in) :: target
+ character(lr_ccc(s,char(target),ss,'first')) :: r
+
+
+ call x_replace_ccc(s,char(target),ss,'first',r)
+
+ end function replace_csc
+
+!*******************************************************************************
+
+ function replace_csc_f(s,target,ss,action) result(r)
+
+ implicit none
+ character(*), intent(in) :: s,ss,action
+ type(string), intent(in) :: target
+ character(lr_ccc(s,char(target),ss,action)) :: r
+
+
+ call x_replace_ccc(s,char(target),ss,action,r)
+
+ end function replace_csc_f
+
+!*******************************************************************************
+!*******************************************************************************
+
+ function replace_ccs(s,target,ss) result(r)
+
+ implicit none
+ character(*), intent(in) :: s,target
+ type(string), intent(in) :: ss
+ character(lr_ccc(s,target,char(ss),'first')) :: r
+
+
+ call x_replace_ccc(s,target,char(ss),'first',r)
+
+ end function replace_ccs
+
+!*******************************************************************************
+
+ function replace_ccs_f(s,target,ss,action) result(r)
+
+ implicit none
+ character(*), intent(in) :: s,target,action
+ type(string), intent(in) :: ss
+ character(lr_ccc(s,target,char(ss),action)) :: r
+
+
+ call x_replace_ccc(s,target,char(ss),action,r)
+
+ end function replace_ccs_f
+
+!*******************************************************************************
+!*******************************************************************************
+
+ function replace_css(s,target,ss) result(r)
+
+ implicit none
+ character(*), intent(in) :: s
+ type(string), intent(in) :: ss,target
+ character(lr_ccc(s,char(target),char(ss),'first')) :: r
+
+
+ call x_replace_ccc(s,char(target),char(ss),'first',r)
+
+ end function replace_css
+
+!*******************************************************************************
+
+ function replace_css_f(s,target,ss,action) result(r)
+
+ implicit none
+ character(*), intent(in) :: s,action
+ type(string), intent(in) :: ss,target
+ character(lr_ccc(s,char(target),char(ss),action)) :: r
+
+
+ call x_replace_ccc(s,char(target),char(ss),action,r)
+
+ end function replace_css_f
+
+!*******************************************************************************
+!*******************************************************************************
+ pure function lr_scc(s,target,ss,action) result(l)
+
+ implicit none
+ type(string), intent(in) :: s
+ character(*), intent(in) :: target,ss,action
+ integer :: l
+ logical :: every,back
+ integer :: ls,lt,lss,ipos,nr
+
+
+ ls = len(s)
+ lt = len(target)
+ lss = len(ss)
+
+ if (lt == 0) then
+ if (ls == 0) then
+ l = lss
+ else
+ l = ls
+ endif
+ return
+ endif
+ if (lt == lss) then
+ l = ls
+ return
+ endif
+
+ select case(uppercase(action))
+ case('FIRST')
+ back = .false.
+ every = .false.
+ case('LAST')
+ back = .true.
+ every = .false.
+ case('ALL')
+ back = .false.
+ every = .true.
+ case default
+ back = .false.
+ every = .false.
+ end select
+
+ nr = 0
+ if (back) then
+ ipos = ls
+ do while (ipos > 0)
+ ipos = aindex(s%chars(:ipos),target,back)
+ if (ipos == 0) exit
+ nr = nr + 1
+ if (.not. every) exit
+ ipos = ipos - 1
+ enddo
+
+ else
+ ipos = 1
+ do while (ipos <= ls-lt+1)
+ l = aindex(s%chars(ipos:),target)
+ if (l == 0) exit
+ nr = nr + 1
+ if (.not. every) exit
+ ipos = ipos + l + 1
+ enddo
+ endif
+ l = ls + nr*(lss-lt)
+
+ end function lr_scc
+
+!*******************************************************************************
+
+ function replace_scc(s,target,ss) result(r)
+
+ implicit none
+ type(string), intent(in) :: s
+ character(*), intent(in) :: target,ss
+ character(lr_scc(s,target,ss,'first')) :: r
+
+
+ call x_replace_scc(s,target,ss,'first',r)
+
+
+ end function replace_scc
+
+!*******************************************************************************
+
+ function replace_scc_f(s,target,ss,action) result(r)
+
+ implicit none
+ type(string), intent(in) :: s
+ character(*), intent(in) :: target,ss,action
+ character(lr_scc(s,target,ss,action)) :: r
+
+
+ call x_replace_scc(s,target,ss,action,r)
+
+ end function replace_scc_f
+
+!*******************************************************************************
+! Calculate the result string by the following actions:
+! Search for occurences of TARGET in string S, and replaces these with
+! substring SS. If BACK present with value true search is backward otherwise
+! search is done forward. If EVERY present with value true all accurences
+! of TARGET in S are replaced, otherwise only the first found is
+! replaced. If TARGET is not found the result is the same as S.
+
+ subroutine x_replace_scc(s,target,ss,action,r)
+
+ implicit none
+ type(string), intent(in) :: s
+ character(*), intent(in) :: target,ss,action
+ character(*), intent(inout) :: r
+ logical :: every,back
+ integer :: lr,ls,lt,lss
+ integer :: i1,i2,k1,k2,m1,m2
+
+
+ lr = len(r)
+ ls = len(s)
+ lt = len(target)
+ lss = len(ss)
+
+ if (lt == 0) then
+ if (ls == 0) then
+ r = ss
+ else
+ r = s
+ endif
+ return
+ endif
+
+ select case(uppercase(action))
+ case('FIRST')
+ back = .false.
+ every = .false.
+ case('LAST')
+ back = .true.
+ every = .false.
+ case('ALL')
+ back = .false.
+ every = .true.
+ case default
+ back = .false.
+ every = .false.
+ end select
+
+ if (back) then
+ k2 = ls
+ m2 = lr
+ do
+ i1 = aindex(s%chars(:k2),target,back)
+ if (i1 == 0) then
+ r(:m2) = transfer(s%chars(:k2),r(:m2))
+ return
+ endif
+ i2 = i1 + lt - 1
+ k1 = i2 + 1
+ m1 = m2 + k1 - k2
+ r(m1:m2) = transfer(s%chars(k1:k2),r(m1:m2))
+ m2 = m1 - 1
+ m1 = m2 - lss + 1
+ r(m1:m2) = ss
+ k2 = i1 - 1
+ m2 = m1 - 1
+ if (.not.every) then
+ r(:m2) = transfer(s%chars(:k2),r(:m2))
+ return
+ endif
+ enddo
+ else
+ k1 = 1
+ m1 = 1
+ do
+ i1 = aindex(s%chars(k1:),target)
+ if (i1 == 0) then
+ r(m1:) = transfer(s%chars(k1:),r(m1:))
+ return
+ endif
+ i1 = k1 + (i1 - 1)
+ i2 = i1 + lt - 1
+ k2 = i1 - 1
+ m2 = m1 + k2 - k1
+ r(m1:m2) = transfer(s%chars(k1:k2),r(m1:m2))
+ m1 = m2 + 1
+ m2 = m1 + lss - 1
+ r(m1:m2) = ss
+ k1 = i2 + 1
+ m1 = m2 + 1
+ if (.not.every) then
+ r(m1:) = transfer(s%chars(k1:),r(m1:))
+ return
+ endif
+ enddo
+ endif
+
+ end subroutine x_replace_scc
+
+!*******************************************************************************
+
+ function replace_ssc(s,target,ss) result(r)
+
+ implicit none
+ type(string), intent(in) :: s,target
+ character(*), intent(in) :: ss
+ character(lr_scc(s,char(target),ss,'first')) :: r
+
+
+ call x_replace_scc(s,char(target),ss,'first',r)
+
+
+ end function replace_ssc
+
+!*******************************************************************************
+
+ function replace_ssc_f(s,target,ss,action) result(r)
+
+ implicit none
+ type(string), intent(in) :: s,target
+ character(*), intent(in) :: ss,action
+ character(lr_scc(s,char(target),ss,action)) :: r
+
+
+ call x_replace_scc(s,char(target),ss,action,r)
+
+ end function replace_ssc_f
+
+!*******************************************************************************
+
+ function replace_scs(s,target,ss) result(r)
+
+ implicit none
+ type(string), intent(in) :: s,ss
+ character(*), intent(in) :: target
+ character(lr_scc(s,target,char(ss),'first')) :: r
+
+
+ call x_replace_scc(s,target,char(ss),'first',r)
+
+ end function replace_scs
+
+!*******************************************************************************
+
+ function replace_scs_f(s,target,ss,action) result(r)
+
+ implicit none
+ type(string), intent(in) :: s,ss
+ character(*), intent(in) :: target,action
+ character(lr_scc(s,target,char(ss),action)) :: r
+
+
+ call x_replace_scc(s,target,char(ss),action,r)
+
+ end function replace_scs_f
+
+!*******************************************************************************
+
+ function replace_sss(s,target,ss) result(r)
+
+ implicit none
+ type(string), intent(in) :: s,ss,target
+ character(lr_scc(s,char(target),char(ss),'first')) :: r
+
+
+ call x_replace_scc(s,char(target),char(ss),'first',r)
+
+ end function replace_sss
+
+!*******************************************************************************
+
+ function replace_sss_f(s,target,ss,action) result(r)
+
+ implicit none
+ type(string), intent(in) :: s,ss,target
+ character(*), intent(in) :: action
+ character(lr_scc(s,char(target),char(ss),action)) :: r
+
+
+ call x_replace_scc(s,char(target),char(ss),action,r)
+
+ end function replace_sss_f
+
+!*******************************************************************************
+! SORT, LSORT
+!*******************************************************************************
+!*******************************************************************************
+! Sorts A into ascending order, from A(1) to A(N).
+! Reference: Richard C. Singleton, Algorithm 347, SORT.
+! Comm. ACM 3, 321 (March 1969).
+! Algorithm is Copyright 1969 Association of Computing Machinery,
+!*******************************************************************************
+
+ subroutine sort_c(a)
+
+ implicit none
+ character(*), intent(inout) :: a(:)
+ character(len(a)) :: t,s
+ integer :: p,i,j,k,l,m
+ integer :: is(0:63)
+
+
+ m = 0
+ i = 1
+ j = size(a)
+
+ 5 continue
+ if (i >= j) goto 70
+
+ 10 continue
+ p = (i + j)/2
+ t = a(p)
+ if (a(i) > t) then
+ a(p) = a(i)
+ a(i) = t
+ t = a(p)
+ endif
+ if (a(j) < t) then
+ a(p) = a(j)
+ a(j) = t
+ t = a(p)
+ if (a(i) > t) then
+ a(p) = a(i)
+ a(i) = t
+ t = a(p)
+ endif
+ endif
+
+ k = i
+ l = j
+ do
+ do
+ l = l - 1
+ if (a(l) <= t) exit
+ enddo
+ s = a(l)
+ do
+ k = k + 1
+ if (a(k) >= t) exit
+ enddo
+ if (k > l) exit
+ a(l) = a(k)
+ a(k) = s
+ enddo
+
+ if (l-i > j-k) then
+ is(m) = i
+ m = m + 1
+ is(m) = l
+ m = m + 1
+ i = k
+ else
+ is(m) = k
+ m = m + 1
+ is(m) = j
+ m = m + 1
+ j = l
+ endif
+ goto 80
+
+ 70 continue
+ if (m == 0) return
+ m = m - 1
+ j = is(m)
+ m = m - 1
+ i = is(m)
+
+ 80 continue
+ if (j-i >= 11) goto 10
+ if (i == 1) goto 5
+ i = i - 1
+
+ do
+ i = i + 1
+ if (i == j) goto 70
+ t = a(i+1)
+ if (a(i) <= t) cycle
+ k = i
+ do
+ a(k+1) = a(k)
+ k = k - 1
+ if (t >= a(k)) exit
+ enddo
+ a(k+1) = t
+ enddo
+
+ end subroutine sort_c
+
+!*******************************************************************************
+! Sorts A into ascending order, from A(1) to A(N).
+! Reference: Richard C. Singleton, Algorithm 347, SORT.
+! Comm. ACM 3, 321 (March 1969).
+! Algorithm is Copyright 1969 Association of Computing Machinery,
+!*******************************************************************************
+
+ subroutine sort_s(a)
+
+ implicit none
+ type(string), intent(inout) :: a(:)
+ type(string) :: s,t
+ integer :: p,i,j,k,l,m
+ integer :: is(0:63)
+
+
+ m = 0
+ i = 1
+ j = size(a)
+
+ 5 continue
+ if (i >= j) goto 70
+
+ 10 continue
+ p = (i + j)/2
+ call pstring(t,a(p))
+ if (a(i) > t) then
+ call pstring(a(p),a(i))
+ call pstring(a(i),t)
+ call pstring(t,a(p))
+ endif
+ if (a(j) < t) then
+ call pstring(a(p),a(j))
+ call pstring(a(j),t)
+ call pstring(t,a(p))
+ if (a(i) > t) then
+ call pstring(a(p),a(i))
+ call pstring(a(i),t)
+ call pstring(t,a(p))
+ endif
+ endif
+
+ k = i
+ l = j
+ do
+ do
+ l = l - 1
+ if (a(l) <= t) exit
+ enddo
+ call pstring(s,a(l))
+ do
+ k = k + 1
+ if (a(k) >= t) exit
+ enddo
+ if (k > l) exit
+ call pstring(a(l),a(k))
+ call pstring(a(k),s)
+ enddo
+
+ if (l-i > j-k) then
+ is(m) = i
+ m = m + 1
+ is(m) = l
+ m = m + 1
+ i = k
+ else
+ is(m) = k
+ m = m + 1
+ is(m) = j
+ m = m + 1
+ j = l
+ endif
+ goto 80
+
+ 70 continue
+ if (m == 0) return
+ m = m - 1
+ j = is(m)
+ m = m - 1
+ i = is(m)
+
+ 80 continue
+ if (j-i >= 11) goto 10
+ if (i == 1) goto 5
+ i = i - 1
+
+ do
+ i = i + 1
+ if (i == j) goto 70
+ call pstring(t,a(i+1))
+ if (a(i) <= t) cycle
+ k = i
+ do
+ call pstring(a(k+1),a(k))
+ k = k - 1
+ if (t >= a(k)) exit
+ enddo
+ call pstring(a(k+1),t)
+ enddo
+
+ contains
+
+!-------------------------------------------------------------------------------
+ subroutine pstring(p,t)
+
+ implicit none
+ type(string), intent(inout) :: p
+ type(string), intent(in) :: t
+
+
+ p%len = t%len
+ p%size = t%size
+ p%chars => t%chars
+
+
+ end subroutine pstring
+!-------------------------------------------------------------------------------
+
+ end subroutine sort_s
+
+!*******************************************************************************
+! Sorts A into ascending order, from A(1) to A(N).
+! Reference: Richard C. Singleton, Algorithm 347, SORT.
+! Comm. ACM 3, 321 (March 1969).
+! Algorithm is Copyright 1969 Association of Computing Machinery,
+! reproduced with permission.
+!*******************************************************************************
+
+ subroutine lsort_c(a)
+
+ implicit none
+ character(*), intent(inout) :: a(:)
+ character(len(a)) :: t,s
+ integer :: p,i,j,k,l,m
+ integer :: is(0:63)
+
+
+ m = 0
+ i = 1
+ j = size(a)
+
+ 5 continue
+ if (i >= j) goto 70
+
+ 10 continue
+ p = (i + j)/2
+ t = a(p)
+ if (lgt(a(i),t)) then
+ a(p) = a(i)
+ a(i) = t
+ t = a(p)
+ endif
+ if (llt(a(j),t)) then
+ a(p) = a(j)
+ a(j) = t
+ t = a(p)
+ if (lgt(a(i),t)) then
+ a(p) = a(i)
+ a(i) = t
+ t = a(p)
+ endif
+ endif
+
+ k = i
+ l = j
+ do
+ do
+ l = l - 1
+ if (lle(a(l),t)) exit
+ enddo
+ s = a(l)
+ do
+ k = k + 1
+ if (lge(a(k),t)) exit
+ enddo
+ if (k > l) exit
+ a(l) = a(k)
+ a(k) = s
+ enddo
+
+ if (l-i > j-k) then
+ is(m) = i
+ m = m + 1
+ is(m) = l
+ m = m + 1
+ i = k
+ else
+ is(m) = k
+ m = m + 1
+ is(m) = j
+ m = m + 1
+ j = l
+ endif
+ goto 80
+
+ 70 continue
+ if (m == 0) return
+ m = m - 1
+ j = is(m)
+ m = m - 1
+ i = is(m)
+
+ 80 continue
+ if (j-i >= 11) goto 10
+ if (i == 1) goto 5
+ i = i - 1
+
+ do
+ i = i + 1
+ if (i == j) goto 70
+ t = a(i+1)
+ if (lle(a(i),t)) cycle
+ k = i
+ do
+ a(k+1) = a(k)
+ k = k - 1
+ if (lge(t,a(k))) exit
+ enddo
+ a(k+1) = t
+ enddo
+
+ end subroutine lsort_c
+
+!*******************************************************************************
+! Sorts A into ascending order, from A(1) to A(N).
+! Reference: Richard C. Singleton, Algorithm 347, SORT.
+! Comm. ACM 3, 321 (March 1969).
+! Algorithm is Copyright 1969 Association of Computing Machinery,
+!*******************************************************************************
+
+ subroutine lsort_s(a)
+
+ implicit none
+ type(string), intent(inout) :: a(:)
+ type(string) :: s,t
+ integer :: p,i,j,k,l,m
+ integer :: is(0:63)
+
+
+ m = 0
+ i = 1
+ j = size(a)
+
+ 5 continue
+ if (i >= j) goto 70
+
+ 10 continue
+ p = (i + j)/2
+ call pstring(t,a(p))
+ if (lgt(a(i),t)) then
+ call pstring(a(p),a(i))
+ call pstring(a(i),t)
+ call pstring(t,a(p))
+ endif
+ if (llt(a(j),t)) then
+ call pstring(a(p),a(j))
+ call pstring(a(j),t)
+ call pstring(t,a(p))
+ if (lgt(a(i),t)) then
+ call pstring(a(p),a(i))
+ call pstring(a(i),t)
+ call pstring(t,a(p))
+ endif
+ endif
+
+ k = i
+ l = j
+ do
+ do
+ l = l - 1
+ if (lle(a(l),t)) exit
+ enddo
+ call pstring(s,a(l))
+ do
+ k = k + 1
+ if (lge(a(k),t)) exit
+ enddo
+ if (k > l) exit
+ call pstring(a(l),a(k))
+ call pstring(a(k),s)
+ enddo
+
+ if (l-i > j-k) then
+ is(m) = i
+ m = m + 1
+ is(m) = l
+ m = m + 1
+ i = k
+ else
+ is(m) = k
+ m = m + 1
+ is(m) = j
+ m = m + 1
+ j = l
+ endif
+ goto 80
+
+ 70 continue
+ if (m == 0) return
+ m = m - 1
+ j = is(m)
+ m = m - 1
+ i = is(m)
+
+ 80 continue
+ if (j-i >= 11) goto 10
+ if (i == 1) goto 5
+ i = i - 1
+
+ do
+ i = i + 1
+ if (i == j) goto 70
+ call pstring(t,a(i+1))
+ if (lle(a(i),t)) cycle
+ k = i
+ do
+ call pstring(a(k+1),a(k))
+ k = k - 1
+ if (lge(t,a(k))) exit
+ enddo
+ call pstring(a(k+1),t)
+ enddo
+
+ contains
+
+!-------------------------------------------------------------------------------
+ subroutine pstring(p,t)
+
+ implicit none
+ type(string), intent(inout) :: p
+ type(string), intent(in) :: t
+
+
+ p%len = t%len
+ p%size = t%size
+ p%chars => t%chars
+
+
+ end subroutine pstring
+!-------------------------------------------------------------------------------
+
+ end subroutine lsort_s
+
+!*******************************************************************************
+! RANK, LRANK
+!*******************************************************************************
+!*******************************************************************************
+! Sorts A into ascending order, from A(1) to A(N).
+! Reference: Richard C. Singleton, Algorithm 347, SORT.
+! Comm. ACM 3, 321 (March 1969).
+! Algorithm is Copyright 1969 Association of Computing Machinery,
+! reproduced with permission.
+!*******************************************************************************
+
+ subroutine rank_c(a,r)
+
+ implicit none
+ character(*), intent(in) :: a(:)
+ integer, intent(out) :: r(size(a))
+ character(len(a)) :: t
+ integer :: i,j,k,l,m,n,p,rs,rt
+ integer :: is(0:63)
+
+
+ n = size(a)
+ r(:) = (/ (i, i=1,n) /)
+ m = 0
+ i = 1
+ j = n
+
+ 5 continue
+ if (i >= j) goto 70
+
+ 10 continue
+ p = (j+i)/2
+ rt = r(p)
+ t = a(rt)
+ if (a(r(i)) > t) then
+ r(p) = r(i)
+ r(i) = rt
+ rt = r(p)
+ t = a(rt)
+ endif
+ if (a(r(j)) < t) then
+ r(p) = r(j)
+ r(j) = rt
+ rt = r(p)
+ t = a(rt)
+ if (a(r(i)) > t) then
+ r(p) = r(i)
+ r(i) = rt
+ rt = r(p)
+ t = a(rt)
+ endif
+ endif
+
+ k = i
+ l = j
+ do
+ do
+ l = l - 1
+ if (a(r(l)) <= t) exit
+ enddo
+ rs = r(l)
+ do
+ k = k + 1
+ if (a(r(k)) >= t) exit
+ enddo
+ if (k > l) exit
+ r(l) = r(k)
+ r(k) = rs
+ enddo
+
+ if (l-i > j-k) then
+ is(m) = i
+ m = m + 1
+ is(m) = l
+ m = m + 1
+ i = k
+ else
+ is(m) = k
+ m = m + 1
+ is(m) = j
+ m = m + 1
+ j = l
+ endif
+ goto 80
+
+ 70 continue
+ if (m == 0) return
+ m = m - 1
+ j = is(m)
+ m = m - 1
+ i = is(m)
+
+ 80 continue
+ if (j-i >= 11) goto 10
+ if (i == 1) goto 5
+ i = i - 1
+
+ do
+ i = i + 1
+ if (i == j) goto 70
+ rt = r(i+1)
+ t = a(rt)
+ if (a(r(i)) <= t) cycle
+ k = i
+ do
+ r(k+1) = r(k)
+ k = k - 1
+ if (t >= a(r(k))) exit
+ enddo
+ r(k+1) = rt
+ enddo
+
+ end subroutine rank_c
+
+!*******************************************************************************
+! Sorts A into ascending order, from A(1) to A(N).
+! Reference: Richard C. Singleton, Algorithm 347, SORT.
+! Comm. ACM 3, 321 (March 1969).
+! Algorithm is Copyright 1969 Association of Computing Machinery,
+!*******************************************************************************
+
+ subroutine rank_s(a,r)
+
+ implicit none
+ type(string), intent(in) :: a(:)
+ integer, intent(out) :: r(size(a))
+ type(string) :: t
+ integer :: i,j,k,l,m,n,p,rs,rt
+ integer :: is(0:63)
+
+
+ n = size(a)
+ r(:) = (/ (i, i=1,n) /)
+ m = 0
+ i = 1
+ j = n
+
+ 5 continue
+ if (i >= j) goto 70
+
+ 10 continue
+ p = (j+i)/2
+ rt = r(p)
+ call pstring(t,a(rt))
+ if (a(r(i)) > t) then
+ r(p) = r(i)
+ r(i) = rt
+ rt = r(p)
+ call pstring(t,a(rt))
+ endif
+ if (a(r(j)) < t) then
+ r(p) = r(j)
+ r(j) = rt
+ rt = r(p)
+ call pstring(t,a(rt))
+ if (a(r(i)) > t) then
+ r(p) = r(i)
+ r(i) = rt
+ rt = r(p)
+ call pstring(t,a(rt))
+ endif
+ endif
+
+ k = i
+ l = j
+ do
+ do
+ l = l - 1
+ if (a(r(l)) <= t) exit
+ enddo
+ rs = r(l)
+ do
+ k = k + 1
+ if (a(r(k)) >= t) exit
+ enddo
+ if (k > l) exit
+ r(l) = r(k)
+ r(k) = rs
+ enddo
+
+ if (l-i > j-k) then
+ is(m) = i
+ m = m + 1
+ is(m) = l
+ m = m + 1
+ i = k
+ else
+ is(m) = k
+ m = m + 1
+ is(m) = j
+ m = m + 1
+ j = l
+ endif
+ goto 80
+
+ 70 continue
+ if (m == 0) return
+ m = m - 1
+ j = is(m)
+ m = m - 1
+ i = is(m)
+
+ 80 continue
+ if (j-i >= 11) goto 10
+ if (i == 1) goto 5
+ i = i - 1
+
+ do
+ i = i + 1
+ if (i == j) goto 70
+ rt = r(i+1)
+ call pstring(t,a(rt))
+ if (a(r(i)) <= t) cycle
+ k = i
+ do
+ r(k+1) = r(k)
+ k = k - 1
+ if (t >= a(r(k))) exit
+ enddo
+ r(k+1) = rt
+ enddo
+
+ contains
+
+!-------------------------------------------------------------------------------
+ subroutine pstring(p,t)
+
+ implicit none
+ type(string), intent(inout) :: p
+ type(string), intent(in) :: t
+
+
+ p%len = t%len
+ p%size = t%size
+ p%chars => t%chars
+
+
+ end subroutine pstring
+!-------------------------------------------------------------------------------
+
+ end subroutine rank_s
+
+!*******************************************************************************
+! Sorts A into ascending order, from A(1) to A(N).
+! Reference: Richard C. Singleton, Algorithm 347, SORT.
+! Comm. ACM 3, 321 (March 1969).
+! Algorithm is Copyright 1969 Association of Computing Machinery,
+!*******************************************************************************
+
+ subroutine lrank_c(a,r)
+
+ implicit none
+ character(*), intent(in) :: a(:)
+ integer, intent(out) :: r(size(a))
+ character(len(a)) :: t
+ integer :: i,j,k,l,m,n,p,rs,rt
+ integer :: is(0:63)
+
+
+ n = size(a)
+ r(:) = (/ (i, i=1,n) /)
+ m = 0
+ i = 1
+ j = n
+
+ 5 continue
+ if (i >= j) goto 70
+
+ 10 continue
+ p = (j+i)/2
+ rt = r(p)
+ t = a(rt)
+ if (lgt(a(r(i)),t)) then
+ r(p) = r(i)
+ r(i) = rt
+ rt = r(p)
+ t = a(rt)
+ endif
+ if (llt(a(r(j)),t)) then
+ r(p) = r(j)
+ r(j) = rt
+ rt = r(p)
+ t = a(rt)
+ if (llt(a(r(i)),t)) then
+ r(p) = r(i)
+ r(i) = rt
+ rt = r(p)
+ t = a(rt)
+ endif
+ endif
+
+ k = i
+ l = j
+ do
+ do
+ l = l - 1
+ if (lle(a(r(l)),t)) exit
+ enddo
+ rs = r(l)
+ do
+ k = k + 1
+ if (lge(a(r(k)),t)) exit
+ enddo
+ if (k > l) exit
+ r(l) = r(k)
+ r(k) = rs
+ enddo
+
+ if (l-i > j-k) then
+ is(m) = i
+ m = m + 1
+ is(m) = l
+ m = m + 1
+ i = k
+ else
+ is(m) = k
+ m = m + 1
+ is(m) = j
+ m = m + 1
+ j = l
+ endif
+ goto 80
+
+ 70 continue
+ if (m == 0) return
+ m = m - 1
+ j = is(m)
+ m = m - 1
+ i = is(m)
+
+ 80 continue
+ if (j-i >= 11) goto 10
+ if (i == 1) goto 5
+ i = i - 1
+
+ do
+ i = i + 1
+ if (i == j) goto 70
+ rt = r(i+1)
+ t = a(rt)
+ if (lle(a(r(i)),t)) cycle
+ k = i
+ do
+ r(k+1) = r(k)
+ k = k - 1
+ if (lge(t,a(r(k)))) exit
+ enddo
+ r(k+1) = rt
+ enddo
+
+ end subroutine lrank_c
+
+!*******************************************************************************
+! Sorts A into ascending order, from A(1) to A(N).
+! Reference: Richard C. Singleton, Algorithm 347, SORT.
+! Comm. ACM 3, 321 (March 1969).
+! Algorithm is Copyright 1969 Association of Computing Machinery,
+!*******************************************************************************
+
+ subroutine lrank_s(a,r)
+
+ implicit none
+ type(string), intent(in) :: a(:)
+ integer, intent(out) :: r(size(a))
+ type(string) :: t
+ integer :: i,j,k,l,m,n,p,rs,rt
+ integer :: is(0:63)
+
+
+ n = size(a)
+ r(:) = (/ (i, i=1,n) /)
+ m = 0
+ i = 1
+ j = n
+
+ 5 continue
+ if (i >= j) goto 70
+
+ 10 continue
+ p = (j+i)/2
+ rt = r(p)
+ call pstring(t,a(rt))
+ if (lgt(a(r(i)),t)) then
+ r(p) = r(i)
+ r(i) = rt
+ rt = r(p)
+ call pstring(t,a(rt))
+ endif
+ if (llt(a(r(j)),t)) then
+ r(p) = r(j)
+ r(j) = rt
+ rt = r(p)
+ call pstring(t,a(rt))
+ if (lgt(a(r(i)),t)) then
+ r(p) = r(i)
+ r(i) = rt
+ rt = r(p)
+ call pstring(t,a(rt))
+ endif
+ endif
+
+ k = i
+ l = j
+ do
+ do
+ l = l - 1
+ if (lle(a(r(l)),t)) exit
+ enddo
+ rs = r(l)
+ do
+ k = k + 1
+ if (lge(a(r(k)),t)) exit
+ enddo
+ if (k > l) exit
+ r(l) = r(k)
+ r(k) = rs
+ enddo
+
+ if (l-i > j-k) then
+ is(m) = i
+ m = m + 1
+ is(m) = l
+ m = m + 1
+ i = k
+ else
+ is(m) = k
+ m = m + 1
+ is(m) = j
+ m = m + 1
+ j = l
+ endif
+ goto 80
+
+ 70 continue
+ if (m == 0) return
+ m = m - 1
+ j = is(m)
+ m = m - 1
+ i = is(m)
+
+ 80 continue
+ if (j-i >= 11) goto 10
+ if (i == 1) goto 5
+ i = i - 1
+
+ do
+ i = i + 1
+ if (i == j) goto 70
+ rt = r(i+1)
+ call pstring(t,a(rt))
+ if (lle(a(r(i)),t)) cycle
+ k = i
+ do
+ r(k+1) = r(k)
+ k = k - 1
+ if (lge(t,a(r(k)))) exit
+ enddo
+ r(k+1) = rt
+ enddo
+
+ contains
+
+!-------------------------------------------------------------------------------
+ subroutine pstring(p,t)
+
+ implicit none
+ type(string), intent(inout) :: p
+ type(string), intent(in) :: t
+
+
+ p%len = t%len
+ p%size = t%size
+ p%chars => t%chars
+
+
+ end subroutine pstring
+!-------------------------------------------------------------------------------
+
+ end subroutine lrank_s
+
+!*******************************************************************************
+! COMPARE, LCOMPARE, ACOMPARE, ALCOMPARE
+!*******************************************************************************
+!*******************************************************************************
+
+ elemental function compare_ss(s1,s2) result(css)
+
+ implicit none
+ type(string), intent(in) :: s1,s2
+ character(2) :: css
+ integer :: i,l1,l2
+
+
+ l1 = len(s1)
+ l2 = len(s2)
+ do i=1,min(l1,l2)
+ if (s1%chars(i) < s2%chars(i)) then
+ css = 'LT'
+ return
+ elseif (s1%chars(i) > s2%chars(i)) then
+ css = 'GT'
+ return
+ endif
+ enddo
+ if (l1 < l2) then
+ do i=l1+1,l2
+ if (blank < s2%chars(i)) then
+ css = 'LT'
+ return
+ elseif (blank > s2%chars(i)) then
+ css = 'GT'
+ return
+ endif
+ enddo
+ elseif (l1 > l2) then
+ do i=l2+1,l1
+ if (s1%chars(i) < blank) then
+ css = 'LT'
+ return
+ elseif (s1%chars(i) > blank) then
+ css = 'GT'
+ return
+ endif
+ enddo
+ endif
+ css = 'EQ'
+
+ end function compare_ss
+
+!*******************************************************************************
+
+ elemental function compare_cs(c,s) result(css)
+
+ implicit none
+ character(*), intent(in) :: c
+ type(string), intent(in) :: s
+ character(2) :: css
+ integer :: i,lc,ls
+
+
+ lc = len(c)
+ ls = len(s)
+ do i=1,min(lc,ls)
+ if (c(i:i) < s%chars(i)) then
+ css = 'LT'
+ return
+ elseif (c(i:i) > s%chars(i)) then
+ css = 'GT'
+ return
+ endif
+ enddo
+ if (lc < ls) then
+ do i=lc+1,ls
+ if (blank < s%chars(i)) then
+ css = 'LT'
+ return
+ elseif (blank > s%chars(i)) then
+ css = 'GT'
+ return
+ endif
+ enddo
+ elseif (lc > ls) then
+ do i=ls+1,lc
+ if (c(i:i) < blank) then
+ css = 'LT'
+ return
+ elseif (c(i:i) > blank) then
+ css = 'GT'
+ return
+ endif
+ enddo
+ endif
+ css = 'EQ'
+
+ end function compare_cs
+
+!*******************************************************************************
+! ==
+!*******************************************************************************
+! string == string
+
+ elemental function s_eq_s(s1,s2)
+
+ implicit none
+ type(string), intent(in) :: s1,s2
+ logical :: s_eq_s
+ integer :: l1,l2
+
+
+ l1 = len(s1)
+ l2 = len(s2)
+ if (l1 > l2) then
+ s_eq_s = all(s1%chars(1:l2) == s2%chars) .and. &
+ all(s1%chars(l2+1:l1) == blank)
+ elseif (l1 < l2) then
+ s_eq_s = all(s1%chars == s2%chars(1:l1)) .and. &
+ all(blank == s2%chars(l1+1:l2))
+ else
+ s_eq_s = all(s1%chars == s2%chars)
+ endif
+
+ end function s_eq_s
+
+!*******************************************************************************
+! string == character
+
+ elemental function s_eq_c(s,c)
+
+ implicit none
+ type(string), intent(in) :: s
+ character(*), intent(in) :: c
+ logical :: s_eq_c
+ integer :: i,ls,lc
+
+
+ ls = len(s)
+ lc = len(c)
+ do i=1,min(ls,lc)
+ if (s%chars(i) /= c(i:i)) then
+ s_eq_c = .false.
+ return
+ endif
+ enddo
+ if ((ls > lc) .and. any(s%chars(lc+1:ls) /= blank)) then
+ s_eq_c = .false.
+ elseif ((ls < lc) .and. (blank /= c(ls+1:lc))) then
+ s_eq_c = .false.
+ else
+ s_eq_c = .true.
+ endif
+
+ end function s_eq_c
+
+!*******************************************************************************
+! character == string
+
+ elemental function c_eq_s(c,s)
+
+ implicit none
+ character(*), intent(in) :: c
+ type(string), intent(in) :: s
+ logical :: c_eq_s
+ integer :: i,lc,ls
+
+
+ lc = len(c)
+ ls = len(s)
+ do i=1,min(lc,ls)
+ if (c(i:i) /= s%chars(i)) then
+ c_eq_s = .false.
+ return
+ endif
+ enddo
+ if ((lc > ls) .and. (c(ls+1:lc) /= blank)) then
+ c_eq_s = .false.
+ elseif ((lc < ls) .and. any(blank /= s%chars(lc+1:ls) ) )then
+ c_eq_s = .false.
+ else
+ c_eq_s = .true.
+ endif
+
+ end function c_eq_s
+
+!*******************************************************************************
+! /=
+!*******************************************************************************
+! string /= string
+
+ elemental function s_ne_s(s1,s2)
+
+ implicit none
+ type(string), intent(in) :: s1,s2
+ logical :: s_ne_s
+ integer :: l1,l2
+
+
+ l1 = len(s1)
+ l2 = len(s2)
+ if (l1 > l2) then
+ s_ne_s = any(s1%chars(1:l2) /= s2%chars) .or. &
+ any(s1%chars(l2+1:l1) /= blank)
+ elseif (l1 < l2) then
+ s_ne_s = any(s1%chars /= s2%chars(1:l1)) .or. &
+ any(blank /= s2%chars(l1+1:l2))
+ else
+ s_ne_s = any(s1%chars /= s2%chars)
+ endif
+
+ end function s_ne_s
+
+!*******************************************************************************
+! string /= character
+
+ elemental function s_ne_c(s,c)
+
+ implicit none
+ type(string), intent(in) :: s
+ character(*), intent(in) :: c
+ logical :: s_ne_c
+ integer :: i,ls,lc
+
+
+ ls = len(s)
+ lc = len(c)
+ do i=1,min(ls,lc)
+ if (s%chars(i) /= c(i:i) )then
+ s_ne_c = .true.
+ return
+ endif
+ enddo
+ if ((ls > lc) .and. any(s%chars(ls+1:lc) /= blank)) then
+ s_ne_c = .true.
+ elseif ((ls < lc) .and. blank /= c(ls+1:lc)) then
+ s_ne_c = .true.
+ else
+ s_ne_c = .false.
+ endif
+
+ end function s_ne_c
+
+!*******************************************************************************
+! character /= string
+
+ elemental function c_ne_s(c,s)
+
+ implicit none
+ character(*), intent(in) :: c
+ type(string), intent(in) :: s
+ logical :: c_ne_s
+ integer :: i,lc,ls
+
+
+ lc = len(c)
+ ls = len(s)
+ do i=1,min(lc,ls)
+ if (c(i:i) /= s%chars(i)) then
+ c_ne_s = .true.
+ return
+ endif
+ enddo
+ if ((lc > ls) .and. c(ls+1:lc) /= blank) then
+ c_ne_s = .true.
+ elseif ((lc < ls) .and. any(blank /= s%chars(lc+1:ls))) then
+ c_ne_s = .true.
+ else
+ c_ne_s = .false.
+ endif
+
+ end function c_ne_s
+
+!*******************************************************************************
+! < operators
+!*******************************************************************************
+! string < string
+
+ elemental function s_lt_s(s1,s2)
+
+ implicit none
+ type(string), intent(in) :: s1,s2
+ logical :: s_lt_s
+
+
+ s_lt_s = compare_ss(s1,s2) == 'LT'
+
+ end function s_lt_s
+
+!*******************************************************************************
+! string < character
+
+ elemental function s_lt_c(s,c)
+
+ implicit none
+ type(string), intent(in) :: s
+ character(*), intent(in) :: c
+ logical :: s_lt_c
+
+
+ s_lt_c = compare_cs(c,s) == 'GT'
+
+ end function s_lt_c
+
+!*******************************************************************************
+! character < string
+
+ elemental function c_lt_s(c,s)
+
+ implicit none
+ character(*), intent(in) :: c
+ type(string), intent(in) :: s
+ logical :: c_lt_s
+
+
+ c_lt_s = compare_cs(c,s) == 'LT'
+
+ end function c_lt_s
+
+!*******************************************************************************
+! <= operators
+!*******************************************************************************
+! string <= string
+
+ elemental function s_le_s(s1,s2)
+
+ implicit none
+ type(string), intent(in) :: s1,s2
+ logical :: s_le_s
+
+
+ s_le_s = compare_ss(s1,s2) /= 'GT'
+
+ end function s_le_s
+
+!*******************************************************************************
+! string <= character
+
+ elemental function s_le_c(s,c)
+
+ implicit none
+ type(string), intent(in) :: s
+ character(*), intent(in) :: c
+ logical :: s_le_c
+
+
+ s_le_c = compare_cs(c,s) /= 'LT'
+
+ end function s_le_c
+
+!*******************************************************************************
+! character <= string
+
+ elemental function c_le_s(c,s)
+
+ implicit none
+ character(*), intent(in) :: c
+ type(string), intent(in) :: s
+ logical :: c_le_s
+
+
+ c_le_s = compare_cs(c,s) /= 'GT'
+
+ end function c_le_s
+
+!*******************************************************************************
+! >= operators
+!*******************************************************************************
+! string >= string
+
+ elemental function s_ge_s(s1,s2)
+
+ implicit none
+ type(string), intent(in) :: s1,s2
+ logical :: s_ge_s
+
+
+ s_ge_s = compare_ss(s1,s2) /= 'LT'
+
+ end function s_ge_s
+
+!*******************************************************************************
+! string >= character
+
+ elemental function s_ge_c(s,c)
+
+ implicit none
+ type(string), intent(in) :: s
+ character(*), intent(in) :: c
+ logical :: s_ge_c
+
+
+ s_ge_c = compare_cs(c,s) /= 'GT'
+
+ end function s_ge_c
+
+!*******************************************************************************
+! character >= string
+
+ elemental function c_ge_s(c,s)
+
+ implicit none
+ character(*), intent(in) :: c
+ type(string), intent(in) :: s
+ logical :: c_ge_s
+
+
+ c_ge_s = compare_cs(c,s) /= 'LT'
+
+ end function c_ge_s
+
+!*******************************************************************************
+! > operators
+!*******************************************************************************
+! string > string
+
+ elemental function s_gt_s(s1,s2)
+
+ implicit none
+ type(string), intent(in) :: s1,s2
+ logical :: s_gt_s
+
+
+ s_gt_s = compare_ss(s1,s2) == 'GT'
+
+ end function s_gt_s
+
+!*******************************************************************************
+! string > character
+
+ elemental function s_gt_c(s,c)
+
+ implicit none
+ type(string), intent(in) :: s
+ character(*), intent(in) :: c
+ logical :: s_gt_c
+
+
+ s_gt_c = compare_cs(c,s) == 'LT'
+
+ end function s_gt_c
+
+!*******************************************************************************
+! character > string
+
+ elemental function c_gt_s(c,s)
+
+ implicit none
+ character(*), intent(in) :: c
+ type(string), intent(in) :: s
+ logical :: c_gt_s
+
+
+ c_gt_s = compare_cs(c,s) == 'GT'
+
+ end function c_gt_s
+
+!*******************************************************************************
+
+ elemental function lcompare_ss(s1,s2) result(css)
+
+ implicit none
+ type(string), intent(in) :: s1,s2
+ character(2) :: css
+ integer :: i,l1,l2
+
+
+ l1 = len(s1)
+ l2 = len(s2)
+ do i=1,min(l1,l2)
+ if (llt(s1%chars(i),s2%chars(i))) then
+ css = 'LT'
+ return
+ elseif (lgt(s1%chars(i),s2%chars(i))) then
+ css = 'GT'
+ return
+ endif
+ enddo
+ if (l1 < l2) then
+ do i=l1+1,l2
+ if (llt(blank,s2%chars(i))) then
+ css = 'LT'
+ return
+ elseif (lgt(blank,s2%chars(i))) then
+ css = 'GT'
+ return
+ endif
+ enddo
+ elseif (l1 > l2) then
+ do i=l2+1,l1
+ if (llt(s1%chars(i),blank)) then
+ css = 'LT'
+ return
+ elseif (lgt(s1%chars(i),blank)) then
+ css = 'GT'
+ return
+ endif
+ enddo
+ endif
+ css = 'EQ'
+
+ end function lcompare_ss
+
+!*******************************************************************************
+
+ elemental function lcompare_cs(c,s) result(css)
+
+ implicit none
+ character(*), intent(in) :: c
+ type(string), intent(in) :: s
+ character(2) :: css
+ integer :: i,lc,ls
+
+
+ lc = len(c)
+ ls = len(s)
+ do i=1,min(lc,ls)
+ if (llt(c(i:i),s%chars(i))) then
+ css = 'LT'
+ return
+ elseif (lgt(c(i:i),s%chars(i))) then
+ css = 'GT'
+ return
+ endif
+ enddo
+ if (lc < ls) then
+ do i=lc+1,ls
+ if (llt(blank,s%chars(i))) then
+ css = 'LT'
+ return
+ elseif (lgt(blank,s%chars(i))) then
+ css = 'GT'
+ return
+ endif
+ enddo
+ elseif (lc > ls) then
+ do i=ls+1,lc
+ if (llt(c(i:i),blank)) then
+ css = 'LT'
+ return
+ elseif (lgt(c(i:i),blank)) then
+ css = 'GT'
+ return
+ endif
+ enddo
+ endif
+ css = 'EQ'
+
+ end function lcompare_cs
+
+!*******************************************************************************
+! LLT function
+!*******************************************************************************
+! llt(string,string)
+
+ elemental function s_llt_s(s1,s2)
+
+ implicit none
+ type(string), intent(in) :: s1,s2
+ logical :: s_llt_s
+
+ s_llt_s = (lcompare_ss(s1,s2) == 'LT')
+
+ end function s_llt_s
+
+!*******************************************************************************
+! llt(string,character)
+
+ elemental function s_llt_c(s1,c2)
+
+ implicit none
+ type(string), intent(in) :: s1
+ character(*), intent(in) :: c2
+ logical :: s_llt_c
+
+ s_llt_c = (lcompare_cs(c2,s1) == 'GT')
+
+ end function s_llt_c
+
+!*******************************************************************************
+! llt(character,string)
+
+ elemental function c_llt_s(c1,s2)
+
+ implicit none
+ type(string), intent(in) :: s2
+ character(*), intent(in) :: c1
+ logical :: c_llt_s
+
+ c_llt_s = (lcompare_cs(c1,s2) == 'LT')
+
+ end function c_llt_s
+
+!*******************************************************************************
+! LGT function
+!*******************************************************************************
+! lgt(string,string)
+
+ elemental function s_lgt_s(s1,s2)
+
+ implicit none
+ type(string), intent(in) :: s1,s2
+ logical :: s_lgt_s
+
+ s_lgt_s = (lcompare_ss(s1,s2) == 'GT')
+
+ end function s_lgt_s
+
+!*******************************************************************************
+! lgt(string,character)
+
+ elemental function s_lgt_c(s1,c2)
+
+ implicit none
+ type(string), intent(in) :: s1
+ character(*), intent(in) :: c2
+ logical :: s_lgt_c
+
+ s_lgt_c = (lcompare_cs(c2,s1) == 'LT')
+
+ end function s_lgt_c
+
+!*******************************************************************************
+! lgt(character,string)
+
+ elemental function c_lgt_s(c1,s2)
+
+ implicit none
+ type(string), intent(in) :: s2
+ character(*), intent(in) :: c1
+ logical :: c_lgt_s
+
+ c_lgt_s = (lcompare_cs(c1,s2) == 'GT')
+
+ end function c_lgt_s
+
+!*******************************************************************************
+! LGE function
+!*******************************************************************************
+! lge(string,string)
+
+ elemental function s_lge_s(s1,s2)
+
+ implicit none
+ type(string), intent(in) :: s1,s2
+ logical :: s_lge_s
+
+ s_lge_s = (lcompare_ss(s1,s2) /= 'LT')
+
+ end function s_lge_s
+
+!*******************************************************************************
+! lge(string,character)
+
+ elemental function s_lge_c(s1,c2)
+
+ implicit none
+ type(string), intent(in) :: s1
+ character(*), intent(in) :: c2
+ logical :: s_lge_c
+
+ s_lge_c = (lcompare_cs(c2,s1) /= 'GT')
+
+ end function s_lge_c
+
+!*******************************************************************************
+! lge(character,string)
+
+ elemental function c_lge_s(c1,s2)
+
+ implicit none
+ type(string), intent(in) :: s2
+ character(*), intent(in) :: c1
+ logical :: c_lge_s
+
+ c_lge_s = (lcompare_cs(c1,s2) /= 'LT')
+
+ end function c_lge_s
+
+!*******************************************************************************
+! LLE function
+!*******************************************************************************
+! lle(string,string)
+
+ elemental function s_lle_s(s1,s2)
+
+ implicit none
+ type(string), intent(in) :: s1,s2
+ logical :: s_lle_s
+
+ s_lle_s = (lcompare_ss(s1,s2) /= 'GT')
+
+ end function s_lle_s
+
+!*******************************************************************************
+! lle(string,character)
+
+ elemental function s_lle_c(s1,c2)
+
+ implicit none
+ type(string), intent(in) :: s1
+ character(*), intent(in) :: c2
+ logical :: s_lle_c
+
+ s_lle_c = (lcompare_cs(c2,s1) /= 'LT')
+
+ end function s_lle_c
+
+!*******************************************************************************
+! lle(character,string)
+
+ elemental function c_lle_s(c1,s2)
+
+ implicit none
+ type(string), intent(in) :: s2
+ character(*), intent(in) :: c1
+ logical :: c_lle_s
+
+ c_lle_s = (lcompare_cs(c1,s2) /= 'GT')
+
+ end function c_lle_s
+
+!*******************************************************************************
+
+ pure function acompare_aa(a1,a2) result(caa)
+
+ implicit none
+ character, intent(in) :: a1(:),a2(:)
+ character(2) :: caa
+ integer :: i,l1,l2
+
+
+ l1 = size(a1)
+ l2 = size(a2)
+ do i=1,min(l1,l2)
+ if (a1(i) < a2(i)) then
+ caa = 'LT'
+ return
+ elseif (a1(i) > a2(i)) then
+ caa = 'GT'
+ return
+ endif
+ enddo
+ if (l1 < l2) then
+ do i=l1+1,l2
+ if (blank < a2(i)) then
+ caa = 'LT'
+ return
+ elseif (blank > a2(i)) then
+ caa = 'GT'
+ return
+ endif
+ enddo
+ elseif (l1 > l2) then
+ do i=l2+1,l1
+ if (a1(i) < blank) then
+ caa = 'LT'
+ return
+ elseif (a1(i) > blank) then
+ caa = 'GT'
+ return
+ endif
+ enddo
+ endif
+ caa = 'EQ'
+
+ end function acompare_aa
+
+!*******************************************************************************
+
+ pure function acompare_ca(c,a) result(cca)
+
+ implicit none
+ character(*), intent(in) :: c
+ character, intent(in) :: a(:)
+ character(2) :: cca
+ integer :: i,lc,la
+
+
+ lc = len(c)
+ la = size(a)
+ do i=1,min(lc,la)
+ if (c(i:i) < a(i)) then
+ cca = 'LT'
+ return
+ elseif (c(i:i) > a(i)) then
+ cca = 'GT'
+ return
+ endif
+ enddo
+ if (lc < la) then
+ do i=lc+1,la
+ if (blank < a(i)) then
+ cca = 'LT'
+ return
+ elseif (blank > a(i)) then
+ cca = 'GT'
+ return
+ endif
+ enddo
+ elseif (lc > la) then
+ do i=la+1,lc
+ if (c(i:i) < blank) then
+ cca = 'LT'
+ return
+ elseif (c(i:i) > blank) then
+ cca = 'GT'
+ return
+ endif
+ enddo
+ endif
+ cca = 'EQ'
+
+ end function acompare_ca
+
+!*******************************************************************************
+! ==
+!*******************************************************************************
+! array == array
+
+ pure function a_eq_a(a1,a2)
+
+ implicit none
+ character, intent(in) :: a1(:),a2(:)
+ logical :: a_eq_a
+ integer :: l1,l2
+
+
+ l1 = size(a1)
+ l2 = size(a2)
+ if (l1 > l2) then
+ a_eq_a = all(a1(1:l2) == a2) .and. &
+ all(a1(l2+1:l1) == blank)
+ elseif (l1 < l2) then
+ a_eq_a = all(a1 == a2(1:l1)) .and. &
+ all(blank == a2(l1+1:l2))
+ else
+ a_eq_a = all(a1 == a2)
+ endif
+
+ end function a_eq_a
+
+!*******************************************************************************
+! array == character
+
+ pure function a_eq_c(a,c)
+
+ implicit none
+ character, intent(in) :: a(:)
+ character(*), intent(in) :: c
+ logical :: a_eq_c
+ integer :: i,la,lc
+
+
+ la = len(a)
+ lc = len(c)
+ do i=1,min(la,lc)
+ if (a(i) /= c(i:i)) then
+ a_eq_c = .false.
+ return
+ endif
+ enddo
+ if ((la > lc) .and. any(a(lc+1:la) /= blank)) then
+ a_eq_c = .false.
+ elseif ((la < lc) .and. (blank /= c(la+1:lc))) then
+ a_eq_c = .false.
+ else
+ a_eq_c = .true.
+ endif
+
+ end function a_eq_c
+
+!*******************************************************************************
+! character == array
+
+ pure function c_eq_a(c,a)
+
+ implicit none
+ character(*), intent(in) :: c
+ character, intent(in) :: a(:)
+ logical :: c_eq_a
+
+
+ c_eq_a = a_eq_c(a,c)
+
+ end function c_eq_a
+
+!*******************************************************************************
+! /=
+!*******************************************************************************
+! array /= array
+
+ pure function a_ne_a(a1,a2)
+
+ implicit none
+ character, intent(in) :: a1(:),a2(:)
+ logical :: a_ne_a
+ integer :: l1,l2
+
+
+ l1 = size(a1)
+ l2 = size(a2)
+ if (l1 > l2) then
+ a_ne_a = any(a1(1:l2) /= a2) .or. &
+ any(a1(l2+1:l1) /= blank)
+ elseif (l1 < l2) then
+ a_ne_a = any(a1 /= a2(1:l1)) .or. &
+ any(blank /= a2(l1+1:l2))
+ else
+ a_ne_a = any(a1 /= a2)
+ endif
+
+ end function a_ne_a
+
+!*******************************************************************************
+! array /= character
+
+ pure function a_ne_c(a,c)
+
+ implicit none
+ character, intent(in) :: a(:)
+ character(*), intent(in) :: c
+ logical :: a_ne_c
+ integer :: i,la,lc
+
+
+ la = size(a)
+ lc = len(c)
+ do i=1,min(la,lc)
+ if (a(i) /= c(i:i) )then
+ a_ne_c = .true.
+ return
+ endif
+ enddo
+ if ((la > lc) .and. any(a(la+1:lc) /= blank)) then
+ a_ne_c = .true.
+ elseif ((la < lc) .and. blank /= c(la+1:lc)) then
+ a_ne_c = .true.
+ else
+ a_ne_c = .false.
+ endif
+
+ end function a_ne_c
+
+!*******************************************************************************
+! character /= array
+
+ pure function c_ne_a(c,a)
+
+ implicit none
+ character(*), intent(in) :: c
+ character, intent(in) :: a(:)
+ logical :: c_ne_a
+
+
+ c_ne_a = acompare_ca(c,a) /= 'EQ'
+
+ end function c_ne_a
+
+!*******************************************************************************
+! < operators
+!*******************************************************************************
+! array < array
+
+ pure function a_lt_a(a1,a2)
+
+ implicit none
+ character, intent(in) :: a1(:),a2(:)
+ logical :: a_lt_a
+
+
+ a_lt_a = acompare_aa(a1,a2) == 'LT'
+
+ end function a_lt_a
+
+!*******************************************************************************
+! array < character
+
+ pure function a_lt_c(a,c)
+
+ implicit none
+ character, intent(in) :: a(:)
+ character(*), intent(in) :: c
+ logical :: a_lt_c
+
+
+ a_lt_c = acompare_ca(c,a) == 'GT'
+
+ end function a_lt_c
+
+!*******************************************************************************
+! character < array
+
+ pure function c_lt_a(c,a)
+
+ implicit none
+ character(*), intent(in) :: c
+ character, intent(in) :: a(:)
+ logical :: c_lt_a
+
+
+ c_lt_a = acompare_ca(c,a) == 'LT'
+
+ end function c_lt_a
+
+!*******************************************************************************
+! <= operators
+!*******************************************************************************
+! array <= array
+
+ pure function a_le_a(a1,a2)
+
+ implicit none
+ character, intent(in) :: a1(:),a2(:)
+ logical :: a_le_a
+
+
+ a_le_a = acompare_aa(a1,a2) /= 'GT'
+
+ end function a_le_a
+
+!*******************************************************************************
+! array <= character
+
+ pure function a_le_c(a,c)
+
+ implicit none
+ character, intent(in) :: a(:)
+ character(*), intent(in) :: c
+ logical :: a_le_c
+
+
+ a_le_c = acompare_ca(c,a) /= 'LT'
+
+ end function a_le_c
+
+!*******************************************************************************
+! character <= array
+
+ pure function c_le_a(c,a)
+
+ implicit none
+ character(*), intent(in) :: c
+ character, intent(in) :: a(:)
+ logical :: c_le_a
+
+
+ c_le_a = acompare_ca(c,a) /= 'GT'
+
+ end function c_le_a
+
+!*******************************************************************************
+! >= operators
+!*******************************************************************************
+! array >= array
+
+ pure function a_ge_a(a1,a2)
+
+ implicit none
+ character, intent(in) :: a1(:),a2(:)
+ logical :: a_ge_a
+
+
+ a_ge_a = acompare_aa(a1,a2) /= 'LT'
+
+ end function a_ge_a
+
+!*******************************************************************************
+! array >= character
+
+ pure function a_ge_c(a,c)
+
+ implicit none
+ character, intent(in) :: a(:)
+ character(*), intent(in) :: c
+ logical :: a_ge_c
+
+
+ a_ge_c = acompare_ca(c,a) /= 'GT'
+
+ end function a_ge_c
+
+!*******************************************************************************
+! character >= array
+
+ pure function c_ge_a(c,a)
+
+ implicit none
+ character(*), intent(in) :: c
+ character, intent(in) :: a(:)
+ logical :: c_ge_a
+
+
+ c_ge_a = acompare_ca(c,a) /= 'LT'
+
+ end function c_ge_a
+
+!*******************************************************************************
+! > operators
+!*******************************************************************************
+! array > array
+
+ pure function a_gt_a(a1,a2)
+
+ implicit none
+ character, intent(in) :: a1(:),a2(:)
+ logical :: a_gt_a
+
+
+ a_gt_a = acompare_aa(a1,a2) == 'GT'
+
+ end function a_gt_a
+
+!*******************************************************************************
+! array > character
+
+ pure function a_gt_c(a,c)
+
+ implicit none
+ character, intent(in) :: a(:)
+ character(*), intent(in) :: c
+ logical :: a_gt_c
+
+
+ a_gt_c = acompare_ca(c,a) == 'LT'
+
+ end function a_gt_c
+
+!*******************************************************************************
+! character > array
+
+ pure function c_gt_a(c,a)
+
+ implicit none
+ character(*), intent(in) :: c
+ character, intent(in) :: a(:)
+ logical :: c_gt_a
+
+
+ c_gt_a = acompare_ca(c,a) == 'GT'
+
+ end function c_gt_a
+
+!*******************************************************************************
+
+ pure function alcompare_aa(a1,a2) result(caa)
+
+ implicit none
+ character, intent(in) :: a1(:),a2(:)
+ character(2) :: caa
+ integer :: i,l1,l2
+
+
+ l1 = size(a1)
+ l2 = size(a2)
+ do i=1,min(l1,l2)
+ if (llt(a1(i),a2(i))) then
+ caa = 'LT'
+ return
+ elseif (lgt(a1(i),a2(i))) then
+ caa = 'GT'
+ return
+ endif
+ enddo
+ if (l1 < l2) then
+ do i=l1+1,l2
+ if (llt(blank,a2(i))) then
+ caa = 'LT'
+ return
+ elseif (lgt(blank,a2(i))) then
+ caa = 'GT'
+ return
+ endif
+ enddo
+ elseif (l1 > l2) then
+ do i=l2+1,l1
+ if (llt(a1(i),blank)) then
+ caa = 'LT'
+ return
+ elseif (lgt(a1(i),blank)) then
+ caa = 'GT'
+ return
+ endif
+ enddo
+ endif
+ caa = 'EQ'
+
+ end function alcompare_aa
+
+!*******************************************************************************
+
+ pure function alcompare_ca(c,a) result(cca)
+
+ implicit none
+ character(*), intent(in) :: c
+ character, intent(in) :: a(:)
+ character(2) :: cca
+ integer :: i,lc,la
+
+
+ lc = len(c)
+ la = size(a)
+ do i=1,min(lc,la)
+ if (llt(c(i:i),a(i))) then
+ cca = 'LT'
+ return
+ elseif (lgt(c(i:i),a(i))) then
+ cca = 'GT'
+ return
+ endif
+ enddo
+ if (lc < la) then
+ do i=lc+1,la
+ if (llt(blank,a(i))) then
+ cca = 'LT'
+ return
+ elseif (lgt(blank,a(i))) then
+ cca = 'GT'
+ return
+ endif
+ enddo
+ elseif (lc > la) then
+ do i=la+1,lc
+ if (llt(c(i:i),blank)) then
+ cca = 'LT'
+ return
+ elseif (lgt(c(i:i),blank)) then
+ cca = 'GT'
+ return
+ endif
+ enddo
+ endif
+ cca = 'EQ'
+
+ end function alcompare_ca
+
+!*******************************************************************************
+! LLT operators
+!*******************************************************************************
+! array < array
+
+ pure function a_allt_a(a1,a2)
+
+ implicit none
+ character, intent(in) :: a1(:),a2(:)
+ logical :: a_allt_a
+
+
+ a_allt_a = alcompare_aa(a1,a2) == 'LT'
+
+ end function a_allt_a
+
+!*******************************************************************************
+! array < character
+
+ pure function a_allt_c(a1,c2)
+
+ implicit none
+ character, intent(in) :: a1(:)
+ character(*), intent(in) :: c2
+ logical :: a_allt_c
+
+
+ a_allt_c = alcompare_ca(c2,a1) == 'GT'
+
+ end function a_allt_c
+
+!*******************************************************************************
+! character < array
+
+ pure function c_allt_a(c1,a2)
+
+ implicit none
+ character(*), intent(in) :: c1
+ character, intent(in) :: a2(:)
+ logical :: c_allt_a
+
+
+ c_allt_a = alcompare_ca(c1,a2) == 'LT'
+
+ end function c_allt_a
+
+!*******************************************************************************
+! LLE operators
+!*******************************************************************************
+! array <= array
+
+ pure function a_alle_a(a1,a2)
+
+ implicit none
+ character, intent(in) :: a1(:),a2(:)
+ logical :: a_alle_a
+
+
+ a_alle_a = alcompare_aa(a1,a2) /= 'GT'
+
+ end function a_alle_a
+
+!*******************************************************************************
+! array <= character
+
+ pure function a_alle_c(a1,c2)
+
+ implicit none
+ character, intent(in) :: a1(:)
+ character(*), intent(in) :: c2
+ logical :: a_alle_c
+
+
+ a_alle_c = alcompare_ca(c2,a1) /= 'LT'
+
+ end function a_alle_c
+
+!*******************************************************************************
+! character <= array
+
+ pure function c_alle_a(c1,a2)
+
+ implicit none
+ character(*), intent(in) :: c1
+ character, intent(in) :: a2(:)
+ logical :: c_alle_a
+
+
+ c_alle_a = alcompare_ca(c1,a2) /= 'GT'
+
+ end function c_alle_a
+
+!*******************************************************************************
+! LGE operators
+!*******************************************************************************
+! array >= array
+
+ pure function a_alge_a(a1,a2)
+
+ implicit none
+ character, intent(in) :: a1(:),a2(:)
+ logical :: a_alge_a
+
+
+ a_alge_a = alcompare_aa(a1,a2) /= 'LT'
+
+ end function a_alge_a
+
+!*******************************************************************************
+! array >= character
+
+ pure function a_alge_c(a1,c2)
+
+ implicit none
+ character, intent(in) :: a1(:)
+ character(*), intent(in) :: c2
+ logical :: a_alge_c
+
+
+ a_alge_c = alcompare_ca(c2,a1) /= 'GT'
+
+ end function a_alge_c
+
+!*******************************************************************************
+! character >= array
+
+ pure function c_alge_a(c1,a2)
+
+ implicit none
+ character(*), intent(in) :: c1
+ character, intent(in) :: a2(:)
+ logical :: c_alge_a
+
+
+ c_alge_a = alcompare_ca(c1,a2) /= 'LT'
+
+ end function c_alge_a
+
+!*******************************************************************************
+! LGT operators
+!*******************************************************************************
+! array > array
+
+ pure function a_algt_a(a1,a2)
+
+ implicit none
+ character, intent(in) :: a1(:),a2(:)
+ logical :: a_algt_a
+
+
+ a_algt_a = alcompare_aa(a1,a2) == 'GT'
+
+ end function a_algt_a
+
+!*******************************************************************************
+! array > character
+
+ pure function a_algt_c(a1,c2)
+
+ implicit none
+ character, intent(in) :: a1(:)
+ character(*), intent(in) :: c2
+ logical :: a_algt_c
+
+
+ a_algt_c = alcompare_ca(c2,a1) == 'LT'
+
+ end function a_algt_c
+
+!*******************************************************************************
+! character > array
+
+ pure function c_algt_a(c1,a2)
+
+ implicit none
+ character(*), intent(in) :: c1
+ character, intent(in) :: a2(:)
+ logical :: c_algt_a
+
+
+ c_algt_a = alcompare_ca(c1,a2) == 'GT'
+
+ end function c_algt_a
+
+!*******************************************************************************
+! INDEX
+!*******************************************************************************
+
+ elemental function index_ss(s,sub,back)
+
+ implicit none
+ type(string), intent(in) :: s,sub
+ logical, intent(in), optional :: back
+ integer :: index_ss
+ logical :: dir_switch
+ integer :: ls,lsub
+
+
+ if (present(back)) then
+ dir_switch = back
+ else
+ dir_switch = .false.
+ endif
+
+ ls = len(s)
+ lsub = len(sub)
+ index_ss = aindex(s%chars(:ls),sub%chars(:lsub),dir_switch)
+
+ end function index_ss
+
+!*******************************************************************************
+
+ elemental function index_sc(s,sub,back)
+
+ implicit none
+ type(string), intent(in) :: s
+ character(*), intent(in) :: sub
+ logical, intent(in), optional :: back
+ integer :: index_sc
+ logical :: dir_switch
+ integer :: ls
+
+
+ if (present(back)) then
+ dir_switch = back
+ else
+ dir_switch = .false.
+ endif
+
+ ls = len(s)
+ index_sc = aindex(s%chars(:ls),sub,dir_switch)
+
+ end function index_sc
+
+!*******************************************************************************
+
+ elemental function index_cs(s,sub,back)
+
+ implicit none
+ character(*), intent(in) :: s
+ type(string), intent(in) :: sub
+ logical, intent(in), optional :: back
+ integer :: index_cs
+ logical :: dir_switch
+
+
+ if (present(back)) then
+ dir_switch = back
+ else
+ dir_switch = .false.
+ endif
+
+ index_cs = index(s,char(sub),dir_switch)
+
+ end function index_cs
+
+!*******************************************************************************
+! AINDEX
+!*******************************************************************************
+
+ pure function aindex_aa(s,sub,back) result(index_aa)
+
+ implicit none
+ character, intent(in) :: s(:),sub(:)
+ logical, intent(in), optional :: back
+ integer :: index_aa
+ logical :: dir_switch
+ integer :: i,ls,lss
+
+
+ if (present(back)) then
+ dir_switch = back
+ else
+ dir_switch = .false.
+ endif
+
+ ls = size(s)
+ lss = size(sub)
+
+ if (lss == 0) then
+ if (dir_switch) then
+ index_aa = ls + 1
+ else
+ index_aa = 1
+ endif
+ return
+ endif
+
+ if (dir_switch) then
+! backwards search
+ do i=ls-lss+1,1,-1
+ if (all(s(i:i+lss-1) == sub(1:lss))) then
+ index_aa = i
+ return
+ endif
+ enddo
+ index_aa = 0
+ else
+! forward search
+ do i=1,ls-lss+1
+ if (all(s(i:i+lss-1) == sub(1:lss))) then
+ index_aa = i
+ return
+ endif
+ enddo
+ index_aa = 0
+ endif
+
+ end function aindex_aa
+
+!*******************************************************************************
+
+ pure function aindex_ac(s,sub,back) result(index_ac)
+
+ implicit none
+ character, intent(in) :: s(:)
+ character(*), intent(in) :: sub
+ logical, intent(in), optional :: back
+ integer :: index_ac
+ logical :: dir_switch,matched
+ integer :: i,j,ls,lss
+
+
+ if (present(back)) then
+ dir_switch = back
+ else
+ dir_switch = .false.
+ endif
+
+ ls = size(s)
+ lss = len(sub)
+
+ if (lss == 0) then
+ if (dir_switch) then
+ index_ac = ls + 1
+ else
+ index_ac = 1
+ endif
+ return
+ endif
+
+ if (dir_switch) then
+ index_ac = 0
+ do i=ls-lss+1,1,-1
+ matched = all(s(i:i+lss-1) == (/ (sub(j:j), j=1,lss) /))
+ if (matched) then
+ index_ac = i
+ return
+ endif
+ enddo
+ else
+ index_ac = 0
+ do i=1,ls-lss+1
+ matched = all(s(i:i+lss-1) == (/ (sub(j:j), j=1,lss) /))
+ if (matched) then
+ index_ac = i
+ return
+ endif
+ enddo
+ endif
+
+ end function aindex_ac
+
+!*******************************************************************************
+
+ pure function aindex_ca(s,sub,back) result(index_ca)
+
+ implicit none
+ character(*), intent(in) :: s
+ character, intent(in) :: sub(:)
+ logical, intent(in), optional :: back
+ integer :: index_ca
+ logical :: dir_switch,matched
+ integer :: i,j,ls,lss
+
+
+ if (present(back)) then
+ dir_switch = back
+ else
+ dir_switch = .false.
+ endif
+
+ ls = len(s)
+ lss = size(sub)
+
+ if (lss == 0) then
+ if (dir_switch) then
+ index_ca = ls + 1
+ else
+ index_ca = 1
+ endif
+ return
+ endif
+
+ if (dir_switch) then
+ do i=ls-lss+1,1,-1
+ matched = .true.
+ do j=1,lss
+ if (s(i+j-1:i+j-1) /= sub(j)) then
+ matched = .false.
+ exit
+ endif
+ enddo
+ if (matched) then
+ index_ca = i
+ return
+ endif
+ enddo
+ index_ca = 0
+ else
+ do i=1,ls-lss+1
+ matched = .true.
+ do j=1,lss
+ if (s(i+j-1:i+j-1) /= sub(j)) then
+ matched = .false.
+ exit
+ endif
+ enddo
+ if (matched) then
+ index_ca = i
+ return
+ endif
+ enddo
+ index_ca = 0
+ endif
+
+ end function aindex_ca
+
+!*******************************************************************************
+! SCAN
+!*******************************************************************************
+
+ elemental function scan_ss(s,set,back)
+
+ implicit none
+ type(string), intent(in) :: s,set
+ logical, intent(in), optional :: back
+ integer :: scan_ss
+ logical :: dir_switch
+ integer :: ls,lset
+
+
+ if (present(back)) then
+ dir_switch = back
+ else
+ dir_switch = .false.
+ endif
+
+ ls = len(s)
+ lset = len(set)
+ scan_ss = ascan_aa(s%chars(1:ls),set%chars(1:lset),dir_switch)
+
+ end function scan_ss
+
+!*******************************************************************************
+
+ elemental function scan_sc(s,set,back)
+
+ implicit none
+ type(string), intent(in) :: s
+ character(*), intent(in) :: set
+ logical, intent(in), optional :: back
+ integer :: scan_sc
+ logical :: dir_switch
+ integer :: ls
+
+
+ if (present(back)) then
+ dir_switch = back
+ else
+ dir_switch = .false.
+ endif
+
+ ls = len(s)
+ scan_sc = ascan_ac(s%chars(1:ls),set,dir_switch)
+
+ end function scan_sc
+
+!*******************************************************************************
+
+ elemental function scan_cs(s,set,back)
+
+ implicit none
+ character(*), intent(in) :: s
+ type(string), intent(in) :: set
+ logical, intent(in), optional :: back
+ integer :: scan_cs
+ logical :: dir_switch
+ integer :: lset
+
+
+ if (present(back)) then
+ dir_switch = back
+ else
+ dir_switch = .false.
+ endif
+
+ lset = len(set)
+ scan_cs = ascan_ca(s,set%chars(1:lset),dir_switch)
+
+ end function scan_cs
+!*******************************************************************************
+! ASCAN
+!*******************************************************************************
+
+ pure function ascan_aa(s,set,back)
+
+ implicit none
+ character, intent(in) :: s(:),set(:)
+ logical, intent(in), optional :: back
+ integer :: ascan_aa
+ logical :: dir_switch
+ integer :: i,ls,lset
+
+
+ if (present(back)) then
+ dir_switch = back
+ else
+ dir_switch = .false.
+ endif
+
+ ls = size(s)
+ lset = size(set)
+ if (dir_switch) then
+! backwards search
+ do i=ls,1,-1
+ if (any(set(1:lset) == s(i))) then
+ ascan_aa = i
+ return
+ endif
+ enddo
+ ascan_aa = 0
+ else
+! forward search
+ do i=1,ls
+ if (any(set(1:lset) == s(i))) then
+ ascan_aa = i
+ return
+ endif
+ enddo
+ ascan_aa = 0
+ endif
+
+ end function ascan_aa
+
+!*******************************************************************************
+
+ pure function ascan_ac(s,set,back)
+
+ implicit none
+ character, intent(in) :: s(:)
+ character(*), intent(in) :: set
+ logical, intent(in), optional :: back
+ integer :: ascan_ac
+ logical :: dir_switch,matched
+ integer :: i,j,ls,lset
+
+
+ if (present(back)) then
+ dir_switch = back
+ else
+ dir_switch = .false.
+ endif
+
+ ls = size(s)
+ lset = len(set)
+ if (dir_switch) then
+! backwards search
+ do i=ls,1,-1
+ matched = .false.
+ do j=1,lset
+ if (s(i) == set(j:j)) then
+ matched = .true.
+ exit
+ endif
+ enddo
+ if (matched) then
+ ascan_ac = i
+ return
+ endif
+ enddo
+ ascan_ac = 0
+ else
+! forward search
+ do i=1,ls
+ matched = .false.
+ do j=1,lset
+ if (s(i) == set(j:j)) then
+ matched = .true.
+ exit
+ endif
+ enddo
+ if (matched) then
+ ascan_ac = i
+ return
+ endif
+ enddo
+ ascan_ac = 0
+ endif
+
+ end function ascan_ac
+
+!*******************************************************************************
+
+ pure function ascan_ca(s,set,back)
+
+ implicit none
+ character(*), intent(in) :: s
+ character, intent(in) :: set(:)
+ logical, intent(in), optional :: back
+ integer :: ascan_ca
+ logical :: dir_switch,matched
+ integer :: i,j,ls,lset
+
+
+ if (present(back)) then
+ dir_switch = back
+ else
+ dir_switch = .false.
+ endif
+
+ ls = len(s)
+ lset = size(set)
+ if (dir_switch) then
+! backwards search
+ do i=ls,1,-1
+ matched = .false.
+ do j=1,lset
+ if (s(i:i) == set(j)) then
+ matched = .true.
+ exit
+ endif
+ enddo
+ if (matched) then
+ ascan_ca = i
+ return
+ endif
+ enddo
+ ascan_ca = 0
+ else
+! forward search
+ do i=1,ls
+ matched = .false.
+ do j=1,lset
+ if (s(i:i) == set(j)) then
+ matched = .true.
+ exit
+ endif
+ enddo
+ if (matched) then
+ ascan_ca = i
+ return
+ endif
+ enddo
+ ascan_ca = 0
+ endif
+
+ end function ascan_ca
+
+!*******************************************************************************
+! VERIFY
+!*******************************************************************************
+
+ elemental function verify_ss(s,set,back)
+
+ implicit none
+ type(string), intent(in) :: s,set
+ logical, intent(in), optional :: back
+ integer :: verify_ss
+ logical :: dir_switch
+ integer :: ls,lset
+
+
+ if (present(back)) then
+ dir_switch = back
+ else
+ dir_switch = .false.
+ endif
+
+ ls = len(s)
+ lset = len(set)
+ verify_ss = averify_aa(s%chars(1:ls),set%chars(1:lset),dir_switch)
+
+ end function verify_ss
+
+!*******************************************************************************
+
+ elemental function verify_sc(s,set,back)
+
+ implicit none
+ type(string), intent(in) :: s
+ character(*), intent(in) :: set
+ logical, intent(in), optional :: back
+ integer :: verify_sc
+ logical :: dir_switch
+ integer :: ls
+
+
+ if (present(back)) then
+ dir_switch = back
+ else
+ dir_switch = .false.
+ endif
+
+ ls = len(s)
+ verify_sc = averify_ac(s%chars(1:ls),set,dir_switch)
+
+ end function verify_sc
+
+!*******************************************************************************
+
+ elemental function verify_cs(s,set,back)
+
+ implicit none
+ character(*), intent(in) :: s
+ type(string), intent(in) :: set
+ logical, intent(in), optional :: back
+ integer :: verify_cs
+ logical :: dir_switch
+ integer :: lset
+
+
+ if (present(back)) then
+ dir_switch = back
+ else
+ dir_switch = .false.
+ endif
+
+ lset = len(set)
+ verify_cs = averify_ca(s,set%chars(1:lset),dir_switch)
+
+ end function verify_cs
+
+!*******************************************************************************
+! AVERIFY
+!*******************************************************************************
+
+ pure function averify_aa(s,set,back)
+
+ implicit none
+ character, intent(in) :: s(:),set(:)
+ logical, intent(in), optional :: back
+ integer :: averify_aa
+ logical :: dir_switch
+ integer :: i,ls,lset
+
+
+ if (present(back)) then
+ dir_switch = back
+ else
+ dir_switch = .false.
+ endif
+
+ ls = size(s)
+ lset = size(set)
+ if (dir_switch) then
+! backwards search
+ do i=ls,1,-1
+ if (.not.(any(set(1:lset) == s(i)))) then
+ averify_aa = i
+ return
+ endif
+ enddo
+ averify_aa = 0
+ else
+! forward search
+ do i=1,ls
+ if (.not.(any(set(1:lset) == s(i)))) then
+ averify_aa = i
+ return
+ endif
+ enddo
+ averify_aa = 0
+ endif
+
+ end function averify_aa
+
+!*******************************************************************************
+
+ pure function averify_ac(s,set,back)
+
+ implicit none
+ character, intent(in) :: s(:)
+ character(*), intent(in) :: set
+ logical, intent(in), optional :: back
+ integer :: averify_ac
+ logical :: dir_switch
+ integer :: i,j,ls,lset
+
+
+ if (present(back)) then
+ dir_switch = back
+ else
+ dir_switch = .false.
+ endif
+
+ ls = size(s)
+ lset = len(set)
+ if (dir_switch) then
+! backwards search
+b: do i=ls,1,-1
+ do j=1,lset
+ if (s(i) == set(j:j)) cycle b
+ enddo
+ averify_ac = i
+ return
+ enddo b
+ averify_ac = 0
+ else
+! forward search
+f: do i=1,ls
+ do j=1,lset
+ if (s(i) == set(j:j)) cycle f
+ enddo
+ averify_ac = i
+ return
+ enddo f
+ averify_ac = 0
+ endif
+
+ end function averify_ac
+
+!*******************************************************************************
+
+ pure function averify_ca(s,set,back)
+
+ implicit none
+ character(*), intent(in) :: s
+ character, intent(in) :: set(:)
+ logical, intent(in), optional :: back
+ integer :: averify_ca
+ logical :: dir_switch
+ integer :: i,j,ls,lset
+
+
+ if (present(back)) then
+ dir_switch = back
+ else
+ dir_switch = .false.
+ endif
+
+ ls = len(s)
+ lset = size(set)
+ if (dir_switch) then
+! backwards search
+b: do i=ls,1,-1
+ do j=1,lset
+ if (s(i:i) == set(j)) cycle b
+ enddo
+ averify_ca = i
+ return
+ enddo b
+ averify_ca = 0
+ else
+! forward search
+f: do i=1,ls
+ do j=1,lset
+ if (s(i:i) == set(j)) cycle f
+ enddo
+ averify_ca = i
+ return
+ enddo f
+ averify_ca = 0
+ endif
+
+ end function averify_ca
+
+!*******************************************************************************
+! UPPERCASE
+!*******************************************************************************
+
+ pure function uppercase_s(s,begin,end)
+
+ implicit none
+ type(string), intent(in) :: s
+ integer, intent(in), optional :: begin,end
+ character(len(s)) :: uppercase_s
+ integer :: i,i1,i2,j
+
+
+ i1 = 1
+ if (present(begin)) i1 = max(i1,begin)
+ i2 = len(s)
+ if (present(end)) i2 = min(i2,end)
+
+ do i=1,i1-1
+ uppercase_s(i:i) = s%chars(i)
+ enddo
+ do i=i1,i2
+ j = iachar(s%chars(i))
+ select case(j)
+ case(97:122)
+ uppercase_s(i:i) = achar(j-32)
+ case default
+ uppercase_s(1:i) = s%chars(i)
+ end select
+ enddo
+ do i=i2+1,len(s)
+ uppercase_s(i:i) = s%chars(i)
+ enddo
+
+ end function uppercase_s
+
+!*******************************************************************************
+
+ pure function uppercase_c(c,begin,end)
+
+ implicit none
+ character(*), intent(in) :: c
+ integer, intent(in), optional :: begin,end
+ character(len(c)) :: uppercase_c
+ integer :: i,i1,i2,j
+
+
+ i1 = 1
+ if (present(begin)) i1 = max(i1,begin)
+ i2 = len(c)
+ if (present(end)) i2 = min(i2,end)
+
+ uppercase_c(:i1-1) = c(:i1-1)
+ do i=i1,i2
+ j = iachar(c(i:i))
+ select case(j)
+ case(97:122)
+ uppercase_c(i:i) = achar(j-32)
+ case default
+ uppercase_c(i:i) = c(i:i)
+ end select
+ enddo
+ uppercase_c(i2+1:) = c(i2+1:)
+
+ end function uppercase_c
+
+!*******************************************************************************
+
+ elemental subroutine to_uppercase_s(s,begin,end)
+
+ implicit none
+ type(string), intent(inout) :: s
+ integer, intent(in), optional :: begin,end
+ integer :: i,i1,i2,j
+
+
+ i1 = 1
+ if (present(begin)) i1 = max(i1,begin)
+ i2 = len(s)
+ if (present(end)) i2 = min(i2,end)
+
+ do i=i1,i2
+ j = iachar(s%chars(i))
+ select case(j)
+ case(97:122)
+ s%chars(i) = achar(j-32)
+ case default
+ continue
+ end select
+ enddo
+
+ end subroutine to_uppercase_s
+
+!*******************************************************************************
+
+ elemental subroutine to_uppercase_c(c,begin,end)
+
+ implicit none
+ character(*), intent(inout) :: c
+ integer, intent(in), optional :: begin,end
+ integer :: i,i1,i2,j
+
+
+ i1 = 1
+ if (present(begin)) i1 = max(i1,begin)
+ i2 = len(c)
+ if (present(end)) i2 = min(i2,end)
+
+ do i=i1,i2
+ j = iachar(c(i:i))
+ select case(j)
+ case(97:122)
+ c(i:i) = achar(j-32)
+ case default
+ continue
+ end select
+ enddo
+
+ end subroutine to_uppercase_c
+
+!*******************************************************************************
+! LOWERCASE
+!*******************************************************************************
+
+ pure function lowercase_s(s,begin,end)
+
+ implicit none
+ type(string), intent(in) :: s
+ integer, intent(in), optional :: begin,end
+ character(len(s)) :: lowercase_s
+ integer :: i,i1,i2,j
+
+
+ i1 = 1
+ if (present(begin)) i1 = max(i1,begin)
+ i2 = len(s)
+ if (present(end)) i2 = min(i2,end)
+
+ do i=1,i1-1
+ lowercase_s(i:i) = s%chars(i)
+ enddo
+ do i=i1,i2
+ j = iachar(s%chars(i))
+ select case(j)
+ case(65:90)
+ lowercase_s(i:i) = achar(j+32)
+ case default
+ lowercase_s(i:i) = s%chars(i)
+ end select
+ enddo
+ do i=i2+1,len(s)
+ lowercase_s(i:i) = s%chars(i)
+ enddo
+
+ end function lowercase_s
+
+!*******************************************************************************
+
+ pure function lowercase_c(c,begin,end)
+
+ implicit none
+ character(*), intent(in) :: c
+ integer, intent(in), optional :: begin,end
+ character(len(c)) :: lowercase_c
+ integer :: i,i1,i2,j
+
+
+ i1 = 1
+ if (present(begin)) i1 = max(i1,begin)
+ i2 = len(c)
+ if (present(end)) i2 = min(i2,end)
+
+ lowercase_c(:i1-1) = c(:i1-1)
+ do i=i1,i2
+ j = iachar(c(i:i))
+ select case(j)
+ case(65:90)
+ lowercase_c(i:i) = achar(j+32)
+ case default
+ lowercase_c(i:i) = c(i:i)
+ end select
+ enddo
+ lowercase_c(i2+1:) = c(i2+1:)
+
+ end function lowercase_c
+
+!*******************************************************************************
+
+ elemental subroutine to_lowercase_s(s,begin,end)
+
+ implicit none
+ type(string), intent(inout) :: s
+ integer, intent(in), optional :: begin,end
+ integer :: i,i1,i2,j
+
+
+ i1 = 1
+ if (present(begin)) i1 = max(i1,begin)
+ i2 = len(s)
+ if (present(end)) i2 = min(i2,end)
+
+ do i=i1,i2
+ j = iachar(s%chars(i))
+ select case(j)
+ case(65:90)
+ s%chars(i) = achar(j+32)
+ case default
+ continue
+ end select
+ enddo
+
+ end subroutine to_lowercase_s
+
+!*******************************************************************************
+
+ elemental subroutine to_lowercase_c(c,begin,end)
+
+ implicit none
+ character(*), intent(inout) :: c
+ integer, intent(in), optional :: begin,end
+ integer :: i,i1,i2,j
+
+
+ i1 = 1
+ if (present(begin)) i1 = max(i1,begin)
+ i2 = len(c)
+ if (present(end)) i2 = min(i2,end)
+
+ do i=i1,i2
+ j = iachar(c(i:i))
+ select case(j)
+ case(65:90)
+ c(i:i) = achar(j+32)
+ case default
+ continue
+ end select
+ enddo
+
+ end subroutine to_lowercase_c
+
+!*******************************************************************************
+
+!*******************************************************************************
+
+ end module m_strings
Index: /XMLF90/src/wxml/flib_wxml.f90
===================================================================
--- /XMLF90/src/wxml/flib_wxml.f90 (revision 6)
+++ /XMLF90/src/wxml/flib_wxml.f90 (revision 6)
@@ -0,0 +1,11 @@
+module flib_wxml
+
+!use m_wxml_buffer
+!use m_wxml_dictionary
+!use m_wxml_elstack
+use m_wxml_text
+use m_wxml_core
+
+public
+
+end module flib_wxml
Index: /XMLF90/src/wxml/m_wxml_buffer.f90
===================================================================
--- /XMLF90/src/wxml/m_wxml_buffer.f90 (revision 6)
+++ /XMLF90/src/wxml/m_wxml_buffer.f90 (revision 6)
@@ -0,0 +1,176 @@
+module m_wxml_buffer
+
+!
+! At this point we use a fixed-size buffer.
+! Note however that buffer overflows will only be
+! triggered by overly long *unbroken* pcdata values, or
+! by overly long attribute values. Hopefully
+! element or attribute names are "short enough".
+! There is code in the parser module m_fsm to avoid buffer overflows
+! caused by pcdata values.
+!
+! This module is re-used from the parser package.
+! Most of the routines are superfluous at this point.
+!
+! In a forthcoming implementation it could be made dynamical...
+!
+integer, parameter, public :: MAX_BUFF_SIZE = 2000
+integer, parameter, private :: BUFF_SIZE_WARNING = 1750
+!
+type, public :: buffer_t
+private
+ integer :: size
+ character(len=MAX_BUFF_SIZE) :: str
+end type buffer_t
+
+public :: add_to_buffer
+public :: print_buffer, str, char, len
+public :: operator (.equal.)
+public :: buffer_nearly_full, reset_buffer
+
+
+!----------------------------------------------------------------
+interface add_to_buffer
+ module procedure add_str_to_buffer
+end interface
+private :: add_char_to_buffer, add_str_to_buffer
+
+interface operator (.equal.)
+ module procedure compare_buffers, compare_buffer_str, &
+ compare_str_buffer
+end interface
+private :: compare_buffers, compare_buffer_str, compare_str_buffer
+
+interface str
+ module procedure buffer_to_str
+end interface
+interface char ! Experimental
+ module procedure buffer_to_str
+end interface
+private :: buffer_to_str
+
+interface len
+ module procedure buffer_length
+end interface
+private :: buffer_length
+
+CONTAINS
+!==================================================================
+
+!----------------------------------------------------------------
+function compare_buffers(a,b) result(equal) ! .equal. generic
+type(buffer_t), intent(in) :: a
+type(buffer_t), intent(in) :: b
+logical :: equal
+
+equal = ((a%size == b%size) .and. (a%str(1:a%size) == b%str(1:b%size)))
+
+end function compare_buffers
+
+!----------------------------------------------------------------
+function compare_buffer_str(buffer,str) result(equal) ! .equal. generic
+type(buffer_t), intent(in) :: buffer
+character(len=*), intent(in) :: str
+logical :: equal
+
+equal = (buffer%str(1:buffer%size) == trim(str))
+
+end function compare_buffer_str
+
+!----------------------------------------------------------------
+function compare_str_buffer(str,buffer) result(equal) ! .equal. generic
+character(len=*), intent(in) :: str
+type(buffer_t), intent(in) :: buffer
+logical :: equal
+
+equal = (buffer%str(1:buffer%size) == trim(str))
+
+end function compare_str_buffer
+
+!----------------------------------------------------------------
+subroutine add_char_to_buffer(c,buffer)
+character(len=1), intent(in) :: c
+type(buffer_t), intent(inout) :: buffer
+
+integer :: n
+buffer%size = buffer%size + 1
+n = buffer%size
+
+if (n> MAX_BUFF_SIZE) then
+ stop "wxml Buffer overflow: long unbroken string of pcdata or attribute value..."
+! RETURN
+!
+endif
+
+buffer%str(n:n) = c
+end subroutine add_char_to_buffer
+
+!----------------------------------------------------------------
+subroutine add_str_to_buffer(s,buffer)
+character(len=*), intent(in) :: s
+type(buffer_t), intent(inout) :: buffer
+
+integer :: n, len_s, last_pos
+
+len_s = len(s)
+last_pos = buffer%size
+buffer%size = buffer%size + len_s
+n = buffer%size
+
+if (n> MAX_BUFF_SIZE) then
+ stop "wxml Buffer overflow: long unbroken string of pcdata or attribute value..."
+! RETURN
+endif
+
+buffer%str(last_pos+1:n) = s
+end subroutine add_str_to_buffer
+
+!----------------------------------------------------------------
+subroutine reset_buffer(buffer)
+type(buffer_t), intent(inout) :: buffer
+
+buffer%size = 0
+
+end subroutine reset_buffer
+
+!----------------------------------------------------------------
+subroutine print_buffer(buffer)
+type(buffer_t), intent(in) :: buffer
+
+integer :: i
+
+do i = 1, buffer%size
+ write(unit=6,fmt="(a1)",advance="no") buffer%str(i:i)
+enddo
+
+end subroutine print_buffer
+!----------------------------------------------------------------
+! This is better... but could it lead to memory leaks?
+!
+function buffer_to_str(buffer) result(str)
+type(buffer_t), intent(in) :: buffer
+character(len=buffer%size) :: str
+
+str = buffer%str(1:buffer%size)
+end function buffer_to_str
+
+!----------------------------------------------------------------
+function buffer_nearly_full(buffer) result(warn)
+type(buffer_t), intent(in) :: buffer
+logical :: warn
+
+warn = buffer%size > BUFF_SIZE_WARNING
+
+end function buffer_nearly_full
+
+!----------------------------------------------------------------
+function buffer_length(buffer) result(length)
+type(buffer_t), intent(in) :: buffer
+integer :: length
+
+length = buffer%size
+
+end function buffer_length
+
+
+end module m_wxml_buffer
Index: /XMLF90/src/wxml/m_wxml_core.f90
===================================================================
--- /XMLF90/src/wxml/m_wxml_core.f90 (revision 6)
+++ /XMLF90/src/wxml/m_wxml_core.f90 (revision 6)
@@ -0,0 +1,380 @@
+module m_wxml_core
+
+use m_wxml_buffer
+use m_wxml_elstack
+use m_wxml_dictionary
+
+logical, private, save :: pcdata_advance_line_default = .false.
+logical, private, save :: pcdata_advance_space_default = .false.
+
+integer, private, parameter :: sp = selected_real_kind(6,30)
+integer, private, parameter :: dp = selected_real_kind(14,100)
+
+private
+
+type, public :: xmlf_t
+ integer :: lun
+ type(buffer_t) :: buffer
+ type(elstack_t) :: stack
+ type(wxml_dictionary_t) :: dict
+ logical :: start_tag_closed
+ logical :: root_element_output
+ logical :: indenting_requested
+end type xmlf_t
+
+public :: xml_OpenFile, xml_NewElement, xml_EndElement, xml_Close
+public :: xml_AddPcdata, xml_AddAttribute, xml_AddXMLDeclaration
+public :: xml_AddComment, xml_AddCdataSection
+
+public :: xml_AddArray
+interface xml_AddArray
+ module procedure xml_AddArray_integer, &
+ xml_AddArray_real_dp, xml_AddArray_real_sp
+end interface
+private :: xml_AddArray_integer, xml_AddArray_real_dp, xml_AddArray_real_sp
+
+private :: get_unit
+private :: add_eol
+private :: write_attributes
+
+
+integer, private, parameter :: COLUMNS = 80
+
+CONTAINS
+
+!-------------------------------------------------------------------
+subroutine xml_OpenFile(filename, xf, indent)
+character(len=*), intent(in) :: filename
+type(xmlf_t), intent(inout) :: xf
+logical, intent(in), optional :: indent
+
+integer :: iostat
+
+call get_unit(xf%lun,iostat)
+if (iostat /= 0) stop "cannot open file"
+open(unit=xf%lun, file=filename, form="formatted", status="replace", &
+ action="write", position="rewind") ! , recl=65536)
+
+call reset_elstack(xf%stack)
+call reset_dict(xf%dict)
+call reset_buffer(xf%buffer)
+
+xf%start_tag_closed = .true.
+xf%root_element_output = .false.
+
+xf%indenting_requested = .false.
+if (present(indent)) then
+ xf%indenting_requested = indent
+endif
+end subroutine xml_OpenFile
+
+!-------------------------------------------------------------------
+subroutine xml_AddXMLDeclaration(xf,encoding)
+type(xmlf_t), intent(inout) :: xf
+character(len=*), intent(in), optional :: encoding
+
+if (present(encoding)) then
+ call add_to_buffer("", xf%buffer)
+else
+ call add_to_buffer("", xf%buffer)
+endif
+end subroutine xml_AddXMLDeclaration
+
+!-------------------------------------------------------------------
+subroutine xml_AddComment(xf,comment)
+type(xmlf_t), intent(inout) :: xf
+character(len=*), intent(in) :: comment
+
+call close_start_tag(xf,">")
+call add_eol(xf)
+call add_to_buffer("", xf%buffer)
+end subroutine xml_AddComment
+
+!-------------------------------------------------------------------
+subroutine xml_AddCdataSection(xf,cdata)
+type(xmlf_t), intent(inout) :: xf
+character(len=*), intent(in) :: cdata
+
+call close_start_tag(xf,">")
+call add_to_buffer("", xf%buffer)
+end subroutine xml_AddCdataSection
+
+!-------------------------------------------------------------------
+subroutine xml_NewElement(xf,name)
+type(xmlf_t), intent(inout) :: xf
+character(len=*), intent(in) :: name
+
+if (is_empty(xf%stack)) then
+ if (xf%root_element_output) stop "two root elements"
+ xf%root_element_output = .true.
+endif
+
+call close_start_tag(xf,">")
+call push_elstack(name,xf%stack)
+call add_eol(xf)
+call add_to_buffer("<" // trim(name),xf%buffer)
+xf%start_tag_closed = .false.
+call reset_dict(xf%dict)
+
+end subroutine xml_NewElement
+!-------------------------------------------------------------------
+subroutine xml_AddPcdata(xf,pcdata,space,line_feed)
+type(xmlf_t), intent(inout) :: xf
+character(len=*), intent(in) :: pcdata
+logical, intent(in), optional :: space
+logical, intent(in), optional :: line_feed
+
+logical :: advance_line , advance_space
+integer :: n, i, jmax
+integer, parameter :: chunk_size = 128
+
+advance_line = pcdata_advance_line_default
+if (present(line_feed)) then
+ advance_line = line_feed
+endif
+
+advance_space = pcdata_advance_space_default
+if (present(space)) then
+ advance_space = space
+endif
+
+if (is_empty(xf%stack)) then
+ stop "pcdata outside element content"
+endif
+
+call close_start_tag(xf,">")
+
+if (advance_line) then
+ call add_eol(xf)
+ advance_space = .false.
+else
+ if (xf%indenting_requested) then
+ if ((len(xf%buffer) + len_trim(pcdata) + 1) > COLUMNS ) then
+ call add_eol(xf)
+ advance_space = .false.
+ endif
+ endif
+endif
+if (advance_space) call add_to_buffer(" ",xf%buffer)
+if (len(xf%buffer) > 0) call dump_buffer(xf,lf=.false.)
+!
+! We bypass the buffer for the bulk of the dump
+!
+n = len(pcdata)
+!print *, "writing pcdata of length: ", n
+i = 1
+do
+ jmax = min(i+chunk_size-1,n)
+! print *, "writing chunk: ", i, jmax
+ write(unit=xf%lun,fmt="(a)",advance="no") pcdata(i:jmax)
+ if (jmax == n) exit
+ i = jmax + 1
+enddo
+end subroutine xml_AddPcdata
+
+!-------------------------------------------------------------------
+subroutine xml_AddAttribute(xf,name,value)
+type(xmlf_t), intent(inout) :: xf
+character(len=*), intent(in) :: name
+character(len=*), intent(in) :: value
+
+if (is_empty(xf%stack)) then
+ stop "attributes outside element content"
+endif
+
+if (xf%start_tag_closed) then
+ stop "attributes outside start tag"
+endif
+if (has_key(xf%dict,name)) then
+ stop "duplicate att name"
+endif
+
+call add_key_to_dict(trim(name),xf%dict)
+call add_value_to_dict(trim(value),xf%dict)
+
+end subroutine xml_AddAttribute
+
+!-----------------------------------------------------------
+subroutine xml_EndElement(xf,name)
+type(xmlf_t), intent(inout) :: xf
+character(len=*), intent(in) :: name
+
+character(len=100) :: current
+
+if (is_empty(xf%stack)) then
+ stop "Out of elements to close"
+endif
+
+call get_top_elstack(xf%stack,current)
+if (current /= name) then
+ print *, "current, name: ", trim(current), " ", trim(name)
+ stop
+endif
+if (.not. xf%start_tag_closed) then ! Empty element
+ if (len(xf%dict) > 0) call write_attributes(xf)
+ call add_to_buffer(" />",xf%buffer)
+ xf%start_tag_closed = .true.
+else
+ call add_eol(xf)
+ call add_to_buffer("" // trim(name) // ">", xf%buffer)
+endif
+call pop_elstack(xf%stack,current)
+
+end subroutine xml_EndElement
+
+!----------------------------------------------------------------
+
+subroutine xml_Close(xf)
+type(xmlf_t), intent(in) :: xf
+
+write(unit=xf%lun,fmt="(a)") char(xf%buffer)
+close(unit=xf%lun)
+
+end subroutine xml_Close
+
+!==================================================================
+!-------------------------------------------------------------------
+subroutine get_unit(lun,iostat)
+
+! Get an available Fortran unit number
+
+integer, intent(out) :: lun
+integer, intent(out) :: iostat
+
+integer :: i
+logical :: unit_used
+
+do i = 10, 99
+ lun = i
+ inquire(unit=lun,opened=unit_used)
+ if (.not. unit_used) then
+ iostat = 0
+ return
+ endif
+enddo
+iostat = -1
+lun = -1
+end subroutine get_unit
+
+!----------------------------------------------------------
+subroutine add_eol(xf)
+type(xmlf_t), intent(inout) :: xf
+
+integer :: indent_level
+character(len=100), parameter :: blanks = ""
+
+indent_level = len(xf%stack) - 1
+write(unit=xf%lun,fmt="(a)") char(xf%buffer)
+call reset_buffer(xf%buffer)
+
+if (xf%indenting_requested) &
+ call add_to_buffer(blanks(1:indent_level),xf%buffer)
+
+end subroutine add_eol
+!------------------------------------------------------------
+subroutine dump_buffer(xf,lf)
+type(xmlf_t), intent(inout) :: xf
+logical, intent(in), optional :: lf
+
+if (present(lf)) then
+ if (lf) then
+ write(unit=xf%lun,fmt="(a)",advance="yes") char(xf%buffer)
+ else
+ write(unit=xf%lun,fmt="(a)",advance="no") char(xf%buffer)
+ endif
+else
+ write(unit=xf%lun,fmt="(a)",advance="no") char(xf%buffer)
+endif
+call reset_buffer(xf%buffer)
+
+end subroutine dump_buffer
+
+!------------------------------------------------------------
+subroutine close_start_tag(xf,s)
+type(xmlf_t), intent(inout) :: xf
+character(len=*), intent(in) :: s
+
+if (.not. xf%start_tag_closed) then
+ if (len(xf%dict) > 0) call write_attributes(xf)
+ call add_to_buffer(s, xf%buffer)
+ xf%start_tag_closed = .true.
+endif
+
+end subroutine close_start_tag
+
+!-------------------------------------------------------------
+subroutine write_attributes(xf)
+type(xmlf_t), intent(inout) :: xf
+
+integer :: i, status, size
+character(len=100) :: key, value
+
+do i = 1, len(xf%dict)
+ call get_key(xf%dict,i,key,status)
+ call get_value(xf%dict,key,value,status)
+ key = adjustl(key)
+ value = adjustl(value)
+ size = len_trim(key) + len_trim(value) + 4
+ if ((len(xf%buffer) + size) > COLUMNS) call add_eol(xf)
+ call add_to_buffer(" ", xf%buffer)
+ call add_to_buffer(trim(key), xf%buffer)
+ call add_to_buffer("=", xf%buffer)
+ call add_to_buffer("""",xf%buffer)
+ call add_to_buffer(trim(value), xf%buffer)
+ call add_to_buffer("""", xf%buffer)
+enddo
+
+end subroutine write_attributes
+
+!---------------------------------------------------------------
+ subroutine xml_AddArray_integer(xf,a,format)
+ type(xmlf_t), intent(inout) :: xf
+ integer, intent(in), dimension(:) :: a
+ character(len=*), intent(in), optional :: format
+
+ call close_start_tag(xf,">")
+ if (len(xf%buffer) > 0) call dump_buffer(xf,lf=.true.)
+ if (present(format)) then
+ write(xf%lun,format) a
+ else
+ write(xf%lun,"(6(i12))") a
+ endif
+ end subroutine xml_AddArray_integer
+
+!-------------------------------------------------------------------
+ subroutine xml_AddArray_real_dp(xf,a,format)
+ type(xmlf_t), intent(inout) :: xf
+ real(kind=dp), intent(in), dimension(:) :: a
+ character(len=*), intent(in), optional :: format
+
+ call close_start_tag(xf,">")
+ if (len(xf%buffer) > 0) call dump_buffer(xf,lf=.true.)
+ if (present(format)) then
+ write(xf%lun,format) a
+ else
+ write(xf%lun,"(4(es20.12))") a
+ endif
+ end subroutine xml_AddArray_real_dp
+
+!------------------------------------------------------------------
+ subroutine xml_AddArray_real_sp(xf,a,format)
+ type(xmlf_t), intent(inout) :: xf
+ real(kind=sp), intent(in), dimension(:) :: a
+ character(len=*), intent(in), optional :: format
+
+ call close_start_tag(xf,">")
+ if (len(xf%buffer) > 0) call dump_buffer(xf,lf=.true.)
+ if (present(format)) then
+ write(xf%lun,format) a
+ else
+ write(xf%lun,"(4(es20.12))") a
+ endif
+ end subroutine xml_AddArray_real_sp
+
+end module m_wxml_core
+
Index: /XMLF90/src/wxml/m_wxml_dictionary.f90
===================================================================
--- /XMLF90/src/wxml/m_wxml_dictionary.f90 (revision 6)
+++ /XMLF90/src/wxml/m_wxml_dictionary.f90 (revision 6)
@@ -0,0 +1,162 @@
+module m_wxml_dictionary
+
+private
+!
+! A very rough implementation for now
+! It uses fixed-length buffers for key/value pairs,
+! and the maximum number of dictionary items is hardwired.
+
+integer, parameter, private :: MAX_ITEMS = 30
+type, public :: wxml_dictionary_t
+private
+ integer :: number_of_items ! = 0
+ character(len=100), dimension(MAX_ITEMS) :: key
+ character(len=100), dimension(MAX_ITEMS) :: value
+end type wxml_dictionary_t
+
+!
+! Building procedures
+!
+public :: add_key_to_dict, add_value_to_dict, reset_dict
+
+!
+! Query and extraction procedures
+!
+public :: len
+interface len
+ module procedure number_of_entries
+end interface
+public :: number_of_entries
+public :: get_key
+public :: get_value
+public :: has_key
+public :: print_dict
+!
+interface get_value
+ module procedure wxml_get_value
+end interface
+
+CONTAINS
+
+!------------------------------------------------------
+function number_of_entries(dict) result(n)
+type(wxml_dictionary_t), intent(in) :: dict
+integer :: n
+
+n = dict%number_of_items
+
+end function number_of_entries
+
+!------------------------------------------------------
+function has_key(dict,key) result(found)
+type(wxml_dictionary_t), intent(in) :: dict
+character(len=*), intent(in) :: key
+logical :: found
+
+integer :: n, i
+found = .false.
+n = dict%number_of_items
+do i = 1, n
+ if (dict%key(i) == key) then
+ found = .true.
+ exit
+ endif
+enddo
+end function has_key
+
+!------------------------------------------------------
+subroutine wxml_get_value(dict,key,value,status)
+type(wxml_dictionary_t), intent(in) :: dict
+character(len=*), intent(in) :: key
+character(len=*), intent(out) :: value
+integer, intent(out) :: status
+!
+integer :: n, i
+
+status = -1
+n = dict%number_of_items
+do i = 1, n
+ if (dict%key(i) == key) then
+ value = dict%value(i)
+ status = 0
+ RETURN
+ endif
+enddo
+
+end subroutine wxml_get_value
+
+!------------------------------------------------------
+subroutine get_key(dict,i,key,status)
+!
+! Get the i'th key
+!
+type(wxml_dictionary_t), intent(in) :: dict
+integer, intent(in) :: i
+character(len=*), intent(out) :: key
+integer, intent(out) :: status
+
+if (i <= dict%number_of_items) then
+ key = dict%key(i)
+ status = 0
+else
+ key = ""
+ status = -1
+endif
+
+end subroutine get_key
+
+!------------------------------------------------------
+subroutine add_key_to_dict(key,dict)
+character(len=*), intent(in) :: key
+type(wxml_dictionary_t), intent(inout) :: dict
+
+integer :: n
+
+n = dict%number_of_items
+if (n == MAX_ITEMS) then
+ write(unit=0,fmt=*) "Dictionary capacity exceeded !"
+ RETURN
+endif
+
+n = n + 1
+dict%key(n) = key
+dict%number_of_items = n
+
+end subroutine add_key_to_dict
+
+!------------------------------------------------------
+! Assumes we build the dictionary in an orderly fashion,
+! so one adds first the key and then immediately afterwards the value.
+!
+subroutine add_value_to_dict(value,dict)
+character(len=*), intent(in) :: value
+type(wxml_dictionary_t), intent(inout) :: dict
+
+integer :: n
+
+n = dict%number_of_items
+dict%value(n) = value
+
+end subroutine add_value_to_dict
+
+!------------------------------------------------------
+subroutine reset_dict(dict)
+type(wxml_dictionary_t), intent(inout) :: dict
+
+dict%number_of_items = 0
+
+end subroutine reset_dict
+
+!------------------------------------------------------
+subroutine print_dict(dict)
+type(wxml_dictionary_t), intent(in) :: dict
+
+integer :: i
+
+do i = 1, dict%number_of_items
+ print *, trim(dict%key(i)), " = ", trim(dict%value(i))
+enddo
+
+end subroutine print_dict
+
+end module m_wxml_dictionary
Index: /XMLF90/src/wxml/m_wxml_elstack.f90
===================================================================
--- /XMLF90/src/wxml/m_wxml_elstack.f90 (revision 6)
+++ /XMLF90/src/wxml/m_wxml_elstack.f90 (revision 6)
@@ -0,0 +1,143 @@
+module m_wxml_elstack
+
+private
+
+!
+! Simple stack to keep track of which elements have appeared so far
+!
+integer, parameter, private :: STACK_SIZE = 20
+
+type, public :: elstack_t
+private
+ integer :: n_items
+ character(len=100), dimension(STACK_SIZE) :: data
+end type elstack_t
+
+public :: push_elstack, pop_elstack, reset_elstack, print_elstack
+public :: get_top_elstack, is_empty, get_elstack_signature
+public :: len
+
+interface len
+ module procedure number_of_items
+end interface
+private :: number_of_items
+
+interface is_empty
+ module procedure is_empty_elstack
+end interface
+private :: is_empty_elstack
+
+CONTAINS
+
+!-----------------------------------------------------------------
+subroutine reset_elstack(elstack)
+type(elstack_t), intent(inout) :: elstack
+
+elstack%n_items = 0
+
+end subroutine reset_elstack
+
+!-----------------------------------------------------------------
+function is_empty_elstack(elstack) result(answer)
+type(elstack_t), intent(in) :: elstack
+logical :: answer
+
+answer = (elstack%n_items == 0)
+end function is_empty_elstack
+
+!-----------------------------------------------------------------
+function number_of_items(elstack) result(n)
+type(elstack_t), intent(in) :: elstack
+integer :: n
+
+n = elstack%n_items
+end function number_of_items
+
+!-----------------------------------------------------------------
+subroutine push_elstack(item,elstack)
+character(len=*), intent(in) :: item
+type(elstack_t), intent(inout) :: elstack
+
+integer :: n
+
+n = elstack%n_items
+if (n == STACK_SIZE) then
+ stop "*Element stack full"
+endif
+n = n + 1
+elstack%data(n) = item
+elstack%n_items = n
+
+end subroutine push_elstack
+
+!-----------------------------------------------------------------
+subroutine pop_elstack(elstack,item)
+type(elstack_t), intent(inout) :: elstack
+character(len=*), intent(out) :: item
+
+!
+! We assume the elstack is not empty... (the user has called is_empty first)
+!
+integer :: n
+
+n = elstack%n_items
+if (n == 0) then
+ stop "*********Element stack empty"
+endif
+item = elstack%data(n)
+elstack%n_items = n - 1
+
+end subroutine pop_elstack
+
+!-----------------------------------------------------------------
+subroutine get_top_elstack(elstack,item)
+!
+! Get the top element of the stack, *without popping it*.
+!
+type(elstack_t), intent(in) :: elstack
+character(len=*), intent(out) :: item
+
+!
+! We assume the elstack is not empty... (the user has called is_empty first)
+!
+integer :: n
+
+n = elstack%n_items
+if (n == 0) then
+ stop "*********Element stack empty"
+endif
+item = elstack%data(n)
+
+end subroutine get_top_elstack
+
+!-----------------------------------------------------------------
+subroutine print_elstack(elstack,unit)
+type(elstack_t), intent(in) :: elstack
+integer, intent(in) :: unit
+integer :: i
+
+do i = elstack%n_items, 1, -1
+ write(unit=unit,fmt=*) trim(elstack%data(i))
+enddo
+
+end subroutine print_elstack
+
+!-------------------------------------------------------------
+subroutine get_elstack_signature(elstack,string)
+type(elstack_t), intent(in) :: elstack
+character(len=*), intent(out) :: string
+integer :: i, length, j
+
+string = ""
+j = 0
+do i = 1, elstack%n_items
+ length = len_trim(elstack%data(i))
+ string(j+1:j+1) = "/"
+ j = j+1
+ string(j+1:j+length) = trim(elstack%data(i))
+ j = j + length
+enddo
+
+end subroutine get_elstack_signature
+
+end module m_wxml_elstack
Index: /XMLF90/src/wxml/m_wxml_text.f90
===================================================================
--- /XMLF90/src/wxml/m_wxml_text.f90 (revision 6)
+++ /XMLF90/src/wxml/m_wxml_text.f90 (revision 6)
@@ -0,0 +1,73 @@
+module m_wxml_text
+!
+integer, private, parameter :: sp = selected_real_kind(6,30)
+integer, private, parameter :: dp = selected_real_kind(14,100)
+!
+! TODO : Add optional format parameter
+!
+private
+
+public :: str
+
+interface str
+ module procedure str_integer, str_real_dp, str_real_sp, &
+ str_logical
+end interface
+private :: str_integer, str_real_dp, str_real_sp, str_logical
+
+CONTAINS
+
+ function str_integer(int,format) result(s)
+ integer, intent(in) :: int
+ character(len=*), intent(in), optional :: format
+ character(len=100) :: s
+
+ if (present(format)) then
+ write(s,format) int
+ else
+ write(s,"(i25)") int
+ endif
+ s = adjustl(s)
+ end function str_integer
+
+ function str_logical(log,format) result(s)
+ logical, intent(in) :: log
+ character(len=*), intent(in), optional :: format
+ character(len=100) :: s
+
+ if (present(format)) then
+ write(s,format) log
+ else
+ write(s,"(l1)") log
+ endif
+ s = adjustl(s)
+ end function str_logical
+
+ function str_real_dp(x,format) result(s)
+ real(kind=dp), intent(in) :: x
+ character(len=*), intent(in), optional :: format
+ character(len=100) :: s
+
+ if (present(format)) then
+ write(s,format) x
+ else
+ write(s,"(g22.12)") x
+ endif
+ s = adjustl(s)
+ end function str_real_dp
+
+ function str_real_sp(x,format) result(s)
+ real(kind=sp), intent(in) :: x
+ character(len=*), intent(in), optional :: format
+ character(len=100) :: s
+
+ if (present(format)) then
+ write(s,format) x
+ else
+ write(s,"(g22.12)") x
+ endif
+ s = adjustl(s)
+ end function str_real_sp
+
+
+end module m_wxml_text
Index: /XMLF90/src/xpath/Ba.xml
===================================================================
--- /XMLF90/src/xpath/Ba.xml (revision 6)
+++ /XMLF90/src/xpath/Ba.xml (revision 6)
@@ -0,0 +1,34 @@
+
+
+
+
+
+
+ pg Ba with 5s as semicore, 5p in valence -- soft Vf
+ Ba
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ test Ba
+ Ba
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/src/xpath/Developer.Guide
===================================================================
--- /XMLF90/src/xpath/Developer.Guide (revision 6)
+++ /XMLF90/src/xpath/Developer.Guide (revision 6)
@@ -0,0 +1,63 @@
+Developer Notes for the XPATH-lite API
+
+This API is built on top of the more fundamental SAX one. The basic
+idea is to have a set of programable handlers that communicate among
+themselves and with the parser via module variables.
+
+A new pseudo-handler, "signal_handler", has been added to the optional
+argument list of xml_parse(). In the current implementation it just
+checks whether a stop signal has been raised by the user side of the
+program (for example, after a "begin tag" event, or after going out
+of the scope of a parent element).
+
+Since the SAX parser is stream-oriented, and XPATH searches can be
+done in any order, there are new routines to rewind the XML file and
+to synchronize the physical file reader with a previously saved point
+in the XML tree.
+
+These tools, and the rather sophisticated path-matching routine
+provided (which allows for wildcards and the "//" construction) would
+be enough for standard use, as implemented in the routine
+"get_node". However, there is also the possibility of performing
+searches constrained to a given ancestor element ("context" searches)
+so that blocks of logically related information can be processed
+together. A context is implicitly created by a call to
+"mark_node". Contexts can be saved and "synched" to, allowing for
+repeated constrained searches (calls with relative paths). Contexts
+can even be passed to subroutines to package the parsing of common
+elements once and for all. (See for example Examples/xpath/pseudo.f90).
+This feature is nevertheless in need of a more rigorous specification:
+
+* What should be the behavior if a "mark_node" is followed by a
+ call to "get_node" with an absolute path?
+* Should there always be an "automatic rewind" to the beginning of the
+ context before any successive calls to "get_node"?
+
+
+LIMITATIONS
+
+The pcdata buffer provided by the user as a character variable could
+overflow. Note that the parser itself uses a string of length
+MAX_PCDATA_SIZE (currently 65536) as a buffer to hold PCDATA. A
+warning is issued if there is not enough space (in the user or in the
+system buffer) to hold the data.
+
+Support for converting PCDATA characters to numerical arrays "on the
+fly" is planned for a forthcoming version.
+
+
+The coding style is that of the F subset of Fortran90. I strongly
+believe that it makes for better coding and fewer errors.
+Go to http://www.fortran.com/imagine1/ and get a feel for it. You can
+download free implementations for Linux and Windows, or get an
+inexpensive CD+Book combination to help support the project. Of course,
+F *is* Fortran, so you can always compile it with a Fortran compiler.
+
+
+
+
+
+
+
+
+
Index: /XMLF90/src/xpath/flib_xpath.f90
===================================================================
--- /XMLF90/src/xpath/flib_xpath.f90 (revision 6)
+++ /XMLF90/src/xpath/flib_xpath.f90 (revision 6)
@@ -0,0 +1,12 @@
+module flib_xpath
+
+!
+! Stub module to gather all the XML functionality needed by the user
+!
+use flib_sax
+use m_path
+
+public
+
+end module flib_xpath
+
Index: /XMLF90/src/xpath/m_path.f90
===================================================================
--- /XMLF90/src/xpath/m_path.f90 (revision 6)
+++ /XMLF90/src/xpath/m_path.f90 (revision 6)
@@ -0,0 +1,617 @@
+module m_path
+!
+! XPATH-like API for XML Parsing
+! Copyright Alberto Garcia , August 2003
+!
+use flib_sax
+
+private
+!
+public :: get_node, mark_node, enable_debug, disable_debug
+
+private :: match, process_node, get_path
+private :: begin_element, end_element, pcdata_handler, empty_element
+private :: pause_parsing
+
+!
+integer, private, save :: global_status
+integer, public, parameter :: END_OF_FILE = -1
+integer, public, parameter :: END_OF_ANCESTOR_ELEMENT = -2
+integer, public, parameter :: PCDATA_OVERFLOW = 7
+
+logical, private, save :: debug_xpath = .false.
+logical, private, save :: debug_sax = .false.
+character(len=500), private, save :: path_required
+character(len=100), private, save :: target_path ! *** Hard limit
+
+
+logical, private, save :: in_target_element = .false.
+logical, private, save :: in_pcdata_level = .false.
+
+logical, private, save :: stop_parsing = .false.
+!
+! This global variable determines whether we stop after
+! getting the initial element tag, or after digesting the full node.
+!
+logical, private, save :: full_node = .true.
+
+logical, private, save :: relative_path = .false.
+logical, private, save :: looking_for_current_element
+
+logical, private, save :: attributes_requested
+type(dictionary_t), private, save, pointer :: attributes_recovered
+
+integer, parameter, private :: MAX_PCDATA_SIZE = 65536
+logical, private, save :: pcdata_requested
+character(len=MAX_PCDATA_SIZE), private, &
+ save :: pcdata_recovered !*** Hard
+integer, private, save :: len_pcdata
+integer, private, save :: max_len_pcdata
+
+type(xml_t), pointer, save, private :: xp
+
+CONTAINS !===========================================================
+
+!----------------------------------------------------
+! Debugging control
+!
+subroutine enable_debug(sax)
+logical, intent(in), optional :: sax
+ debug_xpath = .true.
+ debug_sax = .false.
+ if (present(sax)) then
+ debug_sax = sax
+ endif
+end subroutine enable_debug
+
+subroutine disable_debug()
+ debug_xpath = .false.
+end subroutine disable_debug
+
+!----------------------------------------------------
+! Main routines
+!---------------------------------------------------------------------
+subroutine mark_node(fxml,path,att_name,att_value,attributes,status)
+!
+! Performs a search of a given element (by path, and/or presence of
+! a given attribute and/or value of that attribute), returning optionally
+! the element's attribute dictionary, and leaving the file handle fxml'
+! ready to process the rest of the element's contents (child elements'
+! and/or pcdata).
+!
+! Side effects: it sets "ancestor_path" to the element's path'
+!
+! If the argument "path" is present and evaluates to a relative path (a
+! string not beginning with "/"), the search is interrupted after the end
+! of the "ancestor_element" set by a previous call to "mark_node".
+! If not earlier, the search ends at the end of the file.
+!
+! The status argument, if present, will hold a return value,
+! which will be:
+!
+! 0 on success,
+! negative in case of end-of-file or end-of-ancestor-element, or
+! positive in case of a malfunction
+!
+type(xml_t), intent(inout), target :: fxml
+character(len=*), intent(in), optional :: path
+character(len=*), intent(in), optional :: att_name
+character(len=*), intent(in), optional :: att_value
+type(dictionary_t), intent(out), optional :: attributes
+integer, intent(out), optional :: status
+
+
+character(len=200) :: ancestor_path ! local variable
+
+ full_node = .false.
+ call process_node(fxml, &
+ path,att_name,att_value, &
+ attributes, &
+ status=status)
+ if (status == 0) then
+ call xml_mark_path(fxml,ancestor_path)
+ if (debug_xpath) print *, "Setting ancestor_path to: ", trim(ancestor_path)
+ endif
+
+end subroutine mark_node
+
+!--------------------------------------------------------------------
+subroutine get_node(fxml,path,att_name,att_value,attributes,pcdata,status)
+!
+! Performs a search of a given element (by path, and/or presence of
+! a given attribute and/or value of that attribute), returning optionally
+! the element's attribute dictionary and any PCDATA characters contained'
+! in the element's scope (but not child elements). It leaves the file handle'
+! physically and logically positioned:
+!
+! after the end of the element's start tag if 'pcdata' is not present'
+! after the end of the element's end tag if 'pcdata' is present'
+!
+! If the argument "path" is present and evaluates to a relative path (a
+! string not beginning with "/"), the search is interrupted after the end
+! of the "ancestor_element" set by a previous call to "mark_node".
+! If not earlier, the search ends at the end of the file.
+!
+! The status argument, if present, will hold a return value,
+! which will be:
+!
+! 0 on success,
+! negative in case of end-of-file or end-of-ancestor-element, or
+! positive in case of a malfunction (such as the overflow of the
+! user's pcdata buffer).'
+!
+type(xml_t), intent(inout), target :: fxml
+character(len=*), intent(in), optional :: path
+character(len=*), intent(in), optional :: att_name
+character(len=*), intent(in), optional :: att_value
+type(dictionary_t), intent(out), optional :: attributes
+character(len=*), intent(out), optional, target :: pcdata
+integer, intent(out), optional :: status
+
+ full_node = present(pcdata)
+ call process_node(fxml, &
+ path,att_name,att_value, &
+ attributes,pcdata, &
+ status=status)
+
+end subroutine get_node
+!
+!--------------------------------------------------------------------
+! Workhorse routines follow
+!--------------------------------------------------------------------
+subroutine process_node(fxml,path,att_name,att_value, &
+ attributes,pcdata,&
+ status)
+type(xml_t), intent(inout), target :: fxml
+character(len=*), intent(in), optional :: path
+character(len=*), intent(in), optional :: att_name
+character(len=*), intent(in), optional :: att_value
+type(dictionary_t), intent(out), optional :: attributes
+character(len=*), intent(out), optional, target :: pcdata
+integer, intent(out), optional :: status
+
+logical :: path_present, att_name_present, att_value_present
+logical :: attributes_present
+
+character(len=3) :: any_path = "//*"
+character(len=200) :: local_path, ancestor_path ! *** Hard limit
+character(len=500) :: value ! *** Hard limit
+integer :: local_status
+
+type(dictionary_t) :: local_attributes
+
+global_status = 0 ! reset
+
+path_present = present(path)
+attributes_present = present(attributes)
+att_name_present = present(att_name)
+att_value_present = present(att_value)
+
+relative_path = .false.
+
+if (path_present) then
+ if (debug_xpath) print *, "SEARCHING for: ", trim(path)
+ if (path(1:1) /= "/") then
+ !
+ ! Relative path search
+ !
+ call xml_path(fxml,local_path)
+ call xml_get_path_mark(fxml,ancestor_path)
+ if (ancestor_path == "") then
+ if (debug_xpath) print *, "Relative search with null ancestor..."
+ endif
+ relative_path = .true.
+ if (debug_xpath) print *, "Relative search. ANCESTOR ELEMENT: ", &
+ trim(ancestor_path)
+ !
+ ! Convert to absolute path
+ local_path = trim(local_path) // "/" // trim(path)
+ if (debug_xpath) print *, "Converting ", trim(path), &
+ " to absolute path: ", trim(local_path)
+ else
+ local_path = path
+ endif
+else
+ local_path = any_path
+endif
+
+looking_for_current_element = (path == ".")
+!
+! Use local_attributes, since it is in principle possible that
+! the user does not need to get back the attribute list.
+!
+do ! Loop until we satisfy the constraints
+
+ if (debug_xpath) print *, "--> Calling get_path ..."
+ call get_path(fxml,local_path,local_attributes,pcdata,local_status)
+ if (debug_xpath) print *, "-->Status after get_path: ", local_status
+ if (local_status /= 0) EXIT
+
+ if (debug_xpath) print *, "FOUND path matching: ", trim(local_path)
+
+ if (att_name_present) then
+ if (debug_xpath) print *, "Checking ", trim(att_name), " among ", &
+ number_of_entries(local_attributes), " entries:"
+ if (debug_xpath) call print_dict(local_attributes)
+
+ if (has_key(local_attributes,att_name)) then
+
+ if (att_value_present) then
+ call get_value(local_attributes,att_name,value,local_status)
+ if (local_status /= 0) then
+ if (debug_xpath) print *, "Failed to get value of att: ", &
+ trim(att_name)
+ EXIT
+ endif
+
+ if (att_value == value) then
+ local_status = 0
+ if (debug_xpath) print *, "Got correct att name and value "
+ EXIT
+ else
+ if (debug_xpath) print *, "att value: ", trim(value), &
+ " does not match"
+ cycle ! We keep searching
+ endif
+ else ! Found att_name, and no value required
+ local_status = 0
+ if (debug_xpath) print *, "Got correct att name"
+ EXIT
+ endif
+ else ! Did not find that attribute name
+ if (debug_xpath) print *, "Att name not present"
+ cycle ! keep searching
+ endif
+ else ! Found path, and no att info required
+ local_status = 0
+ if (debug_xpath) print *, "Found correct path. No other reqs."
+ EXIT
+ endif
+
+enddo
+
+if (present(status)) then
+ status = local_status
+ if (debug_xpath) print *, "--Returning status: ", status
+endif
+
+if (attributes_present) then
+ attributes = local_attributes
+endif
+
+end subroutine process_node
+
+!--------------------------------------------------------------------
+subroutine get_path(fxml,path,attributes,pcdata,status)
+type(xml_t), intent(inout), target :: fxml
+character(len=*), intent(in) :: path
+type(dictionary_t), intent(out), optional, target :: attributes
+character(len=*), intent(out), optional, target :: pcdata
+integer, intent(out), optional :: status
+
+logical :: status_present
+
+xp => fxml
+
+path_required = path
+status_present = present(status)
+pcdata_requested = (present(pcdata))
+
+attributes_requested = (present(attributes))
+if (attributes_requested) then
+ call reset_dict(attributes)
+ attributes_recovered => attributes
+endif
+
+if (pcdata_requested) then
+!
+! Make sure we do not overstep the bounds of the supplied argument
+!
+ max_len_pcdata = min(len(pcdata),MAX_PCDATA_SIZE)
+ len_pcdata = 0
+ pcdata_recovered(1:max_len_pcdata) = ""
+ if (debug_xpath) print *, "Max length of pcdata store: ", max_len_pcdata
+endif
+
+if (looking_for_current_element) then
+ if (debug_xpath) print *, "Returning info about current element"
+
+ ! We are now in the desired element, and we have the name and
+ ! attribute list saved in xp.
+ !
+ if (attributes_requested) call xml_attributes(xp,attributes_recovered)
+ !
+ if (pcdata_requested) then
+ !
+ ! Set things up so that we can get the pcdata
+ !
+ call xml_path(xp,target_path)
+ in_target_element = .true.
+ in_pcdata_level = .true.
+ else
+ if (status_present) status = 0
+ RETURN ! We are done
+ endif
+else
+ target_path = ""
+ in_target_element = .false.
+ in_pcdata_level = .false.
+endif
+
+stop_parsing = .false.
+
+call xml_parse(fxml, &
+ begin_element_handler = begin_element , &
+ end_element_handler = end_element, &
+ pcdata_chunk_handler = pcdata_handler, &
+ verbose = debug_sax, signal_handler=pause_parsing, &
+ empty_element_handler = empty_element)
+
+if (eof_xmlfile(fxml)) then
+ global_status = END_OF_FILE
+ if (debug_xpath) print *, "Found end of file"
+ if (pcdata_requested) pcdata = ""
+else if (global_status == END_OF_ANCESTOR_ELEMENT) then
+ if (debug_xpath) print *, "Found end of ancestor element"
+ if (pcdata_requested) pcdata = ""
+else
+ if (debug_xpath) print *, "Parser found candidate element"
+ if (pcdata_requested) then
+ pcdata = pcdata_recovered(1:len_pcdata)
+ if (debug_xpath) print *, "PCDATA recovered: ", pcdata_recovered(1:len_pcdata)
+ endif
+endif
+if (global_status > 0) then
+ if (debug_xpath) print *, "Something went slightly wrong. Status > 0"
+endif
+!
+if (present(status)) status = global_status
+
+
+end subroutine get_path
+
+!==================================================================
+subroutine begin_element(name,attributes)
+character(len=*), intent(in) :: name
+type(dictionary_t), intent(in) :: attributes
+
+character(len=1000) :: path ! *** Hard limit
+
+call xml_path(xp,path)
+if (debug_xpath) print *, " begin_element ::: PATH: " , trim(path)
+if (debug_xpath) print *, "path: ", trim(path), " req: ", trim(path_required)
+if (match(path,path_required)) then
+ if (debug_xpath) print *, " Match path: " , trim(path)
+ in_target_element = .true.
+ target_path = path
+ in_pcdata_level = .true.
+ if (debug_xpath) print *, "In element name: " , name
+ if (attributes_requested) attributes_recovered = attributes
+ ! stop parsing
+ if (debug_xpath) print *, "full_node: ", full_node
+ if (.not. full_node) then
+ if (debug_xpath) print *, "Stopping parsing after initial tag"
+ stop_parsing = .true.
+ endif
+else
+ !
+ ! If we are at the pcdata level and we enter another element,
+ ! we must not read pcdata
+ !
+ if (in_pcdata_level) in_pcdata_level = .false.
+endif
+
+end subroutine begin_element
+!------------------------------------------------------------
+subroutine end_element(name)
+character(len=*), intent(in) :: name
+
+character(len=300) :: path ! *** Hard limit
+character(len=300) :: left_path ! *** Hard limit
+character(len=300) :: ancestor_path ! *** Hard limit
+!
+
+call xml_path(xp,path) ! path *after* leaving element
+left_path = trim(path) // "/" // trim(name)
+
+if (in_target_element) then
+ if (path == target_path) then
+ !
+ ! We are back to pcdata level after visiting child elements
+ !
+ in_pcdata_level = .true.
+
+ else if (left_path == target_path) then
+
+ ! We stop the parsing at the end of the element
+ !
+ if (debug_xpath) print *, "Exiting target element: ", trim(target_path)
+ in_target_element = .false.
+ in_pcdata_level = .false.
+ if (debug_xpath) print *, "Stopping parsing after end of target element"
+ stop_parsing = .true.
+ endif
+
+else if (relative_path) then
+ !
+ ! Check in case we go out of ancestor element
+ !
+ call xml_get_path_mark(xp,ancestor_path)
+ if (match(left_path,ancestor_path)) then
+ !
+ ! We are leaving the ancestor element
+ !
+ if (debug_xpath) print *, "Relative search. End of element: ", name
+ if (debug_xpath) print *, "Leaving Path: ", trim(left_path)
+ if (debug_xpath) print *, "Ancestor Path: ", trim(ancestor_path)
+ if (debug_xpath) print *, "Stopping parsing after end of ancestor element"
+
+ stop_parsing = .true.
+ global_status = END_OF_ANCESTOR_ELEMENT
+ endif
+endif
+
+end subroutine end_element
+
+!------------------------------------------------------------
+subroutine empty_element(name,attributes)
+character(len=*), intent(in) :: name
+type(dictionary_t), intent(in) :: attributes
+
+character(len=300) :: path ! *** Hard limit
+
+call xml_path(xp,path)
+if (debug_xpath) print *, " empty_element ::: PATH: " , trim(path)
+if (debug_xpath) print *, "path: ", trim(path), " req: ", trim(path_required)
+if (match(path,path_required)) then
+ if (debug_xpath) print *, " Match path: " , trim(path)
+ if (debug_xpath) print *, "In (empty) element name: " , name
+ if (attributes_requested) attributes_recovered = attributes
+ ! stop parsing
+ stop_parsing = .true.
+ if (debug_xpath) print *, "Stopping parsing after empty tag"
+ if (debug_xpath) print *, "full_node: ", full_node
+ if (full_node) then
+ if (debug_xpath) print *, "*Warning: full_node requested, empty tag found"
+ endif
+endif
+!
+! There is no logic for ancestor element handling, as by definition
+! an emtpy element cannot have children.
+!
+end subroutine empty_element
+
+!-----------------------------------------------------------
+subroutine pcdata_handler(chunk)
+character(len=*), intent(in) :: chunk
+
+integer :: len_chunk
+
+if (in_pcdata_level) then
+ !
+ ! Build pcdata_recovered chunk by chunk, until it overflows
+ !
+ if (pcdata_requested) then
+ if (debug_xpath) print *, "Found chunk of pcdata: ", chunk
+ len_chunk = len(chunk)
+ if ((len_pcdata + len_chunk) > max_len_pcdata) then
+ !
+ if (debug_xpath) print *, "***Pcdata Overflow "
+ global_status = PCDATA_OVERFLOW
+ stop_parsing = .true.
+ return
+ endif
+ pcdata_recovered(len_pcdata+1:len_pcdata+len_chunk) = chunk
+ len_pcdata = len_pcdata + len_chunk
+ endif
+endif
+
+end subroutine pcdata_handler
+!--------------------------------------------------------------------
+
+subroutine pause_parsing(res)
+logical, intent(out) :: res
+
+res = stop_parsing
+
+end subroutine pause_parsing
+!--------------------------------------------------------------------
+
+recursive function match(p,ptarget) result(res_match)
+character(len=*), intent(in) :: p
+character(len=*), intent(in) :: ptarget
+logical :: res_match
+
+!
+! Checks whether a given XML path matches the target path ptarget
+! Only absolute paths are considered.
+!
+! Examples of target paths:
+!
+! /pseudo/vps/radfunc [1]
+! //radfunc/data
+! //data
+! //*/vps/data
+! //job//data
+! //*
+!
+integer :: len_target, len_path, pos_target, pos_path
+character(len=100) :: anchor_leaf ! *** Hard limit
+
+res_match = .false.
+
+if (trim(p) == trim(ptarget)) then
+ res_match = .true.
+ return
+
+else if (ptarget == "/") then
+ ! We process // in the middle below
+
+ res_match = .true.
+ return
+
+else ! We get the extreme elements
+
+ len_target = len_trim(ptarget)
+ len_path = len_trim(p)
+ pos_target = index(ptarget,"/",back=.true.)
+ pos_path = index(p,"/",back=.true.)
+
+ if (pos_target == len_target) then ! // in the middle...
+ ! Get leaf further up
+ search_anchor : do
+ pos_target = index(ptarget(1:len_target-1),"/",back=.true.)
+ if (pos_target == 1) then ! Target begins by /.//
+ res_match = .true.
+ return
+ endif
+ anchor_leaf = ptarget(pos_target:len_target-1)
+ if (anchor_leaf == "/.") then ! keep searching
+ len_target = pos_target
+ cycle search_anchor
+ else
+ exit search_anchor
+ endif
+ enddo search_anchor
+
+ ! Note that the anchor includes the leading /
+ ! Now we search for that anchor in the candidate path
+ !
+ pos_path = index(p(1:len_path),trim(anchor_leaf),back=.true.)
+ if (pos_path /= 0) then
+
+ ! Found anchor. Continue further up.
+ !
+ res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+ endif
+
+ else if (ptarget(pos_target+1:len_target) == ".") then
+
+ ! A dot is a dummy. Continue further up in target path.
+ !
+ res_match = match(p(1:len_path),ptarget(1:pos_target-1))
+
+ else if (ptarget(pos_target+1:len_target) == "*") then
+
+ if (len_path == pos_path) then
+ RETURN ! empty path element
+ endif
+
+ ! A star matches any non-empty leaf. Continue further up.
+ !
+ res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+
+ else if (p(pos_path+1:len_path) == &
+ ptarget(pos_target+1:len_target)) then
+
+ ! Leafs are equal. Continue further up.
+ !
+ res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+
+ endif
+
+endif
+
+end function match
+
+end module m_path
Index: /XMLF90/src/xpath/m_path_orig.f90
===================================================================
--- /XMLF90/src/xpath/m_path_orig.f90 (revision 6)
+++ /XMLF90/src/xpath/m_path_orig.f90 (revision 6)
@@ -0,0 +1,629 @@
+module m_path
+!
+! XPATH-like API for XML Parsing
+! Copyright Alberto Garcia , August 2003
+!
+use flib_sax
+
+private
+!
+public :: get_node, mark_node, enable_debug, disable_debug
+
+private :: match, process_node, get_path
+private :: begin_element, end_element, pcdata_handler, empty_element
+private :: pause_parsing
+
+!
+integer, private, save :: global_status
+integer, public, parameter :: END_OF_FILE = -1
+integer, public, parameter :: END_OF_ANCESTOR_ELEMENT = -2
+integer, public, parameter :: PCDATA_OVERFLOW = 7
+
+logical, private, save :: debug_xpath = .false.
+logical, private, save :: debug_sax = .false.
+character(len=500), private, save :: path_required
+character(len=100), private, save :: target_path ! *** Hard limit
+
+
+logical, private, save :: in_target_element = .false.
+logical, private, save :: in_pcdata_level = .false.
+
+logical, private, save :: stop_parsing = .false.
+!
+! This global variable determines whether we stop after
+! getting the initial element tag, or after digesting the full node.
+!
+logical, private, save :: full_node = .true.
+
+logical, private, save :: relative_path = .false.
+logical, private, save :: looking_for_current_element
+
+logical, private, save :: attributes_requested
+type(dictionary_t), private, save, pointer :: attributes_recovered
+
+integer, parameter, private :: MAX_PCDATA_SIZE = 65536
+logical, private, save :: pcdata_requested
+character(len=MAX_PCDATA_SIZE), private, &
+ save :: pcdata_recovered !*** Hard
+integer, private, save :: len_pcdata
+integer, private, save :: max_len_pcdata
+
+type(xml_t), pointer, save, private :: xp
+
+CONTAINS !===========================================================
+
+!----------------------------------------------------
+! Debugging control
+!
+subroutine enable_debug(sax)
+logical, intent(in), optional :: sax
+ debug_xpath = .true.
+ debug_sax = .false.
+ if (present(sax)) then
+ debug_sax = sax
+ endif
+end subroutine enable_debug
+
+subroutine disable_debug()
+ debug_xpath = .false.
+end subroutine disable_debug
+
+!----------------------------------------------------
+! Main routines
+!---------------------------------------------------------------------
+subroutine mark_node(fxml,path,att_name,att_value,attributes,status)
+!
+! Performs a search of a given element (by path, and/or presence of
+! a given attribute and/or value of that attribute), returning optionally
+! the element's attribute dictionary, and leaving the file handle fxml
+! ready to process the rest of the element's contents (child elements
+! and/or pcdata).
+!
+! Side effects: it sets "ancestor_path" to the element's path
+!
+! If the argument "path" is present and evaluates to a relative path (a
+! string not beginning with "/"), the search is interrupted after the end
+! of the "ancestor_element" set by a previous call to "mark_node".
+! If not earlier, the search ends at the end of the file.
+!
+! The status argument, if present, will hold a return value,
+! which will be:
+!
+! 0 on success,
+! negative in case of end-of-file or end-of-ancestor-element, or
+! positive in case of a malfunction
+!
+type(xml_t), intent(inout), target :: fxml
+character(len=*), intent(in), optional :: path
+character(len=*), intent(in), optional :: att_name
+character(len=*), intent(in), optional :: att_value
+type(dictionary_t), intent(out), optional :: attributes
+integer, intent(out), optional :: status
+
+
+character(len=200) :: ancestor_path ! local variable
+
+ full_node = .false.
+ call process_node(fxml, &
+ path,att_name,att_value, &
+ attributes, &
+ status=status)
+ if (status == 0) then
+ call xml_mark_path(fxml,ancestor_path)
+ if (debug_xpath) print *, "Setting ancestor_path to: ", trim(ancestor_path)
+ endif
+
+end subroutine mark_node
+
+!--------------------------------------------------------------------
+subroutine get_node(fxml,path,att_name,att_value,attributes,pcdata,status)
+!
+! Performs a search of a given element (by path, and/or presence of
+! a given attribute and/or value of that attribute), returning optionally
+! the element's attribute dictionary and any PCDATA characters contained
+! in the element's scope (but not child elements). It leaves the file handle
+! physically and logically positioned:
+!
+! after the end of the element's start tag if 'pcdata' is not present
+! after the end of the element's end tag if 'pcdata' is present
+!
+! If the argument "path" is present and evaluates to a relative path (a
+! string not beginning with "/"), the search is interrupted after the end
+! of the "ancestor_element" set by a previous call to "mark_node".
+! If not earlier, the search ends at the end of the file.
+!
+! The status argument, if present, will hold a return value,
+! which will be:
+!
+! 0 on success,
+! negative in case of end-of-file or end-of-ancestor-element, or
+! positive in case of a malfunction (such as the overflow of the
+! user's pcdata buffer).
+!
+type(xml_t), intent(inout), target :: fxml
+character(len=*), intent(in), optional :: path
+character(len=*), intent(in), optional :: att_name
+character(len=*), intent(in), optional :: att_value
+type(dictionary_t), intent(out), optional :: attributes
+character(len=*), intent(out), optional, target :: pcdata
+integer, intent(out), optional :: status
+
+ full_node = present(pcdata)
+ call process_node(fxml, &
+ path,att_name,att_value, &
+ attributes,pcdata, &
+ status=status)
+
+end subroutine get_node
+!
+!--------------------------------------------------------------------
+! Workhorse routines follow
+!--------------------------------------------------------------------
+subroutine process_node(fxml,path,att_name,att_value, &
+ attributes,pcdata,&
+ status)
+type(xml_t), intent(inout), target :: fxml
+character(len=*), intent(in), optional :: path
+character(len=*), intent(in), optional :: att_name
+character(len=*), intent(in), optional :: att_value
+type(dictionary_t), intent(out), optional :: attributes
+character(len=*), intent(out), optional, target :: pcdata
+integer, intent(out), optional :: status
+
+logical :: path_present, att_name_present, att_value_present
+logical :: attributes_present
+
+character(len=3) :: any_path = "//*"
+character(len=200) :: local_path, ancestor_path ! *** Hard limit
+character(len=500) :: value ! *** Hard limit
+integer :: local_status
+
+type(dictionary_t) :: local_attributes
+
+global_status = 0 ! reset
+
+path_present = present(path)
+attributes_present = present(attributes)
+att_name_present = present(att_name)
+att_value_present = present(att_value)
+
+relative_path = .false.
+
+if (path_present) then
+ if (debug_xpath) print *, "SEARCHING for: ", trim(path)
+ if (path(1:1) /= "/") then
+ !
+ ! Relative path search
+ !
+ call xml_path(fxml,local_path)
+ call xml_get_path_mark(fxml,ancestor_path)
+ if (ancestor_path == "") then
+ if (debug_xpath) print *, "Relative search with null ancestor..."
+ endif
+ relative_path = .true.
+ if (debug_xpath) print *, "Relative search. ANCESTOR ELEMENT: ", &
+ trim(ancestor_path)
+ !
+ ! Convert to absolute path
+ local_path = trim(local_path) // "/" // trim(path)
+ if (debug_xpath) print *, "Converting ", trim(path), &
+ " to absolute path: ", trim(local_path)
+ else
+ local_path = path
+ endif
+else
+ local_path = any_path
+endif
+
+looking_for_current_element = (path == ".")
+!
+! Use local_attributes, since it is in principle possible that
+! the user does not need to get back the attribute list.
+!
+do ! Loop until we satisfy the constraints
+
+ if (debug_xpath) print *, "--> Calling get_path ..."
+ call get_path(fxml,local_path,local_attributes,pcdata,local_status)
+ if (debug_xpath) print *, "-->Status after get_path: ", local_status
+ if (local_status /= 0) EXIT
+
+ if (debug_xpath) print *, "FOUND path matching: ", trim(local_path)
+
+ if (att_name_present) then
+ if (debug_xpath) print *, "Checking ", trim(att_name), " among ", &
+ number_of_entries(local_attributes), " entries:"
+ if (debug_xpath) call print_dict(local_attributes)
+
+ if (has_key(local_attributes,att_name)) then
+
+ if (att_value_present) then
+ call get_value(local_attributes,att_name,value,local_status)
+ if (local_status /= 0) then
+ if (debug_xpath) print *, "Failed to get value of att: ", &
+ trim(att_name)
+ EXIT
+ endif
+
+ if (att_value == value) then
+ local_status = 0
+ if (debug_xpath) print *, "Got correct att name and value "
+ EXIT
+ else
+ if (debug_xpath) print *, "att value: ", trim(value), &
+ " does not match"
+ cycle ! We keep searching
+ endif
+ else ! Found att_name, and no value required
+ local_status = 0
+ if (debug_xpath) print *, "Got correct att name"
+ EXIT
+ endif
+ else ! Did not find that attribute name
+ if (debug_xpath) print *, "Att name not present"
+ cycle ! keep searching
+ endif
+ else ! Found path, and no att info required
+ local_status = 0
+ if (debug_xpath) print *, "Found correct path. No other reqs."
+ EXIT
+ endif
+
+enddo
+
+if (present(status)) then
+ status = local_status
+ if (debug_xpath) print *, "--Returning status: ", status
+endif
+
+if (attributes_present) then
+ attributes = local_attributes
+endif
+
+end subroutine process_node
+
+!--------------------------------------------------------------------
+subroutine get_path(fxml,path,attributes,pcdata,status)
+type(xml_t), intent(inout), target :: fxml
+character(len=*), intent(in) :: path
+type(dictionary_t), intent(out), optional, target :: attributes
+character(len=*), intent(out), optional, target :: pcdata
+integer, intent(out), optional :: status
+
+logical :: status_present
+
+xp => fxml
+
+path_required = path
+status_present = present(status)
+pcdata_requested = (present(pcdata))
+
+attributes_requested = (present(attributes))
+if (attributes_requested) then
+ call reset_dict(attributes)
+ attributes_recovered => attributes
+endif
+
+if (pcdata_requested) then
+!
+! Make sure we do not overstep the bounds of the supplied argument
+!
+ max_len_pcdata = min(len(pcdata),MAX_PCDATA_SIZE)
+ len_pcdata = 0
+ pcdata_recovered(1:max_len_pcdata) = ""
+ if (debug_xpath) print *, "Max length of pcdata store: ", max_len_pcdata
+endif
+
+if (looking_for_current_element) then
+ if (debug_xpath) print *, "Returning info about current element"
+
+ ! We are now in the desired element, and we have the name and
+ ! attribute list saved in xp.
+ !
+ if (attributes_requested) call xml_attributes(xp,attributes_recovered)
+ !
+ if (pcdata_requested) then
+ !
+ ! Set things up so that we can get the pcdata
+ !
+ call xml_path(xp,target_path)
+ in_target_element = .true.
+ in_pcdata_level = .true.
+ else
+ if (status_present) status = 0
+ RETURN ! We are done
+ endif
+else
+ target_path = ""
+ in_target_element = .false.
+ in_pcdata_level = .false.
+endif
+
+stop_parsing = .false.
+
+call xml_parse(fxml, &
+ begin_element_handler = begin_element , &
+ end_element_handler = end_element, &
+ pcdata_chunk_handler = pcdata_handler, &
+ verbose = debug_sax, signal_handler=pause_parsing, &
+ empty_element_handler = empty_element)
+
+if (eof_xmlfile(fxml)) then
+ global_status = END_OF_FILE
+ if (debug_xpath) print *, "Found end of file"
+ if (pcdata_requested) pcdata = ""
+else if (global_status == END_OF_ANCESTOR_ELEMENT) then
+ if (debug_xpath) print *, "Found end of ancestor element"
+ if (pcdata_requested) pcdata = ""
+else
+ if (debug_xpath) print *, "Parser found candidate element"
+ if (pcdata_requested) then
+ pcdata = pcdata_recovered(1:len_pcdata)
+ if (debug_xpath) print *, "PCDATA recovered: ", pcdata_recovered(1:len_pcdata)
+ endif
+endif
+if (global_status > 0) then
+ if (debug_xpath) print *, "Something went slightly wrong. Status > 0"
+endif
+!
+if (present(status)) status = global_status
+
+
+end subroutine get_path
+
+!==================================================================
+subroutine begin_element(name,attributes)
+character(len=*), intent(in) :: name
+type(dictionary_t), intent(in) :: attributes
+
+character(len=1000) :: path ! *** Hard limit
+
+call xml_path(xp,path)
+if (debug_xpath) print *, " begin_element ::: PATH: " , trim(path)
+if (debug_xpath) print *, "path: ", trim(path), " req: ", trim(path_required)
+if (match(path,path_required)) then
+ if (debug_xpath) print *, " Match path: " , trim(path)
+ in_target_element = .true.
+ target_path = path
+ in_pcdata_level = .true.
+ if (debug_xpath) print *, "In element name: " , name
+ if (attributes_requested) attributes_recovered = attributes
+ ! stop parsing
+ if (debug_xpath) print *, "full_node: ", full_node
+ if (.not. full_node) then
+ if (debug_xpath) print *, "Stopping parsing after initial tag"
+ stop_parsing = .true.
+ endif
+else
+ !
+ ! If we are at the pcdata level and we enter another element,
+ ! we must not read pcdata
+ !
+ if (in_pcdata_level) in_pcdata_level = .false.
+endif
+
+end subroutine begin_element
+!------------------------------------------------------------
+subroutine end_element(name)
+character(len=*), intent(in) :: name
+
+character(len=300) :: path ! *** Hard limit
+character(len=300) :: left_path ! *** Hard limit
+character(len=300) :: ancestor_path ! *** Hard limit
+!
+
+call xml_path(xp,path) ! path *after* leaving element
+left_path = trim(path) // "/" // trim(name)
+
+if (in_target_element) then
+ if (path == target_path) then
+ !
+ ! We are back to pcdata level after visiting child elements
+ !
+ in_pcdata_level = .true.
+
+ else if (left_path == target_path) then
+
+ ! We stop the parsing at the end of the element
+ !
+ if (debug_xpath) print *, "Exiting target element: ", trim(target_path)
+ in_target_element = .false.
+ in_pcdata_level = .false.
+ if (debug_xpath) print *, "Stopping parsing after end of target element"
+ stop_parsing = .true.
+ endif
+
+else if (relative_path) then
+ !
+ ! Check in case we go out of ancestor element
+ !
+ call xml_get_path_mark(xp,ancestor_path)
+ if (match(left_path,ancestor_path)) then
+ !
+ ! We are leaving the ancestor element
+ !
+ if (debug_xpath) print *, "Relative search. End of element: ", name
+ if (debug_xpath) print *, "Leaving Path: ", trim(left_path)
+ if (debug_xpath) print *, "Ancestor Path: ", trim(ancestor_path)
+ if (debug_xpath) print *, "Stopping parsing after end of ancestor element"
+
+ stop_parsing = .true.
+ global_status = END_OF_ANCESTOR_ELEMENT
+ endif
+endif
+
+end subroutine end_element
+
+!------------------------------------------------------------
+subroutine empty_element(name,attributes)
+character(len=*), intent(in) :: name
+type(dictionary_t), intent(in) :: attributes
+
+character(len=300) :: path ! *** Hard limit
+
+call xml_path(xp,path)
+if (debug_xpath) print *, " empty_element ::: PATH: " , trim(path)
+if (debug_xpath) print *, "path: ", trim(path), " req: ", trim(path_required)
+if (match(path,path_required)) then
+ if (debug_xpath) print *, " Match path: " , trim(path)
+ if (debug_xpath) print *, "In (empty) element name: " , name
+ if (attributes_requested) attributes_recovered = attributes
+ ! stop parsing
+ stop_parsing = .true.
+ if (debug_xpath) print *, "Stopping parsing after empty tag"
+ if (debug_xpath) print *, "full_node: ", full_node
+ if (full_node) then
+ if (debug_xpath) print *, "*Warning: full_node requested, empty tag found"
+ endif
+endif
+!
+! There is no logic for ancestor element handling, as by definition
+! an emtpy element cannot have children.
+!
+end subroutine empty_element
+
+!-----------------------------------------------------------
+subroutine pcdata_handler(chunk)
+character(len=*), intent(in) :: chunk
+
+integer :: len_chunk
+
+if (in_pcdata_level) then
+ !
+ ! Build pcdata_recovered chunk by chunk, until it overflows
+ !
+ if (pcdata_requested) then
+ if (debug_xpath) print *, "Found chunk of pcdata: ", chunk
+ len_chunk = len(chunk)
+ if ((len_pcdata + len_chunk) > max_len_pcdata) then
+ !
+ if (debug_xpath) print *, "***Pcdata Overflow "
+ global_status = PCDATA_OVERFLOW
+ stop_parsing = .true.
+ return
+ endif
+ pcdata_recovered(len_pcdata+1:len_pcdata+len_chunk) = chunk
+ len_pcdata = len_pcdata + len_chunk
+ endif
+endif
+
+end subroutine pcdata_handler
+!--------------------------------------------------------------------
+
+subroutine pause_parsing(res)
+logical, intent(out) :: res
+
+res = stop_parsing
+
+end subroutine pause_parsing
+!--------------------------------------------------------------------
+
+recursive function match(p,ptarget) result(res_match)
+character(len=*), intent(in) :: p
+character(len=*), intent(in) :: ptarget
+logical :: res_match
+
+!
+! Checks whether a given XML path matches the target path ptarget
+! Only absolute paths are considered.
+!
+! Examples of target paths:
+!
+! /pseudo/vps/radfunc [1]
+! //radfunc/data
+! //data
+! //*/vps/data
+! //job//data
+! //*
+!
+integer :: len_target, len_path, pos_target, pos_path
+character(len=100) :: anchor_leaf ! *** Hard limit
+
+res_match = .false.
+
+if (trim(p) == trim(ptarget)) then
+ res_match = .true.
+ return
+
+else if (ptarget == "/") then
+ ! We process // in the middle below
+
+ res_match = .true.
+ return
+
+else ! We get the extreme elements
+
+ len_target = len_trim(ptarget)
+ len_path = len_trim(p)
+ pos_target = index(ptarget,"/",back=.true.)
+ pos_path = index(p,"/",back=.true.)
+
+ if (pos_target == len_target) then ! // in the middle...
+ ! Get leaf further up
+ search_anchor : do
+ pos_target = index(ptarget(1:len_target-1),"/",back=.true.)
+ if (pos_target == 1) then ! Target begins by /.//
+ res_match = .true.
+ return
+ endif
+ anchor_leaf = ptarget(pos_target:len_target-1)
+ if (anchor_leaf == "/.") then ! keep searching
+ len_target = pos_target
+ cycle search_anchor
+ else
+ exit search_anchor
+ endif
+ enddo search_anchor
+
+ ! Note that the anchor includes the leading /
+ ! Now we search for that anchor in the candidate path
+ !
+ pos_path = index(p(1:len_path),trim(anchor_leaf),back=.true.)
+ if (pos_path /= 0) then
+
+ ! Found anchor. Continue further up.
+ !
+ res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+ endif
+
+ else if (ptarget(pos_target+1:len_target) == ".") then
+
+ ! A dot is a dummy. Continue further up in target path.
+ !
+ res_match = match(p(1:len_path),ptarget(1:pos_target-1))
+
+ else if (ptarget(pos_target+1:len_target) == "*") then
+
+ if (len_path == pos_path) then
+ RETURN ! empty path element
+ endif
+
+ ! A star matches any non-empty leaf. Continue further up.
+ !
+ res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+
+ else if (p(pos_path+1:len_path) == &
+ ptarget(pos_target+1:len_target)) then
+
+ ! Leafs are equal. Continue further up.
+ !
+ res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+
+ endif
+
+endif
+
+end function match
+
+end module m_path
+
+
+
+
+
+
+
+
+
+
+
+
Index: /XMLF90/src/xpath/match_tester.f90
===================================================================
--- /XMLF90/src/xpath/match_tester.f90 (revision 6)
+++ /XMLF90/src/xpath/match_tester.f90 (revision 6)
@@ -0,0 +1,148 @@
+program m
+
+character(len=100) :: p, t
+logical :: result
+
+do
+ write(unit=*,fmt="(a)",advance="no") "Target path: "
+ read(unit=*,fmt="(a)") t
+ write(unit=*,fmt="(a)",advance="no") "Path: "
+ read(unit=*,fmt="(a)") p
+
+ result = match(p,t)
+ print *, "Result: ", result
+
+enddo
+
+
+CONTAINS
+
+recursive function match(p,ptarget) result(res_match)
+character(len=*), intent(in) :: p
+character(len=*), intent(in) :: ptarget
+logical :: res_match
+
+!
+! Checks whether a given XML path matches the target path ptarget
+! Only absolute paths are considered.
+!
+! Examples of target paths:
+!
+! /pseudo/vps/radfunc [1]
+! //radfunc/data
+! //data
+! //*/vps/data
+! //job//data
+! //*
+!
+integer :: len_target, len_path, pos_target, pos_path
+character(len=100) :: anchor_leaf
+
+res_match = .false.
+
+ print *, ":testing: "
+ print *, " ", trim(p)
+ print *, " against: ", trim(ptarget)
+ print *, "-----------------------------------------"
+
+if (trim(p) == trim(ptarget)) then
+ res_match = .true.
+ print *, "outright equality"
+ return
+
+else if (ptarget == "/") then
+ ! We process // in the middle below
+
+ res_match = .true.
+ print *, "target begins by //"
+ return
+
+else ! We get the extreme elements
+
+ len_target = len_trim(ptarget)
+ len_path = len_trim(p)
+ pos_target = index(ptarget,"/",back=.true.)
+ pos_path = index(p,"/",back=.true.)
+
+ print *, " Path leaf: ", p(pos_path+1:len_path)
+ print *, " Target leaf: ", ptarget(pos_target+1:len_target)
+
+ if (pos_target == len_target) then ! // in the middle...
+ ! Get leaf further up
+ search_anchor : do
+ print *, "looking for anchor in: ", ptarget(1:len_target-1)
+ print *, "press enter"
+ read *
+ pos_target = index(ptarget(1:len_target-1),"/",back=.true.)
+ print *, "pos_target in anchor search: ", pos_target
+ if (pos_target == 1) then ! Target begins by /.//
+ res_match = .true.
+ print *, "reached initial /.// in target"
+ return
+ endif
+ anchor_leaf = ptarget(pos_target:len_target-1)
+ print *, " Anchor leaf: ", trim(anchor_leaf)
+ if (anchor_leaf == "/.") then ! keep searching
+ len_target = pos_target
+ cycle search_anchor
+ else
+ exit search_anchor
+ endif
+ enddo search_anchor
+
+ ! Note that the anchor includes the leading /
+ ! Now we search for that anchor in the candidate path
+ !
+ print *, " Searching anchor in : ", trim(p(1:len_path))
+ pos_path = index(p(1:len_path),trim(anchor_leaf),back=.true.)
+ if (pos_path /= 0) then
+
+ ! Found anchor. Continue further up.
+ !
+ res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+ endif
+
+ else if (ptarget(pos_target+1:len_target) == ".") then
+
+ ! A dot is a dummy. Continue further up.
+ !
+ res_match = match(p(1:len_path),ptarget(1:pos_target-1))
+
+ else if (ptarget(pos_target+1:len_target) == "*") then
+
+ if (len_path == pos_path) then
+ print *, "empty element. len_path, pos_path: ", len_path, pos_path
+ RETURN ! empty path element
+ endif
+
+ ! A star matches any non-empty leaf. Continue further up.
+ !
+ res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+
+ else if (p(pos_path+1:len_path) == &
+ ptarget(pos_target+1:len_target)) then
+
+ ! Leafs are equal. Continue further up.
+ !
+ res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+
+ endif
+
+endif
+
+end function match
+
+end program m
+
+
+
+
+
+
+
+
+
+
+
+
+
| |