zdrvgex.c
Go to the documentation of this file.
00001 /* zdrvgex.f -- translated by f2c (version 20061008).
00002    You must link the resulting object file with libf2c:
00003         on Microsoft Windows system, link with libf2c.lib;
00004         on Linux or Unix systems, link with .../path/to/libf2c.a -lm
00005         or, if you install libf2c.a in a standard place, with -lf2c -lm
00006         -- in that order, at the end of the command line, as in
00007                 cc *.o -lf2c -lm
00008         Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
00009 
00010                 http://www.netlib.org/f2c/libf2c.zip
00011 */
00012 
00013 #include "f2c.h"
00014 #include "memory_alloc.h"
00015 
00016 /* Common Block Declarations */
00017 
00018 struct {
00019     integer infot, nunit;
00020     logical ok, lerr;
00021 } infoc_;
00022 
00023 #define infoc_1 infoc_
00024 
00025 struct {
00026     char srnamt[32];
00027 } srnamc_;
00028 
00029 #define srnamc_1 srnamc_
00030 
00031 /* Table of constant values */
00032 
00033 static integer c__1 = 1;
00034 static integer c__2 = 2;
00035 static integer c__0 = 0;
00036 static integer c_n1 = -1;
00037 static doublecomplex c_b20 = {0.,0.};
00038 static logical c_true = TRUE_;
00039 static integer c__6 = 6;
00040 static integer c__7 = 7;
00041 static doublereal c_b166 = 0.;
00042 
00043 /* Subroutine */ int zdrvge_(logical *dotype, integer *nn, integer *nval, 
00044         integer *nrhs, doublereal *thresh, logical *tsterr, integer *nmax, 
00045         doublecomplex *a, doublecomplex *afac, doublecomplex *asav, 
00046         doublecomplex *b, doublecomplex *bsav, doublecomplex *x, 
00047         doublecomplex *xact, doublereal *s, doublecomplex *work, doublereal *
00048         rwork, integer *iwork, integer *nout)
00049 {
00050     /* Initialized data */
00051 
00052     static integer iseedy[4] = { 1988,1989,1990,1991 };
00053     static char transs[1*3] = "N" "T" "C";
00054     static char facts[1*3] = "F" "N" "E";
00055     static char equeds[1*4] = "N" "R" "C" "B";
00056 
00057     /* Format strings */
00058     static char fmt_9999[] = "(1x,a,\002, N =\002,i5,\002, type \002,i2,\002"
00059             ", test(\002,i2,\002) =\002,g12.5)";
00060     static char fmt_9997[] = "(1x,a,\002, FACT='\002,a1,\002', TRANS='\002,a"
00061             "1,\002', N=\002,i5,\002, EQUED='\002,a1,\002', type \002,i2,\002"
00062             ", test(\002,i1,\002)=\002,g12.5)";
00063     static char fmt_9998[] = "(1x,a,\002, FACT='\002,a1,\002', TRANS='\002,a"
00064             "1,\002', N=\002,i5,\002, type \002,i2,\002, test(\002,i1,\002)"
00065             "=\002,g12.5)";
00066 
00067     /* System generated locals */
00068     address a__1[2];
00069     integer i__1, i__2, i__3, i__4, i__5[2];
00070     doublereal d__1, d__2;
00071     char ch__1[2];
00072 
00073     /* Builtin functions */
00074     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
00075     integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
00076     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
00077 
00078     /* Local variables */
00079     extern /* Subroutine */ int zebchvxx_(doublereal *, char *);
00080     integer i__, k, n;
00081     doublereal *errbnds_c__, *errbnds_n__;
00082     integer k1, nb, in, kl, ku, nt, n_err_bnds__;
00083     extern doublereal zla_rpvgrw__(integer *, integer *, doublecomplex *, 
00084             integer *, doublecomplex *, integer *);
00085     integer lda;
00086     char fact[1];
00087     integer ioff, mode;
00088     doublereal amax;
00089     char path[3];
00090     integer imat, info;
00091     doublereal *berr;
00092     char dist[1];
00093     doublereal rdum[1], rpvgrw_svxx__;
00094     char type__[1];
00095     integer nrun, ifact, nfail, iseed[4], nfact;
00096     extern doublereal dget06_(doublereal *, doublereal *);
00097     extern logical lsame_(char *, char *);
00098     char equed[1];
00099     integer nbmin;
00100     doublereal rcond, roldc;
00101     integer nimat;
00102     doublereal roldi;
00103     extern /* Subroutine */ int zget01_(integer *, integer *, doublecomplex *, 
00104              integer *, doublecomplex *, integer *, integer *, doublereal *, 
00105             doublereal *), zget02_(char *, integer *, integer *, integer *, 
00106             doublecomplex *, integer *, doublecomplex *, integer *, 
00107             doublecomplex *, integer *, doublereal *, doublereal *);
00108     doublereal anorm;
00109     integer itran;
00110     extern /* Subroutine */ int zget04_(integer *, integer *, doublecomplex *, 
00111              integer *, doublecomplex *, integer *, doublereal *, doublereal *
00112 );
00113     logical equil;
00114     doublereal roldo;
00115     extern /* Subroutine */ int zget07_(char *, integer *, integer *, 
00116             doublecomplex *, integer *, doublecomplex *, integer *, 
00117             doublecomplex *, integer *, doublecomplex *, integer *, 
00118             doublereal *, logical *, doublereal *, doublereal *);
00119     char trans[1];
00120     integer izero, nerrs, lwork;
00121     extern /* Subroutine */ int zgesv_(integer *, integer *, doublecomplex *, 
00122             integer *, integer *, doublecomplex *, integer *, integer *);
00123     logical zerot;
00124     char xtype[1];
00125     extern /* Subroutine */ int zlatb4_(char *, integer *, integer *, integer 
00126             *, char *, integer *, integer *, doublereal *, integer *, 
00127             doublereal *, char *), aladhd_(integer *, 
00128             char *);
00129     extern doublereal dlamch_(char *);
00130     extern /* Subroutine */ int alaerh_(char *, char *, integer *, integer *, 
00131             char *, integer *, integer *, integer *, integer *, integer *, 
00132             integer *, integer *, integer *, integer *);
00133     logical prefac;
00134     doublereal colcnd, rcondc;
00135     logical nofact;
00136     integer iequed;
00137     doublereal rcondi;
00138     extern doublereal zlange_(char *, integer *, integer *, doublecomplex *, 
00139             integer *, doublereal *);
00140     extern /* Subroutine */ int alasvm_(char *, integer *, integer *, integer 
00141             *, integer *);
00142     doublereal cndnum, anormi, rcondo, ainvnm;
00143     extern /* Subroutine */ int zlaqge_(integer *, integer *, doublecomplex *, 
00144              integer *, doublereal *, doublereal *, doublereal *, doublereal *
00145 , doublereal *, char *);
00146     logical trfcon;
00147     doublereal anormo, rowcnd;
00148     extern /* Subroutine */ int xlaenv_(integer *, integer *), zgeequ_(
00149             integer *, integer *, doublecomplex *, integer *, doublereal *, 
00150             doublereal *, doublereal *, doublereal *, doublereal *, integer *)
00151             , zgetrf_(integer *, integer *, doublecomplex *, integer *, 
00152             integer *, integer *), zlacpy_(char *, integer *, integer *, 
00153             doublecomplex *, integer *, doublecomplex *, integer *), 
00154             zgetri_(integer *, doublecomplex *, integer *, integer *, 
00155             doublecomplex *, integer *, integer *), zlarhs_(char *, char *, 
00156             char *, char *, integer *, integer *, integer *, integer *, 
00157             integer *, doublecomplex *, integer *, doublecomplex *, integer *, 
00158              doublecomplex *, integer *, integer *, integer *), zlaset_();
00159     extern doublereal zlantr_(char *, char *, char *, integer *, integer *, 
00160             doublecomplex *, integer *, doublereal *);
00161     extern /* Subroutine */ int zlatms_(integer *, integer *, char *, integer 
00162             *, char *, doublereal *, integer *, doublereal *, doublereal *, 
00163             integer *, integer *, char *, doublecomplex *, integer *, 
00164             doublecomplex *, integer *);
00165     doublereal result[7];
00166     extern /* Subroutine */ int zgesvx_(char *, char *, integer *, integer *, 
00167             doublecomplex *, integer *, doublecomplex *, integer *, integer *, 
00168              char *, doublereal *, doublereal *, doublecomplex *, integer *, 
00169             doublecomplex *, integer *, doublereal *, doublereal *, 
00170             doublereal *, doublecomplex *, doublereal *, integer *);
00171     doublereal rpvgrw;
00172     extern /* Subroutine */ int zerrvx_(char *, integer *), zgesvxx_(
00173             char *, char *, integer *, integer *, doublecomplex *, integer *, 
00174             doublecomplex *, integer *, integer *, char *, doublereal *, 
00175             doublereal *, doublecomplex *, integer *, doublecomplex *, 
00176             integer *, doublereal *, doublereal *, doublereal *, integer *, 
00177             doublereal *, doublereal *, integer *, doublereal *, 
00178             doublecomplex *, doublereal *, integer *);
00179 
00180     /* Fortran I/O blocks */
00181     static cilist io___55 = { 0, 0, 0, fmt_9999, 0 };
00182     static cilist io___62 = { 0, 0, 0, fmt_9997, 0 };
00183     static cilist io___63 = { 0, 0, 0, fmt_9998, 0 };
00184     static cilist io___64 = { 0, 0, 0, fmt_9997, 0 };
00185     static cilist io___65 = { 0, 0, 0, fmt_9998, 0 };
00186     static cilist io___66 = { 0, 0, 0, fmt_9997, 0 };
00187     static cilist io___67 = { 0, 0, 0, fmt_9998, 0 };
00188     static cilist io___68 = { 0, 0, 0, fmt_9997, 0 };
00189     static cilist io___69 = { 0, 0, 0, fmt_9998, 0 };
00190     static cilist io___75 = { 0, 0, 0, fmt_9997, 0 };
00191     static cilist io___76 = { 0, 0, 0, fmt_9998, 0 };
00192     static cilist io___77 = { 0, 0, 0, fmt_9997, 0 };
00193     static cilist io___78 = { 0, 0, 0, fmt_9998, 0 };
00194     static cilist io___79 = { 0, 0, 0, fmt_9997, 0 };
00195     static cilist io___80 = { 0, 0, 0, fmt_9998, 0 };
00196     static cilist io___81 = { 0, 0, 0, fmt_9997, 0 };
00197     static cilist io___82 = { 0, 0, 0, fmt_9998, 0 };
00198 
00199 
00200 
00201 /*  -- LAPACK test routine (version 3.1) -- */
00202 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00203 /*     November 2006 */
00204 
00205 /*     .. Scalar Arguments .. */
00206 /*     .. */
00207 /*     .. Array Arguments .. */
00208 /*     .. */
00209 
00210 /*  Purpose */
00211 /*  ======= */
00212 
00213 /*  ZDRVGE tests the driver routines ZGESV, -SVX, and -SVXX. */
00214 
00215 /*  Note that this file is used only when the XBLAS are available, */
00216 /*  otherwise zdrvge.f defines this subroutine. */
00217 
00218 /*  Arguments */
00219 /*  ========= */
00220 
00221 /*  DOTYPE  (input) LOGICAL array, dimension (NTYPES) */
00222 /*          The matrix types to be used for testing.  Matrices of type j */
00223 /*          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = */
00224 /*          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. */
00225 
00226 /*  NN      (input) INTEGER */
00227 /*          The number of values of N contained in the vector NVAL. */
00228 
00229 /*  NVAL    (input) INTEGER array, dimension (NN) */
00230 /*          The values of the matrix column dimension N. */
00231 
00232 /*  NRHS    (input) INTEGER */
00233 /*          The number of right hand side vectors to be generated for */
00234 /*          each linear system. */
00235 
00236 /*  THRESH  (input) DOUBLE PRECISION */
00237 /*          The threshold value for the test ratios.  A result is */
00238 /*          included in the output file if RESULT >= THRESH.  To have */
00239 /*          every test ratio printed, use THRESH = 0. */
00240 
00241 /*  TSTERR  (input) LOGICAL */
00242 /*          Flag that indicates whether error exits are to be tested. */
00243 
00244 /*  NMAX    (input) INTEGER */
00245 /*          The maximum value permitted for N, used in dimensioning the */
00246 /*          work arrays. */
00247 
00248 /*  A       (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) */
00249 
00250 /*  AFAC    (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) */
00251 
00252 /*  ASAV    (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) */
00253 
00254 /*  B       (workspace) COMPLEX*16 array, dimension (NMAX*NRHS) */
00255 
00256 /*  BSAV    (workspace) COMPLEX*16 array, dimension (NMAX*NRHS) */
00257 
00258 /*  X       (workspace) COMPLEX*16 array, dimension (NMAX*NRHS) */
00259 
00260 /*  XACT    (workspace) COMPLEX*16 array, dimension (NMAX*NRHS) */
00261 
00262 /*  S       (workspace) DOUBLE PRECISION array, dimension (2*NMAX) */
00263 
00264 /*  WORK    (workspace) COMPLEX*16 array, dimension */
00265 /*                      (NMAX*max(3,NRHS)) */
00266 
00267 /*  RWORK   (workspace) DOUBLE PRECISION array, dimension (2*NRHS+NMAX) */
00268 
00269 /*  IWORK   (workspace) INTEGER array, dimension (NMAX) */
00270 
00271 /*  NOUT    (input) INTEGER */
00272 /*          The unit number for output. */
00273 
00274 /*  ===================================================================== */
00275 
00276 /*     .. Parameters .. */
00277 /*     .. */
00278 /*     .. Local Scalars .. */
00279 /*     .. */
00280 /*     .. Local Arrays .. */
00281 /*     .. */
00282 /*     .. External Functions .. */
00283 /*     .. */
00284 /*     .. External Subroutines .. */
00285 /*     .. */
00286 /*     .. Intrinsic Functions .. */
00287 /*     .. */
00288 /*     .. Scalars in Common .. */
00289 /*     .. */
00290 /*     .. Common blocks .. */
00291 /*     .. */
00292 /*     .. Data statements .. */
00293     /* Parameter adjustments */
00294     --iwork;
00295     --rwork;
00296     --work;
00297     --s;
00298     --xact;
00299     --x;
00300     --bsav;
00301     --b;
00302     --asav;
00303     --afac;
00304     --a;
00305     --nval;
00306     --dotype;
00307 
00308     /* Function Body */
00309 /*     .. */
00310 /*     .. Executable Statements .. */
00311 
00312 /*     Initialize constants and the random number seed. */
00313 
00314     s_copy(path, "Zomplex precision", (ftnlen)1, (ftnlen)17);
00315     s_copy(path + 1, "GE", (ftnlen)2, (ftnlen)2);
00316     nrun = 0;
00317     nfail = 0;
00318     nerrs = 0;
00319     for (i__ = 1; i__ <= 4; ++i__) {
00320         iseed[i__ - 1] = iseedy[i__ - 1];
00321 /* L10: */
00322     }
00323 
00324 /*     Test the error exits */
00325 
00326     if (*tsterr) {
00327         zerrvx_(path, nout);
00328     }
00329     infoc_1.infot = 0;
00330 
00331 /*     Set the block size and minimum block size for testing. */
00332 
00333     nb = 1;
00334     nbmin = 2;
00335     xlaenv_(&c__1, &nb);
00336     xlaenv_(&c__2, &nbmin);
00337 
00338 /*     Do for each value of N in NVAL */
00339 
00340     i__1 = *nn;
00341     for (in = 1; in <= i__1; ++in) {
00342         n = nval[in];
00343         lda = max(n,1);
00344         *(unsigned char *)xtype = 'N';
00345         nimat = 11;
00346         if (n <= 0) {
00347             nimat = 1;
00348         }
00349 
00350         i__2 = nimat;
00351         for (imat = 1; imat <= i__2; ++imat) {
00352 
00353 /*           Do the tests only if DOTYPE( IMAT ) is true. */
00354 
00355             if (! dotype[imat]) {
00356                 goto L80;
00357             }
00358 
00359 /*           Skip types 5, 6, or 7 if the matrix size is too small. */
00360 
00361             zerot = imat >= 5 && imat <= 7;
00362             if (zerot && n < imat - 4) {
00363                 goto L80;
00364             }
00365 
00366 /*           Set up parameters with ZLATB4 and generate a test matrix */
00367 /*           with ZLATMS. */
00368 
00369             zlatb4_(path, &imat, &n, &n, type__, &kl, &ku, &anorm, &mode, &
00370                     cndnum, dist);
00371             rcondc = 1. / cndnum;
00372 
00373             s_copy(srnamc_1.srnamt, "ZLATMS", (ftnlen)32, (ftnlen)6);
00374             zlatms_(&n, &n, dist, iseed, type__, &rwork[1], &mode, &cndnum, &
00375                     anorm, &kl, &ku, "No packing", &a[1], &lda, &work[1], &
00376                     info);
00377 
00378 /*           Check error code from ZLATMS. */
00379 
00380             if (info != 0) {
00381                 alaerh_(path, "ZLATMS", &info, &c__0, " ", &n, &n, &c_n1, &
00382                         c_n1, &c_n1, &imat, &nfail, &nerrs, nout);
00383                 goto L80;
00384             }
00385 
00386 /*           For types 5-7, zero one or more columns of the matrix to */
00387 /*           test that INFO is returned correctly. */
00388 
00389             if (zerot) {
00390                 if (imat == 5) {
00391                     izero = 1;
00392                 } else if (imat == 6) {
00393                     izero = n;
00394                 } else {
00395                     izero = n / 2 + 1;
00396                 }
00397                 ioff = (izero - 1) * lda;
00398                 if (imat < 7) {
00399                     i__3 = n;
00400                     for (i__ = 1; i__ <= i__3; ++i__) {
00401                         i__4 = ioff + i__;
00402                         a[i__4].r = 0., a[i__4].i = 0.;
00403 /* L20: */
00404                     }
00405                 } else {
00406                     i__3 = n - izero + 1;
00407                     zlaset_("Full", &n, &i__3, &c_b20, &c_b20, &a[ioff + 1], &
00408                             lda);
00409                 }
00410             } else {
00411                 izero = 0;
00412             }
00413 
00414 /*           Save a copy of the matrix A in ASAV. */
00415 
00416             zlacpy_("Full", &n, &n, &a[1], &lda, &asav[1], &lda);
00417 
00418             for (iequed = 1; iequed <= 4; ++iequed) {
00419                 *(unsigned char *)equed = *(unsigned char *)&equeds[iequed - 
00420                         1];
00421                 if (iequed == 1) {
00422                     nfact = 3;
00423                 } else {
00424                     nfact = 1;
00425                 }
00426 
00427                 i__3 = nfact;
00428                 for (ifact = 1; ifact <= i__3; ++ifact) {
00429                     *(unsigned char *)fact = *(unsigned char *)&facts[ifact - 
00430                             1];
00431                     prefac = lsame_(fact, "F");
00432                     nofact = lsame_(fact, "N");
00433                     equil = lsame_(fact, "E");
00434 
00435                     if (zerot) {
00436                         if (prefac) {
00437                             goto L60;
00438                         }
00439                         rcondo = 0.;
00440                         rcondi = 0.;
00441 
00442                     } else if (! nofact) {
00443 
00444 /*                    Compute the condition number for comparison with */
00445 /*                    the value returned by ZGESVX (FACT = 'N' reuses */
00446 /*                    the condition number from the previous iteration */
00447 /*                    with FACT = 'F'). */
00448 
00449                         zlacpy_("Full", &n, &n, &asav[1], &lda, &afac[1], &
00450                                 lda);
00451                         if (equil || iequed > 1) {
00452 
00453 /*                       Compute row and column scale factors to */
00454 /*                       equilibrate the matrix A. */
00455 
00456                             zgeequ_(&n, &n, &afac[1], &lda, &s[1], &s[n + 1], 
00457                                     &rowcnd, &colcnd, &amax, &info);
00458                             if (info == 0 && n > 0) {
00459                                 if (lsame_(equed, "R")) 
00460                                         {
00461                                     rowcnd = 0.;
00462                                     colcnd = 1.;
00463                                 } else if (lsame_(equed, "C")) {
00464                                     rowcnd = 1.;
00465                                     colcnd = 0.;
00466                                 } else if (lsame_(equed, "B")) {
00467                                     rowcnd = 0.;
00468                                     colcnd = 0.;
00469                                 }
00470 
00471 /*                          Equilibrate the matrix. */
00472 
00473                                 zlaqge_(&n, &n, &afac[1], &lda, &s[1], &s[n + 
00474                                         1], &rowcnd, &colcnd, &amax, equed);
00475                             }
00476                         }
00477 
00478 /*                    Save the condition number of the non-equilibrated */
00479 /*                    system for use in ZGET04. */
00480 
00481                         if (equil) {
00482                             roldo = rcondo;
00483                             roldi = rcondi;
00484                         }
00485 
00486 /*                    Compute the 1-norm and infinity-norm of A. */
00487 
00488                         anormo = zlange_("1", &n, &n, &afac[1], &lda, &rwork[
00489                                 1]);
00490                         anormi = zlange_("I", &n, &n, &afac[1], &lda, &rwork[
00491                                 1]);
00492 
00493 /*                    Factor the matrix A. */
00494 
00495                         zgetrf_(&n, &n, &afac[1], &lda, &iwork[1], &info);
00496 
00497 /*                    Form the inverse of A. */
00498 
00499                         zlacpy_("Full", &n, &n, &afac[1], &lda, &a[1], &lda);
00500                         lwork = *nmax * max(3,*nrhs);
00501                         zgetri_(&n, &a[1], &lda, &iwork[1], &work[1], &lwork, 
00502                                 &info);
00503 
00504 /*                    Compute the 1-norm condition number of A. */
00505 
00506                         ainvnm = zlange_("1", &n, &n, &a[1], &lda, &rwork[1]);
00507                         if (anormo <= 0. || ainvnm <= 0.) {
00508                             rcondo = 1.;
00509                         } else {
00510                             rcondo = 1. / anormo / ainvnm;
00511                         }
00512 
00513 /*                    Compute the infinity-norm condition number of A. */
00514 
00515                         ainvnm = zlange_("I", &n, &n, &a[1], &lda, &rwork[1]);
00516                         if (anormi <= 0. || ainvnm <= 0.) {
00517                             rcondi = 1.;
00518                         } else {
00519                             rcondi = 1. / anormi / ainvnm;
00520                         }
00521                     }
00522 
00523                     for (itran = 1; itran <= 3; ++itran) {
00524                         for (i__ = 1; i__ <= 7; ++i__) {
00525                             result[i__ - 1] = 0.;
00526                         }
00527 
00528 /*                    Do for each value of TRANS. */
00529 
00530                         *(unsigned char *)trans = *(unsigned char *)&transs[
00531                                 itran - 1];
00532                         if (itran == 1) {
00533                             rcondc = rcondo;
00534                         } else {
00535                             rcondc = rcondi;
00536                         }
00537 
00538 /*                    Restore the matrix A. */
00539 
00540                         zlacpy_("Full", &n, &n, &asav[1], &lda, &a[1], &lda);
00541 
00542 /*                    Form an exact solution and set the right hand side. */
00543 
00544                         s_copy(srnamc_1.srnamt, "ZLARHS", (ftnlen)32, (ftnlen)
00545                                 6);
00546                         zlarhs_(path, xtype, "Full", trans, &n, &n, &kl, &ku, 
00547                                 nrhs, &a[1], &lda, &xact[1], &lda, &b[1], &
00548                                 lda, iseed, &info);
00549                         *(unsigned char *)xtype = 'C';
00550                         zlacpy_("Full", &n, nrhs, &b[1], &lda, &bsav[1], &lda);
00551 
00552                         if (nofact && itran == 1) {
00553 
00554 /*                       --- Test ZGESV  --- */
00555 
00556 /*                       Compute the LU factorization of the matrix and */
00557 /*                       solve the system. */
00558 
00559                             zlacpy_("Full", &n, &n, &a[1], &lda, &afac[1], &
00560                                     lda);
00561                             zlacpy_("Full", &n, nrhs, &b[1], &lda, &x[1], &
00562                                     lda);
00563 
00564                             s_copy(srnamc_1.srnamt, "ZGESV ", (ftnlen)32, (
00565                                     ftnlen)6);
00566                             zgesv_(&n, nrhs, &afac[1], &lda, &iwork[1], &x[1], 
00567                                      &lda, &info);
00568 
00569 /*                       Check error code from ZGESV . */
00570 
00571                             if (info != izero) {
00572                                 alaerh_(path, "ZGESV ", &info, &izero, " ", &
00573                                         n, &n, &c_n1, &c_n1, nrhs, &imat, &
00574                                         nfail, &nerrs, nout);
00575                                 goto L50;
00576                             }
00577 
00578 /*                       Reconstruct matrix from factors and compute */
00579 /*                       residual. */
00580 
00581                             zget01_(&n, &n, &a[1], &lda, &afac[1], &lda, &
00582                                     iwork[1], &rwork[1], result);
00583                             nt = 1;
00584                             if (izero == 0) {
00585 
00586 /*                          Compute residual of the computed solution. */
00587 
00588                                 zlacpy_("Full", &n, nrhs, &b[1], &lda, &work[
00589                                         1], &lda);
00590                                 zget02_("No transpose", &n, &n, nrhs, &a[1], &
00591                                         lda, &x[1], &lda, &work[1], &lda, &
00592                                         rwork[1], &result[1]);
00593 
00594 /*                          Check solution from generated exact solution. */
00595 
00596                                 zget04_(&n, nrhs, &x[1], &lda, &xact[1], &lda, 
00597                                          &rcondc, &result[2]);
00598                                 nt = 3;
00599                             }
00600 
00601 /*                       Print information about the tests that did not */
00602 /*                       pass the threshold. */
00603 
00604                             i__4 = nt;
00605                             for (k = 1; k <= i__4; ++k) {
00606                                 if (result[k - 1] >= *thresh) {
00607                                     if (nfail == 0 && nerrs == 0) {
00608                                         aladhd_(nout, path);
00609                                     }
00610                                     io___55.ciunit = *nout;
00611                                     s_wsfe(&io___55);
00612                                     do_fio(&c__1, "ZGESV ", (ftnlen)6);
00613                                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
00614                                             integer));
00615                                     do_fio(&c__1, (char *)&imat, (ftnlen)
00616                                             sizeof(integer));
00617                                     do_fio(&c__1, (char *)&k, (ftnlen)sizeof(
00618                                             integer));
00619                                     do_fio(&c__1, (char *)&result[k - 1], (
00620                                             ftnlen)sizeof(doublereal));
00621                                     e_wsfe();
00622                                     ++nfail;
00623                                 }
00624 /* L30: */
00625                             }
00626                             nrun += nt;
00627                         }
00628 
00629 /*                    --- Test ZGESVX --- */
00630 
00631                         if (! prefac) {
00632                             zlaset_("Full", &n, &n, &c_b20, &c_b20, &afac[1], 
00633                                     &lda);
00634                         }
00635                         zlaset_("Full", &n, nrhs, &c_b20, &c_b20, &x[1], &lda);
00636                         if (iequed > 1 && n > 0) {
00637 
00638 /*                       Equilibrate the matrix if FACT = 'F' and */
00639 /*                       EQUED = 'R', 'C', or 'B'. */
00640 
00641                             zlaqge_(&n, &n, &a[1], &lda, &s[1], &s[n + 1], &
00642                                     rowcnd, &colcnd, &amax, equed);
00643                         }
00644 
00645 /*                    Solve the system and compute the condition number */
00646 /*                    and error bounds using ZGESVX. */
00647 
00648                         s_copy(srnamc_1.srnamt, "ZGESVX", (ftnlen)32, (ftnlen)
00649                                 6);
00650                         zgesvx_(fact, trans, &n, nrhs, &a[1], &lda, &afac[1], 
00651                                 &lda, &iwork[1], equed, &s[1], &s[n + 1], &b[
00652                                 1], &lda, &x[1], &lda, &rcond, &rwork[1], &
00653                                 rwork[*nrhs + 1], &work[1], &rwork[(*nrhs << 
00654                                 1) + 1], &info);
00655 
00656 /*                    Check the error code from ZGESVX. */
00657 
00658                         if (info == n + 1) {
00659                             goto L50;
00660                         }
00661                         if (info != izero) {
00662 /* Writing concatenation */
00663                             i__5[0] = 1, a__1[0] = fact;
00664                             i__5[1] = 1, a__1[1] = trans;
00665                             s_cat(ch__1, a__1, i__5, &c__2, (ftnlen)2);
00666                             alaerh_(path, "ZGESVX", &info, &izero, ch__1, &n, 
00667                                     &n, &c_n1, &c_n1, nrhs, &imat, &nfail, &
00668                                     nerrs, nout);
00669                             goto L50;
00670                         }
00671 
00672 /*                    Compare RWORK(2*NRHS+1) from ZGESVX with the */
00673 /*                    computed reciprocal pivot growth factor RPVGRW */
00674 
00675                         if (info != 0) {
00676                             rpvgrw = zlantr_("M", "U", "N", &info, &info, &
00677                                     afac[1], &lda, rdum);
00678                             if (rpvgrw == 0.) {
00679                                 rpvgrw = 1.;
00680                             } else {
00681                                 rpvgrw = zlange_("M", &n, &info, &a[1], &lda, 
00682                                         rdum) / rpvgrw;
00683                             }
00684                         } else {
00685                             rpvgrw = zlantr_("M", "U", "N", &n, &n, &afac[1], 
00686                                     &lda, rdum);
00687                             if (rpvgrw == 0.) {
00688                                 rpvgrw = 1.;
00689                             } else {
00690                                 rpvgrw = zlange_("M", &n, &n, &a[1], &lda, 
00691                                         rdum) / rpvgrw;
00692                             }
00693                         }
00694 /* Computing MAX */
00695                         d__2 = rwork[(*nrhs << 1) + 1];
00696                         result[6] = (d__1 = rpvgrw - rwork[(*nrhs << 1) + 1], 
00697                                 abs(d__1)) / max(d__2,rpvgrw) / dlamch_("E");
00698 
00699                         if (! prefac) {
00700 
00701 /*                       Reconstruct matrix from factors and compute */
00702 /*                       residual. */
00703 
00704                             zget01_(&n, &n, &a[1], &lda, &afac[1], &lda, &
00705                                     iwork[1], &rwork[(*nrhs << 1) + 1], 
00706                                     result);
00707                             k1 = 1;
00708                         } else {
00709                             k1 = 2;
00710                         }
00711 
00712                         if (info == 0) {
00713                             trfcon = FALSE_;
00714 
00715 /*                       Compute residual of the computed solution. */
00716 
00717                             zlacpy_("Full", &n, nrhs, &bsav[1], &lda, &work[1]
00718 , &lda);
00719                             zget02_(trans, &n, &n, nrhs, &asav[1], &lda, &x[1]
00720 , &lda, &work[1], &lda, &rwork[(*nrhs << 
00721                                     1) + 1], &result[1]);
00722 
00723 /*                       Check solution from generated exact solution. */
00724 
00725                             if (nofact || prefac && lsame_(equed, "N")) {
00726                                 zget04_(&n, nrhs, &x[1], &lda, &xact[1], &lda, 
00727                                          &rcondc, &result[2]);
00728                             } else {
00729                                 if (itran == 1) {
00730                                     roldc = roldo;
00731                                 } else {
00732                                     roldc = roldi;
00733                                 }
00734                                 zget04_(&n, nrhs, &x[1], &lda, &xact[1], &lda, 
00735                                          &roldc, &result[2]);
00736                             }
00737 
00738 /*                       Check the error bounds from iterative */
00739 /*                       refinement. */
00740 
00741                             zget07_(trans, &n, nrhs, &asav[1], &lda, &b[1], &
00742                                     lda, &x[1], &lda, &xact[1], &lda, &rwork[
00743                                     1], &c_true, &rwork[*nrhs + 1], &result[3]
00744 );
00745                         } else {
00746                             trfcon = TRUE_;
00747                         }
00748 
00749 /*                    Compare RCOND from ZGESVX with the computed value */
00750 /*                    in RCONDC. */
00751 
00752                         result[5] = dget06_(&rcond, &rcondc);
00753 
00754 /*                    Print information about the tests that did not pass */
00755 /*                    the threshold. */
00756 
00757                         if (! trfcon) {
00758                             for (k = k1; k <= 7; ++k) {
00759                                 if (result[k - 1] >= *thresh) {
00760                                     if (nfail == 0 && nerrs == 0) {
00761                                         aladhd_(nout, path);
00762                                     }
00763                                     if (prefac) {
00764                                         io___62.ciunit = *nout;
00765                                         s_wsfe(&io___62);
00766                                         do_fio(&c__1, "ZGESVX", (ftnlen)6);
00767                                         do_fio(&c__1, fact, (ftnlen)1);
00768                                         do_fio(&c__1, trans, (ftnlen)1);
00769                                         do_fio(&c__1, (char *)&n, (ftnlen)
00770                                                 sizeof(integer));
00771                                         do_fio(&c__1, equed, (ftnlen)1);
00772                                         do_fio(&c__1, (char *)&imat, (ftnlen)
00773                                                 sizeof(integer));
00774                                         do_fio(&c__1, (char *)&k, (ftnlen)
00775                                                 sizeof(integer));
00776                                         do_fio(&c__1, (char *)&result[k - 1], 
00777                                                 (ftnlen)sizeof(doublereal));
00778                                         e_wsfe();
00779                                     } else {
00780                                         io___63.ciunit = *nout;
00781                                         s_wsfe(&io___63);
00782                                         do_fio(&c__1, "ZGESVX", (ftnlen)6);
00783                                         do_fio(&c__1, fact, (ftnlen)1);
00784                                         do_fio(&c__1, trans, (ftnlen)1);
00785                                         do_fio(&c__1, (char *)&n, (ftnlen)
00786                                                 sizeof(integer));
00787                                         do_fio(&c__1, (char *)&imat, (ftnlen)
00788                                                 sizeof(integer));
00789                                         do_fio(&c__1, (char *)&k, (ftnlen)
00790                                                 sizeof(integer));
00791                                         do_fio(&c__1, (char *)&result[k - 1], 
00792                                                 (ftnlen)sizeof(doublereal));
00793                                         e_wsfe();
00794                                     }
00795                                     ++nfail;
00796                                 }
00797 /* L40: */
00798                             }
00799                             nrun = nrun + 7 - k1;
00800                         } else {
00801                             if (result[0] >= *thresh && ! prefac) {
00802                                 if (nfail == 0 && nerrs == 0) {
00803                                     aladhd_(nout, path);
00804                                 }
00805                                 if (prefac) {
00806                                     io___64.ciunit = *nout;
00807                                     s_wsfe(&io___64);
00808                                     do_fio(&c__1, "ZGESVX", (ftnlen)6);
00809                                     do_fio(&c__1, fact, (ftnlen)1);
00810                                     do_fio(&c__1, trans, (ftnlen)1);
00811                                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
00812                                             integer));
00813                                     do_fio(&c__1, equed, (ftnlen)1);
00814                                     do_fio(&c__1, (char *)&imat, (ftnlen)
00815                                             sizeof(integer));
00816                                     do_fio(&c__1, (char *)&c__1, (ftnlen)
00817                                             sizeof(integer));
00818                                     do_fio(&c__1, (char *)&result[0], (ftnlen)
00819                                             sizeof(doublereal));
00820                                     e_wsfe();
00821                                 } else {
00822                                     io___65.ciunit = *nout;
00823                                     s_wsfe(&io___65);
00824                                     do_fio(&c__1, "ZGESVX", (ftnlen)6);
00825                                     do_fio(&c__1, fact, (ftnlen)1);
00826                                     do_fio(&c__1, trans, (ftnlen)1);
00827                                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
00828                                             integer));
00829                                     do_fio(&c__1, (char *)&imat, (ftnlen)
00830                                             sizeof(integer));
00831                                     do_fio(&c__1, (char *)&c__1, (ftnlen)
00832                                             sizeof(integer));
00833                                     do_fio(&c__1, (char *)&result[0], (ftnlen)
00834                                             sizeof(doublereal));
00835                                     e_wsfe();
00836                                 }
00837                                 ++nfail;
00838                                 ++nrun;
00839                             }
00840                             if (result[5] >= *thresh) {
00841                                 if (nfail == 0 && nerrs == 0) {
00842                                     aladhd_(nout, path);
00843                                 }
00844                                 if (prefac) {
00845                                     io___66.ciunit = *nout;
00846                                     s_wsfe(&io___66);
00847                                     do_fio(&c__1, "ZGESVX", (ftnlen)6);
00848                                     do_fio(&c__1, fact, (ftnlen)1);
00849                                     do_fio(&c__1, trans, (ftnlen)1);
00850                                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
00851                                             integer));
00852                                     do_fio(&c__1, equed, (ftnlen)1);
00853                                     do_fio(&c__1, (char *)&imat, (ftnlen)
00854                                             sizeof(integer));
00855                                     do_fio(&c__1, (char *)&c__6, (ftnlen)
00856                                             sizeof(integer));
00857                                     do_fio(&c__1, (char *)&result[5], (ftnlen)
00858                                             sizeof(doublereal));
00859                                     e_wsfe();
00860                                 } else {
00861                                     io___67.ciunit = *nout;
00862                                     s_wsfe(&io___67);
00863                                     do_fio(&c__1, "ZGESVX", (ftnlen)6);
00864                                     do_fio(&c__1, fact, (ftnlen)1);
00865                                     do_fio(&c__1, trans, (ftnlen)1);
00866                                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
00867                                             integer));
00868                                     do_fio(&c__1, (char *)&imat, (ftnlen)
00869                                             sizeof(integer));
00870                                     do_fio(&c__1, (char *)&c__6, (ftnlen)
00871                                             sizeof(integer));
00872                                     do_fio(&c__1, (char *)&result[5], (ftnlen)
00873                                             sizeof(doublereal));
00874                                     e_wsfe();
00875                                 }
00876                                 ++nfail;
00877                                 ++nrun;
00878                             }
00879                             if (result[6] >= *thresh) {
00880                                 if (nfail == 0 && nerrs == 0) {
00881                                     aladhd_(nout, path);
00882                                 }
00883                                 if (prefac) {
00884                                     io___68.ciunit = *nout;
00885                                     s_wsfe(&io___68);
00886                                     do_fio(&c__1, "ZGESVX", (ftnlen)6);
00887                                     do_fio(&c__1, fact, (ftnlen)1);
00888                                     do_fio(&c__1, trans, (ftnlen)1);
00889                                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
00890                                             integer));
00891                                     do_fio(&c__1, equed, (ftnlen)1);
00892                                     do_fio(&c__1, (char *)&imat, (ftnlen)
00893                                             sizeof(integer));
00894                                     do_fio(&c__1, (char *)&c__7, (ftnlen)
00895                                             sizeof(integer));
00896                                     do_fio(&c__1, (char *)&result[6], (ftnlen)
00897                                             sizeof(doublereal));
00898                                     e_wsfe();
00899                                 } else {
00900                                     io___69.ciunit = *nout;
00901                                     s_wsfe(&io___69);
00902                                     do_fio(&c__1, "ZGESVX", (ftnlen)6);
00903                                     do_fio(&c__1, fact, (ftnlen)1);
00904                                     do_fio(&c__1, trans, (ftnlen)1);
00905                                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
00906                                             integer));
00907                                     do_fio(&c__1, (char *)&imat, (ftnlen)
00908                                             sizeof(integer));
00909                                     do_fio(&c__1, (char *)&c__7, (ftnlen)
00910                                             sizeof(integer));
00911                                     do_fio(&c__1, (char *)&result[6], (ftnlen)
00912                                             sizeof(doublereal));
00913                                     e_wsfe();
00914                                 }
00915                                 ++nfail;
00916                                 ++nrun;
00917                             }
00918 
00919                         }
00920 
00921 /*                    --- Test ZGESVXX --- */
00922 
00923 /*                    Restore the matrices A and B. */
00924 
00925                         zlacpy_("Full", &n, &n, &asav[1], &lda, &a[1], &lda);
00926                         zlacpy_("Full", &n, nrhs, &bsav[1], &lda, &b[1], &lda);
00927                         if (! prefac) {
00928                             zlaset_("Full", &n, &n, &c_b166, &c_b166, &afac[1]
00929 , &lda);
00930                         }
00931                         zlaset_("Full", &n, nrhs, &c_b166, &c_b166, &x[1], &
00932                                 lda);
00933                         if (iequed > 1 && n > 0) {
00934 
00935 /*                       Equilibrate the matrix if FACT = 'F' and */
00936 /*                       EQUED = 'R', 'C', or 'B'. */
00937 
00938                             zlaqge_(&n, &n, &a[1], &lda, &s[1], &s[n + 1], &
00939                                     rowcnd, &colcnd, &amax, equed);
00940                         }
00941 
00942 /*                    Solve the system and compute the condition number */
00943 /*                    and error bounds using ZGESVXX. */
00944 
00945                         s_copy(srnamc_1.srnamt, "ZGESVXX", (ftnlen)32, (
00946                                 ftnlen)7);
00947                         n_err_bnds__ = 3;
00948 
00949                         dalloc3();
00950 
00951                         zgesvxx_(fact, trans, &n, nrhs, &a[1], &lda, &afac[1], 
00952                                  &lda, &iwork[1], equed, &s[1], &s[n + 1], &b[
00953                                 1], &lda, &x[1], &lda, &rcond, &rpvgrw_svxx__, 
00954                                  berr, &n_err_bnds__, errbnds_n__, 
00955                                 errbnds_c__, &c__0, &c_b166, &work[1], &rwork[
00956                                 1], &info);
00957 
00958                         free3();
00959 
00960 /*                    Check the error code from ZGESVXX. */
00961 
00962                         if (info == n + 1) {
00963                             goto L50;
00964                         }
00965                         if (info != izero) {
00966 /* Writing concatenation */
00967                             i__5[0] = 1, a__1[0] = fact;
00968                             i__5[1] = 1, a__1[1] = trans;
00969                             s_cat(ch__1, a__1, i__5, &c__2, (ftnlen)2);
00970                             alaerh_(path, "ZGESVXX", &info, &izero, ch__1, &n, 
00971                                      &n, &c_n1, &c_n1, nrhs, &imat, &nfail, &
00972                                     nerrs, nout);
00973                             goto L50;
00974                         }
00975 
00976 /*                    Compare rpvgrw_svxx from ZGESVXX with the computed */
00977 /*                    reciprocal pivot growth factor RPVGRW */
00978 
00979                         if (info > 0 && info < n + 1) {
00980                             rpvgrw = zla_rpvgrw__(&n, &info, &a[1], &lda, &
00981                                     afac[1], &lda);
00982                         } else {
00983                             rpvgrw = zla_rpvgrw__(&n, &n, &a[1], &lda, &afac[
00984                                     1], &lda);
00985                         }
00986                         result[6] = (d__1 = rpvgrw - rpvgrw_svxx__, abs(d__1))
00987                                  / max(rpvgrw_svxx__,rpvgrw) / dlamch_("E");
00988 
00989                         if (! prefac) {
00990 
00991 /*                       Reconstruct matrix from factors and compute */
00992 /*                       residual. */
00993 
00994                             zget01_(&n, &n, &a[1], &lda, &afac[1], &lda, &
00995                                     iwork[1], &rwork[(*nrhs << 1) + 1], 
00996                                     result);
00997                             k1 = 1;
00998                         } else {
00999                             k1 = 2;
01000                         }
01001 
01002                         if (info == 0) {
01003                             trfcon = FALSE_;
01004 
01005 /*                       Compute residual of the computed solution. */
01006 
01007                             zlacpy_("Full", &n, nrhs, &bsav[1], &lda, &work[1]
01008 , &lda);
01009                             zget02_(trans, &n, &n, nrhs, &asav[1], &lda, &x[1]
01010 , &lda, &work[1], &lda, &rwork[(*nrhs << 
01011                                     1) + 1], &result[1]);
01012 
01013 /*                       Check solution from generated exact solution. */
01014 
01015                             if (nofact || prefac && lsame_(equed, "N")) {
01016                                 zget04_(&n, nrhs, &x[1], &lda, &xact[1], &lda, 
01017                                          &rcondc, &result[2]);
01018                             } else {
01019                                 if (itran == 1) {
01020                                     roldc = roldo;
01021                                 } else {
01022                                     roldc = roldi;
01023                                 }
01024                                 zget04_(&n, nrhs, &x[1], &lda, &xact[1], &lda, 
01025                                          &roldc, &result[2]);
01026                             }
01027                         } else {
01028                             trfcon = TRUE_;
01029                         }
01030 
01031 /*                    Compare RCOND from ZGESVXX with the computed value */
01032 /*                    in RCONDC. */
01033 
01034                         result[5] = dget06_(&rcond, &rcondc);
01035 
01036 /*                    Print information about the tests that did not pass */
01037 /*                    the threshold. */
01038 
01039                         if (! trfcon) {
01040                             for (k = k1; k <= 7; ++k) {
01041                                 if (result[k - 1] >= *thresh) {
01042                                     if (nfail == 0 && nerrs == 0) {
01043                                         aladhd_(nout, path);
01044                                     }
01045                                     if (prefac) {
01046                                         io___75.ciunit = *nout;
01047                                         s_wsfe(&io___75);
01048                                         do_fio(&c__1, "ZGESVXX", (ftnlen)7);
01049                                         do_fio(&c__1, fact, (ftnlen)1);
01050                                         do_fio(&c__1, trans, (ftnlen)1);
01051                                         do_fio(&c__1, (char *)&n, (ftnlen)
01052                                                 sizeof(integer));
01053                                         do_fio(&c__1, equed, (ftnlen)1);
01054                                         do_fio(&c__1, (char *)&imat, (ftnlen)
01055                                                 sizeof(integer));
01056                                         do_fio(&c__1, (char *)&k, (ftnlen)
01057                                                 sizeof(integer));
01058                                         do_fio(&c__1, (char *)&result[k - 1], 
01059                                                 (ftnlen)sizeof(doublereal));
01060                                         e_wsfe();
01061                                     } else {
01062                                         io___76.ciunit = *nout;
01063                                         s_wsfe(&io___76);
01064                                         do_fio(&c__1, "ZGESVXX", (ftnlen)7);
01065                                         do_fio(&c__1, fact, (ftnlen)1);
01066                                         do_fio(&c__1, trans, (ftnlen)1);
01067                                         do_fio(&c__1, (char *)&n, (ftnlen)
01068                                                 sizeof(integer));
01069                                         do_fio(&c__1, (char *)&imat, (ftnlen)
01070                                                 sizeof(integer));
01071                                         do_fio(&c__1, (char *)&k, (ftnlen)
01072                                                 sizeof(integer));
01073                                         do_fio(&c__1, (char *)&result[k - 1], 
01074                                                 (ftnlen)sizeof(doublereal));
01075                                         e_wsfe();
01076                                     }
01077                                     ++nfail;
01078                                 }
01079 /* L45: */
01080                             }
01081                             nrun = nrun + 7 - k1;
01082                         } else {
01083                             if (result[0] >= *thresh && ! prefac) {
01084                                 if (nfail == 0 && nerrs == 0) {
01085                                     aladhd_(nout, path);
01086                                 }
01087                                 if (prefac) {
01088                                     io___77.ciunit = *nout;
01089                                     s_wsfe(&io___77);
01090                                     do_fio(&c__1, "ZGESVXX", (ftnlen)7);
01091                                     do_fio(&c__1, fact, (ftnlen)1);
01092                                     do_fio(&c__1, trans, (ftnlen)1);
01093                                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
01094                                             integer));
01095                                     do_fio(&c__1, equed, (ftnlen)1);
01096                                     do_fio(&c__1, (char *)&imat, (ftnlen)
01097                                             sizeof(integer));
01098                                     do_fio(&c__1, (char *)&c__1, (ftnlen)
01099                                             sizeof(integer));
01100                                     do_fio(&c__1, (char *)&result[0], (ftnlen)
01101                                             sizeof(doublereal));
01102                                     e_wsfe();
01103                                 } else {
01104                                     io___78.ciunit = *nout;
01105                                     s_wsfe(&io___78);
01106                                     do_fio(&c__1, "ZGESVXX", (ftnlen)7);
01107                                     do_fio(&c__1, fact, (ftnlen)1);
01108                                     do_fio(&c__1, trans, (ftnlen)1);
01109                                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
01110                                             integer));
01111                                     do_fio(&c__1, (char *)&imat, (ftnlen)
01112                                             sizeof(integer));
01113                                     do_fio(&c__1, (char *)&c__1, (ftnlen)
01114                                             sizeof(integer));
01115                                     do_fio(&c__1, (char *)&result[0], (ftnlen)
01116                                             sizeof(doublereal));
01117                                     e_wsfe();
01118                                 }
01119                                 ++nfail;
01120                                 ++nrun;
01121                             }
01122                             if (result[5] >= *thresh) {
01123                                 if (nfail == 0 && nerrs == 0) {
01124                                     aladhd_(nout, path);
01125                                 }
01126                                 if (prefac) {
01127                                     io___79.ciunit = *nout;
01128                                     s_wsfe(&io___79);
01129                                     do_fio(&c__1, "ZGESVXX", (ftnlen)7);
01130                                     do_fio(&c__1, fact, (ftnlen)1);
01131                                     do_fio(&c__1, trans, (ftnlen)1);
01132                                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
01133                                             integer));
01134                                     do_fio(&c__1, equed, (ftnlen)1);
01135                                     do_fio(&c__1, (char *)&imat, (ftnlen)
01136                                             sizeof(integer));
01137                                     do_fio(&c__1, (char *)&c__6, (ftnlen)
01138                                             sizeof(integer));
01139                                     do_fio(&c__1, (char *)&result[5], (ftnlen)
01140                                             sizeof(doublereal));
01141                                     e_wsfe();
01142                                 } else {
01143                                     io___80.ciunit = *nout;
01144                                     s_wsfe(&io___80);
01145                                     do_fio(&c__1, "ZGESVXX", (ftnlen)7);
01146                                     do_fio(&c__1, fact, (ftnlen)1);
01147                                     do_fio(&c__1, trans, (ftnlen)1);
01148                                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
01149                                             integer));
01150                                     do_fio(&c__1, (char *)&imat, (ftnlen)
01151                                             sizeof(integer));
01152                                     do_fio(&c__1, (char *)&c__6, (ftnlen)
01153                                             sizeof(integer));
01154                                     do_fio(&c__1, (char *)&result[5], (ftnlen)
01155                                             sizeof(doublereal));
01156                                     e_wsfe();
01157                                 }
01158                                 ++nfail;
01159                                 ++nrun;
01160                             }
01161                             if (result[6] >= *thresh) {
01162                                 if (nfail == 0 && nerrs == 0) {
01163                                     aladhd_(nout, path);
01164                                 }
01165                                 if (prefac) {
01166                                     io___81.ciunit = *nout;
01167                                     s_wsfe(&io___81);
01168                                     do_fio(&c__1, "ZGESVXX", (ftnlen)7);
01169                                     do_fio(&c__1, fact, (ftnlen)1);
01170                                     do_fio(&c__1, trans, (ftnlen)1);
01171                                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
01172                                             integer));
01173                                     do_fio(&c__1, equed, (ftnlen)1);
01174                                     do_fio(&c__1, (char *)&imat, (ftnlen)
01175                                             sizeof(integer));
01176                                     do_fio(&c__1, (char *)&c__7, (ftnlen)
01177                                             sizeof(integer));
01178                                     do_fio(&c__1, (char *)&result[6], (ftnlen)
01179                                             sizeof(doublereal));
01180                                     e_wsfe();
01181                                 } else {
01182                                     io___82.ciunit = *nout;
01183                                     s_wsfe(&io___82);
01184                                     do_fio(&c__1, "ZGESVXX", (ftnlen)7);
01185                                     do_fio(&c__1, fact, (ftnlen)1);
01186                                     do_fio(&c__1, trans, (ftnlen)1);
01187                                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
01188                                             integer));
01189                                     do_fio(&c__1, (char *)&imat, (ftnlen)
01190                                             sizeof(integer));
01191                                     do_fio(&c__1, (char *)&c__7, (ftnlen)
01192                                             sizeof(integer));
01193                                     do_fio(&c__1, (char *)&result[6], (ftnlen)
01194                                             sizeof(doublereal));
01195                                     e_wsfe();
01196                                 }
01197                                 ++nfail;
01198                                 ++nrun;
01199                             }
01200 
01201                         }
01202 
01203 L50:
01204                         ;
01205                     }
01206 L60:
01207                     ;
01208                 }
01209 /* L70: */
01210             }
01211 L80:
01212             ;
01213         }
01214 /* L90: */
01215     }
01216 
01217 /*     Print a summary of the results. */
01218 
01219     alasvm_(path, nout, &nfail, &nrun, &nerrs);
01220 
01221 /*     Test Error Bounds for ZGESVXX */
01222     zebchvxx_(thresh, path);
01223     return 0;
01224 
01225 /*     End of ZDRVGE */
01226 
01227 } /* zdrvge_ */

swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:56:22