Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
fleur
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
53
Issues
53
List
Boards
Labels
Service Desk
Milestones
Operations
Operations
Incidents
Packages & Registries
Packages & Registries
Container Registry
Analytics
Analytics
Repository
Value Stream
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
fleur
fleur
Commits
dd70dfa7
Commit
dd70dfa7
authored
Jun 17, 2019
by
Daniel Wortmann
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Started to refactor input of fleur
parent
6626c30d
Changes
8
Hide whitespace changes
Inline
Side-by-side
Showing
8 changed files
with
447 additions
and
334 deletions
+447
-334
io/CMakeLists.txt
io/CMakeLists.txt
+1
-1
io/r_inpXML.F90
io/r_inpXML.F90
+12
-11
io/relax_io.F90
io/relax_io.F90
+14
-8
io/types_xml.f90
io/types_xml.f90
+313
-0
io/xmlIntWrapFort.f90
io/xmlIntWrapFort.f90
+0
-312
types/types_cell.f90
types/types_cell.f90
+1
-1
types/types_kpts.f90
types/types_kpts.f90
+81
-1
types/types_sym.f90
types/types_sym.f90
+25
-0
No files found.
io/CMakeLists.txt
View file @
dd70dfa7
...
...
@@ -26,7 +26,7 @@ io/wrtdop.f90
io/w_inpXML.f90
io/writeOutParameters.f90
io/xsf_io.f90
io/
xmlIntWrapFort
.f90
io/
types_xml
.f90
io/xmlOutput.F90
)
if
(
FLEUR_USE_HDF5
)
...
...
io/r_inpXML.F90
View file @
dd70dfa7
...
...
@@ -16,8 +16,7 @@ CONTAINS
SUBROUTINE
r_inpXML
(&
atoms
,
vacuum
,
input
,
stars
,
sliceplot
,
banddos
,
DIMENSION
,
forcetheo
,
field
,&
cell
,
sym
,
xcpot
,
noco
,
oneD
,
hybrid
,
kpts
,
enpara
,
coreSpecInput
,
wann
,&
noel
,
namex
,
relcor
,
a1
,
a2
,
a3
,
dtild
,&
l_kpts
)
noel
,
namex
,
relcor
,
a1
,
a2
,
a3
,
dtild
)
USE
iso_c_binding
USE
m_juDFT
...
...
@@ -25,7 +24,7 @@ CONTAINS
USE
m_types_forcetheo_extended
USE
m_symdata
,
ONLY
:
nammap
,
ord2
,
l_c2
!USE m_rwsymfile
USE
m_xmlIntWrapFort
!
USE m_xmlIntWrapFort
USE
m_inv3
!USE m_spg2set
!USE m_closure, ONLY : check_close
...
...
@@ -59,7 +58,6 @@ CONTAINS
CLASS
(
t_forcetheo
),
ALLOCATABLE
,
INTENT
(
OUT
)::
forcetheo
TYPE
(
t_coreSpecInput
),
INTENT
(
OUT
)
::
coreSpecInput
TYPE
(
t_wann
)
,
INTENT
(
INOUT
)
::
wann
LOGICAL
,
INTENT
(
OUT
)
::
l_kpts
CHARACTER
(
len
=
3
),
ALLOCATABLE
,
INTENT
(
INOUT
)
::
noel
(:)
CHARACTER
(
len
=
4
),
INTENT
(
OUT
)
::
namex
CHARACTER
(
len
=
12
),
INTENT
(
OUT
)
::
relcor
...
...
@@ -179,12 +177,18 @@ CONTAINS
CALL
xmlInitXPath
()
! Check version of inp.xml
versionString
=
xmlGetAttributeValue
(
'/fleurInput/@fleurInputVersion'
)
IF
((
TRIM
(
ADJUSTL
(
versionString
))
.NE.
'0.27'
)
.AND.
(
TRIM
(
ADJUSTL
(
versionString
))
.NE.
'0.28'
)
.AND.
&
(
TRIM
(
ADJUSTL
(
versionString
))
.NE.
'0.29'
))
THEN
versionString
=
xml
%
GetAttributeValue
(
'/fleurInput/@fleurInputVersion'
)
IF
((
TRIM
(
ADJUSTL
(
versionString
))
.NE.
'0.30'
))
THEN
CALL
juDFT_error
(
'version number of inp.xml file is not compatible with this fleur version'
)
END
IF
!Some types have their own readers
CALL
kpts
%
read_xml
(
xml
)
CALL
sym
%
read_sym
(
xml
)
! Get number of atoms, atom types, and atom species
numberNodes
=
xmlGetNumberOfNodes
(
'/fleurInput/atomGroups/atomGroup/relPos'
)
...
...
@@ -237,7 +241,6 @@ CONTAINS
ALLOCATE
(
kpts
%
ntetra
(
4
,
kpts
%
ntet
),
kpts
%
voltet
(
kpts
%
ntet
))
ALLOCATE
(
wannAtomList
(
atoms
%
nat
))
...
...
@@ -390,9 +393,7 @@ input%preconditioning_param = evaluateFirstOnly(xmlGetAttributeValue('/fleurInpu
! Read in Brillouin zone integration parameters
kpts
%
nkpt3
=
0
l_kpts
=
.FALSE.
valueString
=
TRIM
(
ADJUSTL
(
xmlGetAttributeValue
(
'/fleurInput/calculationSetup/bzIntegration/@mode'
)))
SELECT
CASE
(
valueString
)
CASE
(
'hist'
)
...
...
io/relax_io.F90
View file @
dd70dfa7
...
...
@@ -52,7 +52,7 @@ CONTAINS
END
SUBROUTINE
write_relax
SUBROUTINE
read_relax
(
positions
,
forces
,
energies
)
USE
m_
xmlIntWrapFort
USE
m_
types_xml
USE
m_calculator
REAL
,
INTENT
(
INOUT
),
ALLOCATABLE
::
positions
(:,:,:)
REAL
,
INTENT
(
INOUT
),
ALLOCATABLE
::
forces
(:,:,:)
...
...
@@ -62,7 +62,10 @@ CONTAINS
INTEGER
::
no_steps
INTEGER
::
ntype
,
step
,
n
CHARACTER
(
len
=
100
)::
path
,
p
,
str
no_steps
=
xmlGetNumberOfNodes
(
'/fleurInput/relaxation/relaxation-history/step'
)
TYPE
(
t_xml
)::
xml
no_steps
=
xml
%
GetNumberOfNodes
(
'/fleurInput/relaxation/relaxation-history/step'
)
ntype
=
SIZE
(
positions
,
2
)
IF
(
no_steps
==
0
)
THEN
IF
(
.NOT.
ALLOCATED
(
positions
))
ALLOCATE
(
positions
(
0
,
0
,
0
),
forces
(
0
,
0
,
0
),
energies
(
0
))
...
...
@@ -89,10 +92,10 @@ CONTAINS
END
IF
DO
step
=
1
,
no_steps
WRITE
(
path
,
"(a,i0,a)"
)
'/fleurInput/relaxation/relaxation-history/step['
,
step
,
']'
energies
(
step
)
=
evaluateFirstOnly
(
xmlGetAttributeValue
(
TRIM
(
path
)//
"/@energy"
))
energies
(
step
)
=
evaluateFirstOnly
(
xml
%
GetAttributeValue
(
TRIM
(
path
)//
"/@energy"
))
DO
n
=
1
,
ntype
WRITE
(
p
,
"(a,a,i0,a)"
)
TRIM
(
path
),
"/posforce["
,
n
,
"]"
str
=
xmlGetAttributeValue
(
p
)
str
=
xml
%
GetAttributeValue
(
p
)
positions
(:,
n
,
step
)
=
(/
evaluateFirst
(
str
),
evaluateFirst
(
str
),
evaluateFirst
(
str
)/)
Forces
(:,
n
,
step
)
=
(/
evaluateFirst
(
str
),
evaluateFirst
(
str
),
evaluateFirst
(
str
)/)
ENDDO
...
...
@@ -101,20 +104,23 @@ CONTAINS
SUBROUTINE
read_displacements
(
atoms
,
disp
)
USE
m_
xmlIntWrapFort
USE
m_
types_xml
USE
m_calculator
USE
m_types
TYPE
(
t_atoms
),
INTENT
(
in
)::
atoms
REAL
,
INTENT
(
out
)::
disp
(:,:)
CHARACTER
(
len
=
50
)::
path
,
str
INTEGER
::
n
TYPE
(
t_xml
)::
xml
disp
=
0.0
IF
(
xmlGetNumberOfNodes
(
'/fleurInput/relaxation/displacements'
)
==
0
)
RETURN
IF
(
xml
%
GetNumberOfNodes
(
'/fleurInput/relaxation/displacements'
)
==
0
)
RETURN
!read displacements and apply to positions
IF
(
atoms
%
ntype
.NE.
xmlGetNumberOfNodes
(
'/fleurInput/relaxation/displacements/displace'
))
CALL
judft_error
(
"Wrong number of displacements in relaxation"
)
IF
(
atoms
%
ntype
.NE.
xml
%
GetNumberOfNodes
(
'/fleurInput/relaxation/displacements/displace'
))
CALL
judft_error
(
"Wrong number of displacements in relaxation"
)
DO
n
=
1
,
atoms
%
ntype
WRITE
(
path
,
"(a,i0,a)"
)
'/fleurInput/relaxation/displacements/displace['
,
n
,
']'
str
=
xmlGetAttributeValue
(
path
)
str
=
xml
%
GetAttributeValue
(
path
)
disp
(:,
n
)
=
(/
evaluateFirst
(
str
),
evaluateFirst
(
str
),
evaluateFirst
(
str
)/)
END
DO
END
SUBROUTINE
read_displacements
...
...
io/types_xml.f90
0 → 100644
View file @
dd70dfa7
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Wrapper routines for XML IO - Fortran side
!
! GM'16
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
MODULE
m_types_xml
USE
m_juDFT
PRIVATE
TYPE
t_xml
INTEGER
::
id
CONTAINS
PROCEDURE
,
NOPASS
::
InitInterface
PROCEDURE
,
NOPASS
::
ParseSchema
PROCEDURE
,
NOPASS
::
ParseDoc
PROCEDURE
,
NOPASS
::
ValidateDoc
PROCEDURE
,
NOPASS
::
InitXPath
PROCEDURE
,
NOPASS
::
GetNumberOfNodes
PROCEDURE
,
NOPASS
::
SetAttributeValue
PROCEDURE
,
NOPASS
::
GetAttributeValue
PROCEDURE
,
NOPASS
::
FreeResources
END
TYPE
t_xml
PUBLIC
t_xml
CONTAINS
SUBROUTINE
init_from_command_line
()
IMPLICIT
NONE
CHARACTER
(
len
=
1000
)::
xpath
INTEGER
::
i
,
ii
IF
(
judft_was_argument
(
"-xmlXPath"
))
THEN
xpath
=
judft_string_for_argument
(
"-xmlXPath"
)
DO
WHILE
(
INDEX
(
xpath
,
"="
)
>
0
)
i
=
INDEX
(
xpath
,
"="
)
ii
=
INDEX
(
xpath
,
":"
)
IF
(
ii
==
0
)
ii
=
LEN
(
TRIM
(
xpath
))
+1
IF
(
i
>
100.
OR
.
ii
-
i
>
100
)
CALL
judft_error
(
"Too long xmlXPath argument"
,
calledby
=
"xmlIntWarpFort.f90"
)
CALL
SetAttributeValue
(
xpath
(:
i
-1
),
xpath
(
i
+1
:
ii
-1
))
WRITE
(
*
,
*
)
"Set from command line:"
,
TRIM
(
xpath
(:
i
-1
)),
"="
,
TRIM
(
xpath
(
i
+1
:
ii
-1
))
IF
(
ii
+1
<
LEN
(
xpath
))
THEN
xpath
=
xpath
(
ii
+1
:)
ELSE
xpath
=
""
ENDIF
END
DO
END
IF
END
SUBROUTINE
init_from_command_line
SUBROUTINE
InitInterface
()
USE
iso_c_binding
USE
m_types
IMPLICIT
NONE
INTEGER
::
errorStatus
INTERFACE
FUNCTION
initializeXMLInterface
()
BIND
(
C
,
name
=
"initializeXMLInterface"
)
USE
iso_c_binding
INTEGER
(
c_int
)
initializeXMLInterface
END
FUNCTION
initializeXMLInterface
END
INTERFACE
errorStatus
=
0
errorStatus
=
initializeXMLInterface
()
IF
(
errorStatus
.NE.
0
)
THEN
CALL
juDFT_error
(
"Could not initialize XML interface."
,
calledby
=
"xmlInitInterface"
)
END
IF
END
SUBROUTINE
InitInterface
SUBROUTINE
ParseSchema
(
schemaFilename
)
USE
iso_c_binding
USE
m_types
IMPLICIT
NONE
CHARACTER
(
LEN
=
200
,
KIND
=
c_char
),
INTENT
(
IN
)
::
schemaFilename
INTEGER
::
errorStatus
INTERFACE
FUNCTION
parseXMLSchema
(
schemaFilename
)
BIND
(
C
,
name
=
"parseXMLSchema"
)
USE
iso_c_binding
INTEGER
(
c_int
)
parseXMLSchema
CHARACTER
(
kind
=
c_char
)
::
schemaFilename
(
*
)
END
FUNCTION
parseXMLSchema
END
INTERFACE
errorStatus
=
0
errorStatus
=
parseXMLSchema
(
schemaFilename
)
IF
(
errorStatus
.NE.
0
)
THEN
CALL
juDFT_error
(
"XML Schema file not parsable: "
//
TRIM
(
ADJUSTL
(
schemaFilename
)),
calledby
=
"xmlParseSchema"
)
END
IF
END
SUBROUTINE
ParseSchema
SUBROUTINE
ParseDoc
(
docFilename
)
USE
iso_c_binding
USE
m_types
IMPLICIT
NONE
CHARACTER
(
LEN
=
200
,
KIND
=
c_char
),
INTENT
(
IN
)
::
docFilename
INTEGER
::
errorStatus
INTERFACE
FUNCTION
parseXMLDocument
(
docFilename
)
BIND
(
C
,
name
=
"parseXMLDocument"
)
USE
iso_c_binding
INTEGER
(
c_int
)
parseXMLDocument
CHARACTER
(
kind
=
c_char
)
::
docFilename
(
*
)
END
FUNCTION
parseXMLDocument
END
INTERFACE
errorStatus
=
0
errorStatus
=
parseXMLDocument
(
docFilename
)
IF
(
errorStatus
.NE.
0
)
THEN
CALL
juDFT_error
(
"XML document file not parsable: "
//
TRIM
(
ADJUSTL
(
docFilename
)),
calledby
=
"xmlParseDoc"
)
END
IF
END
SUBROUTINE
ParseDoc
SUBROUTINE
ValidateDoc
()
USE
iso_c_binding
USE
m_types
IMPLICIT
NONE
INTEGER
::
errorStatus
INTERFACE
FUNCTION
validateXMLDocument
()
BIND
(
C
,
name
=
"validateXMLDocument"
)
USE
iso_c_binding
INTEGER
(
c_int
)
validateXMLDocument
END
FUNCTION
validateXMLDocument
END
INTERFACE
errorStatus
=
0
errorStatus
=
validateXMLDocument
()
IF
(
errorStatus
.NE.
0
)
THEN
CALL
juDFT_error
(
"XML document cannot be validated against Schema."
,
calledby
=
"xmlValidateDoc"
)
END
IF
END
SUBROUTINE
ValidateDoc
SUBROUTINE
InitXPath
()
USE
iso_c_binding
USE
m_types
IMPLICIT
NONE
INTEGER
::
errorStatus
INTERFACE
FUNCTION
initializeXPath
()
BIND
(
C
,
name
=
"initializeXPath"
)
USE
iso_c_binding
INTEGER
(
c_int
)
initializeXPath
END
FUNCTION
initializeXPath
END
INTERFACE
errorStatus
=
0
errorStatus
=
initializeXPath
()
IF
(
errorStatus
.NE.
0
)
THEN
CALL
juDFT_error
(
"Could not initialize XPath."
,
calledby
=
"InitXPath"
)
END
IF
CALL
init_from_command_line
()
END
SUBROUTINE
InitXPath
FUNCTION
GetNumberOfNodes
(
xPath
)
USE
iso_c_binding
USE
m_types
IMPLICIT
NONE
INTEGER
::
GetNumberOfNodes
CHARACTER
(
LEN
=*
,
KIND
=
c_char
),
INTENT
(
IN
)
::
xPath
INTERFACE
FUNCTION
getNumberOfXMLNodes
(
xPathExpression
)
BIND
(
C
,
name
=
"getNumberOfXMLNodes"
)
USE
iso_c_binding
INTEGER
(
c_int
)
getNumberOfXMLNodes
CHARACTER
(
kind
=
c_char
)
::
xPathExpression
(
*
)
END
FUNCTION
getNumberOfXMLNodes
END
INTERFACE
GetNumberOfNodes
=
getNumberOfXMLNodes
(
TRIM
(
ADJUSTL
(
xPath
))//
C_NULL_CHAR
)
END
FUNCTION
GetNumberOfNodes
FUNCTION
GetAttributeValue
(
xPath
)
USE
iso_c_binding
USE
m_types
IMPLICIT
NONE
CHARACTER
(
LEN
=
:),
ALLOCATABLE
::
GetAttributeValue
CHARACTER
(
LEN
=*
,
KIND
=
c_char
),
INTENT
(
IN
)
::
xPath
CHARACTER
(
LEN
=
1
,
KIND
=
c_char
),
POINTER
,
DIMENSION
(:)
::
valueFromC
=>
NULL
()
CHARACTER
*
255
::
VALUE
INTEGER
::
length
,
errorStatus
,
i
TYPE
(
c_ptr
)
::
c_string
INTERFACE
FUNCTION
getXMLAttributeValue
(
xPathExpression
)
BIND
(
C
,
name
=
"getXMLAttributeValue"
)
USE
iso_c_binding
CHARACTER
(
KIND
=
c_char
)
::
xPathExpression
(
*
)
TYPE
(
c_ptr
)
::
getXMLAttributeValue
END
FUNCTION
getXMLAttributeValue
END
INTERFACE
c_string
=
getXMLAttributeValue
(
TRIM
(
ADJUSTL
(
xPath
))//
C_NULL_CHAR
)
CALL
C_F_POINTER
(
c_string
,
valueFromC
,
[
255
])
IF
(
.NOT.
C_ASSOCIATED
(
c_string
))
THEN
WRITE
(
*
,
*
)
'Error in trying to obtain attribute value from XPath:'
WRITE
(
*
,
*
)
TRIM
(
ADJUSTL
(
xPath
))
CALL
juDFT_error
(
"Attribute value could not be obtained."
,
calledby
=
"xmlGetAttributeValue"
)
END
IF
VALUE
=
''
i
=
1
DO
WHILE
((
valueFromC
(
i
)
.NE.
C_NULL_CHAR
)
.AND.
(
i
.LE.
255
))
VALUE
(
i
:
i
)
=
valueFromC
(
i
)
i
=
i
+
1
END
DO
length
=
i
-1
GetAttributeValue
=
TRIM
(
ADJUSTL
(
VALUE
(
1
:
length
)))
END
FUNCTION
GetAttributeValue
SUBROUTINE
SetAttributeValue
(
xPath
,
VALUE
)
USE
iso_c_binding
USE
m_types
IMPLICIT
NONE
CHARACTER
(
LEN
=*
,
KIND
=
c_char
),
INTENT
(
IN
)
::
xPath
CHARACTER
(
len
=*
,
KIND
=
c_char
),
INTENT
(
IN
)
::
VALUE
INTEGER
::
errorStatus
INTERFACE
FUNCTION
setXMLAttributeValue
(
xPathExpression
,
valueExpression
)
BIND
(
C
,
name
=
"setXMLAttributeValue"
)
USE
iso_c_binding
CHARACTER
(
KIND
=
c_char
)
::
xPathExpression
(
*
)
CHARACTER
(
KIND
=
c_char
)
::
valueExpression
(
*
)
INTEGER
(
c_int
)
::
setXMLAttributeValue
END
FUNCTION
setXMLAttributeValue
END
INTERFACE
errorStatus
=
setXMLAttributeValue
(
TRIM
(
ADJUSTL
(
xPath
))//
C_NULL_CHAR
,
TRIM
(
ADJUSTL
(
VALUE
))//
C_NULL_CHAR
)
IF
(
errorStatus
.NE.
0
)
THEN
WRITE
(
*
,
*
)
'Error in trying to setting attribute value from XPath:'
WRITE
(
*
,
*
)
TRIM
(
ADJUSTL
(
xPath
))
WRITE
(
*
,
*
)
TRIM
(
ADJUSTL
(
VALUE
))
CALL
juDFT_error
(
"Attribute value could not be set."
,
calledby
=
"xmlSetAttributeValue"
)
END
IF
END
SUBROUTINE
SetAttributeValue
SUBROUTINE
FreeResources
()
USE
iso_c_binding
USE
m_types
IMPLICIT
NONE
INTEGER
::
errorStatus
INTERFACE
FUNCTION
freeXMLResources
()
BIND
(
C
,
name
=
"freeXMLResources"
)
USE
iso_c_binding
INTEGER
freeXMLResources
END
FUNCTION
freeXMLResources
END
INTERFACE
errorStatus
=
0
errorStatus
=
freeXMLResources
()
IF
(
errorStatus
.NE.
0
)
THEN
CALL
juDFT_error
(
"Could not free XML resources."
,
calledby
=
"xmlFreeResources"
)
STOP
'Error!'
END
IF
END
SUBROUTINE
FreeResources
END
MODULE
m_types_xml
io/xmlIntWrapFort.f90
deleted
100644 → 0
View file @
6626c30d
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Wrapper routines for XML IO - Fortran side
!
! GM'16
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
MODULE
m_xmlIntWrapFort
USE
m_juDFT
private
TYPE
t_xml
integer
::
id
contains
PROCEDURE
,
NOPASS
::
InitInterface
PROCEDURE
,
NOPASS
::
ParseSchema
PROCEDURE
,
NOPASS
::
ParseDoc
PROCEDURE
,
NOPASS
::
ValidateDoc
PROCEDURE
,
NOPASS
::
InitXPath
PROCEDURE
,
NOPASS
::
GetNumberOfNodes
PROCEDURE
,
NOPASS
::
SetAttributeValue
PROCEDURE
,
NOPASS
::
FreeResources
end
type
public
t_xml
CONTAINS
SUBROUTINE
init_from_command_line
()
IMPLICIT
NONE
CHARACTER
(
len
=
1000
)::
xpath
INTEGER
::
i
,
ii
IF
(
judft_was_argument
(
"-xmlXPath"
))
THEN
xpath
=
judft_string_for_argument
(
"-xmlXPath"
)
DO
WHILE
(
INDEX
(
xpath
,
"="
)
>
0
)
i
=
INDEX
(
xpath
,
"="
)
ii
=
INDEX
(
xpath
,
":"
)
IF
(
ii
==
0
)
ii
=
LEN
(
TRIM
(
xpath
))
+1
IF
(
i
>
100.
OR
.
ii
-
i
>
100
)
CALL
judft_error
(
"Too long xmlXPath argument"
,
calledby
=
"xmlIntWarpFort.f90"
)
CALL
SetAttributeValue
(
xpath
(:
i
-1
),
xpath
(
i
+1
:
ii
-1
))
WRITE
(
*
,
*
)
"Set from command line:"
,
TRIM
(
xpath
(:
i
-1
)),
"="
,
TRIM
(
xpath
(
i
+1
:
ii
-1
))
IF
(
ii
+1
<
len
(
xpath
))
THEN
xpath
=
xpath
(
ii
+1
:)
ELSE
xpath
=
""
ENDIF
END
DO
END
IF
END
SUBROUTINE
init_from_command_line
SUBROUTINE
InitInterface
()
USE
iso_c_binding
USE
m_types
IMPLICIT
NONE
INTEGER
::
errorStatus
interface
function
initializeXMLInterface
()
bind
(
C
,
name
=
"initializeXMLInterface"
)
use
iso_c_binding
INTEGER
(
c_int
)
initializeXMLInterface
end
function
initializeXMLInterface
end
interface
errorStatus
=
0
errorStatus
=
initializeXMLInterface
()
IF
(
errorStatus
.NE.
0
)
THEN
CALL
juDFT_error
(
"Could not initialize XML interface."
,
calledby
=
"xmlInitInterface"
)
END
IF
END
SUBROUTINE
InitInterface
SUBROUTINE
ParseSchema
(
schemaFilename
)
USE
iso_c_binding
USE
m_types
IMPLICIT
NONE
CHARACTER
(
LEN
=
200
,
KIND
=
c_char
),
INTENT
(
IN
)
::
schemaFilename
INTEGER
::
errorStatus
interface
function
parseXMLSchema
(
schemaFilename
)
bind
(
C
,
name
=
"parseXMLSchema"
)
use
iso_c_binding
INTEGER
(
c_int
)
parseXMLSchema
character
(
kind
=
c_char
)
::
schemaFilename
(
*
)
end
function
parseXMLSchema
end
interface
errorStatus
=
0
errorStatus
=
parseXMLSchema
(
schemaFilename
)
IF
(
errorStatus
.NE.
0
)
THEN
CALL
juDFT_error
(
"XML Schema file not parsable: "
//
TRIM
(
ADJUSTL
(
schemaFilename
)),
calledby
=
"xmlParseSchema"
)
END
IF
END
SUBROUTINE
ParseSchema
SUBROUTINE
ParseDoc
(
docFilename
)
USE
iso_c_binding
USE
m_types
IMPLICIT
NONE
CHARACTER
(
LEN
=
200
,
KIND
=
c_char
),
INTENT
(
IN
)
::
docFilename
INTEGER
::
errorStatus
interface
function
parseXMLDocument
(
docFilename
)
bind
(
C
,
name
=
"parseXMLDocument"
)
use
iso_c_binding
INTEGER
(
c_int
)
parseXMLDocument
character
(
kind
=
c_char
)
::
docFilename
(
*
)
end
function
parseXMLDocument
end
interface
errorStatus
=
0
errorStatus
=
parseXMLDocument
(
docFilename
)
IF
(
errorStatus
.NE.
0
)
THEN
CALL
juDFT_error
(
"XML document file not parsable: "
//
TRIM
(
ADJUSTL
(
docFilename
)),
calledby
=
"xmlParseDoc"
)
END
IF
END
SUBROUTINE
ParseDoc
SUBROUTINE
ValidateDoc
()
USE
iso_c_binding
USE
m_types
IMPLICIT
NONE
INTEGER
::
errorStatus
interface
function
validateXMLDocument
()
bind
(
C
,
name
=
"validateXMLDocument"
)
use
iso_c_binding
INTEGER
(
c_int
)
validateXMLDocument
end
function
validateXMLDocument
end
interface
errorStatus
=
0
errorStatus
=
validateXMLDocument
()
IF
(
errorStatus
.NE.
0
)
THEN
CALL
juDFT_error
(
"XML document cannot be validated against Schema."
,
calledby
=
"xmlValidateDoc"
)
END
IF
END
SUBROUTINE
ValidateDoc
SUBROUTINE
InitXPath
()
USE
iso_c_binding
USE
m_types
IMPLICIT
NONE
INTEGER
::
errorStatus
interface
function
initializeXPath
()
bind
(
C
,
name
=
"initializeXPath"
)
use
iso_c_binding
INTEGER
(
c_int
)
initializeXPath
end
function
initializeXPath
end
interface
errorStatus
=
0
errorStatus
=
initializeXPath
()
IF
(
errorStatus
.NE.
0
)
THEN
CALL
juDFT_error
(
"Could not initialize XPath."
,
calledby
=
"InitXPath"
)
END
IF
CALL
init_from_command_line
()
END
SUBROUTINE
InitXPath
FUNCTION
GetNumberOfNodes
(
xPath
)