LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
slatb4.f
Go to the documentation of this file.
1 *> \brief \b SLATB4
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 SLATB4( 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 *> SLATB4 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 REAL
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 REAL
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 single_lin
116 *
117 * =====================================================================
118  SUBROUTINE slatb4( 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  REAL ANORM, CNDNUM
130 * ..
131 *
132 * =====================================================================
133 *
134 * .. Parameters ..
135  REAL SHRINK, TENTH
136  parameter( shrink = 0.25e0, tenth = 0.1e+0 )
137  REAL ONE
138  parameter( one = 1.0e+0 )
139  REAL TWO
140  parameter( two = 2.0e+0 )
141 * ..
142 * .. Local Scalars ..
143  LOGICAL FIRST
144  CHARACTER*2 C2
145  INTEGER MAT
146  REAL BADC1, BADC2, EPS, LARGE, SMALL
147 * ..
148 * .. External Functions ..
149  LOGICAL LSAMEN
150  REAL SLAMCH
151  EXTERNAL lsamen, slamch
152 * ..
153 * .. Intrinsic Functions ..
154  INTRINSIC abs, max, sqrt
155 * ..
156 * .. External Subroutines ..
157  EXTERNAL slabad
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 = slamch( 'Precision' )
172  badc2 = tenth / eps
173  badc1 = sqrt( badc2 )
174  small = slamch( '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 slabad( 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, xSY, xSP: 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  IF( imat.EQ.2 .OR. imat.EQ.8 ) THEN
522  cndnum = badc1
523  ELSE IF( imat.EQ.3 .OR. imat.EQ.9 ) THEN
524  cndnum = badc2
525  ELSE
526  cndnum = two
527  END IF
528 *
529  IF( imat.EQ.4 ) THEN
530  anorm = small
531  ELSE IF( imat.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 SLATB4
543 *
544  END
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:74
subroutine slatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
SLATB4
Definition: slatb4.f:120