comp-chem/NWChem
1
0
Fork 0
mirror of https://github.com/nwchemgit/nwchem.git synced 2026-07-28 22:25:48 -04:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

bug fix for 2x2ne and 3x3ne covos...EJB

Browse source
This commit is contained in:
Eric Bylaska 2022-10-30 17:43:20 -07:00
parent 1f806bd709
commit cfd502c449
2 changed files with 16 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

16
src/nwpw/pspw/lib/electron/psi_Hv4.F
View file

@ -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)))

9
src/nwpw/pspw/lib/psi/psi.F
View file

@ -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 <g|H|g> ***
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,