/* Subroutine */ int stest_(integer *len, doublereal *scomp, doublereal *
strue, doublereal *ssize, doublereal *sfac)
{
/* Format strings */
static char fmt_99999[] = "(\002 F"
"AIL\002)";
static char fmt_99998[] = "(/\002 CASE N INCX INCY MODE I "
" \002,\002 COMP(I) TRU"
"E(I) DIFFERENCE\002,\002 SIZE(I)\002,/1x)";
static char fmt_99997[] = "(1x,i4,i3,3i5,i3,2d36.8,2d12.4)";
/* System generated locals */
integer i__1;
doublereal d__1, d__2, d__3, d__4, d__5;
/* Builtin functions */
integer s_wsfe(cilist *), e_wsfe(void), do_fio(integer *, char *, ftnlen);
/* Local variables */
static integer i__;
extern doublereal sdiff_(doublereal *, doublereal *);
static doublereal sd;
/* Fortran I/O blocks */
static cilist io___51 = { 0, 6, 0, fmt_99999, 0 };
static cilist io___52 = { 0, 6, 0, fmt_99998, 0 };
static cilist io___53 = { 0, 6, 0, fmt_99997, 0 };
/* ********************************* 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
Parameter adjustments */
--ssize;
--strue;
--scomp;
/* Function Body */
i__1 = *len;
for (i__ = 1; i__ <= i__1; ++i__) {
sd = scomp[i__] - strue[i__];
d__4 = (d__1 = ssize[i__], abs(d__1)) + (d__2 = *sfac * sd, abs(d__2))
;
d__5 = (d__3 = ssize[i__], abs(d__3));
if (sdiff_(&d__4, &d__5) == 0.) {
goto L40;
}
/* HERE SCOMP(I) IS NOT CLOSE TO STRUE(I). */
if (! combla_1.pass) {
goto L20;
}
/* PRINT FAIL MESSAGE AND HEADER. */
combla_1.pass = FALSE_;
s_wsfe(&io___51);
e_wsfe();
s_wsfe(&io___52);
e_wsfe();
L20:
s_wsfe(&io___53);
do_fio(&c__1, (char *)&combla_1.icase, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&combla_1.n, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&combla_1.incx, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&combla_1.incy, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&combla_1.mode, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&scomp[i__], (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&strue[i__], (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&sd, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&ssize[i__], (ftnlen)sizeof(doublereal));
e_wsfe();
L40:
;
}
return 0;
} /* stest_
/* Subroutine */ int stest_(integer *len, real *scomp, real *strue, real *
ssize, real *sfac)
{
/* Format strings */
static char fmt_99999[] = "(\002 F"
"AIL\002)";
static char fmt_99998[] = "(/\002 CASE N INCX INCY MODE I "
" \002,\002 COMP(I) TRU"
"E(I) DIFFERENCE\002,\002 SIZE(I)\002,/1x)";
static char fmt_99997[] = "(1x,i4,i3,3i5,i3,2e36.8,2e12.4)";
/* System generated locals */
integer i__1;
real r__1, r__2, r__3, r__4, r__5;
/* Builtin functions */
integer s_wsfe(cilist *), e_wsfe(void), do_fio(integer *, char *, ftnlen);
/* Local variables */
integer i__;
real sd;
extern doublereal sdiff_(real *, real *);
/* Fortran I/O blocks */
static cilist io___105 = { 0, 6, 0, fmt_99999, 0 };
static cilist io___106 = { 0, 6, 0, fmt_99998, 0 };
static cilist io___107 = { 0, 6, 0, fmt_99997, 0 };
/* ********************************* 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 .. */
/* .. Scalar Arguments .. */
/* .. Array Arguments .. */
/* .. Scalars in Common .. */
/* .. Local Scalars .. */
/* .. External Functions .. */
/* .. Intrinsic Functions .. */
/* .. Common blocks .. */
/* .. Executable Statements .. */
/* Parameter adjustments */
--ssize;
--strue;
--scomp;
/* Function Body */
i__1 = *len;
for (i__ = 1; i__ <= i__1; ++i__) {
sd = scomp[i__] - strue[i__];
r__4 = (r__1 = ssize[i__], dabs(r__1)) + (r__2 = *sfac * sd, dabs(
r__2));
r__5 = (r__3 = ssize[i__], dabs(r__3));
if (sdiff_(&r__4, &r__5) == 0.f) {
goto L40;
}
/* HERE SCOMP(I) IS NOT CLOSE TO STRUE(I). */
if (! combla_1.pass) {
goto L20;
}
/* PRINT FAIL MESSAGE AND HEADER. */
combla_1.pass = FALSE_;
s_wsfe(&io___105);
e_wsfe();
s_wsfe(&io___106);
e_wsfe();
L20:
s_wsfe(&io___107);
do_fio(&c__1, (char *)&combla_1.icase, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&combla_1.n, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&combla_1.incx, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&combla_1.incy, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&combla_1.mode, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&scomp[i__], (ftnlen)sizeof(real));
do_fio(&c__1, (char *)&strue[i__], (ftnlen)sizeof(real));
do_fio(&c__1, (char *)&sd, (ftnlen)sizeof(real));
do_fio(&c__1, (char *)&ssize[i__], (ftnlen)sizeof(real));
e_wsfe();
L40:
;
}
return 0;
} /* stest_ */
