fortran66のブログ

fortran について書きます。

【メモ帳】forpy で Fortran から matplotlib  

Fortran からの作図

forpy を使って、サンプルを元に matplotlib を呼び出します。キーワード変数などの使い方を学びます。
github.com

実行例

べき乗のグラフを片対数のグラフにプロットします。
f:id:fortran66:20180902020931p:plain

ifort -fpp matplot.f90 forpy_mod.obj c:\IntelPython3\Libs\python36.lib

参考ページ: matplotlib の引数

matplotlib.pyplot.grid — Matplotlib 2.2.3 documentation

プログラム

作図は、メインルーチンの最後に、block...end block 構造の中に閉じ込めることで、スッキリできます。

program matplot
    implicit none
    real, parameter :: pi = 4 * atan(1.0)
    real, allocatable :: x(:), y(:)
    integer :: i, n
    
    n = 20
    x = [( 0.1 * i, i = 1, n)]
    y = 10.0**x
    
    block 
        use forpy_mod
        integer :: ierr
        type(module_py) :: plt
        type(tuple) :: args, arg1, arg2    
        type(ndarray) :: x_nd, y_nd
        type(dict) :: kwargs
!forpy        
        ierr = forpy_initialize()
        if (ierr == NO_NUMPY_ERROR) stop 'numpy not found!'
        if (ierr /= 0) stop 'forpy initialization error!'
!matplotlib        
        ierr = import_py(plt, 'matplotlib.pyplot')
        if (exception_matches(ImportError)) stop 'matplotlib not found!'
!main         
        ierr = ndarray_create(x_nd, x)
        ierr = ndarray_create(y_nd, y)
!  y-axis Log        
        ierr = tuple_create(arg1, 1)
        ierr = arg1%setitem(0, "log")
        ierr = call_py_noret(plt, 'yscale', arg1)
        call arg1%destroy()
!  Title        
        ierr = tuple_create(arg1, 1)
        ierr = arg1%setitem(0, "Log plot")
        ierr = call_py_noret(plt, 'title', arg1)
!  Grid x & y-axes (dasehed line)         
        ierr = tuple_create(args, 3)
        ierr = args%setitem(0, .true.)
        ierr = args%setitem(1, "both")
        ierr = args%setitem(2, "both")
        ierr = dict_create(kwargs)
        ierr = kwargs%setitem("linestyle", 'dashed')
        ierr = call_py_noret(plt, 'grid', args, kwargs)
!  set x, y data        
        ierr = tuple_create(arg2, 2)
        ierr = arg2%setitem(0, x_nd)
        ierr = arg2%setitem(1, y_nd)
!  plot         
        ierr = call_py_noret(plt, 'plot', arg2)
        ierr = call_py_noret(plt, 'show')
!clean up        
        call x_nd%destroy()
        call y_nd%destroy()
        call arg1%destroy()
        call arg2%destroy()
        call args%destroy()
        call kwargs%destroy()
        call plt%destroy()
! forpy finalize       
        call forpy_finalize()
    end block
end program matplot

素のままでは、tuple や list や dict を用意するのがめんどくさいので、先日作ったような tuple, list 生成関数を用意して用いるのが好ましいかと思います。

それにつけても、ブラウザに作図する WebAgg サーバーが ctrl-C で中々終了しないのでイライラします。

蛇マジむかつく!

追記 destroy 処理問題を気にしない場合

実行結果

f:id:fortran66:20180902142102p:plain

プログラム

メインルーチン
    program matplot
    implicit none
    real, parameter :: pi = 4 * atan(1.0)
    real, allocatable :: x(:), y(:)
    integer :: i, n
    
    n = 20
    x = [( 0.1 * i, i = 1, n)]
    y = 10.0**x
    
    block 
        use forpy_mod
        use m_tuple 
        integer :: ierr
        type(module_py) :: plt
        type(ndarray)   :: x_nd, y_nd
!forpy        
        ierr = forpy_initialize()
        if (ierr == NO_NUMPY_ERROR) stop 'numpy not found!'
        if (ierr /= 0) stop 'forpy initialization error!'
!matplotlib        
        ierr = import_py(plt, 'matplotlib.pyplot')
        if (exception_matches(ImportError)) stop 'matplotlib not found!'
!main         
        ierr = ndarray_create(x_nd, x)
        ierr = ndarray_create(y_nd, y)
        ierr = call_py_noret(plt, 'yscale', t_tuple("log"))
        ierr = call_py_noret(plt, 'title' , t_tuple("Matplotlib called from Fortran"))
        ierr = call_py_noret(plt, 'grid'  , t_tuple(.true., 'both', 'both'), t_dict("linestyle", 'dashed'))
        ierr = call_py_noret(plt, 'plot'  , t_tuple(x_nd, y_nd))
        ierr = call_py_noret(plt, 'show')
!clean up        
        call x_nd%destroy()
        call y_nd%destroy()
        call plt %destroy()
! forpy finalize       
        call forpy_finalize()
    end block
end program matplot

tuple, list, dict 用ルーチン

    module m_tuple
        use, intrinsic :: iso_fortran_env
        use forpy_mod
        implicit none
        type :: t_c
            class(*), pointer :: p => null()
        end type t_c
        type :: t_d
            character(:), pointer :: t => null() 
            class(*)    , pointer :: p => null()
        end type t_d
    contains
        subroutine tup_assign(tup, i, c)
            type(tuple), intent(in out) :: tup
            integer , intent(in) :: i
            class(*), intent(in) :: c
            integer :: ierr
            select type (c)
            type is (integer(int32))
                ierr = tup%setitem(i, c)
            type is (integer(int64))
                ierr = tup%setitem(i, c)
            type is (real(real32))
                ierr = tup%setitem(i, c)
            type is (real(real64))
                ierr = tup%setitem(i, c)
            type is (logical)
                ierr = tup%setitem(i, c)
            type is (character(*))
                ierr = tup%setitem(i, c)
            type is (tuple)
                ierr = tup%setitem(i, c)
            type is (list)
                ierr = tup%setitem(i, c)
            type is (dict)
                ierr = tup%setitem(i, c)
            type is (ndarray)
                ierr = tup%setitem(i, c)
            type is (object)
                ierr = tup%setitem(i, c)
            class default
                stop 'error tup_assign'
            end select
        end subroutine tup_assign
        
        type(tuple) function t_tuple(c0, c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15) result(tup)
            class(*), intent(in), optional, target :: c0, c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15
            integer :: ierr, i, n
            type(t_c) :: c(0:15) 
            if (present(c0 )) c( 0)%p => c0
            if (present(c1 )) c( 1)%p => c1
            if (present(c2 )) c( 2)%p => c2
            if (present(c3 )) c( 3)%p => c3
            if (present(c4 )) c( 4)%p => c4
            if (present(c5 )) c( 5)%p => c5
            if (present(c6 )) c( 6)%p => c6
            if (present(c7 )) c( 7)%p => c7
            if (present(c8 )) c( 8)%p => c8
            if (present(c9 )) c( 9)%p => c9
            if (present(c10)) c(10)%p => c10
            if (present(c11)) c(11)%p => c11
            if (present(c12)) c(12)%p => c12
            if (present(c13)) c(13)%p => c13
            if (present(c14)) c(14)%p => c14
            if (present(c15)) c(15)%p => c15
            n = 0
            do i = 0, 15
                if (associated(c(i)%p)) n = n + 1            
            end do
            ierr = tuple_create(tup, n)
            do i = 0, 15
                if (associated(c(i)%p)) call tup_assign(tup, i, c(i)%p)
            end do
            forall (i = 0:15) c(i)%p => null()
        end function t_tuple
    
        subroutine lis_append(lst, c)
            type(list), intent(in out) :: lst
            class(*), intent(in) :: c
            integer :: ierr
            select type (c)
            type is (integer(int32))
                ierr = lst%append(c)
            type is (integer(int64))
                ierr = lst%append(c)
            type is (real(real32))
                ierr = lst%append(c)
            type is (real(real64))
                ierr = lst%append(c)
            type is (logical)
                ierr = lst%append(c)
            type is (character(*))
                ierr = lst%append(c)
            type is (tuple)
                ierr = lst%append(c)
            type is (list)
                ierr = lst%append(c)
            type is (dict)
                ierr = lst%append(c)
            type is (ndarray)
                ierr = lst%append(c)
            type is (object)
                ierr = lst%append(c)
            class default
                stop 'error lis_append'
            end select
        end subroutine lis_append
        
        type(list) function t_list(c0, c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15) result(lst)
            class(*), intent(in), optional, target :: c0, c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15
            integer :: ierr, i
            type(t_c) :: c(0:15) 
            if (present(c0 )) c( 0)%p => c0
            if (present(c1 )) c( 1)%p => c1
            if (present(c2 )) c( 2)%p => c2
            if (present(c3 )) c( 3)%p => c3
            if (present(c4 )) c( 4)%p => c4
            if (present(c5 )) c( 5)%p => c5
            if (present(c6 )) c( 6)%p => c6
            if (present(c7 )) c( 7)%p => c7
            if (present(c8 )) c( 8)%p => c8
            if (present(c9 )) c( 9)%p => c9
            if (present(c10)) c(10)%p => c10
            if (present(c11)) c(11)%p => c11
            if (present(c12)) c(12)%p => c12
            if (present(c13)) c(13)%p => c13
            if (present(c14)) c(14)%p => c14
            if (present(c15)) c(15)%p => c15
            ierr = list_create(lst)
            do i = 0, 15
               if (associated(c(i)%p)) call lis_append(lst, c(i)%p)
            end do
            forall (i = 0:15) c(i)%p => null()
        end function t_list
    
        subroutine dic_assign(dic, t, d)
            type(dict), intent(in out) :: dic
            character(*), intent(in) :: t
            class(*)    , intent(in) :: d
            integer :: ierr
            select type (d)
            type is (integer(int32))
                ierr = dic%setitem(t, d)
            type is (integer(int64))
                ierr = dic%setitem(t, d)
            type is (real(real32))
                ierr = dic%setitem(t, d)
            type is (real(real64))
                ierr = dic%setitem(t, d)
            type is (logical)
                ierr = dic%setitem(t, d)
            type is (character(*))
                ierr = dic%setitem(t, d)
            type is (tuple)
                ierr = dic%setitem(t, d)
            type is (list)
                ierr = dic%setitem(t, d)
            type is (dict)
                ierr = dic%setitem(t, d)
            type is (ndarray)
                ierr = dic%setitem(t, d)
            type is (object)
                ierr = dic%setitem(t, d)
            class default
                stop 'error dic_assign'
            end select
        end subroutine dic_assign
    
        type(dict) function t_dict(t0, c0, t1, c1, t2, c2, t3, c3, t4, c4, t5, c5, t6, c6, t7, c7, t8, c8, t9, c9, & 
                                   t10, c10, t11, c11, t12, c12, t13, c13, t14, c14, t15, c15) result(dct)
            character(*), intent(in), optional, target :: t0, t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15
            class(*)    , intent(in), optional, target :: c0, c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15
            integer :: ierr, i
            type(t_d) :: d(0:15) 
            if (present(t0 )) d( 0)%t => t0
            if (present(t1 )) d( 1)%t => t1
            if (present(t2 )) d( 2)%t => t2
            if (present(t3 )) d( 3)%t => t3
            if (present(t4 )) d( 4)%t => t4
            if (present(t5 )) d( 5)%t => t5
            if (present(t6 )) d( 6)%t => t6
            if (present(t7 )) d( 7)%t => t7
            if (present(t8 )) d( 8)%t => t8
            if (present(t9 )) d( 9)%t => t9
            if (present(t10)) d(10)%t => t10
            if (present(t11)) d(11)%t => t11
            if (present(t12)) d(12)%t => t12
            if (present(t13)) d(13)%t => t13
            if (present(t14)) d(14)%t => t14
            if (present(t15)) d(15)%t => t15
            if (present(c0 )) d( 0)%p => c0
            if (present(c1 )) d( 1)%p => c1
            if (present(c2 )) d( 2)%p => c2
            if (present(c3 )) d( 3)%p => c3
            if (present(c4 )) d( 4)%p => c4
            if (present(c5 )) d( 5)%p => c5
            if (present(c6 )) d( 6)%p => c6
            if (present(c7 )) d( 7)%p => c7
            if (present(c8 )) d( 8)%p => c8
            if (present(c9 )) d( 9)%p => c9
            if (present(c10)) d(10)%p => c10
            if (present(c11)) d(11)%p => c11
            if (present(c12)) d(12)%p => c12
            if (present(c13)) d(13)%p => c13
            if (present(c14)) d(14)%p => c14
            if (present(c15)) d(15)%p => c15
            ierr = dict_create(dct)
            do i = 0, 15
                if (associated(d(i)%p)) call dic_assign(dct, d(i)%t, d(i)%p)
            end do
            forall (i = 0:15) 
                d(i)%t => null()
                d(i)%p => null()
            end forall    
        end function t_dict
    end module m_tuple

【メモ帳】ドイツの CAF/PGAS スライド その他

F2x Automated FORTRAN wrapping without limits

EuroSciPy
f2py の後継? あるべき向きが逆w
github.com
youtu.be

邪神ちゃんドロップキック

邪神ちゃんドロップキック

CAF event

CAF event post / event wait

Intel Fortran ver.19 beta に導入されている Fortran2018 の CAF の event 機能を試してみます。

Parallel Programming with Co-arrays (Chapman & Hall/CRC Computational Science)

Parallel Programming with Co-arrays (Chapman & Hall/CRC Computational Science)

プログラム

image1 でエラトステネスのふるいで 100 までの素数を求め、その素数の総数分の配列を各イメージで確保しますが、次にそれぞれのイメージ番号目の素数を1個だけコピーします。(意味不明w)

本来は image1 から put してやればいいと思うのですが、学習のためなので意味不明でも許してください。

人為的に image2 を遅延させています。

            if (me == 2) call sleep(2) ! non-standard
    program CAF09
        use, intrinsic :: iso_fortran_env
        implicit none
        type (event_type) :: event[*]
        integer :: me, ne 
        integer :: i, it(100), np[*]
        integer, allocatable :: ip(:), m(:)[:]
        
        me = this_image()
        ne = num_images()
        
        if (me == 1) then
            ! prime numbers with the sieve of Eratosthenes 
            forall (integer:: i = 1:100) it(i) = i
            it(1) = 0     
            do i = 1, int(sqrt(100.0))
                if (it(i) /= 0) it(i**2::i) = 0
            end do    
            ip = pack(it, it /= 0)
            np = size(ip)
            print '(i4, a/, (10i4))', np, ':', ip
            do i = 2, ne
                event post (event[i])
            end do  
        else
            event wait (event)
            np = np[1]
        end if 
        allocate(m(np)[*])
        if (me == 1) then 
            m = ip
            do i = 2, ne
                event post (event[i])
            end do  
        else 
            if (me == 2) call sleep(2) ! non-standard
            event wait (event)
            m(me) = m(me)[1] 
        end if    
        print *, 'me:', me, m(me)
    end program CAF09

実行結果

image2 だけを眠らせて遅らせたので、image2 以外はさっさと結果を書いて終わりますが、image2 は最後に一人遅れて結果を書き出します。

  25:
   2   3   5   7  11  13  17  19  23  29
  31  37  41  43  47  53  59  61  67  71
  73  79  83  89  97
 me:           1           2
 me:           3           5
 me:           4           7
 me:           6          13
 me:           8          19
 me:           5          11
 me:           7          17
 me:           2           3

Modern Fortran Explained: Incorporating Fortran 2018 (Numerical Mathematics and Scientific Computation)

Modern Fortran Explained: Incorporating Fortran 2018 (Numerical Mathematics and Scientific Computation)

sync images (*) / sync images (1) の場合

上記と同内容のことを Fortran2008 の範囲内でやると sync images (*) / sync images (1) の組み合わせで実現出来ますが、この場合 sync のところで不必要な待ち合わせが行われてしまいます。(全員集合するまで待機)

プログラム

    program CAF08
        use, intrinsic :: iso_fortran_env
        implicit none
   !     type (event_type) :: event[*]
        integer :: me, ne 
        integer :: i, it(100), np[*]
        integer, allocatable :: ip(:), m(:)[:]
        
        me = this_image()
        ne = num_images()
        
        if (me == 1) then
            ! prime numbers by sieve of eratosthenes 
            forall (integer:: i = 1:100) it(i) = i
            it(1) = 0     
            do i = 1, int(sqrt(100.0))
                if (it(i) /= 0) it(i**2::i) = 0
            end do    
            ip = pack(it, it /= 0)
            np = size(ip)
            print '(i4, a/, (10i4))', np, ':', ip
            sync images(*) ! wait  
        else
            sync images(1)
            np = np[1]
        end if 
        allocate(m(np)[*]) ! implicit sync all
        if (me == 1) then 
            m = ip
            sync images(*) ! wait
        else 
            if (me == 2) call sleep(2) ! non-standard
            sync images(1)
            m(me) = m(me)[1] 
        end if    
        print *, 'me:', me, m(me)
    end program CAF08

実行結果

実行結果は同じですが、image2 を遅らせると、sync のところで全員集合するまで、全 image が待ち合わせするので、全 image が遅れて一気に出力されます。

私は少し勘違いしていて、sync all と違って、sync images(*) / sync images(1) の場合、image1 は全員の点呼を取るまで待機するが、他の image は image1 と sync した後は、そのまま待機せずに通過だと思っておりました。実際は sync all と同様に全 image が集合するまで全員待機の模様です。

  25:
   2   3   5   7  11  13  17  19  23  29
  31  37  41  43  47  53  59  61  67  71
  73  79  83  89  97
 me: 1 2
 me: 4 7
 me: 2 3
 me: 8 19
 me: 5 11
 me: 6 13
 me: 7 17
 me: 3 5

【メモ帳】forpy 用 tuple, list 代入

昨日の続き

tuple のみならず list も代入できるようにしてみました。また tuple や list, object 型も要素として代入できるようにしてみました。

OO化すれば、終了処理も自動化できるし便利かも。

forpy 恐るべしw
github.com

[追記]
しかし、Fortran の関数値の代入は、Deep Copy になるので、destroy 処理がちゃんとなされていない可能性がある。 type(c_ptr) が基底にあるので、変数に代入した場合は大丈夫かもしれないが、要素として無名のまま代入した場合はダメかもw

実行結果

代入操作 tuple と list

        type(tuple) :: tu1, tu2
        type(list)  :: lst 
        tu1 = t_tuple(1, 2.0, 'sun')
        tu2 = t_tuple('one', 2, 3.0, 4.0d0, tu1)

        lst = t_list('a', 2, 3.0, '5', 6.0d0, tu2, t_list('uno', 'dos', 'windows'))

D:\Git\Python\forpy-master>asstup
3
5
(1, 2.0, 'sun')
('one', 2, 3.0, 4.0, (1, 2.0, 'sun'))
 
['a', 2, 3.0, '5', 6.0, ('one', 2, 3.0, 4.0, (1, 2.0, 'sun')), ['uno', 'dos', 'windows']]

D:\Git\Python\forpy-master>

プログラム

    module m_tuple
        use, intrinsic :: iso_fortran_env
        use forpy_mod
        implicit none
    contains
        subroutine tup_assign(tup, i, c)
            type(tuple), intent(in out) :: tup
            integer , intent(in) :: i
            class(*), intent(in) :: c
            integer :: ierr
            select type (c)
            type is (integer(int32))
                ierr = tup%setitem(i, c)
            type is (integer(int64))
                ierr = tup%setitem(i, c)
            type is (real(real32))
                ierr = tup%setitem(i, c)
            type is (real(real64))
                ierr = tup%setitem(i, c)
            type is (character(*))
                ierr = tup%setitem(i, c)
            type is (tuple)
                ierr = tup%setitem(i, c)
            type is (list)
                ierr = tup%setitem(i, c)
            type is (object)
                ierr = tup%setitem(i, c)
            class default
                stop 'error tup_assign'
            end select
        end subroutine tup_assign
        
        type(tuple) function t_tuple(c0, c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15) result(tup)
            class(*), intent(in), optional :: c0, c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15
            integer :: ierr, n
            n = 0
            if (present(c0 )) n = 1
            if (present(c1 )) n = n + 1
            if (present(c2 )) n = n + 1
            if (present(c3 )) n = n + 1
            if (present(c4 )) n = n + 1
            if (present(c5 )) n = n + 1
            if (present(c6 )) n = n + 1
            if (present(c7 )) n = n + 1
            if (present(c8 )) n = n + 1
            if (present(c9 )) n = n + 1
            if (present(c10)) n = n + 1
            if (present(c11)) n = n + 1
            if (present(c12)) n = n + 1
            if (present(c13)) n = n + 1
            if (present(c14)) n = n + 1
            if (present(c15)) n = n + 1
            ierr = tuple_create(tup, n)

            if (present(c0 )) call tup_assign(tup,  0, c0)
            if (present(c1 )) call tup_assign(tup,  1, c1)
            if (present(c2 )) call tup_assign(tup,  2, c2)
            if (present(c3 )) call tup_assign(tup,  3, c3)
            if (present(c4 )) call tup_assign(tup,  4, c4)
            if (present(c5 )) call tup_assign(tup,  5, c5)
            if (present(c6 )) call tup_assign(tup,  6, c6)
            if (present(c7 )) call tup_assign(tup,  7, c7)
            if (present(c8 )) call tup_assign(tup,  8, c8)
            if (present(c9 )) call tup_assign(tup,  9, c8)
            if (present(c10)) call tup_assign(tup, 10, c0)
            if (present(c11)) call tup_assign(tup, 11, c1)
            if (present(c12)) call tup_assign(tup, 12, c2)
            if (present(c13)) call tup_assign(tup, 13, c3)
            if (present(c14)) call tup_assign(tup, 14, c4)
            if (present(c15)) call tup_assign(tup, 15, c5)
        end function t_tuple
    
        subroutine lis_append(lst, c)
            type(list), intent(in out) :: lst
            class(*), intent(in) :: c
            integer :: ierr
            select type (c)
            type is (integer(int32))
                ierr = lst%append(c)
            type is (integer(int64))
                ierr = lst%append(c)
            type is (real(real32))
                ierr = lst%append(c)
            type is (real(real64))
                ierr = lst%append(c)
            type is (character(*))
                ierr = lst%append(c)
            type is (tuple)
                ierr = lst%append(c)
            type is (list)
                ierr = lst%append(c)
            type is (object)
                ierr = lst%append(c)
            class default
                stop 'error lis_append'
            end select
        end subroutine lis_append
        
        type(list) function t_list(c0, c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15) result(lst)
            class(*), intent(in), optional :: c0, c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15
            integer :: ierr
            ierr = list_create(lst)
            if (present(c0 )) call lis_append(lst,  c0)
            if (present(c1 )) call lis_append(lst,  c1)
            if (present(c2 )) call lis_append(lst,  c2)
            if (present(c3 )) call lis_append(lst,  c3)
            if (present(c4 )) call lis_append(lst,  c4)
            if (present(c5 )) call lis_append(lst,  c5)
            if (present(c6 )) call lis_append(lst,  c6)
            if (present(c7 )) call lis_append(lst,  c7)
            if (present(c8 )) call lis_append(lst,  c8)
            if (present(c9 )) call lis_append(lst,  c9)
            if (present(c10)) call lis_append(lst, c10)
            if (present(c11)) call lis_append(lst, c11)
            if (present(c12)) call lis_append(lst, c12)
            if (present(c13)) call lis_append(lst, c13)
            if (present(c14)) call lis_append(lst, c14)
            if (present(c15)) call lis_append(lst, c15)
        end function t_list
    end module m_tuple

    program test
        use m_tuple
        integer :: ierr
        type(tuple) :: tu1, tu2
        type(list)  :: lst 
        integer :: len_tu
        ierr = forpy_initialize()
        tu1 = t_tuple(1, 2.0, 'sun')
        ierr = tu1%len(len_tu)
        print *, len_tu

        tu2 = t_tuple('one', 2, 3.0, 4.0d0, tu1)
        ierr = tu2%len(len_tu)
        print *, len_tu
        ierr = print_py(tu1)
        ierr = print_py(tu2)
        
        print *
        lst = t_list('a', 2, 3.0, '5', 6.0d0, tu2, t_list('uno', 'dos', 'windows'))
        ierr = print_py(lst)
        
        call lst%destroy()
        call tu1%destroy()
        call tu2%destroy()
        call forpy_finalize()
    end program test

少し書き直してみた [H30.8.31]

Fortran には、ポインタの配列はないので、ポインタを要素と持つ派生型を定義して、その派生型の配列を作る必要がある。ポインタを配列っぽく書いても、それは配列へのポインタであってポインタの配列にはならない。

    module m_tuple
        use, intrinsic :: iso_fortran_env
        use forpy_mod
        implicit none
        type :: t_c
            class(*), pointer :: p => null()
        end type t_c
    contains
        subroutine tup_assign(tup, i, c)
            type(tuple), intent(in out) :: tup
            integer , intent(in) :: i
            class(*), intent(in) :: c
            integer :: ierr
            select type (c)
            type is (integer(int32))
                ierr = tup%setitem(i, c)
            type is (integer(int64))
                ierr = tup%setitem(i, c)
            type is (real(real32))
                ierr = tup%setitem(i, c)
            type is (real(real64))
                ierr = tup%setitem(i, c)
            type is (character(*))
                ierr = tup%setitem(i, c)
            type is (tuple)
                ierr = tup%setitem(i, c)
            type is (list)
                ierr = tup%setitem(i, c)
            type is (object)
                ierr = tup%setitem(i, c)
            class default
                stop 'error tup_assign'
            end select
        end subroutine tup_assign
        
        type(tuple) function t_tuple(c0, c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15) result(tup)
            class(*), intent(in), optional, target :: c0, c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15
            integer :: ierr, i, n
            type(t_c) :: c(0:15) 
            if (present(c0 )) c( 0)%p => c0
            if (present(c1 )) c( 1)%p => c1
            if (present(c2 )) c( 2)%p => c2
            if (present(c3 )) c( 3)%p => c3
            if (present(c4 )) c( 4)%p => c4
            if (present(c5 )) c( 5)%p => c5
            if (present(c6 )) c( 6)%p => c6
            if (present(c7 )) c( 7)%p => c7
            if (present(c8 )) c( 8)%p => c8
            if (present(c9 )) c( 9)%p => c9
            if (present(c10)) c(10)%p => c10
            if (present(c11)) c(11)%p => c11
            if (present(c12)) c(12)%p => c12
            if (present(c13)) c(13)%p => c13
            if (present(c14)) c(14)%p => c14
            if (present(c15)) c(15)%p => c15
            n = 0
            do i = 0, 15
                if (associated(c(i)%p)) n = n + 1            
            end do
            ierr = tuple_create(tup, n)
            do i = 0, 15
                if (associated(c(i)%p)) call tup_assign(tup, i, c(i)%p)
            end do
            forall (i = 0:15) c(i)%p => null()
        end function t_tuple
    
        subroutine lis_append(lst, c)
            type(list), intent(in out) :: lst
            class(*), intent(in) :: c
            integer :: ierr
            select type (c)
            type is (integer(int32))
                ierr = lst%append(c)
            type is (integer(int64))
                ierr = lst%append(c)
            type is (real(real32))
                ierr = lst%append(c)
            type is (real(real64))
                ierr = lst%append(c)
            type is (character(*))
                ierr = lst%append(c)
            type is (tuple)
                ierr = lst%append(c)
            type is (list)
                ierr = lst%append(c)
            type is (object)
                ierr = lst%append(c)
            class default
                stop 'error lis_append'
            end select
        end subroutine lis_append
        
        type(list) function t_list(c0, c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15) result(lst)
            class(*), intent(in), optional, target :: c0, c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15
            integer :: ierr, i
            type(t_c) :: c(0:15) 
            if (present(c0 )) c( 0)%p => c0
            if (present(c1 )) c( 1)%p => c1
            if (present(c2 )) c( 2)%p => c2
            if (present(c3 )) c( 3)%p => c3
            if (present(c4 )) c( 4)%p => c4
            if (present(c5 )) c( 5)%p => c5
            if (present(c6 )) c( 6)%p => c6
            if (present(c7 )) c( 7)%p => c7
            if (present(c8 )) c( 8)%p => c8
            if (present(c9 )) c( 9)%p => c9
            if (present(c10)) c(10)%p => c10
            if (present(c11)) c(11)%p => c11
            if (present(c12)) c(12)%p => c12
            if (present(c13)) c(13)%p => c13
            if (present(c14)) c(14)%p => c14
            if (present(c15)) c(15)%p => c15
            ierr = list_create(lst)
            do i = 0, 15
               if (associated(c(i)%p)) call lis_append(lst, c(i)%p)
            end do
            forall (i = 0:15) c(i)%p => null()
        end function t_list
    end module m_tuple

    program test
        use m_tuple
        integer :: ierr
        type(tuple) :: tu1, tu2
        type(list)  :: lst 
        integer :: len_tu
        ierr = forpy_initialize()
        tu1 = t_tuple(1, 2.0, 'sun')
        ierr = tu1%len(len_tu)
        print *, len_tu

        tu2 = t_tuple('one', 2, 3.0, 4.0d0, tu1)
        ierr = tu2%len(len_tu)
        print *, len_tu
        ierr = print_py(tu1)
        ierr = print_py(tu2)
        
        print *
        lst = t_list('a', 2, 3.0, '5', 6.0d0, tu2, t_list('uno', 'dos', 'windows'))
        ierr = print_py(lst)
        
        call lst%destroy()
        call tu1%destroy()
        call tu2%destroy()
        call forpy_finalize()
    end program test

IntelPython で PyQt を動かせない

python3.dll がないので叱られ、windows バイナリ zip から python3.dll だけを拾ってくると、こんどは windows plugin が見つからないと叱られ、ネットにある解決法を試しても解消せず。

蛇マジむかつく!

【メモ帳】forpy で Fortran から Python 呼び出し

PythonFortran から呼び出し

以前紹介しましたが続報です。
f:id:fortran66:20180830031240j:plain
fortran66.hatenablog.com

Forpy のニュース

Forpy 紹介ブログが出たようです。作者へのインタビューが載っています。
www.metamost.com

github.com

新たに wiki などもできたようです。
ylikx.github.io


【無料】邪神ちゃんドロップキック(第1話・前半)

【メモ帳】windows DOS 窓からも呼べました。

intel fortran v.18 と intel Python3.6 の組み合わせです。VisualStudio からではなくコマンドラインからコンパイル&実行しました。

set PYTHONHOME=C:\IntelPython3 が必要でした。コンパイル時には、リンク用の情報として C:\IntelPython3\Libs\python36.lib をコマンドラインに付加する必要があります。

D:\Git\Python\forpy-master>set PYTHONHOME=c:\IntelPython3

D:\Git\Python\forpy-master>ifort -fpp forplot.f90 forpy_mod.obj c:\IntelPython3\Libs\python36.lib
インテル(R) 64 対応インテル(R) Visual Fortran コンパイラー (インテル(R) 64 対応アプリケーション用) バージョン 18.0.3.210 ビルド 20180410
(C) 1985-2018 Intel Corporation. 無断での引用、転載を禁じます。

Microsoft (R) Incremental Linker Version 14.15.26726.0
Copyright (C) Microsoft Corporation. All rights reserved.

  • out:forplot.exe
  • subsystem:console

forplot.obj
forpy_mod.obj
c:\IntelPython3\Libs\python36.lib

D:\Git\Python\forpy-master>forplot
Press Ctrl+C to stop WebAgg server
Server is stopped

D:\Git\Python\forpy-master>

f:id:fortran66:20180830031801p:plain

図はブラウザに出ました。

【メモ帳】tuple を無理やり代入式に

Python の tuple は型の異なるものを列挙して派生型定数を作るようなものですが、forpy の api では、はじめに要素数を宣言した後、1要素毎に api 呼び出しで値を詰めてゆく必要があります。

これを class(*) を使って、type の デフォルト・コンストラクタっぽくできるかコンセプトだけ実験してみました。

こんな感じ

type(tuple) :: tu
tu = t_tuple(1, 2.0, 'sun')

原理的に醜くしか出来ないと思いますが、一応は出来る感じです。class(*) 変数引数を百個でも二百個でも列挙羅列し、select type をありとあらゆる型・派生型に対応させてゆけば、何でも tuple に突っ込めるのではないかと思います。

[追記]
関数の出力 tuple の destroy 処理がされていない可能性があります・・・ FINALIZE 処理を入れれば問題ないが・・・

プログラム

    module m_tuple
        use forpy_mod
        implicit none
    contains
	subroutine sub_assign(tup, i, c)
            type(tuple), intent(in out) :: tup
            integer , intent(in) :: i
            class(*), intent(in) :: c
            integer :: ierr
            select type (c)
            type is (integer)
                ierr = tup%setitem(i, c)
            type is (real)
                ierr = tup%setitem(i, c)
            type is (real(8))
                ierr = tup%setitem(i, c)
            type is (character(*))
                ierr = tup%setitem(i, c)
            end select
        end subroutine sub_assign
        
        type(tuple) function t_tuple(c0, c1, c2, c3, c4, c5, c6, c7, c8) result(tup)
            class(*), intent(in), optional :: c0, c1, c2, c3, c4, c5, c6, c7, c8
            integer :: ierr, n
            n = 0
            if (present(c0)) n = 1
            if (present(c1)) n = n + 1
            if (present(c2)) n = n + 1
            if (present(c3)) n = n + 1
            if (present(c4)) n = n + 1
            if (present(c5)) n = n + 1
            if (present(c6)) n = n + 1
            if (present(c7)) n = n + 1
            if (present(c8)) n = n + 1
            ierr = tuple_create(tup, n)

            if (present(c0)) call sub_assign(tup, 0, c0)
            if (present(c1)) call sub_assign(tup, 1, c1)
            if (present(c2)) call sub_assign(tup, 2, c2)
            if (present(c3)) call sub_assign(tup, 3, c3)
            if (present(c4)) call sub_assign(tup, 4, c4)
            if (present(c5)) call sub_assign(tup, 5, c5)
            if (present(c6)) call sub_assign(tup, 6, c6)
            if (present(c7)) call sub_assign(tup, 7, c7)
            if (present(c8)) call sub_assign(tup, 8, c8)
        end function t_tuple
    end module m_tuple

    program test
        use m_tuple
        integer :: ierr
        type(tuple) :: tu1, tu2
        integer :: len_tu
        ierr = forpy_initialize()
        tu1 = t_tuple(1, 2.0, 'sun')
        ierr = tu1%len(len_tu)
        print *, len_tu

        tu2 = t_tuple('one', 2, 3.0, 4.0d0)
        ierr = tu2%len(len_tu)
        print *, len_tu

        call tu1%destroy()
        call tu2%destroy()
        call forpy_finalize()
    end program test

実行結果

O@HP8:~/forpy$ ifort tup.f90 forpy_mod.o `python3-config --ldflags`
O@HP8:~/forpy$ ./a.out
3
4

forpy の API は C 言語的な、関数の戻り値をエラーコードにするという、非 Fortran 的な副作用のある関数を使っているので、育ちのよろしくない感じがしてやや落ち着きませんw

結論:蛇はむかつくw


邪神ちゃんねるV第6話

【メモ帳】CAF 例題

何故なら image 1 は特別な存在だからです

Fortran の coarray は SPMD 型の並列モデルで、それぞれのイメージはほぼ等価で違いは無いのですが、標準入力だけは image 1 番が担っていて、他のイメージが標準入力をしようとすると実行時エラーが出て叱られます。思いつく限り、これだけが例外の気がします。

なお標準出力の方は、どのイメージでも可能です。

ヴェルタースオリジナル「特別な存在」篇

Parallel Programming with Co-arrays (Chapman & Hall/CRC Computational Science)

Parallel Programming with Co-arrays (Chapman & Hall/CRC Computational Science)

プログラム

    program CAF05
        implicit none
        integer :: m[*]
        integer :: ne, me
        
        ne = num_images()
        me = this_image()
        
        if (me == 1) then 
            print *, 'input integer'
            read *, m
        end if    
        
        sync all
        m = m[1] * me
        
        print *, me, m
    end program CAF05

実行結果

 input integer
3
           1           3
           4          12
           7          21
           8          24
           5          15
           6          18
           2           6
           3           9
続行するには何かキーを押してください . . .

排他制御

critical / lock (blocking) / lock (non-blocking)

プログラム

[訂正:H30.9.2] critical 前の sync all が抜けていました。

    program CAF06
        use, intrinsic :: iso_fortran_env, only : lock_type
        implicit none
        type (lock_type) :: lck[*]
        logical :: success
        integer :: ne, me, m[*]
        
        ne = num_images()
        me = this_image()
        m = 0

        sync all 
        critical
            print *, 'critical     ; this_image()=', me
            m[1] = m[1] + 1        
        end critical
        sync all
        if (me == 1) print '(4g0/)', ' sum= ', m, ' num_images()=', ne
        
        
        lock (lck[1])
            print *, 'lock:blocking; this_image()=', me
            m[2] = m[2] + 1        
        unlock (lck[1])
        sync all
        if (me == 2) print '(4g0/)', ' sum= ', m, ' num_images()=', ne
        
        
        lock (lck[1], acquired_lock = success)
        if (success) then 
            print *, 'lock:non-blocking; this_image()=', me
            m[3] = m[3] + 1        
            unlock (lck[1])
        end if    
        sync all
        if (me == 3) print '(4g0)', ' sum= ', m, ' num_images()=', ne
    end program CAF06

実行結果

 critical     ; this_image()=           1
 critical     ; this_image()=           7
 critical     ; this_image()=           5
 critical     ; this_image()=           6
 critical     ; this_image()=           4
 critical     ; this_image()=           8
 critical     ; this_image()=           3
 critical     ; this_image()=           2
 sum= 8 num_images()=8

 lock:blocking; this_image()=           1
 lock:blocking; this_image()=           4
 lock:blocking; this_image()=           3
 lock:blocking; this_image()=           2
 lock:blocking; this_image()=           7
 lock:blocking; this_image()=           5
 lock:blocking; this_image()=           6
 lock:blocking; this_image()=           8
 sum= 8 num_images()=8

 lock:non-blocking; this_image()=           1
 lock:non-blocking; this_image()=           6
 lock:non-blocking; this_image()=           5
 sum= 3 num_images()=8
続行するには何かキーを押してください . . .

image 番号と多次元 coarray の対応

image_index(coarray, [d1, d2..]) と this_image(coarray) で求めます。

Modern Fortran Explained: Incorporating Fortran 2018 (Numerical Mathematics and Scientific Computation)

Modern Fortran Explained: Incorporating Fortran 2018 (Numerical Mathematics and Scientific Computation)

プログラム

Format に無駄な技巧を使いました。/ と : の前後の , は省略できます。(The Fortran 2003 Hnadbook, §10.2)

毎回数値の後に閉じ括弧 ] を書き出します。これ以上データがないときは format は ] 直後の : 位置で終了します。データがまだあれば、TL1 (左に1文字分相対タブ)で1文字カーソル位置を戻して ] が , で上書きされて次のデータの読み込みに戻ります。

コンソール・スクリーンなら問題ないですが、テレタイプ端末などだと上書きされても消えないので問題あるかもw

    program CAF07
        implicit none
        integer :: n1[*], n2[2, *], n3[2, 2, *]
        integer :: ne, me, m2(2), m3(3)
        
        ne = num_images()
        me = this_image()
        !
        if (me == 1) then 
            print *, 'image_index', image_index(n1, [1]), image_index(n2, [2, 3]), image_index(n3, [2, 2, 1])
        end if
        !
        if (me > 1) sync images(me - 1)
        print '(/2g0)', ' image = ', me
        print '( " [", *( g0,"]":TL1, ", ") )', this_image(n1)
        print '( " [", *( g0,"]":TL1, ", ") )', this_image(n2)
        print '( " [", *( g0,"]":TL1, ", ") )', this_image(n3)
        if (me < ne) sync images(me + 1)
    end program CAF07

The Fortran 2003 Handbook: The Complete Syntax, Features and Procedures

The Fortran 2003 Handbook: The Complete Syntax, Features and Procedures

  • 作者: Jeanne C. Adams,Walter S. Brainerd,Richard A. Hendrickson,Richard E. Maine,Jeanne T. Martin,Brian T. Smith
  • 出版社/メーカー: Springer
  • 発売日: 2014/11/30
  • メディア: ペーパーバック
  • この商品を含むブログを見る

実行結果

 image_index           1           6           4

 image = 1
 [1]
 [1, 1]
 [1, 1, 1]

 image = 2
 [2]
 [2, 1]
 [2, 1, 1]

 image = 3
 [3]
 [1, 2]
 [1, 2, 1]

 image = 4
 [4]
 [2, 2]
 [2, 2, 1]

 image = 5
 [5]
 [1, 3]
 [1, 1, 2]

 image = 6
 [6]
 [2, 3]
 [2, 1, 2]

 image = 7
 [7]
 [1, 4]
 [1, 2, 2]

 image = 8
 [8]
 [2, 4]
 [2, 2, 2]
続行するには何かキーを押してください . . .

イメージ 整列 シリアル実行

まず 1~ne の順番で、次に n~1 の順番で。

プログラム

    program CAF007
        implicit none
        integer :: me, ne 
        
        me = this_image()
        ne = num_images()
        !
        ! 1,2,3....,ne
        !
        if (me >  1) sync images (me - 1)
        print *, me
        if (me < ne) sync images (me + 1)
        !
        !
        ! ne, ne-1, ne-2,...,1
        !
        if (me < ne) sync images (me + 1)
        print *, me
        if (me >  1) sync images (me - 1)
    end program CAF007

実行結果

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

【メモ帳】NEC-SX Aurora TSUBASA 専門サイト?など

NEC SX Aurora ニュース専門サイト

面白い試みです。頑張って欲しいです。

VectoryWork | for beginners

とりあえず、NEC は間諜を放って、物を言う投資家などに「NVidia は儲けの多い AI や自動運転に集中し、ニッチ市場である HPC は捨てるべき!」と騒がせるべきwww

アメリカ大気研究センターの Modern Fortran 講習

Modern Fortran workshop series starts September 11 | Computational Information Systems Laboratory

  • Scalar Fortran - Tuesday, Sept. 11: Scope, definition, scalar declarations and usage, and interacting with the processor.
  • Vector Fortran - Tuesday, Sept. 18: Arrays, storage order, elemental operations, and array intrinsics.
  • Object-Oriented Fortran - Wednesday, Sept. 26: Derived types, defined operations, defined assignment, and inheritance.
  • Parallel Fortran - Tuesday, Oct. 2: Coarray concepts, declarations, and usage; synchronization and treating failed images.

Scalar Fortran, Vector Fortran, Object-Oriented Fortran, Parallel Fortran この分類法が面白いと思いました。

C++, GO OR RUST

ds9a.nl

The key point here is our programmers are Googlers, they’re not researchers. They’re typically, fairly young, fresh out of school, probably learned Java, maybe learned C or C++, probably learned Python. They’re not capable of understanding a brilliant language but we want to use them to build good software. So, the language that we give them has to be easy for them to understand and easy to adopt. – Rob Pike

孫引きw GO の FAQ 辺りで見た気がする。ある程度 Fortran ユーザーにも当てはまる事ではないでしょうか。


GO は Wirth の Oberon をひとつの基盤にしており、Wirth の考え方を反映しています。Modern Fortran も 多分に Oberon の影響があり、Fortran が例外やゲネリックを持たない理由の説明は、GO がそれらを持たない説明を読めば良かろうかと思われます。

ただし Fortran には、継承(Type Extension)、演算子オーバーロードなどはありますが・・・ また例外の祖型は alternate retuen や I/O 文の END= などにありますが、どちらも GOTO 文の一種と言えます。Wirth は、例外構文は形を変えた GOTO 文だと言って採用していません。