LAPACK  3.6.1
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
November 2013

Definition at line 123 of file zlatb4.f.

123 *
124 * -- LAPACK test routine (version 3.5.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 * November 2013
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' ) .OR.
344  $ lsamen( 2, c2, 'HE' ) .OR. lsamen( 2, c2, 'HP' ) .OR.
345  $ lsamen( 2, c2, 'SY' ) .OR. lsamen( 2, c2, 'SP' ) ) THEN
346 *
347 * xPO, xPP, xHE, xHP, xSY, xSP: Set parameters to generate a
348 * symmetric or Hermitian matrix.
349 *
350 * Set TYPE, the type of matrix to be generated.
351 *
352  TYPE = c2( 1: 1 )
353 *
354 * Set the lower and upper bandwidths.
355 *
356  IF( imat.EQ.1 ) THEN
357  kl = 0
358  ELSE
359  kl = max( n-1, 0 )
360  END IF
361  ku = kl
362 *
363 * Set the condition number and norm.
364 *
365  IF( imat.EQ.6 ) THEN
366  cndnum = badc1
367  ELSE IF( imat.EQ.7 ) THEN
368  cndnum = badc2
369  ELSE
370  cndnum = two
371  END IF
372 *
373  IF( imat.EQ.8 ) THEN
374  anorm = small
375  ELSE IF( imat.EQ.9 ) THEN
376  anorm = large
377  ELSE
378  anorm = one
379  END IF
380 *
381  ELSE IF( lsamen( 2, c2, 'PB' ) ) THEN
382 *
383 * xPB: Set parameters to generate a symmetric band matrix.
384 *
385 * Set TYPE, the type of matrix to be generated.
386 *
387  TYPE = 'P'
388 *
389 * Set the norm and condition number.
390 *
391  IF( imat.EQ.5 ) THEN
392  cndnum = badc1
393  ELSE IF( imat.EQ.6 ) THEN
394  cndnum = badc2
395  ELSE
396  cndnum = two
397  END IF
398 *
399  IF( imat.EQ.7 ) THEN
400  anorm = small
401  ELSE IF( imat.EQ.8 ) THEN
402  anorm = large
403  ELSE
404  anorm = one
405  END IF
406 *
407  ELSE IF( lsamen( 2, c2, 'PT' ) ) THEN
408 *
409 * xPT: Set parameters to generate a symmetric positive definite
410 * tridiagonal matrix.
411 *
412  TYPE = 'P'
413  IF( imat.EQ.1 ) THEN
414  kl = 0
415  ELSE
416  kl = 1
417  END IF
418  ku = kl
419 *
420 * Set the condition number and norm.
421 *
422  IF( imat.EQ.3 ) THEN
423  cndnum = badc1
424  ELSE IF( imat.EQ.4 ) THEN
425  cndnum = badc2
426  ELSE
427  cndnum = two
428  END IF
429 *
430  IF( imat.EQ.5 .OR. imat.EQ.11 ) THEN
431  anorm = small
432  ELSE IF( imat.EQ.6 .OR. imat.EQ.12 ) THEN
433  anorm = large
434  ELSE
435  anorm = one
436  END IF
437 *
438  ELSE IF( lsamen( 2, c2, 'TR' ) .OR. lsamen( 2, c2, 'TP' ) ) THEN
439 *
440 * xTR, xTP: Set parameters to generate a triangular matrix
441 *
442 * Set TYPE, the type of matrix to be generated.
443 *
444  TYPE = 'N'
445 *
446 * Set the lower and upper bandwidths.
447 *
448  mat = abs( imat )
449  IF( mat.EQ.1 .OR. mat.EQ.7 ) THEN
450  kl = 0
451  ku = 0
452  ELSE IF( imat.LT.0 ) THEN
453  kl = max( n-1, 0 )
454  ku = 0
455  ELSE
456  kl = 0
457  ku = max( n-1, 0 )
458  END IF
459 *
460 * Set the condition number and norm.
461 *
462  IF( mat.EQ.3 .OR. mat.EQ.9 ) THEN
463  cndnum = badc1
464  ELSE IF( mat.EQ.4 .OR. 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 ZLATB4
510 *
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:76
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: