Fortran 2008 の新機能に、pointer を返り値としてもつ関数が、あたかも変数のように扱えるというものがあります。Modern Fortran Explained の 20.5.2 pointer functions denoting variables や The new features of Fortran 2008 の 6.2 Pointer functions に記述があります。
連想配列のようなものに適しているのではないかと思います。
実例1
module m_sub implicit none contains function storage(key) result(loc) integer, intent(in) :: key integer, pointer :: loc integer, target :: m(100) = 0 loc => m(key) end function storage end module m_sub program Console2 use m_sub implicit none integer :: i do i = 1, 10 storage(i) = i**2 end do do i = 1, 10 print *, storage(i) end do end program Console2
実行例1
1 4 9 16 25 36 49 64 81 100 続行するには何かキーを押してください . . .
実例2
フィボナッチ数列を再帰で求めますが、一度求めた値はテーブルに記録して再利用します。フィボナッチ数の計算では意味がないのですが、テーブルのインデックスはとびとびの値でよくなっています。
二重再帰を使っています。
module m_fib implicit none integer, private, parameter :: nmax = 1000 integer, private :: nx = 0 integer, private :: keys(nmax) = -huge(0) integer, private, target :: vals(nmax) = 0 contains recursive function fib(n) result(ires) integer, intent(in) :: n integer :: ires select case(n) case (1:2) ires = 1 case (3:) ires = fib_table(n) case default ires = 0 end select end function fib recursive function fib_table(key) result(ires) integer, intent(in) :: key integer, pointer :: ires integer :: loc loc = findloc(keys(:nx), key, dim = 1) if (loc <= 0) then nx = nx + 1 keys (nx) = key vals(nx) = fib(key - 1) + fib(key - 2) loc = nx end if ires => vals(loc) end function fib_table end module m_fib program fibonacci use m_fib implicit none integer :: i do i = 1, 40 print *, i, fib(i) end do end program fibonacci
実行結果
1 1 2 1 3 2 4 3 5 5 6 8 7 13 8 21 9 34 10 55 11 89 12 144 13 233 14 377 15 610 16 987 17 1597 18 2584 19 4181 20 6765 21 10946 22 17711 23 28657 24 46368 25 75025 26 121393 27 196418 28 317811 29 514229 30 832040 31 1346269 32 2178309 33 3524578 34 5702887 35 9227465 36 14930352 37 24157817 38 39088169 続行するには何かキーを押してください . . .
参考 配列を利用したフィボナッチ計算結果再利用型
module m_fib2 implicit none contains recursive function fib(n) result(ires) integer, intent(in) :: n integer :: ires select case(n) case (1:2) ires = 1 case (3:) ires = fib(n - 1) + fib(n - 2) case default ires = 0 end select end function fib recursive function fib4(n) result(ires) integer, intent(in) :: n integer :: ires integer, save :: stor(100) = 0 select case(n) case(1:2) ires = 1 case(3:) if (stor(n) == 0) stor(n) = fib4(n - 1) + fib4(n - 2) ires = stor(n) case default ires = 0 end select end function fib4 end module m_fib2 program fibonacci use m_fib2 implicit none integer :: i do i = 1, 38 print *, i, fib(i) end do pause do i = 1, 38 print *, i, fib4(i) end do end program fibonacci