Commit c9a840fc authored by Gregor Michalicek's avatar Gregor Michalicek

Add missing indizes to arrays in t_dos type

parent a60be6e5
......@@ -247,7 +247,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
CALL eparas(ispin,atoms,noccbd,mpi,ikpt,noccbd,we,eig,&
skip_t,cdnvalKLoop%l_evp,eigVecCoeffs,usdus,regCharges,dos,mcd,banddos%l_mcd)
IF (noco%l_mperp.AND.(ispin==jsp_end)) CALL qal_21(dimension,atoms,input,noccbd,noco,eigVecCoeffs,denCoeffsOffdiag,dos)
IF (noco%l_mperp.AND.(ispin==jsp_end)) CALL qal_21(dimension,atoms,input,noccbd,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
......
......@@ -67,7 +67,7 @@ CONTAINS
regCharges%sqal(:,:,jsp) = 0.0
regCharges%enerlo(:,:,jsp) = 0.0
regCharges%sqlo(:,:,jsp) = 0.0
dos%qal(:,:,:,jsp) = 0.0
dos%qal(:,:,:,ikpt,jsp) = 0.0
END IF
!
!---> l-decomposed density for each occupied state
......@@ -110,7 +110,7 @@ CONTAINS
ENDDO
ENDIF ! end MCD
ENDDO
dos%qal(l,n,i,jsp) = (suma+sumb*usdus%ddn(l,n,jsp))/atoms%neq(n)
dos%qal(l,n,i,ikpt,jsp) = (suma+sumb*usdus%ddn(l,n,jsp))/atoms%neq(n)
ENDDO
nt1 = nt1 + atoms%neq(n)
ENDDO
......@@ -123,8 +123,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,jsp)*we(i)*eig(i)
regCharges%sqal(l,n,jsp) = regCharges%sqal(l,n,jsp) + dos%qal(l,n,i,jsp)*we(i)
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)
ENDDO
ENDDO
ENDDO
......@@ -177,7 +177,7 @@ CONTAINS
! llo > 3 used for unoccupied states only
IF( l .GT. 3 ) CYCLE
DO i = 1,ne
dos%qal(l,ntyp,i,jsp)= dos%qal(l,ntyp,i,jsp) + ( 1.0/atoms%neq(ntyp) )* (&
dos%qal(l,ntyp,i,ikpt,jsp)= dos%qal(l,ntyp,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)
......@@ -185,7 +185,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,jsp)= dos%qal(l,ntyp,i,jsp) + ( 1.0/atoms%neq(ntyp) ) *&
dos%qal(l,ntyp,i,ikpt,jsp)= dos%qal(l,ntyp,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,dos)
SUBROUTINE qal_21(dimension,atoms,input,noccbd,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos)
USE m_rotdenmat
USE m_types
......@@ -19,7 +19,7 @@ CONTAINS
TYPE(t_dos), INTENT(INOUT) :: dos
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: noccbd
INTEGER, INTENT (IN) :: noccbd,ikpt
! .. Local Scalars ..
INTEGER i,l,lo,lop ,natom,nn,ntyp
......@@ -149,10 +149,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,1),dos%qal(l,n,i,2),qal21(l,n,i))
dos%qal(l,n,i,ikpt,1),dos%qal(l,n,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,:)
q_loc(1,1) = dos%qal(l,n,i,1); q_loc(2,2) = dos%qal(l,n,i,2)
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)
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)
......
......@@ -70,14 +70,14 @@ CONTAINS
INTEGER,PARAMETER :: n2max=13
REAL,PARAMETER :: emax=2.0/hartree_to_ev_const
! .. Array Arguments ..
REAL, INTENT(IN) :: evac(2,DIMENSION%jspd)
REAL, INTENT(OUT) :: qvlay(DIMENSION%neigd,vacuum%layerd,2,kpts%nkpt,DIMENSION%jspd)
REAL, INTENT(INOUT) :: qvac(DIMENSION%neigd,2,kpts%nkpt,DIMENSION%jspd)
REAL, INTENT(IN) :: we(DIMENSION%neigd)
REAL :: vz(vacuum%nmzd,2) ! Note this breaks the INTENT(IN) from cdnval. It may be read from a file in this subroutine.
REAL, INTENT(IN) :: evac(2,DIMENSION%jspd)
REAL, INTENT(OUT) :: qvlay(DIMENSION%neigd,vacuum%layerd,2,kpts%nkpt,DIMENSION%jspd)
REAL, INTENT(INOUT) :: qvac(DIMENSION%neigd,2,kpts%nkpt,DIMENSION%jspd)
REAL, INTENT(IN) :: we(DIMENSION%neigd)
REAL :: vz(vacuum%nmzd,2) ! Note this breaks the INTENT(IN) from cdnval. It may be read from a file in this subroutine.
! STM-Arguments
REAL, INTENT (IN) :: eig(DIMENSION%neigd)
COMPLEX, INTENT (OUT):: stcoeff(vacuum%nstars,DIMENSION%neigd,vacuum%layerd,2)
REAL, INTENT (IN) :: eig(DIMENSION%neigd)
COMPLEX, INTENT (INOUT) :: stcoeff(vacuum%nstars,DIMENSION%neigd,vacuum%layerd,2,kpts%nkpt,input%jspins)
!
! local STM variables
INTEGER nv2(DIMENSION%jspd)
......@@ -170,8 +170,6 @@ CONTAINS
! ------------------
! WRITE (16,'(a,i2)') 'nstars=',nstars
stcoeff(:,:,:,:) = CMPLX(0.0,0.0)
! -----> set up mapping arrays
IF (noco%l_ss) THEN
jsp_start = 1
......@@ -1198,7 +1196,7 @@ CONTAINS
!=============================================================
!
! calculate 1. to nstars. starcoefficient for each k and energy eigenvalue
! to stcoeff(ne,layer,ivac) if starcoeff=T (the star coefficient values are written to vacdos)
! to stcoeff(ne,layer,ivac,ikpt) if starcoeff=T (the star coefficient values are written to vacdos)
!
IF (vacuum%starcoeff .AND. banddos%vacdos) THEN
DO n=1,ne
......@@ -1229,9 +1227,9 @@ CONTAINS
uej = ue(vacuum%izlay(jj,1),l1,jspin)
t1 = aa*ui*uj + bb*uei*uej +ba*ui*uej + ab*uei*uj
IF (ind2.GE.2.AND.ind2.LE.vacuum%nstars) &
stcoeff(ind2-1,n,jj,ivac) = stcoeff(ind2-1,n,jj,ivac)+ t1*phs/stars%nstr2(ind2)
stcoeff(ind2-1,n,jj,ivac,ikpt,jspin) = stcoeff(ind2-1,n,jj,ivac,ikpt,jspin)+ t1*phs/stars%nstr2(ind2)
IF (ind2p.GE.2.AND.ind2p.LE.vacuum%nstars) &
stcoeff(ind2p-1,n,jj,ivac) = stcoeff(ind2p-1,n,jj,ivac) +CONJG(t1)*phs/stars%nstr2(ind2p)
stcoeff(ind2p-1,n,jj,ivac,ikpt,jspin) = stcoeff(ind2p-1,n,jj,ivac,ikpt,jspin) +CONJG(t1)*phs/stars%nstr2(ind2p)
END DO
END IF
ENDDO
......
......@@ -183,20 +183,20 @@ CONTAINS
CALL timestart("IO (dos-write)")
SELECT CASE (eig66_data_mode(id))
CASE (da_mode)
CALL write_dos_DA(id,nk,jspin,dos%qal(:,:,:,jspin),dos%qvac(:,:,nk,jspin),&
dos%qis(:,nk,jspin),dos%qvlay(:,:,:,nk,jspin),dos%qstars,&
CALL write_dos_DA(id,nk,jspin,dos%qal(:,:,:,nk,jspin),dos%qvac(:,:,nk,jspin),&
dos%qis(:,nk,jspin),dos%qvlay(:,:,:,nk,jspin),dos%qstars(:,:,:,:,nk,jspin),&
ksym,jsym,mcd,slab%qintsl,slab%qmtsl,orbcomp%qmtp,orbcomp%comp)
CASE (hdf_mode)
CALL write_dos_HDF(id,nk,jspin,dos%qal(:,:,:,jspin),dos%qvac(:,:,nk,jspin),&
dos%qis(:,nk,jspin),dos%qvlay(:,:,:,nk,jspin),dos%qstars,&
CALL write_dos_HDF(id,nk,jspin,dos%qal(:,:,:,nk,jspin),dos%qvac(:,:,nk,jspin),&
dos%qis(:,nk,jspin),dos%qvlay(:,:,:,nk,jspin),dos%qstars(:,:,:,:,nk,jspin),&
ksym,jsym,mcd,slab%qintsl,slab%qmtsl,orbcomp%qmtp,orbcomp%comp)
CASE (mem_mode)
CALL write_dos_Mem(id,nk,jspin,dos%qal(:,:,:,jspin),dos%qvac(:,:,nk,jspin),&
dos%qis(:,nk,jspin),dos%qvlay(:,:,:,nk,jspin),dos%qstars,&
CALL write_dos_Mem(id,nk,jspin,dos%qal(:,:,:,nk,jspin),dos%qvac(:,:,nk,jspin),&
dos%qis(:,nk,jspin),dos%qvlay(:,:,:,nk,jspin),dos%qstars(:,:,:,:,nk,jspin),&
ksym,jsym,mcd,slab%qintsl,slab%qmtsl,orbcomp%qmtp,orbcomp%comp)
CASE (MPI_mode)
CALL write_dos_MPI(id,nk,jspin,dos%qal(:,:,:,jspin),dos%qvac(:,:,nk,jspin),&
dos%qis(:,nk,jspin),dos%qvlay(:,:,:,nk,jspin),dos%qstars,&
CALL write_dos_MPI(id,nk,jspin,dos%qal(:,:,:,nk,jspin),dos%qvac(:,:,nk,jspin),&
dos%qis(:,nk,jspin),dos%qvlay(:,:,:,nk,jspin),dos%qstars(:,:,:,:,nk,jspin),&
ksym,jsym,mcd,slab%qintsl,slab%qmtsl,orbcomp%qmtp,orbcomp%comp)
CASE (-1)
CALL juDFT_error("Could not write DOS to eig-file before opening", calledby = "eig66_io")
......
......@@ -12,10 +12,10 @@ PRIVATE
TYPE t_dos
REAL, ALLOCATABLE :: qis(:,:,:)
REAL, ALLOCATABLE :: qal(:,:,:,:)
REAL, ALLOCATABLE :: qal(:,:,:,:,:)
REAL, ALLOCATABLE :: qvac(:,:,:,:)
REAL, ALLOCATABLE :: qvlay(:,:,:,:,:)
COMPLEX, ALLOCATABLE :: qstars(:,:,:,:)
COMPLEX, ALLOCATABLE :: qstars(:,:,:,:,:,:)
CONTAINS
PROCEDURE,PASS :: init => dos_init
......@@ -40,10 +40,10 @@ SUBROUTINE dos_init(thisDOS,input,atoms,dimension,kpts,vacuum)
TYPE(t_vacuum), INTENT(IN) :: vacuum
ALLOCATE(thisDOS%qis(dimension%neigd,kpts%nkpt,input%jspins))
ALLOCATE(thisDOS%qal(0:3,atoms%ntype,dimension%neigd,input%jspins))
ALLOCATE(thisDOS%qal(0:3,atoms%ntype,dimension%neigd,kpts%nkpt,input%jspins))
ALLOCATE(thisDOS%qvac(dimension%neigd,2,kpts%nkpt,input%jspins))
ALLOCATE(thisDOS%qvlay(dimension%neigd,vacuum%layerd,2,kpts%nkpt,input%jspins))
ALLOCATE(thisDOS%qstars(vacuum%nstars,dimension%neigd,vacuum%layerd,2))
ALLOCATE(thisDOS%qstars(vacuum%nstars,dimension%neigd,vacuum%layerd,2,kpts%nkpt,input%jspins))
thisDOS%qis = 0.0
thisDOS%qal = 0.0
......
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