slatb9.c

Go to the documentation of this file.

/* slatb9.f -- translated by f2c (version 20061008).
   You must link the resulting object file with libf2c:
        on Microsoft Windows system, link with libf2c.lib;
        on Linux or Unix systems, link with .../path/to/libf2c.a -lm
        or, if you install libf2c.a in a standard place, with -lf2c -lm
        -- in that order, at the end of the command line, as in
                cc *.o -lf2c -lm
        Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

                http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"
#include "blaswrap.h"

/* Table of constant values */

static integer c__3 = 3;

/* Subroutine */ int slatb9_(char *path, integer *imat, integer *m, integer *
        p, integer *n, char *type__, integer *kla, integer *kua, integer *klb, 
         integer *kub, real *anorm, real *bnorm, integer *modea, integer *
        modeb, real *cndnma, real *cndnmb, char *dista, char *distb)
{
    /* Initialized data */

    static logical first = TRUE_;

    /* System generated locals */
    integer i__1;

    /* Builtin functions */
    double sqrt(doublereal);

    /* Local variables */
    static real eps, badc1, badc2, large, small;
    extern /* Subroutine */ int slabad_(real *, real *);
    extern doublereal slamch_(char *);
    extern logical lsamen_(integer *, char *, char *);


/*  -- LAPACK test routine (version 3.1) -- */
/*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/*     November 2006 */

/*     .. Scalar Arguments .. */
/*     .. */

/*  Purpose */
/*  ======= */

/*  SLATB9 sets parameters for the matrix generator based on the type of */
/*  matrix to be generated. */

/*  Arguments */
/*  ========= */

/*  PATH    (input) CHARACTER*3 */
/*          The LAPACK path name. */

/*  IMAT    (input) INTEGER */
/*          An integer key describing which matrix to generate for this */
/*          path. */

/*  M       (input) INTEGER */
/*          The number of rows in the matrix to be generated. */

/*  N       (input) INTEGER */
/*          The number of columns in the matrix to be generated. */

/*  TYPE    (output) CHARACTER*1 */
/*          The type of the matrix to be generated: */
/*          = 'S':  symmetric matrix; */
/*          = 'P':  symmetric positive (semi)definite matrix; */
/*          = 'N':  nonsymmetric matrix. */

/*  KL      (output) INTEGER */
/*          The lower band width of the matrix to be generated. */

/*  KU      (output) INTEGER */
/*          The upper band width of the matrix to be generated. */

/*  ANORM   (output) REAL */
/*          The desired norm of the matrix to be generated.  The diagonal */
/*          matrix of singular values or eigenvalues is scaled by this */
/*          value. */

/*  MODE    (output) INTEGER */
/*          A key indicating how to choose the vector of eigenvalues. */

/*  CNDNUM  (output) REAL */
/*          The desired condition number. */

/*  DIST    (output) CHARACTER*1 */
/*          The type of distribution to be used by the random number */
/*          generator. */

/*  ===================================================================== */

/*     .. Parameters .. */
/*     .. */
/*     .. Local Scalars .. */
/*     .. */
/*     .. External Functions .. */
/*     .. */
/*     .. Intrinsic Functions .. */
/*     .. */
/*     .. External Subroutines .. */
/*     .. */
/*     .. Save statement .. */
/*     .. */
/*     .. Data statements .. */
/*     .. */
/*     .. Executable Statements .. */

/*     Set some constants for use in the subroutine. */

    if (first) {
        first = FALSE_;
        eps = slamch_("Precision");
        badc2 = .1f / eps;
        badc1 = sqrt(badc2);
        small = slamch_("Safe minimum");
        large = 1.f / small;

/*        If it looks like we're on a Cray, take the square root of */
/*        SMALL and LARGE to avoid overflow and underflow problems. */

        slabad_(&small, &large);
        small = small / eps * .25f;
        large = 1.f / small;
    }

/*     Set some parameters we don't plan to change. */

    *(unsigned char *)type__ = 'N';
    *(unsigned char *)dista = 'S';
    *(unsigned char *)distb = 'S';
    *modea = 3;
    *modeb = 4;

/*     Set the lower and upper bandwidths. */

    if (lsamen_(&c__3, path, "GRQ") || lsamen_(&c__3, 
            path, "LSE") || lsamen_(&c__3, path, "GSV")) {

/*        A: M by N, B: P by N */

        if (*imat == 1) {

/*           A: diagonal, B: upper triangular */

            *kla = 0;
            *kua = 0;
            *klb = 0;
/* Computing MAX */
            i__1 = *n - 1;
            *kub = max(i__1,0);

        } else if (*imat == 2) {

/*           A: upper triangular, B: upper triangular */

            *kla = 0;
/* Computing MAX */
            i__1 = *n - 1;
            *kua = max(i__1,0);
            *klb = 0;
/* Computing MAX */
            i__1 = *n - 1;
            *kub = max(i__1,0);

        } else if (*imat == 3) {

/*           A: lower triangular, B: upper triangular */

/* Computing MAX */
            i__1 = *m - 1;
            *kla = max(i__1,0);
            *kua = 0;
            *klb = 0;
/* Computing MAX */
            i__1 = *n - 1;
            *kub = max(i__1,0);

        } else {

/*           A: general dense, B: general dense */

/* Computing MAX */
            i__1 = *m - 1;
            *kla = max(i__1,0);
/* Computing MAX */
            i__1 = *n - 1;
            *kua = max(i__1,0);
/* Computing MAX */
            i__1 = *p - 1;
            *klb = max(i__1,0);
/* Computing MAX */
            i__1 = *n - 1;
            *kub = max(i__1,0);

        }

    } else if (lsamen_(&c__3, path, "GQR") || lsamen_(&
            c__3, path, "GLM")) {

/*        A: N by M, B: N by P */

        if (*imat == 1) {

/*           A: diagonal, B: lower triangular */

            *kla = 0;
            *kua = 0;
/* Computing MAX */
            i__1 = *n - 1;
            *klb = max(i__1,0);
            *kub = 0;
        } else if (*imat == 2) {

/*           A: lower triangular, B: diagonal */

/* Computing MAX */
            i__1 = *n - 1;
            *kla = max(i__1,0);
            *kua = 0;
            *klb = 0;
            *kub = 0;

        } else if (*imat == 3) {

/*           A: lower triangular, B: upper triangular */

/* Computing MAX */
            i__1 = *n - 1;
            *kla = max(i__1,0);
            *kua = 0;
            *klb = 0;
/* Computing MAX */
            i__1 = *p - 1;
            *kub = max(i__1,0);

        } else {

/*           A: general dense, B: general dense */

/* Computing MAX */
            i__1 = *n - 1;
            *kla = max(i__1,0);
/* Computing MAX */
            i__1 = *m - 1;
            *kua = max(i__1,0);
/* Computing MAX */
            i__1 = *n - 1;
            *klb = max(i__1,0);
/* Computing MAX */
            i__1 = *p - 1;
            *kub = max(i__1,0);
        }

    }

/*     Set the condition number and norm. */

    *cndnma = 100.f;
    *cndnmb = 10.f;
    if (lsamen_(&c__3, path, "GQR") || lsamen_(&c__3, 
            path, "GRQ") || lsamen_(&c__3, path, "GSV")) {
        if (*imat == 5) {
            *cndnma = badc1;
            *cndnmb = badc1;
        } else if (*imat == 6) {
            *cndnma = badc2;
            *cndnmb = badc2;
        } else if (*imat == 7) {
            *cndnma = badc1;
            *cndnmb = badc2;
        } else if (*imat == 8) {
            *cndnma = badc2;
            *cndnmb = badc1;
        }
    }

    *anorm = 10.f;
    *bnorm = 1e3f;
    if (lsamen_(&c__3, path, "GQR") || lsamen_(&c__3, 
            path, "GRQ")) {
        if (*imat == 7) {
            *anorm = small;
            *bnorm = large;
        } else if (*imat == 8) {
            *anorm = large;
            *bnorm = small;
        }
    }

    if (*n <= 1) {
        *cndnma = 1.f;
        *cndnmb = 1.f;
    }

    return 0;

/*     End of SLATB9 */

} /* slatb9_ */