mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-08-30 20:53:42 +02:00
Merge branch 'develop' into develop_manu
This commit is contained in:
commit
e41e34be58
@ -11,9 +11,15 @@ BEGIN_PROVIDER [ double precision, pt2_E0_denominator, (N_states) ]
|
|||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! E0 in the denominator of the PT2
|
! E0 in the denominator of the PT2
|
||||||
END_DOC
|
END_DOC
|
||||||
|
integer :: i,j
|
||||||
if (initialize_pt2_E0_denominator) then
|
if (initialize_pt2_E0_denominator) then
|
||||||
if (h0_type == "EN") then
|
if (h0_type == "EN") then
|
||||||
pt2_E0_denominator(1:N_states) = psi_energy(1:N_states)
|
pt2_E0_denominator(1:N_states) = psi_energy(1:N_states)
|
||||||
|
else if (h0_type == "HF") then
|
||||||
|
do i=1,N_states
|
||||||
|
j = maxloc(abs(psi_coef(:,i)),1)
|
||||||
|
pt2_E0_denominator(i) = psi_det_hii(j)
|
||||||
|
enddo
|
||||||
else if (h0_type == "Barycentric") then
|
else if (h0_type == "Barycentric") then
|
||||||
pt2_E0_denominator(1:N_states) = barycentric_electronic_energy(1:N_states)
|
pt2_E0_denominator(1:N_states) = barycentric_electronic_energy(1:N_states)
|
||||||
else if (h0_type == "Variance") then
|
else if (h0_type == "Variance") then
|
||||||
@ -24,7 +30,9 @@ BEGIN_PROVIDER [ double precision, pt2_E0_denominator, (N_states) ]
|
|||||||
print *, h0_type, ' not implemented'
|
print *, h0_type, ' not implemented'
|
||||||
stop
|
stop
|
||||||
endif
|
endif
|
||||||
call write_double(6,pt2_E0_denominator(1)+nuclear_repulsion, 'PT2 Energy denominator')
|
do i=1,N_states
|
||||||
|
call write_double(6,pt2_E0_denominator(i)+nuclear_repulsion, 'PT2 Energy denominator')
|
||||||
|
enddo
|
||||||
else
|
else
|
||||||
pt2_E0_denominator = -huge(1.d0)
|
pt2_E0_denominator = -huge(1.d0)
|
||||||
endif
|
endif
|
||||||
|
@ -248,8 +248,8 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error, variance, norm, N_in)
|
|||||||
+ 64.d0*pt2_n_tasks_max & ! task
|
+ 64.d0*pt2_n_tasks_max & ! task
|
||||||
+ 3.d0*pt2_n_tasks_max*N_states & ! pt2, variance, norm
|
+ 3.d0*pt2_n_tasks_max*N_states & ! pt2, variance, norm
|
||||||
+ 1.d0*pt2_n_tasks_max & ! i_generator, subset
|
+ 1.d0*pt2_n_tasks_max & ! i_generator, subset
|
||||||
+ 2.d0*(N_int*2.d0*N_in + N_in) & ! selection buffers
|
+ 1.d0*(N_int*2.d0*ii+ ii) & ! selection buffer
|
||||||
+ 1.d0*(N_int*2.d0*N_in + N_in) & ! sort/merge selection buffers
|
+ 1.d0*(N_int*2.d0*ii+ ii) & ! sort selection buffer
|
||||||
+ 2.0d0*(ii) & ! preinteresting, interesting,
|
+ 2.0d0*(ii) & ! preinteresting, interesting,
|
||||||
! prefullinteresting, fullinteresting
|
! prefullinteresting, fullinteresting
|
||||||
+ 2.0d0*(N_int*2*ii) & ! minilist, fullminilist
|
+ 2.0d0*(N_int*2*ii) & ! minilist, fullminilist
|
||||||
@ -350,7 +350,8 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2, error, varianc
|
|||||||
double precision, allocatable :: nI(:,:), nI_task(:,:), T3(:)
|
double precision, allocatable :: nI(:,:), nI_task(:,:), T3(:)
|
||||||
integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket
|
integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket
|
||||||
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
||||||
integer, external :: zmq_delete_tasks
|
integer, external :: zmq_delete_tasks_async_send
|
||||||
|
integer, external :: zmq_delete_tasks_async_recv
|
||||||
integer, external :: zmq_abort
|
integer, external :: zmq_abort
|
||||||
integer, external :: pt2_find_sample_lr
|
integer, external :: pt2_find_sample_lr
|
||||||
|
|
||||||
@ -364,7 +365,7 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2, error, varianc
|
|||||||
|
|
||||||
integer, allocatable :: f(:)
|
integer, allocatable :: f(:)
|
||||||
logical, allocatable :: d(:)
|
logical, allocatable :: d(:)
|
||||||
logical :: do_exit, stop_now
|
logical :: do_exit, stop_now, sending
|
||||||
logical, external :: qp_stop
|
logical, external :: qp_stop
|
||||||
type(selection_buffer) :: b2
|
type(selection_buffer) :: b2
|
||||||
|
|
||||||
@ -372,6 +373,8 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2, error, varianc
|
|||||||
double precision :: rss
|
double precision :: rss
|
||||||
double precision, external :: memory_of_double, memory_of_int
|
double precision, external :: memory_of_double, memory_of_int
|
||||||
|
|
||||||
|
sending =.False.
|
||||||
|
|
||||||
rss = memory_of_int(pt2_n_tasks_max*2+N_det_generators*2)
|
rss = memory_of_int(pt2_n_tasks_max*2+N_det_generators*2)
|
||||||
rss += memory_of_double(N_states*N_det_generators)*3.d0
|
rss += memory_of_double(N_states*N_det_generators)*3.d0
|
||||||
rss += memory_of_double(N_states*pt2_n_tasks_max)*3.d0
|
rss += memory_of_double(N_states*pt2_n_tasks_max)*3.d0
|
||||||
@ -422,6 +425,7 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2, error, varianc
|
|||||||
stop_now = .false.
|
stop_now = .false.
|
||||||
do while (n <= N_det_generators)
|
do while (n <= N_det_generators)
|
||||||
if(f(pt2_J(n)) == 0) then
|
if(f(pt2_J(n)) == 0) then
|
||||||
|
!print *, 'f(pt2_J(n)) == 0'
|
||||||
d(pt2_J(n)) = .true.
|
d(pt2_J(n)) = .true.
|
||||||
do while(d(U+1))
|
do while(d(U+1))
|
||||||
U += 1
|
U += 1
|
||||||
@ -447,6 +451,7 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2, error, varianc
|
|||||||
! Add Stochastic part
|
! Add Stochastic part
|
||||||
c = pt2_R(n)
|
c = pt2_R(n)
|
||||||
if(c > 0) then
|
if(c > 0) then
|
||||||
|
!print *, 'c>0'
|
||||||
x = 0d0
|
x = 0d0
|
||||||
x2 = 0d0
|
x2 = 0d0
|
||||||
x3 = 0d0
|
x3 = 0d0
|
||||||
@ -500,7 +505,7 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2, error, varianc
|
|||||||
exit
|
exit
|
||||||
else
|
else
|
||||||
call pull_pt2_results(zmq_socket_pull, index, eI_task, vI_task, nI_task, task_id, n_tasks, b2)
|
call pull_pt2_results(zmq_socket_pull, index, eI_task, vI_task, nI_task, task_id, n_tasks, b2)
|
||||||
if (zmq_delete_tasks(zmq_to_qp_run_socket,zmq_socket_pull,task_id,n_tasks,more) == -1) then
|
if (zmq_delete_tasks_async_send(zmq_to_qp_run_socket,task_id,n_tasks,sending) == -1) then
|
||||||
stop 'Unable to delete tasks'
|
stop 'Unable to delete tasks'
|
||||||
endif
|
endif
|
||||||
do i=1,n_tasks
|
do i=1,n_tasks
|
||||||
@ -511,12 +516,19 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2, error, varianc
|
|||||||
end do
|
end do
|
||||||
do i=1, b2%cur
|
do i=1, b2%cur
|
||||||
call add_to_selection_buffer(b, b2%det(1,1,i), b2%val(i))
|
call add_to_selection_buffer(b, b2%det(1,1,i), b2%val(i))
|
||||||
|
! We assume the pulled buffer is sorted
|
||||||
if (b2%val(i) > b%mini) exit
|
if (b2%val(i) > b%mini) exit
|
||||||
end do
|
end do
|
||||||
|
if (zmq_delete_tasks_async_recv(zmq_to_qp_run_socket,more,sending) == -1) then
|
||||||
|
stop 'Unable to delete tasks'
|
||||||
|
endif
|
||||||
end if
|
end if
|
||||||
end do
|
end do
|
||||||
|
!print *, 'deleting b2'
|
||||||
call delete_selection_buffer(b2)
|
call delete_selection_buffer(b2)
|
||||||
|
!print *, 'sorting b'
|
||||||
call sort_selection_buffer(b)
|
call sort_selection_buffer(b)
|
||||||
|
!print *, 'done'
|
||||||
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||||
|
|
||||||
end subroutine
|
end subroutine
|
||||||
|
@ -1,4 +1,3 @@
|
|||||||
|
|
||||||
subroutine run_pt2_slave(thread,iproc,energy)
|
subroutine run_pt2_slave(thread,iproc,energy)
|
||||||
use f77_zmq
|
use f77_zmq
|
||||||
use selection_types
|
use selection_types
|
||||||
@ -18,7 +17,7 @@ subroutine run_pt2_slave(thread,iproc,energy)
|
|||||||
integer(ZMQ_PTR), external :: new_zmq_push_socket
|
integer(ZMQ_PTR), external :: new_zmq_push_socket
|
||||||
integer(ZMQ_PTR) :: zmq_socket_push
|
integer(ZMQ_PTR) :: zmq_socket_push
|
||||||
|
|
||||||
type(selection_buffer) :: b, b2
|
type(selection_buffer) :: b
|
||||||
logical :: done, buffer_ready
|
logical :: done, buffer_ready
|
||||||
|
|
||||||
double precision,allocatable :: pt2(:,:), variance(:,:), norm(:,:)
|
double precision,allocatable :: pt2(:,:), variance(:,:), norm(:,:)
|
||||||
@ -27,6 +26,9 @@ subroutine run_pt2_slave(thread,iproc,energy)
|
|||||||
|
|
||||||
double precision :: rss
|
double precision :: rss
|
||||||
double precision, external :: memory_of_double, memory_of_int
|
double precision, external :: memory_of_double, memory_of_int
|
||||||
|
integer :: bsize ! Size of selection buffers
|
||||||
|
logical :: sending
|
||||||
|
|
||||||
rss = memory_of_int(pt2_n_tasks_max)*67.d0
|
rss = memory_of_int(pt2_n_tasks_max)*67.d0
|
||||||
rss += memory_of_double(pt2_n_tasks_max)*(N_states*3)
|
rss += memory_of_double(pt2_n_tasks_max)*(N_states*3)
|
||||||
call check_mem(rss,irp_here)
|
call check_mem(rss,irp_here)
|
||||||
@ -50,6 +52,7 @@ subroutine run_pt2_slave(thread,iproc,energy)
|
|||||||
buffer_ready = .False.
|
buffer_ready = .False.
|
||||||
n_tasks = 1
|
n_tasks = 1
|
||||||
|
|
||||||
|
sending = .False.
|
||||||
done = .False.
|
done = .False.
|
||||||
n_tasks = 1
|
n_tasks = 1
|
||||||
do while (.not.done)
|
do while (.not.done)
|
||||||
@ -72,8 +75,8 @@ subroutine run_pt2_slave(thread,iproc,energy)
|
|||||||
enddo
|
enddo
|
||||||
if (b%N == 0) then
|
if (b%N == 0) then
|
||||||
! Only first time
|
! Only first time
|
||||||
call create_selection_buffer(N, N*2, b)
|
bsize = min(N, (elec_alpha_num * (mo_num-elec_alpha_num))**2)
|
||||||
call create_selection_buffer(N, N*2, b2)
|
call create_selection_buffer(bsize, bsize*2, b)
|
||||||
buffer_ready = .True.
|
buffer_ready = .True.
|
||||||
else
|
else
|
||||||
ASSERT (N == b%N)
|
ASSERT (N == b%N)
|
||||||
@ -100,14 +103,14 @@ subroutine run_pt2_slave(thread,iproc,energy)
|
|||||||
done = .true.
|
done = .true.
|
||||||
endif
|
endif
|
||||||
call sort_selection_buffer(b)
|
call sort_selection_buffer(b)
|
||||||
call merge_selection_buffers(b,b2)
|
call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending)
|
||||||
call push_pt2_results(zmq_socket_push, i_generator, pt2, variance, norm, b, task_id, n_tasks)
|
call push_pt2_results_async_send(zmq_socket_push, i_generator, pt2, variance, norm, b, task_id, n_tasks,sending)
|
||||||
b%mini = b2%mini
|
|
||||||
b%cur=0
|
b%cur=0
|
||||||
|
|
||||||
! Try to adjust n_tasks around nproc/8 seconds per job
|
! Try to adjust n_tasks around nproc/2 seconds per job
|
||||||
n_tasks = min(2*n_tasks,int( dble(n_tasks * nproc/8) / (time1 - time0 + 1.d0)))
|
n_tasks = min(2*n_tasks,int( dble(n_tasks * nproc/2) / (time1 - time0 + 1.d0)))
|
||||||
end do
|
end do
|
||||||
|
call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending)
|
||||||
|
|
||||||
integer, external :: disconnect_from_taskserver
|
integer, external :: disconnect_from_taskserver
|
||||||
do i=1,300
|
do i=1,300
|
||||||
@ -120,7 +123,6 @@ subroutine run_pt2_slave(thread,iproc,energy)
|
|||||||
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||||
if (buffer_ready) then
|
if (buffer_ready) then
|
||||||
call delete_selection_buffer(b)
|
call delete_selection_buffer(b)
|
||||||
call delete_selection_buffer(b2)
|
|
||||||
endif
|
endif
|
||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
@ -226,6 +228,129 @@ IRP_ENDIF
|
|||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
|
subroutine push_pt2_results_async_send(zmq_socket_push, index, pt2, variance, norm, b, task_id, n_tasks, sending)
|
||||||
|
use f77_zmq
|
||||||
|
use selection_types
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_socket_push
|
||||||
|
double precision, intent(in) :: pt2(N_states,n_tasks)
|
||||||
|
double precision, intent(in) :: variance(N_states,n_tasks)
|
||||||
|
double precision, intent(in) :: norm(N_states,n_tasks)
|
||||||
|
integer, intent(in) :: n_tasks, index(n_tasks), task_id(n_tasks)
|
||||||
|
type(selection_buffer), intent(inout) :: b
|
||||||
|
logical, intent(inout) :: sending
|
||||||
|
integer :: rc
|
||||||
|
|
||||||
|
if (sending) then
|
||||||
|
print *, irp_here, ': sending is true'
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
|
sending = .True.
|
||||||
|
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, n_tasks, 4, ZMQ_SNDMORE)
|
||||||
|
if (rc == -1) then
|
||||||
|
return
|
||||||
|
else if(rc /= 4) then
|
||||||
|
stop 'push'
|
||||||
|
endif
|
||||||
|
|
||||||
|
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, index, 4*n_tasks, ZMQ_SNDMORE)
|
||||||
|
if (rc == -1) then
|
||||||
|
return
|
||||||
|
else if(rc /= 4*n_tasks) then
|
||||||
|
stop 'push'
|
||||||
|
endif
|
||||||
|
|
||||||
|
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, pt2, 8*N_states*n_tasks, ZMQ_SNDMORE)
|
||||||
|
if (rc == -1) then
|
||||||
|
return
|
||||||
|
else if(rc /= 8*N_states*n_tasks) then
|
||||||
|
stop 'push'
|
||||||
|
endif
|
||||||
|
|
||||||
|
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, variance, 8*N_states*n_tasks, ZMQ_SNDMORE)
|
||||||
|
if (rc == -1) then
|
||||||
|
return
|
||||||
|
else if(rc /= 8*N_states*n_tasks) then
|
||||||
|
stop 'push'
|
||||||
|
endif
|
||||||
|
|
||||||
|
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, norm, 8*N_states*n_tasks, ZMQ_SNDMORE)
|
||||||
|
if (rc == -1) then
|
||||||
|
return
|
||||||
|
else if(rc /= 8*N_states*n_tasks) then
|
||||||
|
stop 'push'
|
||||||
|
endif
|
||||||
|
|
||||||
|
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, task_id, n_tasks*4, ZMQ_SNDMORE)
|
||||||
|
if (rc == -1) then
|
||||||
|
return
|
||||||
|
else if(rc /= 4*n_tasks) then
|
||||||
|
stop 'push'
|
||||||
|
endif
|
||||||
|
|
||||||
|
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, b%cur, 4, ZMQ_SNDMORE)
|
||||||
|
if (rc == -1) then
|
||||||
|
return
|
||||||
|
else if(rc /= 4) then
|
||||||
|
stop 'push'
|
||||||
|
endif
|
||||||
|
|
||||||
|
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, b%val, 8*b%cur, ZMQ_SNDMORE)
|
||||||
|
if (rc == -1) then
|
||||||
|
return
|
||||||
|
else if(rc /= 8*b%cur) then
|
||||||
|
stop 'push'
|
||||||
|
endif
|
||||||
|
|
||||||
|
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, b%det, bit_kind*N_int*2*b%cur, 0)
|
||||||
|
if (rc == -1) then
|
||||||
|
return
|
||||||
|
else if(rc /= N_int*2*8*b%cur) then
|
||||||
|
stop 'push'
|
||||||
|
endif
|
||||||
|
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
subroutine push_pt2_results_async_recv(zmq_socket_push,mini,sending)
|
||||||
|
use f77_zmq
|
||||||
|
use selection_types
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_socket_push
|
||||||
|
double precision, intent(out) :: mini
|
||||||
|
logical, intent(inout) :: sending
|
||||||
|
integer :: rc
|
||||||
|
|
||||||
|
if (.not.sending) return
|
||||||
|
|
||||||
|
! Activate is zmq_socket_push is a REQ
|
||||||
|
IRP_IF ZMQ_PUSH
|
||||||
|
IRP_ELSE
|
||||||
|
character*(2) :: ok
|
||||||
|
rc = f77_zmq_recv( zmq_socket_push, ok, 2, 0)
|
||||||
|
if (rc == -1) then
|
||||||
|
return
|
||||||
|
else if ((rc /= 2).and.(ok(1:2) /= 'ok')) then
|
||||||
|
print *, irp_here//': error in receiving ok'
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
|
rc = f77_zmq_recv( zmq_socket_push, mini, 8, 0)
|
||||||
|
IRP_ENDIF
|
||||||
|
sending = .False.
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
subroutine pull_pt2_results(zmq_socket_pull, index, pt2, variance, norm, task_id, n_tasks, b)
|
subroutine pull_pt2_results(zmq_socket_pull, index, pt2, variance, norm, task_id, n_tasks, b)
|
||||||
use f77_zmq
|
use f77_zmq
|
||||||
use selection_types
|
use selection_types
|
||||||
@ -315,7 +440,7 @@ subroutine pull_pt2_results(zmq_socket_pull, index, pt2, variance, norm, task_id
|
|||||||
! Activate is zmq_socket_pull is a REP
|
! Activate is zmq_socket_pull is a REP
|
||||||
IRP_IF ZMQ_PUSH
|
IRP_IF ZMQ_PUSH
|
||||||
IRP_ELSE
|
IRP_ELSE
|
||||||
rc = f77_zmq_send( zmq_socket_pull, 'ok', 2, 0)
|
rc = f77_zmq_send( zmq_socket_pull, 'ok', 2, ZMQ_SNDMORE)
|
||||||
if (rc == -1) then
|
if (rc == -1) then
|
||||||
n_tasks = 1
|
n_tasks = 1
|
||||||
task_id(1) = 0
|
task_id(1) = 0
|
||||||
@ -323,6 +448,7 @@ IRP_ELSE
|
|||||||
print *, irp_here//': error in sending ok'
|
print *, irp_here//': error in sending ok'
|
||||||
stop -1
|
stop -1
|
||||||
endif
|
endif
|
||||||
|
rc = f77_zmq_send( zmq_socket_pull, b%mini, 8, 0)
|
||||||
IRP_ENDIF
|
IRP_ENDIF
|
||||||
|
|
||||||
end subroutine
|
end subroutine
|
||||||
|
@ -55,12 +55,13 @@ subroutine run_selection_slave(thread,iproc,energy)
|
|||||||
if (done) then
|
if (done) then
|
||||||
ctask = ctask - 1
|
ctask = ctask - 1
|
||||||
else
|
else
|
||||||
integer :: i_generator, N, subset
|
integer :: i_generator, N, subset, bsize
|
||||||
read(task,*) subset, i_generator, N
|
read(task,*) subset, i_generator, N
|
||||||
if(buf%N == 0) then
|
if(buf%N == 0) then
|
||||||
! Only first time
|
! Only first time
|
||||||
call create_selection_buffer(N, N*2, buf)
|
bsize = min(N, (elec_alpha_num * (mo_num-elec_alpha_num))**2)
|
||||||
call create_selection_buffer(N, N*2, buf2)
|
call create_selection_buffer(bsize, bsize*2, buf)
|
||||||
|
! call create_selection_buffer(N, N*2, buf2)
|
||||||
buffer_ready = .True.
|
buffer_ready = .True.
|
||||||
else
|
else
|
||||||
ASSERT (N == buf%N)
|
ASSERT (N == buf%N)
|
||||||
@ -83,9 +84,9 @@ subroutine run_selection_slave(thread,iproc,energy)
|
|||||||
end do
|
end do
|
||||||
if(ctask > 0) then
|
if(ctask > 0) then
|
||||||
call sort_selection_buffer(buf)
|
call sort_selection_buffer(buf)
|
||||||
call merge_selection_buffers(buf,buf2)
|
! call merge_selection_buffers(buf,buf2)
|
||||||
call push_selection_results(zmq_socket_push, pt2, variance, norm, buf, task_id(1), ctask)
|
call push_selection_results(zmq_socket_push, pt2, variance, norm, buf, task_id(1), ctask)
|
||||||
buf%mini = buf2%mini
|
! buf%mini = buf2%mini
|
||||||
pt2(:) = 0d0
|
pt2(:) = 0d0
|
||||||
variance(:) = 0d0
|
variance(:) = 0d0
|
||||||
norm(:) = 0d0
|
norm(:) = 0d0
|
||||||
@ -108,7 +109,7 @@ subroutine run_selection_slave(thread,iproc,energy)
|
|||||||
call end_zmq_push_socket(zmq_socket_push,thread)
|
call end_zmq_push_socket(zmq_socket_push,thread)
|
||||||
if (buffer_ready) then
|
if (buffer_ready) then
|
||||||
call delete_selection_buffer(buf)
|
call delete_selection_buffer(buf)
|
||||||
call delete_selection_buffer(buf2)
|
! call delete_selection_buffer(buf2)
|
||||||
endif
|
endif
|
||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
|
@ -153,9 +153,6 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
|
|||||||
logical :: monoAdo, monoBdo
|
logical :: monoAdo, monoBdo
|
||||||
integer :: maskInd
|
integer :: maskInd
|
||||||
|
|
||||||
double precision :: rss
|
|
||||||
double precision, external :: memory_of_double, memory_of_int
|
|
||||||
|
|
||||||
PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique
|
PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique
|
||||||
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order
|
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order
|
||||||
PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
|
PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
|
||||||
@ -241,8 +238,8 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
|
|||||||
|
|
||||||
allocate(preinteresting(0:32), prefullinteresting(0:32), &
|
allocate(preinteresting(0:32), prefullinteresting(0:32), &
|
||||||
interesting(0:32), fullinteresting(0:32))
|
interesting(0:32), fullinteresting(0:32))
|
||||||
preinteresting(0) = 0
|
preinteresting(:) = 0
|
||||||
prefullinteresting(0) = 0
|
prefullinteresting(:) = 0
|
||||||
|
|
||||||
do i=1,N_int
|
do i=1,N_int
|
||||||
negMask(i,1) = not(psi_det_generators(i,1,i_generator))
|
negMask(i,1) = not(psi_det_generators(i,1,i_generator))
|
||||||
@ -645,13 +642,11 @@ subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, intere
|
|||||||
negMask(i,2) = not(mask(i,2))
|
negMask(i,2) = not(mask(i,2))
|
||||||
end do
|
end do
|
||||||
|
|
||||||
do i=1, N_sel ! interesting(0)
|
do i=1, N_sel
|
||||||
!i = interesting(ii)
|
|
||||||
if (interesting(i) < 0) then
|
if (interesting(i) < 0) then
|
||||||
stop 'prefetch interesting(i) and det(i)'
|
stop 'prefetch interesting(i) and det(i)'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
|
|
||||||
mobMask(1,1) = iand(negMask(1,1), det(1,1,i))
|
mobMask(1,1) = iand(negMask(1,1), det(1,1,i))
|
||||||
mobMask(1,2) = iand(negMask(1,2), det(1,2,i))
|
mobMask(1,2) = iand(negMask(1,2), det(1,2,i))
|
||||||
nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2))
|
nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2))
|
||||||
@ -682,10 +677,10 @@ subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, intere
|
|||||||
end if
|
end if
|
||||||
end if
|
end if
|
||||||
|
|
||||||
call bitstring_to_list_in_selection(mobMask(1,1), p(1,1), p(0,1), N_int)
|
|
||||||
call bitstring_to_list_in_selection(mobMask(1,2), p(1,2), p(0,2), N_int)
|
|
||||||
|
|
||||||
if (interesting(i) >= i_gen) then
|
if (interesting(i) >= i_gen) then
|
||||||
|
call bitstring_to_list_in_selection(mobMask(1,1), p(1,1), p(0,1), N_int)
|
||||||
|
call bitstring_to_list_in_selection(mobMask(1,2), p(1,2), p(0,2), N_int)
|
||||||
|
|
||||||
perMask(1,1) = iand(mask(1,1), not(det(1,1,i)))
|
perMask(1,1) = iand(mask(1,1), not(det(1,1,i)))
|
||||||
perMask(1,2) = iand(mask(1,2), not(det(1,2,i)))
|
perMask(1,2) = iand(mask(1,2), not(det(1,2,i)))
|
||||||
do j=2,N_int
|
do j=2,N_int
|
||||||
@ -704,9 +699,14 @@ subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, intere
|
|||||||
else
|
else
|
||||||
call get_d0(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i)))
|
call get_d0(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i)))
|
||||||
end if
|
end if
|
||||||
else
|
else if(nt == 4) then
|
||||||
if(nt == 4) call past_d2(banned, p, sp)
|
call bitstring_to_list_in_selection(mobMask(1,1), p(1,1), p(0,1), N_int)
|
||||||
if(nt == 3) call past_d1(bannedOrb, p)
|
call bitstring_to_list_in_selection(mobMask(1,2), p(1,2), p(0,2), N_int)
|
||||||
|
call past_d2(banned, p, sp)
|
||||||
|
else if(nt == 3) then
|
||||||
|
call bitstring_to_list_in_selection(mobMask(1,1), p(1,1), p(0,1), N_int)
|
||||||
|
call bitstring_to_list_in_selection(mobMask(1,2), p(1,2), p(0,2), N_int)
|
||||||
|
call past_d1(bannedOrb, p)
|
||||||
end if
|
end if
|
||||||
end do
|
end do
|
||||||
|
|
||||||
|
@ -2,6 +2,10 @@
|
|||||||
subroutine create_selection_buffer(N, siz_, res)
|
subroutine create_selection_buffer(N, siz_, res)
|
||||||
use selection_types
|
use selection_types
|
||||||
implicit none
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Allocates the memory for a selection buffer.
|
||||||
|
! The arrays have dimension siz_ and the maximum number of elements is N
|
||||||
|
END_DOC
|
||||||
|
|
||||||
integer, intent(in) :: N, siz_
|
integer, intent(in) :: N, siz_
|
||||||
type(selection_buffer), intent(out) :: res
|
type(selection_buffer), intent(out) :: res
|
||||||
|
@ -251,8 +251,8 @@ subroutine run_slave_main
|
|||||||
+ 64.d0*pt2_n_tasks_max & ! task
|
+ 64.d0*pt2_n_tasks_max & ! task
|
||||||
+ 3.d0*pt2_n_tasks_max*N_states & ! pt2, variance, norm
|
+ 3.d0*pt2_n_tasks_max*N_states & ! pt2, variance, norm
|
||||||
+ 1.d0*pt2_n_tasks_max & ! i_generator, subset
|
+ 1.d0*pt2_n_tasks_max & ! i_generator, subset
|
||||||
+ 2.d0*(N_int*2.d0*N_det+ N_det) & ! selection buffers
|
+ 2.d0*(N_int*2.d0*ii+ ii) & ! selection buffer
|
||||||
+ 1.d0*(N_int*2.d0*N_det+ N_det) & ! sort/merge selection buffers
|
+ 1.d0*(N_int*2.d0*ii+ ii) & ! sort selection buffer
|
||||||
+ 2.0d0*(ii) & ! preinteresting, interesting,
|
+ 2.0d0*(ii) & ! preinteresting, interesting,
|
||||||
! prefullinteresting, fullinteresting
|
! prefullinteresting, fullinteresting
|
||||||
+ 2.0d0*(N_int*2*ii) & ! minilist, fullminilist
|
+ 2.0d0*(N_int*2*ii) & ! minilist, fullminilist
|
||||||
|
@ -10,7 +10,7 @@ subroutine run_stochastic_cipsi
|
|||||||
|
|
||||||
double precision :: rss
|
double precision :: rss
|
||||||
double precision, external :: memory_of_double
|
double precision, external :: memory_of_double
|
||||||
PROVIDE H_apply_buffer_allocated
|
PROVIDE H_apply_buffer_allocated N_generators_bitmask
|
||||||
|
|
||||||
threshold_generators = 1.d0
|
threshold_generators = 1.d0
|
||||||
SOFT_TOUCH threshold_generators
|
SOFT_TOUCH threshold_generators
|
||||||
|
@ -139,6 +139,8 @@ subroutine davidson_slave_work(zmq_to_qp_run_socket, zmq_socket_push, N_st, sze,
|
|||||||
! Run tasks
|
! Run tasks
|
||||||
! ---------
|
! ---------
|
||||||
|
|
||||||
|
logical :: sending
|
||||||
|
sending=.False.
|
||||||
|
|
||||||
allocate(v_t(N_st,N_det), s_t(N_st,N_det))
|
allocate(v_t(N_st,N_det), s_t(N_st,N_det))
|
||||||
do
|
do
|
||||||
@ -158,9 +160,11 @@ subroutine davidson_slave_work(zmq_to_qp_run_socket, zmq_socket_push, N_st, sze,
|
|||||||
if (task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id) == -1) then
|
if (task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id) == -1) then
|
||||||
print *, irp_here, 'Unable to send task_done'
|
print *, irp_here, 'Unable to send task_done'
|
||||||
endif
|
endif
|
||||||
call davidson_push_results(zmq_socket_push, v_t, s_t, imin, imax, task_id)
|
call davidson_push_results_async_recv(zmq_socket_push, sending)
|
||||||
|
call davidson_push_results_async_send(zmq_socket_push, v_t, s_t, imin, imax, task_id, sending)
|
||||||
end do
|
end do
|
||||||
deallocate(u_t,v_t, s_t)
|
deallocate(u_t,v_t, s_t)
|
||||||
|
call davidson_push_results_async_recv(zmq_socket_push, sending)
|
||||||
|
|
||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
@ -210,6 +214,73 @@ IRP_ENDIF
|
|||||||
|
|
||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
|
subroutine davidson_push_results_async_send(zmq_socket_push, v_t, s_t, imin, imax, task_id,sending)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Push the results of $H | U \rangle$ from a worker to the master.
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer(ZMQ_PTR) ,intent(in) :: zmq_socket_push
|
||||||
|
integer ,intent(in) :: task_id, imin, imax
|
||||||
|
double precision ,intent(in) :: v_t(N_states_diag,N_det)
|
||||||
|
double precision ,intent(in) :: s_t(N_states_diag,N_det)
|
||||||
|
logical ,intent(inout) :: sending
|
||||||
|
integer :: rc, sz
|
||||||
|
integer*8 :: rc8
|
||||||
|
|
||||||
|
if (sending) then
|
||||||
|
print *, irp_here, ': sending=true'
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
|
sending = .True.
|
||||||
|
|
||||||
|
sz = (imax-imin+1)*N_states_diag
|
||||||
|
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, task_id, 4, ZMQ_SNDMORE)
|
||||||
|
if(rc /= 4) stop 'davidson_push_results failed to push task_id'
|
||||||
|
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, imin, 4, ZMQ_SNDMORE)
|
||||||
|
if(rc /= 4) stop 'davidson_push_results failed to push imin'
|
||||||
|
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, imax, 4, ZMQ_SNDMORE)
|
||||||
|
if(rc /= 4) stop 'davidson_push_results failed to push imax'
|
||||||
|
|
||||||
|
rc8 = f77_zmq_send8( zmq_socket_push, v_t(1,imin), 8_8*sz, ZMQ_SNDMORE)
|
||||||
|
if(rc8 /= 8_8*sz) stop 'davidson_push_results failed to push vt'
|
||||||
|
|
||||||
|
rc8 = f77_zmq_send8( zmq_socket_push, s_t(1,imin), 8_8*sz, 0)
|
||||||
|
if(rc8 /= 8_8*sz) stop 'davidson_push_results failed to push st'
|
||||||
|
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
subroutine davidson_push_results_async_recv(zmq_socket_push,sending)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Push the results of $H | U \rangle$ from a worker to the master.
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer(ZMQ_PTR) ,intent(in) :: zmq_socket_push
|
||||||
|
logical ,intent(inout) :: sending
|
||||||
|
|
||||||
|
integer :: rc
|
||||||
|
|
||||||
|
if (.not.sending) return
|
||||||
|
! Activate is zmq_socket_push is a REQ
|
||||||
|
IRP_IF ZMQ_PUSH
|
||||||
|
IRP_ELSE
|
||||||
|
character*(2) :: ok
|
||||||
|
rc = f77_zmq_recv( zmq_socket_push, ok, 2, 0)
|
||||||
|
if ((rc /= 2).and.(ok(1:2)/='ok')) then
|
||||||
|
print *, irp_here, ': f77_zmq_recv( zmq_socket_push, ok, 2, 0)'
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
|
IRP_ENDIF
|
||||||
|
sending = .False.
|
||||||
|
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
subroutine davidson_pull_results(zmq_socket_pull, v_t, s_t, imin, imax, task_id)
|
subroutine davidson_pull_results(zmq_socket_pull, v_t, s_t, imin, imax, task_id)
|
||||||
@ -275,22 +346,28 @@ subroutine davidson_collector(zmq_to_qp_run_socket, zmq_socket_pull, v0, s0, sze
|
|||||||
integer :: more, task_id, imin, imax
|
integer :: more, task_id, imin, imax
|
||||||
|
|
||||||
double precision, allocatable :: v_t(:,:), s_t(:,:)
|
double precision, allocatable :: v_t(:,:), s_t(:,:)
|
||||||
|
logical :: sending
|
||||||
integer :: i,j
|
integer :: i,j
|
||||||
|
integer, external :: zmq_delete_task_async_send
|
||||||
|
integer, external :: zmq_delete_task_async_recv
|
||||||
|
|
||||||
allocate(v_t(N_st,N_det), s_t(N_st,N_det))
|
allocate(v_t(N_st,N_det), s_t(N_st,N_det))
|
||||||
v0 = 0.d0
|
v0 = 0.d0
|
||||||
s0 = 0.d0
|
s0 = 0.d0
|
||||||
more = 1
|
more = 1
|
||||||
|
sending = .False.
|
||||||
do while (more == 1)
|
do while (more == 1)
|
||||||
call davidson_pull_results(zmq_socket_pull, v_t, s_t, imin, imax, task_id)
|
call davidson_pull_results(zmq_socket_pull, v_t, s_t, imin, imax, task_id)
|
||||||
|
if (zmq_delete_task_async_send(zmq_to_qp_run_socket,task_id,sending) == -1) then
|
||||||
|
stop 'Unable to delete task'
|
||||||
|
endif
|
||||||
do j=1,N_st
|
do j=1,N_st
|
||||||
do i=imin,imax
|
do i=imin,imax
|
||||||
v0(i,j) = v0(i,j) + v_t(j,i)
|
v0(i,j) = v0(i,j) + v_t(j,i)
|
||||||
s0(i,j) = s0(i,j) + s_t(j,i)
|
s0(i,j) = s0(i,j) + s_t(j,i)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
integer, external :: zmq_delete_task
|
if (zmq_delete_task_async_recv(zmq_to_qp_run_socket,more,sending) == -1) then
|
||||||
if (zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id,more) == -1) then
|
|
||||||
stop 'Unable to delete task'
|
stop 'Unable to delete task'
|
||||||
endif
|
endif
|
||||||
end do
|
end do
|
||||||
|
@ -8,5 +8,6 @@ BEGIN_PROVIDER [ character*32,h0_type ]
|
|||||||
else
|
else
|
||||||
h0_type = 'EN'
|
h0_type = 'EN'
|
||||||
endif
|
endif
|
||||||
|
! h0_type = 'HF'
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
@ -246,7 +246,7 @@ IRP_ENDIF
|
|||||||
! stop 'Unable to set ZMQ_RCVBUF on pull socket'
|
! stop 'Unable to set ZMQ_RCVBUF on pull socket'
|
||||||
! endif
|
! endif
|
||||||
|
|
||||||
rc = f77_zmq_setsockopt(new_zmq_pull_socket,ZMQ_RCVHWM,8,4)
|
rc = f77_zmq_setsockopt(new_zmq_pull_socket,ZMQ_RCVHWM,50,4)
|
||||||
if (rc /= 0) then
|
if (rc /= 0) then
|
||||||
stop 'Unable to set ZMQ_RCVHWM on pull socket'
|
stop 'Unable to set ZMQ_RCVHWM on pull socket'
|
||||||
endif
|
endif
|
||||||
@ -1085,6 +1085,62 @@ integer function zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id,mo
|
|||||||
endif
|
endif
|
||||||
end
|
end
|
||||||
|
|
||||||
|
integer function zmq_delete_task_async_send(zmq_to_qp_run_socket,task_id,sending)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! When a task is done, it has to be removed from the list of tasks on the qp_run
|
||||||
|
! queue. This guarantees that the results have been received in the pull.
|
||||||
|
END_DOC
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
||||||
|
integer, intent(in) :: task_id
|
||||||
|
logical, intent(inout) :: sending
|
||||||
|
integer :: rc
|
||||||
|
character*(512) :: message
|
||||||
|
|
||||||
|
if (sending) then
|
||||||
|
print *, irp_here, ': sending=true'
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
|
zmq_delete_task_async_send = 0
|
||||||
|
|
||||||
|
write(message,*) 'del_task ', zmq_state, task_id
|
||||||
|
rc = f77_zmq_send(zmq_to_qp_run_socket,trim(message),len(trim(message)),0)
|
||||||
|
if (rc /= len(trim(message))) then
|
||||||
|
zmq_delete_task_async_send = -1
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
sending = .True.
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
integer function zmq_delete_task_async_recv(zmq_to_qp_run_socket,more,sending)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! When a task is done, it has to be removed from the list of tasks on the qp_run
|
||||||
|
! queue. This guarantees that the results have been received in the pull.
|
||||||
|
END_DOC
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
||||||
|
integer, intent(out) :: more
|
||||||
|
logical, intent(inout) :: sending
|
||||||
|
integer :: rc
|
||||||
|
character*(512) :: message
|
||||||
|
character*(64) :: reply
|
||||||
|
if (.not.sending) return
|
||||||
|
sending = .False.
|
||||||
|
reply = ''
|
||||||
|
rc = f77_zmq_recv(zmq_to_qp_run_socket,reply,64,0)
|
||||||
|
if (reply(16:19) == 'more') then
|
||||||
|
more = 1
|
||||||
|
else if (reply(16:19) == 'done') then
|
||||||
|
more = 0
|
||||||
|
else
|
||||||
|
zmq_delete_task_async_recv = -1
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
end
|
||||||
|
|
||||||
integer function zmq_delete_tasks(zmq_to_qp_run_socket,zmq_socket_pull,task_id,n_tasks,more)
|
integer function zmq_delete_tasks(zmq_to_qp_run_socket,zmq_socket_pull,task_id,n_tasks,more)
|
||||||
use f77_zmq
|
use f77_zmq
|
||||||
implicit none
|
implicit none
|
||||||
@ -1128,7 +1184,7 @@ integer function zmq_delete_tasks(zmq_to_qp_run_socket,zmq_socket_pull,task_id,n
|
|||||||
endif
|
endif
|
||||||
end
|
end
|
||||||
|
|
||||||
integer function zmq_delete_tasks_async_send(zmq_to_qp_run_socket,zmq_socket_pull,task_id,n_tasks,more)
|
integer function zmq_delete_tasks_async_send(zmq_to_qp_run_socket,task_id,n_tasks,sending)
|
||||||
use f77_zmq
|
use f77_zmq
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -1136,13 +1192,17 @@ integer function zmq_delete_tasks_async_send(zmq_to_qp_run_socket,zmq_socket_pul
|
|||||||
! queue. This guarantees that the results have been received in the pull.
|
! queue. This guarantees that the results have been received in the pull.
|
||||||
END_DOC
|
END_DOC
|
||||||
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
||||||
integer(ZMQ_PTR) :: zmq_socket_pull
|
|
||||||
integer, intent(in) :: n_tasks, task_id(n_tasks)
|
integer, intent(in) :: n_tasks, task_id(n_tasks)
|
||||||
integer, intent(in) :: more
|
logical, intent(inout) :: sending
|
||||||
integer :: rc, k
|
integer :: rc, k
|
||||||
character*(64) :: fmt, reply
|
character*(64) :: fmt, reply
|
||||||
character(LEN=:), allocatable :: message
|
character(LEN=:), allocatable :: message
|
||||||
|
|
||||||
|
if (sending) then
|
||||||
|
print *, irp_here, ': sending is true'
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
|
sending = .True.
|
||||||
zmq_delete_tasks_async_send = 0
|
zmq_delete_tasks_async_send = 0
|
||||||
|
|
||||||
allocate(character(LEN=64+n_tasks*12) :: message)
|
allocate(character(LEN=64+n_tasks*12) :: message)
|
||||||
@ -1162,7 +1222,7 @@ integer function zmq_delete_tasks_async_send(zmq_to_qp_run_socket,zmq_socket_pul
|
|||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
integer function zmq_delete_tasks_async_recv(zmq_to_qp_run_socket,zmq_socket_pull,task_id,n_tasks,more)
|
integer function zmq_delete_tasks_async_recv(zmq_to_qp_run_socket,more,sending)
|
||||||
use f77_zmq
|
use f77_zmq
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -1170,12 +1230,12 @@ integer function zmq_delete_tasks_async_recv(zmq_to_qp_run_socket,zmq_socket_pul
|
|||||||
! queue. This guarantees that the results have been received in the pull.
|
! queue. This guarantees that the results have been received in the pull.
|
||||||
END_DOC
|
END_DOC
|
||||||
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
||||||
integer(ZMQ_PTR) :: zmq_socket_pull
|
|
||||||
integer, intent(in) :: n_tasks, task_id(n_tasks)
|
|
||||||
integer, intent(out) :: more
|
integer, intent(out) :: more
|
||||||
|
logical, intent(inout) :: sending
|
||||||
integer :: rc
|
integer :: rc
|
||||||
character*(64) :: reply
|
character*(64) :: reply
|
||||||
|
|
||||||
|
if (.not.sending) return
|
||||||
zmq_delete_tasks_async_recv = 0
|
zmq_delete_tasks_async_recv = 0
|
||||||
|
|
||||||
reply = ''
|
reply = ''
|
||||||
@ -1188,6 +1248,7 @@ integer function zmq_delete_tasks_async_recv(zmq_to_qp_run_socket,zmq_socket_pul
|
|||||||
else
|
else
|
||||||
zmq_delete_tasks_async_recv = -1
|
zmq_delete_tasks_async_recv = -1
|
||||||
endif
|
endif
|
||||||
|
sending = .False.
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user