少数のユーザーが小さいターミナルウィンドウを使用しているという理由で、80カラムの幅に収められたソースコードのパッチを送ってくるが、正直なところ、このパッチは読みにくい。
ソースコード1行当たりの長さを80文字に制限するコーディング規則は、多くのプロジェクトで見られる。Linuxカーネルがソースコード1行当たりの文字数を引き上げた場合、ほかのプロジェクトも同様の動きを見せる可能性がある。
世界のどこかで緑文字の 80x25 端末で頑張っているみどりのおじさんが私たちを見守ってくれている！
交通誘導をする緑のおじさんのイラスト素材 [63306629] - PIXTA
追記：R3.3.30 文法チェックには引っかかりませんが、さりとてオプションとしては機能していない感じです。default(none) のチェックも効かず、local も効いてない。
do concurrent ではスレッド並列の並列実行がなされるので、do loop 内の変数のスレッド独立性の問題が出ます。F2008 では block..end block を利用してスレッド独立な変数を局所的に宣言する方法が用意されていましたが、F2018 では OpenMP の影響でしょうか、do concurrent 文の後ろに新たに修飾子が加わって、局所性や値の引継ぎなどが制御できるようになりました。Intel Fortran v.19.1 で実行できるようなので試してみます。
Locality of variables in DO CONCURRENT constructs can now be declared on the DO CONCURRENT statement
help file より
You can specify LOCAL, LOCAL_INIT, SHARED, and DEFAULT (NONE) in the same DO CONCURRENT statement.
コンパイル時のオプションで並列化を on/off することで do concurrent の効果をみてみます。計算量が少ないのであまり大きな差は出ていませんが、約二倍のスピードが出ています。(600 vs 300; 単位はシステムクロックのティック数の差だった気がします。)
並列なし
do concurrent time = 4.687500000000000E-002 600
並列あり
do concurrent time = 0.187500000000000 300
昔作ったプログラムを修正してみます。 ほとんど覚えていないのですが、メモリーリークしているかもしれません。マルチスレッドにすることで win32 で絵をかきつつプログラムの実行を続けていました。その辺よく分かっていないので非推奨 API を使っています。いまは coarray や OpenMP で行けるかもしれません。
64bit windows で動くようにしました。block...end block によりお絵かき部分を分離しました。
計算の胆部分。ループ変数は do concurrent 内で局所宣言します。
call system_clock(it0) call cpu_time(t0) do concurrent (integer::ix = 0:imax, iy = 0:jmax) local(x, y) x = xmin + ix * dx y = ymax - iy * dy ic(ix, iy) = imandel(x, y) end do call cpu_time(t1) call system_clock(it1) print *, ' do concurrent time =', t1 - t0, it1 - it0
module m_oop implicit none type :: t_rgb integer :: ir, ig, ib end type t_rgb type, abstract :: t_device character(len = 80) :: title = 'Plotter' integer :: nsize_x = 640, nsize_y = 480 integer :: line_width = 1 type (t_rgb) :: rgb = t_rgb(0, 0, 0) contains procedure (device_on), deferred, pass :: on procedure (device_off), deferred, pass :: off procedure (device_show), deferred, pass :: show procedure (device_pen), deferred, pass :: pen procedure (device_lineTo), deferred, pass :: lineTo procedure (device_moveTo), deferred, pass :: moveTo procedure (device_dot), deferred, pass :: dot end type t_device abstract interface subroutine device_on(self) import :: t_device class(t_device), intent(in out) :: self end subroutine device_on subroutine device_off(self) import :: t_device class(t_device), intent(in) :: self end subroutine device_off subroutine device_show(self) import :: t_device class(t_device), intent(in) :: self end subroutine device_show subroutine device_pen(self, line_width, rgb) import :: t_device, t_rgb class(t_device), intent(in out) :: self integer, intent(in), optional :: line_width type (t_rgb), intent(in), optional :: rgb end subroutine device_pen subroutine device_lineTo(self, ix, iy) import :: t_device class(t_device), intent(in) :: self integer, intent(in) :: ix, iy end subroutine device_lineTo subroutine device_moveTo(self, ix, iy) import :: t_device class(t_device), intent(in) :: self integer, intent(in) :: ix, iy end subroutine device_moveTo subroutine device_dot(self, ix, iy, icol) import :: t_device, t_rgb class(t_device), intent(in) :: self integer, intent(in) :: ix, iy integer, intent(in) :: icol ! type (t_rgb), intent(in) :: rgb end subroutine device_dot end interface end module m_oop module m_win32 use ifwina use ifwinty use ifmt, only : RTL_CRITICAL_SECTION use m_oop implicit none type, extends(t_device) :: t_win32 contains procedure, pass :: on => gr_on procedure, pass :: off => gr_off procedure, pass :: show => gr_show procedure, pass :: pen => gr_pen procedure, pass :: lineTo => gr_lineTo procedure, pass :: moveTo => gr_moveTo procedure, pass :: dot => gr_dot end type t_win32 type :: t_wnd integer (HANDLE) :: hWnd integer (HANDLE) :: hDC integer (LPINT) :: hThread integer (LPDWORD):: id integer (HANDLE) :: hPen type (RTL_CRITICAL_SECTION) :: lpCriticalSection end type t_wnd type (t_wnd) :: wnd contains integer(HANDLE) function WinMain( hInstance, nCmdShow, win32 ) implicit none integer (HANDLE), intent(in) :: hInstance integer (SINT) , intent(in) :: nCmdShow type (t_win32), intent(in) :: win32 type (T_WNDCLASS) :: wc type (T_MSG) :: mesg integer (HANDLE) :: hWndMain integer (BOOL) :: iretb character (LEN = 256) :: ClassName = 'Fortran'//char(0) integer :: iwindow_frame_x, iwindow_frame_y logical, save :: first = .true. ! Init Main window iwindow_frame_x = 2 * GetSystemMetrics(SM_CXFIXEDFRAME) !side line = 6, title bar = 25 iwindow_frame_y = 2 * GetSystemMetrics(SM_CYFIXEDFRAME) + GetSystemMetrics(SM_CYCAPTION) ! if (first) then WinMain = -1 ! Error code wc%lpszClassName = loc(ClassName) ! non-standard Fortran :: LOC(xxx) = TRANSFER(C_LOC(xxx), iii) wc%lpfnWndProc = loc(MainWndProc) ! CALLBACK procedure name wc%style = ior(CS_VREDRAW , CS_HREDRAW) wc%hInstance = hInstance wc%hIcon = NULL wc%hCursor = LoadCursor( NULL, IDC_ARROW ) wc%hbrBackground = ( COLOR_WINDOW + 1 ) if ( RegisterClass(wc) == 0 ) return ! initialize window first = .false. end if ! Init instance WinMain = -2 ! Error code hWndMain = CreateWindow( ClassName, & trim(win32%title)//char(0), & int(ior(WS_OVERLAPPED, WS_SYSMENU)), & CW_USEDEFAULT, CW_USEDEFAULT, & win32%nsize_x + iwindow_frame_x, & win32%nsize_y + iwindow_frame_y, & 0, 0, & hInstance, & NULL ) if (hWndMain == 0) return iretb = ShowWindow( hWndMain, nCmdShow ) iretb = UpdateWindow( hWndMain ) ! Message Loop do while ( GetMessage (mesg, NULL, 0, 0) ) iretb = TranslateMessage( mesg ) iretb = DispatchMessage( mesg ) end do WinMain = mesg%wParam end function WinMain integer (LRESULT) function MainWndProc( hWnd, mesg, wParam, lParam ) !DEC$ ATTRIBUTES STDcall, DECORATE, ALIAS : 'MainWndProc' :: MainWndProc integer (HANDLE) , intent(in) :: hWnd integer (UINT) , intent(in) :: mesg integer (fwParam), intent(in) :: wParam integer (flParam), intent(in) :: lParam ! integer (HANDLE) :: hDC, hBmp integer (BOOL) :: iretb type (T_PAINTSTRUCT) :: ps type (T_RECT) :: rc ! MainWndProc = 0 select case ( mesg ) case (WM_CREATE) wnd%hWnd = hWnd hDC = GetDC(hWnd) wnd%hDC = CreateCompatibleDC(hDC) iretb = GetClientRect(hWnd, rc) hBmp = CreateCompatibleBitmap(hDC, rc%right - rc%left, rc%bottom - rc%top) iretb = SelectObject(wnd%hDC, hBmp) iretb = PatBlt(wnd%hDC, 0, 0, rc%right - rc%left, rc%bottom - rc%top, WHITENESS) iretb = ReleaseDC(hWnd, hDC) iretb = DeleteObject(hBmp) case (WM_DESTROY) call EnterCriticalSection( loc(wnd%lpCriticalSection) ) iretb = DeleteObject( wnd%hDC ) call PostQuitMessage( 0 ) call LeaveCriticalSection( loc(wnd%lpCriticalSection) ) case (WM_PAINT) call EnterCriticalSection( loc(wnd%lpCriticalSection) ) hDC = BeginPaint( wnd%hWnd, ps ) iretb = GetClientRect( wnd%hWnd, rc ) iretb = BitBlt(hDC, 0, 0, rc%right - rc%left, rc%bottom - rc%top, wnd%hDC, 0, 0, SRCCOPY) iretb = endPaint( wnd%hWnd, ps ) call LeaveCriticalSection( loc(wnd%lpCriticalSection) ) case (WM_RBUTTONUP) call EnterCriticalSection( loc(wnd%lpCriticalSection) ) iretb = DeleteObject( wnd%hDC ) call PostQuitMessage( 0 ) call LeaveCriticalSection( loc(wnd%lpCriticalSection) ) case default MainWndProc = DefWindowProc( hWnd, mesg, wParam, lParam ) end select end function MainWndProc subroutine gr_on(self) use IFMT, only : CreateThread ! multithread module class(t_win32), intent(in out) :: self integer (BOOL) :: iretb integer (HANDLE) :: hBmp type (T_RECT) :: rc call InitializeCriticalSection( loc(wnd%lpCriticalSection) ) ! non-standard Fortran :: LOC wnd%hThread = CreateThread(NULL, 0_LPINT, Thread_Proc, NULL, CREATE_SUSPENDED, wnd%id) iretb = SetThreadPriority(wnd%hThread, THREAD_PRIORITY_BELOW_NORMAL) iretb = ResumeThread(wnd%hThread) call sleep(100) ! wait for Window initialization iretb = GetClientRect(wnd%hWnd, rc) hBmp = CreateCompatibleBitmap(wnd%hDC, rc%right - rc%left, rc%bottom - rc%top) iretb = SelectObject(wnd%hDC, hBmp) iretb = DeleteObject(hBmp) iretb = PatBlt(wnd%hDC, 0, 0, rc%right - rc%left, rc%bottom - rc%top, WHITENESS) wnd%hPen = CreatePen(PS_SOLID, 1, 0) contains integer (LONG) function Thread_Proc(lp_ThreadParameter) ! !DEC$ ATTRIBUTES STDcall, ALIAS:"_thread_proc" :: Thread_Proc integer (LPINT), intent(in) :: lp_ThreadParameter integer (LPINT):: hInst hInst = GetModuleHandle(NULL) Thread_Proc = WinMain(hInst, SW_SHOWNORMAL, self) end function Thread_Proc end subroutine gr_on subroutine gr_off(self) class(t_win32), intent(in) :: self integer (BOOL) :: iretb integer (DWORD) :: iwait iwait = INFINITE call gr_show(self) iretb = DeleteObject(wnd%hPen) iretb = WaitForSingleObject(wnd%hThread, iwait) iretb = CloseHandle(wnd%hThread) iretb = PostMessage(wnd%hWnd, WM_DESTROY, NULL, NULL) wnd%hThread = NULL call DeleteCriticalSection( loc(wnd%lpCriticalSection) ) ! non-standard Fortran :: LOC end subroutine gr_off subroutine gr_show(self) class(t_win32), intent(in) :: self integer (BOOL):: iretb call EnterCriticalSection( loc(wnd%lpCriticalSection) ) ! non-standard Fortran :: LOC iretb = InvalidateRect(wnd%hWnd, NULL, FALSE) call LeaveCriticalSection( loc(wnd%lpCriticalSection) ) ! non-standard Fortran :: LOC end subroutine gr_show subroutine gr_pen(self, line_width, rgb) class(t_win32), intent(in out) :: self integer, intent(in), optional :: line_width type (t_rgb), intent(in), optional :: rgb integer (BOOL) :: iretb associate( rgb_ => self%rgb, line_width_ => self%line_width ) if ( present(rgb) ) rgb_ = rgb if ( present(line_width) ) line_width_ = line_width call EnterCriticalSection( loc(wnd%lpCriticalSection) ) ! non-standard Fortran :: LOC iretb = DeleteObject(wnd%hPen) wnd%hPen = CreatePen(PS_SOLID, line_width_, irgb(rgb_)) iretb = SelectObject(wnd%hDC, wnd%hPen) iretb = MoveToEx(wnd%hDC, 0, 0, NULL) call LeaveCriticalSection( loc(wnd%lpCriticalSection) ) ! non-standard Fortran :: LOC end associate contains integer function irgb(rgb) type(t_rgb), intent(in) :: rgb irgb = rgb%ir + (rgb%ig + (rgb%ib * 256)) * 256 end function irgb end subroutine gr_pen subroutine gr_moveTo(self, ix, iy) class(t_win32), intent(in) :: self integer, intent(in) :: ix, iy integer (BOOL):: iretb call EnterCriticalSection( loc(wnd%lpCriticalSection) ) ! non-standard Fortran :: LOC iretb = MoveToEx(wnd%hDC, ix, iy, NULL) call LeaveCriticalSection( loc(wnd%lpCriticalSection) ) ! non-standard Fortran :: LOC end subroutine gr_moveTo subroutine gr_lineTo(self, ix, iy) class(t_win32), intent(in) :: self integer, intent(in) :: ix, iy integer (BOOL):: iretb call EnterCriticalSection( loc(wnd%lpCriticalSection) ) ! non-standard Fortran :: LOC iretb = LineTo(wnd%hDC, ix, iy) call LeaveCriticalSection( loc(wnd%lpCriticalSection) ) ! non-standard Fortran :: LOC end subroutine gr_lineTo subroutine gr_dot(self, ix, iy, icol) class(t_win32), intent(in) :: self integer, intent(in) :: ix, iy, icol integer (BOOL):: iretb call EnterCriticalSection( loc(wnd%lpCriticalSection) ) ! non-standard Fortran :: LOC iretb = SetPixel(wnd%hDC, ix, iy, icol) call LeaveCriticalSection( loc(wnd%lpCriticalSection) ) ! non-standard Fortran :: LOC end subroutine gr_dot end module m_win32 module m_plot use m_oop use m_win32 implicit none private public :: t_rgb, t_device, t_win32 end module m_plot module m_mandel implicit none integer, parameter :: kd = kind(0.0d0) contains pure elemental integer function imandel(x, y) real(kd), intent(in) :: x, y real(kd) :: a, b, a2, b2 integer :: icount a = x b = y a2 = a * a b2 = b * b icount = 150 !maxiter do while (a2 + b2 <= 4.0_kd .AND. icount > 0) b = 2.0_kd * a * b - y a = a2 - b2 - x a2 = a * a b2 = b * b icount = icount - 1 end do imandel = icount end function imandel end module m_mandel program Mandel use m_mandel implicit none !integer, parameter :: kd = SELECTED_REAL_KIND(15) integer, parameter :: m = 1000 integer :: nwinx = 1024, nwiny = 1024 integer :: i, j, imax, jmax, maxiter, icount real (kd) :: xmin, xmax, ymin, ymax real (kd) :: xmin1, xmax1, ymin1, ymax1 real (kd) :: x, y, a, b, a2, b2, dx, dy real (kd) :: t0, t1 integer, allocatable :: ic(:, :) integer :: icol(0:m), it0, it1 ! xmin = -2.0d0 !1.10950d0 xmax = 2.0d0 !1.10951d0 ymin = -2.0d0 !0.24758d0 ymax = 2.0d0 !0.24759d0 maxiter = 252 ! dx = xmax - xmin dy = ymax - ymin if (dx <= 0.0_kd .OR. dy <= 0.0_kd .OR. maxiter <= 0 .OR. maxiter > M) stop 'input error' if (dx * nwinx > dy * nwiny) then imax = nwinx jmax = nint(nwinx * dy / dx) else imax = nint(nwiny * dx / dy) jmax = int(nwiny) end if ! dx = dx / real(imax, kd) dy = dy / real(jmax, kd) icol(0) = 0 ! black j = irgb(255, 255, 255) do i = maxiter, 1, -1 icol(i) = j if (j > 1) j = j - irgb(255, 255, 255) / maxiter end do ! allocate( ic(0:imax, 0:jmax) ) ! call system_clock(it0) call cpu_time(t0) do concurrent (integer::ix = 0:imax, iy = 0:jmax) local(x, y) x = xmin + ix * dx y = ymax - iy * dy ic(ix, iy) = imandel(x, y) end do call cpu_time(t1) call system_clock(it1) print *, ' do concurrent time =', t1 - t0, it1 - it0 ! ! plotter ! block use m_plot class(t_device), allocatable :: fig type(t_rgb), parameter :: rgb_black = t_rgb(0, 0, 0) fig = t_win32('Mandelbrot 1', imax, jmax, 1, rgb_black) call fig%on() do i = 0, imax do j = 0, jmax call fig%dot(i, j, icol(ic(i, j))) end do call fig%show() end do call fig%off() end block contains integer function irgb(ir, ig, ib) integer, intent(in) :: ir, ig, ib irgb = ir + (ig + (ib * 256)) * 256 end function irgb end program Mandel
数値計算のためのFortran90/95プログラミング入門(第2版)
intel fortran ではまだですが、gfortran の場合 OpenCoarray で team 機能の一部が試せます。Team を使うと coarray のイメージをいくつかの群れに分けて、別々のタスクに従事させことが容易になります。
参考：J. Reid, The new features of Fortran 2018 https://www.fortranplus.co.uk/app/download/29753373/N2161.pdf
sourceryinstitute, OpenCoarray github.com
以下の記事を参考にお任せコースで行きます。 www.scivision.dev
sudo apt install gfortran libcoarrays-dev libcoarrays-openmpi-dev
しかし、この場合 openmpi を利用するので、openmpi 固有のめんどくささが生じて、記事通りにゆきません。FAQ を見る必要があります。
コンパイル時のライブラリ名を caf_openmpi にする必要があります。また CAFRUN 用の設定が面倒なので mpirun を利用することにします。
gfortran -fcoarray=lib xxxxxf90 -lcaf_openmpi mpirun -np 9 --oversubscribe ./a.out
よく分からないので、サンプルを元に、二種類のチーム分けを試してみました。それぞれフォーメーション１と２ です。フォーメーション１では、イメージ番号の３による剰余での分け方で、２では４で割った商でチーム分けしました。
program caf0 use, intrinsic :: iso_fortran_env implicit none real :: arr[*] integer :: me, ne type(team_type) :: form1, form2 ne = num_images() me = this_image() form team (mod(me, 3) + 1, form1) if (me == 1) print *, 'formation 1' change team (form1) sync team (form1) select case(team_number()) case (1) print *, 'a-team', me, ne case (2) print *, 'b-team', me, ne case (3) print *, 'c-team', me, ne case default stop 'never come here' end select sync team (form1) end team form team (me / 4 + 1, form2) sync all if (me == 1) print *, 'formation 2' sync all change team (form2) select case(team_number()) case (1) print *, 'team 1', me, ne case (2) print *, 'team 2', me, ne case (3) print *, 'team 3', me, ne case default stop 'never come here' end select end team end program caf0
$ gfortran -fcoarray=lib team.f90 -lcaf_openmpi $ mpirun -np 9 --oversubscribe ./a.out formation 1 c-team 5 9 c-team 8 9 c-team 2 9 a-team 6 9 a-team 9 9 a-team 3 9 b-team 7 9 b-team 4 9 b-team 1 9 formation 2 team 1 2 9 team 1 3 9 team 2 5 9 team 2 6 9 team 1 1 9 team 3 8 9 team 3 9 9 team 2 7 9 team 2 4 9
IP が完全に別物になって public network に引っかかるようになっています。
.bashrc に書き込んでいた
export DISPLAY=:0.0
を書き換えます。
export DISPLAY=$(cat /etc/resolv.conf | grep nameserver | awk '{print $2}'):0
参考サイト：
Windows Firewall 設定をいじります。 管理者権限の powershell で（コマンドプロンプト不可）以下のように打ち込みます。
Set-NetFirewallProfile -DisabledInterfaceAliases "vEthernet (WSL)"
firewall は、何か警告を表示します。
参考サイト：
Cray の chapel 言語ですが、2.0 に向けて index を 1 始まりから 0 始まりに変更しようとしているようです。
• One key Chapel 2.0 focus area related to changing from 1- to 0-based indexing
裏切りです！連盟よさらば！WHO脱退！
最近オンライン集会があったようですが、スライドを斜め見た感じでは色々とわりといい感じになっているようです。Julia 言語対策でしょうか Python との連携の容易化も図っているようです。
NHK 第二放送の漢詩を読むがコロナにちなんで三国志演義の所を途中でやめて第七、八回の代わりに、第一、二回を放送してたのですが、何故か今週は第九回に飛んでしまいました。意味不明です。
先々週くらいに金星が高度を落としておりましたが、最近は西空によく見えません。どうも内合が近いらしいので、明け方の方へ移るようです。
少し前に月の地球照が綺麗でした。太陽黒点も一か月連続で出なかったようで、氷河期に向かって頑張って欲しいところです。
いつの間にか windows が 2020-may 版に update されており、また VMware Workstation 15.5 が出て Hyper-V に対応したようなので、WSL-2 へ移行してみました。Hyper-V 有効化などののち VMware を更新、転換へ。転換はウイルスチェッカーが働いて死ぬほど時間がかかりましたが無事終了できました。
また新たに Ubuntu 20.04 も落としてきて WSL-2 変換しました。Ubuntu 20.04 だと apt install gfortran で gfortran-9 がインストールされ gfortran-10 も普通に apt install でインストールできました。
block 構文でも import 命令が使えるようなので（今のところ Intel Fortran だけで gfortran-10 はまだだめ）、import 文を使って block 内の局所変数と外側の変数のアクセス・コントロールが制御できないか試してみましたが、本来の想定の外なのでイマイチな感じでした。
default では外側の変数はいわば global 変数として自由に読み書きアクセスできます。block 内で宣言した変数は、同名のばあい優先され外側を覆い隠し (shadowing) し、外側の同名の変数にアクセスする手段を失います。
import, none を付けると外側の変数すべてが読み書きアクセス不能になります。一部だけアクセスしたり、別名を付けたりすることも不可能になります。import,all は default 時と同じ読み書きアクセス可能になりますので意味がありません。import, none と import,only : の組み合わせも許されていません。
program Console1 implicit none real :: x = 1.0 integer :: i = 2.0 block ! import, none ! import, only : i real :: x = 3.0 print *, x i = 3 print *, i end block print *, x, i end program Console1
3.000000
3
1.000000 3
なお ALGOL様のミニ言語における block 構造内での変数へのアクセスコントロールは、1970年代にダイクストラがプログラミング原論で論じています。
プログラミング原論―いかにしてプログラムをつくるか (サイエンスライブラリ―情報電算機)
Dr. Fortran こと Steve Lionel 氏の最新ブログ記事が面白かったです。OPEN 文は CLOSE せずに複数回適用出来て、それによって種々のオプションを更新できるようです。この挙動は知らなかったですｗ
delimiter 指定で文字列を ' ' や " " でくるんでおくと、＊で読み込むときに単語間切れ目の空白に煩わされなくて済みます。
だいたい JOB CARD でファイルをファイル番号と結びつけることがい多かったので、OPEN 文はなるたけ使わない派ｗ
The Cyber Vanguard さんのサイトにある modern fortran 講座の zeroMQ 利用の HTTP サーバーで、OpenMP の sections 機能を利用した並列実行で一人センド＝レシーブやっています。
Fortran の並列実行はデータパラレル指向で、他言語のタスクパラレル指向と別ですが、OpenMP が準標準化しているからタスクパラレルするためにそれを使うのもありかもです。Coarray の team なら標準規格の範囲内でタスクパラレルできますが、まだほとんどの処理系で実装されていない･･･ まぁ本義を離れれば今のままでも image 毎に勝手なこともできるけど。
