int mad_cmat_divm (const cnum_t x[], const num_t y[], cnum_t r[], ssz_t m, ssz_t n, ssz_t p, num_t rcond) { CHKXYR; int info=0; const int nm=m, nn=n, np=p; mad_alloc_tmp(cnum_t, a, n*p); mad_vec_copyv(y, a, n*p); // square system (y is square, n == p), use LU decomposition if (n == p) { int ipiv[n]; mad_cvec_copy(x, r, m*p); zgesv_(&np, &nm, a, &np, ipiv, r, &np, &info); if (!info) return mad_free_tmp(a), n; } // non-square system or singular square system, use QR or LQ factorization cnum_t sz; num_t rwk[2*nn]; int rank, ldb=MAX(nn,np), lwork=-1; // query for optimal size int JPVT[nn]; memset(JPVT, 0, sizeof JPVT); mad_alloc_tmp(cnum_t, rr, ldb*nm); mad_cmat_copy(x, rr, m, p, p, ldb); // input strided copy [M x NRHS] zgelsy_(&np, &nn, &nm, a, &np, rr, &ldb, JPVT, &rcond, &rank, &sz, &lwork, rwk, &info); // query mad_alloc_tmp(cnum_t, wk, lwork=creal(sz)); zgelsy_(&np, &nn, &nm, a, &np, rr, &ldb, JPVT, &rcond, &rank, wk, &lwork, rwk, &info); // compute mad_cmat_copy(rr, r, m, n, ldb, n); // output strided copy [N x NRHS] mad_free_tmp(wk); mad_free_tmp(rr); mad_free_tmp(a); if (info < 0) error("invalid input argument"); if (info > 0) error("unexpect lapack error"); return rank; }
void LaLinearSolveComplex(int hn, std::complex<double> * A, std::complex<double> * F) { // Solve Ax=F // A on exit LU factorization // F is overwritten by solution x integer n = hn; integer nrhs =1; integer *ipiv; ipiv = new integer[n]; integer info; zgesv_(&n, &nrhs, A, &n, ipiv, F, &n, &info ); if(info!=0) cout << " ***** Error in LapackGEP.cpp LaLinearSolveComplex : info = " << info << endl; delete[] ipiv; return; }
/* ----------------------------------------------------------------------| */ /* Subroutine */ int zgpadm_(integer *ideg, integer *m, doublereal *t, doublecomplex *h__, integer *ldh, doublecomplex *wsp, integer *lwsp, integer *ipiv, integer *iexph, integer *ns, integer *iflag) { /* System generated locals */ integer h_dim1, h_offset, i__1, i__2, i__3, i__4; doublereal d__1, d__2; doublecomplex z__1, z__2; /* Builtin functions */ /* Subroutine */ int s_stop(char *, ftnlen); double z_abs(doublecomplex *), log(doublereal); integer pow_ii(integer *, integer *); /* Local variables */ static integer i__, j, k; static doublecomplex cp, cq; static integer ip, mm, iq, ih2, iodd, iget, iput, icoef; static doublecomplex scale; static integer ifree, iused; extern /* Subroutine */ int zgemm_(char *, char *, integer *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, ftnlen, ftnlen); static doublereal hnorm; extern /* Subroutine */ int zgesv_(integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *); static doublecomplex scale2; extern /* Subroutine */ int zaxpy_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), zdscal_( integer *, doublereal *, doublecomplex *, integer *); /* -----Purpose----------------------------------------------------------| */ /* Computes exp(t*H), the matrix exponential of a general complex */ /* matrix in full, using the irreducible rational Pade approximation */ /* to the exponential exp(z) = r(z) = (+/-)( I + 2*(q(z)/p(z)) ), */ /* combined with scaling-and-squaring. */ /* -----Arguments--------------------------------------------------------| */ /* ideg : (input) the degre of the diagonal Pade to be used. */ /* a value of 6 is generally satisfactory. */ /* m : (input) order of H. */ /* H(ldh,m) : (input) argument matrix. */ /* t : (input) time-scale (can be < 0). */ /* wsp(lwsp) : (workspace/output) lwsp .ge. 4*m*m+ideg+1. */ /* ipiv(m) : (workspace) */ /* >>>> iexph : (output) number such that wsp(iexph) points to exp(tH) */ /* i.e., exp(tH) is located at wsp(iexph ... iexph+m*m-1) */ /* ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ */ /* NOTE: if the routine was called with wsp(iptr), */ /* then exp(tH) will start at wsp(iptr+iexph-1). */ /* ns : (output) number of scaling-squaring used. */ /* iflag : (output) exit flag. */ /* 0 - no problem */ /* <0 - problem */ /* ----------------------------------------------------------------------| */ /* Roger B. Sidje ([email protected]) */ /* EXPOKIT: Software Package for Computing Matrix Exponentials. */ /* ACM - Transactions On Mathematical Software, 24(1):130-156, 1998 */ /* ----------------------------------------------------------------------| */ /* --- check restrictions on input parameters ... */ /* Parameter adjustments */ --ipiv; h_dim1 = *ldh; h_offset = 1 + h_dim1; h__ -= h_offset; --wsp; /* Function Body */ mm = *m * *m; *iflag = 0; if (*ldh < *m) { *iflag = -1; } if (*lwsp < (mm << 2) + *ideg + 1) { *iflag = -2; } if (*iflag != 0) { s_stop("bad sizes (in input of ZGPADM)", (ftnlen)30); } /* --- initialise pointers ... */ icoef = 1; ih2 = icoef + (*ideg + 1); ip = ih2 + mm; iq = ip + mm; ifree = iq + mm; /* --- scaling: seek ns such that ||t*H/2^ns|| < 1/2; */ /* and set scale = t/2^ns ... */ i__1 = *m; for (i__ = 1; i__ <= i__1; ++i__) { i__2 = i__; wsp[i__2].r = 0., wsp[i__2].i = 0.; } i__1 = *m; for (j = 1; j <= i__1; ++j) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { i__3 = i__; i__4 = i__; d__1 = z_abs(&h__[i__ + j * h_dim1]); z__1.r = wsp[i__4].r + d__1, z__1.i = wsp[i__4].i; wsp[i__3].r = z__1.r, wsp[i__3].i = z__1.i; } } hnorm = 0.; i__1 = *m; for (i__ = 1; i__ <= i__1; ++i__) { /* Computing MAX */ i__2 = i__; d__1 = hnorm, d__2 = wsp[i__2].r; hnorm = max(d__1,d__2); } hnorm = (d__1 = *t * hnorm, abs(d__1)); if (hnorm == 0.) { s_stop("Error - null H in input of ZGPADM.", (ftnlen)34); } /* Computing MAX */ i__1 = 0, i__2 = (integer) (log(hnorm) / log(2.)) + 2; *ns = max(i__1,i__2); d__1 = *t / (doublereal) pow_ii(&c__2, ns); z__1.r = d__1, z__1.i = 0.; scale.r = z__1.r, scale.i = z__1.i; z__1.r = scale.r * scale.r - scale.i * scale.i, z__1.i = scale.r * scale.i + scale.i * scale.r; scale2.r = z__1.r, scale2.i = z__1.i; /* --- compute Pade coefficients ... */ i__ = *ideg + 1; j = (*ideg << 1) + 1; i__1 = icoef; wsp[i__1].r = 1., wsp[i__1].i = 0.; i__1 = *ideg; for (k = 1; k <= i__1; ++k) { i__2 = icoef + k; i__3 = icoef + k - 1; d__1 = (doublereal) (i__ - k); z__2.r = d__1 * wsp[i__3].r, z__2.i = d__1 * wsp[i__3].i; d__2 = (doublereal) (k * (j - k)); z__1.r = z__2.r / d__2, z__1.i = z__2.i / d__2; wsp[i__2].r = z__1.r, wsp[i__2].i = z__1.i; } /* --- H2 = scale2*H*H ... */ zgemm_("n", "n", m, m, m, &scale2, &h__[h_offset], ldh, &h__[h_offset], ldh, &c_b1, &wsp[ih2], m, (ftnlen)1, (ftnlen)1); /* --- initialise p (numerator) and q (denominator) ... */ i__1 = icoef + *ideg - 1; cp.r = wsp[i__1].r, cp.i = wsp[i__1].i; i__1 = icoef + *ideg; cq.r = wsp[i__1].r, cq.i = wsp[i__1].i; i__1 = *m; for (j = 1; j <= i__1; ++j) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { i__3 = ip + (j - 1) * *m + i__ - 1; wsp[i__3].r = 0., wsp[i__3].i = 0.; i__3 = iq + (j - 1) * *m + i__ - 1; wsp[i__3].r = 0., wsp[i__3].i = 0.; } i__2 = ip + (j - 1) * (*m + 1); wsp[i__2].r = cp.r, wsp[i__2].i = cp.i; i__2 = iq + (j - 1) * (*m + 1); wsp[i__2].r = cq.r, wsp[i__2].i = cq.i; } /* --- Apply Horner rule ... */ iodd = 1; k = *ideg - 1; L100: iused = iodd * iq + (1 - iodd) * ip; zgemm_("n", "n", m, m, m, &c_b2, &wsp[iused], m, &wsp[ih2], m, &c_b1, & wsp[ifree], m, (ftnlen)1, (ftnlen)1); i__1 = *m; for (j = 1; j <= i__1; ++j) { i__2 = ifree + (j - 1) * (*m + 1); i__3 = ifree + (j - 1) * (*m + 1); i__4 = icoef + k - 1; z__1.r = wsp[i__3].r + wsp[i__4].r, z__1.i = wsp[i__3].i + wsp[i__4] .i; wsp[i__2].r = z__1.r, wsp[i__2].i = z__1.i; } ip = (1 - iodd) * ifree + iodd * ip; iq = iodd * ifree + (1 - iodd) * iq; ifree = iused; iodd = 1 - iodd; --k; if (k > 0) { goto L100; } /* --- Obtain (+/-)(I + 2*(p\q)) ... */ if (iodd != 0) { zgemm_("n", "n", m, m, m, &scale, &wsp[iq], m, &h__[h_offset], ldh, & c_b1, &wsp[ifree], m, (ftnlen)1, (ftnlen)1); iq = ifree; } else { zgemm_("n", "n", m, m, m, &scale, &wsp[ip], m, &h__[h_offset], ldh, & c_b1, &wsp[ifree], m, (ftnlen)1, (ftnlen)1); ip = ifree; } z__1.r = -1., z__1.i = -0.; zaxpy_(&mm, &z__1, &wsp[ip], &c__1, &wsp[iq], &c__1); zgesv_(m, m, &wsp[iq], m, &ipiv[1], &wsp[ip], m, iflag); if (*iflag != 0) { s_stop("Problem in ZGESV (within ZGPADM)", (ftnlen)32); } zdscal_(&mm, &c_b19, &wsp[ip], &c__1); i__1 = *m; for (j = 1; j <= i__1; ++j) { i__2 = ip + (j - 1) * (*m + 1); i__3 = ip + (j - 1) * (*m + 1); z__1.r = wsp[i__3].r + 1., z__1.i = wsp[i__3].i + 0.; wsp[i__2].r = z__1.r, wsp[i__2].i = z__1.i; } iput = ip; if (*ns == 0 && iodd != 0) { zdscal_(&mm, &c_b21, &wsp[ip], &c__1); goto L200; } /* -- squaring : exp(t*H) = (exp(t*H))^(2^ns) ... */ iodd = 1; i__1 = *ns; for (k = 1; k <= i__1; ++k) { iget = iodd * ip + (1 - iodd) * iq; iput = (1 - iodd) * ip + iodd * iq; zgemm_("n", "n", m, m, m, &c_b2, &wsp[iget], m, &wsp[iget], m, &c_b1, &wsp[iput], m, (ftnlen)1, (ftnlen)1); iodd = 1 - iodd; } L200: *iexph = iput; return 0; } /* zgpadm_ */
/* Subroutine */ int zerrvx_(char *path, integer *nunit) { /* Format strings */ static char fmt_9999[] = "(1x,a3,\002 drivers passed the tests of the er" "ror exits\002)"; static char fmt_9998[] = "(\002 *** \002,a3,\002 drivers failed the test" "s of the error \002,\002exits ***\002)"; /* System generated locals */ integer i__1; doublereal d__1, d__2; doublecomplex z__1; /* Builtin functions */ integer s_wsle(cilist *), e_wsle(void); /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void); /* Local variables */ doublecomplex a[16] /* was [4][4] */, b[4]; doublereal c__[4]; integer i__, j; doublereal r__[4]; doublecomplex w[8], x[4]; char c2[2]; doublereal r1[4], r2[4]; doublecomplex af[16] /* was [4][4] */; char eq[1]; doublereal rf[4]; integer ip[4]; doublereal rw[4]; integer info; doublereal rcond; extern /* Subroutine */ int zgbsv_(integer *, integer *, integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *), zgesv_(integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *), zhesv_(char *, integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, doublecomplex * , integer *, integer *), zpbsv_(char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *), zhpsv_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *), zgtsv_(integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, integer *), zposv_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *), zppsv_( char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, integer *), zspsv_(char *, integer *, integer * , doublecomplex *, integer *, doublecomplex *, integer *, integer *), zptsv_(integer *, integer *, doublereal *, doublecomplex *, doublecomplex *, integer *, integer *), zsysv_( char *, integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); extern logical lsamen_(integer *, char *, char *); extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical *, logical *), zgbsvx_(char *, char *, integer *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, char *, doublereal *, doublereal *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublereal *, doublecomplex *, doublereal *, integer *), zgesvx_(char *, char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, char *, doublereal *, doublereal *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublereal *, doublecomplex *, doublereal *, integer *), zhesvx_(char *, char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublereal *, doublecomplex *, integer *, doublereal *, integer *), zpbsvx_(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, char *, doublereal *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublereal *, doublecomplex *, doublereal *, integer *), zhpsvx_(char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublereal *, doublecomplex *, doublereal *, integer *), zgtsvx_(char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex * , doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublereal *, doublecomplex *, doublereal *, integer *), zposvx_(char *, char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, char *, doublereal *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublereal *, doublecomplex *, doublereal *, integer *), zppsvx_(char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, char *, doublereal *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublereal *, doublecomplex *, doublereal *, integer *), zspsvx_(char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublereal *, doublecomplex *, doublereal *, integer *), zptsvx_(char *, integer *, integer *, doublereal *, doublecomplex *, doublereal *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublereal *, doublecomplex *, doublereal *, integer *), zsysvx_(char *, char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal * , doublereal *, doublecomplex *, integer *, doublereal *, integer *); /* Fortran I/O blocks */ static cilist io___1 = { 0, 0, 0, 0, 0 }; static cilist io___20 = { 0, 0, 0, fmt_9999, 0 }; static cilist io___21 = { 0, 0, 0, fmt_9998, 0 }; /* -- LAPACK test routine (version 3.1.1) -- */ /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ /* January 2007 */ /* .. Scalar Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* ZERRVX tests the error exits for the COMPLEX*16 driver routines */ /* for solving linear systems of equations. */ /* Arguments */ /* ========= */ /* PATH (input) CHARACTER*3 */ /* The LAPACK path name for the routines to be tested. */ /* NUNIT (input) INTEGER */ /* The unit number for output. */ /* ===================================================================== */ /* .. Parameters .. */ /* .. */ /* .. Local Scalars .. */ /* .. */ /* .. Local Arrays .. */ /* .. */ /* .. External Functions .. */ /* .. */ /* .. External Subroutines .. */ /* .. */ /* .. Scalars in Common .. */ /* .. */ /* .. Common blocks .. */ /* .. */ /* .. Intrinsic Functions .. */ /* .. */ /* .. Executable Statements .. */ infoc_1.nout = *nunit; io___1.ciunit = infoc_1.nout; s_wsle(&io___1); e_wsle(); s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2); /* Set the variables to innocuous values. */ for (j = 1; j <= 4; ++j) { for (i__ = 1; i__ <= 4; ++i__) { i__1 = i__ + (j << 2) - 5; d__1 = 1. / (doublereal) (i__ + j); d__2 = -1. / (doublereal) (i__ + j); z__1.r = d__1, z__1.i = d__2; a[i__1].r = z__1.r, a[i__1].i = z__1.i; i__1 = i__ + (j << 2) - 5; d__1 = 1. / (doublereal) (i__ + j); d__2 = -1. / (doublereal) (i__ + j); z__1.r = d__1, z__1.i = d__2; af[i__1].r = z__1.r, af[i__1].i = z__1.i; /* L10: */ } i__1 = j - 1; b[i__1].r = 0., b[i__1].i = 0.; r1[j - 1] = 0.; r2[j - 1] = 0.; i__1 = j - 1; w[i__1].r = 0., w[i__1].i = 0.; i__1 = j - 1; x[i__1].r = 0., x[i__1].i = 0.; c__[j - 1] = 0.; r__[j - 1] = 0.; ip[j - 1] = j; /* L20: */ } *(unsigned char *)eq = ' '; infoc_1.ok = TRUE_; if (lsamen_(&c__2, c2, "GE")) { /* ZGESV */ s_copy(srnamc_1.srnamt, "ZGESV ", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zgesv_(&c_n1, &c__0, a, &c__1, ip, b, &c__1, &info); chkxer_("ZGESV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgesv_(&c__0, &c_n1, a, &c__1, ip, b, &c__1, &info); chkxer_("ZGESV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zgesv_(&c__2, &c__1, a, &c__1, ip, b, &c__2, &info); chkxer_("ZGESV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zgesv_(&c__2, &c__1, a, &c__2, ip, b, &c__1, &info); chkxer_("ZGESV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZGESVX */ s_copy(srnamc_1.srnamt, "ZGESVX", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zgesvx_("/", "N", &c__0, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgesvx_("N", "/", &c__0, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zgesvx_("N", "N", &c_n1, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zgesvx_("N", "N", &c__0, &c_n1, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; zgesvx_("N", "N", &c__2, &c__1, a, &c__1, af, &c__2, ip, eq, r__, c__, b, &c__2, x, &c__2, &rcond, r1, r2, w, rw, &info); chkxer_("ZGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; zgesvx_("N", "N", &c__2, &c__1, a, &c__2, af, &c__1, ip, eq, r__, c__, b, &c__2, x, &c__2, &rcond, r1, r2, w, rw, &info); chkxer_("ZGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; *(unsigned char *)eq = '/'; zgesvx_("F", "N", &c__0, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; *(unsigned char *)eq = 'R'; zgesvx_("F", "N", &c__1, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; *(unsigned char *)eq = 'C'; zgesvx_("F", "N", &c__1, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 14; zgesvx_("N", "N", &c__2, &c__1, a, &c__2, af, &c__2, ip, eq, r__, c__, b, &c__1, x, &c__2, &rcond, r1, r2, w, rw, &info); chkxer_("ZGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 16; zgesvx_("N", "N", &c__2, &c__1, a, &c__2, af, &c__2, ip, eq, r__, c__, b, &c__2, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZGESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } else if (lsamen_(&c__2, c2, "GB")) { /* ZGBSV */ s_copy(srnamc_1.srnamt, "ZGBSV ", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zgbsv_(&c_n1, &c__0, &c__0, &c__0, a, &c__1, ip, b, &c__1, &info); chkxer_("ZGBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgbsv_(&c__1, &c_n1, &c__0, &c__0, a, &c__1, ip, b, &c__1, &info); chkxer_("ZGBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zgbsv_(&c__1, &c__0, &c_n1, &c__0, a, &c__1, ip, b, &c__1, &info); chkxer_("ZGBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zgbsv_(&c__0, &c__0, &c__0, &c_n1, a, &c__1, ip, b, &c__1, &info); chkxer_("ZGBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; zgbsv_(&c__1, &c__1, &c__1, &c__0, a, &c__3, ip, b, &c__1, &info); chkxer_("ZGBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; zgbsv_(&c__2, &c__0, &c__0, &c__0, a, &c__1, ip, b, &c__1, &info); chkxer_("ZGBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZGBSVX */ s_copy(srnamc_1.srnamt, "ZGBSVX", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zgbsvx_("/", "N", &c__0, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, & info); chkxer_("ZGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgbsvx_("N", "/", &c__0, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, & info); chkxer_("ZGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zgbsvx_("N", "N", &c_n1, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, & info); chkxer_("ZGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zgbsvx_("N", "N", &c__1, &c_n1, &c__0, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, & info); chkxer_("ZGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zgbsvx_("N", "N", &c__1, &c__0, &c_n1, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, & info); chkxer_("ZGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; zgbsvx_("N", "N", &c__0, &c__0, &c__0, &c_n1, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, & info); chkxer_("ZGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; zgbsvx_("N", "N", &c__1, &c__1, &c__1, &c__0, a, &c__2, af, &c__4, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, & info); chkxer_("ZGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; zgbsvx_("N", "N", &c__1, &c__1, &c__1, &c__0, a, &c__3, af, &c__3, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, & info); chkxer_("ZGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; *(unsigned char *)eq = '/'; zgbsvx_("F", "N", &c__0, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, & info); chkxer_("ZGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; *(unsigned char *)eq = 'R'; zgbsvx_("F", "N", &c__1, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, & info); chkxer_("ZGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 14; *(unsigned char *)eq = 'C'; zgbsvx_("F", "N", &c__1, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, & info); chkxer_("ZGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 16; zgbsvx_("N", "N", &c__2, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__1, x, &c__2, &rcond, r1, r2, w, rw, & info); chkxer_("ZGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 18; zgbsvx_("N", "N", &c__2, &c__0, &c__0, &c__0, a, &c__1, af, &c__1, ip, eq, r__, c__, b, &c__2, x, &c__1, &rcond, r1, r2, w, rw, & info); chkxer_("ZGBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } else if (lsamen_(&c__2, c2, "GT")) { /* ZGTSV */ s_copy(srnamc_1.srnamt, "ZGTSV ", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zgtsv_(&c_n1, &c__0, a, &a[4], &a[8], b, &c__1, &info); chkxer_("ZGTSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgtsv_(&c__0, &c_n1, a, &a[4], &a[8], b, &c__1, &info); chkxer_("ZGTSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zgtsv_(&c__2, &c__0, a, &a[4], &a[8], b, &c__1, &info); chkxer_("ZGTSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZGTSVX */ s_copy(srnamc_1.srnamt, "ZGTSVX", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zgtsvx_("/", "N", &c__0, &c__0, a, &a[4], &a[8], af, &af[4], &af[8], & af[12], ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZGTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zgtsvx_("N", "/", &c__0, &c__0, a, &a[4], &a[8], af, &af[4], &af[8], & af[12], ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZGTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zgtsvx_("N", "N", &c_n1, &c__0, a, &a[4], &a[8], af, &af[4], &af[8], & af[12], ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZGTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zgtsvx_("N", "N", &c__0, &c_n1, a, &a[4], &a[8], af, &af[4], &af[8], & af[12], ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZGTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 14; zgtsvx_("N", "N", &c__2, &c__0, a, &a[4], &a[8], af, &af[4], &af[8], & af[12], ip, b, &c__1, x, &c__2, &rcond, r1, r2, w, rw, &info); chkxer_("ZGTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 16; zgtsvx_("N", "N", &c__2, &c__0, a, &a[4], &a[8], af, &af[4], &af[8], & af[12], ip, b, &c__2, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZGTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } else if (lsamen_(&c__2, c2, "PO")) { /* ZPOSV */ s_copy(srnamc_1.srnamt, "ZPOSV ", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zposv_("/", &c__0, &c__0, a, &c__1, b, &c__1, &info); chkxer_("ZPOSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zposv_("U", &c_n1, &c__0, a, &c__1, b, &c__1, &info); chkxer_("ZPOSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zposv_("U", &c__0, &c_n1, a, &c__1, b, &c__1, &info); chkxer_("ZPOSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zposv_("U", &c__2, &c__0, a, &c__1, b, &c__2, &info); chkxer_("ZPOSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zposv_("U", &c__2, &c__0, a, &c__2, b, &c__1, &info); chkxer_("ZPOSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZPOSVX */ s_copy(srnamc_1.srnamt, "ZPOSVX", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zposvx_("/", "U", &c__0, &c__0, a, &c__1, af, &c__1, eq, c__, b, & c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZPOSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zposvx_("N", "/", &c__0, &c__0, a, &c__1, af, &c__1, eq, c__, b, & c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZPOSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zposvx_("N", "U", &c_n1, &c__0, a, &c__1, af, &c__1, eq, c__, b, & c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZPOSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zposvx_("N", "U", &c__0, &c_n1, a, &c__1, af, &c__1, eq, c__, b, & c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZPOSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; zposvx_("N", "U", &c__2, &c__0, a, &c__1, af, &c__2, eq, c__, b, & c__2, x, &c__2, &rcond, r1, r2, w, rw, &info); chkxer_("ZPOSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; zposvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__1, eq, c__, b, & c__2, x, &c__2, &rcond, r1, r2, w, rw, &info); chkxer_("ZPOSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; *(unsigned char *)eq = '/'; zposvx_("F", "U", &c__0, &c__0, a, &c__1, af, &c__1, eq, c__, b, & c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZPOSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; *(unsigned char *)eq = 'Y'; zposvx_("F", "U", &c__1, &c__0, a, &c__1, af, &c__1, eq, c__, b, & c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZPOSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; zposvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__2, eq, c__, b, & c__1, x, &c__2, &rcond, r1, r2, w, rw, &info); chkxer_("ZPOSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 14; zposvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__2, eq, c__, b, & c__2, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZPOSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } else if (lsamen_(&c__2, c2, "PP")) { /* ZPPSV */ s_copy(srnamc_1.srnamt, "ZPPSV ", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zppsv_("/", &c__0, &c__0, a, b, &c__1, &info); chkxer_("ZPPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zppsv_("U", &c_n1, &c__0, a, b, &c__1, &info); chkxer_("ZPPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zppsv_("U", &c__0, &c_n1, a, b, &c__1, &info); chkxer_("ZPPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; zppsv_("U", &c__2, &c__0, a, b, &c__1, &info); chkxer_("ZPPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZPPSVX */ s_copy(srnamc_1.srnamt, "ZPPSVX", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zppsvx_("/", "U", &c__0, &c__0, a, af, eq, c__, b, &c__1, x, &c__1, & rcond, r1, r2, w, rw, &info); chkxer_("ZPPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zppsvx_("N", "/", &c__0, &c__0, a, af, eq, c__, b, &c__1, x, &c__1, & rcond, r1, r2, w, rw, &info); chkxer_("ZPPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zppsvx_("N", "U", &c_n1, &c__0, a, af, eq, c__, b, &c__1, x, &c__1, & rcond, r1, r2, w, rw, &info); chkxer_("ZPPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zppsvx_("N", "U", &c__0, &c_n1, a, af, eq, c__, b, &c__1, x, &c__1, & rcond, r1, r2, w, rw, &info); chkxer_("ZPPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; *(unsigned char *)eq = '/'; zppsvx_("F", "U", &c__0, &c__0, a, af, eq, c__, b, &c__1, x, &c__1, & rcond, r1, r2, w, rw, &info); chkxer_("ZPPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; *(unsigned char *)eq = 'Y'; zppsvx_("F", "U", &c__1, &c__0, a, af, eq, c__, b, &c__1, x, &c__1, & rcond, r1, r2, w, rw, &info); chkxer_("ZPPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; zppsvx_("N", "U", &c__2, &c__0, a, af, eq, c__, b, &c__1, x, &c__2, & rcond, r1, r2, w, rw, &info); chkxer_("ZPPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; zppsvx_("N", "U", &c__2, &c__0, a, af, eq, c__, b, &c__2, x, &c__1, & rcond, r1, r2, w, rw, &info); chkxer_("ZPPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } else if (lsamen_(&c__2, c2, "PB")) { /* ZPBSV */ s_copy(srnamc_1.srnamt, "ZPBSV ", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zpbsv_("/", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, &info) ; chkxer_("ZPBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zpbsv_("U", &c_n1, &c__0, &c__0, a, &c__1, b, &c__1, &info) ; chkxer_("ZPBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zpbsv_("U", &c__1, &c_n1, &c__0, a, &c__1, b, &c__1, &info) ; chkxer_("ZPBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zpbsv_("U", &c__0, &c__0, &c_n1, a, &c__1, b, &c__1, &info) ; chkxer_("ZPBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; zpbsv_("U", &c__1, &c__1, &c__0, a, &c__1, b, &c__2, &info) ; chkxer_("ZPBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; zpbsv_("U", &c__2, &c__0, &c__0, a, &c__1, b, &c__1, &info) ; chkxer_("ZPBSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZPBSVX */ s_copy(srnamc_1.srnamt, "ZPBSVX", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zpbsvx_("/", "U", &c__0, &c__0, &c__0, a, &c__1, af, &c__1, eq, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zpbsvx_("N", "/", &c__0, &c__0, &c__0, a, &c__1, af, &c__1, eq, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zpbsvx_("N", "U", &c_n1, &c__0, &c__0, a, &c__1, af, &c__1, eq, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zpbsvx_("N", "U", &c__1, &c_n1, &c__0, a, &c__1, af, &c__1, eq, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zpbsvx_("N", "U", &c__0, &c__0, &c_n1, a, &c__1, af, &c__1, eq, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zpbsvx_("N", "U", &c__1, &c__1, &c__0, a, &c__1, af, &c__2, eq, c__, b, &c__2, x, &c__2, &rcond, r1, r2, w, rw, &info); chkxer_("ZPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; zpbsvx_("N", "U", &c__1, &c__1, &c__0, a, &c__2, af, &c__1, eq, c__, b, &c__2, x, &c__2, &rcond, r1, r2, w, rw, &info); chkxer_("ZPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; *(unsigned char *)eq = '/'; zpbsvx_("F", "U", &c__0, &c__0, &c__0, a, &c__1, af, &c__1, eq, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; *(unsigned char *)eq = 'Y'; zpbsvx_("F", "U", &c__1, &c__0, &c__0, a, &c__1, af, &c__1, eq, c__, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; zpbsvx_("N", "U", &c__2, &c__0, &c__0, a, &c__1, af, &c__1, eq, c__, b, &c__1, x, &c__2, &rcond, r1, r2, w, rw, &info); chkxer_("ZPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 15; zpbsvx_("N", "U", &c__2, &c__0, &c__0, a, &c__1, af, &c__1, eq, c__, b, &c__2, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZPBSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } else if (lsamen_(&c__2, c2, "PT")) { /* ZPTSV */ s_copy(srnamc_1.srnamt, "ZPTSV ", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zptsv_(&c_n1, &c__0, r__, a, b, &c__1, &info); chkxer_("ZPTSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zptsv_(&c__0, &c_n1, r__, a, b, &c__1, &info); chkxer_("ZPTSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; zptsv_(&c__2, &c__0, r__, a, b, &c__1, &info); chkxer_("ZPTSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZPTSVX */ s_copy(srnamc_1.srnamt, "ZPTSVX", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zptsvx_("/", &c__0, &c__0, r__, a, rf, af, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZPTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zptsvx_("N", &c_n1, &c__0, r__, a, rf, af, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZPTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zptsvx_("N", &c__0, &c_n1, r__, a, rf, af, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZPTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; zptsvx_("N", &c__2, &c__0, r__, a, rf, af, b, &c__1, x, &c__2, &rcond, r1, r2, w, rw, &info); chkxer_("ZPTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; zptsvx_("N", &c__2, &c__0, r__, a, rf, af, b, &c__2, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZPTSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } else if (lsamen_(&c__2, c2, "HE")) { /* ZHESV */ s_copy(srnamc_1.srnamt, "ZHESV ", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zhesv_("/", &c__0, &c__0, a, &c__1, ip, b, &c__1, w, &c__1, &info); chkxer_("ZHESV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zhesv_("U", &c_n1, &c__0, a, &c__1, ip, b, &c__1, w, &c__1, &info); chkxer_("ZHESV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zhesv_("U", &c__0, &c_n1, a, &c__1, ip, b, &c__1, w, &c__1, &info); chkxer_("ZHESV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; zhesv_("U", &c__2, &c__0, a, &c__1, ip, b, &c__2, w, &c__1, &info); chkxer_("ZHESV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; zhesv_("U", &c__2, &c__0, a, &c__2, ip, b, &c__1, w, &c__1, &info); chkxer_("ZHESV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZHESVX */ s_copy(srnamc_1.srnamt, "ZHESVX", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zhesvx_("/", "U", &c__0, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, &c__1, rw, &info); chkxer_("ZHESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zhesvx_("N", "/", &c__0, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, &c__1, rw, &info); chkxer_("ZHESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zhesvx_("N", "U", &c_n1, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, &c__1, rw, &info); chkxer_("ZHESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zhesvx_("N", "U", &c__0, &c_n1, a, &c__1, af, &c__1, ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, &c__1, rw, &info); chkxer_("ZHESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; zhesvx_("N", "U", &c__2, &c__0, a, &c__1, af, &c__2, ip, b, &c__2, x, &c__2, &rcond, r1, r2, w, &c__4, rw, &info); chkxer_("ZHESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; zhesvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__1, ip, b, &c__2, x, &c__2, &rcond, r1, r2, w, &c__4, rw, &info); chkxer_("ZHESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; zhesvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__2, ip, b, &c__1, x, &c__2, &rcond, r1, r2, w, &c__4, rw, &info); chkxer_("ZHESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; zhesvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__2, ip, b, &c__2, x, &c__1, &rcond, r1, r2, w, &c__4, rw, &info); chkxer_("ZHESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 18; zhesvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__2, ip, b, &c__2, x, &c__2, &rcond, r1, r2, w, &c__3, rw, &info); chkxer_("ZHESVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } else if (lsamen_(&c__2, c2, "HP")) { /* ZHPSV */ s_copy(srnamc_1.srnamt, "ZHPSV ", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zhpsv_("/", &c__0, &c__0, a, ip, b, &c__1, &info); chkxer_("ZHPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zhpsv_("U", &c_n1, &c__0, a, ip, b, &c__1, &info); chkxer_("ZHPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zhpsv_("U", &c__0, &c_n1, a, ip, b, &c__1, &info); chkxer_("ZHPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zhpsv_("U", &c__2, &c__0, a, ip, b, &c__1, &info); chkxer_("ZHPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZHPSVX */ s_copy(srnamc_1.srnamt, "ZHPSVX", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zhpsvx_("/", "U", &c__0, &c__0, a, af, ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZHPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zhpsvx_("N", "/", &c__0, &c__0, a, af, ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZHPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zhpsvx_("N", "U", &c_n1, &c__0, a, af, ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZHPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zhpsvx_("N", "U", &c__0, &c_n1, a, af, ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZHPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; zhpsvx_("N", "U", &c__2, &c__0, a, af, ip, b, &c__1, x, &c__2, &rcond, r1, r2, w, rw, &info); chkxer_("ZHPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; zhpsvx_("N", "U", &c__2, &c__0, a, af, ip, b, &c__2, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZHPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } else if (lsamen_(&c__2, c2, "SY")) { /* ZSYSV */ s_copy(srnamc_1.srnamt, "ZSYSV ", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zsysv_("/", &c__0, &c__0, a, &c__1, ip, b, &c__1, w, &c__1, &info); chkxer_("ZSYSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zsysv_("U", &c_n1, &c__0, a, &c__1, ip, b, &c__1, w, &c__1, &info); chkxer_("ZSYSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zsysv_("U", &c__0, &c_n1, a, &c__1, ip, b, &c__1, w, &c__1, &info); chkxer_("ZSYSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; zsysv_("U", &c__2, &c__0, a, &c__2, ip, b, &c__1, w, &c__1, &info); chkxer_("ZSYSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZSYSVX */ s_copy(srnamc_1.srnamt, "ZSYSVX", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zsysvx_("/", "U", &c__0, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, &c__1, rw, &info); chkxer_("ZSYSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zsysvx_("N", "/", &c__0, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, &c__1, rw, &info); chkxer_("ZSYSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zsysvx_("N", "U", &c_n1, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, &c__1, rw, &info); chkxer_("ZSYSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zsysvx_("N", "U", &c__0, &c_n1, a, &c__1, af, &c__1, ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, &c__1, rw, &info); chkxer_("ZSYSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; zsysvx_("N", "U", &c__2, &c__0, a, &c__1, af, &c__2, ip, b, &c__2, x, &c__2, &rcond, r1, r2, w, &c__4, rw, &info); chkxer_("ZSYSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; zsysvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__1, ip, b, &c__2, x, &c__2, &rcond, r1, r2, w, &c__4, rw, &info); chkxer_("ZSYSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; zsysvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__2, ip, b, &c__1, x, &c__2, &rcond, r1, r2, w, &c__4, rw, &info); chkxer_("ZSYSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; zsysvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__2, ip, b, &c__2, x, &c__1, &rcond, r1, r2, w, &c__4, rw, &info); chkxer_("ZSYSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 18; zsysvx_("N", "U", &c__2, &c__0, a, &c__2, af, &c__2, ip, b, &c__2, x, &c__2, &rcond, r1, r2, w, &c__3, rw, &info); chkxer_("ZSYSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } else if (lsamen_(&c__2, c2, "SP")) { /* ZSPSV */ s_copy(srnamc_1.srnamt, "ZSPSV ", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zspsv_("/", &c__0, &c__0, a, ip, b, &c__1, &info); chkxer_("ZSPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zspsv_("U", &c_n1, &c__0, a, ip, b, &c__1, &info); chkxer_("ZSPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zspsv_("U", &c__0, &c_n1, a, ip, b, &c__1, &info); chkxer_("ZSPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; zspsv_("U", &c__2, &c__0, a, ip, b, &c__1, &info); chkxer_("ZSPSV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); /* ZSPSVX */ s_copy(srnamc_1.srnamt, "ZSPSVX", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; zspsvx_("/", "U", &c__0, &c__0, a, af, ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZSPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; zspsvx_("N", "/", &c__0, &c__0, a, af, ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZSPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; zspsvx_("N", "U", &c_n1, &c__0, a, af, ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZSPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; zspsvx_("N", "U", &c__0, &c_n1, a, af, ip, b, &c__1, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZSPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; zspsvx_("N", "U", &c__2, &c__0, a, af, ip, b, &c__1, x, &c__2, &rcond, r1, r2, w, rw, &info); chkxer_("ZSPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; zspsvx_("N", "U", &c__2, &c__0, a, af, ip, b, &c__2, x, &c__1, &rcond, r1, r2, w, rw, &info); chkxer_("ZSPSVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); } /* Print a summary line. */ if (infoc_1.ok) { io___20.ciunit = infoc_1.nout; s_wsfe(&io___20); do_fio(&c__1, path, (ftnlen)3); e_wsfe(); } else { io___21.ciunit = infoc_1.nout; s_wsfe(&io___21); do_fio(&c__1, path, (ftnlen)3); e_wsfe(); } return 0; /* End of ZERRVX */ } /* zerrvx_ */
void zgesv_test ( ) /******************************************************************************/ /* Purpose: ZGESV_TEST demonstrates ZGESV. Licensing: This code is distributed under the GNU LGPL license. Modified: 14 May 2013 Author: John Burkardt */ { # define NDIM 2 doublecomplex *A; doublecomplex *B; int i; static long int INFO; int info2; static long int IPIV[NDIM]; int j; long int LDA; long int LDB; long int N; long int NRHS; const double pi = 3.141592653589793; printf ( "\n" ); printf ( "ZGESV_TEST\n" ); printf ( " Demonstrate the use of ZGESV to solve a linear system\n" ); printf ( " using double precision complex arithmetic.\n" ); A = ( doublecomplex * ) malloc ( NDIM * NDIM * sizeof ( doublecomplex ) ); B = ( doublecomplex * ) malloc ( NDIM * sizeof ( doublecomplex ) ); N = NDIM; NRHS = 1; LDA = NDIM; LDB = NDIM; /* Print the coefficient matrix. */ printf ( "\n" ); printf ( " Coefficient matrix A:\n" ); printf ( "\n" ); for ( i = 0; i < N; i++ ) { for ( j = 0; j < N; j++ ) { A[i+N*j].r = cos ( pi * ( double ) ( i + 1 ) * 3.0 / 4.0 ); A[i+N*j].i = sin ( pi * ( double ) ( j + 1 ) / 5.0 ); printf ( " %f + %fi", A[i+N*j].r, A[i+N*j].i ); } printf ( "\n" ); } /* Print the right hand side. */ printf ( "\n" ); printf ( " Right hand side B:\n" ); printf ( "\n" ); B[0].r = 1.0; B[0].i = 1.0; B[1].r = 2.0; B[1].i = 3.0; for ( i = 0; i < N; i++ ) { printf ( " %f + %fi\n", B[i].r, B[i].i ); } /* Call ZGESV to compute the solution. */ info2 = zgesv_ ( &N, &NRHS, A, &LDA, IPIV, B, &LDB, &INFO ); printf ( "\n" ); printf ( " Return value of error flag INFO = %d\n", ( int ) INFO ); printf ( "\n" ); printf ( " Computed solution X:\n" ); printf ( "\n" ); for ( i = 0; i < N; i++ ) { printf ( " %f + %fi\n", B[i].r, B[i].i ); } free ( A ); free ( B ); return; # undef NDIM }