gcc/testsuite/g77.f-torture/execute/f90-intrinsic-bit.f

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