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

swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:55:40