Commit 8880aa02 authored by Daniel Wortmann's avatar Daniel Wortmann

Made fleur compile and link

parent ef0ca40a
cmake_minimum_required(VERSION 3.0)
project(FLEUR LANGUAGES Fortran)
set(FLEURINPUT_COMPILEOPTS "-r8")
add_library(fleurinput STATIC
types_coreSpecInput.f90 types_hybrid.f90 types_noco.f90 types_vacuum.f90 fleurinput_read_xml.f90
types_banddos.f90 types_fleurinput_base.f90 types_input.f90 types_oneD.f90 types_wannier.f90
types_cell.f90 types_kpts.f90 types_fleurinput.f90 types_sliceplot.f90 types_sym.f90
types_atoms.F90 types_econfig.F90 types_field.F90 types_xcpot.F90 types_enparaXML.f90 types_forcetheo_data.f90
types_xml.f90 calculator.f constants.f90 mpi_bc_tool.F90
types_xml.f90 calculator.f constants.f90 mpi_bc_tool.F90 ../io/xml/inputSchema.h ../io/xml/dropInputSchema.c ../io/xml/xmlInterfaceWrapper.c
)
#Set module directories
include_directories("${CMAKE_CURRENT_BINARY_DIR}/modules/fleurinput")
if (DEFINED FLEURINPUT_COMPILEOPTS )
target_compile_options(fleurinput PRIVATE ${FLEURINPUT_COMPILEOPTS})
endif()
target_link_libraries(fleurinput juDFT)
set_target_properties(fleurinput PROPERTIES Fortran_MODULE_DIRECTORY modules/fleurinput)
......@@ -206,7 +206,7 @@ MODULE m_types_atoms
SUBROUTINE read_xml_atoms(this,xml)
USE m_types_xml
IMPLICIT NONE
CLASS(t_atoms),INTENT(OUT):: this
CLASS(t_atoms),INTENT(INOUT):: this
TYPE(t_xml),INTENT(IN) :: xml
CHARACTER(len=200):: xpaths,xpathg,xpath,valueString,lstring,nstring,core,valence
......@@ -301,8 +301,8 @@ MODULE m_types_atoms
END IF
lString = xml%getAttributeValue(TRIM(ADJUSTL(xPath))//'/@l')
nString = xml%getAttributeValue(TRIM(ADJUSTL(xPath))//'/@n')
CALL getIntegerSequenceFromString(TRIM(ADJUSTL(lString)), lNumbers, lNumCount)
CALL getIntegerSequenceFromString(TRIM(ADJUSTL(nString)), nNumbers, nNumCount)
CALL xml%getIntegerSequenceFromString(TRIM(ADJUSTL(lString)), lNumbers, lNumCount)
CALL xml%getIntegerSequenceFromString(TRIM(ADJUSTL(nString)), nNumbers, nNumCount)
IF(lNumCount.NE.nNumCount) THEN
CALL judft_error('Error in LO input: l quantum number count does not equal n quantum number count')
END IF
......
......@@ -34,7 +34,7 @@ MODULE m_types_banddos
CONTAINS
SUBROUTINE read_xml(this,xml)
USE m_types_xml
CLASS(t_banddos),INTENT(OUT)::this
CLASS(t_banddos),INTENT(INOUT)::this
TYPE(t_xml),INTENT(IN)::xml
INTEGER::numberNodes
......
......@@ -114,7 +114,7 @@ CONTAINS
SUBROUTINE read_xml_cell(this,xml)
use m_types_xml
class(t_cell),intent(out)::this
class(t_cell),intent(INout)::this
type(t_xml),intent(in) ::xml
! Read in lattice parameters
......
......@@ -32,7 +32,7 @@ MODULE m_types_coreSpecInput
CONTAINS
SUBROUTINE read_xml_corespecinput(This,xml)
USE m_types_xml
CLASS(t_coreSpecInput),INTENT(OUT)::this
CLASS(t_coreSpecInput),INTENT(INOUT)::this
TYPE(t_xml),INTENT(IN)::xml
......
......@@ -26,7 +26,7 @@ CONTAINS
SUBROUTINE read_xml_enpara(this,xml)
use m_types_xml
CLASS(t_enparaXML),INTENT(OUT):: this
CLASS(t_enparaXML),INTENT(INOUT):: this
TYPE(t_xml),INTENT(IN) :: xml
LOGICAL :: l_enpara,film
......
......@@ -20,7 +20,7 @@ MODULE m_types_fleurinput_base
CONTAINS
SUBROUTINE read_xml(this,xml)
USE m_types_xml
CLASS(t_fleurinput_base),INTENT(OUT):: this
CLASS(t_fleurinput_base),INTENT(INOUT):: this
TYPE(t_xml),INTENT(IN) :: xml
END SUBROUTINE read_xml
SUBROUTINE mpi_bc(this,mpi_comm,irank)
......
......@@ -38,7 +38,7 @@ MODULE m_types_forcetheo_data
CONTAINS
SUBROUTINE read_xml_forcetheo_data(this,xml)
USE m_types_xml
CLASS(t_forcetheo_data),INTENT(OUT):: this
CLASS(t_forcetheo_data),INTENT(INOUT):: this
TYPE(t_xml),INTENT(IN) :: xml
CHARACTER(len=200)::str
......
......@@ -56,7 +56,7 @@ MODULE m_types_hybrid
CONTAINS
SUBROUTINE read_xml_hybrid(this,xml)
USE m_types_xml
CLASS(t_hybrid),INTENT(out):: this
CLASS(t_hybrid),INTENT(INout):: this
TYPE(t_xml),INTENT(in) :: xml
......
......@@ -154,7 +154,7 @@ CONTAINS
SUBROUTINE read_xml_input(this,xml)
USE m_types_xml
use m_constants
CLASS(t_input),INTENT(out):: this
CLASS(t_input),INTENT(inout):: this
TYPE(t_xml),intent(in) :: xml
CHARACTER(len=100):: valueString,xpathA,xpathB
......
......@@ -42,7 +42,7 @@ CONTAINS
SUBROUTINE read_xml_kpts(this,xml)
USE m_types_xml
USE m_calculator
CLASS(t_kpts),INTENT(out):: this
CLASS(t_kpts),INTENT(inout):: this
TYPE(t_xml),INTENT(IN) :: xml
CHARACTER(len=10) ::name !TODO
......@@ -54,11 +54,11 @@ CONTAINS
number_sets = xml%GetNumberOfNodes('/fleurInput/calculationSetup/bzIntegration/kPointList')
DO n=1,number_sets
DO n=number_sets,1,-1
WRITE(path,"(a,i0,a)") '/fleurInput/calculationSetup/bzIntegration/kPointList[',n,']'
IF(TRIM(ADJUSTL(name))==xml%GetAttributeValue(TRIM(path)//'/@name')) EXIT
enddo
IF (n>number_sets) CALL judft_error(("No kpoints named:"//TRIM(name)//" found"))
IF (n==0) CALL judft_error(("No kpoints named:"//TRIM(name)//" found"))
this%nkpt=evaluateFirstOnly(xml%GetAttributeValue(TRIM(path)//'/@count'))
this%numSpecialPoints=xml%GetNumberOfNodes(TRIM(path)//"specialPoint")
......
......@@ -38,7 +38,7 @@ MODULE m_types_noco
CONTAINS
SUBROUTINE read_xml_noco(this,xml)
USE m_types_xml
CLASS(t_noco),INTENT(out):: this
CLASS(t_noco),INTENT(inout):: this
TYPE(t_xml),INTENT(IN) :: xml
INTEGER:: numberNodes,ntype,itype
......
......@@ -79,11 +79,11 @@ MODULE m_types_oneD
contains
procedure :: read_xml=>read_xml_oneD
END TYPE t_oneD
PUBLIC::t_oneD
PUBLIC::t_oneD,od_dim,od_inp,od_gga,od_lda,od_sym
CONTAINS
SUBROUTINE read_xml_oneD(this,xml)
use m_types_xml
class(t_oned),intent(out)::this
class(t_oned),intent(inout)::this
type(t_xml),intent(in) ::xml
......
......@@ -25,7 +25,7 @@ MODULE m_types_sliceplot
CONTAINS
SUBROUTINE read_xml_sliceplot(this,xml)
USE m_types_xml
CLASS(t_sliceplot),INTENT(OUT)::this
CLASS(t_sliceplot),INTENT(inOUT)::this
TYPE(t_xml),INTENT(IN)::xml
CHARACTER(len=200)::xpatha
......
......@@ -49,7 +49,7 @@ MODULE m_types_sym
PROCEDURE :: init
PROCEDURE :: print_xml
PROCEDURE :: closure
PROCEDURE :: read_xml
PROCEDURE :: read_xml=>read_xml_sym
PROCEDURE :: mpi_bc => mpi_bc_sym
PROCEDURE,PRIVATE :: check_close
END TYPE t_sym
......@@ -87,10 +87,10 @@ CONTAINS
end subroutine mpi_bc_sym
SUBROUTINE read_xml(this,xml)
SUBROUTINE read_xml_sym(this,xml)
USE m_types_xml
USE m_calculator
CLASS(t_sym),INTENT(out):: this
CLASS(t_sym),INTENT(inout):: this
TYPE(t_xml),INTENT(IN) :: xml
INTEGER:: number_sets,n
......@@ -110,7 +110,7 @@ CONTAINS
str=xml%GetAttributeValue(TRIM(path)//'/row-3')
READ(str,*) this%mrot(3,:,n),this%tau(3,n)
ENDDO
END SUBROUTINE read_xml
END SUBROUTINE read_xml_sym
SUBROUTINE print_xml(sym,fh,filename)
......@@ -139,7 +139,7 @@ CONTAINS
SUBROUTINE init(sym,cell,film)
!Generates missing symmetry info.
!tau,mrot and nop have to be specified already
!tau,mrot and nop have to be specified alread
!USE m_dwigner
USE m_types_cell
CLASS(t_sym),INTENT(INOUT):: sym
......
......@@ -35,7 +35,7 @@ MODULE m_types_vacuum
CONTAINS
SUBROUTINE read_xml(this,xml)
USE m_types_xml
CLASS(t_vacuum),INTENT(OUT)::this
CLASS(t_vacuum),INTENT(INOUT)::this
TYPE(t_xml),INTENT(IN)::xml
CHARACTER(len=100)::xpatha
......
......@@ -137,7 +137,7 @@ MODULE m_types_wannier
CONTAINS
SUBROUTINE read_xml_wannier(this,xml)
USE m_types_xml
CLASS(t_wann),INTENT(out):: this
CLASS(t_wann),INTENT(inout):: this
TYPE(t_xml),INTENT(in) :: xml
! Read in optional Wannier functions parameters
......
......@@ -57,6 +57,8 @@ MODULE m_types_xcpot
PROCEDURE :: get_exchange_weight => xcpot_get_exchange_weight
PROCEDURE :: get_vxc => xcpot_get_vxc
PROCEDURE :: get_exc => xcpot_get_exc
PROCEDURE,NOPASS :: alloc_gradients => xcpot_alloc_gradients
END TYPE t_xcpot
CONTAINS
......@@ -201,4 +203,4 @@ MODULE m_types_xcpot
ALLOCATE(grad%gggrd(ngrid),grad%grgru(ngrid),grad%grgrd(ngrid))
END SUBROUTINE xcpot_alloc_gradients
END MODULE m_types_xcpot
End MODULE m_types_xcpot
......@@ -23,6 +23,7 @@ MODULE m_types_xml
PROCEDURE,NOPASS :: GetNumberOfNodes
PROCEDURE,NOPASS :: SetAttributeValue
PROCEDURE,NOPASS :: GetAttributeValue
PROCEDURE,NOPASS :: getIntegerSequenceFromString
PROCEDURE :: read_q_list
PROCEDURE,NOPASS :: popFirstStringToken
PROCEDURE,NOPASS :: countStringTokens
......@@ -34,7 +35,8 @@ MODULE m_types_xml
PROCEDURE :: get_ntype
PROCEDURE :: posPath
END TYPE t_xml
PUBLIC t_xml,evaluateFirstOnly,EvaluateFirst,evaluateFirstBool,evaluateFirstBoolOnly,evaluateFirstInt,evaluateFirstIntOnly
PUBLIC t_xml,evaluateFirstOnly,EvaluateFirst,evaluateFirstBool,evaluateFirstBoolOnly,evaluateFirstInt,evaluateFirstIntOnly,&
evaluateList
CONTAINS
SUBROUTINE init(xml)
......@@ -61,11 +63,11 @@ CONTAINS
schemaFilename = "FleurInputSchema.xsd"//C_NULL_CHAR
docFilename = "inp.xml"//C_NULL_CHAR
CALL xmlInitInterface()
CALL xmlParseSchema(schemaFilename)
CALL xmlParseDoc(docFilename)
CALL xmlValidateDoc()
CALL xmlInitXPath()
CALL InitInterface()
CALL ParseSchema(schemaFilename)
CALL ParseDoc(docFilename)
CALL ValidateDoc()
CALL InitXPath()
! Check version of inp.xml
versionString = xml%GetAttributeValue('/fleurInput/@fleurInputVersion')
......@@ -75,7 +77,7 @@ CONTAINS
! Read in constants
xPathA = '/fleurInput/constants/constant'
numberNodes = xmlGetNumberOfNodes(xPathA)
numberNodes = xml%GetNumberOfNodes(xPathA)
DO i = 1, numberNodes
WRITE(xPathB,*) TRIM(ADJUSTL(xPathA)), '[',i,']'
tempReal = evaluateFirstOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xPathB))//'/@value'))
......@@ -204,6 +206,99 @@ CONTAINS
END FUNCTION popFirstStringToken
SUBROUTINE getIntegerSequenceFromString(string, sequence, count)
IMPLICIT NONE
CHARACTER(*), INTENT(IN) :: string
INTEGER, ALLOCATABLE, INTENT(OUT) :: sequence(:)
INTEGER, INTENT(OUT) :: count
INTEGER :: i, length, start, lastNumber, currentNumber, index
LOGICAL singleNumber, comma, dash
! 3 cases: 1. a single number
! 2. number - number
! 3. comma separated numbers
length = LEN(string)
count = 0
start = 1
singleNumber = .TRUE.
comma = .FALSE.
dash = .FALSE.
lastNumber = 0
count = 0
! 1. Determine number count
DO i = 1, length
SELECT CASE (string(i:i))
CASE ('0':'9')
CASE (',')
IF ((start.EQ.i).OR.(dash)) THEN
STOP 'String has wrong syntax (in getIntegerSequenceFromString)'
END IF
singleNumber = .FALSE.
comma = .TRUE.
READ(string(start:i-1),*) lastNumber
count = count + 1
start = i+1
CASE ('-')
IF ((start.EQ.i).OR.(dash).OR.(comma)) THEN
STOP 'String has wrong syntax (in getIntegerSequenceFromString)'
END IF
singleNumber = .FALSE.
dash = .TRUE.
READ(string(start:i-1),*) lastNumber
start = i+1
CASE DEFAULT
STOP 'String has wrong syntax (in getIntegerSequenceFromString)'
END SELECT
END DO
IF(start.GT.length) THEN
STOP 'String has wrong syntax (in getIntegerSequenceFromString)'
END IF
READ(string(start:length),*) currentNumber
IF (dash) THEN
count = currentNumber - lastNumber + 1
ELSE
count = count + 1
END IF
IF (ALLOCATED(sequence)) THEN
DEALLOCATE(sequence)
END IF
ALLOCATE(sequence(count))
! 2. Read in numbers iff comma separation ...and store numbers in any case
IF (singleNumber) THEN
sequence(1) = currentNumber
ELSE IF (dash) THEN
DO i = 1, count
sequence(i) = lastNumber + i - 1
END DO
ELSE
index = 1
start = 1
DO i = 1, length
SELECT CASE (string(i:i))
CASE (',')
comma = .TRUE.
READ(string(start:i-1),*) lastNumber
start = i+1
sequence(index) = lastNumber
index = index + 1
END SELECT
END DO
sequence(index) = currentNumber
END IF
END SUBROUTINE getIntegerSequenceFromString
FUNCTION countStringTokens(line) RESULT(tokenCount)
IMPLICIT NONE
......
......@@ -20,7 +20,7 @@ CONTAINS
USE m_types_atoms
USE m_radsra
USE m_differ
!Use m_xmlOutput
Use m_xmlOutput
USE m_constants
IMPLICIT NONE
LOGICAL,INTENT(IN):: lo
......@@ -38,7 +38,7 @@ CONTAINS
USE m_types_atoms
USE m_radsra
USE m_differ
!USE m_xmlOutput
USE m_xmlOutput
USE m_constants
IMPLICIT NONE
LOGICAL,INTENT(IN):: lo
......@@ -155,7 +155,7 @@ CONTAINS
USE m_types_atoms
USE m_radsra
USE m_differ
!USE m_xmlOutput
USE m_xmlOutput
USE m_constants
IMPLICIT NONE
LOGICAL,INTENT(IN):: lo
......
......@@ -54,7 +54,7 @@ CONTAINS
!The total nucleii charge
zc=SUM(atoms%neq(:)*atoms%zatom(:))
zc = zc + 2*input%sigma
!zc = zc + 2*input%sigma !TODO : reactivate fields
IF (fixtotal) THEN
!-roa
......
......@@ -74,7 +74,7 @@ SUBROUTINE exchange_valence_hf(nk,kpts,nkpt_EIBZ,sym,atoms,hybrid,cell,dimension
#endif
USE m_io_hybrid
USE m_kp_perturbation
use m_juDFT
IMPLICIT NONE
TYPE(t_hybdat), INTENT(IN) :: hybdat
......@@ -519,7 +519,7 @@ SUBROUTINE calc_divergence(cell,kpts,divergence)
USE m_util, ONLY: cerf
USE m_types
USE m_constants
USE m_juDFT
IMPLICIT NONE
TYPE(t_cell), INTENT(IN) :: cell
......
......@@ -10,7 +10,7 @@
! M.Betzinger (09/07) !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
MODULE m_symm_hf
use m_juDFT
#define irreps .false.
CONTAINS
......@@ -19,7 +19,7 @@ SUBROUTINE symm_hf_init(sym,kpts,nk,nsymop,rrot,psym)
USE m_types
USE m_util ,ONLY: modulo1
USE m_juDFT
IMPLICIT NONE
TYPE(t_sym), INTENT(IN) :: sym
......
......@@ -5,7 +5,7 @@
!--------------------------------------------------------------------------------
MODULE m_trafo
use m_judft
CONTAINS
SUBROUTINE waveftrafo_symm(cmt_out,z_out,cmt,l_real,z_r,z_c,bandi,ndb,&
......
......@@ -36,7 +36,8 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
USE m_nocoInputCheck
USE m_types_forcetheo_extended
USE m_relaxio
USE m_prpqfftmap
IMPLICIT NONE
TYPE(t_mpi) ,INTENT (IN) :: mpi
......@@ -357,7 +358,7 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
! Dimensioning of stars
IF (input%film.OR.(sym%namgrp.ne.'any ')) THEN
IF (input%film) THEN
CALL strgn1_dim(stars%gmax,cell%bmat,sym%invs,sym%zrfs,sym%mrot,&
sym%tau,sym%nop,sym%nop2,stars%mx1,stars%mx2,stars%mx3,&
stars%ng3,stars%ng2,oneD%odd)
......@@ -492,7 +493,7 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
! Generate stars
CALL timestart("strgn")
IF (input%film.OR.(sym%namgrp.NE.'any ')) THEN
IF (input%film) THEN
CALL strgn1(stars,sym,atoms,vacuum,sphhar,input,cell,xcpot)
IF (oneD%odd%d1) THEN
CALL od_strgn1(xcpot,cell,sym,oneD)
......
......@@ -35,7 +35,7 @@ MODULE m_cdnpot_io_common
l_same = .TRUE.
IF(ABS(stars%gmaxInit-refStars%gmaxInit).GT.1e-10) l_same = .FALSE.
!IF(ABS(stars%gmaxInit-refStars%gmaxInit).GT.1e-10) l_same = .FALSE.
IF(stars%ng3.NE.refStars%ng3) l_same = .FALSE.
IF(stars%ng2.NE.refStars%ng2) l_same = .FALSE.
IF(stars%mx1.NE.refStars%mx1) l_same = .FALSE.
......
......@@ -149,7 +149,7 @@ SUBROUTINE w_inpXML(&
! <cutoffs Kmax="3.60000" Gmax="11.000000" GmaxXC="9.200000" numbands="0"/>
110 FORMAT(' <cutoffs Kmax="',f0.8,'" Gmax="',f0.8,'" GmaxXC="',f0.8,'" numbands="',i0,'"/>')
WRITE (fileNum,110) input%rkmax,stars%gmaxInit,xcpot%gmaxxc,input%gw_neigd
WRITE (fileNum,110) input%rkmax,input%gmax,xcpot%gmaxxc,input%gw_neigd
! <scfLoop itmax="9" maxIterBroyd="99" imix="Anderson" alpha="0.05" preconditioning_param="0.0" spinf="2.00"/>
120 FORMAT(' <scfLoop itmax="',i0,'" minDistance="',f0.8,'" maxIterBroyd="',i0,'" imix="',a,'" alpha="',f0.8,'" preconditioning_param="',f3.1,'" spinf="',f0.8,'"/>')
......@@ -433,7 +433,7 @@ SUBROUTINE w_inpXML(&
END DO
IF (.not.input%film) tempTaual(3,na) = tempTaual(3,na)*scpos(3)
IF (input%film) THEN
tempTaual(3,na) = cell%amat(3,3)*tempTaual(3,na)/input%scaleCell
tempTaual(3,na) = cell%amat(3,3)*tempTaual(3,na)
END IF
!+odim in 1D case all the coordinates are given in cartesian YM
IF (oneD%odd%d1) THEN
......
This diff is collapsed.
This diff is collapsed.
......@@ -117,7 +117,8 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
CALL cdnval(eig_id,mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,stars,vacuum,dimension,&
sphhar,sym,vTot,oneD,cdnvalJob,outDen,regCharges,dos,results,moments,coreSpecInput,mcd,slab,orbcomp)
END DO
call xcpot%val_den%copyPotDen(outDen)
!TODO: change storage of META-GGA data
!call xcpot%val_den%copyPotDen(outDen)
! calculate kinetic energy density for MetaGGAs
if(xcpot%exc_is_metagga()) then
......@@ -170,7 +171,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
CALL cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,&
stars,cell,sphhar,atoms,vTot,outDen,moments,results)
endif
call xcpot%core_den%subPotDen(outDen, xcpot%val_den)
!call xcpot%core_den%subPotDen(outDen, xcpot%val_den)
CALL timestop("cdngen: cdncore")
CALL enpara%calcOutParams(input,atoms,vacuum,regCharges)
......
......@@ -15,7 +15,6 @@
USE m_judft
USE m_juDFT_init
USE m_init_wannier_defaults
USE m_rinpXML
USE m_postprocessInput
USE m_gen_map
USE m_dwigner
......@@ -31,7 +30,6 @@
USE m_fleur_info
USE m_mixing_history
USE m_checks
USE m_prpqfftmap
USE m_writeOutHeader
!USE m_fleur_init_old
USE m_types_xcpot_inbuild
......
......@@ -79,14 +79,16 @@ SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,&
IF (mpi%irank == 0) THEN
! if sigma is not 0.0, then divide this charge among all atoms
IF ( ABS(input%sigma).LT. 1.e-6) THEN
!TODO: reactivate efields
!IF ( ABS(input%sigma).LT. 1.e-6) THEN
IF (1==1) THEN
qdel = 0.0
ELSE
natot = 0
DO n = 1, atoms%ntype
IF (atoms%zatom(n).GE.1.0) natot = natot + atoms%neq(n)
END DO
qdel = 2.*input%sigma/natot
!qdel = 2.*input%sigma/natot
END IF
WRITE (6,FMT=8000)
......
......@@ -4,6 +4,9 @@ set(fleur_F90 ${fleur_F90}
types/types.F90
types/types_setup.F90
types/types_mat.F90
types/types_stars.f90
types/types_sphhar.f90
types/types_forcetheo.F90
types/types_xcpot_inbuild.F90
types/types_xcpot_inbuild_nofunction.F90
types/types_xcpot_data.F90
......
......@@ -11,7 +11,7 @@ MODULE m_types_enpara
USE m_types_fleurinput_base
IMPLICIT NONE
PRIVATE
TYPE,EXTENDS(t_fleurinput_base):: t_enpara
TYPE:: t_enpara
REAL, ALLOCATABLE CPP_MANAGED :: el0(:,:,:)
REAL :: evac0(2,2)
REAL :: evac(2,2)
......@@ -37,7 +37,6 @@ MODULE m_types_enpara
PROCEDURE :: mix
PROCEDURE :: calcOutParams
procedure :: set_quantum_numbers
PROCEDURE :: read_xml=>read_xml_enpara
END TYPE t_enpara
......@@ -46,48 +45,6 @@ MODULE m_types_enpara
CONTAINS
SUBROUTINE read_xml_enpara(this,xml)
use m_types_xml
CLASS(t_enpara),INTENT(OUT):: this
TYPE(t_xml),INTENT(IN) :: xml
LOGICAL :: l_enpara,film
INTEGER :: jspins,ntype,lmaxd,n,lo
CHARACTER(len=100)::xpath,xpath2
INTEGER, ALLOCATABLE :: nlo(:),neq(:)
ntype=xml%get_ntype()
nlo=xml%get_nlo()
lmaxd=xml%get_lmaxd()
jspins=evaluateFirstIntOnly(xml%GetAttributeValue('/fleurInput/calculationSetup/magnetism/@jspins'))
film=xml%GetNumberOfNodes('/fleurInput/cell/filmLattice')==1
CALL this%init(ntype,MAXVAL(nlo),lmaxd,jspins)
l_enpara = .FALSE.
INQUIRE (file ='enpara',exist= l_enpara)
IF (l_enpara) THEN
CALL this%READ(ntype,nlo,jspins,film,.TRUE.)
RETURN
END IF
DO n=1,ntype
xPath=TRIM(xml%speciesPath(n))//'/energyParameters'
this%qn_el(0,n,:)=evaluateFirstIntOnly(xml%GetAttributeValue(TRIM(xpath)//'/@s'))
this%qn_el(1,n,:)=evaluateFirstIntOnly(xml%GetAttributeValue(TRIM(xpath)//'/@p'))
this%qn_el(2,n,:)=evaluateFirstIntOnly(xml%GetAttributeValue(TRIM(xpath)//'/@d'))
this%qn_el(3,n,:)=evaluateFirstIntOnly(xml%GetAttributeValue(TRIM(xpath)//'/@f'))
DO lo=1,nlo(n)
WRITE(xpath2,"(a,a,i0,a)") TRIM(xml%speciesPath(n)),'/lo[',lo,']'
this%qn_ello(lo,n,:)=evaluateFirstINTOnly(xml%GetAttributeValue(TRIM(xpath)//'/@n'))
IF (TRIM(ADJUSTL(xml%getAttributeValue(TRIM(ADJUSTL(xPath))//'@type')))=='HELO') &
this%qn_ello(lo,n,:)=-1*this%qn_ello(lo,n,:)
END DO
END DO
!Read vacuum
END SUBROUTINE read_xml_enpara
SUBROUTINE set_quantum_numbers(enpara,ntype,atoms,str,lo)
use m_types_atoms
......@@ -207,7 +164,7 @@ CONTAINS
USE m_types_atoms
USE m_types_vacuum
USE m_types_input
!USE m_xmlOutput
USE m_xmlOutput
USE m_types_potden
USE m_find_enpara
CLASS(t_enpara),INTENT(inout):: enpara
......
......@@ -6,12 +6,11 @@
MODULE m_types_stars
USE m_juDFT
USE m_fleurinput_base
IMPLICIT NONE
PRIVATE
PUBLIC :: t_stars
!The stars
TYPE,EXTENDS(t_fleurinput_base):: t_stars
TYPE:: t_stars
!max-length of star
REAL :: gmax
!no of 3d-stars
......
......@@ -56,16 +56,16 @@ MODULE m_types_xcpot_libxc
PUBLIC t_xcpot_libxc
CONTAINS
SUBROUTINE read_xml_libxc(xcpot,xml)
SUBROUTINE read_xml_libxc(this,xml)
USE m_types_xml
CLASS(t_xcpot_libxc),INTENT(out):: xcpot
CLASS(t_xcpot_libxc),INTENT(INOUT):: this
TYPE(t_xml),INTENT(in) :: xml
CHARACTER(len=10)::xpathA,xpathB
INTEGER :: vxc_id_x,vxc_id_c, exc_id_x, exc_id_c,jspins