Commit 09cb2516 authored by Daniel Wortmann's avatar Daniel Wortmann

Bugfixes

parent 56418866
......@@ -26,6 +26,7 @@ make_atomic_defaults.f90
read_inpgen_input.f90
closure.f90
super_check.f90
make_kpoints.f90
${FLEUR_SRC}/init/compile_descr.F90
${FLEUR_SRC}/global/constants.f90
......
......@@ -229,7 +229,7 @@ contains
nz=-1
IF (element.NE."") THEN
nz=element_to_z(element)
IF (z.NE.0.AND.nz.NE.FLOOR(z)) CALL judft_error("z and z of specified element differ")
IF (z>-1.AND.nz.NE.FLOOR(z)) CALL judft_error("z and z of specified element differ")
ELSE
nz=FLOOR(z)
ENDIF
......@@ -245,6 +245,12 @@ contains
IF (ncst>-1) CALL judft_warn("ncst is no longer supported as input")
IF (LEN_TRIM(econfig)==0)THEN
ap=find_atompar(nz,rmt)
econfig=ap%econfig
IF (LEN_TRIM(lo)==0) lo=ap%lo
END IF
ap=t_atompar(id=INT(id),nucnumber=nz,rmt=rmt,dx=dx,jri=jri,lmax=lmax,lnonsph=lnonsph,lo=lo,bmu=bmu,econfig=econfig,desc=name)
......@@ -254,22 +260,24 @@ contains
IMPLICIT NONE
CHARACTER(len=*),INTENT(in):: element
CHARACTER(len=2) :: ele
INTEGER,parameter :: adiff=ICHAR('A')-ICHAR('a')
INTEGER :: n
CHARACTER(len=2) :: ele,nam
INTEGER,parameter :: adiff=abs(ICHAR('A')-ICHAR('a'))
INTEGER :: n,diff
ele=ADJUSTL(element)
IF (ele(1:1)>='A'.AND.ele(1:1)<='Z') ele(1:1)=CHAR(ICHAR(ele(1:1))-adiff)
IF (ele(2:2)>='A'.AND.ele(2:2)<='Z') ele(2:2)=CHAR(ICHAR(ele(2:2))-adiff)
element_to_z = -1
DO n = 0, SIZE(namat_const)-1
IF (TRIM(ele) == TRIM(ADJUSTL(namat_const(n)))) THEN
element_to_z = n
EXIT
ENDIF
ENDDO
nam=ADJUSTL(namat_const(n))
diff=ABS(ICHAR(ele(1:1))-ICHAR(nam(1:1)))
IF (diff==0.OR.diff==adiff)THEN
diff=ABS(ICHAR(ele(2:2))-ICHAR(nam(2:2)))
IF (diff==0.OR.diff==adiff) THEN
element_to_z = n
EXIT
ENDIF
END IF
END DO
END FUNCTION element_to_z
END SUBROUTINE read_atom_params_old
......
......@@ -20,7 +20,7 @@ PROGRAM inpgen
USE m_make_crystal
USE m_make_atomic_defaults
USE m_make_defaults
!use m_make_kpoints
USE m_make_kpoints
USE m_winpxml
USE m_xsf_io
USE m_types_input
......@@ -69,8 +69,11 @@ PROGRAM inpgen
l_explicit=judft_was_argument("-explicit")
l_include=judft_was_argument("-singlefile")
OPEN(6,file='out')
INQUIRE(file='inp.xml',exist=l_inpxml)
IF (l_inpxml.AND..NOT.judft_was_argument("-inp.xml")) CALL judft_error("inp.xml exists and can not be overwritten")
IF (l_inpxml.AND..NOT.(judft_was_argument("-inp.xml").or.judft_was_argument("-overwrite")))&
CALL judft_error("inp.xml exists and can not be overwritten")
IF (judft_was_argument("-inp")) THEN
STOP "not yet"
......@@ -96,7 +99,7 @@ PROGRAM inpgen
!All atom related parameters are set here. Note that some parameters might
!have been set in the read_input call before by adding defaults to the atompar module
CALL make_atomic_defaults(input,vacuum,cell,oneD,atoms)
CALL make_atomic_defaults(input,vacuum,cell,oneD,atoms,enpara)
!Set all defaults that have not been specified before or can not be specified in inpgen
CALL make_defaults(atoms,sym,cell,vacuum,input,stars,&
......@@ -109,24 +112,23 @@ PROGRAM inpgen
!
!Now the IO-section
!
IF (.NOT.l_inpxml) THEN
IF (.NOT.l_inpxml.or.judft_was_argument("-overwrite")) THEN
!the inp.xml file
!CALL dump_FleurInputSchema()
CALL w_inpxml(&
atoms,vacuum,input,stars,sliceplot,forcetheo,banddos,&
cell,sym,xcpot,noco,oneD,hybrid,kpts,&
.false.,"inp.xml",&
l_explicit,l_include,enpara)
cell,sym,xcpot,noco,oneD,hybrid,kpts,enpara,&
5,l_explicit,l_include,"inp.xml")
if (.not.l_include) CALL sym%print_XML(99,"sym.xml")
ENDIF
if (.not.l_include) CALL kpts%print_XML(99,kpts_str,"kpts.xml")
if (.not.l_include) CALL kpts%print_XML(99,"kpts.xml")
! Structure in xsf-format
OPEN (55,file="struct.xsf")
CALL xsf_WRITE_atoms(55,atoms,input%film,.FALSE.,cell%amat)
CLOSE (55)
CLOSE(6)
CALL juDFT_end("All done",1)
CALL juDFT_end("All done")
END PROGRAM inpgen
......@@ -29,6 +29,9 @@ CONTAINS
CALL new_argument(0,"-warn_only","do not stop for warnings","")
CALL new_argument(0,"-singlefile","include all data in inp.xml, do not create files for kpoints and symmetry","")
CALL new_argument(1,"-k","String to define k-point set","")
call new_argument(0,"-no_send","Do not send usage data","")
CALL new_argument(0,"-overwrite","Overwrite inp.xml if present","")
CALL new_argument(0,"-h","Print this help message","")
IF (.NOT.check_arguments()) CALL judft_warn("Invalid command line arguments",hint="Use -h option to see valid choices")
......
......@@ -9,7 +9,7 @@ MODULE m_make_atomic_defaults
IMPLICIT NONE
CONTAINS
SUBROUTINE make_atomic_defaults(input,vacuum,cell,oneD,atoms)
SUBROUTINE make_atomic_defaults(input,vacuum,cell,oneD,atoms,enpara)
USE m_check_mt_radii
USE m_atompar
USE m_types_atoms
......@@ -18,8 +18,10 @@ CONTAINS
USE m_types_cell
USE m_types_oneD
USE m_constants
USE m_types_enpara
TYPE(t_atoms),INTENT(INOUT) :: atoms
TYPE(t_enpara),INTENT(OUT) :: enpara
TYPE(t_input),INTENT(IN) :: input
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_cell),INTENT(IN) :: cell
......@@ -29,32 +31,28 @@ CONTAINS
INTEGER :: element_species(120)
CHARACTER(len=1) :: lotype(0:3)=(/'s','p','d','f'/)
TYPE(t_atompar):: ap
TYPE(t_atompar):: ap(atoms%ntype)
element_species=0
atoms%nlod=9 ! This fixed dimensioning might have to be made more dynamical!
ALLOCATE(atoms%nz(atoms%ntype))
ALLOCATE(atoms%jri(atoms%ntype))
ALLOCATE(atoms%dx(atoms%ntype))
ALLOCATE(atoms%lmax(atoms%ntype))
ALLOCATE(atoms%nlo(atoms%ntype))
ALLOCATE(atoms%llo(atoms%nlod,atoms%ntype))
ALLOCATE(atoms%lnonsph(atoms%ntype))
ALLOCATE(atoms%nflip(atoms%ntype))
ALLOCATE(atoms%l_geo(atoms%ntype))
ALLOCATE(atoms%lda_u(atoms%ntype))
!ALLOCATE(atoms%bmu(atoms%ntype))
ALLOCATE(atoms%econf(atoms%ntype))
ALLOCATE(atoms%relax(3,atoms%ntype))
ALLOCATE(atoms%ulo_der(atoms%nlod,atoms%ntype))
ALLOCATE(atoms%rmt(atoms%ntype))
ALLOCATE(atoms%speciesname(atoms%ntype))
ALLOCATE(atoms%lapw_l(atoms%ntype))
ALLOCATE(atoms%llo(99,atoms%ntype));atoms%llo=-1!will be redone later
atoms%lapw_l=0
atoms%speciesname=""
atoms%nz(:) = NINT(atoms%zatom(:))
atoms%rmt(:) = 999.9
atoms%ulo_der = 0
......@@ -70,28 +68,28 @@ CONTAINS
DO n=1,atoms%ntype
id=NINT(atoms%zatom(n)-atoms%nz(n)*100)
IF (id>0) THEN
ap=find_atompar(atoms%nz(n),atoms%rmt(n),id)
ap(n)=find_atompar(atoms%nz(n),atoms%rmt(n),id)
!This specific atom also has a rmt given?
IF (ap%id==id.AND.ap%rmt>0.0) atoms%rmt(n)=ap%rmt
IF (ap(n)%id==id.AND.ap(n)%rmt>0.0) atoms%rmt(n)=ap(n)%rmt
ELSE
ap=find_atompar(atoms%nz(n),atoms%rmt(n))
ap(n)=find_atompar(atoms%nz(n),atoms%rmt(n))
ENDIF
CALL ap%add_defaults()
atoms%jri(n)=ap%jri
atoms%dx(n)=ap%dx
atoms%lmax(n)=ap%lmax
atoms%lnonsph(n)=ap%lnonsph
!atoms%bmu(n))=ap%bmu
CALL ap(n)%add_defaults()
atoms%jri(n)=ap(n)%jri
atoms%dx(n)=ap(n)%dx
atoms%lmax(n)=ap(n)%lmax
atoms%lnonsph(n)=ap(n)%lnonsph
!atoms%bmu(n))=ap(n)%bmu
!local orbitals
atoms%nlo(n)=len_TRIM(ap%lo)/2
atoms%nlo(n)=len_TRIM(ap(n)%lo)/2
DO i=1,atoms%nlo(n)
DO l = 0, 3
IF (ap%lo(2*i:2*i) == lotype(l)) atoms%llo(i,n) = l
!Setting of llo will be redone below
IF (ap(n)%lo(2*i:2*i) == lotype(l)) atoms%llo(i,n) = l
ENDDO
ENDDO
atoms%ulo_der(:,n)=0
call atoms%econf(n)%init(ap%econfig)
CALL atoms%econf(n)%init(ap(n)%econfig)
if (abs(ap(n)%bmu)>1E-8) call atoms%econf(n)%set_initial_moment(ap(n)%bmu)
!atoms%ncst(n)=econfig_count_core(econfig)
......@@ -112,7 +110,23 @@ CONTAINS
endif
END DO
atoms%nlod=MAXVAL(atoms%nlo)
atoms%lmaxd=MAXVAL(atoms%lmax)
DEALLOCATE(atoms%llo)
ALLOCATE(atoms%llo(atoms%nlod,atoms%ntype));atoms%llo=-1
ALLOCATE(atoms%ulo_der(atoms%nlod,atoms%ntype))
atoms%ulo_der=0
CALL enpara%init(atoms,2,.TRUE.)
DO n=1,atoms%ntype
DO i=1,atoms%nlo(n)
DO l = 0, 3
IF (ap(n)%lo(2*i:2*i) == lotype(l)) atoms%llo(i,n) = l
ENDDO
ENDDO
CALL enpara%set_quantum_numbers(n,atoms,ap(n)%econfig,ap(n)%lo)
END DO
END SUBROUTINE make_atomic_defaults
END MODULE m_make_atomic_defaults
......@@ -40,12 +40,19 @@ CONTAINS
TYPE(t_hybrid),INTENT(INOUT)::hybrid
integer :: n
!
!input
!
input%delgau = input%tkb
IF (noco%l_ss) noco%l_noco=.TRUE.
IF (noco%l_noco) input%jspins = 2
!check for magnetism
DO n=1,atoms%ntype
IF (ANY(atoms%econf(n)%occupation(:,1).NE.atoms%econf(n)%occupation(:,2))) input%jspins=2
ENDDO
IF ( ANY(atoms%nlo(:).NE.0) ) THEN
input%ellow = -1.8
......@@ -67,9 +74,14 @@ CONTAINS
input%gw_neigd = 0
END IF
IF (input%rkmax==0.0) input%rkmax=MAXVAL(atoms%lmax/atoms%rmt)
IF (input%rkmax>4.5) THEN
PRINT *,"WARNING, large default rkmax has been reduced. Check input"
input%rkmax=4.5
ENDIF
input%rkmax = real(NINT(input%rkmax * 10 ) / 10.)
IF (noco%l_ss) input%ctail = .FALSE.
input%zelec=sum(atoms%econf(:)%valence_electrons)
!
! stars
!
......
......@@ -3,68 +3,72 @@
! 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_make_kpoints
use m_juDFT
implicit none
contains
subroutine make_kpoints(kpts,cell,sym,film,l_socorss,str)
use m_types_kpts
use m_types_cell
use m_types_sym
type(t_kpts),intent(out)::kpts
type(t_cell),intent(in) ::cell
type(t_sym),intent(in) ::sym
logical,intent(in)::l_socorss
character(len=*),intent(inout)::str
logical::tria,l_gamma,l_soc_or_ss
MODULE m_make_kpoints
USE m_juDFT
IMPLICIT NONE
CONTAINS
SUBROUTINE make_kpoints(kpts,cell,sym,film,l_socorss,str)
USE m_types_kpts
USE m_types_cell
USE m_types_sym
TYPE(t_kpts),INTENT(out)::kpts
TYPE(t_cell),INTENT(in) ::cell
TYPE(t_sym),INTENT(in) ::sym
LOGICAL,INTENT(in)::l_socorss,film
CHARACTER(len=*),INTENT(inout)::str
LOGICAL:: tria,l_gamma,l_soc_or_ss
REAL :: den
INTEGER:: nk,grid(3)
character(len=20)::name=""
l_soc_or_ss=l_socorss
if (judft_was_argument("-k")) then
if (len_trim(str)>1) call judft_error("Do not specify k-points in file and on command line")
IF (judft_was_argument("-k")) THEN
IF (LEN_TRIM(str)>1) CALL judft_error("Do not specify k-points in file and on command line")
str=judft_string_for_argument("-k")
end if
END IF
!set name
IF (INDEX(str,"#")>0) THEN
name=trim(adjustl(str(INDEX(str,"#")+1:)))
str=str(:INDEX(str,"#")-1)
END IF
str=adjustl(str)
do while(index(str,'@')>0)
if (index(str,'tria@')==1) then
tria=.true.
str=ADJUSTL(str)
DO WHILE(INDEX(str,'@')>0)
IF (INDEX(str,'tria@')==1) THEN
tria=.TRUE.
str=str(6:)
endif
if (index(str,'gamma@')==1) then
l_gamma=.true.
ENDIF
IF (INDEX(str,'gamma@')==1) THEN
l_gamma=.TRUE.
str=str(7:)
endif
if (index(str,'soc@')==1) then
l_soc_or_ss=.true.
ENDIF
IF (INDEX(str,'soc@')==1) THEN
l_soc_or_ss=.TRUE.
str=str(5:)
endif
end do
if (index(str,'den=')==1) THEN
ENDIF
END DO
IF (INDEX(str,'den=')==1) THEN
str=str(5:)
read(str,*) den
call kpts%init_by_density(den,cell,sym,film,tria,l_soc_or_ss,l_gamma)
elseif(index(str,'nk=')==1) then
READ(str,*) den
CALL kpts%init_by_density(den,cell,sym,film,tria,l_soc_or_ss,l_gamma)
ELSEIF(INDEX(str,'nk=')==1) THEN
str=str(4:)
read(str,*) nk
call kpts%init_by_number(nk,cell,sym,film,tria,l_soc_or_ss,l_gamma)
elseif(index(str,'grid=')==1) then
READ(str,*) nk
CALL kpts%init_by_number(nk,cell,sym,film,tria,l_soc_or_ss,l_gamma)
ELSEIF(INDEX(str,'grid=')==1) THEN
str=str(6:)
read(str,*) grid
call kpts%init_by_grid(grid,cell,sym,film,tria,l_soc_or_ss,l_gamma)
elseif(index(str,'file')==1) then
call kpts%init_by_kptsfile(cell,sym,film,tria,l_soc_or_ss,l_gamma)
elseif(index(str,'special')==1) then
call kpts%init_by_kptsfile(cell,sym,film,tria,l_soc_or_ss,l_gamma)
elseif(len_trim(str)<1.or.index(adjustl(str),'#')==1) then
call kpts%init_defaults(cell,sym,film,tria,l_soc_or_ss,l_gamma)
else
call judft_error(("Could not process -k argument:"//str))
endif
!set name
if (index(str,"#")>0) then
str=str(index(str,"#")+1:)
else
str='default'
end if
end subroutine make_kpoints
READ(str,*) grid
CALL kpts%init_by_grid(grid,cell,sym,film,tria,l_soc_or_ss,l_gamma)
ELSEIF(INDEX(str,'file')==1) THEN
CALL kpts%init_by_kptsfile(film)
ELSEIF(LEN_TRIM(str)<1.OR.INDEX(ADJUSTL(str),'#')==1) THEN
CALL kpts%init_defaults(cell,sym,film,tria,l_soc_or_ss,l_gamma)
ELSE
CALL judft_error(("Could not process -k argument:"//str))
ENDIF
if (len_trim(name)>0) kpts%name=name
END SUBROUTINE make_kpoints
END MODULE m_make_kpoints
......@@ -289,20 +289,22 @@ CONTAINS
NAMELIST /exco/ xctyp, relxc
INTEGER :: ios
relxc=.false.
xctyp='pbe'
READ(line,exco,iostat=ios)
IF (ios.NE.0) CALL judft_error(("Error reading:"//line))
IF (ios.NE.0) CALL judft_error(("Error reading:"//trim(line)))
call xcpot%init(xctyp,relxc,1) !Is it OK to use ntype=1 here??
END SUBROUTINE process_exco
SUBROUTINE process_comp(line,jspins,frcor,ctail,kcrel,gmax,gmaxxc,rkmax)
SUBROUTINE process_comp(line,jspins,frcor,ctail,kcrel,gmax,gmaxxc,kmax)
CHARACTER(len=*),INTENT(in)::line
INTEGER,INTENT(inout):: jspins,kcrel
LOGICAL,INTENT(inout):: frcor,ctail
REAL,intent(inout) :: gmax,gmaxxc,rkmax
REAL,intent(inout) :: gmax,gmaxxc,kmax
INTEGER :: ios
NAMELIST /comp/ jspins, frcor, ctail, kcrel, gmax, gmaxxc, rkmax
NAMELIST /comp/ jspins, frcor, ctail, kcrel, gmax, gmaxxc, kmax
READ(line,comp,iostat=ios)
IF (ios.NE.0) CALL judft_error(("Error reading:"//line))
......
......@@ -17,10 +17,9 @@ MODULE m_winpXML
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
CONTAINS
SUBROUTINE w_inpXML(&
& atoms,vacuum,input,stars,sliceplot,forcetheo,banddos,&
& cell,sym,xcpot,noco,oneD,hybrid,kpts,&
& l_outFile,filename,&
& l_explicitIn,l_includeIn,enpara)
atoms,vacuum,input,stars,sliceplot,forcetheo,banddos,&
cell,sym,xcpot,noco,oneD,hybrid,kpts,enpara,&
filenum,l_explicitIn,l_includeIn,filename)
use m_types_input
......@@ -63,11 +62,12 @@ SUBROUTINE w_inpXML(&
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_enpara),INTENT(IN) :: enpara
CLASS(t_forcetheo),INTENT(IN):: forcetheo !nothing is done here so far....
LOGICAL, INTENT (IN) :: l_outFile, l_explicitIn,l_includeIn
CHARACTER(LEN=*),INTENT(IN) :: filename
LOGICAL, INTENT (IN) :: l_explicitIn,l_includeIn
INTEGER,INTENT(IN) :: fileNum
CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: filename
INTEGER :: iSpecies, fileNum
INTEGER :: iSpecies
CHARACTER(len=8) :: name(10)
INTEGER :: numSpecies
INTEGER :: speciesRepAtomType(atoms%ntype)
......@@ -123,8 +123,8 @@ SUBROUTINE w_inpXML(&
REAL :: tempTaual(3,atoms%nat), scpos(3)
REAL :: amatTemp(3,3), bmatTemp(3,3)
l_include=l_inclueIn.or.l_outfile
l_explicit = l_explicitIn.OR.l_outFile
l_include=l_includeIn.or..not.present(filename)
l_explicit = l_explicitIn.OR..not.present(filename)
l_nocoOpt = noco%l_noco.OR.juDFT_was_argument("-noco")
band = .false.
......@@ -132,17 +132,12 @@ SUBROUTINE w_inpXML(&
fileNum = -1
IF(l_outFile) THEN
fileNum = getXMLOutputUnitNumber()
CALL openXMLElementNoAttributes('inputData')
ELSE
fileNum = 5
OPEN (fileNum,file=TRIM(ADJUSTL(filename)),form='formatted',status='unknown')
REWIND (fileNum)
IF(PRESENT(filename)) THEN
OPEN (fileNum,file=TRIM(ADJUSTL(filename)),form='formatted',status='replace')
WRITE (fileNum,'(a)') '<?xml version="1.0" encoding="UTF-8" standalone="no"?>'
WRITE (fileNum,'(a)') '<fleurInput fleurInputVersion="0.29">'
ELSE
CALL openXMLElementNoAttributes('inputData')
END IF
WRITE (fileNum,'(a)') ' <comment>'
......@@ -230,9 +225,10 @@ SUBROUTINE w_inpXML(&
WRITE (fileNum,200) input%zelec,TRIM(ADJUSTL(bzIntMode)),input%tkb
if (l_include) THEN
call kpts%print_xml(fileNum,"default")
call kpts%print_xml(fileNum)
else
WRITE (fileNum,'(a)')' <xi:include xmlns:xi="http://www.w3.org/2001/XInclude" href="kpts.xml"> </xi:include>'
WRITE (fileNum,'(a)')' <!-- k-points included here -->'
WRITE (fileNum,'(a)')' <xi:include xmlns:xi="http://www.w3.org/2001/XInclude" href="kpts.xml"> </xi:include>'
end if
WRITE (fileNum,'(a)') ' </bzIntegration>'
......@@ -245,7 +241,8 @@ SUBROUTINE w_inpXML(&
if (l_include) THEN
call sym%print_xml(fileNum)
else
WRITE (fileNum,'(a)')' <xi:include xmlns:xi="http://www.w3.org/2001/XInclude" href="sym.xml"> </xi:include>'
WRITE (fileNum,'(a)')' <!-- symmetry operations included here -->'
WRITE (fileNum,'(a)')' <xi:include xmlns:xi="http://www.w3.org/2001/XInclude" href="sym.xml"> </xi:include>'
end if
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!! Note: Different options for the cell definition!
......@@ -319,7 +316,7 @@ SUBROUTINE w_inpXML(&
! <species name="Si-1" element="Si" atomicNumber="14" coreStates="4" magMom="0.0" flipSpin="F">
300 FORMAT(' <species name="',a,'" element="',a,'" atomicNumber="',i0,'" flipSpin="',l1,'">')
speciesName = TRIM(ADJUSTL(atoms%speciesName(iSpecies)))
WRITE (fileNum,300) TRIM(ADJUSTL(speciesName)),TRIM(ADJUSTL(namat_const(atoms%nz(iAtomType)+1))),atoms%nz(iAtomType),atoms%nflip(iAtomType)
WRITE (fileNum,300) TRIM(ADJUSTL(speciesName)),TRIM(ADJUSTL(namat_const(atoms%nz(iAtomType)))),atoms%nz(iAtomType),atoms%nflip(iAtomType)
! <mtSphere radius="2.160000" gridPoints="521" logIncrement="0.022000"/>
310 FORMAT(' <mtSphere radius="',f0.8,'" gridPoints="',i0,'" logIncrement="',f0.8,'"/>')
......@@ -329,12 +326,11 @@ SUBROUTINE w_inpXML(&
320 FORMAT(' <atomicCutoffs lmax="',i0,'" lnonsphr="',i0,'"/>')
WRITE (fileNum,320) atoms%lmax(iAtomType),atoms%lnonsph(iAtomType)
print *,"enpara IO missing"
! IF (ALL(enpara%qn_el(0:3,iAtomType,1).ne.0)) THEN
IF (ALL(enpara%qn_el(0:3,iAtomType,1).ne.0)) THEN
!! <energyParameters s="3" p="3" d="3" f="4"/>
! 321 FORMAT(' <energyParameters s="',i0,'" p="',i0,'" d="',i0,'" f="',i0,'"/>')
! WRITE (fileNum,321) enpara%qn_el(0:3,iAtomType,1)
! END IF
321 FORMAT(' <energyParameters s="',i0,'" p="',i0,'" d="',i0,'" f="',i0,'"/>')
WRITE (fileNum,321) enpara%qn_el(0:3,iAtomType,1)
END IF
IF(l_explicit.OR.hybrid%l_hybrid) THEN
315 FORMAT(' <prodBasis lcutm="',i0,'" lcutwf="',i0,'" select="',a,'"/>')
......@@ -503,13 +499,13 @@ SUBROUTINE w_inpXML(&
WRITE (fileNum,430) banddos%e_mcd_lo,banddos%e_mcd_up
WRITE (fileNum,'(a)') ' </output>'
IF(l_outFile) THEN
CALL closeXMLElement('inputData')
ELSE
WRITE (fileNum,'(a)')' <!-- We include the file relax.inp here to enable relaxations (see documentation) -->'
IF(present(filename)) THEN
WRITE (fileNum,'(a)')' <!-- We include the file relax.inp here to enable relaxations (see documentation) -->'
WRITE (fileNum,'(a)')' <xi:include xmlns:xi="http://www.w3.org/2001/XInclude" href="relax.xml"> <xi:fallback/> </xi:include>'
WRITE (fileNum,'(a)') '</fleurInput>'
CLOSE (fileNum)
ELSE
CALL closeXMLElement('inputData')
END IF
END SUBROUTINE w_inpXML
......
......@@ -115,9 +115,8 @@ MODULE m_types_atoms
integer,intent(in)::n,nn
if (n>atoms%ntype.or.nn>atoms%ntype) call judft_error("Same species checked for non-existing atom")
same_species=atoms%nz(n)==atoms%nz(nn)
same_species=same_species.and.atoms%speciesname(n)==atoms%speciesname(nn)
same_species=same_species.and.atoms%jri(n)==atoms%jri(nn)
same_species=same_species.and.atoms%dx(n)==atoms%dx(nn)
same_species=same_species.and.atoms%rmt(n)==atoms%rmt(nn)
......
......@@ -123,13 +123,18 @@ CONTAINS
n=INDEX(str,"|")
IF (n==0) CALL judft_error(("Invalid econfig:"//TRIM(str)))
CALL convert_to_extended(str(1:n-1),core,core_occ)
IF (INDEX(str,"|")==1) THEN
! No core
core=""
ALLOCATE(core_occ(0))
ELSE
CALL convert_to_extended(str(1:n-1),core,core_occ)
ENDIF
CALL convert_to_extended(str(INDEX(str,"|")+1:),valence,valence_occ)
CALL econf%init(core,valence)
!Now set occupations
core=econf%coreconfig(INDEX(econf%coreconfig,"("):) !remove noble gas
IF (SIZE(core_occ)>0) core=econf%coreconfig(INDEX(econf%coreconfig,"("):) !remove noble gas
DO n=1,SIZE(core_occ)
CALL econf%set_occupation(core(:INDEX(core,")")),core_occ(n),-1.)
core=core(INDEX(core,")")+1:)
......@@ -263,8 +268,8 @@ CONTAINS
SUBROUTINE set_initial_moment(econf,bmu)
CLASS(t_econfig),INTENT(OUT):: econf
real ,INTENT(IN) :: bmu
CLASS(t_econfig),INTENT(INOUT):: econf
real ,INTENT(IN ) :: bmu
INTEGER:: n
REAL :: p,el
......@@ -358,8 +363,8 @@ CONTAINS
REAL,ALLOCATABLE,INTENT(OUT) :: occupations(:)
CHARACTER(len=200)::conf
REAL :: occ,occupation(100) !this is the tmp local variable (no 's')
INTEGER:: n,nn
REAL :: occupation(100) !this is the tmp local variable (no 's')
INTEGER:: n,nn,occ
CHARACTER:: n_ch,ch
extended=""
......
......@@ -35,6 +35,7 @@ MODULE m_types_enpara
PROCEDURE :: write
PROCEDURE :: mix
PROCEDURE :: calcOutParams
procedure :: set_quantum_numbers
END TYPE t_enpara
......@@ -42,6 +43,47 @@ MODULE m_types_enpara
PUBLIC:: t_enpara
CONTAINS
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_enpara),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