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

/* Double Complex */ VOID zlatm2_(doublecomplex * ret_val, integer *m, 
	integer *n, integer *i__, integer *j, integer *kl, integer *ku, 
	integer *idist, integer *iseed, doublecomplex *d__, integer *igrade, 
	doublecomplex *dl, doublecomplex *dr, integer *ipvtng, integer *iwork, 
	 doublereal *sparse)
{
    /* System generated locals */
    integer i__1, i__2;
    doublecomplex z__1, z__2, z__3;

    /* Builtin functions */
    void z_div(doublecomplex *, doublecomplex *, doublecomplex *), d_cnjg(
	    doublecomplex *, doublecomplex *);

    /* Local variables */
    integer isub, jsub;
    doublecomplex ctemp;
    extern doublereal dlaran_(integer *);
    extern /* Double Complex */ VOID zlarnd_(doublecomplex *, integer *, 
	    integer *);


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

/*     .. Scalar Arguments .. */

/*     .. */

/*     .. Array Arguments .. */

/*     .. */

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

/*     ZLATM2 returns the (I,J) entry of a random matrix of dimension */
/*     (M, N) described by the other paramters. It is called by the */
/*     ZLATMR routine in order to build random test matrices. No error */
/*     checking on parameters is done, because this routine is called in */
/*     a tight loop by ZLATMR which has already checked the parameters. */

/*     Use of ZLATM2 differs from CLATM3 in the order in which the random */
/*     number generator is called to fill in random matrix entries. */
/*     With ZLATM2, the generator is called to fill in the pivoted matrix */
/*     columnwise. With ZLATM3, the generator is called to fill in the */
/*     matrix columnwise, after which it is pivoted. Thus, ZLATM3 can */
/*     be used to construct random matrices which differ only in their */
/*     order of rows and/or columns. ZLATM2 is used to construct band */
/*     matrices while avoiding calling the random number generator for */
/*     entries outside the band (and therefore generating random numbers */

/*     The matrix whose (I,J) entry is returned is constructed as */
/*     follows (this routine only computes one entry): */

/*       If I is outside (1..M) or J is outside (1..N), return zero */
/*          (this is convenient for generating matrices in band format). */

/*       Generate a matrix A with random entries of distribution IDIST. */

/*       Set the diagonal to D. */

/*       Grade the matrix, if desired, from the left (by DL) and/or */
/*          from the right (by DR or DL) as specified by IGRADE. */

/*       Permute, if desired, the rows and/or columns as specified by */
/*          IPVTNG and IWORK. */

/*       Band the matrix to have lower bandwidth KL and upper */
/*          bandwidth KU. */

/*       Set random entries to zero as specified by SPARSE. */

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

/*  M      - INTEGER */
/*           Number of rows of matrix. Not modified. */

/*  N      - INTEGER */
/*           Number of columns of matrix. Not modified. */

/*  I      - INTEGER */
/*           Row of entry to be returned. Not modified. */

/*  J      - INTEGER */
/*           Column of entry to be returned. Not modified. */

/*  KL     - INTEGER */
/*           Lower bandwidth. Not modified. */

/*  KU     - INTEGER */
/*           Upper bandwidth. Not modified. */

/*  IDIST  - INTEGER */
/*           On entry, IDIST specifies the type of distribution to be */
/*           used to generate a random matrix . */
/*           1 => real and imaginary parts each UNIFORM( 0, 1 ) */
/*           2 => real and imaginary parts each UNIFORM( -1, 1 ) */
/*           3 => real and imaginary parts each NORMAL( 0, 1 ) */
/*           4 => complex number uniform in DISK( 0 , 1 ) */
/*           Not modified. */

/*  ISEED  - INTEGER            array of dimension ( 4 ) */
/*           Seed for random number generator. */
/*           Changed on exit. */

/*  D      - COMPLEX*16            array of dimension ( MIN( I , J ) ) */
/*           Diagonal entries of matrix. Not modified. */

/*  IGRADE - INTEGER */
/*           Specifies grading of matrix as follows: */
/*           0  => no grading */
/*           1  => matrix premultiplied by diag( DL ) */
/*           2  => matrix postmultiplied by diag( DR ) */
/*           3  => matrix premultiplied by diag( DL ) and */
/*                         postmultiplied by diag( DR ) */
/*           4  => matrix premultiplied by diag( DL ) and */
/*                         postmultiplied by inv( diag( DL ) ) */
/*           5  => matrix premultiplied by diag( DL ) and */
/*                         postmultiplied by diag( CONJG(DL) ) */
/*           6  => matrix premultiplied by diag( DL ) and */
/*                         postmultiplied by diag( DL ) */
/*           Not modified. */

/*  DL     - COMPLEX*16            array ( I or J, as appropriate ) */
/*           Left scale factors for grading matrix.  Not modified. */

/*  DR     - COMPLEX*16            array ( I or J, as appropriate ) */
/*           Right scale factors for grading matrix.  Not modified. */

/*  IPVTNG - INTEGER */
/*           On entry specifies pivoting permutations as follows: */
/*           0 => none. */
/*           1 => row pivoting. */
/*           2 => column pivoting. */
/*           3 => full pivoting, i.e., on both sides. */
/*           Not modified. */

/*  IWORK  - INTEGER            array ( I or J, as appropriate ) */
/*           This array specifies the permutation used. The */
/*           row (or column) in position K was originally in */
/*           position IWORK( K ). */
/*           This differs from IWORK for ZLATM3. Not modified. */

/*  SPARSE - DOUBLE PRECISION               between 0. and 1. */
/*           On entry specifies the sparsity of the matrix */
/*           if sparse matix is to be generated. */
/*           SPARSE should lie between 0 and 1. */
/*           A uniform ( 0, 1 ) random number x is generated and */
/*           compared to SPARSE; if x is larger the matrix entry */
/*           is unchanged and if x is smaller the entry is set */
/*           to zero. Thus on the average a fraction SPARSE of the */
/*           entries will be set to zero. */
/*           Not modified. */

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

/*     .. Parameters .. */

/*     .. */

/*     .. Local Scalars .. */

/*     .. */

/*     .. External Functions .. */

/*     .. */

/*     .. Intrinsic Functions .. */

/*     .. */

/* ----------------------------------------------------------------------- */

/*     .. Executable Statements .. */


/*     Check for I and J in range */

    /* Parameter adjustments */
    --iwork;
    --dr;
    --dl;
    --d__;
    --iseed;

    /* Function Body */
    if (*i__ < 1 || *i__ > *m || *j < 1 || *j > *n) {
	 ret_val->r = 0.,  ret_val->i = 0.;
	return ;
    }

/*     Check for banding */

    if (*j > *i__ + *ku || *j < *i__ - *kl) {
	 ret_val->r = 0.,  ret_val->i = 0.;
	return ;
    }

/*     Check for sparsity */

    if (*sparse > 0.) {
	if (dlaran_(&iseed[1]) < *sparse) {
	     ret_val->r = 0.,  ret_val->i = 0.;
	    return ;
	}
    }

/*     Compute subscripts depending on IPVTNG */

    if (*ipvtng == 0) {
	isub = *i__;
	jsub = *j;
    } else if (*ipvtng == 1) {
	isub = iwork[*i__];
	jsub = *j;
    } else if (*ipvtng == 2) {
	isub = *i__;
	jsub = iwork[*j];
    } else if (*ipvtng == 3) {
	isub = iwork[*i__];
	jsub = iwork[*j];
    }

/*     Compute entry and grade it according to IGRADE */

    if (isub == jsub) {
	i__1 = isub;
	ctemp.r = d__[i__1].r, ctemp.i = d__[i__1].i;
    } else {
	zlarnd_(&z__1, idist, &iseed[1]);
	ctemp.r = z__1.r, ctemp.i = z__1.i;
    }
    if (*igrade == 1) {
	i__1 = isub;
	z__1.r = ctemp.r * dl[i__1].r - ctemp.i * dl[i__1].i, z__1.i = 
		ctemp.r * dl[i__1].i + ctemp.i * dl[i__1].r;
	ctemp.r = z__1.r, ctemp.i = z__1.i;
    } else if (*igrade == 2) {
	i__1 = jsub;
	z__1.r = ctemp.r * dr[i__1].r - ctemp.i * dr[i__1].i, z__1.i = 
		ctemp.r * dr[i__1].i + ctemp.i * dr[i__1].r;
	ctemp.r = z__1.r, ctemp.i = z__1.i;
    } else if (*igrade == 3) {
	i__1 = isub;
	z__2.r = ctemp.r * dl[i__1].r - ctemp.i * dl[i__1].i, z__2.i = 
		ctemp.r * dl[i__1].i + ctemp.i * dl[i__1].r;
	i__2 = jsub;
	z__1.r = z__2.r * dr[i__2].r - z__2.i * dr[i__2].i, z__1.i = z__2.r * 
		dr[i__2].i + z__2.i * dr[i__2].r;
	ctemp.r = z__1.r, ctemp.i = z__1.i;
    } else if (*igrade == 4 && isub != jsub) {
	i__1 = isub;
	z__2.r = ctemp.r * dl[i__1].r - ctemp.i * dl[i__1].i, z__2.i = 
		ctemp.r * dl[i__1].i + ctemp.i * dl[i__1].r;
	z_div(&z__1, &z__2, &dl[jsub]);
	ctemp.r = z__1.r, ctemp.i = z__1.i;
    } else if (*igrade == 5) {
	i__1 = isub;
	z__2.r = ctemp.r * dl[i__1].r - ctemp.i * dl[i__1].i, z__2.i = 
		ctemp.r * dl[i__1].i + ctemp.i * dl[i__1].r;
	d_cnjg(&z__3, &dl[jsub]);
	z__1.r = z__2.r * z__3.r - z__2.i * z__3.i, z__1.i = z__2.r * z__3.i 
		+ z__2.i * z__3.r;
	ctemp.r = z__1.r, ctemp.i = z__1.i;
    } else if (*igrade == 6) {
	i__1 = isub;
	z__2.r = ctemp.r * dl[i__1].r - ctemp.i * dl[i__1].i, z__2.i = 
		ctemp.r * dl[i__1].i + ctemp.i * dl[i__1].r;
	i__2 = jsub;
	z__1.r = z__2.r * dl[i__2].r - z__2.i * dl[i__2].i, z__1.i = z__2.r * 
		dl[i__2].i + z__2.i * dl[i__2].r;
	ctemp.r = z__1.r, ctemp.i = z__1.i;
    }
     ret_val->r = ctemp.r,  ret_val->i = ctemp.i;
    return ;

/*     End of ZLATM2 */

} /* zlatm2_ */