zdrvge.c
Go to the documentation of this file.
00001 /* zdrvge.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 "blaswrap.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 
00042 /* Subroutine */ int zdrvge_(logical *dotype, integer *nn, integer *nval, 
00043         integer *nrhs, doublereal *thresh, logical *tsterr, integer *nmax, 
00044         doublecomplex *a, doublecomplex *afac, doublecomplex *asav, 
00045         doublecomplex *b, doublecomplex *bsav, doublecomplex *x, 
00046         doublecomplex *xact, doublereal *s, doublecomplex *work, doublereal *
00047         rwork, integer *iwork, integer *nout)
00048 {
00049     /* Initialized data */
00050 
00051     static integer iseedy[4] = { 1988,1989,1990,1991 };
00052     static char transs[1*3] = "N" "T" "C";
00053     static char facts[1*3] = "F" "N" "E";
00054     static char equeds[1*4] = "N" "R" "C" "B";
00055 
00056     /* Format strings */
00057     static char fmt_9999[] = "(1x,a,\002, N =\002,i5,\002, type \002,i2,\002"
00058             ", test(\002,i2,\002) =\002,g12.5)";
00059     static char fmt_9997[] = "(1x,a,\002, FACT='\002,a1,\002', TRANS='\002,a"
00060             "1,\002', N=\002,i5,\002, EQUED='\002,a1,\002', type \002,i2,\002"
00061             ", test(\002,i1,\002)=\002,g12.5)";
00062     static char fmt_9998[] = "(1x,a,\002, FACT='\002,a1,\002', TRANS='\002,a"
00063             "1,\002', N=\002,i5,\002, type \002,i2,\002, test(\002,i1,\002)"
00064             "=\002,g12.5)";
00065 
00066     /* System generated locals */
00067     address a__1[2];
00068     integer i__1, i__2, i__3, i__4, i__5[2];
00069     doublereal d__1, d__2;
00070     char ch__1[2];
00071 
00072     /* Builtin functions */
00073     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
00074     integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
00075     /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
00076 
00077     /* Local variables */
00078     integer i__, k, n, k1, nb, in, kl, ku, nt, lda;
00079     char fact[1];
00080     integer ioff, mode;
00081     doublereal amax;
00082     char path[3];
00083     integer imat, info;
00084     char dist[1];
00085     doublereal rdum[1];
00086     char type__[1];
00087     integer nrun, ifact, nfail, iseed[4], nfact;
00088     extern doublereal dget06_(doublereal *, doublereal *);
00089     extern logical lsame_(char *, char *);
00090     char equed[1];
00091     integer nbmin;
00092     doublereal rcond, roldc;
00093     integer nimat;
00094     doublereal roldi;
00095     extern /* Subroutine */ int zget01_(integer *, integer *, doublecomplex *, 
00096              integer *, doublecomplex *, integer *, integer *, doublereal *, 
00097             doublereal *), zget02_(char *, integer *, integer *, integer *, 
00098             doublecomplex *, integer *, doublecomplex *, integer *, 
00099             doublecomplex *, integer *, doublereal *, doublereal *);
00100     doublereal anorm;
00101     integer itran;
00102     extern /* Subroutine */ int zget04_(integer *, integer *, doublecomplex *, 
00103              integer *, doublecomplex *, integer *, doublereal *, doublereal *
00104 );
00105     logical equil;
00106     doublereal roldo;
00107     extern /* Subroutine */ int zget07_(char *, integer *, integer *, 
00108             doublecomplex *, integer *, doublecomplex *, integer *, 
00109             doublecomplex *, integer *, doublecomplex *, integer *, 
00110             doublereal *, logical *, doublereal *, doublereal *);
00111     char trans[1];
00112     integer izero, nerrs, lwork;
00113     extern /* Subroutine */ int zgesv_(integer *, integer *, doublecomplex *, 
00114             integer *, integer *, doublecomplex *, integer *, integer *);
00115     logical zerot;
00116     char xtype[1];
00117     extern /* Subroutine */ int zlatb4_(char *, integer *, integer *, integer 
00118             *, char *, integer *, integer *, doublereal *, integer *, 
00119             doublereal *, char *), aladhd_(integer *, 
00120             char *);
00121     extern doublereal dlamch_(char *);
00122     extern /* Subroutine */ int alaerh_(char *, char *, integer *, integer *, 
00123             char *, integer *, integer *, integer *, integer *, integer *, 
00124             integer *, integer *, integer *, integer *);
00125     logical prefac;
00126     doublereal colcnd, rcondc;
00127     logical nofact;
00128     integer iequed;
00129     doublereal rcondi;
00130     extern doublereal zlange_(char *, integer *, integer *, doublecomplex *, 
00131             integer *, doublereal *);
00132     extern /* Subroutine */ int alasvm_(char *, integer *, integer *, integer 
00133             *, integer *);
00134     doublereal cndnum, anormi, rcondo, ainvnm;
00135     extern /* Subroutine */ int zlaqge_(integer *, integer *, doublecomplex *, 
00136              integer *, doublereal *, doublereal *, doublereal *, doublereal *
00137 , doublereal *, char *);
00138     logical trfcon;
00139     doublereal anormo, rowcnd;
00140     extern /* Subroutine */ int xlaenv_(integer *, integer *), zgeequ_(
00141             integer *, integer *, doublecomplex *, integer *, doublereal *, 
00142             doublereal *, doublereal *, doublereal *, doublereal *, integer *)
00143             , zgetrf_(integer *, integer *, doublecomplex *, integer *, 
00144             integer *, integer *), zlacpy_(char *, integer *, integer *, 
00145             doublecomplex *, integer *, doublecomplex *, integer *), 
00146             zgetri_(integer *, doublecomplex *, integer *, integer *, 
00147             doublecomplex *, integer *, integer *), zlarhs_(char *, char *, 
00148             char *, char *, integer *, integer *, integer *, integer *, 
00149             integer *, doublecomplex *, integer *, doublecomplex *, integer *, 
00150              doublecomplex *, integer *, integer *, integer *), zlaset_(char *, integer *, integer *, 
00151             doublecomplex *, doublecomplex *, doublecomplex *, integer *);
00152     extern doublereal zlantr_(char *, char *, char *, integer *, integer *, 
00153             doublecomplex *, integer *, doublereal *);
00154     extern /* Subroutine */ int zlatms_(integer *, integer *, char *, integer 
00155             *, char *, doublereal *, integer *, doublereal *, doublereal *, 
00156             integer *, integer *, char *, doublecomplex *, integer *, 
00157             doublecomplex *, integer *);
00158     doublereal result[7];
00159     extern /* Subroutine */ int zgesvx_(char *, char *, integer *, integer *, 
00160             doublecomplex *, integer *, doublecomplex *, integer *, integer *, 
00161              char *, doublereal *, doublereal *, doublecomplex *, integer *, 
00162             doublecomplex *, integer *, doublereal *, doublereal *, 
00163             doublereal *, doublecomplex *, doublereal *, integer *);
00164     doublereal rpvgrw;
00165     extern /* Subroutine */ int zerrvx_(char *, integer *);
00166 
00167     /* Fortran I/O blocks */
00168     static cilist io___55 = { 0, 0, 0, fmt_9999, 0 };
00169     static cilist io___62 = { 0, 0, 0, fmt_9997, 0 };
00170     static cilist io___63 = { 0, 0, 0, fmt_9998, 0 };
00171     static cilist io___64 = { 0, 0, 0, fmt_9997, 0 };
00172     static cilist io___65 = { 0, 0, 0, fmt_9998, 0 };
00173     static cilist io___66 = { 0, 0, 0, fmt_9997, 0 };
00174     static cilist io___67 = { 0, 0, 0, fmt_9998, 0 };
00175     static cilist io___68 = { 0, 0, 0, fmt_9997, 0 };
00176     static cilist io___69 = { 0, 0, 0, fmt_9998, 0 };
00177 
00178 
00179 
00180 /*  -- LAPACK test routine (version 3.1) -- */
00181 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00182 /*     November 2006 */
00183 
00184 /*     .. Scalar Arguments .. */
00185 /*     .. */
00186 /*     .. Array Arguments .. */
00187 /*     .. */
00188 
00189 /*  Purpose */
00190 /*  ======= */
00191 
00192 /*  ZDRVGE tests the driver routines ZGESV and -SVX. */
00193 
00194 /*  Arguments */
00195 /*  ========= */
00196 
00197 /*  DOTYPE  (input) LOGICAL array, dimension (NTYPES) */
00198 /*          The matrix types to be used for testing.  Matrices of type j */
00199 /*          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = */
00200 /*          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. */
00201 
00202 /*  NN      (input) INTEGER */
00203 /*          The number of values of N contained in the vector NVAL. */
00204 
00205 /*  NVAL    (input) INTEGER array, dimension (NN) */
00206 /*          The values of the matrix column dimension N. */
00207 
00208 /*  NRHS    (input) INTEGER */
00209 /*          The number of right hand side vectors to be generated for */
00210 /*          each linear system. */
00211 
00212 /*  THRESH  (input) DOUBLE PRECISION */
00213 /*          The threshold value for the test ratios.  A result is */
00214 /*          included in the output file if RESULT >= THRESH.  To have */
00215 /*          every test ratio printed, use THRESH = 0. */
00216 
00217 /*  TSTERR  (input) LOGICAL */
00218 /*          Flag that indicates whether error exits are to be tested. */
00219 
00220 /*  NMAX    (input) INTEGER */
00221 /*          The maximum value permitted for N, used in dimensioning the */
00222 /*          work arrays. */
00223 
00224 /*  A       (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) */
00225 
00226 /*  AFAC    (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) */
00227 
00228 /*  ASAV    (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) */
00229 
00230 /*  B       (workspace) COMPLEX*16 array, dimension (NMAX*NRHS) */
00231 
00232 /*  BSAV    (workspace) COMPLEX*16 array, dimension (NMAX*NRHS) */
00233 
00234 /*  X       (workspace) COMPLEX*16 array, dimension (NMAX*NRHS) */
00235 
00236 /*  XACT    (workspace) COMPLEX*16 array, dimension (NMAX*NRHS) */
00237 
00238 /*  S       (workspace) DOUBLE PRECISION array, dimension (2*NMAX) */
00239 
00240 /*  WORK    (workspace) COMPLEX*16 array, dimension */
00241 /*                      (NMAX*max(3,NRHS)) */
00242 
00243 /*  RWORK   (workspace) DOUBLE PRECISION array, dimension (2*NRHS+NMAX) */
00244 
00245 /*  IWORK   (workspace) INTEGER array, dimension (NMAX) */
00246 
00247 /*  NOUT    (input) INTEGER */
00248 /*          The unit number for output. */
00249 
00250 /*  ===================================================================== */
00251 
00252 /*     .. Parameters .. */
00253 /*     .. */
00254 /*     .. Local Scalars .. */
00255 /*     .. */
00256 /*     .. Local Arrays .. */
00257 /*     .. */
00258 /*     .. External Functions .. */
00259 /*     .. */
00260 /*     .. External Subroutines .. */
00261 /*     .. */
00262 /*     .. Intrinsic Functions .. */
00263 /*     .. */
00264 /*     .. Scalars in Common .. */
00265 /*     .. */
00266 /*     .. Common blocks .. */
00267 /*     .. */
00268 /*     .. Data statements .. */
00269     /* Parameter adjustments */
00270     --iwork;
00271     --rwork;
00272     --work;
00273     --s;
00274     --xact;
00275     --x;
00276     --bsav;
00277     --b;
00278     --asav;
00279     --afac;
00280     --a;
00281     --nval;
00282     --dotype;
00283 
00284     /* Function Body */
00285 /*     .. */
00286 /*     .. Executable Statements .. */
00287 
00288 /*     Initialize constants and the random number seed. */
00289 
00290     s_copy(path, "Zomplex precision", (ftnlen)1, (ftnlen)17);
00291     s_copy(path + 1, "GE", (ftnlen)2, (ftnlen)2);
00292     nrun = 0;
00293     nfail = 0;
00294     nerrs = 0;
00295     for (i__ = 1; i__ <= 4; ++i__) {
00296         iseed[i__ - 1] = iseedy[i__ - 1];
00297 /* L10: */
00298     }
00299 
00300 /*     Test the error exits */
00301 
00302     if (*tsterr) {
00303         zerrvx_(path, nout);
00304     }
00305     infoc_1.infot = 0;
00306 
00307 /*     Set the block size and minimum block size for testing. */
00308 
00309     nb = 1;
00310     nbmin = 2;
00311     xlaenv_(&c__1, &nb);
00312     xlaenv_(&c__2, &nbmin);
00313 
00314 /*     Do for each value of N in NVAL */
00315 
00316     i__1 = *nn;
00317     for (in = 1; in <= i__1; ++in) {
00318         n = nval[in];
00319         lda = max(n,1);
00320         *(unsigned char *)xtype = 'N';
00321         nimat = 11;
00322         if (n <= 0) {
00323             nimat = 1;
00324         }
00325 
00326         i__2 = nimat;
00327         for (imat = 1; imat <= i__2; ++imat) {
00328 
00329 /*           Do the tests only if DOTYPE( IMAT ) is true. */
00330 
00331             if (! dotype[imat]) {
00332                 goto L80;
00333             }
00334 
00335 /*           Skip types 5, 6, or 7 if the matrix size is too small. */
00336 
00337             zerot = imat >= 5 && imat <= 7;
00338             if (zerot && n < imat - 4) {
00339                 goto L80;
00340             }
00341 
00342 /*           Set up parameters with ZLATB4 and generate a test matrix */
00343 /*           with ZLATMS. */
00344 
00345             zlatb4_(path, &imat, &n, &n, type__, &kl, &ku, &anorm, &mode, &
00346                     cndnum, dist);
00347             rcondc = 1. / cndnum;
00348 
00349             s_copy(srnamc_1.srnamt, "ZLATMS", (ftnlen)32, (ftnlen)6);
00350             zlatms_(&n, &n, dist, iseed, type__, &rwork[1], &mode, &cndnum, &
00351                     anorm, &kl, &ku, "No packing", &a[1], &lda, &work[1], &
00352                     info);
00353 
00354 /*           Check error code from ZLATMS. */
00355 
00356             if (info != 0) {
00357                 alaerh_(path, "ZLATMS", &info, &c__0, " ", &n, &n, &c_n1, &
00358                         c_n1, &c_n1, &imat, &nfail, &nerrs, nout);
00359                 goto L80;
00360             }
00361 
00362 /*           For types 5-7, zero one or more columns of the matrix to */
00363 /*           test that INFO is returned correctly. */
00364 
00365             if (zerot) {
00366                 if (imat == 5) {
00367                     izero = 1;
00368                 } else if (imat == 6) {
00369                     izero = n;
00370                 } else {
00371                     izero = n / 2 + 1;
00372                 }
00373                 ioff = (izero - 1) * lda;
00374                 if (imat < 7) {
00375                     i__3 = n;
00376                     for (i__ = 1; i__ <= i__3; ++i__) {
00377                         i__4 = ioff + i__;
00378                         a[i__4].r = 0., a[i__4].i = 0.;
00379 /* L20: */
00380                     }
00381                 } else {
00382                     i__3 = n - izero + 1;
00383                     zlaset_("Full", &n, &i__3, &c_b20, &c_b20, &a[ioff + 1], &
00384                             lda);
00385                 }
00386             } else {
00387                 izero = 0;
00388             }
00389 
00390 /*           Save a copy of the matrix A in ASAV. */
00391 
00392             zlacpy_("Full", &n, &n, &a[1], &lda, &asav[1], &lda);
00393 
00394             for (iequed = 1; iequed <= 4; ++iequed) {
00395                 *(unsigned char *)equed = *(unsigned char *)&equeds[iequed - 
00396                         1];
00397                 if (iequed == 1) {
00398                     nfact = 3;
00399                 } else {
00400                     nfact = 1;
00401                 }
00402 
00403                 i__3 = nfact;
00404                 for (ifact = 1; ifact <= i__3; ++ifact) {
00405                     *(unsigned char *)fact = *(unsigned char *)&facts[ifact - 
00406                             1];
00407                     prefac = lsame_(fact, "F");
00408                     nofact = lsame_(fact, "N");
00409                     equil = lsame_(fact, "E");
00410 
00411                     if (zerot) {
00412                         if (prefac) {
00413                             goto L60;
00414                         }
00415                         rcondo = 0.;
00416                         rcondi = 0.;
00417 
00418                     } else if (! nofact) {
00419 
00420 /*                    Compute the condition number for comparison with */
00421 /*                    the value returned by ZGESVX (FACT = 'N' reuses */
00422 /*                    the condition number from the previous iteration */
00423 /*                    with FACT = 'F'). */
00424 
00425                         zlacpy_("Full", &n, &n, &asav[1], &lda, &afac[1], &
00426                                 lda);
00427                         if (equil || iequed > 1) {
00428 
00429 /*                       Compute row and column scale factors to */
00430 /*                       equilibrate the matrix A. */
00431 
00432                             zgeequ_(&n, &n, &afac[1], &lda, &s[1], &s[n + 1], 
00433                                     &rowcnd, &colcnd, &amax, &info);
00434                             if (info == 0 && n > 0) {
00435                                 if (lsame_(equed, "R")) 
00436                                         {
00437                                     rowcnd = 0.;
00438                                     colcnd = 1.;
00439                                 } else if (lsame_(equed, "C")) {
00440                                     rowcnd = 1.;
00441                                     colcnd = 0.;
00442                                 } else if (lsame_(equed, "B")) {
00443                                     rowcnd = 0.;
00444                                     colcnd = 0.;
00445                                 }
00446 
00447 /*                          Equilibrate the matrix. */
00448 
00449                                 zlaqge_(&n, &n, &afac[1], &lda, &s[1], &s[n + 
00450                                         1], &rowcnd, &colcnd, &amax, equed);
00451                             }
00452                         }
00453 
00454 /*                    Save the condition number of the non-equilibrated */
00455 /*                    system for use in ZGET04. */
00456 
00457                         if (equil) {
00458                             roldo = rcondo;
00459                             roldi = rcondi;
00460                         }
00461 
00462 /*                    Compute the 1-norm and infinity-norm of A. */
00463 
00464                         anormo = zlange_("1", &n, &n, &afac[1], &lda, &rwork[
00465                                 1]);
00466                         anormi = zlange_("I", &n, &n, &afac[1], &lda, &rwork[
00467                                 1]);
00468 
00469 /*                    Factor the matrix A. */
00470 
00471                         zgetrf_(&n, &n, &afac[1], &lda, &iwork[1], &info);
00472 
00473 /*                    Form the inverse of A. */
00474 
00475                         zlacpy_("Full", &n, &n, &afac[1], &lda, &a[1], &lda);
00476                         lwork = *nmax * max(3,*nrhs);
00477                         zgetri_(&n, &a[1], &lda, &iwork[1], &work[1], &lwork, 
00478                                 &info);
00479 
00480 /*                    Compute the 1-norm condition number of A. */
00481 
00482                         ainvnm = zlange_("1", &n, &n, &a[1], &lda, &rwork[1]);
00483                         if (anormo <= 0. || ainvnm <= 0.) {
00484                             rcondo = 1.;
00485                         } else {
00486                             rcondo = 1. / anormo / ainvnm;
00487                         }
00488 
00489 /*                    Compute the infinity-norm condition number of A. */
00490 
00491                         ainvnm = zlange_("I", &n, &n, &a[1], &lda, &rwork[1]);
00492                         if (anormi <= 0. || ainvnm <= 0.) {
00493                             rcondi = 1.;
00494                         } else {
00495                             rcondi = 1. / anormi / ainvnm;
00496                         }
00497                     }
00498 
00499                     for (itran = 1; itran <= 3; ++itran) {
00500 
00501 /*                    Do for each value of TRANS. */
00502 
00503                         *(unsigned char *)trans = *(unsigned char *)&transs[
00504                                 itran - 1];
00505                         if (itran == 1) {
00506                             rcondc = rcondo;
00507                         } else {
00508                             rcondc = rcondi;
00509                         }
00510 
00511 /*                    Restore the matrix A. */
00512 
00513                         zlacpy_("Full", &n, &n, &asav[1], &lda, &a[1], &lda);
00514 
00515 /*                    Form an exact solution and set the right hand side. */
00516 
00517                         s_copy(srnamc_1.srnamt, "ZLARHS", (ftnlen)32, (ftnlen)
00518                                 6);
00519                         zlarhs_(path, xtype, "Full", trans, &n, &n, &kl, &ku, 
00520                                 nrhs, &a[1], &lda, &xact[1], &lda, &b[1], &
00521                                 lda, iseed, &info);
00522                         *(unsigned char *)xtype = 'C';
00523                         zlacpy_("Full", &n, nrhs, &b[1], &lda, &bsav[1], &lda);
00524 
00525                         if (nofact && itran == 1) {
00526 
00527 /*                       --- Test ZGESV  --- */
00528 
00529 /*                       Compute the LU factorization of the matrix and */
00530 /*                       solve the system. */
00531 
00532                             zlacpy_("Full", &n, &n, &a[1], &lda, &afac[1], &
00533                                     lda);
00534                             zlacpy_("Full", &n, nrhs, &b[1], &lda, &x[1], &
00535                                     lda);
00536 
00537                             s_copy(srnamc_1.srnamt, "ZGESV ", (ftnlen)32, (
00538                                     ftnlen)6);
00539                             zgesv_(&n, nrhs, &afac[1], &lda, &iwork[1], &x[1], 
00540                                      &lda, &info);
00541 
00542 /*                       Check error code from ZGESV . */
00543 
00544                             if (info != izero) {
00545                                 alaerh_(path, "ZGESV ", &info, &izero, " ", &
00546                                         n, &n, &c_n1, &c_n1, nrhs, &imat, &
00547                                         nfail, &nerrs, nout);
00548                             }
00549 
00550 /*                       Reconstruct matrix from factors and compute */
00551 /*                       residual. */
00552 
00553                             zget01_(&n, &n, &a[1], &lda, &afac[1], &lda, &
00554                                     iwork[1], &rwork[1], result);
00555                             nt = 1;
00556                             if (izero == 0) {
00557 
00558 /*                          Compute residual of the computed solution. */
00559 
00560                                 zlacpy_("Full", &n, nrhs, &b[1], &lda, &work[
00561                                         1], &lda);
00562                                 zget02_("No transpose", &n, &n, nrhs, &a[1], &
00563                                         lda, &x[1], &lda, &work[1], &lda, &
00564                                         rwork[1], &result[1]);
00565 
00566 /*                          Check solution from generated exact solution. */
00567 
00568                                 zget04_(&n, nrhs, &x[1], &lda, &xact[1], &lda, 
00569                                          &rcondc, &result[2]);
00570                                 nt = 3;
00571                             }
00572 
00573 /*                       Print information about the tests that did not */
00574 /*                       pass the threshold. */
00575 
00576                             i__4 = nt;
00577                             for (k = 1; k <= i__4; ++k) {
00578                                 if (result[k - 1] >= *thresh) {
00579                                     if (nfail == 0 && nerrs == 0) {
00580                                         aladhd_(nout, path);
00581                                     }
00582                                     io___55.ciunit = *nout;
00583                                     s_wsfe(&io___55);
00584                                     do_fio(&c__1, "ZGESV ", (ftnlen)6);
00585                                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
00586                                             integer));
00587                                     do_fio(&c__1, (char *)&imat, (ftnlen)
00588                                             sizeof(integer));
00589                                     do_fio(&c__1, (char *)&k, (ftnlen)sizeof(
00590                                             integer));
00591                                     do_fio(&c__1, (char *)&result[k - 1], (
00592                                             ftnlen)sizeof(doublereal));
00593                                     e_wsfe();
00594                                     ++nfail;
00595                                 }
00596 /* L30: */
00597                             }
00598                             nrun += nt;
00599                         }
00600 
00601 /*                    --- Test ZGESVX --- */
00602 
00603                         if (! prefac) {
00604                             zlaset_("Full", &n, &n, &c_b20, &c_b20, &afac[1], 
00605                                     &lda);
00606                         }
00607                         zlaset_("Full", &n, nrhs, &c_b20, &c_b20, &x[1], &lda);
00608                         if (iequed > 1 && n > 0) {
00609 
00610 /*                       Equilibrate the matrix if FACT = 'F' and */
00611 /*                       EQUED = 'R', 'C', or 'B'. */
00612 
00613                             zlaqge_(&n, &n, &a[1], &lda, &s[1], &s[n + 1], &
00614                                     rowcnd, &colcnd, &amax, equed);
00615                         }
00616 
00617 /*                    Solve the system and compute the condition number */
00618 /*                    and error bounds using ZGESVX. */
00619 
00620                         s_copy(srnamc_1.srnamt, "ZGESVX", (ftnlen)32, (ftnlen)
00621                                 6);
00622                         zgesvx_(fact, trans, &n, nrhs, &a[1], &lda, &afac[1], 
00623                                 &lda, &iwork[1], equed, &s[1], &s[n + 1], &b[
00624                                 1], &lda, &x[1], &lda, &rcond, &rwork[1], &
00625                                 rwork[*nrhs + 1], &work[1], &rwork[(*nrhs << 
00626                                 1) + 1], &info);
00627 
00628 /*                    Check the error code from ZGESVX. */
00629 
00630                         if (info != izero) {
00631 /* Writing concatenation */
00632                             i__5[0] = 1, a__1[0] = fact;
00633                             i__5[1] = 1, a__1[1] = trans;
00634                             s_cat(ch__1, a__1, i__5, &c__2, (ftnlen)2);
00635                             alaerh_(path, "ZGESVX", &info, &izero, ch__1, &n, 
00636                                     &n, &c_n1, &c_n1, nrhs, &imat, &nfail, &
00637                                     nerrs, nout);
00638                         }
00639 
00640 /*                    Compare RWORK(2*NRHS+1) from ZGESVX with the */
00641 /*                    computed reciprocal pivot growth factor RPVGRW */
00642 
00643                         if (info != 0) {
00644                             rpvgrw = zlantr_("M", "U", "N", &info, &info, &
00645                                     afac[1], &lda, rdum);
00646                             if (rpvgrw == 0.) {
00647                                 rpvgrw = 1.;
00648                             } else {
00649                                 rpvgrw = zlange_("M", &n, &info, &a[1], &lda, 
00650                                         rdum) / rpvgrw;
00651                             }
00652                         } else {
00653                             rpvgrw = zlantr_("M", "U", "N", &n, &n, &afac[1], 
00654                                     &lda, rdum);
00655                             if (rpvgrw == 0.) {
00656                                 rpvgrw = 1.;
00657                             } else {
00658                                 rpvgrw = zlange_("M", &n, &n, &a[1], &lda, 
00659                                         rdum) / rpvgrw;
00660                             }
00661                         }
00662 /* Computing MAX */
00663                         d__2 = rwork[(*nrhs << 1) + 1];
00664                         result[6] = (d__1 = rpvgrw - rwork[(*nrhs << 1) + 1], 
00665                                 abs(d__1)) / max(d__2,rpvgrw) / dlamch_("E");
00666 
00667                         if (! prefac) {
00668 
00669 /*                       Reconstruct matrix from factors and compute */
00670 /*                       residual. */
00671 
00672                             zget01_(&n, &n, &a[1], &lda, &afac[1], &lda, &
00673                                     iwork[1], &rwork[(*nrhs << 1) + 1], 
00674                                     result);
00675                             k1 = 1;
00676                         } else {
00677                             k1 = 2;
00678                         }
00679 
00680                         if (info == 0) {
00681                             trfcon = FALSE_;
00682 
00683 /*                       Compute residual of the computed solution. */
00684 
00685                             zlacpy_("Full", &n, nrhs, &bsav[1], &lda, &work[1]
00686 , &lda);
00687                             zget02_(trans, &n, &n, nrhs, &asav[1], &lda, &x[1]
00688 , &lda, &work[1], &lda, &rwork[(*nrhs << 
00689                                     1) + 1], &result[1]);
00690 
00691 /*                       Check solution from generated exact solution. */
00692 
00693                             if (nofact || prefac && lsame_(equed, "N")) {
00694                                 zget04_(&n, nrhs, &x[1], &lda, &xact[1], &lda, 
00695                                          &rcondc, &result[2]);
00696                             } else {
00697                                 if (itran == 1) {
00698                                     roldc = roldo;
00699                                 } else {
00700                                     roldc = roldi;
00701                                 }
00702                                 zget04_(&n, nrhs, &x[1], &lda, &xact[1], &lda, 
00703                                          &roldc, &result[2]);
00704                             }
00705 
00706 /*                       Check the error bounds from iterative */
00707 /*                       refinement. */
00708 
00709                             zget07_(trans, &n, nrhs, &asav[1], &lda, &b[1], &
00710                                     lda, &x[1], &lda, &xact[1], &lda, &rwork[
00711                                     1], &c_true, &rwork[*nrhs + 1], &result[3]
00712 );
00713                         } else {
00714                             trfcon = TRUE_;
00715                         }
00716 
00717 /*                    Compare RCOND from ZGESVX with the computed value */
00718 /*                    in RCONDC. */
00719 
00720                         result[5] = dget06_(&rcond, &rcondc);
00721 
00722 /*                    Print information about the tests that did not pass */
00723 /*                    the threshold. */
00724 
00725                         if (! trfcon) {
00726                             for (k = k1; k <= 7; ++k) {
00727                                 if (result[k - 1] >= *thresh) {
00728                                     if (nfail == 0 && nerrs == 0) {
00729                                         aladhd_(nout, path);
00730                                     }
00731                                     if (prefac) {
00732                                         io___62.ciunit = *nout;
00733                                         s_wsfe(&io___62);
00734                                         do_fio(&c__1, "ZGESVX", (ftnlen)6);
00735                                         do_fio(&c__1, fact, (ftnlen)1);
00736                                         do_fio(&c__1, trans, (ftnlen)1);
00737                                         do_fio(&c__1, (char *)&n, (ftnlen)
00738                                                 sizeof(integer));
00739                                         do_fio(&c__1, equed, (ftnlen)1);
00740                                         do_fio(&c__1, (char *)&imat, (ftnlen)
00741                                                 sizeof(integer));
00742                                         do_fio(&c__1, (char *)&k, (ftnlen)
00743                                                 sizeof(integer));
00744                                         do_fio(&c__1, (char *)&result[k - 1], 
00745                                                 (ftnlen)sizeof(doublereal));
00746                                         e_wsfe();
00747                                     } else {
00748                                         io___63.ciunit = *nout;
00749                                         s_wsfe(&io___63);
00750                                         do_fio(&c__1, "ZGESVX", (ftnlen)6);
00751                                         do_fio(&c__1, fact, (ftnlen)1);
00752                                         do_fio(&c__1, trans, (ftnlen)1);
00753                                         do_fio(&c__1, (char *)&n, (ftnlen)
00754                                                 sizeof(integer));
00755                                         do_fio(&c__1, (char *)&imat, (ftnlen)
00756                                                 sizeof(integer));
00757                                         do_fio(&c__1, (char *)&k, (ftnlen)
00758                                                 sizeof(integer));
00759                                         do_fio(&c__1, (char *)&result[k - 1], 
00760                                                 (ftnlen)sizeof(doublereal));
00761                                         e_wsfe();
00762                                     }
00763                                     ++nfail;
00764                                 }
00765 /* L40: */
00766                             }
00767                             nrun = nrun + 7 - k1;
00768                         } else {
00769                             if (result[0] >= *thresh && ! prefac) {
00770                                 if (nfail == 0 && nerrs == 0) {
00771                                     aladhd_(nout, path);
00772                                 }
00773                                 if (prefac) {
00774                                     io___64.ciunit = *nout;
00775                                     s_wsfe(&io___64);
00776                                     do_fio(&c__1, "ZGESVX", (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)sizeof(
00780                                             integer));
00781                                     do_fio(&c__1, equed, (ftnlen)1);
00782                                     do_fio(&c__1, (char *)&imat, (ftnlen)
00783                                             sizeof(integer));
00784                                     do_fio(&c__1, (char *)&c__1, (ftnlen)
00785                                             sizeof(integer));
00786                                     do_fio(&c__1, (char *)&result[0], (ftnlen)
00787                                             sizeof(doublereal));
00788                                     e_wsfe();
00789                                 } else {
00790                                     io___65.ciunit = *nout;
00791                                     s_wsfe(&io___65);
00792                                     do_fio(&c__1, "ZGESVX", (ftnlen)6);
00793                                     do_fio(&c__1, fact, (ftnlen)1);
00794                                     do_fio(&c__1, trans, (ftnlen)1);
00795                                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
00796                                             integer));
00797                                     do_fio(&c__1, (char *)&imat, (ftnlen)
00798                                             sizeof(integer));
00799                                     do_fio(&c__1, (char *)&c__1, (ftnlen)
00800                                             sizeof(integer));
00801                                     do_fio(&c__1, (char *)&result[0], (ftnlen)
00802                                             sizeof(doublereal));
00803                                     e_wsfe();
00804                                 }
00805                                 ++nfail;
00806                                 ++nrun;
00807                             }
00808                             if (result[5] >= *thresh) {
00809                                 if (nfail == 0 && nerrs == 0) {
00810                                     aladhd_(nout, path);
00811                                 }
00812                                 if (prefac) {
00813                                     io___66.ciunit = *nout;
00814                                     s_wsfe(&io___66);
00815                                     do_fio(&c__1, "ZGESVX", (ftnlen)6);
00816                                     do_fio(&c__1, fact, (ftnlen)1);
00817                                     do_fio(&c__1, trans, (ftnlen)1);
00818                                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
00819                                             integer));
00820                                     do_fio(&c__1, equed, (ftnlen)1);
00821                                     do_fio(&c__1, (char *)&imat, (ftnlen)
00822                                             sizeof(integer));
00823                                     do_fio(&c__1, (char *)&c__6, (ftnlen)
00824                                             sizeof(integer));
00825                                     do_fio(&c__1, (char *)&result[5], (ftnlen)
00826                                             sizeof(doublereal));
00827                                     e_wsfe();
00828                                 } else {
00829                                     io___67.ciunit = *nout;
00830                                     s_wsfe(&io___67);
00831                                     do_fio(&c__1, "ZGESVX", (ftnlen)6);
00832                                     do_fio(&c__1, fact, (ftnlen)1);
00833                                     do_fio(&c__1, trans, (ftnlen)1);
00834                                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
00835                                             integer));
00836                                     do_fio(&c__1, (char *)&imat, (ftnlen)
00837                                             sizeof(integer));
00838                                     do_fio(&c__1, (char *)&c__6, (ftnlen)
00839                                             sizeof(integer));
00840                                     do_fio(&c__1, (char *)&result[5], (ftnlen)
00841                                             sizeof(doublereal));
00842                                     e_wsfe();
00843                                 }
00844                                 ++nfail;
00845                                 ++nrun;
00846                             }
00847                             if (result[6] >= *thresh) {
00848                                 if (nfail == 0 && nerrs == 0) {
00849                                     aladhd_(nout, path);
00850                                 }
00851                                 if (prefac) {
00852                                     io___68.ciunit = *nout;
00853                                     s_wsfe(&io___68);
00854                                     do_fio(&c__1, "ZGESVX", (ftnlen)6);
00855                                     do_fio(&c__1, fact, (ftnlen)1);
00856                                     do_fio(&c__1, trans, (ftnlen)1);
00857                                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
00858                                             integer));
00859                                     do_fio(&c__1, equed, (ftnlen)1);
00860                                     do_fio(&c__1, (char *)&imat, (ftnlen)
00861                                             sizeof(integer));
00862                                     do_fio(&c__1, (char *)&c__7, (ftnlen)
00863                                             sizeof(integer));
00864                                     do_fio(&c__1, (char *)&result[6], (ftnlen)
00865                                             sizeof(doublereal));
00866                                     e_wsfe();
00867                                 } else {
00868                                     io___69.ciunit = *nout;
00869                                     s_wsfe(&io___69);
00870                                     do_fio(&c__1, "ZGESVX", (ftnlen)6);
00871                                     do_fio(&c__1, fact, (ftnlen)1);
00872                                     do_fio(&c__1, trans, (ftnlen)1);
00873                                     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
00874                                             integer));
00875                                     do_fio(&c__1, (char *)&imat, (ftnlen)
00876                                             sizeof(integer));
00877                                     do_fio(&c__1, (char *)&c__7, (ftnlen)
00878                                             sizeof(integer));
00879                                     do_fio(&c__1, (char *)&result[6], (ftnlen)
00880                                             sizeof(doublereal));
00881                                     e_wsfe();
00882                                 }
00883                                 ++nfail;
00884                                 ++nrun;
00885                             }
00886 
00887                         }
00888 
00889 /* L50: */
00890                     }
00891 L60:
00892                     ;
00893                 }
00894 /* L70: */
00895             }
00896 L80:
00897             ;
00898         }
00899 /* L90: */
00900     }
00901 
00902 /*     Print a summary of the results. */
00903 
00904     alasvm_(path, nout, &nfail, &nrun, &nerrs);
00905 
00906     return 0;
00907 
00908 /*     End of ZDRVGE */
00909 
00910 } /* zdrvge_ */

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