kusano 7d535a
/*  -- translated by f2c (version 19940927).
kusano 7d535a
   You must link the resulting object file with the libraries:
kusano 7d535a
	-lf2c -lm   (in that order)
kusano 7d535a
*/
kusano 7d535a
kusano 7d535a
#include <string.h></string.h>
kusano 7d535a
#include "f2c.h"
kusano 7d535a
kusano 7d535a
/* Table of constant values */
kusano 7d535a
kusano 7d535a
static integer c__2 = 2;
kusano 7d535a
kusano 7d535a
/* Subroutine */ int dlatb4_(char *path, integer *imat, integer *m, integer *
kusano 7d535a
	n, char *type, integer *kl, integer *ku, doublereal *anorm, integer *
kusano 7d535a
	mode, doublereal *cndnum, char *dist)
kusano 7d535a
{
kusano 7d535a
    /* Initialized data */
kusano 7d535a
kusano 7d535a
    static logical first = TRUE_;
kusano 7d535a
kusano 7d535a
    /* System generated locals */
kusano 7d535a
    integer i__1;
kusano 7d535a
kusano 7d535a
    /* Builtin functions */
kusano 7d535a
    double sqrt(doublereal);
kusano 7d535a
kusano 7d535a
    /* Local variables */
kusano 7d535a
    static doublereal badc1, badc2, large, small;
kusano 7d535a
    static char c2[2];
kusano 7d535a
    extern /* Subroutine */ int dlabad_(doublereal *, doublereal *);
kusano 7d535a
    extern doublereal dlamch_(char *);
kusano 7d535a
    extern logical lsamen_(integer *, char *, char *);
kusano 7d535a
    static integer mat;
kusano 7d535a
    static doublereal eps;
kusano 7d535a
kusano 7d535a
/*  -- LAPACK test routine (version 2.0) --   
kusano 7d535a
       Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,   
kusano 7d535a
       Courant Institute, Argonne National Lab, and Rice University   
kusano 7d535a
       February 29, 1992   
kusano 7d535a
kusano 7d535a
    Purpose   
kusano 7d535a
    =======   
kusano 7d535a
kusano 7d535a
    DLATB4 sets parameters for the matrix generator based on the type of 
kusano 7d535a
  
kusano 7d535a
    matrix to be generated.   
kusano 7d535a
kusano 7d535a
    Arguments   
kusano 7d535a
    =========   
kusano 7d535a
kusano 7d535a
    PATH    (input) CHARACTER*3   
kusano 7d535a
            The LAPACK path name.   
kusano 7d535a
kusano 7d535a
    IMAT    (input) INTEGER   
kusano 7d535a
            An integer key describing which matrix to generate for this   
kusano 7d535a
            path.   
kusano 7d535a
kusano 7d535a
    M       (input) INTEGER   
kusano 7d535a
            The number of rows in the matrix to be generated.   
kusano 7d535a
kusano 7d535a
    N       (input) INTEGER   
kusano 7d535a
            The number of columns in the matrix to be generated.   
kusano 7d535a
kusano 7d535a
    TYPE    (output) CHARACTER*1   
kusano 7d535a
            The type of the matrix to be generated:   
kusano 7d535a
            = 'S':  symmetric matrix   
kusano 7d535a
            = 'P':  symmetric positive (semi)definite matrix   
kusano 7d535a
            = 'N':  nonsymmetric matrix   
kusano 7d535a
kusano 7d535a
    KL      (output) INTEGER   
kusano 7d535a
            The lower band width of the matrix to be generated.   
kusano 7d535a
kusano 7d535a
    KU      (output) INTEGER   
kusano 7d535a
            The upper band width of the matrix to be generated.   
kusano 7d535a
kusano 7d535a
    ANORM   (output) DOUBLE PRECISION   
kusano 7d535a
            The desired norm of the matrix to be generated.  The diagonal 
kusano 7d535a
  
kusano 7d535a
            matrix of singular values or eigenvalues is scaled by this   
kusano 7d535a
            value.   
kusano 7d535a
kusano 7d535a
    MODE    (output) INTEGER   
kusano 7d535a
            A key indicating how to choose the vector of eigenvalues.   
kusano 7d535a
kusano 7d535a
    CNDNUM  (output) DOUBLE PRECISION   
kusano 7d535a
            The desired condition number.   
kusano 7d535a
kusano 7d535a
    DIST    (output) CHARACTER*1   
kusano 7d535a
            The type of distribution to be used by the random number   
kusano 7d535a
            generator.   
kusano 7d535a
kusano 7d535a
    ===================================================================== 
kusano 7d535a
  
kusano 7d535a
kusano 7d535a
kusano 7d535a
       Set some constants for use in the subroutine. */
kusano 7d535a
kusano 7d535a
    if (first) {
kusano 7d535a
	first = FALSE_;
kusano 7d535a
	eps = dlamch_("Precision");
kusano 7d535a
	badc2 = .1 / eps;
kusano 7d535a
	badc1 = sqrt(badc2);
kusano 7d535a
	small = dlamch_("Safe minimum");
kusano 7d535a
	large = 1. / small;
kusano 7d535a
kusano 7d535a
/*        If it looks like we're on a Cray, take the square root of   
kusano 7d535a
          SMALL and LARGE to avoid overflow and underflow problems. */
kusano 7d535a
kusano 7d535a
	dlabad_(&small, &large);
kusano 7d535a
	small = small / eps * .25;
kusano 7d535a
	large = 1. / small;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
    strncpy(c2, path + 1, 2);
kusano 7d535a
    
kusano 7d535a
/*     Set some parameters we don't plan to change. */
kusano 7d535a
kusano 7d535a
    *(unsigned char *)dist = 'S';
kusano 7d535a
    *mode = 3;
kusano 7d535a
kusano 7d535a
    if (lsamen_(&c__2, c2, "QR") || lsamen_(&c__2, c2, "LQ") 
kusano 7d535a
	    || lsamen_(&c__2, c2, "QL") || lsamen_(&c__2, c2, "RQ")) {
kusano 7d535a
kusano 7d535a
/*        xQR, xLQ, xQL, xRQ:  Set parameters to generate a general   
kusano 7d535a
                               M x N matrix.   
kusano 7d535a
kusano 7d535a
          Set TYPE, the type of matrix to be generated. */
kusano 7d535a
kusano 7d535a
	*(unsigned char *)type = 'N';
kusano 7d535a
kusano 7d535a
/*        Set the lower and upper bandwidths. */
kusano 7d535a
kusano 7d535a
	if (*imat == 1) {
kusano 7d535a
	    *kl = 0;
kusano 7d535a
	    *ku = 0;
kusano 7d535a
	} else if (*imat == 2) {
kusano 7d535a
	    *kl = 0;
kusano 7d535a
/* Computing MAX */
kusano 7d535a
	    i__1 = *n - 1;
kusano 7d535a
	    *ku = max(i__1,0);
kusano 7d535a
	} else if (*imat == 3) {
kusano 7d535a
/* Computing MAX */
kusano 7d535a
	    i__1 = *m - 1;
kusano 7d535a
	    *kl = max(i__1,0);
kusano 7d535a
	    *ku = 0;
kusano 7d535a
	} else {
kusano 7d535a
/* Computing MAX */
kusano 7d535a
	    i__1 = *m - 1;
kusano 7d535a
	    *kl = max(i__1,0);
kusano 7d535a
/* Computing MAX */
kusano 7d535a
	    i__1 = *n - 1;
kusano 7d535a
	    *ku = max(i__1,0);
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
/*        Set the condition number and norm. */
kusano 7d535a
kusano 7d535a
	if (*imat == 5) {
kusano 7d535a
	    *cndnum = badc1;
kusano 7d535a
	} else if (*imat == 6) {
kusano 7d535a
	    *cndnum = badc2;
kusano 7d535a
	} else {
kusano 7d535a
	    *cndnum = 2.;
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
	if (*imat == 7) {
kusano 7d535a
	    *anorm = small;
kusano 7d535a
	} else if (*imat == 8) {
kusano 7d535a
	    *anorm = large;
kusano 7d535a
	} else {
kusano 7d535a
	    *anorm = 1.;
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
    } else if (lsamen_(&c__2, c2, "GE")) {
kusano 7d535a
kusano 7d535a
/*        xGE:  Set parameters to generate a general M x N matrix.   
kusano 7d535a
kusano 7d535a
          Set TYPE, the type of matrix to be generated. */
kusano 7d535a
kusano 7d535a
	*(unsigned char *)type = 'N';
kusano 7d535a
kusano 7d535a
/*        Set the lower and upper bandwidths. */
kusano 7d535a
kusano 7d535a
	if (*imat == 1) {
kusano 7d535a
	    *kl = 0;
kusano 7d535a
	    *ku = 0;
kusano 7d535a
	} else if (*imat == 2) {
kusano 7d535a
	    *kl = 0;
kusano 7d535a
/* Computing MAX */
kusano 7d535a
	    i__1 = *n - 1;
kusano 7d535a
	    *ku = max(i__1,0);
kusano 7d535a
	} else if (*imat == 3) {
kusano 7d535a
/* Computing MAX */
kusano 7d535a
	    i__1 = *m - 1;
kusano 7d535a
	    *kl = max(i__1,0);
kusano 7d535a
	    *ku = 0;
kusano 7d535a
	} else {
kusano 7d535a
/* Computing MAX */
kusano 7d535a
	    i__1 = *m - 1;
kusano 7d535a
	    *kl = max(i__1,0);
kusano 7d535a
/* Computing MAX */
kusano 7d535a
	    i__1 = *n - 1;
kusano 7d535a
	    *ku = max(i__1,0);
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
/*        Set the condition number and norm. */
kusano 7d535a
kusano 7d535a
	if (*imat == 8) {
kusano 7d535a
	    *cndnum = badc1;
kusano 7d535a
	} else if (*imat == 9) {
kusano 7d535a
	    *cndnum = badc2;
kusano 7d535a
	} else {
kusano 7d535a
	    *cndnum = 2.;
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
	if (*imat == 10) {
kusano 7d535a
	    *anorm = small;
kusano 7d535a
	} else if (*imat == 11) {
kusano 7d535a
	    *anorm = large;
kusano 7d535a
	} else {
kusano 7d535a
	    *anorm = 1.;
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
    } else if (lsamen_(&c__2, c2, "GB")) {
kusano 7d535a
kusano 7d535a
/*        xGB:  Set parameters to generate a general banded matrix.   
kusano 7d535a
kusano 7d535a
          Set TYPE, the type of matrix to be generated. */
kusano 7d535a
kusano 7d535a
	*(unsigned char *)type = 'N';
kusano 7d535a
kusano 7d535a
/*        Set the condition number and norm. */
kusano 7d535a
kusano 7d535a
	if (*imat == 5) {
kusano 7d535a
	    *cndnum = badc1;
kusano 7d535a
	} else if (*imat == 6) {
kusano 7d535a
	    *cndnum = badc2 * .1;
kusano 7d535a
	} else {
kusano 7d535a
	    *cndnum = 2.;
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
	if (*imat == 7) {
kusano 7d535a
	    *anorm = small;
kusano 7d535a
	} else if (*imat == 8) {
kusano 7d535a
	    *anorm = large;
kusano 7d535a
	} else {
kusano 7d535a
	    *anorm = 1.;
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
    } else if (lsamen_(&c__2, c2, "GT")) {
kusano 7d535a
kusano 7d535a
/*        xGT:  Set parameters to generate a general tridiagonal matri
kusano 7d535a
x.   
kusano 7d535a
kusano 7d535a
          Set TYPE, the type of matrix to be generated. */
kusano 7d535a
kusano 7d535a
	*(unsigned char *)type = 'N';
kusano 7d535a
kusano 7d535a
/*        Set the lower and upper bandwidths. */
kusano 7d535a
kusano 7d535a
	if (*imat == 1) {
kusano 7d535a
	    *kl = 0;
kusano 7d535a
	} else {
kusano 7d535a
	    *kl = 1;
kusano 7d535a
	}
kusano 7d535a
	*ku = *kl;
kusano 7d535a
kusano 7d535a
/*        Set the condition number and norm. */
kusano 7d535a
kusano 7d535a
	if (*imat == 3) {
kusano 7d535a
	    *cndnum = badc1;
kusano 7d535a
	} else if (*imat == 4) {
kusano 7d535a
	    *cndnum = badc2;
kusano 7d535a
	} else {
kusano 7d535a
	    *cndnum = 2.;
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
	if (*imat == 5 || *imat == 11) {
kusano 7d535a
	    *anorm = small;
kusano 7d535a
	} else if (*imat == 6 || *imat == 12) {
kusano 7d535a
	    *anorm = large;
kusano 7d535a
	} else {
kusano 7d535a
	    *anorm = 1.;
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
    } else if (lsamen_(&c__2, c2, "PO") || lsamen_(&c__2, c2, "PP") || lsamen_(&c__2, c2, "SY") || lsamen_(&c__2, c2, 
kusano 7d535a
	    "SP")) {
kusano 7d535a
kusano 7d535a
/*        xPO, xPP, xSY, xSP: Set parameters to generate a   
kusano 7d535a
          symmetric matrix.   
kusano 7d535a
kusano 7d535a
          Set TYPE, the type of matrix to be generated. */
kusano 7d535a
kusano 7d535a
	*(unsigned char *)type = *(unsigned char *)c2;
kusano 7d535a
kusano 7d535a
/*        Set the lower and upper bandwidths. */
kusano 7d535a
kusano 7d535a
	if (*imat == 1) {
kusano 7d535a
	    *kl = 0;
kusano 7d535a
	} else {
kusano 7d535a
/* Computing MAX */
kusano 7d535a
	    i__1 = *n - 1;
kusano 7d535a
	    *kl = max(i__1,0);
kusano 7d535a
	}
kusano 7d535a
	*ku = *kl;
kusano 7d535a
kusano 7d535a
/*        Set the condition number and norm. */
kusano 7d535a
kusano 7d535a
	if (*imat == 6) {
kusano 7d535a
	    *cndnum = badc1;
kusano 7d535a
	} else if (*imat == 7) {
kusano 7d535a
	    *cndnum = badc2;
kusano 7d535a
	} else {
kusano 7d535a
	    *cndnum = 2.;
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
	if (*imat == 8) {
kusano 7d535a
	    *anorm = small;
kusano 7d535a
	} else if (*imat == 9) {
kusano 7d535a
	    *anorm = large;
kusano 7d535a
	} else {
kusano 7d535a
	    *anorm = 1.;
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
    } else if (lsamen_(&c__2, c2, "PB")) {
kusano 7d535a
kusano 7d535a
/*        xPB:  Set parameters to generate a symmetric band matrix.   
kusano 7d535a
kusano 7d535a
          Set TYPE, the type of matrix to be generated. */
kusano 7d535a
kusano 7d535a
	*(unsigned char *)type = 'P';
kusano 7d535a
kusano 7d535a
/*        Set the norm and condition number. */
kusano 7d535a
kusano 7d535a
	if (*imat == 5) {
kusano 7d535a
	    *cndnum = badc1;
kusano 7d535a
	} else if (*imat == 6) {
kusano 7d535a
	    *cndnum = badc2;
kusano 7d535a
	} else {
kusano 7d535a
	    *cndnum = 2.;
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
	if (*imat == 7) {
kusano 7d535a
	    *anorm = small;
kusano 7d535a
	} else if (*imat == 8) {
kusano 7d535a
	    *anorm = large;
kusano 7d535a
	} else {
kusano 7d535a
	    *anorm = 1.;
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
    } else if (lsamen_(&c__2, c2, "PT")) {
kusano 7d535a
kusano 7d535a
/*        xPT:  Set parameters to generate a symmetric positive defini
kusano 7d535a
te   
kusano 7d535a
          tridiagonal matrix. */
kusano 7d535a
kusano 7d535a
	*(unsigned char *)type = 'P';
kusano 7d535a
	if (*imat == 1) {
kusano 7d535a
	    *kl = 0;
kusano 7d535a
	} else {
kusano 7d535a
	    *kl = 1;
kusano 7d535a
	}
kusano 7d535a
	*ku = *kl;
kusano 7d535a
kusano 7d535a
/*        Set the condition number and norm. */
kusano 7d535a
kusano 7d535a
	if (*imat == 3) {
kusano 7d535a
	    *cndnum = badc1;
kusano 7d535a
	} else if (*imat == 4) {
kusano 7d535a
	    *cndnum = badc2;
kusano 7d535a
	} else {
kusano 7d535a
	    *cndnum = 2.;
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
	if (*imat == 5 || *imat == 11) {
kusano 7d535a
	    *anorm = small;
kusano 7d535a
	} else if (*imat == 6 || *imat == 12) {
kusano 7d535a
	    *anorm = large;
kusano 7d535a
	} else {
kusano 7d535a
	    *anorm = 1.;
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
    } else if (lsamen_(&c__2, c2, "TR") || lsamen_(&c__2, c2, "TP")) {
kusano 7d535a
kusano 7d535a
/*        xTR, xTP:  Set parameters to generate a triangular matrix   
kusano 7d535a
kusano 7d535a
          Set TYPE, the type of matrix to be generated. */
kusano 7d535a
kusano 7d535a
	*(unsigned char *)type = 'N';
kusano 7d535a
kusano 7d535a
/*        Set the lower and upper bandwidths. */
kusano 7d535a
kusano 7d535a
	mat = abs(*imat);
kusano 7d535a
	if (mat == 1 || mat == 7) {
kusano 7d535a
	    *kl = 0;
kusano 7d535a
	    *ku = 0;
kusano 7d535a
	} else if (*imat < 0) {
kusano 7d535a
/* Computing MAX */
kusano 7d535a
	    i__1 = *n - 1;
kusano 7d535a
	    *kl = max(i__1,0);
kusano 7d535a
	    *ku = 0;
kusano 7d535a
	} else {
kusano 7d535a
	    *kl = 0;
kusano 7d535a
/* Computing MAX */
kusano 7d535a
	    i__1 = *n - 1;
kusano 7d535a
	    *ku = max(i__1,0);
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
/*        Set the condition number and norm. */
kusano 7d535a
kusano 7d535a
	if (mat == 3 || mat == 9) {
kusano 7d535a
	    *cndnum = badc1;
kusano 7d535a
	} else if (mat == 4) {
kusano 7d535a
	    *cndnum = badc2;
kusano 7d535a
	} else if (mat == 10) {
kusano 7d535a
	    *cndnum = badc2;
kusano 7d535a
	} else {
kusano 7d535a
	    *cndnum = 2.;
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
	if (mat == 5) {
kusano 7d535a
	    *anorm = small;
kusano 7d535a
	} else if (mat == 6) {
kusano 7d535a
	    *anorm = large;
kusano 7d535a
	} else {
kusano 7d535a
	    *anorm = 1.;
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
    } else if (lsamen_(&c__2, c2, "TB")) {
kusano 7d535a
kusano 7d535a
/*        xTB:  Set parameters to generate a triangular band matrix. 
kusano 7d535a
  
kusano 7d535a
kusano 7d535a
          Set TYPE, the type of matrix to be generated. */
kusano 7d535a
kusano 7d535a
	*(unsigned char *)type = 'N';
kusano 7d535a
kusano 7d535a
/*        Set the norm and condition number. */
kusano 7d535a
kusano 7d535a
	if (*imat == 2 || *imat == 8) {
kusano 7d535a
	    *cndnum = badc1;
kusano 7d535a
	} else if (*imat == 3 || *imat == 9) {
kusano 7d535a
	    *cndnum = badc2;
kusano 7d535a
	} else {
kusano 7d535a
	    *cndnum = 2.;
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
	if (*imat == 4) {
kusano 7d535a
	    *anorm = small;
kusano 7d535a
	} else if (*imat == 5) {
kusano 7d535a
	    *anorm = large;
kusano 7d535a
	} else {
kusano 7d535a
	    *anorm = 1.;
kusano 7d535a
	}
kusano 7d535a
    }
kusano 7d535a
    if (*n <= 1) {
kusano 7d535a
	*cndnum = 1.;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
    return 0;
kusano 7d535a
kusano 7d535a
/*     End of DLATB4 */
kusano 7d535a
kusano 7d535a
} /* dlatb4_ */
kusano 7d535a