1 DOUBLE PRECISION FUNCTION DLATM2( M, N, I, J, KL, KU, IDIST,
2 $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE )
3 *
4 * -- LAPACK auxiliary test routine (version 3.1) --
5 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
6 * June 2010
7 *
8 * .. Scalar Arguments ..
9 *
10 INTEGER I, IDIST, IGRADE, IPVTNG, J, KL, KU, M, N
11 DOUBLE PRECISION SPARSE
12 * ..
13 *
14 * .. Array Arguments ..
15 *
16 INTEGER ISEED( 4 ), IWORK( * )
17 DOUBLE PRECISION D( * ), DL( * ), DR( * )
18 * ..
19 *
20 * Purpose
21 * =======
22 *
23 * DLATM2 returns the (I,J) entry of a random matrix of dimension
24 * (M, N) described by the other paramters. It is called by the
25 * DLATMR routine in order to build random test matrices. No error
26 * checking on parameters is done, because this routine is called in
27 * a tight loop by DLATMR which has already checked the parameters.
28 *
29 * Use of DLATM2 differs from SLATM3 in the order in which the random
30 * number generator is called to fill in random matrix entries.
31 * With DLATM2, the generator is called to fill in the pivoted matrix
32 * columnwise. With DLATM3, the generator is called to fill in the
33 * matrix columnwise, after which it is pivoted. Thus, DLATM3 can
34 * be used to construct random matrices which differ only in their
35 * order of rows and/or columns. DLATM2 is used to construct band
36 * matrices while avoiding calling the random number generator for
37 * entries outside the band (and therefore generating random numbers
38 *
39 * The matrix whose (I,J) entry is returned is constructed as
40 * follows (this routine only computes one entry):
41 *
42 * If I is outside (1..M) or J is outside (1..N), return zero
43 * (this is convenient for generating matrices in band format).
44 *
45 * Generate a matrix A with random entries of distribution IDIST.
46 *
47 * Set the diagonal to D.
48 *
49 * Grade the matrix, if desired, from the left (by DL) and/or
50 * from the right (by DR or DL) as specified by IGRADE.
51 *
52 * Permute, if desired, the rows and/or columns as specified by
53 * IPVTNG and IWORK.
54 *
55 * Band the matrix to have lower bandwidth KL and upper
56 * bandwidth KU.
57 *
58 * Set random entries to zero as specified by SPARSE.
59 *
60 * Arguments
61 * =========
62 *
63 * M (input) INTEGER
64 * Number of rows of matrix. Not modified.
65 *
66 * N (input) INTEGER
67 * Number of columns of matrix. Not modified.
68 *
69 * I (input) INTEGER
70 * Row of entry to be returned. Not modified.
71 *
72 * J (input) INTEGER
73 * Column of entry to be returned. Not modified.
74 *
75 * KL (input) INTEGER
76 * Lower bandwidth. Not modified.
77 *
78 * KU (input) INTEGER
79 * Upper bandwidth. Not modified.
80 *
81 * IDIST (input) INTEGER
82 * On entry, IDIST specifies the type of distribution to be
83 * used to generate a random matrix .
84 * 1 => UNIFORM( 0, 1 )
85 * 2 => UNIFORM( -1, 1 )
86 * 3 => NORMAL( 0, 1 )
87 * Not modified.
88 *
89 * ISEED (input/output) INTEGER array of dimension ( 4 )
90 * Seed for random number generator.
91 * Changed on exit.
92 *
93 * D (input) DOUBLE PRECISION array of dimension ( MIN( I , J ) )
94 * Diagonal entries of matrix. Not modified.
95 *
96 * IGRADE (input) INTEGER
97 * Specifies grading of matrix as follows:
98 * 0 => no grading
99 * 1 => matrix premultiplied by diag( DL )
100 * 2 => matrix postmultiplied by diag( DR )
101 * 3 => matrix premultiplied by diag( DL ) and
102 * postmultiplied by diag( DR )
103 * 4 => matrix premultiplied by diag( DL ) and
104 * postmultiplied by inv( diag( DL ) )
105 * 5 => matrix premultiplied by diag( DL ) and
106 * postmultiplied by diag( DL )
107 * Not modified.
108 *
109 * DL (input) DOUBLE PRECISION array ( I or J, as appropriate )
110 * Left scale factors for grading matrix. Not modified.
111 *
112 * DR (input) DOUBLE PRECISION array ( I or J, as appropriate )
113 * Right scale factors for grading matrix. Not modified.
114 *
115 * IPVTNG (input) INTEGER
116 * On entry specifies pivoting permutations as follows:
117 * 0 => none.
118 * 1 => row pivoting.
119 * 2 => column pivoting.
120 * 3 => full pivoting, i.e., on both sides.
121 * Not modified.
122 *
123 * IWORK (workspace) INTEGER array ( I or J, as appropriate )
124 * This array specifies the permutation used. The
125 * row (or column) in position K was originally in
126 * position IWORK( K ).
127 * This differs from IWORK for DLATM3. Not modified.
128 *
129 * SPARSE (input) DOUBLE PRECISION between 0. and 1.
130 * On entry specifies the sparsity of the matrix
131 * if sparse matix is to be generated.
132 * SPARSE should lie between 0 and 1.
133 * A uniform ( 0, 1 ) random number x is generated and
134 * compared to SPARSE; if x is larger the matrix entry
135 * is unchanged and if x is smaller the entry is set
136 * to zero. Thus on the average a fraction SPARSE of the
137 * entries will be set to zero.
138 * Not modified.
139 *
140 * =====================================================================
141 *
142 * .. Parameters ..
143 *
144 DOUBLE PRECISION ZERO
145 PARAMETER ( ZERO = 0.0D0 )
146 * ..
147 *
148 * .. Local Scalars ..
149 *
150 INTEGER ISUB, JSUB
151 DOUBLE PRECISION TEMP
152 * ..
153 *
154 * .. External Functions ..
155 *
156 DOUBLE PRECISION DLARAN, DLARND
157 EXTERNAL DLARAN, DLARND
158 * ..
159 *
160 *-----------------------------------------------------------------------
161 *
162 * .. Executable Statements ..
163 *
164 *
165 * Check for I and J in range
166 *
167 IF( I.LT.1 .OR. I.GT.M .OR. J.LT.1 .OR. J.GT.N ) THEN
168 DLATM2 = ZERO
169 RETURN
170 END IF
171 *
172 * Check for banding
173 *
174 IF( J.GT.I+KU .OR. J.LT.I-KL ) THEN
175 DLATM2 = ZERO
176 RETURN
177 END IF
178 *
179 * Check for sparsity
180 *
181 IF( SPARSE.GT.ZERO ) THEN
182 IF( DLARAN( ISEED ).LT.SPARSE ) THEN
183 DLATM2 = ZERO
184 RETURN
185 END IF
186 END IF
187 *
188 * Compute subscripts depending on IPVTNG
189 *
190 IF( IPVTNG.EQ.0 ) THEN
191 ISUB = I
192 JSUB = J
193 ELSE IF( IPVTNG.EQ.1 ) THEN
194 ISUB = IWORK( I )
195 JSUB = J
196 ELSE IF( IPVTNG.EQ.2 ) THEN
197 ISUB = I
198 JSUB = IWORK( J )
199 ELSE IF( IPVTNG.EQ.3 ) THEN
200 ISUB = IWORK( I )
201 JSUB = IWORK( J )
202 END IF
203 *
204 * Compute entry and grade it according to IGRADE
205 *
206 IF( ISUB.EQ.JSUB ) THEN
207 TEMP = D( ISUB )
208 ELSE
209 TEMP = DLARND( IDIST, ISEED )
210 END IF
211 IF( IGRADE.EQ.1 ) THEN
212 TEMP = TEMP*DL( ISUB )
213 ELSE IF( IGRADE.EQ.2 ) THEN
214 TEMP = TEMP*DR( JSUB )
215 ELSE IF( IGRADE.EQ.3 ) THEN
216 TEMP = TEMP*DL( ISUB )*DR( JSUB )
217 ELSE IF( IGRADE.EQ.4 .AND. ISUB.NE.JSUB ) THEN
218 TEMP = TEMP*DL( ISUB ) / DL( JSUB )
219 ELSE IF( IGRADE.EQ.5 ) THEN
220 TEMP = TEMP*DL( ISUB )*DL( JSUB )
221 END IF
222 DLATM2 = TEMP
223 RETURN
224 *
225 * End of DLATM2
226 *
227 END
2 $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE )
3 *
4 * -- LAPACK auxiliary test routine (version 3.1) --
5 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
6 * June 2010
7 *
8 * .. Scalar Arguments ..
9 *
10 INTEGER I, IDIST, IGRADE, IPVTNG, J, KL, KU, M, N
11 DOUBLE PRECISION SPARSE
12 * ..
13 *
14 * .. Array Arguments ..
15 *
16 INTEGER ISEED( 4 ), IWORK( * )
17 DOUBLE PRECISION D( * ), DL( * ), DR( * )
18 * ..
19 *
20 * Purpose
21 * =======
22 *
23 * DLATM2 returns the (I,J) entry of a random matrix of dimension
24 * (M, N) described by the other paramters. It is called by the
25 * DLATMR routine in order to build random test matrices. No error
26 * checking on parameters is done, because this routine is called in
27 * a tight loop by DLATMR which has already checked the parameters.
28 *
29 * Use of DLATM2 differs from SLATM3 in the order in which the random
30 * number generator is called to fill in random matrix entries.
31 * With DLATM2, the generator is called to fill in the pivoted matrix
32 * columnwise. With DLATM3, the generator is called to fill in the
33 * matrix columnwise, after which it is pivoted. Thus, DLATM3 can
34 * be used to construct random matrices which differ only in their
35 * order of rows and/or columns. DLATM2 is used to construct band
36 * matrices while avoiding calling the random number generator for
37 * entries outside the band (and therefore generating random numbers
38 *
39 * The matrix whose (I,J) entry is returned is constructed as
40 * follows (this routine only computes one entry):
41 *
42 * If I is outside (1..M) or J is outside (1..N), return zero
43 * (this is convenient for generating matrices in band format).
44 *
45 * Generate a matrix A with random entries of distribution IDIST.
46 *
47 * Set the diagonal to D.
48 *
49 * Grade the matrix, if desired, from the left (by DL) and/or
50 * from the right (by DR or DL) as specified by IGRADE.
51 *
52 * Permute, if desired, the rows and/or columns as specified by
53 * IPVTNG and IWORK.
54 *
55 * Band the matrix to have lower bandwidth KL and upper
56 * bandwidth KU.
57 *
58 * Set random entries to zero as specified by SPARSE.
59 *
60 * Arguments
61 * =========
62 *
63 * M (input) INTEGER
64 * Number of rows of matrix. Not modified.
65 *
66 * N (input) INTEGER
67 * Number of columns of matrix. Not modified.
68 *
69 * I (input) INTEGER
70 * Row of entry to be returned. Not modified.
71 *
72 * J (input) INTEGER
73 * Column of entry to be returned. Not modified.
74 *
75 * KL (input) INTEGER
76 * Lower bandwidth. Not modified.
77 *
78 * KU (input) INTEGER
79 * Upper bandwidth. Not modified.
80 *
81 * IDIST (input) INTEGER
82 * On entry, IDIST specifies the type of distribution to be
83 * used to generate a random matrix .
84 * 1 => UNIFORM( 0, 1 )
85 * 2 => UNIFORM( -1, 1 )
86 * 3 => NORMAL( 0, 1 )
87 * Not modified.
88 *
89 * ISEED (input/output) INTEGER array of dimension ( 4 )
90 * Seed for random number generator.
91 * Changed on exit.
92 *
93 * D (input) DOUBLE PRECISION array of dimension ( MIN( I , J ) )
94 * Diagonal entries of matrix. Not modified.
95 *
96 * IGRADE (input) INTEGER
97 * Specifies grading of matrix as follows:
98 * 0 => no grading
99 * 1 => matrix premultiplied by diag( DL )
100 * 2 => matrix postmultiplied by diag( DR )
101 * 3 => matrix premultiplied by diag( DL ) and
102 * postmultiplied by diag( DR )
103 * 4 => matrix premultiplied by diag( DL ) and
104 * postmultiplied by inv( diag( DL ) )
105 * 5 => matrix premultiplied by diag( DL ) and
106 * postmultiplied by diag( DL )
107 * Not modified.
108 *
109 * DL (input) DOUBLE PRECISION array ( I or J, as appropriate )
110 * Left scale factors for grading matrix. Not modified.
111 *
112 * DR (input) DOUBLE PRECISION array ( I or J, as appropriate )
113 * Right scale factors for grading matrix. Not modified.
114 *
115 * IPVTNG (input) INTEGER
116 * On entry specifies pivoting permutations as follows:
117 * 0 => none.
118 * 1 => row pivoting.
119 * 2 => column pivoting.
120 * 3 => full pivoting, i.e., on both sides.
121 * Not modified.
122 *
123 * IWORK (workspace) INTEGER array ( I or J, as appropriate )
124 * This array specifies the permutation used. The
125 * row (or column) in position K was originally in
126 * position IWORK( K ).
127 * This differs from IWORK for DLATM3. Not modified.
128 *
129 * SPARSE (input) DOUBLE PRECISION between 0. and 1.
130 * On entry specifies the sparsity of the matrix
131 * if sparse matix is to be generated.
132 * SPARSE should lie between 0 and 1.
133 * A uniform ( 0, 1 ) random number x is generated and
134 * compared to SPARSE; if x is larger the matrix entry
135 * is unchanged and if x is smaller the entry is set
136 * to zero. Thus on the average a fraction SPARSE of the
137 * entries will be set to zero.
138 * Not modified.
139 *
140 * =====================================================================
141 *
142 * .. Parameters ..
143 *
144 DOUBLE PRECISION ZERO
145 PARAMETER ( ZERO = 0.0D0 )
146 * ..
147 *
148 * .. Local Scalars ..
149 *
150 INTEGER ISUB, JSUB
151 DOUBLE PRECISION TEMP
152 * ..
153 *
154 * .. External Functions ..
155 *
156 DOUBLE PRECISION DLARAN, DLARND
157 EXTERNAL DLARAN, DLARND
158 * ..
159 *
160 *-----------------------------------------------------------------------
161 *
162 * .. Executable Statements ..
163 *
164 *
165 * Check for I and J in range
166 *
167 IF( I.LT.1 .OR. I.GT.M .OR. J.LT.1 .OR. J.GT.N ) THEN
168 DLATM2 = ZERO
169 RETURN
170 END IF
171 *
172 * Check for banding
173 *
174 IF( J.GT.I+KU .OR. J.LT.I-KL ) THEN
175 DLATM2 = ZERO
176 RETURN
177 END IF
178 *
179 * Check for sparsity
180 *
181 IF( SPARSE.GT.ZERO ) THEN
182 IF( DLARAN( ISEED ).LT.SPARSE ) THEN
183 DLATM2 = ZERO
184 RETURN
185 END IF
186 END IF
187 *
188 * Compute subscripts depending on IPVTNG
189 *
190 IF( IPVTNG.EQ.0 ) THEN
191 ISUB = I
192 JSUB = J
193 ELSE IF( IPVTNG.EQ.1 ) THEN
194 ISUB = IWORK( I )
195 JSUB = J
196 ELSE IF( IPVTNG.EQ.2 ) THEN
197 ISUB = I
198 JSUB = IWORK( J )
199 ELSE IF( IPVTNG.EQ.3 ) THEN
200 ISUB = IWORK( I )
201 JSUB = IWORK( J )
202 END IF
203 *
204 * Compute entry and grade it according to IGRADE
205 *
206 IF( ISUB.EQ.JSUB ) THEN
207 TEMP = D( ISUB )
208 ELSE
209 TEMP = DLARND( IDIST, ISEED )
210 END IF
211 IF( IGRADE.EQ.1 ) THEN
212 TEMP = TEMP*DL( ISUB )
213 ELSE IF( IGRADE.EQ.2 ) THEN
214 TEMP = TEMP*DR( JSUB )
215 ELSE IF( IGRADE.EQ.3 ) THEN
216 TEMP = TEMP*DL( ISUB )*DR( JSUB )
217 ELSE IF( IGRADE.EQ.4 .AND. ISUB.NE.JSUB ) THEN
218 TEMP = TEMP*DL( ISUB ) / DL( JSUB )
219 ELSE IF( IGRADE.EQ.5 ) THEN
220 TEMP = TEMP*DL( ISUB )*DL( JSUB )
221 END IF
222 DLATM2 = TEMP
223 RETURN
224 *
225 * End of DLATM2
226 *
227 END