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