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 599 of file c_dblat1.f.

599 * ********************************* STEST **************************
600 *
601 * THIS SUBR COMPARES ARRAYS SCOMP() AND STRUE() OF LENGTH LEN TO
602 * SEE IF THE TERM BY TERM DIFFERENCES, MULTIPLIED BY SFAC, ARE
603 * NEGLIGIBLE.
604 *
605 * C. L. LAWSON, JPL, 1974 DEC 10
606 *
607 * .. Parameters ..
608  INTEGER nout
609  parameter(nout=6)
610 * .. Scalar Arguments ..
611  DOUBLE PRECISION sfac
612  INTEGER len
613 * .. Array Arguments ..
614  DOUBLE PRECISION scomp(len), ssize(len), strue(len)
615 * .. Scalars in Common ..
616  INTEGER icase, incx, incy, mode, n
617  LOGICAL pass
618 * .. Local Scalars ..
619  DOUBLE PRECISION sd
620  INTEGER i
621 * .. External Functions ..
622  DOUBLE PRECISION sdiff
623  EXTERNAL sdiff
624 * .. Intrinsic Functions ..
625  INTRINSIC abs
626 * .. Common blocks ..
627  COMMON /combla/icase, n, incx, incy, mode, pass
628 * .. Executable Statements ..
629 *
630  DO 40 i = 1, len
631  sd = scomp(i) - strue(i)
632  IF (sdiff(abs(ssize(i))+abs(sfac*sd),abs(ssize(i))).EQ.0.0d0)
633  + GO TO 40
634 *
635 * HERE SCOMP(I) IS NOT CLOSE TO STRUE(I).
636 *
637  IF ( .NOT. pass) GO TO 20
638 * PRINT FAIL MESSAGE AND HEADER.
639  pass = .false.
640  WRITE (nout,99999)
641  WRITE (nout,99998)
642  20 WRITE (nout,99997) icase, n, incx, incy, mode, i, scomp(i),
643  + strue(i), sd, ssize(i)
644  40 CONTINUE
645  RETURN
646 *
647 99999 FORMAT (' FAIL')
648 99998 FORMAT (/' CASE N INCX INCY MODE I ',
649  + ' COMP(I) TRUE(I) DIFFERENCE',
650  + ' SIZE(I)',/1x)
651 99997 FORMAT (1x,i4,i3,3i5,i3,2d36.8,2d12.4)
real function sdiff(SA, SB)
Definition: cblat1.f:645