slatb5.c
Go to the documentation of this file.
00001 /* slatb5.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 /* Subroutine */ int slatb5_(char *path, integer *imat, integer *n, char *
00017         type__, integer *kl, integer *ku, real *anorm, integer *mode, real *
00018         cndnum, char *dist)
00019 {
00020     /* Initialized data */
00021 
00022     static logical first = TRUE_;
00023 
00024     /* System generated locals */
00025     integer i__1;
00026 
00027     /* Builtin functions */
00028     double sqrt(doublereal);
00029     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
00030 
00031     /* Local variables */
00032     char c2[2];
00033     static real eps, badc1, badc2, large, small;
00034     extern /* Subroutine */ int slabad_(real *, real *);
00035     extern doublereal slamch_(char *);
00036 
00037 
00038 /*  -- LAPACK test routine (version 3.1) -- */
00039 /*     Craig Lucas, University of Manchester / NAG Ltd. */
00040 /*     October, 2008 */
00041 
00042 /*     .. Scalar Arguments .. */
00043 /*     .. */
00044 
00045 /*  Purpose */
00046 /*  ======= */
00047 
00048 /*  SLATB5 sets parameters for the matrix generator based on the type */
00049 /*  of matrix to be generated. */
00050 
00051 /*  Arguments */
00052 /*  ========= */
00053 
00054 /*  PATH    (input) CHARACTER*3 */
00055 /*          The LAPACK path name. */
00056 
00057 /*  IMAT    (input) INTEGER */
00058 /*          An integer key describing which matrix to generate for this */
00059 /*          path. */
00060 
00061 /*  N       (input) INTEGER */
00062 /*          The number of rows and columns in the matrix to be generated. */
00063 
00064 /*  TYPE    (output) CHARACTER*1 */
00065 /*          The type of the matrix to be generated: */
00066 /*          = 'S':  symmetric matrix */
00067 /*          = 'P':  symmetric positive (semi)definite matrix */
00068 /*          = 'N':  nonsymmetric matrix */
00069 
00070 /*  KL      (output) INTEGER */
00071 /*          The lower band width of the matrix to be generated. */
00072 
00073 /*  KU      (output) INTEGER */
00074 /*          The upper band width of the matrix to be generated. */
00075 
00076 /*  ANORM   (output) REAL */
00077 /*          The desired norm of the matrix to be generated.  The diagonal */
00078 /*          matrix of singular values or eigenvalues is scaled by this */
00079 /*          value. */
00080 
00081 /*  MODE    (output) INTEGER */
00082 /*          A key indicating how to choose the vector of eigenvalues. */
00083 
00084 /*  CNDNUM  (output) REAL */
00085 /*          The desired condition number. */
00086 
00087 /*  DIST    (output) CHARACTER*1 */
00088 /*          The type of distribution to be used by the random number */
00089 /*          generator. */
00090 
00091 /*  ===================================================================== */
00092 
00093 /*     .. Parameters .. */
00094 /*     .. */
00095 /*     .. Local Scalars .. */
00096 /*     .. */
00097 /*     .. External Functions .. */
00098 /*     .. */
00099 /*     .. Intrinsic Functions .. */
00100 /*     .. */
00101 /*     .. External Subroutines .. */
00102 /*     .. */
00103 /*     .. Save statement .. */
00104 /*     .. */
00105 /*     .. Data statements .. */
00106 /*     .. */
00107 /*     .. Executable Statements .. */
00108 
00109 /*     Set some constants for use in the subroutine. */
00110 
00111     if (first) {
00112         first = FALSE_;
00113         eps = slamch_("Precision");
00114         badc2 = .1f / eps;
00115         badc1 = sqrt(badc2);
00116         small = slamch_("Safe minimum");
00117         large = 1.f / small;
00118 
00119 /*        If it looks like we're on a Cray, take the square root of */
00120 /*        SMALL and LARGE to avoid overflow and underflow problems. */
00121 
00122         slabad_(&small, &large);
00123         small = small / eps * .25f;
00124         large = 1.f / small;
00125     }
00126 
00127     s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
00128 
00129 /*     Set some parameters */
00130 
00131     *(unsigned char *)dist = 'S';
00132     *mode = 3;
00133 
00134 /*     Set TYPE, the type of matrix to be generated. */
00135 
00136     *(unsigned char *)type__ = *(unsigned char *)c2;
00137 
00138 /*     Set the lower and upper bandwidths. */
00139 
00140     if (*imat == 1) {
00141         *kl = 0;
00142     } else {
00143 /* Computing MAX */
00144         i__1 = *n - 1;
00145         *kl = max(i__1,0);
00146     }
00147     *ku = *kl;
00148 
00149 /*     Set the condition number and norm.etc */
00150 
00151     if (*imat == 3) {
00152         *cndnum = 1e4f;
00153         *mode = 2;
00154     } else if (*imat == 4) {
00155         *cndnum = 1e4f;
00156         *mode = 1;
00157     } else if (*imat == 5) {
00158         *cndnum = 1e4f;
00159         *mode = 3;
00160     } else if (*imat == 6) {
00161         *cndnum = badc1;
00162     } else if (*imat == 7) {
00163         *cndnum = badc2;
00164     } else {
00165         *cndnum = 2.f;
00166     }
00167 
00168     if (*imat == 8) {
00169         *anorm = small;
00170     } else if (*imat == 9) {
00171         *anorm = large;
00172     } else {
00173         *anorm = 1.f;
00174     }
00175 
00176     if (*n <= 1) {
00177         *cndnum = 1.f;
00178     }
00179 
00180     return 0;
00181 
00182 /*     End of SLATB5 */
00183 
00184 } /* slatb5_ */


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