1 /* dlatm2.f -- translated by f2c (version 20061008).
2 You must link the resulting object file with libf2c:
3 on Microsoft Windows system, link with libf2c.lib;
4 on Linux or Unix systems, link with .../path/to/libf2c.a -lm
5 or, if you install libf2c.a in a standard place, with -lf2c -lm
6 -- in that order, at the end of the command line, as in
7 cc *.o -lf2c -lm
8 Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
10 http://www.netlib.org/f2c/libf2c.zip
11 */
13 #include "f2c.h"
14 #include "blaswrap.h"
16 doublereal dlatm2_(integer *m, integer *n, integer *i__, integer *j, integer *
17 kl, integer *ku, integer *idist, integer *iseed, doublereal *d__,
18 integer *igrade, doublereal *dl, doublereal *dr, integer *ipvtng,
19 integer *iwork, doublereal *sparse)
20 {
21 /* System generated locals */
22 doublereal ret_val;
24 /* Local variables */
25 integer isub, jsub;
26 doublereal temp;
27 extern doublereal dlaran_(integer *), dlarnd_(integer *, integer *);
30 /* -- LAPACK auxiliary test routine (version 3.1) -- */
31 /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
32 /* November 2006 */
34 /* .. Scalar Arguments .. */
36 /* .. */
38 /* .. Array Arguments .. */
40 /* .. */
42 /* Purpose */
43 /* ======= */
45 /* DLATM2 returns the (I,J) entry of a random matrix of dimension */
46 /* (M, N) described by the other paramters. It is called by the */
47 /* DLATMR routine in order to build random test matrices. No error */
48 /* checking on parameters is done, because this routine is called in */
49 /* a tight loop by DLATMR which has already checked the parameters. */
51 /* Use of DLATM2 differs from SLATM3 in the order in which the random */
52 /* number generator is called to fill in random matrix entries. */
53 /* With DLATM2, the generator is called to fill in the pivoted matrix */
54 /* columnwise. With DLATM3, the generator is called to fill in the */
55 /* matrix columnwise, after which it is pivoted. Thus, DLATM3 can */
56 /* be used to construct random matrices which differ only in their */
57 /* order of rows and/or columns. DLATM2 is used to construct band */
58 /* matrices while avoiding calling the random number generator for */
59 /* entries outside the band (and therefore generating random numbers */
61 /* The matrix whose (I,J) entry is returned is constructed as */
62 /* follows (this routine only computes one entry): */
64 /* If I is outside (1..M) or J is outside (1..N), return zero */
65 /* (this is convenient for generating matrices in band format). */
67 /* Generate a matrix A with random entries of distribution IDIST. */
69 /* Set the diagonal to D. */
71 /* Grade the matrix, if desired, from the left (by DL) and/or */
72 /* from the right (by DR or DL) as specified by IGRADE. */
74 /* Permute, if desired, the rows and/or columns as specified by */
75 /* IPVTNG and IWORK. */
77 /* Band the matrix to have lower bandwidth KL and upper */
78 /* bandwidth KU. */
80 /* Set random entries to zero as specified by SPARSE. */
82 /* Arguments */
83 /* ========= */
85 /* M - INTEGER */
86 /* Number of rows of matrix. Not modified. */
88 /* N - INTEGER */
89 /* Number of columns of matrix. Not modified. */
91 /* I - INTEGER */
92 /* Row of entry to be returned. Not modified. */
94 /* J - INTEGER */
95 /* Column of entry to be returned. Not modified. */
97 /* KL - INTEGER */
98 /* Lower bandwidth. Not modified. */
100 /* KU - INTEGER */
101 /* Upper bandwidth. Not modified. */
103 /* IDIST - INTEGER */
104 /* On entry, IDIST specifies the type of distribution to be */
105 /* used to generate a random matrix . */
106 /* 1 => UNIFORM( 0, 1 ) */
107 /* 2 => UNIFORM( -1, 1 ) */
108 /* 3 => NORMAL( 0, 1 ) */
109 /* Not modified. */
111 /* ISEED - INTEGER array of dimension ( 4 ) */
112 /* Seed for random number generator. */
113 /* Changed on exit. */
115 /* D - DOUBLE PRECISION array of dimension ( MIN( I , J ) ) */
116 /* Diagonal entries of matrix. Not modified. */
118 /* IGRADE - INTEGER */
119 /* Specifies grading of matrix as follows: */
120 /* 0 => no grading */
121 /* 1 => matrix premultiplied by diag( DL ) */
122 /* 2 => matrix postmultiplied by diag( DR ) */
123 /* 3 => matrix premultiplied by diag( DL ) and */
124 /* postmultiplied by diag( DR ) */
125 /* 4 => matrix premultiplied by diag( DL ) and */
126 /* postmultiplied by inv( diag( DL ) ) */
127 /* 5 => matrix premultiplied by diag( DL ) and */
128 /* postmultiplied by diag( DL ) */
129 /* Not modified. */
131 /* DL - DOUBLE PRECISION array ( I or J, as appropriate ) */
132 /* Left scale factors for grading matrix. Not modified. */
134 /* DR - DOUBLE PRECISION array ( I or J, as appropriate ) */
135 /* Right scale factors for grading matrix. Not modified. */
137 /* IPVTNG - INTEGER */
138 /* On entry specifies pivoting permutations as follows: */
139 /* 0 => none. */
140 /* 1 => row pivoting. */
141 /* 2 => column pivoting. */
142 /* 3 => full pivoting, i.e., on both sides. */
143 /* Not modified. */
145 /* IWORK - INTEGER array ( I or J, as appropriate ) */
146 /* This array specifies the permutation used. The */
147 /* row (or column) in position K was originally in */
148 /* position IWORK( K ). */
149 /* This differs from IWORK for DLATM3. Not modified. */
151 /* SPARSE - DOUBLE PRECISION between 0. and 1. */
152 /* On entry specifies the sparsity of the matrix */
153 /* if sparse matix is to be generated. */
154 /* SPARSE should lie between 0 and 1. */
155 /* A uniform ( 0, 1 ) random number x is generated and */
156 /* compared to SPARSE; if x is larger the matrix entry */
157 /* is unchanged and if x is smaller the entry is set */
158 /* to zero. Thus on the average a fraction SPARSE of the */
159 /* entries will be set to zero. */
160 /* Not modified. */
162 /* ===================================================================== */
164 /* .. Parameters .. */
166 /* .. */
168 /* .. Local Scalars .. */
170 /* .. */
172 /* .. External Functions .. */
174 /* .. */
176 /* ----------------------------------------------------------------------- */
178 /* .. Executable Statements .. */
181 /* Check for I and J in range */
183 /* Parameter adjustments */
184 --iwork;
185 --dr;
186 --dl;
187 --d__;
188 --iseed;
190 /* Function Body */
191 if (*i__ < 1 || *i__ > *m || *j < 1 || *j > *n) {
192 ret_val = 0.;
193 return ret_val;
194 }
196 /* Check for banding */
198 if (*j > *i__ + *ku || *j < *i__ - *kl) {
199 ret_val = 0.;
200 return ret_val;
201 }
203 /* Check for sparsity */
205 if (*sparse > 0.) {
206 if (dlaran_(&iseed[1]) < *sparse) {
207 ret_val = 0.;
208 return ret_val;
209 }
210 }
212 /* Compute subscripts depending on IPVTNG */
214 if (*ipvtng == 0) {
215 isub = *i__;
216 jsub = *j;
217 } else if (*ipvtng == 1) {
218 isub = iwork[*i__];
219 jsub = *j;
220 } else if (*ipvtng == 2) {
221 isub = *i__;
222 jsub = iwork[*j];
223 } else if (*ipvtng == 3) {
224 isub = iwork[*i__];
225 jsub = iwork[*j];
226 }
228 /* Compute entry and grade it according to IGRADE */
230 if (isub == jsub) {
231 temp = d__[isub];
232 } else {
233 temp = dlarnd_(idist, &iseed[1]);
234 }
235 if (*igrade == 1) {
236 temp *= dl[isub];
237 } else if (*igrade == 2) {
238 temp *= dr[jsub];
239 } else if (*igrade == 3) {
240 temp = temp * dl[isub] * dr[jsub];
241 } else if (*igrade == 4 && isub != jsub) {
242 temp = temp * dl[isub] / dl[jsub];
243 } else if (*igrade == 5) {
244 temp = temp * dl[isub] * dl[jsub];
245 }
246 ret_val = temp;
247 return ret_val;
249 /* End of DLATM2 */
251 } /* dlatm2_ */