523
  524
  525
  526
  527
  528
  529
  530
  531
  532      INTEGER          NOUT
  533      parameter(nout=6)
  534
  535      REAL             SFAC
  536      INTEGER          LEN
  537
  538      REAL             SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
  539
  540      INTEGER          ICASE, INCX, INCY, MODE, N
  541      LOGICAL          PASS
  542
  543      REAL             SD
  544      INTEGER          I
  545
  546      REAL             SDIFF
  548
  549      INTRINSIC        abs
  550
  551      COMMON           /combla/icase, n, incx, incy, mode, pass
  552
  553
  554      DO 40 i = 1, len
  555         sd = scomp(i) - strue(i)
  556         IF (
sdiff(abs(ssize(i))+abs(sfac*sd),abs(ssize(i))).EQ.0.0e0)
 
  557     +       GO TO 40
  558
  559
  560
  561         IF ( .NOT. pass) GO TO 20
  562
  563         pass = .false.
  564         WRITE (nout,99999)
  565         WRITE (nout,99998)
  566   20    WRITE (nout,99997) icase, n, incx, incy, mode, i, scomp(i),
  567     +     strue(i), sd, ssize(i)
  568   40 CONTINUE
  569      RETURN
  570
  57199999 FORMAT ('                                       FAIL')
  57299998 FORMAT (/' CASE  N INCX INCY MODE  I                            ',
  573     +       ' COMP(I)                             TRUE(I)  DIFFERENCE',
  574     +       '     SIZE(I)',/1x)
  57599997 FORMAT (1x,i4,i3,3i5,i3,2e36.8,2e12.4)
real function sdiff(sa, sb)