1program sample
2 implicit none
3
4 integer :: i
5 real(8) :: a, b, c
6 real(8) :: x(10)
7
8 do i = 1, 10
9 x(i) = real(i, 8)
10 enddo
11
12 ! intent属性
13 a = 1.0
14 b = 2.0
15 call add(a, b, c)
16 write(*, *) a, b, c
17
18 ! 配列の渡し方
19 write(*, *) 'average ===> ', average1(x), average2(10, x)
20
21 ! save属性の使い方
22 do i = 1, 10
23 call fibonacci()
24 enddo
25
26 stop
27contains
28
29 !
30 ! <<< intent属性 >>>
31 !
32 ! * intent(in) => 入力用変数(値の変更不可)
33 ! * intent(out) => 出力用変数
34 ! * intent(inout) => 入出力
35 !
36 ! 以下は
37 !
38 ! c = a + b
39 !
40 ! のような処理を行うことを意図している．ユーザーはこの場合にaやbが変更されると
41 ! は予想しないであろう．誤ってサブルーチン内でaやbの値を変更するのを防ぐために
42 ! intent(in)を指定する．
43 !
44 subroutine add(a, b, c)
45 implicit none
46 real(8), intent(in) :: a, b ! 入力用変数(変更不可)
47 real(8), intent(out) :: c ! 出力用変数
48
49 ! 以下はコンパイルエラー
50 !a = 1.0_8
51
52 ! 出力用の変数に値を代入
53 c = a + b
54
55 endsubroutine add
56
57 !
58 ! <<< 形状引継ぎ配列の使い方 >>>
59 !
60 ! 引数の配列のサイズは自動的に呼出し時に与えた配列のサイズになる
61 ! サイズが必要な場合は組み込み関数sizeを用いて取得可能
62 !
63 function average1(x) result(ave)
64 implicit none
65 real(8), intent(in) :: x(:) ! サイズは自動的に決まる
66 real(8) :: ave
67
68 ave = sum(x) / size(x)
69
70 endfunction average1
71
72 !
73 ! <<< 配列サイズの引数渡し >>>
74 !
75 ! 配列のサイズを引数として明示的に受け取る
76 !
77 function average2(n, x) result(ave)
78 implicit none
79 integer, intent(in) :: n ! サイズを引数として受け取る
80 real(8), intent(in) :: x(n) ! サイズは引数として渡された整数
81 real(8) :: ave
82
83 ave = sum(x) / size(x)
84
85 endfunction average2
86
87 !
88 ! <<< save属性 >>>
89 !
90 ! save属性付きの変数はプログラム実行中はその値を保持するので，複数回呼び出され
91 ! た場合には前回の呼出し時の値を記憶したままとなる
92 !
93 subroutine fibonacci()
94 implicit none
95 ! 以下の3つがsave属性付き (初回の呼出し時の値は宣言文で与える)
96 integer, save :: n = 1
97 integer, save :: f0 = 0
98 integer, save :: f1 = 0
99
100 integer :: f2
101
102 if(n == 1) then
103 write(*, *) 'Fibonacci number [', 0, '] = ', f0
104 f2 = 1
105 else
106 f2 = f0 + f1
107 endif
108
109 write(*, *) 'Fibonacci number [', n, '] = ', f2
110
111 ! 次回呼び出し用 (これらの値を記憶し続ける)
112 n = n + 1
113 f0 = f1
114 f1 = f2
115
116 endsubroutine fibonacci
117
118endprogram sample