Skip to content

GitLab

fleur
fleur
Commit a640aae8 authored by Daniel Wortmann's avatar Daniel Wortmann
Browse files
Options

Many bugfixes and missing initalizations

parent a324e4cc
Hide whitespace changes
Inline Side-by-side
Showing with 174 additions and 111 deletions
cdn/cdnovlp.F90
View file @ a640aae8
......@@ -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,7 +174,7 @@
! (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%econf(n)%num_core_states.GT.0).OR.l_st) THEN
......@@ -182,13 +182,13 @@
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
......@@ -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
......
cdn/cdnval.F90
View file @ a640aae8
......@@ -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 (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)
atoms%msh,vTot%mt(:,0,:,:),f,g)
END DO
DEALLOCATE (f,g,flo)
......
cdn_mt/cdncore.F90
View file @ a640aae8
......@@ -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
......
core/ccdnup.f90
View file @ a640aae8
......@@ -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)
......
core/cored.F90
View file @ a640aae8
......@@ -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,9 +37,9 @@ 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(maxval(atoms%econf%num_states)),a(DIMENSION%msh),b(DIMENSION%msh),ain(DIMENSION%msh),ahelp(DIMENSION%msh)
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)
......@@ -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)
......@@ -93,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)
......@@ -186,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
......
core/coredr.F90
View file @ a640aae8
......@@ -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
......
core/etabinit.F90
View file @ a640aae8
......@@ -39,14 +39,14 @@ CONTAINS
! ..
! .. Local Arrays ..
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)
!
WRITE (6,FMT=8020)
!
ncmsh = DIMENSION%msh
ncmsh = atoms%msh
! ---> set up densities
DO jatom = 1,atoms%ntype
z = atoms%zatom(jatom)
......@@ -68,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 )
......@@ -89,7 +89,7 @@ CONTAINS
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,&
CALL differ(fn,fl,fj,c,z,dxx,rnot,rn,d,atoms%msh,vrd,&
e, a,b,ierr)
IF (ierr/=0) CALL juDFT_error("error in core-levels",calledby="etabinit")
WRITE (6,FMT=8010) fn,fl,fj,e,weight
......
fleurinput/types_atoms.F90
View file @ a640aae8
......@@ -35,6 +35,7 @@ MODULE m_types_atoms
INTEGER ::n_u
! dimensions
INTEGER :: jmtd
INTEGER :: msh=0 !core state mesh was in dimension
!No of element
INTEGER, ALLOCATABLE ::nz(:)
!atoms per type
......@@ -97,6 +98,7 @@ MODULE m_types_atoms
INTEGER, ALLOCATABLE :: relax(:, :) !<(3,ntype)
INTEGER, ALLOCATABLE :: nflip(:) !<flip magnetisation of this atom
CONTAINS
PROCEDURE :: init=>init_atoms
PROCEDURE :: nsp => calc_nsp_atom
PROCEDURE :: same_species
PROCEDURE :: read_xml => read_xml_atoms
......@@ -118,14 +120,15 @@ MODULE m_types_atoms
rank=0
end if
call mpi_bc(this% ntype,rank,mpi_comm)
call mpi_bc(this% nat,rank,mpi_comm)
call mpi_bc(this%ntype,rank,mpi_comm)
call mpi_bc(this%nat,rank,mpi_comm)
call mpi_bc(this%nlod,rank,mpi_comm)
call mpi_bc(this%llod,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% 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%neq,rank,mpi_comm)
call mpi_bc(this%jri,rank,mpi_comm)
......@@ -222,7 +225,7 @@ MODULE m_types_atoms
ALLOCATE(this%lda_u(4*this%ntype))
ALLOCATE(this%bmu(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%label(this%nat))
ALLOCATE(this%pos(3,this%nat))
......@@ -231,8 +234,10 @@ MODULE m_types_atoms
ALLOCATE(this%ncv(this%ntype)) ! For what is this?
ALLOCATE(this%lapw_l(this%ntype)) ! Where do I put this?
ALLOCATE(this%llo(MAXVAL(xml%get_nlo()),this%ntype))
ALLOCATE(this%speciesname(this%ntype))
this%lapw_l(:) = -1
this%n_u = 0
na=0
DO n = 1, this%ntype
!in Species:
!@name,element,atomicNumber,coreStates
......@@ -241,6 +246,7 @@ MODULE m_types_atoms
!optional: energyParameters,prodBasis,special,force,electronConfig,nocoParams,ldaU(up to 4),lo(as many as needed)
xpathg=xml%groupPath(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'))
IF (this%nz(n).EQ.0) THEN
WRITE(*,*) 'Note: Replacing atomic number 0 by 1.0e-10 on atom type ', n
......@@ -332,7 +338,51 @@ MODULE m_types_atoms
END DO
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
this%nlotot = 0
......@@ -346,7 +396,7 @@ MODULE m_types_atoms
ALLOCATE(this%lo1l(0:this%llod,this%ntype))
ALLOCATE(this%nlol(0:this%llod,this%ntype))
ALLOCATE(this%l_dulo(this%nlod,this%ntype))
DO n = 1, this%ntype
IF (this%nlo(n).GE.1) THEN
......@@ -421,7 +471,8 @@ MODULE m_types_atoms
jrc = jrc + 1
radius = radius*dr
END DO
this%msh=max(this%msh,jrc)
this%volmts(iType) = (fpi_const/3.0)*this%rmt(iType)**3
END DO
this%nlotot = 0
......@@ -431,10 +482,18 @@ MODULE m_types_atoms
END DO
END DO
this%lmaxd=maxval(this%lmax)
END SUBROUTINE read_xml_atoms
subroutine init_atoms(this,cell)
use m_types_cell
class(t_atoms),intent(inout):: this
type(t_cell),INTENT(IN) :: cell
where (abs(this%pos(3,:)-this%taual(3,:))>0.5) this%taual(3,:) = this%taual(3,:) / cell%amat(3,3)
this%pos(:,:) = matmul(cell%amat,this%taual(:,:))
end subroutine init_atoms
END MODULE m_types_atoms
fleurinput/types_econfig.F90
View file @ a640aae8
......@@ -30,16 +30,21 @@ MODULE m_types_econfig
PUBLIC :: t_econfig
CONTAINS
SUBROUTINE get_core(econf,nst,nprnc,kappa,occupation)
SUBROUTINE get_core(econf,nst,nprnc,kappa,occupation,l_valence)
CLASS(t_econfig),INTENT(IN) :: econf
INTEGER ,INTENT(out) :: nst
INTEGER ,INTENT(out) :: nprnc(:),kappa(:)
REAL ,INTENT(out) :: occupation(:,:)
LOGICAL,OPTIONAL,INTENT(IN) :: l_valence
nst=econf%num_core_states
if (present(l_valence)) then
if (l_valence) nst=econf%num_states
endif
nprnc(:nst)=econf%nprnc(:nst)
kappa(:nst)=econf%kappa(:nst)
occupation(:nst,:)=econf%occupation(:nst,:)
if (size(occupation,2)==1) occupation=occupation*2
END SUBROUTINE get_core
......@@ -242,7 +247,7 @@ CONTAINS
IF (up==-1. .AND. down==-1) THEN
!Set all defaults
econf%occupation=0.0
DO n=1,econf%num_core_states
DO n=1,econf%num_states
econf%occupation(n,:)=ABS(econf%kappa(n))
END DO
ELSE
......
hybrid/read_core.F90
View file @ a640aae8
......@@ -313,8 +313,8 @@
! - local arrays -
INTEGER :: kappa(dimension%nstd),nprnc(dimension%nstd)
REAL :: vrd(dimension%msh)
REAL :: occ(dimension%nstd),occ_h(dimension%nstd,2),a(dimension%msh),b(dimension%msh)
REAL :: vrd(atoms%msh)
REAL :: occ(dimension%nstd),occ_h(dimension%nstd,2),a(atoms%msh),b(atoms%msh)
REAL,ALLOCATABLE,SAVE:: vr0(:,:,:)
! - intrinsic functions -
......@@ -357,7 +357,7 @@
rnot = atoms%rmsh(1,itype)
d = exp(atoms%dx(itype))
ncmsh = nint( log( (atoms%rmt(itype)+10.0)/rnot ) / dxx + 1 )
ncmsh = min( ncmsh, dimension%msh )
ncmsh = min( ncmsh, atoms%msh )
rn = rnot* (d** (ncmsh-1))
nst = atoms%econf(itype)%num_core_states
......@@ -400,7 +400,7 @@
rnot = atoms%rmsh(1,itype)
d = exp(atoms%dx(itype))
ncmsh = nint( log( (atoms%rmt(itype)+10.0)/rnot ) / dxx + 1 )
ncmsh = min( ncmsh, dimension%msh )
ncmsh = min( ncmsh, atoms%msh )
rn = rnot* (d** (ncmsh-1))
IF ( mpi%irank == 0 ) THEN
WRITE(6 ,FMT=8000) z,rnot,dxx,atoms%jri(itype)
......@@ -495,7 +495,7 @@
! - local arrays -
INTEGER :: kappa(dimension%nstd),nprnc(dimension%nstd)
INTEGER :: nindxcr(0:dimension%nstd,atoms%ntype)
REAL :: occ(dimension%nstd),occ_h(dimension%nstd,2),a(dimension%msh),b(dimension%msh)
REAL :: occ(dimension%nstd),occ_h(dimension%nstd,2),a(atoms%msh),b(atoms%msh)
INTEGER :: lmaxc(atoms%ntype)
......@@ -520,7 +520,7 @@
rnot = atoms%rmsh(1,itype)
d = exp(atoms%dx(itype))
ncmsh = nint( log( (atoms%rmt(itype)+10.0)/rnot ) / dxx + 1 )
ncmsh = min( ncmsh, dimension%msh )
ncmsh = min( ncmsh, atoms%msh )
rn = rnot* (d** (ncmsh-1))
nst = atoms%econf(itype)%num_core_states
......
init/initParallelProcesses.F90
View file @ a640aae8
......@@ -76,7 +76,7 @@ SUBROUTINE initParallelProcesses(atoms,vacuum,input,stars,sliceplot,banddos,&
CALL MPI_BCAST(dimension%nvd,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(dimension%neigd,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(dimension%nv2d,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(dimension%msh,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%msh,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(dimension%nspd,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(kpts%numSpecialPoints,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(kpts%nkpt,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
......
init/local_sym.f
View file @ a640aae8
......@@ -37,7 +37,7 @@
> lmaxd,lmax,nops,mrot,tau,
> natd,ntype,neq,amat,bmat,pos,
X nlhd,memd,ntypsd,l_dim,
< nlhtyp,ntypsy,nlh,llh,nmem,mlh,clnu)
< nlhtyp,nlh,llh,nmem,mlh,clnu)
USE m_ptsym
USE m_lhcal
......@@ -52,7 +52,6 @@
LOGICAL, INTENT (IN) :: l_dim
INTEGER :: nlhd,memd,ntypsd
INTEGER :: nlhtyp(ntype)
INTEGER, INTENT(OUT) :: ntypsy(natd)
INTEGER, INTENT(OUT) :: llh(0:nlhd,ntypsd),nmem(0:nlhd,ntypsd)
INTEGER, INTENT(OUT) :: mlh(memd,0:nlhd,ntypsd),nlh(ntypsd)
COMPLEX, INTENT(OUT) :: clnu(memd,0:nlhd,ntypsd)
......@@ -179,15 +178,7 @@
ENDDO
ENDDO
na = 0
DO n = 1, ntype
DO nn = 1,neq(n)
na = na + 1
ntypsy(na) = typsym(na)
! ntypsy(na) = typsym(na-nn+1)
ENDDO
ENDDO
!---> output results
DO n = 1, nsymt
WRITE (6,'(/," --- Local symmetry",i3,":",i4,
......
init/make_sphhar.f90
View file @ a640aae8
......@@ -24,14 +24,14 @@ contains
! Dimensioning of lattice harmonics
ALLOCATE(atoms%nlhtyp(atoms%ntype),sym%ntypsy(atoms%nat))
ALLOCATE(atoms%nlhtyp(atoms%ntype))
ALLOCATE(sphhar%clnu(1,1,1),sphhar%nlh(1),sphhar%llh(1,1),sphhar%nmem(1,1),sphhar%mlh(1,1,1))
sphhar%ntypsd = 0
IF (.NOT.oneD%odd%d1) THEN
CALL local_sym(atoms%lmaxd,atoms%lmax,sym%nop,sym%mrot,sym%tau,&
atoms%nat,atoms%ntype,atoms%neq,cell%amat,cell%bmat,&
atoms%taual,sphhar%nlhd,sphhar%memd,sphhar%ntypsd,.true.,&
atoms%nlhtyp,sym%ntypsy,sphhar%nlh,sphhar%llh,&
atoms%nlhtyp,sphhar%nlh,sphhar%llh,&
sphhar%nmem,sphhar%mlh,sphhar%clnu)
ELSE IF (oneD%odd%d1) THEN
WRITE(*,*) 'Note: I would be surprised if lattice harmonics generation works'
......@@ -48,7 +48,7 @@ contains
CALL local_sym(atoms%lmaxd,lmx1,sym%nop,sym%mrot,sym%tau,&
atoms%nat,atoms%nat,nq1,cell%amat,cell%bmat,atoms%taual,&
sphhar%nlhd,sphhar%memd,sphhar%ntypsd,.true.,nlhtp1,&
sym%ntypsy,sphhar%nlh,sphhar%llh,sphhar%nmem,&
sphhar%nlh,sphhar%llh,sphhar%nmem,&
sphhar%mlh,sphhar%clnu)
ii = 1
DO i = 1,atoms%ntype
......@@ -69,7 +69,7 @@ contains
CALL local_sym(atoms%lmaxd,atoms%lmax,sym%nop,sym%mrot,sym%tau,&
atoms%nat,atoms%ntype,atoms%neq,cell%amat,cell%bmat,atoms%taual,&
sphhar%nlhd,sphhar%memd,sphhar%ntypsd,.FALSE.,&
atoms%nlhtyp,sym%ntypsy,sphhar%nlh,sphhar%llh,sphhar%nmem,sphhar%mlh,sphhar%clnu)
atoms%nlhtyp,sphhar%nlh,sphhar%llh,sphhar%nmem,sphhar%mlh,sphhar%clnu)
sym%nsymt = sphhar%ntypsd
oneD%mrot1(:,:,:) = sym%mrot(:,:,:)
oneD%tau1(:,:) = sym%tau(:,:)
......@@ -89,7 +89,7 @@ contains
CALL local_sym(atoms%lmaxd,lmx1,sym%nop,sym%mrot,sym%tau,&
atoms%nat,atoms%nat,nq1,cell%amat,cell%bmat,atoms%taual,&
sphhar%nlhd,sphhar%memd,sphhar%ntypsd,.FALSE.,&
nlhtp1,sym%ntypsy,sphhar%nlh,sphhar%llh,sphhar%nmem,sphhar%mlh,sphhar%clnu)
nlhtp1,sphhar%nlh,sphhar%llh,sphhar%nmem,sphhar%mlh,sphhar%clnu)
sym%nsymt = sphhar%ntypsd
ii = 1
DO i = 1,atoms%ntype
......
init/make_stars.f90
View file @ a640aae8
......@@ -46,19 +46,19 @@ MODULE m_make_stars
! Dimensioning of stars
IF (input%film) THEN
CALL strgn1_dim(stars%gmax,cell%bmat,sym%invs,sym%zrfs,sym%mrot,&
CALL strgn1_dim(input%gmax,cell%bmat,sym%invs,sym%zrfs,sym%mrot,&
sym%tau,sym%nop,sym%nop2,stars%mx1,stars%mx2,stars%mx3,&
stars%ng3,stars%ng2,oneD%odd)
ELSE
CALL strgn2_dim(stars%gmax,cell%bmat,sym%invs,sym%zrfs,sym%mrot,&
CALL strgn2_dim(input%gmax,cell%bmat,sym%invs,sym%zrfs,sym%mrot,&
sym%tau,sym%nop,stars%mx1,stars%mx2,stars%mx3,&
stars%ng3,stars%ng2)
oneD%odd%n2d = stars%ng2
oneD%odd%nq2 = stars%ng2
oneD%odd%nop = sym%nop
END IF
stars%gmax=input%gmax
stars%kimax2= (2*stars%mx1+1)* (2*stars%mx2+1)-1
stars%kimax = (2*stars%mx1+1)*