non-busy-waiting dispatch

This commit is contained in:
ignis 2019-06-14 18:46:51 +09:00
parent 785cfe63b9
commit 9cfb2af9ac

View file

@ -102,6 +102,7 @@
SUBROUTINE main_lb SUBROUTINE main_lb
INTEGER :: fread,i INTEGER :: fread,i
LOGICAL :: received
CALL READ_INTRO CALL READ_INTRO
@ -132,7 +133,13 @@
countnum=countnum+1 countnum=countnum+1
CALL MPI_RECV(id_to, 1, MPI_INTEGER, MPI_ANY_SOURCE, tag, MPI_COMM_TASK, mpi_status, mpi_err) CALL MPI_Irecv(id_to, 1, MPI_INTEGER, MPI_ANY_SOURCE, tag, MPI_COMM_TASK, mpi_request, mpi_err)
do
call MPI_Test(mpi_request, received, mpi_status, mpi_err)
if (received) exit
call SLEEP (1)
end do
CALL MPI_SEND(fread, 1, MPI_INTEGER, id_to, tag, MPI_COMM_TASK, mpi_err) CALL MPI_SEND(fread, 1, MPI_INTEGER, id_to, tag, MPI_COMM_TASK, mpi_err)
ENDIF ENDIF
@ -141,7 +148,13 @@
end_of_dispatch1: DO i=1,numprocs-1 end_of_dispatch1: DO i=1,numprocs-1
CALL MPI_RECV(id_to, 1, MPI_INTEGER, MPI_ANY_SOURCE, tag, MPI_COMM_TASK, mpi_status, mpi_err) CALL MPI_Irecv (id_to, 1, MPI_INTEGER, MPI_ANY_SOURCE, tag, MPI_COMM_TASK, mpi_request, mpi_err)
do
call MPI_Test(mpi_request, received, mpi_status, mpi_err)
if (received) exit
call SLEEP (1)
end do
CALL MPI_SEND(-1, 1, MPI_INTEGER, id_to, tag, MPI_COMM_TASK, mpi_err) CALL MPI_SEND(-1, 1, MPI_INTEGER, id_to, tag, MPI_COMM_TASK, mpi_err)
ENDDO end_of_dispatch1 ENDDO end_of_dispatch1
@ -190,7 +203,13 @@
ELSE ELSE
CALL MPI_RECV(id_to, 1, MPI_INTEGER, MPI_ANY_SOURCE, tag, MPI_COMM_TASK, mpi_status, mpi_err) CALL MPI_Irecv(id_to, 1, MPI_INTEGER, MPI_ANY_SOURCE, tag, MPI_COMM_TASK, mpi_request, mpi_err)
do
call MPI_Test(mpi_request, received, mpi_status, mpi_err)
if (received) exit
call SLEEP (1)
end do
CALL MPI_SEND(fread, 1, MPI_INTEGER, id_to, tag, MPI_COMM_TASK, mpi_err) CALL MPI_SEND(fread, 1, MPI_INTEGER, id_to, tag, MPI_COMM_TASK, mpi_err)
ENDIF ENDIF
@ -199,7 +218,13 @@
end_of_dispatch2: DO i=1,numprocs-1 end_of_dispatch2: DO i=1,numprocs-1
CALL MPI_RECV(id_to, 1, MPI_INTEGER, MPI_ANY_SOURCE, tag, MPI_COMM_TASK, mpi_status, mpi_err) CALL MPI_Irecv (id_to, 1, MPI_INTEGER, MPI_ANY_SOURCE, tag, MPI_COMM_TASK, mpi_request, mpi_err)
do
call MPI_Test(mpi_request, received, mpi_status, mpi_err)
if (received) exit
call SLEEP (1)
end do
CALL MPI_SEND(-1, 1, MPI_INTEGER, id_to, tag, MPI_COMM_TASK, mpi_err) CALL MPI_SEND(-1, 1, MPI_INTEGER, id_to, tag, MPI_COMM_TASK, mpi_err)
ENDDO end_of_dispatch2 ENDDO end_of_dispatch2