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

◆ slatb4()

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.

Definition at line 118 of file slatb4.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 REAL ANORM, CNDNUM
130* ..
131*
132* =====================================================================
133*
134* .. Parameters ..
135 REAL SHRINK, TENTH
136 parameter( shrink = 0.25e0, tenth = 0.1e+0 )
137 REAL ONE
138 parameter( one = 1.0e+0 )
139 REAL TWO
140 parameter( two = 2.0e+0 )
141* ..
142* .. Local Scalars ..
143 LOGICAL FIRST
144 CHARACTER*2 C2
145 INTEGER MAT
146 REAL BADC1, BADC2, EPS, LARGE, SMALL
147* ..
148* .. External Functions ..
149 LOGICAL LSAMEN
150 REAL SLAMCH
151 EXTERNAL lsamen, slamch
152* ..
153* .. Intrinsic Functions ..
154 INTRINSIC abs, max, sqrt
155* ..
156* .. External Subroutines ..
157 EXTERNAL slabad
158* ..
159* .. Save statement ..
160 SAVE eps, small, large, badc1, badc2, first
161* ..
162* .. Data statements ..
163 DATA first / .true. /
164* ..
165* .. Executable Statements ..
166*
167* Set some constants for use in the subroutine.
168*
169 IF( first ) THEN
170 first = .false.
171 eps = slamch( 'Precision' )
172 badc2 = tenth / eps
173 badc1 = sqrt( badc2 )
174 small = slamch( 'Safe minimum' )
175 large = one / small
176*
177* If it looks like we're on a Cray, take the square root of
178* SMALL and LARGE to avoid overflow and underflow problems.
179*
180 CALL slabad( small, large )
181 small = shrink*( small / eps )
182 large = one / small
183 END IF
184*
185 c2 = path( 2: 3 )
186*
187* Set some parameters we don't plan to change.
188*
189 dist = 'S'
190 mode = 3
191*
192 IF( lsamen( 2, c2, 'QR' ) .OR. lsamen( 2, c2, 'LQ' ) .OR.
193 $ lsamen( 2, c2, 'QL' ) .OR. lsamen( 2, c2, 'RQ' ) ) THEN
194*
195* xQR, xLQ, xQL, xRQ: Set parameters to generate a general
196* M x N matrix.
197*
198* Set TYPE, the type of matrix to be generated.
199*
200 TYPE = 'N'
201*
202* Set the lower and upper bandwidths.
203*
204 IF( imat.EQ.1 ) THEN
205 kl = 0
206 ku = 0
207 ELSE IF( imat.EQ.2 ) THEN
208 kl = 0
209 ku = max( n-1, 0 )
210 ELSE IF( imat.EQ.3 ) THEN
211 kl = max( m-1, 0 )
212 ku = 0
213 ELSE
214 kl = max( m-1, 0 )
215 ku = max( n-1, 0 )
216 END IF
217*
218* Set the condition number and norm.
219*
220 IF( imat.EQ.5 ) THEN
221 cndnum = badc1
222 ELSE IF( imat.EQ.6 ) THEN
223 cndnum = badc2
224 ELSE
225 cndnum = two
226 END IF
227*
228 IF( imat.EQ.7 ) THEN
229 anorm = small
230 ELSE IF( imat.EQ.8 ) THEN
231 anorm = large
232 ELSE
233 anorm = one
234 END IF
235*
236 ELSE IF( lsamen( 2, c2, 'GE' ) ) THEN
237*
238* xGE: Set parameters to generate a general M x N matrix.
239*
240* Set TYPE, the type of matrix to be generated.
241*
242 TYPE = 'N'
243*
244* Set the lower and upper bandwidths.
245*
246 IF( imat.EQ.1 ) THEN
247 kl = 0
248 ku = 0
249 ELSE IF( imat.EQ.2 ) THEN
250 kl = 0
251 ku = max( n-1, 0 )
252 ELSE IF( imat.EQ.3 ) THEN
253 kl = max( m-1, 0 )
254 ku = 0
255 ELSE
256 kl = max( m-1, 0 )
257 ku = max( n-1, 0 )
258 END IF
259*
260* Set the condition number and norm.
261*
262 IF( imat.EQ.8 ) THEN
263 cndnum = badc1
264 ELSE IF( imat.EQ.9 ) THEN
265 cndnum = badc2
266 ELSE
267 cndnum = two
268 END IF
269*
270 IF( imat.EQ.10 ) THEN
271 anorm = small
272 ELSE IF( imat.EQ.11 ) THEN
273 anorm = large
274 ELSE
275 anorm = one
276 END IF
277*
278 ELSE IF( lsamen( 2, c2, 'GB' ) ) THEN
279*
280* xGB: Set parameters to generate a general banded matrix.
281*
282* Set TYPE, the type of matrix to be generated.
283*
284 TYPE = 'N'
285*
286* Set the condition number and norm.
287*
288 IF( imat.EQ.5 ) THEN
289 cndnum = badc1
290 ELSE IF( imat.EQ.6 ) THEN
291 cndnum = tenth*badc2
292 ELSE
293 cndnum = two
294 END IF
295*
296 IF( imat.EQ.7 ) THEN
297 anorm = small
298 ELSE IF( imat.EQ.8 ) THEN
299 anorm = large
300 ELSE
301 anorm = one
302 END IF
303*
304 ELSE IF( lsamen( 2, c2, 'GT' ) ) THEN
305*
306* xGT: Set parameters to generate a general tridiagonal matrix.
307*
308* Set TYPE, the type of matrix to be generated.
309*
310 TYPE = 'N'
311*
312* Set the lower and upper bandwidths.
313*
314 IF( imat.EQ.1 ) THEN
315 kl = 0
316 ELSE
317 kl = 1
318 END IF
319 ku = kl
320*
321* Set the condition number and norm.
322*
323 IF( imat.EQ.3 ) THEN
324 cndnum = badc1
325 ELSE IF( imat.EQ.4 ) THEN
326 cndnum = badc2
327 ELSE
328 cndnum = two
329 END IF
330*
331 IF( imat.EQ.5 .OR. imat.EQ.11 ) THEN
332 anorm = small
333 ELSE IF( imat.EQ.6 .OR. imat.EQ.12 ) THEN
334 anorm = large
335 ELSE
336 anorm = one
337 END IF
338*
339 ELSE IF( lsamen( 2, c2, 'PO' ) .OR. lsamen( 2, c2, 'PP' ) ) THEN
340*
341* xPO, xPP, xSY, xSP: Set parameters to generate a
342* symmetric positive definite matrix.
343*
344* Set TYPE, the type of matrix to be generated.
345*
346 TYPE = c2( 1: 1 )
347*
348* Set the lower and upper bandwidths.
349*
350 IF( imat.EQ.1 ) THEN
351 kl = 0
352 ELSE
353 kl = max( n-1, 0 )
354 END IF
355 ku = kl
356*
357* Set the condition number and norm.
358*
359 IF( imat.EQ.6 ) THEN
360 cndnum = badc1
361 ELSE IF( imat.EQ.7 ) THEN
362 cndnum = badc2
363 ELSE
364 cndnum = two
365 END IF
366*
367 IF( imat.EQ.8 ) THEN
368 anorm = small
369 ELSE IF( imat.EQ.9 ) THEN
370 anorm = large
371 ELSE
372 anorm = one
373 END IF
374*
375*
376 ELSE IF( lsamen( 2, c2, 'SY' ) .OR. lsamen( 2, c2, 'SP' ) ) THEN
377*
378* xSY, xSP: Set parameters to generate a
379* symmetric matrix.
380*
381* Set TYPE, the type of matrix to be generated.
382*
383 TYPE = c2( 1: 1 )
384*
385* Set the lower and upper bandwidths.
386*
387 IF( imat.EQ.1 ) THEN
388 kl = 0
389 ELSE
390 kl = max( n-1, 0 )
391 END IF
392 ku = kl
393*
394* Set the condition number and norm.
395*
396 IF( imat.EQ.7 ) THEN
397 cndnum = badc1
398 ELSE IF( imat.EQ.8 ) THEN
399 cndnum = badc2
400 ELSE
401 cndnum = two
402 END IF
403*
404 IF( imat.EQ.9 ) THEN
405 anorm = small
406 ELSE IF( imat.EQ.10 ) THEN
407 anorm = large
408 ELSE
409 anorm = one
410 END IF
411*
412 ELSE IF( lsamen( 2, c2, 'PB' ) ) THEN
413*
414* xPB: Set parameters to generate a symmetric band matrix.
415*
416* Set TYPE, the type of matrix to be generated.
417*
418 TYPE = 'P'
419*
420* Set the norm and condition number.
421*
422 IF( imat.EQ.5 ) THEN
423 cndnum = badc1
424 ELSE IF( imat.EQ.6 ) THEN
425 cndnum = badc2
426 ELSE
427 cndnum = two
428 END IF
429*
430 IF( imat.EQ.7 ) THEN
431 anorm = small
432 ELSE IF( imat.EQ.8 ) THEN
433 anorm = large
434 ELSE
435 anorm = one
436 END IF
437*
438 ELSE IF( lsamen( 2, c2, 'PT' ) ) THEN
439*
440* xPT: Set parameters to generate a symmetric positive definite
441* tridiagonal matrix.
442*
443 TYPE = 'P'
444 IF( imat.EQ.1 ) THEN
445 kl = 0
446 ELSE
447 kl = 1
448 END IF
449 ku = kl
450*
451* Set the condition number and norm.
452*
453 IF( imat.EQ.3 ) THEN
454 cndnum = badc1
455 ELSE IF( imat.EQ.4 ) THEN
456 cndnum = badc2
457 ELSE
458 cndnum = two
459 END IF
460*
461 IF( imat.EQ.5 .OR. imat.EQ.11 ) THEN
462 anorm = small
463 ELSE IF( imat.EQ.6 .OR. imat.EQ.12 ) THEN
464 anorm = large
465 ELSE
466 anorm = one
467 END IF
468*
469 ELSE IF( lsamen( 2, c2, 'TR' ) .OR. lsamen( 2, c2, 'TP' ) ) THEN
470*
471* xTR, xTP: Set parameters to generate a triangular matrix
472*
473* Set TYPE, the type of matrix to be generated.
474*
475 TYPE = 'N'
476*
477* Set the lower and upper bandwidths.
478*
479 mat = abs( imat )
480 IF( mat.EQ.1 .OR. mat.EQ.7 ) THEN
481 kl = 0
482 ku = 0
483 ELSE IF( imat.LT.0 ) THEN
484 kl = max( n-1, 0 )
485 ku = 0
486 ELSE
487 kl = 0
488 ku = max( n-1, 0 )
489 END IF
490*
491* Set the condition number and norm.
492*
493 IF( mat.EQ.3 .OR. mat.EQ.9 ) THEN
494 cndnum = badc1
495 ELSE IF( mat.EQ.4 ) THEN
496 cndnum = badc2
497 ELSE IF( mat.EQ.10 ) THEN
498 cndnum = badc2
499 ELSE
500 cndnum = two
501 END IF
502*
503 IF( mat.EQ.5 ) THEN
504 anorm = small
505 ELSE IF( mat.EQ.6 ) THEN
506 anorm = large
507 ELSE
508 anorm = one
509 END IF
510*
511 ELSE IF( lsamen( 2, c2, 'TB' ) ) THEN
512*
513* xTB: Set parameters to generate a triangular band matrix.
514*
515* Set TYPE, the type of matrix to be generated.
516*
517 TYPE = 'N'
518*
519* Set the norm and condition number.
520*
521 mat = abs( imat )
522 IF( mat.EQ.2 .OR. mat.EQ.8 ) THEN
523 cndnum = badc1
524 ELSE IF( mat.EQ.3 .OR. mat.EQ.9 ) THEN
525 cndnum = badc2
526 ELSE
527 cndnum = two
528 END IF
529*
530 IF( mat.EQ.4 ) THEN
531 anorm = small
532 ELSE IF( mat.EQ.5 ) THEN
533 anorm = large
534 ELSE
535 anorm = one
536 END IF
537 END IF
538 IF( n.LE.1 )
539 $ cndnum = one
540*
541 RETURN
542*
543* End of SLATB4
544*
lsamen
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:74
slabad
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:74
slamch
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:68
Here is the call graph for this function:
Here is the caller graph for this function: