Help us understand the problem. What is going on with this article?

fortran+MPIコーディング入門(2) 集団通信

More than 1 year has passed since last update.

前回は、MPIプログラムでは「プロセスがそれぞれの変数に同じ処理をする」という基本を学びました。今回はそのプロセス同士が扱うデータをやり取りする方法を扱います。

目次(予定)

  1. 並列処理とは
  2. プロセス並列の基本
  3. 集団通信 ←今ココ
  4. 1対1通信
  5. オブジェクト指向コードの並列化

集団通信

集団通信とは、多対多となる通信、つまり複数のプロセスを相手にデータをやり取りする場合を指します。

流れとしては、すべてのプロセスにデータを送る、あるいはすべてのプロセスからデータを受け取るというような処理になります。MPIではすべてのプロセスがその処理を行うので、多数対多数になります。

MPI_bcast

bcastはbroadcastの略です。自身の変数を他のすべてのプロセスに送ります。

あるプロセスでだけ設定ファイルを読み取り、他のプロセスへ配信するというような場合に使います。

以下にテストサブルーチンを示します。これでは変数xx_bcastをプロセス0がブロードキャストします。

subroutine smp_bcast()
    double precision :: xx_bcast = 0d0

    integer :: data_num = 1     ! 送信するデータの個数
    integer :: origin_rank = 0  ! 送信元プロセスのランク

    !ランク0のxx_bcastだけ1d0にする
    if(me == 0) then
       xx_bcast=1d0
    end if

    write(LOGUNIT,*) "smp_bcast"
    write(LOGUNIT,*) "original xx_bcast:",xx_bcast

    call mpi_bcast(xx_bcast, data_num, mpi_double_precision, origin_rank, &
         mpi_comm_world, ierr)

    write(LOGUNIT,*) "new xx_bcast:", xx_bcast

  end subroutine smp_bcast

これを実行すると、プロセス0以外は次のようになります。

 smp_bcast
 original xx_bcast:   0.0000000000000000
 new xx_bcast:   1.0000000000000000

プロセス0ではoriginal xx_bcastも1.0になります。こうしてすべてのプロセスでxx_bcastがoriginalのxx_bcastという同じ値に同期されます。

MPI_gather

gatherは「集める」と言う意味です。他のプロセスの配列を受け取り、配列に並べます。

以下のテストコードでは、各プロセスのランクを2倍した値をプロセス0の配列xx_gatherに集約します。

subroutine smp_gather()
    integer, allocatable :: xx_gather(:)

    integer :: data_num = 1
    integer :: root_rank = 0

    allocate(xx_gather(nnn))

    xx_gather=0

    write(LOGUNIT,*) "smp_gather"

    call mpi_gather(2*me, data_num, mpi_integer, &
         xx_gather(1), data_num, mpi_integer, &
         root_rank, &
         mpi_comm_world, ierr)

    write(LOGUNIT,*) xx_gather

  end subroutine smp_gather

これを実行すると、プロセス0では次のような結果になります。

smp_gather
           0           2           4           6           8          10          12          14

MPI_allgather

gather + bcastのようなものです。別個にやるよりこっちの方が速いらしいです。

MPI_reduce

他のプロセスの変数を合計したり積を取ったり、処理したものを
受け取ります。

以下のコードでは、各プロセスのランクの総和をプロセス0のsum_rankに代入します。

  subroutine smp_reduce()
    integer :: sum_rank 
    integer :: root_rank = 0

    sum_rank = 0

    write(LOGUNIT,*) "smp_reduce"

    call mpi_reduce(me, sum_rank, 1, mpi_integer, mpi_sum,&
         root_rank, mpi_comm_world, ierr)

    write(LOGUNIT,*) sum_rank

  end subroutine smp_reduce

MPI_allreduce

MPI_reduce + MPI_bcastのようなもの。こちらも速いらしいです。

サンプルコード

上記のテストを実行して各プロセスがsmp0301_xxxx.logに出力するコードが下記になります。

smp0301.f90
program main
  implicit none
  include "mpif.h"

  integer :: LOGUNIT = 125

  integer :: ierr
  integer :: me
  integer :: nnn

  character(len=4) :: me_char
  character(len=40) :: log_name

  ! 初期化
  call mpi_init(ierr)
  call mpi_comm_rank(mpi_comm_world,me,ierr)
  call mpi_comm_size(mpi_comm_world,nnn,ierr)

  ! 各プロセスがそれぞれのログファイルを開く
  write(me_char,'(i4.4)') me
  log_name = "smp0301_" // me_char // ".log"
  open(LOGUNIT, file=log_name,status="replace")

  write(LOGUNIT,*) "Process: ", me , "/", nnn

  ! テストを実行
  call smp_bcast()
  call smp_gather()
  call smp_reduce()

  ! 終了処理
  close(LOGUNIT)
  call mpi_finalize(ierr)


contains
  !----------------------------------------------------------------------
  subroutine smp_bcast()
    double precision :: xx_bcast = 0d0

    integer :: data_num = 1     ! 送信するデータの個数
    integer :: origin_rank = 0  ! 送信元プロセスのランク

    !ランク0のxx_bcastだけ1d0にする
    if(me == 0) then
       xx_bcast=1d0
    end if

    write(LOGUNIT,*) "smp_bcast"
    write(LOGUNIT,*) "original xx_bcast:",xx_bcast

    call mpi_bcast(xx_bcast, data_num, mpi_double_precision, origin_rank, &
         mpi_comm_world, ierr)

    write(LOGUNIT,*) "new xx_bcast:", xx_bcast

  end subroutine smp_bcast
  !----------------------------------------------------------------------
  subroutine smp_gather()
    integer, allocatable :: xx_gather(:)

    integer :: data_num = 1
    integer :: root_rank = 0

    allocate(xx_gather(nnn))

    xx_gather=0

    write(LOGUNIT,*) "smp_gather"

    call mpi_gather(2*me, data_num, mpi_integer, &
         xx_gather(1), data_num, mpi_integer, &
         root_rank, &
         mpi_comm_world, ierr)

    write(LOGUNIT,*) xx_gather

  end subroutine smp_gather
  !----------------------------------------------------------------------
  subroutine smp_reduce()
    integer :: sum_rank 
    integer :: root_rank = 0

    sum_rank = 0

    write(LOGUNIT,*) "smp_reduce"

    call mpi_reduce(me, sum_rank, 1, mpi_integer, mpi_sum,&
         root_rank, mpi_comm_world, ierr)

    write(LOGUNIT,*) sum_rank

  end subroutine smp_reduce

end program main

参考サイト

http://www.cv.titech.ac.jp/~hiro-lab/study/mpi_reference/chapter3.html

Why not register and get more from Qiita?
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away
Comments
Sign up for free and join this conversation.
If you already have a Qiita account
Why do not you register as a user and use Qiita more conveniently?
You need to log in to use this function. Qiita can be used more conveniently after logging in.
You seem to be reading articles frequently this month. Qiita can be used more conveniently after logging in.
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away