fortran66のブログ

fortran について書きます。

【メモ帳】type 要素の procedure pointer は pass 属性

type bound procedure は pointer で動的付け替え可

Wirh の OO 言語のように、type 内に procedure pointer を置いたら、実行時に動的に換えられないものかとふと思って試してみました。結果、できるし呼び出しはデフォルトで pass 属性なので contains させて静的に結び付けた場合と変わりなく使えました。

改めて MFE(Modern Fortran Explained)を紐解いて見ますと、文脈が違うものの Figure 14.2 の例題にそのものの例があってギャフン死。

とりあえず contains をつけずに、普通の変数などと同様に procedure pointer を並べておけば、呼び出しは contains で括りつけた普通の type bound procedure と同じく pass 属性となって第一引数が当該派生型になるようです。

Modern Fortran Explained (Numerical Mathematics and Scientific Computation)

Modern Fortran Explained (Numerical Mathematics and Scientific Computation)

Modern Fortran Explained (Numerical Mathematics and Scientific Computation)

Modern Fortran Explained (Numerical Mathematics and Scientific Computation)

  • 作者: Michael Metcalf,John Reid,Malcolm Cohen
  • 出版社/メーカー: Oxford Univ Pr on Demand
  • 発売日: 2011/05/19
  • メディア: ハードカバー
  • クリック: 2回
  • この商品を含むブログを見る
Modern Fortran Explained (Numerical Mathematics and Scientific Computation)

Modern Fortran Explained (Numerical Mathematics and Scientific Computation)

以下に実行例

ソースプログラム

    module m_mod1
      implicit none
      type :: t_test
        real :: x
        procedure(func), pass,pointer :: proc => null()
      end type t_test  
      abstract interface 
        pure real function func(this)
          import
          class(t_test), intent(in) :: this
        end function func  
      end interface  
    end module m_mod1  
      
    module m_mod2
      use m_mod1
      implicit none
      private 
      public :: f, g
    contains  
      pure real function f(this)
        class(t_test), intent(in) :: this
        f = sin(this%x)
      end function f
      
      pure real function g(this)
        class(t_test), intent(in) :: this
        g = cos(this%x)
      end function g
    end module m_mod2
    
    program Console9
      use m_mod1
      use m_mod2
      implicit none
      type (t_test) :: a, b
      real, parameter :: pi = 4 * atan(1.0)
      a%proc => f
      b%proc => g
      a%x = pi
      b%x = pi
      print *, 2 * a%proc() * b%proc() ! 2sin(x)cos(x)
      a%x = 2 * a%x
      print *,     a%proc()            !  sin(2x)
    end program Console9

実行結果

  1.7484555E-07
  1.7484555E-07
続行するには何かキーを押してください . . .