From cfd502c44939984629b2afbbfdd926e601f579cf Mon Sep 17 00:00:00 2001 From: Eric Bylaska Date: Sun, 30 Oct 2022 17:43:20 -0700 Subject: [PATCH] bug fix for 2x2ne and 3x3ne covos...EJB --- src/nwpw/pspw/lib/electron/psi_Hv4.F | 16 ++++++++++------ src/nwpw/pspw/lib/psi/psi.F | 9 ++++++--- 2 files changed, 16 insertions(+), 9 deletions(-) diff --git a/src/nwpw/pspw/lib/electron/psi_Hv4.F b/src/nwpw/pspw/lib/electron/psi_Hv4.F index c39701f9b6..bbbe4ac203 100644 --- a/src/nwpw/pspw/lib/electron/psi_Hv4.F +++ b/src/nwpw/pspw/lib/electron/psi_Hv4.F @@ -945,7 +945,7 @@ c > dcpl_mb(vpsi(1))) call D3dB_ny(1,ny) call D3dB_nz(1,nz) call D3dB_nfft3d(1,nfft3d) - n2ft3d = 2*nfft3d + call D3dB_n2ft3d(1,n2ft3d) value = BA_push_get(mt_dcpl,nfft3d,'vall',vall(2),vall(1)) value = value.and. > BA_push_get(mt_dcpl,nfft3d,'vpsi',vpsi(2),vpsi(1)) @@ -1000,6 +1000,8 @@ c > dcpl_mb(vpsi(1))) if (field_exist) > call D3dB_rr_Sum2(1,v_field,dcpl_mb(vall(1))) + call D3dB_r_Zero_Ends(1,dcpl_mb(vall(1))) + * ************************************************************** * **** Hpsi_k = Hpsi_k + FFT[vall_r+xcp)*psi_r +Vsic*psi_r] **** @@ -1009,13 +1011,15 @@ c > dcpl_mb(vpsi(1))) done = .false. do while (.not.done) if (indx1.le.n2(ispin)) then - ms = 1 - if (indx1.gt.n2(1)) ms = 2 * **** vpsi_r = (vall_r)*psi_r **** - call D3dB_r_Copy(1,dcpl_mb(vall(1)),dcpl_mb(vpsi(1))) - call D3dB_rr_Mul2(1,psi_r(1+(indx1-1)*n2ft3d), - > dcpl_mb(vpsi(1))) +c call D3dB_r_Copy(1,dcpl_mb(vall(1)),dcpl_mb(vpsi(1))) +c call D3dB_rr_Mul2(1,psi_r(1+(indx1-1)*n2ft3d), +c > dcpl_mb(vpsi(1))) + + call D3dB_rr_Mul(1,dcpl_mb(vall(1)), + > psi_r(1+(indx1-1)*n2ft3d), + > dcpl_mb(vpsi(1))) * **** put vpsi_r in k-space **** call D3dB_rc_pfft3f_queuein(1,dcpl_mb(vpsi(1))) diff --git a/src/nwpw/pspw/lib/psi/psi.F b/src/nwpw/pspw/lib/psi/psi.F index 4c50b984d6..42c78c87db 100644 --- a/src/nwpw/pspw/lib/psi/psi.F +++ b/src/nwpw/pspw/lib/psi/psi.F @@ -887,6 +887,9 @@ c > dcpl_mb(psi1(1)),1) call Parallel_taskid(taskid) oprint= ((taskid.eq.MASTER).and.control_print(print_medium)) + !*** need to redo cr_fft of psi1 *** + if (ci_algorithm.ge.5) call electron_gen_psi_r(dcpl_mb(psi1(1))) + Hgg = 0.0d0 if (.not.BA_push_get(mt_dcpl,npack1,'g93',g93(2),g93(1))) @@ -2049,7 +2052,7 @@ c H2ge = H2ge + ehfx Hge = H1ge + H2ge Hee = H1ee + H2ee + Eion c if (oprint) write(*,*) "Hgg=",Hgg," Hge=",Hge," Hee=",Hee - write(*,*) "Hgg=",Hgg," Hge=",Hge," Hee=",Hee + !write(*,*) "Hgg=",Hgg," Hge=",Hge," Hee=",Hee A = 1.0d0 B = -Hgg - Hee C = Hgg*Hee - Hge*Hge @@ -2213,6 +2216,7 @@ c oprint = .true. !*** generate Hgg if Hgg==0 *** * *** generate *** if (dabs(Hgg).lt.1.0d-9) then + * **** apply H1 operator **** call psi_H1psi(ispin,neq,npack1,n2ft3d,psig,psig_r,hpsig) H1gg=0.0d0 @@ -2397,7 +2401,7 @@ c call D3dB_rr_Sum2(1,hpsie_r,vcge) c1 = 1.0d0/dsqrt(1.0d0+lmbda**2) !c2 = dsqrt(1.0d0-c1*c1) c2 = lmbda/dsqrt(1.0d0+lmbda**2) - !write(*,*) "Elow=",Elow," Ehigh=",Ehigh + if (oprint) write(*,*) "Elow=",Elow," Ehigh=",Ehigh !write(*,*) * **** generate dElow/dpsie **** @@ -3767,7 +3771,6 @@ c write(*,*) ciE(1),ciE(2),ciE(3),ciE(4) * **** get H1psi **** - !call dcopy(2*nemaxq*npack1,0.0d0,0,H1psi,1) call Parallel_shared_vector_zero(.true.,2*nemaxq*npack1,H1psi) if (aperiodic) then call psi_H1v4(ispin,neq,psi,psi_r,