1program sample
2 implicit none
3
4 integer, parameter :: winloss(3, 3) = &
5 & reshape((/0, +1, -1, -1, 0, +1, +1, -1, 0/),(/3, 3/))
6
7 character(128) :: ch, cyou, ccom, message
8 integer :: you, com
9 real(8) :: r
10
11 ! 乱数のseedを設定
12 call random_seed_clock()
13
14 !
15 ! コンピューターとジャンケン
16 !
17 ! グー=r, パー=p, チョキ=s を入力する. それ以外を入力すると終了.
18 !
19 do while(.true.)
20 !
21 ! ユーザーの手を入力
22 !
23 write(*, fmt='(/,a)', advance='no') &
24 & 'Input (r for rock, p for paper, s for scissors) : '
25 read(*, *) ch
26
27 select case(ch)
28 case('r')
29 you = 1
30 write(cyou, fmt='(a)') 'Rock (you)'
31 case('p')
32 you = 2
33 write(cyou, fmt='(a)') 'Paper (you)'
34 case('s')
35 you = 3
36 write(cyou, fmt='(a)') 'Scissors (you)'
37 case default
38 write(*, *) 'bye'
39 exit
40 endselect
41
42 !
43 ! コンピューターの手を乱数で決定
44 !
45 call random_number(r)
46
47 if(r <= 1.0_8 / 3.0_8) then
48 com = 1
49 write(ccom, fmt='(a)') 'Rock (Com)'
50 else if(r <= 2.0_8 / 3.0_8) then
51 com = 2
52 write(ccom, fmt='(a)') 'Paper (Com)'
53 else
54 com = 3
55 write(ccom, fmt='(a)') 'Scissors (Com)'
56 endif
57
58 write(message, fmt='(a, " v.s. ", a)') trim(cyou), trim(ccom)
59
60 select case(winloss(you, com))
61 case(-1)
62 write(*, '(a, " => ", a)') trim(message), 'You loose !'
63 case(0)
64 write(*, '(a, " => ", a)') trim(message), 'Even !'
65 case(1)
66 write(*, '(a, " => ", a)') trim(message), 'You win !'
67 case default
68 write(*, *) 'Error' ! 念の為エラー処理
69 endselect
70
71 enddo
72
73 stop
74contains
75 !
76 ! 乱数のseedをシステムクロックに応じて変更
77 !
78 subroutine random_seed_clock()
79 implicit none
80 integer :: nseed, clock
81 integer, allocatable :: seed(:)
82
83 ! システムクロックを取得
84 call system_clock(clock)
85
86 call random_seed(size=nseed)
87 allocate(seed(nseed))
88
89 seed = clock
90 call random_seed(put=seed)
91
92 deallocate(seed)
93 endsubroutine random_seed_clock
94
95endprogram sample