00001 COMPLEX FUNCTION CLATM2( M, N, I, J, KL, KU, IDIST, ISEED, D,
00002 $ IGRADE, DL, DR, IPVTNG, IWORK, SPARSE )
00003 *
00004 * -- LAPACK auxiliary test routine (version 3.1) --
00005 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00006 * June 2010
00007 *
00008 * .. Scalar Arguments ..
00009 *
00010 INTEGER I, IDIST, IGRADE, IPVTNG, J, KL, KU, M, N
00011 REAL SPARSE
00012 * ..
00013 *
00014 * .. Array Arguments ..
00015 *
00016 INTEGER ISEED( 4 ), IWORK( * )
00017 COMPLEX D( * ), DL( * ), DR( * )
00018 * ..
00019 *
00020 * Purpose
00021 * =======
00022 *
00023 * CLATM2 returns the (I,J) entry of a random matrix of dimension
00024 * (M, N) described by the other paramters. It is called by the
00025 * CLATMR routine in order to build random test matrices. No error
00026 * checking on parameters is done, because this routine is called in
00027 * a tight loop by CLATMR which has already checked the parameters.
00028 *
00029 * Use of CLATM2 differs from CLATM3 in the order in which the random
00030 * number generator is called to fill in random matrix entries.
00031 * With CLATM2, the generator is called to fill in the pivoted matrix
00032 * columnwise. With CLATM3, the generator is called to fill in the
00033 * matrix columnwise, after which it is pivoted. Thus, CLATM3 can
00034 * be used to construct random matrices which differ only in their
00035 * order of rows and/or columns. CLATM2 is used to construct band
00036 * matrices while avoiding calling the random number generator for
00037 * entries outside the band (and therefore generating random numbers
00038 *
00039 * The matrix whose (I,J) entry is returned is constructed as
00040 * follows (this routine only computes one entry):
00041 *
00042 * If I is outside (1..M) or J is outside (1..N), return zero
00043 * (this is convenient for generating matrices in band format).
00044 *
00045 * Generate a matrix A with random entries of distribution IDIST.
00046 *
00047 * Set the diagonal to D.
00048 *
00049 * Grade the matrix, if desired, from the left (by DL) and/or
00050 * from the right (by DR or DL) as specified by IGRADE.
00051 *
00052 * Permute, if desired, the rows and/or columns as specified by
00053 * IPVTNG and IWORK.
00054 *
00055 * Band the matrix to have lower bandwidth KL and upper
00056 * bandwidth KU.
00057 *
00058 * Set random entries to zero as specified by SPARSE.
00059 *
00060 * Arguments
00061 * =========
00062 *
00063 * M (input) INTEGER
00064 * Number of rows of matrix. Not modified.
00065 *
00066 * N (input) INTEGER
00067 * Number of columns of matrix. Not modified.
00068 *
00069 * I (input) INTEGER
00070 * Row of entry to be returned. Not modified.
00071 *
00072 * J (input) INTEGER
00073 * Column of entry to be returned. Not modified.
00074 *
00075 * KL (input) INTEGER
00076 * Lower bandwidth. Not modified.
00077 *
00078 * KU (input) INTEGER
00079 * Upper bandwidth. Not modified.
00080 *
00081 * IDIST (input) INTEGER
00082 * On entry, IDIST specifies the type of distribution to be
00083 * used to generate a random matrix .
00084 * 1 => real and imaginary parts each UNIFORM( 0, 1 )
00085 * 2 => real and imaginary parts each UNIFORM( -1, 1 )
00086 * 3 => real and imaginary parts each NORMAL( 0, 1 )
00087 * 4 => complex number uniform in DISK( 0 , 1 )
00088 * Not modified.
00089 *
00090 * ISEED (input/output) INTEGER array of dimension ( 4 )
00091 * Seed for random number generator.
00092 * Changed on exit.
00093 *
00094 * D (input) COMPLEX array of dimension ( MIN( I , J ) )
00095 * Diagonal entries of matrix. Not modified.
00096 *
00097 * IGRADE (input) INTEGER
00098 * Specifies grading of matrix as follows:
00099 * 0 => no grading
00100 * 1 => matrix premultiplied by diag( DL )
00101 * 2 => matrix postmultiplied by diag( DR )
00102 * 3 => matrix premultiplied by diag( DL ) and
00103 * postmultiplied by diag( DR )
00104 * 4 => matrix premultiplied by diag( DL ) and
00105 * postmultiplied by inv( diag( DL ) )
00106 * 5 => matrix premultiplied by diag( DL ) and
00107 * postmultiplied by diag( CONJG(DL) )
00108 * 6 => matrix premultiplied by diag( DL ) and
00109 * postmultiplied by diag( DL )
00110 * Not modified.
00111 *
00112 * DL (input) COMPLEX array ( I or J, as appropriate )
00113 * Left scale factors for grading matrix. Not modified.
00114 *
00115 * DR (input) COMPLEX array ( I or J, as appropriate )
00116 * Right scale factors for grading matrix. Not modified.
00117 *
00118 * IPVTNG (input) INTEGER
00119 * On entry specifies pivoting permutations as follows:
00120 * 0 => none.
00121 * 1 => row pivoting.
00122 * 2 => column pivoting.
00123 * 3 => full pivoting, i.e., on both sides.
00124 * Not modified.
00125 *
00126 * IWORK (workspace) INTEGER array ( I or J, as appropriate )
00127 * This array specifies the permutation used. The
00128 * row (or column) in position K was originally in
00129 * position IWORK( K ).
00130 * This differs from IWORK for CLATM3. Not modified.
00131 *
00132 * SPARSE (input) REAL
00133 * Value between 0. and 1.
00134 * On entry specifies the sparsity of the matrix
00135 * if sparse matix is to be generated.
00136 * SPARSE should lie between 0 and 1.
00137 * A uniform ( 0, 1 ) random number x is generated and
00138 * compared to SPARSE; if x is larger the matrix entry
00139 * is unchanged and if x is smaller the entry is set
00140 * to zero. Thus on the average a fraction SPARSE of the
00141 * entries will be set to zero.
00142 * Not modified.
00143 *
00144 * =====================================================================
00145 *
00146 * .. Parameters ..
00147 *
00148 COMPLEX CZERO
00149 PARAMETER ( CZERO = ( 0.0E0, 0.0E0 ) )
00150 REAL ZERO
00151 PARAMETER ( ZERO = 0.0E0 )
00152 * ..
00153 *
00154 * .. Local Scalars ..
00155 *
00156 INTEGER ISUB, JSUB
00157 COMPLEX CTEMP
00158 * ..
00159 *
00160 * .. External Functions ..
00161 *
00162 REAL SLARAN
00163 COMPLEX CLARND
00164 EXTERNAL SLARAN, CLARND
00165 * ..
00166 *
00167 * .. Intrinsic Functions ..
00168 *
00169 INTRINSIC CONJG
00170 * ..
00171 *
00172 *-----------------------------------------------------------------------
00173 *
00174 * .. Executable Statements ..
00175 *
00176 *
00177 * Check for I and J in range
00178 *
00179 IF( I.LT.1 .OR. I.GT.M .OR. J.LT.1 .OR. J.GT.N ) THEN
00180 CLATM2 = CZERO
00181 RETURN
00182 END IF
00183 *
00184 * Check for banding
00185 *
00186 IF( J.GT.I+KU .OR. J.LT.I-KL ) THEN
00187 CLATM2 = CZERO
00188 RETURN
00189 END IF
00190 *
00191 * Check for sparsity
00192 *
00193 IF( SPARSE.GT.ZERO ) THEN
00194 IF( SLARAN( ISEED ).LT.SPARSE ) THEN
00195 CLATM2 = CZERO
00196 RETURN
00197 END IF
00198 END IF
00199 *
00200 * Compute subscripts depending on IPVTNG
00201 *
00202 IF( IPVTNG.EQ.0 ) THEN
00203 ISUB = I
00204 JSUB = J
00205 ELSE IF( IPVTNG.EQ.1 ) THEN
00206 ISUB = IWORK( I )
00207 JSUB = J
00208 ELSE IF( IPVTNG.EQ.2 ) THEN
00209 ISUB = I
00210 JSUB = IWORK( J )
00211 ELSE IF( IPVTNG.EQ.3 ) THEN
00212 ISUB = IWORK( I )
00213 JSUB = IWORK( J )
00214 END IF
00215 *
00216 * Compute entry and grade it according to IGRADE
00217 *
00218 IF( ISUB.EQ.JSUB ) THEN
00219 CTEMP = D( ISUB )
00220 ELSE
00221 CTEMP = CLARND( IDIST, ISEED )
00222 END IF
00223 IF( IGRADE.EQ.1 ) THEN
00224 CTEMP = CTEMP*DL( ISUB )
00225 ELSE IF( IGRADE.EQ.2 ) THEN
00226 CTEMP = CTEMP*DR( JSUB )
00227 ELSE IF( IGRADE.EQ.3 ) THEN
00228 CTEMP = CTEMP*DL( ISUB )*DR( JSUB )
00229 ELSE IF( IGRADE.EQ.4 .AND. ISUB.NE.JSUB ) THEN
00230 CTEMP = CTEMP*DL( ISUB ) / DL( JSUB )
00231 ELSE IF( IGRADE.EQ.5 ) THEN
00232 CTEMP = CTEMP*DL( ISUB )*CONJG( DL( JSUB ) )
00233 ELSE IF( IGRADE.EQ.6 ) THEN
00234 CTEMP = CTEMP*DL( ISUB )*DL( JSUB )
00235 END IF
00236 CLATM2 = CTEMP
00237 RETURN
00238 *
00239 * End of CLATM2
00240 *
00241 END