1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
C integer byte case with integer byte parameters as case(s)
subroutine ib
integer *1 a /1/
integer *1 one,two,three
parameter (one=1,two=2,three=3)
select case (a)
case (one)
case (two)
call abort
case (three)
call abort
case default
call abort
end select
print*,'normal ib'
end
C integer halfword case with integer halfword parameters
subroutine ih
integer *2 a /1/
integer *2 one,two,three
parameter (one=1,two=2,three=3)
select case (a)
case (one)
case (two)
call abort
case (three)
call abort
case default
call abort
end select
print*,'normal ih'
end
C integer case with integer parameters
subroutine iw
integer *4 a /1/
integer *4 one,two,three
parameter (one=1,two=2,three=3)
select case (a)
case (one)
case (two)
call abort
case (three)
call abort
case default
call abort
end select
print*,'normal iw'
end
C integer double case with integer double parameters
subroutine id
integer *8 a /1/
integer *8 one,two,three
parameter (one=1,two=2,three=3)
select case (a)
case (one)
case (two)
call abort
case (three)
call abort
case default
call abort
end select
print*,'normal id'
end
C integer byte select with integer case
subroutine ib_mixed
integer*1 s /1/
select case (s)
case (1)
case (2)
call abort
end select
print*,'ib ok'
end
C integer halfword with integer case
subroutine ih_mixed
integer*2 s /1/
select case (s)
case (1)
case default
call abort
end select
print*,'ih ok'
end
C integer word with integer case
subroutine iw_mixed
integer s /5/
select case (s)
case (1)
call abort
case (2)
call abort
case (3)
call abort
case (4)
call abort
case (5)
C
case (6)
call abort
case default
call abort
end select
print*,'iw ok'
end
C integer doubleword with integer case
subroutine id_mixed
integer *8 s /1024/
select case (s)
case (1)
call abort
case (1023)
call abort
case (1025)
call abort
case (1024)
C
end select
print*,'i8 ok'
end
subroutine l1_mixed
logical*1 s /.TRUE./
select case (s)
case (.TRUE.)
case (.FALSE.)
call abort
end select
print*,'l1 ok'
end
subroutine l2_mixed
logical*2 s /.FALSE./
select case (s)
case (.TRUE.)
call abort
case (.FALSE.)
end select
print*,'lh ok'
end
subroutine l4_mixed
logical*4 s /.TRUE./
select case (s)
case (.FALSE.)
call abort
case (.TRUE.)
end select
print*,'lw ok'
end
subroutine l8_mixed
logical*8 s /.TRUE./
select case (s)
case (.TRUE.)
case (.FALSE.)
call abort
end select
print*,'ld ok'
end
C main
C -- regression cases
call ib
call ih
call iw
call id
C -- new functionality
call ib_mixed
call ih_mixed
call iw_mixed
call id_mixed
end
|
