目次

FORTRAN入門

Fortran 90

コンパイルと実行

FORTRAN90の書式

PROGRAM EXAMPLE                     ! PROGRAM 文
  IMPLICIT NONE                     ! IMPLICIT 文
  INTEGER, PARAMETER:: IMAX = 10    ! 定数（整定数）宣言
  INTEGER:: I                       ! 変数（整数変数）宣言
  REAL(8), DIMENSION(0:IMAX):: DD   ! 配列（実数配列）宣言
  REAL(8):: D, DMAX = 0.D0          ! 変数（実数変数）初期化
!                                     コメント
  READ (*, *) DD                    ! 入力
  DO I = 0, IMAX                    ! DO 文
    D = DD(I)                       ! 代入文
    IF (D > DMIN) THEN              ! IF 文
      DMAX = D                      !   字下げ
    END IF                          ! END IF文
    PRINT "(I4, 3E12.5)", I, D, &   ! 書式文字列による書式付出力
    &     DMIN, DMAX                ! 継続行
  END DO                            ! END DO文 
  PRINT *, 'MAXIMUM VALUE = ', DMAX ! 出力
  STOP                              ! STOP文
END PROGRAM EXAMPLE                 ! END PROGRAM文

定数と変数

定数 整定数 絶対値が2147483647以下の整数 -10 200 -123456
定数 実定数 F形式 有効桁数約6桁の実数 -10.0 3.14159 .00153
E形式 有効桁数約6桁の実数 3.14159E0 15.3E-3
D形式 有効桁数約16桁の実数 3.141592654D0
変数 整変数 INTEGER I,J,K,L,M,Nで始めるのが望ましい II KJ J123 M123
実変数 REAL(8) A-H, O-Zで始めるのが望ましい AA CC D123 B123

例題 1

program prog1
  print *, 'Hello, World'
  stop
end program prog1
program prog1
  print *, 'Hello, World (1)'
  print '(A)', 'Hello, World (2)'
  print '(A8)', 'Hello, World (3)'
  print '(A)', 'Hello, World'
  print '(A$)', 'Hello, '
  print '(A)', 'World'
  stop
end program prog1
  print *, 'Hello, World'
  print '(A)', 'Hello, World'
  write (*, *) 'Hello, World'
  write (*, '(A)') 'Hello, World'

例題 2

program prog2
  implicit none
  real(8):: xvalue
  write (*, '(A)', advance = 'no') 'Input X: '
  read (*, *) xvalue
  write (*, '("X = ", E15.7)') xvalue
  stop
end program prog2
program prog2
  implicit none
  real(8):: xvalue
  print '(A$)', 'Input X: '
  read (*, *) xvalue
  print '("X = ", E15.7)', xvalue
  stop
end program prog2

例題 3

program prog3
  implicit none
  integer:: counter
  real(8):: xvalue
  do counter = 1, 5
    xvalue = 1./dble(counter)
    write (*, *) counter, xvalue
  end do
  stop
end program prog3
program prog3
  implicit none
  integer:: counter
  real(8):: xvalue
  do counter = 1, 5
    xvalue = 1./dble(counter)
    print *, counter, xvalue
  end do
  stop
end program prog3

例題 4

program prog4
  implicit none
  integer, parameter:: IMAX = 10
  integer:: i, isum
  real(8):: dsum
  isum = 0
  dsum = 0.d0
  do i = 1, IMAX
    isum = isum + i
    dsum = dsum + dble(i)
    write (*, *) i, isum, dsum
  end do
  write (*, *) 'ISUM = ', isum
  write (*, *) 'DSUM = ', dsum
  write (*, *) '1/ISUM = ', 1/isum
  write (*, *) '1.D0/DSUM = ', 1.d0/dsum
  stop
end program prog4
program prog4
  implicit none
  integer, parameter:: IMAX = 10
  integer:: i, isum
  real(8):: dsum
  isum = 0
  dsum = 0.d0
  do i = 1, IMAX
    isum = isum + i
    dsum = dsum + dble(i)
    print *, i, isum, dsum
  end do
  print *, 'ISUM = ', isum
  print *, 'DSUM = ', dsum
  print *, '1/ISUM = ', 1/isum
  print *, '1.D0/DSUM = ', 1.d0/dsum
  stop
end program prog4

例題 5

program prog5
  implicit none
  integer, parameter:: IMAX = 10
  integer:: i
  real(8):: r
  do i = 1, IMAX
    call random_number(r)
    write (*, *) i, r
  end do
  stop
end program prog5

例題 6

program prog6
  implicit none
  integer:: N, M       !!!  M <- N - 1
  integer:: i          !!!  Counter
  real(8), dimension(:), allocatable:: r
  write (*, '(A)', advance = 'no') 'N = '
  read (*, *) N
  write (*, *) 'N = ', N
  M = N - 1
  allocate (r(0:M))
  call random_seed()
  call random_number(r)
  do i = 0, M
    write (*, *) i, r(i)
  end do
  deallocate (r)
  stop
end program prog6

例題 7

program prog7
  implicit none
  integer:: N, M
  integer:: i, idummy
  real(8):: dmini, trial
  real(8), dimension(:), allocatable:: r
  read (*, *) N
  write (*, *) 'Number of Data = ', N
  M = N - 1
  allocate (r(0:M))
  do i = 0, M
    read (*, *) idummy, r(i)
  end do
!
  dmini = r(0)
  do i = 1, M
    trial = r(i)
    if (trial <= dmini) then
      dmini = trial
      write (*, '(A10)', advance = 'no') 'CHANGED: '
      write (*, '(I8, 2E15.7)') i, trial, dmini
    else
      write (*, '(A10, I8, 2E15.7)') ' ', i, trial, dmini
    end if
  end do
  deallocate (r)
  write (*, *) 'Minimum Value = ', dmini
  stop
end program prog7

例題 8

program prog8
  implicit none
  integer, parameter:: N = 100, M = N - 1
  real(8):: a, b, h
  real(8), dimension(0:M):: x, y, z
  real(8):: getvalue
  integer:: i
  a = 0.d0
  b = 1.d0
  h = (b - a)/dble(N)
  do i = 0, M
    x(i) = a + h*dble(i)
    call setvalue(x(i), y(i))
    z(i) = getvalue(x(i))
  end do
  do i = 0, M
    write (*, '(3E15.7)') x(i), y(i), z(i)
  end do
  stop
end program prog8
!
subroutine setvalue(xval, yval)
  implicit none
  real(8):: xval, yval
  yval = sin(xval)
  return
end subroutine setvalue
!
function getvalue(xval) result(yval)
  implicit none
  real(8):: xval, yval
  yval = exp(-xval)
  return
end function getvalue
program prog10
  implicit none
  integer, parameter:: NX = 511, NY = 511
  real(8):: a = -5.D0, b = 5.D0, c = -5.D0, d = 5.D0
  real(8):: h, zmin, zmax
  real(8), dimension(0:NX):: x
  real(8), dimension(0:NY):: y
  real(8), dimension(0:NX, 0:NY):: z
  integer, dimension(0:NX, 0:NY):: iz
  real(8):: getvalue
  integer:: i, j
!
  h = (b - a)/dble(NX)
  do i = 0, NX
    x(i) = a + h*dble(i)
  end do
!
  h = (d - c)/dble(NY)
  do j = 0, NY
    y(j) = c + h*dble(j)
  end do
 
  do i = 0, NX
    do j = 0, NY 
      z(i, j) = getvalue(x(i), y(j))
    end do
  end do 
!
  zmin = minval(z)
  zmax = maxval(z)
  do i = 0, NX
    do j = 0, NY 
      iz(i, j) = int(255.0*(z(i, j) - zmin)/(zmax - zmin))
    end do
  end do 
 
  do j = 0, NY
    do i = 0, NX 
      print '(I4$)', iz(i, j)
    end do
        print '(A)', ' '
  end do
!
  stop
end program prog10
!
function getvalue(xval, yval) result(zval)
  implicit none
  real(8):: xval, yval, zval
  zval = exp(-(xval*xval + yval*yval))
  return
end function getvalue

x=Aからx=Bまでの区間をN分割し、関数値 f(x) を出力するプログラムを作成する。

  1. $\begin{array}{*{20}c}{f\left( x \right) = \sqrt x ,} & {\left( {0 \le x \le 10} \right)}\end{array}$
  2. $\begin{array}{*{20}c}{f\left( x \right) = \log |x+1| ,} & {\left( {-1 < x \le 10} \right)}\end{array} $
  3. $\begin{array}{*{20}c}{f\left( x \right) = x^2{\rm e}^{-x} ,} & {\left( {0 \le x \le 6} \right)}\end{array} $
  4. $\begin{array}{*{20}c}{f\left( x \right) = x^2{\rm e}^{-x^2} ,} & {\left( {-4 \le x \le 4} \right)}\end{array} $
  5. $\begin{array}{*{20}c}{f\left( x \right) = \displaystyle\frac{\sin^2 x}{x^2} ,} & {\left( {-4\pi \le x \le 4\pi} \right)}\end{array} $

簡易版　例題8

program prog81
  implicit none
  integer, parameter:: N = 100
  real(8):: a = 0.D0, b = 1.D0
  real(8):: h
  real(8), dimension(0:N):: x, y
  real(8):: getvalue
  integer:: i
!
  h = (b - a)/dble(N)
!
  do i = 0, N
    x(i) = a + h*dble(i)
  end do
!
  do i = 0, N
    y(i) = getvalue(x(i))
  end do
!
  do i = 0, N
    print '(2E15.7)', x(i), y(i)
  end do
!
  stop
end program prog81
!
function getvalue(xval) result(yval)
  implicit none
  real(8):: xval, yval
  yval = exp(-xval)
  return
end function getvalue

プログラム「moge_exec」に、ファイル「hoge_in.data」から入力を読み込んで、出力をファイル「hage_out.data」に書き込むには 

$ ./moge_exec < hoge_in.data > hage_out.data

または 

$ cat hoge_in.data | ./moge_exec > hage_out.data

とする。

固定サイズ配列型　例題7

program prog71
  implicit none
  integer, parameter:: N = 100, M = N - 1
  real(8), dimension(0:M):: r
  integer:: i, idummy
  real(8):: dmini, trial
!
  do i = 0, M
    read (*, *) idummy, r(i)
  end do
!
  dmini = r(0)
  do i = 1, M
    trial = r(i)
    if (trial <= dmini) then
      dmini = trial
      print '(A10$)', 'CHANGED: '
      print '(I8, 2E15.7)', i, trial, dmini
    else
      print '(A10, I8, 2E15.7)', '', i, trial, dmini
    end if
  end do
!
  print *, 'Minimum Value = ', dmini
  stop
end program prog71

prog5に

  1. call random_seed()　を加えて実行。
  2. 配列を使う
real(8):: r →  real(8), dimension(IMAX):: r
  r → r(i)
  1. call random_number® に変更して場所もdoの前に移動
  print '(A$)', 'Input N: '
  read (*, *) n

を追加

最終的な例題5

program prog55
  implicit none
  integer, parameter:: IMAX = 10
  integer:: i, n, m
  real(8), dimension(0:IMAX):: r ! r(0), r(1), ..., r(10)
  call random_seed()
  print '(A$)', 'Input N: '
  read (*, *) n
  m = n - 1 
  call random_number(r)
  do i = 0, m
    print *, i, r(i)
  end do
  stop
end program prog55

例題　2

例題　3

例題　4

例題　5

program prog5
  implicit none
  integer, parameter:: IMAX = 10
  integer:: i
  real(8):: r
  do i = 1, IMAX
    call random_number(r)
    print *, i, r
  end do
  stop
end program prog5

例題　6

program prog6
  implicit none
  integer:: N, M       !!!  M <- N - 1
  integer:: i          !!!  Counter
  real(8), dimension(:), allocatable:: r
  print '(A$)', 'N = '
  read (*, *) N
  print *, 'N = ', N
  M = N - 1
  allocate (r(0:M))
  call random_seed()
  call random_number(r)
  do i = 0, M
    print *, i, r(i)
  end do
  deallocate (r)
  stop
end program prog6

例題　7

program prog7
  implicit none
  integer:: N, M
  integer:: i, idummy
  real(8):: dmini, trial
  real(8), dimension(:), allocatable:: r
  read (*, *) N
  write (*, *) 'Number of Data = ', N
  M = N - 1
  allocate (r(0:M))
  do i = 0, M
    read (*, *) idummy, r(i)
  end do
!
  dmini = r(0)
  do i = 1, M
    trial = r(i)
    if (trial <= dmini) then
      dmini = trial
      print '(A10$)', 'CHANGED: '
      print '(I8, 2E15.7)', i, trial, dmini
    else
      print '(A10, I8, 2E15.7)', '', i, trial, dmini
    end if
  end do
  deallocate (r)
  print *, 'Minimum Value = ', dmini
  stop
end program prog7

例題　8

program prog8
  implicit none
  integer, parameter:: N = 100, M = N - 1
  real(8):: a, b, h
  real(8), dimension(0:M):: x, y, z
  real(8):: getvalue
  integer:: i
  a = 0.d0
  b = 1.d0
  h = (b - a)/dble(N)
  do i = 0, M
    x(i) = a + h*dble(i)
    call setvalue(x(i), y(i))
    z(i) = getvalue(x(i))
  end do
  do i = 0, M
    print '(3E15.7)', x(i), y(i), z(i)
  end do
  stop
end program prog8
subroutine setvalue(xval, yval)
  implicit none
  real(8):: xval, yval
  yval = sin(xval)
  return
end subroutine setvalue
function getvalue(xval) result(yval)
  implicit none
  real(8):: xval, yval
  yval = exp(-xval)
  return
end function getvalue