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