1*> \brief \b CLATSY
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 CLATSY( 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            X( LDX, * )
20*       ..
21*
22*
23*> \par Purpose:
24*  =============
25*>
26*> \verbatim
27*>
28*> CLATSY 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 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 December 2016
86*
87*> \ingroup complex_lin
88*
89*  =====================================================================
90      SUBROUTINE CLATSY( UPLO, N, X, LDX, ISEED )
91*
92*  -- LAPACK test routine (version 3.7.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*     December 2016
96*
97*     .. Scalar Arguments ..
98      CHARACTER          UPLO
99      INTEGER            LDX, N
100*     ..
101*     .. Array Arguments ..
102      INTEGER            ISEED( * )
103      COMPLEX            X( LDX, * )
104*     ..
105*
106*  =====================================================================
107*
108*     .. Parameters ..
109      COMPLEX            EYE
110      PARAMETER          ( EYE = ( 0.0, 1.0 ) )
111*     ..
112*     .. Local Scalars ..
113      INTEGER            I, J, N5
114      REAL               ALPHA, ALPHA3, BETA
115      COMPLEX            A, B, C, R
116*     ..
117*     .. External Functions ..
118      COMPLEX            CLARND
119      EXTERNAL           CLARND
120*     ..
121*     .. Intrinsic Functions ..
122      INTRINSIC          ABS, SQRT
123*     ..
124*     .. Executable Statements ..
125*
126*     Initialize constants
127*
128      ALPHA = ( 1.+SQRT( 17. ) ) / 8.
129      BETA = ALPHA - 1. / 1000.
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.0
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*CLARND( 5, ISEED )
148            B = CLARND( 5, ISEED ) / ALPHA
149            C = A - 2.*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 ) = CLARND( 2, ISEED )
156            X( I-3, I-3 ) = CLARND( 2, ISEED )
157            X( I-4, I-4 ) = CLARND( 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.0*X( I-3, I-3 )
160            ELSE
161               X( I-4, I-3 ) = 2.0*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*CLARND( 5, ISEED )
170            B = CLARND( 5, ISEED ) / ALPHA
171            C = A - 2.*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 ) = CLARND( 2, ISEED )
178            I = I - 3
179         END IF
180         IF( I.GT.1 ) THEN
181            X( I, I ) = CLARND( 2, ISEED )
182            X( I-1, I-1 ) = CLARND( 2, ISEED )
183            IF( ABS( X( I, I ) ).GT.ABS( X( I-1, I-1 ) ) ) THEN
184               X( I-1, I ) = 2.0*X( I, I )
185            ELSE
186               X( I-1, I ) = 2.0*X( I-1, I-1 )
187            END IF
188            I = I - 2
189         ELSE IF( I.EQ.1 ) THEN
190            X( I, I ) = CLARND( 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.0
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*CLARND( 5, ISEED )
210            B = CLARND( 5, ISEED ) / ALPHA
211            C = A - 2.*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 ) = CLARND( 2, ISEED )
218            X( I+3, I+3 ) = CLARND( 2, ISEED )
219            X( I+4, I+4 ) = CLARND( 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.0*X( I+3, I+3 )
222            ELSE
223               X( I+4, I+3 ) = 2.0*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*CLARND( 5, ISEED )
232            B = CLARND( 5, ISEED ) / ALPHA
233            C = A - 2.*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 ) = CLARND( 2, ISEED )
240            I = I + 3
241         END IF
242         IF( I.LT.N ) THEN
243            X( I, I ) = CLARND( 2, ISEED )
244            X( I+1, I+1 ) = CLARND( 2, ISEED )
245            IF( ABS( X( I, I ) ).GT.ABS( X( I+1, I+1 ) ) ) THEN
246               X( I+1, I ) = 2.0*X( I, I )
247            ELSE
248               X( I+1, I ) = 2.0*X( I+1, I+1 )
249            END IF
250            I = I + 2
251         ELSE IF( I.EQ.N ) THEN
252            X( I, I ) = CLARND( 2, ISEED )
253            I = I + 1
254         END IF
255      END IF
256*
257      RETURN
258*
259*     End of CLATSY
260*
261      END
262