LAPACK  3.7.0
LAPACK: Linear Algebra PACKage
subroutine zlatb4 ( character*3  PATH,
integer  IMAT,
integer  M,
integer  N,
character  TYPE,
integer  KL,
integer  KU,
double precision  ANORM,
integer  MODE,
double precision  CNDNUM,
character  DIST 
)

ZLATB4

Purpose: 
 ZLATB4 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
          = 'H':  Hermitian matrix
          = 'P':  Hermitian 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 DOUBLE PRECISION
          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 DOUBLE PRECISION
          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
December 2016

Definition at line 123 of file zlatb4.f.

123 *
124 * -- LAPACK test routine (version 3.7.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 * December 2016
128 *
129 * .. Scalar Arguments ..
130  CHARACTER dist, type
131  CHARACTER*3 path
132  INTEGER imat, kl, ku, m, mode, n
133  DOUBLE PRECISION anorm, cndnum
134 * ..
135 *
136 * =====================================================================
137 *
138 * .. Parameters ..
139  DOUBLE PRECISION shrink, tenth
140  parameter ( shrink = 0.25d0, tenth = 0.1d+0 )
141  DOUBLE PRECISION one
142  parameter ( one = 1.0d+0 )
143  DOUBLE PRECISION two
144  parameter ( two = 2.0d+0 )
145 * ..
146 * .. Local Scalars ..
147  LOGICAL first
148  CHARACTER*2 c2
149  INTEGER mat
150  DOUBLE PRECISION badc1, badc2, eps, large, small
151 * ..
152 * .. External Functions ..
153  LOGICAL lsamen
154  DOUBLE PRECISION dlamch
155  EXTERNAL lsamen, dlamch
156 * ..
157 * .. Intrinsic Functions ..
158  INTRINSIC abs, max, sqrt
159 * ..
160 * .. External Subroutines ..
161  EXTERNAL dlabad
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 = dlamch( 'Precision' )
176  badc2 = tenth / eps
177  badc1 = sqrt( badc2 )
178  small = dlamch( '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 dlabad( 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' ) ) THEN
344 *
345 * xPO, xPP: Set parameters to generate a
346 * symmetric or Hermitian positive definite 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, 'HE' ) .OR. lsamen( 2, c2, 'HP' ) .OR.
380  $ lsamen( 2, c2, 'SY' ) .OR. lsamen( 2, c2, 'SP' ) ) THEN
381 *
382 * xHE, xHP, xSY, xSP: Set parameters to generate a
383 * symmetric or Hermitian matrix.
384 *
385 * Set TYPE, the type of matrix to be generated.
386 *
387  TYPE = c2( 1: 1 )
388 *
389 * Set the lower and upper bandwidths.
390 *
391  IF( imat.EQ.1 ) THEN
392  kl = 0
393  ELSE
394  kl = max( n-1, 0 )
395  END IF
396  ku = kl
397 *
398 * Set the condition number and norm.
399 *
400  IF( imat.EQ.7 ) THEN
401  cndnum = badc1
402  ELSE IF( imat.EQ.8 ) THEN
403  cndnum = badc2
404  ELSE
405  cndnum = two
406  END IF
407 *
408  IF( imat.EQ.9 ) THEN
409  anorm = small
410  ELSE IF( imat.EQ.10 ) THEN
411  anorm = large
412  ELSE
413  anorm = one
414  END IF
415 *
416  ELSE IF( lsamen( 2, c2, 'PB' ) ) THEN
417 *
418 * xPB: Set parameters to generate a symmetric band matrix.
419 *
420 * Set TYPE, the type of matrix to be generated.
421 *
422  TYPE = 'P'
423 *
424 * Set the norm and condition number.
425 *
426  IF( imat.EQ.5 ) THEN
427  cndnum = badc1
428  ELSE IF( imat.EQ.6 ) THEN
429  cndnum = badc2
430  ELSE
431  cndnum = two
432  END IF
433 *
434  IF( imat.EQ.7 ) THEN
435  anorm = small
436  ELSE IF( imat.EQ.8 ) THEN
437  anorm = large
438  ELSE
439  anorm = one
440  END IF
441 *
442  ELSE IF( lsamen( 2, c2, 'PT' ) ) THEN
443 *
444 * xPT: Set parameters to generate a symmetric positive definite
445 * tridiagonal matrix.
446 *
447  TYPE = 'P'
448  IF( imat.EQ.1 ) THEN
449  kl = 0
450  ELSE
451  kl = 1
452  END IF
453  ku = kl
454 *
455 * Set the condition number and norm.
456 *
457  IF( imat.EQ.3 ) THEN
458  cndnum = badc1
459  ELSE IF( imat.EQ.4 ) THEN
460  cndnum = badc2
461  ELSE
462  cndnum = two
463  END IF
464 *
465  IF( imat.EQ.5 .OR. imat.EQ.11 ) THEN
466  anorm = small
467  ELSE IF( imat.EQ.6 .OR. imat.EQ.12 ) THEN
468  anorm = large
469  ELSE
470  anorm = one
471  END IF
472 *
473  ELSE IF( lsamen( 2, c2, 'TR' ) .OR. lsamen( 2, c2, 'TP' ) ) THEN
474 *
475 * xTR, xTP: Set parameters to generate a triangular matrix
476 *
477 * Set TYPE, the type of matrix to be generated.
478 *
479  TYPE = 'N'
480 *
481 * Set the lower and upper bandwidths.
482 *
483  mat = abs( imat )
484  IF( mat.EQ.1 .OR. mat.EQ.7 ) THEN
485  kl = 0
486  ku = 0
487  ELSE IF( imat.LT.0 ) THEN
488  kl = max( n-1, 0 )
489  ku = 0
490  ELSE
491  kl = 0
492  ku = max( n-1, 0 )
493  END IF
494 *
495 * Set the condition number and norm.
496 *
497  IF( mat.EQ.3 .OR. mat.EQ.9 ) THEN
498  cndnum = badc1
499  ELSE IF( mat.EQ.4 .OR. mat.EQ.10 ) THEN
500  cndnum = badc2
501  ELSE
502  cndnum = two
503  END IF
504 *
505  IF( mat.EQ.5 ) THEN
506  anorm = small
507  ELSE IF( mat.EQ.6 ) THEN
508  anorm = large
509  ELSE
510  anorm = one
511  END IF
512 *
513  ELSE IF( lsamen( 2, c2, 'TB' ) ) THEN
514 *
515 * xTB: Set parameters to generate a triangular band matrix.
516 *
517 * Set TYPE, the type of matrix to be generated.
518 *
519  TYPE = 'N'
520 *
521 * Set the norm and condition number.
522 *
523  IF( imat.EQ.2 .OR. imat.EQ.8 ) THEN
524  cndnum = badc1
525  ELSE IF( imat.EQ.3 .OR. imat.EQ.9 ) THEN
526  cndnum = badc2
527  ELSE
528  cndnum = two
529  END IF
530 *
531  IF( imat.EQ.4 ) THEN
532  anorm = small
533  ELSE IF( imat.EQ.5 ) THEN
534  anorm = large
535  ELSE
536  anorm = one
537  END IF
538  END IF
539  IF( n.LE.1 )
540  $ cndnum = one
541 *
542  RETURN
543 *
544 * End of ZLATB4
545 *
dlamch
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
lsamen
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:76
dlabad
subroutine dlabad(SMALL, LARGE)
DLABAD
Definition: dlabad.f:76

Here is the call graph for this function:

Here is the caller graph for this function: