main Program

Uses

  • program~~main~4~~UsesGraph program~main~4 main module~collective_demo_cli collective_demo_CLI program~main~4->module~collective_demo_cli module~fakeextdatamod_collective FakeExtDataMod_collective program~main~4->module~fakeextdatamod_collective module~mapl_exceptionhandling MAPL_ExceptionHandling program~main~4->module~mapl_exceptionhandling module~pfio pFIO program~main~4->module~pfio mpi mpi program~main~4->mpi

sanity check


Calls

program~~main~4~~CallsGraph program~main~4 main mpi_comm_rank mpi_comm_rank program~main~4->mpi_comm_rank mpi_comm_size mpi_comm_size program~main~4->mpi_comm_size mpi_comm_split mpi_comm_split program~main~4->mpi_comm_split mpi_finalize mpi_finalize program~main~4->mpi_finalize mpi_init_thread mpi_init_thread program~main~4->mpi_init_thread none~finalize~2 FakeExtData%finalize program~main~4->none~finalize~2 none~init~3 FakeExtData%init program~main~4->none~init~3 none~run~3 FakeExtData%run program~main~4->none~run~3 proc~get_directory_service get_directory_service program~main~4->proc~get_directory_service proc~get_server get_server program~main~4->proc~get_server proc~mapl_abort MAPL_abort program~main~4->proc~mapl_abort proc~mapl_verify MAPL_Verify program~main~4->proc~mapl_verify proc~process_command_line process_command_line program~main~4->proc~process_command_line proc~split_color split_color program~main~4->proc~split_color start start program~main~4->start none~terminate~4 ClientThread%terminate none~finalize~2->none~terminate~4 none~init~3->mpi_comm_rank none~init~3->mpi_comm_size none~init~3->proc~mapl_verify at at none~init~3->at connect_to_server connect_to_server none~init~3->connect_to_server none~get_dimensions~2 FileMetadata%get_dimensions none~init~3->none~get_dimensions~2 none~run~3->at none~add_ext_collection ClientThread%add_ext_collection none~run~3->none~add_ext_collection none~collective_prefetch_data ClientThread%collective_prefetch_data none~run~3->none~collective_prefetch_data none~done_collective_prefetch ClientThread%done_collective_prefetch none~run~3->none~done_collective_prefetch connect_to_client connect_to_client proc~get_server->connect_to_client publish publish proc~get_server->publish mpi_abort mpi_abort proc~mapl_abort->mpi_abort proc~mapl_throw_exception MAPL_throw_exception proc~mapl_verify->proc~mapl_throw_exception interface~mapl_assert MAPL_Assert proc~process_command_line->interface~mapl_assert push_back push_back proc~process_command_line->push_back

Variables

Type Attributes Name Initial
integer, parameter :: BOTH_COLOR = 3
integer, parameter :: CLIENT_COLOR = 2
integer, parameter :: NO_COLOR = 0
integer, parameter :: SERVER_COLOR = 1
integer :: color
integer :: comm
integer :: ierror
integer :: key
integer :: npes
integer :: provided
integer :: rank
integer :: rc
integer :: required
integer :: status
class(AbstractDirectoryService), pointer :: d_s => null()
class(AbstractServer), pointer :: server
type(CommandLineOptions) :: options
type(FakeExtData), target :: extData

Functions

function split_color(stype, split_rank) result(color)

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: stype
integer, intent(in) :: split_rank

Return Value integer

function get_directory_service(stype) result(d_s)

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: stype

Return Value class(AbstractDirectoryService), pointer

function get_server(stype, comm, d_s, port_name) result(server)

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: stype
integer, intent(in) :: comm
class(AbstractDirectoryService), intent(inout), target :: d_s
character(len=*), intent(in) :: port_name

Return Value class(BaseServer), pointer


Source Code

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