selection_slave does parallel davidson - unstable on fast iterations

This commit is contained in:
Yann Garniron 2016-10-07 09:57:14 +02:00
parent c5ad63ac0f
commit 1b63438d68
3 changed files with 48 additions and 12 deletions

View File

@ -32,7 +32,7 @@ OPENMP : 1 ; Append OpenMP flags
#
[OPT]
FC : -traceback
FCFLAGS : -xHost -O2 -ip -ftz -g
FCFLAGS : -xSSE4.2 -O2 -ip -ftz -g
# Profiling flags
#################

View File

@ -28,26 +28,37 @@ subroutine run_wf
call provide_everything
zmq_context = f77_zmq_ctx_new ()
zmq_state = 'selection'
state = 'Waiting'
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
do
call wait_for_state(zmq_state,state)
if(trim(state) /= 'selection') exit
print *, 'Getting wave function'
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states_diag)
call wait_for_next_state(state)
print *, "STATE ", trim(state)
if(trim(state) == "Stopped") exit
if(trim(state) == 'selection') then
zmq_state = 'selection'
print *, 'Getting wave function'
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states_diag)
integer :: rc, i
integer :: rc, i
print *, 'Selection slave running'
print *, 'Selection slave running'
!$OMP PARALLEL PRIVATE(i)
i = omp_get_thread_num()
call selection_dressing_slave_tcp(i, energy)
!$OMP END PARALLEL
!$OMP PARALLEL PRIVATE(i)
i = omp_get_thread_num()
call selection_dressing_slave_tcp(i, energy)
!$OMP END PARALLEL
else if(trim(state) == "davidson") then
zmq_state = 'davidson'
call davidson_miniserver_get()
print *, "Davidson slave running"
!$OMP PARALLEL PRIVATE(i)
i = omp_get_thread_num()
call davidson_slave_tcp(i)
!$OMP END PARALLEL
end if
end do
end

View File

@ -854,6 +854,31 @@ subroutine zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id,more)
endif
end
subroutine wait_for_next_state(state)
use f77_zmq
implicit none
character*(64), intent(out) :: state
integer(ZMQ_PTR) :: zmq_socket_sub
integer(ZMQ_PTR), external :: new_zmq_sub_socket
integer :: rc
zmq_socket_sub = new_zmq_sub_socket()
state = 'Waiting'
do while(state == "Waiting")
rc = f77_zmq_recv( zmq_socket_sub, state, 64, 0)
if (rc > 0) then
state = trim(state(1:rc))
else
print *, 'Timeout reached. Stopping'
state = "Stopped"
end if
end do
call end_zmq_sub_socket(zmq_socket_sub)
end subroutine
subroutine wait_for_state(state_wait,state)
use f77_zmq
implicit none