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