scemama/qp_plugins_scemama
1
0
Fork 0
mirror of https://gitlab.com/scemama/qp_plugins_scemama.git synced 2024-07-25 20:27:35 +02:00
Code Issues Releases Wiki Activity

Removed H matrix elements in champ

Browse Source
This commit is contained in:
Anthony Scemama 2020-08-26 10:53:46 +02:00
parent 164bf79053
commit 101012938f
1 changed files with 68 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

136
stable/champ/save_for_champ.irp.f
View File

@ -23,73 +23,73 @@ program qmcpack
call system('rm '//trim(ezfio_filename)//'/mo_basis/ao_md5')
call system('$QP_ROOT/src/champ/qp_convert.py '//trim(ezfio_filename))
integer :: iunit
integer, external :: getUnitAndOpen
iunit = getUnitAndOpen(trim(ezfio_filename)//'.H','w')
double precision, external :: diag_h_mat_elem
write(iunit,*) N_states
do istate=1,N_states
write(iunit,*) istate, psi_energy_with_nucl_rep(istate)
enddo
write(iunit,*) N_det
do k=1,N_det
write(iunit,'(I10,X,F22.15)') k, diag_h_mat_elem(psi_det(1,1,k),N_int) + nuclear_repulsion
enddo
double precision :: F(N_states)
integer(bit_kind), allocatable :: det(:,:,:)
double precision , allocatable :: coef(:,:)
integer :: ispin
double precision :: norm(N_states), hij
allocate(det(N_int,2,N_det), coef(N_det,N_states))
do j=1,mo_num
do i=1,j-1
do ispin=1,2
call build_singly_excited_wavefunction(j,i,1,det,coef)
F = 0.d0
do istate=1,N_states
norm(istate) = 0.d0
do k=1,N_det
norm(istate) = norm(istate) + coef(k,istate) * coef(k,istate)
enddo
if (norm(istate) > 0.d0) then
norm(istate) = (1.d0/dsqrt(norm(istate)))
endif
enddo
if (sum(norm(:)) > 0.d0) then
do istate = 1,N_states
coef(:,istate) = coef(:,istate) * norm(istate)
enddo
!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(i,j,istate,hij) REDUCTION(+:F)
do k=1,N_det
if (sum(coef(k,:)*coef(k,:))==0.d0) cycle
call i_H_j(det(1,1,k), det(1,1,k), N_int, hij)
do istate=1,N_states
F(istate) = F(istate) + hij*coef(k,istate)*coef(k,istate)
enddo
do l=1,k-1
if (sum(coef(l,:)*coef(l,:))==0.d0) cycle
call i_H_j(det(1,1,k), det(1,1,l), N_int, hij)
do istate=1,N_states
F(istate) = F(istate) + 2.d0*hij*coef(k,istate)*coef(l,istate)
enddo
enddo
enddo
!$OMP END PARALLEL DO
F(:) = F(:) - psi_energy(:)
endif
do istate=1,N_states
write(iunit,'(I4,X,I4,X,I1,X,I3,X,F22.15)') i, j, ispin, istate, F(istate)
enddo
enddo
enddo
enddo
deallocate(det,coef)
close(iunit)
! integer :: iunit
! integer, external :: getUnitAndOpen
! iunit = getUnitAndOpen(trim(ezfio_filename)//'.H','w')
!
! double precision, external :: diag_h_mat_elem
! write(iunit,*) N_states
! do istate=1,N_states
! write(iunit,*) istate, psi_energy_with_nucl_rep(istate)
! enddo
! write(iunit,*) N_det
! do k=1,N_det
! write(iunit,'(I10,X,F22.15)') k, diag_h_mat_elem(psi_det(1,1,k),N_int) + nuclear_repulsion
! enddo
!
!
! double precision :: F(N_states)
! integer(bit_kind), allocatable :: det(:,:,:)
! double precision , allocatable :: coef(:,:)
! integer :: ispin
! double precision :: norm(N_states), hij
! allocate(det(N_int,2,N_det), coef(N_det,N_states))
! do j=1,mo_num
! do i=1,j-1
! do ispin=1,2
! call build_singly_excited_wavefunction(j,i,1,det,coef)
! F = 0.d0
! do istate=1,N_states
! norm(istate) = 0.d0
! do k=1,N_det
! norm(istate) = norm(istate) + coef(k,istate) * coef(k,istate)
! enddo
! if (norm(istate) > 0.d0) then
! norm(istate) = (1.d0/dsqrt(norm(istate)))
! endif
! enddo
! if (sum(norm(:)) > 0.d0) then
!
! do istate = 1,N_states
! coef(:,istate) = coef(:,istate) * norm(istate)
! enddo
! !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(i,j,istate,hij) REDUCTION(+:F)
! do k=1,N_det
! if (sum(coef(k,:)*coef(k,:))==0.d0) cycle
! call i_H_j(det(1,1,k), det(1,1,k), N_int, hij)
! do istate=1,N_states
! F(istate) = F(istate) + hij*coef(k,istate)*coef(k,istate)
! enddo
! do l=1,k-1
! if (sum(coef(l,:)*coef(l,:))==0.d0) cycle
! call i_H_j(det(1,1,k), det(1,1,l), N_int, hij)
! do istate=1,N_states
! F(istate) = F(istate) + 2.d0*hij*coef(k,istate)*coef(l,istate)
! enddo
! enddo
! enddo
! !$OMP END PARALLEL DO
! F(:) = F(:) - psi_energy(:)
! endif
! do istate=1,N_states
! write(iunit,'(I4,X,I4,X,I1,X,I3,X,F22.15)') i, j, ispin, istate, F(istate)
! enddo
! enddo
! enddo
! enddo
!
! deallocate(det,coef)
!
! close(iunit)
end