103 lines
2.8 KiB
Fortran
103 lines
2.8 KiB
Fortran
integer function zmq_put_dvector(zmq_to_qp_run_socket, worker_id, name, x, size_x)
|
|
use f77_zmq
|
|
implicit none
|
|
BEGIN_DOC
|
|
! Put the X vector on the qp_run scheduler
|
|
END_DOC
|
|
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
|
integer, intent(in) :: worker_id
|
|
character*(*) :: name
|
|
integer, intent(in) :: size_x
|
|
double precision, intent(out) :: x(size_x)
|
|
integer :: rc
|
|
character*(256) :: msg
|
|
|
|
! Failure
|
|
zmq_put_dvector = -1
|
|
|
|
write(msg,'(A,1X,I8,1X,A200)') 'put_data '//trim(zmq_state), worker_id, name
|
|
rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),ZMQ_SNDMORE)
|
|
if (rc /= len(trim(msg))) then
|
|
print *, irp_here, ': Error sending '//name
|
|
return
|
|
endif
|
|
|
|
rc = f77_zmq_send(zmq_to_qp_run_socket,x,size_x*8,0)
|
|
if (rc /= size_x*8) then
|
|
print *, irp_here, ': Error sending '//name
|
|
return
|
|
endif
|
|
|
|
rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0)
|
|
if (msg(1:rc) /= 'put_data_reply ok') then
|
|
print *, rc, trim(msg)
|
|
print *, irp_here, ': Error in put_data_reply'
|
|
return
|
|
endif
|
|
|
|
! Success
|
|
zmq_put_dvector = 0
|
|
|
|
end
|
|
|
|
|
|
integer function zmq_get_dvector(zmq_to_qp_run_socket, worker_id, name, x, size_x)
|
|
use f77_zmq
|
|
implicit none
|
|
BEGIN_DOC
|
|
! Get psi_coef from the qp_run scheduler
|
|
END_DOC
|
|
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
|
integer, intent(in) :: worker_id
|
|
integer, intent(in) :: size_x
|
|
character*(*), intent(in) :: name
|
|
double precision, intent(out) :: x(size_x)
|
|
integer :: rc
|
|
integer*8 :: rc8
|
|
character*(256) :: msg
|
|
|
|
! Success
|
|
zmq_get_dvector = 0
|
|
|
|
write(msg,'(A,1X,I8,1X,A200)') 'get_data '//trim(zmq_state), worker_id, name
|
|
rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),0)
|
|
if (rc /= len(trim(msg))) then
|
|
print *, irp_here, ': Error getting '//name
|
|
zmq_get_dvector = -1
|
|
endif
|
|
|
|
rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0)
|
|
if (msg(1:14) /= 'get_data_reply') then
|
|
print *, rc, trim(msg)
|
|
print *, irp_here, ': Error in get_data_reply'
|
|
zmq_get_dvector = -1
|
|
endif
|
|
|
|
rc = f77_zmq_recv(zmq_to_qp_run_socket,x,size_x*8,0)
|
|
if (rc /= size_x*8) then
|
|
print *, irp_here, ': Error getting '//name
|
|
zmq_get_dvector = -1
|
|
endif
|
|
|
|
|
|
IRP_IF MPI
|
|
integer :: ierr
|
|
include 'mpif.h'
|
|
call MPI_BCAST (zmq_get_dvector, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
|
|
if (ierr /= MPI_SUCCESS) then
|
|
print *, irp_here//': Unable to broadcast zmq_get_dvector'
|
|
stop -1
|
|
endif
|
|
call MPI_BCAST (x, size_x, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
|
|
if (ierr /= MPI_SUCCESS) then
|
|
print *, irp_here//': Unable to broadcast dvector'
|
|
stop -1
|
|
endif
|
|
IRP_ENDIF
|
|
|
|
|
|
end
|
|
|
|
|
|
|