zchkeq.c
Go to the documentation of this file.
00001 /* zchkeq.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 /* Table of constant values */
00017 
00018 static doublereal c_b9 = 10.;
00019 static integer c_n1 = -1;
00020 static integer c__5 = 5;
00021 static integer c__13 = 13;
00022 static integer c__1 = 1;
00023 
00024 /* Subroutine */ int zchkeq_(doublereal *thresh, integer *nout)
00025 {
00026     /* Format strings */
00027     static char fmt_9999[] = "(1x,\002All tests for \002,a3,\002 routines pa"
00028             "ssed the threshold\002)";
00029     static char fmt_9998[] = "(\002 ZGEEQU failed test with value \002,d10"
00030             ".3,\002 exceeding\002,\002 threshold \002,d10.3)";
00031     static char fmt_9997[] = "(\002 ZGBEQU failed test with value \002,d10"
00032             ".3,\002 exceeding\002,\002 threshold \002,d10.3)";
00033     static char fmt_9996[] = "(\002 ZPOEQU failed test with value \002,d10"
00034             ".3,\002 exceeding\002,\002 threshold \002,d10.3)";
00035     static char fmt_9995[] = "(\002 ZPPEQU failed test with value \002,d10"
00036             ".3,\002 exceeding\002,\002 threshold \002,d10.3)";
00037     static char fmt_9994[] = "(\002 ZPBEQU failed test with value \002,d10"
00038             ".3,\002 exceeding\002,\002 threshold \002,d10.3)";
00039 
00040     /* System generated locals */
00041     integer i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8;
00042     doublereal d__1, d__2, d__3;
00043     doublecomplex z__1;
00044 
00045     /* Builtin functions */
00046     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
00047     double pow_di(doublereal *, integer *);
00048     integer pow_ii(integer *, integer *), s_wsle(cilist *), e_wsle(void), 
00049             s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
00050 
00051     /* Local variables */
00052     doublecomplex a[25] /* was [5][5] */;
00053     doublereal c__[5];
00054     integer i__, j, m, n;
00055     doublereal r__[5];
00056     doublecomplex ab[65]        /* was [13][5] */, ap[15];
00057     integer kl;
00058     logical ok;
00059     integer ku;
00060     doublereal eps, pow[11];
00061     integer info;
00062     char path[3];
00063     doublereal norm, rpow[11], ccond, rcond, rcmin, rcmax, ratio;
00064     extern doublereal dlamch_(char *);
00065     extern /* Subroutine */ int zgbequ_(integer *, integer *, integer *, 
00066             integer *, doublecomplex *, integer *, doublereal *, doublereal *, 
00067              doublereal *, doublereal *, doublereal *, integer *), zgeequ_(
00068             integer *, integer *, doublecomplex *, integer *, doublereal *, 
00069             doublereal *, doublereal *, doublereal *, doublereal *, integer *)
00070             , zpbequ_(char *, integer *, integer *, doublecomplex *, integer *
00071 , doublereal *, doublereal *, doublereal *, integer *);
00072     doublereal reslts[5];
00073     extern /* Subroutine */ int zpoequ_(integer *, doublecomplex *, integer *, 
00074              doublereal *, doublereal *, doublereal *, integer *), zppequ_(
00075             char *, integer *, doublecomplex *, doublereal *, doublereal *, 
00076             doublereal *, integer *);
00077 
00078     /* Fortran I/O blocks */
00079     static cilist io___25 = { 0, 0, 0, 0, 0 };
00080     static cilist io___26 = { 0, 0, 0, fmt_9999, 0 };
00081     static cilist io___27 = { 0, 0, 0, fmt_9998, 0 };
00082     static cilist io___28 = { 0, 0, 0, fmt_9997, 0 };
00083     static cilist io___29 = { 0, 0, 0, fmt_9996, 0 };
00084     static cilist io___30 = { 0, 0, 0, fmt_9995, 0 };
00085     static cilist io___31 = { 0, 0, 0, fmt_9994, 0 };
00086 
00087 
00088 
00089 /*  -- LAPACK test routine (version 3.1) -- */
00090 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00091 /*     November 2006 */
00092 
00093 /*     .. Scalar Arguments .. */
00094 /*     .. */
00095 
00096 /*  Purpose */
00097 /*  ======= */
00098 
00099 /*  ZCHKEQ tests ZGEEQU, ZGBEQU, ZPOEQU, ZPPEQU and ZPBEQU */
00100 
00101 /*  Arguments */
00102 /*  ========= */
00103 
00104 /*  THRESH  (input) DOUBLE PRECISION */
00105 /*          Threshold for testing routines. Should be between 2 and 10. */
00106 
00107 /*  NOUT    (input) INTEGER */
00108 /*          The unit number for output. */
00109 
00110 /*  ===================================================================== */
00111 
00112 /*     .. Parameters .. */
00113 /*     .. */
00114 /*     .. Local Scalars .. */
00115 /*     .. */
00116 /*     .. Local Arrays .. */
00117 /*     .. */
00118 /*     .. External Functions .. */
00119 /*     .. */
00120 /*     .. External Subroutines .. */
00121 /*     .. */
00122 /*     .. Intrinsic Functions .. */
00123 /*     .. */
00124 /*     .. Executable Statements .. */
00125 
00126     s_copy(path, "Zomplex precision", (ftnlen)1, (ftnlen)17);
00127     s_copy(path + 1, "EQ", (ftnlen)2, (ftnlen)2);
00128 
00129     eps = dlamch_("P");
00130     for (i__ = 1; i__ <= 5; ++i__) {
00131         reslts[i__ - 1] = 0.;
00132 /* L10: */
00133     }
00134     for (i__ = 1; i__ <= 11; ++i__) {
00135         i__1 = i__ - 1;
00136         pow[i__ - 1] = pow_di(&c_b9, &i__1);
00137         rpow[i__ - 1] = 1. / pow[i__ - 1];
00138 /* L20: */
00139     }
00140 
00141 /*     Test ZGEEQU */
00142 
00143     for (n = 0; n <= 5; ++n) {
00144         for (m = 0; m <= 5; ++m) {
00145 
00146             for (j = 1; j <= 5; ++j) {
00147                 for (i__ = 1; i__ <= 5; ++i__) {
00148                     if (i__ <= m && j <= n) {
00149                         i__1 = i__ + j * 5 - 6;
00150                         i__2 = i__ + j;
00151                         d__1 = pow[i__ + j] * pow_ii(&c_n1, &i__2);
00152                         a[i__1].r = d__1, a[i__1].i = 0.;
00153                     } else {
00154                         i__1 = i__ + j * 5 - 6;
00155                         a[i__1].r = 0., a[i__1].i = 0.;
00156                     }
00157 /* L30: */
00158                 }
00159 /* L40: */
00160             }
00161 
00162             zgeequ_(&m, &n, a, &c__5, r__, c__, &rcond, &ccond, &norm, &info);
00163 
00164             if (info != 0) {
00165                 reslts[0] = 1.;
00166             } else {
00167                 if (n != 0 && m != 0) {
00168 /* Computing MAX */
00169                     d__2 = reslts[0], d__3 = (d__1 = (rcond - rpow[m - 1]) / 
00170                             rpow[m - 1], abs(d__1));
00171                     reslts[0] = max(d__2,d__3);
00172 /* Computing MAX */
00173                     d__2 = reslts[0], d__3 = (d__1 = (ccond - rpow[n - 1]) / 
00174                             rpow[n - 1], abs(d__1));
00175                     reslts[0] = max(d__2,d__3);
00176 /* Computing MAX */
00177                     d__2 = reslts[0], d__3 = (d__1 = (norm - pow[n + m]) / 
00178                             pow[n + m], abs(d__1));
00179                     reslts[0] = max(d__2,d__3);
00180                     i__1 = m;
00181                     for (i__ = 1; i__ <= i__1; ++i__) {
00182 /* Computing MAX */
00183                         d__2 = reslts[0], d__3 = (d__1 = (r__[i__ - 1] - rpow[
00184                                 i__ + n]) / rpow[i__ + n], abs(d__1));
00185                         reslts[0] = max(d__2,d__3);
00186 /* L50: */
00187                     }
00188                     i__1 = n;
00189                     for (j = 1; j <= i__1; ++j) {
00190 /* Computing MAX */
00191                         d__2 = reslts[0], d__3 = (d__1 = (c__[j - 1] - pow[n 
00192                                 - j]) / pow[n - j], abs(d__1));
00193                         reslts[0] = max(d__2,d__3);
00194 /* L60: */
00195                     }
00196                 }
00197             }
00198 
00199 /* L70: */
00200         }
00201 /* L80: */
00202     }
00203 
00204 /*     Test with zero rows and columns */
00205 
00206     for (j = 1; j <= 5; ++j) {
00207         i__1 = j * 5 - 2;
00208         a[i__1].r = 0., a[i__1].i = 0.;
00209 /* L90: */
00210     }
00211     zgeequ_(&c__5, &c__5, a, &c__5, r__, c__, &rcond, &ccond, &norm, &info);
00212     if (info != 4) {
00213         reslts[0] = 1.;
00214     }
00215 
00216     for (j = 1; j <= 5; ++j) {
00217         i__1 = j * 5 - 2;
00218         a[i__1].r = 1., a[i__1].i = 0.;
00219 /* L100: */
00220     }
00221     for (i__ = 1; i__ <= 5; ++i__) {
00222         i__1 = i__ + 14;
00223         a[i__1].r = 0., a[i__1].i = 0.;
00224 /* L110: */
00225     }
00226     zgeequ_(&c__5, &c__5, a, &c__5, r__, c__, &rcond, &ccond, &norm, &info);
00227     if (info != 9) {
00228         reslts[0] = 1.;
00229     }
00230     reslts[0] /= eps;
00231 
00232 /*     Test ZGBEQU */
00233 
00234     for (n = 0; n <= 5; ++n) {
00235         for (m = 0; m <= 5; ++m) {
00236 /* Computing MAX */
00237             i__2 = m - 1;
00238             i__1 = max(i__2,0);
00239             for (kl = 0; kl <= i__1; ++kl) {
00240 /* Computing MAX */
00241                 i__3 = n - 1;
00242                 i__2 = max(i__3,0);
00243                 for (ku = 0; ku <= i__2; ++ku) {
00244 
00245                     for (j = 1; j <= 5; ++j) {
00246                         for (i__ = 1; i__ <= 13; ++i__) {
00247                             i__3 = i__ + j * 13 - 14;
00248                             ab[i__3].r = 0., ab[i__3].i = 0.;
00249 /* L120: */
00250                         }
00251 /* L130: */
00252                     }
00253                     i__3 = n;
00254                     for (j = 1; j <= i__3; ++j) {
00255                         i__4 = m;
00256                         for (i__ = 1; i__ <= i__4; ++i__) {
00257 /* Computing MIN */
00258                             i__5 = m, i__6 = j + kl;
00259 /* Computing MAX */
00260                             i__7 = 1, i__8 = j - ku;
00261                             if (i__ <= min(i__5,i__6) && i__ >= max(i__7,i__8)
00262                                      && j <= n) {
00263                                 i__5 = ku + 1 + i__ - j + j * 13 - 14;
00264                                 i__6 = i__ + j;
00265                                 d__1 = pow[i__ + j] * pow_ii(&c_n1, &i__6);
00266                                 ab[i__5].r = d__1, ab[i__5].i = 0.;
00267                             }
00268 /* L140: */
00269                         }
00270 /* L150: */
00271                     }
00272 
00273                     zgbequ_(&m, &n, &kl, &ku, ab, &c__13, r__, c__, &rcond, &
00274                             ccond, &norm, &info);
00275 
00276                     if (info != 0) {
00277                         if (! (n + kl < m && info == n + kl + 1 || m + ku < n 
00278                                 && info == (m << 1) + ku + 1)) {
00279                             reslts[1] = 1.;
00280                         }
00281                     } else {
00282                         if (n != 0 && m != 0) {
00283 
00284                             rcmin = r__[0];
00285                             rcmax = r__[0];
00286                             i__3 = m;
00287                             for (i__ = 1; i__ <= i__3; ++i__) {
00288 /* Computing MIN */
00289                                 d__1 = rcmin, d__2 = r__[i__ - 1];
00290                                 rcmin = min(d__1,d__2);
00291 /* Computing MAX */
00292                                 d__1 = rcmax, d__2 = r__[i__ - 1];
00293                                 rcmax = max(d__1,d__2);
00294 /* L160: */
00295                             }
00296                             ratio = rcmin / rcmax;
00297 /* Computing MAX */
00298                             d__2 = reslts[1], d__3 = (d__1 = (rcond - ratio) /
00299                                      ratio, abs(d__1));
00300                             reslts[1] = max(d__2,d__3);
00301 
00302                             rcmin = c__[0];
00303                             rcmax = c__[0];
00304                             i__3 = n;
00305                             for (j = 1; j <= i__3; ++j) {
00306 /* Computing MIN */
00307                                 d__1 = rcmin, d__2 = c__[j - 1];
00308                                 rcmin = min(d__1,d__2);
00309 /* Computing MAX */
00310                                 d__1 = rcmax, d__2 = c__[j - 1];
00311                                 rcmax = max(d__1,d__2);
00312 /* L170: */
00313                             }
00314                             ratio = rcmin / rcmax;
00315 /* Computing MAX */
00316                             d__2 = reslts[1], d__3 = (d__1 = (ccond - ratio) /
00317                                      ratio, abs(d__1));
00318                             reslts[1] = max(d__2,d__3);
00319 
00320 /* Computing MAX */
00321                             d__2 = reslts[1], d__3 = (d__1 = (norm - pow[n + 
00322                                     m]) / pow[n + m], abs(d__1));
00323                             reslts[1] = max(d__2,d__3);
00324                             i__3 = m;
00325                             for (i__ = 1; i__ <= i__3; ++i__) {
00326                                 rcmax = 0.;
00327                                 i__4 = n;
00328                                 for (j = 1; j <= i__4; ++j) {
00329                                     if (i__ <= j + kl && i__ >= j - ku) {
00330                                         ratio = (d__1 = r__[i__ - 1] * pow[
00331                                                 i__ + j] * c__[j - 1], abs(
00332                                                 d__1));
00333                                         rcmax = max(rcmax,ratio);
00334                                     }
00335 /* L180: */
00336                                 }
00337 /* Computing MAX */
00338                                 d__2 = reslts[1], d__3 = (d__1 = 1. - rcmax, 
00339                                         abs(d__1));
00340                                 reslts[1] = max(d__2,d__3);
00341 /* L190: */
00342                             }
00343 
00344                             i__3 = n;
00345                             for (j = 1; j <= i__3; ++j) {
00346                                 rcmax = 0.;
00347                                 i__4 = m;
00348                                 for (i__ = 1; i__ <= i__4; ++i__) {
00349                                     if (i__ <= j + kl && i__ >= j - ku) {
00350                                         ratio = (d__1 = r__[i__ - 1] * pow[
00351                                                 i__ + j] * c__[j - 1], abs(
00352                                                 d__1));
00353                                         rcmax = max(rcmax,ratio);
00354                                     }
00355 /* L200: */
00356                                 }
00357 /* Computing MAX */
00358                                 d__2 = reslts[1], d__3 = (d__1 = 1. - rcmax, 
00359                                         abs(d__1));
00360                                 reslts[1] = max(d__2,d__3);
00361 /* L210: */
00362                             }
00363                         }
00364                     }
00365 
00366 /* L220: */
00367                 }
00368 /* L230: */
00369             }
00370 /* L240: */
00371         }
00372 /* L250: */
00373     }
00374     reslts[1] /= eps;
00375 
00376 /*     Test ZPOEQU */
00377 
00378     for (n = 0; n <= 5; ++n) {
00379 
00380         for (i__ = 1; i__ <= 5; ++i__) {
00381             for (j = 1; j <= 5; ++j) {
00382                 if (i__ <= n && j == i__) {
00383                     i__1 = i__ + j * 5 - 6;
00384                     i__2 = i__ + j;
00385                     d__1 = pow[i__ + j] * pow_ii(&c_n1, &i__2);
00386                     a[i__1].r = d__1, a[i__1].i = 0.;
00387                 } else {
00388                     i__1 = i__ + j * 5 - 6;
00389                     a[i__1].r = 0., a[i__1].i = 0.;
00390                 }
00391 /* L260: */
00392             }
00393 /* L270: */
00394         }
00395 
00396         zpoequ_(&n, a, &c__5, r__, &rcond, &norm, &info);
00397 
00398         if (info != 0) {
00399             reslts[2] = 1.;
00400         } else {
00401             if (n != 0) {
00402 /* Computing MAX */
00403                 d__2 = reslts[2], d__3 = (d__1 = (rcond - rpow[n - 1]) / rpow[
00404                         n - 1], abs(d__1));
00405                 reslts[2] = max(d__2,d__3);
00406 /* Computing MAX */
00407                 d__2 = reslts[2], d__3 = (d__1 = (norm - pow[n * 2]) / pow[n *
00408                          2], abs(d__1));
00409                 reslts[2] = max(d__2,d__3);
00410                 i__1 = n;
00411                 for (i__ = 1; i__ <= i__1; ++i__) {
00412 /* Computing MAX */
00413                     d__2 = reslts[2], d__3 = (d__1 = (r__[i__ - 1] - rpow[i__]
00414                             ) / rpow[i__], abs(d__1));
00415                     reslts[2] = max(d__2,d__3);
00416 /* L280: */
00417                 }
00418             }
00419         }
00420 /* L290: */
00421     }
00422     z__1.r = -1., z__1.i = -0.;
00423     a[18].r = z__1.r, a[18].i = z__1.i;
00424     zpoequ_(&c__5, a, &c__5, r__, &rcond, &norm, &info);
00425     if (info != 4) {
00426         reslts[2] = 1.;
00427     }
00428     reslts[2] /= eps;
00429 
00430 /*     Test ZPPEQU */
00431 
00432     for (n = 0; n <= 5; ++n) {
00433 
00434 /*        Upper triangular packed storage */
00435 
00436         i__1 = n * (n + 1) / 2;
00437         for (i__ = 1; i__ <= i__1; ++i__) {
00438             i__2 = i__ - 1;
00439             ap[i__2].r = 0., ap[i__2].i = 0.;
00440 /* L300: */
00441         }
00442         i__1 = n;
00443         for (i__ = 1; i__ <= i__1; ++i__) {
00444             i__2 = i__ * (i__ + 1) / 2 - 1;
00445             i__3 = i__ << 1;
00446             ap[i__2].r = pow[i__3], ap[i__2].i = 0.;
00447 /* L310: */
00448         }
00449 
00450         zppequ_("U", &n, ap, r__, &rcond, &norm, &info);
00451 
00452         if (info != 0) {
00453             reslts[3] = 1.;
00454         } else {
00455             if (n != 0) {
00456 /* Computing MAX */
00457                 d__2 = reslts[3], d__3 = (d__1 = (rcond - rpow[n - 1]) / rpow[
00458                         n - 1], abs(d__1));
00459                 reslts[3] = max(d__2,d__3);
00460 /* Computing MAX */
00461                 d__2 = reslts[3], d__3 = (d__1 = (norm - pow[n * 2]) / pow[n *
00462                          2], abs(d__1));
00463                 reslts[3] = max(d__2,d__3);
00464                 i__1 = n;
00465                 for (i__ = 1; i__ <= i__1; ++i__) {
00466 /* Computing MAX */
00467                     d__2 = reslts[3], d__3 = (d__1 = (r__[i__ - 1] - rpow[i__]
00468                             ) / rpow[i__], abs(d__1));
00469                     reslts[3] = max(d__2,d__3);
00470 /* L320: */
00471                 }
00472             }
00473         }
00474 
00475 /*        Lower triangular packed storage */
00476 
00477         i__1 = n * (n + 1) / 2;
00478         for (i__ = 1; i__ <= i__1; ++i__) {
00479             i__2 = i__ - 1;
00480             ap[i__2].r = 0., ap[i__2].i = 0.;
00481 /* L330: */
00482         }
00483         j = 1;
00484         i__1 = n;
00485         for (i__ = 1; i__ <= i__1; ++i__) {
00486             i__2 = j - 1;
00487             i__3 = i__ << 1;
00488             ap[i__2].r = pow[i__3], ap[i__2].i = 0.;
00489             j += n - i__ + 1;
00490 /* L340: */
00491         }
00492 
00493         zppequ_("L", &n, ap, r__, &rcond, &norm, &info);
00494 
00495         if (info != 0) {
00496             reslts[3] = 1.;
00497         } else {
00498             if (n != 0) {
00499 /* Computing MAX */
00500                 d__2 = reslts[3], d__3 = (d__1 = (rcond - rpow[n - 1]) / rpow[
00501                         n - 1], abs(d__1));
00502                 reslts[3] = max(d__2,d__3);
00503 /* Computing MAX */
00504                 d__2 = reslts[3], d__3 = (d__1 = (norm - pow[n * 2]) / pow[n *
00505                          2], abs(d__1));
00506                 reslts[3] = max(d__2,d__3);
00507                 i__1 = n;
00508                 for (i__ = 1; i__ <= i__1; ++i__) {
00509 /* Computing MAX */
00510                     d__2 = reslts[3], d__3 = (d__1 = (r__[i__ - 1] - rpow[i__]
00511                             ) / rpow[i__], abs(d__1));
00512                     reslts[3] = max(d__2,d__3);
00513 /* L350: */
00514                 }
00515             }
00516         }
00517 
00518 /* L360: */
00519     }
00520     i__ = 13;
00521     i__1 = i__ - 1;
00522     z__1.r = -1., z__1.i = -0.;
00523     ap[i__1].r = z__1.r, ap[i__1].i = z__1.i;
00524     zppequ_("L", &c__5, ap, r__, &rcond, &norm, &info);
00525     if (info != 4) {
00526         reslts[3] = 1.;
00527     }
00528     reslts[3] /= eps;
00529 
00530 /*     Test ZPBEQU */
00531 
00532     for (n = 0; n <= 5; ++n) {
00533 /* Computing MAX */
00534         i__2 = n - 1;
00535         i__1 = max(i__2,0);
00536         for (kl = 0; kl <= i__1; ++kl) {
00537 
00538 /*           Test upper triangular storage */
00539 
00540             for (j = 1; j <= 5; ++j) {
00541                 for (i__ = 1; i__ <= 13; ++i__) {
00542                     i__2 = i__ + j * 13 - 14;
00543                     ab[i__2].r = 0., ab[i__2].i = 0.;
00544 /* L370: */
00545                 }
00546 /* L380: */
00547             }
00548             i__2 = n;
00549             for (j = 1; j <= i__2; ++j) {
00550                 i__3 = kl + 1 + j * 13 - 14;
00551                 i__4 = j << 1;
00552                 ab[i__3].r = pow[i__4], ab[i__3].i = 0.;
00553 /* L390: */
00554             }
00555 
00556             zpbequ_("U", &n, &kl, ab, &c__13, r__, &rcond, &norm, &info);
00557 
00558             if (info != 0) {
00559                 reslts[4] = 1.;
00560             } else {
00561                 if (n != 0) {
00562 /* Computing MAX */
00563                     d__2 = reslts[4], d__3 = (d__1 = (rcond - rpow[n - 1]) / 
00564                             rpow[n - 1], abs(d__1));
00565                     reslts[4] = max(d__2,d__3);
00566 /* Computing MAX */
00567                     d__2 = reslts[4], d__3 = (d__1 = (norm - pow[n * 2]) / 
00568                             pow[n * 2], abs(d__1));
00569                     reslts[4] = max(d__2,d__3);
00570                     i__2 = n;
00571                     for (i__ = 1; i__ <= i__2; ++i__) {
00572 /* Computing MAX */
00573                         d__2 = reslts[4], d__3 = (d__1 = (r__[i__ - 1] - rpow[
00574                                 i__]) / rpow[i__], abs(d__1));
00575                         reslts[4] = max(d__2,d__3);
00576 /* L400: */
00577                     }
00578                 }
00579             }
00580             if (n != 0) {
00581 /* Computing MAX */
00582                 i__3 = n - 1;
00583                 i__2 = kl + 1 + max(i__3,1) * 13 - 14;
00584                 z__1.r = -1., z__1.i = -0.;
00585                 ab[i__2].r = z__1.r, ab[i__2].i = z__1.i;
00586                 zpbequ_("U", &n, &kl, ab, &c__13, r__, &rcond, &norm, &info);
00587 /* Computing MAX */
00588                 i__2 = n - 1;
00589                 if (info != max(i__2,1)) {
00590                     reslts[4] = 1.;
00591                 }
00592             }
00593 
00594 /*           Test lower triangular storage */
00595 
00596             for (j = 1; j <= 5; ++j) {
00597                 for (i__ = 1; i__ <= 13; ++i__) {
00598                     i__2 = i__ + j * 13 - 14;
00599                     ab[i__2].r = 0., ab[i__2].i = 0.;
00600 /* L410: */
00601                 }
00602 /* L420: */
00603             }
00604             i__2 = n;
00605             for (j = 1; j <= i__2; ++j) {
00606                 i__3 = j * 13 - 13;
00607                 i__4 = j << 1;
00608                 ab[i__3].r = pow[i__4], ab[i__3].i = 0.;
00609 /* L430: */
00610             }
00611 
00612             zpbequ_("L", &n, &kl, ab, &c__13, r__, &rcond, &norm, &info);
00613 
00614             if (info != 0) {
00615                 reslts[4] = 1.;
00616             } else {
00617                 if (n != 0) {
00618 /* Computing MAX */
00619                     d__2 = reslts[4], d__3 = (d__1 = (rcond - rpow[n - 1]) / 
00620                             rpow[n - 1], abs(d__1));
00621                     reslts[4] = max(d__2,d__3);
00622 /* Computing MAX */
00623                     d__2 = reslts[4], d__3 = (d__1 = (norm - pow[n * 2]) / 
00624                             pow[n * 2], abs(d__1));
00625                     reslts[4] = max(d__2,d__3);
00626                     i__2 = n;
00627                     for (i__ = 1; i__ <= i__2; ++i__) {
00628 /* Computing MAX */
00629                         d__2 = reslts[4], d__3 = (d__1 = (r__[i__ - 1] - rpow[
00630                                 i__]) / rpow[i__], abs(d__1));
00631                         reslts[4] = max(d__2,d__3);
00632 /* L440: */
00633                     }
00634                 }
00635             }
00636             if (n != 0) {
00637 /* Computing MAX */
00638                 i__3 = n - 1;
00639                 i__2 = max(i__3,1) * 13 - 13;
00640                 z__1.r = -1., z__1.i = -0.;
00641                 ab[i__2].r = z__1.r, ab[i__2].i = z__1.i;
00642                 zpbequ_("L", &n, &kl, ab, &c__13, r__, &rcond, &norm, &info);
00643 /* Computing MAX */
00644                 i__2 = n - 1;
00645                 if (info != max(i__2,1)) {
00646                     reslts[4] = 1.;
00647                 }
00648             }
00649 /* L450: */
00650         }
00651 /* L460: */
00652     }
00653     reslts[4] /= eps;
00654     ok = reslts[0] <= *thresh && reslts[1] <= *thresh && reslts[2] <= *thresh 
00655             && reslts[3] <= *thresh && reslts[4] <= *thresh;
00656     io___25.ciunit = *nout;
00657     s_wsle(&io___25);
00658     e_wsle();
00659     if (ok) {
00660         io___26.ciunit = *nout;
00661         s_wsfe(&io___26);
00662         do_fio(&c__1, path, (ftnlen)3);
00663         e_wsfe();
00664     } else {
00665         if (reslts[0] > *thresh) {
00666             io___27.ciunit = *nout;
00667             s_wsfe(&io___27);
00668             do_fio(&c__1, (char *)&reslts[0], (ftnlen)sizeof(doublereal));
00669             do_fio(&c__1, (char *)&(*thresh), (ftnlen)sizeof(doublereal));
00670             e_wsfe();
00671         }
00672         if (reslts[1] > *thresh) {
00673             io___28.ciunit = *nout;
00674             s_wsfe(&io___28);
00675             do_fio(&c__1, (char *)&reslts[1], (ftnlen)sizeof(doublereal));
00676             do_fio(&c__1, (char *)&(*thresh), (ftnlen)sizeof(doublereal));
00677             e_wsfe();
00678         }
00679         if (reslts[2] > *thresh) {
00680             io___29.ciunit = *nout;
00681             s_wsfe(&io___29);
00682             do_fio(&c__1, (char *)&reslts[2], (ftnlen)sizeof(doublereal));
00683             do_fio(&c__1, (char *)&(*thresh), (ftnlen)sizeof(doublereal));
00684             e_wsfe();
00685         }
00686         if (reslts[3] > *thresh) {
00687             io___30.ciunit = *nout;
00688             s_wsfe(&io___30);
00689             do_fio(&c__1, (char *)&reslts[3], (ftnlen)sizeof(doublereal));
00690             do_fio(&c__1, (char *)&(*thresh), (ftnlen)sizeof(doublereal));
00691             e_wsfe();
00692         }
00693         if (reslts[4] > *thresh) {
00694             io___31.ciunit = *nout;
00695             s_wsfe(&io___31);
00696             do_fio(&c__1, (char *)&reslts[4], (ftnlen)sizeof(doublereal));
00697             do_fio(&c__1, (char *)&(*thresh), (ftnlen)sizeof(doublereal));
00698             e_wsfe();
00699         }
00700     }
00701     return 0;
00702 
00703 /*     End of ZCHKEQ */
00704 
00705 } /* zchkeq_ */


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