Commit f369898a authored by Gregor Michalicek's avatar Gregor Michalicek

Quick fix for issue #311

...and some missing irrelevant additional initialization of hybrid%d_wgn2 in main/fleur_init.F90
parent 01ae2a5e
......@@ -227,10 +227,10 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
! perform Brillouin zone integration and summation over the
! bands in order to determine the energy parameters for each atom and angular momentum
CALL eparas(ispin,atoms,noccbd,mpi,ikpt,noccbd,we,eig,&
CALL eparas(ispin,atoms,noccbd,ev_list,mpi,ikpt,noccbd,we,eig,&
skip_t,cdnvalJob%l_evp,eigVecCoeffs,usdus,regCharges,dos,banddos%l_mcd,mcd)
IF (noco%l_mperp.AND.(ispin==jsp_end)) CALL qal_21(dimension,atoms,input,noccbd,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos)
IF (noco%l_mperp.AND.(ispin==jsp_end)) CALL qal_21(dimension,atoms,input,noccbd,ev_list,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos)
! 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
......
......@@ -23,7 +23,7 @@ MODULE m_eparas
!***********************************************************************
!
CONTAINS
SUBROUTINE eparas(jsp,atoms,noccbd, mpi,ikpt,ne,we,eig,skip_t,l_evp,eigVecCoeffs,&
SUBROUTINE eparas(jsp,atoms,noccbd,ev_list,mpi,ikpt,ne,we,eig,skip_t,l_evp,eigVecCoeffs,&
usdus,regCharges,dos,l_mcd,mcd)
USE m_types
IMPLICIT NONE
......@@ -39,6 +39,7 @@ CONTAINS
INTEGER, INTENT (IN) :: noccbd,jsp
INTEGER, INTENT (IN) :: ne,ikpt ,skip_t
LOGICAL, INTENT (IN) :: l_mcd,l_evp
INTEGER, INTENT (IN) :: ev_list(noccbd)
! ..
! .. Array Arguments ..
REAL, INTENT (IN) :: eig(:)!(dimension%neigd),
......@@ -107,7 +108,7 @@ CONTAINS
ENDDO
ENDIF ! end MCD
ENDDO
dos%qal(l,n,i,ikpt,jsp) = (suma+sumb*usdus%ddn(l,n,jsp))/atoms%neq(n)
dos%qal(l,n,ev_list(i),ikpt,jsp) = (suma+sumb*usdus%ddn(l,n,jsp))/atoms%neq(n)
ENDDO
nt1 = nt1 + atoms%neq(n)
ENDDO
......@@ -120,8 +121,8 @@ CONTAINS
DO l = 0,3
DO n = 1,atoms%ntype
DO i = (skip_t+1),noccbd
regCharges%ener(l,n,jsp) = regCharges%ener(l,n,jsp) + dos%qal(l,n,i,ikpt,jsp)*we(i)*eig(i)
regCharges%sqal(l,n,jsp) = regCharges%sqal(l,n,jsp) + dos%qal(l,n,i,ikpt,jsp)*we(i)
regCharges%ener(l,n,jsp) = regCharges%ener(l,n,jsp) + dos%qal(l,n,ev_list(i),ikpt,jsp)*we(i)*eig(i)
regCharges%sqal(l,n,jsp) = regCharges%sqal(l,n,jsp) + dos%qal(l,n,ev_list(i),ikpt,jsp)*we(i)
ENDDO
ENDDO
ENDDO
......@@ -174,7 +175,7 @@ CONTAINS
! llo > 3 used for unoccupied states only
IF( l .GT. 3 ) CYCLE
DO i = 1,ne
dos%qal(l,ntyp,i,ikpt,jsp)= dos%qal(l,ntyp,i,ikpt,jsp) + ( 1.0/atoms%neq(ntyp) )* (&
dos%qal(l,ntyp,ev_list(i),ikpt,jsp)= dos%qal(l,ntyp,ev_list(i),ikpt,jsp) + ( 1.0/atoms%neq(ntyp) )* (&
qaclo(i,lo,ntyp)*usdus%uulon(lo,ntyp,jsp)+qbclo(i,lo,ntyp)*usdus%dulon(lo,ntyp,jsp) )
END DO
DO lop = 1,atoms%nlo(ntyp)
......@@ -182,7 +183,7 @@ CONTAINS
DO i = 1,ne
regCharges%enerlo(lo,ntyp,jsp) = regCharges%enerlo(lo,ntyp,jsp) +qlo(i,lop,lo,ntyp)*we(i)*eig(i)
regCharges%sqlo(lo,ntyp,jsp) = regCharges%sqlo(lo,ntyp,jsp) + qlo(i,lop,lo,ntyp)*we(i)
dos%qal(l,ntyp,i,ikpt,jsp)= dos%qal(l,ntyp,i,ikpt,jsp) + ( 1.0/atoms%neq(ntyp) ) *&
dos%qal(l,ntyp,ev_list(i),ikpt,jsp)= dos%qal(l,ntyp,ev_list(i),ikpt,jsp) + ( 1.0/atoms%neq(ntyp) ) *&
qlo(i,lop,lo,ntyp)*usdus%uloulopn(lop,lo,ntyp,jsp)
ENDDO
ENDIF
......
......@@ -5,7 +5,7 @@ MODULE m_qal21
!***********************************************************************
!
CONTAINS
SUBROUTINE qal_21(dimension,atoms,input,noccbd,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos)
SUBROUTINE qal_21(dimension,atoms,input,noccbd,ev_list,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos)
USE m_types_setup
USE m_types_dos
......@@ -25,6 +25,8 @@ CONTAINS
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: noccbd,ikpt
INTEGER, INTENT (IN) :: ev_list(noccbd)
! .. Local Scalars ..
INTEGER i,l,lo,lop ,natom,nn,ntyp
INTEGER nt1,nt2,lm,n,ll1,ipol,icore,index,m
......@@ -152,10 +154,10 @@ CONTAINS
state : DO i = 1, noccbd
lls : DO l = 0,3
CALL rot_den_mat(noco%alph(n),noco%beta(n),&
dos%qal(l,n,i,ikpt,1),dos%qal(l,n,i,ikpt,2),qal21(l,n,i))
dos%qal(l,n,ev_list(i),ikpt,1),dos%qal(l,n,ev_list(i),ikpt,2),qal21(l,n,i))
IF (.FALSE.) THEN
IF (n==1) WRITE(*,'(3i3,4f10.5)') l,n,i,qal21(l,n,i),dos%qal(l,n,i,ikpt,:)
q_loc(1,1) = dos%qal(l,n,i,ikpt,1); q_loc(2,2) = dos%qal(l,n,i,ikpt,2)
IF (n==1) WRITE(*,'(3i3,4f10.5)') l,n,i,qal21(l,n,i),dos%qal(l,n,ev_list(i),ikpt,:)
q_loc(1,1) = dos%qal(l,n,ev_list(i),ikpt,1); q_loc(2,2) = dos%qal(l,n,ev_list(i),ikpt,2)
q_loc(1,2) = qal21(l,n,i); q_loc(2,1) = CONJG(q_loc(1,2))
q_hlp = MATMUL( TRANSPOSE( CONJG(chi) ) ,q_loc)
q_loc = MATMUL(q_hlp,chi)
......
......@@ -449,6 +449,7 @@
! calculate d_wgn
ALLOCATE (hybrid%d_wgn2(-atoms%lmaxd:atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,0:atoms%lmaxd,sym%nsym))
hybrid%d_wgn2 = CMPLX(0.0,0.0)
CALL d_wigner(sym%nop,sym%mrot,cell%bmat,atoms%lmaxd,hybrid%d_wgn2(:,:,1:,:sym%nop))
hybrid%d_wgn2(:,:,0,:) = 1
......
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