LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine slatb4 ( character*3  PATH,
integer  IMAT,
integer  M,
integer  N,
character  TYPE,
integer  KL,
integer  KU,
real  ANORM,
integer  MODE,
real  CNDNUM,
character  DIST 
)

SLATB4

Purpose: 
 SLATB4 sets parameters for the matrix generator based on the type of
 matrix to be generated.
Parameters
[in]PATH
          PATH is CHARACTER*3
          The LAPACK path name.
[in]IMAT
          IMAT is INTEGER
          An integer key describing which matrix to generate for this
          path.
[in]M
          M is INTEGER
          The number of rows in the matrix to be generated.
[in]N
          N is INTEGER
          The number of columns in the matrix to be generated.
[out]TYPE
          TYPE is CHARACTER*1
          The type of the matrix to be generated:
          = 'S':  symmetric matrix
          = 'P':  symmetric positive (semi)definite matrix
          = 'N':  nonsymmetric matrix
[out]KL
          KL is INTEGER
          The lower band width of the matrix to be generated.
[out]KU
          KU is INTEGER
          The upper band width of the matrix to be generated.
[out]ANORM
          ANORM is REAL
          The desired norm of the matrix to be generated.  The diagonal
          matrix of singular values or eigenvalues is scaled by this
          value.
[out]MODE
          MODE is INTEGER
          A key indicating how to choose the vector of eigenvalues.
[out]CNDNUM
          CNDNUM is REAL
          The desired condition number.
[out]DIST
          DIST is CHARACTER*1
          The type of distribution to be used by the random number
          generator.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 122 of file slatb4.f.

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  IF( lsamen( 2, c2, 'QR' ) .OR. lsamen( 2, c2, 'LQ' ) .OR.
196  $ lsamen( 2, c2, 'QL' ) .OR. lsamen( 2, c2, 'RQ' ) ) THEN
197 *
198 * xQR, xLQ, xQL, xRQ: Set parameters to generate a general
199 * M x N matrix.
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, 'SY' ) .OR. lsamen( 2, c2, 'SP' ) ) THEN
344 *
345 * xPO, xPP, xSY, xSP: Set parameters to generate a
346 * symmetric 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, 'PB' ) ) THEN
380 *
381 * xPB: Set parameters to generate a symmetric band matrix.
382 *
383 * Set TYPE, the type of matrix to be generated.
384 *
385  TYPE = 'P'
386 *
387 * Set the norm and condition number.
388 *
389  IF( imat.EQ.5 ) THEN
390  cndnum = badc1
391  ELSE IF( imat.EQ.6 ) THEN
392  cndnum = badc2
393  ELSE
394  cndnum = two
395  END IF
396 *
397  IF( imat.EQ.7 ) THEN
398  anorm = small
399  ELSE IF( imat.EQ.8 ) THEN
400  anorm = large
401  ELSE
402  anorm = one
403  END IF
404 *
405  ELSE IF( lsamen( 2, c2, 'PT' ) ) THEN
406 *
407 * xPT: Set parameters to generate a symmetric positive definite
408 * tridiagonal matrix.
409 *
410  TYPE = 'P'
411  IF( imat.EQ.1 ) THEN
412  kl = 0
413  ELSE
414  kl = 1
415  END IF
416  ku = kl
417 *
418 * Set the condition number and norm.
419 *
420  IF( imat.EQ.3 ) THEN
421  cndnum = badc1
422  ELSE IF( imat.EQ.4 ) THEN
423  cndnum = badc2
424  ELSE
425  cndnum = two
426  END IF
427 *
428  IF( imat.EQ.5 .OR. imat.EQ.11 ) THEN
429  anorm = small
430  ELSE IF( imat.EQ.6 .OR. imat.EQ.12 ) THEN
431  anorm = large
432  ELSE
433  anorm = one
434  END IF
435 *
436  ELSE IF( lsamen( 2, c2, 'TR' ) .OR. lsamen( 2, c2, 'TP' ) ) THEN
437 *
438 * xTR, xTP: Set parameters to generate a triangular matrix
439 *
440 * Set TYPE, the type of matrix to be generated.
441 *
442  TYPE = 'N'
443 *
444 * Set the lower and upper bandwidths.
445 *
446  mat = abs( imat )
447  IF( mat.EQ.1 .OR. mat.EQ.7 ) THEN
448  kl = 0
449  ku = 0
450  ELSE IF( imat.LT.0 ) THEN
451  kl = max( n-1, 0 )
452  ku = 0
453  ELSE
454  kl = 0
455  ku = max( n-1, 0 )
456  END IF
457 *
458 * Set the condition number and norm.
459 *
460  IF( mat.EQ.3 .OR. mat.EQ.9 ) THEN
461  cndnum = badc1
462  ELSE IF( mat.EQ.4 ) THEN
463  cndnum = badc2
464  ELSE IF( 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 SLATB4
510 *
lsamen
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:76
slabad
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:76
slamch
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69

Here is the call graph for this function:

Here is the caller graph for this function: