mirror of
https://github.com/LCPQ/quantum_package
synced 2024-06-02 11:25:26 +02:00
Debug ZMQ
This commit is contained in:
parent
47511da133
commit
b719eea821
|
|
@ -425,9 +425,6 @@ end function
|
|||
deallocate(seed)
|
||||
|
||||
call RANDOM_NUMBER(pt2_u)
|
||||
call RANDOM_NUMBER(pt2_u)
|
||||
|
||||
|
||||
|
||||
U = 0
|
||||
|
||||
|
|
|
|||
|
|
@ -163,6 +163,7 @@ integer function zmq_put_psi_det(zmq_to_qp_run_socket,worker_id)
|
|||
|
||||
rc8 = f77_zmq_send8(zmq_to_qp_run_socket,psi_det,int(N_int*2_8*N_det*bit_kind,8),0)
|
||||
if (rc8 /= N_int*2_8*N_det*bit_kind) then
|
||||
print *, 'rc=', rc8
|
||||
zmq_put_psi_det = -1
|
||||
return
|
||||
endif
|
||||
|
|
@ -195,8 +196,9 @@ integer function zmq_put_psi_coef(zmq_to_qp_run_socket,worker_id)
|
|||
return
|
||||
endif
|
||||
|
||||
rc8 = f77_zmq_send8(zmq_to_qp_run_socket,psi_coef,int(psi_det_size*N_states*8_8,8),0)
|
||||
rc8 = f77_zmq_send8(zmq_to_qp_run_socket,psi_coef,int(psi_det_size,8)*int(N_states,8)*8_8,0)
|
||||
if (rc8 /= psi_det_size*N_states*8_8) then
|
||||
print *, 'rc=', rc8
|
||||
zmq_put_psi_coef = -1
|
||||
return
|
||||
endif
|
||||
|
|
|
|||
|
|
@ -48,7 +48,6 @@ integer function zmq_get_dvector(zmq_to_qp_run_socket, worker_id, name, x, size_
|
|||
character*(*), intent(in) :: name
|
||||
double precision, intent(out) :: x(size_x)
|
||||
integer :: rc
|
||||
integer*8 :: rc8
|
||||
character*(256) :: msg
|
||||
|
||||
PROVIDE zmq_state
|
||||
|
|
@ -151,7 +150,6 @@ integer function zmq_get_ivector(zmq_to_qp_run_socket, worker_id, name, x, size_
|
|||
character*(*), intent(in) :: name
|
||||
integer, intent(out) :: x(size_x)
|
||||
integer :: rc
|
||||
integer*8 :: rc8
|
||||
character*(256) :: msg
|
||||
|
||||
PROVIDE zmq_state
|
||||
|
|
@ -200,6 +198,206 @@ integer function zmq_get_ivector(zmq_to_qp_run_socket, worker_id, name, x, size_
|
|||
end
|
||||
|
||||
|
||||
integer function zmq_put8_dvector(zmq_to_qp_run_socket, worker_id, name, x, size_x)
|
||||
use f77_zmq
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Put a float 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*8, intent(in) :: size_x
|
||||
double precision, intent(in) :: x(size_x)
|
||||
integer*8 :: rc
|
||||
character*(256) :: msg
|
||||
|
||||
zmq_put8_dvector = 0
|
||||
|
||||
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
|
||||
zmq_put8_dvector = -1
|
||||
return
|
||||
endif
|
||||
|
||||
rc = f77_zmq_send(zmq_to_qp_run_socket,x,size_x*8,0)
|
||||
if (rc /= size_x*8) then
|
||||
zmq_put8_dvector = -1
|
||||
return
|
||||
endif
|
||||
|
||||
rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0)
|
||||
if (msg(1:rc) /= 'put_data_reply ok') then
|
||||
zmq_put8_dvector = -1
|
||||
return
|
||||
endif
|
||||
|
||||
end
|
||||
|
||||
|
||||
integer function zmq_get8_dvector(zmq_to_qp_run_socket, worker_id, name, x, size_x)
|
||||
use f77_zmq
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Get a float vector from the qp_run scheduler
|
||||
END_DOC
|
||||
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
||||
integer, intent(in) :: worker_id
|
||||
integer*8, intent(in) :: size_x
|
||||
character*(*), intent(in) :: name
|
||||
double precision, intent(out) :: x(size_x)
|
||||
integer*8 :: rc
|
||||
character*(256) :: msg
|
||||
|
||||
PROVIDE zmq_state
|
||||
! Success
|
||||
zmq_get8_dvector = 0
|
||||
|
||||
if (mpi_master) then
|
||||
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
|
||||
zmq_get8_dvector = -1
|
||||
print *, irp_here, 'rc /= len(trim(msg))', rc, len(trim(msg))
|
||||
go to 10
|
||||
endif
|
||||
|
||||
rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0)
|
||||
if (msg(1:14) /= 'get_data_reply') then
|
||||
print *, irp_here, 'msg(1:14) /= get_data_reply', msg(1:14)
|
||||
zmq_get8_dvector = -1
|
||||
go to 10
|
||||
endif
|
||||
|
||||
rc = f77_zmq_recv(zmq_to_qp_run_socket,x,size_x*8,0)
|
||||
if (rc /= size_x*8) then
|
||||
print *, irp_here, 'rc /= size_x*8', rc, size_x*8
|
||||
zmq_get8_dvector = -1
|
||||
go to 10
|
||||
endif
|
||||
endif
|
||||
|
||||
10 continue
|
||||
|
||||
IRP_IF MPI_DEBUG
|
||||
print *, irp_here, mpi_rank
|
||||
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
|
||||
IRP_ENDIF
|
||||
IRP_IF MPI
|
||||
integer :: ierr
|
||||
include 'mpif.h'
|
||||
call MPI_BCAST (zmq_get8_dvector, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
|
||||
if (ierr /= MPI_SUCCESS) then
|
||||
print *, irp_here//': Unable to broadcast zmq_get8_dvector'
|
||||
stop -1
|
||||
endif
|
||||
call MPI_BARRIER(MPI_COMM_WORLD,ierr)
|
||||
call broadcast_chunks_double(x, size_x)
|
||||
IRP_ENDIF
|
||||
|
||||
end
|
||||
|
||||
|
||||
|
||||
integer function zmq_put8_ivector(zmq_to_qp_run_socket, worker_id, name, x, size_x)
|
||||
use f77_zmq
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Put a vector of integers 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*8, intent(in) :: size_x
|
||||
integer, intent(in) :: x(size_x)
|
||||
integer*8 :: rc
|
||||
character*(256) :: msg
|
||||
|
||||
zmq_put8_ivector = 0
|
||||
|
||||
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
|
||||
zmq_put8_ivector = -1
|
||||
return
|
||||
endif
|
||||
|
||||
rc = f77_zmq_send(zmq_to_qp_run_socket,x,size_x*4,0)
|
||||
if (rc /= size_x*4) then
|
||||
zmq_put8_ivector = -1
|
||||
return
|
||||
endif
|
||||
|
||||
rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0)
|
||||
if (msg(1:rc) /= 'put_data_reply ok') then
|
||||
zmq_put8_ivector = -1
|
||||
return
|
||||
endif
|
||||
|
||||
end
|
||||
|
||||
|
||||
integer function zmq_get8_ivector(zmq_to_qp_run_socket, worker_id, name, x, size_x)
|
||||
use f77_zmq
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Get a vector of integers from the qp_run scheduler
|
||||
END_DOC
|
||||
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
||||
integer, intent(in) :: worker_id
|
||||
integer*8, intent(in) :: size_x
|
||||
character*(*), intent(in) :: name
|
||||
integer, intent(out) :: x(size_x)
|
||||
integer*8 :: rc
|
||||
character*(256) :: msg
|
||||
|
||||
PROVIDE zmq_state
|
||||
! Success
|
||||
zmq_get8_ivector = 0
|
||||
|
||||
if (mpi_master) then
|
||||
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
|
||||
zmq_get8_ivector = -1
|
||||
go to 10
|
||||
endif
|
||||
|
||||
rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0)
|
||||
if (msg(1:14) /= 'get_data_reply') then
|
||||
zmq_get8_ivector = -1
|
||||
go to 10
|
||||
endif
|
||||
|
||||
rc = f77_zmq_recv(zmq_to_qp_run_socket,x,size_x*4,0)
|
||||
if (rc /= size_x*4) then
|
||||
zmq_get8_ivector = -1
|
||||
go to 10
|
||||
endif
|
||||
endif
|
||||
|
||||
10 continue
|
||||
|
||||
IRP_IF MPI_DEBUG
|
||||
print *, irp_here, mpi_rank
|
||||
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
|
||||
IRP_ENDIF
|
||||
IRP_IF MPI
|
||||
integer :: ierr
|
||||
include 'mpif.h'
|
||||
call MPI_BCAST (zmq_get8_ivector, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
|
||||
if (ierr /= MPI_SUCCESS) then
|
||||
print *, irp_here//': Unable to broadcast zmq_get8_ivector'
|
||||
stop -1
|
||||
endif
|
||||
call MPI_BARRIER(MPI_COMM_WORLD,ierr)
|
||||
call broadcast_chunks_integer(x, size_x)
|
||||
IRP_ENDIF
|
||||
|
||||
end
|
||||
|
||||
|
||||
|
||||
integer function zmq_put_int(zmq_to_qp_run_socket, worker_id, name, x)
|
||||
use f77_zmq
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user