変数っぽく扱える pointer function

Fortran 2008 の新機能に、pointer を返り値としてもつ関数が、あたかも変数のように扱えるというものがあります。Modern Fortran Explained の 20.5.2 pointer functions denoting variables や The new features of Fortran 2008 の 6.2 Pointer functions に記述があります。

連想配列のようなものに適しているのではないかと思います。

実例１

    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
           4
           9
          16
          25
          36
          49
          64
          81
         100
続行するには何かキーを押してください . . .

実例２

フィボナッチ数列を再帰で求めますが、一度求めた値はテーブルに記録して再利用します。フィボナッチ数の計算では意味がないのですが、テーブルのインデックスはとびとびの値でよくなっています。

二重再帰を使っています。

    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