10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-23 12:56:14 +01:00
quantum_package/plugins/Selectors_Utils/zmq.irp.f

100 lines
2.2 KiB
Fortran
Raw Normal View History

2017-11-27 13:17:02 +01:00
BEGIN_TEMPLATE
2017-11-29 15:15:10 +01:00
integer function zmq_put_$X(zmq_to_qp_run_socket,worker_id)
2017-11-27 13:17:02 +01:00
use f77_zmq
implicit none
BEGIN_DOC
! Put $X on the qp_run scheduler
END_DOC
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
integer, intent(in) :: worker_id
integer :: rc
character*(256) :: msg
2017-11-29 15:15:10 +01:00
zmq_put_$X = 0
2017-11-29 13:52:52 +01:00
write(msg,'(A,1X,I8,1X,A200)') 'put_data '//trim(zmq_state), worker_id, '$X'
2017-11-27 13:17:02 +01:00
rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),ZMQ_SNDMORE)
if (rc /= len(trim(msg))) then
2017-11-29 15:15:10 +01:00
zmq_put_$X = -1
return
2017-11-27 13:17:02 +01:00
endif
rc = f77_zmq_send(zmq_to_qp_run_socket,$X,4,0)
if (rc /= 4) then
2017-11-29 15:15:10 +01:00
zmq_put_$X = -1
return
2017-11-27 13:17:02 +01:00
endif
rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0)
if (msg(1:rc) /= 'put_data_reply ok') then
2017-11-29 15:15:10 +01:00
zmq_put_$X = -1
return
2017-11-27 13:17:02 +01:00
endif
end
2017-11-29 15:15:10 +01:00
integer function zmq_get_$X(zmq_to_qp_run_socket, worker_id)
2017-11-27 13:17:02 +01:00
use f77_zmq
implicit none
BEGIN_DOC
! Get $X from the qp_run scheduler
END_DOC
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
integer, intent(in) :: worker_id
integer :: rc
2017-11-28 00:54:22 +01:00
character*(256) :: msg
2017-11-27 13:17:02 +01:00
2018-01-05 15:12:27 +01:00
PROVIDE zmq_state
2017-11-29 15:15:10 +01:00
zmq_get_$X = 0
if (mpi_master) then
2017-11-27 13:17:02 +01:00
2017-11-29 15:15:10 +01:00
write(msg,'(A,1X,I8,1X,A200)') 'get_data '//trim(zmq_state), worker_id, '$X'
rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),0)
2017-11-29 19:10:27 +01:00
if (rc /= len(trim(msg))) then
zmq_get_$X = -1
go to 10
endif
2017-11-29 15:15:10 +01:00
rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0)
2017-11-29 19:10:27 +01:00
if (msg(1:14) /= 'get_data_reply') then
zmq_get_$X = -1
go to 10
endif
2017-11-29 15:15:10 +01:00
rc = f77_zmq_recv(zmq_to_qp_run_socket,$X,4,0)
2017-11-29 19:10:27 +01:00
if (rc /= 4) then
zmq_get_$X = -1
go to 10
endif
2017-11-27 13:17:02 +01:00
endif
2017-11-28 14:20:17 +01:00
2017-11-29 19:10:27 +01:00
10 continue
2017-11-29 15:15:10 +01:00
2017-11-28 14:20:17 +01:00
IRP_IF MPI
include 'mpif.h'
integer :: ierr
2017-11-29 15:15:10 +01:00
call MPI_BCAST (zmq_get_$X, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
2017-11-28 14:20:17 +01:00
if (ierr /= MPI_SUCCESS) then
print *, irp_here//': Unable to broadcast N_det_generators'
stop -1
endif
2017-11-29 19:10:27 +01:00
call MPI_BCAST ($X, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
2017-11-29 15:15:10 +01:00
if (ierr /= MPI_SUCCESS) then
print *, irp_here//': Unable to broadcast N_det_generators'
stop -1
endif
IRP_ENDIF
2017-11-29 19:10:27 +01:00
2017-11-27 13:17:02 +01:00
end
SUBST [ X ]
N_det_generators ;;
N_det_selectors ;;
END_TEMPLATE