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