LAPACK  3.10.1
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 522 of file c_zblat1.f.

523 * ********************************* STEST **************************
524 *
525 * THIS SUBR COMPARES ARRAYS SCOMP() AND STRUE() OF LENGTH LEN TO
526 * SEE IF THE TERM BY TERM DIFFERENCES, MULTIPLIED BY SFAC, ARE
527 * NEGLIGIBLE.
528 *
529 * C. L. LAWSON, JPL, 1974 DEC 10
530 *
531 * .. Parameters ..
532  INTEGER NOUT
533  parameter(nout=6)
534 * .. Scalar Arguments ..
535  DOUBLE PRECISION SFAC
536  INTEGER LEN
537 * .. Array Arguments ..
538  DOUBLE PRECISION SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
539 * .. Scalars in Common ..
540  INTEGER ICASE, INCX, INCY, MODE, N
541  LOGICAL PASS
542 * .. Local Scalars ..
543  DOUBLE PRECISION SD
544  INTEGER I
545 * .. External Functions ..
546  DOUBLE PRECISION SDIFF
547  EXTERNAL sdiff
548 * .. Intrinsic Functions ..
549  INTRINSIC abs
550 * .. Common blocks ..
551  COMMON /combla/icase, n, incx, incy, mode, pass
552 * .. Executable Statements ..
553 *
554  DO 40 i = 1, len
555  sd = scomp(i) - strue(i)
556  IF (sdiff(abs(ssize(i))+abs(sfac*sd),abs(ssize(i))).EQ.0.0d0)
557  + GO TO 40
558 *
559 * HERE SCOMP(I) IS NOT CLOSE TO STRUE(I).
560 *
561  IF ( .NOT. pass) GO TO 20
562 * PRINT FAIL MESSAGE AND HEADER.
563  pass = .false.
564  WRITE (nout,99999)
565  WRITE (nout,99998)
566  20 WRITE (nout,99997) icase, n, incx, incy, mode, i, scomp(i),
567  + strue(i), sd, ssize(i)
568  40 CONTINUE
569  RETURN
570 *
571 99999 FORMAT (' FAIL')
572 99998 FORMAT (/' CASE N INCX INCY MODE I ',
573  + ' COMP(I) TRUE(I) DIFFERENCE',
574  + ' SIZE(I)',/1x)
575 99997 FORMAT (1x,i4,i3,3i5,i3,2d36.8,2d12.4)
real function sdiff(SA, SB)
Definition: cblat1.f:696