Fortran 95 source code to generate a heap by upward method.

heap_upward.f95

!****************************************************
! ヒープ作成（上方移動）
!
!   date          name            version
!   2018.12.06    mk-mode.com     1.00 新規作成
!
! Copyright(C) 2018 mk-mode.com All Rights Reserved.
!****************************************************
!
module const
  implicit none
  ! SP: 単精度(4), DP: 倍精度(8)
  integer,     parameter :: SP = kind(1.0)
  integer(SP), parameter :: DP = selected_real_kind(2 * precision(1.0_SP))
  integer(SP), parameter :: N = 100  ! データ個数
end module const

module heap
  use const, only : SP, DP
  implicit none
  private
  public :: gen_heap

contains
  ! ヒープ生成
  !
  ! :param(in)  integer(4) num: データ個数
  ! :param(in)  integer(4)   b: 元の配列
  ! :param(out) integer(4)   h: ヒープ配列
  subroutine gen_heap(num, b, h)
    implicit none
    integer(SP), intent(in)  :: num, b(num)
    integer(SP), intent(out) :: h(0:num)
    integer(SP) :: i, s, p, w

    h(:) = 0  ! ヒープ配列初期化
    do i = 1, num
      ! 元データ配列から１つヒープ要素として追加
      h(i) = b(i)
      s = i        ! 追加要素の位置
      p = s / 2    ! 親要素の位置
      do while (s >= 2 .and. h(p) > h(s))
        w    = h(p)
        h(p) = h(s)
        h(s) = w
        s = p      ! 追加要素の位置
        p = s / 2  ! 親要素の位置
      end do
    end do
  end subroutine gen_heap
end module heap

program heap_upward
  use const
  use heap
  implicit none
  integer(SP) :: b(N), h(0:N)  ! 元の配列、ヒープ配列
  integer(SP) :: seed_size, clock, i
  real(DP)    :: r
  integer(SP), allocatable :: seed(:)

  ! 乱数の種の設定
  ! (元の配列を毎回異なる内容にするため)
  call system_clock(clock)
  call random_seed(size=seed_size)
  allocate(seed(seed_size))
  seed = clock
  call random_seed(put=seed)
  deallocate(seed)

  ! 元の配列生成（(0, N] の値の配列）
  do i = 1, N
    call random_number(r)
    b(i) = int(r * N) + 1
  end do
  print '(A)', "#### Base"
  print '(10(X, I4))', b

  ! ヒープ配列生成
  call gen_heap(N, b, h)
  print '(A)', "#### Heap"
  print '(10(X, I4))', h(1:)
end program heap_upward