LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
slatb9.f
Go to the documentation of this file.
1 *> \brief \b SLATB9
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 SLATB9( PATH, IMAT, M, P, N, TYPE, KLA, KUA,
12 * KLB, KUB, ANORM, BNORM, MODEA, MODEB,
13 * CNDNMA, CNDNMB, DISTA, DISTB )
14 *
15 * .. Scalar Arguments ..
16 * CHARACTER DISTA, DISTB, TYPE
17 * CHARACTER*3 PATH
18 * INTEGER IMAT, KLA, KUA, KLB, KUB, M, P, MODEA, MODEB, N
19 * REAL ANORM, BNORM, CNDNMA, CNDNMB
20 * ..
21 *
22 *
23 *> \par Purpose:
24 * =============
25 *>
26 *> \verbatim
27 *>
28 *> SLATB9 sets parameters for the matrix generator based on the type of
29 *> matrix to be generated.
30 *> \endverbatim
31 *
32 * Arguments:
33 * ==========
34 *
35 *> \param[in] PATH
36 *> \verbatim
37 *> PATH is CHARACTER*3
38 *> The LAPACK path name.
39 *> \endverbatim
40 *>
41 *> \param[in] IMAT
42 *> \verbatim
43 *> IMAT is INTEGER
44 *> An integer key describing which matrix to generate for this
45 *> path.
46 *> = 1: A: diagonal, B: upper triangular
47 *> = 2: A: upper triangular, B: upper triangular
48 *> = 3: A: lower triangular, B: upper triangular
49 *> Else: A: general dense, B: general dense
50 *> \endverbatim
51 *>
52 *> \param[in] M
53 *> \verbatim
54 *> M is INTEGER
55 *> The number of rows in the matrix to be generated.
56 *> \endverbatim
57 *>
58 *> \param[in] P
59 *> \verbatim
60 *> P is INTEGER
61 *> \endverbatim
62 *>
63 *> \param[in] N
64 *> \verbatim
65 *> N is INTEGER
66 *> The number of columns in the matrix to be generated.
67 *> \endverbatim
68 *>
69 *> \param[out] TYPE
70 *> \verbatim
71 *> TYPE is CHARACTER*1
72 *> The type of the matrix to be generated:
73 *> = 'S': symmetric matrix;
74 *> = 'P': symmetric positive (semi)definite matrix;
75 *> = 'N': nonsymmetric matrix.
76 *> \endverbatim
77 *>
78 *> \param[out] KLA
79 *> \verbatim
80 *> KLA is INTEGER
81 *> The lower band width of the matrix to be generated.
82 *> \endverbatim
83 *>
84 *> \param[out] KUA
85 *> \verbatim
86 *> KUA is INTEGER
87 *> The upper band width of the matrix to be generated.
88 *> \endverbatim
89 *>
90 *> \param[out] KLB
91 *> \verbatim
92 *> KLB is INTEGER
93 *> The lower band width of the matrix to be generated.
94 *> \endverbatim
95 *>
96 *> \param[out] KUB
97 *> \verbatim
98 *> KUA is INTEGER
99 *> The upper band width of the matrix to be generated.
100 *> \endverbatim
101 *>
102 *> \param[out] ANORM
103 *> \verbatim
104 *> ANORM is REAL
105 *> The desired norm of the matrix to be generated. The diagonal
106 *> matrix of singular values or eigenvalues is scaled by this
107 *> value.
108 *> \endverbatim
109 *>
110 *> \param[out] BNORM
111 *> \verbatim
112 *> BNORM is REAL
113 *> The desired norm of the matrix to be generated. The diagonal
114 *> matrix of singular values or eigenvalues is scaled by this
115 *> value.
116 *> \endverbatim
117 *>
118 *> \param[out] MODEA
119 *> \verbatim
120 *> MODEA is INTEGER
121 *> A key indicating how to choose the vector of eigenvalues.
122 *> \endverbatim
123 *>
124 *> \param[out] MODEB
125 *> \verbatim
126 *> MODEB is INTEGER
127 *> A key indicating how to choose the vector of eigenvalues.
128 *> \endverbatim
129 *>
130 *> \param[out] CNDNMA
131 *> \verbatim
132 *> CNDNMA is REAL
133 *> The desired condition number.
134 *> \endverbatim
135 *>
136 *> \param[out] CNDNMB
137 *> \verbatim
138 *> CNDNMB is REAL
139 *> The desired condition number.
140 *> \endverbatim
141 *>
142 *> \param[out] DISTA
143 *> \verbatim
144 *> DISTA is CHARACTER*1
145 *> The type of distribution to be used by the random number
146 *> generator.
147 *> \endverbatim
148 *>
149 *> \param[out] DISTB
150 *> \verbatim
151 *> DISTB is CHARACTER*1
152 *> The type of distribution to be used by the random number
153 *> generator.
154 *> \endverbatim
155 *
156 * Authors:
157 * ========
158 *
159 *> \author Univ. of Tennessee
160 *> \author Univ. of California Berkeley
161 *> \author Univ. of Colorado Denver
162 *> \author NAG Ltd.
163 *
164 *> \ingroup single_eig
165 *
166 * =====================================================================
167  SUBROUTINE slatb9( PATH, IMAT, M, P, N, TYPE, KLA, KUA,
168  $ KLB, KUB, ANORM, BNORM, MODEA, MODEB,
169  $ CNDNMA, CNDNMB, DISTA, DISTB )
170 *
171 * -- LAPACK test routine --
172 * -- LAPACK is a software package provided by Univ. of Tennessee, --
173 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
174 *
175 * .. Scalar Arguments ..
176  CHARACTER DISTA, DISTB, TYPE
177  CHARACTER*3 PATH
178  INTEGER IMAT, KLA, KUA, KLB, KUB, M, P, MODEA, MODEB, N
179  REAL ANORM, BNORM, CNDNMA, CNDNMB
180 * ..
181 *
182 * =====================================================================
183 *
184 * .. Parameters ..
185  REAL SHRINK, TENTH
186  PARAMETER ( SHRINK = 0.25e0, tenth = 0.1e+0 )
187  REAL ONE, TEN
188  parameter( one = 1.0e+0, ten = 1.0e+1 )
189 * ..
190 * .. Local Scalars ..
191  LOGICAL FIRST
192  REAL BADC1, BADC2, EPS, LARGE, SMALL
193 * ..
194 * .. External Functions ..
195  LOGICAL LSAMEN
196  REAL SLAMCH
197  EXTERNAL lsamen, slamch
198 * ..
199 * .. Intrinsic Functions ..
200  INTRINSIC max, sqrt
201 * ..
202 * .. External Subroutines ..
203  EXTERNAL slabad
204 * ..
205 * .. Save statement ..
206  SAVE eps, small, large, badc1, badc2, first
207 * ..
208 * .. Data statements ..
209  DATA first / .true. /
210 * ..
211 * .. Executable Statements ..
212 *
213 * Set some constants for use in the subroutine.
214 *
215  IF( first ) THEN
216  first = .false.
217  eps = slamch( 'Precision' )
218  badc2 = tenth / eps
219  badc1 = sqrt( badc2 )
220  small = slamch( 'Safe minimum' )
221  large = one / small
222 *
223 * If it looks like we're on a Cray, take the square root of
224 * SMALL and LARGE to avoid overflow and underflow problems.
225 *
226  CALL slabad( small, large )
227  small = shrink*( small / eps )
228  large = one / small
229  END IF
230 *
231 * Set some parameters we don't plan to change.
232 *
233  TYPE = 'N'
234  dista = 'S'
235  distb = 'S'
236  modea = 3
237  modeb = 4
238 *
239 * Set the lower and upper bandwidths.
240 *
241  IF( lsamen( 3, path, 'GRQ') .OR. lsamen( 3, path, 'LSE') .OR.
242  $ lsamen( 3, path, 'GSV') )THEN
243 *
244 * A: M by N, B: P by N
245 *
246  IF( imat.EQ.1 ) THEN
247 *
248 * A: diagonal, B: upper triangular
249 *
250  kla = 0
251  kua = 0
252  klb = 0
253  kub = max( n-1,0 )
254 *
255  ELSE IF( imat.EQ.2 ) THEN
256 *
257 * A: upper triangular, B: upper triangular
258 *
259  kla = 0
260  kua = max( n-1, 0 )
261  klb = 0
262  kub = max( n-1, 0 )
263 *
264  ELSE IF( imat.EQ.3 ) THEN
265 *
266 * A: lower triangular, B: upper triangular
267 *
268  kla = max( m-1, 0 )
269  kua = 0
270  klb = 0
271  kub = max( n-1, 0 )
272 *
273  ELSE
274 *
275 * A: general dense, B: general dense
276 *
277  kla = max( m-1, 0 )
278  kua = max( n-1, 0 )
279  klb = max( p-1, 0 )
280  kub = max( n-1, 0 )
281 *
282  END IF
283 *
284  ELSE IF( lsamen( 3, path, 'GQR' ) .OR.
285  $ lsamen( 3, path, 'GLM') )THEN
286 *
287 * A: N by M, B: N by P
288 *
289  IF( imat.EQ.1 ) THEN
290 *
291 * A: diagonal, B: lower triangular
292 *
293  kla = 0
294  kua = 0
295  klb = max( n-1,0 )
296  kub = 0
297  ELSE IF( imat.EQ.2 ) THEN
298 *
299 * A: lower triangular, B: diagonal
300 *
301  kla = max( n-1, 0 )
302  kua = 0
303  klb = 0
304  kub = 0
305 *
306  ELSE IF( imat.EQ.3 ) THEN
307 *
308 * A: lower triangular, B: upper triangular
309 *
310  kla = max( n-1, 0 )
311  kua = 0
312  klb = 0
313  kub = max( p-1, 0 )
314 *
315  ELSE
316 *
317 * A: general dense, B: general dense
318 *
319  kla = max( n-1, 0 )
320  kua = max( m-1, 0 )
321  klb = max( n-1, 0 )
322  kub = max( p-1, 0 )
323  END IF
324 *
325  END IF
326 *
327 * Set the condition number and norm.
328 *
329  cndnma = ten*ten
330  cndnmb = ten
331  IF( lsamen( 3, path, 'GQR') .OR. lsamen( 3, path, 'GRQ') .OR.
332  $ lsamen( 3, path, 'GSV') )THEN
333  IF( imat.EQ.5 ) THEN
334  cndnma = badc1
335  cndnmb = badc1
336  ELSE IF( imat.EQ.6 ) THEN
337  cndnma = badc2
338  cndnmb = badc2
339  ELSE IF( imat.EQ.7 ) THEN
340  cndnma = badc1
341  cndnmb = badc2
342  ELSE IF( imat.EQ.8 ) THEN
343  cndnma = badc2
344  cndnmb = badc1
345  END IF
346  END IF
347 *
348  anorm = ten
349  bnorm = ten*ten*ten
350  IF( lsamen( 3, path, 'GQR') .OR. lsamen( 3, path, 'GRQ') )THEN
351  IF( imat.EQ.7 ) THEN
352  anorm = small
353  bnorm = large
354  ELSE IF( imat.EQ.8 ) THEN
355  anorm = large
356  bnorm = small
357  END IF
358  END IF
359 *
360  IF( n.LE.1 )THEN
361  cndnma = one
362  cndnmb = one
363  END IF
364 *
365  RETURN
366 *
367 * End of SLATB9
368 *
369  END
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:74
subroutine slatb9(PATH, IMAT, M, P, N, TYPE, KLA, KUA, KLB, KUB, ANORM, BNORM, MODEA, MODEB, CNDNMA, CNDNMB, DISTA, DISTB)
SLATB9
Definition: slatb9.f:170