00001 DOUBLE COMPLEX FUNCTION ZLATM3( 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 COMPLEX*16 D( * ), DL( * ), DR( * ) 00020 * .. 00021 * 00022 * Purpose 00023 * ======= 00024 * 00025 * ZLATM3 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. ZLATM3 is called by the 00029 * ZLATMR 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 ZLATMR which has already checked the parameters. 00032 * 00033 * Use of ZLATM3 differs from CLATM2 in the order in which the random 00034 * number generator is called to fill in random matrix entries. 00035 * With ZLATM2, the generator is called to fill in the pivoted matrix 00036 * columnwise. With ZLATM3, the generator is called to fill in the 00037 * matrix columnwise, after which it is pivoted. Thus, ZLATM3 can 00038 * be used to construct random matrices which differ only in their 00039 * order of rows and/or columns. ZLATM2 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 => real and imaginary parts each UNIFORM( 0, 1 ) 00096 * 2 => real and imaginary parts each UNIFORM( -1, 1 ) 00097 * 3 => real and imaginary parts each NORMAL( 0, 1 ) 00098 * 4 => complex number uniform in DISK( 0 , 1 ) 00099 * Not modified. 00100 * 00101 * ISEED (input/output) INTEGER array of dimension ( 4 ) 00102 * Seed for random number generator. 00103 * Changed on exit. 00104 * 00105 * D (input) COMPLEX*16 array of dimension ( MIN( I , J ) ) 00106 * Diagonal entries of matrix. Not modified. 00107 * 00108 * IGRADE (input) INTEGER 00109 * Specifies grading of matrix as follows: 00110 * 0 => no grading 00111 * 1 => matrix premultiplied by diag( DL ) 00112 * 2 => matrix postmultiplied by diag( DR ) 00113 * 3 => matrix premultiplied by diag( DL ) and 00114 * postmultiplied by diag( DR ) 00115 * 4 => matrix premultiplied by diag( DL ) and 00116 * postmultiplied by inv( diag( DL ) ) 00117 * 5 => matrix premultiplied by diag( DL ) and 00118 * postmultiplied by diag( CONJG(DL) ) 00119 * 6 => matrix premultiplied by diag( DL ) and 00120 * postmultiplied by diag( DL ) 00121 * Not modified. 00122 * 00123 * DL (input) COMPLEX*16 array ( I or J, as appropriate ) 00124 * Left scale factors for grading matrix. Not modified. 00125 * 00126 * DR (input) COMPLEX*16 array ( I or J, as appropriate ) 00127 * Right scale factors for grading matrix. Not modified. 00128 * 00129 * IPVTNG (input) INTEGER 00130 * On entry specifies pivoting permutations as follows: 00131 * 0 => none. 00132 * 1 => row pivoting. 00133 * 2 => column pivoting. 00134 * 3 => full pivoting, i.e., on both sides. 00135 * Not modified. 00136 * 00137 * IWORK (input) INTEGER array ( I or J, as appropriate ) 00138 * This array specifies the permutation used. The 00139 * row (or column) originally in position K is in 00140 * position IWORK( K ) after pivoting. 00141 * This differs from IWORK for ZLATM2. Not modified. 00142 * 00143 * SPARSE (input) DOUBLE PRECISION between 0. and 1. 00144 * On entry specifies the sparsity of the matrix 00145 * if sparse matix is to be generated. 00146 * SPARSE should lie between 0 and 1. 00147 * A uniform ( 0, 1 ) random number x is generated and 00148 * compared to SPARSE; if x is larger the matrix entry 00149 * is unchanged and if x is smaller the entry is set 00150 * to zero. Thus on the average a fraction SPARSE of the 00151 * entries will be set to zero. 00152 * Not modified. 00153 * 00154 * ===================================================================== 00155 * 00156 * .. Parameters .. 00157 * 00158 DOUBLE PRECISION ZERO 00159 PARAMETER ( ZERO = 0.0D0 ) 00160 COMPLEX*16 CZERO 00161 PARAMETER ( CZERO = ( 0.0D0, 0.0D0 ) ) 00162 * .. 00163 * 00164 * .. Local Scalars .. 00165 * 00166 COMPLEX*16 CTEMP 00167 * .. 00168 * 00169 * .. External Functions .. 00170 * 00171 DOUBLE PRECISION DLARAN 00172 COMPLEX*16 ZLARND 00173 EXTERNAL DLARAN, ZLARND 00174 * .. 00175 * 00176 * .. Intrinsic Functions .. 00177 * 00178 INTRINSIC DCONJG 00179 * .. 00180 * 00181 *----------------------------------------------------------------------- 00182 * 00183 * .. Executable Statements .. 00184 * 00185 * 00186 * Check for I and J in range 00187 * 00188 IF( I.LT.1 .OR. I.GT.M .OR. J.LT.1 .OR. J.GT.N ) THEN 00189 ISUB = I 00190 JSUB = J 00191 ZLATM3 = CZERO 00192 RETURN 00193 END IF 00194 * 00195 * Compute subscripts depending on IPVTNG 00196 * 00197 IF( IPVTNG.EQ.0 ) THEN 00198 ISUB = I 00199 JSUB = J 00200 ELSE IF( IPVTNG.EQ.1 ) THEN 00201 ISUB = IWORK( I ) 00202 JSUB = J 00203 ELSE IF( IPVTNG.EQ.2 ) THEN 00204 ISUB = I 00205 JSUB = IWORK( J ) 00206 ELSE IF( IPVTNG.EQ.3 ) THEN 00207 ISUB = IWORK( I ) 00208 JSUB = IWORK( J ) 00209 END IF 00210 * 00211 * Check for banding 00212 * 00213 IF( JSUB.GT.ISUB+KU .OR. JSUB.LT.ISUB-KL ) THEN 00214 ZLATM3 = CZERO 00215 RETURN 00216 END IF 00217 * 00218 * Check for sparsity 00219 * 00220 IF( SPARSE.GT.ZERO ) THEN 00221 IF( DLARAN( ISEED ).LT.SPARSE ) THEN 00222 ZLATM3 = CZERO 00223 RETURN 00224 END IF 00225 END IF 00226 * 00227 * Compute entry and grade it according to IGRADE 00228 * 00229 IF( I.EQ.J ) THEN 00230 CTEMP = D( I ) 00231 ELSE 00232 CTEMP = ZLARND( IDIST, ISEED ) 00233 END IF 00234 IF( IGRADE.EQ.1 ) THEN 00235 CTEMP = CTEMP*DL( I ) 00236 ELSE IF( IGRADE.EQ.2 ) THEN 00237 CTEMP = CTEMP*DR( J ) 00238 ELSE IF( IGRADE.EQ.3 ) THEN 00239 CTEMP = CTEMP*DL( I )*DR( J ) 00240 ELSE IF( IGRADE.EQ.4 .AND. I.NE.J ) THEN 00241 CTEMP = CTEMP*DL( I ) / DL( J ) 00242 ELSE IF( IGRADE.EQ.5 ) THEN 00243 CTEMP = CTEMP*DL( I )*DCONJG( DL( J ) ) 00244 ELSE IF( IGRADE.EQ.6 ) THEN 00245 CTEMP = CTEMP*DL( I )*DL( J ) 00246 END IF 00247 ZLATM3 = CTEMP 00248 RETURN 00249 * 00250 * End of ZLATM3 00251 * 00252 END
1.7.2