...
 
Commits (42)
......@@ -12,13 +12,15 @@ include("cmake/CompilerConfig.txt")
include("cmake/Generate_Schema.cmake")
add_subdirectory("fleurinput")
include("cmake/Files_and_Targets.txt")
include("cmake/filespecific.cmake")
include("cmake/ReportConfig.txt")
add_subdirectory("inpgen2")
#install(TARGETS fleur inpgen DESTINATION bin)
......
......@@ -113,7 +113,7 @@
COMPLEX,INTENT (INOUT) :: rhtxy(vacuum%nmzxyd,oneD%odi%n2d-1,2,input%jspins)
REAL, INTENT (INOUT) :: rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
REAL, INTENT (INOUT) :: rht(vacuum%nmzd,2,input%jspins)
REAL, INTENT (INOUT) :: rh(DIMENSION%msh,atoms%ntype)
REAL, INTENT (INOUT) :: rh(atoms%msh,atoms%ntype)
! ..
! .. Local Scalars ..
COMPLEX czero,carg,VALUE,slope,c_ph
......@@ -127,7 +127,7 @@
! .. Local Arrays ..
COMPLEX, ALLOCATABLE :: qpwc(:)
REAL acoff(atoms%ntype),alpha(atoms%ntype),rho_out(2)
REAL rat(DIMENSION%msh,atoms%ntype)
REAL rat(atoms%msh,atoms%ntype)
INTEGER mshc(atoms%ntype)
REAL fJ(-oneD%odi%M:oneD%odi%M),dfJ(-oneD%odi%M:oneD%odi%M)
! ..
......@@ -174,21 +174,21 @@
! (2) cut_off core tails from noise
!
#ifdef CPP_MPI
CALL MPI_BCAST(rh,DIMENSION%msh*atoms%ntype,CPP_MPI_REAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(rh,atoms%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
dxx = EXP(atoms%dx(n))
DO j = atoms%jri(n) + 1 , DIMENSION%msh
DO j = atoms%jri(n) + 1 , atoms%msh
rat(j,n) = rat(j-1,n)*dxx
ENDDO
DO j = atoms%jri(n) - 1 , DIMENSION%msh
DO j = atoms%jri(n) - 1 , atoms%msh
rh(j,n) = rh(j,n)/ (fpi_const*rat(j,n)*rat(j,n))
ENDDO
DO j = DIMENSION%msh , atoms%jri(n) , -1
DO j = atoms%msh , atoms%jri(n) , -1
IF ( rh(j,n) .GT. tol_14 ) THEN
mshc(n) = j
CYCLE nloop
......@@ -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)
......@@ -493,11 +493,11 @@
type(t_atoms) ,intent(in) :: atoms
integer ,intent(in) :: mshc(atoms%ntype)
real ,intent(in) :: alpha(atoms%ntype), tol_14
real ,intent(in) :: rh(DIMENSION%msh,atoms%ntype)
real ,intent(in) :: rh(atoms%msh,atoms%ntype)
real ,intent(in) :: acoff(atoms%ntype)
type(t_stars) ,intent(in) :: stars
integer ,intent(in) :: method2
real ,intent(in) :: rat(DIMENSION%msh,atoms%ntype)
real ,intent(in) :: rat(atoms%msh,atoms%ntype)
type(t_cell) ,intent(in) :: cell
type(t_oneD) ,intent(in) :: oneD
type(t_sym) ,intent(in) :: sym
......@@ -539,7 +539,7 @@
! (1) Form factor for each atom type
CALL FormFactor_forAtomType(DIMENSION,method2,n_out_p,&
CALL FormFactor_forAtomType(atoms%msh,method2,n_out_p,&
atoms%rmt(n),atoms%jri(n),atoms%dx(n),mshc(n),rat(:,n), &
rh(:,n),alpha(n),stars,cell,acoff(n),qf)
......@@ -668,7 +668,7 @@
end subroutine StructureConst_forAtom
!----------------------------------------------------------------------
subroutine FormFactor_forAtomType(DIMENSION,method2,n_out_p,&
subroutine FormFactor_forAtomType(msh,method2,n_out_p,&
rmt,jri,dx,mshc,rat,&
rh,alpha,stars,cell,acoff,qf)
......@@ -677,14 +677,14 @@
USE m_rcerf
USE m_intgr, ONLY : intgr3,intgz0
type(t_dimension),intent(in) :: DIMENSION
integer ,intent(in) :: method2, n_out_p
integer ,intent(in) :: msh,method2, n_out_p
real ,intent(in) :: rmt
integer ,intent(in) :: jri
real ,intent(in) :: dx
integer ,intent(in) :: mshc
real ,intent(in) :: rat(DIMENSION%msh)
real ,intent(in) :: rh(DIMENSION%msh)
real ,intent(in) :: rat(msh)
real ,intent(in) :: rh(msh)
real ,intent(in) :: alpha
type(t_stars) ,intent(in) :: stars
type(t_cell) ,intent(in) :: cell
......@@ -698,7 +698,7 @@
logical tail
! ..Local arrays
real rhohelp(DIMENSION%msh)
real rhohelp(msh)
zero = 0.0
DO k = 1,stars%ng3
......
......@@ -27,7 +27,7 @@ CONTAINS
INTEGER :: jsp, j, ivac, nz, n
REAL :: q2(vacuum%nmz), w, rht1(vacuum%nmzd,2,input%jspins)
COMPLEX :: x(stars%ng3)
qtot = 0.0
qistot = 0.0
DO jsp = 1,input%jspins
......@@ -103,7 +103,7 @@ CONTAINS
call tmp_potden%init(stars, atoms, sphhar, vacuum, noco, input%jspins, POTDEN_TYPE_DEN)
call init_mt_grid(input%jspins, atoms, sphhar, xcpot, sym)
do n_atm =1,atoms%ntype
call mt_from_grid(atoms, sphhar, n_atm, input%jspins, mt(:,:,n_atm), &
call mt_from_grid(atoms, sym, sphhar, n_atm, input%jspins, mt(:,:,n_atm), &
tmp_potden%mt(:,0:,n_atm,:))
do i=1,atoms%jri(n_atm)
......@@ -156,11 +156,11 @@ CONTAINS
REAL qmt(atoms%ntype,input%jspins),qvac(2,input%jspins)
INTEGER, ALLOCATABLE :: lengths(:,:)
CHARACTER(LEN=20) :: attributes(6), names(6)
CALL timestart("cdntot")
call integrate_cdn(stars,atoms,sym,vacuum,input,cell,oneD, den, &
q, qis, qmt, qvac, qtot, qistot)
IF (input%film) THEN
ALLOCATE(lengths(4+vacuum%nvac,2))
ELSE
......@@ -209,7 +209,7 @@ CONTAINS
REAL, INTENT(in) :: q(:), qis(:), qmt(:,:), qvac(:,:), qtot, qistot
character(len=*), intent(in), optional :: hint
integer :: n_mt
if(present(hint)) write (*,*) "DEN of ", hint
write (*,*) "q = ", q
......
......@@ -164,8 +164,8 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
END DO
IF (noco%l_mperp) CALL denCoeffsOffdiag%addRadFunScalarProducts(atoms,f,g,flo,iType)
IF (banddos%l_mcd) CALL mcd_init(atoms,input,dimension,vTot%mt(:,0,:,:),g,f,mcd,iType,jspin)
IF (l_coreSpec) CALL corespec_rme(atoms,input,iType,dimension%nstd,input%jspins,jspin,results%ef,&
dimension%msh,vTot%mt(:,0,:,:),f,g)
IF (l_coreSpec) CALL corespec_rme(atoms,input,iType,29,input%jspins,jspin,results%ef,&
atoms%msh,vTot%mt(:,0,:,:),f,g)
END DO
DEALLOCATE (f,g,flo)
......@@ -234,7 +234,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
! layer charge of each valence state in this k-point of the SBZ from the mt-sphere region of the film
IF (l_dosNdir) THEN
IF (PRESENT(slab)) CALL q_mt_sl(ispin,atoms,noccbd,ikpt,noccbd,skip_t,noccbd,eigVecCoeffs,usdus,slab)
IF (PRESENT(slab)) CALL q_mt_sl(ispin,atoms,sym,noccbd,ikpt,noccbd,skip_t,noccbd,eigVecCoeffs,usdus,slab)
IF (banddos%l_orb.AND.ANY((/banddos%alpha,banddos%beta,banddos%gamma/).NE.0.0)) THEN
CALL abcrot2(atoms,banddos,noccbd,eigVecCoeffs,ispin) ! rotate ab-coeffs
......@@ -264,7 +264,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
END DO
#endif
CALL cdnmt(mpi,input%jspins,atoms,sphhar,noco,jsp_start,jsp_end,&
CALL cdnmt(mpi,input%jspins,atoms,sym,sphhar,noco,jsp_start,jsp_end,&
enpara,vTot%mt(:,0,:,:),denCoeffs,usdus,orb,denCoeffsOffdiag,moments,den%mt)
IF (mpi%irank==0) THEN
IF (l_coreSpec) CALL corespec_ddscs(jspin,input%jspins)
......@@ -274,7 +274,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
8210 FORMAT (/,5x,'check continuity of cdn for spin=',i2)
CALL checkDOPAll(input,dimension,sphhar,stars,atoms,sym,vacuum,oneD,cell,den,ispin)
END IF
IF (input%l_f) CALL force_a8(input,atoms,sphhar,ispin,vTot%mt(:,:,:,ispin),den%mt,force,results)
IF (input%l_f) CALL force_a8(input,atoms,sym,sphhar,ispin,vTot%mt(:,:,:,ispin),den%mt,force,results)
END DO
CALL closeXMLElement('mtCharges')
END IF
......
......@@ -13,7 +13,7 @@ SUBROUTINE genNewNocoInp(input,atoms,noco,noco_new)
USE m_juDFT
USE m_types
USE m_constants
USE m_rwnoco
!USE m_rwnoco
IMPLICIT NONE
......@@ -47,9 +47,10 @@ SUBROUTINE genNewNocoInp(input,atoms,noco,noco_new)
iatom= iatom + atoms%neq(iType)
END DO
CALL judft_error("BUG:noco-write feature not implemented at present")
OPEN (24,file='nocoinp',form='formatted', status='unknown')
REWIND (24)
CALL rw_noco_write(atoms,noco_new, input)
!CALL rw_noco_write(atoms,noco_new, input)
CLOSE (24)
END SUBROUTINE genNewNocoInp
......
......@@ -8,13 +8,14 @@ CONTAINS
!
!***********************************************************************
!
SUBROUTINE q_mt_sl(jsp,atoms,nobd,ikpt,ne,skip_t,noccbd,eigVecCoeffs,usdus,slab)
SUBROUTINE q_mt_sl(jsp,atoms,sym,nobd,ikpt,ne,skip_t,noccbd,eigVecCoeffs,usdus,slab)
USE m_types_setup
USE m_types_usdus
USE m_types_cdnval, ONLY: t_eigVecCoeffs, t_slab
IMPLICIT NONE
TYPE(t_usdus),INTENT(IN) :: usdus
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_eigVecCoeffs),INTENT(IN) :: eigVecCoeffs
TYPE(t_slab), INTENT(INOUT) :: slab
! ..
......@@ -101,7 +102,7 @@ CONTAINS
ENDDO
natom = 1
DO ntyp = 1,atoms%ntype
IF (atoms%invsat(natom).EQ.1) THEN
IF (sym%invsat(natom).EQ.1) THEN
DO lo = 1,atoms%nlo(ntyp)
DO i = 1,ne
qlo(i,lo,ntyp) = 2*qlo(i,lo,ntyp)
......
......@@ -64,7 +64,7 @@ CONTAINS
na = 1
DO n = 1,atoms%ntype
lmx(n) = MIN( atoms%lmax(n) , l_cutoff )
ntypsy_o(n) = atoms%ntypsy(na)
ntypsy_o(n) = sym%ntypsy(na)
na = na + atoms%neq(n)
END DO
!
......
......@@ -12,7 +12,7 @@ MODULE m_abccoflo
! Philipp Kurz 99/04
!*********************************************************************
CONTAINS
SUBROUTINE abccoflo(atoms, con1,rph,cph,ylm,ntyp,na,k,nv, l_lo1,alo1,blo1,&
SUBROUTINE abccoflo(atoms,sym, con1,rph,cph,ylm,ntyp,na,k,nv, l_lo1,alo1,blo1,&
clo1, nkvec, enough,alo,blo,clo,kvec)
!
!*************** ABBREVIATIONS ***************************************
......@@ -33,6 +33,7 @@ CONTAINS
IMPLICIT NONE
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sym),INTENT(IN) :: sym
! ..
! .. Scalar Arguments ..
REAL, INTENT (IN) :: con1,cph ,rph
......@@ -81,7 +82,7 @@ CONTAINS
enough = .TRUE.
term1 = con1* ((atoms%rmt(ntyp)**2)/2)*CMPLX(rph,cph)
DO lo = 1,atoms%nlo(ntyp)
IF (atoms%invsat(na).EQ.0) THEN
IF (sym%invsat(na).EQ.0) THEN
IF ((nkvec(lo)).LT. (2*atoms%llo(lo,ntyp)+1)) THEN
enough = .FALSE.
nkvec(lo) = nkvec(lo) + 1
......@@ -105,7 +106,7 @@ CONTAINS
ENDIF
ENDIF
ELSE
IF ((atoms%invsat(na).EQ.1) .OR. (atoms%invsat(na).EQ.2)) THEN
IF ((sym%invsat(na).EQ.1) .OR. (sym%invsat(na).EQ.2)) THEN
! only invsat=1 is needed invsat=2 for testing
IF ((nkvec(lo)).LT. (2* (2*atoms%llo(lo,ntyp)+1))) THEN
enough = .FALSE.
......
......@@ -84,7 +84,7 @@ CONTAINS
acof(i,lm,na) = acof(i,lm,na) + ctmp*alo1(lo)
bcof(i,lm,na) = bcof(i,lm,na) + ctmp*blo1(lo)
ccof(m,i,lo,na) = ccof(m,i,lo,na) + ctmp*clo1(lo)
IF (atoms%invsat(na)==1.AND.noco%l_soc.AND.sym%invs) THEN
IF (sym%invsat(na)==1.AND.noco%l_soc.AND.sym%invs) THEN
ctmp = zMat%data_c(nbasf,i)*CONJG(term1)*ylm(ll1+m+1)*(-1)**(l-m)
na2 = sym%invsatnr(na)
lmp = ll1 - m
......
......@@ -59,7 +59,7 @@ CONTAINS
DO lo = 1,atoms%nlo(ntyp)
l = atoms%llo(lo,ntyp)
IF (.NOT.((s.LE.eps).AND.(l.GE.1))) THEN
IF (atoms%invsat(na).EQ.0) THEN
IF (sym%invsat(na).EQ.0) THEN
IF ((nkvec(lo,na)).LT. (2*atoms%llo(lo,ntyp)+1)) THEN
enough(na) = .FALSE.
......@@ -86,7 +86,7 @@ CONTAINS
ENDIF ! linind
ENDIF ! nkvec < 2*atoms%llo
ELSEIF (atoms%invsat(na).EQ.1) THEN
ELSEIF (sym%invsat(na).EQ.1) THEN
IF ((nkvec(lo,na)).LT. (2* (2*atoms%llo(lo,ntyp)+1))) THEN
enough(na) = .FALSE.
nkvec(lo,na) = nkvec(lo,na) + 1
......
......@@ -71,7 +71,7 @@ CONTAINS
DO lo = 1,atoms%nlo(ntyp)
l = atoms%llo(lo,ntyp)
IF (.NOT.((s.LE.eps).AND.(l.GE.1))) THEN
IF (atoms%invsat(na).EQ.0) THEN
IF (sym%invsat(na).EQ.0) THEN
IF ((nkvec(lo,na)).LT. (2*atoms%llo(lo,ntyp)+1)) THEN
enough(na) = .FALSE.
nkvec(lo,na) = nkvec(lo,na) + 1
......@@ -118,7 +118,7 @@ CONTAINS
nkvec(lo,na) = nkvec(lo,na) - 1
END IF
END IF
ELSEIF (atoms%invsat(na).EQ.1) THEN
ELSEIF (sym%invsat(na).EQ.1) THEN
IF ((nkvec(lo,na)).LT. (2* (2*atoms%llo(lo,ntyp)+1))) THEN
enough(na) = .FALSE.
nkvec(lo,na) = nkvec(lo,na) + 1
......
......@@ -127,7 +127,7 @@ CONTAINS
natom = natom + atoms%neq(i)
ENDDO
natom = natom + nn
IF ((atoms%invsat(natom).EQ.0) .OR. (atoms%invsat(natom).EQ.1)) THEN
IF ((sym%invsat(natom).EQ.0) .OR. (sym%invsat(natom).EQ.1)) THEN
!---> loop over lapws
IF (zmat%l_real) THEN
ALLOCATE ( work_r(ne) )
......@@ -201,7 +201,7 @@ CONTAINS
IF (oneD%odi%d1) THEN
inap = oneD%ods%ngopr(natom)
ELSE
nap = atoms%ngopr(natom)
nap = sym%ngopr(natom)
inap = sym%invtab(nap)
END IF
DO j = 1,3
......@@ -258,7 +258,7 @@ CONTAINS
ENDIF
IF (noco%l_soc.AND.sym%invs) THEN
IF (atoms%invsat(natom).EQ.1) THEN
IF (sym%invsat(natom).EQ.1) THEN
jatom = sym%invsatnr(natom)
lmp = ll1 - m
inv_f = (-1)**(l-m)
......@@ -317,7 +317,7 @@ CONTAINS
DO n = 1,atoms%ntype
DO nn = 1,atoms%neq(n)
iatom = iatom + 1
IF (atoms%invsat(iatom).EQ.1) THEN
IF (sym%invsat(iatom).EQ.1) THEN
jatom = sym%invsatnr(iatom)
cexp = EXP(tpi_const*ImagUnit*DOT_PRODUCT(atoms%taual(:,jatom)&
& + atoms%taual(:,iatom),lapw%bkpt))
......
......@@ -120,7 +120,7 @@ CONTAINS
! is 1 if atom natom can be mapped via inversion symmetrie and is parent atom
! is 2 if atom natom can be mapped via inversion symmetrie and is second atom
IF ((atoms%invsat(natom).EQ.0) .OR. (atoms%invsat(natom).EQ.1)) THEN
IF ((sym%invsat(natom).EQ.0) .OR. (sym%invsat(natom).EQ.1)) THEN
tmk = tpi_const* dot_product(fk(:),atoms%taual(:,natom))
phase = cmplx(cos(tmk),sin(tmk))
IF (oneD%odi%d1) THEN
......@@ -128,7 +128,7 @@ CONTAINS
! nap = ods%ngopr(natom)
! inap = ods%invtab(nap)
ELSE
nap = atoms%ngopr(natom)
nap = sym%ngopr(natom)
inap = sym%invtab(nap)
END IF
DO j = 1,3
......@@ -174,7 +174,7 @@ CONTAINS
DO n = 1,atoms%ntype
DO nn = 1,atoms%neq(n)
iatom = iatom + 1
IF (atoms%invsat(iatom).EQ.1) THEN
IF (sym%invsat(iatom).EQ.1) THEN
jatom = sym%invsatnr(iatom)
DO ilo = 1,atoms%nlo(n)
l = atoms%llo(ilo,n)
......
......@@ -47,7 +47,7 @@ SUBROUTINE calcDenCoeffs(atoms,sphhar,sym,we,noccbd,eigVecCoeffs,ispin,denCoeffs
CALL timestart("cdnval: rho(n)mtlo")
CALL rhomtlo(atoms,noccbd,we,eigVecCoeffs,denCoeffs,ispin)
CALL rhonmtlo(atoms,sphhar,noccbd,we,eigVecCoeffs,denCoeffs,ispin)
CALL rhonmtlo(atoms,sphhar,sym,noccbd,we,eigVecCoeffs,denCoeffs,ispin)
CALL timestop("cdnval: rho(n)mtlo")
END SUBROUTINE calcDenCoeffs
......
......@@ -49,10 +49,10 @@ SUBROUTINE cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,&
REAL :: seig, rhoint, momint
LOGICAL, PARAMETER :: l_st=.FALSE.
REAL :: rh(dimension%msh,atoms%ntype,input%jspins)
REAL :: rh(atoms%msh,atoms%ntype,input%jspins)
REAL :: qint(atoms%ntype,input%jspins)
REAL :: tec(atoms%ntype,input%jspins)
REAL :: rhTemp(dimension%msh,atoms%ntype,input%jspins)
REAL :: rhTemp(atoms%msh,atoms%ntype,input%jspins)
results%seigc = 0.0
......
......@@ -10,7 +10,7 @@ MODULE m_cdnmt
! Philipp Kurz 2000-02-03
!***********************************************************************
CONTAINS
SUBROUTINE cdnmt(mpi,jspd,atoms,sphhar,noco,jsp_start,jsp_end,enpara,&
SUBROUTINE cdnmt(mpi,jspd,atoms,sym,sphhar,noco,jsp_start,jsp_end,enpara,&
vr,denCoeffs,usdus,orb,denCoeffsOffdiag,moments,rho)
use m_constants,only: sfp_const
USE m_rhosphnlo
......@@ -24,6 +24,7 @@ CONTAINS
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_sphhar), INTENT(IN) :: sphhar
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_enpara), INTENT(IN) :: enpara
TYPE(t_moments), INTENT(INOUT) :: moments
......@@ -65,7 +66,7 @@ CONTAINS
!$OMP PARALLEL DEFAULT(none) &
!$OMP SHARED(usdus,rho,moments,qmtl) &
!$OMP SHARED(atoms,jsp_start,jsp_end,enpara,vr,denCoeffs,sphhar)&
!$OMP SHARED(atoms,sym,jsp_start,jsp_end,enpara,vr,denCoeffs,sphhar)&
!$OMP SHARED(orb,noco,denCoeffsOffdiag,jspd)&
!$OMP PRIVATE(itype,na,ispin,l,rho21,f,g,nodeu,noded,wronk,i,j,s,qmtllo,qmtt,nd,lh,lp,llp,cs)
IF (noco%l_mperp) THEN
......@@ -103,7 +104,7 @@ CONTAINS
qmtllo(l) = 0.0
END DO
CALL rhosphnlo(itype,atoms,sphhar,&
CALL rhosphnlo(itype,atoms,sphhar,sym,&
usdus%uloulopn(1,1,itype,ispin),usdus%dulon(1,itype,ispin),&
usdus%uulon(1,itype,ispin),enpara%ello0(1,itype,ispin),&
vr(1,itype,ispin),denCoeffs%aclo(1,itype,ispin),denCoeffs%bclo(1,itype,ispin),&
......@@ -131,7 +132,7 @@ CONTAINS
ENDIF
!-soc
!---> non-spherical components
nd = atoms%ntypsy(na)
nd = sym%ntypsy(na)
DO lh = 1,sphhar%nlh(nd)
DO l = 0,atoms%lmax(itype)
DO lp = 0,l
......@@ -196,7 +197,7 @@ CONTAINS
ENDDO
!---> non-spherical components
nd = atoms%ntypsy(na)
nd = sym%ntypsy(na)
DO lh = 1,sphhar%nlh(nd)
DO l = 0,atoms%lmax(itype)
DO lp = 0,atoms%lmax(itype)
......
......@@ -68,7 +68,7 @@ CONTAINS
nt = natom
DO na = 1,atoms%neq(nn)
nt = nt + 1
IF (atoms%ntypsy(nt).EQ.ns) THEN
IF (sym%ntypsy(nt).EQ.ns) THEN
DO nb = 1,ne
denCoeffs%uunmt(llp,lh,nn,ispin) = denCoeffs%uunmt(llp,lh,nn,ispin)&
+we(nb)*real(cconst*eigVecCoeffs%acof(nb,lm,nt,ispin)*conjg(eigVecCoeffs%acof(nb,lmp,nt,ispin)))
......
......@@ -46,7 +46,7 @@ CONTAINS
nt= natom
DO na= 1,atoms%neq(nn)
nt= nt+1
IF (atoms%ntypsy(nt)==ns) THEN
IF (sym%ntypsy(nt)==ns) THEN
DO lh = 1,sphhar%nlh(ns)
lv = sphhar%llh(lh,ns)
......@@ -90,7 +90,7 @@ CONTAINS
ENDDO ! l
ENDDO ! lh
ENDIF ! (atoms%ntypsy(nt)==ns)
ENDIF ! (sym%ntypsy(nt)==ns)
ENDDO ! na
natom= natom + atoms%neq(nn)
ENDDO ! nn
......
......@@ -15,7 +15,7 @@ MODULE m_rhonmtlo
!***********************************************************************
!
CONTAINS
SUBROUTINE rhonmtlo(atoms,sphhar,ne,we,eigVecCoeffs,denCoeffs,ispin)
SUBROUTINE rhonmtlo(atoms,sphhar,sym,ne,we,eigVecCoeffs,denCoeffs,ispin)
USE m_gaunt,ONLY:gaunt1
USE m_types
use m_constants
......@@ -24,6 +24,7 @@ CONTAINS
TYPE(t_sphhar), INTENT(IN) :: sphhar
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_eigVecCoeffs), INTENT(IN) :: eigVecCoeffs
TYPE(t_denCoeffs), INTENT(INOUT) :: denCoeffs
......@@ -46,11 +47,11 @@ CONTAINS
neqat0 = 0
DO ntyp = 1,atoms%ntype
!---> loop over the lattice harmonics
DO lh = 1,sphhar%nlh(atoms%ntypsy(neqat0+1))
lpp = sphhar%llh(lh,atoms%ntypsy(neqat0+1))
DO jmem = 1,sphhar%nmem(lh,atoms%ntypsy(neqat0+1))
mpp = sphhar%mlh(jmem,lh,atoms%ntypsy(neqat0+1))
cmv = CONJG(sphhar%clnu(jmem,lh,atoms%ntypsy(neqat0+1)))
DO lh = 1,sphhar%nlh(sym%ntypsy(neqat0+1))
lpp = sphhar%llh(lh,sym%ntypsy(neqat0+1))
DO jmem = 1,sphhar%nmem(lh,sym%ntypsy(neqat0+1))
mpp = sphhar%mlh(jmem,lh,sym%ntypsy(neqat0+1))
cmv = CONJG(sphhar%clnu(jmem,lh,sym%ntypsy(neqat0+1)))
DO lo = 1,atoms%nlo(ntyp)
l = atoms%llo(lo,ntyp)
lpmin0 = ABS(l-lpp)
......
......@@ -12,7 +12,7 @@ MODULE m_rhosphnlo
! Philipp Kurz 99/04
!***********************************************************************
CONTAINS
SUBROUTINE rhosphnlo(itype,atoms,sphhar, uloulopn,dulon,uulon,&
SUBROUTINE rhosphnlo(itype,atoms,sphhar,sym, uloulopn,dulon,uulon,&
ello,vr, aclo,bclo,cclo,acnmt,bcnmt,ccnmt,f,g, rho,qmtllo)
USE m_constants, ONLY : c_light,sfp_const
......@@ -22,6 +22,8 @@ CONTAINS
IMPLICIT NONE
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sym),INTENT(IN) :: sym
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: itype
......@@ -108,7 +110,7 @@ CONTAINS
!---> add the contribution of the local orbitals and flapw - lo cross-
!---> terms to the non-spherical chargedensity inside the muffin tins.
DO lh = 1,sphhar%nlh(atoms%ntypsy(atoms%nat))
DO lh = 1,sphhar%nlh(sym%ntypsy(atoms%nat))
DO lp = 0,atoms%lmax(itype)
DO lo = 1,atoms%nlo(itype)
DO j = 1,atoms%jri(itype)
......
......@@ -103,11 +103,11 @@ MODULE m_setabc1locdn
DO lo = 1,atoms%nlo(ntyp)
enough(natom) = .false.
l = atoms%llo(lo,ntyp)
IF (atoms%invsat(natom).EQ.0) THEN
IF (sym%invsat(natom).EQ.0) THEN
nbasf0(lo,natom) = nbasf
nbasf = nbasf + 2*l + 1
END IF
IF (atoms%invsat(natom).EQ.1) THEN
IF (sym%invsat(natom).EQ.1) THEN
nbasf0(lo,natom) = nbasf
nbasf0(lo,sym%invsatnr(natom)) = nbasf
nbasf = nbasf + 2* (2*l+1)
......
......@@ -94,11 +94,11 @@ CONTAINS
enough(natom) = .false.
nkvec(lo,natom) = 0
l = atoms%llo(lo,ntyp)
IF (atoms%invsat(natom).EQ.0) THEN
IF (sym%invsat(natom).EQ.0) THEN
nbasf0(lo,natom) = nbasf
nbasf = nbasf + 2*l + 1
END IF
IF (atoms%invsat(natom).EQ.1) THEN
IF (sym%invsat(natom).EQ.1) THEN
nbasf0(lo,natom) = nbasf
nbasf0(lo,sym%invsatnr(natom)) = nbasf
nbasf = nbasf + 2* (2*l+1)
......@@ -126,9 +126,9 @@ CONTAINS
DO ntyp = 1, atoms%ntype
DO nn = 1, atoms%neq(ntyp)
natom = natom + 1
IF ((atoms%invsat(natom).EQ.0) .OR. (atoms%invsat(natom).EQ.1)) THEN
IF ((sym%invsat(natom).EQ.0) .OR. (sym%invsat(natom).EQ.1)) THEN
DO lo = 1,atoms%nlo(ntyp)
m = ( atoms%invsat(natom) +1 ) * ( 2 * atoms%llo(lo,ntyp) + 1 )
m = ( sym%invsat(natom) +1 ) * ( 2 * atoms%llo(lo,ntyp) + 1 )
DO l = 1, m
lm = lm + 1
kvec(l,lo,natom) = lapw%kvec(l,lo,natom)
......
include_directories(include)
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)
......@@ -29,7 +31,6 @@ include(init/CMakeLists.txt)
include(ldau/CMakeLists.txt)
include(mix/CMakeLists.txt)
include(vgen/CMakeLists.txt)
include(inpgen/CMakeLists.txt)
include(docs/CMakeLists.txt)
include(mpi/CMakeLists.txt)
include(hybrid/CMakeLists.txt)
......@@ -45,38 +46,17 @@ include(kpoints/CMakeLists.txt)
include(tests/tests_old.cmake)
#include(tests/tests_new.cmake)
set(inpgen_F77 ${inpgen_F77}
inpgen/element.f inpgen/atom_input.f inpgen/crystal.f inpgen/lattice2.f inpgen/setab.f inpgen/super_check.f
inpgen/atom_sym.f inpgen/generator.f inpgen/read_record.f inpgen/soc_or_ssdw.f inpgen/symproperties.f
inpgen/bravais_symm.f inpgen/set_atom_core.f inpgen/spg_gen.f global/triang.f
inpgen/lapw_input.f inpgen/struct_input.f inpgen/write_struct.f
io/calculator.f global/ss_sym.f global/soc_sym.f math/inv3.f io/rw_symfile.f
kpoints/kptgen_hybrid.f kpoints/od_kptsgen.f kpoints/bravais.f kpoints/divi.f kpoints/brzone.f
kpoints/kptmop.f kpoints/kpttet.f init/bandstr1.F kpoints/ordstar.f kpoints/fulstar.f kpoints/kprep.f
kpoints/tetcon.f kpoints/kvecon.f init/boxdim.f global/radsra.f global/differ.f math/inwint.f
math/outint.f math/grule.f )
set(inpgen_F90 ${inpgen_F90} global/constants.f90 io/xsf_io.f90
eigen/orthoglo.F90 math/ylm4.F90 mpi/mpi_bc_tool.F90
global/sort.f90 global/chkmt.f90 inpgen/inpgen.f90 inpgen/set_inp.f90 inpgen/inpgen_help.f90 io/rw_inp.f90 global/find_enpara.f90
inpgen/closure.f90 math/intgr.F90
io/w_inpXML.f90 kpoints/julia.f90 global/utility.F90
init/compile_descr.F90 kpoints/kpoints.f90 io/xmlOutput.F90 kpoints/brzone2.f90 cdn/slab_dim.f90 cdn/slabgeom.f90 dos/nstm3.f90 cdn/int_21.f90
cdn/int_21lo.f90 cdn_mt/rhomt21.f90 cdn_mt/rhonmt21.f90 force/force_a21.F90 force/force_a21_lo.f90 force/force_a21_U.f90 force/force_a12.f90
eigen/tlmplm_store.F90 xc-pot/gaunt.f90 kpoints/unfoldBandKPTS.f90)
set(fleur_SRC ${fleur_F90} ${fleur_F77})
set_source_files_properties(${fleur_F90} PROPERTIES Fortran_FORMAT FREE)
set_source_files_properties(${fleur_F77} PROPERTIES Fortran_FORMAT FIXED)
set_source_files_properties(${inpgen_F90} PROPERTIES Fortran_FORMAT FREE)
set_source_files_properties(${inpgen_F77} PROPERTIES Fortran_FORMAT FIXED)
string(REPLACE ";" " " CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${FLEUR_PRECISION_OPTION}")
message("Flags: ${CMAKE_Fortran_FLAGS}")
set(FLEUR_LINK_LIBRARIES "${FLEUR_LINK_LIBRARIES};juDFT")
set(FLEUR_LINK_LIBRARIES "${FLEUR_LINK_LIBRARIES};juDFT;fleurinput")
include_directories("${CMAKE_CURRENT_BINARY_DIR}/fleurinput/modules/fleurinput")
if (${FLEUR_USE_SERIAL})
#Serial executables
add_executable(fleur ${fleur_SRC} ${c_filesFleur})
......@@ -95,12 +75,6 @@ if(${FLEUR_USE_MPI})
set_target_properties(fleur_MPI PROPERTIES Fortran_MODULE_DIRECTORY modules/fleur_MPI COMPILE_OPTIONS -Imodules/fleur_MPI)
endif ()
#inpgen executable
add_executable(inpgen ${inpgen_F77} ${inpgen_F90} ${juDFT_SRC_F90} ${c_filesInpgen})
target_compile_definitions(inpgen PUBLIC ${FLEUR_DEFINITIONS})
target_link_libraries(inpgen ${FLEUR_LIBRARIES})
target_link_libraries(inpgen juDFT)
set_target_properties(inpgen PROPERTIES Fortran_MODULE_DIRECTORY modules/inpgen COMPILE_OPTIONS -Imodules/inpgen)
include(cmake/docker.txt)
......
......@@ -25,5 +25,5 @@ core/ccdnup.f90
core/cored.F90
core/coredr.F90
core/etabinit.F90
core/setcor.f90
#core/setcor.f90
)
......@@ -23,7 +23,7 @@ CONTAINS
REAL, INTENT (IN) :: sume
! ..
! .. Array Arguments ..
REAL, INTENT (IN) :: rhochr(:),rhospn(:)!(dimension%msh)
REAL, INTENT (IN) :: rhochr(:),rhospn(:)!(atoms%msh)
REAL, INTENT (IN) :: vrs(:,:,:)!(atoms%jmtd,atoms%ntype,input%jspins)
REAL, INTENT (OUT) :: tecs(:,:)!(atoms%ntype,input%jspins)
REAL, INTENT (OUT) :: qints(:,:)!(atoms%ntype,input%jspins)
......
......@@ -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
......@@ -25,7 +25,7 @@ CONTAINS
! .. Array Arguments ..
REAL, INTENT(IN) :: vr(atoms%jmtd,atoms%ntype)
REAL, INTENT(INOUT) :: rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
REAL, INTENT(INOUT) :: rhc(DIMENSION%msh,atoms%ntype,input%jspins)
REAL, INTENT(INOUT) :: rhc(atoms%msh,atoms%ntype,input%jspins)
REAL, INTENT(INOUT) :: qint(atoms%ntype,input%jspins)
REAL, INTENT(INOUT) :: tec(atoms%ntype,input%jspins)
REAL, INTENT(INOUT), OPTIONAL :: EnergyDen(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
......@@ -37,11 +37,11 @@ CONTAINS
! ..
! .. Local Arrays ..
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 rhcs(atoms%msh),rhoc(atoms%msh),rhoss(atoms%msh),vrd(atoms%msh),f(0:3)
REAL rhcs_aux(atoms%msh), rhoss_aux(atoms%msh) !> quantities for energy density calculations
REAL occ(maxval(atoms%econf%num_states)),a(atoms%msh),b(atoms%msh),ain(atoms%msh),ahelp(atoms%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)
! ..
......@@ -53,7 +53,7 @@ CONTAINS
DO n = 1,atoms%ntype
rnot = atoms%rmsh(1,n) ; dxx = atoms%dx(n)
ncmsh = NINT( LOG( (atoms%rmt(n)+10.0)/rnot ) / dxx + 1 )
ncmsh = MIN( ncmsh, DIMENSION%msh )
ncmsh = MIN( ncmsh, atoms%msh )
! ---> update spherical charge density
DO i = 1,atoms%jri(n)
rhoc(i) = rhc(i,n,jspin)
......@@ -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
......@@ -90,7 +93,7 @@ CONTAINS
rnot = atoms%rmsh(1,jatom)
d = EXP(atoms%dx(jatom))
ncmsh = NINT( LOG( (atoms%rmt(jatom)+10.0)/rnot ) / dxx + 1 )
ncmsh = MIN( ncmsh, DIMENSION%msh )
ncmsh = MIN( ncmsh, atoms%msh )
rn = rnot* (d** (ncmsh-1))
WRITE (6,FMT=8000) z,rnot,dxx,atoms%jri(jatom)
DO j = 1,atoms%jri(jatom)
......@@ -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)
......@@ -183,7 +186,7 @@ CONTAINS
ENDIF
rhc(1:ncmsh,jatom,jspin) = rhoss(1:ncmsh) / input%jspins
rhc(ncmsh+1:DIMENSION%msh,jatom,jspin) = 0.0
rhc(ncmsh+1:atoms%msh,jatom,jspin) = 0.0
seig = seig + atoms%neq(jatom)*sume
DO i = 1,nm
......@@ -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)
......
......@@ -23,7 +23,7 @@ CONTAINS
! .. Array Arguments ..
REAL , INTENT (IN) :: vrs(atoms%jmtd,atoms%ntype,input%jspins)
REAL, INTENT (INOUT) :: rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
REAL, INTENT (OUT) :: rhc(DIMENSION%msh,atoms%ntype,input%jspins),qints(atoms%ntype,input%jspins)
REAL, INTENT (OUT) :: rhc(atoms%msh,atoms%ntype,input%jspins),qints(atoms%ntype,input%jspins)
! ..
! .. Local Scalars ..
REAL dxx,rnot,sume,t2,t2b,z,t1,rr,d,v1,v2
......@@ -31,9 +31,9 @@ CONTAINS
LOGICAL exetab
! ..
! .. Local Arrays ..
REAL br(atoms%jmtd,atoms%ntype),brd(DIMENSION%msh),etab(100,atoms%ntype),&
rhcs(atoms%jmtd,atoms%ntype,input%jspins),rhochr(DIMENSION%msh),rhospn(DIMENSION%msh),&
tecs(atoms%ntype,input%jspins),vr(atoms%jmtd,atoms%ntype),vrd(DIMENSION%msh)
REAL br(atoms%jmtd,atoms%ntype),brd(atoms%msh),etab(100,atoms%ntype),&
rhcs(atoms%jmtd,atoms%ntype,input%jspins),rhochr(atoms%msh),rhospn(atoms%msh),&
tecs(atoms%ntype,input%jspins),vr(atoms%jmtd,atoms%ntype),vrd(atoms%msh)
INTEGER nkmust(atoms%ntype),ntab(100,atoms%ntype),ltab(100,atoms%ntype)
! ..
......@@ -76,7 +76,7 @@ CONTAINS
CALL etabinit(atoms,DIMENSION,input, vr, etab,ntab,ltab,nkmust)
END IF
!
ncmsh = DIMENSION%msh
ncmsh = atoms%msh
seig = 0.
! ---> set up densities
DO jatom = 1,atoms%ntype
......@@ -125,7 +125,7 @@ CONTAINS
z = atoms%zatom(jatom)
dxx = atoms%dx(jatom)
CALL spratm(DIMENSION%msh,vrd,brd,z,rnot,dxx,ncmsh,&
CALL spratm(atoms%msh,vrd,brd,z,rnot,dxx,ncmsh,&
etab(1,jatom),ntab(1,jatom),ltab(1,jatom), sume,rhochr,rhospn)
seig = seig + atoms%neq(jatom)*sume
......@@ -144,12 +144,12 @@ CONTAINS
END DO
END IF
IF (input%jspins.EQ.2) THEN
DO j = 1,DIMENSION%msh
DO j = 1,atoms%msh
rhc(j,jatom,input%jspins) = (rhochr(j)+rhospn(j))*0.5
rhc(j,jatom,1) = (rhochr(j)-rhospn(j))*0.5
ENDDO
ELSE
DO j = 1,DIMENSION%msh
DO j = 1,atoms%msh
rhc(j,jatom,1) = rhochr(j)
END DO
END IF
......
......@@ -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,26 +35,25 @@ 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(atoms%msh),a(atoms%msh),b(atoms%msh)
! ..
!
c = c_light(1.0)
!
WRITE (6,FMT=8020)
!
ncmsh = DIMENSION%msh
ncmsh = atoms%msh
! ---> set up densities
DO jatom = 1,atoms%ntype
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))
......@@ -69,10 +68,10 @@ CONTAINS
rr = atoms%rmt(jatom)
d = EXP(atoms%dx(jatom))
ELSE
t2 = vrd(atoms%jri(jatom))/ (atoms%jri(jatom)-DIMENSION%msh)
t2 = vrd(atoms%jri(jatom))/ (atoms%jri(jatom)-atoms%msh)
ENDIF
IF (atoms%jri(jatom).LT.DIMENSION%msh) THEN
DO i = atoms%jri(jatom) + 1,DIMENSION%msh
IF (atoms%jri(jatom).LT.atoms%msh) THEN
DO i = atoms%jri(jatom) + 1,atoms%msh
if (input%l_core_confpot) THEN
rr = d*rr
vrd(i) = rr*( t2 + rr*t1 )
......@@ -83,14 +82,14 @@ 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
weight = 2*fj + 1.e0
fl = fj + (.5e0)*isign(1,kappa(korb))
e = -2* (z/ (fn+fl))**2
CALL differ(fn,fl,fj,c,z,dxx,rnot,rn,d,DIMENSION%msh,vrd,&