mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-12-23 04:43:45 +01:00
Optimize PT2
This commit is contained in:
parent
416ff24ff4
commit
27dc0c06ae
@ -253,22 +253,22 @@ subroutine run_pt2_slave_large(thread,iproc,energy)
|
|||||||
call sort_selection_buffer(b)
|
call sort_selection_buffer(b)
|
||||||
|
|
||||||
call wall_time(time1)
|
call wall_time(time1)
|
||||||
if (time1-time0 > 15.d0) then
|
! if (time1-time0 > 15.d0) then
|
||||||
call omp_set_lock(global_selection_buffer_lock)
|
call omp_set_lock(global_selection_buffer_lock)
|
||||||
global_selection_buffer%mini = b%mini
|
global_selection_buffer%mini = b%mini
|
||||||
call merge_selection_buffers(b,global_selection_buffer)
|
call merge_selection_buffers(b,global_selection_buffer)
|
||||||
b%cur=0
|
b%cur=0
|
||||||
call omp_unset_lock(global_selection_buffer_lock)
|
call omp_unset_lock(global_selection_buffer_lock)
|
||||||
call wall_time(time0)
|
call wall_time(time0)
|
||||||
if ( iproc == 1 .or. i_generator < 100 .or. done) then
|
! endif
|
||||||
call omp_set_lock(global_selection_buffer_lock)
|
|
||||||
call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending)
|
call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending)
|
||||||
call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), global_selection_buffer, (/task_id/), 1,sending)
|
if ( iproc == 1 .or. i_generator < 100 .or. done) then
|
||||||
global_selection_buffer%cur = 0
|
call omp_set_lock(global_selection_buffer_lock)
|
||||||
call omp_unset_lock(global_selection_buffer_lock)
|
call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), global_selection_buffer, (/task_id/), 1,sending)
|
||||||
endif
|
global_selection_buffer%cur = 0
|
||||||
|
call omp_unset_lock(global_selection_buffer_lock)
|
||||||
else
|
else
|
||||||
call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending)
|
|
||||||
call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), b, (/task_id/), 1,sending)
|
call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), b, (/task_id/), 1,sending)
|
||||||
endif
|
endif
|
||||||
|
|
||||||
|
@ -92,38 +92,51 @@ subroutine merge_selection_buffers(b1, b2)
|
|||||||
allocate(val(sze), detmp(N_int, 2, sze))
|
allocate(val(sze), detmp(N_int, 2, sze))
|
||||||
i1=1
|
i1=1
|
||||||
i2=1
|
i2=1
|
||||||
do i=1,nmwen
|
|
||||||
if ( (i1 > b1%cur).and.(i2 > b2%cur) ) then
|
select case (N_int)
|
||||||
exit
|
BEGIN_TEMPLATE
|
||||||
else if (i1 > b1%cur) then
|
case $case
|
||||||
val(i) = b2%val(i2)
|
do i=1,nmwen
|
||||||
detmp(1:N_int,1,i) = b2%det(1:N_int,1,i2)
|
if ( (i1 > b1%cur).and.(i2 > b2%cur) ) then
|
||||||
detmp(1:N_int,2,i) = b2%det(1:N_int,2,i2)
|
exit
|
||||||
i2=i2+1
|
else if (i1 > b1%cur) then
|
||||||
else if (i2 > b2%cur) then
|
val(i) = b2%val(i2)
|
||||||
val(i) = b1%val(i1)
|
detmp(1:$N_int,1,i) = b2%det(1:$N_int,1,i2)
|
||||||
detmp(1:N_int,1,i) = b1%det(1:N_int,1,i1)
|
detmp(1:$N_int,2,i) = b2%det(1:$N_int,2,i2)
|
||||||
detmp(1:N_int,2,i) = b1%det(1:N_int,2,i1)
|
i2=i2+1
|
||||||
i1=i1+1
|
else if (i2 > b2%cur) then
|
||||||
else
|
val(i) = b1%val(i1)
|
||||||
if (b1%val(i1) <= b2%val(i2)) then
|
detmp(1:$N_int,1,i) = b1%det(1:$N_int,1,i1)
|
||||||
val(i) = b1%val(i1)
|
detmp(1:$N_int,2,i) = b1%det(1:$N_int,2,i1)
|
||||||
detmp(1:N_int,1,i) = b1%det(1:N_int,1,i1)
|
i1=i1+1
|
||||||
detmp(1:N_int,2,i) = b1%det(1:N_int,2,i1)
|
|
||||||
i1=i1+1
|
|
||||||
else
|
else
|
||||||
val(i) = b2%val(i2)
|
if (b1%val(i1) <= b2%val(i2)) then
|
||||||
detmp(1:N_int,1,i) = b2%det(1:N_int,1,i2)
|
val(i) = b1%val(i1)
|
||||||
detmp(1:N_int,2,i) = b2%det(1:N_int,2,i2)
|
detmp(1:$N_int,1,i) = b1%det(1:$N_int,1,i1)
|
||||||
i2=i2+1
|
detmp(1:$N_int,2,i) = b1%det(1:$N_int,2,i1)
|
||||||
|
i1=i1+1
|
||||||
|
else
|
||||||
|
val(i) = b2%val(i2)
|
||||||
|
detmp(1:$N_int,1,i) = b2%det(1:$N_int,1,i2)
|
||||||
|
detmp(1:$N_int,2,i) = b2%det(1:$N_int,2,i2)
|
||||||
|
i2=i2+1
|
||||||
|
endif
|
||||||
endif
|
endif
|
||||||
endif
|
enddo
|
||||||
enddo
|
do i=nmwen+1,b2%N
|
||||||
|
val(i) = 0.d0
|
||||||
|
! detmp(1:$N_int,1,i) = 0_bit_kind
|
||||||
|
! detmp(1:$N_int,2,i) = 0_bit_kind
|
||||||
|
enddo
|
||||||
|
SUBST [ case, N_int ]
|
||||||
|
(1); 1;;
|
||||||
|
(2); 2;;
|
||||||
|
(3); 3;;
|
||||||
|
(4); 4;;
|
||||||
|
default; N_int;;
|
||||||
|
END_TEMPLATE
|
||||||
|
end select
|
||||||
deallocate(b2%det, b2%val)
|
deallocate(b2%det, b2%val)
|
||||||
do i=nmwen+1,b2%N
|
|
||||||
val(i) = 0.d0
|
|
||||||
detmp(1:N_int,1:2,i) = 0_bit_kind
|
|
||||||
enddo
|
|
||||||
b2%det => detmp
|
b2%det => detmp
|
||||||
b2%val => val
|
b2%val => val
|
||||||
b2%mini = min(b2%mini,b2%val(b2%N))
|
b2%mini = min(b2%mini,b2%val(b2%N))
|
||||||
|
Loading…
Reference in New Issue
Block a user