LAPACK  3.8.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 891 of file sblat1.f.

891 * ********************************* STEST **************************
892 *
893 * THIS SUBR COMPARES ARRAYS SCOMP() AND STRUE() OF LENGTH LEN TO
894 * SEE IF THE TERM BY TERM DIFFERENCES, MULTIPLIED BY SFAC, ARE
895 * NEGLIGIBLE.
896 *
897 * C. L. LAWSON, JPL, 1974 DEC 10
898 *
899 * .. Parameters ..
900  INTEGER nout
901  REAL zero
902  parameter(nout=6, zero=0.0e0)
903 * .. Scalar Arguments ..
904  REAL sfac
905  INTEGER len
906 * .. Array Arguments ..
907  REAL scomp(len), ssize(len), strue(len)
908 * .. Scalars in Common ..
909  INTEGER icase, incx, incy, n
910  LOGICAL pass
911 * .. Local Scalars ..
912  REAL sd
913  INTEGER i
914 * .. External Functions ..
915  REAL sdiff
916  EXTERNAL sdiff
917 * .. Intrinsic Functions ..
918  INTRINSIC abs
919 * .. Common blocks ..
920  COMMON /combla/icase, n, incx, incy, pass
921 * .. Executable Statements ..
922 *
923  DO 40 i = 1, len
924  sd = scomp(i) - strue(i)
925  IF (abs(sfac*sd) .LE. abs(ssize(i))*epsilon(zero))
926  + GO TO 40
927 *
928 * HERE SCOMP(I) IS NOT CLOSE TO STRUE(I).
929 *
930  IF ( .NOT. pass) GO TO 20
931 * PRINT FAIL MESSAGE AND HEADER.
932  pass = .false.
933  WRITE (nout,99999)
934  WRITE (nout,99998)
935  20 WRITE (nout,99997) icase, n, incx, incy, i, scomp(i),
936  + strue(i), sd, ssize(i)
937  40 CONTINUE
938  RETURN
939 *
940 99999 FORMAT (' FAIL')
941 99998 FORMAT (/' CASE N INCX INCY I ',
942  + ' COMP(I) TRUE(I) DIFFERENCE',
943  + ' SIZE(I)',/1x)
944 99997 FORMAT (1x,i4,i3,2i5,i3,2e36.8,2e12.4)
real function sdiff(SA, SB)
Definition: cblat1.f:645