PTEROSOR/QuantumPackage
10
0
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-23 04:43:45 +01:00
Code Releases Activity

Added replace_wf in h_apply

Browse Source
This commit is contained in:
Anthony Scemama 2023-03-23 15:13:30 +01:00
parent c19f486670
commit a2f229370b
2 changed files with 73 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
external/qp2-dependencies vendored

@ -1 +1 @@
Subproject commit ce14f57b50511825a9fedb096749200779d3f4d4 Subproject commit 6e23ebac001acae91d1c762ca934e09a9b7d614a

46
src/determinants/h_apply.irp.f
View File

@ -69,9 +69,12 @@ subroutine resize_H_apply_buffer(new_size,iproc)
END_DOC END_DOC
PROVIDE H_apply_buffer_allocated PROVIDE H_apply_buffer_allocated
ASSERT (new_size > 0)
ASSERT (iproc >= 0) if (N_det < 0) call abort(irp_here//': N_det < 0')
ASSERT (iproc < nproc) if (N_int <= 0) call abort(irp_here//': N_int <= 0')
if (new_size <= 0) call abort(irp_here//': new_size <= 0')
if (iproc < 0) call abort(irp_here//': iproc < 0')
if (iproc >= nproc) call abort(irp_here//': iproc >= nproc')
allocate ( buffer_det(N_int,2,new_size), & allocate ( buffer_det(N_int,2,new_size), &
buffer_coef(new_size,N_states), & buffer_coef(new_size,N_states), &
@ -126,8 +129,10 @@ subroutine copy_H_apply_buffer_to_wf
ASSERT (N_int > 0) ASSERT (N_int > 0)
ASSERT (N_det > 0) ASSERT (N_det >= 0)
N_det_old = N_det
if (N_det > 0) then
allocate ( buffer_det(N_int,2,N_det), buffer_coef(N_det,N_states) ) allocate ( buffer_det(N_int,2,N_det), buffer_coef(N_det,N_states) )
! Backup determinants ! Backup determinants
@ -151,6 +156,7 @@ subroutine copy_H_apply_buffer_to_wf
enddo enddo
ASSERT ( j == N_det_old ) ASSERT ( j == N_det_old )
enddo enddo
endif
! Update N_det ! Update N_det
N_det = N_det_old N_det = N_det_old
@ -164,6 +170,7 @@ subroutine copy_H_apply_buffer_to_wf
TOUCH psi_det_size TOUCH psi_det_size
endif endif
if (N_det_old > 0) then
! Restore backup in resized array ! Restore backup in resized array
do i=1,N_det_old do i=1,N_det_old
psi_det(:,:,i) = buffer_det(:,:,i) psi_det(:,:,i) = buffer_det(:,:,i)
@ -175,6 +182,7 @@ subroutine copy_H_apply_buffer_to_wf
psi_coef(i,k) = buffer_coef(i,k) psi_coef(i,k) = buffer_coef(i,k)
enddo enddo
enddo enddo
endif
! Copy new buffers ! Copy new buffers
@ -339,3 +347,33 @@ subroutine fill_H_apply_buffer_no_selection(n_selected,det_buffer,Nint,iproc)
call omp_unset_lock(H_apply_buffer_lock(1,iproc)) call omp_unset_lock(H_apply_buffer_lock(1,iproc))
end end
subroutine replace_wf(N_det_new, LDA, psi_coef_new, psi_det_new)
use omp_lib
implicit none
BEGIN_DOC
! Replaces the wave function.
! After calling this subroutine, N_det, psi_det and psi_coef need to be touched
END_DOC
integer, intent(in) :: N_det_new, LDA
double precision, intent(in) :: psi_coef_new(LDA,N_states)
integer(bit_kind), intent(in) :: psi_det_new(N_int,2,N_det_new)
integer :: i,j
PROVIDE H_apply_buffer_allocated
if (N_det_new <= 0) call abort(irp_here//': N_det_new <= 0')
if (N_int <= 0) call abort(irp_here//': N_int <= 0')
if (LDA < N_det_new) call abort(irp_here//': LDA < N_det_new')
do j=0,nproc-1
H_apply_buffer(j)%N_det = 0
enddo
N_det = 0
SOFT_TOUCH N_det
call fill_H_apply_buffer_no_selection(N_det_new,psi_det_new,N_int,0)
call copy_h_apply_buffer_to_wf
psi_coef(1:N_det_new,1:N_states) = psi_coef_new(1:N_det_new,1:N_states)
end