LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-11-12 17:13:54 +01:00
Code Issues Releases Wiki Activity

Added lock on selection buffer

Browse Source
This commit is contained in:
Anthony Scemama 2014-10-27 15:33:22 +01:00
parent f95fee22bf
commit adadc45efa
2 changed files with 11 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/Dets/H_apply.irp.f
View File

@ -1,4 +1,5 @@
use bitmasks
use omp_lib
type H_apply_buffer_type
integer :: N_det
@ -11,7 +12,8 @@ end type H_apply_buffer_type
type(H_apply_buffer_type), pointer :: H_apply_buffer(:)
BEGIN_PROVIDER [ logical, H_apply_buffer_allocated ]
BEGIN_PROVIDER [ logical, H_apply_buffer_allocated ]
&BEGIN_PROVIDER [ integer(omp_lock_kind), H_apply_buffer_lock, (64,0:nproc-1) ]
use omp_lib
implicit none
BEGIN_DOC
@ -24,7 +26,7 @@ BEGIN_PROVIDER [ logical, H_apply_buffer_allocated ]
allocate(H_apply_buffer(0:nproc-1))
iproc = 0
!$OMP PARALLEL PRIVATE(iproc) DEFAULT(NONE) &
!$OMP SHARED(H_apply_buffer,N_int,sze,N_states)
!$OMP SHARED(H_apply_buffer,N_int,sze,N_states,H_apply_buffer_lock)
!$ iproc = omp_get_thread_num()
H_apply_buffer(iproc)%N_det = 0
H_apply_buffer(iproc)%sze = sze
@ -36,6 +38,7 @@ BEGIN_PROVIDER [ logical, H_apply_buffer_allocated ]
H_apply_buffer(iproc)%det = 0_bit_kind
H_apply_buffer(iproc)%coef = 0.d0
H_apply_buffer(iproc)%e2 = 0.d0
call omp_init_lock(H_apply_buffer_lock(1,iproc))
!$OMP END PARALLEL
endif
@ -56,6 +59,7 @@ subroutine resize_H_apply_buffer(new_size,iproc)
ASSERT (iproc >= 0)
ASSERT (iproc < nproc)
call omp_set_lock(H_apply_buffer_lock(1,iproc))
allocate ( buffer_det(N_int,2,new_size), &
buffer_coef(new_size,N_states), &
buffer_e2(new_size,N_states) )
@ -89,6 +93,7 @@ subroutine resize_H_apply_buffer(new_size,iproc)
H_apply_buffer(iproc)%sze = new_size
H_apply_buffer(iproc)%N_det = min(new_size,H_apply_buffer(iproc)%N_det)
call omp_unset_lock(H_apply_buffer_lock(1,iproc))
end
@ -194,6 +199,7 @@ subroutine fill_H_apply_buffer_no_selection(n_selected,det_buffer,Nint,iproc)
if (new_size > H_apply_buffer(iproc)%sze) then
call resize_h_apply_buffer(max(2*H_apply_buffer(iproc)%sze,new_size),iproc)
endif
call omp_set_lock(H_apply_buffer_lock(1,iproc))
do i=1,H_apply_buffer(iproc)%N_det
ASSERT (sum(popcnt(H_apply_buffer(iproc)%det(:,1,i)) )== elec_alpha_num)
ASSERT (sum(popcnt(H_apply_buffer(iproc)%det(:,2,i))) == elec_beta_num)
@ -216,6 +222,7 @@ subroutine fill_H_apply_buffer_no_selection(n_selected,det_buffer,Nint,iproc)
ASSERT (sum(popcnt(H_apply_buffer(iproc)%det(:,1,i)) )== elec_alpha_num)
ASSERT (sum(popcnt(H_apply_buffer(iproc)%det(:,2,i))) == elec_beta_num)
enddo
call omp_unset_lock(H_apply_buffer_lock(1,iproc))
end

2
src/Perturbation/selection.irp.f
View File

@ -26,6 +26,7 @@ subroutine fill_H_apply_buffer_selection(n_selected,det_buffer,e_2_pert_buffer,c
if (new_size > h_apply_buffer(iproc)%sze) then
call resize_h_apply_buffer(max(h_apply_buffer(iproc)%sze*2,new_size),iproc)
endif
call omp_set_lock(H_apply_buffer_lock(1,iproc))
do i=1,H_apply_buffer(iproc)%N_det
ASSERT (sum(popcnt(h_apply_buffer(iproc)%det(:,1,i)) )== elec_alpha_num)
ASSERT (sum(popcnt(h_apply_buffer(iproc)%det(:,2,i))) == elec_beta_num)
@ -63,6 +64,7 @@ subroutine fill_H_apply_buffer_selection(n_selected,det_buffer,e_2_pert_buffer,c
ASSERT (sum(popcnt(h_apply_buffer(iproc)%det(:,1,i)) )== elec_alpha_num)
ASSERT (sum(popcnt(h_apply_buffer(iproc)%det(:,2,i))) == elec_beta_num)
enddo
call omp_unset_lock(H_apply_buffer_lock(1,iproc))
!$OMP CRITICAL
selection_criterion = max(selection_criterion,smax)
selection_criterion_min = min(selection_criterion_min,smin)