LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
clatb4.f
Go to the documentation of this file.
1*> \brief \b CLATB4
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 CLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE,
12* CNDNUM, DIST )
13*
14* .. Scalar Arguments ..
15* CHARACTER DIST, TYPE
16* CHARACTER*3 PATH
17* INTEGER IMAT, KL, KU, M, MODE, N
18* REAL ANORM, CNDNUM
19* ..
20*
21*
22*> \par Purpose:
23* =============
24*>
25*> \verbatim
26*>
27*> CLATB4 sets parameters for the matrix generator based on the type of
28*> matrix to be generated.
29*> \endverbatim
30*
31* Arguments:
32* ==========
33*
34*> \param[in] PATH
35*> \verbatim
36*> PATH is CHARACTER*3
37*> The LAPACK path name.
38*> \endverbatim
39*>
40*> \param[in] IMAT
41*> \verbatim
42*> IMAT is INTEGER
43*> An integer key describing which matrix to generate for this
44*> path.
45*> \endverbatim
46*>
47*> \param[in] M
48*> \verbatim
49*> M is INTEGER
50*> The number of rows in the matrix to be generated.
51*> \endverbatim
52*>
53*> \param[in] N
54*> \verbatim
55*> N is INTEGER
56*> The number of columns in the matrix to be generated.
57*> \endverbatim
58*>
59*> \param[out] TYPE
60*> \verbatim
61*> TYPE is CHARACTER*1
62*> The type of the matrix to be generated:
63*> = 'S': symmetric matrix
64*> = 'H': Hermitian matrix
65*> = 'P': Hermitian positive (semi)definite matrix
66*> = 'N': nonsymmetric matrix
67*> \endverbatim
68*>
69*> \param[out] KL
70*> \verbatim
71*> KL is INTEGER
72*> The lower band width of the matrix to be generated.
73*> \endverbatim
74*>
75*> \param[out] KU
76*> \verbatim
77*> KU is INTEGER
78*> The upper band width of the matrix to be generated.
79*> \endverbatim
80*>
81*> \param[out] ANORM
82*> \verbatim
83*> ANORM is REAL
84*> The desired norm of the matrix to be generated. The diagonal
85*> matrix of singular values or eigenvalues is scaled by this
86*> value.
87*> \endverbatim
88*>
89*> \param[out] MODE
90*> \verbatim
91*> MODE is INTEGER
92*> A key indicating how to choose the vector of eigenvalues.
93*> \endverbatim
94*>
95*> \param[out] CNDNUM
96*> \verbatim
97*> CNDNUM is REAL
98*> The desired condition number.
99*> \endverbatim
100*>
101*> \param[out] DIST
102*> \verbatim
103*> DIST is CHARACTER*1
104*> The type of distribution to be used by the random number
105*> generator.
106*> \endverbatim
107*
108* Authors:
109* ========
110*
111*> \author Univ. of Tennessee
112*> \author Univ. of California Berkeley
113*> \author Univ. of Colorado Denver
114*> \author NAG Ltd.
115*
116*> \ingroup complex_lin
117*
118* =====================================================================
119 SUBROUTINE clatb4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE,
120 $ CNDNUM, DIST )
121*
122* -- LAPACK test routine --
123* -- LAPACK is a software package provided by Univ. of Tennessee, --
124* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
125*
126* .. Scalar Arguments ..
127 CHARACTER DIST, TYPE
128 CHARACTER*3 PATH
129 INTEGER IMAT, KL, KU, M, MODE, N
130 REAL ANORM, CNDNUM
131* ..
132*
133* =====================================================================
134*
135* .. Parameters ..
136 REAL SHRINK, TENTH
137 parameter( shrink = 0.25e0, tenth = 0.1e+0 )
138 REAL ONE
139 parameter( one = 1.0e+0 )
140 REAL TWO
141 parameter( two = 2.0e+0 )
142* ..
143* .. Local Scalars ..
144 LOGICAL FIRST
145 CHARACTER*2 C2
146 INTEGER MAT
147 REAL BADC1, BADC2, EPS, LARGE, SMALL
148* ..
149* .. External Functions ..
150 LOGICAL LSAMEN
151 REAL SLAMCH
152 EXTERNAL lsamen, slamch
153* ..
154* .. Intrinsic Functions ..
155 INTRINSIC abs, max, sqrt
156* ..
157* .. External Subroutines ..
158 EXTERNAL slabad
159* ..
160* .. Save statement ..
161 SAVE eps, small, large, badc1, badc2, first
162* ..
163* .. Data statements ..
164 DATA first / .true. /
165* ..
166* .. Executable Statements ..
167*
168* Set some constants for use in the subroutine.
169*
170 IF( first ) THEN
171 first = .false.
172 eps = slamch( 'Precision' )
173 badc2 = tenth / eps
174 badc1 = sqrt( badc2 )
175 small = slamch( 'Safe minimum' )
176 large = one / small
177*
178* If it looks like we're on a Cray, take the square root of
179* SMALL and LARGE to avoid overflow and underflow problems.
180*
181 CALL slabad( small, large )
182 small = shrink*( small / eps )
183 large = one / small
184 END IF
185*
186 c2 = path( 2: 3 )
187*
188* Set some parameters we don't plan to change.
189*
190 dist = 'S'
191 mode = 3
192*
193* xQR, xLQ, xQL, xRQ: Set parameters to generate a general
194* M x N matrix.
195*
196 IF( lsamen( 2, c2, 'QR' ) .OR. lsamen( 2, c2, 'LQ' ) .OR.
197 $ lsamen( 2, c2, 'QL' ) .OR. lsamen( 2, c2, 'RQ' ) ) THEN
198*
199* Set TYPE, the type of matrix to be generated.
200*
201 TYPE = 'N'
202*
203* Set the lower and upper bandwidths.
204*
205 IF( imat.EQ.1 ) THEN
206 kl = 0
207 ku = 0
208 ELSE IF( imat.EQ.2 ) THEN
209 kl = 0
210 ku = max( n-1, 0 )
211 ELSE IF( imat.EQ.3 ) THEN
212 kl = max( m-1, 0 )
213 ku = 0
214 ELSE
215 kl = max( m-1, 0 )
216 ku = max( n-1, 0 )
217 END IF
218*
219* Set the condition number and norm.
220*
221 IF( imat.EQ.5 ) THEN
222 cndnum = badc1
223 ELSE IF( imat.EQ.6 ) THEN
224 cndnum = badc2
225 ELSE
226 cndnum = two
227 END IF
228*
229 IF( imat.EQ.7 ) THEN
230 anorm = small
231 ELSE IF( imat.EQ.8 ) THEN
232 anorm = large
233 ELSE
234 anorm = one
235 END IF
236*
237 ELSE IF( lsamen( 2, c2, 'GE' ) ) THEN
238*
239* xGE: Set parameters to generate a general M x N matrix.
240*
241* Set TYPE, the type of matrix to be generated.
242*
243 TYPE = 'N'
244*
245* Set the lower and upper bandwidths.
246*
247 IF( imat.EQ.1 ) THEN
248 kl = 0
249 ku = 0
250 ELSE IF( imat.EQ.2 ) THEN
251 kl = 0
252 ku = max( n-1, 0 )
253 ELSE IF( imat.EQ.3 ) THEN
254 kl = max( m-1, 0 )
255 ku = 0
256 ELSE
257 kl = max( m-1, 0 )
258 ku = max( n-1, 0 )
259 END IF
260*
261* Set the condition number and norm.
262*
263 IF( imat.EQ.8 ) THEN
264 cndnum = badc1
265 ELSE IF( imat.EQ.9 ) THEN
266 cndnum = badc2
267 ELSE
268 cndnum = two
269 END IF
270*
271 IF( imat.EQ.10 ) THEN
272 anorm = small
273 ELSE IF( imat.EQ.11 ) THEN
274 anorm = large
275 ELSE
276 anorm = one
277 END IF
278*
279 ELSE IF( lsamen( 2, c2, 'GB' ) ) THEN
280*
281* xGB: Set parameters to generate a general banded matrix.
282*
283* Set TYPE, the type of matrix to be generated.
284*
285 TYPE = 'N'
286*
287* Set the condition number and norm.
288*
289 IF( imat.EQ.5 ) THEN
290 cndnum = badc1
291 ELSE IF( imat.EQ.6 ) THEN
292 cndnum = tenth*badc2
293 ELSE
294 cndnum = two
295 END IF
296*
297 IF( imat.EQ.7 ) THEN
298 anorm = small
299 ELSE IF( imat.EQ.8 ) THEN
300 anorm = large
301 ELSE
302 anorm = one
303 END IF
304*
305 ELSE IF( lsamen( 2, c2, 'GT' ) ) THEN
306*
307* xGT: Set parameters to generate a general tridiagonal matrix.
308*
309* Set TYPE, the type of matrix to be generated.
310*
311 TYPE = 'N'
312*
313* Set the lower and upper bandwidths.
314*
315 IF( imat.EQ.1 ) THEN
316 kl = 0
317 ELSE
318 kl = 1
319 END IF
320 ku = kl
321*
322* Set the condition number and norm.
323*
324 IF( imat.EQ.3 ) THEN
325 cndnum = badc1
326 ELSE IF( imat.EQ.4 ) THEN
327 cndnum = badc2
328 ELSE
329 cndnum = two
330 END IF
331*
332 IF( imat.EQ.5 .OR. imat.EQ.11 ) THEN
333 anorm = small
334 ELSE IF( imat.EQ.6 .OR. imat.EQ.12 ) THEN
335 anorm = large
336 ELSE
337 anorm = one
338 END IF
339*
340 ELSE IF( lsamen( 2, c2, 'PO' ) .OR. lsamen( 2, c2, 'PP' ) ) THEN
341*
342* xPO, xPP: Set parameters to generate a
343* symmetric or Hermitian positive definite matrix.
344*
345* Set TYPE, the type of matrix to be generated.
346*
347 TYPE = c2( 1: 1 )
348*
349* Set the lower and upper bandwidths.
350*
351 IF( imat.EQ.1 ) THEN
352 kl = 0
353 ELSE
354 kl = max( n-1, 0 )
355 END IF
356 ku = kl
357*
358* Set the condition number and norm.
359*
360 IF( imat.EQ.6 ) THEN
361 cndnum = badc1
362 ELSE IF( imat.EQ.7 ) THEN
363 cndnum = badc2
364 ELSE
365 cndnum = two
366 END IF
367*
368 IF( imat.EQ.8 ) THEN
369 anorm = small
370 ELSE IF( imat.EQ.9 ) THEN
371 anorm = large
372 ELSE
373 anorm = one
374 END IF
375*
376 ELSE IF( lsamen( 2, c2, 'HE' ) .OR. lsamen( 2, c2, 'HP' ) .OR.
377 $ lsamen( 2, c2, 'SY' ) .OR. lsamen( 2, c2, 'SP' ) ) THEN
378*
379* xHE, xHP, xSY, xSP: Set parameters to generate a
380* symmetric or Hermitian matrix.
381*
382* Set TYPE, the type of matrix to be generated.
383*
384 TYPE = c2( 1: 1 )
385*
386* Set the lower and upper bandwidths.
387*
388 IF( imat.EQ.1 ) THEN
389 kl = 0
390 ELSE
391 kl = max( n-1, 0 )
392 END IF
393 ku = kl
394*
395* Set the condition number and norm.
396*
397 IF( imat.EQ.7 ) THEN
398 cndnum = badc1
399 ELSE IF( imat.EQ.8 ) THEN
400 cndnum = badc2
401 ELSE
402 cndnum = two
403 END IF
404*
405 IF( imat.EQ.9 ) THEN
406 anorm = small
407 ELSE IF( imat.EQ.10 ) THEN
408 anorm = large
409 ELSE
410 anorm = one
411 END IF
412*
413 ELSE IF( lsamen( 2, c2, 'PB' ) ) THEN
414*
415* xPB: Set parameters to generate a symmetric band matrix.
416*
417* Set TYPE, the type of matrix to be generated.
418*
419 TYPE = 'P'
420*
421* Set the norm and condition number.
422*
423 IF( imat.EQ.5 ) THEN
424 cndnum = badc1
425 ELSE IF( imat.EQ.6 ) THEN
426 cndnum = badc2
427 ELSE
428 cndnum = two
429 END IF
430*
431 IF( imat.EQ.7 ) THEN
432 anorm = small
433 ELSE IF( imat.EQ.8 ) THEN
434 anorm = large
435 ELSE
436 anorm = one
437 END IF
438*
439 ELSE IF( lsamen( 2, c2, 'PT' ) ) THEN
440*
441* xPT: Set parameters to generate a symmetric positive definite
442* tridiagonal matrix.
443*
444 TYPE = 'P'
445 IF( imat.EQ.1 ) THEN
446 kl = 0
447 ELSE
448 kl = 1
449 END IF
450 ku = kl
451*
452* Set the condition number and norm.
453*
454 IF( imat.EQ.3 ) THEN
455 cndnum = badc1
456 ELSE IF( imat.EQ.4 ) THEN
457 cndnum = badc2
458 ELSE
459 cndnum = two
460 END IF
461*
462 IF( imat.EQ.5 .OR. imat.EQ.11 ) THEN
463 anorm = small
464 ELSE IF( imat.EQ.6 .OR. imat.EQ.12 ) THEN
465 anorm = large
466 ELSE
467 anorm = one
468 END IF
469*
470 ELSE IF( lsamen( 2, c2, 'TR' ) .OR. lsamen( 2, c2, 'TP' ) ) THEN
471*
472* xTR, xTP: Set parameters to generate a triangular matrix
473*
474* Set TYPE, the type of matrix to be generated.
475*
476 TYPE = 'N'
477*
478* Set the lower and upper bandwidths.
479*
480 mat = abs( imat )
481 IF( mat.EQ.1 .OR. mat.EQ.7 ) THEN
482 kl = 0
483 ku = 0
484 ELSE IF( imat.LT.0 ) THEN
485 kl = max( n-1, 0 )
486 ku = 0
487 ELSE
488 kl = 0
489 ku = max( n-1, 0 )
490 END IF
491*
492* Set the condition number and norm.
493*
494 IF( mat.EQ.3 .OR. mat.EQ.9 ) THEN
495 cndnum = badc1
496 ELSE IF( mat.EQ.4 .OR. mat.EQ.10 ) THEN
497 cndnum = badc2
498 ELSE
499 cndnum = two
500 END IF
501*
502 IF( mat.EQ.5 ) THEN
503 anorm = small
504 ELSE IF( mat.EQ.6 ) THEN
505 anorm = large
506 ELSE
507 anorm = one
508 END IF
509*
510 ELSE IF( lsamen( 2, c2, 'TB' ) ) THEN
511*
512* xTB: Set parameters to generate a triangular band matrix.
513*
514* Set TYPE, the type of matrix to be generated.
515*
516 TYPE = 'N'
517*
518* Set the norm and condition number.
519*
520 mat = abs( imat )
521 IF( mat.EQ.2 .OR. mat.EQ.8 ) THEN
522 cndnum = badc1
523 ELSE IF( mat.EQ.3 .OR. mat.EQ.9 ) THEN
524 cndnum = badc2
525 ELSE
526 cndnum = two
527 END IF
528*
529 IF( mat.EQ.4 ) THEN
530 anorm = small
531 ELSE IF( mat.EQ.5 ) THEN
532 anorm = large
533 ELSE
534 anorm = one
535 END IF
536 END IF
537 IF( n.LE.1 )
538 $ cndnum = one
539*
540 RETURN
541*
542* End of CLATB4
543*
544 END
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:74
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
Definition: clatb4.f:121