Commit e76b6605 authored by Gregor Michalicek's avatar Gregor Michalicek

Eliminate the t_zmat type + make ChASE work with eigenvector storage

parent c83ccea4
......@@ -105,7 +105,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
TYPE (t_force) :: force
TYPE (t_eigVecCoeffs) :: eigVecCoeffs
TYPE (t_usdus) :: usdus
TYPE (t_zMat) :: zMat
TYPE (t_mat) :: zMat
TYPE (t_gVacMap) :: gVacMap
CALL timestart("cdnval")
......
......@@ -91,7 +91,7 @@ CONTAINS
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_zMat),INTENT(IN) :: zMat
TYPE(t_mat),INTENT(IN) :: zMat
TYPE(t_potden),INTENT(INOUT) :: den
TYPE(t_results),INTENT(INOUT) :: results
TYPE(t_dos), INTENT(INOUT) :: dos
......@@ -232,8 +232,8 @@ CONTAINS
q0_22 = zero
IF (.NOT.zmat%l_real ) THEN
DO nu = 1 , ne
q0_11 = q0_11 + we(nu) * CPP_BLAS_cdotc(lapw%nv(1),zMat%z_c(1,nu),1,zMat%z_c(1,nu),1)
q0_22 = q0_22 + we(nu) * CPP_BLAS_cdotc(lapw%nv(2),zMat%z_c(lapw%nv(1)+atoms%nlotot+1,nu),1, zMat%z_c(lapw%nv(1)+atoms%nlotot+1,nu),1)
q0_11 = q0_11 + we(nu) * CPP_BLAS_cdotc(lapw%nv(1),zMat%data_c(1,nu),1,zMat%data_c(1,nu),1)
q0_22 = q0_22 + we(nu) * CPP_BLAS_cdotc(lapw%nv(2),zMat%data_c(lapw%nv(1)+atoms%nlotot+1,nu),1, zMat%data_c(lapw%nv(1)+atoms%nlotot+1,nu),1)
ENDDO
ENDIF
q0_11 = q0_11/cell%omtil
......@@ -241,11 +241,11 @@ CONTAINS
ELSE
IF (zmat%l_real) THEN
DO nu = 1 , ne
q0=q0+we(nu)*CPP_BLAS_sdot(lapw%nv(jspin),zMat%z_r(1,nu),1,zMat%z_r(1,nu),1)
q0=q0+we(nu)*CPP_BLAS_sdot(lapw%nv(jspin),zMat%data_r(1,nu),1,zMat%data_r(1,nu),1)
ENDDO
ELSE
DO nu = 1 , ne
q0=q0+we(nu) *REAL(CPP_BLAS_cdotc(lapw%nv(jspin),zMat%z_c(1,nu),1,zMat%z_c(1,nu),1))
q0=q0+we(nu) *REAL(CPP_BLAS_cdotc(lapw%nv(jspin),zMat%data_c(1,nu),1,zMat%data_c(1,nu),1))
ENDDO
ENDIF
q0 = q0/cell%omtil
......@@ -315,19 +315,19 @@ CONTAINS
!------> map WF into FFTbox
IF (noco%l_ss) THEN
DO iv = 1 , lapw%nv(1)
psi1r( iv1d(iv,1) ) = REAL( zMat%z_c(iv,nu) )
psi1i( iv1d(iv,1) ) = AIMAG( zMat%z_c(iv,nu) )
psi1r( iv1d(iv,1) ) = REAL( zMat%data_c(iv,nu) )
psi1i( iv1d(iv,1) ) = AIMAG( zMat%data_c(iv,nu) )
ENDDO
DO iv = 1 , lapw%nv(2)
psi2r( iv1d(iv,2) ) = REAL(zMat%z_c(lapw%nv(1)+atoms%nlotot+iv,nu))
psi2i( iv1d(iv,2) ) = AIMAG(zMat%z_c(lapw%nv(1)+atoms%nlotot+iv,nu))
psi2r( iv1d(iv,2) ) = REAL(zMat%data_c(lapw%nv(1)+atoms%nlotot+iv,nu))
psi2i( iv1d(iv,2) ) = AIMAG(zMat%data_c(lapw%nv(1)+atoms%nlotot+iv,nu))
ENDDO
ELSE
DO iv = 1 , lapw%nv(jspin)
psi1r( iv1d(iv,jspin) ) = REAL( zMat%z_c(iv,nu) )
psi1i( iv1d(iv,jspin) ) = AIMAG( zMat%z_c(iv,nu) )
psi2r(iv1d(iv,jspin))=REAL( zMat%z_c(lapw%nv(1)+atoms%nlotot+iv,nu))
psi2i(iv1d(iv,jspin))=AIMAG(zMat%z_c(lapw%nv(1)+atoms%nlotot+iv,nu))
psi1r( iv1d(iv,jspin) ) = REAL( zMat%data_c(iv,nu) )
psi1i( iv1d(iv,jspin) ) = AIMAG( zMat%data_c(iv,nu) )
psi2r(iv1d(iv,jspin))=REAL( zMat%data_c(lapw%nv(1)+atoms%nlotot+iv,nu))
psi2i(iv1d(iv,jspin))=AIMAG(zMat%data_c(lapw%nv(1)+atoms%nlotot+iv,nu))
ENDDO
ENDIF
......@@ -337,12 +337,12 @@ CONTAINS
!------> map WF into FFTbox
IF (zmat%l_real) THEN
DO iv = 1 , lapw%nv(jspin)
psir( iv1d(iv,jspin) ) = zMat%z_r(iv,nu)
psir( iv1d(iv,jspin) ) = zMat%data_r(iv,nu)
ENDDO
ELSE
DO iv = 1 , lapw%nv(jspin)
psir( iv1d(iv,jspin) ) = REAL(zMat%z_c(iv,nu))
psii( iv1d(iv,jspin) ) = AIMAG(zMat%z_c(iv,nu))
psir( iv1d(iv,jspin) ) = REAL(zMat%data_c(iv,nu))
psii( iv1d(iv,jspin) ) = AIMAG(zMat%data_c(iv,nu))
ENDDO
ENDIF
ENDIF
......@@ -384,7 +384,7 @@ CONTAINS
DO i = 1,3
s = s + xk(i)*cell%bmat(i,j)
ENDDO
kpsir( iv1d(iv,jspin) ) = s * zMat%z_r(iv,nu)
kpsir( iv1d(iv,jspin) ) = s * zMat%data_r(iv,nu)
ENDDO
CALL rfft(isn,stars%kq1_fft,stars%kq2_fft,stars%kq3_fft+1,stars%kq1_fft,stars%kq2_fft,stars%kq3_fft,&
nw1,nw2,nw3,wsave,kpsir(ifftq3d), kpsir(-ifftq2))
......@@ -427,8 +427,8 @@ CONTAINS
DO i = 1,3
s = s + xk(i)*cell%bmat(i,j)
ENDDO
kpsir( iv1d(iv,jspin) ) = s * REAL(zMat%z_c(iv,nu))
kpsii( iv1d(iv,jspin) ) = s * AIMAG(zMat%z_c(iv,nu))
kpsir( iv1d(iv,jspin) ) = s * REAL(zMat%data_c(iv,nu))
kpsii( iv1d(iv,jspin) ) = s * AIMAG(zMat%data_c(iv,nu))
ENDDO
!--------------------------------
......@@ -668,12 +668,12 @@ CONTAINS
IF ( ABS( q0 - REAL(cwk(1)) )/q0 .GT. tol_3 ) THEN
WRITE(99,*) "XX:",ne,lapw%nv
IF (zmat%l_real) THEN
DO istr=1,SIZE(zMat%z_r,2)
WRITE(99,*) "X:",istr,zMat%z_r(:,istr)
DO istr=1,SIZE(zMat%data_r,2)
WRITE(99,*) "X:",istr,zMat%data_r(:,istr)
ENDDO
ELSE
DO istr=1,SIZE(zMat%z_c,2)
WRITE(99,*) "X:",istr,zMat%z_c(:,istr)
DO istr=1,SIZE(zMat%data_c,2)
WRITE(99,*) "X:",istr,zMat%data_c(:,istr)
ENDDO
ENDIF
WRITE ( 6,'(''bad quality of charge density'',2f13.8)')q0, REAL( cwk(1) )
......
......@@ -19,7 +19,7 @@ CONTAINS
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_zMat),INTENT(IN) :: zMat
TYPE(t_mat),INTENT(IN) :: zMat
TYPE(t_slab),INTENT(INOUT):: slab
!
! .. Scalar Arguments ..
......@@ -65,11 +65,11 @@ CONTAINS
q1 = 0.0
IF (zmat%l_real) THEN
DO i = 1,lapw%nv(isp)
q1 = q1 + zMat%z_r(i,n)*zMat%z_r(i,n)
q1 = q1 + zMat%data_r(i,n)*zMat%data_r(i,n)
ENDDO
ELSE
DO i = 1,lapw%nv(isp)
q1 = q1 + REAL(zMat%z_c(i,n)*CONJG(zMat%z_c(i,n)))
q1 = q1 + REAL(zMat%data_c(i,n)*CONJG(zMat%data_c(i,n)))
ENDDO
ENDIF
z_z(1) = q1/cell%omtil
......@@ -90,11 +90,11 @@ CONTAINS
phase = stars%rgphs(ix1,iy1,iz1)/ (stars%nstr(ind)*cell%omtil)
phasep = stars%rgphs(-ix1,-iy1,-iz1)/ (stars%nstr(indp)*cell%omtil)
IF (zmat%l_real) THEN
z_z(ind) = z_z(ind) + zMat%z_r(j,n)*zMat%z_r(i,n)*REAL(phase)
z_z(indp) = z_z(indp) + zMat%z_r(i,n)*zMat%z_r(j,n)*REAL(phasep)
z_z(ind) = z_z(ind) + zMat%data_r(j,n)*zMat%data_r(i,n)*REAL(phase)
z_z(indp) = z_z(indp) + zMat%data_r(i,n)*zMat%data_r(j,n)*REAL(phasep)
ELSE
z_z(ind) = z_z(ind) +zMat%z_c(j,n)*CONJG(zMat%z_c(i,n))*phase
z_z(indp)= z_z(indp)+zMat%z_c(i,n)*CONJG(zMat%z_c(j,n))*phasep
z_z(ind) = z_z(ind) +zMat%data_c(j,n)*CONJG(zMat%data_c(i,n))*phase
z_z(indp)= z_z(indp)+zMat%data_c(i,n)*CONJG(zMat%data_c(j,n))*phasep
ENDIF
ENDDO
ENDDO
......
......@@ -59,7 +59,7 @@ CONTAINS
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_zMat),INTENT(IN) :: zMat
TYPE(t_mat),INTENT(IN) :: zMat
TYPE(t_gVacMap),INTENT(IN) :: gVacMap
TYPE(t_potden),INTENT(INOUT) :: den
TYPE(t_dos), INTENT(INOUT) :: dos
......@@ -317,11 +317,11 @@ CONTAINS
t_1(l,m)*stars%sk2(irec2)*dbss(m),0.0)/&
((wronk_1)*SQRT(cell%omtil))
IF (zmat%l_real) THEN
ac_1(l,m,:ne,ispin) = ac_1(l,m,:ne,ispin) + zMat%z_r(kspin,:ne)*av_1
bc_1(l,m,:ne,ispin) = bc_1(l,m,:ne,ispin) + zMat%z_r(kspin,:ne)*bv_1
ac_1(l,m,:ne,ispin) = ac_1(l,m,:ne,ispin) + zMat%data_r(kspin,:ne)*av_1
bc_1(l,m,:ne,ispin) = bc_1(l,m,:ne,ispin) + zMat%data_r(kspin,:ne)*bv_1
ELSE
ac_1(l,m,:ne,ispin) = ac_1(l,m,:ne,ispin) + zMat%z_c(kspin,:ne)*av_1
bc_1(l,m,:ne,ispin) = bc_1(l,m,:ne,ispin) + zMat%z_c(kspin,:ne)*bv_1
ac_1(l,m,:ne,ispin) = ac_1(l,m,:ne,ispin) + zMat%data_c(kspin,:ne)*av_1
bc_1(l,m,:ne,ispin) = bc_1(l,m,:ne,ispin) + zMat%data_c(kspin,:ne)*bv_1
END IF
END DO ! -mb:mb
END IF
......@@ -360,11 +360,11 @@ CONTAINS
bv = c_1 * CMPLX( dt(l),zks* t(l) )
! -----> loop over basis functions
IF (zmat%l_real) THEN
ac(l,:ne,ispin) = ac(l,:ne,ispin) + zMat%z_r(kspin,:ne)*av
bc(l,:ne,ispin) = bc(l,:ne,ispin) + zMat%z_r(kspin,:ne)*bv
ac(l,:ne,ispin) = ac(l,:ne,ispin) + zMat%data_r(kspin,:ne)*av
bc(l,:ne,ispin) = bc(l,:ne,ispin) + zMat%data_r(kspin,:ne)*bv
ELSE
ac(l,:ne,ispin) = ac(l,:ne,ispin) + zMat%z_c(kspin,:ne)*av
bc(l,:ne,ispin) = bc(l,:ne,ispin) + zMat%z_c(kspin,:ne)*bv
ac(l,:ne,ispin) = ac(l,:ne,ispin) + zMat%data_c(kspin,:ne)*av
bc(l,:ne,ispin) = bc(l,:ne,ispin) + zMat%data_c(kspin,:ne)*bv
ENDIF
ENDDO
!---> end of spin loop
......@@ -417,11 +417,11 @@ CONTAINS
t_1(l,m)*stars%sk2(irec2)*dbss(m),0.0)/&
((wronk_1)*SQRT(cell%omtil))
IF (zmat%l_real) THEN
ac_1(l,m,:ne,jspin) = ac_1(l,m,:ne,jspin) + zMat%z_r(k,:ne)*av_1
bc_1(l,m,:ne,jspin) = bc_1(l,m,:ne,jspin) + zMat%z_r(k,:ne)*bv_1
ac_1(l,m,:ne,jspin) = ac_1(l,m,:ne,jspin) + zMat%data_r(k,:ne)*av_1
bc_1(l,m,:ne,jspin) = bc_1(l,m,:ne,jspin) + zMat%data_r(k,:ne)*bv_1
ELSE
ac_1(l,m,:ne,jspin) = ac_1(l,m,:ne,jspin) + zMat%z_c(k,:ne)*av_1
bc_1(l,m,:ne,jspin) = bc_1(l,m,:ne,jspin) + zMat%z_c(k,:ne)*bv_1
ac_1(l,m,:ne,jspin) = ac_1(l,m,:ne,jspin) + zMat%data_c(k,:ne)*av_1
bc_1(l,m,:ne,jspin) = bc_1(l,m,:ne,jspin) + zMat%data_c(k,:ne)*bv_1
ENDIF
END DO ! -mb:mb
END IF
......@@ -455,11 +455,11 @@ CONTAINS
bv = c_1 * CMPLX( dt(l),zks* t(l) )
! -----> loop over basis functions
IF (zmat%l_real) THEN
ac(l,:ne,jspin) = ac(l,:ne,jspin) + zMat%z_r(k,:ne)*av
bc(l,:ne,jspin) = bc(l,:ne,jspin) + zMat%z_r(k,:ne)*bv
ac(l,:ne,jspin) = ac(l,:ne,jspin) + zMat%data_r(k,:ne)*av
bc(l,:ne,jspin) = bc(l,:ne,jspin) + zMat%data_r(k,:ne)*bv
ELSE
ac(l,:ne,jspin) = ac(l,:ne,jspin) + zMat%z_c(k,:ne)*av
bc(l,:ne,jspin) = bc(l,:ne,jspin) + zMat%z_c(k,:ne)*bv
ac(l,:ne,jspin) = ac(l,:ne,jspin) + zMat%data_c(k,:ne)*av
bc(l,:ne,jspin) = bc(l,:ne,jspin) + zMat%data_c(k,:ne)*bv
ENDIF
ENDDO
END IF ! D1
......
......@@ -33,7 +33,7 @@ CONTAINS
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_lapw), INTENT(IN) :: lapw
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_zMat), INTENT(IN) :: zMat
TYPE(t_mat), INTENT(IN) :: zMat
TYPE(t_force), OPTIONAL, INTENT(INOUT) :: force
! .. Scalar Arguments ..
......@@ -70,15 +70,15 @@ CONTAINS
!+gu_con
IF (noco%l_noco) THEN
IF (noco%l_ss) THEN
ctmp = term1*CONJG(ylm(ll1+m+1))*ccchi(iintsp)*zMat%z_c(lapw%nv(1)+atoms%nlotot+nbasf,i)
ctmp = term1*CONJG(ylm(ll1+m+1))*ccchi(iintsp)*zMat%data_c(lapw%nv(1)+atoms%nlotot+nbasf,i)
ELSE
ctmp = term1*CONJG(ylm(ll1+m+1))*( ccchi(1)*zMat%z_c(nbasf,i)+ccchi(2)*zMat%z_c(lapw%nv(1)+atoms%nlotot+nbasf,i) )
ctmp = term1*CONJG(ylm(ll1+m+1))*( ccchi(1)*zMat%data_c(nbasf,i)+ccchi(2)*zMat%data_c(lapw%nv(1)+atoms%nlotot+nbasf,i) )
ENDIF
ELSE
IF (zMat%l_real) THEN
ctmp = zMat%z_r(nbasf,i)*term1*CONJG(ylm(ll1+m+1))
ctmp = zMat%data_r(nbasf,i)*term1*CONJG(ylm(ll1+m+1))
ELSE
ctmp = zMat%z_c(nbasf,i)*term1*CONJG(ylm(ll1+m+1))
ctmp = zMat%data_c(nbasf,i)*term1*CONJG(ylm(ll1+m+1))
ENDIF
ENDIF
acof(i,lm,na) = acof(i,lm,na) + ctmp*alo1(lo)
......
......@@ -24,7 +24,7 @@ CONTAINS
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_zMat),INTENT(IN) :: zMat
TYPE(t_mat),INTENT(IN) :: zMat
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: iintsp
......@@ -88,15 +88,15 @@ CONTAINS
lm = ll1 + m
IF (noco%l_noco) THEN
IF (noco%l_ss) THEN
ctmp = clotmp(m)* ccchi(iintsp)*zMat%z_c(kspin+nbasf,ie)
ctmp = clotmp(m)* ccchi(iintsp)*zMat%data_c(kspin+nbasf,ie)
ELSE
ctmp = clotmp(m)*( ccchi(1)*zMat%z_c(nbasf,ie)+ccchi(2)*zMat%z_c(kspin+nbasf,ie) )
ctmp = clotmp(m)*( ccchi(1)*zMat%data_c(nbasf,ie)+ccchi(2)*zMat%data_c(kspin+nbasf,ie) )
ENDIF
ELSE
IF (zmat%l_real) THEN
ctmp = zMat%z_r(nbasf,ie)*clotmp(m)
ctmp = zMat%data_r(nbasf,ie)*clotmp(m)
ELSE
ctmp = zMat%z_c(nbasf,ie)*clotmp(m)
ctmp = zMat%data_c(nbasf,ie)*clotmp(m)
ENDIF
ENDIF
acof(ie,lm,na) = acof(ie,lm,na) +ctmp*alo1(lo,ntyp)
......@@ -136,15 +136,15 @@ CONTAINS
lm = ll1 + m
IF (noco%l_noco) THEN
IF (noco%l_ss) THEN
ctmp = clotmp(m)*ccchi(iintsp)*zMat%z_c(kspin+nbasf,ie)
ctmp = clotmp(m)*ccchi(iintsp)*zMat%data_c(kspin+nbasf,ie)
ELSE
ctmp = clotmp(m)*( ccchi(1)*zMat%z_c(nbasf,ie)+ccchi(2)*zMat%z_c(kspin+nbasf,ie) )
ctmp = clotmp(m)*( ccchi(1)*zMat%data_c(nbasf,ie)+ccchi(2)*zMat%data_c(kspin+nbasf,ie) )
ENDIF
ELSE
IF (zmat%l_real) THEN
ctmp = zMat%z_r(nbasf,ie)*clotmp(m)
ctmp = zMat%data_r(nbasf,ie)*clotmp(m)
ELSE
ctmp = zMat%z_c(nbasf,ie)*clotmp(m)
ctmp = zMat%data_c(nbasf,ie)*clotmp(m)
END IF
ENDIF
acof(ie,lm,na) = acof(ie,lm,na) +ctmp*alo1(lo,ntyp)
......@@ -158,7 +158,7 @@ CONTAINS
cveccof(i,m,ie,lo,na)=cveccof(i,m,ie,lo,na)+fgp(i)*ctmp*clo1(lo,ntyp)
ENDDO
IF (noco%l_soc.AND.sym%invs) THEN
ctmp = zMat%z_c(nbasf,ie) * CONJG(clotmp(m))*(-1)**(l-m)
ctmp = zMat%data_c(nbasf,ie) * CONJG(clotmp(m))*(-1)**(l-m)
na2 = sym%invsatnr(na)
lmp = ll1 - m
acof(ie,lmp,na2) = acof(ie,lmp,na2) +ctmp*alo1(lo,ntyp)
......
......@@ -25,7 +25,7 @@ CONTAINS
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_zMat),INTENT(IN) :: zMat
TYPE(t_mat),INTENT(IN) :: zMat
TYPE(t_force),OPTIONAL,INTENT(INOUT) :: force
! ..
! .. Scalar Arguments ..
......@@ -138,9 +138,9 @@ CONTAINS
DO k = 1,nvmax
IF (.NOT.noco%l_noco) THEN
IF (zmat%l_real) THEN
work_r(:ne)=zMat%z_r(k,:ne)
work_r(:ne)=zMat%data_r(k,:ne)
ELSE
work_c(:ne)=zMat%z_c(k,:ne)
work_c(:ne)=zMat%data_c(k,:ne)
END IF
ENDIF
......@@ -155,7 +155,7 @@ CONTAINS
!---> stored in the second half of the eigenvector
kspin = (iintsp-1)*(lapw%nv(1)+atoms%nlotot)
DO i = 1,ne
work_c(i) = ccchi(iintsp,jspin)*zMat%z_c(kspin+k,i)
work_c(i) = ccchi(iintsp,jspin)*zMat%data_c(kspin+k,i)
ENDDO
ELSE
!---> perform sum over the two interstitial spin directions
......@@ -163,8 +163,8 @@ CONTAINS
!---> (jspin counts the local spin directions inside each MT)
kspin = lapw%nv(1)+atoms%nlotot
DO i = 1,ne
work_c(i) = ccchi(1,jspin)*zMat%z_c(k,i)&
& + ccchi(2,jspin)*zMat%z_c(kspin+k,i)
work_c(i) = ccchi(1,jspin)*zMat%data_c(k,i)&
& + ccchi(2,jspin)*zMat%data_c(kspin+k,i)
ENDDO
ENDIF
ENDIF ! (noco%l_noco)
......
......@@ -32,7 +32,7 @@ IMPLICIT NONE
CONTAINS
SUBROUTINE chase_diag(mpi,hmat,smat,ikpt,jsp,chase_eig_id,ne,eig,zmat)
SUBROUTINE chase_diag(mpi,hmat,smat,ikpt,jsp,chase_eig_id,iter,ne,eig,zmat)
USE m_types
USE m_types_mpi
......@@ -47,11 +47,12 @@ IMPLICIT NONE
INTEGER, INTENT(IN) :: ikpt
INTEGER, INTENT(IN) :: jsp
INTEGER, INTENT(IN) :: chase_eig_id
INTEGER, INTENT(IN) :: iter
INTEGER, INTENT(INOUT) :: ne
CLASS(t_mat), ALLOCATABLE, INTENT(OUT) :: zmat
REAL, INTENT(OUT) :: eig(:)
INTEGER :: i, j, nev, nex
INTEGER :: i, j, nev, nex, nbands
INTEGER :: info
CLASS(t_Mat), ALLOCATABLE :: zMatTemp
......@@ -96,20 +97,18 @@ IMPLICIT NONE
hmat%data_r(j,i) = hmat%data_r(i,j)
end do
end do
! if(first_entry_franza) then
if(iter.EQ.1) then
call chase_r(hmat%data_r, hmat%matsize1, zMatTemp%data_r, eigenvalues, nev, nex, 25, 1e-10, 'R', 'S' )
! else
! load eigenvectors,...
! call chase_r(hmat%data_r, hmat%matsize1, zMatTemp%data_r, eigenvalues, nev, nex, 25, 1e-10, 'A', 'S' )
! end if
else
CALL read_eig(chase_eig_id,ikpt,jsp,n_start=mpi%n_size,n_end=mpi%n_rank,neig=nbands,eig=eigenvalues,zmat=zMatTemp)
call chase_r(hmat%data_r, hmat%matsize1, zMatTemp%data_r, eigenvalues, nev, nex, 25, 1e-10, 'A', 'S' )
end if
ne = nev
CALL write_eig(chase_eig_id,ikpt,jsp,nev+nex,nev+nex,&
eigenvalues(:(nev+nex)),n_start=mpi%n_size,n_end=mpi%n_rank,zmat=zMatTemp)
!TODO: Store eigenvectors array to reuse it in next iteration
! --> recover the generalized eigenvectors z by solving z' = l^t * z
CALL dtrtrs('U','N','N',hmat%matsize1,nev,smat%data_r,smat%matsize1,zMatTemp%data_r,zmat%matsize1,info)
IF (info.NE.0) THEN
......@@ -153,11 +152,12 @@ IMPLICIT NONE
end do
end do
! if(first_entry_franza) then
if(iter.EQ.1) then
call chase_c(hmat%data_c, hmat%matsize1, zMatTemp%data_c, eigenvalues, nev, nex, 25, 1e-10, 'R', 'S' )
! else
! call chase_c(hmat%data_c, hmat%matsize1, zMatTemp%data_c, eigenvalues, nev, nex, 25, 1e-10, 'A', 'S' )
! end if
else
CALL read_eig(chase_eig_id,ikpt,jsp,n_start=mpi%n_size,n_end=mpi%n_rank,neig=nbands,eig=eigenvalues,zmat=zMatTemp)
call chase_c(hmat%data_c, hmat%matsize1, zMatTemp%data_c, eigenvalues, nev, nex, 25, 1e-10, 'A', 'S' )
end if
ne = nev
......
......@@ -39,7 +39,7 @@ CONTAINS
parallel_solver_available=any((/diag_elpa,diag_elemental,diag_scalapack/)>0)
END FUNCTION parallel_solver_available
SUBROUTINE eigen_diag(mpi,hmat,smat,ikpt,jsp,chase_eig_id,ne,eig,ev)
SUBROUTINE eigen_diag(mpi,hmat,smat,ikpt,jsp,chase_eig_id,iter,ne,eig,ev)
USE m_lapack_diag
USE m_magma
USE m_elpa
......@@ -58,6 +58,7 @@ CONTAINS
INTEGER, INTENT(IN) :: ikpt
INTEGER, INTENT(IN) :: jsp
INTEGER, INTENT(IN) :: chase_eig_id
INTEGER, INTENT(IN) :: iter
INTEGER, INTENT(INOUT) :: ne
REAL, INTENT(OUT) :: eig(:)
......@@ -85,7 +86,7 @@ CONTAINS
CALL lapack_diag(hmat,smat,ne,eig,ev)
CASE (diag_chase)
#ifdef CPP_CHASE
CALL chase_diag(mpi,hmat,smat,ikpt,jsp,chase_eig_id,ne,eig,ev)
CALL chase_diag(mpi,hmat,smat,ikpt,jsp,chase_eig_id,iter,ne,eig,ev)
#else
CALL juDFT_error('ChASE eigensolver selected but not available', calledby = 'eigen_diag')
#endif
......
......@@ -31,7 +31,7 @@ CONTAINS
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_zMat),INTENT(IN) :: zMat
TYPE(t_mat),INTENT(IN) :: zMat
!
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: ne,jspin
......@@ -129,16 +129,16 @@ CONTAINS
norm(i)=0.0
IF (soc) THEN
DO k=1,lapw%nv(jspin)*2
norm(i)=norm(i)+ABS(zMat%z_c(k,i))**2
norm(i)=norm(i)+ABS(zMat%data_c(k,i))**2
ENDDO
ELSE
IF (zmat%l_real) THEN
DO k=1,lapw%nv(jspin)
norm(i)=norm(i)+ABS(zMat%z_r(k,i))**2
norm(i)=norm(i)+ABS(zMat%data_r(k,i))**2
ENDDO
ELSE
DO k=1,lapw%nv(jspin)
norm(i)=norm(i)+ABS(zMat%z_c(k,i))**2
norm(i)=norm(i)+ABS(zMat%data_c(k,i))**2
ENDDO
ENDIF
ENDIF
......@@ -166,22 +166,22 @@ CONTAINS
DO n2=1,ndeg
IF (zmat%l_real) THEN
DO k=1,lapw%nv(jspin)
csum(n1,n2,c)=csum(n1,n2,c)+zMat%z_r(k,deg(n1))*&
zMat%z_r(gmap(k,c),deg(n2))/(norm(deg(n1))*norm(deg(n2)))
csum(n1,n2,c)=csum(n1,n2,c)+zMat%data_r(k,deg(n1))*&
zMat%data_r(gmap(k,c),deg(n2))/(norm(deg(n1))*norm(deg(n2)))
END DO
ELSE
IF (soc) THEN
DO k=1,lapw%nv(jspin)
csum(n1,n2,c)=csum(n1,n2,c)+(CONJG(zMat%z_c(k,deg(n1)))*&
(su(1,1,c)*zMat%z_c(gmap(k,c),deg(n2))+ su(1,2,c)*zMat%z_c(gmap(k,c)+lapw%nv(jspin),deg(n2)))+&
CONJG(zMat%z_c(k+lapw%nv(jspin),deg(n1)))* (su(2,1,c)*zMat%z_c(gmap(k,c),deg(n2))+&
su(2,2,c)*zMat%z_c(gmap(k,c)+lapw%nv(jspin),deg(n2))))/ (norm(deg(n1))*norm(deg(n2)))
csum(n1,n2,c)=csum(n1,n2,c)+(CONJG(zMat%data_c(k,deg(n1)))*&
(su(1,1,c)*zMat%data_c(gmap(k,c),deg(n2))+ su(1,2,c)*zMat%data_c(gmap(k,c)+lapw%nv(jspin),deg(n2)))+&
CONJG(zMat%data_c(k+lapw%nv(jspin),deg(n1)))* (su(2,1,c)*zMat%data_c(gmap(k,c),deg(n2))+&
su(2,2,c)*zMat%data_c(gmap(k,c)+lapw%nv(jspin),deg(n2))))/ (norm(deg(n1))*norm(deg(n2)))
END DO
ELSE
DO k=1,lapw%nv(jspin)
csum(n1,n2,c)=csum(n1,n2,c)+CONJG(zMat%z_c(k,deg(n1)))*&
zMat%z_c(gmap(k,c),deg(n2))/(norm(deg(n1))*norm(deg(n2)))
csum(n1,n2,c)=csum(n1,n2,c)+CONJG(zMat%data_c(k,deg(n1)))*&
zMat%data_c(gmap(k,c),deg(n2))/(norm(deg(n1))*norm(deg(n2)))
END DO
ENDIF
ENDIF
......
......@@ -19,7 +19,7 @@ CONTAINS
!> The matrices generated and diagonalized here are of type m_mat as defined in m_types_mat.
!>@author D. Wortmann
SUBROUTINE eigen(mpi,stars,sphhar,atoms,obsolete,xcpot,sym,kpts,DIMENSION,vacuum,input,&
cell,enpara,banddos,noco,oneD,hybrid,it,eig_id,chase_eig_id,results,inden,v,vx)
cell,enpara,banddos,noco,oneD,hybrid,iter,eig_id,chase_eig_id,results,inden,v,vx)
USE m_constants, ONLY : pi_const,sfp_const
USE m_types
......@@ -67,7 +67,7 @@ CONTAINS
#endif
! ..
! .. Scalar Arguments ..
INTEGER,INTENT(IN) :: it
INTEGER,INTENT(IN) :: iter
INTEGER,INTENT(INOUT) :: eig_id
INTEGER,INTENT(INOUT) :: chase_eig_id
! ..
......@@ -75,7 +75,7 @@ CONTAINS
!+odim
! ..
! .. Local Scalars ..
INTEGER jsp,nk,nred,ne_all,ne_found,nevd,nexd
INTEGER jsp,nk,nred,ne_all,ne_found
INTEGER ne,lh0
INTEGER isp,i,j,err
LOGICAL l_wu,l_file,l_real,l_zref
......@@ -113,7 +113,7 @@ CONTAINS
#ifdef CPP_MPI
CALL mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,v)
#endif
!IF (mpi%irank.EQ.0) CALL openXMLElementFormPoly('iteration',(/'numberForCurrentRun','overallNumber '/),(/it,v%iter/),&
!IF (mpi%irank.EQ.0) CALL openXMLElementFormPoly('iteration',(/'numberForCurrentRun','overallNumber '/),(/iter,v%iter/),&
! RESHAPE((/19,13,5,5/),(/2,2/)))
eig_id=open_eig(&
......@@ -123,16 +123,6 @@ CONTAINS
nsld=atoms%nat,nat=atoms%nat,l_dos=banddos%dos.OR.input%cdinf,l_mcd=banddos%l_mcd,&
l_orb=banddos%l_orb)
IF (juDFT_was_argument("-diag:chase")) THEN
nevd = min(dimension%neigd,dimension%nvd+atoms%nlotot)
nexd = min(max(nevd/4, 45),dimension%nvd+atoms%nlotot-nevd) !dimensioning for workspace
chase_eig_id=open_eig(mpi%mpi_comm,DIMENSION%nbasfcn,nevd+nexd,kpts%nkpt,DIMENSION%jspd,atoms%lmaxd,&
atoms%nlod,atoms%ntype,atoms%nlotot,noco%l_noco,.TRUE.,l_real,noco%l_soc,.FALSE.,&
mpi%n_size,layers=vacuum%layers,nstars=vacuum%nstars,ncored=DIMENSION%nstd,&
nsld=atoms%nat,nat=atoms%nat,l_dos=banddos%dos.OR.input%cdinf,l_mcd=banddos%l_mcd,&
l_orb=banddos%l_orb)
END IF
!---> set up and solve the eigenvalue problem
!---> loop over spins
!---> set up k-point independent t(l'm',lm) matrices
......@@ -173,7 +163,7 @@ CONTAINS
l_wu=.FALSE.
ne_all=DIMENSION%neigd
if (allocated(zmat)) deallocate(zmat)
CALL eigen_diag(mpi,hmat,smat,nk,jsp,chase_eig_id,ne_all,eig,zMat)
CALL eigen_diag(mpi,hmat,smat,nk,jsp,chase_eig_id,iter,ne_all,eig,zMat)
DEALLOCATE(hmat,smat)
!
!---> output results
......
......@@ -44,7 +44,7 @@ CONTAINS
TYPE(t_usdus),INTENT(IN) :: usdus
TYPE(t_tlmplm),INTENT(IN) :: tlmplm
TYPE(t_lapw),INTENT(INOUT) :: lapw
TYPE(t_zMat),INTENT(INOUT) :: zMat
TYPE(t_mat),INTENT(INOUT) :: zMat
! ..
! .. Scalar Arguments ..
......@@ -90,7 +90,7 @@ CONTAINS
! first have to undo this complex conjugation for the
! multiplication with a and b matrices.
zmat%z_c=conjg(zmat%z_c)
zmat%data_c=conjg(zmat%data_c)
ALLOCATE ( h_c(DIMENSION%neigd,DIMENSION%neigd),s_c(DIMENSION%neigd,DIMENSION%neigd) )
h_c = 0.0 ; s_c=0.0
ALLOCATE ( help_r(lhelp) )
......@@ -98,30 +98,30 @@ CONTAINS
!
DO i = 1,ne
IF (l_real) THEN
help_r=MATMUL(hmat%data_r,zmat%z_r(:,i))
help_r=MATMUL(hmat%data_r,zmat%data_r(:,i))
ELSE
help_c=MATMUL(hmat%data_c,zmat%z_c(:,i))
help_c=MATMUL(hmat%data_c,zmat%data_c(:,i))
ENDIF
DO j = i,ne
IF (l_real) THEN
h_r(j,i)=dot_PRODUCT(zmat%z_r(:,j),help_r)
h_r(j,i)=dot_PRODUCT(zmat%data_r(:,j),help_r)
ELSE
h_c(j,i)=dot_PRODUCT(zmat%z_c(:,j),help_c)
h_c(j,i)=dot_PRODUCT(zmat%data_c(:,j),help_c)
ENDIF
END DO
END DO
DO i = 1,ne
IF (l_real) THEN
help_r=MATMUL(smat%data_r,zmat%z_r(:,i))
help_r=MATMUL(smat%data_r,zmat%data_r(:,i))
ELSE
help_c=MATMUL(smat%data_c,zmat%z_c(:,i))
help_c=MATMUL(smat%data_c,zmat%data_c(:,i))
ENDIF
DO