LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ dlatb4()

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.

Definition at line 118 of file dlatb4.f.

120*
121* -- LAPACK test routine --
122* -- LAPACK is a software package provided by Univ. of Tennessee, --
123* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
124*
125* .. Scalar Arguments ..
126 CHARACTER DIST, TYPE
127 CHARACTER*3 PATH
128 INTEGER IMAT, KL, KU, M, MODE, N
129 DOUBLE PRECISION ANORM, CNDNUM
130* ..
131*
132* =====================================================================
133*
134* .. Parameters ..
135 DOUBLE PRECISION SHRINK, TENTH
136 parameter( shrink = 0.25d+0, tenth = 0.1d+0 )
137 DOUBLE PRECISION ONE
138 parameter( one = 1.0d+0 )
139 DOUBLE PRECISION TWO
140 parameter( two = 2.0d+0 )
141* ..
142* .. Local Scalars ..
143 LOGICAL FIRST
144 CHARACTER*2 C2
145 INTEGER MAT
146 DOUBLE PRECISION BADC1, BADC2, EPS, LARGE, SMALL
147* ..
148* .. External Functions ..
149 LOGICAL LSAMEN
150 DOUBLE PRECISION DLAMCH
151 EXTERNAL lsamen, dlamch
152* ..
153* .. Intrinsic Functions ..
154 INTRINSIC abs, max, sqrt
155* ..
156* .. Save statement ..
157 SAVE eps, small, large, badc1, badc2, first
158* ..
159* .. Data statements ..
160 DATA first / .true. /
161* ..
162* .. Executable Statements ..
163*
164* Set some constants for use in the subroutine.
165*
166 IF( first ) THEN
167 first = .false.
168 eps = dlamch( 'Precision' )
169 badc2 = tenth / eps
170 badc1 = sqrt( badc2 )
171 small = dlamch( 'Safe minimum' )
172 large = one / small
173 small = shrink*( small / eps )
174 large = one / small
175 END IF
176*
177 c2 = path( 2: 3 )
178*
179* Set some parameters we don't plan to change.
180*
181 dist = 'S'
182 mode = 3
183*
184 IF( lsamen( 2, c2, 'QR' ) .OR. lsamen( 2, c2, 'LQ' ) .OR.
185 $ lsamen( 2, c2, 'QL' ) .OR. lsamen( 2, c2, 'RQ' ) ) THEN
186*
187* xQR, xLQ, xQL, xRQ: Set parameters to generate a general
188* M x N matrix.
189*
190* Set TYPE, the type of matrix to be generated.
191*
192 TYPE = 'N'
193*
194* Set the lower and upper bandwidths.
195*
196 IF( imat.EQ.1 ) THEN
197 kl = 0
198 ku = 0
199 ELSE IF( imat.EQ.2 ) THEN
200 kl = 0
201 ku = max( n-1, 0 )
202 ELSE IF( imat.EQ.3 ) THEN
203 kl = max( m-1, 0 )
204 ku = 0
205 ELSE
206 kl = max( m-1, 0 )
207 ku = max( n-1, 0 )
208 END IF
209*
210* Set the condition number and norm.
211*
212 IF( imat.EQ.5 ) THEN
213 cndnum = badc1
214 ELSE IF( imat.EQ.6 ) THEN
215 cndnum = badc2
216 ELSE
217 cndnum = two
218 END IF
219*
220 IF( imat.EQ.7 ) THEN
221 anorm = small
222 ELSE IF( imat.EQ.8 ) THEN
223 anorm = large
224 ELSE
225 anorm = one
226 END IF
227*
228 ELSE IF( lsamen( 2, c2, 'QK' ) ) THEN
229*
230* xQK: truncated QR with pivoting.
231* Set parameters to generate a general
232* M x N matrix.
233*
234* Set TYPE, the type of matrix to be generated. 'N' is nonsymmetric.
235*
236 TYPE = 'N'
237*
238* Set DIST, the type of distribution for the random
239* number generator. 'S' is
240*
241 dist = 'S'
242*
243* Set the lower and upper bandwidths.
244*
245 IF( imat.EQ.2 ) THEN
246*
247* 2. Random, Diagonal, CNDNUM = 2
248*
249 kl = 0
250 ku = 0
251 cndnum = two
252 anorm = one
253 mode = 3
254 ELSE IF( imat.EQ.3 ) THEN
255*
256* 3. Random, Upper triangular, CNDNUM = 2
257*
258 kl = 0
259 ku = max( n-1, 0 )
260 cndnum = two
261 anorm = one
262 mode = 3
263 ELSE IF( imat.EQ.4 ) THEN
264*
265* 4. Random, Lower triangular, CNDNUM = 2
266*
267 kl = max( m-1, 0 )
268 ku = 0
269 cndnum = two
270 anorm = one
271 mode = 3
272 ELSE
273*
274* 5.-19. Rectangular matrix
275*
276 kl = max( m-1, 0 )
277 ku = max( n-1, 0 )
278*
279 IF( imat.GE.5 .AND. imat.LE.14 ) THEN
280*
281* 5.-14. Random, CNDNUM = 2.
282*
283 cndnum = two
284 anorm = one
285 mode = 3
286*
287 ELSE IF( imat.EQ.15 ) THEN
288*
289* 15. Random, CNDNUM = sqrt(0.1/EPS)
290*
291 cndnum = badc1
292 anorm = one
293 mode = 3
294*
295 ELSE IF( imat.EQ.16 ) THEN
296*
297* 16. Random, CNDNUM = 0.1/EPS
298*
299 cndnum = badc2
300 anorm = one
301 mode = 3
302*
303 ELSE IF( imat.EQ.17 ) THEN
304*
305* 17. Random, CNDNUM = 0.1/EPS,
306* one small singular value S(N)=1/CNDNUM
307*
308 cndnum = badc2
309 anorm = one
310 mode = 2
311*
312 ELSE IF( imat.EQ.18 ) THEN
313*
314* 18. Random, scaled near underflow
315*
316 cndnum = two
317 anorm = small
318 mode = 3
319*
320 ELSE IF( imat.EQ.19 ) THEN
321*
322* 19. Random, scaled near overflow
323*
324 cndnum = two
325 anorm = large
326 mode = 3
327*
328 END IF
329*
330 END IF
331*
332 ELSE IF( lsamen( 2, c2, 'GE' ) ) THEN
333*
334* xGE: Set parameters to generate a general M x N matrix.
335*
336* Set TYPE, the type of matrix to be generated.
337*
338 TYPE = 'N'
339*
340* Set the lower and upper bandwidths.
341*
342 IF( imat.EQ.1 ) THEN
343 kl = 0
344 ku = 0
345 ELSE IF( imat.EQ.2 ) THEN
346 kl = 0
347 ku = max( n-1, 0 )
348 ELSE IF( imat.EQ.3 ) THEN
349 kl = max( m-1, 0 )
350 ku = 0
351 ELSE
352 kl = max( m-1, 0 )
353 ku = max( n-1, 0 )
354 END IF
355*
356* Set the condition number and norm.
357*
358 IF( imat.EQ.8 ) THEN
359 cndnum = badc1
360 ELSE IF( imat.EQ.9 ) THEN
361 cndnum = badc2
362 ELSE
363 cndnum = two
364 END IF
365*
366 IF( imat.EQ.10 ) THEN
367 anorm = small
368 ELSE IF( imat.EQ.11 ) THEN
369 anorm = large
370 ELSE
371 anorm = one
372 END IF
373*
374 ELSE IF( lsamen( 2, c2, 'GB' ) ) THEN
375*
376* xGB: Set parameters to generate a general banded matrix.
377*
378* Set TYPE, the type of matrix to be generated.
379*
380 TYPE = 'N'
381*
382* Set the condition number and norm.
383*
384 IF( imat.EQ.5 ) THEN
385 cndnum = badc1
386 ELSE IF( imat.EQ.6 ) THEN
387 cndnum = tenth*badc2
388 ELSE
389 cndnum = two
390 END IF
391*
392 IF( imat.EQ.7 ) THEN
393 anorm = small
394 ELSE IF( imat.EQ.8 ) THEN
395 anorm = large
396 ELSE
397 anorm = one
398 END IF
399*
400 ELSE IF( lsamen( 2, c2, 'GT' ) ) THEN
401*
402* xGT: Set parameters to generate a general tridiagonal matrix.
403*
404* Set TYPE, the type of matrix to be generated.
405*
406 TYPE = 'N'
407*
408* Set the lower and upper bandwidths.
409*
410 IF( imat.EQ.1 ) THEN
411 kl = 0
412 ELSE
413 kl = 1
414 END IF
415 ku = kl
416*
417* Set the condition number and norm.
418*
419 IF( imat.EQ.3 ) THEN
420 cndnum = badc1
421 ELSE IF( imat.EQ.4 ) THEN
422 cndnum = badc2
423 ELSE
424 cndnum = two
425 END IF
426*
427 IF( imat.EQ.5 .OR. imat.EQ.11 ) THEN
428 anorm = small
429 ELSE IF( imat.EQ.6 .OR. imat.EQ.12 ) THEN
430 anorm = large
431 ELSE
432 anorm = one
433 END IF
434*
435 ELSE IF( lsamen( 2, c2, 'PO' ) .OR. lsamen( 2, c2, 'PP' ) ) THEN
436*
437* xPO, xPP: Set parameters to generate a
438* symmetric positive definite matrix.
439*
440* Set TYPE, the type of matrix to be generated.
441*
442 TYPE = c2( 1: 1 )
443*
444* Set the lower and upper bandwidths.
445*
446 IF( imat.EQ.1 ) THEN
447 kl = 0
448 ELSE
449 kl = max( n-1, 0 )
450 END IF
451 ku = kl
452*
453* Set the condition number and norm.
454*
455 IF( imat.EQ.6 ) THEN
456 cndnum = badc1
457 ELSE IF( imat.EQ.7 ) THEN
458 cndnum = badc2
459 ELSE
460 cndnum = two
461 END IF
462*
463 IF( imat.EQ.8 ) THEN
464 anorm = small
465 ELSE IF( imat.EQ.9 ) THEN
466 anorm = large
467 ELSE
468 anorm = one
469 END IF
470*
471*
472 ELSE IF( lsamen( 2, c2, 'SY' ) .OR. lsamen( 2, c2, 'SP' ) ) THEN
473*
474* xSY, xSP: Set parameters to generate a
475* symmetric matrix.
476*
477* Set TYPE, the type of matrix to be generated.
478*
479 TYPE = c2( 1: 1 )
480*
481* Set the lower and upper bandwidths.
482*
483 IF( imat.EQ.1 ) THEN
484 kl = 0
485 ELSE
486 kl = max( n-1, 0 )
487 END IF
488 ku = kl
489*
490* Set the condition number and norm.
491*
492 IF( imat.EQ.7 ) THEN
493 cndnum = badc1
494 ELSE IF( imat.EQ.8 ) THEN
495 cndnum = badc2
496 ELSE
497 cndnum = two
498 END IF
499*
500 IF( imat.EQ.9 ) THEN
501 anorm = small
502 ELSE IF( imat.EQ.10 ) THEN
503 anorm = large
504 ELSE
505 anorm = one
506 END IF
507*
508 ELSE IF( lsamen( 2, c2, 'PB' ) ) THEN
509*
510* xPB: Set parameters to generate a symmetric band matrix.
511*
512* Set TYPE, the type of matrix to be generated.
513*
514 TYPE = 'P'
515*
516* Set the norm and condition number.
517*
518 IF( imat.EQ.5 ) THEN
519 cndnum = badc1
520 ELSE IF( imat.EQ.6 ) THEN
521 cndnum = badc2
522 ELSE
523 cndnum = two
524 END IF
525*
526 IF( imat.EQ.7 ) THEN
527 anorm = small
528 ELSE IF( imat.EQ.8 ) THEN
529 anorm = large
530 ELSE
531 anorm = one
532 END IF
533*
534 ELSE IF( lsamen( 2, c2, 'PT' ) ) THEN
535*
536* xPT: Set parameters to generate a symmetric positive definite
537* tridiagonal matrix.
538*
539 TYPE = 'P'
540 IF( imat.EQ.1 ) THEN
541 kl = 0
542 ELSE
543 kl = 1
544 END IF
545 ku = kl
546*
547* Set the condition number and norm.
548*
549 IF( imat.EQ.3 ) THEN
550 cndnum = badc1
551 ELSE IF( imat.EQ.4 ) THEN
552 cndnum = badc2
553 ELSE
554 cndnum = two
555 END IF
556*
557 IF( imat.EQ.5 .OR. imat.EQ.11 ) THEN
558 anorm = small
559 ELSE IF( imat.EQ.6 .OR. imat.EQ.12 ) THEN
560 anorm = large
561 ELSE
562 anorm = one
563 END IF
564*
565 ELSE IF( lsamen( 2, c2, 'TR' ) .OR. lsamen( 2, c2, 'TP' ) ) THEN
566*
567* xTR, xTP: Set parameters to generate a triangular matrix
568*
569* Set TYPE, the type of matrix to be generated.
570*
571 TYPE = 'N'
572*
573* Set the lower and upper bandwidths.
574*
575 mat = abs( imat )
576 IF( mat.EQ.1 .OR. mat.EQ.7 ) THEN
577 kl = 0
578 ku = 0
579 ELSE IF( imat.LT.0 ) THEN
580 kl = max( n-1, 0 )
581 ku = 0
582 ELSE
583 kl = 0
584 ku = max( n-1, 0 )
585 END IF
586*
587* Set the condition number and norm.
588*
589 IF( mat.EQ.3 .OR. mat.EQ.9 ) THEN
590 cndnum = badc1
591 ELSE IF( mat.EQ.4 ) THEN
592 cndnum = badc2
593 ELSE IF( mat.EQ.10 ) THEN
594 cndnum = badc2
595 ELSE
596 cndnum = two
597 END IF
598*
599 IF( mat.EQ.5 ) THEN
600 anorm = small
601 ELSE IF( mat.EQ.6 ) THEN
602 anorm = large
603 ELSE
604 anorm = one
605 END IF
606*
607 ELSE IF( lsamen( 2, c2, 'TB' ) ) THEN
608*
609* xTB: Set parameters to generate a triangular band matrix.
610*
611* Set TYPE, the type of matrix to be generated.
612*
613 TYPE = 'N'
614*
615* Set the norm and condition number.
616*
617 mat = abs( imat )
618 IF( mat.EQ.2 .OR. mat.EQ.8 ) THEN
619 cndnum = badc1
620 ELSE IF( mat.EQ.3 .OR. mat.EQ.9 ) THEN
621 cndnum = badc2
622 ELSE
623 cndnum = two
624 END IF
625*
626 IF( mat.EQ.4 ) THEN
627 anorm = small
628 ELSE IF( mat.EQ.5 ) THEN
629 anorm = large
630 ELSE
631 anorm = one
632 END IF
633 END IF
634 IF( n.LE.1 )
635 $ cndnum = one
636*
637 RETURN
638*
639* End of DLATB4
640*
dlamch
double precision function dlamch(cmach)
DLAMCH
Definition dlamch.f:69
lsamen
logical function lsamen(n, ca, cb)
LSAMEN
Definition lsamen.f:74
Here is the caller graph for this function: