614
615
616
617
618
619
620
621
622
623 INTEGER NOUT
624 REAL ZERO
625 parameter(nout=6, zero=0.0e0)
626
627 REAL SFAC
628 INTEGER LEN
629
630 REAL SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
631
632 INTEGER ICASE, INCX, INCY, MODE, N
633 LOGICAL PASS
634
635 REAL SD
636 INTEGER I
637
638 REAL SDIFF
640
641 INTRINSIC abs
642
643 COMMON /combla/icase, n, incx, incy, mode, pass
644
645
646 DO 40 i = 1, len
647 sd = scomp(i) - strue(i)
648 IF (abs(sfac*sd) .LE. abs(ssize(i))*epsilon(zero))
649 + GO TO 40
650
651
652
653 IF ( .NOT. pass) GO TO 20
654
655 pass = .false.
656 WRITE (nout,99999)
657 WRITE (nout,99998)
658 20 WRITE (nout,99997) icase, n, incx, incy, mode, i, scomp(i),
659 + strue(i), sd, ssize(i)
660 40 CONTINUE
661 RETURN
662
66399999 FORMAT (' FAIL')
66499998 FORMAT (/' CASE N INCX INCY MODE I ',
665 + ' COMP(I) TRUE(I) DIFFERENCE',
666 + ' SIZE(I)',/1x)
66799997 FORMAT (1x,i4,i3,3i5,i3,2e36.8,2e12.4)
668
669
670
real function sdiff(sa, sb)