chap07/kadai5.f90

サンプルコードのダウンロード

  1program answer
  2  implicit none
  3
  4  character(len=128), parameter :: datafile = 'rand.dat'
  5
  6  integer :: i, n, ios, to_be_found
  7  integer, allocatable :: x(:)
  8
  9  ! データファイルの読み込み
 10  open(unit=10, iostat=ios, file=datafile, action='read', &
 11       & form='formatted', status='old')
 12
 13  if(ios /= 0) then
 14    write(*, *) 'Failed to open file'
 15  endif
 16
 17  read(10, *) n
 18
 19  allocate(x(n))
 20
 21  read(10, *) x
 22
 23  close(10)
 24
 25  ! ソート
 26  call bsort(x)
 27
 28  ! 見つけたい数を読み込む
 29  write(*, fmt='(a)', advance='no') 'Input an integer : '
 30  read(*, *) to_be_found
 31
 32  ! 二分探索で見つける
 33  call bsearch(x, to_be_found, i)
 34
 35  if(i /= -1) then
 36    write(*, '(i8, a, i8)') to_be_found, ' was fouund at index ', i
 37  else
 38    write(*, '(i8, a)') to_be_found, ' was not found !'
 39  endif
 40
 41  deallocate(x)
 42
 43  stop
 44contains
 45  !
 46  ! 二分探索
 47  !
 48  subroutine bsearch(array, var, index)
 49    implicit none
 50    integer, intent(in) :: array(:) ! ソートされた配列
 51    integer, intent(in) :: var      ! 探したい値
 52    integer, intent(out) :: index    ! 見つかった要素へのインデックス
 53
 54    integer :: left, right, middle
 55
 56    index = -1
 57    left = 1
 58    right = size(array)
 59
 60    do while(left <= right)
 61      middle = (left + right) / 2
 62      if(array(middle) == var) then
 63        index = middle
 64        exit
 65      else if(array(middle) > var) then
 66        right = middle - 1
 67      else if(array(middle) < var) then
 68        left = middle + 1
 69      endif
 70    enddo
 71
 72  endsubroutine bsearch
 73
 74  !
 75  ! バブルソート
 76  !
 77  subroutine bsort(array)
 78    implicit none
 79    integer, intent(inout) :: array(:) ! 配列にはソートされた結果が代入される
 80
 81    integer :: i, j, n
 82
 83    n = size(array)
 84    do i = 1, n
 85      do j = 1, n - i
 86        call swapif(array(j), array(j + 1))
 87      enddo
 88    enddo
 89
 90  endsubroutine bsort
 91
 92  !
 93  ! a, bが a > b なら交換, それ以外なら何もしない
 94  !
 95  subroutine swapif(a, b)
 96    implicit none
 97    integer, intent(inout) :: a, b
 98
 99    integer :: c
100
101    if(a > b) then
102      c = a
103      a = b
104      b = c
105    endif
106
107  endsubroutine swapif
108
109endprogram answer