Skip to content

GitLab

fleur
fleur
Commit dd70dfa7 authored by Daniel Wortmann's avatar Daniel Wortmann
Browse files
Options

Started to refactor input of fleur

parent 6626c30d
Hide whitespace changes
Inline Side-by-side
Showing with 447 additions and 334 deletions
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)