00001 /* slatm2.f -- translated by f2c (version 20061008). 00002 You must link the resulting object file with libf2c: 00003 on Microsoft Windows system, link with libf2c.lib; 00004 on Linux or Unix systems, link with .../path/to/libf2c.a -lm 00005 or, if you install libf2c.a in a standard place, with -lf2c -lm 00006 -- in that order, at the end of the command line, as in 00007 cc *.o -lf2c -lm 00008 Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., 00009 00010 http://www.netlib.org/f2c/libf2c.zip 00011 */ 00012 00013 #include "f2c.h" 00014 #include "blaswrap.h" 00015 00016 doublereal slatm2_(integer *m, integer *n, integer *i__, integer *j, integer * 00017 kl, integer *ku, integer *idist, integer *iseed, real *d__, integer * 00018 igrade, real *dl, real *dr, integer *ipvtng, integer *iwork, real * 00019 sparse) 00020 { 00021 /* System generated locals */ 00022 real ret_val; 00023 00024 /* Local variables */ 00025 integer isub, jsub; 00026 real temp; 00027 extern doublereal slaran_(integer *), slarnd_(integer *, integer *); 00028 00029 00030 /* -- LAPACK auxiliary test routine (version 3.1) -- */ 00031 /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ 00032 /* November 2006 */ 00033 00034 /* .. Scalar Arguments .. */ 00035 00036 /* .. */ 00037 00038 /* .. Array Arguments .. */ 00039 00040 /* .. */ 00041 00042 /* Purpose */ 00043 /* ======= */ 00044 00045 /* SLATM2 returns the (I,J) entry of a random matrix of dimension */ 00046 /* (M, N) described by the other paramters. It is called by the */ 00047 /* SLATMR routine in order to build random test matrices. No error */ 00048 /* checking on parameters is done, because this routine is called in */ 00049 /* a tight loop by SLATMR which has already checked the parameters. */ 00050 00051 /* Use of SLATM2 differs from SLATM3 in the order in which the random */ 00052 /* number generator is called to fill in random matrix entries. */ 00053 /* With SLATM2, the generator is called to fill in the pivoted matrix */ 00054 /* columnwise. With SLATM3, the generator is called to fill in the */ 00055 /* matrix columnwise, after which it is pivoted. Thus, SLATM3 can */ 00056 /* be used to construct random matrices which differ only in their */ 00057 /* order of rows and/or columns. SLATM2 is used to construct band */ 00058 /* matrices while avoiding calling the random number generator for */ 00059 /* entries outside the band (and therefore generating random numbers */ 00060 00061 /* The matrix whose (I,J) entry is returned is constructed as */ 00062 /* follows (this routine only computes one entry): */ 00063 00064 /* If I is outside (1..M) or J is outside (1..N), return zero */ 00065 /* (this is convenient for generating matrices in band format). */ 00066 00067 /* Generate a matrix A with random entries of distribution IDIST. */ 00068 00069 /* Set the diagonal to D. */ 00070 00071 /* Grade the matrix, if desired, from the left (by DL) and/or */ 00072 /* from the right (by DR or DL) as specified by IGRADE. */ 00073 00074 /* Permute, if desired, the rows and/or columns as specified by */ 00075 /* IPVTNG and IWORK. */ 00076 00077 /* Band the matrix to have lower bandwidth KL and upper */ 00078 /* bandwidth KU. */ 00079 00080 /* Set random entries to zero as specified by SPARSE. */ 00081 00082 /* Arguments */ 00083 /* ========= */ 00084 00085 /* M - INTEGER */ 00086 /* Number of rows of matrix. Not modified. */ 00087 00088 /* N - INTEGER */ 00089 /* Number of columns of matrix. Not modified. */ 00090 00091 /* I - INTEGER */ 00092 /* Row of entry to be returned. Not modified. */ 00093 00094 /* J - INTEGER */ 00095 /* Column of entry to be returned. Not modified. */ 00096 00097 /* KL - INTEGER */ 00098 /* Lower bandwidth. Not modified. */ 00099 00100 /* KU - INTEGER */ 00101 /* Upper bandwidth. Not modified. */ 00102 00103 /* IDIST - INTEGER */ 00104 /* On entry, IDIST specifies the type of distribution to be */ 00105 /* used to generate a random matrix . */ 00106 /* 1 => UNIFORM( 0, 1 ) */ 00107 /* 2 => UNIFORM( -1, 1 ) */ 00108 /* 3 => NORMAL( 0, 1 ) */ 00109 /* Not modified. */ 00110 00111 /* ISEED - INTEGER array of dimension ( 4 ) */ 00112 /* Seed for random number generator. */ 00113 /* Changed on exit. */ 00114 00115 /* D - REAL array of dimension ( MIN( I , J ) ) */ 00116 /* Diagonal entries of matrix. Not modified. */ 00117 00118 /* IGRADE - INTEGER */ 00119 /* Specifies grading of matrix as follows: */ 00120 /* 0 => no grading */ 00121 /* 1 => matrix premultiplied by diag( DL ) */ 00122 /* 2 => matrix postmultiplied by diag( DR ) */ 00123 /* 3 => matrix premultiplied by diag( DL ) and */ 00124 /* postmultiplied by diag( DR ) */ 00125 /* 4 => matrix premultiplied by diag( DL ) and */ 00126 /* postmultiplied by inv( diag( DL ) ) */ 00127 /* 5 => matrix premultiplied by diag( DL ) and */ 00128 /* postmultiplied by diag( DL ) */ 00129 /* Not modified. */ 00130 00131 /* DL - REAL array ( I or J, as appropriate ) */ 00132 /* Left scale factors for grading matrix. Not modified. */ 00133 00134 /* DR - REAL array ( I or J, as appropriate ) */ 00135 /* Right scale factors for grading matrix. Not modified. */ 00136 00137 /* IPVTNG - INTEGER */ 00138 /* On entry specifies pivoting permutations as follows: */ 00139 /* 0 => none. */ 00140 /* 1 => row pivoting. */ 00141 /* 2 => column pivoting. */ 00142 /* 3 => full pivoting, i.e., on both sides. */ 00143 /* Not modified. */ 00144 00145 /* IWORK - INTEGER array ( I or J, as appropriate ) */ 00146 /* This array specifies the permutation used. The */ 00147 /* row (or column) in position K was originally in */ 00148 /* position IWORK( K ). */ 00149 /* This differs from IWORK for SLATM3. Not modified. */ 00150 00151 /* SPARSE - REAL between 0. and 1. */ 00152 /* On entry specifies the sparsity of the matrix */ 00153 /* if sparse matix is to be generated. */ 00154 /* SPARSE should lie between 0 and 1. */ 00155 /* A uniform ( 0, 1 ) random number x is generated and */ 00156 /* compared to SPARSE; if x is larger the matrix entry */ 00157 /* is unchanged and if x is smaller the entry is set */ 00158 /* to zero. Thus on the average a fraction SPARSE of the */ 00159 /* entries will be set to zero. */ 00160 /* Not modified. */ 00161 00162 /* ===================================================================== */ 00163 00164 /* .. Parameters .. */ 00165 00166 /* .. */ 00167 00168 /* .. Local Scalars .. */ 00169 00170 /* .. */ 00171 00172 /* .. External Functions .. */ 00173 00174 /* .. */ 00175 00176 /* ----------------------------------------------------------------------- */ 00177 00178 /* .. Executable Statements .. */ 00179 00180 00181 /* Check for I and J in range */ 00182 00183 /* Parameter adjustments */ 00184 --iwork; 00185 --dr; 00186 --dl; 00187 --d__; 00188 --iseed; 00189 00190 /* Function Body */ 00191 if (*i__ < 1 || *i__ > *m || *j < 1 || *j > *n) { 00192 ret_val = 0.f; 00193 return ret_val; 00194 } 00195 00196 /* Check for banding */ 00197 00198 if (*j > *i__ + *ku || *j < *i__ - *kl) { 00199 ret_val = 0.f; 00200 return ret_val; 00201 } 00202 00203 /* Check for sparsity */ 00204 00205 if (*sparse > 0.f) { 00206 if (slaran_(&iseed[1]) < *sparse) { 00207 ret_val = 0.f; 00208 return ret_val; 00209 } 00210 } 00211 00212 /* Compute subscripts depending on IPVTNG */ 00213 00214 if (*ipvtng == 0) { 00215 isub = *i__; 00216 jsub = *j; 00217 } else if (*ipvtng == 1) { 00218 isub = iwork[*i__]; 00219 jsub = *j; 00220 } else if (*ipvtng == 2) { 00221 isub = *i__; 00222 jsub = iwork[*j]; 00223 } else if (*ipvtng == 3) { 00224 isub = iwork[*i__]; 00225 jsub = iwork[*j]; 00226 } 00227 00228 /* Compute entry and grade it according to IGRADE */ 00229 00230 if (isub == jsub) { 00231 temp = d__[isub]; 00232 } else { 00233 temp = slarnd_(idist, &iseed[1]); 00234 } 00235 if (*igrade == 1) { 00236 temp *= dl[isub]; 00237 } else if (*igrade == 2) { 00238 temp *= dr[jsub]; 00239 } else if (*igrade == 3) { 00240 temp = temp * dl[isub] * dr[jsub]; 00241 } else if (*igrade == 4 && isub != jsub) { 00242 temp = temp * dl[isub] / dl[jsub]; 00243 } else if (*igrade == 5) { 00244 temp = temp * dl[isub] * dl[jsub]; 00245 } 00246 ret_val = temp; 00247 return ret_val; 00248 00249 /* End of SLATM2 */ 00250 00251 } /* slatm2_ */