cerred.c
Go to the documentation of this file.
00001 /* cerred.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, nout;
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 struct {
00032     integer selopt, seldim;
00033     logical selval[20];
00034     real selwr[20], selwi[20];
00035 } sslct_;
00036 
00037 #define sslct_1 sslct_
00038 
00039 /* Table of constant values */
00040 
00041 static integer c__2 = 2;
00042 static integer c__0 = 0;
00043 static integer c__1 = 1;
00044 static integer c_n1 = -1;
00045 static integer c__4 = 4;
00046 static integer c__5 = 5;
00047 
00048 /* Subroutine */ int cerred_(char *path, integer *nunit)
00049 {
00050     /* Format strings */
00051     static char fmt_9999[] = "(1x,a,\002 passed the tests of the error exits"
00052             " (\002,i3,\002 tests done)\002)";
00053     static char fmt_9998[] = "(\002 *** \002,a,\002 failed the tests of the "
00054             "error exits ***\002)";
00055 
00056     /* System generated locals */
00057     integer i__1;
00058 
00059     /* Builtin functions */
00060     integer s_wsle(cilist *), e_wsle(void);
00061     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
00062     integer s_wsfe(cilist *), i_len_trim(char *, ftnlen), do_fio(integer *, 
00063             char *, ftnlen), e_wsfe(void);
00064 
00065     /* Local variables */
00066     complex a[16]       /* was [4][4] */;
00067     logical b[4];
00068     integer i__, j;
00069     real s[4];
00070     complex u[16]       /* was [4][4] */, w[16], x[4];
00071     char c2[2];
00072     real r1[4], r2[4];
00073     integer iw[16], nt;
00074     complex vl[16]      /* was [4][4] */, vr[16]        /* was [4][4] */;
00075     real rw[20];
00076     complex vt[16]      /* was [4][4] */;
00077     integer ihi, ilo, info, sdim;
00078     extern /* Subroutine */ int cgees_(char *, char *, L_fp, integer *, 
00079             complex *, integer *, integer *, complex *, complex *, integer *, 
00080             complex *, integer *, real *, logical *, integer *), cgeev_(char *, char *, integer *, complex *, integer *, 
00081             complex *, complex *, integer *, complex *, integer *, complex *, 
00082             integer *, real *, integer *);
00083     real abnrm;
00084     extern /* Subroutine */ int cgesdd_(char *, integer *, integer *, complex 
00085             *, integer *, real *, complex *, integer *, complex *, integer *, 
00086             complex *, integer *, real *, integer *, integer *), 
00087             cgesvd_(char *, char *, integer *, integer *, complex *, integer *
00088 , real *, complex *, integer *, complex *, integer *, complex *, 
00089             integer *, real *, integer *);
00090     extern logical cslect_();
00091     extern /* Subroutine */ int cgeesx_(char *, char *, L_fp, char *, integer 
00092             *, complex *, integer *, integer *, complex *, complex *, integer 
00093             *, real *, real *, complex *, integer *, real *, logical *, 
00094             integer *);
00095     extern logical lsamen_(integer *, char *, char *);
00096     extern /* Subroutine */ int cgeevx_(char *, char *, char *, char *, 
00097             integer *, complex *, integer *, complex *, complex *, integer *, 
00098             complex *, integer *, integer *, integer *, real *, real *, real *
00099 , real *, complex *, integer *, real *, integer *), chkxer_(char *, integer *, integer *, logical *, 
00100              logical *);
00101 
00102     /* Fortran I/O blocks */
00103     static cilist io___1 = { 0, 0, 0, 0, 0 };
00104     static cilist io___23 = { 0, 0, 0, fmt_9999, 0 };
00105     static cilist io___24 = { 0, 0, 0, fmt_9998, 0 };
00106     static cilist io___26 = { 0, 0, 0, fmt_9999, 0 };
00107     static cilist io___27 = { 0, 0, 0, fmt_9998, 0 };
00108     static cilist io___28 = { 0, 0, 0, fmt_9999, 0 };
00109     static cilist io___29 = { 0, 0, 0, fmt_9998, 0 };
00110 
00111 
00112 
00113 /*  -- LAPACK test routine (version 3.1) -- */
00114 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00115 /*     November 2006 */
00116 
00117 /*     .. Scalar Arguments .. */
00118 /*     .. */
00119 
00120 /*  Purpose */
00121 /*  ======= */
00122 
00123 /*  CERRED tests the error exits for the eigenvalue driver routines for */
00124 /*  REAL matrices: */
00125 
00126 /*  PATH  driver   description */
00127 /*  ----  ------   ----------- */
00128 /*  CEV   CGEEV    find eigenvalues/eigenvectors for nonsymmetric A */
00129 /*  CES   CGEES    find eigenvalues/Schur form for nonsymmetric A */
00130 /*  CVX   CGEEVX   CGEEV + balancing and condition estimation */
00131 /*  CSX   CGEESX   CGEES + balancing and condition estimation */
00132 /*  CBD   CGESVD   compute SVD of an M-by-N matrix A */
00133 /*        CGESDD   compute SVD of an M-by-N matrix A(by divide and */
00134 /*                 conquer) */
00135 
00136 /*  Arguments */
00137 /*  ========= */
00138 
00139 /*  PATH    (input) CHARACTER*3 */
00140 /*          The LAPACK path name for the routines to be tested. */
00141 
00142 /*  NUNIT   (input) INTEGER */
00143 /*          The unit number for output. */
00144 
00145 /*  ===================================================================== */
00146 
00147 /*     .. Parameters .. */
00148 /*     .. */
00149 /*     .. Local Scalars .. */
00150 /*     .. */
00151 /*     .. Local Arrays .. */
00152 /*     .. */
00153 /*     .. External Subroutines .. */
00154 /*     .. */
00155 /*     .. External Functions .. */
00156 /*     .. */
00157 /*     .. Intrinsic Functions .. */
00158 /*     .. */
00159 /*     .. Arrays in Common .. */
00160 /*     .. */
00161 /*     .. Scalars in Common .. */
00162 /*     .. */
00163 /*     .. Common blocks .. */
00164 /*     .. */
00165 /*     .. Executable Statements .. */
00166 
00167     infoc_1.nout = *nunit;
00168     io___1.ciunit = infoc_1.nout;
00169     s_wsle(&io___1);
00170     e_wsle();
00171     s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
00172 
00173 /*     Initialize A */
00174 
00175     for (j = 1; j <= 4; ++j) {
00176         for (i__ = 1; i__ <= 4; ++i__) {
00177             i__1 = i__ + (j << 2) - 5;
00178             a[i__1].r = 0.f, a[i__1].i = 0.f;
00179 /* L10: */
00180         }
00181 /* L20: */
00182     }
00183     for (i__ = 1; i__ <= 4; ++i__) {
00184         i__1 = i__ + (i__ << 2) - 5;
00185         a[i__1].r = 1.f, a[i__1].i = 0.f;
00186 /* L30: */
00187     }
00188     infoc_1.ok = TRUE_;
00189     nt = 0;
00190 
00191     if (lsamen_(&c__2, c2, "EV")) {
00192 
00193 /*        Test CGEEV */
00194 
00195         s_copy(srnamc_1.srnamt, "CGEEV ", (ftnlen)32, (ftnlen)6);
00196         infoc_1.infot = 1;
00197         cgeev_("X", "N", &c__0, a, &c__1, x, vl, &c__1, vr, &c__1, w, &c__1, 
00198                 rw, &info);
00199         chkxer_("CGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00200                 infoc_1.ok);
00201         infoc_1.infot = 2;
00202         cgeev_("N", "X", &c__0, a, &c__1, x, vl, &c__1, vr, &c__1, w, &c__1, 
00203                 rw, &info);
00204         chkxer_("CGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00205                 infoc_1.ok);
00206         infoc_1.infot = 3;
00207         cgeev_("N", "N", &c_n1, a, &c__1, x, vl, &c__1, vr, &c__1, w, &c__1, 
00208                 rw, &info);
00209         chkxer_("CGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00210                 infoc_1.ok);
00211         infoc_1.infot = 5;
00212         cgeev_("N", "N", &c__2, a, &c__1, x, vl, &c__1, vr, &c__1, w, &c__4, 
00213                 rw, &info);
00214         chkxer_("CGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00215                 infoc_1.ok);
00216         infoc_1.infot = 8;
00217         cgeev_("V", "N", &c__2, a, &c__2, x, vl, &c__1, vr, &c__1, w, &c__4, 
00218                 rw, &info);
00219         chkxer_("CGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00220                 infoc_1.ok);
00221         infoc_1.infot = 10;
00222         cgeev_("N", "V", &c__2, a, &c__2, x, vl, &c__1, vr, &c__1, w, &c__4, 
00223                 rw, &info);
00224         chkxer_("CGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00225                 infoc_1.ok);
00226         infoc_1.infot = 12;
00227         cgeev_("V", "V", &c__1, a, &c__1, x, vl, &c__1, vr, &c__1, w, &c__1, 
00228                 rw, &info);
00229         chkxer_("CGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00230                 infoc_1.ok);
00231         nt += 7;
00232 
00233     } else if (lsamen_(&c__2, c2, "ES")) {
00234 
00235 /*        Test CGEES */
00236 
00237         s_copy(srnamc_1.srnamt, "CGEES ", (ftnlen)32, (ftnlen)6);
00238         infoc_1.infot = 1;
00239         cgees_("X", "N", (L_fp)cslect_, &c__0, a, &c__1, &sdim, x, vl, &c__1, 
00240                 w, &c__1, rw, b, &info);
00241         chkxer_("CGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00242                 infoc_1.ok);
00243         infoc_1.infot = 2;
00244         cgees_("N", "X", (L_fp)cslect_, &c__0, a, &c__1, &sdim, x, vl, &c__1, 
00245                 w, &c__1, rw, b, &info);
00246         chkxer_("CGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00247                 infoc_1.ok);
00248         infoc_1.infot = 4;
00249         cgees_("N", "S", (L_fp)cslect_, &c_n1, a, &c__1, &sdim, x, vl, &c__1, 
00250                 w, &c__1, rw, b, &info);
00251         chkxer_("CGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00252                 infoc_1.ok);
00253         infoc_1.infot = 6;
00254         cgees_("N", "S", (L_fp)cslect_, &c__2, a, &c__1, &sdim, x, vl, &c__1, 
00255                 w, &c__4, rw, b, &info);
00256         chkxer_("CGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00257                 infoc_1.ok);
00258         infoc_1.infot = 10;
00259         cgees_("V", "S", (L_fp)cslect_, &c__2, a, &c__2, &sdim, x, vl, &c__1, 
00260                 w, &c__4, rw, b, &info);
00261         chkxer_("CGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00262                 infoc_1.ok);
00263         infoc_1.infot = 12;
00264         cgees_("N", "S", (L_fp)cslect_, &c__1, a, &c__1, &sdim, x, vl, &c__1, 
00265                 w, &c__1, rw, b, &info);
00266         chkxer_("CGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00267                 infoc_1.ok);
00268         nt += 6;
00269 
00270     } else if (lsamen_(&c__2, c2, "VX")) {
00271 
00272 /*        Test CGEEVX */
00273 
00274         s_copy(srnamc_1.srnamt, "CGEEVX", (ftnlen)32, (ftnlen)6);
00275         infoc_1.infot = 1;
00276         cgeevx_("X", "N", "N", "N", &c__0, a, &c__1, x, vl, &c__1, vr, &c__1, 
00277                 &ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, rw, &info);
00278         chkxer_("CGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00279                 infoc_1.ok);
00280         infoc_1.infot = 2;
00281         cgeevx_("N", "X", "N", "N", &c__0, a, &c__1, x, vl, &c__1, vr, &c__1, 
00282                 &ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, rw, &info);
00283         chkxer_("CGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00284                 infoc_1.ok);
00285         infoc_1.infot = 3;
00286         cgeevx_("N", "N", "X", "N", &c__0, a, &c__1, x, vl, &c__1, vr, &c__1, 
00287                 &ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, rw, &info);
00288         chkxer_("CGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00289                 infoc_1.ok);
00290         infoc_1.infot = 4;
00291         cgeevx_("N", "N", "N", "X", &c__0, a, &c__1, x, vl, &c__1, vr, &c__1, 
00292                 &ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, rw, &info);
00293         chkxer_("CGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00294                 infoc_1.ok);
00295         infoc_1.infot = 5;
00296         cgeevx_("N", "N", "N", "N", &c_n1, a, &c__1, x, vl, &c__1, vr, &c__1, 
00297                 &ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, rw, &info);
00298         chkxer_("CGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00299                 infoc_1.ok);
00300         infoc_1.infot = 7;
00301         cgeevx_("N", "N", "N", "N", &c__2, a, &c__1, x, vl, &c__1, vr, &c__1, 
00302                 &ilo, &ihi, s, &abnrm, r1, r2, w, &c__4, rw, &info);
00303         chkxer_("CGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00304                 infoc_1.ok);
00305         infoc_1.infot = 10;
00306         cgeevx_("N", "V", "N", "N", &c__2, a, &c__2, x, vl, &c__1, vr, &c__1, 
00307                 &ilo, &ihi, s, &abnrm, r1, r2, w, &c__4, rw, &info);
00308         chkxer_("CGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00309                 infoc_1.ok);
00310         infoc_1.infot = 12;
00311         cgeevx_("N", "N", "V", "N", &c__2, a, &c__2, x, vl, &c__1, vr, &c__1, 
00312                 &ilo, &ihi, s, &abnrm, r1, r2, w, &c__4, rw, &info);
00313         chkxer_("CGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00314                 infoc_1.ok);
00315         infoc_1.infot = 20;
00316         cgeevx_("N", "N", "N", "N", &c__1, a, &c__1, x, vl, &c__1, vr, &c__1, 
00317                 &ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, rw, &info);
00318         chkxer_("CGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00319                 infoc_1.ok);
00320         infoc_1.infot = 20;
00321         cgeevx_("N", "N", "V", "V", &c__1, a, &c__1, x, vl, &c__1, vr, &c__1, 
00322                 &ilo, &ihi, s, &abnrm, r1, r2, w, &c__2, rw, &info);
00323         chkxer_("CGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00324                 infoc_1.ok);
00325         nt += 10;
00326 
00327     } else if (lsamen_(&c__2, c2, "SX")) {
00328 
00329 /*        Test CGEESX */
00330 
00331         s_copy(srnamc_1.srnamt, "CGEESX", (ftnlen)32, (ftnlen)6);
00332         infoc_1.infot = 1;
00333         cgeesx_("X", "N", (L_fp)cslect_, "N", &c__0, a, &c__1, &sdim, x, vl, &
00334                 c__1, r1, r2, w, &c__1, rw, b, &info);
00335         chkxer_("CGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00336                 infoc_1.ok);
00337         infoc_1.infot = 2;
00338         cgeesx_("N", "X", (L_fp)cslect_, "N", &c__0, a, &c__1, &sdim, x, vl, &
00339                 c__1, r1, r2, w, &c__1, rw, b, &info);
00340         chkxer_("CGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00341                 infoc_1.ok);
00342         infoc_1.infot = 4;
00343         cgeesx_("N", "N", (L_fp)cslect_, "X", &c__0, a, &c__1, &sdim, x, vl, &
00344                 c__1, r1, r2, w, &c__1, rw, b, &info);
00345         chkxer_("CGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00346                 infoc_1.ok);
00347         infoc_1.infot = 5;
00348         cgeesx_("N", "N", (L_fp)cslect_, "N", &c_n1, a, &c__1, &sdim, x, vl, &
00349                 c__1, r1, r2, w, &c__1, rw, b, &info);
00350         chkxer_("CGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00351                 infoc_1.ok);
00352         infoc_1.infot = 7;
00353         cgeesx_("N", "N", (L_fp)cslect_, "N", &c__2, a, &c__1, &sdim, x, vl, &
00354                 c__1, r1, r2, w, &c__4, rw, b, &info);
00355         chkxer_("CGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00356                 infoc_1.ok);
00357         infoc_1.infot = 11;
00358         cgeesx_("V", "N", (L_fp)cslect_, "N", &c__2, a, &c__2, &sdim, x, vl, &
00359                 c__1, r1, r2, w, &c__4, rw, b, &info);
00360         chkxer_("CGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00361                 infoc_1.ok);
00362         infoc_1.infot = 15;
00363         cgeesx_("N", "N", (L_fp)cslect_, "N", &c__1, a, &c__1, &sdim, x, vl, &
00364                 c__1, r1, r2, w, &c__1, rw, b, &info);
00365         chkxer_("CGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00366                 infoc_1.ok);
00367         nt += 7;
00368 
00369     } else if (lsamen_(&c__2, c2, "BD")) {
00370 
00371 /*        Test CGESVD */
00372 
00373         s_copy(srnamc_1.srnamt, "CGESVD", (ftnlen)32, (ftnlen)6);
00374         infoc_1.infot = 1;
00375         cgesvd_("X", "N", &c__0, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, &
00376                 c__1, rw, &info);
00377         chkxer_("CGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00378                 infoc_1.ok);
00379         infoc_1.infot = 2;
00380         cgesvd_("N", "X", &c__0, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, &
00381                 c__1, rw, &info);
00382         chkxer_("CGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00383                 infoc_1.ok);
00384         infoc_1.infot = 2;
00385         cgesvd_("O", "O", &c__0, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, &
00386                 c__1, rw, &info);
00387         chkxer_("CGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00388                 infoc_1.ok);
00389         infoc_1.infot = 3;
00390         cgesvd_("N", "N", &c_n1, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, &
00391                 c__1, rw, &info);
00392         chkxer_("CGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00393                 infoc_1.ok);
00394         infoc_1.infot = 4;
00395         cgesvd_("N", "N", &c__0, &c_n1, a, &c__1, s, u, &c__1, vt, &c__1, w, &
00396                 c__1, rw, &info);
00397         chkxer_("CGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00398                 infoc_1.ok);
00399         infoc_1.infot = 6;
00400         cgesvd_("N", "N", &c__2, &c__1, a, &c__1, s, u, &c__1, vt, &c__1, w, &
00401                 c__5, rw, &info);
00402         chkxer_("CGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00403                 infoc_1.ok);
00404         infoc_1.infot = 9;
00405         cgesvd_("A", "N", &c__2, &c__1, a, &c__2, s, u, &c__1, vt, &c__1, w, &
00406                 c__5, rw, &info);
00407         chkxer_("CGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00408                 infoc_1.ok);
00409         infoc_1.infot = 11;
00410         cgesvd_("N", "A", &c__1, &c__2, a, &c__1, s, u, &c__1, vt, &c__1, w, &
00411                 c__5, rw, &info);
00412         chkxer_("CGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00413                 infoc_1.ok);
00414         nt += 8;
00415         if (infoc_1.ok) {
00416             io___23.ciunit = infoc_1.nout;
00417             s_wsfe(&io___23);
00418             do_fio(&c__1, srnamc_1.srnamt, i_len_trim(srnamc_1.srnamt, (
00419                     ftnlen)32));
00420             do_fio(&c__1, (char *)&nt, (ftnlen)sizeof(integer));
00421             e_wsfe();
00422         } else {
00423             io___24.ciunit = infoc_1.nout;
00424             s_wsfe(&io___24);
00425             e_wsfe();
00426         }
00427 
00428 /*        Test CGESDD */
00429 
00430         s_copy(srnamc_1.srnamt, "CGESDD", (ftnlen)32, (ftnlen)6);
00431         infoc_1.infot = 1;
00432         cgesdd_("X", &c__0, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, &c__1, 
00433                  rw, iw, &info);
00434         chkxer_("CGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00435                 infoc_1.ok);
00436         infoc_1.infot = 2;
00437         cgesdd_("N", &c_n1, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, &c__1, 
00438                  rw, iw, &info);
00439         chkxer_("CGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00440                 infoc_1.ok);
00441         infoc_1.infot = 3;
00442         cgesdd_("N", &c__0, &c_n1, a, &c__1, s, u, &c__1, vt, &c__1, w, &c__1, 
00443                  rw, iw, &info);
00444         chkxer_("CGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00445                 infoc_1.ok);
00446         infoc_1.infot = 5;
00447         cgesdd_("N", &c__2, &c__1, a, &c__1, s, u, &c__1, vt, &c__1, w, &c__5, 
00448                  rw, iw, &info);
00449         chkxer_("CGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00450                 infoc_1.ok);
00451         infoc_1.infot = 8;
00452         cgesdd_("A", &c__2, &c__1, a, &c__2, s, u, &c__1, vt, &c__1, w, &c__5, 
00453                  rw, iw, &info);
00454         chkxer_("CGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00455                 infoc_1.ok);
00456         infoc_1.infot = 10;
00457         cgesdd_("A", &c__1, &c__2, a, &c__1, s, u, &c__1, vt, &c__1, w, &c__5, 
00458                  rw, iw, &info);
00459         chkxer_("CGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00460                 infoc_1.ok);
00461         nt += -2;
00462         if (infoc_1.ok) {
00463             io___26.ciunit = infoc_1.nout;
00464             s_wsfe(&io___26);
00465             do_fio(&c__1, srnamc_1.srnamt, i_len_trim(srnamc_1.srnamt, (
00466                     ftnlen)32));
00467             do_fio(&c__1, (char *)&nt, (ftnlen)sizeof(integer));
00468             e_wsfe();
00469         } else {
00470             io___27.ciunit = infoc_1.nout;
00471             s_wsfe(&io___27);
00472             e_wsfe();
00473         }
00474     }
00475 
00476 /*     Print a summary line. */
00477 
00478     if (! lsamen_(&c__2, c2, "BD")) {
00479         if (infoc_1.ok) {
00480             io___28.ciunit = infoc_1.nout;
00481             s_wsfe(&io___28);
00482             do_fio(&c__1, srnamc_1.srnamt, i_len_trim(srnamc_1.srnamt, (
00483                     ftnlen)32));
00484             do_fio(&c__1, (char *)&nt, (ftnlen)sizeof(integer));
00485             e_wsfe();
00486         } else {
00487             io___29.ciunit = infoc_1.nout;
00488             s_wsfe(&io___29);
00489             e_wsfe();
00490         }
00491     }
00492 
00493     return 0;
00494 
00495 /*     End of CERRED */
00496 
00497 } /* cerred_ */


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