LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
zlatsy.f
Go to the documentation of this file.
1 *> \brief \b ZLATSY
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 ZLATSY( UPLO, N, X, LDX, ISEED )
12 *
13 * .. Scalar Arguments ..
14 * CHARACTER UPLO
15 * INTEGER LDX, N
16 * ..
17 * .. Array Arguments ..
18 * INTEGER ISEED( * )
19 * COMPLEX*16 X( LDX, * )
20 * ..
21 *
22 *
23 *> \par Purpose:
24 * =============
25 *>
26 *> \verbatim
27 *>
28 *> ZLATSY generates a special test matrix for the complex symmetric
29 *> (indefinite) factorization. The pivot blocks of the generated matrix
30 *> will be in the following order:
31 *> 2x2 pivot block, non diagonalizable
32 *> 1x1 pivot block
33 *> 2x2 pivot block, diagonalizable
34 *> (cycle repeats)
35 *> A row interchange is required for each non-diagonalizable 2x2 block.
36 *> \endverbatim
37 *
38 * Arguments:
39 * ==========
40 *
41 *> \param[in] UPLO
42 *> \verbatim
43 *> UPLO is CHARACTER
44 *> Specifies whether the generated matrix is to be upper or
45 *> lower triangular.
46 *> = 'U': Upper triangular
47 *> = 'L': Lower triangular
48 *> \endverbatim
49 *>
50 *> \param[in] N
51 *> \verbatim
52 *> N is INTEGER
53 *> The dimension of the matrix to be generated.
54 *> \endverbatim
55 *>
56 *> \param[out] X
57 *> \verbatim
58 *> X is COMPLEX*16 array, dimension (LDX,N)
59 *> The generated matrix, consisting of 3x3 and 2x2 diagonal
60 *> blocks which result in the pivot sequence given above.
61 *> The matrix outside of these diagonal blocks is zero.
62 *> \endverbatim
63 *>
64 *> \param[in] LDX
65 *> \verbatim
66 *> LDX is INTEGER
67 *> The leading dimension of the array X.
68 *> \endverbatim
69 *>
70 *> \param[in,out] ISEED
71 *> \verbatim
72 *> ISEED is INTEGER array, dimension (4)
73 *> On entry, the seed for the random number generator. The last
74 *> of the four integers must be odd. (modified on exit)
75 *> \endverbatim
76 *
77 * Authors:
78 * ========
79 *
80 *> \author Univ. of Tennessee
81 *> \author Univ. of California Berkeley
82 *> \author Univ. of Colorado Denver
83 *> \author NAG Ltd.
84 *
85 *> \date November 2011
86 *
87 *> \ingroup complex16_lin
88 *
89 * =====================================================================
90  SUBROUTINE zlatsy( UPLO, N, X, LDX, ISEED )
91 *
92 * -- LAPACK test routine (version 3.4.0) --
93 * -- LAPACK is a software package provided by Univ. of Tennessee, --
94 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
95 * November 2011
96 *
97 * .. Scalar Arguments ..
98  CHARACTER uplo
99  INTEGER ldx, n
100 * ..
101 * .. Array Arguments ..
102  INTEGER iseed( * )
103  COMPLEX*16 x( ldx, * )
104 * ..
105 *
106 * =====================================================================
107 *
108 * .. Parameters ..
109  COMPLEX*16 eye
110  parameter( eye = ( 0.0d0, 1.0d0 ) )
111 * ..
112 * .. Local Scalars ..
113  INTEGER i, j, n5
114  DOUBLE PRECISION alpha, alpha3, beta
115  COMPLEX*16 a, b, c, r
116 * ..
117 * .. External Functions ..
118  COMPLEX*16 zlarnd
119  EXTERNAL zlarnd
120 * ..
121 * .. Intrinsic Functions ..
122  INTRINSIC abs, sqrt
123 * ..
124 * .. Executable Statements ..
125 *
126 * Initialize constants
127 *
128  alpha = ( 1.d0+sqrt( 17.d0 ) ) / 8.d0
129  beta = alpha - 1.d0 / 1000.d0
130  alpha3 = alpha*alpha*alpha
131 *
132 * UPLO = 'U': Upper triangular storage
133 *
134  IF( uplo.EQ.'U' ) THEN
135 *
136 * Fill the upper triangle of the matrix with zeros.
137 *
138  DO 20 j = 1, n
139  DO 10 i = 1, j
140  x( i, j ) = 0.0d0
141  10 continue
142  20 continue
143  n5 = n / 5
144  n5 = n - 5*n5 + 1
145 *
146  DO 30 i = n, n5, -5
147  a = alpha3*zlarnd( 5, iseed )
148  b = zlarnd( 5, iseed ) / alpha
149  c = a - 2.d0*b*eye
150  r = c / beta
151  x( i, i ) = a
152  x( i-2, i ) = b
153  x( i-2, i-1 ) = r
154  x( i-2, i-2 ) = c
155  x( i-1, i-1 ) = zlarnd( 2, iseed )
156  x( i-3, i-3 ) = zlarnd( 2, iseed )
157  x( i-4, i-4 ) = zlarnd( 2, iseed )
158  IF( abs( x( i-3, i-3 ) ).GT.abs( x( i-4, i-4 ) ) ) THEN
159  x( i-4, i-3 ) = 2.0d0*x( i-3, i-3 )
160  ELSE
161  x( i-4, i-3 ) = 2.0d0*x( i-4, i-4 )
162  END IF
163  30 continue
164 *
165 * Clean-up for N not a multiple of 5.
166 *
167  i = n5 - 1
168  IF( i.GT.2 ) THEN
169  a = alpha3*zlarnd( 5, iseed )
170  b = zlarnd( 5, iseed ) / alpha
171  c = a - 2.d0*b*eye
172  r = c / beta
173  x( i, i ) = a
174  x( i-2, i ) = b
175  x( i-2, i-1 ) = r
176  x( i-2, i-2 ) = c
177  x( i-1, i-1 ) = zlarnd( 2, iseed )
178  i = i - 3
179  END IF
180  IF( i.GT.1 ) THEN
181  x( i, i ) = zlarnd( 2, iseed )
182  x( i-1, i-1 ) = zlarnd( 2, iseed )
183  IF( abs( x( i, i ) ).GT.abs( x( i-1, i-1 ) ) ) THEN
184  x( i-1, i ) = 2.0d0*x( i, i )
185  ELSE
186  x( i-1, i ) = 2.0d0*x( i-1, i-1 )
187  END IF
188  i = i - 2
189  ELSE IF( i.EQ.1 ) THEN
190  x( i, i ) = zlarnd( 2, iseed )
191  i = i - 1
192  END IF
193 *
194 * UPLO = 'L': Lower triangular storage
195 *
196  ELSE
197 *
198 * Fill the lower triangle of the matrix with zeros.
199 *
200  DO 50 j = 1, n
201  DO 40 i = j, n
202  x( i, j ) = 0.0d0
203  40 continue
204  50 continue
205  n5 = n / 5
206  n5 = n5*5
207 *
208  DO 60 i = 1, n5, 5
209  a = alpha3*zlarnd( 5, iseed )
210  b = zlarnd( 5, iseed ) / alpha
211  c = a - 2.d0*b*eye
212  r = c / beta
213  x( i, i ) = a
214  x( i+2, i ) = b
215  x( i+2, i+1 ) = r
216  x( i+2, i+2 ) = c
217  x( i+1, i+1 ) = zlarnd( 2, iseed )
218  x( i+3, i+3 ) = zlarnd( 2, iseed )
219  x( i+4, i+4 ) = zlarnd( 2, iseed )
220  IF( abs( x( i+3, i+3 ) ).GT.abs( x( i+4, i+4 ) ) ) THEN
221  x( i+4, i+3 ) = 2.0d0*x( i+3, i+3 )
222  ELSE
223  x( i+4, i+3 ) = 2.0d0*x( i+4, i+4 )
224  END IF
225  60 continue
226 *
227 * Clean-up for N not a multiple of 5.
228 *
229  i = n5 + 1
230  IF( i.LT.n-1 ) THEN
231  a = alpha3*zlarnd( 5, iseed )
232  b = zlarnd( 5, iseed ) / alpha
233  c = a - 2.d0*b*eye
234  r = c / beta
235  x( i, i ) = a
236  x( i+2, i ) = b
237  x( i+2, i+1 ) = r
238  x( i+2, i+2 ) = c
239  x( i+1, i+1 ) = zlarnd( 2, iseed )
240  i = i + 3
241  END IF
242  IF( i.LT.n ) THEN
243  x( i, i ) = zlarnd( 2, iseed )
244  x( i+1, i+1 ) = zlarnd( 2, iseed )
245  IF( abs( x( i, i ) ).GT.abs( x( i+1, i+1 ) ) ) THEN
246  x( i+1, i ) = 2.0d0*x( i, i )
247  ELSE
248  x( i+1, i ) = 2.0d0*x( i+1, i+1 )
249  END IF
250  i = i + 2
251  ELSE IF( i.EQ.n ) THEN
252  x( i, i ) = zlarnd( 2, iseed )
253  i = i + 1
254  END IF
255  END IF
256 *
257  return
258 *
259 * End of ZLATSY
260 *
261  END