LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
zlatm4.f
Go to the documentation of this file.
1*> \brief \b ZLATM4
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 ZLATM4( ITYPE, N, NZ1, NZ2, RSIGN, AMAGN, RCOND,
12* TRIANG, IDIST, ISEED, A, LDA )
13*
14* .. Scalar Arguments ..
15* LOGICAL RSIGN
16* INTEGER IDIST, ITYPE, LDA, N, NZ1, NZ2
17* DOUBLE PRECISION AMAGN, RCOND, TRIANG
18* ..
19* .. Array Arguments ..
20* INTEGER ISEED( 4 )
21* COMPLEX*16 A( LDA, * )
22* ..
23*
24*
25*> \par Purpose:
26* =============
27*>
28*> \verbatim
29*>
30*> ZLATM4 generates basic square matrices, which may later be
31*> multiplied by others in order to produce test matrices. It is
32*> intended mainly to be used to test the generalized eigenvalue
33*> routines.
34*>
35*> It first generates the diagonal and (possibly) subdiagonal,
36*> according to the value of ITYPE, NZ1, NZ2, RSIGN, AMAGN, and RCOND.
37*> It then fills in the upper triangle with random numbers, if TRIANG is
38*> non-zero.
39*> \endverbatim
40*
41* Arguments:
42* ==========
43*
44*> \param[in] ITYPE
45*> \verbatim
46*> ITYPE is INTEGER
47*> The "type" of matrix on the diagonal and sub-diagonal.
48*> If ITYPE < 0, then type abs(ITYPE) is generated and then
49*> swapped end for end (A(I,J) := A'(N-J,N-I).) See also
50*> the description of AMAGN and RSIGN.
51*>
52*> Special types:
53*> = 0: the zero matrix.
54*> = 1: the identity.
55*> = 2: a transposed Jordan block.
56*> = 3: If N is odd, then a k+1 x k+1 transposed Jordan block
57*> followed by a k x k identity block, where k=(N-1)/2.
58*> If N is even, then k=(N-2)/2, and a zero diagonal entry
59*> is tacked onto the end.
60*>
61*> Diagonal types. The diagonal consists of NZ1 zeros, then
62*> k=N-NZ1-NZ2 nonzeros. The subdiagonal is zero. ITYPE
63*> specifies the nonzero diagonal entries as follows:
64*> = 4: 1, ..., k
65*> = 5: 1, RCOND, ..., RCOND
66*> = 6: 1, ..., 1, RCOND
67*> = 7: 1, a, a^2, ..., a^(k-1)=RCOND
68*> = 8: 1, 1-d, 1-2*d, ..., 1-(k-1)*d=RCOND
69*> = 9: random numbers chosen from (RCOND,1)
70*> = 10: random numbers with distribution IDIST (see ZLARND.)
71*> \endverbatim
72*>
73*> \param[in] N
74*> \verbatim
75*> N is INTEGER
76*> The order of the matrix.
77*> \endverbatim
78*>
79*> \param[in] NZ1
80*> \verbatim
81*> NZ1 is INTEGER
82*> If abs(ITYPE) > 3, then the first NZ1 diagonal entries will
83*> be zero.
84*> \endverbatim
85*>
86*> \param[in] NZ2
87*> \verbatim
88*> NZ2 is INTEGER
89*> If abs(ITYPE) > 3, then the last NZ2 diagonal entries will
90*> be zero.
91*> \endverbatim
92*>
93*> \param[in] RSIGN
94*> \verbatim
95*> RSIGN is LOGICAL
96*> = .TRUE.: The diagonal and subdiagonal entries will be
97*> multiplied by random numbers of magnitude 1.
98*> = .FALSE.: The diagonal and subdiagonal entries will be
99*> left as they are (usually non-negative real.)
100*> \endverbatim
101*>
102*> \param[in] AMAGN
103*> \verbatim
104*> AMAGN is DOUBLE PRECISION
105*> The diagonal and subdiagonal entries will be multiplied by
106*> AMAGN.
107*> \endverbatim
108*>
109*> \param[in] RCOND
110*> \verbatim
111*> RCOND is DOUBLE PRECISION
112*> If abs(ITYPE) > 4, then the smallest diagonal entry will be
113*> RCOND. RCOND must be between 0 and 1.
114*> \endverbatim
115*>
116*> \param[in] TRIANG
117*> \verbatim
118*> TRIANG is DOUBLE PRECISION
119*> The entries above the diagonal will be random numbers with
120*> magnitude bounded by TRIANG (i.e., random numbers multiplied
121*> by TRIANG.)
122*> \endverbatim
123*>
124*> \param[in] IDIST
125*> \verbatim
126*> IDIST is INTEGER
127*> On entry, DIST specifies the type of distribution to be used
128*> to generate a random matrix .
129*> = 1: real and imaginary parts each UNIFORM( 0, 1 )
130*> = 2: real and imaginary parts each UNIFORM( -1, 1 )
131*> = 3: real and imaginary parts each NORMAL( 0, 1 )
132*> = 4: complex number uniform in DISK( 0, 1 )
133*> \endverbatim
134*>
135*> \param[in,out] ISEED
136*> \verbatim
137*> ISEED is INTEGER array, dimension (4)
138*> On entry ISEED specifies the seed of the random number
139*> generator. The values of ISEED are changed on exit, and can
140*> be used in the next call to ZLATM4 to continue the same
141*> random number sequence.
142*> Note: ISEED(4) should be odd, for the random number generator
143*> used at present.
144*> \endverbatim
145*>
146*> \param[out] A
147*> \verbatim
148*> A is COMPLEX*16 array, dimension (LDA, N)
149*> Array to be computed.
150*> \endverbatim
151*>
152*> \param[in] LDA
153*> \verbatim
154*> LDA is INTEGER
155*> Leading dimension of A. Must be at least 1 and at least N.
156*> \endverbatim
157*
158* Authors:
159* ========
160*
161*> \author Univ. of Tennessee
162*> \author Univ. of California Berkeley
163*> \author Univ. of Colorado Denver
164*> \author NAG Ltd.
165*
166*> \ingroup complex16_eig
167*
168* =====================================================================
169 SUBROUTINE zlatm4( ITYPE, N, NZ1, NZ2, RSIGN, AMAGN, RCOND,
170 $ TRIANG, IDIST, ISEED, A, LDA )
171*
172* -- LAPACK test routine --
173* -- LAPACK is a software package provided by Univ. of Tennessee, --
174* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
175*
176* .. Scalar Arguments ..
177 LOGICAL RSIGN
178 INTEGER IDIST, ITYPE, LDA, N, NZ1, NZ2
179 DOUBLE PRECISION AMAGN, RCOND, TRIANG
180* ..
181* .. Array Arguments ..
182 INTEGER ISEED( 4 )
183 COMPLEX*16 A( LDA, * )
184* ..
185*
186* =====================================================================
187*
188* .. Parameters ..
189 DOUBLE PRECISION ZERO, ONE
190 parameter( zero = 0.0d+0, one = 1.0d+0 )
191 COMPLEX*16 CZERO, CONE
192 parameter( czero = ( 0.0d+0, 0.0d+0 ),
193 $ cone = ( 1.0d+0, 0.0d+0 ) )
194* ..
195* .. Local Scalars ..
196 INTEGER I, ISDB, ISDE, JC, JD, JR, K, KBEG, KEND, KLEN
197 DOUBLE PRECISION ALPHA
198 COMPLEX*16 CTEMP
199* ..
200* .. External Functions ..
201 DOUBLE PRECISION DLARAN
202 COMPLEX*16 ZLARND
203 EXTERNAL dlaran, zlarnd
204* ..
205* .. External Subroutines ..
206 EXTERNAL zlaset
207* ..
208* .. Intrinsic Functions ..
209 INTRINSIC abs, dble, dcmplx, exp, log, max, min, mod
210* ..
211* .. Executable Statements ..
212*
213 IF( n.LE.0 )
214 $ RETURN
215 CALL zlaset( 'Full', n, n, czero, czero, a, lda )
216*
217* Insure a correct ISEED
218*
219 IF( mod( iseed( 4 ), 2 ).NE.1 )
220 $ iseed( 4 ) = iseed( 4 ) + 1
221*
222* Compute diagonal and subdiagonal according to ITYPE, NZ1, NZ2,
223* and RCOND
224*
225 IF( itype.NE.0 ) THEN
226 IF( abs( itype ).GE.4 ) THEN
227 kbeg = max( 1, min( n, nz1+1 ) )
228 kend = max( kbeg, min( n, n-nz2 ) )
229 klen = kend + 1 - kbeg
230 ELSE
231 kbeg = 1
232 kend = n
233 klen = n
234 END IF
235 isdb = 1
236 isde = 0
237 GO TO ( 10, 30, 50, 80, 100, 120, 140, 160,
238 $ 180, 200 )abs( itype )
239*
240* abs(ITYPE) = 1: Identity
241*
242 10 CONTINUE
243 DO 20 jd = 1, n
244 a( jd, jd ) = cone
245 20 CONTINUE
246 GO TO 220
247*
248* abs(ITYPE) = 2: Transposed Jordan block
249*
250 30 CONTINUE
251 DO 40 jd = 1, n - 1
252 a( jd+1, jd ) = cone
253 40 CONTINUE
254 isdb = 1
255 isde = n - 1
256 GO TO 220
257*
258* abs(ITYPE) = 3: Transposed Jordan block, followed by the
259* identity.
260*
261 50 CONTINUE
262 k = ( n-1 ) / 2
263 DO 60 jd = 1, k
264 a( jd+1, jd ) = cone
265 60 CONTINUE
266 isdb = 1
267 isde = k
268 DO 70 jd = k + 2, 2*k + 1
269 a( jd, jd ) = cone
270 70 CONTINUE
271 GO TO 220
272*
273* abs(ITYPE) = 4: 1,...,k
274*
275 80 CONTINUE
276 DO 90 jd = kbeg, kend
277 a( jd, jd ) = dcmplx( jd-nz1 )
278 90 CONTINUE
279 GO TO 220
280*
281* abs(ITYPE) = 5: One large D value:
282*
283 100 CONTINUE
284 DO 110 jd = kbeg + 1, kend
285 a( jd, jd ) = dcmplx( rcond )
286 110 CONTINUE
287 a( kbeg, kbeg ) = cone
288 GO TO 220
289*
290* abs(ITYPE) = 6: One small D value:
291*
292 120 CONTINUE
293 DO 130 jd = kbeg, kend - 1
294 a( jd, jd ) = cone
295 130 CONTINUE
296 a( kend, kend ) = dcmplx( rcond )
297 GO TO 220
298*
299* abs(ITYPE) = 7: Exponentially distributed D values:
300*
301 140 CONTINUE
302 a( kbeg, kbeg ) = cone
303 IF( klen.GT.1 ) THEN
304 alpha = rcond**( one / dble( klen-1 ) )
305 DO 150 i = 2, klen
306 a( nz1+i, nz1+i ) = dcmplx( alpha**dble( i-1 ) )
307 150 CONTINUE
308 END IF
309 GO TO 220
310*
311* abs(ITYPE) = 8: Arithmetically distributed D values:
312*
313 160 CONTINUE
314 a( kbeg, kbeg ) = cone
315 IF( klen.GT.1 ) THEN
316 alpha = ( one-rcond ) / dble( klen-1 )
317 DO 170 i = 2, klen
318 a( nz1+i, nz1+i ) = dcmplx( dble( klen-i )*alpha+rcond )
319 170 CONTINUE
320 END IF
321 GO TO 220
322*
323* abs(ITYPE) = 9: Randomly distributed D values on ( RCOND, 1):
324*
325 180 CONTINUE
326 alpha = log( rcond )
327 DO 190 jd = kbeg, kend
328 a( jd, jd ) = exp( alpha*dlaran( iseed ) )
329 190 CONTINUE
330 GO TO 220
331*
332* abs(ITYPE) = 10: Randomly distributed D values from DIST
333*
334 200 CONTINUE
335 DO 210 jd = kbeg, kend
336 a( jd, jd ) = zlarnd( idist, iseed )
337 210 CONTINUE
338*
339 220 CONTINUE
340*
341* Scale by AMAGN
342*
343 DO 230 jd = kbeg, kend
344 a( jd, jd ) = amagn*dble( a( jd, jd ) )
345 230 CONTINUE
346 DO 240 jd = isdb, isde
347 a( jd+1, jd ) = amagn*dble( a( jd+1, jd ) )
348 240 CONTINUE
349*
350* If RSIGN = .TRUE., assign random signs to diagonal and
351* subdiagonal
352*
353 IF( rsign ) THEN
354 DO 250 jd = kbeg, kend
355 IF( dble( a( jd, jd ) ).NE.zero ) THEN
356 ctemp = zlarnd( 3, iseed )
357 ctemp = ctemp / abs( ctemp )
358 a( jd, jd ) = ctemp*dble( a( jd, jd ) )
359 END IF
360 250 CONTINUE
361 DO 260 jd = isdb, isde
362 IF( dble( a( jd+1, jd ) ).NE.zero ) THEN
363 ctemp = zlarnd( 3, iseed )
364 ctemp = ctemp / abs( ctemp )
365 a( jd+1, jd ) = ctemp*dble( a( jd+1, jd ) )
366 END IF
367 260 CONTINUE
368 END IF
369*
370* Reverse if ITYPE < 0
371*
372 IF( itype.LT.0 ) THEN
373 DO 270 jd = kbeg, ( kbeg+kend-1 ) / 2
374 ctemp = a( jd, jd )
375 a( jd, jd ) = a( kbeg+kend-jd, kbeg+kend-jd )
376 a( kbeg+kend-jd, kbeg+kend-jd ) = ctemp
377 270 CONTINUE
378 DO 280 jd = 1, ( n-1 ) / 2
379 ctemp = a( jd+1, jd )
380 a( jd+1, jd ) = a( n+1-jd, n-jd )
381 a( n+1-jd, n-jd ) = ctemp
382 280 CONTINUE
383 END IF
384*
385 END IF
386*
387* Fill in upper triangle
388*
389 IF( triang.NE.zero ) THEN
390 DO 300 jc = 2, n
391 DO 290 jr = 1, jc - 1
392 a( jr, jc ) = triang*zlarnd( idist, iseed )
393 290 CONTINUE
394 300 CONTINUE
395 END IF
396*
397 RETURN
398*
399* End of ZLATM4
400*
401 END
subroutine zlaset(uplo, m, n, alpha, beta, a, lda)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
Definition zlaset.f:106
subroutine zlatm4(itype, n, nz1, nz2, rsign, amagn, rcond, triang, idist, iseed, a, lda)
ZLATM4
Definition zlatm4.f:171