main Program

Uses

  • program~~main~2~~UsesGraph program~main~2 main iso_fortran_env iso_fortran_env program~main~2->iso_fortran_env module~fakehistdatamod FakeHistDataMod program~main~2->module~fakehistdatamod module~mapl_exceptionhandling MAPL_ExceptionHandling program~main~2->module~mapl_exceptionhandling module~performace_cli performace_CLI program~main~2->module~performace_cli module~pfio pFIO program~main~2->module~pfio module~pflogger pflogger program~main~2->module~pflogger mpi mpi program~main~2->mpi

Calls

program~~main~2~~CallsGraph program~main~2 main connect_to_client connect_to_client program~main~2->connect_to_client free_directory_resources free_directory_resources program~main~2->free_directory_resources mpi_barrier mpi_barrier program~main~2->mpi_barrier mpi_bcast mpi_bcast program~main~2->mpi_bcast mpi_comm_rank mpi_comm_rank program~main~2->mpi_comm_rank mpi_comm_size mpi_comm_size program~main~2->mpi_comm_size mpi_comm_split mpi_comm_split program~main~2->mpi_comm_split mpi_comm_split_type mpi_comm_split_type program~main~2->mpi_comm_split_type mpi_finalize mpi_finalize program~main~2->mpi_finalize mpi_init mpi_init program~main~2->mpi_init mpi_wtime mpi_wtime program~main~2->mpi_wtime none~finalize~2 FakeHistData%finalize program~main~2->none~finalize~2 none~init FakeHistData%init program~main~2->none~init none~run~3 FakeHistData%run program~main~2->none~run~3 proc~initialize~7 initialize program~main~2->proc~initialize~7 proc~process_command_line process_command_line program~main~2->proc~process_command_line publish publish program~main~2->publish start start program~main~2->start

Variables

Type Attributes Name Initial
integer :: InNode_Comm
integer :: NodeRoot_Comm
integer :: app_color
integer :: app_rank
integer :: app_size
integer :: i
integer :: i_color
integer :: i_comm
integer :: i_rank
integer :: i_size
integer :: ierror
integer :: innode_rank
integer :: key
integer :: my_appcomm
integer :: my_icomm
integer :: my_ocomm
integer :: node_num
integer :: node_rank
integer :: npes
integer :: o_color
integer :: o_comm
integer :: o_rank
integer :: o_size
integer :: rank
integer :: root_color
integer :: status
integer :: tmp_rank
real(kind=REAL64) :: t0
real(kind=REAL64) :: t1
class(AbstractDirectoryService), allocatable, target :: directory_service
class(BaseServer), allocatable :: iserver
class(BaseServer), allocatable :: oserver
type(CommandLineOptions) :: options
type(FakeHistData), target :: HistData

Source Code

program main
   use, intrinsic :: iso_fortran_env, only: REAL32, REAL64
   use mpi
   use pFIO
   use performace_CLI
   use FakeHistDataMod
   use MAPL_ExceptionHandling
   use pFlogger, only: pflogger_init => initialize
   implicit none

   integer :: rank, npes, ierror
   integer :: status, key

   class(BaseServer),allocatable :: iserver,oserver
   class(AbstractDirectoryService), allocatable, target :: directory_service

   type (CommandLineOptions) :: options
   type (FakeHistData), target :: HistData

   integer :: my_icomm, my_ocomm, my_appcomm, o_comm, i_comm
   integer :: InNode_Comm,innode_rank, node_rank, node_num, NodeRoot_Comm
   integer :: root_color,o_color,i_color, app_color
   integer :: tmp_rank, i_size, i_rank, o_size, o_rank, app_size, app_rank
   integer :: i
   real(kind=REAL64) :: t0, t1   

   call MPI_init(ierror)
   call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierror)
   call MPI_Comm_size(MPI_COMM_WORLD, npes, ierror)

   call process_command_line(options, rc=status)

   call pflogger_init()
   directory_service = DirectoryService(MPI_COMM_WORLD)

   my_icomm   = MPI_COMM_NULL
   my_appcomm = MPI_COMM_NULL
   my_ocomm   = MPI_COMM_NULL

   ! split into node
   call MPI_Comm_split_type(MPI_COMM_WORLD, MPI_COMM_TYPE_SHARED, 0, MPI_INFO_NULL, InNode_Comm,ierror)
   call MPI_Comm_rank(InNode_Comm, InNode_Rank, ierror)

   root_color = 0
   key = 0
   if ( InNode_rank ==0) root_color = 1
   call MPI_COMM_SPLIT( MPI_COMM_WORLD, root_color, key, NodeRoot_Comm, ierror)
   
   if (root_color == 1) then ! they are all roots of  nodes
      call MPI_COMM_SIZE(NodeRoot_Comm, Node_Num, ierror)  
      call MPI_COMM_RANK(NodeRoot_Comm, Node_Rank, ierror)
   endif

   ! now each process knows its node_rank
   call Mpi_Bcast(Node_Rank, 1, MPI_INTEGER, 0, InNode_Comm, ierror)
   call Mpi_Bcast(Node_Num,  1, MPI_INTEGER, 0, InNode_Comm, ierror)
   if (rank ==0) print*, "total node number: ", node_num 

   if (rank ==0) call execute_command_line('rm -f test_out1.nc4')
 
    o_color   = 0 
    i_color   = 0
    app_color = 0
    my_icomm  = MPI_COMM_NULL
    my_appcomm= MPI_COMM_NULL
    my_ocomm  = MPI_COMM_NULL
    ! o-sever
    if (Node_rank < options%nodes_oserver) o_color = 1
    call MPI_COMM_SPLIT( MPI_COMM_WORLD, o_color, key, o_Comm, ierror)   
    if (o_color == 1) my_ocomm = o_comm 

    if (o_color == 0) then
       call MPI_COMM_RANK(o_comm, tmp_Rank, ierror)
       if (tmp_rank >= options%npes_client) then 
          i_color = 1
       else
          app_color = 1
       endif
       call MPI_COMM_SPLIT( o_comm, i_color, key, i_Comm, ierror)
       
       if(i_color == 1) my_icomm = i_comm
       if(app_color ==1) my_appcomm = i_comm
  
    endif
    
    call Mpi_Barrier(MPI_COMM_WORLD,ierror)
    t0 = MPI_wtime()

    if (my_icomm /= MPI_COMM_NULL) then

      call MPI_Comm_rank(my_icomm, i_rank, ierror)
      call MPI_Comm_size(my_icomm, i_size, ierror)
      if(i_rank ==0) print*, "i_server size:", i_size

      allocate(iserver, source = MpiServer(my_icomm, 'iserver'))
      call directory_service%publish(PortInfo('iserver',iserver), iserver)
      if( my_appcomm == MPI_COMM_NULL) then ! mpi server
         call directory_service%connect_to_client('iserver', iserver)
         call iserver%start()
      endif
   endif

   if( my_ocomm /= MPI_COMM_NULl) then

      call MPI_Comm_rank(my_ocomm, o_rank, ierror)
      call MPI_Comm_size(my_ocomm, o_size, ierror)
      if(o_rank ==0) print*, "o_server size:", o_size

      allocate(oserver, source = MpiServer(my_ocomm, 'oserver'))
      call directory_service%publish(PortInfo('oserver',oserver), oserver)
      if (my_appcomm == MPI_COMM_NULL) then 
         call directory_service%connect_to_client('oserver', oserver)
         call oserver%start()
      endif
   endif

   if ( my_appcomm /= MPI_COMM_NULL) then
     
      call MPI_Comm_rank(my_appcomm, app_rank, ierror)
      call MPI_Comm_size(my_appcomm, app_size, ierror)
      if(app_rank ==0) print*, "app client size:", app_size

      call histData%init(options,my_appcomm,directory_service)
      !call histData%run(step=1)
      call histData%run(step=2)
      call histData%finalize()

   end if
  
   call Mpi_Barrier(MPI_COMM_WORLD,ierror)
   t1 = MPI_wtime()
   if( rank == 0) then
      print*, "seconds wall time : ", t1-t0
   endif

   if ( rank == 0) then
   !   call execute_command_line('diff test_out_TUV.nc4 test_out.nc4', exitstat = status )
   !   if (status == 0) then
   !      print*, 'test_out.nc4 and test_out_TUV.nc4 are the same and thus removed'
   !      call execute_command_line('rm -f test_out.nc4')
   !   else
   !      print*, 'test_out.nc4 and test_out_TUV.nc4 differ'
   !      stop 1
   !   endif

      do i = 1, options%num_collection
!         call execute_command_line('rm -f test_out'//i_to_string(i)//'.nc4')
      enddo
   endif
   call directory_service%free_directory_resources()
   call MPI_finalize(ierror)

end program main