Commit f41618da authored by Simon Brass's avatar Simon Brass
Browse files

Update.

parent 8191c678
#define DEBUG(MSG) call debug (MSG,& \
__FILE__,& \
__LINE)
use error, only: debug
!> /file Define routines to handle error, warning and debug messages.
module error
use iso_fortran_env, only: ERROR_UNIT
implicit none
private
public :: debug
contains
subroutine debug (msg, file, line)
character(len=*), intent(in) :: msg, file, line
write (ERROR_UNIT, *) file, ":", line, ": ", msg
end subroutine debug
end module error
program main
#include "debug.h"
use iso_fortran_env, only: r64 => REAL64, OUTPUT_UNIT
use iso_c_binding, only: c_int
......@@ -6,17 +7,10 @@ program main
use request_handler
use result_handler
use mpi_f08
use utils, only: sleep
implicit none
interface
function sleep (seconds) bind (C, name="sleep")
import :: c_int
integer(c_int) :: sleep
integer(c_int), intent(in), value :: seconds
end function sleep
end interface
integer, parameter :: n_channels = 11
type(result_t), dimension(n_channels), target :: result
integer :: i_channel, rank, n_size, source, n_handler, handler_id
......
......@@ -34,7 +34,7 @@ contains
type(result_t), intent(in), target :: result
integer, intent(in) :: n_requests
handler%obj => result
handler%success = .false.
handler%finished = .false.
call handler%allocate (n_requests)
end subroutine result_handler_init
......@@ -44,7 +44,7 @@ contains
type(MPI_COMM), intent(in) :: comm
if (associated (handler%obj)) write (ERROR_UNIT, *) "[ASSOCIATED]"
call handler%obj%receive (source, comm, handler%request)
handler%success = .true.
handler%finished = .false.
end subroutine result_handler_handle
subroutine result_handler_client_handle (handler, rank, comm)
......@@ -54,7 +54,7 @@ contains
if (associated (handler%obj)) write (ERROR_UNIT, *) "CLIENT: [ASSOCIATED]"
call handler%obj%send (rank, comm, handler%request)
!! \todo{sbrass} Communication has not finished... so, no success?
handler%success = .false.
handler%finished = .false.
end subroutine result_handler_client_handle
!> Finalize result_handler_t.
......
......@@ -17,6 +17,7 @@
module request_handler
use iso_fortran_env, only: ERROR_UNIT
use mpi_f08
use utils
implicit none
......@@ -37,12 +38,16 @@ module request_handler
integer :: n_requests = 0
type(MPI_REQUEST), dimension(:), allocatable :: request
type(MPI_STATUS), dimension(:), allocatable :: status
logical :: success = .false.
logical :: finished = .false.
#ifdef TIME
type(cpu_time_t) :: reqT
#endif
contains
!! \todo{sbrass} implement initialization procedure.
procedure(request_handler_handle), deferred :: handle
procedure(request_handler_client_handle), deferred :: client_handle
procedure :: allocate => request_handler_allocate
procedure :: testall => request_handler_testall
procedure :: waitall => request_handler_waitall
end type request_handler_t
......@@ -61,7 +66,6 @@ module request_handler
type(MPI_COMM) :: comm
integer :: n_comm_size
integer :: comm_rank
! integer, dimension(:), allocatable :: occupied
integer :: n_handlers
type(request_handler_container_t), dimension(:), allocatable :: handler
contains
......@@ -72,15 +76,17 @@ module request_handler
procedure :: handle => request_handler_manager_handle
procedure :: handle_request => request_handler_manager_handle_request
procedure :: handler_waitall => request_handler_manager_handler_waitall
procedure :: handler_testall => request_handler_manager_handler_testall
procedure :: handler_wait => request_handler_manager_handler_wait
generic :: write(formatted) => print
procedure, private :: print => request_handler_manager_write
end type request_handler_manager_t
abstract interface
!> Handle a request.
!> Handle a request from server side.
!!
!! Must set handler%success?
!! \param[in] source Integer rank of the source in comm.
!! \param[in] comm MPI communicator.
subroutine request_handler_handle (handler, source, comm)
import :: request_handler_t, MPI_COMM
class(request_handler_t), intent(inout) :: handler
......@@ -88,6 +94,10 @@ module request_handler
type(MPI_COMM), intent(in) :: comm
end subroutine request_handler_handle
!> Handle a request from client side.
!!
!! \param[in] rank Integer of the receiver in comm.
!! \param[in] comm MPI communicator.
subroutine request_handler_client_handle (handler, rank, comm)
import :: request_handler_t, MPI_COMM
class(request_handler_t), intent(inout) :: handler
......@@ -118,13 +128,23 @@ contains
handler%n_requests = n_requests
end subroutine request_handler_allocate
!> Call MPI_WATIALL.
!> Call MPI_WATIALL and raise finished flag.
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
handler%finished = .true.
end subroutine request_handler_waitall
logical function request_handler_testall (handler) result (flag)
class(request_handler_t), intent(inout) :: handler
if (.not. handler%finished) then
call MPI_TESTALL (handler%n_requests, handler%request, handler%finished, &
handler%status)
end if
flag = handler%finished
end function request_handler_testall
subroutine request_container_final (rhc)
type(request_handler_container_t), intent(inout) :: rhc
deallocate (rhc%ptr)
......@@ -161,7 +181,7 @@ contains
!> Slave worker request the master worker.
!!
!! \param[in] server_id Index for the respective handler on the server.
!! \param[in] server_id Index for the respective handler on the client.
!! \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
integer, intent(in) :: server_id
......@@ -179,6 +199,15 @@ contains
call rhm%handler(client_id)%ptr%client_handle (0, rhm%comm)
end subroutine request_handler_manager_request
!> Test if handler with id has finished.
!!
!! \param[in] id Index for the respective handler.
logical function request_handler_manager_handler_testall (rhm, id) result (flag)
class(request_handler_manager_t), intent(inout) :: rhm
integer, intent(in) :: id
flag = rhm%handler(id)%ptr%testall ()
end function request_handler_manager_handler_testall
!> The master worker listens to handle requests from the slave workers.
!!
!! \param[in]
......@@ -206,6 +235,7 @@ contains
count_handler = count_handler + 1
!! |todo{sbrass} Old handle has to finish at this point!!! Keep track
!! of that, somehow...
!! \note{}
call MPI_IRECV (handler(indices(i)), 1, MPI_INTEGER, &
indices(i), MPI_ANY_TAG, rhm%comm, reqs(indices(i)))
end do
......
module utils
use iso_fortran_env, only: r64 => REAL64
use iso_c_binding, only: c_int
implicit none
private
interface
function sleep (seconds) bind (C, name="sleep")
import :: c_int
integer(c_int) :: sleep
integer(c_int), intent(in), value :: seconds
end function sleep
end interface
public :: sleep
type :: cpu_time_t
private
real(r64) :: start
real(r64) :: finish
contains
procedure :: begin => cpu_time_begin
procedure :: end => cpu_time_end
procedure :: time => cpu_time_time
generic :: write(formatted) => print
procedure :: print => cpu_time_print
end type cpu_time_t
contains
subroutine cpu_time_print (dtv, unit, iotype, vlist, iostat, iomsg)
class(cpu_time_t), intent(in) :: dtv
integer, intent(in) :: unit
character (len=*), intent(in) :: iotype
integer, dimension(:), intent(in) :: vlist
integer, intent(out) :: iostat
character (len=*), intent(inout) :: iomsg
write (unit, iostat=iostat) (dtv%finish - dtv%start)
end subroutine cpu_time_print
subroutine cpu_time_begin (ct)
class(cpu_time_t), intent(inout) :: ct
call cpu_time (ct%start)
end subroutine cpu_time_begin
subroutine cpu_time_end (ct)
class(cpu_time_t), intent(inout) :: ct
call cpu_time (ct%finish)
end subroutine cpu_time_end
real(r64) function cpu_time_time (ct) result (delta)
class(cpu_time_t), intent(in) :: ct
delta = ct%finish - ct%start
end function cpu_time_time
end module utils
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