diff --git a/cdn/cdnval.F90 b/cdn/cdnval.F90 index 44369a63544834acfb636f4acffffc3e4bce344b..83e89ca0a8f74da99b08a9a87727a0ead191e449 100644 --- a/cdn/cdnval.F90 +++ b/cdn/cdnval.F90 @@ -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 diff --git a/cdn/eparas.f90 b/cdn/eparas.f90 index 51c2e6650f4d9f88cec410e20ee473e479491cda..178b22dc25bccef1a8b06b804da56b234a4071b6 100644 --- a/cdn/eparas.f90 +++ b/cdn/eparas.f90 @@ -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 diff --git a/cdn/qal_21.f90 b/cdn/qal_21.f90 index 644b92d40a1bc40650ee50632beb4517377786a4..74aefc9bed747c88e431283274c002a5d9c676bb 100644 --- a/cdn/qal_21.f90 +++ b/cdn/qal_21.f90 @@ -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) diff --git a/main/fleur_init.F90 b/main/fleur_init.F90 index ab0e286cc3267afe6b24621714215fbacec46725..782388869e61cbe335acbf86ca530e23497a1e12 100644 --- a/main/fleur_init.F90 +++ b/main/fleur_init.F90 @@ -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