LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
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 *> \date November 2011
167 *
168 *> \ingroup complex16_eig
169 *
170 * =====================================================================
171  SUBROUTINE zlatm4( ITYPE, N, NZ1, NZ2, RSIGN, AMAGN, RCOND,
172  $ triang, idist, iseed, a, lda )
173 *
174 * -- LAPACK test routine (version 3.4.0) --
175 * -- LAPACK is a software package provided by Univ. of Tennessee, --
176 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
177 * November 2011
178 *
179 * .. Scalar Arguments ..
180  LOGICAL rsign
181  INTEGER idist, itype, lda, n, nz1, nz2
182  DOUBLE PRECISION amagn, rcond, triang
183 * ..
184 * .. Array Arguments ..
185  INTEGER iseed( 4 )
186  COMPLEX*16 a( lda, * )
187 * ..
188 *
189 * =====================================================================
190 *
191 * .. Parameters ..
192  DOUBLE PRECISION zero, one
193  parameter( zero = 0.0d+0, one = 1.0d+0 )
194  COMPLEX*16 czero, cone
195  parameter( czero = ( 0.0d+0, 0.0d+0 ),
196  $ cone = ( 1.0d+0, 0.0d+0 ) )
197 * ..
198 * .. Local Scalars ..
199  INTEGER i, isdb, isde, jc, jd, jr, k, kbeg, kend, klen
200  DOUBLE PRECISION alpha
201  COMPLEX*16 ctemp
202 * ..
203 * .. External Functions ..
204  DOUBLE PRECISION dlaran
205  COMPLEX*16 zlarnd
206  EXTERNAL dlaran, zlarnd
207 * ..
208 * .. External Subroutines ..
209  EXTERNAL zlaset
210 * ..
211 * .. Intrinsic Functions ..
212  INTRINSIC abs, dble, dcmplx, exp, log, max, min, mod
213 * ..
214 * .. Executable Statements ..
215 *
216  IF( n.LE.0 )
217  $ return
218  CALL zlaset( 'Full', n, n, czero, czero, a, lda )
219 *
220 * Insure a correct ISEED
221 *
222  IF( mod( iseed( 4 ), 2 ).NE.1 )
223  $ iseed( 4 ) = iseed( 4 ) + 1
224 *
225 * Compute diagonal and subdiagonal according to ITYPE, NZ1, NZ2,
226 * and RCOND
227 *
228  IF( itype.NE.0 ) THEN
229  IF( abs( itype ).GE.4 ) THEN
230  kbeg = max( 1, min( n, nz1+1 ) )
231  kend = max( kbeg, min( n, n-nz2 ) )
232  klen = kend + 1 - kbeg
233  ELSE
234  kbeg = 1
235  kend = n
236  klen = n
237  END IF
238  isdb = 1
239  isde = 0
240  go to( 10, 30, 50, 80, 100, 120, 140, 160,
241  $ 180, 200 )abs( itype )
242 *
243 * abs(ITYPE) = 1: Identity
244 *
245  10 continue
246  DO 20 jd = 1, n
247  a( jd, jd ) = cone
248  20 continue
249  go to 220
250 *
251 * abs(ITYPE) = 2: Transposed Jordan block
252 *
253  30 continue
254  DO 40 jd = 1, n - 1
255  a( jd+1, jd ) = cone
256  40 continue
257  isdb = 1
258  isde = n - 1
259  go to 220
260 *
261 * abs(ITYPE) = 3: Transposed Jordan block, followed by the
262 * identity.
263 *
264  50 continue
265  k = ( n-1 ) / 2
266  DO 60 jd = 1, k
267  a( jd+1, jd ) = cone
268  60 continue
269  isdb = 1
270  isde = k
271  DO 70 jd = k + 2, 2*k + 1
272  a( jd, jd ) = cone
273  70 continue
274  go to 220
275 *
276 * abs(ITYPE) = 4: 1,...,k
277 *
278  80 continue
279  DO 90 jd = kbeg, kend
280  a( jd, jd ) = dcmplx( jd-nz1 )
281  90 continue
282  go to 220
283 *
284 * abs(ITYPE) = 5: One large D value:
285 *
286  100 continue
287  DO 110 jd = kbeg + 1, kend
288  a( jd, jd ) = dcmplx( rcond )
289  110 continue
290  a( kbeg, kbeg ) = cone
291  go to 220
292 *
293 * abs(ITYPE) = 6: One small D value:
294 *
295  120 continue
296  DO 130 jd = kbeg, kend - 1
297  a( jd, jd ) = cone
298  130 continue
299  a( kend, kend ) = dcmplx( rcond )
300  go to 220
301 *
302 * abs(ITYPE) = 7: Exponentially distributed D values:
303 *
304  140 continue
305  a( kbeg, kbeg ) = cone
306  IF( klen.GT.1 ) THEN
307  alpha = rcond**( one / dble( klen-1 ) )
308  DO 150 i = 2, klen
309  a( nz1+i, nz1+i ) = dcmplx( alpha**dble( i-1 ) )
310  150 continue
311  END IF
312  go to 220
313 *
314 * abs(ITYPE) = 8: Arithmetically distributed D values:
315 *
316  160 continue
317  a( kbeg, kbeg ) = cone
318  IF( klen.GT.1 ) THEN
319  alpha = ( one-rcond ) / dble( klen-1 )
320  DO 170 i = 2, klen
321  a( nz1+i, nz1+i ) = dcmplx( dble( klen-i )*alpha+rcond )
322  170 continue
323  END IF
324  go to 220
325 *
326 * abs(ITYPE) = 9: Randomly distributed D values on ( RCOND, 1):
327 *
328  180 continue
329  alpha = log( rcond )
330  DO 190 jd = kbeg, kend
331  a( jd, jd ) = exp( alpha*dlaran( iseed ) )
332  190 continue
333  go to 220
334 *
335 * abs(ITYPE) = 10: Randomly distributed D values from DIST
336 *
337  200 continue
338  DO 210 jd = kbeg, kend
339  a( jd, jd ) = zlarnd( idist, iseed )
340  210 continue
341 *
342  220 continue
343 *
344 * Scale by AMAGN
345 *
346  DO 230 jd = kbeg, kend
347  a( jd, jd ) = amagn*dble( a( jd, jd ) )
348  230 continue
349  DO 240 jd = isdb, isde
350  a( jd+1, jd ) = amagn*dble( a( jd+1, jd ) )
351  240 continue
352 *
353 * If RSIGN = .TRUE., assign random signs to diagonal and
354 * subdiagonal
355 *
356  IF( rsign ) THEN
357  DO 250 jd = kbeg, kend
358  IF( dble( a( jd, jd ) ).NE.zero ) THEN
359  ctemp = zlarnd( 3, iseed )
360  ctemp = ctemp / abs( ctemp )
361  a( jd, jd ) = ctemp*dble( a( jd, jd ) )
362  END IF
363  250 continue
364  DO 260 jd = isdb, isde
365  IF( dble( a( jd+1, jd ) ).NE.zero ) THEN
366  ctemp = zlarnd( 3, iseed )
367  ctemp = ctemp / abs( ctemp )
368  a( jd+1, jd ) = ctemp*dble( a( jd+1, jd ) )
369  END IF
370  260 continue
371  END IF
372 *
373 * Reverse if ITYPE < 0
374 *
375  IF( itype.LT.0 ) THEN
376  DO 270 jd = kbeg, ( kbeg+kend-1 ) / 2
377  ctemp = a( jd, jd )
378  a( jd, jd ) = a( kbeg+kend-jd, kbeg+kend-jd )
379  a( kbeg+kend-jd, kbeg+kend-jd ) = ctemp
380  270 continue
381  DO 280 jd = 1, ( n-1 ) / 2
382  ctemp = a( jd+1, jd )
383  a( jd+1, jd ) = a( n+1-jd, n-jd )
384  a( n+1-jd, n-jd ) = ctemp
385  280 continue
386  END IF
387 *
388  END IF
389 *
390 * Fill in upper triangle
391 *
392  IF( triang.NE.zero ) THEN
393  DO 300 jc = 2, n
394  DO 290 jr = 1, jc - 1
395  a( jr, jc ) = triang*zlarnd( idist, iseed )
396  290 continue
397  300 continue
398  END IF
399 *
400  return
401 *
402 * End of ZLATM4
403 *
404  END