分割数プログラム 改

以前も分割数のリストを求めるプログラムを書きましたが、当時のインテルのコンパイラのバグ？らしき仕様のせいで、一時記憶を用いていました。最新の v.17 コンパイラでは、自動割り付けの制限が緩くなったので、書き直してみました。また、ついでなので派生型に対するユーザー定義型 I/O ルーチンを書くことで出力部分も簡素化しました。
fortran66.hatenablog.com

実行結果

the number of partitons of 1 is 1
1
the number of partitons of 2 is 2
2
1 1
the number of partitons of 3 is 3
3
2 1
1 1 1
the number of partitons of 4 is 5
4
3 1
2 2
2 1 1
1 1 1 1
the number of partitons of 5 is 7
5
4 1
3 2
3 1 1
2 2 1
2 1 1 1
1 1 1 1 1
続行するには何かキーを押してください . . .

チェックのために30までの分割数も求めてみました。

the number of partitons of 1 is 1
the number of partitons of 2 is 2
the number of partitons of 3 is 3
the number of partitons of 4 is 5
the number of partitons of 5 is 7
the number of partitons of 6 is 11
the number of partitons of 7 is 15
the number of partitons of 8 is 22
the number of partitons of 9 is 30
the number of partitons of 10 is 42
the number of partitons of 11 is 56
the number of partitons of 12 is 77
the number of partitons of 13 is 101
the number of partitons of 14 is 135
the number of partitons of 15 is 176
the number of partitons of 16 is 231
the number of partitons of 17 is 297
the number of partitons of 18 is 385
the number of partitons of 19 is 490
the number of partitons of 20 is 627
the number of partitons of 21 is 792
the number of partitons of 22 is 1002
the number of partitons of 23 is 1255
the number of partitons of 24 is 1575
the number of partitons of 25 is 1958
the number of partitons of 26 is 2436
the number of partitons of 27 is 3010
the number of partitons of 28 is 3718
the number of partitons of 29 is 4565
the number of partitons of 30 is 5604
続行するには何かキーを押してください . . .

ソース・プログラム

module m_partition
    implicit none
    type :: t_part
      integer, allocatable :: l(:) 
    contains  
      procedure :: wr_part
      generic   :: write(formatted) => wr_part
    end type t_part
contains
    function partition(n) result(res)
      integer, intent(in) :: n
      type (t_part), allocatable :: res(:)
      allocate(res(0))                    ! 
      call parti([integer::], n, n, res)  ! [] zero-sized integer array 
    end function partition

    recursive subroutine parti(list, n, nmax, pl)
      integer, intent(in) :: list(:), n, nmax
      type (t_part), allocatable, intent(in out) :: pl(:)
      integer :: i
      if (n == 0) then
        pl = [pl, t_part(list)]
      else 
        do i = n - nmax, n - 1
          call parti([list, n - i], i, min(i, n - i), pl)
        end do
      end if
    end subroutine parti
    
    subroutine wr_part(dtv, unit, iotype, vlist, io, iomsg)
      class (t_part), intent(in) :: dtv
      integer, intent(in) :: unit
      character (len = *), intent(in) :: iotype
      integer, intent(in ) :: vlist(:)
      integer, intent(out) :: io
      character (len = *), intent(in out) :: iomsg
      character (len = 20) :: fmt 
      integer :: i
      if (iotype == 'LISTDIRECTED') then
        write(unit, *, iostat = io) dtv%l  
      else if (iotype == 'DT') then
        write(fmt, '(a, g0, a)') '(', vlist(1), 'i3)'
        write(unit, fmt) dtv%l
      end if    
    end subroutine wr_part
end module m_partition
     
program part
    use m_partition
    implicit none
    type (t_part), allocatable :: table(:)
    integer :: k, i
    do k = 1, 5
      table = partition(k)
      print *, 'the number of partitons of', k, 'is', size(table)
      print '(DT(100))', table
    end do
end program part