LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine zlatsy ( character  UPLO,
integer  N,
complex*16, dimension( ldx, * )  X,
integer  LDX,
integer, dimension( * )  ISEED 
)

ZLATSY

Purpose: 
 ZLATSY generates a special test matrix for the complex symmetric
 (indefinite) factorization.  The pivot blocks of the generated matrix
 will be in the following order:
    2x2 pivot block, non diagonalizable
    1x1 pivot block
    2x2 pivot block, diagonalizable
    (cycle repeats)
 A row interchange is required for each non-diagonalizable 2x2 block.
Parameters
[in]UPLO
          UPLO is CHARACTER
          Specifies whether the generated matrix is to be upper or
          lower triangular.
          = 'U':  Upper triangular
          = 'L':  Lower triangular
[in]N
          N is INTEGER
          The dimension of the matrix to be generated.
[out]X
          X is COMPLEX*16 array, dimension (LDX,N)
          The generated matrix, consisting of 3x3 and 2x2 diagonal
          blocks which result in the pivot sequence given above.
          The matrix outside of these diagonal blocks is zero.
[in]LDX
          LDX is INTEGER
          The leading dimension of the array X.
[in,out]ISEED
          ISEED is INTEGER array, dimension (4)
          On entry, the seed for the random number generator.  The last
          of the four integers must be odd.  (modified on exit)
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 91 of file zlatsy.f.

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 *
zlarnd
complex *16 function zlarnd(IDIST, ISEED)
ZLARND
Definition: zlarnd.f:77

Here is the caller graph for this function: