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