mirror of
https://github.com/LCPQ/quantum_package
synced 2024-08-25 05:51:46 +02:00
Added control ID in zmq_state
This commit is contained in:
parent
f7831c033a
commit
140a8e30fd
@ -106,7 +106,6 @@ let reply_ok rep_socket =
|
||||
|> ZMQ.Socket.send rep_socket
|
||||
|
||||
let reply_wrong_state rep_socket =
|
||||
Printf.printf "WRONG STATE\n%!";
|
||||
Message.Error_msg.create "Wrong state"
|
||||
|> Message.Error_msg.to_string
|
||||
|> ZMQ.Socket.send rep_socket
|
||||
|
@ -29,7 +29,7 @@ subroutine run_wf
|
||||
integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket
|
||||
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
||||
double precision :: energy(N_states)
|
||||
character*(64) :: states(4)
|
||||
character*(64) :: states(3)
|
||||
integer :: rc, i, ierr
|
||||
double precision :: t0, t1
|
||||
|
||||
@ -44,18 +44,18 @@ subroutine run_wf
|
||||
|
||||
do
|
||||
|
||||
call wait_for_states(states,zmq_state,3)
|
||||
call wait_for_states(states,zmq_state,size(states))
|
||||
print *, trim(zmq_state)
|
||||
|
||||
if(trim(zmq_state) == 'Stopped') then
|
||||
if(zmq_state(1:7) == 'Stopped') then
|
||||
|
||||
exit
|
||||
|
||||
else if (trim(zmq_state) == 'selection') then
|
||||
else if (zmq_state(1:9) == 'selection') then
|
||||
|
||||
! Selection
|
||||
! ---------
|
||||
|
||||
print *, 'Selection'
|
||||
call wall_time(t0)
|
||||
call zmq_get_psi(zmq_to_qp_run_socket,1)
|
||||
call zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states)
|
||||
@ -70,14 +70,8 @@ subroutine run_wf
|
||||
call run_selection_slave(0,i,energy)
|
||||
!$OMP END PARALLEL
|
||||
print *, 'Selection done'
|
||||
IRP_IF MPI
|
||||
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
|
||||
if (ierr /= MPI_SUCCESS) then
|
||||
print *, irp_here, 'error in barrier'
|
||||
endif
|
||||
IRP_ENDIF
|
||||
|
||||
else if (trim(zmq_state) == 'davidson') then
|
||||
else if (zmq_state(1:8) == 'davidson') then
|
||||
|
||||
! Davidson
|
||||
! --------
|
||||
@ -95,15 +89,8 @@ subroutine run_wf
|
||||
call davidson_slave_tcp(0)
|
||||
call omp_set_nested(.False.)
|
||||
print *, 'Davidson done'
|
||||
IRP_IF MPI
|
||||
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
|
||||
if (ierr /= MPI_SUCCESS) then
|
||||
print *, irp_here, 'error in barrier'
|
||||
endif
|
||||
IRP_ENDIF
|
||||
|
||||
|
||||
else if (trim(zmq_state) == 'pt2') then
|
||||
else if (zmq_state(1:3) == 'pt2') then
|
||||
|
||||
! PT2
|
||||
! ---
|
||||
@ -125,15 +112,16 @@ subroutine run_wf
|
||||
call run_pt2_slave(0,i,energy,lstop)
|
||||
!$OMP END PARALLEL
|
||||
print *, 'PT2 done'
|
||||
IRP_IF MPI
|
||||
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
|
||||
if (ierr /= MPI_SUCCESS) then
|
||||
print *, irp_here, 'error in barrier'
|
||||
endif
|
||||
IRP_ENDIF
|
||||
|
||||
endif
|
||||
|
||||
IRP_IF MPI
|
||||
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
|
||||
if (ierr /= MPI_SUCCESS) then
|
||||
print *, irp_here, 'error in barrier'
|
||||
endif
|
||||
IRP_ENDIF
|
||||
|
||||
end do
|
||||
IRP_IF MPI
|
||||
call MPI_finalize(i)
|
||||
|
@ -526,7 +526,9 @@ subroutine new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,name_in)
|
||||
integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket
|
||||
integer(ZMQ_PTR),external :: new_zmq_pull_socket
|
||||
integer(ZMQ_PTR), intent(out) :: zmq_to_qp_run_socket, zmq_socket_pull
|
||||
integer, save :: icount=0
|
||||
|
||||
icount = icount+1
|
||||
call omp_set_lock(zmq_lock)
|
||||
zmq_context = f77_zmq_ctx_new ()
|
||||
call omp_unset_lock(zmq_lock)
|
||||
@ -541,7 +543,7 @@ subroutine new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,name_in)
|
||||
|
||||
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
||||
zmq_socket_pull = new_zmq_pull_socket ()
|
||||
name = name_in
|
||||
write(name,'(A,I8.8)') trim(name_in)//'.', icount
|
||||
sze = len(trim(name))
|
||||
call lowercase(name,sze)
|
||||
message = 'new_job '//trim(name)//' '//zmq_socket_push_tcp_address//' '//zmq_socket_pull_inproc_address
|
||||
@ -604,8 +606,10 @@ subroutine end_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,name_in)
|
||||
|
||||
character*(512) :: message, name
|
||||
integer :: i,rc, sze
|
||||
integer, save :: icount=0
|
||||
|
||||
name = name_in
|
||||
icount = icount+1
|
||||
write(name,'(A,I8.8)') trim(name_in)//'.', icount
|
||||
sze = len(trim(name))
|
||||
call lowercase(name,sze)
|
||||
if (name /= zmq_state) then
|
||||
@ -1209,8 +1213,13 @@ subroutine wait_for_states(state_wait,state,n)
|
||||
integer(ZMQ_PTR) :: zmq_socket_sub
|
||||
integer(ZMQ_PTR), external :: new_zmq_sub_socket
|
||||
integer :: rc, i
|
||||
integer :: sze(n)
|
||||
logical :: condition
|
||||
|
||||
do i=1,n
|
||||
sze(i) = len(trim(state_wait(i)))
|
||||
enddo
|
||||
|
||||
zmq_socket_sub = new_zmq_sub_socket()
|
||||
state = 'Waiting'
|
||||
condition = .True.
|
||||
@ -1224,7 +1233,7 @@ subroutine wait_for_states(state_wait,state,n)
|
||||
endif
|
||||
condition = trim(state) /= 'Stopped'
|
||||
do i=1,n
|
||||
condition = condition .and. (trim(state) /= trim(state_wait(i)))
|
||||
condition = condition .and. (state(1:sze(i)) /= state_wait(i)(1:sze(i)))
|
||||
enddo
|
||||
end do
|
||||
call end_zmq_sub_socket(zmq_socket_sub)
|
||||
|
Loading…
Reference in New Issue
Block a user