Commit 74a330a4 authored by Daniel Wortmann's avatar Daniel Wortmann

Put atoms%econf into FLEUR. Compiles but does not run

parent 0710e1bd
......@@ -177,7 +177,7 @@
CALL MPI_BCAST(rh,DIMENSION%msh*atoms%ntype,CPP_MPI_REAL,0,mpi%mpi_comm,ierr)
#endif
nloop: DO n = 1 , atoms%ntype
IF ((atoms%ncst(n).GT.0).OR.l_st) THEN
IF ((atoms%econf(n)%num_core_states.GT.0).OR.l_st) THEN
DO j = 1 , atoms%jri(n)
rat(j,n) = atoms%rmsh(j,n)
ENDDO
......@@ -205,7 +205,7 @@
! IF mshc = jri either core tail too small or no core (i.e. H)
!
DO n = 1,atoms%ntype
IF ((mshc(n).GT.atoms%jri(n)).AND.((atoms%ncst(n).GT.0).OR.l_st)) THEN
IF ((mshc(n).GT.atoms%jri(n)).AND.((atoms%econf(n)%num_core_states.GT.0).OR.l_st)) THEN
j1 = atoms%jri(n) - 1
IF ( method1 .EQ. 1) THEN
......@@ -440,7 +440,7 @@
! they are contained in the plane wave part
!
DO n = 1,atoms%ntype
IF ((mshc(n).GT.atoms%jri(n)).AND.((atoms%ncst(n).GT.0).OR.l_st)) THEN
IF ((mshc(n).GT.atoms%jri(n)).AND.((atoms%econf(n)%num_core_states.GT.0).OR.l_st)) THEN
DO j = 1,atoms%jri(n)
rho(j,0,n,jspin) = rho(j,0,n,jspin)&
& - sfp_const*rat(j,n)*rat(j,n)*rh(j,n)
......
......@@ -25,5 +25,5 @@ core/ccdnup.f90
core/cored.F90
core/coredr.F90
core/etabinit.F90
core/setcor.f90
#core/setcor.f90
)
......@@ -8,7 +8,7 @@ CONTAINS
USE m_juDFT
USE m_intgr, ONLY : intgr3,intgr0,intgr1
USE m_constants, ONLY : c_light,sfp_const
USE m_setcor
!USE m_setcor
USE m_differ
USE m_types
USE m_xmlOutput
......@@ -39,9 +39,9 @@ CONTAINS
REAL rhcs(DIMENSION%msh),rhoc(DIMENSION%msh),rhoss(DIMENSION%msh),vrd(DIMENSION%msh),f(0:3)
REAL rhcs_aux(DIMENSION%msh), rhoss_aux(DIMENSION%msh) !> quantities for energy density calculations
REAL occ(DIMENSION%nstd),a(DIMENSION%msh),b(DIMENSION%msh),ain(DIMENSION%msh),ahelp(DIMENSION%msh)
REAL occ_h(DIMENSION%nstd,2)
INTEGER kappa(DIMENSION%nstd),nprnc(DIMENSION%nstd)
REAL occ(maxval(atoms%econf%num_states)),a(DIMENSION%msh),b(DIMENSION%msh),ain(DIMENSION%msh),ahelp(DIMENSION%msh)
REAL occ_h(maxval(atoms%econf%num_states),2)
INTEGER kappa(maxval(atoms%econf%num_states)),nprnc(maxval(atoms%econf%num_states))
CHARACTER(LEN=20) :: attributes(6)
REAL stateEnergies(29)
! ..
......@@ -81,7 +81,10 @@ CONTAINS
! rn = rmt(jatom)
dxx = atoms%dx(jatom)
bmu = 0.0
CALL setcor(jatom,input%jspins,atoms,input,bmu,nst,kappa,nprnc,occ_h)
!CALL setcor(jatom,input%jspins,atoms,input,bmu,nst,kappa,nprnc,occ_h)
CALL atoms%econf(jatom)%get_core(nst,nprnc,kappa,occ_h)
IF ((bmu > 99.)) THEN
occ(1:nst) = input%jspins * occ_h(1:nst,jspin)
ELSE
......@@ -124,7 +127,7 @@ CONTAINS
ENDDO
END IF
nst = atoms%ncst(jatom) ! for lda+U
nst = atoms%econf(jatom)%num_core_states ! for lda+U
IF (input%gw==1 .OR. input%gw==3)&
& WRITE(15) nst,atoms%rmsh(1:atoms%jri(jatom),jatom)
......@@ -217,7 +220,7 @@ CONTAINS
CALL openXMLElementForm('coreStates',(/'atomType ','atomicNumber ','spin ','kinEnergy ',&
'eigValSum ','lostElectrons'/),&
attributes,RESHAPE((/8,12,4,9,9,13,6,3,1,18,18,9/),(/6,2/)))
DO korb = 1, atoms%ncst(jatom)
DO korb = 1, atoms%econf(jatom)%num_core_states
fj = iabs(kappa(korb)) - .5e0
weight = 2*fj + 1.e0
IF (bmu > 99.) weight = occ(korb)
......
......@@ -17,7 +17,7 @@ CONTAINS
etab,ntab,ltab,nkmust)
USE m_constants, ONLY : c_light
USE m_setcor
!USE m_setcor
USE m_differ
USE m_types
IMPLICIT NONE
......@@ -35,12 +35,11 @@ CONTAINS
! ..
! .. Local Scalars ..
REAL c,d,dxx,e,fj,fl,fn,rn,rnot,t2 ,z,t1,rr,weight
REAL bmu
INTEGER i,ic,iksh,ilshell,j,jatom,korb,l, nst,ncmsh ,nshell,ipos,ierr
! ..
! .. Local Arrays ..
INTEGER kappa(DIMENSION%nstd),nprnc(DIMENSION%nstd)
REAL eig(DIMENSION%nstd),occ(DIMENSION%nstd,1),vrd(DIMENSION%msh),a(DIMENSION%msh),b(DIMENSION%msh)
INTEGER kappa(maxval(atoms%econf%num_states)),nprnc(maxval(atoms%econf%num_states))
REAL eig(maxval(atoms%econf%num_states)),occ(maxval(atoms%econf%num_states),1),vrd(DIMENSION%msh),a(DIMENSION%msh),b(DIMENSION%msh)
! ..
!
c = c_light(1.0)
......@@ -53,8 +52,8 @@ CONTAINS
z = atoms%zatom(jatom)
rn = atoms%rmt(jatom)
dxx = atoms%dx(jatom)
bmu = 0.0
CALL setcor(jatom,1,atoms,input,bmu,nst,kappa,nprnc,occ)
!CALL setcor(jatom,1,atoms,input,bmu,nst,kappa,nprnc,occ)
CALL atoms%econf(jatom)%get_core(nst,nprnc,kappa,occ)
rnot = atoms%rmsh(1,jatom)
d = EXP(atoms%dx(jatom))
rn = rnot* (d** (ncmsh-1))
......@@ -83,7 +82,7 @@ CONTAINS
ENDDO
END IF
nst = atoms%ncst(jatom)
nst = atoms%econf(jatom)%num_core_states
DO korb = 1,nst
fn = nprnc(korb)
fj = iabs(kappa(korb)) - .5e0
......
......@@ -110,7 +110,7 @@ MODULE m_corespec_eval
msh,vr,f,g)
USE m_constants, ONLY : c_light
USE m_setcor
!USE m_setcor
USE m_differ
USE m_intgr, ONLY : intgr3
USE m_dr2fdr
......@@ -167,8 +167,8 @@ MODULE m_corespec_eval
! core setup
bmu = 0.0
CALL setcor(itype,jspins,atoms,input,bmu,nst,kappa,nprnc,occ)
!CALL setcor(itype,jspins,atoms,input,bmu,nst,kappa,nprnc,occ)
CALL atoms%econf(itype)%get_core(nst,nprnc,kappa,occ)
! extend core potential
vrd(1:nr) = vr(1:nr,itype,jspin)
t2 = vrd(nr)/(nr-msh)
......
......@@ -158,9 +158,9 @@ MODULE m_corespec_io
write(*,csmsgs) trim(smeno),&
&"found more than 2*csv%nc-1 of csi%edgeidx > 0 !"//csmsgerr ; stop
endif
if((csv%nc-1)**2+maxval(csi%edgeidx).gt.atoms%ncst(csi%atomType)) then
if((csv%nc-1)**2+maxval(csi%edgeidx).gt.atoms%econf(csi%atomType)%num_core_states) then
write(*,csmsgs) trim(smeno),&
&"found (csv%nc-1)^2+maxval(csi%edgeidx) > atoms%ncst(csi%atomType)!"//csmsgerr
&"found (csv%nc-1)^2+maxval(csi%edgeidx) > num_core_states(csi%atomType)!"//csmsgerr
stop
endif
csv%nljc = count(csi%edgeidx.gt.0)
......
......@@ -193,7 +193,7 @@
REAL,ALLOCATABLE :: core11r(:,:,:,:),core22r(:,:,:,:)
REAL,ALLOCATABLE :: eig_cr(:,:,:)
ncstd = maxval(atoms%ncst)
ncstd = maxval(atoms%econf%num_core_states)
ALLOCATE( nindxcr(0:ncstd,atoms%ntype),stat = ok )
! generate relativistic core wave functions( ->core1r,core2r )
......@@ -284,7 +284,7 @@
USE m_intgr, ONLY : intgr3,intgr0,intgr1
USE m_constants, ONLY : c_light
USE m_setcor
!USE m_setcor
USE m_differ
USE m_types
IMPLICIT NONE
......@@ -344,9 +344,11 @@
z = atoms%zatom(itype)
dxx = atoms%dx(itype)
bmu = 0.0
CALL setcor( itype,input%jspins,atoms,input,bmu,&
& nst,kappa,nprnc,occ_h)
! CALL setcor( itype,input%jspins,atoms,input,bmu,&
! & nst,kappa,nprnc,occ_h)
call atoms%econf(itype)%get_core(nst,kappa,nprnc,occ_h)
IF ((bmu > 99.)) THEN
occ(1:nst) = input%jspins * occ_h(1:nst,jspin)
ELSE
......@@ -358,7 +360,7 @@
ncmsh = min( ncmsh, dimension%msh )
rn = rnot* (d** (ncmsh-1))
nst = atoms%ncst(itype)
nst = atoms%econf(itype)%num_core_states
DO 80 korb = 1,nst
IF (occ(korb).EQ.0) GOTO 80
......@@ -387,7 +389,8 @@
z = atoms%zatom(itype)
dxx = atoms%dx(itype)
bmu = 0.0
CALL setcor(itype,input%jspins,atoms,input,bmu,nst,kappa,nprnc,occ_h)
!CALL setcor(itype,input%jspins,atoms,input,bmu,nst,kappa,nprnc,occ_h)
call atoms%econf(itype)%get_core(nst,nprnc,kappa,occ_h)
IF ((bmu > 99.)) THEN
occ(1:nst) = input%jspins * occ_h(1:nst,jspin)
......@@ -427,7 +430,7 @@
END DO
END IF
nst = atoms%ncst(itype)
nst = atoms%econf(itype)%num_core_states
DO 90 korb = 1,nst
......@@ -473,7 +476,7 @@
USE m_intgr, ONLY : intgr3,intgr0,intgr1
USE m_constants, ONLY : c_light
USE m_setcor
!USE m_setcor
USE m_differ
USE m_types
IMPLICIT NONE
......@@ -509,7 +512,8 @@
z = atoms%zatom(itype)
dxx = atoms%dx(itype)
bmu = 0.0
CALL setcor(itype,input%jspins,atoms,input,bmu, nst,kappa,nprnc,occ_h)
!CALL setcor(itype,input%jspins,atoms,input,bmu, nst,kappa,nprnc,occ_h)
call atoms%econf(itype)%get_core(nst,nprnc,kappa,occ_h)
occ(1:nst) = occ_h(1:nst,1)
......@@ -519,7 +523,7 @@
ncmsh = min( ncmsh, dimension%msh )
rn = rnot* (d** (ncmsh-1))
nst = atoms%ncst(itype)
nst = atoms%econf(itype)%num_core_states
DO korb = 1,nst
IF (occ(korb).EQ.0) CYCLE
......
......@@ -18,7 +18,7 @@
!*********************************************************************
USE m_types
USE m_setcor, ONLY: setcor
!USE m_setcor, ONLY: setcor
IMPLICIT NONE
! ..
! .. Scalar Arguments ..
......@@ -37,9 +37,6 @@
REAL qn,qe,bmu
INTEGER n,iwd,nst,nc
! ..
! .. Local Array ..
INTEGER kappa(dimension%nstd),nprnc(dimension%nstd)
REAL occ(dimension%nstd,1)
! ..
! .. Local Parameters ..
INTEGER, PARAMETER :: pTOP = 1, pBOT = 2, pTOPBOT = 3
......@@ -59,11 +56,7 @@
!---> core electrons
DO n = 1,atoms%ntype
IF (atoms%zatom(n).GE.1.0) THEN
bmu = 0.0
CALL setcor(n,1,atoms,input,bmu, nst,kappa,nprnc,occ)
DO nc=1,atoms%ncst(n)
qe=qe+atoms%neq(n)*occ(nc,1)
ENDDO
qe=qe+atoms%neq(n)*atoms%econf(n)%core_electrons
WRITE (6,*) 'neq= ',atoms%neq(n),' ncore= ',qe
ENDIF
ENDDO
......
......@@ -98,6 +98,9 @@ SUBROUTINE initParallelProcesses(atoms,vacuum,input,stars,sliceplot,banddos,&
CALL MPI_BCAST(oneD%odd%nn2d,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
!CALL MPI_BCAST(obsolete%nwdd,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
DO n=1,atoms%ntype
CALL atoms%econf(n)%broadcast(mpi%mpi_comm)
END DO
IF (mpi%irank.NE.0) THEN
IF(ALLOCATED(atoms%neq)) DEALLOCATE(atoms%neq)
IF(ALLOCATED(atoms%volmts)) DEALLOCATE(atoms%volmts)
......@@ -106,11 +109,9 @@ SUBROUTINE initParallelProcesses(atoms,vacuum,input,stars,sliceplot,banddos,&
ALLOCATE(atoms%nz(atoms%ntype),atoms%zatom(atoms%ntype)) !nz and zatom have the same content!
ALLOCATE(atoms%jri(atoms%ntype),atoms%dx(atoms%ntype),atoms%rmt(atoms%ntype))
ALLOCATE(atoms%lmax(atoms%ntype),atoms%nlo(atoms%ntype),atoms%lnonsph(atoms%ntype))
ALLOCATE(atoms%ncst(atoms%ntype),atoms%lda_u(4*atoms%ntype))
ALLOCATE(atoms%nflip(atoms%ntype),atoms%bmu(atoms%ntype),atoms%neq(atoms%ntype))
ALLOCATE(atoms%l_geo(atoms%ntype),atoms%relax(3,atoms%ntype))
ALLOCATE(atoms%taual(3,atoms%nat),atoms%pos(3,atoms%nat))
ALLOCATE(atoms%numStatesProvided(atoms%ntype))
ALLOCATE(atoms%rmsh(atoms%jmtd,atoms%ntype))
ALLOCATE(atoms%volmts(atoms%ntype))
......
......@@ -100,7 +100,7 @@
& atoms%lmax(atoms%ntype),atoms%ntypsy(atoms%nat),atoms%neq(atoms%ntype),atoms%nlhtyp(atoms%ntype),&
& atoms%rmt(atoms%ntype),atoms%zatom(atoms%ntype),atoms%jri(atoms%ntype),atoms%dx(atoms%ntype), &
& atoms%nlo(atoms%ntype),atoms%llo(atoms%nlod,atoms%ntype),atoms%nflip(atoms%ntype),atoms%bmu(atoms%ntype),&
& noel(atoms%ntype),vacuum%izlay(vacuum%layerd,2),atoms%ncst(atoms%ntype),atoms%lnonsph(atoms%ntype),&
& noel(atoms%ntype),vacuum%izlay(vacuum%layerd,2),atoms%econf(atoms%ntype),atoms%lnonsph(atoms%ntype),&
& atoms%taual(3,atoms%nat),atoms%pos(3,atoms%nat),&
& atoms%nz(atoms%ntype),atoms%relax(3,atoms%ntype),&
& atoms%l_geo(atoms%ntype),noco%alph(atoms%ntype),noco%beta(atoms%ntype),&
......@@ -132,7 +132,7 @@
atoms%jmtd = 0
rmtmax = 0.0
dimension%neigd = 0
dimension%nstd = maxval(atoms%ncst)
dimension%nstd = maxval(atoms%econf%num_core_states)
atoms%lmaxd = maxval(atoms%lmax)
atoms%jmtd = maxval(atoms%jri)
rmtmax = maxval(atoms%rmt)
......@@ -360,7 +360,7 @@
DEALLOCATE( sym%mrot,sym%tau,&
& atoms%lmax,atoms%ntypsy,atoms%neq,atoms%nlhtyp,atoms%rmt,atoms%zatom,atoms%jri,atoms%dx,atoms%nlo,atoms%llo,atoms%nflip,atoms%bmu,noel,&
& vacuum%izlay,atoms%ncst,atoms%lnonsph,atoms%taual,atoms%pos,atoms%nz,atoms%relax,&
& vacuum%izlay,atoms%econf,atoms%lnonsph,atoms%taual,atoms%pos,atoms%nz,atoms%relax,&
& atoms%l_geo,noco%alph,noco%beta,atoms%lda_u,noco%l_relax,noco%b_con,sphhar%clnu,sphhar%nlh,&
& sphhar%llh,sphhar%nmem,sphhar%mlh,hybrid%select1,hybrid%lcutm1,&
& hybrid%lcutwf)
......
......@@ -49,11 +49,8 @@ CONTAINS
LOGICAL, INTENT(OUT):: l_opti
INTEGER, ALLOCATABLE :: xmlElectronStates(:,:)
INTEGER, ALLOCATABLE :: atomTypeSpecies(:)
INTEGER, ALLOCATABLE :: speciesRepAtomType(:)
REAL, ALLOCATABLE :: xmlCoreOccs(:,:,:)
LOGICAL, ALLOCATABLE :: xmlPrintCoreStates(:,:)
CHARACTER(len=3), ALLOCATABLE :: noel(:)
! .. Local Scalars ..
INTEGER :: i,n,l,m1,m2,isym,iisym,numSpecies,pc,iAtom,iType
......@@ -91,7 +88,6 @@ CONTAINS
ENDIF
!-odim
ALLOCATE ( atoms%nz(atoms%ntype),atoms%relax(3,atoms%ntype),atoms%nlhtyp(atoms%ntype))
ALLOCATE (atoms%corestateoccs(1,2,atoms%ntype));atoms%corestateoccs=0.0
ALLOCATE ( sphhar%clnu(sphhar%memd,0:sphhar%nlhd,sphhar%ntypsd),stars%ustep(stars%ng3) )
ALLOCATE ( stars%ig(-stars%mx1:stars%mx1,-stars%mx2:stars%mx2,-stars%mx3:stars%mx3),stars%ig2(stars%ng3) )
ALLOCATE ( atoms%jri(atoms%ntype),stars%kv2(2,stars%ng2),stars%kv3(3,stars%ng3),sphhar%llh(0:sphhar%nlhd,sphhar%ntypsd) )
......@@ -101,7 +97,7 @@ CONTAINS
ALLOCATE ( sphhar%nlh(sphhar%ntypsd),sphhar%nmem(0:sphhar%nlhd,sphhar%ntypsd) )
ALLOCATE ( stars%nstr2(stars%ng2),atoms%ntypsy(atoms%nat),stars%nstr(stars%ng3) )
ALLOCATE ( stars%igfft(0:stars%kimax,2),stars%igfft2(0:stars%kimax2,2),atoms%nflip(atoms%ntype) )
ALLOCATE ( atoms%ncst(atoms%ntype) )
ALLOCATE ( atoms%econf(atoms%ntype) )
ALLOCATE ( vacuum%izlay(vacuum%layerd,2) )
ALLOCATE ( sym%invarop(atoms%nat,sym%nop),sym%invarind(atoms%nat) )
ALLOCATE ( sym%multab(sym%nop,sym%nop),sym%invtab(sym%nop) )
......@@ -123,7 +119,6 @@ CONTAINS
ALLOCATE ( noco%b_con(2,atoms%ntype),atoms%lda_u(atoms%ntype),atoms%l_dulo(atoms%nlod,atoms%ntype) )
ALLOCATE ( sym%d_wgn(-3:3,-3:3,3,sym%nop) )
ALLOCATE ( atoms%ulo_der(atoms%nlod,atoms%ntype) )
ALLOCATE ( atoms%numStatesProvided(atoms%ntype))
ALLOCATE ( kpts%ntetra(4,kpts%ntet), kpts%voltet(kpts%ntet))
!+odim
ALLOCATE ( oneD%ig1(-oneD%odd%k3:oneD%odd%k3,-oneD%odd%M:oneD%odd%M) )
......@@ -138,7 +133,6 @@ CONTAINS
ALLOCATE ( hybrid%nindx(0:atoms%lmaxd,atoms%ntype) )
kpts%specificationType = 0
atoms%numStatesProvided(:) = 0
input%l_coreSpec = .FALSE.
......@@ -225,12 +219,8 @@ CONTAINS
WRITE(*,*) 'beautiful.'
WRITE(*,*) ''
ALLOCATE(noel(atoms%ntype),atomTypeSpecies(atoms%ntype),speciesRepAtomType(atoms%ntype))
ALLOCATE(xmlElectronStates(29,atoms%ntype),xmlPrintCoreStates(29,atoms%ntype))
ALLOCATE(xmlCoreOccs(1,1,1),atoms%label(atoms%nat))
ALLOCATE(hybrid%lcutm1(atoms%ntype),hybrid%lcutwf(atoms%ntype),hybrid%select1(4,atoms%ntype))
filename = 'inpConverted.xml'
xmlElectronStates = noState_const
xmlPrintCoreStates = .FALSE.
DO i = 1, atoms%nat
WRITE(atoms%label(i),'(i0)') i
END DO
......@@ -266,12 +256,10 @@ CONTAINS
atoms,obsolete,vacuum,input,stars,sliceplot,forcetheo,banddos,&
cell,sym,xcpot,noco,oneD,hybrid,kpts,kpts%nkpt3,kpts%l_gamma,&
noel,namex,relcor,a1,a2,a3,cell%amat(3,3),input%comment,&
xmlElectronStates,xmlPrintCoreStates,xmlCoreOccs,&
atomTypeSpecies,speciesRepAtomType,.FALSE.,filename,&
.TRUE.,numSpecies,enpara)
DEALLOCATE(atoms%speciesName, atoms%label)
DEALLOCATE(noel,atomTypeSpecies,speciesRepAtomType)
DEALLOCATE(xmlElectronStates,xmlPrintCoreStates,xmlCoreOccs)
CALL juDFT_end("Fleur inp to XML input conversion completed.")
END IF
END IF ! mpi%irank.eq.0
......
......@@ -286,7 +286,7 @@
CALL juDFT_warn ("Element name and nuclear number do not match!" ,calledby ="inped")
ENDIF
ENDIF
WRITE (6,8140) noel(n),atoms%nz(n),atoms%ncst(n),atoms%lmax(n),atoms%jri(n),atoms%rmt(n),atoms%dx(n)
WRITE (6,8140) noel(n),atoms%nz(n),atoms%econf(n)%num_core_states,atoms%lmax(n),atoms%jri(n),atoms%rmt(n),atoms%dx(n)
8140 FORMAT (a3,i3,3i5,2f10.6)
IF (atoms%jri(n)>atoms%jmtd) CALL juDFT_error("jmtd",calledby ="inped")
atoms%zatom(n) = atoms%nz(n)
......
set(fleur_F77 ${fleur_F77}
inpgen/atom_input.f
inpgen/atom_sym.f
inpgen/bravais_symm.f
inpgen/crystal.f
inpgen/element.f
inpgen/generator.f
inpgen/lapw_input.f
inpgen/lattice2.f
inpgen/read_record.f
inpgen/set_atom_core.f
inpgen/setab.f
inpgen/soc_or_ssdw.f
inpgen/spg_gen.f
inpgen/struct_input.f
inpgen/super_check.f
inpgen/symproperties.f
inpgen/write_struct.f
#inpgen/atom_input.f
#inpgen/atom_sym.f
#inpgen/bravais_symm.f
#inpgen/crystal.f
#inpgen/element.f
#inpgen/generator.f
#inpgen/lapw_input.f
#inpgen/lattice2.f
#inpgen/read_record.f
#inpgen/set_atom_core.f
#inpgen/setab.f
#inpgen/soc_or_ssdw.f
#inpgen/spg_gen.f
#inpgen/struct_input.f
#inpgen/super_check.f
#inpgen/symproperties.f
#inpgen/write_struct.f
)
set(fleur_F90 ${fleur_F90}
inpgen/set_inp.f90
inpgen/inpgen_help.f90
#inpgen/set_inp.f90
#inpgen/inpgen_help.f90
inpgen/closure.f90
)
......@@ -16,8 +16,8 @@ CONTAINS
SUBROUTINE r_inpXML(&
atoms,obsolete,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,xmlElectronStates,&
xmlPrintCoreStates,xmlCoreOccs,atomTypeSpecies,speciesRepAtomType,&
noel,namex,relcor,a1,a2,a3,dtild,&
atomTypeSpecies,speciesRepAtomType,&
l_kpts)
USE iso_c_binding
......@@ -30,7 +30,7 @@ CONTAINS
USE m_inv3
USE m_spg2set
USE m_closure, ONLY : check_close
USE m_symproperties
!USE m_symproperties
USE m_calculator
USE m_constants
USE m_inpeig
......@@ -63,11 +63,8 @@ CONTAINS
TYPE(t_coreSpecInput),INTENT(OUT) :: coreSpecInput
TYPE(t_wann) ,INTENT(INOUT) :: wann
LOGICAL, INTENT(OUT) :: l_kpts
INTEGER, ALLOCATABLE, INTENT(INOUT) :: xmlElectronStates(:,:)
INTEGER, ALLOCATABLE, INTENT(INOUT) :: atomTypeSpecies(:)
INTEGER, ALLOCATABLE, INTENT(INOUT) :: speciesRepAtomType(:)
REAL, ALLOCATABLE, INTENT(INOUT) :: xmlCoreOccs(:,:,:)
LOGICAL, ALLOCATABLE, INTENT(INOUT) :: xmlPrintCoreStates(:,:)
CHARACTER(len=3), ALLOCATABLE, INTENT(INOUT) :: noel(:)
CHARACTER(len=4), INTENT(OUT) :: namex
CHARACTER(len=12), INTENT(OUT) :: relcor
......@@ -102,21 +99,16 @@ CONTAINS
CHARACTER(len=20) :: mixingScheme
CHARACTER(len=10) :: loType
LOGICAL :: kptGamma, l_relcor,ldummy
INTEGER :: iAtomType, startCoreStates, endCoreStates
INTEGER :: iAtomType
CHARACTER(len=100) :: xPosString, yPosString, zPosString
CHARACTER(len=200) :: coreStatesString
! REAL :: tempTaual(3,atoms%nat)
REAL :: coreStateOccs(29,2)
INTEGER :: coreStateNprnc(29), coreStateKappa(29)
INTEGER :: speciesXMLElectronStates(29)
REAL :: speciesXMLCoreOccs(2,29)
LOGICAL :: speciesXMLPrintCoreStates(29)
TYPE(t_econfig) :: econf
INTEGER :: iType, iLO, iSpecies, lNumCount, nNumCount, iLLO, jsp, j, l, absSum, numTokens
INTEGER :: numberNodes, nodeSum, numSpecies, n2spg, n1, n2, ikpt, iqpt
INTEGER :: atomicNumber, coreStates, gridPoints, lmax, lnonsphr, lmaxAPW
INTEGER :: atomicNumber, gridPoints, lmax, lnonsphr, lmaxAPW
INTEGER :: latticeDef, symmetryDef, nop48, firstAtomOfType, errorStatus
INTEGER :: loEDeriv, ntp1, ios, ntst, jrc, minNeigd, providedCoreStates, providedStates
INTEGER :: loEDeriv, ntp1, ios, ntst, jrc, minNeigd
INTEGER :: nv, nv2, kq1, kq2, kq3, nprncTemp, kappaTemp, tempInt
INTEGER :: ldau_l(4), numVac, numU
INTEGER :: speciesEParams(0:3)
......@@ -216,7 +208,7 @@ CONTAINS
ALLOCATE(atoms%dx(atoms%ntype))
ALLOCATE(atoms%lmax(atoms%ntype))
ALLOCATE(atoms%nlo(atoms%ntype))
ALLOCATE(atoms%ncst(atoms%ntype))
ALLOCATE(atoms%econf(atoms%ntype))
ALLOCATE(atoms%lnonsph(atoms%ntype))
ALLOCATE(atoms%nflip(atoms%ntype))
ALLOCATE(atoms%l_geo(atoms%ntype))
......@@ -228,7 +220,6 @@ CONTAINS
ALLOCATE(atoms%label(atoms%nat))
ALLOCATE(atoms%pos(3,atoms%nat))
ALLOCATE(atoms%rmt(atoms%ntype))
ALLOCATE(atoms%numStatesProvided(atoms%ntype))
ALLOCATE(atoms%namex(atoms%ntype))
ALLOCATE(atoms%icorr(atoms%ntype))
ALLOCATE(atoms%igrd(atoms%ntype))
......@@ -253,14 +244,7 @@ CONTAINS
atomTypeSpecies = -1
speciesRepAtomType = -1
DEALLOCATE(xmlElectronStates,xmlPrintCoreStates,xmlCoreOccs)
ALLOCATE(xmlElectronStates(29,atoms%ntype))
ALLOCATE(xmlPrintCoreStates(29,atoms%ntype))
ALLOCATE(xmlCoreOccs(2,29,atoms%ntype))
xmlElectronStates = noState_const
xmlPrintCoreStates = .FALSE.
xmlCoreOccs = 0.0
ALLOCATE (kpts%ntetra(4,kpts%ntet),kpts%voltet(kpts%ntet))
ALLOCATE (wannAtomList(atoms%nat))
......@@ -1158,31 +1142,11 @@ input%preconditioning_param = evaluateFirstOnly(xmlGetAttributeValue('/fleurInpu
! Construction of missing symmetry information
IF ((symmetryDef.EQ.2).OR.(symmetryDef.EQ.3)) THEN
nop48 = 48
ALLOCATE (invOps(sym%nop),multtab(sym%nop,sym%nop),optype(nop48))
CALL check_close(sym%nop,sym%mrot,sym%tau,&
& multtab,invOps,optype)
CALL symproperties(optype,input%film,sym%nop,multtab,cell%amat,&
& sym%symor,sym%mrot,sym%tau,&
& invSym,sym%invs,sym%zrfs,sym%invs2,sym%nop,sym%nop2)
DEALLOCATE(invOps,multtab,optype)
IF (.NOT.input%film) sym%nop2=sym%nop
IF (input%film) THEN
DO n = 1, sym%nop
DO i = 1, 3
IF (ABS(sym%tau(i,n)) > 0.00001) THEN
CALL juDFT_error("nonsymmorphic symmetries not yet implemented for films!",calledby ="r_inpXML")
ENDIF
END DO
END DO
END IF
CALL sym%init(cell,input%film)
END IF
sym%invs2 = sym%invs.AND.sym%zrfs
ALLOCATE (sym%invarop(atoms%nat,sym%nop),sym%invarind(atoms%nat))
ALLOCATE (sym%multab(sym%nop,sym%nop),sym%invtab(sym%nop))
ALLOCATE (sym%invsatnr(atoms%nat),sym%d_wgn(-3:3,-3:3,3,sym%nop))
ALLOCATE (sym%invsatnr(atoms%nat))
!some settings for film calculations
vacuum%nmzd = 250
......@@ -1326,7 +1290,6 @@ input%preconditioning_param = evaluateFirstOnly(xmlGetAttributeValue('/fleurInpu
ALLOCATE (speciesNLO(numSpecies))
ALLOCATE(atoms%speciesName(numSpecies))
atoms%numStatesProvided = 0
atoms%lapw_l(:) = -1
atoms%n_u = 0
......@@ -1338,7 +1301,6 @@ input%preconditioning_param = evaluateFirstOnly(xmlGetAttributeValue('/fleurInpu
WRITE(xPathA,*) '/fleurInput/atomSpecies/species[',iSpecies,']'
atoms%speciesName(iSpecies) = TRIM(ADJUSTL(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@name')))
atomicNumber = evaluateFirstIntOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@atomicNumber'))
coreStates = evaluateFirstIntOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@coreStates'))
magMom = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@magMom'))
flipSpin = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@flipSpin'))
......@@ -1413,7 +1375,6 @@ input%preconditioning_param = evaluateFirstOnly(xmlGetAttributeValue('/fleurInpu
atoms%dx(iType) = logIncrement
atoms%lmax(iType) = lmax
atoms%nlo(iType) = speciesNLO(iSpecies)
atoms%ncst(iType) = coreStates
atoms%lnonsph(iType) = lnonsphr
atoms%lapw_l(iType) = lmaxAPW
IF (flipSpin) THEN
......@@ -1451,10 +1412,7 @@ input%preconditioning_param = evaluateFirstOnly(xmlGetAttributeValue('/fleurInpu
DIMENSION%nstd = 29
ALLOCATE(atoms%coreStateOccs(DIMENSION%nstd,2,atoms%ntype)); atoms%coreStateOccs=0.0
ALLOCATE(atoms%coreStateNprnc(DIMENSION%nstd,atoms%ntype))
ALLOCATE(atoms%coreStateKappa(DIMENSION%nstd,atoms%ntype))
CALL enpara%init(atoms,input%jspins)
enpara%evac0(:,:) = evac0Temp(:,:)
......@@ -1500,73 +1458,20 @@ input%preconditioning_param = evaluateFirstOnly(xmlGetAttributeValue('/fleurInpu
! Explicitely provided core configurations
coreConfigPresent = .FALSE.
providedCoreStates = 0
providedStates = 0
coreStateOccs = 0.0
speciesXMLElectronStates = noState_const
speciesXMLCoreOccs = -1.0
speciesXMLPrintCoreStates = .FALSE.
WRITE(xPathA,*) '/fleurInput/atomSpecies/species[',iSpecies,']/electronConfig'
numberNodes = xmlGetNumberOfNodes(TRIM(ADJUSTL(xPathA)))
WRITE(xPathA,*) '/fleurInput/atomSpecies/species[',iSpecies,']'
numberNodes = xmlGetNumberOfNodes(TRIM(ADJUSTL(xPathA))//'/electronConfig')
IF (numberNodes.EQ.1) THEN
coreConfigPresent = .TRUE.
valueString = xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/coreConfig')
token = popFirstStringToken(valueString)
DO WHILE (token.NE.' ')
IF (token(1:1).EQ.'[') THEN
DO i = 1, 6
IF (TRIM(ADJUSTL(token)).EQ.nobleGasConfigList_const(i)) THEN