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
dlatb4.f
Go to the documentation of this file.
1  SUBROUTINE dlatb4( 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  DOUBLE PRECISION anorm, cndnum
13 * ..
14 *
15 * Purpose
16 * =======
17 *
18 * DLATB4 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) DOUBLE PRECISION
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) DOUBLE PRECISION
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  DOUBLE PRECISION shrink, tenth
68  parameter( shrink = 0.25d0, tenth = 0.1d+0 )
69  DOUBLE PRECISION one
70  parameter( one = 1.0d+0 )
71  DOUBLE PRECISION two
72  parameter( two = 2.0d+0 )
73 * ..
74 * .. Local Scalars ..
75  LOGICAL first
76  CHARACTER*2 c2
77  INTEGER mat
78  DOUBLE PRECISION badc1, badc2, eps, large, small
79 * ..
80 * .. External Functions ..
81  LOGICAL lsamen
82  DOUBLE PRECISION dlamch
83  EXTERNAL lsamen, dlamch
84 * ..
85 * .. Intrinsic Functions ..
86  INTRINSIC abs, max, sqrt
87 * ..
88 * .. External Subroutines ..
89  EXTERNAL dlabad
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 = dlamch( 'Precision' )
104  badc2 = tenth / eps
105  badc1 = sqrt( badc2 )
106  small = dlamch( '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 dlabad( 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  IF( lsamen( 2, c2, 'QR' ) .OR. lsamen( 2, c2, 'LQ' ) .OR.
125  $ lsamen( 2, c2, 'QL' ) .OR. lsamen( 2, c2, 'RQ' ) ) THEN
126 *
127 * xQR, xLQ, xQL, xRQ: Set parameters to generate a general
128 * M x N matrix.
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, 'SY' ) .OR. lsamen( 2, c2, 'SP' ) ) THEN
273 *
274 * xPO, xPP, xSY, xSP: Set parameters to generate a
275 * symmetric matrix.
276 *
277 * Set TYPE, the type of matrix to be generated.
278 *
279  TYPE = c2( 1: 1 )
280 *
281 * Set the lower and upper bandwidths.
282 *
283  IF( imat.EQ.1 ) THEN
284  kl = 0
285  ELSE
286  kl = max( n-1, 0 )
287  END IF
288  ku = kl
289 *
290 * Set the condition number and norm.
291 *
292  IF( imat.EQ.6 ) THEN
293  cndnum = badc1
294  ELSE IF( imat.EQ.7 ) THEN
295  cndnum = badc2
296  ELSE
297  cndnum = two
298  END IF
299 *
300  IF( imat.EQ.8 ) THEN
301  anorm = small
302  ELSE IF( imat.EQ.9 ) THEN
303  anorm = large
304  ELSE
305  anorm = one
306  END IF
307 *
308  ELSE IF( lsamen( 2, c2, 'PB' ) ) THEN
309 *
310 * xPB: Set parameters to generate a symmetric band matrix.
311 *
312 * Set TYPE, the type of matrix to be generated.
313 *
314  TYPE = 'P'
315 *
316 * Set the norm and condition number.
317 *
318  IF( imat.EQ.5 ) THEN
319  cndnum = badc1
320  ELSE IF( imat.EQ.6 ) THEN
321  cndnum = badc2
322  ELSE
323  cndnum = two
324  END IF
325 *
326  IF( imat.EQ.7 ) THEN
327  anorm = small
328  ELSE IF( imat.EQ.8 ) THEN
329  anorm = large
330  ELSE
331  anorm = one
332  END IF
333 *
334  ELSE IF( lsamen( 2, c2, 'PT' ) ) THEN
335 *
336 * xPT: Set parameters to generate a symmetric positive definite
337 * tridiagonal matrix.
338 *
339  TYPE = 'P'
340  IF( imat.EQ.1 ) THEN
341  kl = 0
342  ELSE
343  kl = 1
344  END IF
345  ku = kl
346 *
347 * Set the condition number and norm.
348 *
349  IF( imat.EQ.3 ) THEN
350  cndnum = badc1
351  ELSE IF( imat.EQ.4 ) THEN
352  cndnum = badc2
353  ELSE
354  cndnum = two
355  END IF
356 *
357  IF( imat.EQ.5 .OR. imat.EQ.11 ) THEN
358  anorm = small
359  ELSE IF( imat.EQ.6 .OR. imat.EQ.12 ) THEN
360  anorm = large
361  ELSE
362  anorm = one
363  END IF
364 *
365  ELSE IF( lsamen( 2, c2, 'TR' ) .OR. lsamen( 2, c2, 'TP' ) ) THEN
366 *
367 * xTR, xTP: Set parameters to generate a triangular matrix
368 *
369 * Set TYPE, the type of matrix to be generated.
370 *
371  TYPE = 'N'
372 *
373 * Set the lower and upper bandwidths.
374 *
375  mat = abs( imat )
376  IF( mat.EQ.1 .OR. mat.EQ.7 ) THEN
377  kl = 0
378  ku = 0
379  ELSE IF( imat.LT.0 ) THEN
380  kl = max( n-1, 0 )
381  ku = 0
382  ELSE
383  kl = 0
384  ku = max( n-1, 0 )
385  END IF
386 *
387 * Set the condition number and norm.
388 *
389  IF( mat.EQ.3 .OR. mat.EQ.9 ) THEN
390  cndnum = badc1
391  ELSE IF( mat.EQ.4 ) THEN
392  cndnum = badc2
393  ELSE IF( mat.EQ.10 ) THEN
394  cndnum = badc2
395  ELSE
396  cndnum = two
397  END IF
398 *
399  IF( mat.EQ.5 ) THEN
400  anorm = small
401  ELSE IF( mat.EQ.6 ) THEN
402  anorm = large
403  ELSE
404  anorm = one
405  END IF
406 *
407  ELSE IF( lsamen( 2, c2, 'TB' ) ) THEN
408 *
409 * xTB: Set parameters to generate a triangular band matrix.
410 *
411 * Set TYPE, the type of matrix to be generated.
412 *
413  TYPE = 'N'
414 *
415 * Set the norm and condition number.
416 *
417  IF( imat.EQ.2 .OR. imat.EQ.8 ) THEN
418  cndnum = badc1
419  ELSE IF( imat.EQ.3 .OR. imat.EQ.9 ) THEN
420  cndnum = badc2
421  ELSE
422  cndnum = two
423  END IF
424 *
425  IF( imat.EQ.4 ) THEN
426  anorm = small
427  ELSE IF( imat.EQ.5 ) THEN
428  anorm = large
429  ELSE
430  anorm = one
431  END IF
432  END IF
433  IF( n.LE.1 )
434  $ cndnum = one
435 *
436  return
437 *
438 * End of DLATB4
439 *
440  END