mpi_initialize Subroutine

public subroutine mpi_initialize(ctx)

MPIを初期化して rank / size を取得する。非MPIビルドでは単一ランクを返す。

Arguments

Type IntentOptional Attributes Name
type(mpi_context), intent(out) :: ctx

Called by

proc~~mpi_initialize~~CalledByGraph proc~mpi_initialize mpi_initialize program~main main program~main->proc~mpi_initialize

Source Code

  subroutine mpi_initialize(ctx)
    type(mpi_context), intent(out) :: ctx
#ifdef USE_MPI
    include 'mpif.h'
    logical :: is_initialized
    integer :: ierr
    integer :: rank_int, size_int
#endif
    ctx = mpi_context()
#ifdef USE_MPI
    call MPI_Initialized(is_initialized, ierr)
    if (.not. is_initialized) then
      call MPI_Init(ierr)
      ctx%initialized_here = .true.
    end if

    call MPI_Comm_rank(MPI_COMM_WORLD, rank_int, ierr)
    call MPI_Comm_size(MPI_COMM_WORLD, size_int, ierr)
    ctx%rank = int(rank_int, i32)
    ctx%size = int(size_int, i32)
    ctx%enabled = (ctx%size > 1_i32)
#endif
    ! MPI ビルド時に launcher 環境変数から rank/size を補完して
    ! root 専用ログの重複を避ける。非 MPI build では collective が no-op
    ! になるため、複数 task launcher を検出したら明示的に停止する。
#ifdef USE_MPI
    if (ctx%size <= 1_i32) call infer_launcher_rank_size(ctx)
#else
    call infer_launcher_rank_size(ctx)
    if (ctx%size > 1_i32) then
      error stop 'BEACH was built without MPI but launcher reports multiple ranks. Rebuild with USE_MPI or run one task.'
    end if
    ctx = mpi_context()
#endif
  end subroutine mpi_initialize