Commit a640aae8 authored by Daniel Wortmann's avatar Daniel Wortmann

Many bugfixes and missing initalizations

parent a324e4cc
...@@ -113,7 +113,7 @@ ...@@ -113,7 +113,7 @@
COMPLEX,INTENT (INOUT) :: rhtxy(vacuum%nmzxyd,oneD%odi%n2d-1,2,input%jspins) 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) :: rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
REAL, INTENT (INOUT) :: rht(vacuum%nmzd,2,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 .. ! .. Local Scalars ..
COMPLEX czero,carg,VALUE,slope,c_ph COMPLEX czero,carg,VALUE,slope,c_ph
...@@ -127,7 +127,7 @@ ...@@ -127,7 +127,7 @@
! .. Local Arrays .. ! .. Local Arrays ..
COMPLEX, ALLOCATABLE :: qpwc(:) COMPLEX, ALLOCATABLE :: qpwc(:)
REAL acoff(atoms%ntype),alpha(atoms%ntype),rho_out(2) 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) INTEGER mshc(atoms%ntype)
REAL fJ(-oneD%odi%M:oneD%odi%M),dfJ(-oneD%odi%M:oneD%odi%M) REAL fJ(-oneD%odi%M:oneD%odi%M),dfJ(-oneD%odi%M:oneD%odi%M)
! .. ! ..
...@@ -174,7 +174,7 @@ ...@@ -174,7 +174,7 @@
! (2) cut_off core tails from noise ! (2) cut_off core tails from noise
! !
#ifdef CPP_MPI #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 #endif
nloop: DO n = 1 , atoms%ntype nloop: DO n = 1 , atoms%ntype
IF ((atoms%econf(n)%num_core_states.GT.0).OR.l_st) THEN IF ((atoms%econf(n)%num_core_states.GT.0).OR.l_st) THEN
...@@ -182,13 +182,13 @@ ...@@ -182,13 +182,13 @@
rat(j,n) = atoms%rmsh(j,n) rat(j,n) = atoms%rmsh(j,n)
ENDDO ENDDO
dxx = EXP(atoms%dx(n)) 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 rat(j,n) = rat(j-1,n)*dxx
ENDDO 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)) rh(j,n) = rh(j,n)/ (fpi_const*rat(j,n)*rat(j,n))
ENDDO 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 IF ( rh(j,n) .GT. tol_14 ) THEN
mshc(n) = j mshc(n) = j
CYCLE nloop CYCLE nloop
...@@ -493,11 +493,11 @@ ...@@ -493,11 +493,11 @@
type(t_atoms) ,intent(in) :: atoms type(t_atoms) ,intent(in) :: atoms
integer ,intent(in) :: mshc(atoms%ntype) integer ,intent(in) :: mshc(atoms%ntype)
real ,intent(in) :: alpha(atoms%ntype), tol_14 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) real ,intent(in) :: acoff(atoms%ntype)
type(t_stars) ,intent(in) :: stars type(t_stars) ,intent(in) :: stars
integer ,intent(in) :: method2 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_cell) ,intent(in) :: cell
type(t_oneD) ,intent(in) :: oneD type(t_oneD) ,intent(in) :: oneD
type(t_sym) ,intent(in) :: sym type(t_sym) ,intent(in) :: sym
...@@ -539,7 +539,7 @@ ...@@ -539,7 +539,7 @@
! (1) Form factor for each atom type ! (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), & atoms%rmt(n),atoms%jri(n),atoms%dx(n),mshc(n),rat(:,n), &
rh(:,n),alpha(n),stars,cell,acoff(n),qf) rh(:,n),alpha(n),stars,cell,acoff(n),qf)
...@@ -668,7 +668,7 @@ ...@@ -668,7 +668,7 @@
end subroutine StructureConst_forAtom 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,& rmt,jri,dx,mshc,rat,&
rh,alpha,stars,cell,acoff,qf) rh,alpha,stars,cell,acoff,qf)
...@@ -677,14 +677,14 @@ ...@@ -677,14 +677,14 @@
USE m_rcerf USE m_rcerf
USE m_intgr, ONLY : intgr3,intgz0 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 real ,intent(in) :: rmt
integer ,intent(in) :: jri integer ,intent(in) :: jri
real ,intent(in) :: dx real ,intent(in) :: dx
integer ,intent(in) :: mshc integer ,intent(in) :: mshc
real ,intent(in) :: rat(DIMENSION%msh) real ,intent(in) :: rat(msh)
real ,intent(in) :: rh(DIMENSION%msh) real ,intent(in) :: rh(msh)
real ,intent(in) :: alpha real ,intent(in) :: alpha
type(t_stars) ,intent(in) :: stars type(t_stars) ,intent(in) :: stars
type(t_cell) ,intent(in) :: cell type(t_cell) ,intent(in) :: cell
...@@ -698,7 +698,7 @@ ...@@ -698,7 +698,7 @@
logical tail logical tail
! ..Local arrays ! ..Local arrays
real rhohelp(DIMENSION%msh) real rhohelp(msh)
zero = 0.0 zero = 0.0
DO k = 1,stars%ng3 DO k = 1,stars%ng3
......
...@@ -165,7 +165,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st ...@@ -165,7 +165,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
IF (noco%l_mperp) CALL denCoeffsOffdiag%addRadFunScalarProducts(atoms,f,g,flo,iType) 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 (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,& IF (l_coreSpec) CALL corespec_rme(atoms,input,iType,dimension%nstd,input%jspins,jspin,results%ef,&
dimension%msh,vTot%mt(:,0,:,:),f,g) atoms%msh,vTot%mt(:,0,:,:),f,g)
END DO END DO
DEALLOCATE (f,g,flo) DEALLOCATE (f,g,flo)
......
...@@ -49,10 +49,10 @@ SUBROUTINE cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,& ...@@ -49,10 +49,10 @@ SUBROUTINE cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,&
REAL :: seig, rhoint, momint REAL :: seig, rhoint, momint
LOGICAL, PARAMETER :: l_st=.FALSE. 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 :: qint(atoms%ntype,input%jspins)
REAL :: tec(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 results%seigc = 0.0
......
...@@ -23,7 +23,7 @@ CONTAINS ...@@ -23,7 +23,7 @@ CONTAINS
REAL, INTENT (IN) :: sume REAL, INTENT (IN) :: sume
! .. ! ..
! .. Array Arguments .. ! .. 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 (IN) :: vrs(:,:,:)!(atoms%jmtd,atoms%ntype,input%jspins)
REAL, INTENT (OUT) :: tecs(:,:)!(atoms%ntype,input%jspins) REAL, INTENT (OUT) :: tecs(:,:)!(atoms%ntype,input%jspins)
REAL, INTENT (OUT) :: qints(:,:)!(atoms%ntype,input%jspins) REAL, INTENT (OUT) :: qints(:,:)!(atoms%ntype,input%jspins)
......
...@@ -25,7 +25,7 @@ CONTAINS ...@@ -25,7 +25,7 @@ CONTAINS
! .. Array Arguments .. ! .. Array Arguments ..
REAL, INTENT(IN) :: vr(atoms%jmtd,atoms%ntype) REAL, INTENT(IN) :: vr(atoms%jmtd,atoms%ntype)
REAL, INTENT(INOUT) :: rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins) 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) :: qint(atoms%ntype,input%jspins)
REAL, INTENT(INOUT) :: tec(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) REAL, INTENT(INOUT), OPTIONAL :: EnergyDen(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
...@@ -37,9 +37,9 @@ CONTAINS ...@@ -37,9 +37,9 @@ CONTAINS
! .. ! ..
! .. Local Arrays .. ! .. Local Arrays ..
REAL rhcs(DIMENSION%msh),rhoc(DIMENSION%msh),rhoss(DIMENSION%msh),vrd(DIMENSION%msh),f(0:3) REAL rhcs(atoms%msh),rhoc(atoms%msh),rhoss(atoms%msh),vrd(atoms%msh),f(0:3)
REAL rhcs_aux(DIMENSION%msh), rhoss_aux(DIMENSION%msh) !> quantities for energy density calculations REAL rhcs_aux(atoms%msh), rhoss_aux(atoms%msh) !> quantities for energy density calculations
REAL occ(maxval(atoms%econf%num_states)),a(DIMENSION%msh),b(DIMENSION%msh),ain(DIMENSION%msh),ahelp(DIMENSION%msh) 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) REAL occ_h(maxval(atoms%econf%num_states),2)
INTEGER kappa(maxval(atoms%econf%num_states)),nprnc(maxval(atoms%econf%num_states)) INTEGER kappa(maxval(atoms%econf%num_states)),nprnc(maxval(atoms%econf%num_states))
CHARACTER(LEN=20) :: attributes(6) CHARACTER(LEN=20) :: attributes(6)
...@@ -53,7 +53,7 @@ CONTAINS ...@@ -53,7 +53,7 @@ CONTAINS
DO n = 1,atoms%ntype DO n = 1,atoms%ntype
rnot = atoms%rmsh(1,n) ; dxx = atoms%dx(n) rnot = atoms%rmsh(1,n) ; dxx = atoms%dx(n)
ncmsh = NINT( LOG( (atoms%rmt(n)+10.0)/rnot ) / dxx + 1 ) 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 ! ---> update spherical charge density
DO i = 1,atoms%jri(n) DO i = 1,atoms%jri(n)
rhoc(i) = rhc(i,n,jspin) rhoc(i) = rhc(i,n,jspin)
...@@ -93,7 +93,7 @@ CONTAINS ...@@ -93,7 +93,7 @@ CONTAINS
rnot = atoms%rmsh(1,jatom) rnot = atoms%rmsh(1,jatom)
d = EXP(atoms%dx(jatom)) d = EXP(atoms%dx(jatom))
ncmsh = NINT( LOG( (atoms%rmt(jatom)+10.0)/rnot ) / dxx + 1 ) 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)) rn = rnot* (d** (ncmsh-1))
WRITE (6,FMT=8000) z,rnot,dxx,atoms%jri(jatom) WRITE (6,FMT=8000) z,rnot,dxx,atoms%jri(jatom)
DO j = 1,atoms%jri(jatom) DO j = 1,atoms%jri(jatom)
...@@ -186,7 +186,7 @@ CONTAINS ...@@ -186,7 +186,7 @@ CONTAINS
ENDIF ENDIF
rhc(1:ncmsh,jatom,jspin) = rhoss(1:ncmsh) / input%jspins 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 seig = seig + atoms%neq(jatom)*sume
DO i = 1,nm DO i = 1,nm
......
...@@ -23,7 +23,7 @@ CONTAINS ...@@ -23,7 +23,7 @@ CONTAINS
! .. Array Arguments .. ! .. Array Arguments ..
REAL , INTENT (IN) :: vrs(atoms%jmtd,atoms%ntype,input%jspins) 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 (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 .. ! .. Local Scalars ..
REAL dxx,rnot,sume,t2,t2b,z,t1,rr,d,v1,v2 REAL dxx,rnot,sume,t2,t2b,z,t1,rr,d,v1,v2
...@@ -31,9 +31,9 @@ CONTAINS ...@@ -31,9 +31,9 @@ CONTAINS
LOGICAL exetab LOGICAL exetab
! .. ! ..
! .. Local Arrays .. ! .. Local Arrays ..
REAL br(atoms%jmtd,atoms%ntype),brd(DIMENSION%msh),etab(100,atoms%ntype),& REAL br(atoms%jmtd,atoms%ntype),brd(atoms%msh),etab(100,atoms%ntype),&
rhcs(atoms%jmtd,atoms%ntype,input%jspins),rhochr(DIMENSION%msh),rhospn(DIMENSION%msh),& rhcs(atoms%jmtd,atoms%ntype,input%jspins),rhochr(atoms%msh),rhospn(atoms%msh),&
tecs(atoms%ntype,input%jspins),vr(atoms%jmtd,atoms%ntype),vrd(DIMENSION%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) INTEGER nkmust(atoms%ntype),ntab(100,atoms%ntype),ltab(100,atoms%ntype)
! .. ! ..
...@@ -76,7 +76,7 @@ CONTAINS ...@@ -76,7 +76,7 @@ CONTAINS
CALL etabinit(atoms,DIMENSION,input, vr, etab,ntab,ltab,nkmust) CALL etabinit(atoms,DIMENSION,input, vr, etab,ntab,ltab,nkmust)
END IF END IF
! !
ncmsh = DIMENSION%msh ncmsh = atoms%msh
seig = 0. seig = 0.
! ---> set up densities ! ---> set up densities
DO jatom = 1,atoms%ntype DO jatom = 1,atoms%ntype
...@@ -125,7 +125,7 @@ CONTAINS ...@@ -125,7 +125,7 @@ CONTAINS
z = atoms%zatom(jatom) z = atoms%zatom(jatom)
dxx = atoms%dx(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) etab(1,jatom),ntab(1,jatom),ltab(1,jatom), sume,rhochr,rhospn)
seig = seig + atoms%neq(jatom)*sume seig = seig + atoms%neq(jatom)*sume
...@@ -144,12 +144,12 @@ CONTAINS ...@@ -144,12 +144,12 @@ CONTAINS
END DO END DO
END IF END IF
IF (input%jspins.EQ.2) THEN 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,input%jspins) = (rhochr(j)+rhospn(j))*0.5
rhc(j,jatom,1) = (rhochr(j)-rhospn(j))*0.5 rhc(j,jatom,1) = (rhochr(j)-rhospn(j))*0.5
ENDDO ENDDO
ELSE ELSE
DO j = 1,DIMENSION%msh DO j = 1,atoms%msh
rhc(j,jatom,1) = rhochr(j) rhc(j,jatom,1) = rhochr(j)
END DO END DO
END IF END IF
......
...@@ -39,14 +39,14 @@ CONTAINS ...@@ -39,14 +39,14 @@ CONTAINS
! .. ! ..
! .. Local Arrays .. ! .. Local Arrays ..
INTEGER kappa(maxval(atoms%econf%num_states)),nprnc(maxval(atoms%econf%num_states)) 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) 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) c = c_light(1.0)
! !
WRITE (6,FMT=8020) WRITE (6,FMT=8020)
! !
ncmsh = DIMENSION%msh ncmsh = atoms%msh
! ---> set up densities ! ---> set up densities
DO jatom = 1,atoms%ntype DO jatom = 1,atoms%ntype
z = atoms%zatom(jatom) z = atoms%zatom(jatom)
...@@ -68,10 +68,10 @@ CONTAINS ...@@ -68,10 +68,10 @@ CONTAINS
rr = atoms%rmt(jatom) rr = atoms%rmt(jatom)
d = EXP(atoms%dx(jatom)) d = EXP(atoms%dx(jatom))
ELSE ELSE
t2 = vrd(atoms%jri(jatom))/ (atoms%jri(jatom)-DIMENSION%msh) t2 = vrd(atoms%jri(jatom))/ (atoms%jri(jatom)-atoms%msh)
ENDIF ENDIF
IF (atoms%jri(jatom).LT.DIMENSION%msh) THEN IF (atoms%jri(jatom).LT.atoms%msh) THEN
DO i = atoms%jri(jatom) + 1,DIMENSION%msh DO i = atoms%jri(jatom) + 1,atoms%msh
if (input%l_core_confpot) THEN if (input%l_core_confpot) THEN
rr = d*rr rr = d*rr
vrd(i) = rr*( t2 + rr*t1 ) vrd(i) = rr*( t2 + rr*t1 )
...@@ -89,7 +89,7 @@ CONTAINS ...@@ -89,7 +89,7 @@ CONTAINS
weight = 2*fj + 1.e0 weight = 2*fj + 1.e0
fl = fj + (.5e0)*isign(1,kappa(korb)) fl = fj + (.5e0)*isign(1,kappa(korb))
e = -2* (z/ (fn+fl))**2 e = -2* (z/ (fn+fl))**2
CALL differ(fn,fl,fj,c,z,dxx,rnot,rn,d,DIMENSION%msh,vrd,& CALL differ(fn,fl,fj,c,z,dxx,rnot,rn,d,atoms%msh,vrd,&
e, a,b,ierr) e, a,b,ierr)
IF (ierr/=0) CALL juDFT_error("error in core-levels",calledby="etabinit") IF (ierr/=0) CALL juDFT_error("error in core-levels",calledby="etabinit")
WRITE (6,FMT=8010) fn,fl,fj,e,weight WRITE (6,FMT=8010) fn,fl,fj,e,weight
......
...@@ -35,6 +35,7 @@ MODULE m_types_atoms ...@@ -35,6 +35,7 @@ MODULE m_types_atoms
INTEGER ::n_u INTEGER ::n_u
! dimensions ! dimensions
INTEGER :: jmtd INTEGER :: jmtd
INTEGER :: msh=0 !core state mesh was in dimension
!No of element !No of element
INTEGER, ALLOCATABLE ::nz(:) INTEGER, ALLOCATABLE ::nz(:)
!atoms per type !atoms per type
...@@ -97,6 +98,7 @@ MODULE m_types_atoms ...@@ -97,6 +98,7 @@ MODULE m_types_atoms
INTEGER, ALLOCATABLE :: relax(:, :) !<(3,ntype) INTEGER, ALLOCATABLE :: relax(:, :) !<(3,ntype)
INTEGER, ALLOCATABLE :: nflip(:) !<flip magnetisation of this atom INTEGER, ALLOCATABLE :: nflip(:) !<flip magnetisation of this atom
CONTAINS CONTAINS
PROCEDURE :: init=>init_atoms
PROCEDURE :: nsp => calc_nsp_atom PROCEDURE :: nsp => calc_nsp_atom
PROCEDURE :: same_species PROCEDURE :: same_species
PROCEDURE :: read_xml => read_xml_atoms PROCEDURE :: read_xml => read_xml_atoms
...@@ -118,14 +120,15 @@ MODULE m_types_atoms ...@@ -118,14 +120,15 @@ MODULE m_types_atoms
rank=0 rank=0
end if end if
call mpi_bc(this% ntype,rank,mpi_comm) call mpi_bc(this%ntype,rank,mpi_comm)
call mpi_bc(this% nat,rank,mpi_comm) call mpi_bc(this%nat,rank,mpi_comm)
call mpi_bc(this%nlod,rank,mpi_comm) call mpi_bc(this%nlod,rank,mpi_comm)
call mpi_bc(this%llod,rank,mpi_comm) call mpi_bc(this%llod,rank,mpi_comm)
call mpi_bc(this%nlotot,rank,mpi_comm) call mpi_bc(this%nlotot,rank,mpi_comm)
call mpi_bc(this% lmaxd,rank,mpi_comm) call mpi_bc(this%lmaxd,rank,mpi_comm)
call mpi_bc(this%n_u,rank,mpi_comm) call mpi_bc(this%n_u,rank,mpi_comm)
call mpi_bc(this% jmtd,rank,mpi_comm) call mpi_bc(this%jmtd,rank,mpi_comm)
call mpi_bc(this%msh,rank,mpi_comm)
call mpi_bc(this%nz,rank,mpi_comm) call mpi_bc(this%nz,rank,mpi_comm)
call mpi_bc(this%neq,rank,mpi_comm) call mpi_bc(this%neq,rank,mpi_comm)
call mpi_bc(this%jri,rank,mpi_comm) call mpi_bc(this%jri,rank,mpi_comm)
...@@ -222,7 +225,7 @@ MODULE m_types_atoms ...@@ -222,7 +225,7 @@ MODULE m_types_atoms
ALLOCATE(this%lda_u(4*this%ntype)) ALLOCATE(this%lda_u(4*this%ntype))
ALLOCATE(this%bmu(this%ntype)) ALLOCATE(this%bmu(this%ntype))
ALLOCATE(this%relax(3,this%ntype)) ALLOCATE(this%relax(3,this%ntype))
ALLOCATE(this%neq(this%ntype)) ALLOCATE(this%neq(this%ntype));this%neq=0
ALLOCATE(this%taual(3,this%nat)) ALLOCATE(this%taual(3,this%nat))
ALLOCATE(this%label(this%nat)) ALLOCATE(this%label(this%nat))
ALLOCATE(this%pos(3,this%nat)) ALLOCATE(this%pos(3,this%nat))
...@@ -231,8 +234,10 @@ MODULE m_types_atoms ...@@ -231,8 +234,10 @@ MODULE m_types_atoms
ALLOCATE(this%ncv(this%ntype)) ! For what is this? ALLOCATE(this%ncv(this%ntype)) ! For what is this?
ALLOCATE(this%lapw_l(this%ntype)) ! Where do I put this? ALLOCATE(this%lapw_l(this%ntype)) ! Where do I put this?
ALLOCATE(this%llo(MAXVAL(xml%get_nlo()),this%ntype)) ALLOCATE(this%llo(MAXVAL(xml%get_nlo()),this%ntype))
ALLOCATE(this%speciesname(this%ntype))
this%lapw_l(:) = -1 this%lapw_l(:) = -1
this%n_u = 0 this%n_u = 0
na=0
DO n = 1, this%ntype DO n = 1, this%ntype
!in Species: !in Species:
!@name,element,atomicNumber,coreStates !@name,element,atomicNumber,coreStates
...@@ -241,6 +246,7 @@ MODULE m_types_atoms ...@@ -241,6 +246,7 @@ MODULE m_types_atoms
!optional: energyParameters,prodBasis,special,force,electronConfig,nocoParams,ldaU(up to 4),lo(as many as needed) !optional: energyParameters,prodBasis,special,force,electronConfig,nocoParams,ldaU(up to 4),lo(as many as needed)
xpathg=xml%groupPath(n) xpathg=xml%groupPath(n)
xpaths=xml%speciesPath(n) xpaths=xml%speciesPath(n)
this%speciesname(n)=trim(adjustl(xml%getAttributeValue(TRIM(ADJUSTL(xPathg))//'/@species')))
this%nz(n)=evaluateFirstIntOnly(xml%getAttributeValue(TRIM(ADJUSTL(xPaths))//'/@atomicNumber')) this%nz(n)=evaluateFirstIntOnly(xml%getAttributeValue(TRIM(ADJUSTL(xPaths))//'/@atomicNumber'))
IF (this%nz(n).EQ.0) THEN IF (this%nz(n).EQ.0) THEN
WRITE(*,*) 'Note: Replacing atomic number 0 by 1.0e-10 on atom type ', n WRITE(*,*) 'Note: Replacing atomic number 0 by 1.0e-10 on atom type ', n
...@@ -332,7 +338,51 @@ MODULE m_types_atoms ...@@ -332,7 +338,51 @@ MODULE m_types_atoms
END DO END DO
END IF END IF
END IF END IF
! Read in atom positions
numberNodes = xml%getNumberOfNodes(TRIM(ADJUSTL(xPathg))//'/relPos')
DO i = 1, numberNodes
this%neq(n)=this%neq(n)+1
na = na + 1
WRITE(xPath,*) TRIM(ADJUSTL(xPathg)),'/relPos[',i,']'
IF(xml%getNumberOfNodes(TRIM(ADJUSTL(xPath))//'/@label').NE.0) THEN
this%label(na) = xml%getAttributeValue(TRIM(ADJUSTL(xPath))//'/@label')
ELSE
WRITE(this%label(na),'(i0)') na
END IF
valueString = xml%getAttributeValue(TRIM(ADJUSTL(xPath)))
this%taual(1,na) = evaluatefirst(valueString)
this%taual(2,na) = evaluatefirst(valueString)
this%taual(3,na) = evaluatefirst(valueString)
this%pos(:,na)=this%taual(:,na) !Use as flag that no rescaling is needed in init
END DO
numberNodes = xml%getNumberOfNodes(TRIM(ADJUSTL(xPathg))//'/absPos')
DO i = 1, numberNodes
na = na + 1
STOP 'absPos not yet implemented!'
END DO
numberNodes = xml%getNumberOfNodes(TRIM(ADJUSTL(xPathg))//'/filmPos')
DO i = 1, numberNodes
this%neq(n)=this%neq(n)+1
na = na + 1
WRITE(xPath,*) TRIM(ADJUSTL(xPathg)),'/filmPos[',i,']'
IF(xml%getNumberOfNodes(TRIM(ADJUSTL(xPath))//'/@label').NE.0) THEN
this%label(na) = xml%getAttributeValue(TRIM(ADJUSTL(xPath))//'/@label')
ELSE
WRITE(this%label(na),'(i0)') na
END IF
valueString = xml%getAttributeValue(TRIM(ADJUSTL(xPath)))
this%taual(1,na) = evaluatefirst(valueString)
this%taual(2,na) = evaluatefirst(valueString)
this%taual(3,na) = evaluatefirst(valueString)
this%pos(1:2,na)=this%taual(1:2,na) !Use as flag that no rescaling is needed in init
this%pos(3,na)=this%taual(3,na)+1
END DO
END DO END DO
this%nlotot = 0 this%nlotot = 0
...@@ -346,7 +396,7 @@ MODULE m_types_atoms ...@@ -346,7 +396,7 @@ MODULE m_types_atoms
ALLOCATE(this%lo1l(0:this%llod,this%ntype)) ALLOCATE(this%lo1l(0:this%llod,this%ntype))
ALLOCATE(this%nlol(0:this%llod,this%ntype)) ALLOCATE(this%nlol(0:this%llod,this%ntype))