Skip to content
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
17 changes: 12 additions & 5 deletions src/fortuno_mpi/mpicmdapp.f90
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@

!> Contains the command line app for driving mpi tests
module fortuno_mpi_mpicmdapp
use mpi_f08, only : MPI_Comm
use fortuno, only : cmd_app, test_list
use fortuno_mpi_mpidriver, only : init_mpi_driver, mpi_driver
use fortuno_mpi_mpienv, only : init_mpi_env, final_mpi_env, mpi_env
Expand All @@ -24,32 +25,38 @@ module fortuno_mpi_mpicmdapp
!!
!! Note: This routine stops the code during execution and never returns.
!!
subroutine execute_mpi_cmd_app(tests)
subroutine execute_mpi_cmd_app(tests, comm)

!> Items to be considered by the app
type(test_list), intent(in) :: tests

!> Optional MPI communicator provided by caller
type(MPI_Comm), optional, intent(in) :: comm

integer :: exitcode

call run_mpi_cmd_app(tests, exitcode)
call run_mpi_cmd_app(tests, exitcode, comm)
stop exitcode, quiet=.true.

end subroutine execute_mpi_cmd_app


!> Sets up and runs the mpi command line up
subroutine run_mpi_cmd_app(tests, exitcode)
!> Sets up and runs the mpi command line
subroutine run_mpi_cmd_app(tests, exitcode, comm)

!> Items to be considered by the app
type(test_list), intent(in) :: tests

!> Exit code
integer, intent(out) :: exitcode

!> Optional MPI communicator provided by caller
type(MPI_Comm), optional, intent(in) :: comm

type(mpi_cmd_app) :: app
type(mpi_env) :: mpienv

call init_mpi_env(mpienv)
call init_mpi_env(mpienv, comm)
call init_mpi_cmd_app(app, mpienv)
call app%run(tests, exitcode)
call final_mpi_env(mpienv)
Expand Down
16 changes: 12 additions & 4 deletions src/fortuno_mpi/mpienv.f90
Original file line number Diff line number Diff line change
Expand Up @@ -34,16 +34,24 @@ module fortuno_mpi_mpienv
contains

!> Initializes the MPI environment
subroutine init_mpi_env(this)
subroutine init_mpi_env(this, comm)

!> Instance
type(mpi_env), intent(out) :: this

!> Optional MPI communicator provided by caller
type(MPI_Comm), optional, intent(in) :: comm

integer :: ierror

call MPI_Init(ierror)
if (ierror /= 0) error stop "MPI_Init failed in init_mpi_env"
this%comm = MPI_COMM_WORLD
if (present(comm)) then
this%comm = comm
else
call MPI_Init(ierror)
if (ierror /= 0) error stop "MPI_Init failed in init_mpi_env"
this%comm = MPI_COMM_WORLD
endif

call MPI_Comm_size(this%comm, this%nranks, ierror)
if (ierror /= 0) error stop "MPI_Comm_size failed in init_mpi_env"
call MPI_Comm_rank(this%comm, this%rank, ierror)
Expand Down