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 944 of file sblat1.f.

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