Commit 4c6c10b5 authored by Daniel Wortmann's avatar Daniel Wortmann

Made fleurinput library

parent 3afeb737
......@@ -18,7 +18,7 @@ include("cmake/filespecific.cmake")
include("cmake/ReportConfig.txt")
add_subdirectory("inpgen2")
#add_subdirectory("inpgen2")
......
include_directories(include)
add_subdirectory(fleurinput)
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)
if(FLEUR_USE_CUSOLVER)
set(c_filesFleur ${c_filesFleur} diagonalization/cusolver.c)
endif()
set(fleur_F90 main/fleur.F90)
set(fleur_F77 "")
include(eigen/CMakeLists.txt)
......
cmake_minimum_required(VERSION 3.0)
project(FLEUR LANGUAGES Fortran)
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_fleurinput.f90 types_kpts.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
)
#Set module directories
include_directories("${CMAKE_CURRENT_BINARY_DIR}/modules/fleurinput")
target_link_libraries(fleurinput juDFT)
MODULE m_fleurinput_read_xml
USE m_types_fleurinput
IMPLICIT NONE
CONTAINS
SUBROUTINE fleurinput_read_xml(cell,sym,atoms,input,noco,vacuum,field,&
sliceplot,banddos,hybrid,oneD,coreSpecInput,wann,&
xcpot,forcetheo_data,kpts,enparaXML)
USE m_types_xml
TYPE(t_cell),INTENT(OUT)::cell
TYPE(t_sym),INTENT(OUT)::sym
TYPE(t_atoms),INTENT(OUT)::atoms
TYPE(t_input),INTENT(OUT)::input
TYPE(t_noco),INTENT(OUT)::noco
TYPE(t_vacuum),INTENT(OUT)::vacuum
TYPE(t_field),INTENT(OUT)::field
TYPE(t_sliceplot),INTENT(OUT)::sliceplot
TYPE(t_banddos),INTENT(OUT)::banddos
TYPE(t_hybrid),INTENT(OUT)::hybrid
TYPE(t_oneD),INTENT(OUT)::oneD
TYPE(t_coreSpecInput),INTENT(OUT)::coreSpecInput
TYPE(t_wann),INTENT(OUT)::wann
CLASS(t_xcpot),INTENT(OUT)::xcpot
TYPE(t_forcetheo_data),INTENT(OUT)::forcetheo_data
TYPE(t_enparaXML),INTENT(OUT)::enparaXML
TYPE(t_kpts),INTENT(OUT)::kpts
TYPE(t_xml)::xml
!Call to init of xml type initialized XML reading and connects to inp.xml
call xml%init()
!Now read from inp.xml for all datatypes
CALL cell%read_xml(xml)
CALL sym%read_xml(xml)
CALL atoms%read_xml(xml)
CALL input%read_xml(xml)
CALL noco%read_xml(xml)
CALL vacuum%read_xml(xml)
CALL field%read_xml(xml)
CALL sliceplot%read_xml(xml)
CALL banddos%read_xml(xml)
CALL hybrid%read_xml(xml)
CALL oneD%read_xml(xml)
CALL coreSpecInput%read_xml(xml)
CALL wann%read_xml(xml)
CALL xcpot%read_xml(xml)
CALL forcetheo_data%read_xml(xml)
CALL enparaXML%read_xml(xml)
CALL kpts%read_xml(xml)
END SUBROUTINE fleurinput_read_xml
END MODULE m_fleurinput_read_xml
!--------------------------------------------------------------------------------
! 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.
!--------------------------------------------------------------------------------
MODULE m_types_banddos
USE m_juDFT
USE m_types_fleurinput_base
IMPLICIT NONE
PRIVATE
PUBLIC:: t_banddos
TYPE,EXTENDS(t_fleurinput_base):: t_banddos
LOGICAL :: dos =.FALSE.
LOGICAL :: band =.FALSE.
LOGICAL :: l_mcd =.FALSE.
LOGICAL :: l_orb =.FALSE.
LOGICAL :: vacdos =.FALSE.
INTEGER :: ndir =0
INTEGER :: orbCompAtom=0
REAL :: e1_dos=0.5
REAL :: e2_dos=-0.5
REAL :: sig_dos=0.015
REAL :: e_mcd_lo =-10.0
REAL :: e_mcd_up= 0.0
LOGICAL :: unfoldband =.FALSE.
INTEGER :: s_cell_x
INTEGER :: s_cell_y
INTEGER :: s_cell_z
REAL :: alpha,beta,gamma !For orbital decomp. (was orbcomprot)
CONTAINS
PROCEDURE :: read_xml
END TYPE t_banddos
CONTAINS
SUBROUTINE read_xml(this,xml)
USE m_types_xml
CLASS(t_banddos),INTENT(OUT)::this
TYPE(t_xml),INTENT(IN)::xml
INTEGER::numberNodes
this%band = evaluateFirstBoolOnly(xml%GetAttributeValue('/fleurInput/output/@band'))
this%dos = evaluateFirstBoolOnly(xml%GetAttributeValue('/fleurInput/output/@dos'))
this%vacdos = evaluateFirstBoolOnly(xml%GetAttributeValue('/fleurInput/output/@vacdos'))
this%l_mcd = evaluateFirstBoolOnly(xml%GetAttributeValue('/fleurInput/output/@mcd'))
numberNodes = xml%GetNumberOfNodes('/fleurInput/output/densityOfStates')
IF ((this%dos).AND.(numberNodes.EQ.0)) THEN
CALL juDFT_error("dos is true but densityOfStates parameters are not set!")
END IF
IF (numberNodes.EQ.1) THEN
this%ndir = evaluateFirstIntOnly(xml%GetAttributeValue('/fleurInput/output/densityOfStates/@ndir'))
this%e2_dos = evaluateFirstOnly(xml%GetAttributeValue('/fleurInput/output/densityOfStates/@minEnergy'))
this%e1_dos = evaluateFirstOnly(xml%GetAttributeValue('/fleurInput/output/densityOfStates/@maxEnergy'))
this%sig_dos = evaluateFirstOnly(xml%GetAttributeValue('/fleurInput/output/densityOfStates/@sigma'))
END IF
IF (this%band) THEN
this%dos=.TRUE.
this%ndir = -4
WRITE(*,*) 'band="T" --> Overriding "dos" and "ndir"!'
ENDIF
! Read in optional magnetic circular dichroism parameters
numberNodes = xml%GetNumberOfNodes('/fleurInput/output/magneticCircularDichroism')
IF ((this%l_mcd).AND.(numberNodes.EQ.0)) THEN
CALL juDFT_error("mcd is true but magneticCircularDichroism parameters are not set!", calledby = "r_inpXML")
END IF
IF (numberNodes.EQ.1) THEN
this%e_mcd_lo = evaluateFirstOnly(xml%GetAttributeValue('/fleurInput/output/magneticCircularDichroism/@energyLo'))
this%e_mcd_up = evaluateFirstOnly(xml%GetAttributeValue('/fleurInput/output/magneticCircularDichroism/@energyUp'))
END IF
! Read in optional parameter for unfolding bandstructure of supercell
numberNodes = xml%GetNumberOfNodes('/fleurInput/output/unfoldingBand')
IF (numberNodes.EQ.1) THEN
this%unfoldband = evaluateFirstBoolOnly(xml%GetAttributeValue('/fleurInput/output/unfoldingBand/@unfoldband'))
this%s_cell_x = evaluateFirstOnly(xml%GetAttributeValue('/fleurInput/output/unfoldingBand/@supercellX'))
this%s_cell_y = evaluateFirstOnly(xml%GetAttributeValue('/fleurInput/output/unfoldingBand/@supercellY'))
this%s_cell_z = evaluateFirstOnly(xml%GetAttributeValue('/fleurInput/output/unfoldingBand/@supercellZ'))
END IF
END SUBROUTINE read_xml
END MODULE m_types_banddos
......@@ -6,63 +6,91 @@
MODULE m_types_cell
USE m_judft
use m_types_fleurinput
USE m_types_fleurinput_base
IMPLICIT NONE
PRIVATE
TYPE,extends(t_fleurinput):: t_cell
!vol of dtilde box
REAL::omtil
!2D area
REAL::area
!bravais matrix
REAL::amat(3, 3)
!rez. bravais matrx
REAL::bmat(3, 3)
!square of bbmat
REAL::bbmat(3, 3),aamat(3,3)
!d-value
REAL::z1
!volume of cell
REAL::vol
!volume of interstitial
REAL::volint
CONTAINS
PROCEDURE :: init
procedure :: read_xml=>read_xml_cell
END TYPE t_cell
PUBLIC t_cell
CONTAINS
SUBROUTINE init(cell)
!initialize cell, only input is cell%amat and cell%z1 in case of a film
USE m_inv3
USE m_constants,ONLY:tpi_const
CLASS (t_cell),INTENT(INOUT):: cell
CALL inv3(cell%amat,cell%bmat,cell%omtil)
IF (cell%omtil<0) CALL judft_warn("Negative volume! You are using a left-handed coordinate system")
cell%omtil=ABS(cell%omtil)
cell%bmat=tpi_const*cell%bmat
IF (cell%z1>0) THEN
cell%vol = (cell%omtil/cell%amat(3,3))*cell%z1
cell%area = cell%omtil/cell%amat(3,3)
ELSE
cell%vol = cell%omtil
cell%area =abs(cell%amat(1,1)*cell%amat(2,2)-cell%amat(1,2)*cell%amat(2,1))
IF (cell%area < 1.0e-7) THEN
cell%area = 1.
CALL juDFT_warn("area = 0",calledby ="types_cell")
END IF
!> This type contains the basic information on the lattice-cell of the calculation
!> To use it, you basically only have to provide cell%amat (and cell%z1 for films)
!> and call its init routine.
TYPE,EXTENDS(t_fleurinput_base):: t_cell
!vol of dtilde box
REAL::omtil
!2D area
REAL::area
!bravais matrix
REAL::amat(3, 3)
!rez. bravais matrx
REAL::bmat(3, 3)
!square of bbmat
REAL::bbmat(3, 3),aamat(3,3)
!d-value
REAL::z1
!volume of cell
REAL::vol
!volume of interstitial
REAL::volint
CONTAINS
PROCEDURE :: init
PROCEDURE :: read_xml=>read_xml_cell
END TYPE t_cell
PUBLIC t_cell
CONTAINS
SUBROUTINE init(cell)
!initialize cell, only input is cell%amat and cell%z1 in case of a film
USE m_constants,ONLY:tpi_const
CLASS (t_cell),INTENT(INOUT):: cell
CALL inv3(cell%amat,cell%bmat,cell%omtil)
IF (cell%omtil<0) CALL judft_warn("Negative volume! You are using a left-handed coordinate system")
cell%omtil=ABS(cell%omtil)
cell%bmat=tpi_const*cell%bmat
IF (cell%z1>0) THEN
cell%vol = (cell%omtil/cell%amat(3,3))*cell%z1
cell%area = cell%omtil/cell%amat(3,3)
ELSE
cell%vol = cell%omtil
cell%area =ABS(cell%amat(1,1)*cell%amat(2,2)-cell%amat(1,2)*cell%amat(2,1))
IF (cell%area < 1.0e-7) THEN
cell%area = 1.
CALL juDFT_warn("area = 0",calledby ="types_cell")
END IF
END IF
cell%bbmat=matmul(cell%bmat,transpose(cell%bmat))
cell%aamat=matmul(transpose(cell%amat),cell%amat)
CONTAINS
!This is a copy of the code in math/inv3
!Put here to make library independent
SUBROUTINE inv3(a,b,d)
IMPLICIT NONE
! ..
! .. Arguments ..
REAL, INTENT (IN) :: a(3,3)
REAL, INTENT (OUT) :: b(3,3) ! inverse matrix
REAL, INTENT (OUT) :: d ! determinant
! ..
d = a(1,1)*a(2,2)*a(3,3) + a(1,2)*a(2,3)*a(3,1) + &
a(2,1)*a(3,2)*a(1,3) - a(1,3)*a(2,2)*a(3,1) - &
a(2,3)*a(3,2)*a(1,1) - a(2,1)*a(1,2)*a(3,3)
b(1,1) = (a(2,2)*a(3,3)-a(2,3)*a(3,2))/d
b(1,2) = (a(1,3)*a(3,2)-a(1,2)*a(3,3))/d
b(1,3) = (a(1,2)*a(2,3)-a(2,2)*a(1,3))/d
b(2,1) = (a(2,3)*a(3,1)-a(2,1)*a(3,3))/d
b(2,2) = (a(1,1)*a(3,3)-a(3,1)*a(1,3))/d
b(2,3) = (a(1,3)*a(2,1)-a(1,1)*a(2,3))/d
b(3,1) = (a(2,1)*a(3,2)-a(2,2)*a(3,1))/d
b(3,2) = (a(1,2)*a(3,1)-a(1,1)*a(3,2))/d
b(3,3) = (a(1,1)*a(2,2)-a(1,2)*a(2,1))/d
END SUBROUTINE inv3
END SUBROUTINE init
SUBROUTINE read_xml_cell(cell,xml)
SUBROUTINE read_xml_cell(this,xml)
use m_types_xml
class(t_cell),intent(out)::cell
class(t_cell),intent(out)::this
type(t_xml),intent(in) ::xml
! Read in lattice parameters
......@@ -71,7 +99,7 @@ MODULE m_types_cell
if (xml%GetNumberOfNodes('')==1) then
path= '/fleurInput/cell/filmLattice'
cell%z1=evaluateFirstOnly(xml%GetAttributeValue(trim(path)//'/@dvac'))/2
this%z1=evaluateFirstOnly(xml%GetAttributeValue(trim(path)//'/@dvac'))/2
dtild=evaluateFirstOnly(xml%GetAttributeValue(trim(path)//'/@dtilda'))
else
path = '/fleurInput/cell/bulkLattice'
......@@ -80,22 +108,22 @@ MODULE m_types_cell
scale=evaluateFirstOnly(xml%GetAttributeValue(trim(path)//'/@scale'))
path=trim(path)//'/bravaisMatrix'
valueString = TRIM(ADJUSTL(xml%GetAttributeValue(TRIM(ADJUSTL(path))//'/row-1')))
cell%amat(1,1) = evaluateFirst(valueString)
cell%amat(2,1) = evaluateFirst(valueString)
cell%amat(3,1) = evaluateFirst(valueString)
this%amat(1,1) = evaluateFirst(valueString)
this%amat(2,1) = evaluateFirst(valueString)
this%amat(3,1) = evaluateFirst(valueString)
valueString = TRIM(ADJUSTL(xml%GetAttributeValue(TRIM(ADJUSTL(path))//'/row-2')))
cell%amat(1,2) = evaluateFirst(valueString)
cell%amat(2,2) = evaluateFirst(valueString)
cell%amat(3,2) = evaluateFirst(valueString)
this%amat(1,2) = evaluateFirst(valueString)
this%amat(2,2) = evaluateFirst(valueString)
this%amat(3,2) = evaluateFirst(valueString)
valueString = TRIM(ADJUSTL(xml%GetAttributeValue(TRIM(ADJUSTL(path))//'/row-2')))
cell%amat(1,3) = evaluateFirst(valueString)
cell%amat(2,3) = evaluateFirst(valueString)
cell%amat(3,3) = evaluateFirst(valueString)
this%amat(1,3) = evaluateFirst(valueString)
this%amat(2,3) = evaluateFirst(valueString)
this%amat(3,3) = evaluateFirst(valueString)
IF (dvac>0) THEN
cell%amat(3,3)=2*cell%z1
this%amat(3,3)=2*this%z1
ENDIF
cell%amat=cell%amat*scale
this%amat=this%amat*scale
END SUBROUTINE read_xml_cell
......
!--------------------------------------------------------------------------------
! 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.
!--------------------------------------------------------------------------------
MODULE m_types_coreSpecInput
USE m_judft
USE m_types_fleurinput_base
IMPLICIT NONE
PRIVATE
PUBLIC:: t_coreSpecInput
! type for the input to the calculation of the core spectrum (EELS)
TYPE,EXTENDS(t_fleurinput_base):: t_coreSpecInput
INTEGER :: verb=0 ! output verbosity
INTEGER :: atomType ! atomic type used for calculation of core spectra
CHARACTER(LEN=1) :: edge ! edge character (K,L,M,N,O,P)
INTEGER :: edgeidx(11) ! l-j edges
INTEGER :: lx ! maximum lmax considered in spectra calculation
REAL :: ek0 ! kinetic energy of incoming electrons
REAL :: emn ! energy spectrum lower bound
REAL :: emx ! energy spectrum upper bound
REAL :: ein ! energy spectrum increment
INTEGER :: nqphi ! no. of angle-sectors for integral over q vectors
INTEGER :: nqr ! no. of radial-sectors for integral over q vectors
REAL :: alpha_ex ! maximal angle of incoming electrons
REAL :: beta_ex ! maximal (measured) angle of outcoming electrons
REAL :: I0 ! incoming intensity
CONTAINS
PROCEDURE read_xml=>read_xml_corespecinput
END TYPE t_coreSpecInput
CONTAINS
SUBROUTINE read_xml_corespecinput(This,xml)
USE m_types_xml
CLASS(t_coreSpecInput),INTENT(OUT)::this
TYPE(t_xml),INTENT(IN)::xml
INTEGER:: numberNodes,tempInt,numTokens,i
LOGICAL::tempBool
CHARACTER(len=100) :: xPathA,xPathB,valueString
! Read in optional core spectrum (EELS) input parameters
xPathA = '/fleurInput/output/coreSpectrum'
numberNodes = xml%GetNumberOfNodes(xPathA)
IF (numberNodes.EQ.1) THEN
tempBool = evaluateFirstBoolOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@verbose'))
IF(tempBool) this%verb = 1
this%ek0 = evaluateFirstOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@eKin'))
this%atomType = evaluateFirstIntOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@atomType'))
this%lx = evaluateFirstIntOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@lmax'))
this%edge = TRIM(ADJUSTL(xml%GetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@edgeType')))
this%emn = evaluateFirstOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@eMin'))
this%emx = evaluateFirstOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@eMax'))
tempInt = evaluateFirstIntOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@numPoints'))
this%ein = (this%emx - this%emn) / (tempInt - 1.0)
this%nqphi = evaluateFirstIntOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@nqphi'))
this%nqr = evaluateFirstIntOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@nqr'))
this%alpha_ex = evaluateFirstOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@alpha_Ex'))
this%beta_ex = evaluateFirstOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@beta_Ex'))
this%I0 = evaluateFirstOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@I_initial'))
xPathB = TRIM(ADJUSTL(xPathA))//'/edgeIndices'
xPathB = TRIM(ADJUSTL(xPathB))//'/text()'
valueString = xml%GetAttributeValue(TRIM(ADJUSTL(xPathB)))
numTokens = xml%countStringTokens(valueString)
this%edgeidx(:) = 0
IF(numTokens.GT.SIZE(this%edgeidx)) THEN
CALL juDFT_error('More EELS edge indices provided than allowed.')
END IF
DO i = 1, MAX(numTokens,SIZE(this%edgeidx))
this%edgeidx(i) = evaluateFirstIntOnly(xml%popFirstStringToken(valueString))
END DO
END IF
END SUBROUTINE read_xml_corespecinput
END MODULE m_types_coreSpecInput
......@@ -3,12 +3,11 @@
! 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.
!--------------------------------------------------------------------------------
MODULE m_types_econfig
USE m_judft
IMPLICIT NONE
PRIVATE
!This is used by t_atoms and does not extend t_fleurinput_base by itself
TYPE:: t_econfig
CHARACTER(len=100) :: coreconfig
CHARACTER(len=100) :: valenceconfig
......
This diff is collapsed.
!--------------------------------------------------------------------------------
! 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.
!--------------------------------------------------------------------------------
MODULE m_types_enparaXML
USE m_judft
USE m_types_fleurinput_base
IMPLICIT NONE
PRIVATE
TYPE,EXTENDS(t_fleurinput_base):: t_enparaXML
INTEGER,ALLOCATABLE :: qn_el(:,:,:) !>if these are .ne.0 they are understood as
INTEGER,ALLOCATABLE :: qn_ello(:,:,:) !>quantum numbers
REAL :: evac0(2,2)
CONTAINS
PROCEDURE :: init
procedure :: set_quantum_numbers
PROCEDURE :: read_xml=>read_xml_enpara
END TYPE t_enparaXML
PUBLIC:: t_enparaXML
CONTAINS
SUBROUTINE read_xml_enpara(this,xml)
use m_types_xml
CLASS(t_enparaXML),INTENT(OUT):: this
TYPE(t_xml),INTENT(IN) :: xml
LOGICAL :: l_enpara,film
INTEGER :: jspins,ntype,lmaxd,n,lo,i
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),jspins)
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
IF (xml%GetNumberOfNodes("/fleurInput/cell/filmLattice")==1) THEN
DO i=1,xml%GetNumberOfNodes("/fleurInput/cell/filmLattice/vacuumEnergyParameters")
WRITE(xpath,"(a,i0,a)") '/fleurInput/cell/filmLattice/vacuumEnergyParameters[',i,']'
n = evaluateFirstIntOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xPath))//'/@vacuum'))
this%evac0(n,:) = evaluateFirstOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xPath))//'/@spinUp'))
IF (xml%GetNumberOfNodes(TRIM(ADJUSTL(xPath))//'/@spinDown').GE.1) THEN
this%evac0(n,2) = evaluateFirstOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xPath))//'/@spinDown'))
END IF
IF (i==1.AND.n==1) this%evac0(2,:)=this%evac0(1,:)
END DO
END IF
END SUBROUTINE read_xml_enpara
SUBROUTINE set_quantum_numbers(enpara,ntype,atoms,str,lo)
use m_types_atoms
!sets the energy parameters according to simple electronic config string and lo string
CLASS(t_enparaXML),INTENT(inout):: enpara
TYPE(t_atoms),INTENT(IN) :: atoms
INTEGER,INTENT(in) :: ntype
CHARACTER(len=*),INTENT(in) :: str,lo
CHARACTER(len=100):: val_str
character :: ch
INTEGER :: qn,n,i,l
!Process lo's
DO i=1,LEN_TRIM(lo)/2
READ(lo(2*i-1:2*i),"(i1,a1)") qn,ch
enpara%qn_ello(i,ntype,:)=qn
ENDDO
!Valence string
val_str=ADJUSTL(str(INDEX(str,"|")+1:))
DO WHILE(LEN_TRIM(val_str)>1)
READ(val_str,"(i1,a1)") qn,ch
l=INDEX("spdf",ch)-1
!check if we have an lo for this l-channel
DO i=1,atoms%nlo(ntype)
IF (l==atoms%llo(i,ntype).AND.qn==enpara%qn_ello(i,ntype,1)) EXIT
ENDDO
IF (atoms%nlo(ntype)==0.OR.i>atoms%nlo(ntype)) THEN
!set the lapw parameter
IF (enpara%qn_el(l,ntype,1)<0) CALL judft_error("Electronic configuration needs more LOs")
enpara%qn_el(l,ntype,:)=-qn
ENDIF
IF (LEN_TRIM(val_str)>5) THEN
val_str=ADJUSTL(val_str(5:))
ELSE
val_str=""
ENDIF
ENDDO
enpara%qn_el(:,ntype,:)=ABS(enpara%qn_el(:,ntype,:))
END SUBROUTINE set_quantum_numbers
SUBROUTINE init(this,ntype,nlod,jspins,l_defaults,nz)
USE m_constants
CLASS(t_enparaXML),INTENT(inout):: this
INTEGER,INTENT(IN) :: jspins,nlod,ntype
LOGICAL,INTENT(IN),OPTIONAL :: l_defaults
INTEGER,INTENT(IN),OPTIONAL :: nz(:)
INTEGER :: n,i,jsp,l
this%evac0=-1E99
ALLOCATE(this%qn_el(0:3,ntype,jspins))
ALLOCATE(this%qn_ello(nlod,ntype,jspins))
IF (PRESENT(l_defaults)) THEN
IF (.NOT.l_defaults) RETURN
ENDIF
!Set most simple defaults
DO jsp=1,jspins
DO n = 1,ntype
IF ( nz(n) < 3 ) THEN
this%qn_el(0:3,n,jsp) = (/1,2,3,4/)
ELSEIF ( nz(n) < 11 ) THEN
this%qn_el(0:3,n,jsp) = (/2,2,3,4/)
ELSEIF ( nz(n) < 19 ) THEN
this%qn_el(0:3,n,jsp) = (/3,3,3,4/)
ELSEIF ( nz(n) < 31 ) THEN
this%qn_el(0:3,n,jsp) = (/4,4,3,4/)
ELSEIF ( nz(n) < 37 ) THEN
this%qn_el(0:3,n,jsp) = (/4,4,4,4/)
ELSEIF ( nz(n) < 49 ) THEN
this%qn_el(0:3,n,jsp) = (/5,5,4,4/)
ELSEIF ( nz(n) < 55 ) THEN
this%qn_el(0:3,n,jsp) = (/5,5,5,4/)
ELSEIF ( nz(n) < 72 ) THEN
this%qn_el(0:3,n,jsp) = (/6,6,5,4/)
ELSEIF ( nz(n) < 81 ) THEN
this%qn_el(0:3,n,jsp) = (/6,6,5,5/)
ELSEIF ( nz(n) < 87 ) THEN
this%qn_el(0:3,n,jsp) = (/6,6,6,5/)
ELSE
this%qn_el(0:3,n,jsp) = (/7,7,6,5/)
ENDIF
this%qn_ello(:,n,jsp) = 0
ENDDO
ENDDO
this%evac0=eVac0Default_const
END SUBROUTINE init
END MODULE m_types_enparaXML
......@@ -9,12 +9,12 @@ MODULE m_types_field
! This module contains definitions for electric and magnetic field -types
!*************************************************************
USE m_juDFT
USE m_types_fleurinput_base
IMPLICIT NONE
PRIVATE
REAL,TARGET::sigma=0.0
TYPE t_efield
TYPE,EXTENDS(t_fleurinput_base):: t_efield
REAL :: zsigma = 10.0 ! Distance to the charged plates
REAL,POINTER :: sigma ! charge at the plates
REAL :: sigma ! charge at the plates
REAL :: sig_b(2)= 0.0 ! Extra charge for the top/bottom plate
COMPLEX :: vslope = 0.0 ! Dirichlet bnd. cond.: Slope
REAL, ALLOCATABLE :: sigEF(:,:,:) ! (nx, ny, nvac)
......@@ -42,18 +42,18 @@ MODULE m_types_field
PUBLIC t_field,t_efield
CONTAINS
SUBROUTINE init_field(this,input)
USE m_types_setup
SUBROUTINE init_field(this)
!USE m_types_setup
IMPLICIT NONE
CLASS(t_field),INTENT(INOUT)::this
TYPE(t_input),INTENT(INOUT) ::input
input%sigma => sigma
this%efield%sigma=>sigma
!TYPE(t_input),