Commit ad4ad915 authored by Gregor Michalicek's avatar Gregor Michalicek

Initial introduction of the loading of inp.xml by fleur

For very simple test systems fleur can now use the inp.xml file
as an input. Note, however, that the functionality is still
very incomplete. Therefore, preliminary fleur has to be invoked
with -xmlInput to make use of inp.xml.

Besides the feature incompleteness it is expected that there are
still some bugs in loading inp.xml. So far it is
only tested for Si and Fe. For Fe a small deviation from the
reference total energy is observed (0.03 mHtr), the magnetic
moments are off by 0.003. The cause is yet unknown.
parent 4ade8224
include_directories(include)
set(c_files io/xml/inputSchema.h io/xml/dropInputSchema.c)
set(c_filesInpgen io/xml/inputSchema.h io/xml/dropInputSchema.c)
set(c_filesFleur io/xml/inputSchema.h io/xml/dropInputSchema.c io/xml/xmlInterfaceWrapper.c)
set(fleur_F90 main/fleur.F90)
set(fleur_F77 "")
......@@ -26,6 +27,7 @@ include(init/CMakeLists.txt)
include(ldau/CMakeLists.txt)
include(mix/CMakeLists.txt)
include(vgen/CMakeLists.txt)
include(inpgen/CMakeLists.txt)
if (${Fleur_uses_MPI})
include(mpi/CMakeLists.txt)
......@@ -57,16 +59,16 @@ set_source_files_properties(${inpgen_F77} PROPERTIES Fortran_FORMAT FIXED)
if (${Fleur_uses_serial})
#Serial executables
add_executable(fleur ${fleur_SRC} ${c_files})
add_executable(fleur ${fleur_SRC} ${c_filesFleur})
target_link_libraries(fleur ${HDF5_LIBS} ${LAPACK_LIBS})
set_target_properties(fleur PROPERTIES Fortran_MODULE_DIRECTORY fleur_modules COMPILE_OPTIONS -Ifleur_modules)
add_executable(fleur_INVS ${fleur_SRC} ${c_files})
add_executable(fleur_INVS ${fleur_SRC} ${c_filesFleur})
target_link_libraries(fleur_INVS ${HDF5_LIBS} ${LAPACK_LIBS})
target_compile_definitions(fleur_INVS PUBLIC -DCPP_INVERSION)
set_target_properties(fleur_INVS PROPERTIES Fortran_MODULE_DIRECTORY fleur_INVS_modules COMPILE_OPTIONS -Ifleur_INVS_modules)
add_executable(fleur_SOC ${fleur_SRC} ${c_files})
add_executable(fleur_SOC ${fleur_SRC} ${c_filesFleur})
target_link_libraries(fleur_SOC ${HDF5_LIBS} ${LAPACK_LIBS})
target_compile_definitions(fleur_SOC PUBLIC -DCPP_SOC)
set_target_properties(fleur_SOC PROPERTIES Fortran_MODULE_DIRECTORY fleur_SOC_modules COMPILE_OPTIONS -Ifleur_SOC_modules)
......@@ -87,21 +89,21 @@ if(${Fleur_uses_MPI})
set(MPI_DEFINITIONS -DCPP_MPI ${MPI_DEFINITIONS})
#fleur_MPI
add_executable(fleur_MPI ${juDFT_HDF} ${juDFT_SRC_F90} ${fleur_SRC} ${c_files}
add_executable(fleur_MPI ${juDFT_HDF} ${juDFT_SRC_F90} ${fleur_SRC} ${c_filesFleur}
${fleur_SRC_MPI})
target_compile_definitions(fleur_MPI PUBLIC ${MPI_DEFINITIONS})
target_link_libraries(fleur_MPI ${HDF5_LIBS} ${LAPACK_LIBS})
set_target_properties(fleur_MPI PROPERTIES Fortran_MODULE_DIRECTORY fleur_MPI_modules COMPILE_OPTIONS -Ifleur_MPI_modules)
#fleur_INVS_MPI
add_executable(fleur_INVS_MPI ${juDFT_HDF} ${juDFT_SRC_F90} ${fleur_SRC} ${c_files}
add_executable(fleur_INVS_MPI ${juDFT_HDF} ${juDFT_SRC_F90} ${fleur_SRC} ${c_filesFleur}
${fleur_SRC_MPI})
target_link_libraries(fleur_INVS_MPI ${HDF5_LIBS} ${LAPACK_LIBS})
target_compile_definitions(fleur_INVS_MPI PUBLIC ${MPI_DEFINITIONS} -DCPP_INVERSION)
set_target_properties(fleur_INVS_MPI PROPERTIES Fortran_MODULE_DIRECTORY fleur_INVS_MPI_modules COMPILE_OPTIONS -Ifleur_INVS_MPI_modules)
#fleur_SOC_MPI
add_executable(fleur_SOC_MPI ${juDFT_HDF} ${juDFT_SRC_F90} ${fleur_SRC} ${c_files}
add_executable(fleur_SOC_MPI ${juDFT_HDF} ${juDFT_SRC_F90} ${fleur_SRC} ${c_filesFleur}
${fleur_SRC_MPI})
target_link_libraries(fleur_SOC_MPI ${HDF5_LIBS} ${LAPACK_LIBS})
target_compile_definitions(fleur_SOC_MPI PUBLIC ${MPI_DEFINITIONS} -DCPP_SOC)
......@@ -110,7 +112,7 @@ ${fleur_SRC_MPI})
endif ()
#inpgen executable
add_executable(inpgen ${inpgen_F77} ${inpgen_F90} ${juDFT_SRC_F90} ${c_files})
add_executable(inpgen ${inpgen_F77} ${inpgen_F90} ${juDFT_SRC_F90} ${c_filesInpgen})
set_target_properties(inpgen PROPERTIES Fortran_MODULE_DIRECTORY inpgen_modules COMPILE_OPTIONS -Iinpgen_modules)
......
......@@ -191,6 +191,14 @@
INTEGER,ALLOCATABLE::jri(:)
!core states
INTEGER,ALLOCATABLE::ncst(:)
!Are core states explicitely provided?
LOGICAL,ALLOCATABLE::coreStatesProvided(:)
!core state occupations
REAL,ALLOCATABLE::coreStateOccs(:,:,:)
!core state nprnc
INTEGER,ALLOCATABLE::coreStateNprnc(:,:)
!core state kappa
INTEGER,ALLOCATABLE::coreStateKappa(:,:)
!lmax
INTEGER,ALLOCATABLE::lmax(:)
!lmax non-spherical
......@@ -264,6 +272,9 @@
REAL ,ALLOCATABLE :: bkf(:,:)
INTEGER,ALLOCATABLE :: bkp(:)
INTEGER,ALLOCATABLE :: bksym(:)
INTEGER :: numSpecialPoints
CHARACTER(LEN=50),ALLOCATABLE :: specialPointNames(:)
REAL ,ALLOCATABLE :: specialPoints(:,:)
ENDTYPE
......@@ -488,6 +499,7 @@
INTEGER ::phnd
INTEGER ::nsh
INTEGER ::mtypes
INTEGER :: nmopq(3)
REAL :: thetaJ
REAL :: qn
INTEGER :: nmagn
......@@ -541,6 +553,7 @@
INTEGER :: imix
INTEGER :: gw
INTEGER :: gw_neigd
INTEGER :: qfix
REAL :: xa !< mixing parameter for geometry optimzer
REAL :: thetad !< Debey temperature for first step of geometry optimzer
REAL :: epsdisp !< minimal displacement. If all displacements are < epsdisp stop
......@@ -569,6 +582,7 @@
LOGICAL:: eigvar(3)
LOGICAL:: sso_opt(2)
LOGICAL:: total
LOGICAL:: l_inpXML
REAL :: ellow
REAL :: elup
REAL :: rkmax
......@@ -587,6 +601,7 @@
end type
TYPE t_banddos
LOGICAL :: dos
LOGICAL :: band
LOGICAL :: l_mcd
LOGICAL :: l_orb
LOGICAL :: vacdos
......
......@@ -19,6 +19,5 @@ inpgen/symproperties.f
inpgen/write_struct.f
)
set(fleur_F90 ${fleur_F90}
inpgen/inpgen.f90
inpgen/set_inp.f90
)
......@@ -15,6 +15,9 @@ io/inpnoco.F90
io/loddop.f90
io/rw_inp.f90
io/rw_noco.f90
io/r_inpXML.F90
io/wrtdop.f90
io/w_inpXML.f90
io/xsf_io.f90
io/xmlIntWrapFort.f90
)
......@@ -7,8 +7,9 @@
IMPLICIT NONE
PRIVATE
PUBLIC :: evaluate,ASSIGN_var,delete_vars,evaluatefirst
$ ,makenumberstring,show
PUBLIC :: evaluate,ASSIGN_var,delete_vars,evaluatefirst,
$ makenumberstring,show,evaluateFirstOnly,
$ evaluateFirstIntOnly,evaluateFirstBoolOnly
CHARACTER(len = 10),SAVE,ALLOCATABLE :: var_names(:)
REAL,ALLOCATABLE,SAVE :: var_values(:)
......@@ -731,4 +732,85 @@
END FUNCTION
!>
FUNCTION evaluateFirstOnly(s)result(number)
IMPLICIT NONE
CHARACTER(len =*), INTENT(IN) :: s
REAL :: number
!<-- Locals
CHARACTER(len=LEN(s)) :: tempS
INTEGER :: pos
!>
tempS = ADJUSTL(s)
IF (len_TRIM(tempS) == 0) THEN
number = 0
RETURN
ENDIF
pos = INDEX(tempS," ")
IF (pos == 0) pos = LEN(tempS)
number = evaluate(tempS(:pos))
END FUNCTION
FUNCTION evaluateFirstIntOnly(s)result(number)
IMPLICIT NONE
CHARACTER(len =*), INTENT(in) :: s
INTEGER :: number
!<-- Locals
INTEGER :: pos
CHARACTER(len=LEN(s)) :: tempS
!>
tempS = ADJUSTL(s)
IF (len_TRIM(tempS) == 0) THEN
number = 0
RETURN
END IF
pos = INDEX(tempS," ")
IF (pos == 0) pos = LEN(tempS)
number = NINT(evaluate(tempS(:pos)))
END FUNCTION
FUNCTION evaluateFirstBoolOnly(s)result(bool)
IMPLICIT NONE
CHARACTER(len =*), INTENT(in) :: s
LOGICAL :: bool
!<-- Locals
INTEGER :: pos
CHARACTER(len=LEN(s)) :: tempS
!>
tempS = ADJUSTL(s)
IF (len_TRIM(tempS) == 0) THEN
CALL juDFT_error("String is empty.",
+ calledby ="calculator")
RETURN
END IF
pos = INDEX(tempS," ")
IF (pos == 0) pos = LEN(tempS)
SELECT CASE (tempS(:pos))
CASE ('F','f','false','FALSE')
bool = .FALSE.
CASE ('T','t','true','TRUE')
bool = .TRUE.
CASE DEFAULT
CALL juDFT_error('No valid bool at start of: ' // tempS,
+ calledby ="calculator")
END SELECT
END FUNCTION
END MODULE m_calculator
This diff is collapsed.
MODULE m_xmlIntWrapFort
CONTAINS
SUBROUTINE xmlInitInterface()
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
WRITE(*,*) 'Initializing xml interface'
errorStatus = initializeXMLInterface()
IF(errorStatus.NE.0) STOP 'Error!'
END SUBROUTINE xmlInitInterface
SUBROUTINE xmlParseSchema(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
WRITE(*,*) 'Parsing xml schema file ', TRIM(ADJUSTL(schemaFilename))
errorStatus = parseXMLSchema(schemaFilename)
IF(errorStatus.NE.0) STOP 'Error!'
END SUBROUTINE xmlParseSchema
SUBROUTINE xmlParseDoc(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
WRITE(*,*) 'Parsing xml document file ', TRIM(ADJUSTL(docFilename))
errorStatus = parseXMLDocument(docFilename)
IF(errorStatus.NE.0) STOP 'Error!'
END SUBROUTINE xmlParseDoc
SUBROUTINE xmlValidateDoc()
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
WRITE(*,*) 'Validating xml document file'
errorStatus = validateXMLDocument()
IF(errorStatus.NE.0) STOP 'Error!'
END SUBROUTINE xmlValidateDoc
SUBROUTINE xmlInitXPath()
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
WRITE(*,*) 'Initializing xPath'
errorStatus = initializeXPath()
IF(errorStatus.NE.0) STOP 'Error!'
END SUBROUTINE xmlInitXPath
FUNCTION xmlGetNumberOfNodes(xPath)
USE iso_c_binding
USE m_types
IMPLICIT NONE
INTEGER :: xmlGetNumberOfNodes
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
xmlGetNumberOfNodes = getNumberOfXMLNodes(TRIM(ADJUSTL(xPath))//C_NULL_CHAR)
END FUNCTION xmlGetNumberOfNodes
FUNCTION xmlGetAttributeValue(xPath)
USE iso_c_binding
USE m_types
IMPLICIT NONE
CHARACTER(LEN=255) :: xmlGetAttributeValue
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
! WRITE(*,*) 'Obtaining xml attribute value ', TRIM(ADJUSTL(xPath))
c_string = getXMLAttributeValue(TRIM(ADJUSTL(xPath))//C_NULL_CHAR)
CALL C_F_POINTER(c_string, valueFromC, [ 255 ])
IF (.NOT.c_associated(c_string)) THEN
STOP 'null returned!'
END IF
DO i=1, 255
value(i:i) = valueFromC(i)
END DO
length = LEN_TRIM(value(1:INDEX(value, CHAR(0))))
! WRITE(*,*) 'Attribute value is ', value(1:length-1)
xmlGetAttributeValue = value(1:length-1)
END FUNCTION xmlGetAttributeValue
SUBROUTINE xmlFreeResources()
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
WRITE(*,*) 'Releasing xml resources'
errorStatus = freeXMLResources()
IF(errorStatus.NE.0) STOP 'Error!'
END SUBROUTINE xmlFreeResources
END MODULE m_xmlIntWrapFort
......@@ -6,7 +6,9 @@
sliceplot,banddos,obsolete,enpara,xcpot,results,jij,kpts,hybrid,&
oneD,l_opti)
USE m_judft
USE m_juDFT_init
USE m_types
USE m_rinpXML
USE m_dimens
USE m_inped
USE m_setup
......@@ -45,7 +47,7 @@
! .. Local Scalars ..
INTEGER :: i,n,l,m1,m2,isym,iisym
INTEGER :: i,n,l,m1,m2,isym,iisym
COMPLEX :: cdum
#ifdef CPP_MPI
INCLUDE 'mpif.h'
......@@ -77,6 +79,26 @@
OPEN (16,file='inf',form='formatted',status='unknown')
ENDIF
input%l_inpXML = .FALSE.
kpts%numSpecialPoints = 0
INQUIRE (file='inp.xml',exist=input%l_inpXML)
IF(.NOT.juDFT_was_argument("-xmlInput")) THEN
input%l_inpXML = .FALSE.
END IF
IF (input%l_inpXML) THEN
IF (mpi%irank.EQ.0) THEN
CALL r_inpXML(&
atoms,obsolete,vacuum,input,stars,sliceplot,banddos,dimension,&
cell,sym,xcpot,noco,Jij,oneD,hybrid,kpts,enpara,sphhar,l_opti)
ALLOCATE (results%force(3,atoms%ntype,dimension%jspd))
ALLOCATE (results%force_old(3,atoms%ntype))
results%force(:,:,:) = 0.0
WRITE(*,*) 'TODO: Distribute parameters and arrays to other parallel processes!'
END IF
ELSE ! else branch of "IF (input%l_inpXML) THEN"
CALL dimens(&
& mpi,ivers,input,&
& sym,stars,&
......@@ -136,6 +158,7 @@
ALLOCATE ( enpara%enmix(dimension%jspd),sym%d_wgn(-3:3,-3:3,3,sym%nop) )
ALLOCATE ( atoms%ulo_der(atoms%nlod,atoms%ntypd) )
ALLOCATE ( noco%soc_opt(atoms%ntypd+2) )
ALLOCATE ( atoms%coreStatesProvided(atoms%ntypd))
!+odim
ALLOCATE ( oneD%ig1(-oneD%odd%k3:oneD%odd%k3,-oneD%odd%M:oneD%odd%M) )
ALLOCATE ( oneD%kv1(2,oneD%odd%n2d),oneD%nstr1(oneD%odd%n2d) )
......@@ -153,7 +176,7 @@
hybrid%ddist = 1.
!
atoms%coreStatesProvided(:) = .FALSE.
atoms%vr0(:) = 0.0
jij%M(:) = 0.0
......@@ -221,6 +244,9 @@
!+t3e
ENDIF ! mpi%irank.eq.0
CALL timestop("preparation:stars,lattice harmonics,+etc")
END IF ! end of else branch of "IF (input%l_inpXML) THEN"
!
!-odim
oneD%odd%nq2 = oneD%odd%n2d
......
......@@ -298,6 +298,7 @@
ENDIF
l_enpara = .FALSE.
INQUIRE (file='enpara',exist=l_enpara)
l_enpara = l_enpara.OR.input%l_inpXML
!
! set up parameters for enpara-file
!
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment