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