Commit 032fabcf authored by Simon Braß's avatar Simon Braß
Browse files

request.f08: add stack for handler management.

parent ca7e7170
......@@ -10,6 +10,7 @@ libbalancer = shared_library('balancer',
'utils.f08'])
#executable('mpi-request-1', 'mpi-request-1.f08', link_with: libbalancer)
mpi_request_1 = executable('mpi-request-1', 'mpi-request-1.f08', link_with: libbalancer)
mpi_balancer_2 = executable('mpi-balancer-2', 'mpi-balancer-2.f08', link_with: libbalancer)
mpi_balancer_3 = executable('mpi-balancer-3', 'mpi-balancer-3.f08', link_with: libbalancer)
......
......@@ -56,6 +56,20 @@ module request_handler
final :: request_container_final
end type request_handler_container_t
type :: request_handler_stack_t
private
integer :: max_stacksize
integer :: top
type(request_handler_container_t), dimension(:), allocatable :: item
contains
procedure :: init => request_handler_stack_init
procedure :: push => request_handler_stack_push
procedure :: pop => request_handler_stack_pop
procedure :: peek => request_handler_stack_peek
procedure :: is_empty => request_handler_stack_is_empty
procedure :: is_full => request_handler_stack_is_full
end type request_handler_stack_t
!> Introduce a container object in order to handle arrays of
!! request_handler_t objcts.
type :: request_handler_manager_t
......@@ -64,7 +78,7 @@ module request_handler
integer :: n_comm_size
integer :: comm_rank
integer :: n_handlers
type(request_handler_container_t), dimension(:), allocatable :: handler
type(request_handler_stack_t) :: handler
contains
procedure :: init => request_handler_manager_init
procedure :: register => request_handler_manager_register
......@@ -105,6 +119,11 @@ module request_handler
public :: request_handler_t, request_handler_manager_t
contains
!!
!! Request handler.
!!
!> Allocate MPI request and status object.
!!
!! Must be called during or after object-initialization.
......@@ -129,7 +148,7 @@ contains
subroutine request_handler_waitall (handler)
class(request_handler_t), intent(inout) :: handler
call MPI_WAITALL (handler%n_requests, handler%request, handler%status)
!! \todo{sbrass} catch error
!! \todo{sbrass - catch error}
handler%finished = .true.
end subroutine request_handler_waitall
......@@ -147,11 +166,68 @@ contains
deallocate (rhc%ptr)
end subroutine request_container_final
!!
!! Request handler stack.
!!
subroutine request_handler_stack_init (stack, max_stacksize)
class(request_handler_stack_t), intent(out) :: stack
integer, intent(in) :: max_stacksize
allocate (stack%item(max_stacksize))
stack%max_stacksize = max_stacksize
stack%top = 0
end subroutine request_handler_stack_init
subroutine request_handler_stack_push (stack, handler)
class(request_handler_stack_t), intent(inout) :: stack
class(request_handler_t), pointer, intent(in) :: handler
if (stack%top >= stack%max_stacksize) then
write (ERROR_UNIT, *) "Stack push: Stack is full."
stop 1
end if
stack%top = stack%top + 1
stack%item(stack%top)%ptr => handler
end subroutine request_handler_stack_push
subroutine request_handler_stack_pop (stack, handler)
class(request_handler_stack_t), intent(inout) :: stack
class(request_handler_t), pointer, intent(out) :: handler
if (stack%top < 1) then
write (ERROR_UNIT, *) "Stack pop: Stack is empty."
end if
handler => stack%item(stack%top)%ptr
stack%top = stack%top - 1
end subroutine request_handler_stack_pop
subroutine request_handler_stack_peek (stack, i_handler, handler)
class(request_handler_stack_t), intent(in) :: stack
integer, intent(in) :: i_handler
class(request_handler_t), pointer, intent(out) :: handler
if (i_handler > stack%max_stacksize .or. &
i_handler < 1) then
write (ERROR_UNIT, *) "Stack peek: i_handler out of range: ", i_handler
end if
handler => stack%item(i_handler)%ptr
end subroutine request_handler_stack_peek
logical function request_handler_stack_is_empty (stack) result (flag)
class(request_handler_stack_t), intent(in) :: stack
flag = (stack%top < 1)
end function request_handler_stack_is_empty
logical function request_handler_stack_is_full (stack) result (flag)
class(request_handler_stack_t), intent(in) :: stack
flag = (stack%top >= stack%max_stacksize)
end function request_handler_stack_is_full
!!
!! Request handler manager
!!
subroutine request_handler_manager_init (rhm, n_size, comm)
class(request_handler_manager_t), intent(out) :: rhm
integer, intent(in) :: n_size
type(MPI_COMM), intent(in) :: comm
allocate (rhm%handler (n_size))
call rhm%handler%init (n_size)
rhm%n_handlers = n_size
rhm%comm = comm
call MPI_COMM_SIZE (rhm%comm, rhm%n_comm_size)
......@@ -165,39 +241,47 @@ contains
integer, dimension(:), intent(in) :: vlist
integer, intent(out) :: iostat
character (len=*), intent(inout) :: iomsg
write (unit, iostat=iostat) size (dtv%handler)
write (unit, iostat=iostat) dtv%n_handlers
end subroutine request_handler_manager_write
subroutine request_handler_manager_register (rhm, id, handler)
!> Master register a new request_handler_t object by adding it to the handler stack.
!!
!! \note
!! Although, we use a "stack" to organize the handler objects, we use it in an
!! ambivalent way, meaning that the stack reduces on the master to an mere
!! container for an array where can access (peek) at single elements with
!! their respective index. However, for the slave we will actually use a single
!! item stack, in order to keep track of the latest handler.
!! \param[in] handler Handler object.
subroutine request_handler_manager_register (rhm, handler)
class(request_handler_manager_t), intent(inout) :: rhm
integer, intent(in) :: id
class(request_handler_t), intent(in), pointer :: handler
rhm%handler(id)%ptr => handler
call rhm%handler%push (handler)
end subroutine request_handler_manager_register
!> Slave worker request the master worker.
!!
!! \param[in] server_id Index for the respective handler on the server.
!! \param[in] client_id Index for the respective handler on the client.
subroutine request_handler_manager_request (rhm, server_id, client_id)
class(request_handler_manager_t), intent(in) :: rhm
!! \param[out] handler
subroutine request_handler_manager_request (rhm, server_id, handler)
class(request_handler_manager_t), intent(inout) :: rhm
integer, intent(in) :: server_id
integer, intent(in) :: client_id
class(request_handler_t), intent(in), pointer :: handler
type(MPI_REQUEST) :: req
type(MPI_STATUS) :: stat
integer, parameter :: REQUEST_TAG = 1
!! Check whether previous request has already finished.
if (client_id > 1) then
!! Test locally the request, if not finished, wait until finished.
! if (.not. rhm%handler_test (client_id - 1)) call rhm%handler_wait (client_id - 1)
call rhm%handler_wait (client_id - 1)
end if
class(request_handler_t), pointer :: last_handler
do while (.not. rhm%handler%is_empty ())
call rhm%handler%pop (last_handler)
call last_handler%waitall ()
end do
call MPI_ISEND (server_id, 1, MPI_INTEGER, &
0, REQUEST_TAG, rhm%comm, req)
call rhm%handler%push (handler)
call MPI_WAIT (req, stat)
!! \todo{sbrass} Catch MPI error.
!! Client handle, which may differ from the server handle.
call rhm%handler(client_id)%ptr%client_handle (0, rhm%comm)
call handler%client_handle (0, rhm%comm)
end subroutine request_handler_manager_request
!> The master worker listens to handle requests from the slave workers.
......@@ -242,13 +326,15 @@ contains
end do
end subroutine request_handler_manager_handler_waitall
!> Wait for a handler to finish.
!> Master wait for a handler to finish.
!!
!! \param[in] id Index for the handler (locally).
subroutine request_handler_manager_handler_wait (rhm, id)
class(request_handler_manager_t), intent(in) :: rhm
integer, intent(in) :: id
call rhm%handler(id)%ptr%waitall ()
class(request_handler_t), pointer :: handler
call rhm%handler%peek (id, handler)
call handler%waitall ()
end subroutine request_handler_manager_handler_wait
!> Test if handler with id has finished.
......@@ -257,7 +343,9 @@ contains
logical function request_handler_manager_handler_test (rhm, id) result (flag)
class(request_handler_manager_t), intent(in) :: rhm
integer, intent(in) :: id
flag = rhm%handler(id)%ptr%testall ()
class(request_handler_t), pointer :: handler
call rhm%handler%peek (id, handler)
flag = handler%testall ()
end function request_handler_manager_handler_test
!> Run handler with [[id]], and let the handler know the source of the request.
......@@ -268,7 +356,9 @@ contains
class(request_handler_manager_t), intent(inout) :: rhm
integer, intent(in) :: request_id
integer, intent(in) :: request_source
call rhm%handler(request_id)%ptr%handle (request_source, rhm%comm)
class(request_handler_t), pointer :: handler
call rhm%handler%peek (request_id, handler)
call handler%handle (request_source, rhm%comm)
!! \todo{sbrass} Check on success of handle?
!! Is it already finished, or is the finalization postponed?
end subroutine request_handler_manager_handle
......@@ -279,7 +369,9 @@ contains
integer function request_handler_manager_get_n_requests (rhm, id) result (n_requests)
class(request_handler_manager_t), intent(in) :: rhm
integer, intent(in) :: id
n_requests = rhm%handler(id)%ptr%n_requests
class(request_handler_t), pointer :: handler
call rhm%handler%peek (id, handler)
n_requests = handler%n_requests
end function request_handler_manager_get_n_requests
end module request_handler
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment