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