LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-06-29 15:54:42 +02:00
Code Releases Activity

Cleaning

Browse Source
This commit is contained in:
Anthony Scemama 2021-12-07 22:53:28 +01:00
parent 13eee57e67
commit dc43924aa6
4 changed files with 10 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
src/cipsi/pt2_stoch_routines.irp.f
View File

@ -117,7 +117,6 @@ subroutine ZMQ_pt2(E, pt2_data, pt2_data_err, relative_error, N_in)
integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull
integer, intent(in) :: N_in integer, intent(in) :: N_in
! integer, intent(inout) :: N_in
double precision, intent(in) :: relative_error, E(N_states) double precision, intent(in) :: relative_error, E(N_states)
type(pt2_type), intent(inout) :: pt2_data, pt2_data_err type(pt2_type), intent(inout) :: pt2_data, pt2_data_err
! !

17
src/cipsi/selection_buffer.irp.f
View File

@ -60,6 +60,7 @@ subroutine add_to_selection_buffer(b, det, val)
b%val(b%cur) = val b%val(b%cur) = val
if(b%cur == size(b%val)) then if(b%cur == size(b%val)) then
call sort_selection_buffer(b) call sort_selection_buffer(b)
b%cur = b%cur-1
end if end if
end if end if
end subroutine end subroutine
@ -144,8 +145,8 @@ subroutine sort_selection_buffer(b)
double precision :: rss double precision :: rss
double precision, external :: memory_of_double, memory_of_int double precision, external :: memory_of_double, memory_of_int
rss = memory_of_int(b%cur) + 2*N_int*memory_of_double(size(b%det,3)) ! rss = memory_of_int(b%cur) + 2*N_int*memory_of_double(size(b%det,3))
call check_mem(rss,irp_here) ! call check_mem(rss,irp_here)
allocate(iorder(b%cur), detmp(N_int, 2, size(b%det,3))) allocate(iorder(b%cur), detmp(N_int, 2, size(b%det,3)))
do i=1,b%cur do i=1,b%cur
iorder(i) = i iorder(i) = i
@ -225,14 +226,14 @@ subroutine make_selection_buffer_s2(b)
endif endif
dup = .True. dup = .True.
do k=1,N_int do k=1,N_int
if ( (tmp_array(k,1,i) /= tmp_array(k,1,j)) & if ( (tmp_array(k,1,i) /= tmp_array(k,1,j)) .or. &
.or. (tmp_array(k,2,i) /= tmp_array(k,2,j)) ) then (tmp_array(k,2,i) /= tmp_array(k,2,j)) ) then
dup = .False. dup = .False.
exit exit
endif endif
enddo enddo
if (dup) then if (dup) then
val(i) = max(val(i), val(j)) val(i) = min(val(i), val(j))
duplicate(j) = .True. duplicate(j) = .True.
endif endif
j+=1 j+=1
@ -282,9 +283,6 @@ subroutine make_selection_buffer_s2(b)
call configuration_to_dets_size(o(1,1,i),sze,elec_alpha_num,N_int) call configuration_to_dets_size(o(1,1,i),sze,elec_alpha_num,N_int)
n_d = n_d + sze n_d = n_d + sze
if (n_d > b%cur) then if (n_d > b%cur) then
! if (n_d - b%cur > b%cur - n_d + sze) then
! n_d = n_d - sze
! endif
exit exit
endif endif
enddo enddo
@ -329,10 +327,11 @@ subroutine remove_duplicates_in_selection_buffer(b)
integer(bit_kind), allocatable :: tmp_array(:,:,:) integer(bit_kind), allocatable :: tmp_array(:,:,:)
logical, allocatable :: duplicate(:) logical, allocatable :: duplicate(:)
n_d = b%cur
logical :: found_duplicates logical :: found_duplicates
double precision :: rss double precision :: rss
double precision, external :: memory_of_double double precision, external :: memory_of_double
n_d = b%cur
rss = (4*N_int+4)*memory_of_double(n_d) rss = (4*N_int+4)*memory_of_double(n_d)
call check_mem(rss,irp_here) call check_mem(rss,irp_here)

2
src/cipsi/slave_cipsi.irp.f
View File

@ -311,7 +311,7 @@ subroutine run_slave_main
if (mpi_master) then if (mpi_master) then
print *, 'Running PT2' print *, 'Running PT2'
endif endif
!$OMP PARALLEL PRIVATE(i) NUM_THREADS(nproc_target+1) !$OMP PARALLEL PRIVATE(i) NUM_THREADS(nproc_target)
i = omp_get_thread_num() i = omp_get_thread_num()
call run_pt2_slave(0,i,pt2_e0_denominator) call run_pt2_slave(0,i,pt2_e0_denominator)
!$OMP END PARALLEL !$OMP END PARALLEL

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

@ -322,10 +322,7 @@ subroutine fill_H_apply_buffer_no_selection(n_selected,det_buffer,Nint,iproc)
ASSERT (sum(popcnt(H_apply_buffer(iproc)%det(:,2,i))) == elec_beta_num) ASSERT (sum(popcnt(H_apply_buffer(iproc)%det(:,2,i))) == elec_beta_num)
enddo enddo
do i=1,n_selected do i=1,n_selected
do j=1,N_int H_apply_buffer(iproc)%det(:,:,i+H_apply_buffer(iproc)%N_det) = det_buffer(:,:,i)
H_apply_buffer(iproc)%det(j,1,i+H_apply_buffer(iproc)%N_det) = det_buffer(j,1,i)
H_apply_buffer(iproc)%det(j,2,i+H_apply_buffer(iproc)%N_det) = det_buffer(j,2,i)
enddo
ASSERT (sum(popcnt(H_apply_buffer(iproc)%det(:,1,i+H_apply_buffer(iproc)%N_det)) )== elec_alpha_num) ASSERT (sum(popcnt(H_apply_buffer(iproc)%det(:,1,i+H_apply_buffer(iproc)%N_det)) )== elec_alpha_num)
ASSERT (sum(popcnt(H_apply_buffer(iproc)%det(:,2,i+H_apply_buffer(iproc)%N_det))) == elec_beta_num) ASSERT (sum(popcnt(H_apply_buffer(iproc)%det(:,2,i+H_apply_buffer(iproc)%N_det))) == elec_beta_num)
enddo enddo