LAPACK  3.8.0
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 888 of file dblat1.f.

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