LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ stest()

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

Definition at line 937 of file dblat1.f.

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