1*> \brief \b ZLATSP
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 ZLATSP( UPLO, N, X, ISEED )
12*
13*       .. Scalar Arguments ..
14*       CHARACTER          UPLO
15*       INTEGER            N
16*       ..
17*       .. Array Arguments ..
18*       INTEGER            ISEED( * )
19*       COMPLEX*16         X( * )
20*       ..
21*
22*
23*> \par Purpose:
24*  =============
25*>
26*> \verbatim
27*>
28*> ZLATSP generates a special test matrix for the complex symmetric
29*> (indefinite) factorization for packed matrices.  The pivot blocks of
30*> the generated matrix 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 (N*(N+1)/2)
59*>          The generated matrix in packed storage format.  The matrix
60*>          consists of 3x3 and 2x2 diagonal blocks which result in the
61*>          pivot sequence given above.  The matrix outside these
62*>          diagonal blocks is zero.
63*> \endverbatim
64*>
65*> \param[in,out] ISEED
66*> \verbatim
67*>          ISEED is INTEGER array, dimension (4)
68*>          On entry, the seed for the random number generator.  The last
69*>          of the four integers must be odd.  (modified on exit)
70*> \endverbatim
71*
72*  Authors:
73*  ========
74*
75*> \author Univ. of Tennessee
76*> \author Univ. of California Berkeley
77*> \author Univ. of Colorado Denver
78*> \author NAG Ltd.
79*
80*> \ingroup complex16_lin
81*
82*  =====================================================================
83      SUBROUTINE ZLATSP( UPLO, N, X, ISEED )
84*
85*  -- LAPACK test routine --
86*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
87*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
88*
89*     .. Scalar Arguments ..
90      CHARACTER          UPLO
91      INTEGER            N
92*     ..
93*     .. Array Arguments ..
94      INTEGER            ISEED( * )
95      COMPLEX*16         X( * )
96*     ..
97*
98*  =====================================================================
99*
100*     .. Parameters ..
101      COMPLEX*16         EYE
102      PARAMETER          ( EYE = ( 0.0D0, 1.0D0 ) )
103*     ..
104*     .. Local Scalars ..
105      INTEGER            J, JJ, N5
106      DOUBLE PRECISION   ALPHA, ALPHA3, BETA
107      COMPLEX*16         A, B, C, R
108*     ..
109*     .. External Functions ..
110      COMPLEX*16         ZLARND
111      EXTERNAL           ZLARND
112*     ..
113*     .. Intrinsic Functions ..
114      INTRINSIC          ABS, SQRT
115*     ..
116*     .. Executable Statements ..
117*
118*     Initialize constants
119*
120      ALPHA = ( 1.D0+SQRT( 17.D0 ) ) / 8.D0
121      BETA = ALPHA - 1.D0 / 1000.D0
122      ALPHA3 = ALPHA*ALPHA*ALPHA
123*
124*     Fill the matrix with zeros.
125*
126      DO 10 J = 1, N*( N+1 ) / 2
127         X( J ) = 0.0D0
128   10 CONTINUE
129*
130*     UPLO = 'U':  Upper triangular storage
131*
132      IF( UPLO.EQ.'U' ) THEN
133         N5 = N / 5
134         N5 = N - 5*N5 + 1
135*
136         JJ = N*( N+1 ) / 2
137         DO 20 J = N, N5, -5
138            A = ALPHA3*ZLARND( 5, ISEED )
139            B = ZLARND( 5, ISEED ) / ALPHA
140            C = A - 2.D0*B*EYE
141            R = C / BETA
142            X( JJ ) = A
143            X( JJ-2 ) = B
144            JJ = JJ - J
145            X( JJ ) = ZLARND( 2, ISEED )
146            X( JJ-1 ) = R
147            JJ = JJ - ( J-1 )
148            X( JJ ) = C
149            JJ = JJ - ( J-2 )
150            X( JJ ) = ZLARND( 2, ISEED )
151            JJ = JJ - ( J-3 )
152            X( JJ ) = ZLARND( 2, ISEED )
153            IF( ABS( X( JJ+( J-3 ) ) ).GT.ABS( X( JJ ) ) ) THEN
154               X( JJ+( J-4 ) ) = 2.0D0*X( JJ+( J-3 ) )
155            ELSE
156               X( JJ+( J-4 ) ) = 2.0D0*X( JJ )
157            END IF
158            JJ = JJ - ( J-4 )
159   20    CONTINUE
160*
161*        Clean-up for N not a multiple of 5.
162*
163         J = N5 - 1
164         IF( J.GT.2 ) THEN
165            A = ALPHA3*ZLARND( 5, ISEED )
166            B = ZLARND( 5, ISEED ) / ALPHA
167            C = A - 2.D0*B*EYE
168            R = C / BETA
169            X( JJ ) = A
170            X( JJ-2 ) = B
171            JJ = JJ - J
172            X( JJ ) = ZLARND( 2, ISEED )
173            X( JJ-1 ) = R
174            JJ = JJ - ( J-1 )
175            X( JJ ) = C
176            JJ = JJ - ( J-2 )
177            J = J - 3
178         END IF
179         IF( J.GT.1 ) THEN
180            X( JJ ) = ZLARND( 2, ISEED )
181            X( JJ-J ) = ZLARND( 2, ISEED )
182            IF( ABS( X( JJ ) ).GT.ABS( X( JJ-J ) ) ) THEN
183               X( JJ-1 ) = 2.0D0*X( JJ )
184            ELSE
185               X( JJ-1 ) = 2.0D0*X( JJ-J )
186            END IF
187            JJ = JJ - J - ( J-1 )
188            J = J - 2
189         ELSE IF( J.EQ.1 ) THEN
190            X( JJ ) = ZLARND( 2, ISEED )
191            J = J - 1
192         END IF
193*
194*     UPLO = 'L':  Lower triangular storage
195*
196      ELSE
197         N5 = N / 5
198         N5 = N5*5
199*
200         JJ = 1
201         DO 30 J = 1, N5, 5
202            A = ALPHA3*ZLARND( 5, ISEED )
203            B = ZLARND( 5, ISEED ) / ALPHA
204            C = A - 2.D0*B*EYE
205            R = C / BETA
206            X( JJ ) = A
207            X( JJ+2 ) = B
208            JJ = JJ + ( N-J+1 )
209            X( JJ ) = ZLARND( 2, ISEED )
210            X( JJ+1 ) = R
211            JJ = JJ + ( N-J )
212            X( JJ ) = C
213            JJ = JJ + ( N-J-1 )
214            X( JJ ) = ZLARND( 2, ISEED )
215            JJ = JJ + ( N-J-2 )
216            X( JJ ) = ZLARND( 2, ISEED )
217            IF( ABS( X( JJ-( N-J-2 ) ) ).GT.ABS( X( JJ ) ) ) THEN
218               X( JJ-( N-J-2 )+1 ) = 2.0D0*X( JJ-( N-J-2 ) )
219            ELSE
220               X( JJ-( N-J-2 )+1 ) = 2.0D0*X( JJ )
221            END IF
222            JJ = JJ + ( N-J-3 )
223   30    CONTINUE
224*
225*        Clean-up for N not a multiple of 5.
226*
227         J = N5 + 1
228         IF( J.LT.N-1 ) THEN
229            A = ALPHA3*ZLARND( 5, ISEED )
230            B = ZLARND( 5, ISEED ) / ALPHA
231            C = A - 2.D0*B*EYE
232            R = C / BETA
233            X( JJ ) = A
234            X( JJ+2 ) = B
235            JJ = JJ + ( N-J+1 )
236            X( JJ ) = ZLARND( 2, ISEED )
237            X( JJ+1 ) = R
238            JJ = JJ + ( N-J )
239            X( JJ ) = C
240            JJ = JJ + ( N-J-1 )
241            J = J + 3
242         END IF
243         IF( J.LT.N ) THEN
244            X( JJ ) = ZLARND( 2, ISEED )
245            X( JJ+( N-J+1 ) ) = ZLARND( 2, ISEED )
246            IF( ABS( X( JJ ) ).GT.ABS( X( JJ+( N-J+1 ) ) ) ) THEN
247               X( JJ+1 ) = 2.0D0*X( JJ )
248            ELSE
249               X( JJ+1 ) = 2.0D0*X( JJ+( N-J+1 ) )
250            END IF
251            JJ = JJ + ( N-J+1 ) + ( N-J )
252            J = J + 2
253         ELSE IF( J.EQ.N ) THEN
254            X( JJ ) = ZLARND( 2, ISEED )
255            JJ = JJ + ( N-J+1 )
256            J = J + 1
257         END IF
258      END IF
259*
260      RETURN
261*
262*     End of ZLATSP
263*
264      END
265