Fixing Davidson

This commit is contained in:
Anthony Scemama 2019-01-28 13:00:59 +01:00
parent e8c0ba6ca0
commit c35594edd3
2 changed files with 17 additions and 0 deletions

View File

@ -165,10 +165,12 @@ subroutine run_slave_main
call wall_time(t1)
call write_double(6,(t1-t0),'Broadcast time')
!---
call omp_set_nested(.True.)
call davidson_slave_tcp(0)
call omp_set_nested(.False.)
print *, mpi_rank, ': Davidson done'
!---
IRP_IF MPI
call MPI_BARRIER(MPI_COMM_WORLD, ierr)

View File

@ -35,10 +35,25 @@ subroutine davidson_run_slave(thread,iproc)
integer(ZMQ_PTR) :: zmq_socket_push
integer, external :: connect_to_taskserver
integer :: doexit, send, receive
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
doexit = 0
if (connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread) == -1) then
doexit=1
endif
IRP_IF MPI
include 'mpif.h'
integer :: ierr
send = doexit
call MPI_AllReduce(send, receive, 1, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then
doexit=1
endif
doexit = receive
IRP_ENDIF
if (doexit) then
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
return
endif