LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ 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 598 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*
64799999 FORMAT (' FAIL')
64899998 FORMAT (/' CASE N INCX INCY MODE I ',
649 + ' COMP(I) TRUE(I) DIFFERENCE',
650 + ' SIZE(I)',/1x)
65199997 FORMAT (1x,i4,i3,3i5,i3,2d36.8,2d12.4)
real function sdiff(sa, sb)
Definition cblat1.f:701