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

ZLATSP

Purpose: 
 ZLATSP generates a special test matrix for the complex symmetric
 (indefinite) factorization for packed matrices.  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 (N*(N+1)/2)
          The generated matrix in packed storage format.  The matrix
          consists of 3x3 and 2x2 diagonal blocks which result in the
          pivot sequence given above.  The matrix outside these
          diagonal blocks is zero.
[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 86 of file zlatsp.f.

86 *
87 * -- LAPACK test routine (version 3.4.0) --
88 * -- LAPACK is a software package provided by Univ. of Tennessee, --
89 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
90 * November 2011
91 *
92 * .. Scalar Arguments ..
93  CHARACTER uplo
94  INTEGER n
95 * ..
96 * .. Array Arguments ..
97  INTEGER iseed( * )
98  COMPLEX*16 x( * )
99 * ..
100 *
101 * =====================================================================
102 *
103 * .. Parameters ..
104  COMPLEX*16 eye
105  parameter ( eye = ( 0.0d0, 1.0d0 ) )
106 * ..
107 * .. Local Scalars ..
108  INTEGER j, jj, n5
109  DOUBLE PRECISION alpha, alpha3, beta
110  COMPLEX*16 a, b, c, r
111 * ..
112 * .. External Functions ..
113  COMPLEX*16 zlarnd
114  EXTERNAL zlarnd
115 * ..
116 * .. Intrinsic Functions ..
117  INTRINSIC abs, sqrt
118 * ..
119 * .. Executable Statements ..
120 *
121 * Initialize constants
122 *
123  alpha = ( 1.d0+sqrt( 17.d0 ) ) / 8.d0
124  beta = alpha - 1.d0 / 1000.d0
125  alpha3 = alpha*alpha*alpha
126 *
127 * Fill the matrix with zeros.
128 *
129  DO 10 j = 1, n*( n+1 ) / 2
130  x( j ) = 0.0d0
131  10 CONTINUE
132 *
133 * UPLO = 'U': Upper triangular storage
134 *
135  IF( uplo.EQ.'U' ) THEN
136  n5 = n / 5
137  n5 = n - 5*n5 + 1
138 *
139  jj = n*( n+1 ) / 2
140  DO 20 j = n, n5, -5
141  a = alpha3*zlarnd( 5, iseed )
142  b = zlarnd( 5, iseed ) / alpha
143  c = a - 2.d0*b*eye
144  r = c / beta
145  x( jj ) = a
146  x( jj-2 ) = b
147  jj = jj - j
148  x( jj ) = zlarnd( 2, iseed )
149  x( jj-1 ) = r
150  jj = jj - ( j-1 )
151  x( jj ) = c
152  jj = jj - ( j-2 )
153  x( jj ) = zlarnd( 2, iseed )
154  jj = jj - ( j-3 )
155  x( jj ) = zlarnd( 2, iseed )
156  IF( abs( x( jj+( j-3 ) ) ).GT.abs( x( jj ) ) ) THEN
157  x( jj+( j-4 ) ) = 2.0d0*x( jj+( j-3 ) )
158  ELSE
159  x( jj+( j-4 ) ) = 2.0d0*x( jj )
160  END IF
161  jj = jj - ( j-4 )
162  20 CONTINUE
163 *
164 * Clean-up for N not a multiple of 5.
165 *
166  j = n5 - 1
167  IF( j.GT.2 ) THEN
168  a = alpha3*zlarnd( 5, iseed )
169  b = zlarnd( 5, iseed ) / alpha
170  c = a - 2.d0*b*eye
171  r = c / beta
172  x( jj ) = a
173  x( jj-2 ) = b
174  jj = jj - j
175  x( jj ) = zlarnd( 2, iseed )
176  x( jj-1 ) = r
177  jj = jj - ( j-1 )
178  x( jj ) = c
179  jj = jj - ( j-2 )
180  j = j - 3
181  END IF
182  IF( j.GT.1 ) THEN
183  x( jj ) = zlarnd( 2, iseed )
184  x( jj-j ) = zlarnd( 2, iseed )
185  IF( abs( x( jj ) ).GT.abs( x( jj-j ) ) ) THEN
186  x( jj-1 ) = 2.0d0*x( jj )
187  ELSE
188  x( jj-1 ) = 2.0d0*x( jj-j )
189  END IF
190  jj = jj - j - ( j-1 )
191  j = j - 2
192  ELSE IF( j.EQ.1 ) THEN
193  x( jj ) = zlarnd( 2, iseed )
194  j = j - 1
195  END IF
196 *
197 * UPLO = 'L': Lower triangular storage
198 *
199  ELSE
200  n5 = n / 5
201  n5 = n5*5
202 *
203  jj = 1
204  DO 30 j = 1, n5, 5
205  a = alpha3*zlarnd( 5, iseed )
206  b = zlarnd( 5, iseed ) / alpha
207  c = a - 2.d0*b*eye
208  r = c / beta
209  x( jj ) = a
210  x( jj+2 ) = b
211  jj = jj + ( n-j+1 )
212  x( jj ) = zlarnd( 2, iseed )
213  x( jj+1 ) = r
214  jj = jj + ( n-j )
215  x( jj ) = c
216  jj = jj + ( n-j-1 )
217  x( jj ) = zlarnd( 2, iseed )
218  jj = jj + ( n-j-2 )
219  x( jj ) = zlarnd( 2, iseed )
220  IF( abs( x( jj-( n-j-2 ) ) ).GT.abs( x( jj ) ) ) THEN
221  x( jj-( n-j-2 )+1 ) = 2.0d0*x( jj-( n-j-2 ) )
222  ELSE
223  x( jj-( n-j-2 )+1 ) = 2.0d0*x( jj )
224  END IF
225  jj = jj + ( n-j-3 )
226  30 CONTINUE
227 *
228 * Clean-up for N not a multiple of 5.
229 *
230  j = n5 + 1
231  IF( j.LT.n-1 ) THEN
232  a = alpha3*zlarnd( 5, iseed )
233  b = zlarnd( 5, iseed ) / alpha
234  c = a - 2.d0*b*eye
235  r = c / beta
236  x( jj ) = a
237  x( jj+2 ) = b
238  jj = jj + ( n-j+1 )
239  x( jj ) = zlarnd( 2, iseed )
240  x( jj+1 ) = r
241  jj = jj + ( n-j )
242  x( jj ) = c
243  jj = jj + ( n-j-1 )
244  j = j + 3
245  END IF
246  IF( j.LT.n ) THEN
247  x( jj ) = zlarnd( 2, iseed )
248  x( jj+( n-j+1 ) ) = zlarnd( 2, iseed )
249  IF( abs( x( jj ) ).GT.abs( x( jj+( n-j+1 ) ) ) ) THEN
250  x( jj+1 ) = 2.0d0*x( jj )
251  ELSE
252  x( jj+1 ) = 2.0d0*x( jj+( n-j+1 ) )
253  END IF
254  jj = jj + ( n-j+1 ) + ( n-j )
255  j = j + 2
256  ELSE IF( j.EQ.n ) THEN
257  x( jj ) = zlarnd( 2, iseed )
258  jj = jj + ( n-j+1 )
259  j = j + 1
260  END IF
261  END IF
262 *
263  RETURN
264 *
265 * End of ZLATSP
266 *
zlarnd
complex *16 function zlarnd(IDIST, ISEED)
ZLARND
Definition: zlarnd.f:77

Here is the caller graph for this function: