LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ stest()

subroutine stest ( integer  LEN,
real, dimension(len)  SCOMP,
real, dimension(len)  STRUE,
real, dimension(len)  SSIZE,
real  SFAC 
)

Definition at line 939 of file sblat1.f.

940 * ********************************* STEST **************************
941 *
942 * THIS SUBR COMPARES ARRAYS SCOMP() AND STRUE() OF LENGTH LEN TO
943 * SEE IF THE TERM BY TERM DIFFERENCES, MULTIPLIED BY SFAC, ARE
944 * NEGLIGIBLE.
945 *
946 * C. L. LAWSON, JPL, 1974 DEC 10
947 *
948 * .. Parameters ..
949  INTEGER NOUT
950  REAL ZERO
951  parameter(nout=6, zero=0.0e0)
952 * .. Scalar Arguments ..
953  REAL SFAC
954  INTEGER LEN
955 * .. Array Arguments ..
956  REAL SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
957 * .. Scalars in Common ..
958  INTEGER ICASE, INCX, INCY, N
959  LOGICAL PASS
960 * .. Local Scalars ..
961  REAL SD
962  INTEGER I
963 * .. External Functions ..
964  REAL SDIFF
965  EXTERNAL sdiff
966 * .. Intrinsic Functions ..
967  INTRINSIC abs
968 * .. Common blocks ..
969  COMMON /combla/icase, n, incx, incy, pass
970 * .. Executable Statements ..
971 *
972  DO 40 i = 1, len
973  sd = scomp(i) - strue(i)
974  IF (abs(sfac*sd) .LE. abs(ssize(i))*epsilon(zero))
975  + GO TO 40
976 *
977 * HERE SCOMP(I) IS NOT CLOSE TO STRUE(I).
978 *
979  IF ( .NOT. pass) GO TO 20
980 * PRINT FAIL MESSAGE AND HEADER.
981  pass = .false.
982  WRITE (nout,99999)
983  WRITE (nout,99998)
984  20 WRITE (nout,99997) icase, n, incx, incy, i, scomp(i),
985  + strue(i), sd, ssize(i)
986  40 CONTINUE
987  RETURN
988 *
989 99999 FORMAT (' FAIL')
990 99998 FORMAT (/' CASE N INCX INCY I ',
991  + ' COMP(I) TRUE(I) DIFFERENCE',
992  + ' SIZE(I)',/1x)
993 99997 FORMAT (1x,i4,i3,2i5,i3,2e36.8,2e12.4)
994 *
995 * End of STEST
996 *
real function sdiff(SA, SB)
Definition: cblat1.f:696