swiftnav: dlatb4.c Source File

Go to the documentation of this file.
00001 /* dlatb4.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__2 = 2;
00019 
00020 /* Subroutine */ int dlatb4_(char *path, integer *imat, integer *m, integer *
00021         n, char *type__, integer *kl, integer *ku, doublereal *anorm, integer 
00022         *mode, doublereal *cndnum, char *dist)
00023 {
00024     /* Initialized data */
00025 
00026     static logical first = TRUE_;
00027 
00028     /* System generated locals */
00029     integer i__1;
00030 
00031     /* Builtin functions */
00032     double sqrt(doublereal);
00033     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
00034 
00035     /* Local variables */
00036     char c2[2];
00037     integer mat;
00038     static doublereal eps, badc1, badc2, large, small;
00039     extern /* Subroutine */ int dlabad_(doublereal *, doublereal *);
00040     extern doublereal dlamch_(char *);
00041     extern logical lsamen_(integer *, char *, char *);
00042 
00043 
00044 /*  -- LAPACK test routine (version 3.1) -- */
00045 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00046 /*     November 2006 */
00047 
00048 /*     .. Scalar Arguments .. */
00049 /*     .. */
00050 
00051 /*  Purpose */
00052 /*  ======= */
00053 
00054 /*  DLATB4 sets parameters for the matrix generator based on the type of */
00055 /*  matrix to be generated. */
00056 
00057 /*  Arguments */
00058 /*  ========= */
00059 
00060 /*  PATH    (input) CHARACTER*3 */
00061 /*          The LAPACK path name. */
00062 
00063 /*  IMAT    (input) INTEGER */
00064 /*          An integer key describing which matrix to generate for this */
00065 /*          path. */
00066 
00067 /*  M       (input) INTEGER */
00068 /*          The number of rows in the matrix to be generated. */
00069 
00070 /*  N       (input) INTEGER */
00071 /*          The number of columns in the matrix to be generated. */
00072 
00073 /*  TYPE    (output) CHARACTER*1 */
00074 /*          The type of the matrix to be generated: */
00075 /*          = 'S':  symmetric matrix */
00076 /*          = 'P':  symmetric positive (semi)definite matrix */
00077 /*          = 'N':  nonsymmetric matrix */
00078 
00079 /*  KL      (output) INTEGER */
00080 /*          The lower band width of the matrix to be generated. */
00081 
00082 /*  KU      (output) INTEGER */
00083 /*          The upper band width of the matrix to be generated. */
00084 
00085 /*  ANORM   (output) DOUBLE PRECISION */
00086 /*          The desired norm of the matrix to be generated.  The diagonal */
00087 /*          matrix of singular values or eigenvalues is scaled by this */
00088 /*          value. */
00089 
00090 /*  MODE    (output) INTEGER */
00091 /*          A key indicating how to choose the vector of eigenvalues. */
00092 
00093 /*  CNDNUM  (output) DOUBLE PRECISION */
00094 /*          The desired condition number. */
00095 
00096 /*  DIST    (output) CHARACTER*1 */
00097 /*          The type of distribution to be used by the random number */
00098 /*          generator. */
00099 
00100 /*  ===================================================================== */
00101 
00102 /*     .. Parameters .. */
00103 /*     .. */
00104 /*     .. Local Scalars .. */
00105 /*     .. */
00106 /*     .. External Functions .. */
00107 /*     .. */
00108 /*     .. Intrinsic Functions .. */
00109 /*     .. */
00110 /*     .. External Subroutines .. */
00111 /*     .. */
00112 /*     .. Save statement .. */
00113 /*     .. */
00114 /*     .. Data statements .. */
00115 /*     .. */
00116 /*     .. Executable Statements .. */
00117 
00118 /*     Set some constants for use in the subroutine. */
00119 
00120     if (first) {
00121         first = FALSE_;
00122         eps = dlamch_("Precision");
00123         badc2 = .1 / eps;
00124         badc1 = sqrt(badc2);
00125         small = dlamch_("Safe minimum");
00126         large = 1. / small;
00127 
00128 /*        If it looks like we're on a Cray, take the square root of */
00129 /*        SMALL and LARGE to avoid overflow and underflow problems. */
00130 
00131         dlabad_(&small, &large);
00132         small = small / eps * .25;
00133         large = 1. / small;
00134     }
00135 
00136     s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
00137 
00138 /*     Set some parameters we don't plan to change. */
00139 
00140     *(unsigned char *)dist = 'S';
00141     *mode = 3;
00142 
00143     if (lsamen_(&c__2, c2, "QR") || lsamen_(&c__2, c2, 
00144             "LQ") || lsamen_(&c__2, c2, "QL") || lsamen_(&c__2, c2, "RQ")) {
00145 
00146 /*        xQR, xLQ, xQL, xRQ:  Set parameters to generate a general */
00147 /*                             M x N matrix. */
00148 
00149 /*        Set TYPE, the type of matrix to be generated. */
00150 
00151         *(unsigned char *)type__ = 'N';
00152 
00153 /*        Set the lower and upper bandwidths. */
00154 
00155         if (*imat == 1) {
00156             *kl = 0;
00157             *ku = 0;
00158         } else if (*imat == 2) {
00159             *kl = 0;
00160 /* Computing MAX */
00161             i__1 = *n - 1;
00162             *ku = max(i__1,0);
00163         } else if (*imat == 3) {
00164 /* Computing MAX */
00165             i__1 = *m - 1;
00166             *kl = max(i__1,0);
00167             *ku = 0;
00168         } else {
00169 /* Computing MAX */
00170             i__1 = *m - 1;
00171             *kl = max(i__1,0);
00172 /* Computing MAX */
00173             i__1 = *n - 1;
00174             *ku = max(i__1,0);
00175         }
00176 
00177 /*        Set the condition number and norm. */
00178 
00179         if (*imat == 5) {
00180             *cndnum = badc1;
00181         } else if (*imat == 6) {
00182             *cndnum = badc2;
00183         } else {
00184             *cndnum = 2.;
00185         }
00186 
00187         if (*imat == 7) {
00188             *anorm = small;
00189         } else if (*imat == 8) {
00190             *anorm = large;
00191         } else {
00192             *anorm = 1.;
00193         }
00194 
00195     } else if (lsamen_(&c__2, c2, "GE")) {
00196 
00197 /*        xGE:  Set parameters to generate a general M x N matrix. */
00198 
00199 /*        Set TYPE, the type of matrix to be generated. */
00200 
00201         *(unsigned char *)type__ = 'N';
00202 
00203 /*        Set the lower and upper bandwidths. */
00204 
00205         if (*imat == 1) {
00206             *kl = 0;
00207             *ku = 0;
00208         } else if (*imat == 2) {
00209             *kl = 0;
00210 /* Computing MAX */
00211             i__1 = *n - 1;
00212             *ku = max(i__1,0);
00213         } else if (*imat == 3) {
00214 /* Computing MAX */
00215             i__1 = *m - 1;
00216             *kl = max(i__1,0);
00217             *ku = 0;
00218         } else {
00219 /* Computing MAX */
00220             i__1 = *m - 1;
00221             *kl = max(i__1,0);
00222 /* Computing MAX */
00223             i__1 = *n - 1;
00224             *ku = max(i__1,0);
00225         }
00226 
00227 /*        Set the condition number and norm. */
00228 
00229         if (*imat == 8) {
00230             *cndnum = badc1;
00231         } else if (*imat == 9) {
00232             *cndnum = badc2;
00233         } else {
00234             *cndnum = 2.;
00235         }
00236 
00237         if (*imat == 10) {
00238             *anorm = small;
00239         } else if (*imat == 11) {
00240             *anorm = large;
00241         } else {
00242             *anorm = 1.;
00243         }
00244 
00245     } else if (lsamen_(&c__2, c2, "GB")) {
00246 
00247 /*        xGB:  Set parameters to generate a general banded matrix. */
00248 
00249 /*        Set TYPE, the type of matrix to be generated. */
00250 
00251         *(unsigned char *)type__ = 'N';
00252 
00253 /*        Set the condition number and norm. */
00254 
00255         if (*imat == 5) {
00256             *cndnum = badc1;
00257         } else if (*imat == 6) {
00258             *cndnum = badc2 * .1;
00259         } else {
00260             *cndnum = 2.;
00261         }
00262 
00263         if (*imat == 7) {
00264             *anorm = small;
00265         } else if (*imat == 8) {
00266             *anorm = large;
00267         } else {
00268             *anorm = 1.;
00269         }
00270 
00271     } else if (lsamen_(&c__2, c2, "GT")) {
00272 
00273 /*        xGT:  Set parameters to generate a general tridiagonal matrix. */
00274 
00275 /*        Set TYPE, the type of matrix to be generated. */
00276 
00277         *(unsigned char *)type__ = 'N';
00278 
00279 /*        Set the lower and upper bandwidths. */
00280 
00281         if (*imat == 1) {
00282             *kl = 0;
00283         } else {
00284             *kl = 1;
00285         }
00286         *ku = *kl;
00287 
00288 /*        Set the condition number and norm. */
00289 
00290         if (*imat == 3) {
00291             *cndnum = badc1;
00292         } else if (*imat == 4) {
00293             *cndnum = badc2;
00294         } else {
00295             *cndnum = 2.;
00296         }
00297 
00298         if (*imat == 5 || *imat == 11) {
00299             *anorm = small;
00300         } else if (*imat == 6 || *imat == 12) {
00301             *anorm = large;
00302         } else {
00303             *anorm = 1.;
00304         }
00305 
00306     } else if (lsamen_(&c__2, c2, "PO") || lsamen_(&
00307             c__2, c2, "PP") || lsamen_(&c__2, c2, "SY") || lsamen_(&c__2, c2, "SP")) {
00308 
00309 /*        xPO, xPP, xSY, xSP: Set parameters to generate a */
00310 /*        symmetric matrix. */
00311 
00312 /*        Set TYPE, the type of matrix to be generated. */
00313 
00314         *(unsigned char *)type__ = *(unsigned char *)c2;
00315 
00316 /*        Set the lower and upper bandwidths. */
00317 
00318         if (*imat == 1) {
00319             *kl = 0;
00320         } else {
00321 /* Computing MAX */
00322             i__1 = *n - 1;
00323             *kl = max(i__1,0);
00324         }
00325         *ku = *kl;
00326 
00327 /*        Set the condition number and norm. */
00328 
00329         if (*imat == 6) {
00330             *cndnum = badc1;
00331         } else if (*imat == 7) {
00332             *cndnum = badc2;
00333         } else {
00334             *cndnum = 2.;
00335         }
00336 
00337         if (*imat == 8) {
00338             *anorm = small;
00339         } else if (*imat == 9) {
00340             *anorm = large;
00341         } else {
00342             *anorm = 1.;
00343         }
00344 
00345     } else if (lsamen_(&c__2, c2, "PB")) {
00346 
00347 /*        xPB:  Set parameters to generate a symmetric band matrix. */
00348 
00349 /*        Set TYPE, the type of matrix to be generated. */
00350 
00351         *(unsigned char *)type__ = 'P';
00352 
00353 /*        Set the norm and condition number. */
00354 
00355         if (*imat == 5) {
00356             *cndnum = badc1;
00357         } else if (*imat == 6) {
00358             *cndnum = badc2;
00359         } else {
00360             *cndnum = 2.;
00361         }
00362 
00363         if (*imat == 7) {
00364             *anorm = small;
00365         } else if (*imat == 8) {
00366             *anorm = large;
00367         } else {
00368             *anorm = 1.;
00369         }
00370 
00371     } else if (lsamen_(&c__2, c2, "PT")) {
00372 
00373 /*        xPT:  Set parameters to generate a symmetric positive definite */
00374 /*        tridiagonal matrix. */
00375 
00376         *(unsigned char *)type__ = 'P';
00377         if (*imat == 1) {
00378             *kl = 0;
00379         } else {
00380             *kl = 1;
00381         }
00382         *ku = *kl;
00383 
00384 /*        Set the condition number and norm. */
00385 
00386         if (*imat == 3) {
00387             *cndnum = badc1;
00388         } else if (*imat == 4) {
00389             *cndnum = badc2;
00390         } else {
00391             *cndnum = 2.;
00392         }
00393 
00394         if (*imat == 5 || *imat == 11) {
00395             *anorm = small;
00396         } else if (*imat == 6 || *imat == 12) {
00397             *anorm = large;
00398         } else {
00399             *anorm = 1.;
00400         }
00401 
00402     } else if (lsamen_(&c__2, c2, "TR") || lsamen_(&
00403             c__2, c2, "TP")) {
00404 
00405 /*        xTR, xTP:  Set parameters to generate a triangular matrix */
00406 
00407 /*        Set TYPE, the type of matrix to be generated. */
00408 
00409         *(unsigned char *)type__ = 'N';
00410 
00411 /*        Set the lower and upper bandwidths. */
00412 
00413         mat = abs(*imat);
00414         if (mat == 1 || mat == 7) {
00415             *kl = 0;
00416             *ku = 0;
00417         } else if (*imat < 0) {
00418 /* Computing MAX */
00419             i__1 = *n - 1;
00420             *kl = max(i__1,0);
00421             *ku = 0;
00422         } else {
00423             *kl = 0;
00424 /* Computing MAX */
00425             i__1 = *n - 1;
00426             *ku = max(i__1,0);
00427         }
00428 
00429 /*        Set the condition number and norm. */
00430 
00431         if (mat == 3 || mat == 9) {
00432             *cndnum = badc1;
00433         } else if (mat == 4) {
00434             *cndnum = badc2;
00435         } else if (mat == 10) {
00436             *cndnum = badc2;
00437         } else {
00438             *cndnum = 2.;
00439         }
00440 
00441         if (mat == 5) {
00442             *anorm = small;
00443         } else if (mat == 6) {
00444             *anorm = large;
00445         } else {
00446             *anorm = 1.;
00447         }
00448 
00449     } else if (lsamen_(&c__2, c2, "TB")) {
00450 
00451 /*        xTB:  Set parameters to generate a triangular band matrix. */
00452 
00453 /*        Set TYPE, the type of matrix to be generated. */
00454 
00455         *(unsigned char *)type__ = 'N';
00456 
00457 /*        Set the norm and condition number. */
00458 
00459         if (*imat == 2 || *imat == 8) {
00460             *cndnum = badc1;
00461         } else if (*imat == 3 || *imat == 9) {
00462             *cndnum = badc2;
00463         } else {
00464             *cndnum = 2.;
00465         }
00466 
00467         if (*imat == 4) {
00468             *anorm = small;
00469         } else if (*imat == 5) {
00470             *anorm = large;
00471         } else {
00472             *anorm = 1.;
00473         }
00474     }
00475     if (*n <= 1) {
00476         *cndnum = 1.;
00477     }
00478 
00479     return 0;
00480 
00481 /*     End of DLATB4 */
00482 
00483 } /* dlatb4_ */