LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-21 11:03:29 +01:00
Code Releases Activity

Optimize PT2

Browse Source
This commit is contained in:
Anthony Scemama 2022-03-10 00:55:23 +01:00
parent 416ff24ff4
commit 27dc0c06ae
2 changed files with 51 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
src/cipsi/run_pt2_slave.irp.f
View File

@ -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

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

@ -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))