Docstoc

情報処理概論12.pptx

Document Sample
情報処理概論12.pptx Powered By Docstoc
					    情報処理概論

工学部 物質科学工学科 応用化学コース 機能物質化学クラス

            第12回

                                1
   先週の演習の解答例
四目並べの手の入力           1 2 3 4 5 6 7
                    [ ][ ][ ][ ][ ][ ][   ]
                    [ ][ ][ ][ ][ ][ ][   ]
                    [ ][ ][ ][ ][ ][ ][   ]
”ヒント”で未実装だった        [ ][ ][*][ ][ ][ ][   ]
                    [ ][ ][o][*][ ][ ][   ]
部分:                 [*][*][o][o][o][*][   ]
・列が一杯かどうか?         o : Drop where? (0 =   Exit) 2
                    1 2 3 4 5 6 7
・盤の更新               [ ][ ][ ][ ][ ][ ][   ]
                    [ ][ ][ ][ ][ ][ ][   ]
                    [ ][ ][ ][ ][ ][ ][   ]
                    [ ][ ][*][ ][ ][ ][   ]
                    [ ][o][o][*][ ][ ][   ]
                    [*][*][o][o][o][*][   ]
                   * : Drop where? (0 =   Exit)
               2
      列が一杯かどうか?
  指定された列の一番上が空かどうか?
   
if (board(x, n) /= ' ') then
   write(*, *) ' This column is full!!'
                          x列目
              6   [ ][ ][o][*][ ][ ][ ]
              5   [ ][*][o][*][ ][ ][ ]
              4   [ ][o][*][o][ ][ ][ ]
          n   3   [ ][*][o][*][ ][ ][ ]
              2   [ ][*][o][o][ ][ ][ ]
              1   [*][o][*][o][*][ ][ ]
                   1 2 3 4 5 6 7
                    3      m
                  盤の更新
    指定された列で空白な要素のうち一番下の要素
    に新しい玉を追加
    例) x列目を上から下へ調べてゆき、
       「一つ下の要素が空白以外」である要素が
       見つかったら、そこに新しい玉を配置
    [ ][ ][o][*][ ][   ][   ]
    [ ][*][o][*][ ][   ][   ]     board(x, 5)
    [ ][o][*][o][ ][   ][   ]     board(x, 4)
n   [ ][*][o][*][*][   ][   ]     board(x, 3)
    [ ][*][o][o][o][   ][   ]
                              board(x, 3) が空白でないので
    [*][o][*][o][*][   ][   ]
                              board(x, 4) に新しい玉を配置

             m               4
                     盤の更新
        n
    y = 指定された列で空白な要素のうち一番下の要素
    do while ((y>1).and.(board(x, y-1)==' '))
        に新しい玉を追加
      y = y - 1
                                          x列目
    end do
    board(x, y) = mark
       [ ][ ][o][*][ ][   ][   ]
       [ ][*][o][*][ ][   ][   ]       board(x, 5)
       [ ][o][*][o][ ][   ][   ]       board(x, 4)
n      [ ][*][o][*][*][   ][   ]       board(x, 3)
       [ ][*][o][o][o][   ][   ]
       [*][o][*][o][*][   ][   ]

                m                  5
             サブルーチン drop
subroutine drop(m, n, board, side)
implicit none
integer, intent(IN) :: m, n, side
character(len=1), dimension(m, n), intent(INOUT) :: board
integer :: x, done
character(len=1) :: mark

 select case (side)
 case (1)
   mark = '*'
 case (2)
   mark = 'o'
 end select

 done = 0
 do while (done == 0)
   write(*, '(a, a)', advance='NO') &
          mark, ' : Drop where? (0 = Exit) '
   read(*, *) x                6
       サブルーチン drop (続き)
    if (x == 0) then
       stop
    else if (x > m .or. x < 1) then
      write(*, *) ' Out of range!!'
    else if (board(x, n) /= ' ') then
      write(*, *) ' This column is full!!'
    else
      y = n
      do while ((y > 1) .and. (board(x, y-1) == ' '))
         y = y - 1
      end do
      board(x, y) = mark
      done = 1
    end if
  end do
end subroutine
                               7
                  別の方法
    if (x == 0) then
       stop
    else if (x > m .or. x < 1) then
      write(*, *) ' Out of range!!'
    else
      y = 1
      do while ((y <= n) .and. (board(x, y) /= ' '))
         y = y + 1
      end do
      if (y <= n) then
         board(x, y) = mark
         done = 1
      else
         write(*, *) ' This column is full!!'
      end if
    end if               指定された列を下から上に調べてゆき、
  end do                 空白の要素が見つかったらそこに新しい
end subroutine           玉を配置する
                         8
     今回の内容
関数




       9
    今日の予習プログラム(1/3)
program sample3
  implicit none
  integer :: number1, number2
  integer, dimension(:), allocatable :: english, math
  real(8), external :: average
  intrinsic dble

  open(10, file="eng.dat")
  read(10, *) number1
  allocate(english(number1))
  call input_data(10, number1, english)
  close(10)

  write(*, '(A20, F6.2)') "Ave. of English = ", &
                         average(number1,
english)

  open(11, file="math.dat")
  read(11, *) number2
  allocate(math(number2))                               次ページへ続く
                                math)
  call input_data(11, number2, 10
    今日の予習プログラム(2/3)
  write(*, '(A20, F6.2)') "Ave. of Math = ", &
                          average(number2, math)
stop
end program

subroutine input_data(file, n, a)
  implicit none
  integer, intent(IN) :: file
  integer, intent(IN) :: n
  integer, dimension(n), intent(OUT) :: a
  integer :: i

  do i = 1, n
    read(file, *) a(i)
  end do
end subroutine




                                                   次ページへ続く
                              11
    今日の予習プログラム(3/3)
function average(n, a)
  implicit none
  integer, intent(IN) :: n
  integer, dimension(n), intent(IN) :: a
  real(8) :: average
  integer :: i, total
  intrinsic dble

  total = 0
  do i = 1, n
    total = total + a(i)
  end do

  average = dble(total) / dble(n)

end function




                              12
                 関数の定義
  function 関数名(引数)
    implicit none
    変数,関数の宣言(引数やこの関数自身の宣言も行う)

   ... 計算 ...

    関数名 = 式
  end function

主プログラムの外で function ~ end function により定
義
関数自身も変数として宣言する
関数と同名の変数に格納された値が
「返り値」として呼び出し側に返される.

                    13
               関数定義の例
                名前        引数
function average(n, a)
  implicit none
  integer, intent(IN) :: n                 引数の宣言
  integer, dimension(n), intent(IN) :: a
  real(8) :: average
                                              関数(の返り値)
  integer :: i, total                         の宣言
  intrinsic dble
                             関数内で用いる変数や関数
 total = 0                   の宣言
 do i = 1, n
   total = total + a(i)
 end do

 average = dble(total) / dble(n)
                                           返り値の計算, 
end function                               代入
                             14
        関数の利用法
使用する関数の宣言
データ型名, external :: 関数名




関数の呼び出し
 通常の関数と同じ
 引数の順番に注意
 関数からさらに他の関数を呼び出しても良い
  呼び出し側の関数の中で,呼び出される側の関数の宣言が
  必要

                  15
                  関数利用の例
program sample3
  implicit none
  integer :: number1, number2
  integer, dimension(:), allocatable :: english, math
  real(8), external :: average
  intrinsic dble
                                            使用する関数の宣言
  ...

  write(*, '(A20, F6.2)') "Ave. of Math = ", &
                          average(number2, math)
stop
end program
                       関数の呼び出し              引数


                                16
intrinsic 関数と external関数
intrinsic関数
  Fortranの規格で定義されている組み込み関数
    sin, cos, sqrt, dble 等
  講義の Webページから辿れる
   「Fortran90 プログラミング」
  の付録を参照

external関数
  プログラマが定義した関数



                             17
          関数を使ったプログラム例:
           台形積分のプログラム
       台形積分
                      h = (b – a) / n

                                 区間 [xi, xi+1 ) の積分を
                                 台形で近似
f(x)
                                 f(xi)
                                         f(xi+1)
  a              b                                     f(xi+2)
                                         si     si+1
         n等分
   x0 ... xi ... xn               xi          xi+1 xi+2
     xi = a + h × i
                         18
                 台形積分
1区間の面積
     si = (f(xi)+f(xi+1)) × h / 2

全区間の面積
 S = s0 + s1 + ... + sn-1
   = (h / 2) × (f(x0)+f(x1)+f(x1)+f(x2)+f(x2)+f(x3)
                              ... +f(xn-1)+f(xn))
   = (h / 2) × (f(x0) + f(xn) + 2 ×(f(x1) + ... + f(xn-1))
   = (h / 2) × ( f(a) + f(b) + 2×(f(x1) + ... + f(xn-1) )



                            19
         台形積分プログラム(1/3)
program trapezoid
  implicit none
  integer, parameter :: n = 1000
  integer :: i
  real(8) :: start, end, s1, s2, h
  real(8), external :: f, ff

 write(*, *) "Start point? "
 read(*, *) start
 write(*, *) "End point? "
 read(*, *) end

 h = (end - start) / dble(n)
 s1 = 0.0D0
 do i = 1, n-1
   s1 = s1 + f(start + h * i)
 end do
 s1 = (s1 * 2.0D0 + f(start) + f(end)) * h / 2.0D0
                               20
         台形積分プログラム(2/3)
  write(*, '(A, F15.12)') 'Trapezoid: ', s1

  s2 = ff(end) – ff(start)
  write(*, '(A, F15.12)') 'Integral:   ', s2
stop
end program




                             21
         台形積分プログラム(3/3)
function f(x)
  implicit none
  real(8), intent(IN) :: x
  real(8) :: f
  intrinsic sin

  f = sin(x)
end function

function ff(x)
  implicit none
  real(8), intent(IN) :: x
  real(8) :: ff
  intrinsic cos

  ff = -1d0 * cos(x)
end function
                             22

				
DOCUMENT INFO
Shared By:
Categories:
Tags:
Stats:
views:0
posted:12/2/2013
language:Japanese
pages:22