|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 REAL FUNCTION SLATM2( M, N, I, J, KL, KU, IDIST, 00002 $ ISEED, D, 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 REAL D( * ), DL( * ), DR( * ) 00018 * .. 00019 * 00020 * Purpose 00021 * ======= 00022 * 00023 * SLATM2 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 * SLATMR 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 SLATMR which has already checked the parameters. 00028 * 00029 * Use of SLATM2 differs from SLATM3 in the order in which the random 00030 * number generator is called to fill in random matrix entries. 00031 * With SLATM2, the generator is called to fill in the pivoted matrix 00032 * columnwise. With SLATM3, the generator is called to fill in the 00033 * matrix columnwise, after which it is pivoted. Thus, SLATM3 can 00034 * be used to construct random matrices which differ only in their 00035 * order of rows and/or columns. SLATM2 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 => UNIFORM( 0, 1 ) 00085 * 2 => UNIFORM( -1, 1 ) 00086 * 3 => NORMAL( 0, 1 ) 00087 * Not modified. 00088 * 00089 * ISEED (input/output) INTEGER array of dimension ( 4 ) 00090 * Seed for random number generator. 00091 * Changed on exit. 00092 * 00093 * D (input) REAL array of dimension ( MIN( I , J ) ) 00094 * Diagonal entries of matrix. Not modified. 00095 * 00096 * IGRADE (input) INTEGER 00097 * Specifies grading of matrix as follows: 00098 * 0 => no grading 00099 * 1 => matrix premultiplied by diag( DL ) 00100 * 2 => matrix postmultiplied by diag( DR ) 00101 * 3 => matrix premultiplied by diag( DL ) and 00102 * postmultiplied by diag( DR ) 00103 * 4 => matrix premultiplied by diag( DL ) and 00104 * postmultiplied by inv( diag( DL ) ) 00105 * 5 => matrix premultiplied by diag( DL ) and 00106 * postmultiplied by diag( DL ) 00107 * Not modified. 00108 * 00109 * DL (input) REAL array ( I or J, as appropriate ) 00110 * Left scale factors for grading matrix. Not modified. 00111 * 00112 * DR (input) REAL array ( I or J, as appropriate ) 00113 * Right scale factors for grading matrix. Not modified. 00114 * 00115 * IPVTNG (input) INTEGER 00116 * On entry specifies pivoting permutations as follows: 00117 * 0 => none. 00118 * 1 => row pivoting. 00119 * 2 => column pivoting. 00120 * 3 => full pivoting, i.e., on both sides. 00121 * Not modified. 00122 * 00123 * IWORK (workspace) INTEGER array ( I or J, as appropriate ) 00124 * This array specifies the permutation used. The 00125 * row (or column) in position K was originally in 00126 * position IWORK( K ). 00127 * This differs from IWORK for SLATM3. Not modified. 00128 * 00129 * SPARSE (input) REAL between 0. and 1. 00130 * On entry specifies the sparsity of the matrix 00131 * if sparse matix is to be generated. 00132 * SPARSE should lie between 0 and 1. 00133 * A uniform ( 0, 1 ) random number x is generated and 00134 * compared to SPARSE; if x is larger the matrix entry 00135 * is unchanged and if x is smaller the entry is set 00136 * to zero. Thus on the average a fraction SPARSE of the 00137 * entries will be set to zero. 00138 * Not modified. 00139 * 00140 * ===================================================================== 00141 * 00142 * .. Parameters .. 00143 * 00144 REAL ZERO 00145 PARAMETER ( ZERO = 0.0E0 ) 00146 * .. 00147 * 00148 * .. Local Scalars .. 00149 * 00150 INTEGER ISUB, JSUB 00151 REAL TEMP 00152 * .. 00153 * 00154 * .. External Functions .. 00155 * 00156 REAL SLARAN, SLARND 00157 EXTERNAL SLARAN, SLARND 00158 * .. 00159 * 00160 *----------------------------------------------------------------------- 00161 * 00162 * .. Executable Statements .. 00163 * 00164 * 00165 * Check for I and J in range 00166 * 00167 IF( I.LT.1 .OR. I.GT.M .OR. J.LT.1 .OR. J.GT.N ) THEN 00168 SLATM2 = ZERO 00169 RETURN 00170 END IF 00171 * 00172 * Check for banding 00173 * 00174 IF( J.GT.I+KU .OR. J.LT.I-KL ) THEN 00175 SLATM2 = ZERO 00176 RETURN 00177 END IF 00178 * 00179 * Check for sparsity 00180 * 00181 IF( SPARSE.GT.ZERO ) THEN 00182 IF( SLARAN( ISEED ).LT.SPARSE ) THEN 00183 SLATM2 = ZERO 00184 RETURN 00185 END IF 00186 END IF 00187 * 00188 * Compute subscripts depending on IPVTNG 00189 * 00190 IF( IPVTNG.EQ.0 ) THEN 00191 ISUB = I 00192 JSUB = J 00193 ELSE IF( IPVTNG.EQ.1 ) THEN 00194 ISUB = IWORK( I ) 00195 JSUB = J 00196 ELSE IF( IPVTNG.EQ.2 ) THEN 00197 ISUB = I 00198 JSUB = IWORK( J ) 00199 ELSE IF( IPVTNG.EQ.3 ) THEN 00200 ISUB = IWORK( I ) 00201 JSUB = IWORK( J ) 00202 END IF 00203 * 00204 * Compute entry and grade it according to IGRADE 00205 * 00206 IF( ISUB.EQ.JSUB ) THEN 00207 TEMP = D( ISUB ) 00208 ELSE 00209 TEMP = SLARND( IDIST, ISEED ) 00210 END IF 00211 IF( IGRADE.EQ.1 ) THEN 00212 TEMP = TEMP*DL( ISUB ) 00213 ELSE IF( IGRADE.EQ.2 ) THEN 00214 TEMP = TEMP*DR( JSUB ) 00215 ELSE IF( IGRADE.EQ.3 ) THEN 00216 TEMP = TEMP*DL( ISUB )*DR( JSUB ) 00217 ELSE IF( IGRADE.EQ.4 .AND. ISUB.NE.JSUB ) THEN 00218 TEMP = TEMP*DL( ISUB ) / DL( JSUB ) 00219 ELSE IF( IGRADE.EQ.5 ) THEN 00220 TEMP = TEMP*DL( ISUB )*DL( JSUB ) 00221 END IF 00222 SLATM2 = TEMP 00223 RETURN 00224 * 00225 * End of SLATM2 00226 * 00227 END
1.7.3 
