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