From e76b66056b46e2e65458c8194206b69ab052e71e Mon Sep 17 00:00:00 2001 From: Gregor Michalicek Date: Mon, 4 Jun 2018 19:11:25 +0200 Subject: [PATCH] Eliminate the t_zmat type + make ChASE work with eigenvector storage --- cdn/cdnval.F90 | 2 +- cdn/pwden.F90 | 46 ++++++++++----------- cdn/q_int_sl.F90 | 14 +++---- cdn/vacden.F90 | 34 ++++++++-------- cdn_mt/abclocdn.F90 | 10 ++--- cdn_mt/abclocdn_pulay.F90 | 20 ++++----- cdn_mt/abcof.F90 | 12 +++--- diagonalization/chase_diag.F90 | 26 ++++++------ diagonalization/eigen_diag.F90 | 5 ++- dos/sympsi.F90 | 24 +++++------ eigen/eigen.F90 | 20 +++------ eigen_secvar/aline.F90 | 30 +++++++------- eigen_soc/alineso.F90 | 38 ++++++++--------- eigen_soc/hsohelp.F90 | 26 ++++++------ eigen_soc/ssomat.F90 | 13 +++--- global/types.F90 | 14 +++---- hybrid/gen_wavf.F90 | 12 +++--- hybrid/hf_setup.F90 | 22 +++++----- io/cdn_read.F | 2 +- io/eig66_da.F90 | 10 ++--- io/eig66_hdf.F90 | 6 +-- io/eig66_io.F90 | 2 +- io/eig66_mem.F90 | 18 ++++----- io/eig66_mpi.F90 | 12 +++--- main/fleur.F90 | 15 ++++++- wannier/wann_1dvacabcof.F | 10 ++--- wannier/wann_2dvacabcof.F | 10 ++--- wannier/wann_kptsrotate.F | 12 +++--- wannier/wann_maxbnd.F | 10 ++--- wannier/wann_mmk0_od_vac.F | 18 ++++----- wannier/wann_mmk0_vac.F | 10 ++--- wannier/wann_mmkb_int.F | 18 ++++----- wannier/wann_mmkb_od_vac.F | 34 ++++++++-------- wannier/wann_mmkb_vac.F | 18 ++++----- wannier/wann_plot.F | 2 +- wannier/wann_plot_um_dat.F | 26 ++++++------ wannier/wann_real.F | 6 +-- wannier/wann_rw_eig.F | 12 +++--- wannier/wann_updown.F | 46 ++++++++++----------- wannier/wannier.F | 74 +++++++++++++++++----------------- wannier/wannier_to_lapw.F | 30 +++++++------- 41 files changed, 386 insertions(+), 383 deletions(-) diff --git a/cdn/cdnval.F90 b/cdn/cdnval.F90 index 28fa3126..b1d5eb0d 100644 --- a/cdn/cdnval.F90 +++ b/cdn/cdnval.F90 @@ -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") diff --git a/cdn/pwden.F90 b/cdn/pwden.F90 index 766d177e..4e3c74c7 100644 --- a/cdn/pwden.F90 +++ b/cdn/pwden.F90 @@ -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) ) diff --git a/cdn/q_int_sl.F90 b/cdn/q_int_sl.F90 index a2e66f7c..9e098dbf 100644 --- a/cdn/q_int_sl.F90 +++ b/cdn/q_int_sl.F90 @@ -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 diff --git a/cdn/vacden.F90 b/cdn/vacden.F90 index 51d3af76..cb520b60 100644 --- a/cdn/vacden.F90 +++ b/cdn/vacden.F90 @@ -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 diff --git a/cdn_mt/abclocdn.F90 b/cdn_mt/abclocdn.F90 index b3575b19..8d03130d 100644 --- a/cdn_mt/abclocdn.F90 +++ b/cdn_mt/abclocdn.F90 @@ -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) diff --git a/cdn_mt/abclocdn_pulay.F90 b/cdn_mt/abclocdn_pulay.F90 index 56f24f3f..dbb14ec7 100644 --- a/cdn_mt/abclocdn_pulay.F90 +++ b/cdn_mt/abclocdn_pulay.F90 @@ -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) diff --git a/cdn_mt/abcof.F90 b/cdn_mt/abcof.F90 index 4ff4211a..f630e333 100644 --- a/cdn_mt/abcof.F90 +++ b/cdn_mt/abcof.F90 @@ -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) diff --git a/diagonalization/chase_diag.F90 b/diagonalization/chase_diag.F90 index 0726a2df..e8460161 100644 --- a/diagonalization/chase_diag.F90 +++ b/diagonalization/chase_diag.F90 @@ -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 diff --git a/diagonalization/eigen_diag.F90 b/diagonalization/eigen_diag.F90 index 774b9cfa..45183f50 100644 --- a/diagonalization/eigen_diag.F90 +++ b/diagonalization/eigen_diag.F90 @@ -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 diff --git a/dos/sympsi.F90 b/dos/sympsi.F90 index f54043f7..ab8c8b98 100644 --- a/dos/sympsi.F90 +++ b/dos/sympsi.F90 @@ -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 diff --git a/eigen/eigen.F90 b/eigen/eigen.F90 index f9082c0e..9c7099ea 100644 --- a/eigen/eigen.F90 +++ b/eigen/eigen.F90 @@ -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 diff --git a/eigen_secvar/aline.F90 b/eigen_secvar/aline.F90 index c092b634..522e5a4c 100644 --- a/eigen_secvar/aline.F90 +++ b/eigen_secvar/aline.F90 @@ -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 j = i,ne IF (l_real) THEN - s_r(j,i) = dot_product(zmat%z_r(:,j),help_r) + s_r(j,i) = dot_product(zmat%data_r(:,j),help_r) ELSE - s_c(j,i) =dot_PRODUCT(zmat%z_c(:,j),help_c) + s_c(j,i) =dot_PRODUCT(zmat%data_c(:,j),help_c) ENDIF END DO END DO @@ -130,7 +130,7 @@ CONTAINS ALLOCATE ( ccof(-atoms%llod:atoms%llod,DIMENSION%neigd,atoms%nlod,atoms%nat) ) ! conjugate again for use with abcof; finally use cdotc to revert again - IF (.NOT.l_real) zMat%z_c = CONJG(zMat%z_c) + IF (.NOT.l_real) zMat%data_c = CONJG(zMat%data_c) if (noco%l_soc) CALL juDFT_error("no SOC & reduced diagonalization",calledby="aline") CALL abcof(input,atoms,sym,cell,lapw,ne,& @@ -176,16 +176,16 @@ CONTAINS DO i = 1,lapw%nmat IF (l_real) THEN - help_r(:ne)=zMat%z_r(i,:ne) + help_r(:ne)=zMat%data_r(i,:ne) ELSE - help_c(:ne)=zMat%z_c(i,:ne) + help_c(:ne)=zMat%data_c(i,:ne) END IF DO j = 1,ne IF (l_real) THEN !---> for LAPACK call - zMat%z_r(i,j) = CPP_BLAS_sdot(ne,help_r,1,h_r(1,j),1) + zMat%data_r(i,j) = CPP_BLAS_sdot(ne,help_r,1,h_r(1,j),1) ELSE - zMat%z_c(i,j) = CPP_BLAS_cdotc(ne,help_c,1,h_c(1,j),1) + zMat%data_c(i,j) = CPP_BLAS_cdotc(ne,help_c,1,h_c(1,j),1) ENDIF END DO END DO diff --git a/eigen_soc/alineso.F90 b/eigen_soc/alineso.F90 index abc7db7f..97aa7ff3 100644 --- a/eigen_soc/alineso.F90 +++ b/eigen_soc/alineso.F90 @@ -60,7 +60,7 @@ CONTAINS COMPLEX,ALLOCATABLE :: hso(:,:),hsomtx(:,:,:,:) COMPLEX,ALLOCATABLE :: sigma_xc_apw(:,:),sigma_xc(:,:) - TYPE(t_zMAT)::zmat(dimension%jspd) + TYPE(t_mat)::zmat(dimension%jspd) ! .. ! .. External Subroutines .. EXTERNAL CPP_LAPACK_cheev @@ -75,24 +75,24 @@ CONTAINS l_real=sym%invs.and..not.noco%l_noco.and..not.(noco%l_soc.and.atoms%n_u>0) zmat%l_real=l_real - zMat(1:dimension%jspd)%nbasfcn=lapw%nv(1:dimension%jspd)+atoms%nlotot - zmat%nbands=dimension%neigd + zMat(1:dimension%jspd)%matsize1=lapw%nv(1:dimension%jspd)+atoms%nlotot + zmat%matsize2=dimension%neigd INQUIRE (4649,opened=l_socvec) INQUIRE (file='fleur.qsgw',exist=l_qsgw) if (l_real) THEN - ALLOCATE (zmat(1)%z_r(zmat(1)%nbasfcn,DIMENSION%neigd) ) - zmat(1)%z_r(:,:)= 0. + ALLOCATE (zmat(1)%data_r(zmat(1)%matsize1,DIMENSION%neigd) ) + zmat(1)%data_r(:,:)= 0. if (size(zmat)==2)THEN - ALLOCATE(zmat(2)%z_r(zmat(2)%nbasfcn,DIMENSION%neigd) ) - zmat(2)%z_r=0.0 + ALLOCATE(zmat(2)%data_r(zmat(2)%matsize1,DIMENSION%neigd) ) + zmat(2)%data_r=0.0 ENDIF else - ALLOCATE (zmat(1)%z_c(zmat(1)%nbasfcn,DIMENSION%neigd) ) - zmat(1)%z_c(:,:)= 0. + ALLOCATE (zmat(1)%data_c(zmat(1)%matsize1,DIMENSION%neigd) ) + zmat(1)%data_c(:,:)= 0. if (size(zmat)==2)THEN - ALLOCATE(zmat(2)%z_c(zmat(2)%nbasfcn,DIMENSION%neigd) ) - zmat(2)%z_c=0.0 + ALLOCATE(zmat(2)%data_c(zmat(2)%matsize1,DIMENSION%neigd) ) + zmat(2)%data_c=0.0 ENDIF endif zso(:,:,:)= CMPLX(0.,0.) @@ -228,12 +228,12 @@ CONTAINS j = nsz(1) * (jsp2-1) + 1 ; j1 = nsz(1) * jsp2 if (l_real) THEN sigma_xc(i:i1,j:j1) = & - & MATMUL ( TRANSPOSE(zmat(1)%z_r(:nbas,:)) ,& - & MATMUL ( sigma_xc_apw, zmat(1)%z_r(:nbas,:) ) ) + & MATMUL ( TRANSPOSE(zmat(1)%data_r(:nbas,:)) ,& + & MATMUL ( sigma_xc_apw, zmat(1)%data_r(:nbas,:) ) ) else sigma_xc(i:i1,j:j1) = & - & MATMUL ( CONJG(TRANSPOSE(zmat(1)%z_c(:nbas,:))) ,& - & MATMUL ( sigma_xc_apw, zmat(1)%z_c(:nbas,:) ) ) + & MATMUL ( CONJG(TRANSPOSE(zmat(1)%data_c(:nbas,:))) ,& + & MATMUL ( sigma_xc_apw, zmat(1)%data_c(:nbas,:) ) ) endif hso(i:i1,j:j1) = hso(i:i1,j:j1) + CONJG(sigma_xc(i:i1,j:j1)) IF(jsp1.NE.jsp2) THEN @@ -304,11 +304,11 @@ else ENDDO ! j if (l_real) THEN - CALL CPP_BLAS_cgemm("N","N",zmat(1)%nbasfcn,2*dimension%neigd,dimension%neigd,CMPLX(1.d0,0.d0),CMPLX(zmat(jsp)%z_r(:,:)),& - zmat(1)%nbasfcn, zhelp2,DIMENSION%neigd,CMPLX(0.d0,0.d0), zso(1,1,jsp2),zmat(1)%nbasfcn) + CALL CPP_BLAS_cgemm("N","N",zmat(1)%matsize1,2*dimension%neigd,dimension%neigd,CMPLX(1.d0,0.d0),CMPLX(zmat(jsp)%data_r(:,:)),& + zmat(1)%matsize1, zhelp2,DIMENSION%neigd,CMPLX(0.d0,0.d0), zso(1,1,jsp2),zmat(1)%matsize1) else - CALL CPP_BLAS_cgemm("N","N",zmat(1)%nbasfcn,2*dimension%neigd,dimension%neigd, CMPLX(1.d0,0.d0),zmat(jsp)%z_c(:,:),& - zmat(1)%nbasfcn, zhelp2,DIMENSION%neigd,CMPLX(0.d0,0.d0), zso(:,:,jsp2),zmat(1)%nbasfcn) + CALL CPP_BLAS_cgemm("N","N",zmat(1)%matsize1,2*dimension%neigd,dimension%neigd, CMPLX(1.d0,0.d0),zmat(jsp)%data_c(:,:),& + zmat(1)%matsize1, zhelp2,DIMENSION%neigd,CMPLX(0.d0,0.d0), zso(:,:,jsp2),zmat(1)%matsize1) endif ENDDO !isp diff --git a/eigen_soc/hsohelp.F90 b/eigen_soc/hsohelp.F90 index a24c8094..61da3efa 100644 --- a/eigen_soc/hsohelp.F90 +++ b/eigen_soc/hsohelp.F90 @@ -40,14 +40,14 @@ CONTAINS COMPLEX, INTENT (OUT):: ahelp(-atoms%lmaxd:atoms%lmaxd,atoms%lmaxd,atoms%nat,DIMENSION%neigd,DIMENSION%jspd) COMPLEX, INTENT (OUT):: bhelp(-atoms%lmaxd:atoms%lmaxd,atoms%lmaxd,atoms%nat,DIMENSION%neigd,DIMENSION%jspd) COMPLEX, INTENT (OUT):: chelp(-atoms%llod :atoms%llod, DIMENSION%neigd,atoms%nlod,atoms%nat, DIMENSION%jspd) - TYPE(t_zmat),INTENT(IN) :: zmat(:) ! (DIMENSION%nbasfcn,DIMENSION%neigd,DIMENSION%jspd) + TYPE(t_mat),INTENT(IN) :: zmat(:) ! (DIMENSION%nbasfcn,DIMENSION%neigd,DIMENSION%jspd) !-odim !+odim ! .. ! .. Locals .. TYPE(t_atoms) :: atoms_local TYPE(t_noco) :: noco_local - TYPE(t_zMat) :: zMat_local + TYPE(t_mat) :: zMat_local INTEGER ispin ,l,n ,na,ie,lm,ll1,nv1(DIMENSION%jspd),m,lmd INTEGER, ALLOCATABLE :: g1(:,:),g2(:,:),g3(:,:) COMPLEX, ALLOCATABLE :: acof(:,:,:),bcof(:,:,:) @@ -77,15 +77,15 @@ CONTAINS ALLOCATE ( acof(DIMENSION%neigd,0:lmd,atoms%nat),bcof(DIMENSION%neigd,0:lmd,atoms%nat) ) DO ispin = 1, input%jspins IF (zmat(1)%l_real.AND.noco%l_soc) THEN - zso(:,1:DIMENSION%neigd,ispin) = CMPLX(zmat(ispin)%z_r(:,1:DIMENSION%neigd),0.0) + zso(:,1:DIMENSION%neigd,ispin) = CMPLX(zmat(ispin)%data_r(:,1:DIMENSION%neigd),0.0) zMat_local%l_real = .FALSE. - zMat_local%nbasfcn = zmat(1)%nbasfcn - zMat_local%nbands = DIMENSION%neigd - ALLOCATE(zMat_local%z_c(zmat(1)%nbasfcn,DIMENSION%neigd)) - zMat_local%z_c(:,:) = zso(:,1:DIMENSION%neigd,ispin) + zMat_local%matsize1 = zmat(1)%matsize1 + zMat_local%matsize2 = DIMENSION%neigd + ALLOCATE(zMat_local%data_c(zmat(1)%matsize1,DIMENSION%neigd)) + zMat_local%data_c(:,:) = zso(:,1:DIMENSION%neigd,ispin) CALL abcof(input,atoms_local,sym,cell,lapw,nsz(ispin),& usdus, noco_local,ispin,oneD, acof,bcof,chelp(-atoms%llod:,:,:,:,ispin),zMat_local) - DEALLOCATE(zMat_local%z_c) + DEALLOCATE(zMat_local%data_c) ! ! ! transfer (a,b)cofs to (a,b)helps used in hsoham @@ -105,13 +105,13 @@ CONTAINS chelp(:,:,:,:,ispin) = (chelp(:,:,:,:,ispin)) ELSE zMat_local%l_real = zmat(1)%l_real - zMat_local%nbasfcn = zmat(1)%nbasfcn - zMat_local%nbands = DIMENSION%neigd - ALLOCATE(zMat_local%z_c(zmat(1)%nbasfcn,DIMENSION%neigd)) - zMat_local%z_c(:,:) = zmat(ispin)%z_c(:,:) + zMat_local%matsize1 = zmat(1)%matsize1 + zMat_local%matsize2 = DIMENSION%neigd + ALLOCATE(zMat_local%data_c(zmat(1)%matsize1,DIMENSION%neigd)) + zMat_local%data_c(:,:) = zmat(ispin)%data_c(:,:) CALL abcof(input,atoms_local,sym,cell,lapw,nsz(ispin),& usdus, noco_local,ispin,oneD, acof,bcof,chelp(-atoms%llod:,:,:,:,ispin),zMat_local) - DEALLOCATE(zMat_local%z_c) + DEALLOCATE(zMat_local%data_c) ! ! transfer (a,b)cofs to (a,b)helps used in hsoham ! diff --git a/eigen_soc/ssomat.F90 b/eigen_soc/ssomat.F90 index 2ff4a6e4..5bfa0ae7 100644 --- a/eigen_soc/ssomat.F90 +++ b/eigen_soc/ssomat.F90 @@ -8,6 +8,7 @@ CONTAINS USE m_eig66_io USE m_spnorb USE m_abcof + USE m_types_mat USE m_types_setup USE m_types_mpi USE m_types_enpara @@ -54,8 +55,8 @@ CONTAINS COMPLEX, ALLOCATABLE :: ccof(:,:,:,:,:,:) COMPLEX,ALLOCATABLE :: soangl(:,:,:,:,:,:,:) - TYPE(t_rsoc):: rsoc - TYPE(t_zmat):: zmat + TYPE(t_rsoc) :: rsoc + TYPE(t_mat) :: zmat TYPE(t_usdus):: usdus TYPE(t_lapw) :: lapw @@ -90,11 +91,11 @@ CONTAINS DO nk=mpi%irank+1,kpts%nkpt,mpi%isize CALL lapw%init(input,noco, kpts,atoms,sym,nk,cell,.false., mpi) - zMat%nbasfcn=lapw%nv(1)+lapw%nv(2)+2*atoms%nlotot - zmat%nbands=DIMENSION%neigd + zMat%matsize1=lapw%nv(1)+lapw%nv(2)+2*atoms%nlotot + zmat%matsize2=DIMENSION%neigd zmat%l_real=.FALSE. - IF (ALLOCATED(zmat%z_c)) DEALLOCATE(zmat%z_c) - ALLOCATE(zmat%z_c(zMat%nbasfcn,zmat%nbands)) + IF (ALLOCATED(zmat%data_c)) DEALLOCATE(zmat%data_c) + ALLOCATE(zmat%data_c(zMat%matsize1,zmat%matsize2)) CALL read_eig(eig_id,nk,1,neig=ne,eig=eig_shift(:,nk,1),zmat=zmat) DO jsloc= 1,2 eig_shift(:,nk,1)=0.0 !not needed diff --git a/global/types.F90 b/global/types.F90 index 3c7553c4..ecd86131 100644 --- a/global/types.F90 +++ b/global/types.F90 @@ -749,13 +749,13 @@ MODULE m_types INTEGER :: n_rank !< rank in sub_comm END TYPE t_mpi - TYPE t_zMat - LOGICAL :: l_real - INTEGER :: nbasfcn - INTEGER :: nbands - REAL, ALLOCATABLE :: z_r(:,:) ! z_r(nbasfcn,nbands) - COMPLEX, ALLOCATABLE :: z_c(:,:) ! z_c(nbasfcn,nbands) - END TYPE t_zMat +! TYPE t_zMat +! LOGICAL :: l_real +! INTEGER :: nbasfcn +! INTEGER :: nbands +! REAL, ALLOCATABLE :: z_r(:,:) ! z_r(nbasfcn,nbands) +! COMPLEX, ALLOCATABLE :: z_c(:,:) ! z_c(nbasfcn,nbands) +! END TYPE t_zMat TYPE t_hamOvlp LOGICAL :: l_real diff --git a/hybrid/gen_wavf.F90 b/hybrid/gen_wavf.F90 index 234a53a1..b5f676a0 100644 --- a/hybrid/gen_wavf.F90 +++ b/hybrid/gen_wavf.F90 @@ -61,7 +61,7 @@ REAL,INTENT(IN) :: el_eig(0:atoms%lmaxd,atoms%ntype) REAL,INTENT(IN) :: ello_eig(atoms%nlod,atoms%ntype) - TYPE(t_zmat),INTENT(IN) :: zmat(:) !for all kpoints + TYPE(t_mat),INTENT(IN) :: zmat(:) !for all kpoints ! - - local scalars - - INTEGER :: ilo,idum ,m @@ -113,7 +113,7 @@ !CALL CPU_TIME(time1) call usdus%init(atoms,dimension%jspd) - call zhlp%alloc(zmat(1)%l_real,zmat(1)%nbasfcn,zmat(1)%nbands) + call zhlp%alloc(zmat(1)%l_real,zmat(1)%matsize1,zmat(1)%matsize2) ! setup rotations in reciprocal space @@ -350,12 +350,12 @@ ! write cmt at irreducible k-points in direct-access file cmt call write_cmt(cmt,ikpt0) - call zhlp%alloc(zmat(1)%l_real,zmat(1)%nbasfcn,zmat(1)%nbands) + call zhlp%alloc(zmat(1)%l_real,zmat(1)%matsize1,zmat(1)%matsize2) IF (zhlp%l_real) THEN - zhlp%data_r=zmat(ikpt0)%z_r + zhlp%data_r=zmat(ikpt0)%data_r ELSE - zhlp%data_c=zmat(ikpt0)%z_c + zhlp%data_c=zmat(ikpt0)%data_c end IF call write_z(zhlp,ikpt0) @@ -367,7 +367,7 @@ IF ( kpts%bkp(ikpt) .eq. ikpt0 .and. ikpt0 .ne. ikpt ) THEN iop = kpts%bksym(ikpt) CALL waveftrafo_genwavf( cmthlp,zhlp%data_r,zhlp%data_c,& - & cmt(:,:,:),zmat(1)%l_real,zmat(ikpt0)%z_r(:,:),zmat(ikpt0)%z_c(:,:),ikpt0,iop,atoms,& + & cmt(:,:,:),zmat(1)%l_real,zmat(ikpt0)%data_r(:,:),zmat(ikpt0)%data_c(:,:),ikpt0,iop,atoms,& & hybrid,kpts,sym,& & jsp,dimension,hybrid%nbands(ikpt0),& & cell,lapw(ikpt0),lapw(ikpt),.true.) diff --git a/hybrid/hf_setup.F90 b/hybrid/hf_setup.F90 index b790f0bc..95286de9 100644 --- a/hybrid/hf_setup.F90 +++ b/hybrid/hf_setup.F90 @@ -33,7 +33,7 @@ CONTAINS INTEGER :: ok,nk,nrec1,i,j,ll,l1,l2,ng,itype,n,l,n1,n2,nn - TYPE(t_zmat),ALLOCATABLE :: zmat(:) + TYPE(t_mat),ALLOCATABLE :: zmat(:) REAL, ALLOCATABLE :: basprod(:) REAL :: el_eig(0:atoms%lmaxd,atoms%ntype), ello_eig(atoms%nlod,atoms%ntype),bk(3) INTEGER :: degenerat(DIMENSION%neigd2+1,kpts%nkpt) @@ -74,14 +74,14 @@ CONTAINS IF ( skip_kpt(nk) ) CYCLE #endif nrec1 = kpts%nkpt*(jsp-1) + nk - zmat(nk)%nbasfcn=dimension%nbasfcn - zmat(nk)%nbands=dimension%neigd2 + zmat(nk)%matsize1=dimension%nbasfcn + zmat(nk)%matsize2=dimension%neigd2 IF (l_real) THEN - ALLOCATE(zmat(nk)%z_r(dimension%nbasfcn,dimension%neigd2)) - ALLOCATE(zmat(nk)%z_c(0,0)) + ALLOCATE(zmat(nk)%data_r(dimension%nbasfcn,dimension%neigd2)) + ALLOCATE(zmat(nk)%data_c(0,0)) else - ALLOCATE(zmat(nk)%z_c(dimension%nbasfcn,dimension%neigd2)) - ALLOCATE(zmat(nk)%z_r(0,0)) + ALLOCATE(zmat(nk)%data_c(dimension%nbasfcn,dimension%neigd2)) + ALLOCATE(zmat(nk)%data_r(0,0)) ENDIF CALL judft_error("TODO,hs_setup") !CALL read_eig(eig_id_hf,nk,jsp,el=el_eig,ello=ello_eig, neig=hybrid%ne_eig(nk),eig=eig_irr(:,nk), w_iks=results%w_iks(:,nk,jsp),&!kveclo=hybdat%kveclo_eig(:,nk), @@ -90,12 +90,12 @@ CONTAINS END DO !Allocate further space DO nk=kpts%nkpt+1,kpts%nkptf - zmat(nk)%nbasfcn=dimension%nbasfcn - zmat(nk)%nbands=dimension%neigd2 + zmat(nk)%matsize1=dimension%nbasfcn + zmat(nk)%matsize2=dimension%neigd2 if (l_real) THEN - ALLOCATE(zmat(nk)%z_r(dimension%nbasfcn,dimension%neigd2)) + ALLOCATE(zmat(nk)%data_r(dimension%nbasfcn,dimension%neigd2)) else - ALLOCATE(zmat(nk)%z_c(dimension%nbasfcn,dimension%neigd2)) + ALLOCATE(zmat(nk)%data_c(dimension%nbasfcn,dimension%neigd2)) endif Enddo ! diff --git a/io/cdn_read.F b/io/cdn_read.F index 76e31e8a..139c2571 100644 --- a/io/cdn_read.F +++ b/io/cdn_read.F @@ -70,7 +70,7 @@ c n_bands(i) the number of ev's processed on n_rank=0...i-1 REAL, INTENT (OUT) :: eig(:) !bkpt(3),eig(neigd) - TYPE(t_zmat), INTENT (INOUT) :: zmat !z(nbasfcn,noccbd) !can be real/complex + TYPE(t_mat), INTENT (INOUT) :: zmat !z(nbasfcn,noccbd) !can be real/complex ! Local variables ... INTEGER :: isp diff --git a/io/eig66_da.F90 b/io/eig66_da.F90 index 4917fcf1..c0a1eea1 100644 --- a/io/eig66_da.F90 +++ b/io/eig66_da.F90 @@ -154,7 +154,7 @@ CONTAINS INTEGER, INTENT(OUT),OPTIONAL :: neig REAL, INTENT(OUT),OPTIONAL :: eig(:),w_iks(:) INTEGER, INTENT(IN),OPTIONAL :: n_start,n_end - TYPE(t_zmat),OPTIONAL :: zmat + TYPE(t_mat),OPTIONAL :: zmat !Local variables INTEGER:: nv_s,nmat_s,n,nrec,neig_s @@ -189,17 +189,17 @@ CONTAINS ALLOCATE(eig_s(neig_s)) IF (PRESENT(zmat)) THEN IF (zmat%l_real) THEN - INQUIRE(IOLENGTH=n) neig_s,eig_s,REAL(zmat%z_r) + INQUIRE(IOLENGTH=n) neig_s,eig_s,REAL(zmat%data_r) IF (n>d%recl_vec) THEN CALL juDFT_error("BUG: Too long record") END IF - READ(d%file_io_id_vec,REC=nrec) neig_s,eig_s,zmat%z_r + READ(d%file_io_id_vec,REC=nrec) neig_s,eig_s,zmat%data_r ELSE - INQUIRE(IOLENGTH=n) neig_s,eig_s,CMPLX(zmat%z_c) + INQUIRE(IOLENGTH=n) neig_s,eig_s,CMPLX(zmat%data_c) IF (n>d%recl_vec) THEN CALL juDFT_error("BUG: Too long record") END IF - READ(d%file_io_id_vec,REC=nrec) neig_s,eig_s,zmat%z_c + READ(d%file_io_id_vec,REC=nrec) neig_s,eig_s,zmat%data_c ENDIF ELSE INQUIRE(IOLENGTH=n) neig_s,eig_s diff --git a/io/eig66_hdf.F90 b/io/eig66_hdf.F90 index 57ef707d..58c2886c 100644 --- a/io/eig66_hdf.F90 +++ b/io/eig66_hdf.F90 @@ -413,7 +413,7 @@ CONTAINS INTEGER, INTENT(OUT),OPTIONAL :: neig REAL, INTENT(OUT),OPTIONAL :: eig(:),w_iks(:) INTEGER, INTENT(IN),OPTIONAL :: n_start,n_end - TYPE(t_zMat),OPTIONAL :: zmat + TYPE(t_mat),OPTIONAL :: zmat #ifdef CPP_HDF INTEGER:: n1,n,k @@ -441,9 +441,9 @@ CONTAINS IF (.NOT.PRESENT(n_end)) CALL juDFT_error("BUG3 in read_eig") IF (PRESENT(zMat)) THEN IF (zmat%l_real) THEN - CALL priv_r_vec(d,nk,jspin,n_start,n_end,zmat%z_r) + CALL priv_r_vec(d,nk,jspin,n_start,n_end,zmat%data_r) ELSE - CALL priv_r_vecc(d,nk,jspin,n_start,n_end,zmat%z_c) + CALL priv_r_vecc(d,nk,jspin,n_start,n_end,zmat%data_c) ENDIF ENDIF ENDIF diff --git a/io/eig66_io.F90 b/io/eig66_io.F90 index d774b126..f888fed5 100644 --- a/io/eig66_io.F90 +++ b/io/eig66_io.F90 @@ -122,7 +122,7 @@ CONTAINS INTEGER, INTENT(OUT),OPTIONAL :: neig REAL, INTENT(OUT),OPTIONAL :: eig(:),w_iks(:) INTEGER, INTENT(IN),OPTIONAL :: n_start,n_end - TYPE(t_zMAT),INTENT(INOUT),OPTIONAL :: zmat + TYPE(t_mat),INTENT(INOUT),OPTIONAL :: zmat INTEGER::n CALL timestart("IO (read)") SELECT CASE (eig66_data_mode(id)) diff --git a/io/eig66_mem.F90 b/io/eig66_mem.F90 index abcdba23..117dca67 100644 --- a/io/eig66_mem.F90 +++ b/io/eig66_mem.F90 @@ -84,12 +84,12 @@ CONTAINS INTEGER:: jspin,nk,i,ii,iii,nv,tmp_id REAL :: wk,bk3(3),evac(2) REAL :: eig(neig),w_iks(neig),ello(d%nlo,d%ntype),el(d%lmax,d%ntype) - TYPE(t_zmat):: zmat + TYPE(t_mat):: zmat zmat%l_real=l_real - zmat%nbasfcn=nmat - zmat%nbands=neig - ALLOCATE(zmat%z_r(nmat,neig),zmat%z_c(nmat,neig)) + zmat%matsize1=nmat + zmat%matsize2=neig + ALLOCATE(zmat%data_r(nmat,neig),zmat%data_c(nmat,neig)) tmp_id=eig66_data_newid(DA_mode) IF (d%l_dos) CPP_error("Can not read DOS-data") @@ -157,7 +157,7 @@ CONTAINS INTEGER, INTENT(OUT),OPTIONAL :: neig REAL, INTENT(OUT),OPTIONAL :: eig(:),w_iks(:) INTEGER, INTENT(IN),OPTIONAL :: n_start,n_end - TYPE(t_zMAT),OPTIONAL :: zmat + TYPE(t_mat),OPTIONAL :: zmat INTEGER::nrec, arrayStart TYPE(t_data_mem),POINTER:: d @@ -183,7 +183,7 @@ CONTAINS arrayStart = 1 IF(PRESENT(n_start)) THEN - arrayStart = (n_start-1)*zMat%nbasfcn+1 + arrayStart = (n_start-1)*zMat%matsize1+1 END IF IF (PRESENT(zmat)) THEN @@ -191,13 +191,13 @@ CONTAINS IF (zmat%l_real) THEN IF (.NOT.ALLOCATED(d%eig_vecr)) THEN IF (.NOT.ALLOCATED(d%eig_vecc)) CALL juDFT_error("BUG: can not read real/complex vectors from memory") - zmat%z_r=REAL(RESHAPE(d%eig_vecc(arrayStart:arrayStart+SIZE(zmat%z_r)-1,nrec),SHAPE(zmat%z_r))) + zmat%data_r=REAL(RESHAPE(d%eig_vecc(arrayStart:arrayStart+SIZE(zmat%data_r)-1,nrec),SHAPE(zmat%data_r))) ELSE - zmat%z_r=RESHAPE(d%eig_vecr(arrayStart:arrayStart+SIZE(zmat%z_r)-1,nrec),SHAPE(zmat%z_r)) + zmat%data_r=RESHAPE(d%eig_vecr(arrayStart:arrayStart+SIZE(zmat%data_r)-1,nrec),SHAPE(zmat%data_r)) ENDIF ELSE !TYPE is (COMPLEX) IF (.NOT.ALLOCATED(d%eig_vecc)) CALL juDFT_error("BUG: can not read complex vectors from memory", calledby = "eig66_mem") - zmat%z_c=RESHAPE(d%eig_vecc(arrayStart:arrayStart+SIZE(zmat%z_c)-1,nrec),SHAPE(zmat%z_c)) + zmat%data_c=RESHAPE(d%eig_vecc(arrayStart:arrayStart+SIZE(zmat%data_c)-1,nrec),SHAPE(zmat%data_c)) END IF ENDIF END SUBROUTINE read_eig diff --git a/io/eig66_mpi.F90 b/io/eig66_mpi.F90 index 580228df..ef4b570f 100644 --- a/io/eig66_mpi.F90 +++ b/io/eig66_mpi.F90 @@ -250,7 +250,7 @@ CONTAINS INTEGER, INTENT(OUT),OPTIONAL :: neig REAL, INTENT(OUT),OPTIONAL :: eig(:),w_iks(:) INTEGER, INTENT(IN),OPTIONAL :: n_start,n_end - TYPE(t_zmat),OPTIONAL :: zmat + TYPE(t_mat),OPTIONAL :: zmat #ifdef CPP_MPI INTEGER :: pe,tmp_size,e @@ -291,10 +291,10 @@ CONTAINS ENDIF IF (PRESENT(zmat)) THEN - tmp_size=zmat%nbasfcn + tmp_size=zmat%matsize1 ALLOCATE(tmp_real(tmp_size)) ALLOCATE(tmp_cmplx(tmp_size)) - DO n=1,zmat%nbands + DO n=1,zmat%matsize2 n1=n IF (PRESENT(n_start)) n1=n_start+n-1 IF (PRESENT(n_end)) THEN @@ -309,13 +309,13 @@ CONTAINS CALL MPI_GET(tmp_cmplx,tmp_size,MPI_DOUBLE_COMPLEX,pe,slot,tmp_size,MPI_DOUBLE_COMPLEX,d%zc_handle,e) CALL MPI_WIN_UNLOCK(pe,d%zc_handle,e) !print *, nk,jspin,n1,"r PE:",pe," Slot: ",slot," Size:",tmp_size,tmp_cmplx(1) - zmat%z_r(:,n)=REAL(tmp_cmplx) + zmat%data_r(:,n)=REAL(tmp_cmplx) else CALL MPI_WIN_LOCK(MPI_LOCK_SHARED,pe,0,d%zr_handle,e) CALL MPI_GET(tmp_real,tmp_size,MPI_DOUBLE_PRECISION,pe,slot,tmp_size,MPI_DOUBLE_PRECISION,d%zr_handle,e) CALL MPI_WIN_UNLOCK(pe,d%zr_handle,e) !print *, nk,jspin,n1,"r PE:",pe," Slot: ",slot," Size:",tmp_size,tmp_real(1) - zmat%z_r(:,n)=tmp_real + zmat%data_r(:,n)=tmp_real endif ELSE if (d%l_real) call judft_error("Could not read complex data, only real data is stored",calledby="eig66_mpi%read_eig") @@ -323,7 +323,7 @@ CONTAINS CALL MPI_GET(tmp_cmplx,tmp_size,MPI_DOUBLE_COMPLEX,pe,slot,tmp_size,MPI_DOUBLE_COMPLEX,d%zc_handle,e) CALL MPI_WIN_UNLOCK(pe,d%zc_handle,e) !print *, nk,jspin,n1,"r PE:",pe," Slot: ",slot," Size:",tmp_size,tmp_cmplx(1) - zmat%z_c(:,n)=tmp_cmplx + zmat%data_c(:,n)=tmp_cmplx ENDIF ENDDO ENDIF diff --git a/main/fleur.F90 b/main/fleur.F90 index 149f4102..831794fa 100644 --- a/main/fleur.F90 +++ b/main/fleur.F90 @@ -102,8 +102,8 @@ CONTAINS ! .. Local Scalars .. INTEGER:: eig_id,chase_eig_id, archiveType - INTEGER:: n,it,ithf - LOGICAL:: l_opti,l_cont,l_qfix, l_wann_inp + INTEGER:: n,it,ithf,nevd,nexd + LOGICAL:: l_opti,l_cont,l_qfix, l_wann_inp, l_real REAL :: fermiEnergyTemp, fix #ifdef CPP_MPI INCLUDE 'mpif.h' @@ -133,6 +133,17 @@ CONTAINS !-Wannier + l_real = sym%invs.AND..NOT.noco%l_noco + 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 + it = 0 ithf = 0 diff --git a/wannier/wann_1dvacabcof.F b/wannier/wann_1dvacabcof.F index 550ee9dd..03a7fc01 100644 --- a/wannier/wann_1dvacabcof.F +++ b/wannier/wann_1dvacabcof.F @@ -26,7 +26,7 @@ c******************************************************** TYPE(t_vacuum),INTENT(IN) :: vacuum TYPE(t_stars),INTENT(IN) :: stars TYPE(t_cell),INTENT(IN) :: cell - TYPE(t_zMat),INTENT(IN) :: zMat + TYPE(t_mat),INTENT(IN) :: zMat integer,intent(in)::nv2d,n2d,n3d integer,intent(in)::nslibd @@ -138,13 +138,13 @@ c******************************************************** / ((wronk_1)*sqrt(omtil)) IF (zMat%l_real) THEN do n = 1,nslibd - ac(l,m,n) = ac(l,m,n) + zMat%z_r(k+addnoco,n)*av - bc(l,m,n) = bc(l,m,n) + zMat%z_r(k+addnoco,n)*bv + ac(l,m,n) = ac(l,m,n) + zMat%data_r(k+addnoco,n)*av + bc(l,m,n) = bc(l,m,n) + zMat%data_r(k+addnoco,n)*bv end do ELSE do n = 1,nslibd - ac(l,m,n) = ac(l,m,n) + zMat%z_c(k+addnoco,n)*av - bc(l,m,n) = bc(l,m,n) + zMat%z_c(k+addnoco,n)*bv + ac(l,m,n) = ac(l,m,n) + zMat%data_c(k+addnoco,n)*av + bc(l,m,n) = bc(l,m,n) + zMat%data_c(k+addnoco,n)*bv end do END IF end do ! -mb:mb diff --git a/wannier/wann_2dvacabcof.F b/wannier/wann_2dvacabcof.F index e8faa40d..97385ce3 100644 --- a/wannier/wann_2dvacabcof.F +++ b/wannier/wann_2dvacabcof.F @@ -22,7 +22,7 @@ c******************************************************** implicit none - TYPE(t_zMat),INTENT(IN) :: zMat + TYPE(t_mat),INTENT(IN) :: zMat logical,intent(in)::l_ss integer,intent(in)::nv2d,jspin,addnoco @@ -157,16 +157,16 @@ c-----> loop over basis functions IF (zMat%l_real) THEN do n = 1,nslibd ac(l,n,jvac) = ac(l,n,jvac) + - + zMat%z_r(k+addnoco,n)*av + + zMat%data_r(k+addnoco,n)*av bc(l,n,jvac) = bc(l,n,jvac) + - + zMat%z_r(k+addnoco,n)*bv + + zMat%data_r(k+addnoco,n)*bv enddo ELSE do n = 1,nslibd ac(l,n,jvac) = ac(l,n,jvac) + - + zMat%z_c(k+addnoco,n)*av + + zMat%data_c(k+addnoco,n)*av bc(l,n,jvac) = bc(l,n,jvac) + - + zMat%z_c(k+addnoco,n)*bv + + zMat%data_c(k+addnoco,n)*bv enddo END IF enddo diff --git a/wannier/wann_kptsrotate.F b/wannier/wann_kptsrotate.F index ef14f9d5..2513e14a 100644 --- a/wannier/wann_kptsrotate.F +++ b/wannier/wann_kptsrotate.F @@ -48,7 +48,7 @@ c**************************************** real,intent(inout) :: bkpt(3) integer,intent(inout) :: k1(:,:),k2(:,:),k3(:,:) !nvd,jspd - TYPE(t_zmat), INTENT (INOUT) :: zMat !z(nbasfcn,noccbd) !can be real/complex + TYPE(t_mat), INTENT (INOUT) :: zMat !z(nbasfcn,noccbd) !can be real/complex complex,intent(out) :: nsfactor !phase of non-symmorphic ops @@ -76,7 +76,7 @@ c print*,testmat IF(.NOT.zMat%l_real) THEN if(oper.lt.0)then - zMat%z_c = CONJG(zMat%z_c) + zMat%data_c = CONJG(zMat%data_c) shiftnonsymm=-1.0*shiftnonsymm endif END IF @@ -134,9 +134,9 @@ c print*,testmat phase = tpi*phase phase = cos(phase) IF(zMat%l_real) THEN - zMat%z_r(j+jj,:) = phase * zMat%z_r(j+jj,:) + zMat%data_r(j+jj,:) = phase * zMat%data_r(j+jj,:) ELSE - zMat%z_c(j+jj,:) = phase * zMat%z_c(j+jj,:) + zMat%data_c(j+jj,:) = phase * zMat%data_c(j+jj,:) END IF enddo jj=jj+nv(jspin) @@ -149,9 +149,9 @@ c print*,testmat phase = tpi*phase phase = cos(phase) IF(zMat%l_real) THEN - zMat%z_r(jj+ilo,:) = phase * zMat%z_r(jj+ilo,:) + zMat%data_r(jj+ilo,:) = phase * zMat%data_r(jj+ilo,:) ELSE - zMat%z_c(jj+ilo,:) = phase * zMat%z_c(jj+ilo,:) + zMat%data_c(jj+ilo,:) = phase * zMat%data_c(jj+ilo,:) END IF enddo enddo diff --git a/wannier/wann_maxbnd.F b/wannier/wann_maxbnd.F index 361ae9e8..a8afcb2f 100644 --- a/wannier/wann_maxbnd.F +++ b/wannier/wann_maxbnd.F @@ -42,15 +42,15 @@ c**************************************************************** integer :: n_start,n_end,co integer :: num_bands - TYPE(t_zmat) :: zMat + TYPE(t_mat) :: zMat zMat%l_real = l_real - zMat%nbasfcn = nbasfcn - zMat%nbands = neigd + zMat%matsize1 = nbasfcn + zMat%matsize2 = neigd IF(l_real) THEN - ALLOCATE (zMat%z_r(zMat%nbasfcn,zMat%nbands)) + ALLOCATE (zMat%data_r(zMat%matsize1,zMat%matsize2)) ELSE - ALLOCATE (zMat%z_c(zMat%nbasfcn,zMat%nbands)) + ALLOCATE (zMat%data_c(zMat%matsize1,zMat%matsize2)) END IF n_start=1 diff --git a/wannier/wann_mmk0_od_vac.F b/wannier/wann_mmk0_od_vac.F index cc41f9ba..686357b1 100644 --- a/wannier/wann_mmk0_od_vac.F +++ b/wannier/wann_mmk0_od_vac.F @@ -35,7 +35,7 @@ c*************************************************************** implicit none - TYPE(t_zmat), INTENT(IN) :: zMat + TYPE(t_mat), INTENT(IN) :: zMat TYPE(t_dimension),INTENT(IN) :: DIMENSION TYPE(t_oneD),INTENT(IN) :: oneD @@ -159,20 +159,20 @@ c ..intrinsic functions.. IF(zMat%l_real) THEN do n = 1,nslibd acof(l,m,n) = acof(l,m,n) + - + zMat%z_r(k+addnoco,n)*avac -c + conjg(zMat%z_r(k,n))*avac + + zMat%data_r(k+addnoco,n)*avac +c + conjg(zMat%data_r(k,n))*avac bcof(l,m,n) = bcof(l,m,n) + - + zMat%z_r(k+addnoco,n)*bvac -c + conjg(zMat%z_r(k,n))*bvac + + zMat%data_r(k+addnoco,n)*bvac +c + conjg(zMat%data_r(k,n))*bvac enddo ELSE do n = 1,nslibd acof(l,m,n) = acof(l,m,n) + - + zMat%z_c(k+addnoco,n)*avac -c + conjg(zMat%z_c(k,n))*avac + + zMat%data_c(k+addnoco,n)*avac +c + conjg(zMat%data_c(k,n))*avac bcof(l,m,n) = bcof(l,m,n) + - + zMat%z_c(k+addnoco,n)*bvac -c + conjg(zMat%z_c(k,n))*bvac + + zMat%data_c(k+addnoco,n)*bvac +c + conjg(zMat%data_c(k,n))*bvac enddo END IF enddo ! -mb:mb diff --git a/wannier/wann_mmk0_vac.F b/wannier/wann_mmk0_vac.F index eb1933d5..84c624ba 100644 --- a/wannier/wann_mmk0_vac.F +++ b/wannier/wann_mmk0_vac.F @@ -30,7 +30,7 @@ c*************************************************************** implicit none - TYPE(t_zmat), INTENT(IN) :: zMat + TYPE(t_mat), INTENT(IN) :: zMat c .. scalar Arguments.. logical, intent (in) :: l_noco @@ -172,13 +172,13 @@ c-----> construct a and b coefficients c-----> loop over basis functions IF(zMat%l_real) THEN do n = 1,nslibd - ac(l,n) = ac(l,n) + zMat%z_r(k+addnoco,n)*av - bc(l,n) = bc(l,n) + zMat%z_r(k+addnoco,n)*bv + ac(l,n) = ac(l,n) + zMat%data_r(k+addnoco,n)*av + bc(l,n) = bc(l,n) + zMat%data_r(k+addnoco,n)*bv enddo ELSE do n = 1,nslibd - ac(l,n) = ac(l,n) + zMat%z_c(k+addnoco,n)*av - bc(l,n) = bc(l,n) + zMat%z_c(k+addnoco,n)*bv + ac(l,n) = ac(l,n) + zMat%data_c(k+addnoco,n)*av + bc(l,n) = bc(l,n) + zMat%data_c(k+addnoco,n)*bv enddo END IF enddo diff --git a/wannier/wann_mmkb_int.F b/wannier/wann_mmkb_int.F index a0528414..e0ca0931 100644 --- a/wannier/wann_mmkb_int.F +++ b/wannier/wann_mmkb_int.F @@ -20,7 +20,7 @@ #include "cpp_double.h" implicit none - TYPE(t_zmat), INTENT(IN) :: zMat, zMat_b + TYPE(t_mat), INTENT(IN) :: zMat, zMat_b integer, intent(in) :: addnoco,addnoco2 integer, intent(in) :: nvd,n3d,k1(nvd),k2(nvd),k3(nvd) @@ -74,25 +74,25 @@ c--> determine index and phase factor enddo IF(zMat%l_real) THEN call CPP_BLAS_sgemm('T','N',nv,nslibd_b,nv_b,real(1.0), - & stepf_r,nv_b,zMat_b%z_r(1+addnoco2,1),nbasfcn, -c & stepf_r,nv_b,zMat_b%z_r,nbasfcn, + & stepf_r,nv_b,zMat_b%data_r(1+addnoco2,1),nbasfcn, +c & stepf_r,nv_b,zMat_b%data_r,nbasfcn, & real(0.0),phasusbmat_r,nv) call CPP_BLAS_sgemm('T','N',nslibd,nslibd_b,nv,real(1.0), - & zMat%z_r(1+addnoco,1),nbasfcn,phasusbmat_r,nv, -c & zMat%z_r,nbasfcn,phasusbmat_r,nv, + & zMat%data_r(1+addnoco,1),nbasfcn,phasusbmat_r,nv, +c & zMat%data_r,nbasfcn,phasusbmat_r,nv, & real(0.0),mmnk_tmp,nbnd) mmnk(1:nslibd,1:nslibd_b)=mmnk(1:nslibd,1:nslibd_b)+ & mmnk_tmp(1:nslibd,1:nslibd_b)*interchi ELSE call CPP_BLAS_cgemm('T','N',nv,nslibd_b,nv_b,cmplx(1.0), - & stepf_c,nv_b,zMat_b%z_c(1+addnoco2,1), -c & stepf_c,nv_b,zMat_b%z_c, + & stepf_c,nv_b,zMat_b%data_c(1+addnoco2,1), +c & stepf_c,nv_b,zMat_b%data_c, & nbasfcn,cmplx(0.0), & phasusbmat_c,nv) phasusbmat_c=conjg(phasusbmat_c) call CPP_BLAS_cgemm('T','N',nslibd,nslibd_b,nv,interchi, - & zMat%z_c(1+addnoco,1),nbasfcn,phasusbmat_c,nv, -c & zMat%z_c,nbasfcn,phasusbmat_c,nv, + & zMat%data_c(1+addnoco,1),nbasfcn,phasusbmat_c,nv, +c & zMat%data_c,nbasfcn,phasusbmat_c,nv, & cmplx(1.0),mmnk,nbnd) END IF diff --git a/wannier/wann_mmkb_od_vac.F b/wannier/wann_mmkb_od_vac.F index 1fecd513..321e2680 100644 --- a/wannier/wann_mmkb_od_vac.F +++ b/wannier/wann_mmkb_od_vac.F @@ -38,7 +38,7 @@ c*************************************************************** TYPE(t_vacuum),INTENT(IN) :: vacuum TYPE(t_stars),INTENT(IN) :: stars TYPE(t_cell),INTENT(IN) :: cell - TYPE(t_zmat), INTENT(IN) :: zMat, zMat_b + TYPE(t_mat), INTENT(IN) :: zMat, zMat_b c .. scalar Arguments.. logical, intent (in) :: l_noco @@ -203,20 +203,20 @@ c...for the k-point IF (zMat%l_real) THEN do n = 1,nslibd acof(l,m,n) = acof(l,m,n) + - + zMat%z_r(k+addnoco,n)*avac -c + conjg(zMat%z_r(k,n))*avac + + zMat%data_r(k+addnoco,n)*avac +c + conjg(zMat%data_r(k,n))*avac bcof(l,m,n) = bcof(l,m,n) + - + zMat%z_r(k+addnoco,n)*bvac -c + conjg(zMat%z_r(k,n))*bvac + + zMat%data_r(k+addnoco,n)*bvac +c + conjg(zMat%data_r(k,n))*bvac enddo ELSE do n = 1,nslibd acof(l,m,n) = acof(l,m,n) + - + zMat%z_c(k+addnoco,n)*avac -c + conjg(zMat%z_c(k,n))*avac + + zMat%data_c(k+addnoco,n)*avac +c + conjg(zMat%data_c(k,n))*avac bcof(l,m,n) = bcof(l,m,n) + - + zMat%z_c(k+addnoco,n)*bvac -c + conjg(zMat%z_c(k,n))*bvac + + zMat%data_c(k+addnoco,n)*bvac +c + conjg(zMat%data_c(k,n))*bvac enddo END IF enddo ! -mb:mb @@ -258,20 +258,20 @@ c...for the b-point IF (zMat_b%l_real) THEN do n = 1,nslibd_b acof_b(l,m,n) = acof_b(l,m,n) + - + zMat_b%z_r(k+addnoco2,n)*avac -c + conjg(zMat_b%z_r(k,n))*avac + + zMat_b%data_r(k+addnoco2,n)*avac +c + conjg(zMat_b%data_r(k,n))*avac bcof_b(l,m,n) = bcof_b(l,m,n) + - + zMat_b%z_r(k+addnoco2,n)*bvac -c + conjg(zMat_b%z_r(k,n))*bvac + + zMat_b%data_r(k+addnoco2,n)*bvac +c + conjg(zMat_b%data_r(k,n))*bvac enddo ELSE do n = 1,nslibd_b acof_b(l,m,n) = acof_b(l,m,n) + - + zMat_b%z_c(k+addnoco2,n)*avac -c + conjg(zMat_b%z_c(k,n))*avac + + zMat_b%data_c(k+addnoco2,n)*avac +c + conjg(zMat_b%data_c(k,n))*avac bcof_b(l,m,n) = bcof_b(l,m,n) + - + zMat_b%z_c(k+addnoco2,n)*bvac -c + conjg(zMat_b%z_c(k,n))*bvac + + zMat_b%data_c(k+addnoco2,n)*bvac +c + conjg(zMat_b%data_c(k,n))*bvac enddo END IF enddo ! -mb:mb diff --git a/wannier/wann_mmkb_vac.F b/wannier/wann_mmkb_vac.F index fca98759..997d0216 100644 --- a/wannier/wann_mmkb_vac.F +++ b/wannier/wann_mmkb_vac.F @@ -32,7 +32,7 @@ c*************************************************************** implicit none - TYPE(t_zmat), INTENT(IN) :: zMat, zMat_b + TYPE(t_mat), INTENT(IN) :: zMat, zMat_b c .. scalar Arguments.. logical, intent (in) :: l_noco @@ -228,13 +228,13 @@ c-----> construct a and b coefficients for the k-point c-----> loop over basis functions IF(zMat%l_real) THEN do n = 1,nslibd - ac(l,n) = ac(l,n) + zMat%z_r(k+addnoco,n)*av - bc(l,n) = bc(l,n) + zMat%z_r(k+addnoco,n)*bv + ac(l,n) = ac(l,n) + zMat%data_r(k+addnoco,n)*av + bc(l,n) = bc(l,n) + zMat%data_r(k+addnoco,n)*bv enddo ELSE do n = 1,nslibd - ac(l,n) = ac(l,n) + zMat%z_c(k+addnoco,n)*av - bc(l,n) = bc(l,n) + zMat%z_c(k+addnoco,n)*bv + ac(l,n) = ac(l,n) + zMat%data_c(k+addnoco,n)*av + bc(l,n) = bc(l,n) + zMat%data_c(k+addnoco,n)*bv enddo END IF enddo @@ -272,13 +272,13 @@ c-----> construct a and b coefficients for the k+b point c-----> loop over basis functions IF(zMat_b%l_real) THEN do n = 1,nslibd_b - ac_b(l,n) = ac_b(l,n) + zMat_b%z_r(k+addnoco,n)*av - bc_b(l,n) = bc_b(l,n) + zMat_b%z_r(k+addnoco,n)*bv + ac_b(l,n) = ac_b(l,n) + zMat_b%data_r(k+addnoco,n)*av + bc_b(l,n) = bc_b(l,n) + zMat_b%data_r(k+addnoco,n)*bv enddo ELSE do n = 1,nslibd_b - ac_b(l,n) = ac_b(l,n) + zMat_b%z_c(k+addnoco,n)*av - bc_b(l,n) = bc_b(l,n) + zMat_b%z_c(k+addnoco,n)*bv + ac_b(l,n) = ac_b(l,n) + zMat_b%data_c(k+addnoco,n)*av + bc_b(l,n) = bc_b(l,n) + zMat_b%data_c(k+addnoco,n)*bv enddo END IF enddo diff --git a/wannier/wann_plot.F b/wannier/wann_plot.F index debb43e4..1e508d61 100644 --- a/wannier/wann_plot.F +++ b/wannier/wann_plot.F @@ -66,7 +66,7 @@ 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 ! .. Scalar Arguments .. INTEGER, INTENT (IN) :: n3d,nmzxyd,n2d,ntypsd,ikpt,jspin,nv2d diff --git a/wannier/wann_plot_um_dat.F b/wannier/wann_plot_um_dat.F index 79e51a89..46f40e93 100644 --- a/wannier/wann_plot_um_dat.F +++ b/wannier/wann_plot_um_dat.F @@ -222,7 +222,7 @@ c real dotirp integer :: ngopr1(natd) TYPE(t_usdus) :: usdus - TYPE(t_zmat) :: zzMat, zMat + TYPE(t_mat) :: zzMat, zMat um_format=.false. l_byindex=.false. @@ -526,12 +526,12 @@ c****************************************************************** allocate (we(neigd),eigg(neigd)) zzMat%l_real = l_real - zzMat%nbasfcn = nbasfcn - zzMat%nbands = neigd + zzMat%matsize1 = nbasfcn + zzMat%matsize2 = neigd IF(l_real) THEN - ALLOCATE (zzMat%z_r(zzMat%nbasfcn,zzMat%nbands)) + ALLOCATE (zzMat%data_r(zzMat%matsize1,zzMat%matsize2)) ELSE - ALLOCATE (zzMat%z_c(zzMat%nbasfcn,zzMat%nbands)) + ALLOCATE (zzMat%data_c(zzMat%matsize1,zzMat%matsize2)) END IF CALL judft_error("TODO:adjust in wann_plot_um_dat") ! call wann_read_eig(eig_id, lmaxd,ntypd,nlod,neigd,nvd,wannierspin, @@ -539,14 +539,14 @@ c****************************************************************** ! < nmat,nv, k1,k2,k3,bkpt,wk,nbands,eigg,zzMat, .false.,1) zMat%l_real = zzMat%l_real - zMat%nbasfcn = zzMat%nbasfcn - zMat%nbands = zzMat%nbands + zMat%matsize1 = zzMat%matsize1 + zMat%matsize2 = zzMat%matsize2 IF (zzMat%l_real) THEN - ALLOCATE (zMat%z_r(zMat%nbasfcn,zMat%nbands)) - zMat%z_r = 0.0 + ALLOCATE (zMat%data_r(zMat%matsize1,zMat%matsize2)) + zMat%data_r = 0.0 ELSE - ALLOCATE (zMat%z_c(zMat%nbasfcn,zMat%nbands)) - zMat%z_c = CMPLX(0.0,0.0) + ALLOCATE (zMat%data_c(zMat%matsize1,zMat%matsize2)) + zMat%data_c = CMPLX(0.0,0.0) END IF @@ -568,11 +568,11 @@ c...we work only within the energy window we(nslibd) = we(i) IF(zzMat%l_real) THEN do j = 1,nv(jspin) + nlotot - zMat%z_r(j,nslibd) = zzMat%z_r(j,i) + zMat%data_r(j,nslibd) = zzMat%data_r(j,i) end do ELSE do j = 1,nv(jspin) + nlotot - zMat%z_c(j,nslibd) = zzMat%z_c(j,i) + zMat%data_c(j,nslibd) = zzMat%data_c(j,i) end do END IF endif diff --git a/wannier/wann_real.F b/wannier/wann_real.F index 4032805e..97e3ec7b 100644 --- a/wannier/wann_real.F +++ b/wannier/wann_real.F @@ -27,7 +27,7 @@ c ******************************************************** USE m_constants IMPLICIT NONE - TYPE(t_zMat),INTENT(IN) :: zMat + TYPE(t_mat),INTENT(IN) :: zMat C .. Scalar Arguments .. INTEGER, INTENT (IN) :: n3d,nmzxyd,n2d,ntypsd,llod,nlod,iband @@ -107,7 +107,7 @@ c write (6,*) 'nv,nvd=',nv,nvd c write (6,*) 'k1,k2,k3=',k1(k),k2(k),k3(k) c write (6,*) 'z(k,iband)=', z(k,iband) arg = tpi * ((k1(k))*rcc(1)+(k2(k))*rcc(2)+(k3(k))*rcc(3)) - xdnout = xdnout + zMat%z_r(k+addnoco,iband)* + xdnout = xdnout + zMat%data_r(k+addnoco,iband)* + cmplx(cos(arg),sin(arg))*const IF (((abs(p(1)-2.2).le.0.0001).and.(abs(p(2)).le.0.0001)) & .or.((abs(p(2)-2.2).le.0.0001).and.(abs(p(1)).le.0.0001)))then @@ -122,7 +122,7 @@ c write (6,*) 'val=',z(k,iband)*cmplx(cos(arg),sin(arg)) c write (6,*) 'k1,k2,k3=',k1(k),k2(k),k3(k) c write (6,*) 'z(k,iband)=', z(k,iband) arg = tpi * ((k1(k))*rcc(1)+(k2(k))*rcc(2)+(k3(k))*rcc(3)) - xdnout = xdnout + zMat%z_c(k+addnoco,iband)* + xdnout = xdnout + zMat%data_c(k+addnoco,iband)* + cmplx(cos(arg),sin(arg))*const IF (((abs(p(1)-2.2).le.0.0001).and.(abs(p(2)).le.0.0001)) & .or.((abs(p(2)-2.2).le.0.0001).and.(abs(p(1)).le.0.0001)))then diff --git a/wannier/wann_rw_eig.F b/wannier/wann_rw_eig.F index 4eeacaaf..5aeaadca 100644 --- a/wannier/wann_rw_eig.F +++ b/wannier/wann_rw_eig.F @@ -69,15 +69,15 @@ c**************************************************************** ! END QPOINTS real,parameter :: hartree=27.21138505 - TYPE(t_zmat) :: zMat !z(nbasfcn,noccbd) !can be real/complex + TYPE(t_mat) :: zMat !z(nbasfcn,noccbd) !can be real/complex zMat%l_real = l_real - zMat%nbasfcn = nbasfcn - zMat%nbands = neigd + zMat%matsize1 = nbasfcn + zMat%matsize2 = neigd IF(l_real) THEN - ALLOCATE (zMat%z_r(zMat%nbasfcn,zMat%nbands)) + ALLOCATE (zMat%data_r(zMat%matsize1,zMat%matsize2)) ELSE - ALLOCATE (zMat%z_c(zMat%nbasfcn,zMat%nbands)) + ALLOCATE (zMat%data_c(zMat%matsize1,zMat%matsize2)) END IF ! WRITE(*,*)'min',band_min,'max',band_max,'num',numbands @@ -233,7 +233,7 @@ c***************************************************************** REAL, INTENT (OUT) :: ello(nlod,ntypd,jspd),evdu(2,jspd) REAL, INTENT (OUT) :: epar(0:lmaxd,ntypd,jspd) - TYPE(t_zMat), INTENT (INOUT) :: zMat !z(nbasfcn,noccbd) !can be real/complex + TYPE(t_mat), INTENT (INOUT) :: zMat !z(nbasfcn,noccbd) !can be real/complex integer :: n_start,n_end diff --git a/wannier/wann_updown.F b/wannier/wann_updown.F index 307d725a..693daee1 100644 --- a/wannier/wann_updown.F +++ b/wannier/wann_updown.F @@ -259,7 +259,7 @@ c..wf-hamiltonian in real space (hopping in the same unit cell) integer :: spinloop1,spinloop2,ilop TYPE(t_usdus) :: usdus - TYPE(t_zmat) :: zMat(2),zzMat(2) + TYPE(t_mat) :: zMat(2),zzMat(2) TYPE(t_lapw) :: lapw IF(l_ss) CALL juDFT_error("spin-spiral not yet in this version" @@ -712,14 +712,14 @@ c**************************************************************** n_end=neigd zzMat(jspin)%l_real = l_real - zzMat(jspin)%nbasfcn = nbasfcn - zzMat(jspin)%nbands = neigd + zzMat(jspin)%matsize1 = nbasfcn + zzMat(jspin)%matsize2 = neigd IF(l_real) THEN - ALLOCATE (zzMat(jspin)%z_r(zzMat(jspin)%nbasfcn, - + zzMat(jspin)%nbands)) + ALLOCATE (zzMat(jspin)%data_r(zzMat(jspin)%matsize1, + + zzMat(jspin)%matsize2)) ELSE - ALLOCATE (zzMat(jspin)%z_c(zzMat(jspin)%nbasfcn, - + zzMat(jspin)%nbands)) + ALLOCATE (zzMat(jspin)%data_c(zzMat(jspin)%matsize1, + + zzMat(jspin)%matsize2)) END IF ! CALL cdn_read( @@ -741,18 +741,18 @@ c...we work only within the energy window DO jspin = 1, wannierspin zMat(jspin)%l_real = zzMat(jspin)%l_real - zMat(jspin)%nbasfcn = zzMat(jspin)%nbasfcn - zMat(jspin)%nbands = zzMat(jspin)%nbands + zMat(jspin)%matsize1 = zzMat(jspin)%matsize1 + zMat(jspin)%matsize2 = zzMat(jspin)%matsize2 IF (zzMat(jspin)%l_real) THEN - IF(.not.allocated(zmat(jspin)%z_r)) - + ALLOCATE (zMat(jspin)%z_r(zMat(jspin)%nbasfcn, - + zMat(jspin)%nbands)) - zMat(jspin)%z_r = 0.0 + IF(.not.allocated(zmat(jspin)%data_r)) + + ALLOCATE (zMat(jspin)%data_r(zMat(jspin)%matsize1, + + zMat(jspin)%matsize2)) + zMat(jspin)%data_r = 0.0 ELSE - IF(.not.allocated(zMat(jspin)%z_c)) - + ALLOCATE (zMat(jspin)%z_c(zMat(jspin)%nbasfcn, - + zMat(jspin)%nbands)) - zMat(jspin)%z_c = CMPLX(0.0,0.0) + IF(.not.allocated(zMat(jspin)%data_c)) + + ALLOCATE (zMat(jspin)%data_c(zMat(jspin)%matsize1, + + zMat(jspin)%matsize2)) + zMat(jspin)%data_c = CMPLX(0.0,0.0) END IF END DO @@ -781,11 +781,11 @@ c...we work only within the energy window endif IF (zzMat(jspin)%l_real) THEN do j = 1,funbas - zMat(jspin)%z_r(j,nslibd) = zzMat(jspin)%z_r(j,i) + zMat(jspin)%data_r(j,nslibd) = zzMat(jspin)%data_r(j,i) enddo ELSE do j = 1,funbas - zMat(jspin)%z_c(j,nslibd) = zzMat(jspin)%z_c(j,i) + zMat(jspin)%data_c(j,nslibd) = zzMat(jspin)%data_c(j,i) enddo END IF endif @@ -956,11 +956,11 @@ c--> determine index and phase factor do n = 1,nslibd do dir=1,3 IF (zMat%l_real) THEN - zzConjgTemp = cmplx(zMat(1)%z_r(i+addnoco,m) * - + zMat(2)%z_r(j+addnoco,n), 0.0) + zzConjgTemp = cmplx(zMat(1)%data_r(i+addnoco,m) * + + zMat(2)%data_r(j+addnoco,n), 0.0) ELSE - zzConjgTemp = zMat(1)%z_c(i+addnoco,m) * - + CONJG(zMat(2)%z_c(j+addnoco,n)) + zzConjgTemp = zMat(1)%data_c(i+addnoco,m) * + + CONJG(zMat(2)%data_c(j+addnoco,n)) END IF value=phasust*zzConjgTemp nablamat(dir,m,n,ikpt) = nablamat(dir,m,n,ikpt) - diff --git a/wannier/wannier.F b/wannier/wannier.F index bffec7bc..b2677e9a 100644 --- a/wannier/wannier.F +++ b/wannier/wannier.F @@ -306,7 +306,7 @@ c---->gwf logical :: l_bqpts,l_gwf,l_nochi TYPE(t_usdus) :: usdus - TYPE(t_zmat) :: zMat, zzMat, zMat_b, zMat_qb + TYPE(t_mat) :: zMat, zzMat, zMat_b, zMat_qb TYPE(t_lapw) :: lapw, lapw_b, lapw_qb TYPE(t_wann) :: wannTemp @@ -1217,40 +1217,40 @@ c**************************************************************** !if(l_p0) write(*,*)'ujugaunt=',tt2-tt3 zzMat%l_real = l_real - zzMat%nbasfcn = DIMENSION%nbasfcn - zzMat%nbands = DIMENSION%neigd + zzMat%matsize1 = DIMENSION%nbasfcn + zzMat%matsize2 = DIMENSION%neigd IF(l_real) THEN - IF(.not.ALLOCATED(zzMat%z_r)) - > ALLOCATE (zzMat%z_r(zzMat%nbasfcn,zzMat%nbands)) + IF(.not.ALLOCATED(zzMat%data_r)) + > ALLOCATE (zzMat%data_r(zzMat%matsize1,zzMat%matsize2)) ELSE - IF(.not.ALLOCATED(zzMat%z_c)) - > ALLOCATE (zzMat%z_c(zzMat%nbasfcn,zzMat%nbands)) + IF(.not.ALLOCATED(zzMat%data_c)) + > ALLOCATE (zzMat%data_c(zzMat%matsize1,zzMat%matsize2)) END IF zMat%l_real = zzMat%l_real - zMat%nbasfcn = zzMat%nbasfcn - zMat%nbands = zzMat%nbands + zMat%matsize1 = zzMat%matsize1 + zMat%matsize2 = zzMat%matsize2 IF (zzMat%l_real) THEN - IF(.not.ALLOCATED(zMat%z_r)) - > ALLOCATE (zMat%z_r(zMat%nbasfcn,zMat%nbands)) - zMat%z_r = 0.0 + IF(.not.ALLOCATED(zMat%data_r)) + > ALLOCATE (zMat%data_r(zMat%matsize1,zMat%matsize2)) + zMat%data_r = 0.0 ELSE - IF(.not.ALLOCATED(zMat%z_c)) - > ALLOCATE (zMat%z_c(zMat%nbasfcn,zMat%nbands)) - zMat%z_c = CMPLX(0.0,0.0) + IF(.not.ALLOCATED(zMat%data_c)) + > ALLOCATE (zMat%data_c(zMat%matsize1,zMat%matsize2)) + zMat%data_c = CMPLX(0.0,0.0) END IF zMat_b%l_real = zzMat%l_real - zMat_b%nbasfcn = zzMat%nbasfcn - zMat_b%nbands = zzMat%nbands + zMat_b%matsize1 = zzMat%matsize1 + zMat_b%matsize2 = zzMat%matsize2 IF (zzMat%l_real) THEN - IF(.not.ALLOCATED(zMat_b%z_r)) - > ALLOCATE (zMat_b%z_r(zMat_b%nbasfcn,zMat_b%nbands)) - zMat_b%z_r = 0.0 + IF(.not.ALLOCATED(zMat_b%data_r)) + > ALLOCATE (zMat_b%data_r(zMat_b%matsize1,zMat_b%matsize2)) + zMat_b%data_r = 0.0 ELSE - IF(.not.ALLOCATED(zMat_b%z_c)) - > ALLOCATE (zMat_b%z_c(zMat_b%nbasfcn,zMat_b%nbands)) - zMat_b%z_c = CMPLX(0.0,0.0) + IF(.not.ALLOCATED(zMat_b%data_c)) + > ALLOCATE (zMat_b%data_c(zMat_b%matsize1,zMat_b%matsize2)) + zMat_b%data_c = CMPLX(0.0,0.0) END IF i_rec = 0 ; n_rank = 0 @@ -1318,11 +1318,11 @@ c...we work only within the energy window endif IF(zzMat%l_real) THEN do j = 1, funbas - zMat%z_r(j,nslibd) = zzMat%z_r(j,i) + zMat%data_r(j,nslibd) = zzMat%data_r(j,i) end do ELSE do j = 1, funbas - zMat%z_c(j,nslibd) = zzMat%z_c(j,i) + zMat%data_c(j,nslibd) = zzMat%data_c(j,i) end do END IF endif @@ -1744,11 +1744,11 @@ c print*,"something to do" endif IF (zzMat%l_real) THEN do j = 1,funbas - zMat_b%z_r(j,nslibd_b) = zzMat%z_r(j,i) + zMat_b%data_r(j,nslibd_b) = zzMat%data_r(j,i) enddo ELSE do j = 1,funbas - zMat_b%z_c(j,nslibd_b) = zzMat%z_c(j,i) + zMat_b%data_c(j,nslibd_b) = zzMat%data_c(j,i) enddo END IF endif @@ -2003,14 +2003,14 @@ c*******************************************c > calledby="wannier") zMat_qb%l_real = zzMat%l_real - zMat_qb%nbasfcn = zzMat%nbasfcn - zMat_qb%nbands = zzMat%nbands + zMat_qb%matsize1 = zzMat%matsize1 + zMat_qb%matsize2 = zzMat%matsize2 IF (zzMat%l_real) THEN - ALLOCATE (zMat_qb%z_r(zMat%nbasfcn,zMat%nbands)) - zMat_qb%z_r = 0.0 + ALLOCATE (zMat_qb%data_r(zMat%matsize1,zMat%matsize2)) + zMat_qb%data_r = 0.0 ELSE - ALLOCATE (zMat_qb%z_c(zMat%nbasfcn,zMat%nbands)) - zMat_qb%z_c = CMPLX(0.0,0.0) + ALLOCATE (zMat_qb%data_c(zMat%matsize1,zMat%matsize2)) + zMat_qb%data_c = CMPLX(0.0,0.0) END IF eig_qb(:) = 0. @@ -2033,11 +2033,11 @@ c*******************************************c endif IF (zzMat%l_real) THEN do j = 1,funbas - zMat_qb%z_r(j,nslibd_qb) = zzMat%z_r(j,i) + zMat_qb%data_r(j,nslibd_qb) = zzMat%data_r(j,i) enddo ELSE do j = 1,funbas - zMat_qb%z_c(j,nslibd_qb) = zzMat%z_c(j,i) + zMat_qb%data_c(j,nslibd_qb) = zzMat%data_c(j,i) enddo END IF endif @@ -2046,10 +2046,10 @@ c*******************************************c ! check that eigenvectors and -values are identical if q=q+b if(iqpt.eq.qptibz_b .and. jspin.eq.jspin_b) then IF(zMat%l_real) THEN - if(any(zMat%z_r.ne.zMat_qb%z_r)) + if(any(zMat%data_r.ne.zMat_qb%data_r)) + write(*,*)'z.ne.z_qb',iqpt,ikpt ELSE - if(any(zMat%z_c.ne.zMat_qb%z_c)) + if(any(zMat%data_c.ne.zMat_qb%data_c)) + write(*,*)'z.ne.z_qb',iqpt,ikpt END IF if(any(eig.ne.eig_qb)) write(*,*)'eig.ne.eiq_qb',iqpt,ikpt diff --git a/wannier/wannier_to_lapw.F b/wannier/wannier_to_lapw.F index 92b0d093..d630077f 100644 --- a/wannier/wannier_to_lapw.F +++ b/wannier/wannier_to_lapw.F @@ -202,7 +202,7 @@ cccccccccccccccccc local variables cccccccccccccccccccc complex,allocatable::wannz(:,:),wannz2(:,:) real denom - TYPE(t_zmat) :: zzMat, zMat + TYPE(t_mat) :: zzMat, zMat TYPE(t_usdus) :: usdus ci=cmplx(0.,1.) @@ -450,12 +450,12 @@ c****************************************************************** allocate (we(neigd),eigg(neigd)) zzMat%l_real = l_real - zzMat%nbasfcn = nbasfcn - zzMat%nbands = neigd + zzMat%matsize1 = nbasfcn + zzMat%matsize2 = neigd IF(l_real) THEN - ALLOCATE (zzMat%z_r(zzMat%nbasfcn,zzMat%nbands)) + ALLOCATE (zzMat%data_r(zzMat%matsize1,zzMat%matsize2)) ELSE - ALLOCATE (zzMat%z_c(zzMat%nbasfcn,zzMat%nbands)) + ALLOCATE (zzMat%data_c(zzMat%matsize1,zzMat%matsize2)) END IF call wann_read_eig( @@ -469,14 +469,14 @@ c****************************************************************** zMat%l_real = zzMat%l_real - zMat%nbasfcn = zzMat%nbasfcn - zMat%nbands = zzMat%nbands + zMat%matsize1 = zzMat%matsize1 + zMat%matsize2 = zzMat%matsize2 IF (zzMat%l_real) THEN - ALLOCATE (zMat%z_r(zMat%nbasfcn,zMat%nbands)) - zMat%z_r = 0.0 + ALLOCATE (zMat%data_r(zMat%matsize1,zMat%matsize2)) + zMat%data_r = 0.0 ELSE - ALLOCATE (zMat%z_c(zMat%nbasfcn,zMat%nbands)) - zMat%z_c = CMPLX(0.0,0.0) + ALLOCATE (zMat%data_c(zMat%matsize1,zMat%matsize2)) + zMat%data_c = CMPLX(0.0,0.0) END IF nslibd = 0 @@ -497,11 +497,11 @@ c...we work only within the energy window we(nslibd) = we(i) IF(zzMat%l_real) THEN do j = 1,nv(jspin) + nlotot - zMat%z_r(j,nslibd) = zzMat%z_r(j,i) + zMat%data_r(j,nslibd) = zzMat%data_r(j,i) end do ELSE do j = 1,nv(jspin) + nlotot - zMat%z_c(j,nslibd) = zzMat%z_c(j,i) + zMat%data_c(j,nslibd) = zzMat%data_c(j,i) end do END IF endif @@ -591,12 +591,12 @@ c*************************************************************** do m=1,num_wann IF(zMat%l_real) THEN do j=1, nv(jspin) - wannz(j,m)=wannz(j,m)+zMat%z_r(j,n)* + wannz(j,m)=wannz(j,m)+zMat%data_r(j,n)* + u_matrix(n,m,ikpt)/sqrt(omtil) enddo ELSE do j=1, nv(jspin) - wannz(j,m)=wannz(j,m)+zMat%z_c(j,n)* + wannz(j,m)=wannz(j,m)+zMat%data_c(j,n)* + u_matrix(n,m,ikpt)/sqrt(omtil) enddo END IF -- GitLab