mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-08-29 04:12:00 +02:00
Merge branch 'dev-stable' into dev-stable-tc-scf
This commit is contained in:
commit
f4bcf66b9b
@ -69,9 +69,15 @@ subroutine resize_H_apply_buffer(new_size,iproc)
|
||||
END_DOC
|
||||
PROVIDE H_apply_buffer_allocated
|
||||
|
||||
|
||||
ASSERT (new_size > 0)
|
||||
ASSERT (iproc >= 0)
|
||||
ASSERT (iproc < nproc)
|
||||
if (N_det < 0) call abort() !irp_here//': N_det < 0')
|
||||
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), &
|
||||
buffer_coef(new_size,N_states), &
|
||||
@ -126,8 +132,10 @@ subroutine copy_H_apply_buffer_to_wf
|
||||
|
||||
|
||||
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) )
|
||||
|
||||
! Backup determinants
|
||||
@ -151,6 +159,7 @@ subroutine copy_H_apply_buffer_to_wf
|
||||
enddo
|
||||
ASSERT ( j == N_det_old )
|
||||
enddo
|
||||
endif
|
||||
|
||||
! Update N_det
|
||||
N_det = N_det_old
|
||||
@ -164,6 +173,7 @@ subroutine copy_H_apply_buffer_to_wf
|
||||
TOUCH psi_det_size
|
||||
endif
|
||||
|
||||
if (N_det_old > 0) then
|
||||
! Restore backup in resized array
|
||||
do i=1,N_det_old
|
||||
psi_det(:,:,i) = buffer_det(:,:,i)
|
||||
@ -175,6 +185,7 @@ subroutine copy_H_apply_buffer_to_wf
|
||||
psi_coef(i,k) = buffer_coef(i,k)
|
||||
enddo
|
||||
enddo
|
||||
endif
|
||||
|
||||
! Copy new buffers
|
||||
|
||||
@ -339,3 +350,33 @@ subroutine fill_H_apply_buffer_no_selection(n_selected,det_buffer,Nint,iproc)
|
||||
call omp_unset_lock(H_apply_buffer_lock(1,iproc))
|
||||
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
|
||||
|
Loading…
Reference in New Issue
Block a user