gcc/testsuite/gfortran.dg/g77/f90-intrinsic-bit.f

   1 c { dg-do run }
   2 c  f90-intrinsic-bit.f
   3 c
   4 c Test Fortran 90
   5 c  * intrinsic bit manipulation functions - Section 13.10.10
   6 c  * bitcopy subroutine - Section 13.9.3
   7 c David Billinghurst <David.Billinghurst@riotinto.com>
   8 c
   9 c Notes:
  10 c  * g77 only supports scalar arguments
  11 c  * third argument of ISHFTC is not optional in g77
  12
  13       logical fail
  14       integer   i, i2, ia, i3
  15       integer*2 j, j2, j3, ja
  16       integer*1 k, k2, k3, ka
  17       integer*8 m, m2, m3, ma
  18
  19       common /flags/ fail
  20       fail = .false.
  21
  22 c     BIT_SIZE - Section 13.13.16
  23 c     Determine BIT_SIZE by counting the bits
  24       ia = 0
  25       i = 0
  26       i = not(i)
  27       do while ( (i.ne.0) .and. (ia.lt.127) )
  28          ia = ia + 1
  29          i = ishft(i,-1)
  30       end do
  31       call c_i(BIT_SIZE(i),ia,'BIT_SIZE(integer)')
  32       ja = 0
  33       j = 0
  34       j = not(j)
  35       do while  ( (j.ne.0) .and. (ja.lt.127) )
  36          ja = ja + 1
  37          j = ishft(j,-1)
  38       end do
  39       call c_i2(BIT_SIZE(j),ja,'BIT_SIZE(integer*2)')
  40       ka = 0
  41       k = 0
  42       k = not(k)
  43       do while ( (k.ne.0) .and. (ka.lt.127) )
  44          ka = ka + 1
  45          k = ishft(k,-1)
  46       end do
  47       call c_i1(BIT_SIZE(k),ka,'BIT_SIZE(integer*1)')
  48       ma = 0
  49       m = 0
  50       m = not(m)
  51       do while ( (m.ne.0) .and. (ma.lt.127) )
  52          ma = ma + 1
  53          m = ishft(m,-1)
  54       end do
  55       call c_i8(BIT_SIZE(m),ma,'BIT_SIZE(integer*8)')
  56
  57 c     BTEST  - Section 13.13.17
  58       j  = 7
  59       j2 = 3
  60       k  = 7
  61       k2 = 3
  62       m  = 7
  63       m2 = 3
  64       call c_l(BTEST(7,3),.true.,'BTEST(integer,integer)')
  65       call c_l(BTEST(7,j2),.true.,'BTEST(integer,integer*2)')
  66       call c_l(BTEST(7,k2),.true.,'BTEST(integer,integer*1)')
  67       call c_l(BTEST(7,m2),.true.,'BTEST(integer,integer*8)')
  68       call c_l(BTEST(j,3),.true.,'BTEST(integer*2,integer)')
  69       call c_l(BTEST(j,j2),.true.,'BTEST(integer*2,integer*2)')
  70       call c_l(BTEST(j,k2),.true.,'BTEST(integer*2,integer*1)')
  71       call c_l(BTEST(j,m2),.true.,'BTEST(integer*2,integer*8)')
  72       call c_l(BTEST(k,3),.true.,'BTEST(integer*1,integer)')
  73       call c_l(BTEST(k,j2),.true.,'BTEST(integer*1,integer*2)')
  74       call c_l(BTEST(k,k2),.true.,'BTEST(integer*1,integer*1)')
  75       call c_l(BTEST(k,m2),.true.,'BTEST(integer*1,integer*8)')
  76       call c_l(BTEST(m,3),.true.,'BTEST(integer*8,integer)')
  77       call c_l(BTEST(m,j2),.true.,'BTEST(integer*8,integer*2)')
  78       call c_l(BTEST(m,k2),.true.,'BTEST(integer*8,integer*1)')
  79       call c_l(BTEST(m,m2),.true.,'BTEST(integer*8,integer*8)')
  80
  81 c     IAND   - Section 13.13.40
  82       j  = 3
  83       j2 = 1
  84       ja = 1
  85       k  = 3
  86       k2 = 1
  87       ka = 1
  88       m  = 3
  89       m2 = 1
  90       ma = 1
  91       call c_i(IAND(3,1),1,'IAND(integer,integer)')
  92       call c_i2(IAND(j,j2),ja,'IAND(integer*2,integer*2)')
  93       call c_i1(IAND(k,k2),ka,'IAND(integer*1,integer*1)')
  94       call c_i8(IAND(m,m2),ma,'IAND(integer*8,integer*8)')
  95
  96
  97 c     IBCLR  - Section 13.13.41
  98       j  = 14
  99       j2 = 1
 100       ja = 12
 101       k  = 14
 102       k2 = 1
 103       ka = 12
 104       m  = 14
 105       m2 = 1
 106       ma = 12
 107       call c_i(IBCLR(14,1),12,'IBCLR(integer,integer)')
 108       call c_i(IBCLR(14,j2),12,'IBCLR(integer,integer*2)')
 109       call c_i(IBCLR(14,k2),12,'IBCLR(integer,integer*1)')
 110       call c_i(IBCLR(14,m2),12,'IBCLR(integer,integer*8)')
 111       call c_i2(IBCLR(j,1),ja,'IBCLR(integer*2,integer)')
 112       call c_i2(IBCLR(j,j2),ja,'IBCLR(integer*2,integer*2)')
 113       call c_i2(IBCLR(j,k2),ja,'IBCLR(integer*2,integer*1)')
 114       call c_i2(IBCLR(j,m2),ja,'IBCLR(integer*2,integer*8)')
 115       call c_i1(IBCLR(k,1),ka,'IBCLR(integer*1,integer)')
 116       call c_i1(IBCLR(k,j2),ka,'IBCLR(integer*1,integer*2)')
 117       call c_i1(IBCLR(k,k2),ka,'IBCLR(integer*1,integer*1)')
 118       call c_i1(IBCLR(k,m2),ka,'IBCLR(integer*1,integer*8)')
 119       call c_i8(IBCLR(m,1),ma,'IBCLR(integer*8,integer)')
 120       call c_i8(IBCLR(m,j2),ma,'IBCLR(integer*8,integer*2)')
 121       call c_i8(IBCLR(m,k2),ma,'IBCLR(integer*8,integer*1)')
 122       call c_i8(IBCLR(m,m2),ma,'IBCLR(integer*8,integer*8)')
 123
 124 c     IBSET  - Section 13.13.43
 125       j  = 12
 126       j2 = 1
 127       ja = 14
 128       k  = 12
 129       k2 = 1
 130       ka = 14
 131       m  = 12
 132       m2 = 1
 133       ma = 14
 134       call c_i(IBSET(12,1),14,'IBSET(integer,integer)')
 135       call c_i(IBSET(12,j2),14,'IBSET(integer,integer*2)')
 136       call c_i(IBSET(12,k2),14,'IBSET(integer,integer*1)')
 137       call c_i(IBSET(12,m2),14,'IBSET(integer,integer*8)')
 138       call c_i2(IBSET(j,1),ja,'IBSET(integer*2,integer)')
 139       call c_i2(IBSET(j,j2),ja,'IBSET(integer*2,integer*2)')
 140       call c_i2(IBSET(j,k2),ja,'IBSET(integer*2,integer*1)')
 141       call c_i2(IBSET(j,m2),ja,'IBSET(integer*2,integer*8)')
 142       call c_i1(IBSET(k,1),ka,'IBSET(integer*1,integer)')
 143       call c_i1(IBSET(k,j2),ka,'IBSET(integer*1,integer*2)')
 144       call c_i1(IBSET(k,k2),ka,'IBSET(integer*1,integer*1)')
 145       call c_i1(IBSET(k,m2),ka,'IBSET(integer*1,integer*8)')
 146       call c_i8(IBSET(m,1),ma,'IBSET(integer*8,integer)')
 147       call c_i8(IBSET(m,j2),ma,'IBSET(integer*8,integer*2)')
 148       call c_i8(IBSET(m,k2),ma,'IBSET(integer*8,integer*1)')
 149       call c_i8(IBSET(m,m2),ma,'IBSET(integer*8,integer*8)')
 150
 151 c     IEOR   - Section 13.13.45
 152       j  = 3
 153       j2 = 1
 154       ja = 2
 155       k  = 3
 156       k2 = 1
 157       ka = 2
 158       m  = 3
 159       m2 = 1
 160       ma = 2
 161       call c_i(IEOR(3,1),2,'IEOR(integer,integer)')
 162       call c_i2(IEOR(j,j2),ja,'IEOR(integer*2,integer*2)')
 163       call c_i1(IEOR(k,k2),ka,'IEOR(integer*1,integer*1)')
 164       call c_i8(IEOR(m,m2),ma,'IEOR(integer*8,integer*8)')
 165
 166 c     ISHFT  - Section 13.13.49
 167       i  = 3
 168       i2 = 1
 169       i3 = 0
 170       ia = 6
 171       j  = 3
 172       j2 = 1
 173       j3 = 0
 174       ja = 6
 175       k  = 3
 176       k2 = 1
 177       k3 = 0
 178       ka = 6
 179       m  = 3
 180       m2 = 1
 181       m3 = 0
 182       ma = 6
 183       call c_i(ISHFT(i,i2),ia,'ISHFT(integer,integer)')
 184       call c_i(ISHFT(i,BIT_SIZE(i)),i3,'ISHFT(integer,integer) 2')
 185       call c_i(ISHFT(i,-BIT_SIZE(i)),i3,'ISHFT(integer,integer) 3')
 186       call c_i(ISHFT(i,0),i,'ISHFT(integer,integer) 4')
 187       call c_i2(ISHFT(j,j2),ja,'ISHFT(integer*2,integer*2)')
 188       call c_i2(ISHFT(j,BIT_SIZE(j)),j3,
 189      $     'ISHFT(integer*2,integer*2) 2')
 190       call c_i2(ISHFT(j,-BIT_SIZE(j)),j3,
 191      $     'ISHFT(integer*2,integer*2) 3')
 192       call c_i2(ISHFT(j,0),j,'ISHFT(integer*2,integer*2) 4')
 193       call c_i1(ISHFT(k,k2),ka,'ISHFT(integer*1,integer*1)')
 194       call c_i1(ISHFT(k,BIT_SIZE(k)),k3,
 195      $     'ISHFT(integer*1,integer*1) 2')
 196       call c_i1(ISHFT(k,-BIT_SIZE(k)),k3,
 197      $     'ISHFT(integer*1,integer*1) 3')
 198       call c_i1(ISHFT(k,0),k,'ISHFT(integer*1,integer*1) 4')
 199       call c_i8(ISHFT(m,m2),ma,'ISHFT(integer*8,integer*8)')
 200       call c_i8(ISHFT(m,BIT_SIZE(m)),m3,
 201      $     'ISHFT(integer*8,integer*8) 2')
 202       call c_i8(ISHFT(m,-BIT_SIZE(m)),m3,
 203      $     'ISHFT(integer*8,integer*8) 3')
 204       call c_i8(ISHFT(m,0),m,'ISHFT(integer*8,integer*8) 4')
 205
 206 c     ISHFTC - Section 13.13.50
 207 c     The third argument is not optional in g77
 208       i  = 3
 209       i2 = 2
 210       i3 = 3
 211       ia = 5
 212       j  = 3
 213       j2 = 2
 214       j3 = 3
 215       ja = 5
 216       k  = 3
 217       k2 = 2
 218       k3 = 3
 219       ka = 5
 220       m2 = 2
 221       m3 = 3
 222       ma = 5
 223 c     test all the combinations of arguments
 224       call c_i(ISHFTC(i,i2,i3),5,'ISHFTC(integer,integer,integer)')
 225       call c_i(ISHFTC(i,i2,j3),5,'ISHFTC(integer,integer,integer*2)')
 226       call c_i(ISHFTC(i,i2,k3),5,'ISHFTC(integer,integer,integer*1)')
 227       call c_i(ISHFTC(i,i2,m3),5,'ISHFTC(integer,integer,integer*8)')
 228       call c_i(ISHFTC(i,j2,i3),5,'ISHFTC(integer,integer*2,integer)')
 229       call c_i(ISHFTC(i,j2,j3),5,'ISHFTC(integer,integer*2,integer*2)')
 230       call c_i(ISHFTC(i,j2,k3),5,'ISHFTC(integer,integer*2,integer*1)')
 231       call c_i(ISHFTC(i,j2,m3),5,'ISHFTC(integer,integer*2,integer*8)')
 232       call c_i(ISHFTC(i,k2,i3),5,'ISHFTC(integer,integer*1,integer)')
 233       call c_i(ISHFTC(i,k2,j3),5,'ISHFTC(integer,integer*1,integer*2)')
 234       call c_i(ISHFTC(i,k2,k3),5,'ISHFTC(integer,integer*1,integer*1)')
 235       call c_i(ISHFTC(i,k2,m3),5,'ISHFTC(integer,integer*1,integer*8)')
 236       call c_i(ISHFTC(i,m2,i3),5,'ISHFTC(integer,integer*8,integer)')
 237       call c_i(ISHFTC(i,m2,j3),5,'ISHFTC(integer,integer*8,integer*2)')
 238       call c_i(ISHFTC(i,m2,k3),5,'ISHFTC(integer,integer*8,integer*1)')
 239       call c_i(ISHFTC(i,m2,m3),5,'ISHFTC(integer,integer*8,integer*8)')
 240
 241       call c_i2(ISHFTC(j,i2,i3),ja,'ISHFTC(integer*2,integer,integer)')
 242       call c_i2(ISHFTC(j,i2,j3),ja,
 243      $     'ISHFTC(integer*2,integer,integer*2)')
 244       call c_i2(ISHFTC(j,i2,k3),ja,
 245      $     'ISHFTC(integer*2,integer,integer*1)')
 246       call c_i2(ISHFTC(j,i2,m3),ja,
 247      $     'ISHFTC(integer*2,integer,integer*8)')
 248       call c_i2(ISHFTC(j,j2,i3),ja,
 249      $     'ISHFTC(integer*2,integer*2,integer)')
 250       call c_i2(ISHFTC(j,j2,j3),ja,
 251      $     'ISHFTC(integer*2,integer*2,integer*2)')
 252       call c_i2(ISHFTC(j,j2,k3),ja,
 253      $     'ISHFTC(integer*2,integer*2,integer*1)')
 254       call c_i2(ISHFTC(j,j2,m3),ja,
 255      $     'ISHFTC(integer*2,integer*2,integer*8)')
 256       call c_i2(ISHFTC(j,k2,i3),ja,
 257      $     'ISHFTC(integer*2,integer*1,integer)')
 258       call c_i2(ISHFTC(j,k2,j3),ja,
 259      $     'ISHFTC(integer*2,integer*1,integer*2)')
 260       call c_i2(ISHFTC(j,k2,k3),ja,
 261      $     'ISHFTC(integer*2,integer*1,integer*1)')
 262       call c_i2(ISHFTC(j,k2,m3),ja,
 263      $     'ISHFTC(integer*2,integer*1,integer*8)')
 264       call c_i2(ISHFTC(j,m2,i3),ja,
 265      $     'ISHFTC(integer*2,integer*8,integer)')
 266       call c_i2(ISHFTC(j,m2,j3),ja,
 267      $     'ISHFTC(integer*2,integer*8,integer*2)')
 268       call c_i2(ISHFTC(j,m2,k3),ja,
 269      $     'ISHFTC(integer*2,integer*8,integer*1)')
 270       call c_i2(ISHFTC(j,m2,m3),ja,
 271      $     'ISHFTC(integer*2,integer*8,integer*8)')
 272
 273       call c_i1(ISHFTC(k,i2,i3),ka,'ISHFTC(integer*1,integer,integer)')
 274       call c_i1(ISHFTC(k,i2,j3),ka,
 275      $     'ISHFTC(integer*1,integer,integer*2)')
 276       call c_i1(ISHFTC(k,i2,k3),ka,
 277      $     'ISHFTC(integer*1,integer,integer*1)')
 278       call c_i1(ISHFTC(k,i2,m3),ka,
 279      $     'ISHFTC(integer*1,integer,integer*8)')
 280       call c_i1(ISHFTC(k,j2,i3),ka,
 281      $     'ISHFTC(integer*1,integer*2,integer)')
 282       call c_i1(ISHFTC(k,j2,j3),ka,
 283      $     'ISHFTC(integer*1,integer*2,integer*2)')
 284       call c_i1(ISHFTC(k,j2,k3),ka,
 285      $     'ISHFTC(integer*1,integer*2,integer*1)')
 286       call c_i1(ISHFTC(k,j2,m3),ka,
 287      $     'ISHFTC(integer*1,integer*2,integer*8)')
 288       call c_i1(ISHFTC(k,k2,i3),ka,
 289      $     'ISHFTC(integer*1,integer*1,integer)')
 290       call c_i1(ISHFTC(k,k2,j3),ka,
 291      $     'ISHFTC(integer*1,integer*1,integer*2)')
 292       call c_i1(ISHFTC(k,k2,k3),ka,
 293      $     'ISHFTC(integer*1,integer*1,integer*1)')
 294       call c_i1(ISHFTC(k,k2,m3),ka,
 295      $     'ISHFTC(integer*1,integer*1,integer*8)')
 296       call c_i1(ISHFTC(k,m2,i3),ka,
 297      $     'ISHFTC(integer*1,integer*8,integer)')
 298       call c_i1(ISHFTC(k,m2,j3),ka,
 299      $     'ISHFTC(integer*1,integer*8,integer*2)')
 300       call c_i1(ISHFTC(k,m2,k3),ka,
 301      $     'ISHFTC(integer*1,integer*8,integer*1)')
 302       call c_i1(ISHFTC(k,m2,m3),ka,
 303      $     'ISHFTC(integer*1,integer*8,integer*8)')
 304
 305       call c_i8(ISHFTC(m,i2,i3),ma,'ISHFTC(integer*8,integer,integer)')
 306       call c_i8(ISHFTC(m,i2,j3),ma,
 307      $     'ISHFTC(integer*8,integer,integer*2)')
 308       call c_i8(ISHFTC(m,i2,k3),ma,
 309      $     'ISHFTC(integer*8,integer,integer*1)')
 310       call c_i8(ISHFTC(m,i2,m3),ma,
 311      $     'ISHFTC(integer*8,integer,integer*8)')
 312       call c_i8(ISHFTC(m,j2,i3),ma,
 313      $     'ISHFTC(integer*8,integer*2,integer)')
 314       call c_i8(ISHFTC(m,j2,j3),ma,
 315      $     'ISHFTC(integer*8,integer*2,integer*2)')
 316       call c_i8(ISHFTC(m,j2,k3),ma,
 317      $     'ISHFTC(integer*8,integer*2,integer*1)')
 318       call c_i8(ISHFTC(m,j2,m3),ma,
 319      $     'ISHFTC(integer*8,integer*2,integer*8)')
 320       call c_i8(ISHFTC(m,k2,i3),ma,
 321      $     'ISHFTC(integer*8,integer*1,integer)')
 322       call c_i8(ISHFTC(m,k2,j3),ma,
 323      $     'ISHFTC(integer*1,integer*8,integer*2)')
 324       call c_i8(ISHFTC(m,k2,k3),ma,
 325      $     'ISHFTC(integer*1,integer*8,integer*1)')
 326       call c_i8(ISHFTC(m,k2,m3),ma,
 327      $     'ISHFTC(integer*1,integer*8,integer*8)')
 328       call c_i8(ISHFTC(m,m2,i3),ma,
 329      $     'ISHFTC(integer*8,integer*8,integer)')
 330       call c_i8(ISHFTC(m,m2,j3),ma,
 331      $     'ISHFTC(integer*8,integer*8,integer*2)')
 332       call c_i8(ISHFTC(m,m2,k3),ma,
 333      $     'ISHFTC(integer*8,integer*8,integer*1)')
 334       call c_i8(ISHFTC(m,m2,m3),ma,
 335      $     'ISHFTC(integer*8,integer*8,integer*8)')
 336
 337 c     test the corner cases
 338       call c_i(ISHFTC(i,BIT_SIZE(i),BIT_SIZE(i)),i,
 339      $     'ISHFTC(i,BIT_SIZE(i),BIT_SIZE(i)) i = integer')
 340       call c_i(ISHFTC(i,0,BIT_SIZE(i)),i,
 341      $     'ISHFTC(i,0,BIT_SIZE(i)) i = integer')
 342       call c_i(ISHFTC(i,-BIT_SIZE(i),BIT_SIZE(i)),i,
 343      $     'ISHFTC(i,-BIT_SIZE(i),BIT_SIZE(i)) i = integer')
 344       call c_i2(ISHFTC(j,BIT_SIZE(j),BIT_SIZE(j)),j,
 345      $     'ISHFTC(j,BIT_SIZE(j),BIT_SIZE(j)) j = integer*2')
 346       call c_i2(ISHFTC(j,0,BIT_SIZE(j)),j,
 347      $     'ISHFTC(j,0,BIT_SIZE(j)) j = integer*2')
 348       call c_i2(ISHFTC(j,-BIT_SIZE(j),BIT_SIZE(j)),j,
 349      $     'ISHFTC(j,-BIT_SIZE(j),BIT_SIZE(j)) j = integer*2')
 350       call c_i1(ISHFTC(k,BIT_SIZE(k),BIT_SIZE(k)),k,
 351      $     'ISHFTC(k,BIT_SIZE(k),BIT_SIZE(k)) k = integer*1')
 352       call c_i1(ISHFTC(k,0,BIT_SIZE(k)),k,
 353      $     'ISHFTC(k,0,BIT_SIZE(k)) k = integer*1')
 354       call c_i1(ISHFTC(k,-BIT_SIZE(k),BIT_SIZE(k)),k,
 355      $     'ISHFTC(k,-BIT_SIZE(k),BIT_SIZE(k)) k = integer*1')
 356       call c_i8(ISHFTC(m,BIT_SIZE(m),BIT_SIZE(m)),m,
 357      $     'ISHFTC(m,BIT_SIZE(m),BIT_SIZE(m)) m = integer*8')
 358       call c_i8(ISHFTC(m,0,BIT_SIZE(m)),m,
 359      $     'ISHFTC(m,0,BIT_SIZE(m)) m = integer*8')
 360       call c_i8(ISHFTC(m,-BIT_SIZE(m),BIT_SIZE(m)),m,
 361      $     'ISHFTC(m,-BIT_SIZE(m),BIT_SIZE(m)) m = integer*8')
 362
 363 c     MVBITS - Section 13.13.74
 364       i = 6
 365       call MVBITS(7,2,2,i,0)
 366       call c_i(i,5,'MVBITS 1')
 367       j = 6
 368       j2 = 7
 369       ja = 5
 370       call MVBITS(j2,2,2,j,0)
 371       call c_i2(j,ja,'MVBITS 2')
 372       k = 6
 373       k2 = 7
 374       ka = 5
 375       call MVBITS(k2,2,2,k,0)
 376       call c_i1(k,ka,'MVBITS 3')
 377       m = 6
 378       m2 = 7
 379       ma = 5
 380       call MVBITS(m2,2,2,m,0)
 381       call c_i8(m,ma,'MVBITS 4')
 382
 383 c     NOT    - Section 13.13.77
 384 c     Rather than assume integer sizes, mask off high bits
 385       j  = 21
 386       j2 = 31
 387       ja = 10
 388       k  = 21
 389       k2 = 31
 390       ka = 10
 391       m  = 21
 392       m2 = 31
 393       ma = 10
 394       call c_i(IAND(NOT(21),31),10,'NOT(integer)')
 395       call c_i2(IAND(NOT(j),j2),ja,'NOT(integer*2)')
 396       call c_i1(IAND(NOT(k),k2),ka,'NOT(integer*1)')
 397       call c_i8(IAND(NOT(m),m2),ma,'NOT(integer*8)')
 398
 399       if ( fail ) call abort()
 400       end
 401
 402       subroutine failure(label)
 403 c     Report failure and set flag
 404       character*(*) label
 405       logical fail
 406       common /flags/ fail
 407       write(6,'(a,a,a)') 'Test ',label,' FAILED'
 408       fail = .true.
 409       end
 410
 411       subroutine c_l(i,j,label)
 412 c     Check if LOGICAL i equals j, and fail otherwise
 413       logical i,j
 414       character*(*) label
 415       if ( i .eqv. j ) then
 416          call failure(label)
 417          write(6,*) 'Got ',i,' expected ', j
 418       end if
 419       end
 420
 421       subroutine c_i(i,j,label)
 422 c     Check if INTEGER i equals j, and fail otherwise
 423       integer i,j
 424       character*(*) label
 425       if ( i .ne. j ) then
 426          call failure(label)
 427          write(6,*) 'Got ',i,' expected ', j
 428       end if
 429       end
 430
 431       subroutine c_i2(i,j,label)
 432 c     Check if INTEGER*2 i equals j, and fail otherwise
 433       integer*2 i,j
 434       character*(*) label
 435       if ( i .ne. j ) then
 436          call failure(label)
 437          write(6,*) 'Got ',i,' expected ', j
 438       end if
 439       end
 440
 441       subroutine c_i1(i,j,label)
 442 c     Check if INTEGER*1 i equals j, and fail otherwise
 443       integer*1 i,j
 444       character*(*) label
 445       if ( i .ne. j ) then
 446          call failure(label)
 447          write(6,*) 'Got ',i,' expected ', j
 448       end if
 449       end
 450
 451       subroutine c_i8(i,j,label)
 452 c     Check if INTEGER*8 i equals j, and fail otherwise
 453       integer*8 i,j
 454       character*(*) label
 455       if ( i .ne. j ) then
 456          call failure(label)
 457          write(6,*) 'Got ',i,' expected ', j
 458       end if
 459       end