/* Subroutine */ int check0_(doublereal *sfac) { /* Initialized data */ static doublereal ds1[8] = { .8,.6,.8,-.6,.8,0.,1.,0. }; static doublereal datrue[8] = { .5,.5,.5,-.5,-.5,0.,1.,1. }; static doublereal dbtrue[8] = { 0.,.6,0.,-.6,0.,0.,1.,0. }; static doublereal da1[8] = { .3,.4,-.3,-.4,-.3,0.,0.,1. }; static doublereal db1[8] = { .4,.3,.4,.3,-.4,0.,1.,0. }; static doublereal dc1[8] = { .6,.8,-.6,.8,.6,1.,0.,1. }; /* 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 k; extern /* Subroutine */ int drotg_(doublereal *, doublereal *, doublereal *, doublereal *), stest1_(doublereal *, doublereal *, doublereal * , doublereal *); static doublereal sa, sb, sc, ss; /* Fortran I/O blocks */ static cilist io___19 = { 0, 6, 0, 0, 0 }; /* Compute true values which cannot be prestored in decimal notation */ dbtrue[0] = 1.6666666666666667; dbtrue[2] = -1.6666666666666667; dbtrue[4] = 1.6666666666666667; for (k = 1; k <= 8; ++k) { combla_1.n = k; if (combla_1.icase == 3) { if (k > 8) { goto L40; } sa = da1[k - 1]; sb = db1[k - 1]; drotg_(&sa, &sb, &sc, &ss); stest1_(&sa, &datrue[k - 1], &datrue[k - 1], sfac); stest1_(&sb, &dbtrue[k - 1], &dbtrue[k - 1], sfac); stest1_(&sc, &dc1[k - 1], &dc1[k - 1], sfac); stest1_(&ss, &ds1[k - 1], &ds1[k - 1], sfac); } else { s_wsle(&io___19); do_lio(&c__9, &c__1, " Shouldn't be here in CHECK0", (ftnlen)28); e_wsle(); s_stop("", (ftnlen)0); } /* L20: */ } L40: return 0; } /* check0_
/* Subroutine */ int check1_(doublereal *sfac) { /* Initialized data */ static doublereal strue2[5] = { 0.,.5,.6,.7,.7 }; static doublereal strue4[5] = { 0.,.7,1.,1.3,1.7 }; static doublecomplex ctrue5[80] /* was [8][5][2] */ = { {.1,.1},{ 1., 2. },{1.,2.},{1.,2.},{1.,2.},{1.,2.},{1.,2.},{1.,2.},{-.16,-.37},{ 3.,4. },{3.,4.},{3.,4.},{3.,4.},{3.,4.},{3.,4.},{3.,4.},{-.17,-.19} ,{.13,-.39},{5.,6.},{5.,6.},{5.,6.},{5.,6.},{5.,6.},{5.,6.},{ .11, -.03 },{-.17,.46},{-.17,-.19},{7.,8.},{7.,8.},{7.,8.},{7.,8.},{ 7., 8. },{.19,-.17},{.32,.09},{.23,-.24},{.18,.01},{2.,3.},{2.,3.},{ 2., 3. },{2.,3.},{.1,.1},{4.,5.},{4.,5.},{4.,5.},{4.,5.},{4.,5.},{ 4., 5. },{4.,5.},{-.16,-.37},{6.,7.},{6.,7.},{6.,7.},{6.,7.},{6.,7.},{ 6.,7. },{6.,7.},{-.17,-.19},{8.,9.},{.13,-.39},{2.,5.},{2.,5.},{ 2., 5. },{2.,5.},{2.,5.},{.11,-.03},{3.,6.},{-.17,.46},{4.,7.},{ -.17, -.19 },{7.,2.},{7.,2.},{7.,2.},{.19,-.17},{5.,8.},{.32,.09},{6.,9.} ,{.23,-.24},{8.,3.},{.18,.01},{9.,4.} }; static doublecomplex ctrue6[80] /* was [8][5][2] */ = { {.1,.1},{ 1., 2. },{1.,2.},{1.,2.},{1.,2.},{1.,2.},{1.,2.},{1.,2.},{.09,-.12},{ 3.,4. },{3.,4.},{3.,4.},{3.,4.},{3.,4.},{3.,4.},{3.,4.},{.03,-.09}, {.15,-.03},{5.,6.},{5.,6.},{5.,6.},{5.,6.},{5.,6.},{5.,6.},{.03, .03 },{-.18,.03},{.03,-.09},{7.,8.},{7.,8.},{7.,8.},{7.,8.},{7.,8.} ,{.09,.03},{.03,.12},{.12,.03},{.03,.06},{2.,3.},{2.,3.},{2.,3.},{ 2.,3. },{.1,.1},{4.,5.},{4.,5.},{4.,5.},{4.,5.},{4.,5.},{4.,5.},{ 4.,5. },{.09,-.12},{6.,7.},{6.,7.},{6.,7.},{6.,7.},{6.,7.},{6.,7.}, {6.,7.},{.03,-.09},{8.,9.},{.15,-.03},{2.,5.},{2.,5.},{2.,5.},{2., 5. },{2.,5.},{.03,.03},{3.,6.},{-.18,.03},{4.,7.},{.03,-.09},{ 7., 2. },{7.,2.},{7.,2.},{.09,.03},{5.,8.},{.03,.12},{6.,9.},{.12,.03}, {8.,3.},{.03,.06},{9.,4.} }; static integer itrue3[5] = { 0,1,2,2,2 }; static doublereal sa = .3; static doublecomplex ca = {.4,-.7}; static doublecomplex cv[80] /* was [8][5][2] */ = { {.1,.1},{1.,2.},{ 1., 2. },{1.,2.},{1.,2.},{1.,2.},{1.,2.},{1.,2.},{.3,-.4},{3.,4.},{ 3., 4. },{3.,4.},{3.,4.},{3.,4.},{3.,4.},{3.,4.},{.1,-.3},{.5,-.1},{ 5., 6. },{5.,6.},{5.,6.},{5.,6.},{5.,6.},{5.,6.},{.1,.1},{-.6,.1},{ .1, -.3 },{7.,8.},{7.,8.},{7.,8.},{7.,8.},{7.,8.},{.3,.1},{.1,.4},{ .4, .1 },{.1,.2},{2.,3.},{2.,3.},{2.,3.},{2.,3.},{.1,.1},{4.,5.},{ 4., 5. },{4.,5.},{4.,5.},{4.,5.},{4.,5.},{4.,5.},{.3,-.4},{6.,7.},{ 6., 7. },{6.,7.},{6.,7.},{6.,7.},{6.,7.},{6.,7.},{.1,-.3},{8.,9.},{ .5, -.1 },{2.,5.},{2.,5.},{2.,5.},{2.,5.},{2.,5.},{.1,.1},{3.,6.},{ -.6, .1 },{4.,7.},{.1,-.3},{7.,2.},{7.,2.},{7.,2.},{.3,.1},{5.,8.},{ .1, .4 },{6.,9.},{.4,.1},{8.,3.},{.1,.2},{9.,4.} }; /* System generated locals */ integer i__1, i__2, i__3; doublereal d__1; doublecomplex z__1; /* 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 i__; extern /* Subroutine */ int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), ctest_(integer *, doublecomplex *, doublecomplex *, doublecomplex *, doublereal *); static doublecomplex mwpcs[5], mwpct[5]; extern /* Subroutine */ int itest1_(integer *, integer *); extern doublereal dznrm2_(integer *, doublecomplex *, integer *); extern /* Subroutine */ int stest1_(doublereal *, doublereal *, doublereal *, doublereal *); static doublecomplex cx[8]; extern /* Subroutine */ int zdscal_(integer *, doublereal *, doublecomplex *, integer *); extern integer izamax_(integer *, doublecomplex *, integer *); extern doublereal dzasum_(integer *, doublecomplex *, integer *); static integer np1, len; /* Fortran I/O blocks */ static cilist io___19 = { 0, 6, 0, 0, 0 }; #define ctrue5_subscr(a_1,a_2,a_3) ((a_3)*5 + (a_2))*8 + a_1 - 49 #define ctrue5_ref(a_1,a_2,a_3) ctrue5[ctrue5_subscr(a_1,a_2,a_3)] #define ctrue6_subscr(a_1,a_2,a_3) ((a_3)*5 + (a_2))*8 + a_1 - 49 #define ctrue6_ref(a_1,a_2,a_3) ctrue6[ctrue6_subscr(a_1,a_2,a_3)] #define cv_subscr(a_1,a_2,a_3) ((a_3)*5 + (a_2))*8 + a_1 - 49 #define cv_ref(a_1,a_2,a_3) cv[cv_subscr(a_1,a_2,a_3)] 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__) { i__2 = i__ - 1; i__3 = cv_subscr(i__, np1, combla_1.incx); cx[i__2].r = cv[i__3].r, cx[i__2].i = cv[i__3].i; /* L20: */ } if (combla_1.icase == 6) { d__1 = dznrm2_(&combla_1.n, cx, &combla_1.incx); stest1_(&d__1, &strue2[np1 - 1], &strue2[np1 - 1], sfac); } else if (combla_1.icase == 7) { d__1 = dzasum_(&combla_1.n, cx, &combla_1.incx); stest1_(&d__1, &strue4[np1 - 1], &strue4[np1 - 1], sfac); } else if (combla_1.icase == 8) { zscal_(&combla_1.n, &ca, cx, &combla_1.incx); ctest_(&len, cx, &ctrue5_ref(1, np1, combla_1.incx), & ctrue5_ref(1, np1, combla_1.incx), sfac); } else if (combla_1.icase == 9) { zdscal_(&combla_1.n, &sa, cx, &combla_1.incx); ctest_(&len, cx, &ctrue6_ref(1, np1, combla_1.incx), & ctrue6_ref(1, np1, combla_1.incx), sfac); } else if (combla_1.icase == 10) { i__1 = izamax_(&combla_1.n, cx, &combla_1.incx); itest1_(&i__1, &itrue3[np1 - 1]); } else { s_wsle(&io___19); do_lio(&c__9, &c__1, " Shouldn't be here in CHECK1", (ftnlen) 28); e_wsle(); s_stop("", (ftnlen)0); } /* L40: */ } /* L60: */ } combla_1.incx = 1; if (combla_1.icase == 8) { /* ZSCAL Add a test for alpha equal to zero. */ ca.r = 0., ca.i = 0.; for (i__ = 1; i__ <= 5; ++i__) { i__1 = i__ - 1; mwpct[i__1].r = 0., mwpct[i__1].i = 0.; i__1 = i__ - 1; mwpcs[i__1].r = 1., mwpcs[i__1].i = 1.; /* L80: */ } zscal_(&c__5, &ca, cx, &combla_1.incx); ctest_(&c__5, cx, mwpct, mwpcs, sfac); } else if (combla_1.icase == 9) { /* ZDSCAL Add a test for alpha equal to zero. */ sa = 0.; for (i__ = 1; i__ <= 5; ++i__) { i__1 = i__ - 1; mwpct[i__1].r = 0., mwpct[i__1].i = 0.; i__1 = i__ - 1; mwpcs[i__1].r = 1., mwpcs[i__1].i = 1.; /* L100: */ } zdscal_(&c__5, &sa, cx, &combla_1.incx); ctest_(&c__5, cx, mwpct, mwpcs, sfac); /* Add a test for alpha equal to one. */ sa = 1.; for (i__ = 1; i__ <= 5; ++i__) { i__1 = i__ - 1; i__2 = i__ - 1; mwpct[i__1].r = cx[i__2].r, mwpct[i__1].i = cx[i__2].i; i__1 = i__ - 1; i__2 = i__ - 1; mwpcs[i__1].r = cx[i__2].r, mwpcs[i__1].i = cx[i__2].i; /* L120: */ } zdscal_(&c__5, &sa, cx, &combla_1.incx); ctest_(&c__5, cx, mwpct, mwpcs, sfac); /* Add a test for alpha equal to minus one. */ sa = -1.; for (i__ = 1; i__ <= 5; ++i__) { i__1 = i__ - 1; i__2 = i__ - 1; z__1.r = -cx[i__2].r, z__1.i = -cx[i__2].i; mwpct[i__1].r = z__1.r, mwpct[i__1].i = z__1.i; i__1 = i__ - 1; i__2 = i__ - 1; z__1.r = -cx[i__2].r, z__1.i = -cx[i__2].i; mwpcs[i__1].r = z__1.r, mwpcs[i__1].i = z__1.i; /* L140: */ } zdscal_(&c__5, &sa, cx, &combla_1.incx); ctest_(&c__5, cx, mwpct, mwpcs, sfac); } 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 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 check0_(real *sfac) { /* Initialized data */ static real ds1[8] = { .8f,.6f,.8f,-.6f,.8f,0.f,1.f,0.f }; static real datrue[8] = { .5f,.5f,.5f,-.5f,-.5f,0.f,1.f,1.f }; static real dbtrue[8] = { 0.f,.6f,0.f,-.6f,0.f,0.f,1.f,0.f }; static real da1[8] = { .3f,.4f,-.3f,-.4f,-.3f,0.f,0.f,1.f }; static real db1[8] = { .4f,.3f,.4f,.3f,-.4f,0.f,1.f,0.f }; static real dc1[8] = { .6f,.8f,-.6f,.8f,.6f,1.f,0.f,1.f }; /* Builtin functions */ integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), e_wsle(void); /* Subroutine */ int s_stop(char *, ftnlen); /* Local variables */ integer k; real sa, sb, sc, ss; extern /* Subroutine */ int srotg_(real *, real *, real *, real *), stest1_(real *, real *, real *, real *); /* Fortran I/O blocks */ static cilist io___19 = { 0, 6, 0, 0, 0 }; /* .. Parameters .. */ /* .. Scalar Arguments .. */ /* .. Scalars in Common .. */ /* .. Local Scalars .. */ /* .. Local Arrays .. */ /* .. External Subroutines .. */ /* .. Common blocks .. */ /* .. Data statements .. */ /* .. Executable Statements .. */ /* Compute true values which cannot be prestored */ /* in decimal notation */ dbtrue[0] = 1.6666666666666667f; dbtrue[2] = -1.6666666666666667f; dbtrue[4] = 1.6666666666666667f; for (k = 1; k <= 8; ++k) { /* .. Set N=K for identification in output if any .. */ combla_1.n = k; if (combla_1.icase == 3) { /* .. SROTG .. */ if (k > 8) { goto L40; } sa = da1[k - 1]; sb = db1[k - 1]; srotg_(&sa, &sb, &sc, &ss); stest1_(&sa, &datrue[k - 1], &datrue[k - 1], sfac); stest1_(&sb, &dbtrue[k - 1], &dbtrue[k - 1], sfac); stest1_(&sc, &dc1[k - 1], &dc1[k - 1], sfac); stest1_(&ss, &ds1[k - 1], &ds1[k - 1], sfac); } else { s_wsle(&io___19); do_lio(&c__9, &c__1, " Shouldn't be here in CHECK0", (ftnlen)28); e_wsle(); s_stop("", (ftnlen)0); } /* L20: */ } L40: return 0; } /* check0_ */
/* 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 check0_(doublereal *sfac) { /* Initialized data */ static doublereal ds1[8] = { .8,.6,.8,-.6,.8,0.,1.,0. }; static doublereal datrue[8] = { .5,.5,.5,-.5,-.5,0.,1.,1. }; static doublereal dbtrue[8] = { 0.,.6,0.,-.6,0.,0.,1.,0. }; static doublereal da1[8] = { .3,.4,-.3,-.4,-.3,0.,0.,1. }; static doublereal db1[8] = { .4,.3,.4,.3,-.4,0.,1.,0. }; static doublereal dc1[8] = { .6,.8,-.6,.8,.6,1.,0.,1. }; /* Local variables */ integer k; doublereal sa, sb, sc, ss; /* Fortran I/O blocks */ static cilist io___18 = { 0, 6, 0, 0, 0 }; /* .. Parameters .. */ /* .. Scalar Arguments .. */ /* .. Scalars in Common .. */ /* .. Local Scalars .. */ /* .. Local Arrays .. */ /* .. External Subroutines .. */ /* .. Common blocks .. */ /* .. Data statements .. */ /* .. Executable Statements .. */ /* Compute true values which cannot be prestored */ /* in decimal notation */ dbtrue[0] = 1.6666666666666667; dbtrue[2] = -1.6666666666666667; dbtrue[4] = 1.6666666666666667; for (k = 1; k <= 8; ++k) { /* .. Set N=K for identification in output if any .. */ combla_1.n = k; if (combla_1.icase == 3) { /* .. DROTG .. */ if (k > 8) { goto L40; } sa = da1[k - 1]; sb = db1[k - 1]; drotg_(&sa, &sb, &sc, &ss); stest1_(&sa, &datrue[k - 1], &datrue[k - 1], sfac); stest1_(&sb, &dbtrue[k - 1], &dbtrue[k - 1], sfac); stest1_(&sc, &dc1[k - 1], &dc1[k - 1], sfac); stest1_(&ss, &ds1[k - 1], &ds1[k - 1], sfac); } else { s_wsle(&io___18); do_lio(&c__9, &c__1, " Shouldn't be here in CHECK0", (ftnlen)28); e_wsle(); s_stop("", (ftnlen)0); } /* L20: */ } L40: return 0; } /* check0_ */
/* 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_ */