/* f06zcce.c * * Copyright 1992 Numerical Algorithms Group. * * Mark 3, 1992. * Mark 5 revised, 1998. * Mark 6 revised, 2000. * Mark 7 revised, 2001. * */ #include #include #include #include #include #include #include #include #include #define NSUBS 9 #define RZERO 0.0 #define NMAX 20 #define NIDMAX 9 #define NALMAX 7 #define NBEMAX 7 /* Common Block Declarations */ struct { Integer infot, nout; int ok, lerr; } infoc; #define nmax_2 NMAX *2 #define nmax_nmax NMAX * NMAX struct { char srnamt[14]; } srnamc; /* Table of constant values */ static Complex cmplx_0_0 = {0.0, 0.0}; static Complex cmplx_1_0 = {1.0, 0.0}; static Complex rogue = {-1.0e10, 1.0e10}; static Complex transpose_aa [nmax_nmax]; static Complex transpose_bb [nmax_nmax]; static Complex transpose_cc [nmax_nmax]; static void cchk1(const char sname[], double eps, double thresh, int trace, int *fatal, Integer nidim, Integer idim[], Integer nalf, Complex alf[], Integer nbet, Complex bet[], Integer nmax, Complex a[], Complex aa[], Complex as[], Complex b[], Complex bb[], Complex bs[], Complex c[], Complex cc[], Complex cs[], Complex ct[], double g[]); static void cchk2(const char sname[], double eps, double thresh, int trace, int *fatal, Integer nidim, Integer idim[], Integer nalf, Complex alf[], Integer nbet, Complex bet[], Integer nmax, Complex a[], Complex aa[], Complex as[], Complex b[], Complex bb[], Complex bs[], Complex c[], Complex cc[], Complex cs[], Complex ct[], double g[]); static void cchk3(const char sname[], double eps, double thresh, int trace, int *fatal, Integer nidim, Integer idim[], Integer nalf, Complex alf[], Integer nmax, Complex a[], Complex aa[], Complex as[], Complex b[], Complex bb[], Complex bs[], Complex ct[], double g[], Complex c[]); static void cchk4(const char sname[], double eps, double thresh, int trace, int *fatal, Integer nidim, Integer idim[], Integer nalf, Complex alf[], Integer nbet, Complex bet[], Integer nmax, Complex a[], Complex aa[], Complex as[], Complex b[], Complex bb[], Complex bs[], Complex c[], Complex cc[], Complex cs[], Complex ct[], double g[]); static void cchk5(const char sname[], double eps, double thresh, int trace, int *fatal, Integer nidim, Integer idim[], Integer nalf, Complex alf[], Integer nbet, Complex bet[], Integer nmax, Complex ab[], Complex aa[], Complex as[], Complex bb[], Complex bs[], Complex c[], Complex cc[], Complex cs[], Complex ct[], double g[], Complex w[]); static void cchke(Integer isnum, const char srnamt[]); static void cmake(const char type[], char uplo, char diag, Integer m, Integer n, Complex a[], Integer nmax, Complex aa[], Integer tda, int *reset, Complex transl); static void cmmch(char transa, char transb, Integer m, Integer n, Integer kk, Complex alpha, Complex a[], Integer tda, Complex b[], Integer tdb, Complex beta, Complex c[], Integer tdc, Complex ct[], double g[], Complex cc[], Integer tdcc, double eps, double *err, int *fatal, int mv); static int lce(Complex ri[], Complex rj[], Integer lr); static int lceres(const char type[], char uplo, Integer m, Integer n, Complex aa[], Complex as[], Integer tda); static void chkxer(const char srnamt[], Integer infot, int *lerr, int *ok); static Complex cbeg(int *reset); int main(void) { static const char *snames[NSUBS] = {"f06zac/zgemm", "f06zcc/zhemm", "f06ztc/zsymm", "f06zfc/ztrmm", "f06zjc/ztrsm", "f06zpc/zherk", "f06zuc/zsyrk", "f06zrc/zher2k", "f06zwc/zsyr2k"}; /* Local variables */ static Integer idim[NIDMAX]; int same; Integer nbet, nalf; static Complex c[NMAX*NMAX]; static double g[NMAX]; Integer i, j; Integer n; int fatal; static Complex w[130]; int trace; Integer nidim, isnum; int ltest[NSUBS]; static Complex aa[NMAX*NMAX], ab[2*NMAX*NMAX] , bb[NMAX*NMAX], cc[NMAX*NMAX], as[NMAX*NMAX], bs[NMAX*NMAX], cs[NMAX*NMAX], ct[NMAX]; int sfatal; char snamet[7], transa, transb; double thresh; int ltestt, tsterr; static Complex alf[NALMAX]; static Complex bet[NBEMAX]; double eps, err; Vprintf("f06zcc Example Program Results\n\n"); Vscanf("%*[^\n]"); infoc.nout = 6; /* Read flags */ /* Read the flag that directs tracing of execution */ Vscanf("%d%*[^\n]", &trace); /* Read the flag that directs stopping on any failure. */ Vscanf("%d%*[^\n]", &sfatal); /* Read the flag that indicates whether error exits are to be tested. */ Vscanf("%d%*[^\n]", &tsterr); /* Read the threshold value of the test ratio */ Vscanf("%lf%*[^\n]", &thresh); /* Read and check the parameter values for the tests. */ Vscanf("%ld%*[^\n]", &nidim); if (nidim < 1 || nidim > NIDMAX) { Vprintf("Number of values of %c is less than 1 or greater than %2d\n", 'n', NIDMAX); goto L400; } for (i = 1; i <= nidim; ++i) Vscanf("%ld", &idim[i-1]); Vscanf("%*[^\n]"); for (i = 1; i <= nidim; ++i) { if (idim[i - 1] < 0 || idim[i - 1] > NMAX) { Vprintf("Value of n is less than 0 or greater than %2d\n", NMAX); goto L400; } } /* Values of alpha */ Vscanf("%ld%*[^\n]", &nalf); if (nalf < 1 || nalf > NALMAX) { Vprintf("Number of values of alpha is less than 1 or greater than %2d\n", NALMAX); goto L400; } for (i = 1; i <= nalf; ++i) Vscanf(" ( %lf , %lf ) ", &alf[i-1].re, &alf[i-1].im); Vscanf("%*[^\n]"); /* Values of BETA */ Vscanf("%ld%*[^\n]", &nbet); if (nbet < 1 || nbet > NBEMAX) { Vprintf("Number of values of beta is less than 1 or greater than %2d\n", NBEMAX); goto L400; } for (i = 1; i <= nbet; ++i) Vscanf(" ( %lf , %lf ) ", &bet[i-1].re, &bet[i-1].im); Vscanf("%*[^\n] "); /* Report values of parameters. */ Vprintf("Tests of the complex level 3 BLAS\n" "The following parameter values will be used\n"); Vprintf(" For n "); for (i = 1; i <= nidim; ++i) Vprintf("%ld%c", idim[i-1], ( ! i% NIDMAX || i==nidim) ? '\n' : ' '); Vprintf(" For alpha "); for (i = 1; i <= nalf; ++i) { Vprintf("(%6.1f, %6.1f)%c", alf[i-1].re, alf[i-1].im, (! i%NALMAX || i==nalf) ? '\n' : ' '); } Vprintf(" For beta "); for (i = 1; i <= nbet; ++i) { Vprintf("(%6.1f, %6.1f)%c", bet[i-1].re, bet[i-1].im, (! i%NBEMAX || i==nbet) ? '\n' : ' '); } if (! tsterr) Vprintf("Error-exits will not be tested\n"); Vprintf("Functions pass computational tests if test ratio is" " less than %8.2f\n", thresh); /* Read names of subroutines and flags which indicate */ /* whether they are to be tested. */ for (i = 1; i <= NSUBS; ++i) ltest[i - 1] = FALSE; while (scanf("%s%d%*[^\n]",snamet, <estt) != EOF) { for (i = 1; i <= NSUBS; ++i) { if (! strncmp(snamet, snames[i-1], 6)) goto L100; } Vprintf("Function name %s not recognized \n" "******* Tests abandoned *******\n", snamet); return EXIT_FAILURE; L100: ltest[i - 1] = ltestt; } /* Compute eps (the machine precision). */ eps = X02AJC; Vprintf("Relative machine precision is taken to be %9.1e\n", eps); /* Check the reliability of CMMCH using exact data. */ n = MIN(32,NMAX); for (j = 1; j <= n; ++j) { for (i = 1; i <= n; ++i) ab[i-1+(j-1)*NMAX] = a02bac((double) MAX(i-j+1,0), 0.0); ab[ j-1 + NMAX*NMAX] = a02bac((double) j, 0.0); ab[ (j+NMAX)*NMAX-NMAX] = a02bac((double) j, 0.0); c[ j - 1] = cmplx_0_0; } for (j = 1; j <= n; ++j) cc[ j - 1] = a02bac((double) (j*((j+1)*j)/2-(j+1)*j*(j-1)/3), 0.0); /* CC holds the exact result. On exit from CMMCH CT holds */ /* the result computed by CMMCH. */ transa = 'n'; transb = 'n'; cmmch(transa, transb, n, (Integer)1, n, cmplx_1_0, ab, (Integer)NMAX, &ab[NMAX*NMAX], (Integer)NMAX, cmplx_0_0, c, (Integer)NMAX, ct, g, cc, (Integer)NMAX, eps, &err, &fatal, 1); same = lce(cc, ct, n); if (! same || err != 0.0) { Vprintf("Error in cmvch - in-line dot products are being " "evaluated wrongly.\ncmmch was called with transa = %c and transb = %c \n" "and returned same = %d and err = %12.3f.\nThis may be due to faults in the " "arithmetic or the compiler.\n******* Tests abandoned *******\n", transa, transb, same, err); return EXIT_FAILURE; } transb = 'c'; cmmch(transa, transb, n, (Integer)1, n, cmplx_1_0, ab, (Integer)NMAX, &ab[NMAX*NMAX], (Integer)NMAX, cmplx_0_0, c, (Integer)NMAX, ct, g, cc, (Integer)NMAX, eps, &err, &fatal, 1); same = lce(cc, ct, n); if (! same || err != 0.0) { Vprintf("Error in cmvch - in-line dot products are being " "evaluated wrongly.\ncmmch was called with transa = %c and transb = %c \n" "and returned same = %d and err = %12.3f.\nThis may be due to faults in the " "arithmetic or the compiler.\n******* Tests abandoned *******\n", transa, transb, same, err); return EXIT_FAILURE; } for (j = 1; j <= n; ++j) { ab[ j-1+NMAX*NMAX] = a02bac((double)(n-j+1), 0.0); ab[ (j+NMAX)*NMAX-NMAX] = a02bac((double)(n-j+1), 0.0); } for (j = 1; j <= n; ++j) cc[ n-j] = a02bac((double)(j*((j+1)*j)/2-(j+1)*j*(j-1)/3), 0.0); transa = 'c'; transb = 'n'; cmmch(transa, transb, n, (Integer)1, n, cmplx_1_0, ab, (Integer)NMAX, &ab[NMAX*NMAX], (Integer)NMAX, cmplx_0_0, c, (Integer)NMAX, ct, g, cc, (Integer)NMAX, eps, &err, &fatal, 1); same = lce(cc, ct, n); if (! same || err != 0.0) { Vprintf("Error in cmvch - in-line dot products are being " "evaluated wrongly.\ncmmch was called with transa = %c and transb = %c \n" "and returned same = %d and err = %12.3f.\nThis may be due to faults in the " "arithmetic or the compiler.\n******* Tests abandoned *******\n", transa, transb, same, err); return EXIT_FAILURE; } transb = 'c'; cmmch(transa, transb, n, (Integer)1, n, cmplx_1_0, ab, (Integer)NMAX, &ab[NMAX*NMAX], (Integer)NMAX, cmplx_0_0, c, (Integer)NMAX, ct, g, cc, (Integer)NMAX, eps, &err, &fatal, 1); same = lce(cc, ct, n); if (! same || err != 0.0) { Vprintf("Error in cmvch - in-line dot products are being " "evaluated wrongly.\ncmmch was called with transa = %c and transb = %c \n" "and returned same = %d and err = %12.3f.\nThis may be due to faults in the " "arithmetic or the compiler.\n******* Tests abandoned *******\n", transa, transb, same, err); return EXIT_FAILURE; } /* Test each subroutine in turn. */ for (isnum = 1; isnum <= NSUBS; ++isnum) { if (! ltest[isnum - 1]) { /* Subprogram is not to be tested. */ Vprintf("%6s was not tested\n", snames[isnum - 1]); } else { (void)strcpy(srnamc.srnamt, snames[isnum - 1]); /* Test error exits. */ if (tsterr) { Vprintf("\n"); cchke(isnum, snames[isnum - 1]); } /* Test computations. */ infoc.infot = 0; infoc.ok = TRUE; fatal = FALSE; switch ((int)isnum) { case 1: goto L240; case 2: goto L260; case 3: goto L260; case 4: goto L280; case 5: goto L280; case 6: goto L300; case 7: goto L300; case 8: goto L320; case 9: goto L320; } /* Test f06zac, 01. */ L240: cchk1(snames[isnum - 1], eps, thresh, trace, &fatal, nidim, idim, nalf, alf, nbet, bet, (Integer)NMAX, ab, aa, as, &ab[NMAX*NMAX], bb, bs, c, cc, cs, ct, g); goto L340; /* Test f06zac, 02, f06ztc, 03. */ L260: cchk2(snames[isnum - 1], eps, thresh, trace, &fatal, nidim, idim, nalf, alf, nbet, bet, (Integer)NMAX, ab, aa, as, &ab[NMAX*NMAX], bb, bs, c, cc, cs, ct, g); goto L340; /* Test f06zfc, 04, f06zjc, 05. */ L280: cchk3(snames[isnum - 1], eps, thresh, trace, &fatal, nidim, idim, nalf, alf, (Integer)NMAX, ab, aa, as, &ab[NMAX*NMAX], bb, bs, ct, g, c); goto L340; /* Test f06zpc, 06, f06zuc, 07. */ L300: cchk4(snames[isnum - 1], eps, thresh, trace, &fatal, nidim, idim, nalf, alf, nbet, bet, (Integer)NMAX, ab, aa, as, &ab[NMAX*NMAX], bb, bs, c, cc, cs, ct, g); goto L340; /* Test f06zrc, 08,f06zwc, 09. */ L320: cchk5(snames[isnum - 1], eps, thresh, trace, &fatal, nidim, idim, nalf, alf, nbet, bet, (Integer)NMAX, ab, aa, as, bb, bs, c, cc, cs, ct, g, w); goto L340; L340: if (fatal && sfatal) goto L380; } } Vprintf("End of tests\n"); return EXIT_SUCCESS; L380: Vprintf("******* Fatal error - Tests abandoned *******\n"); goto L420; L400: Vprintf("Amend data file or increase array sizes in program\n" "******* Tests abandoned *******\n"); L420: return EXIT_FAILURE; } static void cchk1(const char sname[], double eps, double thresh, int trace, int *fatal, Integer nidim, Integer idim[], Integer nalf, Complex alf[], Integer nbet, Complex bet[], Integer nmax, Complex a[], Complex aa[], Complex as[], Complex b[], Complex bb[], Complex bs[], Complex c[], Complex cc[], Complex cs[], Complex ct[], double g[]) { /* Initialized data */ static char ich[4] = "ntc"; /* Local variables */ Complex beta; Integer tdas, tdbs, tdcs; int same, null; Integer i, j, k, m, n; Complex alpha; int isame[13], trana, tranb; Integer nargs; int reset; Integer ia, ib, ma, mb, na, nb, nc, ik, im, in, ks, ms, ns; char transa, transb; double errmax; Integer ica, icb, taa, tbb, tda, tcc, tdb, tdc; Complex als, bls; double err; MatrixTranspose transa_c, tranas_c; MatrixTranspose transb_c, tranbs_c; Integer max_d; /* Tests f06zac. */ /* Auxiliary routine for test program for Level 3 Blas. */ #define G(I) g[(I)-1] #define CT(I) ct[(I)-1] #define CS(I) cs[(I)-1] #define CC(I) cc[(I)-1] #define BS(I) bs[(I)-1] #define BB(I) bb[(I)-1] #define AS(I) as[(I)-1] #define AA(I) aa[(I)-1] #define BET(I) bet[(I)-1] #define ALF(I) alf[(I)-1] #define IDIM(I) idim[(I)-1] /* Function Body */ if (trace) { Vprintf("\nComputational tests : \n"); Vprintf("\nf06zac tested with : \n"); Vprintf("(Transpose (t), Transpose (t),.........)\n"); Vprintf("(Notranspose (n), Transpose (t),.........)\n"); Vprintf("(ConjugateTranspose (c), ConjugateTranspose (c),.........)\n\n"); } nargs = 13; nc = 0; reset = TRUE; errmax = 0.0; for (im = 1; im <= nidim; ++im) { m = IDIM(im); for (in = 1; in <= nidim; ++in) { n = IDIM(in); /* Set tdc to 1 more than minimum value if room. */ tdc = m; tdc = nmax; /* if (tdc < nmax) { ++tdc; } */ /* Skip tests if not enough room. */ if (tdc > nmax) goto L200; tcc = tdc * n; null = n <= 0 || m <= 0; for (ik = 1; ik <= nidim; ++ik) { k = IDIM(ik); for (ica = 1; ica <= 3; ++ica) { transa = ich[ica - 1]; trana = transa == 't' || transa == 'c'; if (transa == 't') transa_c = Transpose; else if (transa == 'c') transa_c = ConjugateTranspose; else transa_c = NoTranspose; if (trana) { ma = k; na = m; } else { ma = m; na = k; } /* Set tda to 1 more than minimum value if room. */ tda = ma; tda = nmax; /* if (tda < nmax) { ++tda; } */ /* Skip tests if not enough room. */ if (tda > nmax) goto L160; taa = tda * na; /* Generate the matrix A. */ cmake("ge", ' ', ' ', ma, na, a, nmax, aa, tda, &reset, cmplx_0_0); for (icb = 1; icb <= 3; ++icb) { transb = ich[icb - 1]; tranb = transb == 't' || transb == 'c'; if (transb == 't') transb_c = Transpose; else if (transb == 'c') transb_c = ConjugateTranspose; else transb_c = NoTranspose; if (tranb) { mb = n; nb = k; } else { mb = k; nb = n; } /* Set tdb to 1 more than minimum value if room. */ tdb = mb; tdb = nmax; /* if (tdb < nmax) { ++tdb; } */ /* Skip tests if not enough room. */ if (tdb > nmax) goto L140; tbb = tdb * nb; /* Generate the matrix B. */ cmake("ge", ' ', ' ', mb, nb, b, nmax, bb, tdb, &reset, cmplx_0_0); for (ia = 1; ia <= nalf; ++ia) { alpha = ALF( ia); for (ib = 1; ib <= nbet; ++ib) { beta = BET( ib); /* Generate the matrix C. */ cmake("ge", ' ', ' ', m, n, c, nmax, cc, tdc, &reset, cmplx_0_0); ++nc; /* Save every datum before calling the subroutine. */ tranas_c = transa_c; tranbs_c = transb_c; ms = m; ns = n; ks = k; als = alpha; for (i = 1; i <= taa; ++i) AS( i) = AA( i); tdas = tda; for (i = 1; i <= tbb; ++i) BS( i) = BB(i); tdbs = tdb; bls = beta; for (i = 1; i <= tcc; ++i) CS(i) = CC( i); tdcs = tdc; /* Call the subroutine. */ if (trace) { Vprintf("%6ld: %6s(%c,%c," "%3ld,%3ld,%3ld," " (%4.1f,%4.1f), A,%3ld, B,%3ld, (%4.1f,%4.1f), C,%3ld).\n", nc, sname, transa, transb, m, n, k, alpha.re, alpha.im, tda, tdb, beta.re, beta.im, tdc); } max_d = MAX(m, k); if (n > max_d) max_d = n; for (j =0; j < max_d; ++j) { for (i = 0; i < max_d; ++i) { transpose_aa[i * tda + j] = aa[i + j * tda]; transpose_bb[i * tda + j] = bb[i + j * tda]; transpose_cc[i * tda + j] = cc[i + j * tda]; } } f06zac(transa_c, transb_c, m, n, k, alpha, transpose_aa, tda, transpose_bb, tdb, beta, transpose_cc, tdc); for (j =0; j < max_d; ++j) { for (i = 0; i < max_d; ++i) { aa[i + j * tda] = transpose_aa[i * tda + j]; bb[i + j * tda] = transpose_bb[i * tda + j]; cc[i + j * tda] = transpose_cc[i * tda + j]; } } /* Check if error-exit was taken incorrectly. */ if (! infoc.ok) { Vprintf(" ******* Fatal error - " "error-exit taken on valid call ******\n"); *fatal = TRUE; goto L240; } /* See what data changed inside subroutines. */ isame[0] = transa_c == tranas_c; isame[1] = transb_c == tranbs_c; isame[2] = ms == m; isame[3] = ns == n; isame[4] = ks == k; isame[5] = als.re == alpha.re && als.im == alpha.im; isame[6] = lce(as, aa, taa); isame[7] = tdas == tda; isame[8] = lce(bs, bb, tbb); isame[9] = tdbs == tdb; isame[10] = bls.re == beta.re && bls.im == beta.im; if (null) isame[11] = lce(cs, cc, tcc); else { isame[11] = lceres("ge", ' ', m, n, cs, cc, tdc); } isame[12] = tdcs == tdc; /* * If data was incorrectly changed, report * and return. */ same = TRUE; for (i = 1; i <= nargs; ++i) { same = same && isame[i - 1]; if (! isame[i - 1]) { Vprintf(" ******* Fatal error - " "parameter number %2ld was changed incorrectly *******\n", i); } } if (! same) { *fatal = TRUE; goto L240; } if (! null) { /* Check the result. */ cmmch(transa, transb, m, n, k, alpha, a, nmax, b, nmax, beta, c, nmax, ct, g, cc, tdc,eps, &err, fatal, 1); errmax = MAX(errmax,err); /* If got really bad answer, report and */ /* return. */ if (*fatal) goto L240; } } } L140: ; } L160: ; } } L200: ; } } /* Report result. */ if (errmax < thresh) { Vprintf("%.6s passed the computational tests ( %6ld calls)\n", sname, nc); } else { Vprintf("%.6s completed the computational tests (%6ld calls)\n" "******* but with maximum test ratio ,%8.2f,- suspect *******\n", sname, nc, errmax); } goto L260; L240: Vprintf("******* %.6s failed on call number:\n", sname); Vprintf("%6ld: %6s(%c,%c," "%3ld,%3ld,%3ld," " (%4.1f,%4.1f), A,%3ld, B,%3ld, (%4.1f,%4.1f), C,%3ld).\n", nc, sname, transa, transb, m, n, k, alpha.re, alpha.im, tda, tdb, beta.re, beta.im, tdc); L260: return; } /* cchk1 */ /* ---------------------------------------------------------------------- */ static void cchk2(const char sname[], double eps, double thresh, int trace, int *fatal, Integer nidim, Integer idim[], Integer nalf, Complex alf[], Integer nbet, Complex bet[], Integer nmax, Complex a[], Complex aa[], Complex as[], Complex b[], Complex bb[], Complex bs[], Complex c[], Complex cc[], Complex cs[], Complex ct[], double g[]) { /* Initialized data */ static char ichs[3] = "lr"; static char ichu[3] = "ul"; /* Local variables */ Complex beta; Integer tdas, tdbs, tdcs; int same; char side; int conj, left, null; char uplo; Integer i, j, m, n; Integer max_d; Complex alpha; int isame[13]; Integer nargs; int reset; Integer ia, ib, na, nc, im, in, ms, ns; double errmax; Integer taa, tbb, tda, tcc, tdb, tdc; Integer ics; Complex als, bls; Integer icu; double err; OperationSide side_c, sides_c; MatrixTriangle uplo_c, uplos_c; /* Tests f06zcc and f06ztc. */ /* Auxiliary routine for test program for Level 3 Blas. */ #define G(I) g[(I)-1] #define CT(I) ct[(I)-1] #define CS(I) cs[(I)-1] #define CC(I) cc[(I)-1] #define BS(I) bs[(I)-1] #define BB(I) bb[(I)-1] #define AS(I) as[(I)-1] #define AA(I) aa[(I)-1] #define BET(I) bet[(I)-1] #define ALF(I) alf[(I)-1] #define IDIM(I) idim[(I)-1] /* Function Body */ conj = ! strncmp(sname + 8, "he", 2); if (trace) { Vprintf("\nComputational tests : \n"); if (conj) Vprintf("\nf06zcc tested with : \n"); else Vprintf("\nf06ztc tested with : \n"); Vprintf("(RightSide (r), UpperTriangle (u),.........)\n"); Vprintf("(LeftSide (l), LowerTriangle (l),....)\n\n"); } nargs = 12; nc = 0; reset = TRUE; errmax = 0.0; for (im = 1; im <= nidim; ++im) { m = IDIM(im); for (in = 1; in <= nidim; ++in) { n = IDIM(in); /* Set tdc to 1 more than minimum value if room. */ tdc = m; tdc = nmax; /* if (tdc < nmax) { ++tdc; } */ /* Skip tests if not enough room. */ if (tdc > nmax) goto L180; tcc = tdc * n; null = n <= 0 || m <= 0; /* Set tdb to 1 more than minimum value if room. */ tdb = m; tdb = nmax; /* if (tdb < nmax) { ++tdb; } */ /* Skip tests if not enough room. */ if (tdb > nmax) goto L180; tbb = tdb * n; /* Generate the matrix B. */ cmake("ge", ' ', ' ', m, n, b, nmax, bb, tdb, & reset, cmplx_0_0); for (ics = 1; ics <= 2; ++ics) { side = ichs[ics - 1]; left = side == 'l'; if (left) { na = m; side_c = LeftSide; } else { na = n; side_c = RightSide; } /* Set tda to 1 more than minimum value if room. */ tda = na; tda = nmax; /* if (tda < nmax) { ++tda; } */ /* Skip tests if not enough room. */ if (tda > nmax) goto L160; taa = tda * na; for (icu = 1; icu <= 2; ++icu) { uplo = ichu[icu - 1]; if (uplo == 'u') uplo_c = UpperTriangle; else uplo_c = LowerTriangle; /* Generate the hermitian or symmetric matrix A. */ cmake(sname + 8, uplo, ' ', na, na, a, nmax, aa, tda, &reset, cmplx_0_0); for (ia = 1; ia <= nalf; ++ia) { alpha = ALF( ia); for (ib = 1; ib <= nbet; ++ib) { beta = BET( ib); /* Generate the matrix C. */ cmake("ge", ' ', ' ', m, n, c, nmax, cc, tdc, &reset, cmplx_0_0) ; ++nc; /* Save every datum before calling the subroutine. */ sides_c = side_c; uplos_c = uplo_c; ms = m; ns = n; als.re = alpha.re, als.im = alpha.im; for (i = 1; i <= taa; ++i) AS( i) = AA( i); tdas = tda; for (i = 1; i <= tbb; ++i) BS( i) = BB( i); tdbs = tdb; bls = beta; for (i = 1; i <= tcc; ++i) CS( i) = CC( i); tdcs = tdc; /* Call the subroutine. */ if (trace) { Vprintf("%6ld: %6s(%c,%c," "%3ld,%3ld," " (%4.1f,%4.1f), A,%3ld, B,%3ld, (%4.1f,%4.1f), C,%3ld).\n", nc, sname, side, uplo, m, n, alpha.re, alpha.im, tda, tdb, beta.re, beta.im, tdc); } max_d = MAX(m, n); for (j =0; j < max_d; ++j) { for (i = 0; i < max_d; ++i) { transpose_aa[i * tda + j] = aa[i + j * tda]; transpose_bb[i * tda + j] = bb[i + j * tda]; transpose_cc[i * tda + j] = cc[i + j * tda]; } } if (conj) { f06zcc(side_c, uplo_c, m, n, alpha, transpose_aa, tda, transpose_bb, tdb, beta, transpose_cc, tdc); } else { f06ztc(side_c, uplo_c, m, n, alpha, transpose_aa, tda, transpose_bb, tdb, beta, transpose_cc, tdc); } for (j =0; j < max_d; ++j) { for (i = 0; i < max_d; ++i) { aa[i + j * tda] = transpose_aa[i * tda + j]; bb[i + j * tda] = transpose_bb[i * tda + j]; cc[i + j * tda] = transpose_cc[i * tda + j]; } } /* Check if error-exit was taken incorrectly. */ if (! infoc.ok) { Vprintf(" ******* Fatal error - " "error-exit taken on valid call ******\n"); *fatal = TRUE; goto L220; } /* See what data changed inside subroutines. */ isame[0] = sides_c == side_c; isame[1] = uplos_c == uplo_c; isame[2] = ms == m; isame[3] = ns == n; isame[4] = als.re == alpha.re && als.im == alpha.im; isame[5] = lce(as, aa, taa); isame[6] = tdas == tda; isame[7] = lce(bs, bb, tbb); isame[8] = tdbs == tdb; isame[9] = bls.re == beta.re && bls.im == beta.im; if (null) isame[10] = lce(cs, cc, tcc); else { isame[10] = lceres("ge", ' ', m, n, cs, cc, tdc); } isame[11] = tdcs == tdc; /* * If data was incorrectly changed, report and * return. */ same = TRUE; for (i = 1; i <= nargs; ++i) { same = same && isame[i - 1]; if (! isame[i - 1]) { Vprintf(" ******* Fatal error - " "parameter number %2ld was changed incorrectly *******\n", i); } } if (! same) { *fatal = TRUE; goto L220; } if (! null) { /* Check the result. */ if (left) { cmmch('n', 'n', m, n, m, alpha, a, nmax, b, nmax, beta, c, nmax, ct, g, cc, tdc,eps, &err, fatal, 1); } else { cmmch('n', 'n', m, n, n, alpha, b, nmax, a, nmax, beta, c, nmax, ct, g, cc, tdc, eps, & err, fatal, 1); } errmax = MAX(errmax,err); /* * If got really bad answer, report and * return. */ if (*fatal) goto L220; } } } } L160: ; } L180: ; } } /* Report result. */ if (errmax < thresh) { Vprintf("%.6s passed the computational tests ( %6ld calls)\n", sname, nc); } else { Vprintf("%.6s completed the computational tests (%6ld calls)\n" "******* but with maximum test ratio ,%8.2f,- suspect *******\n", sname, nc, errmax); } goto L240; L220: Vprintf("******* %.6s failed on call number:\n", sname); Vprintf("%6ld: %6s(%c,%c," "%3ld,%3ld," " (%4.1f,%4.1f), A,%3ld, B,%3ld, (%4.1f,%4.1f), C,%3ld).\n", nc, sname, side, uplo, m, n, alpha.re, alpha.im, tda, tdb, beta.re, beta.im, tdc); L240: return; } /* cchk2 */ /* -------------------------------------------------------------------- */ static void cchk3(const char sname[], double eps, double thresh, int trace, int *fatal, Integer nidim, Integer idim[], Integer nalf, Complex alf[], Integer nmax, Complex a[], Complex aa[], Complex as[], Complex b[], Complex bb[], Complex bs[], Complex ct[], double g[], Complex c[]) { /* Initialized data */ static char ichu[2+1] = "ul"; static char icht[3+1] = "ntc"; static char ichd[2+1] = "un"; static char ichs[2+1] = "lr"; /* Local variables */ char diag; Integer tdas, tdbs; int same; char side; int left, null; char uplo; Integer i, j, m, n; Integer max_d; Complex alpha; int isame[13]; Integer nargs; int reset; Integer ia, na, nc, im, in, ms, ns; char transa; double errmax; Integer taa, icd, tbb, tda, tdb; Integer ics; Complex als; Integer ict, icu; double err; OperationSide side_c, sides_c; MatrixTriangle uplo_c, uplos_c; MatrixTranspose transa_c, tranas_c; MatrixUnitTriangular diag_c, diags_c; /* Tests f06zfc and f06zjc. */ /* Auxiliary routine for test program for Level 3 Blas. */ #define G(I) g[(I)-1] #define CT(I) ct[(I)-1] #define BS(I) bs[(I)-1] #define BB(I) bb[(I)-1] #define AS(I) as[(I)-1] #define AA(I) aa[(I)-1] #define ALF(I) alf[(I)-1] #define IDIM(I) idim[(I)-1] /* Function Body */ if (trace) { Vprintf("\nComputational tests : \n"); if (strstr(sname, "mm")) Vprintf("\nf06zfc tested with : \n"); else Vprintf("\nf06zjc tested with : \n"); Vprintf("(RightSide (r), UpperTriangle (u), Transpose (t), NotUnitTriangular (n),..)\n"); Vprintf("(LeftSide (l), LowerTriangle (l), NoTranspose (n), UnitTriangular (u),..)\n"); Vprintf("(LeftSide (l), LowerTriangle (l), ConjugateTranspose (c), UnitTriangular (u),..)\n\n"); } nargs = 11; nc = 0; reset = TRUE; errmax = 0.0; /* Set up zero matrix for CMMCH. */ for (j = 1; j <= nmax; ++j) { for (i = 1; i <= nmax; ++i) c[i-1+(j-1)*nmax] = cmplx_0_0; } for (im = 1; im <= nidim; ++im) { m = IDIM(im); for (in = 1; in <= nidim; ++in) { n = IDIM(in); /* Set tdb to 1 more than minimum value if room. */ tdb = m; tdb = nmax; /* if (tdb < nmax) { ++tdb; } */ /* Skip tests if not enough room. */ if (tdb > nmax) goto L260; tbb = tdb * n; null = m <= 0 || n <= 0; for (ics = 1; ics <= 2; ++ics) { side = ichs[ics - 1]; left = side == 'l'; if (left) { side_c = LeftSide; na = m; } else { side_c = RightSide; na = n; } /* Set tda to 1 more than minimum value if room. */ tda = na; tda = nmax; /* if (tda < nmax) { ++tda; } */ /* Skip tests if not enough room. */ if (tda > nmax) goto L260; taa = tda * na; for (icu = 1; icu <= 2; ++icu) { uplo = ichu[icu - 1]; if (uplo == 'u') uplo_c = UpperTriangle; else uplo_c = LowerTriangle; for (ict = 1; ict <= 3; ++ict) { transa = icht[ict - 1]; if (transa == 't') transa_c = Transpose; else if (transa == 'c') transa_c = ConjugateTranspose; else transa_c = NoTranspose; for (icd = 1; icd <= 2; ++icd) { diag = ichd[icd - 1]; if (diag == 'n') diag_c = NotUnitTriangular; else diag_c = UnitTriangular; for (ia = 1; ia <= nalf; ++ia) { alpha = ALF( ia); /* Generate the matrix A. */ cmake("tr", uplo, diag, na, na, a, nmax, aa, tda, &reset, cmplx_0_0); /* Generate the matrix B. */ cmake("ge", ' ', ' ', m, n, b, nmax, bb, tdb, &reset, cmplx_0_0); ++nc; /* Save every datum before calling the subroutine. */ sides_c = side_c; uplos_c = uplo_c; tranas_c = transa_c; diags_c = diag_c; ms = m; ns = n; als = alpha; for (i = 1; i <= taa; ++i) AS( i) = AA( i); tdas = tda; for (i = 1; i <= tbb; ++i) BS( i) = BB( i); tdbs = tdb; /* Call the subroutine. */ if (! strncmp(sname + 10, "mm", 2)) { if (trace) { Vprintf("%6ld: %6s(%c,%c,%c,%c," "%3ld,%3ld," " (%4.1f,%4.1f), A,%3ld, B,%3ld).\n", nc, sname, side, uplo, transa, diag, m, n, alpha.re, alpha.im, tda, tdb); } max_d = MAX(m, n); for (j =0; j < max_d; ++j) { for (i = 0; i < max_d; ++i) { transpose_aa[i * tda + j] = aa[i + j * tda]; transpose_bb[i * tda + j] = bb[i + j * tda]; } } f06zfc (side_c, uplo_c, transa_c, diag_c, m, n, alpha, transpose_aa, tda, transpose_bb, tdb); for (j =0; j < max_d; ++j) { for (i = 0; i < max_d; ++i) { aa[i + j * tda] = transpose_aa[i * tda + j]; bb[i + j * tda] = transpose_bb[i * tda + j]; } } } else if (! strncmp(sname + 10, "sm", 2)) { if (trace) { Vprintf("%6ld: %6s(%c,%c,%c,%c," "%3ld,%3ld," " (%4.1f,%4.1f), A,%3ld, B,%3ld).\n", nc, sname, side, uplo, transa, diag, m, n, alpha.re, alpha.im, tda, tdb); } max_d = MAX(m, n); for (j =0; j < max_d; ++j) { for (i = 0; i < max_d; ++i) { transpose_aa[i * tda + j] = aa[i + j * tda]; transpose_bb[i * tda + j] = bb[i + j * tda]; } } f06zjc (side_c, uplo_c, transa_c, diag_c, m, n, alpha, transpose_aa, tda, transpose_bb, tdb); for (j =0; j < max_d; ++j) { for (i = 0; i < max_d; ++i) { aa[i + j * tda] = transpose_aa[i * tda + j]; bb[i + j * tda] = transpose_bb[i * tda + j]; } } } /* Check if error-exit was taken incorrectly. */ if (! infoc.ok) { Vprintf(" ******* Fatal error - " "error-exit taken on valid call ******\n"); *fatal = TRUE; goto L300; } /* See what data changed inside subroutines. */ isame[0] = sides_c == side_c; isame[1] = uplos_c == uplo_c; isame[2] = tranas_c == transa_c; isame[3] = diags_c == diag_c; isame[4] = ms == m; isame[5] = ns == n; isame[6] = als.re == alpha.re && als.im == alpha.im; isame[7] = lce(as, aa, taa); isame[8] = tdas == tda; if (null) isame[9] = lce(bs, bb, tbb); else isame[9] = lceres("ge", ' ', m, n, bs, bb, tdb); isame[10] = tdbs == tdb; /* If data was incorrectly changed, report and return. */ same = TRUE; for (i = 1; i <= nargs; ++i) { same = same && isame[i - 1]; if (! isame[i - 1]) { Vprintf(" ******* Fatal error - " "parameter number %2ld was changed incorrectly *******\n", i); } } if (! same) { *fatal = TRUE; goto L300; } if (! null) { if (! strncmp(sname + 10, "mm", 2)) { /* Check the result. */ if (left) { cmmch(transa, 'n', m, n, m, alpha, a, nmax, b, nmax, cmplx_0_0, c, nmax, ct, g, bb, tdb, eps, &err, fatal, 1); } else { cmmch('n', transa, m, n, n, alpha, b, nmax, a, nmax, cmplx_0_0, c, nmax, ct, g, bb, tdb, eps, &err, fatal, 1); } } else if (! strncmp(sname + 10, "sm", 2)) { /* * Compute approximation to original * matrix. */ for (j = 1; j <= n; ++j) { for (i = 1; i <= m; ++i) { c[i-1+(j-1)*nmax] = bb[i-1+(j-1)*tdb]; bb[i-1+(j-1)*tdb] = a02ccc(alpha, b[i-1+(j-1)*nmax]); } } if (left) { cmmch(transa, 'n', m, n, m, cmplx_1_0, a, nmax, c, nmax, cmplx_0_0, b, nmax, ct, g, bb, tdb, eps, &err, fatal, 0); } else { cmmch('n', transa, m, n, n, cmplx_1_0, c, nmax, a, nmax, cmplx_0_0, b, nmax, ct, g, bb, tdb,eps, &err, fatal, 0); } } errmax = MAX(errmax,err); /* If got really bad answer, report and return. */ if (*fatal) goto L300; } } } } } } L260: ; } } /* Report result. */ if (errmax < thresh) { Vprintf("%.6s passed the computational tests ( %6ld calls)\n", sname, nc); } else { Vprintf("%.6s completed the computational tests (%6ld calls)\n" "******* but with maximum test ratio ,%8.2f,- suspect *******\n", sname, nc, errmax); } goto L320; L300: Vprintf("******* %.6s failed on call number:\n", sname); Vprintf("%6ld: %6s(%c,%c,%c,%c," "%3ld,%3ld," " (%4.1f,%4.1f), A,%3ld, B,%3ld).\n", nc, sname, side, uplo, transa, diag, m, n, alpha.re, alpha.im, tda, tdb); L320: return; } /* cchk3 */ /* -------------------------------------------------------------------- */ static void cchk4(const char sname[], double eps, double thresh, int trace, int *fatal, Integer nidim, Integer idim[], Integer nalf, Complex alf[], Integer nbet, Complex bet[], Integer nmax, Complex a[], Complex aa[], Complex as[], Complex b[], Complex bb[], Complex bs[], Complex c[], Complex cc[], Complex cs[], Complex ct[], double g[]) { /* Initialized data */ static char icht[2+1] = "nc"; static char ichu[2+1] = "ul"; /* Local variables */ Complex beta; Integer tdas, tdcs; int same, conj; Complex bets; double rals; int tran, null; char uplo; Integer i, j, k, n; Integer max_d; Complex alpha; int isame[13]; Integer nargs; double rbeta, rbets; int reset; char trans; int upper; Integer ia, ib, jc, ma, na, nc, ik, in, jj, lj, ks, ns; double ralpha; double errmax; char transt; Integer taa, tda, tcc, tdc; Complex als; Integer ict, icu; double err; MatrixTriangle uplo_c, uplos_c; MatrixTranspose trans_c, transs_c; /* Tests f06zpc and f06zuc. */ /* Auxiliary routine for test program for Level 3 Blas. */ #define G(I) g[(I)-1] #define CT(I) ct[(I)-1] #define CS(I) cs[(I)-1] #define CC(I) cc[(I)-1] #define BS(I) bs[(I)-1] #define BB(I) bb[(I)-1] #define AS(I) as[(I)-1] #define AA(I) aa[(I)-1] #define BET(I) bet[(I)-1] #define ALF(I) alf[(I)-1] #define IDIM(I) idim[(I)-1] /* Function Body */ conj = ! strncmp(sname + 8, "he", 2); if (trace) { Vprintf("\nComputational tests : \n"); if (conj) { Vprintf("\nf06zpc tested with : \n"); Vprintf("(UpperTriangle (u), NoTranspose (n),..)\n"); Vprintf("(LowerTriangle (l), ConjugateTranspose (c),.....)\n\n"); } else { Vprintf("\nf06zuc tested with : \n"); Vprintf("(UpperTriangle (u), Transpose (t),..)\n"); Vprintf("(UpperTriangle (l), NoTranspose (n),..)\n\n"); } } nargs = 10; nc = 0; reset = TRUE; errmax = 0.0; for (in = nidim; in <= nidim; ++in) { n = IDIM(in); /* Set tdc to 1 more than minimum value if room. */ tdc = n; tdc = nmax; /* if (tdc < nmax) { ++tdc; } */ /* Skip tests if not enough room. */ if (tdc > nmax) goto L200; tcc = tdc * n; for (ik = 1; ik <= nidim; ++ik) { k = IDIM(ik); for (ict = 1; ict <= 2; ++ict) { trans = icht[ict - 1]; trans_c = NoTranspose; if (trans == 'c') trans_c = ConjugateTranspose; if (trans == 'n') trans_c = NoTranspose; tran = trans == 'c'; if (tran && ! conj) { trans = 't'; trans_c = Transpose; } if (tran) { ma = k; na = n; } else { ma = n; na = k; } /* Set tda to 1 more than minimum value if room. */ tda = ma; tda = nmax; /* if (tda < nmax) { ++tda; } */ /* Skip tests if not enough room. */ if (tda > nmax) goto L160; taa = tda * na; /* Generate the matrix A. */ cmake("ge", ' ', ' ', ma, na, a, nmax, aa, tda, &reset, cmplx_0_0); for (icu = 1; icu <= 2; ++icu) { uplo = ichu[icu - 1]; upper = uplo == 'u'; if (uplo == 'u') uplo_c = UpperTriangle; else uplo_c = LowerTriangle; for (ia = 1; ia <= nalf; ++ia) { alpha = ALF( ia); ralpha = 0.0; if (conj) { ralpha = alpha.re; alpha = a02bac(ralpha, 0.0); } for (ib = 1; ib <= nbet; ++ib) { beta = BET( ib); rbeta = 0.0; if (conj) { rbeta = beta.re; beta = a02bac(rbeta, 0.0); } null = n <= 0; if (conj) { null = null || ((k <= 0 || ralpha == 0.0) && rbeta == 1.0); } /* Generate the matrix C. */ cmake(sname + 8, uplo, ' ', n, n, c, nmax, cc, tdc, &reset, cmplx_0_0); ++nc; /* Save every datum before calling the subroutine. */ uplos_c = uplo_c; transs_c = trans_c; ns = n; ks = k; rals = 0.0; if (conj) rals = ralpha; else als = alpha; for (i = 1; i <= taa; ++i) AS( i) = AA( i); tdas = tda; rbets = 0.0; if (conj) rbets = rbeta; else bets = beta; for (i = 1; i <= tcc; ++i) CS( i) = CC( i); tdcs = tdc; /* Call the subroutine. */ if (conj) { if (trace) { Vprintf("%6ld: %6s(%c,%c," "%3ld,%3ld," "%4.1f A,%3ld, %4.1f, C,%3ld).\n", nc, sname, uplo, trans, n, k, ralpha, tda, rbeta, tdc); } max_d = MAX(n, k); for (j =0; j < max_d; ++j) { for (i = 0; i < max_d; ++i) { transpose_aa[i * tda + j] = aa[i + j * tda]; transpose_cc[i * tda + j] = cc[i + j * tda]; } } f06zpc(uplo_c, trans_c, n, k, ralpha, transpose_aa, tda, rbeta, transpose_cc, tdc); for (j =0; j < max_d; ++j) { for (i = 0; i < max_d; ++i) { aa[i + j * tda] = transpose_aa[i * tda + j]; cc[i + j * tda] = transpose_cc[i * tda + j]; } } } else { if (trace) { Vprintf("%6ld: %6s(%c,%c," "%3ld,%3ld," " (%4.1f,%4.1f), A,%3ld, (%4.1f,%4.1f), C,%3ld).\n", nc, sname, uplo, trans, n, k, alpha.re, alpha.im, tda, beta.re, beta.im, tdc); } max_d = MAX(n, k); for (j =0; j < max_d; ++j) { for (i = 0; i < max_d; ++i) { transpose_aa[i * tda + j] = aa[i + j * tda]; transpose_cc[i * tda + j] = cc[i + j * tda]; } } f06zuc(uplo_c, trans_c, n, k, alpha, transpose_aa, tda, beta, transpose_cc, tdc); for (j =0; j < max_d; ++j) { for (i = 0; i < max_d; ++i) { aa[i + j * tda] = transpose_aa[i * tda + j]; cc[i + j * tda] = transpose_cc[i * tda + j]; } } } /* Check if error-exit was taken incorrectly. */ if (! infoc.ok) { Vprintf(" ******* Fatal error - " "error-exit taken on valid call ******\n"); *fatal = TRUE; goto L240; } /* See what data changed inside subroutines. */ isame[0] = uplos_c == uplo_c; isame[1] = transs_c == trans_c; isame[2] = ns == n; isame[3] = ks == k; if (conj) isame[4] = rals == ralpha; else isame[4] = (als.re == alpha.re && als.im == alpha.im); isame[5] = lce(as, aa, taa); isame[6] = tdas == tda; if (conj) isame[7] = rbets == rbeta; else isame[7] = (bets.re == beta.re && bets.im == beta.im); if (null) isame[8] = lce(cs, cc, tcc); else { isame[8] = lceres(sname + 8, uplo, n, n, cs, cc, tdc); } isame[9] = tdcs == tdc; /* If data was incorrectly changed, report and */ /* return. */ same = TRUE; for (i = 1; i <= nargs; ++i) { same = same && isame[i - 1]; if (! isame[i - 1]) { Vprintf(" ******* Fatal error - " "parameter number %2ld was changed incorrectly *******\n", i); } } if (! same) { *fatal = TRUE; goto L240; } if (! null) { /* Check the result column by column. */ if (conj) transt = 'c'; else transt = 't'; jc = 1; for (j = 1; j <= n; ++j) { if (upper) { jj = 1; lj = j; } else { jj = j; lj = n - j + 1; } if (tran) { cmmch(transt, 'n', lj, (Integer)1, k, alpha, &a[(jj-1)*nmax], nmax, &a[(j-1)*nmax], nmax, beta, &c[jj-1+(j-1)*nmax], nmax, ct, g, &CC(jc), tdc, eps, &err, fatal, 1); } else { cmmch('n', transt, lj, (Integer)1, k, alpha, &a[jj-1], nmax, &a[j-1], nmax, beta, & c[jj-1+(j-1)*nmax], nmax, ct, g, &CC(jc), tdc, eps, &err, fatal, 1); } if (upper) jc += tdc; else jc = jc + tdc + 1; errmax = MAX(errmax,err); /* * If got really bad answer, report and * return. */ if (*fatal) goto L220; } } } } } L160: ; } } L200: ; } /* Report result. */ if (errmax < thresh) { Vprintf("%.6s passed the computational tests ( %6ld calls)\n", sname, nc); } else { Vprintf("%.6s completed the computational tests (%6ld calls)\n" "******* but with maximum test ratio ,%8.2f,- suspect *******\n", sname, nc, errmax); } goto L260; L220: if (n > 1) Vprintf(" These are the results for column %3ld).\n", j); L240: Vprintf("******* %.6s failed on call number:\n", sname); if (conj) Vprintf("%6ld: %6s(%c,%c," "%3ld,%3ld," " %4.1f, A,%3ld, %4.1f, C,%3ld).\n", nc, sname, uplo, trans, n, k, ralpha, tda, rbeta, tdc); else Vprintf("%6ld: %6s(%c,%c," "%3ld,%3ld," " (%4.1f,%4.1f), A,%3ld, (%4.1f,%4.1f), C,%3ld).\n", nc, sname, uplo, trans, n, k, alpha.re, alpha.im, tda, beta.re, beta.im, tdc); L260:; } /* cchk4 */ /* ---------------------------------------------------------------------- */ static void cchk5(const char sname[], double eps, double thresh, int trace, int *fatal, Integer nidim, Integer idim[], Integer nalf, Complex alf[], Integer nbet, Complex bet[], Integer nmax, Complex ab[], Complex aa[], Complex as[], Complex bb[], Complex bs[], Complex c[], Complex cc[], Complex cs[], Complex ct[], double g[], Complex w[]) { /* Initialized data */ static char icht[2+1] = "nc"; static char ichu[2+1] = "ul"; /* Local variables */ Integer jjab; Complex beta; Integer tdas, tdbs, tdcs; int same, conj; Complex bets; int tran, null; char uplo; Integer i, j, k, n; Complex alpha; double rbeta; int isame[13]; Integer nargs; double rbets; int reset; char trans; int upper; Integer ia, ib, jc, ma, na, nc, ik, in, jj, lj, ks, ns; double errmax; char transt; Integer taa, tbb, tda, tcc, tdb, tdc; Complex als; Integer ict, icu; double err; Integer max_d; MatrixTranspose trans_c, transs_c; MatrixTriangle uplo_c, uplos_c; /* Tests f06zrc and f06zwc. */ /* Auxiliary routine for test program for Level 3 Blas. */ #define W(I) w[(I)-1] #define G(I) g[(I)-1] #define CT(I) ct[(I)-1] #define CS(I) cs[(I)-1] #define CC(I) cc[(I)-1] #define BS(I) bs[(I)-1] #define BB(I) bb[(I)-1] #define AS(I) as[(I)-1] #define AA(I) aa[(I)-1] #define AB(I) ab[(I)-1] #define BET(I) bet[(I)-1] #define ALF(I) alf[(I)-1] #define IDIM(I) idim[(I)-1] /* Function Body */ conj = ! strncmp(sname + 8, "he", 2); if (trace) { Vprintf("\nComputational tests : \n"); if (conj) { Vprintf("\nf06zrc tested with : \n"); Vprintf("(UpperTriangle (u), NoTranspose (n),..)\n"); Vprintf("(LowerTriangle (l), ConjugateTranspose (c),.....)\n\n"); } else { Vprintf("\nf06zwc tested with : \n"); Vprintf("(UpperTriangle (u), Transpose (t),..)\n"); Vprintf("(UpperTriangle (l), NoTranspose (n),..)\n\n"); } } nargs = 12; nc = 0; reset = TRUE; errmax = 0.0; for (in = 1; in <= nidim; ++in) { n = IDIM(in); /* Set tdc to 1 more than minimum value if room. */ tdc = n; tdc = nmax; /* if (tdc < nmax) { ++tdc; } */ /* Skip tests if not enough room. */ if (tdc > nmax) goto L260; tcc = tdc * n; for (ik = 1; ik <= nidim; ++ik) { k = IDIM(ik); for (ict = 1; ict <= 2; ++ict) { trans = icht[ict - 1]; tran = trans == 'c'; trans_c = NoTranspose; if (trans == 'c') trans_c = ConjugateTranspose; if (tran && ! conj) { trans = 't'; trans_c = Transpose; } if (tran) { ma = k; na = n; } else { ma = n; na = k; } /* Set tda to 1 more than minimum value if room. */ tda = ma; tda = nmax; /* if (tda < nmax) { ++tda; } */ /* Skip tests if not enough room. */ if (tda > nmax) goto L220; taa = tda * na; /* Generate the matrix A. */ if (tran) { cmake("ge", ' ', ' ', ma, na, ab, nmax<<1, aa, tda, &reset, cmplx_0_0); } else { cmake("ge", ' ', ' ', ma, na, ab, nmax, aa, tda, &reset, cmplx_0_0); } /* Generate the matrix B. */ tdb = tda; tbb = taa; if (tran) { cmake("ge", ' ', ' ', ma, na, &AB(k + 1), nmax<<1, bb , tdb, &reset, cmplx_0_0); } else { cmake("ge", ' ', ' ', ma, na, &AB(k * nmax + 1), nmax, bb, tdb, &reset, cmplx_0_0); } for (icu = 1; icu <= 2; ++icu) { uplo = ichu[icu - 1]; upper = uplo == 'u'; if (uplo == 'u') uplo_c = UpperTriangle; else uplo_c = LowerTriangle; for (ia = 1; ia <= nalf; ++ia) { alpha = ALF( ia); for (ib = 1; ib <= nbet; ++ib) { beta = BET( ib); rbeta = 0.0; if (conj) { rbeta = beta.re; beta = a02bac(rbeta, 0.0); } null = n <= 0; if (conj) { null = null || ((k <= 0 || (alpha.re == 0.0 && alpha.im == 0.0)) && rbeta == 1.0); } /* Generate the matrix C. */ cmake(sname + 8, uplo, ' ', n, n, c, nmax, cc, tdc, &reset, cmplx_0_0); ++nc; /* Save every datum before calling the subroutine. */ uplos_c = uplo_c; transs_c = trans_c; ns = n; ks = k; als = alpha; for (i = 1; i <= taa; ++i) AS( i) = AA( i); tdas = tda; for (i = 1; i <= tbb; ++i) BS( i) = BB( i); tdbs = tdb; rbets = 0.0; if (conj) rbets = rbeta; else bets = beta; for (i = 1; i <= tcc; ++i) CS( i) = CC( i); tdcs = tdc; /* Call the subroutine. */ if (conj) { if (trace) { Vprintf("%6ld: %6s(%c,%c," "%3ld,%3ld," " (%4.1f,%4.1f), A,%3ld, B,%3ld, %4.1f, C,%3ld).\n", nc, sname, uplo, trans, n, k, alpha.re, alpha.im, tda, tdb, rbeta, tdc); } max_d = MAX(n, k); for (j =0; j < max_d; ++j) { for (i = 0; i < max_d; ++i) { transpose_aa[i * tda + j] = aa[i + j * tda]; transpose_bb[i * tda + j] = bb[i + j * tda]; transpose_cc[i * tda + j] = cc[i + j * tda]; } } f06zrc (uplo_c, trans_c, n, k, alpha, transpose_aa, tda, transpose_bb, tdb, rbeta, transpose_cc, tdc); for (j =0; j < max_d; ++j) { for (i = 0; i < max_d; ++i) { aa[i + j * tda] = transpose_aa[i * tda + j]; bb[i + j * tda] = transpose_bb[i * tda + j]; cc[i + j * tda] = transpose_cc[i * tda + j]; } } } else { if (trace) { Vprintf("%6ld: %6s(%c,%c," "%3ld,%3ld," " (%4.1f,%4.1f), A,%3ld, B,%3ld, (%4.1f,%4.1f), C,%3ld).\n", nc, sname, uplo, trans, n, k, alpha.re, alpha.im, tda, tdb, beta.re, beta.im, tdc); } max_d = MAX(n, k); for (j =0; j < max_d; ++j) { for (i = 0; i < max_d; ++i) { transpose_aa[i * tda + j] = aa[i + j * tda]; transpose_bb[i * tda + j] = bb[i + j * tda]; transpose_cc[i * tda + j] = cc[i + j * tda]; } } f06zwc (uplo_c, trans_c, n, k, alpha, transpose_aa, tda, transpose_bb, tdb, beta, transpose_cc, tdc); for (j =0; j < max_d; ++j) { for (i = 0; i < max_d; ++i) { aa[i + j * tda] = transpose_aa[i * tda + j]; bb[i + j * tda] = transpose_bb[i * tda + j]; cc[i + j * tda] = transpose_cc[i * tda + j]; } } } /* Check if error-exit was taken incorrectly. */ if (! infoc.ok) { Vprintf(" ******* Fatal error - " "error-exit taken on valid call ******\n"); *fatal = TRUE; goto L300; } /* See what data changed inside subroutines. */ isame[0] = uplos_c == uplo_c; isame[1] = transs_c == trans_c; isame[2] = ns == n; isame[3] = ks == k; isame[4] = als.re == alpha.re && als.im == alpha.im; isame[5] = lce(as, aa, taa); isame[6] = tdas == tda; isame[7] = lce(bs, bb, tbb); isame[8] = tdbs == tdb; if (conj) isame[9] = rbets == rbeta; else isame[9] = (bets.re == beta.re && bets.im == beta.im); if (null) isame[10] = lce(cs, cc, tcc); else { isame[10] = lceres("he", uplo, n, n, cs , cc, tdc); } isame[11] = tdcs == tdc; /* * If data was incorrectly changed, report and * return. */ same = TRUE; for (i = 1; i <= nargs; ++i) { same = same && isame[i - 1]; if (! isame[i - 1]) { Vprintf(" ******* Fatal error - " "parameter number %2ld was changed incorrectly *******\n", i); } } if (! same) { *fatal = TRUE; goto L300; } if (! null) { /* Check the result column by column. */ if (conj) transt = 'c'; else transt = 't'; jjab = 1; jc = 1; for (j = 1; j <= n; ++j) { if (upper) { jj = 1; lj = j; } else { jj = j; lj = n - j + 1; } if (tran) { for (i = 1; i <= k; ++i) { W(i) = a02ccc(alpha, AB(((j-1)*2) * nmax + k + i)); if (conj) W(k+i) = a02ccc(a02cfc(alpha), AB(((j-1)*2) * nmax + i)); else W(k+i) = a02ccc(alpha, AB(((j-1)*2) * nmax + i)); } cmmch(transt, 'n', lj, (Integer)1, k<<1, cmplx_1_0, &AB(jjab), nmax<<1, w, nmax<<1, beta, &c[jj-1+(j-1)*nmax], nmax, ct, g, &CC(jc), tdc, eps, &err, fatal, 1); } else { for (i = 1; i <= k; ++i) { if (conj) { W(i) = a02ccc(alpha, a02cfc(AB((k + i - 1) * nmax + j))); W(k+i) = a02cfc(a02ccc(alpha, AB((i-1) * nmax + j))); } else { W(i) = a02ccc(alpha, AB((k + i - 1) * nmax + j)); W(k+i) = a02ccc(alpha, AB((i-1) * nmax + j)); } } cmmch('n', 'n', lj, (Integer)1, k<<1, cmplx_1_0, &AB(jj), nmax, w, nmax<<1, beta, &c[jj-1+(j-1)*nmax], nmax, ct, g, &CC(jc), tdc, eps, &err, fatal, 1); } if (upper) jc += tdc; else { jc = jc + tdc + 1; if (tran) jjab += nmax << 1; } errmax = MAX(errmax,err); /* If got really bad answer, report and */ /* return. */ if (*fatal) goto L280; } } } } } L220: ; } } L260: ; } /* Report result. */ if (errmax < thresh) { Vprintf("%.6s passed the computational tests ( %6ld calls)\n", sname, nc); } else { Vprintf("%.6s completed the computational tests (%6ld calls)\n" "******* but with maximum test ratio ,%8.2f,- suspect *******\n", sname, nc, errmax); } goto L320; L280: if (n > 1) Vprintf(" These are the results for column %3ld).\n", j); L300: Vprintf("******* %.6s failed on call number:\n", sname); if (conj) { Vprintf("%6ld: %6s(%c,%c," "%3ld,%3ld," " (%4.1f,%4.1f), A,%3ld, B,%3ld, %4.1f, C,%3ld).\n", nc, sname, uplo, trans, n, k, alpha.re, alpha.im, tda, tdb, rbeta, tdc); } else { Vprintf("%6ld: %6s(%c,%c," "%3ld,%3ld," " (%4.1f,%4.1f), A,%3ld, B,%3ld, (%4.1f,%4.1f), C,%3ld).\n", nc, sname, uplo, trans, n, k, alpha.re, alpha.im, tda, tdb, beta.re, beta.im, tdc); } L320: ; } /* cchk5 */ /* ------------------------------------------------------------------ */ static void cchke(Integer isnum, const char srnamt[]) { /* Local variables */ Complex beta = {0.0,0.0}, a[2], b[2], c[2], alpha = {0.0,0.0}; double rbeta = 0.0; double ralpha = 0.0; Integer one = 1; Integer two = 2; Integer m_one = -1; Integer zero = 0; /* Tests the error exits from the Level 3 Blas. */ /* Requires a special version of the error-handling routine f06aaz. */ /* alpha, beta, a, b and c should not need to be */ /* defined if anything is wrong. */ infoc.ok = TRUE; /* * lerr is set to TRUE by the special version of f06aaz each time * it is called, and is then tested and re-set by chkxer. */ infoc.lerr = FALSE; switch ((int)isnum) { case 1: goto L20; case 2: goto L40; case 3: goto L60; case 4: goto L80; case 5: goto L100; case 6: goto L120; case 7: goto L140; case 8: goto L160; case 9: goto L180; } L20: infoc.infot = 1; f06zac((MatrixTranspose)999, NoTranspose, zero, zero, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 1; f06zac((MatrixTranspose)999, ConjugateTranspose, zero, zero, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 1; f06zac((MatrixTranspose)999, Transpose, zero, zero, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 2; f06zac(NoTranspose, (MatrixTranspose)999, zero, zero, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 2; f06zac(ConjugateTranspose, (MatrixTranspose)999, zero, zero, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 2; f06zac(Transpose, (MatrixTranspose)999, zero, zero, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06zac(NoTranspose, NoTranspose, m_one, zero, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06zac(NoTranspose, ConjugateTranspose, m_one, zero, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06zac(NoTranspose, Transpose, m_one, zero, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06zac(ConjugateTranspose, NoTranspose, m_one, zero, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06zac(ConjugateTranspose, ConjugateTranspose, m_one, zero, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06zac(ConjugateTranspose, Transpose, m_one, zero, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06zac(Transpose, NoTranspose, m_one, zero, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06zac(Transpose, ConjugateTranspose, m_one, zero, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06zac(Transpose, Transpose, m_one, zero, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06zac(NoTranspose, NoTranspose, zero, m_one, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06zac(NoTranspose, ConjugateTranspose, zero, m_one, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06zac(NoTranspose, Transpose, zero, m_one, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06zac(ConjugateTranspose, NoTranspose, zero, m_one, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06zac(ConjugateTranspose, ConjugateTranspose, zero, m_one, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06zac(ConjugateTranspose, Transpose, zero, m_one, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06zac(Transpose, NoTranspose, zero, m_one, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06zac(Transpose, ConjugateTranspose, zero, m_one, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06zac(Transpose, Transpose, zero, m_one, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zac(NoTranspose, NoTranspose, zero, zero, m_one, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zac(NoTranspose, ConjugateTranspose, zero, zero, m_one, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zac(NoTranspose, Transpose, zero, zero, m_one, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zac(ConjugateTranspose, NoTranspose, zero, zero, m_one, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zac(ConjugateTranspose, ConjugateTranspose, zero, zero, m_one, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zac(ConjugateTranspose, Transpose, zero, zero, m_one, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zac(Transpose, NoTranspose, zero, zero, m_one, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zac(Transpose, ConjugateTranspose, zero, zero, m_one, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zac(Transpose, Transpose, zero, zero, m_one, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 8; f06zac(NoTranspose, NoTranspose, two, zero, two, alpha, a, one, b, two, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 8; f06zac(NoTranspose, ConjugateTranspose, two, zero, two, alpha, a, one, b, two, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 8; f06zac(NoTranspose, Transpose, two, zero, two, alpha, a, one, b, two, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 8; f06zac(ConjugateTranspose, NoTranspose, two, zero, two, alpha, a, one, b, two, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 8; f06zac(ConjugateTranspose, ConjugateTranspose, two, zero, two, alpha, a, one, b, two, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 8; f06zac(ConjugateTranspose, Transpose, two, zero, two, alpha, a, one, b, two, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 8; f06zac(Transpose, NoTranspose, two, zero, two, alpha, a, one, b, two, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 8; f06zac(Transpose, ConjugateTranspose, two, zero, two, alpha, a, one, b, two, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 8; f06zac(Transpose, Transpose, two, zero, two, alpha, a, one, b, two, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 10; f06zac(NoTranspose, NoTranspose, zero, two, two, alpha, a, two, b, one, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 10; f06zac(ConjugateTranspose, NoTranspose, zero, two, two, alpha, a, two, b, one, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 10; f06zac(Transpose, NoTranspose, zero, two, two, alpha, a, two, b, one, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 10; f06zac(NoTranspose, ConjugateTranspose, zero, two, two, alpha, a, two, b, one, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 10; f06zac(ConjugateTranspose, ConjugateTranspose, zero, two, two, alpha, a, two, b, one, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 10; f06zac(Transpose, ConjugateTranspose, zero, two, two, alpha, a, two, b, one, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 10; f06zac(NoTranspose, Transpose, zero, two, two, alpha, a, two, b, one, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 10; f06zac(ConjugateTranspose, Transpose, zero, two, two, alpha, a, two, b, one, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 10; f06zac(Transpose, Transpose, zero, two, two, alpha, a, two, b, one, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 13; f06zac(NoTranspose, NoTranspose, two, two, zero, alpha, a, two, b, two, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 13; f06zac(NoTranspose, ConjugateTranspose, two, two, zero, alpha, a, two, b, two, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 13; f06zac(NoTranspose, Transpose, two, two, zero, alpha, a, two, b, two, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 13; f06zac(ConjugateTranspose, NoTranspose, two, two, zero, alpha, a, two, b, two, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 13; f06zac(ConjugateTranspose, ConjugateTranspose, two, two, zero, alpha, a, two, b, two, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 13; f06zac(ConjugateTranspose, Transpose, two, two, zero, alpha, a, two, b, two, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 13; f06zac(Transpose, NoTranspose, two, two, zero, alpha, a, two, b, two, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 13; f06zac(Transpose, ConjugateTranspose, two, two, zero, alpha, a, two, b, two, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 13; f06zac(Transpose, Transpose, two, two, zero, alpha, a, two, b, two, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); goto L200; L40: infoc.infot = 1; f06zcc((OperationSide)999, UpperTriangle, zero, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 2; f06zcc(LeftSide, (MatrixTriangle)999, zero, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06zcc(LeftSide, UpperTriangle, m_one, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06zcc(RightSide, UpperTriangle, m_one, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06zcc(LeftSide, LowerTriangle, m_one, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06zcc(RightSide, LowerTriangle, m_one, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06zcc(LeftSide, UpperTriangle, zero, m_one, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06zcc(RightSide, UpperTriangle, zero, m_one, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06zcc(LeftSide, LowerTriangle, zero, m_one, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06zcc(RightSide, LowerTriangle, zero, m_one, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 7; f06zcc(LeftSide, UpperTriangle, two, zero, alpha, a, one, b, two, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 7; f06zcc(RightSide, UpperTriangle, zero, two, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 7; f06zcc(LeftSide, LowerTriangle, two, zero, alpha, a, one, b, two, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 7; f06zcc(RightSide, LowerTriangle, zero, two, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zcc(LeftSide, UpperTriangle, zero, two, alpha, a, two, b, one, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zcc(RightSide, UpperTriangle, zero, two, alpha, a, two, b, one, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zcc(LeftSide, LowerTriangle, zero, two, alpha, a, one, b, one, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zcc(RightSide, LowerTriangle, zero, two, alpha, a, two, b, one, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 12; f06zcc(LeftSide, UpperTriangle, zero, two, alpha, a, one, b, two, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 12; f06zcc(RightSide, UpperTriangle, zero, two, alpha, a, two, b, two, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 12; f06zcc(LeftSide, LowerTriangle, zero, two, alpha, a, one, b, two, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 12; f06zcc(RightSide, LowerTriangle, zero, two, alpha, a, two, b, two, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); goto L200; L60: infoc.infot = 1; f06ztc((OperationSide)999, UpperTriangle, zero, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 2; f06ztc(LeftSide, (MatrixTriangle)999, zero, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06ztc(LeftSide, UpperTriangle, m_one, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06ztc(RightSide, UpperTriangle, m_one, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06ztc(LeftSide, LowerTriangle, m_one, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06ztc(RightSide, LowerTriangle, m_one, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06ztc(LeftSide, UpperTriangle, zero, m_one, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06ztc(RightSide, UpperTriangle, zero, m_one, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06ztc(LeftSide, LowerTriangle, zero, m_one, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06ztc(RightSide, LowerTriangle, zero, m_one, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 7; f06ztc(LeftSide, UpperTriangle, two, zero, alpha, a, one, b, two, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 7; f06ztc(RightSide, UpperTriangle, zero, two, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 7; f06ztc(LeftSide, LowerTriangle, two, zero, alpha, a, one, b, two, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 7; f06ztc(RightSide, LowerTriangle, zero, two, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06ztc(LeftSide, UpperTriangle, zero, two, alpha, a, one, b, one, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06ztc(RightSide, UpperTriangle, zero, two, alpha, a, two, b, one, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06ztc(LeftSide, LowerTriangle, zero, two, alpha, a, one, b, one, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06ztc(RightSide, LowerTriangle, zero, two, alpha, a, two, b, one, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 12; f06ztc(LeftSide, UpperTriangle, zero, two, alpha, a, one, b, two, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 12; f06ztc(RightSide, UpperTriangle, zero, two, alpha, a, two, b, two, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 12; f06ztc(LeftSide, LowerTriangle, zero, two, alpha, a, one, b, two, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 12; f06ztc(RightSide, LowerTriangle, zero, two, alpha, a, two, b, two, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); goto L200; L80: infoc.infot = 1; f06zfc((OperationSide)999, UpperTriangle, NoTranspose, NotUnitTriangular, zero, zero, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 2; f06zfc(LeftSide, (MatrixTriangle)999, NoTranspose, NotUnitTriangular, zero, zero, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06zfc(LeftSide, UpperTriangle, (MatrixTranspose)999, NotUnitTriangular, zero, zero, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06zfc(LeftSide, UpperTriangle, NoTranspose, (MatrixUnitTriangular)999, zero, zero, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zfc(LeftSide, UpperTriangle, NoTranspose, NotUnitTriangular, m_one, zero, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zfc(LeftSide, UpperTriangle, ConjugateTranspose, NotUnitTriangular, m_one, zero, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zfc(LeftSide, UpperTriangle, Transpose, NotUnitTriangular, m_one, zero, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zfc(RightSide, UpperTriangle, NoTranspose, NotUnitTriangular, m_one, zero, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zfc(RightSide, UpperTriangle, ConjugateTranspose, NotUnitTriangular, m_one, zero, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zfc(RightSide, UpperTriangle, Transpose, NotUnitTriangular, m_one, zero, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zfc(LeftSide, LowerTriangle, NoTranspose, NotUnitTriangular, m_one, zero, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zfc(LeftSide, LowerTriangle, ConjugateTranspose, NotUnitTriangular, m_one, zero, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zfc(LeftSide, LowerTriangle, Transpose, NotUnitTriangular, m_one, zero, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zfc(RightSide, LowerTriangle, NoTranspose, NotUnitTriangular, m_one, zero, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zfc(RightSide, LowerTriangle, ConjugateTranspose, NotUnitTriangular, m_one, zero, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zfc(RightSide, LowerTriangle, Transpose, NotUnitTriangular, m_one, zero, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 6; f06zfc(LeftSide, UpperTriangle, NoTranspose, NotUnitTriangular, zero, m_one, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 6; f06zfc(LeftSide, UpperTriangle, ConjugateTranspose, NotUnitTriangular, zero, m_one, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 6; f06zfc(LeftSide, UpperTriangle, Transpose, NotUnitTriangular, zero, m_one, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 6; f06zfc(RightSide, UpperTriangle, NoTranspose, NotUnitTriangular, zero, m_one, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 6; f06zfc(RightSide, UpperTriangle, ConjugateTranspose, NotUnitTriangular, zero, m_one, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 6; f06zfc(RightSide, UpperTriangle, Transpose, NotUnitTriangular, zero, m_one, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 6; f06zfc(LeftSide, LowerTriangle, NoTranspose, NotUnitTriangular, zero, m_one, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 6; f06zfc(LeftSide, LowerTriangle, ConjugateTranspose, NotUnitTriangular, zero, m_one, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 6; f06zfc(LeftSide, LowerTriangle, Transpose, NotUnitTriangular, zero, m_one, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 6; f06zfc(RightSide, LowerTriangle, NoTranspose, NotUnitTriangular, zero, m_one, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 6; f06zfc(RightSide, LowerTriangle, ConjugateTranspose, NotUnitTriangular, zero, m_one, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 6; f06zfc(RightSide, LowerTriangle, Transpose, NotUnitTriangular, zero, m_one, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zfc(LeftSide, UpperTriangle, NoTranspose, NotUnitTriangular, two, zero, alpha, a, one, b, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zfc(LeftSide, UpperTriangle, ConjugateTranspose, NotUnitTriangular, two, zero, alpha, a, one, b, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zfc(LeftSide, UpperTriangle, Transpose, NotUnitTriangular, two, zero, alpha, a, one, b, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zfc(RightSide, UpperTriangle, NoTranspose, NotUnitTriangular, zero, two, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zfc(RightSide, UpperTriangle, ConjugateTranspose, NotUnitTriangular, zero, two, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zfc(RightSide, UpperTriangle, Transpose, NotUnitTriangular, zero, two, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zfc(LeftSide, LowerTriangle, NoTranspose, NotUnitTriangular, two, zero, alpha, a, one, b, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zfc(LeftSide, LowerTriangle, ConjugateTranspose, NotUnitTriangular, two, zero, alpha, a, one, b, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zfc(LeftSide, LowerTriangle, Transpose, NotUnitTriangular, two, zero, alpha, a, one, b, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zfc(RightSide, LowerTriangle, NoTranspose, NotUnitTriangular, zero, two, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zfc(RightSide, LowerTriangle, ConjugateTranspose, NotUnitTriangular, zero, two, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zfc(RightSide, LowerTriangle, Transpose, NotUnitTriangular, zero, two, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 11; f06zfc(LeftSide, UpperTriangle, NoTranspose, NotUnitTriangular, zero, two, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 11; f06zfc(LeftSide, UpperTriangle, ConjugateTranspose, NotUnitTriangular, zero, two, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 11; f06zfc(LeftSide, UpperTriangle, Transpose, NotUnitTriangular, zero, two, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 11; f06zfc(RightSide, UpperTriangle, NoTranspose, NotUnitTriangular, zero, two, alpha, a, two, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 11; f06zfc(RightSide, UpperTriangle, ConjugateTranspose, NotUnitTriangular, zero, two, alpha, a, two, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 11; f06zfc(RightSide, UpperTriangle, Transpose, NotUnitTriangular, zero, two, alpha, a, two, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 11; f06zfc(LeftSide, LowerTriangle, NoTranspose, NotUnitTriangular, zero, two, alpha, a, two, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 11; f06zfc(LeftSide, LowerTriangle, ConjugateTranspose, NotUnitTriangular, zero, two, alpha, a, two, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 11; f06zfc(LeftSide, LowerTriangle, Transpose, NotUnitTriangular, zero, two, alpha, a, two, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 11; f06zfc(RightSide, LowerTriangle, NoTranspose, NotUnitTriangular, zero, two, alpha, a, two, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 11; f06zfc(RightSide, LowerTriangle, ConjugateTranspose, NotUnitTriangular, zero, two, alpha, a, two, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 11; f06zfc(RightSide, LowerTriangle, Transpose, NotUnitTriangular, zero, two, alpha, a, two, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); goto L200; L100: infoc.infot = 1; f06zjc((OperationSide)999, UpperTriangle, NoTranspose, NotUnitTriangular, zero, zero, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 2; f06zjc(LeftSide, (MatrixTriangle)999, NoTranspose, NotUnitTriangular, zero, zero, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06zjc(LeftSide, UpperTriangle, (MatrixTranspose)999, NotUnitTriangular, zero, zero, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06zjc(LeftSide, UpperTriangle, NoTranspose, (MatrixUnitTriangular)999, zero, zero, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zjc(LeftSide, UpperTriangle, NoTranspose, NotUnitTriangular, m_one, zero, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zjc(LeftSide, UpperTriangle, ConjugateTranspose, NotUnitTriangular, m_one, zero, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zjc(LeftSide, UpperTriangle, Transpose, NotUnitTriangular, m_one, zero, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zjc(RightSide, UpperTriangle, NoTranspose, NotUnitTriangular, m_one, zero, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zjc(RightSide, UpperTriangle, ConjugateTranspose, NotUnitTriangular, m_one, zero, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zjc(RightSide, UpperTriangle, Transpose, NotUnitTriangular, m_one, zero, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zjc(LeftSide, LowerTriangle, NoTranspose, NotUnitTriangular, m_one, zero, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zjc(LeftSide, LowerTriangle, ConjugateTranspose, NotUnitTriangular, m_one, zero, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zjc(LeftSide, LowerTriangle, Transpose, NotUnitTriangular, m_one, zero, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zjc(RightSide, LowerTriangle, NoTranspose, NotUnitTriangular, m_one, zero, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zjc(RightSide, LowerTriangle, ConjugateTranspose, NotUnitTriangular, m_one, zero, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 5; f06zjc(RightSide, LowerTriangle, Transpose, NotUnitTriangular, m_one, zero, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 6; f06zjc(LeftSide, UpperTriangle, NoTranspose, NotUnitTriangular, zero, m_one, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 6; f06zjc(LeftSide, UpperTriangle, ConjugateTranspose, NotUnitTriangular, zero, m_one, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 6; f06zjc(LeftSide, UpperTriangle, Transpose, NotUnitTriangular, zero, m_one, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 6; f06zjc(RightSide, UpperTriangle, NoTranspose, NotUnitTriangular, zero, m_one, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 6; f06zjc(RightSide, UpperTriangle, ConjugateTranspose, NotUnitTriangular, zero, m_one, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 6; f06zjc(RightSide, UpperTriangle, Transpose, NotUnitTriangular, zero, m_one, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 6; f06zjc(LeftSide, LowerTriangle, NoTranspose, NotUnitTriangular, zero, m_one, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 6; f06zjc(LeftSide, LowerTriangle, ConjugateTranspose, NotUnitTriangular, zero, m_one, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 6; f06zjc(LeftSide, LowerTriangle, Transpose, NotUnitTriangular, zero, m_one, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 6; f06zjc(RightSide, LowerTriangle, NoTranspose, NotUnitTriangular, zero, m_one, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 6; f06zjc(RightSide, LowerTriangle, ConjugateTranspose, NotUnitTriangular, zero, m_one, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 6; f06zjc(RightSide, LowerTriangle, Transpose, NotUnitTriangular, zero, m_one, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zjc(LeftSide, UpperTriangle, NoTranspose, NotUnitTriangular, two, zero, alpha, a, one, b, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zjc(LeftSide, UpperTriangle, ConjugateTranspose, NotUnitTriangular, two, zero, alpha, a, one, b, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zjc(LeftSide, UpperTriangle, Transpose, NotUnitTriangular, two, zero, alpha, a, one, b, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zjc(RightSide, UpperTriangle, NoTranspose, NotUnitTriangular, zero, two, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zjc(RightSide, UpperTriangle, ConjugateTranspose, NotUnitTriangular, zero, two, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zjc(RightSide, UpperTriangle, Transpose, NotUnitTriangular, zero, two, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zjc(LeftSide, LowerTriangle, NoTranspose, NotUnitTriangular, two, zero, alpha, a, one, b, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zjc(LeftSide, LowerTriangle, ConjugateTranspose, NotUnitTriangular, two, zero, alpha, a, one, b, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zjc(LeftSide, LowerTriangle, Transpose, NotUnitTriangular, two, zero, alpha, a, one, b, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zjc(RightSide, LowerTriangle, NoTranspose, NotUnitTriangular, zero, two, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zjc(RightSide, LowerTriangle, ConjugateTranspose, NotUnitTriangular, zero, two, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zjc(RightSide, LowerTriangle, Transpose, NotUnitTriangular, zero, two, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 11; f06zjc(LeftSide, UpperTriangle, NoTranspose, NotUnitTriangular, zero, two, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 11; f06zjc(LeftSide, UpperTriangle, ConjugateTranspose, NotUnitTriangular, zero, two, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 11; f06zjc(LeftSide, UpperTriangle, Transpose, NotUnitTriangular, zero, two, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 11; f06zjc(RightSide, UpperTriangle, NoTranspose, NotUnitTriangular, zero, two, alpha, a, two, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 11; f06zjc(RightSide, UpperTriangle, ConjugateTranspose, NotUnitTriangular, zero, two, alpha, a, two, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 11; f06zjc(RightSide, UpperTriangle, Transpose, NotUnitTriangular, zero, two, alpha, a, two, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 11; f06zjc(LeftSide, LowerTriangle, NoTranspose, NotUnitTriangular, zero, two, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 11; f06zjc(LeftSide, LowerTriangle, ConjugateTranspose, NotUnitTriangular, zero, two, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 11; f06zjc(LeftSide, LowerTriangle, Transpose, NotUnitTriangular, zero, two, alpha, a, one, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 11; f06zjc(RightSide, LowerTriangle, NoTranspose, NotUnitTriangular, zero, two, alpha, a, two, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 11; f06zjc(RightSide, LowerTriangle, ConjugateTranspose, NotUnitTriangular, zero, two, alpha, a, two, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 11; f06zjc(RightSide, LowerTriangle, Transpose, NotUnitTriangular, zero, two, alpha, a, two, b, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); goto L200; L120: infoc.infot = 1; f06zpc((MatrixTriangle)999, NoTranspose, zero, zero, ralpha, a, one, rbeta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 2; f06zpc(UpperTriangle, Transpose, zero, zero, ralpha, a, one, rbeta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06zpc(UpperTriangle, NoTranspose, m_one, zero, ralpha, a, one, rbeta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06zpc(UpperTriangle, ConjugateTranspose, m_one, zero, ralpha, a, one, rbeta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06zpc(LowerTriangle, NoTranspose, m_one, zero, ralpha, a, one, rbeta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06zpc(LowerTriangle, ConjugateTranspose, m_one, zero, ralpha, a, one, rbeta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06zpc(UpperTriangle, NoTranspose, zero, m_one, ralpha, a, one, rbeta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06zpc(UpperTriangle, ConjugateTranspose, zero, m_one, ralpha, a, one, rbeta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06zpc(LowerTriangle, NoTranspose, zero, m_one, ralpha, a, one, rbeta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06zpc(LowerTriangle, ConjugateTranspose, zero, m_one, ralpha, a, one, rbeta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 7; f06zpc(UpperTriangle, NoTranspose, zero, two, ralpha, a, one, rbeta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 7; f06zpc(UpperTriangle, ConjugateTranspose, two, zero, ralpha, a, one, rbeta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 7; f06zpc(LowerTriangle, NoTranspose, zero, two, ralpha, a, one, rbeta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 7; f06zpc(LowerTriangle, ConjugateTranspose, two, zero, ralpha, a, one, rbeta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 10; f06zpc(UpperTriangle, NoTranspose, two, zero, ralpha, a, one, rbeta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 10; f06zpc(UpperTriangle, ConjugateTranspose, two, zero, ralpha, a, two, rbeta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 10; f06zpc(LowerTriangle, NoTranspose, two, zero, ralpha, a, two, rbeta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 10; f06zpc(LowerTriangle, ConjugateTranspose, two, zero, ralpha, a, two, rbeta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); goto L200; L140: infoc.infot = 1; f06zuc((MatrixTriangle)999, NoTranspose, zero, zero, alpha, a, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 2; f06zuc(UpperTriangle, ConjugateTranspose, zero, zero, alpha, a, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06zuc(UpperTriangle, NoTranspose, m_one, zero, alpha, a, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06zuc(UpperTriangle, Transpose, m_one, zero, alpha, a, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06zuc(LowerTriangle, NoTranspose, m_one, zero, alpha, a, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06zuc(LowerTriangle, Transpose, m_one, zero, alpha, a, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06zuc(UpperTriangle, NoTranspose, zero, m_one, alpha, a, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06zuc(UpperTriangle, Transpose, zero, m_one, alpha, a, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06zuc(LowerTriangle, NoTranspose, zero, m_one, alpha, a, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06zuc(LowerTriangle, Transpose, zero, m_one, alpha, a, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 7; f06zuc(UpperTriangle, NoTranspose, zero, two, alpha, a, one, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 7; f06zuc(UpperTriangle, Transpose, two, zero, alpha, a, one, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 7; f06zuc(LowerTriangle, NoTranspose, zero, two, alpha, a, one, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 7; f06zuc(LowerTriangle, Transpose, two, zero, alpha, a, one, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 10; f06zuc(UpperTriangle, NoTranspose, two, zero, alpha, a, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 10; f06zuc(UpperTriangle, Transpose, two, zero, alpha, a, two, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 10; f06zuc(LowerTriangle, NoTranspose, two, zero, alpha, a, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 10; f06zuc(LowerTriangle, Transpose, two, zero, alpha, a, two, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); goto L200; L160: infoc.infot = 1; f06zrc((MatrixTriangle)999, NoTranspose, zero, zero, alpha, a, one, b, one, rbeta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 2; f06zrc(UpperTriangle, Transpose, zero, zero, alpha, a, one, b, one, rbeta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06zrc(UpperTriangle, NoTranspose, m_one, zero, alpha, a, one, b, one, rbeta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06zrc(UpperTriangle, ConjugateTranspose, m_one, zero, alpha, a, one, b, one, rbeta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06zrc(LowerTriangle, NoTranspose, m_one, zero, alpha, a, one, b, one, rbeta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06zrc(LowerTriangle, ConjugateTranspose, m_one, zero, alpha, a, one, b, one, rbeta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06zrc(UpperTriangle, NoTranspose, zero, m_one, alpha, a, one, b, one, rbeta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06zrc(UpperTriangle, ConjugateTranspose, zero, m_one, alpha, a, one, b, one, rbeta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06zrc(LowerTriangle, NoTranspose, zero, m_one, alpha, a, one, b, one, rbeta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06zrc(LowerTriangle, ConjugateTranspose, zero, m_one, alpha, a, one, b, one, rbeta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 7; f06zrc(UpperTriangle, NoTranspose, zero, two, alpha, a, one, b, two, rbeta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 7; f06zrc(UpperTriangle, ConjugateTranspose, two, zero, alpha, a, one, b, two, rbeta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 7; f06zrc(LowerTriangle, NoTranspose, zero, two, alpha, a, one, b, two, rbeta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 7; f06zrc(LowerTriangle, ConjugateTranspose, two, zero, alpha, a, one, b, two, rbeta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zrc(UpperTriangle, NoTranspose, zero, two, alpha, a, two, b, one, rbeta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zrc(UpperTriangle, ConjugateTranspose, two, zero, alpha, a, two, b, one, rbeta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zrc(LowerTriangle, NoTranspose, zero, two, alpha, a, two, b, one, rbeta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zrc(LowerTriangle, ConjugateTranspose, two, zero, alpha, a, two, b, one, rbeta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 12; f06zrc(UpperTriangle, NoTranspose, two, zero, alpha, a, one, b, one, rbeta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 12; f06zrc(UpperTriangle, ConjugateTranspose, two, zero, alpha, a, two, b, two, rbeta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 12; f06zrc(LowerTriangle, NoTranspose, two, zero, alpha, a, one, b, one, rbeta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 12; f06zrc(LowerTriangle, ConjugateTranspose, two, zero, alpha, a, two, b, two, rbeta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); goto L200; L180: infoc.infot = 1; f06zwc((MatrixTriangle)999, NoTranspose, zero, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 2; f06zwc(UpperTriangle, ConjugateTranspose, zero, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06zwc(UpperTriangle, NoTranspose, m_one, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06zwc(UpperTriangle, Transpose, m_one, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06zwc(LowerTriangle, NoTranspose, m_one, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 3; f06zwc(LowerTriangle, Transpose, m_one, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06zwc(UpperTriangle, NoTranspose, zero, m_one, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06zwc(UpperTriangle, Transpose, zero, m_one, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06zwc(LowerTriangle, NoTranspose, zero, m_one, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 4; f06zwc(LowerTriangle, Transpose, zero, m_one, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 7; f06zwc(UpperTriangle, NoTranspose, zero, two, alpha, a, one, b, two, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 7; f06zwc(UpperTriangle, Transpose, two, zero, alpha, a, one, b, two, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 7; f06zwc(LowerTriangle, NoTranspose, zero, two, alpha, a, one, b, two, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 7; f06zwc(LowerTriangle, Transpose, two, zero, alpha, a, one, b, two, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zwc(UpperTriangle, NoTranspose, zero, two, alpha, a, two, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zwc(UpperTriangle, Transpose, two, zero, alpha, a, two, b, one, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zwc(LowerTriangle, NoTranspose, zero, two, alpha, a, two, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 9; f06zwc(LowerTriangle, Transpose, two, zero, alpha, a, two, b, one, beta, c, two); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 12; f06zwc(UpperTriangle, NoTranspose, two, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 12; f06zwc(UpperTriangle, Transpose, two, zero, alpha, a, two, b, two, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 12; f06zwc(LowerTriangle, NoTranspose, two, zero, alpha, a, one, b, one, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); infoc.infot = 12; f06zwc(LowerTriangle, Transpose, two, zero, alpha, a, two, b, two, beta, c, one); chkxer(srnamt, infoc.infot, &infoc.lerr, &infoc.ok); L200: if (infoc.ok) Vprintf("%.6s passed the tests of error-exits\n", srnamt); else Vprintf(" ******* %.6s failed the tests of error-exits *******\n", srnamt); } /* cchke */ /* ---------------------------------------------------------------- */ static void cmake(const char type[], char uplo, char diag, Integer m, Integer n, Complex a[], Integer nmax, Complex aa[], Integer tda, int *reset, Complex transl) { /* Local variables */ Integer ibeg, iend; int unit; Integer i, j; int lower, upper; Integer jj; int gen, her, tri, sym; /* * Generates values for an M by N matrix A. * Stores the values in the array AA in the data structure required * by the routine, with unwanted elements set to rogue value. * type is 'ge', 'he', 'sy' or 'tr'. */ /* Parameter adjustments */ #define AA(I) aa[(I)-1] /* Function Body */ gen = ! strncmp(type, "ge", 2); her = ! strncmp(type, "he", 2); sym = ! strncmp(type, "sy", 2); tri = ! strncmp(type, "tr", 2); upper = (her || sym || tri) && uplo == 'u'; lower = (her || sym || tri) && uplo == 'l'; unit = tri && diag == 'u'; /* Generate data in array A. */ for (j = 1; j <= n; ++j) { for (i = 1; i <= m; ++i) { if (gen || (upper && i <= j) || (lower && i >= j)) { a[i-1+(j-1)*nmax] = a02cac(cbeg(reset), transl); if (i != j) { /* Set some elements to zero */ if (n > 3 && j == n / 2) a[ i-1+(j-1)*nmax] = cmplx_0_0; if (her) a[j-1+(i-1)*nmax] = a02cfc(a[i-1+(j-1)*nmax]); else if (sym) a[ j-1+(i-1)*nmax] = a[ i-1+(j-1)*nmax]; else if (tri) a[ j-1+(i-1)*nmax] = cmplx_0_0; } } } if (her) a[ j-1+(j-1)*nmax] = a02bac(a02bbc(a[j-1+(j-1)*nmax]), 0.0); if (tri) a[ j-1+(j-1)*nmax] = a02cac(a[ j-1+(j-1)*nmax], cmplx_1_0); if (unit) a[ j-1+(j-1)*nmax] = cmplx_1_0; } /* Store elements in array AS in data structure required by routine. */ if (! strncmp(type, "ge", 2)) { for (j = 1; j <= n; ++j) { for (i = 1; i <= m; ++i) aa[ i-1 + (j - 1) * tda] = a[ i-1+(j-1)*nmax]; for (i = m + 1; i <= tda; ++i) aa[ i-1 + (j - 1) * tda] = rogue; } } else if (! strncmp(type, "he", 2) || ! strncmp(type, "sy", 2) || ! strncmp(type, "tr", 2)) { for (j = 1; j <= n; ++j) { if (upper) { ibeg = 1; if (unit) iend = j - 1; else iend = j; } else { if (unit) ibeg = j + 1; else ibeg = j; iend = n; } for (i = 1; i <= ibeg - 1; ++i) AA( i + (j - 1) * tda) = rogue; for (i = ibeg; i <= iend; ++i) aa[ i-1 + (j - 1) * tda] = a[ i-1+(j-1)*nmax]; for (i = iend + 1; i <= tda; ++i) aa[ i-1 + (j - 1) * tda] = rogue; if (her) { jj = j + (j - 1) * tda; AA(jj) = a02bac(a02bbc(AA(jj)), a02bbc(rogue)); } } } } /* cmake */ /* ------------------------------------------------------------------ */ static void cmmch(char transa, char transb, Integer m, Integer n, Integer kk, Complex alpha, Complex a[], Integer tda, Complex b[], Integer tdb, Complex beta, Complex c[], Integer tdc, Complex ct[], double g[], Complex cc[], Integer tdcc, double eps, double *err, int *fatal, int mv) { #define FABS1(CL) FABS(a02bbc(CL)) + FABS(a02bcc(CL)) /* Local variables */ double erri; Integer i, j, k; int trana, tranb, ctrana, ctranb; /* Checks the results of the computational tests. */ /* Parameter adjustments */ #define G(I) g[(I)-1] #define CT(I) ct[(I)-1] /* Function Body */ trana = transa == 't' || transa == 'c'; tranb = transb == 't' || transb == 'c'; ctrana = transa == 'c'; ctranb = transb == 'c'; /* Compute expected result, one column at a time, in CT using data */ /* in A, B and C. */ /* Compute gauges in G. */ for (j = 1; j <= n; ++j) { for (i = 1; i <= m; ++i) { CT( i) = cmplx_0_0; G(i) = 0.0; } if (! trana && ! tranb) { for (k = 1; k <= kk; ++k) { for (i = 1; i <= m; ++i) { CT(i) = a02cac(CT(i), a02ccc(a[i-1+(k-1)*tda], b[k-1+(j-1)*tdb])); G(i) += (FABS1(a[i-1+(k-1)*tda]))* (FABS1(b[k-1+(j-1)*tdb])); } } } else if (trana && ! tranb) { if (ctrana) { for (k = 1; k <= kk; ++k) { for (i = 1; i <= m; ++i) { CT(i) = a02cac(CT(i), a02ccc(a02cfc(a[k-1+(i-1)*tda]), b[k-1+(j-1)*tdb])); G(i) += (FABS1(a[k-1+(i-1)*tda]))* (FABS1(b[k-1+(j-1)*tdb])); } } } else { for (k = 1; k <= kk; ++k) { for (i = 1; i <= m; ++i) { CT(i) = a02cac(CT(i), a02ccc(a[k-1+(i-1)*tda], b[k-1+(j-1)*tdb])); G(i) += (FABS1(a[k-1+(i-1)*tda]))* (FABS1(b[k-1+(j-1)*tdb])); } } } } else if (! trana && tranb) { if (ctranb) { for (k = 1; k <= kk; ++k) { for (i = 1; i <= m; ++i) { CT(i) = a02cac(CT(i), a02ccc(a[i-1+(k-1)*tda], a02cfc(b[j-1+(k-1)*tdb]))); G(i) += (FABS1(a[i-1+(k-1)*tda]))*(FABS1(b[j-1+(k-1)*tdb])); } } } else { for (k = 1; k <= kk; ++k) { for (i = 1; i <= m; ++i) { CT(i) = a02cac(CT(i), a02ccc(a[i-1+(k-1)*tda], b[j-1+(k-1)*tdb])); G(i) += (FABS1(a[i-1+(k-1)*tda]))*(FABS1(b[j-1+(k-1)*tdb])); } } } } else if (trana && tranb) { if (ctrana) { if (ctranb) { for (k = 1; k <= kk; ++k) { for (i = 1; i <= m; ++i) { CT(i) = a02cac(CT(i), a02ccc(a02cfc(a[k-1+(i-1)*tda]), a02cfc(b[j-1+(k-1)*tdb]))); G(i) += (FABS1(a[k-1+(i-1)*tda]))* (FABS1(b[j-1+(k-1)*tdb])); } } } else { for (k = 1; k <= kk; ++k) { for (i = 1; i <= m; ++i) { CT(i) = a02cac(CT(i), a02ccc(a02cfc(a[k-1+(i-1)*tda]), b[j-1+(k-1)*tdb])); G(i) += (FABS1(a[k-1+(i-1)*tda]))* (FABS1(b[j-1+(k-1)*tdb])); } } } } else { if (ctranb) { for (k = 1; k <= kk; ++k) { for (i = 1; i <= m; ++i) { CT(i) = a02cac(CT(i), a02ccc(a[k-1+(i-1)*tda], a02cfc(b[j-1+(k-1)*tdb]))); G(i) += (FABS1(a[k-1+(i-1)*tda]))* (FABS1(b[j-1+(k-1)*tdb])); } } } else { for (k = 1; k <= kk; ++k) { for (i = 1; i <= m; ++i) { CT(i) = a02cac(CT(i), a02ccc(a[k-1+(i-1)*tda], b[j-1+(k-1)*tdb])); G(i) += (FABS1(a[k-1+(i-1)*tda]))* (FABS1(b[j-1+(k-1)*tdb])); } } } } } for (i = 1; i <= m; ++i) { CT(i) = a02cac(a02ccc(CT(i), alpha), a02ccc(beta, c[i-1+(j-1)*tdc])); G(i) = (FABS1(alpha))*G(i) + (FABS1(beta))* (FABS1(c[i-1+(j-1)*tdc])); } /* Compute the error ratio for this result. */ *err = 0.0; for (i = 1; i <= m; ++i) { erri = (FABS1(a02cbc(CT(i), cc[i-1+(j-1)*tdcc]))) / eps; if (G(i) != 0.0) erri /= G(i); *err = MAX(*err,erri); if (*err * sqrt(eps) >= 1.0) goto L460; } } /* If the loop completes, all results are at least half accurate. */ goto L500; /* Report fatal error. */ L460: *fatal = TRUE; Vprintf(" ******* Fatal error - computed result is less than " "half accurate *******\n Expected result " " Computed result\n"); for (i = 1; i <= m; ++i) { if (mv) { Vprintf("%4ld (%15.6g,%15.6g) (%15.6g,%15.6g)\n",i, CT(i).re, CT(i).im, CC(i-1+(j-1)*tdcc).re, CC(i-1+(j-1)*tdcc).im); } else { Vprintf("%4ld (%15.6g,%15.6g) (%15.6g,%15.6g)\n",i, CC(i-1+(j-1)*tdcc).re, CC(i-1+(j-1)*tdcc).im, CT(i).re, CT(i).im); } } if (n > 1) Vprintf(" These are the results for column %3ld.\n", j); L500: ; } /* cmmch */ /* ------------------------------------------------------------------- */ static int lce(Complex ri[], Complex rj[], Integer lr) { /* System generated locals */ int ret_val; /* Local variables */ Integer i; /* Tests if two arrays are identical. */ /* Parameter adjustments */ #define RJ(I) rj[(I)-1] #define RI(I) ri[(I)-1] /* Function Body */ for (i = 1; i <= lr; ++i) { if (RI( i).re != RJ( i).re || RI( i).im != RJ( i).im) goto L40; } ret_val = TRUE; goto L60; L40: ret_val = FALSE; L60: return ret_val; } /* lce */ /* ------------------------------------------------------------------- */ static int lceres(const char type[], char uplo, Integer m, Integer n, Complex aa[], Complex as[], Integer tda) { /* System generated locals */ int ret_val; /* Local variables */ Integer ibeg, iend, i, j; int upper; /* * Tests if selected elements in two arrays are equal. * type is 'ge' or 'he' or 'sy'. */ /* Function Body */ upper = uplo == 'u'; if (! strncmp(type, "ge", 2)) { for (j = 1; j <= n; ++j) { for (i = m + 1; i <= tda; ++i) { if (aa[i-1+(j-1)*tda].re != as[i-1+(j-1)*tda].re || aa[i-1+(j-1)*tda].im != as[i-1+(j-1)*tda].im) goto L140; } } } else if (! strncmp(type, "he", 2) || ! strncmp(type, "sy", 2)) { for (j = 1; j <= n; ++j) { if (upper) { ibeg = 1; iend = j; } else { ibeg = j; iend = n; } for (i = 1; i <= ibeg - 1; ++i) { if (aa[i-1+(j-1)*tda].re != as[i-1+(j-1)*tda].re || aa[i-1+(j-1)*tda].im != as[i-1+(j-1)*tda].im) goto L140; } for (i = iend + 1; i <= tda; ++i) { if (aa[i-1+(j-1)*tda].re != as[i-1+(j-1)*tda].re || aa[i-1+(j-1)*tda].im != as[i-1+(j-1)*tda].im) goto L140; } } } ret_val = TRUE; goto L160; L140: ret_val = FALSE; L160: return ret_val; } /* lceres */ /* ---------------------------------------------------------------------- */ static Complex cbeg(int *reset) { /* Local variables */ static Integer i, j, ic, mi, mj; /* * Generates complex numbers as pairs of random numbers uniformly * distributed between -0.5 and 0.5. * Auxiliary routine for test program for Level 3 Blas. */ /* .. Executable Statements .. */ if (*reset) { /* Initialize local variables. */ mi = 891; mj = 457; i = 7; j = 7; ic = 0; *reset = FALSE; } /* * The sequence of values of I or J is bounded between 1 and 999. * If initial I or J = 1,2,3,6,7 or 9, the period will be 50. * If initial I or J = 4 or 8, the period will be 25. * If initial I or J = 5, the period will be 10. * IC is used to break up the period by skipping 1 value of I or J * in 6. */ ++ic; L20: i *= mi; j *= mj; i -= i / 1000 * 1000; j -= j / 1000 * 1000; if (ic >= 5) { ic = 0; goto L20; } return a02bac((i-500)/1001.0, (j-500)/1001.0); } /* cbeg */ /* ---------------------------------------------------------------- */ static void chkxer(const char srnamt[], Integer infot, int *lerr, int *ok) { /* Tests whether f06aaz has detected an error when it should. */ /* Auxiliary routine for test program for Level 3 Blas. */ if (! (*lerr)) { Vprintf("***** Illegal value of parameter number %1ld," "not detected by %6s *****\n", infot, srnamt); *ok = FALSE; } *lerr = FALSE; } /* chkxer */ /* -------------------------------------------------------------------- */ void f06aaz(const char srname[], Integer info) { /* * This is a special version of F06AAZ to be used only as part of * the test program for testing error exits from the Level 2 BLAS * routines. * F06AAZ is an error handler for the Level 2 BLAS routines. * It is called by the Level 2 BLAS routines if an input parameter is * invalid. */ infoc.lerr = TRUE; if (info != infoc.infot) { if (infoc.infot != 0) { Vprintf(" ******* f06aaz was called with info = %6ld " "instead of %2ld\n",info, infoc.infot); } else Vprintf("f06aaz was called with info = %6ld\n", info); infoc.ok = FALSE; } if (strncmp(srname, srnamc.srnamt, 6)) { Vprintf("f06aaz was called with srname %s instead of %s\n", srname, srnamc.srnamt); } } /* f06aaz_d.c * * Mark 7 Release. Copyright 2002 Numerical Algorithms Group. * * Modified for example program: * infoc.lerr = TRUE; * * NAG C Library * * Purpose * ======= * * f06aaz_d interprets an error from an f16 call in the manner * of the f06aaz handler. * */ #include #include #include #include void f06aaz_d(const char *srname, NagError *fail_f16) { char buf[NAG_ERROR_BUF_LEN]; infoc.lerr = TRUE; /* fail_f16->print = TRUE; */ Vsprintf(buf, nag_errlist[NE_F06_BAD_PARAM], - (1 + fail_f16->iflag)); p01acc(buf, NE_F06_BAD_PARAM, srname, fail_f16); return; }