LAPACK  3.7.0
LAPACK: Linear Algebra PACKage
subroutine dlatb4 ( 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 
)

DLATB4

Purpose: 
 DLATB4 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 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 122 of file dlatb4.f.

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