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_ */