LAPACK 3.11.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 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*
98999999 FORMAT (' FAIL')
99099998 FORMAT (/' CASE N INCX INCY I ',
991 + ' COMP(I) TRUE(I) DIFFERENCE',
992 + ' SIZE(I)',/1x)
99399997 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