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