LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ stest()

subroutine stest ( integer  len,
real, dimension(len)  scomp,
real, dimension(len)  strue,
real, dimension(len)  ssize,
real  sfac 
)

Definition at line 613 of file cblat1.f.

614* ********************************* STEST **************************
615*
616* THIS SUBR COMPARES ARRAYS SCOMP() AND STRUE() OF LENGTH LEN TO
617* SEE IF THE TERM BY TERM DIFFERENCES, MULTIPLIED BY SFAC, ARE
618* NEGLIGIBLE.
619*
620* C. L. LAWSON, JPL, 1974 DEC 10
621*
622* .. Parameters ..
623 INTEGER NOUT
624 REAL ZERO
625 parameter(nout=6, zero=0.0e0)
626* .. Scalar Arguments ..
627 REAL SFAC
628 INTEGER LEN
629* .. Array Arguments ..
630 REAL SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
631* .. Scalars in Common ..
632 INTEGER ICASE, INCX, INCY, MODE, N
633 LOGICAL PASS
634* .. Local Scalars ..
635 REAL SD
636 INTEGER I
637* .. External Functions ..
638 REAL SDIFF
639 EXTERNAL sdiff
640* .. Intrinsic Functions ..
641 INTRINSIC abs
642* .. Common blocks ..
643 COMMON /combla/icase, n, incx, incy, mode, pass
644* .. Executable Statements ..
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* HERE SCOMP(I) IS NOT CLOSE TO STRUE(I).
652*
653 IF ( .NOT. pass) GO TO 20
654* PRINT FAIL MESSAGE AND HEADER.
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* End of STEST
670*
real function sdiff(sa, sb)
Definition cblat1.f:701
Here is the caller graph for this function: