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 "f2c.h"
kusano 7d535a
kusano 7d535a
/* Subroutine */ int slatm1_(integer *mode, real *cond, integer *irsign, 
kusano 7d535a
	integer *idist, integer *iseed, real *d, integer *n, integer *info)
kusano 7d535a
{
kusano 7d535a
    /* System generated locals */
kusano 7d535a
    integer i__1, i__2;
kusano 7d535a
    doublereal d__1, d__2;
kusano 7d535a
kusano 7d535a
    /* Builtin functions */
kusano 7d535a
    double pow_dd(doublereal *, doublereal *), pow_ri(real *, integer *), log(
kusano 7d535a
	    doublereal), exp(doublereal);
kusano 7d535a
kusano 7d535a
    /* Local variables */
kusano 7d535a
    static real temp;
kusano 7d535a
    static integer i;
kusano 7d535a
    static real alpha;
kusano 7d535a
    extern /* Subroutine */ int xerbla_(char *, integer *);
kusano 7d535a
    extern doublereal slaran_(integer *);
kusano 7d535a
    extern /* Subroutine */ int slarnv_(integer *, integer *, integer *, real 
kusano 7d535a
	    *);
kusano 7d535a
kusano 7d535a
kusano 7d535a
/*  -- LAPACK auxiliary 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
       September 30, 1994   
kusano 7d535a
kusano 7d535a
kusano 7d535a
    Purpose   
kusano 7d535a
    =======   
kusano 7d535a
kusano 7d535a
       SLATM1 computes the entries of D(1..N) as specified by   
kusano 7d535a
       MODE, COND and IRSIGN. IDIST and ISEED determine the generation   
kusano 7d535a
       of random numbers. SLATM1 is called by SLATMR to generate   
kusano 7d535a
       random test matrices for LAPACK programs.   
kusano 7d535a
kusano 7d535a
    Arguments   
kusano 7d535a
    =========   
kusano 7d535a
kusano 7d535a
    MODE   - INTEGER   
kusano 7d535a
             On entry describes how D is to be computed:   
kusano 7d535a
             MODE = 0 means do not change D.   
kusano 7d535a
             MODE = 1 sets D(1)=1 and D(2:N)=1.0/COND   
kusano 7d535a
             MODE = 2 sets D(1:N-1)=1 and D(N)=1.0/COND   
kusano 7d535a
             MODE = 3 sets D(I)=COND**(-(I-1)/(N-1))   
kusano 7d535a
             MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND)   
kusano 7d535a
             MODE = 5 sets D to random numbers in the range   
kusano 7d535a
                      ( 1/COND , 1 ) such that their logarithms   
kusano 7d535a
                      are uniformly distributed.   
kusano 7d535a
             MODE = 6 set D to random numbers from same distribution   
kusano 7d535a
                      as the rest of the matrix.   
kusano 7d535a
             MODE < 0 has the same meaning as ABS(MODE), except that   
kusano 7d535a
                the order of the elements of D is reversed.   
kusano 7d535a
             Thus if MODE is positive, D has entries ranging from   
kusano 7d535a
                1 to 1/COND, if negative, from 1/COND to 1,   
kusano 7d535a
             Not modified.   
kusano 7d535a
kusano 7d535a
    COND   - REAL   
kusano 7d535a
             On entry, used as described under MODE above.   
kusano 7d535a
             If used, it must be >= 1. Not modified.   
kusano 7d535a
kusano 7d535a
    IRSIGN - INTEGER   
kusano 7d535a
             On entry, if MODE neither -6, 0 nor 6, determines sign of   
kusano 7d535a
             entries of D   
kusano 7d535a
             0 => leave entries of D unchanged   
kusano 7d535a
             1 => multiply each entry of D by 1 or -1 with probability .5 
kusano 7d535a
  
kusano 7d535a
kusano 7d535a
    IDIST  - CHARACTER*1   
kusano 7d535a
             On entry, IDIST specifies the type of distribution to be   
kusano 7d535a
             used to generate a random matrix .   
kusano 7d535a
             1 => UNIFORM( 0, 1 )   
kusano 7d535a
             2 => UNIFORM( -1, 1 )   
kusano 7d535a
             3 => NORMAL( 0, 1 )   
kusano 7d535a
             Not modified.   
kusano 7d535a
kusano 7d535a
    ISEED  - INTEGER array, dimension ( 4 )   
kusano 7d535a
             On entry ISEED specifies the seed of the random number   
kusano 7d535a
             generator. The random number generator uses a   
kusano 7d535a
             linear congruential sequence limited to small   
kusano 7d535a
             integers, and so should produce machine independent   
kusano 7d535a
             random numbers. The values of ISEED are changed on   
kusano 7d535a
             exit, and can be used in the next call to SLATM1   
kusano 7d535a
             to continue the same random number sequence.   
kusano 7d535a
             Changed on exit.   
kusano 7d535a
kusano 7d535a
    D      - REAL array, dimension ( MIN( M , N ) )   
kusano 7d535a
             Array to be computed according to MODE, COND and IRSIGN.   
kusano 7d535a
             May be changed on exit if MODE is nonzero.   
kusano 7d535a
kusano 7d535a
    N      - INTEGER   
kusano 7d535a
             Number of entries of D. Not modified.   
kusano 7d535a
kusano 7d535a
    INFO   - INTEGER   
kusano 7d535a
              0  => normal termination   
kusano 7d535a
             -1  => if MODE not in range -6 to 6   
kusano 7d535a
             -2  => if MODE neither -6, 0 nor 6, and   
kusano 7d535a
                    IRSIGN neither 0 nor 1   
kusano 7d535a
             -3  => if MODE neither -6, 0 nor 6 and COND less than 1   
kusano 7d535a
             -4  => if MODE equals 6 or -6 and IDIST not in range 1 to 3 
kusano 7d535a
  
kusano 7d535a
             -7  => if N negative   
kusano 7d535a
kusano 7d535a
    ===================================================================== 
kusano 7d535a
  
kusano 7d535a
kusano 7d535a
kusano 7d535a
       Decode and Test the input parameters. Initialize flags & seed.   
kusano 7d535a
kusano 7d535a
       Parameter adjustments */
kusano 7d535a
    --d;
kusano 7d535a
    --iseed;
kusano 7d535a
kusano 7d535a
    /* Function Body */
kusano 7d535a
    *info = 0;
kusano 7d535a
kusano 7d535a
/*     Quick return if possible */
kusano 7d535a
kusano 7d535a
    if (*n == 0) {
kusano 7d535a
	return 0;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     Set INFO if an error */
kusano 7d535a
kusano 7d535a
    if (*mode < -6 || *mode > 6) {
kusano 7d535a
	*info = -1;
kusano 7d535a
    } else if (*mode != -6 && *mode != 0 && *mode != 6 && (*irsign != 0 && *
kusano 7d535a
	    irsign != 1)) {
kusano 7d535a
	*info = -2;
kusano 7d535a
    } else if (*mode != -6 && *mode != 0 && *mode != 6 && *cond < 1.f) {
kusano 7d535a
	*info = -3;
kusano 7d535a
    } else if ((*mode == 6 || *mode == -6) && (*idist < 1 || *idist > 3)) {
kusano 7d535a
	*info = -4;
kusano 7d535a
    } else if (*n < 0) {
kusano 7d535a
	*info = -7;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
    if (*info != 0) {
kusano 7d535a
	i__1 = -(*info);
kusano 7d535a
	xerbla_("SLATM1", &i__1);
kusano 7d535a
	return 0;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     Compute D according to COND and MODE */
kusano 7d535a
kusano 7d535a
    if (*mode != 0) {
kusano 7d535a
	switch (abs(*mode)) {
kusano 7d535a
	    case 1:  goto L10;
kusano 7d535a
	    case 2:  goto L30;
kusano 7d535a
	    case 3:  goto L50;
kusano 7d535a
	    case 4:  goto L70;
kusano 7d535a
	    case 5:  goto L90;
kusano 7d535a
	    case 6:  goto L110;
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
/*        One large D value: */
kusano 7d535a
kusano 7d535a
L10:
kusano 7d535a
	i__1 = *n;
kusano 7d535a
	for (i = 1; i <= i__1; ++i) {
kusano 7d535a
	    d[i] = 1.f / *cond;
kusano 7d535a
/* L20: */
kusano 7d535a
	}
kusano 7d535a
	d[1] = 1.f;
kusano 7d535a
	goto L120;
kusano 7d535a
kusano 7d535a
/*        One small D value: */
kusano 7d535a
kusano 7d535a
L30:
kusano 7d535a
	i__1 = *n;
kusano 7d535a
	for (i = 1; i <= i__1; ++i) {
kusano 7d535a
	    d[i] = 1.f;
kusano 7d535a
/* L40: */
kusano 7d535a
	}
kusano 7d535a
	d[*n] = 1.f / *cond;
kusano 7d535a
	goto L120;
kusano 7d535a
kusano 7d535a
/*        Exponentially distributed D values: */
kusano 7d535a
kusano 7d535a
L50:
kusano 7d535a
	d[1] = 1.f;
kusano 7d535a
	if (*n > 1) {
kusano 7d535a
	    d__1 = (doublereal) (*cond);
kusano 7d535a
	    d__2 = (doublereal) (-1.f / (real) (*n - 1));
kusano 7d535a
	    alpha = pow_dd(&d__1, &d__2);
kusano 7d535a
	    i__1 = *n;
kusano 7d535a
	    for (i = 2; i <= i__1; ++i) {
kusano 7d535a
		i__2 = i - 1;
kusano 7d535a
		d[i] = pow_ri(&alpha, &i__2);
kusano 7d535a
/* L60: */
kusano 7d535a
	    }
kusano 7d535a
	}
kusano 7d535a
	goto L120;
kusano 7d535a
kusano 7d535a
/*        Arithmetically distributed D values: */
kusano 7d535a
kusano 7d535a
L70:
kusano 7d535a
	d[1] = 1.f;
kusano 7d535a
	if (*n > 1) {
kusano 7d535a
	    temp = 1.f / *cond;
kusano 7d535a
	    alpha = (1.f - temp) / (real) (*n - 1);
kusano 7d535a
	    i__1 = *n;
kusano 7d535a
	    for (i = 2; i <= i__1; ++i) {
kusano 7d535a
		d[i] = (real) (*n - i) * alpha + temp;
kusano 7d535a
/* L80: */
kusano 7d535a
	    }
kusano 7d535a
	}
kusano 7d535a
	goto L120;
kusano 7d535a
kusano 7d535a
/*        Randomly distributed D values on ( 1/COND , 1): */
kusano 7d535a
kusano 7d535a
L90:
kusano 7d535a
	alpha = log(1.f / *cond);
kusano 7d535a
	i__1 = *n;
kusano 7d535a
	for (i = 1; i <= i__1; ++i) {
kusano 7d535a
	    d[i] = exp(alpha * slaran_(&iseed[1]));
kusano 7d535a
/* L100: */
kusano 7d535a
	}
kusano 7d535a
	goto L120;
kusano 7d535a
kusano 7d535a
/*        Randomly distributed D values from IDIST */
kusano 7d535a
kusano 7d535a
L110:
kusano 7d535a
	slarnv_(idist, &iseed[1], n, &d[1]);
kusano 7d535a
kusano 7d535a
L120:
kusano 7d535a
kusano 7d535a
/*        If MODE neither -6 nor 0 nor 6, and IRSIGN = 1, assign   
kusano 7d535a
          random signs to D */
kusano 7d535a
kusano 7d535a
	if (*mode != -6 && *mode != 0 && *mode != 6 && *irsign == 1) {
kusano 7d535a
	    i__1 = *n;
kusano 7d535a
	    for (i = 1; i <= i__1; ++i) {
kusano 7d535a
		temp = slaran_(&iseed[1]);
kusano 7d535a
		if (temp > .5f) {
kusano 7d535a
		    d[i] = -(doublereal)d[i];
kusano 7d535a
		}
kusano 7d535a
/* L130: */
kusano 7d535a
	    }
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
/*        Reverse if MODE < 0 */
kusano 7d535a
kusano 7d535a
	if (*mode < 0) {
kusano 7d535a
	    i__1 = *n / 2;
kusano 7d535a
	    for (i = 1; i <= i__1; ++i) {
kusano 7d535a
		temp = d[i];
kusano 7d535a
		d[i] = d[*n + 1 - i];
kusano 7d535a
		d[*n + 1 - i] = temp;
kusano 7d535a
/* L140: */
kusano 7d535a
	    }
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
    return 0;
kusano 7d535a
kusano 7d535a
/*     End of SLATM1 */
kusano 7d535a
kusano 7d535a
} /* slatm1_ */
kusano 7d535a