swiftnav: zlatb4.c Source File

Go to the documentation of this file.
00001 /* zlatb4.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 zlatb4_(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 /*  ZLATB4 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 /*     xQR, xLQ, xQL, xRQ:  Set parameters to generate a general */
00144 /*                          M x N matrix. */
00145 
00146     if (lsamen_(&c__2, c2, "QR") || lsamen_(&c__2, c2, 
00147             "LQ") || lsamen_(&c__2, c2, "QL") || lsamen_(&c__2, c2, "RQ")) {
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, "HE") || lsamen_(&c__2, c2, "HP") || lsamen_(&c__2, c2, "SY") || 
00308             lsamen_(&c__2, c2, "SP")) {
00309 
00310 /*        xPO, xPP, xHE, xHP, xSY, xSP: Set parameters to generate a */
00311 /*        symmetric or Hermitian matrix. */
00312 
00313 /*        Set TYPE, the type of matrix to be generated. */
00314 
00315         *(unsigned char *)type__ = *(unsigned char *)c2;
00316 
00317 /*        Set the lower and upper bandwidths. */
00318 
00319         if (*imat == 1) {
00320             *kl = 0;
00321         } else {
00322 /* Computing MAX */
00323             i__1 = *n - 1;
00324             *kl = max(i__1,0);
00325         }
00326         *ku = *kl;
00327 
00328 /*        Set the condition number and norm. */
00329 
00330         if (*imat == 6) {
00331             *cndnum = badc1;
00332         } else if (*imat == 7) {
00333             *cndnum = badc2;
00334         } else {
00335             *cndnum = 2.;
00336         }
00337 
00338         if (*imat == 8) {
00339             *anorm = small;
00340         } else if (*imat == 9) {
00341             *anorm = large;
00342         } else {
00343             *anorm = 1.;
00344         }
00345 
00346     } else if (lsamen_(&c__2, c2, "PB")) {
00347 
00348 /*        xPB:  Set parameters to generate a symmetric band matrix. */
00349 
00350 /*        Set TYPE, the type of matrix to be generated. */
00351 
00352         *(unsigned char *)type__ = 'P';
00353 
00354 /*        Set the norm and condition number. */
00355 
00356         if (*imat == 5) {
00357             *cndnum = badc1;
00358         } else if (*imat == 6) {
00359             *cndnum = badc2;
00360         } else {
00361             *cndnum = 2.;
00362         }
00363 
00364         if (*imat == 7) {
00365             *anorm = small;
00366         } else if (*imat == 8) {
00367             *anorm = large;
00368         } else {
00369             *anorm = 1.;
00370         }
00371 
00372     } else if (lsamen_(&c__2, c2, "PT")) {
00373 
00374 /*        xPT:  Set parameters to generate a symmetric positive definite */
00375 /*        tridiagonal matrix. */
00376 
00377         *(unsigned char *)type__ = 'P';
00378         if (*imat == 1) {
00379             *kl = 0;
00380         } else {
00381             *kl = 1;
00382         }
00383         *ku = *kl;
00384 
00385 /*        Set the condition number and norm. */
00386 
00387         if (*imat == 3) {
00388             *cndnum = badc1;
00389         } else if (*imat == 4) {
00390             *cndnum = badc2;
00391         } else {
00392             *cndnum = 2.;
00393         }
00394 
00395         if (*imat == 5 || *imat == 11) {
00396             *anorm = small;
00397         } else if (*imat == 6 || *imat == 12) {
00398             *anorm = large;
00399         } else {
00400             *anorm = 1.;
00401         }
00402 
00403     } else if (lsamen_(&c__2, c2, "TR") || lsamen_(&
00404             c__2, c2, "TP")) {
00405 
00406 /*        xTR, xTP:  Set parameters to generate a triangular matrix */
00407 
00408 /*        Set TYPE, the type of matrix to be generated. */
00409 
00410         *(unsigned char *)type__ = 'N';
00411 
00412 /*        Set the lower and upper bandwidths. */
00413 
00414         mat = abs(*imat);
00415         if (mat == 1 || mat == 7) {
00416             *kl = 0;
00417             *ku = 0;
00418         } else if (*imat < 0) {
00419 /* Computing MAX */
00420             i__1 = *n - 1;
00421             *kl = max(i__1,0);
00422             *ku = 0;
00423         } else {
00424             *kl = 0;
00425 /* Computing MAX */
00426             i__1 = *n - 1;
00427             *ku = max(i__1,0);
00428         }
00429 
00430 /*        Set the condition number and norm. */
00431 
00432         if (mat == 3 || mat == 9) {
00433             *cndnum = badc1;
00434         } else if (mat == 4 || mat == 10) {
00435             *cndnum = badc2;
00436         } else {
00437             *cndnum = 2.;
00438         }
00439 
00440         if (mat == 5) {
00441             *anorm = small;
00442         } else if (mat == 6) {
00443             *anorm = large;
00444         } else {
00445             *anorm = 1.;
00446         }
00447 
00448     } else if (lsamen_(&c__2, c2, "TB")) {
00449 
00450 /*        xTB:  Set parameters to generate a triangular band matrix. */
00451 
00452 /*        Set TYPE, the type of matrix to be generated. */
00453 
00454         *(unsigned char *)type__ = 'N';
00455 
00456 /*        Set the norm and condition number. */
00457 
00458         if (*imat == 2 || *imat == 8) {
00459             *cndnum = badc1;
00460         } else if (*imat == 3 || *imat == 9) {
00461             *cndnum = badc2;
00462         } else {
00463             *cndnum = 2.;
00464         }
00465 
00466         if (*imat == 4) {
00467             *anorm = small;
00468         } else if (*imat == 5) {
00469             *anorm = large;
00470         } else {
00471             *anorm = 1.;
00472         }
00473     }
00474     if (*n <= 1) {
00475         *cndnum = 1.;
00476     }
00477 
00478     return 0;
00479 
00480 /*     End of ZLATB4 */
00481 
00482 } /* zlatb4_ */