1 SUBROUTINE DLATB9( PATH, IMAT, M, P, N, TYPE, KLA, KUA, KLB, KUB,
2 $ ANORM, BNORM, MODEA, MODEB, CNDNMA, CNDNMB,
3 $ DISTA, DISTB )
4 *
5 * -- LAPACK test routine (version 3.1) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * November 2006
8 *
9 * .. Scalar Arguments ..
10 CHARACTER DISTA, DISTB, TYPE
11 CHARACTER*3 PATH
12 INTEGER IMAT, KLA, KLB, KUA, KUB, M, MODEA, MODEB, N, P
13 DOUBLE PRECISION ANORM, BNORM, CNDNMA, CNDNMB
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * DLATB9 sets parameters for the matrix generator based on the type of
20 * matrix to be generated.
21 *
22 * Arguments
23 * =========
24 *
25 * PATH (input) CHARACTER*3
26 * The LAPACK path name.
27 *
28 * IMAT (input) INTEGER
29 * An integer key describing which matrix to generate for this
30 * path.
31 *
32 * M (input) INTEGER
33 * The number of rows in the matrix to be generated.
34 *
35 * N (input) INTEGER
36 * The number of columns in the matrix to be generated.
37 *
38 * TYPE (output) CHARACTER*1
39 * The type of the matrix to be generated:
40 * = 'S': symmetric matrix;
41 * = 'P': symmetric positive (semi)definite matrix;
42 * = 'N': nonsymmetric matrix.
43 *
44 * KL (output) INTEGER
45 * The lower band width of the matrix to be generated.
46 *
47 * KU (output) INTEGER
48 * The upper band width of the matrix to be generated.
49 *
50 * ANORM (output) DOUBLE PRECISION
51 * The desired norm of the matrix to be generated. The diagonal
52 * matrix of singular values or eigenvalues is scaled by this
53 * value.
54 *
55 * MODE (output) INTEGER
56 * A key indicating how to choose the vector of eigenvalues.
57 *
58 * CNDNUM (output) DOUBLE PRECISION
59 * The desired condition number.
60 *
61 * DIST (output) CHARACTER*1
62 * The type of distribution to be used by the random number
63 * generator.
64 *
65 * =====================================================================
66 *
67 * .. Parameters ..
68 DOUBLE PRECISION SHRINK, TENTH
69 PARAMETER ( SHRINK = 0.25D0, TENTH = 0.1D+0 )
70 DOUBLE PRECISION ONE, TEN
71 PARAMETER ( ONE = 1.0D+0, TEN = 1.0D+1 )
72 * ..
73 * .. Local Scalars ..
74 LOGICAL FIRST
75 DOUBLE PRECISION BADC1, BADC2, EPS, LARGE, SMALL
76 * ..
77 * .. External Functions ..
78 LOGICAL LSAMEN
79 DOUBLE PRECISION DLAMCH
80 EXTERNAL LSAMEN, DLAMCH
81 * ..
82 * .. Intrinsic Functions ..
83 INTRINSIC MAX, SQRT
84 * ..
85 * .. External Subroutines ..
86 EXTERNAL DLABAD
87 * ..
88 * .. Save statement ..
89 SAVE EPS, SMALL, LARGE, BADC1, BADC2, FIRST
90 * ..
91 * .. Data statements ..
92 DATA FIRST / .TRUE. /
93 * ..
94 * .. Executable Statements ..
95 *
96 * Set some constants for use in the subroutine.
97 *
98 IF( FIRST ) THEN
99 FIRST = .FALSE.
100 EPS = DLAMCH( 'Precision' )
101 BADC2 = TENTH / EPS
102 BADC1 = SQRT( BADC2 )
103 SMALL = DLAMCH( 'Safe minimum' )
104 LARGE = ONE / SMALL
105 *
106 * If it looks like we're on a Cray, take the square root of
107 * SMALL and LARGE to avoid overflow and underflow problems.
108 *
109 CALL DLABAD( SMALL, LARGE )
110 SMALL = SHRINK*( SMALL / EPS )
111 LARGE = ONE / SMALL
112 END IF
113 *
114 * Set some parameters we don't plan to change.
115 *
116 TYPE = 'N'
117 DISTA = 'S'
118 DISTB = 'S'
119 MODEA = 3
120 MODEB = 4
121 *
122 * Set the lower and upper bandwidths.
123 *
124 IF( LSAMEN( 3, PATH, 'GRQ' ) .OR. LSAMEN( 3, PATH, 'LSE' ) .OR.
125 $ LSAMEN( 3, PATH, 'GSV' ) ) THEN
126 *
127 * A: M by N, B: P by N
128 *
129 IF( IMAT.EQ.1 ) THEN
130 *
131 * A: diagonal, B: upper triangular
132 *
133 KLA = 0
134 KUA = 0
135 KLB = 0
136 KUB = MAX( N-1, 0 )
137 *
138 ELSE IF( IMAT.EQ.2 ) THEN
139 *
140 * A: upper triangular, B: upper triangular
141 *
142 KLA = 0
143 KUA = MAX( N-1, 0 )
144 KLB = 0
145 KUB = MAX( N-1, 0 )
146 *
147 ELSE IF( IMAT.EQ.3 ) THEN
148 *
149 * A: lower triangular, B: upper triangular
150 *
151 KLA = MAX( M-1, 0 )
152 KUA = 0
153 KLB = 0
154 KUB = MAX( N-1, 0 )
155 *
156 ELSE
157 *
158 * A: general dense, B: general dense
159 *
160 KLA = MAX( M-1, 0 )
161 KUA = MAX( N-1, 0 )
162 KLB = MAX( P-1, 0 )
163 KUB = MAX( N-1, 0 )
164 *
165 END IF
166 *
167 ELSE IF( LSAMEN( 3, PATH, 'GQR' ) .OR. LSAMEN( 3, PATH, 'GLM' ) )
168 $ THEN
169 *
170 * A: N by M, B: N by P
171 *
172 IF( IMAT.EQ.1 ) THEN
173 *
174 * A: diagonal, B: lower triangular
175 *
176 KLA = 0
177 KUA = 0
178 KLB = MAX( N-1, 0 )
179 KUB = 0
180 ELSE IF( IMAT.EQ.2 ) THEN
181 *
182 * A: lower triangular, B: diagonal
183 *
184 KLA = MAX( N-1, 0 )
185 KUA = 0
186 KLB = 0
187 KUB = 0
188 *
189 ELSE IF( IMAT.EQ.3 ) THEN
190 *
191 * A: lower triangular, B: upper triangular
192 *
193 KLA = MAX( N-1, 0 )
194 KUA = 0
195 KLB = 0
196 KUB = MAX( P-1, 0 )
197 *
198 ELSE
199 *
200 * A: general dense, B: general dense
201 *
202 KLA = MAX( N-1, 0 )
203 KUA = MAX( M-1, 0 )
204 KLB = MAX( N-1, 0 )
205 KUB = MAX( P-1, 0 )
206 END IF
207 *
208 END IF
209 *
210 * Set the condition number and norm.
211 *
212 CNDNMA = TEN*TEN
213 CNDNMB = TEN
214 IF( LSAMEN( 3, PATH, 'GQR' ) .OR. LSAMEN( 3, PATH, 'GRQ' ) .OR.
215 $ LSAMEN( 3, PATH, 'GSV' ) ) THEN
216 IF( IMAT.EQ.5 ) THEN
217 CNDNMA = BADC1
218 CNDNMB = BADC1
219 ELSE IF( IMAT.EQ.6 ) THEN
220 CNDNMA = BADC2
221 CNDNMB = BADC2
222 ELSE IF( IMAT.EQ.7 ) THEN
223 CNDNMA = BADC1
224 CNDNMB = BADC2
225 ELSE IF( IMAT.EQ.8 ) THEN
226 CNDNMA = BADC2
227 CNDNMB = BADC1
228 END IF
229 END IF
230 *
231 ANORM = TEN
232 BNORM = TEN*TEN*TEN
233 IF( LSAMEN( 3, PATH, 'GQR' ) .OR. LSAMEN( 3, PATH, 'GRQ' ) ) THEN
234 IF( IMAT.EQ.7 ) THEN
235 ANORM = SMALL
236 BNORM = LARGE
237 ELSE IF( IMAT.EQ.8 ) THEN
238 ANORM = LARGE
239 BNORM = SMALL
240 END IF
241 END IF
242 *
243 IF( N.LE.1 ) THEN
244 CNDNMA = ONE
245 CNDNMB = ONE
246 END IF
247 *
248 RETURN
249 *
250 * End of DLATB9
251 *
252 END
2 $ ANORM, BNORM, MODEA, MODEB, CNDNMA, CNDNMB,
3 $ DISTA, DISTB )
4 *
5 * -- LAPACK test routine (version 3.1) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * November 2006
8 *
9 * .. Scalar Arguments ..
10 CHARACTER DISTA, DISTB, TYPE
11 CHARACTER*3 PATH
12 INTEGER IMAT, KLA, KLB, KUA, KUB, M, MODEA, MODEB, N, P
13 DOUBLE PRECISION ANORM, BNORM, CNDNMA, CNDNMB
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * DLATB9 sets parameters for the matrix generator based on the type of
20 * matrix to be generated.
21 *
22 * Arguments
23 * =========
24 *
25 * PATH (input) CHARACTER*3
26 * The LAPACK path name.
27 *
28 * IMAT (input) INTEGER
29 * An integer key describing which matrix to generate for this
30 * path.
31 *
32 * M (input) INTEGER
33 * The number of rows in the matrix to be generated.
34 *
35 * N (input) INTEGER
36 * The number of columns in the matrix to be generated.
37 *
38 * TYPE (output) CHARACTER*1
39 * The type of the matrix to be generated:
40 * = 'S': symmetric matrix;
41 * = 'P': symmetric positive (semi)definite matrix;
42 * = 'N': nonsymmetric matrix.
43 *
44 * KL (output) INTEGER
45 * The lower band width of the matrix to be generated.
46 *
47 * KU (output) INTEGER
48 * The upper band width of the matrix to be generated.
49 *
50 * ANORM (output) DOUBLE PRECISION
51 * The desired norm of the matrix to be generated. The diagonal
52 * matrix of singular values or eigenvalues is scaled by this
53 * value.
54 *
55 * MODE (output) INTEGER
56 * A key indicating how to choose the vector of eigenvalues.
57 *
58 * CNDNUM (output) DOUBLE PRECISION
59 * The desired condition number.
60 *
61 * DIST (output) CHARACTER*1
62 * The type of distribution to be used by the random number
63 * generator.
64 *
65 * =====================================================================
66 *
67 * .. Parameters ..
68 DOUBLE PRECISION SHRINK, TENTH
69 PARAMETER ( SHRINK = 0.25D0, TENTH = 0.1D+0 )
70 DOUBLE PRECISION ONE, TEN
71 PARAMETER ( ONE = 1.0D+0, TEN = 1.0D+1 )
72 * ..
73 * .. Local Scalars ..
74 LOGICAL FIRST
75 DOUBLE PRECISION BADC1, BADC2, EPS, LARGE, SMALL
76 * ..
77 * .. External Functions ..
78 LOGICAL LSAMEN
79 DOUBLE PRECISION DLAMCH
80 EXTERNAL LSAMEN, DLAMCH
81 * ..
82 * .. Intrinsic Functions ..
83 INTRINSIC MAX, SQRT
84 * ..
85 * .. External Subroutines ..
86 EXTERNAL DLABAD
87 * ..
88 * .. Save statement ..
89 SAVE EPS, SMALL, LARGE, BADC1, BADC2, FIRST
90 * ..
91 * .. Data statements ..
92 DATA FIRST / .TRUE. /
93 * ..
94 * .. Executable Statements ..
95 *
96 * Set some constants for use in the subroutine.
97 *
98 IF( FIRST ) THEN
99 FIRST = .FALSE.
100 EPS = DLAMCH( 'Precision' )
101 BADC2 = TENTH / EPS
102 BADC1 = SQRT( BADC2 )
103 SMALL = DLAMCH( 'Safe minimum' )
104 LARGE = ONE / SMALL
105 *
106 * If it looks like we're on a Cray, take the square root of
107 * SMALL and LARGE to avoid overflow and underflow problems.
108 *
109 CALL DLABAD( SMALL, LARGE )
110 SMALL = SHRINK*( SMALL / EPS )
111 LARGE = ONE / SMALL
112 END IF
113 *
114 * Set some parameters we don't plan to change.
115 *
116 TYPE = 'N'
117 DISTA = 'S'
118 DISTB = 'S'
119 MODEA = 3
120 MODEB = 4
121 *
122 * Set the lower and upper bandwidths.
123 *
124 IF( LSAMEN( 3, PATH, 'GRQ' ) .OR. LSAMEN( 3, PATH, 'LSE' ) .OR.
125 $ LSAMEN( 3, PATH, 'GSV' ) ) THEN
126 *
127 * A: M by N, B: P by N
128 *
129 IF( IMAT.EQ.1 ) THEN
130 *
131 * A: diagonal, B: upper triangular
132 *
133 KLA = 0
134 KUA = 0
135 KLB = 0
136 KUB = MAX( N-1, 0 )
137 *
138 ELSE IF( IMAT.EQ.2 ) THEN
139 *
140 * A: upper triangular, B: upper triangular
141 *
142 KLA = 0
143 KUA = MAX( N-1, 0 )
144 KLB = 0
145 KUB = MAX( N-1, 0 )
146 *
147 ELSE IF( IMAT.EQ.3 ) THEN
148 *
149 * A: lower triangular, B: upper triangular
150 *
151 KLA = MAX( M-1, 0 )
152 KUA = 0
153 KLB = 0
154 KUB = MAX( N-1, 0 )
155 *
156 ELSE
157 *
158 * A: general dense, B: general dense
159 *
160 KLA = MAX( M-1, 0 )
161 KUA = MAX( N-1, 0 )
162 KLB = MAX( P-1, 0 )
163 KUB = MAX( N-1, 0 )
164 *
165 END IF
166 *
167 ELSE IF( LSAMEN( 3, PATH, 'GQR' ) .OR. LSAMEN( 3, PATH, 'GLM' ) )
168 $ THEN
169 *
170 * A: N by M, B: N by P
171 *
172 IF( IMAT.EQ.1 ) THEN
173 *
174 * A: diagonal, B: lower triangular
175 *
176 KLA = 0
177 KUA = 0
178 KLB = MAX( N-1, 0 )
179 KUB = 0
180 ELSE IF( IMAT.EQ.2 ) THEN
181 *
182 * A: lower triangular, B: diagonal
183 *
184 KLA = MAX( N-1, 0 )
185 KUA = 0
186 KLB = 0
187 KUB = 0
188 *
189 ELSE IF( IMAT.EQ.3 ) THEN
190 *
191 * A: lower triangular, B: upper triangular
192 *
193 KLA = MAX( N-1, 0 )
194 KUA = 0
195 KLB = 0
196 KUB = MAX( P-1, 0 )
197 *
198 ELSE
199 *
200 * A: general dense, B: general dense
201 *
202 KLA = MAX( N-1, 0 )
203 KUA = MAX( M-1, 0 )
204 KLB = MAX( N-1, 0 )
205 KUB = MAX( P-1, 0 )
206 END IF
207 *
208 END IF
209 *
210 * Set the condition number and norm.
211 *
212 CNDNMA = TEN*TEN
213 CNDNMB = TEN
214 IF( LSAMEN( 3, PATH, 'GQR' ) .OR. LSAMEN( 3, PATH, 'GRQ' ) .OR.
215 $ LSAMEN( 3, PATH, 'GSV' ) ) THEN
216 IF( IMAT.EQ.5 ) THEN
217 CNDNMA = BADC1
218 CNDNMB = BADC1
219 ELSE IF( IMAT.EQ.6 ) THEN
220 CNDNMA = BADC2
221 CNDNMB = BADC2
222 ELSE IF( IMAT.EQ.7 ) THEN
223 CNDNMA = BADC1
224 CNDNMB = BADC2
225 ELSE IF( IMAT.EQ.8 ) THEN
226 CNDNMA = BADC2
227 CNDNMB = BADC1
228 END IF
229 END IF
230 *
231 ANORM = TEN
232 BNORM = TEN*TEN*TEN
233 IF( LSAMEN( 3, PATH, 'GQR' ) .OR. LSAMEN( 3, PATH, 'GRQ' ) ) THEN
234 IF( IMAT.EQ.7 ) THEN
235 ANORM = SMALL
236 BNORM = LARGE
237 ELSE IF( IMAT.EQ.8 ) THEN
238 ANORM = LARGE
239 BNORM = SMALL
240 END IF
241 END IF
242 *
243 IF( N.LE.1 ) THEN
244 CNDNMA = ONE
245 CNDNMB = ONE
246 END IF
247 *
248 RETURN
249 *
250 * End of DLATB9
251 *
252 END