LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
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 zlatm4(ITYPE, N, NZ1, NZ2, RSIGN, AMAGN, RCOND, TRIANG, IDIST, ISEED, A, LDA)
ZLATM4
Definition: zlatm4.f:171
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