mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-10-15 20:21:34 +02:00
Cleaning
This commit is contained in:
parent
13eee57e67
commit
dc43924aa6
@ -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, intent(in) :: N_in
|
||||
! integer, intent(inout) :: N_in
|
||||
double precision, intent(in) :: relative_error, E(N_states)
|
||||
type(pt2_type), intent(inout) :: pt2_data, pt2_data_err
|
||||
!
|
||||
|
@ -60,6 +60,7 @@ subroutine add_to_selection_buffer(b, det, val)
|
||||
b%val(b%cur) = val
|
||||
if(b%cur == size(b%val)) then
|
||||
call sort_selection_buffer(b)
|
||||
b%cur = b%cur-1
|
||||
end if
|
||||
end if
|
||||
end subroutine
|
||||
@ -144,8 +145,8 @@ subroutine sort_selection_buffer(b)
|
||||
|
||||
double precision :: rss
|
||||
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))
|
||||
call check_mem(rss,irp_here)
|
||||
! rss = memory_of_int(b%cur) + 2*N_int*memory_of_double(size(b%det,3))
|
||||
! call check_mem(rss,irp_here)
|
||||
allocate(iorder(b%cur), detmp(N_int, 2, size(b%det,3)))
|
||||
do i=1,b%cur
|
||||
iorder(i) = i
|
||||
@ -225,14 +226,14 @@ subroutine make_selection_buffer_s2(b)
|
||||
endif
|
||||
dup = .True.
|
||||
do k=1,N_int
|
||||
if ( (tmp_array(k,1,i) /= tmp_array(k,1,j)) &
|
||||
.or. (tmp_array(k,2,i) /= tmp_array(k,2,j)) ) then
|
||||
if ( (tmp_array(k,1,i) /= tmp_array(k,1,j)) .or. &
|
||||
(tmp_array(k,2,i) /= tmp_array(k,2,j)) ) then
|
||||
dup = .False.
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
if (dup) then
|
||||
val(i) = max(val(i), val(j))
|
||||
val(i) = min(val(i), val(j))
|
||||
duplicate(j) = .True.
|
||||
endif
|
||||
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)
|
||||
n_d = n_d + sze
|
||||
if (n_d > b%cur) then
|
||||
! if (n_d - b%cur > b%cur - n_d + sze) then
|
||||
! n_d = n_d - sze
|
||||
! endif
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
@ -329,10 +327,11 @@ subroutine remove_duplicates_in_selection_buffer(b)
|
||||
integer(bit_kind), allocatable :: tmp_array(:,:,:)
|
||||
logical, allocatable :: duplicate(:)
|
||||
|
||||
n_d = b%cur
|
||||
logical :: found_duplicates
|
||||
double precision :: rss
|
||||
double precision, external :: memory_of_double
|
||||
|
||||
n_d = b%cur
|
||||
rss = (4*N_int+4)*memory_of_double(n_d)
|
||||
call check_mem(rss,irp_here)
|
||||
|
||||
|
@ -311,7 +311,7 @@ subroutine run_slave_main
|
||||
if (mpi_master) then
|
||||
print *, 'Running PT2'
|
||||
endif
|
||||
!$OMP PARALLEL PRIVATE(i) NUM_THREADS(nproc_target+1)
|
||||
!$OMP PARALLEL PRIVATE(i) NUM_THREADS(nproc_target)
|
||||
i = omp_get_thread_num()
|
||||
call run_pt2_slave(0,i,pt2_e0_denominator)
|
||||
!$OMP END PARALLEL
|
||||
|
@ -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)
|
||||
enddo
|
||||
do i=1,n_selected
|
||||
do j=1,N_int
|
||||
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
|
||||
H_apply_buffer(iproc)%det(:,:,i+H_apply_buffer(iproc)%N_det) = det_buffer(:,:,i)
|
||||
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)
|
||||
enddo
|
||||
|
Loading…
Reference in New Issue
Block a user