LAPACK  3.6.1
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 November 2013
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.5.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 * November 2013
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' ) .OR.
344  $ lsamen( 2, c2, 'HE' ) .OR. lsamen( 2, c2, 'HP' ) .OR.
345  $ lsamen( 2, c2, 'SY' ) .OR. lsamen( 2, c2, 'SP' ) ) THEN
346 *
347 * xPO, xPP, xHE, xHP, xSY, xSP: Set parameters to generate a
348 * symmetric or Hermitian matrix.
349 *
350 * Set TYPE, the type of matrix to be generated.
351 *
352  TYPE = c2( 1: 1 )
353 *
354 * Set the lower and upper bandwidths.
355 *
356  IF( imat.EQ.1 ) THEN
357  kl = 0
358  ELSE
359  kl = max( n-1, 0 )
360  END IF
361  ku = kl
362 *
363 * Set the condition number and norm.
364 *
365  IF( imat.EQ.6 ) THEN
366  cndnum = badc1
367  ELSE IF( imat.EQ.7 ) THEN
368  cndnum = badc2
369  ELSE
370  cndnum = two
371  END IF
372 *
373  IF( imat.EQ.8 ) THEN
374  anorm = small
375  ELSE IF( imat.EQ.9 ) THEN
376  anorm = large
377  ELSE
378  anorm = one
379  END IF
380 *
381  ELSE IF( lsamen( 2, c2, 'PB' ) ) THEN
382 *
383 * xPB: Set parameters to generate a symmetric band matrix.
384 *
385 * Set TYPE, the type of matrix to be generated.
386 *
387  TYPE = 'P'
388 *
389 * Set the norm and condition number.
390 *
391  IF( imat.EQ.5 ) THEN
392  cndnum = badc1
393  ELSE IF( imat.EQ.6 ) THEN
394  cndnum = badc2
395  ELSE
396  cndnum = two
397  END IF
398 *
399  IF( imat.EQ.7 ) THEN
400  anorm = small
401  ELSE IF( imat.EQ.8 ) THEN
402  anorm = large
403  ELSE
404  anorm = one
405  END IF
406 *
407  ELSE IF( lsamen( 2, c2, 'PT' ) ) THEN
408 *
409 * xPT: Set parameters to generate a symmetric positive definite
410 * tridiagonal matrix.
411 *
412  TYPE = 'P'
413  IF( imat.EQ.1 ) THEN
414  kl = 0
415  ELSE
416  kl = 1
417  END IF
418  ku = kl
419 *
420 * Set the condition number and norm.
421 *
422  IF( imat.EQ.3 ) THEN
423  cndnum = badc1
424  ELSE IF( imat.EQ.4 ) THEN
425  cndnum = badc2
426  ELSE
427  cndnum = two
428  END IF
429 *
430  IF( imat.EQ.5 .OR. imat.EQ.11 ) THEN
431  anorm = small
432  ELSE IF( imat.EQ.6 .OR. imat.EQ.12 ) THEN
433  anorm = large
434  ELSE
435  anorm = one
436  END IF
437 *
438  ELSE IF( lsamen( 2, c2, 'TR' ) .OR. lsamen( 2, c2, 'TP' ) ) THEN
439 *
440 * xTR, xTP: Set parameters to generate a triangular matrix
441 *
442 * Set TYPE, the type of matrix to be generated.
443 *
444  TYPE = 'N'
445 *
446 * Set the lower and upper bandwidths.
447 *
448  mat = abs( imat )
449  IF( mat.EQ.1 .OR. mat.EQ.7 ) THEN
450  kl = 0
451  ku = 0
452  ELSE IF( imat.LT.0 ) THEN
453  kl = max( n-1, 0 )
454  ku = 0
455  ELSE
456  kl = 0
457  ku = max( n-1, 0 )
458  END IF
459 *
460 * Set the condition number and norm.
461 *
462  IF( mat.EQ.3 .OR. mat.EQ.9 ) THEN
463  cndnum = badc1
464  ELSE IF( mat.EQ.4 .OR. mat.EQ.10 ) THEN
465  cndnum = badc2
466  ELSE
467  cndnum = two
468  END IF
469 *
470  IF( mat.EQ.5 ) THEN
471  anorm = small
472  ELSE IF( mat.EQ.6 ) THEN
473  anorm = large
474  ELSE
475  anorm = one
476  END IF
477 *
478  ELSE IF( lsamen( 2, c2, 'TB' ) ) THEN
479 *
480 * xTB: Set parameters to generate a triangular band matrix.
481 *
482 * Set TYPE, the type of matrix to be generated.
483 *
484  TYPE = 'N'
485 *
486 * Set the norm and condition number.
487 *
488  IF( imat.EQ.2 .OR. imat.EQ.8 ) THEN
489  cndnum = badc1
490  ELSE IF( imat.EQ.3 .OR. imat.EQ.9 ) THEN
491  cndnum = badc2
492  ELSE
493  cndnum = two
494  END IF
495 *
496  IF( imat.EQ.4 ) THEN
497  anorm = small
498  ELSE IF( imat.EQ.5 ) THEN
499  anorm = large
500  ELSE
501  anorm = one
502  END IF
503  END IF
504  IF( n.LE.1 )
505  $ cndnum = one
506 *
507  RETURN
508 *
509 * End of CLATB4
510 *
511  END
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:76
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
Definition: clatb4.f:123