Skip to content

GitLab

Commit 5bf8da4d authored by Gustav Bihlmayer's avatar Gustav Bihlmayer
Browse files

Update mapatom.F90, hsmt_extra.F90 and vec_for_lo.f90 to ensure a complex matrix setup 

with invsatom=0 etc. in case of LDA+U and SOC. Furthermore the i_u counter was reset
for more that one atom per type in hsmt_extra.F90. l_lo1 and some fix spin-spiral + LO
in pathological cases introduces in vec_for_lo.f90. The "scalar relativistic" energy
parameter calculation for LO's was introduced in lodpot.f90. This will change the
total energy in some test cases.
parent a11ffc41
Hide whitespace changes
Inline Side-by-side
Showing with 62 additions and 18 deletions
eigen/hsmt_extra.F90
View file @ 5bf8da4d
......@@ -64,7 +64,7 @@ CONTAINS
COMPLEX chi11,chi21,chi22
INTEGER k,i,spin2,l,ll1,lo,jd
INTEGER m,n,na,nn,np,i_u
INTEGER m,n,na,nn,np,i_u,i_u_save
INTEGER iiloh,iilos,nkvecprevath,nkvecprevats,iintsp,jintsp
INTEGER nc,locolh,locols,nkvecprevatu,iilou,locolu
INTEGER nkvecprevatuTemp,iilouTemp,locoluTemp
......@@ -143,7 +143,7 @@ CONTAINS
IF (oneD%odi%d1) THEN
np = oneD%ods%ngopr(na)
END IF
CALL vec_for_lo(atoms,nintsp,sym,na, n,np,noco, lapw,cell, gk,vk, nkvec,kvec)
CALL vec_for_lo(atoms,nintsp,sym,l_real,na, n,np,noco, lapw,cell, gk,vk, nkvec,kvec)
DO lo = 1,atoms%nlo(n)
kveclo(nkvec_sv+1:nkvec_sv+nkvec(lo,1)) = kvec(1:nkvec(lo,1),lo)
nkvec_sv = nkvec_sv+nkvec(lo,1)
......@@ -275,6 +275,7 @@ CONTAINS
nkvecprevatuTemp = nkvecprevatu
iilouTemp = iilou
locoluTemp = locolu
i_u_save = i_u
DO WHILE (i_u.LE.atoms%n_u)
IF (atoms%lda_u(i_u)%atomType.GT.n) EXIT
nkvecprevatuTemp = nkvecprevatu
......@@ -309,6 +310,9 @@ CONTAINS
END IF
ENDIF ! atoms%invsat(na) = 0 or 1
IF (nn.NE.atoms%neq(n)) THEN
i_u = i_u_save
ENDIF
!---> 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)
......
eigen/lodpot.f90
View file @ 5bf8da4d
......@@ -316,6 +316,14 @@ CONTAINS
CALL differ(fn,fl,fj,c,atoms%zatom(n),atoms%dx(n),atoms%rmsh(1,n),&
rn,d,msh,vrd, e, f(:,1),f(:,2),ierr)
ello(ilo,n,jsp) = e
IF (l > 0) THEN
e = (e_up+e_lo)/2
fn = real(nqn_lo(ilo)) ; fl = real(l) ; fj = fl-0.5
CALL differ(fn,fl,fj,c,atoms%zatom(n),atoms%dx(n),atoms%rmsh(1,n),&
rn,d,msh,vrd, e, f(:,1),f(:,2),ierr)
e = (2.0*ello(ilo,n,jsp) + e ) / 3.0
ello(ilo,n,jsp) = e
ENDIF
IF (mpi%irank == 0) THEN
attributes = ''
......
eigen/vec_for_lo.f90
View file @ 5bf8da4d
......@@ -15,7 +15,7 @@ MODULE m_vecforlo
! eig-file, for later use in charge-density part.
!----------------------------------------------------------------------------
CONTAINS
SUBROUTINE vec_for_lo(atoms,nintsp,sym,na,&
SUBROUTINE vec_for_lo(atoms,nintsp,sym,l_real,na,&
n,np,noco, lapw,cell, gk,vk, nkvec,kvec)
USE m_constants,ONLY: tpi_const,fpi_const
USE m_orthoglo
......@@ -31,6 +31,7 @@ CONTAINS
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: nintsp ,na,n,np
LOGICAL, INTENT (IN) :: l_real
! ..
! .. Array Arguments ..
REAL, INTENT (IN) :: gk(:,:,:)!(dimension%nvd,3,nintsp)
......@@ -40,7 +41,7 @@ CONTAINS
! .. Local Scalars ..
COMPLEX term1
REAL th,con1
INTEGER l,lo ,mind,ll1,lm,iintsp,k,nkmin,ntyp,lmp,m
INTEGER l,lo ,mind,ll1,lm,iintsp,k,nkmin,ntyp,lmp,m,k_start
LOGICAL linind,enough,l_lo1
! ..
! .. Local Arrays ..
......@@ -89,14 +90,42 @@ CONTAINS
nkvec(:,:) = 0
cwork(:,:,:,:) = CMPLX(0.0,0.0)
enough=.FALSE.
DO k = 1,MIN(lapw%nv(1),lapw%nv(nintsp))
IF (ANY(lapw%rk(k,:nintsp).LT.eps)) CYCLE
IF (noco%l_ss) THEN
k_start = 2 ! avoid k=1 !!! GB16
ELSE
k_start = 1
ENDIF
DO k = k_start,MIN(lapw%nv(1),lapw%nv(nintsp))
! IF (ANY(lapw%rk(k,:nintsp).LT.eps)) CYCLE
IF (.NOT.enough) THEN
DO iintsp = 1,nintsp
!--> generate spherical harmonics
vmult(:) = gkrot(k,:,iintsp)
CALL ylm4(atoms%lnonsph(ntyp),vmult, ylm)
l_lo1=.false.
IF ((lapw%rk(k,iintsp).LT.eps).AND.(.not.noco%l_ss)) THEN
l_lo1=.true.
ELSE
l_lo1=.false.
ENDIF
! --> here comes a part of abccoflo()
IF ( l_lo1) THEN
DO lo = 1,atoms%nlo(ntyp)
IF ((nkvec(lo,iintsp).EQ.0).AND.(atoms%llo(lo,ntyp).EQ.0)) THEN
enough = .false.
nkvec(lo,iintsp) = 1
kvec(nkvec(lo,iintsp),lo) = k
term1 = con1* ((atoms%rmt(ntyp)**2)/2)
cwork(0,1,lo,iintsp) = term1 / sqrt(2*tpi_const)
IF((atoms%invsat(na).EQ.1).OR.(atoms%invsat(na).EQ.2)) THEN
cwork(1,1,lo,iintsp) = conjg(term1) / sqrt(2*tpi_const)
ENDIF
ENDIF
ENDDO
ELSE
enough = .TRUE.
term1 = con1* ((atoms%rmt(ntyp)**2)/2)* CMPLX(rph(k,iintsp),cph(k,iintsp))
DO lo = 1,atoms%nlo(ntyp)
......@@ -111,7 +140,7 @@ CONTAINS
cwork(m,nkvec(lo,iintsp),lo,iintsp) = term1*ylm(lm)
END DO
CALL orthoglo(&
sym%invs,atoms,nkvec(lo,iintsp),lo,l,linindq,.FALSE., cwork(-2*atoms%llod,1,1,iintsp),linind)
l_real,atoms,nkvec(lo,iintsp),lo,l,linindq,.FALSE., cwork(-2*atoms%llod,1,1,iintsp),linind)
IF (linind) THEN
kvec(nkvec(lo,iintsp),lo) = k
ELSE
......@@ -134,7 +163,7 @@ CONTAINS
cwork(mind,nkvec(lo,iintsp),lo,iintsp) = ((-1)** (l+m))*CONJG(term1*ylm(lmp))
END DO
CALL orthoglo(&
sym%invs,atoms,nkvec(lo,iintsp),lo,l,linindq,.TRUE., cwork(-2*atoms%llod,1,1,iintsp),linind)
l_real,atoms,nkvec(lo,iintsp),lo,l,linindq,.TRUE., cwork(-2*atoms%llod,1,1,iintsp),linind)
IF (linind) THEN
kvec(nkvec(lo,iintsp),lo) = k
! write(*,*) nkvec(lo,iintsp),k,' <- '
......@@ -153,6 +182,7 @@ CONTAINS
WRITE(*,*) na,k,lapw%nv
CALL juDFT_error("not enough lin. indep. clo-vectors" ,calledby ="vec_for_lo")
END IF
ENDIF
! -- > end of abccoflo-part
ENDDO
ENDIF
......
init/mapatom.F90
View file @ 5bf8da4d
......@@ -214,6 +214,7 @@
sym%invsatnr(na) = 0
END DO
IF (.not.(noco%l_soc.and.atoms%n_u>0)) THEN
IF (sym%invs) THEN
WRITE (6,FMT=*)
nat1 = 1
......@@ -252,6 +253,7 @@
9000 FORMAT ('atom type',i3,': atom',i3,' can be mapped into atom',i3,&
& ' via 3d inversion')
END IF
END IF
END SUBROUTINE mapatom
END MODULE m_mapatom
ldau/v_mmp.F90
View file @ 5bf8da4d
......@@ -93,16 +93,16 @@ CONTAINS
!--------------------------------------------------------------------------------------------+
! initialise vs_mmp
!
IF (sym%invs) THEN
vs_mmp(:,:,i_u,:) = ns_mmp(:,:,i_u,:)
DO ispin = 1,jspins
DO m = -l,l
DO mp = -l,l
ns_mmp(m,mp,i_u,ispin) = vs_mmp(-m,-mp,i_u,ispin)
END DO
END DO
END DO
END IF
!IF (sym%invs) THEN
! vs_mmp(:,:,i_u,:) = ns_mmp(:,:,i_u,:)
! DO ispin = 1,jspins
! DO m = -l,l
! DO mp = -l,l
! ns_mmp(m,mp,i_u,ispin) = vs_mmp(-m,-mp,i_u,ispin)
! END DO
! END DO
! END DO
!END IF
vs_mmp(:,:,i_u,:) = CMPLX(0.0,0.0)
!
! outer spin loop - set up v_mmp
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment