1program answer
2 implicit none
3
4 integer, parameter :: n = 100
5 integer :: i, m, ios
6 character(len=10) :: input, x(n), y(n)
7
8 m = 0
9 read(*, fmt='(a)', iostat=ios) input
10
11 ! 正常に読み込めていれば(ios = 0, 改行は input = '')
12 do while(ios == 0 .and. input /= '')
13 x(m + 1) = input
14 m = m + 1
15 read(*, fmt='(a)', iostat=ios) input
16 enddo
17
18 ! ソート
19 y(1:m) = x(1:m)
20 call bsort(y, m)
21
22 ! 結果の表示
23 write(*, fmt='(a)') '*** before sort ***'
24 do i = 1, m
25 write(*, fmt='(a11)', advance='no') adjustl(x(i))
26 enddo
27 write(*, *)
28
29 write(*, fmt='(a)') '*** after sort ***'
30 do i = 1, m
31 write(*, fmt='(a11)', advance='no') adjustl(y(i))
32 enddo
33 write(*, *)
34
35 stop
36contains
37 !
38 ! 文字列をバブルソートで辞書順にソートする
39 !
40 subroutine bsort(array, n)
41 implicit none
42 character(len=10), intent(inout) :: array(:)
43 integer, intent(in) :: n
44
45 integer :: i, j
46
47 do i = 1, n
48 do j = 1, n - i
49 call swapif(array(j), array(j + 1))
50 enddo
51 enddo
52
53 endsubroutine bsort
54
55 !
56 ! a, bが a > b なら交換, それ以外なら何もしない
57 !
58 subroutine swapif(a, b)
59 implicit none
60 character(len=10), intent(inout) :: a, b
61
62 character(len=10) :: c
63
64 if(a > b) then
65 c = a
66 a = b
67 b = c
68 endif
69
70 endsubroutine swapif
71
72endprogram answer