LAPACK 3.11.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches
slatb9.f
Go to the documentation of this file.
1*> \brief \b SLATB9
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8* Definition:
9* ===========
10*
11* SUBROUTINE SLATB9( PATH, IMAT, M, P, N, TYPE, KLA, KUA,
12* KLB, KUB, ANORM, BNORM, MODEA, MODEB,
13* CNDNMA, CNDNMB, DISTA, DISTB )
14*
15* .. Scalar Arguments ..
16* CHARACTER DISTA, DISTB, TYPE
17* CHARACTER*3 PATH
18* INTEGER IMAT, KLA, KUA, KLB, KUB, M, P, MODEA, MODEB, N
19* REAL ANORM, BNORM, CNDNMA, CNDNMB
20* ..
21*
22*
23*> \par Purpose:
24* =============
25*>
26*> \verbatim
27*>
28*> SLATB9 sets parameters for the matrix generator based on the type of
29*> matrix to be generated.
30*> \endverbatim
31*
32* Arguments:
33* ==========
34*
35*> \param[in] PATH
36*> \verbatim
37*> PATH is CHARACTER*3
38*> The LAPACK path name.
39*> \endverbatim
40*>
41*> \param[in] IMAT
42*> \verbatim
43*> IMAT is INTEGER
44*> An integer key describing which matrix to generate for this
45*> path.
46*> = 1: A: diagonal, B: upper triangular
47*> = 2: A: upper triangular, B: upper triangular
48*> = 3: A: lower triangular, B: upper triangular
49*> Else: A: general dense, B: general dense
50*> \endverbatim
51*>
52*> \param[in] M
53*> \verbatim
54*> M is INTEGER
55*> The number of rows in the matrix to be generated.
56*> \endverbatim
57*>
58*> \param[in] P
59*> \verbatim
60*> P is INTEGER
61*> \endverbatim
62*>
63*> \param[in] N
64*> \verbatim
65*> N is INTEGER
66*> The number of columns in the matrix to be generated.
67*> \endverbatim
68*>
69*> \param[out] TYPE
70*> \verbatim
71*> TYPE is CHARACTER*1
72*> The type of the matrix to be generated:
73*> = 'S': symmetric matrix;
74*> = 'P': symmetric positive (semi)definite matrix;
75*> = 'N': nonsymmetric matrix.
76*> \endverbatim
77*>
78*> \param[out] KLA
79*> \verbatim
80*> KLA is INTEGER
81*> The lower band width of the matrix to be generated.
82*> \endverbatim
83*>
84*> \param[out] KUA
85*> \verbatim
86*> KUA is INTEGER
87*> The upper band width of the matrix to be generated.
88*> \endverbatim
89*>
90*> \param[out] KLB
91*> \verbatim
92*> KLB is INTEGER
93*> The lower band width of the matrix to be generated.
94*> \endverbatim
95*>
96*> \param[out] KUB
97*> \verbatim
98*> KUA is INTEGER
99*> The upper band width of the matrix to be generated.
100*> \endverbatim
101*>
102*> \param[out] ANORM
103*> \verbatim
104*> ANORM is REAL
105*> The desired norm of the matrix to be generated. The diagonal
106*> matrix of singular values or eigenvalues is scaled by this
107*> value.
108*> \endverbatim
109*>
110*> \param[out] BNORM
111*> \verbatim
112*> BNORM is REAL
113*> The desired norm of the matrix to be generated. The diagonal
114*> matrix of singular values or eigenvalues is scaled by this
115*> value.
116*> \endverbatim
117*>
118*> \param[out] MODEA
119*> \verbatim
120*> MODEA is INTEGER
121*> A key indicating how to choose the vector of eigenvalues.
122*> \endverbatim
123*>
124*> \param[out] MODEB
125*> \verbatim
126*> MODEB is INTEGER
127*> A key indicating how to choose the vector of eigenvalues.
128*> \endverbatim
129*>
130*> \param[out] CNDNMA
131*> \verbatim
132*> CNDNMA is REAL
133*> The desired condition number.
134*> \endverbatim
135*>
136*> \param[out] CNDNMB
137*> \verbatim
138*> CNDNMB is REAL
139*> The desired condition number.
140*> \endverbatim
141*>
142*> \param[out] DISTA
143*> \verbatim
144*> DISTA is CHARACTER*1
145*> The type of distribution to be used by the random number
146*> generator.
147*> \endverbatim
148*>
149*> \param[out] DISTB
150*> \verbatim
151*> DISTB is CHARACTER*1
152*> The type of distribution to be used by the random number
153*> generator.
154*> \endverbatim
155*
156* Authors:
157* ========
158*
159*> \author Univ. of Tennessee
160*> \author Univ. of California Berkeley
161*> \author Univ. of Colorado Denver
162*> \author NAG Ltd.
163*
164*> \ingroup single_eig
165*
166* =====================================================================
167 SUBROUTINE slatb9( PATH, IMAT, M, P, N, TYPE, KLA, KUA,
168 \$ KLB, KUB, ANORM, BNORM, MODEA, MODEB,
169 \$ CNDNMA, CNDNMB, DISTA, DISTB )
170*
171* -- LAPACK test routine --
172* -- LAPACK is a software package provided by Univ. of Tennessee, --
173* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
174*
175* .. Scalar Arguments ..
176 CHARACTER DISTA, DISTB, TYPE
177 CHARACTER*3 PATH
178 INTEGER IMAT, KLA, KUA, KLB, KUB, M, P, MODEA, MODEB, N
179 REAL ANORM, BNORM, CNDNMA, CNDNMB
180* ..
181*
182* =====================================================================
183*
184* .. Parameters ..
185 REAL SHRINK, TENTH
186 PARAMETER ( SHRINK = 0.25e0, tenth = 0.1e+0 )
187 REAL ONE, TEN
188 parameter( one = 1.0e+0, ten = 1.0e+1 )
189* ..
190* .. Local Scalars ..
191 LOGICAL FIRST
193* ..
194* .. External Functions ..
195 LOGICAL LSAMEN
196 REAL SLAMCH
197 EXTERNAL lsamen, slamch
198* ..
199* .. Intrinsic Functions ..
200 INTRINSIC max, sqrt
201* ..
202* .. External Subroutines ..
204* ..
205* .. Save statement ..
207* ..
208* .. Data statements ..
209 DATA first / .true. /
210* ..
211* .. Executable Statements ..
212*
213* Set some constants for use in the subroutine.
214*
215 IF( first ) THEN
216 first = .false.
217 eps = slamch( 'Precision' )
218 badc2 = tenth / eps
220 small = slamch( 'Safe minimum' )
221 large = one / small
222*
223* If it looks like we're on a Cray, take the square root of
224* SMALL and LARGE to avoid overflow and underflow problems.
225*
226 CALL slabad( small, large )
227 small = shrink*( small / eps )
228 large = one / small
229 END IF
230*
231* Set some parameters we don't plan to change.
232*
233 TYPE = 'N'
234 dista = 'S'
235 distb = 'S'
236 modea = 3
237 modeb = 4
238*
239* Set the lower and upper bandwidths.
240*
241 IF( lsamen( 3, path, 'GRQ') .OR. lsamen( 3, path, 'LSE') .OR.
242 \$ lsamen( 3, path, 'GSV') )THEN
243*
244* A: M by N, B: P by N
245*
246 IF( imat.EQ.1 ) THEN
247*
248* A: diagonal, B: upper triangular
249*
250 kla = 0
251 kua = 0
252 klb = 0
253 kub = max( n-1,0 )
254*
255 ELSE IF( imat.EQ.2 ) THEN
256*
257* A: upper triangular, B: upper triangular
258*
259 kla = 0
260 kua = max( n-1, 0 )
261 klb = 0
262 kub = max( n-1, 0 )
263*
264 ELSE IF( imat.EQ.3 ) THEN
265*
266* A: lower triangular, B: upper triangular
267*
268 kla = max( m-1, 0 )
269 kua = 0
270 klb = 0
271 kub = max( n-1, 0 )
272*
273 ELSE
274*
275* A: general dense, B: general dense
276*
277 kla = max( m-1, 0 )
278 kua = max( n-1, 0 )
279 klb = max( p-1, 0 )
280 kub = max( n-1, 0 )
281*
282 END IF
283*
284 ELSE IF( lsamen( 3, path, 'GQR' ) .OR.
285 \$ lsamen( 3, path, 'GLM') )THEN
286*
287* A: N by M, B: N by P
288*
289 IF( imat.EQ.1 ) THEN
290*
291* A: diagonal, B: lower triangular
292*
293 kla = 0
294 kua = 0
295 klb = max( n-1,0 )
296 kub = 0
297 ELSE IF( imat.EQ.2 ) THEN
298*
299* A: lower triangular, B: diagonal
300*
301 kla = max( n-1, 0 )
302 kua = 0
303 klb = 0
304 kub = 0
305*
306 ELSE IF( imat.EQ.3 ) THEN
307*
308* A: lower triangular, B: upper triangular
309*
310 kla = max( n-1, 0 )
311 kua = 0
312 klb = 0
313 kub = max( p-1, 0 )
314*
315 ELSE
316*
317* A: general dense, B: general dense
318*
319 kla = max( n-1, 0 )
320 kua = max( m-1, 0 )
321 klb = max( n-1, 0 )
322 kub = max( p-1, 0 )
323 END IF
324*
325 END IF
326*
327* Set the condition number and norm.
328*
329 cndnma = ten*ten
330 cndnmb = ten
331 IF( lsamen( 3, path, 'GQR') .OR. lsamen( 3, path, 'GRQ') .OR.
332 \$ lsamen( 3, path, 'GSV') )THEN
333 IF( imat.EQ.5 ) THEN
336 ELSE IF( imat.EQ.6 ) THEN
339 ELSE IF( imat.EQ.7 ) THEN
342 ELSE IF( imat.EQ.8 ) THEN
345 END IF
346 END IF
347*
348 anorm = ten
349 bnorm = ten*ten*ten
350 IF( lsamen( 3, path, 'GQR') .OR. lsamen( 3, path, 'GRQ') )THEN
351 IF( imat.EQ.7 ) THEN
352 anorm = small
353 bnorm = large
354 ELSE IF( imat.EQ.8 ) THEN
355 anorm = large
356 bnorm = small
357 END IF
358 END IF
359*
360 IF( n.LE.1 )THEN
361 cndnma = one
362 cndnmb = one
363 END IF
364*
365 RETURN
366*
367* End of SLATB9
368*
369 END