cchkrfp.c
Go to the documentation of this file.
00001 /* cchkrfp.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 integer c__1 = 1;
00019 static integer c__3 = 3;
00020 static integer c__12 = 12;
00021 static integer c__0 = 0;
00022 static integer c__50 = 50;
00023 static integer c__16 = 16;
00024 static integer c__9 = 9;
00025 static integer c__4 = 4;
00026 static integer c__8 = 8;
00027 static integer c__6 = 6;
00028 
00029 /* Main program */ int MAIN__(void)
00030 {
00031     /* Format strings */
00032     static char fmt_9994[] = "(/\002 Tests of the COMPLEX LAPACK RFP routine"
00033             "s \002,/\002 LAPACK VERSION \002,i1,\002.\002,i1,\002.\002,i1,/"
00034             "/\002 The following parameter values will be used:\002)";
00035     static char fmt_9996[] = "(\002 !! Invalid input value: \002,a4,\002="
00036             "\002,i6,\002; must be >=\002,i6)";
00037     static char fmt_9995[] = "(\002 !! Invalid input value: \002,a4,\002="
00038             "\002,i6,\002; must be <=\002,i6)";
00039     static char fmt_9993[] = "(4x,a4,\002:  \002,10i6,/11x,10i6)";
00040     static char fmt_9992[] = "(/\002 Routines pass computational tests if te"
00041             "st ratio is \002,\002less than\002,f8.2,/)";
00042     static char fmt_9999[] = "(/\002 Execution not attempted due to input er"
00043             "rors\002)";
00044     static char fmt_9991[] = "(\002 Relative machine \002,a,\002 is taken to"
00045             " be\002,d16.6)";
00046     static char fmt_9998[] = "(/\002 End of tests\002)";
00047     static char fmt_9997[] = "(\002 Total time used = \002,f12.2,\002 seco"
00048             "nds\002,/)";
00049 
00050     /* System generated locals */
00051     integer i__1;
00052     real r__1;
00053     cllist cl__1;
00054 
00055     /* Builtin functions */
00056     integer s_rsle(cilist *), e_rsle(void), s_wsfe(cilist *), do_fio(integer *
00057             , char *, ftnlen), e_wsfe(void), do_lio(integer *, integer *, 
00058             char *, ftnlen);
00059     /* Subroutine */ int s_stop(char *, ftnlen);
00060     integer s_wsle(cilist *), e_wsle(void), f_clos(cllist *);
00061 
00062     /* Local variables */
00063     complex workafac[2500]      /* was [50][50] */, workasav[2500]      /* 
00064             was [50][50] */, workbsav[800]      /* was [50][16] */, workainv[
00065             2500]       /* was [50][50] */, workxact[800]       /* was [50][
00066             16] */;
00067     integer i__;
00068     real s1, s2;
00069     integer nn, vers_patch__, vers_major__, vers_minor__;
00070     complex workarfinv[1275];
00071     real eps;
00072     integer nns, nnt, nval[12];
00073     complex c_work_cpot01__[50], c_work_cpot02__[800]   /* was [50][16] */, 
00074             c_work_cpot03__[2500]       /* was [50][50] */;
00075     real s_work_cpot02__[50], s_work_cpot03__[50];
00076     logical fatal;
00077     integer nsval[12], ntval[9];
00078     complex worka[2500] /* was [50][50] */, workb[800]  /* was [50][16] */, 
00079             workx[800]  /* was [50][16] */;
00080     real s_work_clanhe__[50];
00081     complex c_work_clatms__[150];
00082     real s_work_clatms__[50];
00083     extern doublereal slamch_(char *), second_(void);
00084     extern /* Subroutine */ int ilaver_(integer *, integer *, integer *);
00085     real thresh;
00086     complex workap[1275];
00087     logical tsterr;
00088     extern /* Subroutine */ int cdrvrf1_(integer *, integer *, integer *, 
00089             real *, complex *, integer *, complex *, real *), cdrvrf2_(
00090             integer *, integer *, integer *, complex *, integer *, complex *, 
00091             complex *, complex *), cdrvrf3_(integer *, integer *, integer *, 
00092             real *, complex *, integer *, complex *, complex *, complex *, 
00093             real *, complex *, complex *), cdrvrf4_(integer *, integer *, 
00094             integer *, real *, complex *, complex *, integer *, complex *, 
00095             complex *, integer *, real *), cerrrfp_(integer *), cdrvrfp_(
00096             integer *, integer *, integer *, integer *, integer *, integer *, 
00097             integer *, real *, complex *, complex *, complex *, complex *, 
00098             complex *, complex *, complex *, complex *, complex *, complex *, 
00099             complex *, complex *, complex *, complex *, real *, real *, real *
00100 , real *);
00101     complex workarf[1275];
00102 
00103     /* Fortran I/O blocks */
00104     static cilist io___3 = { 0, 5, 0, 0, 0 };
00105     static cilist io___7 = { 0, 6, 0, fmt_9994, 0 };
00106     static cilist io___8 = { 0, 5, 0, 0, 0 };
00107     static cilist io___10 = { 0, 6, 0, fmt_9996, 0 };
00108     static cilist io___11 = { 0, 6, 0, fmt_9995, 0 };
00109     static cilist io___12 = { 0, 5, 0, 0, 0 };
00110     static cilist io___15 = { 0, 6, 0, fmt_9996, 0 };
00111     static cilist io___16 = { 0, 6, 0, fmt_9995, 0 };
00112     static cilist io___17 = { 0, 6, 0, fmt_9993, 0 };
00113     static cilist io___18 = { 0, 5, 0, 0, 0 };
00114     static cilist io___20 = { 0, 6, 0, fmt_9996, 0 };
00115     static cilist io___21 = { 0, 6, 0, fmt_9995, 0 };
00116     static cilist io___22 = { 0, 5, 0, 0, 0 };
00117     static cilist io___24 = { 0, 6, 0, fmt_9996, 0 };
00118     static cilist io___25 = { 0, 6, 0, fmt_9995, 0 };
00119     static cilist io___26 = { 0, 6, 0, fmt_9993, 0 };
00120     static cilist io___27 = { 0, 5, 0, 0, 0 };
00121     static cilist io___29 = { 0, 6, 0, fmt_9996, 0 };
00122     static cilist io___30 = { 0, 6, 0, fmt_9995, 0 };
00123     static cilist io___31 = { 0, 5, 0, 0, 0 };
00124     static cilist io___33 = { 0, 6, 0, fmt_9996, 0 };
00125     static cilist io___34 = { 0, 6, 0, fmt_9995, 0 };
00126     static cilist io___35 = { 0, 6, 0, fmt_9993, 0 };
00127     static cilist io___36 = { 0, 5, 0, 0, 0 };
00128     static cilist io___38 = { 0, 6, 0, fmt_9992, 0 };
00129     static cilist io___39 = { 0, 5, 0, 0, 0 };
00130     static cilist io___41 = { 0, 6, 0, fmt_9999, 0 };
00131     static cilist io___42 = { 0, 6, 0, fmt_9999, 0 };
00132     static cilist io___44 = { 0, 6, 0, fmt_9991, 0 };
00133     static cilist io___45 = { 0, 6, 0, fmt_9991, 0 };
00134     static cilist io___46 = { 0, 6, 0, fmt_9991, 0 };
00135     static cilist io___47 = { 0, 6, 0, 0, 0 };
00136     static cilist io___68 = { 0, 6, 0, fmt_9998, 0 };
00137     static cilist io___69 = { 0, 6, 0, fmt_9997, 0 };
00138 
00139 
00140 
00141 /*  -- LAPACK test routine (version 3.2.0) -- */
00142 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00143 /*     November 2008 */
00144 
00145 /*  Purpose */
00146 /*  ======= */
00147 
00148 /*  CCHKRFP is the main test program for the COMPLEX linear equation */
00149 /*  routines with RFP storage format */
00150 
00151 
00152 /*  Internal Parameters */
00153 /*  =================== */
00154 
00155 /*  MAXIN   INTEGER */
00156 /*          The number of different values that can be used for each of */
00157 /*          M, N, or NB */
00158 
00159 /*  MAXRHS  INTEGER */
00160 /*          The maximum number of right hand sides */
00161 
00162 /*  NTYPES  INTEGER */
00163 
00164 /*  NMAX    INTEGER */
00165 /*          The maximum allowable value for N. */
00166 
00167 /*  NIN     INTEGER */
00168 /*          The unit number for input */
00169 
00170 /*  NOUT    INTEGER */
00171 /*          The unit number for output */
00172 
00173 /*  ===================================================================== */
00174 
00175 /*     .. Parameters .. */
00176 /*     .. */
00177 /*     .. Local Scalars .. */
00178 /*     .. */
00179 /*     .. Local Arrays .. */
00180 /*     .. */
00181 /*     .. External Functions .. */
00182 /*     .. */
00183 /*     .. External Subroutines .. */
00184 /*     .. */
00185 /*     .. Executable Statements .. */
00186 
00187     s1 = second_();
00188     fatal = FALSE_;
00189 
00190 /*     Read a dummy line. */
00191 
00192     s_rsle(&io___3);
00193     e_rsle();
00194 
00195 /*     Report LAPACK version tag (e.g. LAPACK-3.2.0) */
00196 
00197     ilaver_(&vers_major__, &vers_minor__, &vers_patch__);
00198     s_wsfe(&io___7);
00199     do_fio(&c__1, (char *)&vers_major__, (ftnlen)sizeof(integer));
00200     do_fio(&c__1, (char *)&vers_minor__, (ftnlen)sizeof(integer));
00201     do_fio(&c__1, (char *)&vers_patch__, (ftnlen)sizeof(integer));
00202     e_wsfe();
00203 
00204 /*     Read the values of N */
00205 
00206     s_rsle(&io___8);
00207     do_lio(&c__3, &c__1, (char *)&nn, (ftnlen)sizeof(integer));
00208     e_rsle();
00209     if (nn < 1) {
00210         s_wsfe(&io___10);
00211         do_fio(&c__1, " NN ", (ftnlen)4);
00212         do_fio(&c__1, (char *)&nn, (ftnlen)sizeof(integer));
00213         do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
00214         e_wsfe();
00215         nn = 0;
00216         fatal = TRUE_;
00217     } else if (nn > 12) {
00218         s_wsfe(&io___11);
00219         do_fio(&c__1, " NN ", (ftnlen)4);
00220         do_fio(&c__1, (char *)&nn, (ftnlen)sizeof(integer));
00221         do_fio(&c__1, (char *)&c__12, (ftnlen)sizeof(integer));
00222         e_wsfe();
00223         nn = 0;
00224         fatal = TRUE_;
00225     }
00226     s_rsle(&io___12);
00227     i__1 = nn;
00228     for (i__ = 1; i__ <= i__1; ++i__) {
00229         do_lio(&c__3, &c__1, (char *)&nval[i__ - 1], (ftnlen)sizeof(integer));
00230     }
00231     e_rsle();
00232     i__1 = nn;
00233     for (i__ = 1; i__ <= i__1; ++i__) {
00234         if (nval[i__ - 1] < 0) {
00235             s_wsfe(&io___15);
00236             do_fio(&c__1, " M  ", (ftnlen)4);
00237             do_fio(&c__1, (char *)&nval[i__ - 1], (ftnlen)sizeof(integer));
00238             do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
00239             e_wsfe();
00240             fatal = TRUE_;
00241         } else if (nval[i__ - 1] > 50) {
00242             s_wsfe(&io___16);
00243             do_fio(&c__1, " M  ", (ftnlen)4);
00244             do_fio(&c__1, (char *)&nval[i__ - 1], (ftnlen)sizeof(integer));
00245             do_fio(&c__1, (char *)&c__50, (ftnlen)sizeof(integer));
00246             e_wsfe();
00247             fatal = TRUE_;
00248         }
00249 /* L10: */
00250     }
00251     if (nn > 0) {
00252         s_wsfe(&io___17);
00253         do_fio(&c__1, "N   ", (ftnlen)4);
00254         i__1 = nn;
00255         for (i__ = 1; i__ <= i__1; ++i__) {
00256             do_fio(&c__1, (char *)&nval[i__ - 1], (ftnlen)sizeof(integer));
00257         }
00258         e_wsfe();
00259     }
00260 
00261 /*     Read the values of NRHS */
00262 
00263     s_rsle(&io___18);
00264     do_lio(&c__3, &c__1, (char *)&nns, (ftnlen)sizeof(integer));
00265     e_rsle();
00266     if (nns < 1) {
00267         s_wsfe(&io___20);
00268         do_fio(&c__1, " NNS", (ftnlen)4);
00269         do_fio(&c__1, (char *)&nns, (ftnlen)sizeof(integer));
00270         do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
00271         e_wsfe();
00272         nns = 0;
00273         fatal = TRUE_;
00274     } else if (nns > 12) {
00275         s_wsfe(&io___21);
00276         do_fio(&c__1, " NNS", (ftnlen)4);
00277         do_fio(&c__1, (char *)&nns, (ftnlen)sizeof(integer));
00278         do_fio(&c__1, (char *)&c__12, (ftnlen)sizeof(integer));
00279         e_wsfe();
00280         nns = 0;
00281         fatal = TRUE_;
00282     }
00283     s_rsle(&io___22);
00284     i__1 = nns;
00285     for (i__ = 1; i__ <= i__1; ++i__) {
00286         do_lio(&c__3, &c__1, (char *)&nsval[i__ - 1], (ftnlen)sizeof(integer))
00287                 ;
00288     }
00289     e_rsle();
00290     i__1 = nns;
00291     for (i__ = 1; i__ <= i__1; ++i__) {
00292         if (nsval[i__ - 1] < 0) {
00293             s_wsfe(&io___24);
00294             do_fio(&c__1, "NRHS", (ftnlen)4);
00295             do_fio(&c__1, (char *)&nsval[i__ - 1], (ftnlen)sizeof(integer));
00296             do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
00297             e_wsfe();
00298             fatal = TRUE_;
00299         } else if (nsval[i__ - 1] > 16) {
00300             s_wsfe(&io___25);
00301             do_fio(&c__1, "NRHS", (ftnlen)4);
00302             do_fio(&c__1, (char *)&nsval[i__ - 1], (ftnlen)sizeof(integer));
00303             do_fio(&c__1, (char *)&c__16, (ftnlen)sizeof(integer));
00304             e_wsfe();
00305             fatal = TRUE_;
00306         }
00307 /* L30: */
00308     }
00309     if (nns > 0) {
00310         s_wsfe(&io___26);
00311         do_fio(&c__1, "NRHS", (ftnlen)4);
00312         i__1 = nns;
00313         for (i__ = 1; i__ <= i__1; ++i__) {
00314             do_fio(&c__1, (char *)&nsval[i__ - 1], (ftnlen)sizeof(integer));
00315         }
00316         e_wsfe();
00317     }
00318 
00319 /*     Read the matrix types */
00320 
00321     s_rsle(&io___27);
00322     do_lio(&c__3, &c__1, (char *)&nnt, (ftnlen)sizeof(integer));
00323     e_rsle();
00324     if (nnt < 1) {
00325         s_wsfe(&io___29);
00326         do_fio(&c__1, " NMA", (ftnlen)4);
00327         do_fio(&c__1, (char *)&nnt, (ftnlen)sizeof(integer));
00328         do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
00329         e_wsfe();
00330         nnt = 0;
00331         fatal = TRUE_;
00332     } else if (nnt > 9) {
00333         s_wsfe(&io___30);
00334         do_fio(&c__1, " NMA", (ftnlen)4);
00335         do_fio(&c__1, (char *)&nnt, (ftnlen)sizeof(integer));
00336         do_fio(&c__1, (char *)&c__9, (ftnlen)sizeof(integer));
00337         e_wsfe();
00338         nnt = 0;
00339         fatal = TRUE_;
00340     }
00341     s_rsle(&io___31);
00342     i__1 = nnt;
00343     for (i__ = 1; i__ <= i__1; ++i__) {
00344         do_lio(&c__3, &c__1, (char *)&ntval[i__ - 1], (ftnlen)sizeof(integer))
00345                 ;
00346     }
00347     e_rsle();
00348     i__1 = nnt;
00349     for (i__ = 1; i__ <= i__1; ++i__) {
00350         if (ntval[i__ - 1] < 0) {
00351             s_wsfe(&io___33);
00352             do_fio(&c__1, "TYPE", (ftnlen)4);
00353             do_fio(&c__1, (char *)&ntval[i__ - 1], (ftnlen)sizeof(integer));
00354             do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
00355             e_wsfe();
00356             fatal = TRUE_;
00357         } else if (ntval[i__ - 1] > 9) {
00358             s_wsfe(&io___34);
00359             do_fio(&c__1, "TYPE", (ftnlen)4);
00360             do_fio(&c__1, (char *)&ntval[i__ - 1], (ftnlen)sizeof(integer));
00361             do_fio(&c__1, (char *)&c__9, (ftnlen)sizeof(integer));
00362             e_wsfe();
00363             fatal = TRUE_;
00364         }
00365 /* L320: */
00366     }
00367     if (nnt > 0) {
00368         s_wsfe(&io___35);
00369         do_fio(&c__1, "TYPE", (ftnlen)4);
00370         i__1 = nnt;
00371         for (i__ = 1; i__ <= i__1; ++i__) {
00372             do_fio(&c__1, (char *)&ntval[i__ - 1], (ftnlen)sizeof(integer));
00373         }
00374         e_wsfe();
00375     }
00376 
00377 /*     Read the threshold value for the test ratios. */
00378 
00379     s_rsle(&io___36);
00380     do_lio(&c__4, &c__1, (char *)&thresh, (ftnlen)sizeof(real));
00381     e_rsle();
00382     s_wsfe(&io___38);
00383     do_fio(&c__1, (char *)&thresh, (ftnlen)sizeof(real));
00384     e_wsfe();
00385 
00386 /*     Read the flag that indicates whether to test the error exits. */
00387 
00388     s_rsle(&io___39);
00389     do_lio(&c__8, &c__1, (char *)&tsterr, (ftnlen)sizeof(logical));
00390     e_rsle();
00391 
00392     if (fatal) {
00393         s_wsfe(&io___41);
00394         e_wsfe();
00395         s_stop("", (ftnlen)0);
00396     }
00397 
00398     if (fatal) {
00399         s_wsfe(&io___42);
00400         e_wsfe();
00401         s_stop("", (ftnlen)0);
00402     }
00403 
00404 /*     Calculate and print the machine dependent constants. */
00405 
00406     eps = slamch_("Underflow threshold");
00407     s_wsfe(&io___44);
00408     do_fio(&c__1, "underflow", (ftnlen)9);
00409     do_fio(&c__1, (char *)&eps, (ftnlen)sizeof(real));
00410     e_wsfe();
00411     eps = slamch_("Overflow threshold");
00412     s_wsfe(&io___45);
00413     do_fio(&c__1, "overflow ", (ftnlen)9);
00414     do_fio(&c__1, (char *)&eps, (ftnlen)sizeof(real));
00415     e_wsfe();
00416     eps = slamch_("Epsilon");
00417     s_wsfe(&io___46);
00418     do_fio(&c__1, "precision", (ftnlen)9);
00419     do_fio(&c__1, (char *)&eps, (ftnlen)sizeof(real));
00420     e_wsfe();
00421     s_wsle(&io___47);
00422     e_wsle();
00423 
00424 /*     Test the error exit of: */
00425 
00426     if (tsterr) {
00427         cerrrfp_(&c__6);
00428     }
00429 
00430 /*    Test the routines: cpftrf, cpftri, cpftrs (as in CDRVPO). */
00431 /*    This also tests the routines: ctfsm, ctftri, ctfttr, ctrttf. */
00432 
00433     cdrvrfp_(&c__6, &nn, nval, &nns, nsval, &nnt, ntval, &thresh, worka, 
00434             workasav, workafac, workainv, workb, workbsav, workxact, workx, 
00435             workarf, workarfinv, c_work_clatms__, c_work_cpot01__, 
00436             c_work_cpot02__, c_work_cpot03__, s_work_clatms__, 
00437             s_work_clanhe__, s_work_cpot02__, s_work_cpot03__);
00438 
00439 /*    Test the routine: clanhf */
00440 
00441     cdrvrf1_(&c__6, &nn, nval, &thresh, worka, &c__50, workarf, 
00442             s_work_clanhe__);
00443 
00444 /*    Test the convertion routines: */
00445 /*       chfttp, ctpthf, ctfttr, ctrttf, ctrttp and ctpttr. */
00446 
00447     cdrvrf2_(&c__6, &nn, nval, worka, &c__50, workarf, workap, workasav);
00448 
00449 /*    Test the routine: ctfsm */
00450 
00451     cdrvrf3_(&c__6, &nn, nval, &thresh, worka, &c__50, workarf, workainv, 
00452             workafac, s_work_clanhe__, c_work_cpot03__, c_work_cpot01__);
00453 
00454 
00455 /*    Test the routine: chfrk */
00456 
00457     cdrvrf4_(&c__6, &nn, nval, &thresh, worka, workafac, &c__50, workarf, 
00458             workainv, &c__50, s_work_clanhe__);
00459 
00460     cl__1.cerr = 0;
00461     cl__1.cunit = 5;
00462     cl__1.csta = 0;
00463     f_clos(&cl__1);
00464     s2 = second_();
00465     s_wsfe(&io___68);
00466     e_wsfe();
00467     s_wsfe(&io___69);
00468     r__1 = s2 - s1;
00469     do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real));
00470     e_wsfe();
00471 
00472 
00473 /*     End of CCHKRFP */
00474 
00475     return 0;
00476 } /* MAIN__ */
00477 
00478 /* Main program alias */ int cchkrfp_ () { MAIN__ (); return 0; }


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