Subroutine */ int stest1_(doublereal *scomp1, doublereal *strue1,
doublereal *ssize, doublereal *sfac)
{
static doublereal scomp[1], strue[1];
extern /* Subroutine */ int stest_(integer *, doublereal *, doublereal *,
doublereal *, doublereal *);
/* ************************* STEST1 *****************************
THIS IS AN INTERFACE SUBROUTINE TO ACCOMODATE THE FORTRAN
REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE
ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT.
C.L. LAWSON, JPL, 1978 DEC 6
Parameter adjustments */
--ssize;
/* Function Body */
scomp[0] = *scomp1;
strue[0] = *strue1;
stest_(&c__1, scomp, strue, &ssize[1], sfac);
return 0;
} /* stest1_ */
/* Subroutine */ int stest1_(real *scomp1, real *strue1, real *ssize, real *
sfac)
{
real scomp[1], strue[1];
extern /* Subroutine */ int stest_(integer *, real *, real *, real *,
real *);
/* ************************* STEST1 ***************************** */
/* THIS IS AN INTERFACE SUBROUTINE TO ACCOMODATE THE FORTRAN */
/* REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE */
/* ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT. */
/* C.L. LAWSON, JPL, 1978 DEC 6 */
/* .. Scalar Arguments .. */
/* .. Array Arguments .. */
/* .. Local Arrays .. */
/* .. External Subroutines .. */
/* .. Executable Statements .. */
/* Parameter adjustments */
--ssize;
/* Function Body */
scomp[0] = *scomp1;
strue[0] = *strue1;
stest_(&c__1, scomp, strue, &ssize[1], sfac);
return 0;
} /* stest1_ */
Subroutine */ int ctest_(integer *len, doublecomplex *ccomp, doublecomplex
*ctrue, doublecomplex *csize, doublereal *sfac)
{
/* System generated locals */
integer i__1, i__2;
/* Builtin functions */
double d_imag(doublecomplex *);
/* Local variables */
static integer i__;
static doublereal scomp[20], ssize[20], strue[20];
extern /* Subroutine */ int stest_(integer *, doublereal *, doublereal *,
doublereal *, doublereal *);
/* **************************** CTEST *****************************
C.L. LAWSON, JPL, 1978 DEC 6
Parameter adjustments */
--csize;
--ctrue;
--ccomp;
/* Function Body */
i__1 = *len;
for (i__ = 1; i__ <= i__1; ++i__) {
i__2 = i__;
scomp[(i__ << 1) - 2] = ccomp[i__2].r;
scomp[(i__ << 1) - 1] = d_imag(&ccomp[i__]);
i__2 = i__;
strue[(i__ << 1) - 2] = ctrue[i__2].r;
strue[(i__ << 1) - 1] = d_imag(&ctrue[i__]);
i__2 = i__;
ssize[(i__ << 1) - 2] = csize[i__2].r;
ssize[(i__ << 1) - 1] = d_imag(&csize[i__]);
/* L20: */
}
i__1 = *len << 1;
stest_(&i__1, scomp, strue, ssize, sfac);
return 0;
} /* ctest_
/* Subroutine */ int check3_(real *sfac)
{
/* Initialized data */
static integer incxs[4] = { 1,2,-2,-1 };
static integer incys[4] = { 1,-2,1,-2 };
static integer lens[8] /* was [4][2] */ = { 1,1,2,4,1,1,3,7 };
static integer ns[4] = { 0,1,2,4 };
static real dx1[7] = { .6f,.1f,-.5f,.8f,.9f,-.3f,-.4f };
static real dy1[7] = { .5f,-.9f,.3f,.7f,-.6f,.2f,.8f };
static real sc = .8f;
static real ss = .6f;
static real dt9x[112] /* was [7][4][4] */ = { .6f,0.f,0.f,0.f,0.f,
0.f,0.f,.78f,0.f,0.f,0.f,0.f,0.f,0.f,.78f,-.46f,0.f,0.f,0.f,0.f,
0.f,.78f,-.46f,-.22f,1.06f,0.f,0.f,0.f,.6f,0.f,0.f,0.f,0.f,0.f,
0.f,.78f,0.f,0.f,0.f,0.f,0.f,0.f,.66f,.1f,-.1f,0.f,0.f,0.f,0.f,
.96f,.1f,-.76f,.8f,.9f,-.3f,-.02f,.6f,0.f,0.f,0.f,0.f,0.f,0.f,
.78f,0.f,0.f,0.f,0.f,0.f,0.f,-.06f,.1f,-.1f,0.f,0.f,0.f,0.f,.9f,
.1f,-.22f,.8f,.18f,-.3f,-.02f,.6f,0.f,0.f,0.f,0.f,0.f,0.f,.78f,
0.f,0.f,0.f,0.f,0.f,0.f,.78f,.26f,0.f,0.f,0.f,0.f,0.f,.78f,.26f,
-.76f,1.12f,0.f,0.f,0.f };
static real dt9y[112] /* was [7][4][4] */ = { .5f,0.f,0.f,0.f,0.f,
0.f,0.f,.04f,0.f,0.f,0.f,0.f,0.f,0.f,.04f,-.78f,0.f,0.f,0.f,0.f,
0.f,.04f,-.78f,.54f,.08f,0.f,0.f,0.f,.5f,0.f,0.f,0.f,0.f,0.f,0.f,
.04f,0.f,0.f,0.f,0.f,0.f,0.f,.7f,-.9f,-.12f,0.f,0.f,0.f,0.f,.64f,
-.9f,-.3f,.7f,-.18f,.2f,.28f,.5f,0.f,0.f,0.f,0.f,0.f,0.f,.04f,0.f,
0.f,0.f,0.f,0.f,0.f,.7f,-1.08f,0.f,0.f,0.f,0.f,0.f,.64f,-1.26f,
.54f,.2f,0.f,0.f,0.f,.5f,0.f,0.f,0.f,0.f,0.f,0.f,.04f,0.f,0.f,0.f,
0.f,0.f,0.f,.04f,-.9f,.18f,0.f,0.f,0.f,0.f,.04f,-.9f,.18f,.7f,
-.18f,.2f,.16f };
static real ssize2[28] /* was [14][2] */ = { 0.f,0.f,0.f,0.f,0.f,0.f,
0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,1.17f,1.17f,1.17f,1.17f,1.17f,
1.17f,1.17f,1.17f,1.17f,1.17f,1.17f,1.17f,1.17f,1.17f };
/* Builtin functions */
integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
e_wsle(void);
/* Subroutine */ int s_stop(char *, ftnlen);
/* Local variables */
integer i__, k, ki, kn, mx, my;
real sx[7], sy[7], stx[7], sty[7];
integer lenx, leny;
real mwpc[11];
integer mwpn[11];
real mwps[11];
extern /* Subroutine */ int srot_(integer *, real *, integer *, real *,
integer *, real *, real *);
real mwpx[5], mwpy[5];
integer ksize;
real copyx[5], copyy[5];
extern /* Subroutine */ int stest_(integer *, real *, real *, real *,
real *);
real mwptx[55] /* was [11][5] */, mwpty[55] /* was [11][5] */;
integer mwpinx[11], mwpiny[11];
real mwpstx[5], mwpsty[5];
/* Fortran I/O blocks */
static cilist io___88 = { 0, 6, 0, 0, 0 };
/* .. Parameters .. */
/* .. Scalar Arguments .. */
/* .. Scalars in Common .. */
/* .. Local Scalars .. */
/* .. Local Arrays .. */
/* .. External Subroutines .. */
/* .. Intrinsic Functions .. */
/* .. Common blocks .. */
/* .. Data statements .. */
/* .. Executable Statements .. */
for (ki = 1; ki <= 4; ++ki) {
combla_1.incx = incxs[ki - 1];
combla_1.incy = incys[ki - 1];
mx = abs(combla_1.incx);
my = abs(combla_1.incy);
for (kn = 1; kn <= 4; ++kn) {
combla_1.n = ns[kn - 1];
ksize = min(2,kn);
lenx = lens[kn + (mx << 2) - 5];
leny = lens[kn + (my << 2) - 5];
if (combla_1.icase == 4) {
/* .. SROT .. */
for (i__ = 1; i__ <= 7; ++i__) {
sx[i__ - 1] = dx1[i__ - 1];
sy[i__ - 1] = dy1[i__ - 1];
stx[i__ - 1] = dt9x[i__ + (kn + (ki << 2)) * 7 - 36];
sty[i__ - 1] = dt9y[i__ + (kn + (ki << 2)) * 7 - 36];
/* L20: */
}
srot_(&combla_1.n, sx, &combla_1.incx, sy, &combla_1.incy, &
sc, &ss);
stest_(&lenx, sx, stx, &ssize2[ksize * 14 - 14], sfac);
stest_(&leny, sy, sty, &ssize2[ksize * 14 - 14], sfac);
} else {
s_wsle(&io___88);
do_lio(&c__9, &c__1, " Shouldn't be here in CHECK3", (ftnlen)
28);
e_wsle();
s_stop("", (ftnlen)0);
}
/* L40: */
}
/* L60: */
}
mwpc[0] = 1.f;
for (i__ = 2; i__ <= 11; ++i__) {
mwpc[i__ - 1] = 0.f;
/* L80: */
}
mwps[0] = 0.f;
for (i__ = 2; i__ <= 6; ++i__) {
mwps[i__ - 1] = 1.f;
/* L100: */
}
for (i__ = 7; i__ <= 11; ++i__) {
mwps[i__ - 1] = -1.f;
/* L120: */
}
mwpinx[0] = 1;
mwpinx[1] = 1;
mwpinx[2] = 1;
mwpinx[3] = -1;
mwpinx[4] = 1;
mwpinx[5] = -1;
mwpinx[6] = 1;
mwpinx[7] = 1;
mwpinx[8] = -1;
mwpinx[9] = 1;
mwpinx[10] = -1;
mwpiny[0] = 1;
mwpiny[1] = 1;
mwpiny[2] = -1;
mwpiny[3] = -1;
mwpiny[4] = 2;
mwpiny[5] = 1;
mwpiny[6] = 1;
mwpiny[7] = -1;
mwpiny[8] = -1;
mwpiny[9] = 2;
mwpiny[10] = 1;
for (i__ = 1; i__ <= 11; ++i__) {
mwpn[i__ - 1] = 5;
/* L140: */
}
mwpn[4] = 3;
mwpn[9] = 3;
for (i__ = 1; i__ <= 5; ++i__) {
mwpx[i__ - 1] = (real) i__;
mwpy[i__ - 1] = (real) i__;
mwptx[i__ * 11 - 11] = (real) i__;
mwpty[i__ * 11 - 11] = (real) i__;
mwptx[i__ * 11 - 10] = (real) i__;
mwpty[i__ * 11 - 10] = (real) (-i__);
mwptx[i__ * 11 - 9] = (real) (6 - i__);
mwpty[i__ * 11 - 9] = (real) (i__ - 6);
mwptx[i__ * 11 - 8] = (real) i__;
mwpty[i__ * 11 - 8] = (real) (-i__);
mwptx[i__ * 11 - 6] = (real) (6 - i__);
mwpty[i__ * 11 - 6] = (real) (i__ - 6);
mwptx[i__ * 11 - 5] = (real) (-i__);
mwpty[i__ * 11 - 5] = (real) i__;
mwptx[i__ * 11 - 4] = (real) (i__ - 6);
mwpty[i__ * 11 - 4] = (real) (6 - i__);
mwptx[i__ * 11 - 3] = (real) (-i__);
mwpty[i__ * 11 - 3] = (real) i__;
mwptx[i__ * 11 - 1] = (real) (i__ - 6);
mwpty[i__ * 11 - 1] = (real) (6 - i__);
/* L160: */
}
mwptx[4] = 1.f;
mwptx[15] = 3.f;
mwptx[26] = 5.f;
mwptx[37] = 4.f;
mwptx[48] = 5.f;
mwpty[4] = -1.f;
mwpty[15] = 2.f;
mwpty[26] = -2.f;
mwpty[37] = 4.f;
mwpty[48] = -3.f;
mwptx[9] = -1.f;
mwptx[20] = -3.f;
mwptx[31] = -5.f;
mwptx[42] = 4.f;
mwptx[53] = 5.f;
mwpty[9] = 1.f;
mwpty[20] = 2.f;
mwpty[31] = 2.f;
mwpty[42] = 4.f;
mwpty[53] = 3.f;
for (i__ = 1; i__ <= 11; ++i__) {
combla_1.incx = mwpinx[i__ - 1];
combla_1.incy = mwpiny[i__ - 1];
for (k = 1; k <= 5; ++k) {
copyx[k - 1] = mwpx[k - 1];
copyy[k - 1] = mwpy[k - 1];
mwpstx[k - 1] = mwptx[i__ + k * 11 - 12];
mwpsty[k - 1] = mwpty[i__ + k * 11 - 12];
/* L180: */
}
srot_(&mwpn[i__ - 1], copyx, &combla_1.incx, copyy, &combla_1.incy, &
mwpc[i__ - 1], &mwps[i__ - 1]);
stest_(&c__5, copyx, mwpstx, mwpstx, sfac);
stest_(&c__5, copyy, mwpsty, mwpsty, sfac);
/* L200: */
}
return 0;
} /* check3_ */
/* Subroutine */ int check1_(real *sfac)
{
/* Initialized data */
static real sa[10] = { .3f,-1.f,0.f,1.f,.3f,.3f,.3f,.3f,.3f,.3f };
static real dv[80] /* was [8][5][2] */ = { .1f,2.f,2.f,2.f,2.f,2.f,2.f,
2.f,.3f,3.f,3.f,3.f,3.f,3.f,3.f,3.f,.3f,-.4f,4.f,4.f,4.f,4.f,4.f,
4.f,.2f,-.6f,.3f,5.f,5.f,5.f,5.f,5.f,.1f,-.3f,.5f,-.1f,6.f,6.f,
6.f,6.f,.1f,8.f,8.f,8.f,8.f,8.f,8.f,8.f,.3f,9.f,9.f,9.f,9.f,9.f,
9.f,9.f,.3f,2.f,-.4f,2.f,2.f,2.f,2.f,2.f,.2f,3.f,-.6f,5.f,.3f,2.f,
2.f,2.f,.1f,4.f,-.3f,6.f,-.5f,7.f,-.1f,3.f };
static real dtrue1[5] = { 0.f,.3f,.5f,.7f,.6f };
static real dtrue3[5] = { 0.f,.3f,.7f,1.1f,1.f };
static real dtrue5[80] /* was [8][5][2] */ = { .1f,2.f,2.f,2.f,2.f,
2.f,2.f,2.f,-.3f,3.f,3.f,3.f,3.f,3.f,3.f,3.f,0.f,0.f,4.f,4.f,4.f,
4.f,4.f,4.f,.2f,-.6f,.3f,5.f,5.f,5.f,5.f,5.f,.03f,-.09f,.15f,
-.03f,6.f,6.f,6.f,6.f,.1f,8.f,8.f,8.f,8.f,8.f,8.f,8.f,.09f,9.f,
9.f,9.f,9.f,9.f,9.f,9.f,.09f,2.f,-.12f,2.f,2.f,2.f,2.f,2.f,.06f,
3.f,-.18f,5.f,.09f,2.f,2.f,2.f,.03f,4.f,-.09f,6.f,-.15f,7.f,-.03f,
3.f };
static integer itrue2[5] = { 0,1,2,2,3 };
/* System generated locals */
integer i__1;
real r__1;
/* Builtin functions */
integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
e_wsle(void);
/* Subroutine */ int s_stop(char *, ftnlen);
/* Local variables */
integer i__;
real sx[8];
integer np1, len;
extern doublereal snrm2_(integer *, real *, integer *);
extern /* Subroutine */ int sscal_(integer *, real *, real *, integer *);
real stemp[1];
extern doublereal sasum_(integer *, real *, integer *);
real strue[8];
extern /* Subroutine */ int stest_(integer *, real *, real *, real *,
real *), itest1_(integer *, integer *), stest1_(real *, real *,
real *, real *);
extern integer isamax_(integer *, real *, integer *);
/* Fortran I/O blocks */
static cilist io___32 = { 0, 6, 0, 0, 0 };
/* .. Parameters .. */
/* .. Scalar Arguments .. */
/* .. Scalars in Common .. */
/* .. Local Scalars .. */
/* .. Local Arrays .. */
/* .. External Functions .. */
/* .. External Subroutines .. */
/* .. Intrinsic Functions .. */
/* .. Common blocks .. */
/* .. Data statements .. */
/* .. Executable Statements .. */
for (combla_1.incx = 1; combla_1.incx <= 2; ++combla_1.incx) {
for (np1 = 1; np1 <= 5; ++np1) {
combla_1.n = np1 - 1;
len = max(combla_1.n,1) << 1;
/* .. Set vector arguments .. */
i__1 = len;
for (i__ = 1; i__ <= i__1; ++i__) {
sx[i__ - 1] = dv[i__ + (np1 + combla_1.incx * 5 << 3) - 49];
/* L20: */
}
if (combla_1.icase == 7) {
/* .. SNRM2 .. */
stemp[0] = dtrue1[np1 - 1];
r__1 = snrm2_(&combla_1.n, sx, &combla_1.incx);
stest1_(&r__1, stemp, stemp, sfac);
} else if (combla_1.icase == 8) {
/* .. SASUM .. */
stemp[0] = dtrue3[np1 - 1];
r__1 = sasum_(&combla_1.n, sx, &combla_1.incx);
stest1_(&r__1, stemp, stemp, sfac);
} else if (combla_1.icase == 9) {
/* .. SSCAL .. */
sscal_(&combla_1.n, &sa[(combla_1.incx - 1) * 5 + np1 - 1],
sx, &combla_1.incx);
i__1 = len;
for (i__ = 1; i__ <= i__1; ++i__) {
strue[i__ - 1] = dtrue5[i__ + (np1 + combla_1.incx * 5 <<
3) - 49];
/* L40: */
}
stest_(&len, sx, strue, strue, sfac);
} else if (combla_1.icase == 10) {
/* .. ISAMAX .. */
i__1 = isamax_(&combla_1.n, sx, &combla_1.incx);
itest1_(&i__1, &itrue2[np1 - 1]);
} else {
s_wsle(&io___32);
do_lio(&c__9, &c__1, " Shouldn't be here in CHECK1", (ftnlen)
28);
e_wsle();
s_stop("", (ftnlen)0);
}
/* L60: */
}
/* L80: */
}
return 0;
} /* check1_ */
/* Subroutine */ int check2_(real *sfac)
{
/* Initialized data */
static real sa = .3f;
static integer incxs[4] = { 1,2,-2,-1 };
static integer incys[4] = { 1,-2,1,-2 };
static integer lens[8] /* was [4][2] */ = { 1,1,2,4,1,1,3,7 };
static integer ns[4] = { 0,1,2,4 };
static real dx1[7] = { .6f,.1f,-.5f,.8f,.9f,-.3f,-.4f };
static real dy1[7] = { .5f,-.9f,.3f,.7f,-.6f,.2f,.8f };
static real dt7[16] /* was [4][4] */ = { 0.f,.3f,.21f,.62f,0.f,.3f,-.07f,
.85f,0.f,.3f,-.79f,-.74f,0.f,.3f,.33f,1.27f };
static real dt8[112] /* was [7][4][4] */ = { .5f,0.f,0.f,0.f,0.f,
0.f,0.f,.68f,0.f,0.f,0.f,0.f,0.f,0.f,.68f,-.87f,0.f,0.f,0.f,0.f,
0.f,.68f,-.87f,.15f,.94f,0.f,0.f,0.f,.5f,0.f,0.f,0.f,0.f,0.f,0.f,
.68f,0.f,0.f,0.f,0.f,0.f,0.f,.35f,-.9f,.48f,0.f,0.f,0.f,0.f,.38f,
-.9f,.57f,.7f,-.75f,.2f,.98f,.5f,0.f,0.f,0.f,0.f,0.f,0.f,.68f,0.f,
0.f,0.f,0.f,0.f,0.f,.35f,-.72f,0.f,0.f,0.f,0.f,0.f,.38f,-.63f,
.15f,.88f,0.f,0.f,0.f,.5f,0.f,0.f,0.f,0.f,0.f,0.f,.68f,0.f,0.f,
0.f,0.f,0.f,0.f,.68f,-.9f,.33f,0.f,0.f,0.f,0.f,.68f,-.9f,.33f,.7f,
-.75f,.2f,1.04f };
static real dt10x[112] /* was [7][4][4] */ = { .6f,0.f,0.f,0.f,0.f,
0.f,0.f,.5f,0.f,0.f,0.f,0.f,0.f,0.f,.5f,-.9f,0.f,0.f,0.f,0.f,0.f,
.5f,-.9f,.3f,.7f,0.f,0.f,0.f,.6f,0.f,0.f,0.f,0.f,0.f,0.f,.5f,0.f,
0.f,0.f,0.f,0.f,0.f,.3f,.1f,.5f,0.f,0.f,0.f,0.f,.8f,.1f,-.6f,.8f,
.3f,-.3f,.5f,.6f,0.f,0.f,0.f,0.f,0.f,0.f,.5f,0.f,0.f,0.f,0.f,0.f,
0.f,-.9f,.1f,.5f,0.f,0.f,0.f,0.f,.7f,.1f,.3f,.8f,-.9f,-.3f,.5f,
.6f,0.f,0.f,0.f,0.f,0.f,0.f,.5f,0.f,0.f,0.f,0.f,0.f,0.f,.5f,.3f,
0.f,0.f,0.f,0.f,0.f,.5f,.3f,-.6f,.8f,0.f,0.f,0.f };
static real dt10y[112] /* was [7][4][4] */ = { .5f,0.f,0.f,0.f,0.f,
0.f,0.f,.6f,0.f,0.f,0.f,0.f,0.f,0.f,.6f,.1f,0.f,0.f,0.f,0.f,0.f,
.6f,.1f,-.5f,.8f,0.f,0.f,0.f,.5f,0.f,0.f,0.f,0.f,0.f,0.f,.6f,0.f,
0.f,0.f,0.f,0.f,0.f,-.5f,-.9f,.6f,0.f,0.f,0.f,0.f,-.4f,-.9f,.9f,
.7f,-.5f,.2f,.6f,.5f,0.f,0.f,0.f,0.f,0.f,0.f,.6f,0.f,0.f,0.f,0.f,
0.f,0.f,-.5f,.6f,0.f,0.f,0.f,0.f,0.f,-.4f,.9f,-.5f,.6f,0.f,0.f,
0.f,.5f,0.f,0.f,0.f,0.f,0.f,0.f,.6f,0.f,0.f,0.f,0.f,0.f,0.f,.6f,
-.9f,.1f,0.f,0.f,0.f,0.f,.6f,-.9f,.1f,.7f,-.5f,.2f,.8f };
static real ssize1[4] = { 0.f,.3f,1.6f,3.2f };
static real ssize2[28] /* was [14][2] */ = { 0.f,0.f,0.f,0.f,0.f,0.f,
0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,1.17f,1.17f,1.17f,1.17f,1.17f,
1.17f,1.17f,1.17f,1.17f,1.17f,1.17f,1.17f,1.17f,1.17f };
/* System generated locals */
integer i__1;
real r__1;
/* Builtin functions */
integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
e_wsle(void);
/* Subroutine */ int s_stop(char *, ftnlen);
/* Local variables */
integer i__, j, ki, kn, mx, my;
real sx[7], sy[7], stx[7], sty[7];
integer lenx, leny;
extern doublereal sdot_(integer *, real *, integer *, real *, integer *);
integer ksize;
extern /* Subroutine */ int scopy_(integer *, real *, integer *, real *,
integer *), sswap_(integer *, real *, integer *, real *, integer *
), stest_(integer *, real *, real *, real *, real *), saxpy_(
integer *, real *, real *, integer *, real *, integer *), stest1_(
real *, real *, real *, real *);
/* Fortran I/O blocks */
static cilist io___63 = { 0, 6, 0, 0, 0 };
/* .. Parameters .. */
/* .. Scalar Arguments .. */
/* .. Scalars in Common .. */
/* .. Local Scalars .. */
/* .. Local Arrays .. */
/* .. External Functions .. */
/* .. External Subroutines .. */
/* .. Intrinsic Functions .. */
/* .. Common blocks .. */
/* .. Data statements .. */
/* .. Executable Statements .. */
for (ki = 1; ki <= 4; ++ki) {
combla_1.incx = incxs[ki - 1];
combla_1.incy = incys[ki - 1];
mx = abs(combla_1.incx);
my = abs(combla_1.incy);
for (kn = 1; kn <= 4; ++kn) {
combla_1.n = ns[kn - 1];
ksize = min(2,kn);
lenx = lens[kn + (mx << 2) - 5];
leny = lens[kn + (my << 2) - 5];
/* .. Initialize all argument arrays .. */
for (i__ = 1; i__ <= 7; ++i__) {
sx[i__ - 1] = dx1[i__ - 1];
sy[i__ - 1] = dy1[i__ - 1];
/* L20: */
}
if (combla_1.icase == 1) {
/* .. SDOT .. */
r__1 = sdot_(&combla_1.n, sx, &combla_1.incx, sy, &
combla_1.incy);
stest1_(&r__1, &dt7[kn + (ki << 2) - 5], &ssize1[kn - 1],
sfac);
} else if (combla_1.icase == 2) {
/* .. SAXPY .. */
saxpy_(&combla_1.n, &sa, sx, &combla_1.incx, sy, &
combla_1.incy);
i__1 = leny;
for (j = 1; j <= i__1; ++j) {
sty[j - 1] = dt8[j + (kn + (ki << 2)) * 7 - 36];
/* L40: */
}
stest_(&leny, sy, sty, &ssize2[ksize * 14 - 14], sfac);
} else if (combla_1.icase == 5) {
/* .. SCOPY .. */
for (i__ = 1; i__ <= 7; ++i__) {
sty[i__ - 1] = dt10y[i__ + (kn + (ki << 2)) * 7 - 36];
/* L60: */
}
scopy_(&combla_1.n, sx, &combla_1.incx, sy, &combla_1.incy);
stest_(&leny, sy, sty, ssize2, &c_b34);
} else if (combla_1.icase == 6) {
/* .. SSWAP .. */
sswap_(&combla_1.n, sx, &combla_1.incx, sy, &combla_1.incy);
for (i__ = 1; i__ <= 7; ++i__) {
stx[i__ - 1] = dt10x[i__ + (kn + (ki << 2)) * 7 - 36];
sty[i__ - 1] = dt10y[i__ + (kn + (ki << 2)) * 7 - 36];
/* L80: */
}
stest_(&lenx, sx, stx, ssize2, &c_b34);
stest_(&leny, sy, sty, ssize2, &c_b34);
} else {
s_wsle(&io___63);
do_lio(&c__9, &c__1, " Shouldn't be here in CHECK2", (ftnlen)
28);
e_wsle();
s_stop("", (ftnlen)0);
}
/* L100: */
}
/* L120: */
}
return 0;
} /* check2_ */
/* Subroutine */ int check2_(doublereal *sfac)
{
/* Initialized data */
static doublereal sa = .3;
static integer incxs[4] = { 1,2,-2,-1 };
static integer incys[4] = { 1,-2,1,-2 };
static integer lens[8] /* was [4][2] */ = { 1,1,2,4,1,1,3,7 };
static integer ns[4] = { 0,1,2,4 };
static doublereal dx1[7] = { .6,.1,-.5,.8,.9,-.3,-.4 };
static doublereal dy1[7] = { .5,-.9,.3,.7,-.6,.2,.8 };
static doublereal dt7[16] /* was [4][4] */ = { 0.,.3,.21,.62,0.,.3,-.07,
.85,0.,.3,-.79,-.74,0.,.3,.33,1.27 };
static doublereal dt8[112] /* was [7][4][4] */ = { .5,0.,0.,0.,0.,0.,0.,
.68,0.,0.,0.,0.,0.,0.,.68,-.87,0.,0.,0.,0.,0.,.68,-.87,.15,.94,0.,
0.,0.,.5,0.,0.,0.,0.,0.,0.,.68,0.,0.,0.,0.,0.,0.,.35,-.9,.48,0.,
0.,0.,0.,.38,-.9,.57,.7,-.75,.2,.98,.5,0.,0.,0.,0.,0.,0.,.68,0.,
0.,0.,0.,0.,0.,.35,-.72,0.,0.,0.,0.,0.,.38,-.63,.15,.88,0.,0.,0.,
.5,0.,0.,0.,0.,0.,0.,.68,0.,0.,0.,0.,0.,0.,.68,-.9,.33,0.,0.,0.,
0.,.68,-.9,.33,.7,-.75,.2,1.04 };
static doublereal dt10x[112] /* was [7][4][4] */ = { .6,0.,0.,0.,
0.,0.,0.,.5,0.,0.,0.,0.,0.,0.,.5,-.9,0.,0.,0.,0.,0.,.5,-.9,.3,.7,
0.,0.,0.,.6,0.,0.,0.,0.,0.,0.,.5,0.,0.,0.,0.,0.,0.,.3,.1,.5,0.,0.,
0.,0.,.8,.1,-.6,.8,.3,-.3,.5,.6,0.,0.,0.,0.,0.,0.,.5,0.,0.,0.,0.,
0.,0.,-.9,.1,.5,0.,0.,0.,0.,.7,.1,.3,.8,-.9,-.3,.5,.6,0.,0.,0.,0.,
0.,0.,.5,0.,0.,0.,0.,0.,0.,.5,.3,0.,0.,0.,0.,0.,.5,.3,-.6,.8,0.,
0.,0. };
static doublereal dt10y[112] /* was [7][4][4] */ = { .5,0.,0.,0.,
0.,0.,0.,.6,0.,0.,0.,0.,0.,0.,.6,.1,0.,0.,0.,0.,0.,.6,.1,-.5,.8,
0.,0.,0.,.5,0.,0.,0.,0.,0.,0.,.6,0.,0.,0.,0.,0.,0.,-.5,-.9,.6,0.,
0.,0.,0.,-.4,-.9,.9,.7,-.5,.2,.6,.5,0.,0.,0.,0.,0.,0.,.6,0.,0.,0.,
0.,0.,0.,-.5,.6,0.,0.,0.,0.,0.,-.4,.9,-.5,.6,0.,0.,0.,.5,0.,0.,0.,
0.,0.,0.,.6,0.,0.,0.,0.,0.,0.,.6,-.9,.1,0.,0.,0.,0.,.6,-.9,.1,.7,
-.5,.2,.8 };
static doublereal ssize1[4] = { 0.,.3,1.6,3.2 };
static doublereal ssize2[28] /* was [14][2] */ = { 0.,0.,0.,0.,0.,
0.,0.,0.,0.,0.,0.,0.,0.,0.,1.17,1.17,1.17,1.17,1.17,1.17,1.17,
1.17,1.17,1.17,1.17,1.17,1.17,1.17 };
/* System generated locals */
integer i__1;
doublereal d__1;
/* Local variables */
integer i__, j, ki, kn, mx, my;
doublereal sx[7], sy[7], stx[7], sty[7];
integer lenx, leny;
integer ksize;
/* Fortran I/O blocks */
static cilist io___58 = { 0, 6, 0, 0, 0 };
/* .. Parameters .. */
/* .. Scalar Arguments .. */
/* .. Scalars in Common .. */
/* .. Local Scalars .. */
/* .. Local Arrays .. */
/* .. External Functions .. */
/* .. External Subroutines .. */
/* .. Intrinsic Functions .. */
/* .. Common blocks .. */
/* .. Data statements .. */
/* .. Executable Statements .. */
for (ki = 1; ki <= 4; ++ki) {
combla_1.incx = incxs[ki - 1];
combla_1.incy = incys[ki - 1];
mx = abs(combla_1.incx);
my = abs(combla_1.incy);
for (kn = 1; kn <= 4; ++kn) {
combla_1.n = ns[kn - 1];
ksize = min(2,kn);
lenx = lens[kn + (mx << 2) - 5];
leny = lens[kn + (my << 2) - 5];
/* .. Initialize all argument arrays .. */
for (i__ = 1; i__ <= 7; ++i__) {
sx[i__ - 1] = dx1[i__ - 1];
sy[i__ - 1] = dy1[i__ - 1];
/* L20: */
}
if (combla_1.icase == 1) {
/* .. DDOT .. */
d__1 = ddot_(&combla_1.n, sx, &combla_1.incx, sy, &
combla_1.incy);
stest1_(&d__1, &dt7[kn + (ki << 2) - 5], &ssize1[kn - 1],
sfac);
} else if (combla_1.icase == 2) {
/* .. DAXPY .. */
daxpy_(&combla_1.n, &sa, sx, &combla_1.incx, sy, &
combla_1.incy);
i__1 = leny;
for (j = 1; j <= i__1; ++j) {
sty[j - 1] = dt8[j + (kn + (ki << 2)) * 7 - 36];
/* L40: */
}
stest_(&leny, sy, sty, &ssize2[ksize * 14 - 14], sfac);
} else if (combla_1.icase == 5) {
/* .. DCOPY .. */
for (i__ = 1; i__ <= 7; ++i__) {
sty[i__ - 1] = dt10y[i__ + (kn + (ki << 2)) * 7 - 36];
/* L60: */
}
dcopy_(&combla_1.n, sx, &combla_1.incx, sy, &combla_1.incy);
stest_(&leny, sy, sty, ssize2, &c_b34);
} else if (combla_1.icase == 6) {
/* .. DSWAP .. */
dswap_(&combla_1.n, sx, &combla_1.incx, sy, &combla_1.incy);
for (i__ = 1; i__ <= 7; ++i__) {
stx[i__ - 1] = dt10x[i__ + (kn + (ki << 2)) * 7 - 36];
sty[i__ - 1] = dt10y[i__ + (kn + (ki << 2)) * 7 - 36];
/* L80: */
}
stest_(&lenx, sx, stx, ssize2, &c_b34);
stest_(&leny, sy, sty, ssize2, &c_b34);
} else {
s_wsle(&io___58);
do_lio(&c__9, &c__1, " Shouldn't be here in CHECK2", (ftnlen)
28);
e_wsle();
s_stop("", (ftnlen)0);
}
/* L100: */
}
/* L120: */
}
return 0;
} /* check2_ */
/* Subroutine */ int check1_(doublereal *sfac)
{
/* Initialized data */
static doublereal sa[10] = { .3,-1.,0.,1.,.3,.3,.3,.3,.3,.3 };
static doublereal dv[80] /* was [8][5][2] */ = { .1,2.,2.,2.,2.,2.,2.,
2.,.3,3.,3.,3.,3.,3.,3.,3.,.3,-.4,4.,4.,4.,4.,4.,4.,.2,-.6,.3,5.,
5.,5.,5.,5.,.1,-.3,.5,-.1,6.,6.,6.,6.,.1,8.,8.,8.,8.,8.,8.,8.,.3,
9.,9.,9.,9.,9.,9.,9.,.3,2.,-.4,2.,2.,2.,2.,2.,.2,3.,-.6,5.,.3,2.,
2.,2.,.1,4.,-.3,6.,-.5,7.,-.1,3. };
static doublereal dtrue1[5] = { 0.,.3,.5,.7,.6 };
static doublereal dtrue3[5] = { 0.,.3,.7,1.1,1. };
static doublereal dtrue5[80] /* was [8][5][2] */ = { .1,2.,2.,2.,
2.,2.,2.,2.,-.3,3.,3.,3.,3.,3.,3.,3.,0.,0.,4.,4.,4.,4.,4.,4.,.2,
-.6,.3,5.,5.,5.,5.,5.,.03,-.09,.15,-.03,6.,6.,6.,6.,.1,8.,8.,8.,
8.,8.,8.,8.,.09,9.,9.,9.,9.,9.,9.,9.,.09,2.,-.12,2.,2.,2.,2.,2.,
.06,3.,-.18,5.,.09,2.,2.,2.,.03,4.,-.09,6.,-.15,7.,-.03,3. };
static integer itrue2[5] = { 0,1,2,2,3 };
/* System generated locals */
integer i__1;
doublereal d__1;
/* Local variables */
integer i__;
doublereal sx[8];
integer np1, len;
doublereal stemp[1], strue[8];
/* Fortran I/O blocks */
static cilist io___31 = { 0, 6, 0, 0, 0 };
/* .. Parameters .. */
/* .. Scalar Arguments .. */
/* .. Scalars in Common .. */
/* .. Local Scalars .. */
/* .. Local Arrays .. */
/* .. External Functions .. */
/* .. External Subroutines .. */
/* .. Intrinsic Functions .. */
/* .. Common blocks .. */
/* .. Data statements .. */
/* .. Executable Statements .. */
for (combla_1.incx = 1; combla_1.incx <= 2; ++combla_1.incx) {
for (np1 = 1; np1 <= 5; ++np1) {
combla_1.n = np1 - 1;
len = max(combla_1.n,1) << 1;
/* .. Set vector arguments .. */
i__1 = len;
for (i__ = 1; i__ <= i__1; ++i__) {
sx[i__ - 1] = dv[i__ + (np1 + combla_1.incx * 5 << 3) - 49];
/* L20: */
}
if (combla_1.icase == 7) {
/* .. DNRM2 .. */
stemp[0] = dtrue1[np1 - 1];
d__1 = dnrm2_(&combla_1.n, sx, &combla_1.incx);
stest1_(&d__1, stemp, stemp, sfac);
} else if (combla_1.icase == 8) {
/* .. DASUM .. */
stemp[0] = dtrue3[np1 - 1];
d__1 = dasum_(&combla_1.n, sx, &combla_1.incx);
stest1_(&d__1, stemp, stemp, sfac);
} else if (combla_1.icase == 9) {
/* .. DSCAL .. */
dscal_(&combla_1.n, &sa[(combla_1.incx - 1) * 5 + np1 - 1],
sx, &combla_1.incx);
i__1 = len;
for (i__ = 1; i__ <= i__1; ++i__) {
strue[i__ - 1] = dtrue5[i__ + (np1 + combla_1.incx * 5 <<
3) - 49];
/* L40: */
}
stest_(&len, sx, strue, strue, sfac);
} else if (combla_1.icase == 10) {
/* .. IDAMAX .. */
i__1 = idamax_(&combla_1.n, sx, &combla_1.incx);
itest1_(&i__1, &itrue2[np1 - 1]);
} else {
s_wsle(&io___31);
do_lio(&c__9, &c__1, " Shouldn't be here in CHECK1", (ftnlen)
28);
e_wsle();
s_stop("", (ftnlen)0);
}
/* L60: */
}
/* L80: */
}
return 0;
} /* check1_ */
/* Subroutine */ int check3_(doublereal *sfac)
{
/* Initialized data */
static integer incxs[4] = { 1,2,-2,-1 };
static integer incys[4] = { 1,-2,1,-2 };
static integer lens[8] /* was [4][2] */ = { 1,1,2,4,1,1,3,7 };
static integer ns[4] = { 0,1,2,4 };
static doublereal dx1[7] = { .6,.1,-.5,.8,.9,-.3,-.4 };
static doublereal dy1[7] = { .5,-.9,.3,.7,-.6,.2,.8 };
static doublereal sc = .8;
static doublereal ss = .6;
static doublereal dt9x[112] /* was [7][4][4] */ = { .6,0.,0.,0.,0.,0.,0.,
.78,0.,0.,0.,0.,0.,0.,.78,-.46,0.,0.,0.,0.,0.,.78,-.46,-.22,1.06,
0.,0.,0.,.6,0.,0.,0.,0.,0.,0.,.78,0.,0.,0.,0.,0.,0.,.66,.1,-.1,0.,
0.,0.,0.,.96,.1,-.76,.8,.9,-.3,-.02,.6,0.,0.,0.,0.,0.,0.,.78,0.,
0.,0.,0.,0.,0.,-.06,.1,-.1,0.,0.,0.,0.,.9,.1,-.22,.8,.18,-.3,-.02,
.6,0.,0.,0.,0.,0.,0.,.78,0.,0.,0.,0.,0.,0.,.78,.26,0.,0.,0.,0.,0.,
.78,.26,-.76,1.12,0.,0.,0. };
static doublereal dt9y[112] /* was [7][4][4] */ = { .5,0.,0.,0.,0.,0.,0.,
.04,0.,0.,0.,0.,0.,0.,.04,-.78,0.,0.,0.,0.,0.,.04,-.78,.54,.08,0.,
0.,0.,.5,0.,0.,0.,0.,0.,0.,.04,0.,0.,0.,0.,0.,0.,.7,-.9,-.12,0.,
0.,0.,0.,.64,-.9,-.3,.7,-.18,.2,.28,.5,0.,0.,0.,0.,0.,0.,.04,0.,
0.,0.,0.,0.,0.,.7,-1.08,0.,0.,0.,0.,0.,.64,-1.26,.54,.2,0.,0.,0.,
.5,0.,0.,0.,0.,0.,0.,.04,0.,0.,0.,0.,0.,0.,.04,-.9,.18,0.,0.,0.,
0.,.04,-.9,.18,.7,-.18,.2,.16 };
static doublereal ssize2[28] /* was [14][2] */ = { 0.,0.,0.,0.,0.,
0.,0.,0.,0.,0.,0.,0.,0.,0.,1.17,1.17,1.17,1.17,1.17,1.17,1.17,
1.17,1.17,1.17,1.17,1.17,1.17,1.17 };
/* Builtin functions */
integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
e_wsle(void);
/* Subroutine */ int s_stop(char *, ftnlen);
/* Local variables */
static integer lenx, leny;
static doublereal mwpc[11];
extern /* Subroutine */ int drot_(integer *, doublereal *, integer *,
doublereal *, integer *, doublereal *, doublereal *);
static integer mwpn[11];
static doublereal mwps[11], mwpx[5], mwpy[5];
static integer i__, k, ksize;
static doublereal copyx[5], copyy[5];
extern /* Subroutine */ int stest_(integer *, doublereal *, doublereal *,
doublereal *, doublereal *);
static doublereal mwptx[55] /* was [11][5] */, mwpty[55] /* was [11][5]
*/;
static integer ki, kn, mx, my;
static doublereal sx[7], sy[7];
static integer mwpinx[11], mwpiny[11];
static doublereal mwpstx[5], mwpsty[5], stx[7], sty[7];
/* Fortran I/O blocks */
static cilist io___88 = { 0, 6, 0, 0, 0 };
#define lens_ref(a_1,a_2) lens[(a_2)*4 + a_1 - 5]
#define mwptx_ref(a_1,a_2) mwptx[(a_2)*11 + a_1 - 12]
#define mwpty_ref(a_1,a_2) mwpty[(a_2)*11 + a_1 - 12]
#define ssize2_ref(a_1,a_2) ssize2[(a_2)*14 + a_1 - 15]
#define dt9x_ref(a_1,a_2,a_3) dt9x[((a_3)*4 + (a_2))*7 + a_1 - 36]
#define dt9y_ref(a_1,a_2,a_3) dt9y[((a_3)*4 + (a_2))*7 + a_1 - 36]
for (ki = 1; ki <= 4; ++ki) {
combla_1.incx = incxs[ki - 1];
combla_1.incy = incys[ki - 1];
mx = abs(combla_1.incx);
my = abs(combla_1.incy);
for (kn = 1; kn <= 4; ++kn) {
combla_1.n = ns[kn - 1];
ksize = min(2,kn);
lenx = lens_ref(kn, mx);
leny = lens_ref(kn, my);
if (combla_1.icase == 4) {
for (i__ = 1; i__ <= 7; ++i__) {
sx[i__ - 1] = dx1[i__ - 1];
sy[i__ - 1] = dy1[i__ - 1];
stx[i__ - 1] = dt9x_ref(i__, kn, ki);
sty[i__ - 1] = dt9y_ref(i__, kn, ki);
/* L20: */
}
drot_(&combla_1.n, sx, &combla_1.incx, sy, &combla_1.incy, &
sc, &ss);
stest_(&lenx, sx, stx, &ssize2_ref(1, ksize), sfac);
stest_(&leny, sy, sty, &ssize2_ref(1, ksize), sfac);
} else {
s_wsle(&io___88);
do_lio(&c__9, &c__1, " Shouldn't be here in CHECK3", (ftnlen)
28);
e_wsle();
s_stop("", (ftnlen)0);
}
/* L40: */
}
/* L60: */
}
mwpc[0] = 1.;
for (i__ = 2; i__ <= 11; ++i__) {
mwpc[i__ - 1] = 0.;
/* L80: */
}
mwps[0] = 0.;
for (i__ = 2; i__ <= 6; ++i__) {
mwps[i__ - 1] = 1.;
/* L100: */
}
for (i__ = 7; i__ <= 11; ++i__) {
mwps[i__ - 1] = -1.;
/* L120: */
}
mwpinx[0] = 1;
mwpinx[1] = 1;
mwpinx[2] = 1;
mwpinx[3] = -1;
mwpinx[4] = 1;
mwpinx[5] = -1;
mwpinx[6] = 1;
mwpinx[7] = 1;
mwpinx[8] = -1;
mwpinx[9] = 1;
mwpinx[10] = -1;
mwpiny[0] = 1;
mwpiny[1] = 1;
mwpiny[2] = -1;
mwpiny[3] = -1;
mwpiny[4] = 2;
mwpiny[5] = 1;
mwpiny[6] = 1;
mwpiny[7] = -1;
mwpiny[8] = -1;
mwpiny[9] = 2;
mwpiny[10] = 1;
for (i__ = 1; i__ <= 11; ++i__) {
mwpn[i__ - 1] = 5;
/* L140: */
}
mwpn[4] = 3;
mwpn[9] = 3;
for (i__ = 1; i__ <= 5; ++i__) {
mwpx[i__ - 1] = (doublereal) i__;
mwpy[i__ - 1] = (doublereal) i__;
mwptx_ref(1, i__) = (doublereal) i__;
mwpty_ref(1, i__) = (doublereal) i__;
mwptx_ref(2, i__) = (doublereal) i__;
mwpty_ref(2, i__) = (doublereal) (-i__);
mwptx_ref(3, i__) = (doublereal) (6 - i__);
mwpty_ref(3, i__) = (doublereal) (i__ - 6);
mwptx_ref(4, i__) = (doublereal) i__;
mwpty_ref(4, i__) = (doublereal) (-i__);
mwptx_ref(6, i__) = (doublereal) (6 - i__);
mwpty_ref(6, i__) = (doublereal) (i__ - 6);
mwptx_ref(7, i__) = (doublereal) (-i__);
mwpty_ref(7, i__) = (doublereal) i__;
mwptx_ref(8, i__) = (doublereal) (i__ - 6);
mwpty_ref(8, i__) = (doublereal) (6 - i__);
mwptx_ref(9, i__) = (doublereal) (-i__);
mwpty_ref(9, i__) = (doublereal) i__;
mwptx_ref(11, i__) = (doublereal) (i__ - 6);
mwpty_ref(11, i__) = (doublereal) (6 - i__);
/* L160: */
}
mwptx_ref(5, 1) = 1.;
mwptx_ref(5, 2) = 3.;
mwptx_ref(5, 3) = 5.;
mwptx_ref(5, 4) = 4.;
mwptx_ref(5, 5) = 5.;
mwpty_ref(5, 1) = -1.;
mwpty_ref(5, 2) = 2.;
mwpty_ref(5, 3) = -2.;
mwpty_ref(5, 4) = 4.;
mwpty_ref(5, 5) = -3.;
mwptx_ref(10, 1) = -1.;
mwptx_ref(10, 2) = -3.;
mwptx_ref(10, 3) = -5.;
mwptx_ref(10, 4) = 4.;
mwptx_ref(10, 5) = 5.;
mwpty_ref(10, 1) = 1.;
mwpty_ref(10, 2) = 2.;
mwpty_ref(10, 3) = 2.;
mwpty_ref(10, 4) = 4.;
mwpty_ref(10, 5) = 3.;
for (i__ = 1; i__ <= 11; ++i__) {
combla_1.incx = mwpinx[i__ - 1];
combla_1.incy = mwpiny[i__ - 1];
for (k = 1; k <= 5; ++k) {
copyx[k - 1] = mwpx[k - 1];
copyy[k - 1] = mwpy[k - 1];
mwpstx[k - 1] = mwptx_ref(i__, k);
mwpsty[k - 1] = mwpty_ref(i__, k);
/* L180: */
}
drot_(&mwpn[i__ - 1], copyx, &combla_1.incx, copyy, &combla_1.incy, &
mwpc[i__ - 1], &mwps[i__ - 1]);
stest_(&c__5, copyx, mwpstx, mwpstx, sfac);
stest_(&c__5, copyy, mwpsty, mwpsty, sfac);
/* L200: */
}
return 0;
} /* check3_ */
/* Subroutine */ int check2_(doublereal *sfac)
{
/* Initialized data */
static doublereal sa = .3;
static integer incxs[4] = { 1,2,-2,-1 };
static integer incys[4] = { 1,-2,1,-2 };
static integer lens[8] /* was [4][2] */ = { 1,1,2,4,1,1,3,7 };
static integer ns[4] = { 0,1,2,4 };
static doublereal dx1[7] = { .6,.1,-.5,.8,.9,-.3,-.4 };
static doublereal dy1[7] = { .5,-.9,.3,.7,-.6,.2,.8 };
static doublereal dt7[16] /* was [4][4] */ = { 0.,.3,.21,.62,0.,.3,-.07,
.85,0.,.3,-.79,-.74,0.,.3,.33,1.27 };
static doublereal dt8[112] /* was [7][4][4] */ = { .5,0.,0.,0.,0.,0.,0.,
.68,0.,0.,0.,0.,0.,0.,.68,-.87,0.,0.,0.,0.,0.,.68,-.87,.15,.94,0.,
0.,0.,.5,0.,0.,0.,0.,0.,0.,.68,0.,0.,0.,0.,0.,0.,.35,-.9,.48,0.,
0.,0.,0.,.38,-.9,.57,.7,-.75,.2,.98,.5,0.,0.,0.,0.,0.,0.,.68,0.,
0.,0.,0.,0.,0.,.35,-.72,0.,0.,0.,0.,0.,.38,-.63,.15,.88,0.,0.,0.,
.5,0.,0.,0.,0.,0.,0.,.68,0.,0.,0.,0.,0.,0.,.68,-.9,.33,0.,0.,0.,
0.,.68,-.9,.33,.7,-.75,.2,1.04 };
static doublereal dt10x[112] /* was [7][4][4] */ = { .6,0.,0.,0.,
0.,0.,0.,.5,0.,0.,0.,0.,0.,0.,.5,-.9,0.,0.,0.,0.,0.,.5,-.9,.3,.7,
0.,0.,0.,.6,0.,0.,0.,0.,0.,0.,.5,0.,0.,0.,0.,0.,0.,.3,.1,.5,0.,0.,
0.,0.,.8,.1,-.6,.8,.3,-.3,.5,.6,0.,0.,0.,0.,0.,0.,.5,0.,0.,0.,0.,
0.,0.,-.9,.1,.5,0.,0.,0.,0.,.7,.1,.3,.8,-.9,-.3,.5,.6,0.,0.,0.,0.,
0.,0.,.5,0.,0.,0.,0.,0.,0.,.5,.3,0.,0.,0.,0.,0.,.5,.3,-.6,.8,0.,
0.,0. };
static doublereal dt10y[112] /* was [7][4][4] */ = { .5,0.,0.,0.,
0.,0.,0.,.6,0.,0.,0.,0.,0.,0.,.6,.1,0.,0.,0.,0.,0.,.6,.1,-.5,.8,
0.,0.,0.,.5,0.,0.,0.,0.,0.,0.,.6,0.,0.,0.,0.,0.,0.,-.5,-.9,.6,0.,
0.,0.,0.,-.4,-.9,.9,.7,-.5,.2,.6,.5,0.,0.,0.,0.,0.,0.,.6,0.,0.,0.,
0.,0.,0.,-.5,.6,0.,0.,0.,0.,0.,-.4,.9,-.5,.6,0.,0.,0.,.5,0.,0.,0.,
0.,0.,0.,.6,0.,0.,0.,0.,0.,0.,.6,-.9,.1,0.,0.,0.,0.,.6,-.9,.1,.7,
-.5,.2,.8 };
static doublereal ssize1[4] = { 0.,.3,1.6,3.2 };
static doublereal ssize2[28] /* was [14][2] */ = { 0.,0.,0.,0.,0.,
0.,0.,0.,0.,0.,0.,0.,0.,0.,1.17,1.17,1.17,1.17,1.17,1.17,1.17,
1.17,1.17,1.17,1.17,1.17,1.17,1.17 };
/* System generated locals */
integer i__1;
doublereal d__1;
/* Builtin functions */
integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
e_wsle(void);
/* Subroutine */ int s_stop(char *, ftnlen);
/* Local variables */
extern doublereal ddot_(integer *, doublereal *, integer *, doublereal *,
integer *);
static integer lenx, leny, i__, j;
extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
doublereal *, integer *), dswap_(integer *, doublereal *, integer
*, doublereal *, integer *);
static integer ksize;
extern /* Subroutine */ int daxpy_(integer *, doublereal *, doublereal *,
integer *, doublereal *, integer *), stest_(integer *, doublereal
*, doublereal *, doublereal *, doublereal *), stest1_(doublereal *
, doublereal *, doublereal *, doublereal *);
static integer ki, kn, mx, my;
static doublereal sx[7], sy[7], stx[7], sty[7];
/* Fortran I/O blocks */
static cilist io___63 = { 0, 6, 0, 0, 0 };
#define dt10x_ref(a_1,a_2,a_3) dt10x[((a_3)*4 + (a_2))*7 + a_1 - 36]
#define dt10y_ref(a_1,a_2,a_3) dt10y[((a_3)*4 + (a_2))*7 + a_1 - 36]
#define lens_ref(a_1,a_2) lens[(a_2)*4 + a_1 - 5]
#define ssize2_ref(a_1,a_2) ssize2[(a_2)*14 + a_1 - 15]
#define dt7_ref(a_1,a_2) dt7[(a_2)*4 + a_1 - 5]
#define dt8_ref(a_1,a_2,a_3) dt8[((a_3)*4 + (a_2))*7 + a_1 - 36]
for (ki = 1; ki <= 4; ++ki) {
combla_1.incx = incxs[ki - 1];
combla_1.incy = incys[ki - 1];
mx = abs(combla_1.incx);
my = abs(combla_1.incy);
for (kn = 1; kn <= 4; ++kn) {
combla_1.n = ns[kn - 1];
ksize = min(2,kn);
lenx = lens_ref(kn, mx);
leny = lens_ref(kn, my);
for (i__ = 1; i__ <= 7; ++i__) {
sx[i__ - 1] = dx1[i__ - 1];
sy[i__ - 1] = dy1[i__ - 1];
/* L20: */
}
if (combla_1.icase == 1) {
d__1 = ddot_(&combla_1.n, sx, &combla_1.incx, sy, &
combla_1.incy);
stest1_(&d__1, &dt7_ref(kn, ki), &ssize1[kn - 1], sfac);
} else if (combla_1.icase == 2) {
daxpy_(&combla_1.n, &sa, sx, &combla_1.incx, sy, &
combla_1.incy);
i__1 = leny;
for (j = 1; j <= i__1; ++j) {
sty[j - 1] = dt8_ref(j, kn, ki);
/* L40: */
}
stest_(&leny, sy, sty, &ssize2_ref(1, ksize), sfac);
} else if (combla_1.icase == 5) {
for (i__ = 1; i__ <= 7; ++i__) {
sty[i__ - 1] = dt10y_ref(i__, kn, ki);
/* L60: */
}
dcopy_(&combla_1.n, sx, &combla_1.incx, sy, &combla_1.incy);
stest_(&leny, sy, sty, &ssize2_ref(1, 1), &c_b34);
} else if (combla_1.icase == 6) {
dswap_(&combla_1.n, sx, &combla_1.incx, sy, &combla_1.incy);
for (i__ = 1; i__ <= 7; ++i__) {
stx[i__ - 1] = dt10x_ref(i__, kn, ki);
sty[i__ - 1] = dt10y_ref(i__, kn, ki);
/* L80: */
}
stest_(&lenx, sx, stx, &ssize2_ref(1, 1), &c_b34);
stest_(&leny, sy, sty, &ssize2_ref(1, 1), &c_b34);
} else {
s_wsle(&io___63);
do_lio(&c__9, &c__1, " Shouldn't be here in CHECK2", (ftnlen)
28);
e_wsle();
s_stop("", (ftnlen)0);
}
/* L100: */
}
/* L120: */
}
return 0;
} /* check2_ */
Subroutine */ int check1_(doublereal *sfac)
{
/* Initialized data */
static doublereal sa[10] = { .3,-1.,0.,1.,.3,.3,.3,.3,.3,.3 };
static doublereal dv[80] /* was [8][5][2] */ = { .1,2.,2.,2.,2.,2.,2.,
2.,.3,3.,3.,3.,3.,3.,3.,3.,.3,-.4,4.,4.,4.,4.,4.,4.,.2,-.6,.3,5.,
5.,5.,5.,5.,.1,-.3,.5,-.1,6.,6.,6.,6.,.1,8.,8.,8.,8.,8.,8.,8.,.3,
9.,9.,9.,9.,9.,9.,9.,.3,2.,-.4,2.,2.,2.,2.,2.,.2,3.,-.6,5.,.3,2.,
2.,2.,.1,4.,-.3,6.,-.5,7.,-.1,3. };
static doublereal dtrue1[5] = { 0.,.3,.5,.7,.6 };
static doublereal dtrue3[5] = { 0.,.3,.7,1.1,1. };
static doublereal dtrue5[80] /* was [8][5][2] */ = { .1,2.,2.,2.,
2.,2.,2.,2.,-.3,3.,3.,3.,3.,3.,3.,3.,0.,0.,4.,4.,4.,4.,4.,4.,.2,
-.6,.3,5.,5.,5.,5.,5.,.03,-.09,.15,-.03,6.,6.,6.,6.,.1,8.,8.,8.,
8.,8.,8.,8.,.09,9.,9.,9.,9.,9.,9.,9.,.09,2.,-.12,2.,2.,2.,2.,2.,
.06,3.,-.18,5.,.09,2.,2.,2.,.03,4.,-.09,6.,-.15,7.,-.03,3. };
static integer itrue2[5] = { 0,1,2,2,3 };
/* System generated locals */
integer i__1;
doublereal d__1;
/* Builtin functions */
integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
e_wsle(void);
/* Subroutine */ int s_stop(char *, ftnlen);
/* Local variables */
extern doublereal dnrm2_(integer *, doublereal *, integer *);
static integer i__;
extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
integer *);
extern doublereal dasum_(integer *, doublereal *, integer *);
static doublereal stemp[1], strue[8];
extern /* Subroutine */ int stest_(integer *, doublereal *, doublereal *,
doublereal *, doublereal *), itest1_(integer *, integer *),
stest1_(doublereal *, doublereal *, doublereal *, doublereal *);
extern integer idamax_(integer *, doublereal *, integer *);
static doublereal sx[8];
static integer np1, len;
/* Fortran I/O blocks */
static cilist io___32 = { 0, 6, 0, 0, 0 };
#define dtrue5_ref(a_1,a_2,a_3) dtrue5[((a_3)*5 + (a_2))*8 + a_1 - 49]
#define dv_ref(a_1,a_2,a_3) dv[((a_3)*5 + (a_2))*8 + a_1 - 49]
for (combla_1.incx = 1; combla_1.incx <= 2; ++combla_1.incx) {
for (np1 = 1; np1 <= 5; ++np1) {
combla_1.n = np1 - 1;
len = max(combla_1.n,1) << 1;
i__1 = len;
for (i__ = 1; i__ <= i__1; ++i__) {
sx[i__ - 1] = dv_ref(i__, np1, combla_1.incx);
/* L20: */
}
if (combla_1.icase == 7) {
stemp[0] = dtrue1[np1 - 1];
d__1 = dnrm2_(&combla_1.n, sx, &combla_1.incx);
stest1_(&d__1, stemp, stemp, sfac);
} else if (combla_1.icase == 8) {
stemp[0] = dtrue3[np1 - 1];
d__1 = dasum_(&combla_1.n, sx, &combla_1.incx);
stest1_(&d__1, stemp, stemp, sfac);
} else if (combla_1.icase == 9) {
dscal_(&combla_1.n, &sa[(combla_1.incx - 1) * 5 + np1 - 1],
sx, &combla_1.incx);
i__1 = len;
for (i__ = 1; i__ <= i__1; ++i__) {
strue[i__ - 1] = dtrue5_ref(i__, np1, combla_1.incx);
/* L40: */
}
stest_(&len, sx, strue, strue, sfac);
} else if (combla_1.icase == 10) {
i__1 = idamax_(&combla_1.n, sx, &combla_1.incx);
itest1_(&i__1, &itrue2[np1 - 1]);
} else {
s_wsle(&io___32);
do_lio(&c__9, &c__1, " Shouldn't be here in CHECK1", (ftnlen)
28);
e_wsle();
s_stop("", (ftnlen)0);
}
/* L60: */
}
/* L80: */
}
return 0;
} /* check1_ */
