program main
use mpi
use pFIO
use MAPL_ExceptionHandling
use collective_demo_CLI
use FakeExtDataMod_collective
implicit none
integer :: rank, npes, ierror, provided,required
integer :: status, color, key, rc
class(AbstractServer),pointer :: server
class(AbstractDirectoryService), pointer :: d_s => null()
type (CommandLineOptions) :: options
integer, parameter :: NO_COLOR = 0
integer, parameter :: SERVER_COLOR = 1
integer, parameter :: CLIENT_COLOR = 2
integer, parameter :: BOTH_COLOR = 3
integer :: comm
!$ integer :: num_threads
type (FakeExtData), target :: extData
required = MPI_THREAD_MULTIPLE
call MPI_init_thread(required, provided, ierror)
_VERIFY(ierror)
call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierror)
_VERIFY(ierror)
call MPI_Comm_size(MPI_COMM_WORLD, npes, ierror)
_VERIFY(ierror)
call process_command_line(options, rc=status)
!! sanity check
!$ if(options%server_type == 'openmp') then
!$ if (required > provided) stop "provided thread is not enough for openmp"
!$ num_threads = 10
!$ call omp_set_num_threads(num_threads)
!$ endif
d_s => get_directory_service(options%server_type)
color = split_color(options%server_type,options%npes_server)
key = 0
call MPI_Comm_split(MPI_COMM_WORLD, color, key, comm, ierror)
_VERIFY(ierror)
if (color == SERVER_COLOR .or. color == BOTH_COLOR) then ! server
server=>get_server(options%server_type,comm,d_s,'i_server')
if (color == SERVER_COLOR) call server%start()
endif
if (color == CLIENT_COLOR .or. color == BOTH_COLOR) then ! client
call extData%init(options, comm, d_s, 'i_server')
call extData%run(step=1)
call extData%run(step=2)
call extData%finalize()
end if
call MPI_finalize(ierror)
contains
function get_directory_service(stype) result(d_s)
character(*),intent(in) :: stype
class(AbstractDirectoryService),pointer :: d_s
allocate(d_s, source=DirectoryService(MPI_COMM_WORLD))
_UNUSED_DUMMY(stype)
end function
function split_color(stype,split_rank) result(color)
character(*),intent(in) :: stype
integer,intent(in) :: split_rank
integer :: color
select case (stype)
case ('openmp','mpi')
if (rank < split_rank) then
color = SERVER_COLOR
else
color = CLIENT_COLOR
end if
case ('simple')
color = BOTH_COLOR
case default
stop "not known server type"
end select
end function
function get_server(stype, comm, d_s, port_name) result(server)
character(*),intent(in) :: stype
integer,intent(in) :: comm
class (AbstractDirectoryService), target, intent(inout) :: d_s
character(*), intent(in) :: port_name
class(BaseServer), pointer :: server
select case (stype)
case('mpi')
allocate(server,source=MpiServer(comm, port_name))
call d_s%publish(PortInfo(port_name, server),server)
call d_s%connect_to_client(port_name, server)
print*,"using MpiServer"
case('openmp')
!C$ allocate(server,source=OpenmpServer(comm,d_s))
!C$ print*,"using OpenMpServer"
case('simple')
allocate(server,source=MpiServer(comm, port_name))
call d_s%publish(PortInfo(port_name, server), server)
!C call d_s%connect_to_client(port_name, server)
print*,"using simple server"
end select
end function
end program main