Commit cdf11efd authored by Henning Janssen's avatar Henning Janssen

Fix wrong spin indexing for noco case in evaldos.f90

parent 481c614d
...@@ -52,7 +52,7 @@ ...@@ -52,7 +52,7 @@
! locals ! locals
INTEGER, PARAMETER :: lmax= 4, ned = 1301 INTEGER, PARAMETER :: lmax= 4, ned = 1301
INTEGER i,s,v,index,jspin,k,l,l1,l2,ln,n,nl,ntb,ntria,ntetra INTEGER i,s,v,index,jspin,k,l,l1,l2,ln,n,nl,ntb,ntria,ntetra
INTEGER icore,qdim,n_orb,ncored INTEGER icore,qdim,n_orb,ncored,jsp
REAL as,de,efermi,emax,emin,qmt,sigma,totdos,efermiPrev REAL as,de,efermi,emax,emin,qmt,sigma,totdos,efermiPrev
REAL e_up,e_lo,e_test1,e_test2,fac,sumwei,dk,eFermiCorrection REAL e_up,e_lo,e_test1,e_test2,fac,sumwei,dk,eFermiCorrection
LOGICAL l_tria,l_orbcomp,l_error LOGICAL l_tria,l_orbcomp,l_error
...@@ -146,7 +146,8 @@ ...@@ -146,7 +146,8 @@
qal(:,:,k) = 0.0 qal(:,:,k) = 0.0
qval(:,:,k) = 0.0 qval(:,:,k) = 0.0
ntb = max(ntb,results%neig(k,jspin)) jsp = MERGE(1,jspin,noco%l_noco)
ntb = max(ntb,results%neig(k,jsp))
IF (l_mcd) mcd_local(:,:,k) = RESHAPE(mcd%mcd(:,1:ncored,:,k,jspin),(/3*atoms%ntype*ncored,dimension%neigd/)) IF (l_mcd) mcd_local(:,:,k) = RESHAPE(mcd%mcd(:,1:ncored,:,k,jspin),(/3*atoms%ntype*ncored,dimension%neigd/))
IF (.NOT.l_orbcomp) THEN IF (.NOT.l_orbcomp) THEN
qal(1:lmax*atoms%ntype,:,k)=reshape(dos%qal(0:,:,:,k,jspin),(/lmax*atoms%ntype,size(dos%qal,3)/)) qal(1:lmax*atoms%ntype,:,k)=reshape(dos%qal(0:,:,:,k,jspin),(/lmax*atoms%ntype,size(dos%qal,3)/))
...@@ -159,10 +160,10 @@ ...@@ -159,10 +160,10 @@
qal(slab%nsld+1:2*slab%nsld,:,k) = slab%qmtsl(:,:,k,jspin) qal(slab%nsld+1:2*slab%nsld,:,k) = slab%qmtsl(:,:,k,jspin)
ELSE ELSE
DO i = 1, 23 DO i = 1, 23
DO l = 1, results%neig(k,jspin) DO l = 1, results%neig(k,jsp)
qal(i,l,k) = orbcomp%comp(l,i,n_orb,k,jspin)*orbcomp%qmtp(l,n_orb,k,jspin)/10000. qal(i,l,k) = orbcomp%comp(l,i,n_orb,k,jspin)*orbcomp%qmtp(l,n_orb,k,jspin)/10000.
END DO END DO
DO l = results%neig(k,jspin)+1, dimension%neigd DO l = results%neig(k,jsp)+1, dimension%neigd
qal(i,l,k) = 0.0 qal(i,l,k) = 0.0
END DO END DO
END DO END DO
...@@ -178,7 +179,7 @@ ...@@ -178,7 +179,7 @@
qal(lmax*atoms%ntype+3,n,k) = 0.0 qal(lmax*atoms%ntype+3,n,k) = 0.0
ENDDO ENDDO
ELSEIF ( banddos%vacdos .and. input%film ) THEN ELSEIF ( banddos%vacdos .and. input%film ) THEN
DO i = 1,results%neig(k,jspin) DO i = 1,results%neig(k,jsp)
DO v = 1,vacuum%nvac DO v = 1,vacuum%nvac
DO l = 1,vacuum%layers DO l = 1,vacuum%layers
index = (l-1)*vacuum%nstars + (v-1)*(vacuum%nstars*vacuum%layers) + 1 index = (l-1)*vacuum%nstars + (v-1)*(vacuum%nstars*vacuum%layers) + 1
...@@ -213,10 +214,10 @@ ...@@ -213,10 +214,10 @@
! !
!---- > convert eigenvalues to ev and shift them by efermi !---- > convert eigenvalues to ev and shift them by efermi
! !
DO i = 1 , results%neig(k,jspin) DO i = 1 , results%neig(k,jsp)
ev(i,k) = results%eig(i,k,jspin)*hartree_to_ev_const - efermi ev(i,k) = results%eig(i,k,jsp)*hartree_to_ev_const - efermi
ENDDO ENDDO
DO i = results%neig(k,jspin) + 1, dimension%neigd DO i = results%neig(k,jsp) + 1, dimension%neigd
ev(i,k) = 9.9e+99 ev(i,k) = 9.9e+99
ENDDO ENDDO
! !
...@@ -225,7 +226,7 @@ ...@@ -225,7 +226,7 @@
! !
! calculate the triangles! ! calculate the triangles!
! !
IF ( jspin.EQ.1 ) THEN IF ( jspin.EQ.1 .AND. .FALSE.) THEN
l_tria=.true. l_tria=.true.
IF (input%film .AND. .NOT.oneD%odi%d1) THEN IF (input%film .AND. .NOT.oneD%odi%d1) THEN
CALL triang(kpts%bk,kpts%nkpt,itria,ntria,atr,as,l_tria) CALL triang(kpts%bk,kpts%nkpt,itria,ntria,atr,as,l_tria)
...@@ -282,6 +283,8 @@ ...@@ -282,6 +283,8 @@
67 CONTINUE ! tetrahedron-information read or created 67 CONTINUE ! tetrahedron-information read or created
ENDIF ENDIF
ENDIF ENDIF
l_tria = .false.
! !
IF ( .not.l_mcd ) THEN IF ( .not.l_mcd ) THEN
ALLOCATE (g(ned,qdim)) ALLOCATE (g(ned,qdim))
...@@ -304,7 +307,7 @@ ...@@ -304,7 +307,7 @@
ELSE ELSE
write(*,*) efermi write(*,*) efermi
CALL tetra_dos(lmax,atoms%ntype,dimension%neigd,ned,ntetra,kpts%nkpt,& CALL tetra_dos(lmax,atoms%ntype,dimension%neigd,ned,ntetra,kpts%nkpt,&
itetra,efermi,voltet,e,results%neig(:,jspin), ev,qal, g) itetra,efermi,voltet,e,results%neig(:,jsp), ev,qal, g)
IF (input%jspins.EQ.1) g(:,:) = 2 * g(:,:) IF (input%jspins.EQ.1) g(:,:) = 2 * g(:,:)
ENDIF ENDIF
ELSE ELSE
...@@ -313,10 +316,10 @@ ...@@ -313,10 +316,10 @@
! !
IF ( .not.l_mcd ) THEN IF ( .not.l_mcd ) THEN
CALL dos_bin(input%jspins,qdim,ned,emin,emax,dimension%neigd,kpts%nkpt,& CALL dos_bin(input%jspins,qdim,ned,emin,emax,dimension%neigd,kpts%nkpt,&
results%neig(:,jspin),kpts%wtkpt(1:kpts%nkpt),ev,qal, g) results%neig(:,jsp),kpts%wtkpt(1:kpts%nkpt),ev,qal, g)
ELSE ELSE
CALL dos_bin(input%jspins,3*atoms%ntype*ncored,ned,emin,emax,ntb,kpts%nkpt,& CALL dos_bin(input%jspins,3*atoms%ntype*ncored,ned,emin,emax,ntb,kpts%nkpt,&
results%neig(:,jspin),kpts%wtkpt(1:kpts%nkpt),ev(1:ntb,1:kpts%nkpt), mcd_local(1:3*atoms%ntype*ncored,1:ntb,1:kpts%nkpt), g) results%neig(:,jsp),kpts%wtkpt(1:kpts%nkpt),ev(1:ntb,1:kpts%nkpt), mcd_local(1:3*atoms%ntype*ncored,1:ntb,1:kpts%nkpt), g)
ENDIF ENDIF
ENDIF ENDIF
! !
......
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