LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
slatb5.f
Go to the documentation of this file.
1*> \brief \b SLATB5
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 SLATB5( PATH, IMAT, N, TYPE, KL, KU, ANORM, MODE,
12* CNDNUM, DIST )
13*
14* .. Scalar Arguments ..
15* REAL ANORM, CNDNUM
16* INTEGER IMAT, KL, KU, MODE, N
17* CHARACTER DIST, TYPE
18* CHARACTER*3 PATH
19* ..
20*
21*
22*> \par Purpose:
23* =============
24*>
25*> \verbatim
26*>
27*> SLATB5 sets parameters for the matrix generator based on the type
28*> of 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] N
48*> \verbatim
49*> N is INTEGER
50*> The number of rows and columns in the matrix to be generated.
51*> \endverbatim
52*>
53*> \param[out] TYPE
54*> \verbatim
55*> TYPE is CHARACTER*1
56*> The type of the matrix to be generated:
57*> = 'S': symmetric matrix
58*> = 'P': symmetric positive (semi)definite matrix
59*> = 'N': nonsymmetric matrix
60*> \endverbatim
61*>
62*> \param[out] KL
63*> \verbatim
64*> KL is INTEGER
65*> The lower band width of the matrix to be generated.
66*> \endverbatim
67*>
68*> \param[out] KU
69*> \verbatim
70*> KU is INTEGER
71*> The upper band width of the matrix to be generated.
72*> \endverbatim
73*>
74*> \param[out] ANORM
75*> \verbatim
76*> ANORM is REAL
77*> The desired norm of the matrix to be generated. The diagonal
78*> matrix of singular values or eigenvalues is scaled by this
79*> value.
80*> \endverbatim
81*>
82*> \param[out] MODE
83*> \verbatim
84*> MODE is INTEGER
85*> A key indicating how to choose the vector of eigenvalues.
86*> \endverbatim
87*>
88*> \param[out] CNDNUM
89*> \verbatim
90*> CNDNUM is REAL
91*> The desired condition number.
92*> \endverbatim
93*>
94*> \param[out] DIST
95*> \verbatim
96*> DIST is CHARACTER*1
97*> The type of distribution to be used by the random number
98*> generator.
99*> \endverbatim
100*
101* Authors:
102* ========
103*
104*> \author Univ. of Tennessee
105*> \author Univ. of California Berkeley
106*> \author Univ. of Colorado Denver
107*> \author NAG Ltd.
108*
109*> \ingroup single_lin
110*
111* =====================================================================
112 SUBROUTINE slatb5( PATH, IMAT, N, TYPE, KL, KU, ANORM, MODE,
113 $ CNDNUM, DIST )
114*
115* -- LAPACK test routine --
116* -- LAPACK is a software package provided by Univ. of Tennessee, --
117* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
118*
119* .. Scalar Arguments ..
120 REAL ANORM, CNDNUM
121 INTEGER IMAT, KL, KU, MODE, N
122 CHARACTER DIST, TYPE
123 CHARACTER*3 PATH
124* ..
125*
126* =====================================================================
127*
128* .. Parameters ..
129 REAL SHRINK, TENTH
130 parameter( shrink = 0.25e0, tenth = 0.1e+0 )
131 REAL ONE
132 parameter( one = 1.0e+0 )
133 REAL TWO
134 parameter( two = 2.0e+0 )
135* ..
136* .. Local Scalars ..
137 REAL BADC1, BADC2, EPS, LARGE, SMALL
138 LOGICAL FIRST
139 CHARACTER*2 C2
140* ..
141* .. External Functions ..
142 REAL SLAMCH
143 EXTERNAL slamch
144* ..
145* .. Intrinsic Functions ..
146 INTRINSIC max, sqrt
147* ..
148* .. External Subroutines ..
149 EXTERNAL slabad
150* ..
151* .. Save statement ..
152 SAVE eps, small, large, badc1, badc2, first
153* ..
154* .. Data statements ..
155 DATA first / .true. /
156* ..
157* .. Executable Statements ..
158*
159* Set some constants for use in the subroutine.
160*
161 IF( first ) THEN
162 first = .false.
163 eps = slamch( 'Precision' )
164 badc2 = tenth / eps
165 badc1 = sqrt( badc2 )
166 small = slamch( 'Safe minimum' )
167 large = one / small
168*
169* If it looks like we're on a Cray, take the square root of
170* SMALL and LARGE to avoid overflow and underflow problems.
171*
172 CALL slabad( small, large )
173 small = shrink*( small / eps )
174 large = one / small
175 END IF
176*
177 c2 = path( 2: 3 )
178*
179* Set some parameters
180*
181 dist = 'S'
182 mode = 3
183*
184* Set TYPE, the type of matrix to be generated.
185*
186 TYPE = c2( 1: 1 )
187*
188* Set the lower and upper bandwidths.
189*
190 IF( imat.EQ.1 ) THEN
191 kl = 0
192 ELSE
193 kl = max( n-1, 0 )
194 END IF
195 ku = kl
196*
197* Set the condition number and norm.etc
198*
199 IF( imat.EQ.3 ) THEN
200 cndnum = 1.0e4
201 mode = 2
202 ELSE IF( imat.EQ.4 ) THEN
203 cndnum = 1.0e4
204 mode = 1
205 ELSE IF( imat.EQ.5 ) THEN
206 cndnum = 1.0e4
207 mode = 3
208 ELSE IF( imat.EQ.6 ) THEN
209 cndnum = badc1
210 ELSE IF( imat.EQ.7 ) THEN
211 cndnum = badc2
212 ELSE
213 cndnum = two
214 END IF
215*
216 IF( imat.EQ.8 ) THEN
217 anorm = small
218 ELSE IF( imat.EQ.9 ) THEN
219 anorm = large
220 ELSE
221 anorm = one
222 END IF
223*
224 IF( n.LE.1 )
225 $ cndnum = one
226*
227 RETURN
228*
229* End of SLATB5
230*
231 END
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:74
subroutine slatb5(PATH, IMAT, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
SLATB5
Definition: slatb5.f:114