Commit c2870a9b authored by Simon Brass's avatar Simon Brass
Browse files

mpi-spawn.f08: simple server/client example

parent 503ae119
program main
use mpi_f08
implicit none
integer :: ierr, nprocs, parent_nprocs, myrank
logical :: server_mode = .false.
type(MPI_comm) :: everyone, parent
integer, parameter :: maxprocs = 3
integer, dimension(maxprocs) :: errorcodes
character(len=*), PARAMETER:: cmd='./a.out'
character(25), dimension(1) :: argv
argv = ""
call MPI_init(ierr)
if (ierr /= MPI_SUCCESS) then
print *, "MPI_init error"
end if
call MPI_Comm_size(MPI_Comm_world, nprocs, ierr)
if (ierr /= MPI_SUCCESS) then
print *, "MPI_Comm_size error"
end if
call MPI_Comm_rank(MPI_Comm_world, myrank, ierr)
if (ierr /= MPI_SUCCESS) then
print *, "MPI_Comm_rank error"
end if
! Check if run as Server
call MPI_comm_get_parent(parent)
if (parent == MPI_COMM_NULL .and. nprocs == 1) then
server_mode = .true.
end if
if (server_mode .and. myrank == 0) then
print *, "[SPAWN]"
call MPI_COMM_SPAWN(cmd, argv, maxprocs, MPI_INFO_NULL, 0, MPI_COMM_WORLD, everyone, errorcodes, ierr)
else
print *, "[CHILD]"
call MPI_comm_get_parent(parent)
if (parent == MPI_COMM_NULL) then
print *, "No parent!"
else
call MPI_comm_remote_size (parent, parent_nprocs)
print *, "Parent's size: ", parent_nprocs
end if
end if
print *, "nprocs=", nprocs, " myrank=", myrank
call MPI_finalize(ierr)
if (ierr /= MPI_SUCCESS) then
print *, "MPI_finalize error"
end if
end program main
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment