OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dlatb4.f
Go to the documentation of this file.
1*> \brief \b DLATB4
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8* Definition:
9* ===========
10*
11* SUBROUTINE DLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE,
12* CNDNUM, DIST )
13*
14* .. Scalar Arguments ..
15* CHARACTER DIST, TYPE
16* CHARACTER*3 PATH
17* INTEGER IMAT, KL, KU, M, MODE, N
18* DOUBLE PRECISION ANORM, CNDNUM
19* ..
20*
21*
22*> \par Purpose:
23* =============
24*>
25*> \verbatim
26*>
27*> DLATB4 sets parameters for the matrix generator based on the type of
28*> matrix to be generated.
29*> \endverbatim
30*
31* Arguments:
32* ==========
33*
34*> \param[in] PATH
35*> \verbatim
36*> PATH is CHARACTER*3
37*> The LAPACK path name.
38*> \endverbatim
39*>
40*> \param[in] IMAT
41*> \verbatim
42*> IMAT is INTEGER
43*> An integer key describing which matrix to generate for this
44*> path.
45*> \endverbatim
46*>
47*> \param[in] M
48*> \verbatim
49*> M is INTEGER
50*> The number of rows in the matrix to be generated.
51*> \endverbatim
52*>
53*> \param[in] N
54*> \verbatim
55*> N is INTEGER
56*> The number of columns in the matrix to be generated.
57*> \endverbatim
58*>
59*> \param[out] TYPE
60*> \verbatim
61*> TYPE is CHARACTER*1
62*> The type of the matrix to be generated:
63*> = 'S': symmetric matrix
64*> = 'P': symmetric positive (semi)definite matrix
65*> = 'N': nonsymmetric matrix
66*> \endverbatim
67*>
68*> \param[out] KL
69*> \verbatim
70*> KL is INTEGER
71*> The lower band width of the matrix to be generated.
72*> \endverbatim
73*>
74*> \param[out] KU
75*> \verbatim
76*> KU is INTEGER
77*> The upper band width of the matrix to be generated.
78*> \endverbatim
79*>
80*> \param[out] ANORM
81*> \verbatim
82*> ANORM is DOUBLE PRECISION
83*> The desired norm of the matrix to be generated. The diagonal
84*> matrix of singular values or eigenvalues is scaled by this
85*> value.
86*> \endverbatim
87*>
88*> \param[out] MODE
89*> \verbatim
90*> MODE is INTEGER
91*> A key indicating how to choose the vector of eigenvalues.
92*> \endverbatim
93*>
94*> \param[out] CNDNUM
95*> \verbatim
96*> CNDNUM is DOUBLE PRECISION
97*> The desired condition number.
98*> \endverbatim
99*>
100*> \param[out] DIST
101*> \verbatim
102*> DIST is CHARACTER*1
103*> The type of distribution to be used by the random number
104*> generator.
105*> \endverbatim
106*
107* Authors:
108* ========
109*
110*> \author Univ. of Tennessee
111*> \author Univ. of California Berkeley
112*> \author Univ. of Colorado Denver
113*> \author NAG Ltd.
114*
115*> \ingroup double_lin
116*
117* =====================================================================
118 SUBROUTINE dlatb4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE,
119 $ CNDNUM, DIST )
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.25d0, 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* .. External Subroutines ..
157 EXTERNAL dlabad
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 = dlamch( 'Precision' )
172 badc2 = tenth / eps
173 badc1 = sqrt( badc2 )
174 small = dlamch( '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 dlabad( 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.EQ. IF( IMAT1 ) 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.EQ. IF( IMAT3 ) THEN
324 CNDNUM = BADC1
325.EQ. ELSE IF( IMAT4 ) THEN
326 CNDNUM = BADC2
327 ELSE
328 CNDNUM = TWO
329 END IF
330*
331.EQ..OR..EQ. IF( IMAT5 IMAT11 ) THEN
332 ANORM = SMALL
333.EQ..OR..EQ. ELSE IF( IMAT6 IMAT12 ) 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: 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.EQ. IF( IMAT1 ) 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.EQ. IF( IMAT6 ) THEN
360 CNDNUM = BADC1
361.EQ. ELSE IF( IMAT7 ) THEN
362 CNDNUM = BADC2
363 ELSE
364 CNDNUM = TWO
365 END IF
366*
367.EQ. IF( IMAT8 ) THEN
368 ANORM = SMALL
369.EQ. ELSE IF( IMAT9 ) 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.EQ. IF( IMAT1 ) 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.EQ. IF( IMAT7 ) THEN
397 CNDNUM = BADC1
398.EQ. ELSE IF( IMAT8 ) THEN
399 CNDNUM = BADC2
400 ELSE
401 CNDNUM = TWO
402 END IF
403*
404.EQ. IF( IMAT9 ) THEN
405 ANORM = SMALL
406.EQ. ELSE IF( IMAT10 ) 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.EQ. IF( IMAT5 ) THEN
423 CNDNUM = BADC1
424.EQ. ELSE IF( IMAT6 ) THEN
425 CNDNUM = BADC2
426 ELSE
427 CNDNUM = TWO
428 END IF
429*
430.EQ. IF( IMAT7 ) THEN
431 ANORM = SMALL
432.EQ. ELSE IF( IMAT8 ) 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.EQ. IF( IMAT1 ) 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.EQ. IF( IMAT3 ) THEN
454 CNDNUM = BADC1
455.EQ. ELSE IF( IMAT4 ) THEN
456 CNDNUM = BADC2
457 ELSE
458 CNDNUM = TWO
459 END IF
460*
461.EQ..OR..EQ. IF( IMAT5 IMAT11 ) THEN
462 ANORM = SMALL
463.EQ..OR..EQ. ELSE IF( IMAT6 IMAT12 ) 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.EQ..OR..EQ. IF( MAT1 MAT7 ) THEN
481 KL = 0
482 KU = 0
483.LT. ELSE IF( IMAT0 ) 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.EQ..OR..EQ. IF( MAT3 MAT9 ) THEN
494 CNDNUM = BADC1
495.EQ. ELSE IF( MAT4 ) THEN
496 CNDNUM = BADC2
497.EQ. ELSE IF( MAT10 ) THEN
498 CNDNUM = BADC2
499 ELSE
500 CNDNUM = TWO
501 END IF
502*
503.EQ. IF( MAT5 ) THEN
504 ANORM = SMALL
505.EQ. ELSE IF( MAT6 ) 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.EQ..OR..EQ. IF( IMAT2 IMAT8 ) THEN
522 CNDNUM = BADC1
523.EQ..OR..EQ. ELSE IF( IMAT3 IMAT9 ) THEN
524 CNDNUM = BADC2
525 ELSE
526 CNDNUM = TWO
527 END IF
528*
529.EQ. IF( IMAT4 ) THEN
530 ANORM = SMALL
531.EQ. ELSE IF( IMAT5 ) THEN
532 ANORM = LARGE
533 ELSE
534 ANORM = ONE
535 END IF
536 END IF
537.LE. IF( N1 )
538 $ CNDNUM = ONE
539*
540 RETURN
541*
542* End of DLATB4
543*
544 END
dlabad
subroutine dlabad(small, large)
DLABAD
Definition dlabad.f:74
dlatb4
subroutine dlatb4(path, imat, m, n, type, kl, ku, anorm, mode, cndnum, dist)
DLATB4
Definition dlatb4.f:120
max
#define max(a, b)
Definition macros.h:21