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 ...@@ -105,7 +105,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
TYPE (t_force) :: force TYPE (t_force) :: force
TYPE (t_eigVecCoeffs) :: eigVecCoeffs TYPE (t_eigVecCoeffs) :: eigVecCoeffs
TYPE (t_usdus) :: usdus TYPE (t_usdus) :: usdus
TYPE (t_zMat) :: zMat TYPE (t_mat) :: zMat
TYPE (t_gVacMap) :: gVacMap TYPE (t_gVacMap) :: gVacMap
CALL timestart("cdnval") CALL timestart("cdnval")
......
...@@ -91,7 +91,7 @@ CONTAINS ...@@ -91,7 +91,7 @@ CONTAINS
TYPE(t_cell),INTENT(IN) :: cell TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_kpts),INTENT(IN) :: kpts TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms 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_potden),INTENT(INOUT) :: den
TYPE(t_results),INTENT(INOUT) :: results TYPE(t_results),INTENT(INOUT) :: results
TYPE(t_dos), INTENT(INOUT) :: dos TYPE(t_dos), INTENT(INOUT) :: dos
...@@ -232,8 +232,8 @@ CONTAINS ...@@ -232,8 +232,8 @@ CONTAINS
q0_22 = zero q0_22 = zero
IF (.NOT.zmat%l_real ) THEN IF (.NOT.zmat%l_real ) THEN
DO nu = 1 , ne 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_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%z_c(lapw%nv(1)+atoms%nlotot+1,nu),1, zMat%z_c(lapw%nv(1)+atoms%nlotot+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 ENDDO
ENDIF ENDIF
q0_11 = q0_11/cell%omtil q0_11 = q0_11/cell%omtil
...@@ -241,11 +241,11 @@ CONTAINS ...@@ -241,11 +241,11 @@ CONTAINS
ELSE ELSE
IF (zmat%l_real) THEN IF (zmat%l_real) THEN
DO nu = 1 , ne 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 ENDDO
ELSE ELSE
DO nu = 1 , ne 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 ENDDO
ENDIF ENDIF
q0 = q0/cell%omtil q0 = q0/cell%omtil
...@@ -315,19 +315,19 @@ CONTAINS ...@@ -315,19 +315,19 @@ CONTAINS
!------> map WF into FFTbox !------> map WF into FFTbox
IF (noco%l_ss) THEN IF (noco%l_ss) THEN
DO iv = 1 , lapw%nv(1) DO iv = 1 , lapw%nv(1)
psi1r( iv1d(iv,1) ) = REAL( zMat%z_c(iv,nu) ) psi1r( iv1d(iv,1) ) = REAL( zMat%data_c(iv,nu) )
psi1i( iv1d(iv,1) ) = AIMAG( zMat%z_c(iv,nu) ) psi1i( iv1d(iv,1) ) = AIMAG( zMat%data_c(iv,nu) )
ENDDO ENDDO
DO iv = 1 , lapw%nv(2) DO iv = 1 , lapw%nv(2)
psi2r( iv1d(iv,2) ) = REAL(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%z_c(lapw%nv(1)+atoms%nlotot+iv,nu)) psi2i( iv1d(iv,2) ) = AIMAG(zMat%data_c(lapw%nv(1)+atoms%nlotot+iv,nu))
ENDDO ENDDO
ELSE ELSE
DO iv = 1 , lapw%nv(jspin) DO iv = 1 , lapw%nv(jspin)
psi1r( iv1d(iv,jspin) ) = REAL( zMat%z_c(iv,nu) ) psi1r( iv1d(iv,jspin) ) = REAL( zMat%data_c(iv,nu) )
psi1i( iv1d(iv,jspin) ) = AIMAG( zMat%z_c(iv,nu) ) psi1i( iv1d(iv,jspin) ) = AIMAG( zMat%data_c(iv,nu) )
psi2r(iv1d(iv,jspin))=REAL( zMat%z_c(lapw%nv(1)+atoms%nlotot+iv,nu)) psi2r(iv1d(iv,jspin))=REAL( zMat%data_c(lapw%nv(1)+atoms%nlotot+iv,nu))
psi2i(iv1d(iv,jspin))=AIMAG(zMat%z_c(lapw%nv(1)+atoms%nlotot+iv,nu)) psi2i(iv1d(iv,jspin))=AIMAG(zMat%data_c(lapw%nv(1)+atoms%nlotot+iv,nu))
ENDDO ENDDO
ENDIF ENDIF
...@@ -337,12 +337,12 @@ CONTAINS ...@@ -337,12 +337,12 @@ CONTAINS
!------> map WF into FFTbox !------> map WF into FFTbox
IF (zmat%l_real) THEN IF (zmat%l_real) THEN
DO iv = 1 , lapw%nv(jspin) 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 ENDDO
ELSE ELSE
DO iv = 1 , lapw%nv(jspin) DO iv = 1 , lapw%nv(jspin)
psir( iv1d(iv,jspin) ) = REAL(zMat%z_c(iv,nu)) psir( iv1d(iv,jspin) ) = REAL(zMat%data_c(iv,nu))
psii( iv1d(iv,jspin) ) = AIMAG(zMat%z_c(iv,nu)) psii( iv1d(iv,jspin) ) = AIMAG(zMat%data_c(iv,nu))
ENDDO ENDDO
ENDIF ENDIF
ENDIF ENDIF
...@@ -384,7 +384,7 @@ CONTAINS ...@@ -384,7 +384,7 @@ CONTAINS
DO i = 1,3 DO i = 1,3
s = s + xk(i)*cell%bmat(i,j) s = s + xk(i)*cell%bmat(i,j)
ENDDO ENDDO
kpsir( iv1d(iv,jspin) ) = s * zMat%z_r(iv,nu) kpsir( iv1d(iv,jspin) ) = s * zMat%data_r(iv,nu)
ENDDO ENDDO
CALL rfft(isn,stars%kq1_fft,stars%kq2_fft,stars%kq3_fft+1,stars%kq1_fft,stars%kq2_fft,stars%kq3_fft,& 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)) nw1,nw2,nw3,wsave,kpsir(ifftq3d), kpsir(-ifftq2))
...@@ -427,8 +427,8 @@ CONTAINS ...@@ -427,8 +427,8 @@ CONTAINS
DO i = 1,3 DO i = 1,3
s = s + xk(i)*cell%bmat(i,j) s = s + xk(i)*cell%bmat(i,j)
ENDDO ENDDO
kpsir( iv1d(iv,jspin) ) = s * REAL(zMat%z_c(iv,nu)) kpsir( iv1d(iv,jspin) ) = s * REAL(zMat%data_c(iv,nu))
kpsii( iv1d(iv,jspin) ) = s * AIMAG(zMat%z_c(iv,nu)) kpsii( iv1d(iv,jspin) ) = s * AIMAG(zMat%data_c(iv,nu))
ENDDO ENDDO
!-------------------------------- !--------------------------------
...@@ -668,12 +668,12 @@ CONTAINS ...@@ -668,12 +668,12 @@ CONTAINS
IF ( ABS( q0 - REAL(cwk(1)) )/q0 .GT. tol_3 ) THEN IF ( ABS( q0 - REAL(cwk(1)) )/q0 .GT. tol_3 ) THEN
WRITE(99,*) "XX:",ne,lapw%nv WRITE(99,*) "XX:",ne,lapw%nv
IF (zmat%l_real) THEN IF (zmat%l_real) THEN
DO istr=1,SIZE(zMat%z_r,2) DO istr=1,SIZE(zMat%data_r,2)
WRITE(99,*) "X:",istr,zMat%z_r(:,istr) WRITE(99,*) "X:",istr,zMat%data_r(:,istr)
ENDDO ENDDO
ELSE ELSE
DO istr=1,SIZE(zMat%z_c,2) DO istr=1,SIZE(zMat%data_c,2)
WRITE(99,*) "X:",istr,zMat%z_c(:,istr) WRITE(99,*) "X:",istr,zMat%data_c(:,istr)
ENDDO ENDDO
ENDIF ENDIF
WRITE ( 6,'(''bad quality of charge density'',2f13.8)')q0, REAL( cwk(1) ) WRITE ( 6,'(''bad quality of charge density'',2f13.8)')q0, REAL( cwk(1) )
......
...@@ -19,7 +19,7 @@ CONTAINS ...@@ -19,7 +19,7 @@ CONTAINS
TYPE(t_stars),INTENT(IN) :: stars TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_zMat),INTENT(IN) :: zMat TYPE(t_mat),INTENT(IN) :: zMat
TYPE(t_slab),INTENT(INOUT):: slab TYPE(t_slab),INTENT(INOUT):: slab
! !
! .. Scalar Arguments .. ! .. Scalar Arguments ..
...@@ -65,11 +65,11 @@ CONTAINS ...@@ -65,11 +65,11 @@ CONTAINS
q1 = 0.0 q1 = 0.0
IF (zmat%l_real) THEN IF (zmat%l_real) THEN
DO i = 1,lapw%nv(isp) 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 ENDDO
ELSE ELSE
DO i = 1,lapw%nv(isp) 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 ENDDO
ENDIF ENDIF
z_z(1) = q1/cell%omtil z_z(1) = q1/cell%omtil
...@@ -90,11 +90,11 @@ CONTAINS ...@@ -90,11 +90,11 @@ CONTAINS
phase = stars%rgphs(ix1,iy1,iz1)/ (stars%nstr(ind)*cell%omtil) phase = stars%rgphs(ix1,iy1,iz1)/ (stars%nstr(ind)*cell%omtil)
phasep = stars%rgphs(-ix1,-iy1,-iz1)/ (stars%nstr(indp)*cell%omtil) phasep = stars%rgphs(-ix1,-iy1,-iz1)/ (stars%nstr(indp)*cell%omtil)
IF (zmat%l_real) THEN 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(ind) = z_z(ind) + zMat%data_r(j,n)*zMat%data_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(indp) = z_z(indp) + zMat%data_r(i,n)*zMat%data_r(j,n)*REAL(phasep)
ELSE ELSE
z_z(ind) = z_z(ind) +zMat%z_c(j,n)*CONJG(zMat%z_c(i,n))*phase 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%z_c(i,n)*CONJG(zMat%z_c(j,n))*phasep z_z(indp)= z_z(indp)+zMat%data_c(i,n)*CONJG(zMat%data_c(j,n))*phasep
ENDIF ENDIF
ENDDO ENDDO
ENDDO ENDDO
......
...@@ -59,7 +59,7 @@ CONTAINS ...@@ -59,7 +59,7 @@ CONTAINS
TYPE(t_cell),INTENT(IN) :: cell TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_kpts),INTENT(IN) :: kpts TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms 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_gVacMap),INTENT(IN) :: gVacMap
TYPE(t_potden),INTENT(INOUT) :: den TYPE(t_potden),INTENT(INOUT) :: den
TYPE(t_dos), INTENT(INOUT) :: dos TYPE(t_dos), INTENT(INOUT) :: dos
...@@ -317,11 +317,11 @@ CONTAINS ...@@ -317,11 +317,11 @@ CONTAINS
t_1(l,m)*stars%sk2(irec2)*dbss(m),0.0)/& t_1(l,m)*stars%sk2(irec2)*dbss(m),0.0)/&
((wronk_1)*SQRT(cell%omtil)) ((wronk_1)*SQRT(cell%omtil))
IF (zmat%l_real) THEN IF (zmat%l_real) THEN
ac_1(l,m,:ne,ispin) = ac_1(l,m,:ne,ispin) + zMat%z_r(kspin,:ne)*av_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%z_r(kspin,:ne)*bv_1 bc_1(l,m,:ne,ispin) = bc_1(l,m,:ne,ispin) + zMat%data_r(kspin,:ne)*bv_1
ELSE ELSE
ac_1(l,m,:ne,ispin) = ac_1(l,m,:ne,ispin) + zMat%z_c(kspin,:ne)*av_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%z_c(kspin,:ne)*bv_1 bc_1(l,m,:ne,ispin) = bc_1(l,m,:ne,ispin) + zMat%data_c(kspin,:ne)*bv_1
END IF END IF
END DO ! -mb:mb END DO ! -mb:mb
END IF END IF
...@@ -360,11 +360,11 @@ CONTAINS ...@@ -360,11 +360,11 @@ CONTAINS
bv = c_1 * CMPLX( dt(l),zks* t(l) ) bv = c_1 * CMPLX( dt(l),zks* t(l) )
! -----> loop over basis functions ! -----> loop over basis functions
IF (zmat%l_real) THEN IF (zmat%l_real) THEN
ac(l,:ne,ispin) = ac(l,:ne,ispin) + zMat%z_r(kspin,:ne)*av ac(l,:ne,ispin) = ac(l,:ne,ispin) + zMat%data_r(kspin,:ne)*av
bc(l,:ne,ispin) = bc(l,:ne,ispin) + zMat%z_r(kspin,:ne)*bv bc(l,:ne,ispin) = bc(l,:ne,ispin) + zMat%data_r(kspin,:ne)*bv
ELSE ELSE
ac(l,:ne,ispin) = ac(l,:ne,ispin) + zMat%z_c(kspin,:ne)*av ac(l,:ne,ispin) = ac(l,:ne,ispin) + zMat%data_c(kspin,:ne)*av
bc(l,:ne,ispin) = bc(l,:ne,ispin) + zMat%z_c(kspin,:ne)*bv bc(l,:ne,ispin) = bc(l,:ne,ispin) + zMat%data_c(kspin,:ne)*bv
ENDIF ENDIF
ENDDO ENDDO
!---> end of spin loop !---> end of spin loop
...@@ -417,11 +417,11 @@ CONTAINS ...@@ -417,11 +417,11 @@ CONTAINS
t_1(l,m)*stars%sk2(irec2)*dbss(m),0.0)/& t_1(l,m)*stars%sk2(irec2)*dbss(m),0.0)/&
((wronk_1)*SQRT(cell%omtil)) ((wronk_1)*SQRT(cell%omtil))
IF (zmat%l_real) THEN IF (zmat%l_real) THEN
ac_1(l,m,:ne,jspin) = ac_1(l,m,:ne,jspin) + zMat%z_r(k,:ne)*av_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%z_r(k,:ne)*bv_1 bc_1(l,m,:ne,jspin) = bc_1(l,m,:ne,jspin) + zMat%data_r(k,:ne)*bv_1
ELSE ELSE
ac_1(l,m,:ne,jspin) = ac_1(l,m,:ne,jspin) + zMat%z_c(k,:ne)*av_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%z_c(k,:ne)*bv_1 bc_1(l,m,:ne,jspin) = bc_1(l,m,:ne,jspin) + zMat%data_c(k,:ne)*bv_1
ENDIF ENDIF
END DO ! -mb:mb END DO ! -mb:mb
END IF END IF
...@@ -455,11 +455,11 @@ CONTAINS ...@@ -455,11 +455,11 @@ CONTAINS
bv = c_1 * CMPLX( dt(l),zks* t(l) ) bv = c_1 * CMPLX( dt(l),zks* t(l) )
! -----> loop over basis functions ! -----> loop over basis functions
IF (zmat%l_real) THEN IF (zmat%l_real) THEN
ac(l,:ne,jspin) = ac(l,:ne,jspin) + zMat%z_r(k,:ne)*av ac(l,:ne,jspin) = ac(l,:ne,jspin) + zMat%data_r(k,:ne)*av
bc(l,:ne,jspin) = bc(l,:ne,jspin) + zMat%z_r(k,:ne)*bv bc(l,:ne,jspin) = bc(l,:ne,jspin) + zMat%data_r(k,:ne)*bv
ELSE ELSE
ac(l,:ne,jspin) = ac(l,:ne,jspin) + zMat%z_c(k,:ne)*av ac(l,:ne,jspin) = ac(l,:ne,jspin) + zMat%data_c(k,:ne)*av
bc(l,:ne,jspin) = bc(l,:ne,jspin) + zMat%z_c(k,:ne)*bv bc(l,:ne,jspin) = bc(l,:ne,jspin) + zMat%data_c(k,:ne)*bv
ENDIF ENDIF
ENDDO ENDDO
END IF ! D1 END IF ! D1
......
...@@ -33,7 +33,7 @@ CONTAINS ...@@ -33,7 +33,7 @@ CONTAINS
TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_lapw), INTENT(IN) :: lapw TYPE(t_lapw), INTENT(IN) :: lapw
TYPE(t_cell), INTENT(IN) :: cell 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 TYPE(t_force), OPTIONAL, INTENT(INOUT) :: force
! .. Scalar Arguments .. ! .. Scalar Arguments ..
...@@ -70,15 +70,15 @@ CONTAINS ...@@ -70,15 +70,15 @@ CONTAINS
!+gu_con !+gu_con
IF (noco%l_noco) THEN IF (noco%l_noco) THEN
IF (noco%l_ss) 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 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 ENDIF
ELSE ELSE
IF (zMat%l_real) THEN 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 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
ENDIF ENDIF
acof(i,lm,na) = acof(i,lm,na) + ctmp*alo1(lo) acof(i,lm,na) = acof(i,lm,na) + ctmp*alo1(lo)
......
...@@ -24,7 +24,7 @@ CONTAINS ...@@ -24,7 +24,7 @@ CONTAINS
TYPE(t_noco),INTENT(IN) :: noco TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_zMat),INTENT(IN) :: zMat TYPE(t_mat),INTENT(IN) :: zMat
! .. ! ..
! .. Scalar Arguments .. ! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: iintsp INTEGER, INTENT (IN) :: iintsp
...@@ -88,15 +88,15 @@ CONTAINS ...@@ -88,15 +88,15 @@ CONTAINS
lm = ll1 + m lm = ll1 + m
IF (noco%l_noco) THEN IF (noco%l_noco) THEN
IF (noco%l_ss) 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 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 ENDIF
ELSE ELSE
IF (zmat%l_real) THEN IF (zmat%l_real) THEN
ctmp = zMat%z_r(nbasf,ie)*clotmp(m) ctmp = zMat%data_r(nbasf,ie)*clotmp(m)
ELSE ELSE
ctmp = zMat%z_c(nbasf,ie)*clotmp(m) ctmp = zMat%data_c(nbasf,ie)*clotmp(m)
ENDIF ENDIF
ENDIF ENDIF
acof(ie,lm,na) = acof(ie,lm,na) +ctmp*alo1(lo,ntyp) acof(ie,lm,na) = acof(ie,lm,na) +ctmp*alo1(lo,ntyp)
...@@ -136,15 +136,15 @@ CONTAINS ...@@ -136,15 +136,15 @@ CONTAINS
lm = ll1 + m lm = ll1 + m
IF (noco%l_noco) THEN IF (noco%l_noco) THEN
IF (noco%l_ss) 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 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 ENDIF
ELSE ELSE
IF (zmat%l_real) THEN IF (zmat%l_real) THEN
ctmp = zMat%z_r(nbasf,ie)*clotmp(m) ctmp = zMat%data_r(nbasf,ie)*clotmp(m)
ELSE ELSE
ctmp = zMat%z_c(nbasf,ie)*clotmp(m) ctmp = zMat%data_c(nbasf,ie)*clotmp(m)
END IF END IF
ENDIF ENDIF
acof(ie,lm,na) = acof(ie,lm,na) +ctmp*alo1(lo,ntyp) acof(ie,lm,na) = acof(ie,lm,na) +ctmp*alo1(lo,ntyp)
...@@ -158,7 +158,7 @@ CONTAINS ...@@ -158,7 +158,7 @@ CONTAINS
cveccof(i,m,ie,lo,na)=cveccof(i,m,ie,lo,na)+fgp(i)*ctmp*clo1(lo,ntyp) cveccof(i,m,ie,lo,na)=cveccof(i,m,ie,lo,na)+fgp(i)*ctmp*clo1(lo,ntyp)
ENDDO ENDDO
IF (noco%l_soc.AND.sym%invs) THEN 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) na2 = sym%invsatnr(na)
lmp = ll1 - m lmp = ll1 - m
acof(ie,lmp,na2) = acof(ie,lmp,na2) +ctmp*alo1(lo,ntyp) acof(ie,lmp,na2) = acof(ie,lmp,na2) +ctmp*alo1(lo,ntyp)
......
...@@ -25,7 +25,7 @@ CONTAINS ...@@ -25,7 +25,7 @@ CONTAINS
TYPE(t_sym),INTENT(IN) :: sym TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_atoms),INTENT(IN) :: atoms 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 TYPE(t_force),OPTIONAL,INTENT(INOUT) :: force
! .. ! ..
! .. Scalar Arguments .. ! .. Scalar Arguments ..
...@@ -138,9 +138,9 @@ CONTAINS ...@@ -138,9 +138,9 @@ CONTAINS
DO k = 1,nvmax DO k = 1,nvmax
IF (.NOT.noco%l_noco) THEN IF (.NOT.noco%l_noco) THEN
IF (zmat%l_real) THEN IF (zmat%l_real) THEN
work_r(:ne)=zMat%z_r(k,:ne) work_r(:ne)=zMat%data_r(k,:ne)
ELSE ELSE
work_c(:ne)=zMat%z_c(k,:ne) work_c(:ne)=zMat%data_c(k,:ne)
END IF END IF
ENDIF ENDIF
...@@ -155,7 +155,7 @@ CONTAINS ...@@ -155,7 +155,7 @@ CONTAINS
!---> stored in the second half of the eigenvector !---> stored in the second half of the eigenvector
kspin = (iintsp-1)*(lapw%nv(1)+atoms%nlotot) kspin = (iintsp-1)*(lapw%nv(1)+atoms%nlotot)
DO i = 1,ne 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 ENDDO
ELSE ELSE
!---> perform sum over the two interstitial spin directions !---> perform sum over the two interstitial spin directions
...@@ -163,8 +163,8 @@ CONTAINS ...@@ -163,8 +163,8 @@ CONTAINS
!---> (jspin counts the local spin directions inside each MT) !---> (jspin counts the local spin directions inside each MT)
kspin = lapw%nv(1)+atoms%nlotot kspin = lapw%nv(1)+atoms%nlotot
DO i = 1,ne DO i = 1,ne
work_c(i) = ccchi(1,jspin)*zMat%z_c(k,i)& work_c(i) = ccchi(1,jspin)*zMat%data_c(k,i)&
& + ccchi(2,jspin)*zMat%z_c(kspin+k,i) & + ccchi(2,jspin)*zMat%data_c(kspin+k,i)
ENDDO ENDDO
ENDIF ENDIF
ENDIF ! (noco%l_noco) ENDIF ! (noco%l_noco)
......
...@@ -32,7 +32,7 @@ IMPLICIT NONE ...@@ -32,7 +32,7 @@ IMPLICIT NONE
CONTAINS 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
USE m_types_mpi USE m_types_mpi
...@@ -47,11 +47,12 @@ IMPLICIT NONE ...@@ -47,11 +47,12 @@ IMPLICIT NONE
INTEGER, INTENT(IN) :: ikpt INTEGER, INTENT(IN) :: ikpt
INTEGER, INTENT(IN) :: jsp INTEGER, INTENT(IN) :: jsp
INTEGER, INTENT(IN) :: chase_eig_id INTEGER, INTENT(IN) :: chase_eig_id
INTEGER, INTENT(IN) :: iter
INTEGER, INTENT(INOUT) :: ne INTEGER, INTENT(INOUT) :: ne
CLASS(t_mat), ALLOCATABLE, INTENT(OUT) :: zmat CLASS(t_mat), ALLOCATABLE, INTENT(OUT) :: zmat
REAL, INTENT(OUT) :: eig(:) REAL, INTENT(OUT) :: eig(:)
INTEGER :: i, j, nev, nex INTEGER :: i, j, nev, nex, nbands
INTEGER :: info INTEGER :: info
CLASS(t_Mat), ALLOCATABLE :: zMatTemp CLASS(t_Mat), ALLOCATABLE :: zMatTemp
...@@ -96,20 +97,18 @@ IMPLICIT NONE ...@@ -96,20 +97,18 @@ IMPLICIT NONE
hmat%data_r(j,i) = hmat%data_r(i,j) hmat%data_r(j,i) = hmat%data_r(i,j)
end do end do
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' ) call chase_r(hmat%data_r, hmat%matsize1, zMatTemp%data_r, eigenvalues, nev, nex, 25, 1e-10, 'R', 'S' )
! else else
! load eigenvectors,... 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' ) call chase_r(hmat%data_r, hmat%matsize1, zMatTemp%data_r, eigenvalues, nev, nex, 25, 1e-10, 'A', 'S' )
! end if end if
ne = nev ne = nev
CALL write_eig(chase_eig_id,ikpt,jsp,nev+nex,nev+nex,& 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) 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 ! --> 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) CALL dtrtrs('U','N','N',hmat%matsize1,nev,smat%data_r,smat%matsize1,zMatTemp%data_r,zmat%matsize1,info)
IF (info.NE.0) THEN IF (info.NE.0) THEN
...@@ -153,11 +152,12 @@ IMPLICIT NONE ...@@ -153,11 +152,12 @@ IMPLICIT NONE
end do end do
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' ) call chase_c(hmat%data_c, hmat%matsize1, zMatTemp%data_c, eigenvalues, nev, nex, 25, 1e-10, 'R', 'S' )
! else else
! call chase_c(hmat%data_c, hmat%matsize1, zMatTemp%data_c, eigenvalues, nev, nex, 25, 1e-10, 'A', 'S' ) CALL read_eig(chase_eig_id,ikpt,jsp,n_start=mpi%n_size,n_end=mpi%n_rank,neig=nbands,eig=eigenvalues,zmat=zMatTemp)
! end if call chase_c(hmat%data_c, hmat%matsize1, zMatTemp%data_c, eigenvalues, nev, nex, 25, 1e-10, 'A', 'S' )
end if
ne = nev ne = nev
......
...@@ -39,7 +39,7 @@ CONTAINS ...@@ -39,7 +39,7 @@ CONTAINS
parallel_solver_available=any((/diag_elpa,diag_elemental,diag_scalapack/)>0) parallel_solver_available=any((/diag_elpa,diag_elemental,diag_scalapack/)>0)
END FUNCTION parallel_solver_available 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_lapack_diag
USE m_magma USE m_magma
USE m_elpa USE m_elpa
...@@ -58,6 +58,7 @@ CONTAINS ...@@ -58,6 +58,7 @@ CONTAINS
INTEGER, INTENT(IN) :: ikpt INTEGER, INTENT(IN) :: ikpt
INTEGER, INTENT(IN) :: jsp INTEGER, INTENT(IN) :: jsp
INTEGER, INTENT(IN) :: chase_eig_id INTEGER, INTENT(IN) :: chase_eig_id
INTEGER, INTENT(IN) :: iter
INTEGER, INTENT(INOUT) :: ne INTEGER, INTENT(INOUT) :: ne