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