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


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