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 608 of file zblat1.f.

*     ********************************* STEST **************************
*
*     THIS SUBR COMPARES ARRAYS  SCOMP() AND STRUE() OF LENGTH LEN TO
*     SEE IF THE TERM BY TERM DIFFERENCES, MULTIPLIED BY SFAC, ARE
*     NEGLIGIBLE.
*
*     C. L. LAWSON, JPL, 1974 DEC 10
*
*     .. Parameters ..
      INTEGER          NOUT
      DOUBLE PRECISION ZERO
      parameter(nout=6, zero=0.0d0)
*     .. Scalar Arguments ..
      DOUBLE PRECISION SFAC
      INTEGER          LEN
*     .. Array Arguments ..
      DOUBLE PRECISION SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
*     .. Scalars in Common ..
      INTEGER          ICASE, INCX, INCY, MODE, N
      LOGICAL          PASS
*     .. Local Scalars ..
      DOUBLE PRECISION SD
      INTEGER          I
*     .. External Functions ..
      DOUBLE PRECISION SDIFF
      EXTERNAL         sdiff
*     .. Intrinsic Functions ..
      INTRINSIC        abs
*     .. Common blocks ..
      COMMON           /combla/icase, n, incx, incy, mode, pass
*     .. Executable Statements ..
*
      DO 40 i = 1, len
         sd = scomp(i) - strue(i)
         IF (abs(sfac*sd) .LE. abs(ssize(i))*epsilon(zero))
     +       GO TO 40
*
*                             HERE    SCOMP(I) IS NOT CLOSE TO STRUE(I).
*
         IF ( .NOT. pass) GO TO 20
*                             PRINT FAIL MESSAGE AND HEADER.
         pass = .false.
         WRITE (nout,99999)
         WRITE (nout,99998)
   20    WRITE (nout,99997) icase, n, incx, incy, mode, i, scomp(i),
     +     strue(i), sd, ssize(i)
   40 CONTINUE
      RETURN
*
99999 FORMAT ('                                       FAIL')
99998 FORMAT (/' CASE  N INCX INCY MODE  I                            ',
     +       ' COMP(I)                             TRUE(I)  DIFFERENCE',
     +       '     SIZE(I)',/1x)
99997 FORMAT (1x,i4,i3,3i5,i3,2d36.8,2d12.4)
*
*     End of STEST
*