AbstractDirectoryService.F90 Source File


This file depends on

sourcefile~~abstractdirectoryservice.f90~~EfferentGraph sourcefile~abstractdirectoryservice.f90 AbstractDirectoryService.F90 sourcefile~abstractsocket.f90 AbstractSocket.F90 sourcefile~abstractdirectoryservice.f90->sourcefile~abstractsocket.f90 sourcefile~abstractsocketvector.f90 AbstractSocketVector.F90 sourcefile~abstractdirectoryservice.f90->sourcefile~abstractsocketvector.f90 sourcefile~baseserver.f90 BaseServer.F90 sourcefile~abstractdirectoryservice.f90->sourcefile~baseserver.f90 sourcefile~mapl_keywordenforcer.f90 MAPL_KeywordEnforcer.F90 sourcefile~abstractdirectoryservice.f90->sourcefile~mapl_keywordenforcer.f90 sourcefile~abstractsocketvector.f90->sourcefile~abstractsocket.f90 sourcefile~baseserver.f90->sourcefile~abstractsocket.f90 sourcefile~baseserver.f90->sourcefile~abstractsocketvector.f90 sourcefile~abstractdatamessage.f90 AbstractDataMessage.F90 sourcefile~baseserver.f90->sourcefile~abstractdatamessage.f90 sourcefile~abstractdatareference.f90 AbstractDataReference.F90 sourcefile~baseserver.f90->sourcefile~abstractdatareference.f90 sourcefile~abstractmessage.f90 AbstractMessage.F90 sourcefile~baseserver.f90->sourcefile~abstractmessage.f90 sourcefile~abstractserver.f90 AbstractServer.F90 sourcefile~baseserver.f90->sourcefile~abstractserver.f90 sourcefile~collectivestagedatamessage.f90 CollectiveStageDataMessage.F90 sourcefile~baseserver.f90->sourcefile~collectivestagedatamessage.f90 sourcefile~donemessage.f90 DoneMessage.F90 sourcefile~baseserver.f90->sourcefile~donemessage.f90 sourcefile~dummymessage.f90 DummyMessage.F90 sourcefile~baseserver.f90->sourcefile~dummymessage.f90 sourcefile~mapl_exceptionhandling.f90 MAPL_ExceptionHandling.F90 sourcefile~baseserver.f90->sourcefile~mapl_exceptionhandling.f90 sourcefile~messagevector.f90 MessageVector.F90 sourcefile~baseserver.f90->sourcefile~messagevector.f90 sourcefile~mpisocket.f90 MpiSocket.F90 sourcefile~baseserver.f90->sourcefile~mpisocket.f90 sourcefile~pfio_constants.f90 pFIO_Constants.F90 sourcefile~baseserver.f90->sourcefile~pfio_constants.f90 sourcefile~pfio_utilities.f90 pFIO_Utilities.F90 sourcefile~baseserver.f90->sourcefile~pfio_utilities.f90 sourcefile~rdmareference.f90 RDMAReference.F90 sourcefile~baseserver.f90->sourcefile~rdmareference.f90 sourcefile~serverthread.f90 ServerThread.F90 sourcefile~baseserver.f90->sourcefile~serverthread.f90 sourcefile~serverthreadvector.f90 ServerThreadVector.F90 sourcefile~baseserver.f90->sourcefile~serverthreadvector.f90 sourcefile~shmemreference.f90 ShmemReference.F90 sourcefile~baseserver.f90->sourcefile~shmemreference.f90 sourcefile~simplesocket.f90 SimpleSocket.F90 sourcefile~baseserver.f90->sourcefile~simplesocket.f90

Files dependent on this one

sourcefile~~abstractdirectoryservice.f90~~AfferentGraph sourcefile~abstractdirectoryservice.f90 AbstractDirectoryService.F90 sourcefile~directoryservice.f90 DirectoryService.F90 sourcefile~directoryservice.f90->sourcefile~abstractdirectoryservice.f90 sourcefile~mpiserver.f90 MpiServer.F90 sourcefile~mpiserver.f90->sourcefile~abstractdirectoryservice.f90 sourcefile~multicommserver.f90 MultiCommServer.F90 sourcefile~multicommserver.f90->sourcefile~abstractdirectoryservice.f90 sourcefile~multigroupserver.f90 MultiGroupServer.F90 sourcefile~multigroupserver.f90->sourcefile~abstractdirectoryservice.f90 sourcefile~multilayerserver.f90 MultiLayerServer.F90 sourcefile~multilayerserver.f90->sourcefile~abstractdirectoryservice.f90 sourcefile~openmpserver.f90 OpenMPServer.F90 sourcefile~openmpserver.f90->sourcefile~abstractdirectoryservice.f90 sourcefile~pfio.f90 pFIO.F90 sourcefile~pfio.f90->sourcefile~abstractdirectoryservice.f90 sourcefile~test_directoryservice.pf Test_DirectoryService.pf sourcefile~test_directoryservice.pf->sourcefile~abstractdirectoryservice.f90

Source Code

module pFIO_AbstractDirectoryServiceMod
   use mapl_KeywordEnforcerMod
   use pFIO_BaseServerMod
   use pFIO_AbstractSocketMod
   use pFIO_AbstractSocketVectorMod

   implicit none
   private

   public :: AbstractDirectoryService  
   public :: MAX_LEN_PORT_NAME
   public :: MAX_NUM_PORTS
   public :: PortInfo

   integer,parameter :: MAX_NUM_PORTS = 16
   integer,parameter :: MAX_LEN_PORT_NAME= 16

   type :: PortInfo
     character(len=MAX_LEN_PORT_NAME) :: port_name
     ! it is for simple_directory_service, should be the type BaseThread pointer
     class(BaseServer), pointer :: server_ptr => null()
   end type

   type,abstract :: AbstractDirectoryService
   contains
      procedure(connect_to_server), deferred :: connect_to_server
      procedure(connect_to_client), deferred :: connect_to_client
      procedure(publish),deferred :: publish
      procedure(free_directory_resources), deferred :: free_directory_resources
   end type AbstractDirectoryService

   abstract interface

      subroutine connect_to_server(this, port_name, client, client_comm, unusable, server_size, rc)
         use pFIO_ClientThreadMod
         import AbstractDirectoryService
         import PortInfo
         import AbstractSocket
         import KeywordEnforcer
         class (AbstractDirectoryService), target, intent(inout) :: this
         character(len=*), intent(in) :: port_name
         class (ClientThread), target, intent(inout) :: client
         integer, intent(in) :: client_comm
         class (KeywordEnforcer), optional, intent(in) :: unusable
         integer, optional, intent(out) :: server_size
         integer, optional, intent(out) :: rc
      end subroutine connect_to_server

      subroutine connect_to_client(this, port_name, server, rc)
         use pFIO_BaseServerMod
         import AbstractDirectoryService
         import PortInfo
         import AbstractSocketVector
         class (AbstractDirectoryService), target, intent(inout) :: this
         character(*), intent(in) :: port_name
         class (BaseServer), target, intent(inout) :: server
         integer, optional, intent(out) :: rc
      end subroutine connect_to_client

      subroutine publish(this, port, server, rc)
         use pFIO_BaseServerMod
         import AbstractDirectoryService
         import PortInfo
         class (AbstractDirectoryService), target, intent(inout) :: this
         type(PortInfo), target, intent(in) :: port
         class (BaseServer), intent(in) :: server
         integer, optional, intent(out) :: rc
      end subroutine

      subroutine free_directory_resources(this, rc)
         import AbstractDirectoryService
         class (AbstractDirectoryService), intent(inout) :: this
         integer, optional, intent(out) :: rc
      end subroutine

   end interface

   interface PortInfo
      module procedure new_PortInfo
   endinterface

contains

   function new_PortInfo(port_name, server_ptr) result(port)
      character(*),intent(in) :: port_name
      class (BaseServer),target,optional,intent(in) :: server_ptr
      type(PortInfo) :: port
      port%port_name = port_name
      if(present(server_ptr)) port%server_ptr => server_ptr
   end function

end module pFIO_AbstractDirectoryServiceMod