Commit a324e4cc authored by Daniel Wortmann's avatar Daniel Wortmann

Moved symmetry arrays from atoms type to sym type

parent ab763129
......@@ -242,7 +242,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
......@@ -272,7 +272,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)
......@@ -282,7 +282,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
......
......@@ -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
......
......@@ -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)
......
......@@ -43,7 +43,7 @@ CONTAINS
ntyploop: DO n=1,atoms%ntype
DO nn = 1,atoms%neq(n)
na = SUM(atoms%neq(:n-1))+nn
IF ((atoms%invsat(na)==0) .OR. (atoms%invsat(na)==1)) THEN
IF ((sym%invsat(na)==0) .OR. (sym%invsat(na)==1)) THEN
!---> Calculate Overlapp matrix
CALL timestart("ab-coefficients")
......@@ -84,7 +84,7 @@ CONTAINS
ntyploop: DO n=1,atoms%ntype
DO nn = 1,atoms%neq(n)
na = SUM(atoms%neq(:n-1))+nn
IF ((atoms%invsat(na)==0) .OR. (atoms%invsat(na)==1)) THEN
IF ((sym%invsat(na)==0) .OR. (sym%invsat(na)==1)) THEN
!---> Calculate Overlapp matrix
CALL timestart("ab-coefficients")
......
......@@ -136,10 +136,10 @@ CONTAINS
DO nn = 1,atoms%neq(n)
na = na + 1
IF (atoms%lnonsph(n).LT.0) CYCLE ntype_loop
IF ((atoms%invsat(na).EQ.0) .OR. (atoms%invsat(na).EQ.1)) THEN
IF (atoms%invsat(na).EQ.0) invsfct = 1
IF (atoms%invsat(na).EQ.1) invsfct = 2
np = sym%invtab(atoms%ngopr(na))
IF ((sym%invsat(na).EQ.0) .OR. (sym%invsat(na).EQ.1)) THEN
IF (sym%invsat(na).EQ.0) invsfct = 1
IF (sym%invsat(na).EQ.1) invsfct = 2
np = sym%invtab(sym%ngopr(na))
IF (oneD%odi%d1) THEN
np = oneD%ods%ngopr(na)
END IF
......@@ -308,7 +308,7 @@ CONTAINS
locolu = locoluTemp
END IF
ENDIF ! atoms%invsat(na) = 0 or 1
ENDIF ! sym%invsat(na) = 0 or 1
!---> end loop over equivalent atoms
END DO
IF ( noco%l_noco .AND. (.NOT. noco%l_ss) ) CALL hsmt_hlptomat(atoms%nlotot,lapw%nv,sub_comm,chi11,chi21,chi22,aahlp,aa_c,bbhlp,bb_c)
......
......@@ -95,10 +95,10 @@ CONTAINS
b=0.0
na = SUM(atoms%neq(:n-1))+nn
IF (atoms%lnonsph(n)<0) CYCLE ntyploop
IF ((atoms%invsat(na)==0) .OR. (atoms%invsat(na)==1)) THEN
IF (atoms%invsat(na)==0) invsfct = 1
IF (atoms%invsat(na)==1) invsfct = 2
np = sym%invtab(atoms%ngopr(na))
IF ((sym%invsat(na)==0) .OR. (sym%invsat(na)==1)) THEN
IF (sym%invsat(na)==0) invsfct = 1
IF (sym%invsat(na)==1) invsfct = 2
np = sym%invtab(sym%ngopr(na))
IF (oneD%odi%d1) np = oneD%ods%ngopr(na)
!---> loop over interstitial spins
DO iintsp = 1,nintsp
......@@ -277,7 +277,7 @@ CONTAINS
!---> end loops over interstitial spin
ENDDO
ENDDO
ENDIF ! atoms%invsat(na) = 0 or 1
ENDIF ! sym%invsat(na) = 0 or 1
!---> end loop over equivalent atoms
END DO
IF ( noco%l_noco .AND. (.NOT. noco%l_ss) ) CALL hsmt_hlptomat(atoms%nlotot,lapw%nv,sub_comm,chi11,chi21,chi22,aahlp,aa_c)
......
......@@ -117,10 +117,10 @@ CONTAINS
b=0.0
na = SUM(atoms%neq(:n-1))+nn
IF (atoms%lnonsph(n)<0) CYCLE ntyploop
IF ((atoms%invsat(na)==0) .OR. (atoms%invsat(na)==1)) THEN
IF (atoms%invsat(na)==0) invsfct = 1
IF (atoms%invsat(na)==1) invsfct = 2
np = sym%invtab(atoms%ngopr(na))
IF ((sym%invsat(na)==0) .OR. (sym%invsat(na)==1)) THEN
IF (sym%invsat(na)==0) invsfct = 1
IF (sym%invsat(na)==1) invsfct = 2
np = sym%invtab(sym%ngopr(na))
IF (oneD%odi%d1) np = oneD%ods%ngopr(na)
!Using double buffering create_ab could be overlapped with following GPU work
#if defined(_OPENACC)
......@@ -379,7 +379,7 @@ CONTAINS
! call nvtxEndRange
#endif
ENDDO
ENDIF ! atoms%invsat(na) = 0 or 1
ENDIF ! sym%invsat(na) = 0 or 1
!---> end loop over equivalent atoms
END DO
IF ( noco%l_noco .AND. (.NOT. noco%l_ss) )THEN
......
......@@ -350,8 +350,8 @@ CONTAINS
a=0.0
b=0.0
na = SUM(atoms%neq(:n-1))+nn
IF ((atoms%invsat(na)==0) .OR. (atoms%invsat(na)==1)) THEN
np = sym%invtab(atoms%ngopr(na))
IF ((sym%invsat(na)==0) .OR. (sym%invsat(na)==1)) THEN
np = sym%invtab(sym%ngopr(na))
!---> loop over interstitial spins
DO iintsp = 1,nintsp
IF (noco%l_constr.OR.l_socfirst) THEN
......
......@@ -70,15 +70,15 @@ CONTAINS
!$OMP MASTER
IF ((atoms%invsat(na) == 0) .OR. (atoms%invsat(na) == 1)) THEN
IF ((sym%invsat(na) == 0) .OR. (sym%invsat(na) == 1)) THEN
!---> if this atom is the first of two atoms related by inversion,
!---> the contributions to the overlap matrix of both atoms are added
!---> at once. where it is made use of the fact, that the sum of
!---> these contributions is twice the real part of the contribution
!---> of each atom. note, that in this case there are twice as many
!---> (2*(2*l+1)) k-vectors (compare abccoflo and comments there).
IF (atoms%invsat(na) == 0) invsfct = 1
IF (atoms%invsat(na) == 1) invsfct = 2
IF (sym%invsat(na) == 0) invsfct = 1
IF (sym%invsat(na) == 1) invsfct = 2
!
DO lo = 1,atoms%nlo(ntyp)
......
......@@ -104,7 +104,7 @@ CONTAINS
ab_size=lmax*(lmax+2)+1
ab=0.0
np = sym%invtab(atoms%ngopr(na))
np = sym%invtab(sym%ngopr(na))
!---> set up phase factors
CALL lapw%phase_factors(iintsp,atoms%taual(:,na),noco%qss,c_ph(:,iintsp))
c_ph_dev=c_ph
......@@ -137,7 +137,7 @@ CONTAINS
print*, "Ooooops, TODO in hsmt_ab"
!DO k = 1,lapw%nv(1)
! !determine also the abc coeffs for LOs
! invsfct=MERGE(1,2,atoms%invsat(na).EQ.0)
! invsfct=MERGE(1,2,sym%invsat(na).EQ.0)
! term = fpi_const/SQRT(cell%omtil)* ((atoms%rmt(n)**2)/2)*c_ph(k,iintsp)
! DO lo = 1,atoms%nlo(n)
! l = atoms%llo(lo,n)
......@@ -207,7 +207,7 @@ CONTAINS
l_apw=ALL(gj==0.0)
ab=0.0
np = sym%invtab(atoms%ngopr(na))
np = sym%invtab(sym%ngopr(na))
!---> set up phase factors
CALL lapw%phase_factors(iintsp,atoms%taual(:,na),noco%qss,c_ph(:,iintsp))
......@@ -224,7 +224,7 @@ CONTAINS
END DO
END IF
!$OMP PARALLEL DO DEFAULT(none) &
!$OMP& SHARED(lapw,gkrot,lmax,c_ph,iintsp,ab,fj,gj,abclo,cell,atoms) &
!$OMP& SHARED(lapw,gkrot,lmax,c_ph,iintsp,ab,fj,gj,abclo,cell,atoms,sym) &
!$OMP& SHARED(alo1,blo1,clo1,ab_size,na,n) &
!$OMP& PRIVATE(k,vmult,ylm,l,ll1,m,lm,term,invsfct,lo,nkvec)
DO k = 1,lapw%nv(iintsp)
......@@ -242,7 +242,7 @@ CONTAINS
END DO
IF (PRESENT(abclo)) THEN
!determine also the abc coeffs for LOs
invsfct=MERGE(1,2,atoms%invsat(na).EQ.0)
invsfct=MERGE(1,2,sym%invsat(na).EQ.0)
term = fpi_const/SQRT(cell%omtil)* ((atoms%rmt(n)**2)/2)*c_ph(k,iintsp)
DO lo = 1,atoms%nlo(n)
l = atoms%llo(lo,n)
......
......@@ -45,7 +45,7 @@ CONTAINS
na = sum(atoms%neq(:n-1))
DO nn = 1,atoms%neq(n)
na = na + 1
IF ((atoms%invsat(na).EQ.0) .OR. (atoms%invsat(na).EQ.1)) THEN
IF ((sym%invsat(na).EQ.0) .OR. (sym%invsat(na).EQ.1)) THEN
IF (atoms%nlo(n).GE.1) THEN
......@@ -58,7 +58,7 @@ CONTAINS
!---> hamiltonian matrix, if they are used for this atom.
CALL slomat(&
input,atoms,mpi,lapw,cell,noco,n,na,&
input,atoms,sym,mpi,lapw,cell,noco,n,na,&
isp,ud, alo1,blo1,clo1,fj,gj,&
iintsp,jintsp,chi,smat)
CALL hlomat(input,atoms,mpi,lapw,ud,tlmplm,sym,cell,noco,isp,&
......
......@@ -106,8 +106,8 @@ CONTAINS
DO nn = 1,atoms%neq(n)
na = SUM(atoms%neq(:n-1))+nn
IF ((atoms%invsat(na)==0) .OR. (atoms%invsat(na)==1)) THEN
rchi=MERGE(REAL(chi),REAL(chi)*2,(atoms%invsat(na)==0))
IF ((sym%invsat(na)==0) .OR. (sym%invsat(na)==1)) THEN
rchi=MERGE(REAL(chi),REAL(chi)*2,(sym%invsat(na)==0))
CALL hsmt_ab(sym,atoms,noco,isp,jintsp,n,na,cell,lapw,fj_dev,gj_dev,ab_dev,ab_size,.TRUE.)
......@@ -188,8 +188,8 @@ CONTAINS
DO nn = 1,atoms%neq(n)
na = SUM(atoms%neq(:n-1))+nn
IF ((atoms%invsat(na)==0) .OR. (atoms%invsat(na)==1)) THEN
rchi=MERGE(REAL(chi),REAL(chi)*2,(atoms%invsat(na)==0))
IF ((sym%invsat(na)==0) .OR. (sym%invsat(na)==1)) THEN
rchi=MERGE(REAL(chi),REAL(chi)*2,(sym%invsat(na)==0))
CALL hsmt_ab(sym,atoms,noco,isp,jintsp,n,na,cell,lapw,fj,gj,ab,ab_size,.TRUE.)
!Calculate Hamiltonian
......@@ -265,8 +265,8 @@ CONTAINS
DO nn = 1,atoms%neq(n)
na = SUM(atoms%neq(:n-1))+nn
IF ((atoms%invsat(na)==0) .OR. (atoms%invsat(na)==1)) THEN
rchi=MERGE(REAL(chi),REAL(chi)*2,(atoms%invsat(na)==0))
IF ((sym%invsat(na)==0) .OR. (sym%invsat(na)==1)) THEN
rchi=MERGE(REAL(chi),REAL(chi)*2,(sym%invsat(na)==0))
CALL hsmt_ab(sym,atoms,noco,isp,jintsp,n,na,cell,lapw,fj,gj,ab,ab_size,.TRUE.)
!Calculate Hamiltonian
......