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