PLASMA  2.4.5
PLASMA - Parallel Linear Algebra for Scalable Multi-core Architectures
 All Data Structures Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros Groups
clatb4.f
Go to the documentation of this file.
1  SUBROUTINE clatb4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE,
2  $ cndnum, dist )
3 *
4 * -- LAPACK test routine (version 3.1) --
5 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
6 * November 2006
7 *
8 * .. Scalar Arguments ..
9  CHARACTER dist, type
10  CHARACTER*3 path
11  INTEGER imat, kl, ku, m, mode, n
12  REAL anorm, cndnum
13 * ..
14 *
15 * Purpose
16 * =======
17 *
18 * CLATB4 sets parameters for the matrix generator based on the type of
19 * matrix to be generated.
20 *
21 * Arguments
22 * =========
23 *
24 * PATH (input) CHARACTER*3
25 * The LAPACK path name.
26 *
27 * IMAT (input) INTEGER
28 * An integer key describing which matrix to generate for this
29 * path.
30 *
31 * M (input) INTEGER
32 * The number of rows in the matrix to be generated.
33 *
34 * N (input) INTEGER
35 * The number of columns in the matrix to be generated.
36 *
37 * TYPE (output) CHARACTER*1
38 * The type of the matrix to be generated:
39 * = 'S': symmetric matrix
40 * = 'P': symmetric positive (semi)definite matrix
41 * = 'N': nonsymmetric matrix
42 *
43 * KL (output) INTEGER
44 * The lower band width of the matrix to be generated.
45 *
46 * KU (output) INTEGER
47 * The upper band width of the matrix to be generated.
48 *
49 * ANORM (output) REAL
50 * The desired norm of the matrix to be generated. The diagonal
51 * matrix of singular values or eigenvalues is scaled by this
52 * value.
53 *
54 * MODE (output) INTEGER
55 * A key indicating how to choose the vector of eigenvalues.
56 *
57 * CNDNUM (output) REAL
58 * The desired condition number.
59 *
60 * DIST (output) CHARACTER*1
61 * The type of distribution to be used by the random number
62 * generator.
63 *
64 * =====================================================================
65 *
66 * .. Parameters ..
67  REAL shrink, tenth
68  parameter( shrink = 0.25e0, tenth = 0.1e+0 )
69  REAL one
70  parameter( one = 1.0e+0 )
71  REAL two
72  parameter( two = 2.0e+0 )
73 * ..
74 * .. Local Scalars ..
75  LOGICAL first
76  CHARACTER*2 c2
77  INTEGER mat
78  REAL badc1, badc2, eps, large, small
79 * ..
80 * .. External Functions ..
81  LOGICAL lsamen
82  REAL slamch
83  EXTERNAL lsamen, slamch
84 * ..
85 * .. Intrinsic Functions ..
86  INTRINSIC abs, max, sqrt
87 * ..
88 * .. External Subroutines ..
89  EXTERNAL slabad
90 * ..
91 * .. Save statement ..
92  SAVE eps, small, large, badc1, badc2, first
93 * ..
94 * .. Data statements ..
95  DATA first / .true. /
96 * ..
97 * .. Executable Statements ..
98 *
99 * Set some constants for use in the subroutine.
100 *
101  IF( first ) THEN
102  first = .false.
103  eps = slamch( 'Precision' )
104  badc2 = tenth / eps
105  badc1 = sqrt( badc2 )
106  small = slamch( 'Safe minimum' )
107  large = one / small
108 *
109 * If it looks like we're on a Cray, take the square root of
110 * SMALL and LARGE to avoid overflow and underflow problems.
111 *
112  CALL slabad( small, large )
113  small = shrink*( small / eps )
114  large = one / small
115  END IF
116 *
117  c2 = path( 2: 3 )
118 *
119 * Set some parameters we don't plan to change.
120 *
121  dist = 'S'
122  mode = 3
123 *
124 * xQR, xLQ, xQL, xRQ: Set parameters to generate a general
125 * M x N matrix.
126 *
127  IF( lsamen( 2, c2, 'QR' ) .OR. lsamen( 2, c2, 'LQ' ) .OR.
128  $ lsamen( 2, c2, 'QL' ) .OR. lsamen( 2, c2, 'RQ' ) ) THEN
129 *
130 * Set TYPE, the type of matrix to be generated.
131 *
132  TYPE = 'N'
133 *
134 * Set the lower and upper bandwidths.
135 *
136  IF( imat.EQ.1 ) THEN
137  kl = 0
138  ku = 0
139  ELSE IF( imat.EQ.2 ) THEN
140  kl = 0
141  ku = max( n-1, 0 )
142  ELSE IF( imat.EQ.3 ) THEN
143  kl = max( m-1, 0 )
144  ku = 0
145  ELSE
146  kl = max( m-1, 0 )
147  ku = max( n-1, 0 )
148  END IF
149 *
150 * Set the condition number and norm.
151 *
152  IF( imat.EQ.5 ) THEN
153  cndnum = badc1
154  ELSE IF( imat.EQ.6 ) THEN
155  cndnum = badc2
156  ELSE
157  cndnum = two
158  END IF
159 *
160  IF( imat.EQ.7 ) THEN
161  anorm = small
162  ELSE IF( imat.EQ.8 ) THEN
163  anorm = large
164  ELSE
165  anorm = one
166  END IF
167 *
168  ELSE IF( lsamen( 2, c2, 'GE' ) ) THEN
169 *
170 * xGE: Set parameters to generate a general M x N matrix.
171 *
172 * Set TYPE, the type of matrix to be generated.
173 *
174  TYPE = 'N'
175 *
176 * Set the lower and upper bandwidths.
177 *
178  IF( imat.EQ.1 ) THEN
179  kl = 0
180  ku = 0
181  ELSE IF( imat.EQ.2 ) THEN
182  kl = 0
183  ku = max( n-1, 0 )
184  ELSE IF( imat.EQ.3 ) THEN
185  kl = max( m-1, 0 )
186  ku = 0
187  ELSE
188  kl = max( m-1, 0 )
189  ku = max( n-1, 0 )
190  END IF
191 *
192 * Set the condition number and norm.
193 *
194  IF( imat.EQ.8 ) THEN
195  cndnum = badc1
196  ELSE IF( imat.EQ.9 ) THEN
197  cndnum = badc2
198  ELSE
199  cndnum = two
200  END IF
201 *
202  IF( imat.EQ.10 ) THEN
203  anorm = small
204  ELSE IF( imat.EQ.11 ) THEN
205  anorm = large
206  ELSE
207  anorm = one
208  END IF
209 *
210  ELSE IF( lsamen( 2, c2, 'GB' ) ) THEN
211 *
212 * xGB: Set parameters to generate a general banded matrix.
213 *
214 * Set TYPE, the type of matrix to be generated.
215 *
216  TYPE = 'N'
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 = tenth*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, 'GT' ) ) THEN
237 *
238 * xGT: Set parameters to generate a general tridiagonal 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  ELSE
249  kl = 1
250  END IF
251  ku = kl
252 *
253 * Set the condition number and norm.
254 *
255  IF( imat.EQ.3 ) THEN
256  cndnum = badc1
257  ELSE IF( imat.EQ.4 ) THEN
258  cndnum = badc2
259  ELSE
260  cndnum = two
261  END IF
262 *
263  IF( imat.EQ.5 .OR. imat.EQ.11 ) THEN
264  anorm = small
265  ELSE IF( imat.EQ.6 .OR. imat.EQ.12 ) THEN
266  anorm = large
267  ELSE
268  anorm = one
269  END IF
270 *
271  ELSE IF( lsamen( 2, c2, 'PO' ) .OR. lsamen( 2, c2, 'PP' ) .OR.
272  $ lsamen( 2, c2, 'HE' ) .OR. lsamen( 2, c2, 'HP' ) .OR.
273  $ lsamen( 2, c2, 'SY' ) .OR. lsamen( 2, c2, 'SP' ) ) THEN
274 *
275 * xPO, xPP, xHE, xHP, xSY, xSP: Set parameters to generate a
276 * symmetric or Hermitian matrix.
277 *
278 * Set TYPE, the type of matrix to be generated.
279 *
280  TYPE = c2( 1: 1 )
281 *
282 * Set the lower and upper bandwidths.
283 *
284  IF( imat.EQ.1 ) THEN
285  kl = 0
286  ELSE
287  kl = max( n-1, 0 )
288  END IF
289  ku = kl
290 *
291 * Set the condition number and norm.
292 *
293  IF( imat.EQ.6 ) THEN
294  cndnum = badc1
295  ELSE IF( imat.EQ.7 ) THEN
296  cndnum = badc2
297  ELSE
298  cndnum = two
299  END IF
300 *
301  IF( imat.EQ.8 ) THEN
302  anorm = small
303  ELSE IF( imat.EQ.9 ) THEN
304  anorm = large
305  ELSE
306  anorm = one
307  END IF
308 *
309  ELSE IF( lsamen( 2, c2, 'PB' ) ) THEN
310 *
311 * xPB: Set parameters to generate a symmetric band matrix.
312 *
313 * Set TYPE, the type of matrix to be generated.
314 *
315  TYPE = 'P'
316 *
317 * Set the norm and condition number.
318 *
319  IF( imat.EQ.5 ) THEN
320  cndnum = badc1
321  ELSE IF( imat.EQ.6 ) THEN
322  cndnum = badc2
323  ELSE
324  cndnum = two
325  END IF
326 *
327  IF( imat.EQ.7 ) THEN
328  anorm = small
329  ELSE IF( imat.EQ.8 ) THEN
330  anorm = large
331  ELSE
332  anorm = one
333  END IF
334 *
335  ELSE IF( lsamen( 2, c2, 'PT' ) ) THEN
336 *
337 * xPT: Set parameters to generate a symmetric positive definite
338 * tridiagonal matrix.
339 *
340  TYPE = 'P'
341  IF( imat.EQ.1 ) THEN
342  kl = 0
343  ELSE
344  kl = 1
345  END IF
346  ku = kl
347 *
348 * Set the condition number and norm.
349 *
350  IF( imat.EQ.3 ) THEN
351  cndnum = badc1
352  ELSE IF( imat.EQ.4 ) THEN
353  cndnum = badc2
354  ELSE
355  cndnum = two
356  END IF
357 *
358  IF( imat.EQ.5 .OR. imat.EQ.11 ) THEN
359  anorm = small
360  ELSE IF( imat.EQ.6 .OR. imat.EQ.12 ) THEN
361  anorm = large
362  ELSE
363  anorm = one
364  END IF
365 *
366  ELSE IF( lsamen( 2, c2, 'TR' ) .OR. lsamen( 2, c2, 'TP' ) ) THEN
367 *
368 * xTR, xTP: Set parameters to generate a triangular matrix
369 *
370 * Set TYPE, the type of matrix to be generated.
371 *
372  TYPE = 'N'
373 *
374 * Set the lower and upper bandwidths.
375 *
376  mat = abs( imat )
377  IF( mat.EQ.1 .OR. mat.EQ.7 ) THEN
378  kl = 0
379  ku = 0
380  ELSE IF( imat.LT.0 ) THEN
381  kl = max( n-1, 0 )
382  ku = 0
383  ELSE
384  kl = 0
385  ku = max( n-1, 0 )
386  END IF
387 *
388 * Set the condition number and norm.
389 *
390  IF( mat.EQ.3 .OR. mat.EQ.9 ) THEN
391  cndnum = badc1
392  ELSE IF( mat.EQ.4 .OR. mat.EQ.10 ) THEN
393  cndnum = badc2
394  ELSE
395  cndnum = two
396  END IF
397 *
398  IF( mat.EQ.5 ) THEN
399  anorm = small
400  ELSE IF( mat.EQ.6 ) THEN
401  anorm = large
402  ELSE
403  anorm = one
404  END IF
405 *
406  ELSE IF( lsamen( 2, c2, 'TB' ) ) THEN
407 *
408 * xTB: Set parameters to generate a triangular band matrix.
409 *
410 * Set TYPE, the type of matrix to be generated.
411 *
412  TYPE = 'N'
413 *
414 * Set the norm and condition number.
415 *
416  IF( imat.EQ.2 .OR. imat.EQ.8 ) THEN
417  cndnum = badc1
418  ELSE IF( imat.EQ.3 .OR. imat.EQ.9 ) THEN
419  cndnum = badc2
420  ELSE
421  cndnum = two
422  END IF
423 *
424  IF( imat.EQ.4 ) THEN
425  anorm = small
426  ELSE IF( imat.EQ.5 ) THEN
427  anorm = large
428  ELSE
429  anorm = one
430  END IF
431  END IF
432  IF( n.LE.1 )
433  $ cndnum = one
434 *
435  return
436 *
437 * End of CLATB4
438 *
439  END