LAPACK 3.11.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches

## ◆ stest()

 subroutine stest ( integer LEN, real, dimension(len) SCOMP, real, dimension(len) STRUE, real, dimension(len) SSIZE, real SFAC )

Definition at line 522 of file c_cblat1.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 REAL SFAC
536 INTEGER LEN
537* .. Array Arguments ..
538 REAL SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
539* .. Scalars in Common ..
540 INTEGER ICASE, INCX, INCY, MODE, N
541 LOGICAL PASS
542* .. Local Scalars ..
543 REAL SD
544 INTEGER I
545* .. External Functions ..
546 REAL 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.0e0)
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*
57199999 FORMAT (' FAIL')
57299998 FORMAT (/' CASE N INCX INCY MODE I ',
573 + ' COMP(I) TRUE(I) DIFFERENCE',
574 + ' SIZE(I)',/1x)
57599997 FORMAT (1x,i4,i3,3i5,i3,2e36.8,2e12.4)
real function sdiff(SA, SB)
Definition: cblat1.f:696