LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2025-01-10 21:18:29 +01:00
Code Issues Releases Wiki Activity

Fetch i_generator from ZMQ

Browse Source
This commit is contained in:
Anthony Scemama 2016-05-29 22:38:06 +02:00
parent 3f2f870281
commit e2f4857b83
2 changed files with 22 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
src/Determinants/H_apply.irp.f
View File

@ -307,14 +307,14 @@ subroutine fill_H_apply_buffer_no_selection(n_selected,det_buffer,Nint,iproc)
end end
subroutine push_pt2(zmq_socket_push,pt2,norm_pert,H_pert_diag,N_st,task_id) subroutine push_pt2(zmq_socket_push,pt2,norm_pert,H_pert_diag,i_generator,N_st,task_id)
use f77_zmq use f77_zmq
implicit none implicit none
BEGIN_DOC BEGIN_DOC
! Push PT2 calculation to the collector ! Push PT2 calculation to the collector
END_DOC END_DOC
integer(ZMQ_PTR), intent(in) :: zmq_socket_push integer(ZMQ_PTR), intent(in) :: zmq_socket_push
integer, intent(in) :: N_st integer, intent(in) :: N_st, i_generator
double precision, intent(in) :: pt2(N_st), norm_pert(N_st), H_pert_diag(N_st) double precision, intent(in) :: pt2(N_st), norm_pert(N_st), H_pert_diag(N_st)
integer, intent(in) :: task_id integer, intent(in) :: task_id
integer :: rc integer :: rc
@ -343,6 +343,12 @@ subroutine push_pt2(zmq_socket_push,pt2,norm_pert,H_pert_diag,N_st,task_id)
stop 'error' stop 'error'
endif endif
rc = f77_zmq_send( zmq_socket_push, i_generator, 4, ZMQ_SNDMORE)
if (rc /= 4) then
print *, irp_here, 'f77_zmq_send( zmq_socket_push, i_generator, 4, 0)'
stop 'error'
endif
rc = f77_zmq_send( zmq_socket_push, task_id, 4, 0) rc = f77_zmq_send( zmq_socket_push, task_id, 4, 0)
if (rc /= 4) then if (rc /= 4) then
print *, irp_here, 'f77_zmq_send( zmq_socket_push, task_id, 4, 0)' print *, irp_here, 'f77_zmq_send( zmq_socket_push, task_id, 4, 0)'
@ -358,7 +364,7 @@ subroutine push_pt2(zmq_socket_push,pt2,norm_pert,H_pert_diag,N_st,task_id)
! endif ! endif
end end
subroutine pull_pt2(zmq_socket_pull,pt2,norm_pert,H_pert_diag,N_st,n,task_id) subroutine pull_pt2(zmq_socket_pull,pt2,norm_pert,H_pert_diag,i_generator,N_st,n,task_id)
use f77_zmq use f77_zmq
implicit none implicit none
BEGIN_DOC BEGIN_DOC
@ -368,7 +374,7 @@ subroutine pull_pt2(zmq_socket_pull,pt2,norm_pert,H_pert_diag,N_st,n,task_id)
integer, intent(in) :: N_st integer, intent(in) :: N_st
double precision, intent(out) :: pt2(N_st), norm_pert(N_st), H_pert_diag(N_st) double precision, intent(out) :: pt2(N_st), norm_pert(N_st), H_pert_diag(N_st)
integer, intent(out) :: task_id integer, intent(out) :: task_id
integer, intent(out) :: n integer, intent(out) :: n, i_generator
integer :: rc integer :: rc
n=0 n=0
@ -406,6 +412,12 @@ subroutine pull_pt2(zmq_socket_pull,pt2,norm_pert,H_pert_diag,N_st,n,task_id)
stop 'error' stop 'error'
endif endif
rc = f77_zmq_recv( zmq_socket_pull, i_generator, 4, 0)
if (rc /= 4) then
print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, i_generator, 4, 0)'
stop 'error'
endif
rc = f77_zmq_recv( zmq_socket_pull, task_id, 4, 0) rc = f77_zmq_recv( zmq_socket_pull, task_id, 4, 0)
if (rc /= 4) then if (rc /= 4) then
print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, task_id, 4, 0)' print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, task_id, 4, 0)'

12
src/Determinants/H_apply_zmq.template.f
View File

@ -41,13 +41,13 @@ subroutine $subroutine($params_main)
PROVIDE nproc N_states PROVIDE nproc N_states
!$OMP PARALLEL DEFAULT(NONE) & !$OMP PARALLEL DEFAULT(NONE) &
!$OMP PRIVATE(i) & !$OMP PRIVATE(i) &
!$OMP SHARED(zmq_socket_pair,N_states, pt2, norm_pert, H_pert_diag, n, task_id) & !$OMP SHARED(zmq_socket_pair,N_states, pt2, norm_pert, H_pert_diag, n, task_id, i_generator) &
!$OMP num_threads(nproc+1) !$OMP num_threads(nproc+1)
i = omp_get_thread_num() i = omp_get_thread_num()
if (i == 0) then if (i == 0) then
call $subroutine_collector() call $subroutine_collector()
integer :: n, task_id integer :: n, task_id
call pull_pt2(zmq_socket_pair, pt2, norm_pert, H_pert_diag, N_states, n, task_id) call pull_pt2(zmq_socket_pair, pt2, norm_pert, H_pert_diag, i_generator, N_states, n, task_id)
else else
call $subroutine_slave_inproc(i) call $subroutine_slave_inproc(i)
endif endif
@ -168,7 +168,7 @@ subroutine $subroutine_slave(thread, iproc)
endif endif
call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id,1) call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id,1)
call push_pt2(zmq_socket_push,pt2,norm_pert,H_pert_diag,N_st,task_id) call push_pt2(zmq_socket_push,pt2,norm_pert,H_pert_diag,i_generator,N_st,task_id)
enddo enddo
@ -193,7 +193,7 @@ subroutine $subroutine_collector
integer(ZMQ_PTR), external :: new_zmq_pull_socket integer(ZMQ_PTR), external :: new_zmq_pull_socket
integer(ZMQ_PTR) :: zmq_socket_pull integer(ZMQ_PTR) :: zmq_socket_pull
integer*8 :: control, accu integer*8 :: control, accu
integer :: n, more, task_id integer :: n, more, task_id, i_generator
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
@ -211,7 +211,7 @@ subroutine $subroutine_collector
more = 1 more = 1
do while (more == 1) do while (more == 1)
call pull_pt2(zmq_socket_pull, pt2, norm_pert, H_pert_diag, N_states, n, task_id) call pull_pt2(zmq_socket_pull, pt2, norm_pert, H_pert_diag, i_generator, N_states, n, task_id)
if (n > 0) then if (n > 0) then
do k=1,N_states do k=1,N_states
pt2(k,2) = pt2(k,1) + pt2(k,2) pt2(k,2) = pt2(k,1) + pt2(k,2)
@ -233,7 +233,7 @@ subroutine $subroutine_collector
socket_result = new_zmq_pair_socket(.False.) socket_result = new_zmq_pair_socket(.False.)
call push_pt2(socket_result, pt2(1,2), norm_pert(1,2), H_pert_diag(1,2), N_states,0) call push_pt2(socket_result, pt2(1,2), norm_pert(1,2), H_pert_diag(1,2), i_generator, N_states,0)
deallocate ( pt2, norm_pert, H_pert_diag) deallocate ( pt2, norm_pert, H_pert_diag)