LAPACK  3.9.1
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 921 of file sblat1.f.

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