fortran66のブログ

fortran について書きます。

Fortran 入門 f95

ネット上のフリー入門 Fortran95

大阪大学レーザー研 高性能計算機室

公開テキスト
ページ内にLinkあり。

FORTRANのよい入門書がないと相談したところ、レーザー研の共同研究者である摂南大学の田口先生が、ご自分の研究室向けに作られていた入門書を一般的なものに加筆修正して提供してくださいました。 これは、Fortran文法とプログラムの書き方を解説した基礎編、様々な数値計算法を解説した実践編の2部構成の400ページを超す大作として進化し、2015年7月には技術評論社より「Fortranハンドブック」として出版されました。

  • 2011/10/17 第2.1版 2011/7/8(福田) パソコン&スーパーコンピュータで計算するための基礎知識

pdf 1.17MB

  • 2016/3/29 第4版 2013/5/20

摂南大学 田口俊弘先生より
ご提供いただきました) Fortranスマートプログラミング(2015年度版) pdf 930KB

※上記2つの資料の抜粋版は、東北大学の 広報誌(SENAC)に掲載されています。
      詳細はこちら(2012年4月号、7月号、10月号、2013年1月号)。

「並列Fortranの現状と展望」の講演資料公開

Fortranに関するシンポジウム(第3回)

「並列Fortranの現状と展望」
~現代化か肥大化か?~

が六月初旬に無事開催された模様です。以下のページで講演資料が見られます。

並列Fortranに関するシンポジウムのご案内(第3回) - 高性能 Fortran 推進協議会

Fortran ~ modernization or cumbersome ~
Project Editor, ISO/IEC Fortran standard / Numerical Algorithms Group Oxford/Tokyo
Malcolm Cohen

Modern Fortran Explained の著者の一人であり日本 NAG の Malcolm Cohen 氏の講演は、Fortran 規格を定めかつコンパイラを作る側からの視点で甚だ興味深いものです。

オブジェクト指向Fortranが拓く(はずだった)新しい世界
名古屋大学 未来材料・システム研究所
出川 智啓

先ごろ話題になった Fortran 同人の中の人の講演で、Fortran によるオブジェクト指向を解説した力作に基づく講演です。

角川のオンラインストア電子書籍が購入できます。
bookwalker.jp

twitter で正誤表が配られています。


Fortranで高性能計算 ~その仕様使いますか?~
宇宙航空研究開発機構 宇宙科学研究所
高木 亮治

Modern Fortran の仕様の利用とパフォーマンスのバランスについて、実際のプログラムでの使用例をもとに論じられています。

糞アマゾンで売られている海賊版 

Jacob Mason 名義で大量の技術書の海賊版が売られている。もしくはただの詐欺。値段が安いわけでもないので、目的が何なのかよく分からない。ISBN 番号はついているし、このからくりは何なのか?

Michael Metcalf, John Reid & Malcolm Cohen の Modern Fortran Explained が、まんまコピーで売られているw

著作権表示ページのこの手抜き感ww
f:id:fortran66:20170618210537p:plain


アマゾンは中国・韓国人による違法 windows や office 海賊版も一向に取り締まろうとせず、破廉恥極まりない。

本物

日アマゾン

米アマゾン
www.amazon.com

英アマゾン
www.amazon.co.uk

Fortran 三面記事 ウィークエンダー  

www.youtube.com

ARM が自社 CPU 用に HPC 向けの Fortran 2003 水準のコンパイラを出す

ネット新聞によりますと

www.hpcwire.com

HPC 分野の標準の C/C++/Fortran compiler および基本的ライブラリ optimized BLAS, LAPACK and FFTデバッグツールなどを揃えるとのことです。

developer.arm.com

自動ベクトル化機能をもったコンパイラだそうです。
試してみたいものですが、旧型ラズパイのラズビアン環境でゆけるのかよく分かりません。

CoArray Fortran が Jupyter 上で試せる

ネットニュースグループによりますと

「Try Coarray Fortran in the cloud」Zaak氏が Jupyter Notebook 上で CAF が試せるからくりを開発した模様です。Fortran プログラムそのものが動くもようで、F2PY のようにサブルーチンだけというわけではないようです。そのうえで CoArray も動くようです。

https://groups.google.com/forum/#!topic/comp.lang.fortran/_VFKgicY9SE

一応、リンクを踏むと用意してある環境で試せる模様です。

An Empirical Study of Fortran Programs – Don Knuth (1971) [pdf]

ハッカーニュースによりますと
An Empirical Study of Fortran Programs – Don Knuth (1971) [pdf] | Hacker News

Fortran 95/2003 for Scientists & Engineers (5th edition) 値下がり中

アマゾン乞食による貧困調査

米アマゾンで Stephen Chapman の 「Fortran 95/2003 for Scientists & Engineers (第5版)」が 中古 $60 台に値下がり中の模様です。新版が出たせいで値崩れしたものと思われます。1000頁を超える大部の書で $100~$200 していたので大幅安です。CoArray の章が加わったものと思われます。

www.amazon.com




Fortran

NHK カルチャーラジオ アメリカン・ミュージックの系譜 が面白い

第11回【ヒップポップ~知的でクリエイティブな側面】
www4.nhk.or.jp

ヒップホップって、匹夫凡夫の聞く現代のお経のような音楽だと思っていましたが、90年代ポストモダンの文脈から見ると、70年代から最先端を切っていたということで、なかなか面白い解釈でした。

ロックまでの音楽は自己の内側・内面にある衝動のようなものから引き出した何かを音楽という形式で表現していたが、ヒップホップは自己の外側にあるレコードコレクション・データベースから適当にサンプリングして音楽を構成するという点で画期的に新しかったと言われていて、なるほどと思いました。

90年代といえば、庵野エヴァンゲリオンが過去特撮の引用ばかりでもはや創作にオリジナリティは必要ないと言い、押井守攻殻機動隊の登場人物が小難しいことを言いあってるけどあれは裏で外部データベースを必死で検索しての引用合戦なんだ、と言われていたのを思い出します。

元曲のお気に入り部分以外は要らないから捨てるという発想はすがすがしい限りです。2000年代からの日常系萌四コマアニメへの進化に通ずるものがあると思います。

アマゾンがホール・フーズ・マーケット買収

新聞によりますと
www.nikkei.com

最近ホールフーズの売り上げが落ち目になってきて、店舗改革がプレミアム感を落としてうまくいっていないというニュースが出ていましたが、赤字になる前にアマゾンに見切り売りのようです。ショッピングモール形式が時代遅れになりつつあるようでアマゾン独り勝ちです。アマゾンはマーケットプレイス業者向けの金貸し事業も始めたようで、ゆりかごから墓場までアマゾンに支配されそうです。

そのうちアマゾンが CPU メーカーを買収して amazon Fortran が出る日も近い。数値は三割引きで表示とか。

むかしホールフーズマーケットで、伊藤園のペットボトルのお茶が健康食品として $2 で売られていて愛飲していましたが、米国向けはミニマルアート風のこじゃれた外装で、おーい!お茶などのダジャレた外装と対極をなしていました。

ホールフーズは、金持白人がプリウスBMW で乗り付ける意識高い系と馬鹿にされる店なので、アマゾンの19世紀的強盗資本主義のノリと合わないと思うのですが・・・

CAF と MPI 例題比較  その2

W. Gropp 等の Using MPI の例題を CAF で書き直してみるつもりが、二個目の例題で早くも大苦戦で苦笑。


CAF の sync によるバリアでは、任意の imeage を1個を待つことができないようで、manager-worker 型の処理に困りました。集団通信のように任意の順で来る全員を待つことはできるが、任意の一名が出頭すればよろしいとい形にはできないようです。(それとも何か理解を間違えているのか?w)

配列 A を coarray にして、worker 側から get 出来るようにすれば色々すっきりするので、元々こういう manager-worker 型の構造は取る必要はないのかもしれません。 

とりあえず仕方がないので、manager-worker 間の制御には atomic 変数による spin-wait loop を例題から借りてきて、worker 間の排他処理には lock を用いました。citical だと内部で sync が使えないようなので、lock を用いる必要がありました。

参考:J. Reid (2009), "Coarrays in Fortran 2008"
ftp://cuter.rl.ac.uk/pub/talks/jkr.pgas.7X09.pdf

CAF

例題では c = Axb を計算しています。manager に当たる image 1 がデータの配布と結果の回収をおこない、image 2 以降が積を計算します。データの回収と配布に2回の sync が必要になります。

ソースプログラム

まだごちゃごちゃしています。intelコンパイラのバグで debug モードでうまくいかないところがあるので回避しています。手抜きの為、MPI 版にあるプロセッサ数が行列次元より大きい場合の処理を省略しました。

    program CAF3_5
      use, intrinsic :: iso_fortran_env
      implicit none
      integer, parameter :: kd = kind(1.0d0)
      integer, parameter :: MAX_ROWS = 1000, MAX_COLS = 1000
      real(kd) :: a(MAX_ROWS, MAX_COLS), b(MAX_COLS)[*]
      real(kd) :: c(MAX_ROWS), buffer(MAX_COLS)[*], ans[*]
      integer :: rows, cols
      integer :: myid, numprocs
      integer :: i, j, numsent, cnt = 0
      integer :: row[*], no[*]

      logical(atomic_logical_kind) :: locked[*] = .true.
      logical :: val
      
      type(lock_type) :: list_lock[*]  

      myid     = this_image()
      numprocs = num_images()
      
!      manager = 1
      rows = 100
      cols = 100
      !
      ! Initialize A, b ; Broadcast b
      !
      if (myid == 1) then
        do j = 1, cols
          b(j) = 1
          do i = 1, rows
            a(i, j) = i 
          end do
        end do
        sync images(*) ! Broadcast b
        numsent = 0
      else
        sync images(1)  
        b(:) = b(:)[1]  
      end if
      !
      ! send initial data
      !
      if (myid == 1) then
        do i = 2, numprocs
          numsent = numsent + 1
          row[i] = numsent
!          buffer(:)[i] = a(numsent, :)  ! intel fortran v.18 bug in debug mode
          do j  = 1, rows
            buffer(j)[i] = a(numsent, j)  
          end do
          sync images (i)
        end do    
      else
        sync images (1)
      end if
      !
      ! main loop
      !
      do 
        if (myid == 1) then
          val = .true.   ! Spin-wait loop
          do while (val)
            call atomic_ref(val, locked)  
          end do    
          sync memory
          call atomic_define(locked, .true.)   
          ! receive data
          sync images(no)
          c(row) = ans  
          ! send new data
          numsent = numsent + 1
          row[no] = numsent
          if (numsent > rows) then 
            row[no] = 0
            cnt = cnt + 1
            if (cnt >= numprocs - 1) then 
                sync images (no)
                exit
            end if    
          end if  
!          buffer(:)[no] = a(numsent, :)  ! intel fortran v.18 bug in debug mode
          do j  = 1, rows
            buffer(j)[no] = a(numsent, j)  
          end do
          sync images(no)
        else
          if (row == 0) exit
          ans = dot_product(buffer, b)
          lock(list_lock[1])  
            ! send result
            no[1] = myid
            sync memory
            call atomic_define(locked[1], .false.) ! release image 1 from spin loop
            row[1] = row
            ans[1] = ans
            sync images (1) ! send result
            sync images (1) ! recv new data
          unlock(list_lock[1])  
        end if    
      end do    
      if (myid == 1) print *, c(:rows) 
      sync all
    end program CAF3_5
実行結果
   100.000000000000        200.000000000000        300.000000000000
   400.000000000000        500.000000000000        600.000000000000
   700.000000000000        800.000000000000        900.000000000000
   1000.00000000000        1100.00000000000        1200.00000000000
   1300.00000000000        1400.00000000000        1500.00000000000
   1600.00000000000        1700.00000000000        1800.00000000000
   1900.00000000000        2000.00000000000        2100.00000000000
   2200.00000000000        2300.00000000000        2400.00000000000
   2500.00000000000        2600.00000000000        2700.00000000000
   2800.00000000000        2900.00000000000        3000.00000000000
   3100.00000000000        3200.00000000000        3300.00000000000
   3400.00000000000        3500.00000000000        3600.00000000000
   3700.00000000000        3800.00000000000        3900.00000000000
   4000.00000000000        4100.00000000000        4200.00000000000
   4300.00000000000        4400.00000000000        4500.00000000000
   4600.00000000000        4700.00000000000        4800.00000000000
   4900.00000000000        5000.00000000000        5100.00000000000
   5200.00000000000        5300.00000000000        5400.00000000000
   5500.00000000000        5600.00000000000        5700.00000000000
   5800.00000000000        5900.00000000000        6000.00000000000
   6100.00000000000        6200.00000000000        6300.00000000000
   6400.00000000000        6500.00000000000        6600.00000000000
   6700.00000000000        6800.00000000000        6900.00000000000
   7000.00000000000        7100.00000000000        7200.00000000000
   7300.00000000000        7400.00000000000        7500.00000000000
   7600.00000000000        7700.00000000000        7800.00000000000
   7900.00000000000        8000.00000000000        8100.00000000000
   8200.00000000000        8300.00000000000        8400.00000000000
   8500.00000000000        8600.00000000000        8700.00000000000
   8800.00000000000        8900.00000000000        9000.00000000000
   9100.00000000000        9200.00000000000        9300.00000000000
   9400.00000000000        9500.00000000000        9600.00000000000
   9700.00000000000        9800.00000000000        9900.00000000000
   10000.0000000000
続行するには何かキーを押してください . . .

MPI Figs. 3-5, 3-6, 3-7 from W.Gropp et. al.

ソースプログラム
    program MPI3_5
      use mpi
      implicit none
      integer, parameter :: kd = kind(1.0d0)
      integer, parameter :: MAX_ROWS = 1000, MAX_COLS = 1000
      integer :: rows, cols
      real(kd) :: a(MAX_ROWS, MAX_COLS), b(MAX_COLS)
      real(kd) :: c(MAX_ROWS), buffer(MAX_COLS), ans
      
      integer :: myid, manager, numprocs, ierr, status(MPI_STATUS_SIZE)
      integer :: i, j, numsent, sender
      integer :: anstype, row
      
      call MPI_INIT(ierr)
      call MPI_COMM_RANK(MPI_COMM_WORLD, myid, ierr)
      call MPI_COMM_SIZE(MPI_COMM_WORLD, numprocs, ierr)
      manager = 0
      rows = 100
      cols = 100
      
      if (myid == manager) then
        do j = 1, cols
          b(j) = 1
          do i = 1, rows
            a(i, j) = i
          end do
        end do
        numsent = 0
        !
        call MPI_BCAST(b, cols, MPI_DOUBLE_PRECISION, manager, MPI_COMM_WORLD, ierr)
        !
        do i = 1, min(numprocs - 1, rows)
          do j = 1, cols
            buffer(j) = a(i, j)
          end do
          call MPI_SEND(buffer, cols, MPI_DOUBLE_PRECISION, i, i, MPI_COMM_WORLD, ierr)
          numsent = numsent + 1
        end do
        do i = 1, rows
          call MPI_RECV(ans, 1, MPI_DOUBLE_PRECISION, MPI_ANY_SOURCE, MPI_ANY_TAG, MPI_COMM_WORLD, status, ierr)
          sender  = status(MPI_SOURCE)
          anstype = status(MPI_TAG)
          c(anstype) = ans
          if (numsent < rows) then
            do j = 1, cols
              buffer(j) = a(numsent + 1, j)
            end do    
            call MPI_SEND(buffer, cols, MPI_DOUBLE_PRECISION, sender, numsent + 1, MPI_COMM_WORLD, ierr)
            numsent = numsent + 1
          else
            call MPI_SEND(MPI_BOTTOM, 0, MPI_DOUBLE_PRECISION, sender, 0, MPI_COMM_WORLD, ierr)  
          end if    
        end do  
      else
        call MPI_BCAST(b, cols, MPI_DOUBLE_PRECISION, manager, MPI_COMM_WORLD, ierr)
        if (myid <= rows) then
          do 
            call MPI_RECV(buffer, cols, MPI_DOUBLE_PRECISION, manager, MPI_ANY_TAG, MPI_COMM_WORLD, status, ierr)
            if (status(MPI_TAG) == 0) exit
            row = status(MPI_TAG)
            ans = 0.0_kd
            do i = 1, cols
              ans = ans + buffer(i) * b(i)
            end do  
            call MPI_SEND(ans, 1, MPI_DOUBLE_PRECISION, manager, row, MPI_COMM_WORLD, ierr)
          end do  
        end if  
      end if
      call MPI_FINALIZE(ierr)
      if (myid == 0) print *, c(:cols) 
    end program MPI3_5
実行結果
C:\Program Files (x86)\IntelSWTools>mpiexec -n 4 "C:\Users\O\Documents\Visual Studio 2015\Projects\MPI\Console2\x64\Debug\Console2.exe"
   100.000000000000        200.000000000000        300.000000000000
   400.000000000000        500.000000000000        600.000000000000
   700.000000000000        800.000000000000        900.000000000000
   1000.00000000000        1100.00000000000        1200.00000000000
   1300.00000000000        1400.00000000000        1500.00000000000
   1600.00000000000        1700.00000000000        1800.00000000000
   1900.00000000000        2000.00000000000        2100.00000000000
   2200.00000000000        2300.00000000000        2400.00000000000
   2500.00000000000        2600.00000000000        2700.00000000000
   2800.00000000000        2900.00000000000        3000.00000000000
   3100.00000000000        3200.00000000000        3300.00000000000
   3400.00000000000        3500.00000000000        3600.00000000000
   3700.00000000000        3800.00000000000        3900.00000000000
   4000.00000000000        4100.00000000000        4200.00000000000
   4300.00000000000        4400.00000000000        4500.00000000000
   4600.00000000000        4700.00000000000        4800.00000000000
   4900.00000000000        5000.00000000000        5100.00000000000
   5200.00000000000        5300.00000000000        5400.00000000000
   5500.00000000000        5600.00000000000        5700.00000000000
   5800.00000000000        5900.00000000000        6000.00000000000
   6100.00000000000        6200.00000000000        6300.00000000000
   6400.00000000000        6500.00000000000        6600.00000000000
   6700.00000000000        6800.00000000000        6900.00000000000
   7000.00000000000        7100.00000000000        7200.00000000000
   7300.00000000000        7400.00000000000        7500.00000000000
   7600.00000000000        7700.00000000000        7800.00000000000
   7900.00000000000        8000.00000000000        8100.00000000000
   8200.00000000000        8300.00000000000        8400.00000000000
   8500.00000000000        8600.00000000000        8700.00000000000
   8800.00000000000        8900.00000000000        9000.00000000000
   9100.00000000000        9200.00000000000        9300.00000000000
   9400.00000000000        9500.00000000000        9600.00000000000
   9700.00000000000        9800.00000000000        9900.00000000000
   10000.0000000000

 

CAF と MPI 例題比較

W. Gropp 等の Using MPI の最初の例題を CAF で書いて見ます。

つらつら本を読んでいますと、並列プログラミングの場合、1)通信、2)同期、3)排他を考えなければならないようです。通信がなければ単なる独立な実行と同じになります。通信する場合は順序(タイミング)が定まらねばなりませんが、順序が一意に確定していれば同期によって実現します。順序に任意性がある場合はさらに排他処理が必要になります。


プログラム

CAF の場合単方向通信なので、通信と同期が分離していて、明示的に同期を取らなければなりません。MPI の場合基本がブロッキング型の双方向通信なので、通信が暗黙に同期を含んでいます。

また Fortran 2008 の CAF の場合は集団通信用の命令がないため*1、ギャザー・スキャター型の、順序に任意性のある演算の場合、明示的に排他処理をしなければなりません。 MPI は沢山の集団通信用のルーチンを用意して、排他処理を明示的にしなくてよいようにしてあるようです。

CAF
    program CAF3_2
      implicit none
      integer, parameter :: kd = kind(1.0d0)
      real(kd), parameter :: pi_kd = 4 * atan(1.0_kd)
      real(kd) :: pi[*], mypi, h, sum, x, f, a
      integer :: n[*], i, me, ne
      !
      f(a) = 4.0_kd / (1.0_kd + a * a)
      !
      me = this_image()
      ne = num_images()
      do 
        ! Broadcast n  
        if (me == 1) then 
          print *, 'enter the number of intervals: (0 quits) '
          read *, n
          pi = 0.0_kd
          sync images(*)
        else
          sync images(1)
          n = n[1]
        end if
        if (n == 0) exit
        !
        h = 1.0_kd / n
        sum = 0.0_kd
        do i = me, n, ne
          x = h * (real(i, kd) - 0.5_kd)
          sum = sum + f(x)
        end do
        mypi = h * sum
        !
        ! reduction
        critical 
          pi[1] = pi[1] + mypi
        end critical
        sync all
        if (me == 1) then
          print *, 'pi is', pi, ' Error is', abs(pi - pi_kd)
        end if  
      end do
    end program CAF3_2
CAF 実行結果
 enter the number of intervals: (0 quits)
10
 pi is   3.14242598500110       Error is  8.333314113051493E-004
 enter the number of intervals: (0 quits)
100
 pi is   3.14160098692312       Error is  8.333333331833614E-006
 enter the number of intervals: (0 quits)
1000
 pi is   3.14159273692313       Error is  8.333333401111531E-008
 enter the number of intervals: (0 quits)
10000
 pi is   3.14159265442313       Error is  8.333342904620622E-010
 enter the number of intervals: (0 quits)
0
MPI
    program mpi3_2
      use mpi
      implicit none
      integer, parameter :: kd = kind(0.0d0)
      real(kd), parameter :: pi25dt = 3.141592653589793238462643_kd
      real(kd) :: mypi, pi, h, sum, x, f, a
      integer :: i, n, ierr, myid, numprocs
      ! statement function
      f(a) = 4.0_kd / (1.0_kd + a * a)
      !
      call MPI_INIT(ierr)
      call MPI_COMM_RANK(MPI_COMM_WORLD, myid, ierr)
      call MPI_COMM_SIZE(MPI_COMM_WORLD, numprocs, ierr)      
      do 
        if (myid == 0) then
          print *, 'Enter the number of intervals: (0 quits) '
          read  *, n
        end if    
      ! broadcast n
        call MPI_BCAST(n, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
      !
        if (n == 0) exit
      !
        h = 1.0_kd / n
        sum = 0.0_kd
        do i = myid + 1, n, numprocs
          x = h * (real(i, kd) - 0.5_kd) 
          sum = sum + f(x)
        end do  
        mypi = h * sum
      !  collect all the partial sums  
        call MPI_REDUCE(mypi, pi, 1, MPI_DOUBLE_PRECISION, MPI_SUM, 0, MPI_COMM_WORLD, ierr)
      !
        if (myid == 0) then
          print *, 'pi is ', pi, ' Error is', abs(pi - pi25dt)
        end if
      end do  
      call MPI_FINALIZE(ierr)
    end program mpi3_2
MPI 実行結果
C:\Users\O\Documents\Visual Studio 2015\Projects\MPI\MPI\x64\Debug>mpiexec -n 4 mpi.exe
 Enter the number of intervals: (0 quits)
10
 pi is    3.14242598500110       Error is  8.333314113051493E-004
 Enter the number of intervals: (0 quits)
100
 pi is    3.14160098692312       Error is  8.333333331833614E-006
 Enter the number of intervals: (0 quits)
1000
 pi is    3.14159273692313       Error is  8.333333312293689E-008
 Enter the number of intervals: (0 quits)
10000
 pi is    3.14159265442312       Error is  8.333307377483834E-010
 Enter the number of intervals: (0 quits)
0

*1:Fortran 2015 で導入予定です。

CAF の勉強

Fortran 2008 で導入された CAF (CoArray Fortran) 関係の命令を少し勉強したので、まとめをメモしておきます。coarray は PGAS 言語に分類される並列プログラミング用の仕組みです。ここで扱うのは Fortran 2008 の範囲で、Fortran 2015 で拡張される予定の部分については扱いません。勉強中なので間違っていたらゴメン!


コードを適切にセグメントに分けると、その部分集合 {Pi} はシリアル実行なら全順序集合としての構造を持つ。

CAF による並列実行の時、各イメージが独立も実行され相互にやり取りをしないなら、それぞれが全順序集合のコードセグメント {Pi}, {Qi}, {Ri}・・・ のように分かれる。各イメージごとに、CoArray を通じたデータのやり取りをする場合、データの読み込み・書き込みは排他的に順序づけて行なわなければならない。つまりコードセグメント間に順序関係を考えねばならない。

異なるイメージのコードセグメント間に順序関係を考えるとき、コードセグメント全体としては、半順序の構造をもつ。CAF でのデータのやり取りは、順序が定義されているコードセグメント間でしか許されない。(半順序なので、任意の二つのコードセグメント (Pi, Qj) を取り出したとき、この二つに順序が定義されているとは限らない。

CAF でコードセグメント間に順序を定義するときは、sync 命令を用いる。

一つのコードセグメントが複数のコードセグメントとデータをやり取りする時、データをやり取りする二つのコードセグメント間に順序関係が定義されても、データを直接やり取りしないコードセグメント間には順序が定義されていない。この場合、これらの間の順序は任意であるので、順序に依らずにデータ読み書きの排他性を保つ必要がある。この目的で critical..end critical、lock..unlock、atomic の三つの命令がある。

critical と lock はコード実行に関する排他性を保証する機能であり、atomic はデータへのアクセスの排他性を保証する機能である。critical は全イメージがブロッキング型で排他実行される。lock はより詳細に排他実行されるイメージを制御でき、ノンブロッキング型の排他実行も可能である。atomic 命令は、変数へのアクセスを排他的に行うための命令群であり、ノンブロッキング型の排他実行になっている。


d.hatena.ne.jp

critical no flag blocking random order
lock lock_type blocking random order
lock+acquired lock_type+logical non-blocking random order
atom atomic_logical_kind/atomic_int_kind non-blocking user-specified order

プログラム例

独立なイメージの実行 (イメージ間の順序構造なし)

ソース・プログラム
    program CAF00
      implicit none
      print *, 'Hello from', this_image(), 'out of', num_images(), 'images.' 
    end program CAF00
実行結果
 Hello from           3 out of           8 images.
 Hello from           6 out of           8 images.
 Hello from           8 out of           8 images.
 Hello from           1 out of           8 images.
 Hello from           7 out of           8 images.
 Hello from           2 out of           8 images.
 Hello from           5 out of           8 images.
 Hello from           4 out of           8 images.
続行するには何かキーを押してください . . .

イメージの実行 (環状の順序構造: 切れ目が必要)

ソース・プログラム
    program CAF04
      implicit none
      integer :: m[*], itmp[*]
      integer :: i, n, k
      n = num_images()
      i = this_image()
      m = i
      itmp = m
      print *, i, m
      sync all
      
      k = i - 1
      if (k == 0) k = n
      m[k] = itmp

      if (i == 1) print *
      sync all
      print *, i, m
    end program CAF04
実行結果
 3 3
 1 1
 2 2
 4 4

 3 4
 1 2
 2 3
 4 1
続行するには何かキーを押してください . . .

順序を完全な円環にすると、身動きが取れなくなるので、切れ目を入れて直線と端点処理にしている。
f:id:fortran66:20170603215639p:plain

Critical による排他実行

ソース・プログラム
    program CAF05
      implicit none
      integer :: me, ni
      integer :: k[*] = 1
      integer :: p(4)[*] 
      
      me = this_image()
      ni = num_images()
      sync all

      critical
        p(k[1])[1] = me
        k[1] = k[1] + 1
      end critical    
      
      sync all
      if (me == 1) print *, p
    end program CAF05
実行結果
           1           3           4           2
続行するには何かキーを押してください . . .

lock による排他実行

ソース・プログラム
    program CAF08
      use, intrinsic :: iso_fortran_env, only : lock_type
      implicit none
      type(lock_type) :: list_lock[*]  
      integer :: i, p[*] = 0
      p = this_image()
      sync all
      if (this_image() == 1) then
        do i = 2, num_images()
           lock(list_lock[1])
             p[1] = p[1] + p[i]
           unlock(list_lock[1])
        end do
        print *, this_image(), num_images(), p
      end if
    end program CAF08    
実行結果
           1          10          55
続行するには何かキーを押してください . . .

atomic による変数への排他アクセス

ソース・プログラム
  program CAF10
    use, intrinsic :: iso_fortran_env
    implicit none
    logical(atomic_logical_kind) :: locked[*] = .true.
    logical :: val
    integer :: me, p = 1, q = 2, i = 0
    me = this_image()
    if (me == p) then
      sync memory
      call atomic_define(locked[q],.false.)
    else if (me == q) then
      val = .true.
      do while (val)
        i = i + 1  
        call atomic_ref(val,locked)
      end do
      sync memory
    end if
    print *, me , i
  end program CAF10    
実行結果
           1           0
           2         188
続行するには何かキーを押してください . . .

イメージ1が初めに lock に排他的にアクセスしているあいだ、イメージ2は実行可能になるまで、188回ループを回って順番を待っている。(ノンブロッキング実行のため待たされることは無い)