1module mod_vector
2 implicit none
3 private
4
5 type :: vector2
6 real(8) :: x, y
7 endtype vector2
8
9 type :: vector3
10 real(8) :: x, y, z
11 endtype vector3
12
13 interface operator(+)
14 module procedure add2, add3
15 endinterface operator(+)
16
17 interface operator(-)
18 module procedure sub2, sub3
19 endinterface operator(-)
20
21 interface operator(*)
22 module procedure cross2, cross3
23 endinterface operator(*)
24
25 interface assignment(=)
26 module procedure assign2, assign2_array, assign3, assign3_array
27 endinterface assignment(=)
28
29 interface show
30 module procedure show2, show3
31 endinterface show
32
33 public :: vector2, vector3
34 public :: show, operator(+), operator(-), operator(*), assignment(=)
35
36contains
37
38 !
39 ! 2次元ベクトル用演算子
40 !
41 function add2(a, b) result(ret)
42 implicit none
43 type(vector2), intent(in) :: a, b
44 type(vector2) :: ret
45
46 ret % x = a % x + b % x
47 ret % y = a % y + b % y
48 endfunction add2
49
50 function sub2(a, b) result(ret)
51 implicit none
52 type(vector2), intent(in) :: a, b
53 type(vector2) :: ret
54
55 ret % x = a % x - b % x
56 ret % y = a % y - b % y
57 endfunction sub2
58
59 function cross2(a, b) result(ret)
60 implicit none
61 type(vector2), intent(in) :: a, b
62 real(8) :: ret
63
64 ret = a % x * b % y - a % y * b % x
65 endfunction cross2
66
67 subroutine assign2(a, b)
68 implicit none
69 type(vector2), intent(out) :: a
70 real(8), intent(in) :: b
71
72 a % x = b
73 a % y = b
74 endsubroutine assign2
75
76 subroutine assign2_array(a, b)
77 implicit none
78 type(vector2), intent(out) :: a
79 real(8), intent(in) :: b(2)
80
81 a % x = b(1)
82 a % y = b(2)
83 endsubroutine assign2_array
84
85 subroutine show2(v)
86 implicit none
87 type(vector2), intent(in) :: v
88
89 write(*, '("vector2 : ", f10.4, ",", f10.4)') v % x, v % y
90 return
91 endsubroutine show2
92
93 !
94 ! 3次元ベクトル用演算子
95 !
96 function add3(a, b) result(ret)
97 implicit none
98 type(vector3), intent(in) :: a, b
99 type(vector3) :: ret
100
101 ret % x = a % x + b % x
102 ret % y = a % y + b % y
103 ret % z = a % z + b % z
104 endfunction add3
105
106 function sub3(a, b) result(ret)
107 implicit none
108 type(vector3), intent(in) :: a, b
109 type(vector3) :: ret
110
111 ret % x = a % x - b % x
112 ret % y = a % y - b % y
113 ret % z = a % z - b % z
114 endfunction sub3
115
116 function cross3(a, b) result(ret)
117 implicit none
118 type(vector3), intent(in) :: a, b
119 type(vector3) :: ret
120
121 ret % x = a % y * b % z - a % z * b % y
122 ret % y = a % z * b % x - a % x * b % z
123 ret % z = a % x * b % y - a % y * b % x
124 endfunction cross3
125
126 subroutine assign3(a, b)
127 implicit none
128 type(vector3), intent(out) :: a
129 real(8), intent(in) :: b
130
131 a % x = b
132 a % y = b
133 a % z = b
134 endsubroutine assign3
135
136 subroutine assign3_array(a, b)
137 implicit none
138 type(vector3), intent(out) :: a
139 real(8), intent(in) :: b(3)
140
141 a % x = b(1)
142 a % y = b(2)
143 a % z = b(3)
144 endsubroutine assign3_array
145
146 subroutine show3(v)
147 implicit none
148 type(vector3), intent(in) :: v
149
150 write(*, '("vector3 : ", f10.4, ",", f10.4, ",", f10.4)') v % x, v % y, v % z
151 return
152 endsubroutine show3
153
154endmodule mod_vector
155
156program answer
157 use mod_vector
158 implicit none
159
160 type(vector2) :: a, b, c
161 type(vector3) :: x, y, z
162
163 write(*, fmt='(a)') '--- vector2 ---'
164
165 a = (/1.0_8, 0.0_8/)
166 b = 1.0_8
167 c = a + b
168
169 call show(a + b)
170 call show(a - b)
171
172 write(*, fmt='("a * b = ", f12.4)') a * b
173
174 write(*, fmt='(a)') '--- vector3 ---'
175
176 x = (/1.0_8, 0.0_8, 0.0_8/)
177 y = 1.0_8
178 z = x * y
179
180 call show(x)
181 call show(y)
182 call show(z)
183 call show(x + y)
184 call show(x - y)
185
186 stop
187endprogram answer