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*> \ingroup complex_lin
86*
87*  =====================================================================
88      SUBROUTINE CLATSY( UPLO, N, X, LDX, ISEED )
89*
90*  -- LAPACK test routine --
91*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
92*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
93*
94*     .. Scalar Arguments ..
95      CHARACTER          UPLO
96      INTEGER            LDX, N
97*     ..
98*     .. Array Arguments ..
99      INTEGER            ISEED( * )
100      COMPLEX            X( LDX, * )
101*     ..
102*
103*  =====================================================================
104*
105*     .. Parameters ..
106      COMPLEX            EYE
107      PARAMETER          ( EYE = ( 0.0, 1.0 ) )
108*     ..
109*     .. Local Scalars ..
110      INTEGER            I, J, N5
111      REAL               ALPHA, ALPHA3, BETA
112      COMPLEX            A, B, C, R
113*     ..
114*     .. External Functions ..
115      COMPLEX            CLARND
116      EXTERNAL           CLARND
117*     ..
118*     .. Intrinsic Functions ..
119      INTRINSIC          ABS, SQRT
120*     ..
121*     .. Executable Statements ..
122*
123*     Initialize constants
124*
125      ALPHA = ( 1.+SQRT( 17. ) ) / 8.
126      BETA = ALPHA - 1. / 1000.
127      ALPHA3 = ALPHA*ALPHA*ALPHA
128*
129*     UPLO = 'U':  Upper triangular storage
130*
131      IF( UPLO.EQ.'U' ) THEN
132*
133*        Fill the upper triangle of the matrix with zeros.
134*
135         DO 20 J = 1, N
136            DO 10 I = 1, J
137               X( I, J ) = 0.0
138   10       CONTINUE
139   20    CONTINUE
140         N5 = N / 5
141         N5 = N - 5*N5 + 1
142*
143         DO 30 I = N, N5, -5
144            A = ALPHA3*CLARND( 5, ISEED )
145            B = CLARND( 5, ISEED ) / ALPHA
146            C = A - 2.*B*EYE
147            R = C / BETA
148            X( I, I ) = A
149            X( I-2, I ) = B
150            X( I-2, I-1 ) = R
151            X( I-2, I-2 ) = C
152            X( I-1, I-1 ) = CLARND( 2, ISEED )
153            X( I-3, I-3 ) = CLARND( 2, ISEED )
154            X( I-4, I-4 ) = CLARND( 2, ISEED )
155            IF( ABS( X( I-3, I-3 ) ).GT.ABS( X( I-4, I-4 ) ) ) THEN
156               X( I-4, I-3 ) = 2.0*X( I-3, I-3 )
157            ELSE
158               X( I-4, I-3 ) = 2.0*X( I-4, I-4 )
159            END IF
160   30    CONTINUE
161*
162*        Clean-up for N not a multiple of 5.
163*
164         I = N5 - 1
165         IF( I.GT.2 ) THEN
166            A = ALPHA3*CLARND( 5, ISEED )
167            B = CLARND( 5, ISEED ) / ALPHA
168            C = A - 2.*B*EYE
169            R = C / BETA
170            X( I, I ) = A
171            X( I-2, I ) = B
172            X( I-2, I-1 ) = R
173            X( I-2, I-2 ) = C
174            X( I-1, I-1 ) = CLARND( 2, ISEED )
175            I = I - 3
176         END IF
177         IF( I.GT.1 ) THEN
178            X( I, I ) = CLARND( 2, ISEED )
179            X( I-1, I-1 ) = CLARND( 2, ISEED )
180            IF( ABS( X( I, I ) ).GT.ABS( X( I-1, I-1 ) ) ) THEN
181               X( I-1, I ) = 2.0*X( I, I )
182            ELSE
183               X( I-1, I ) = 2.0*X( I-1, I-1 )
184            END IF
185            I = I - 2
186         ELSE IF( I.EQ.1 ) THEN
187            X( I, I ) = CLARND( 2, ISEED )
188            I = I - 1
189         END IF
190*
191*     UPLO = 'L':  Lower triangular storage
192*
193      ELSE
194*
195*        Fill the lower triangle of the matrix with zeros.
196*
197         DO 50 J = 1, N
198            DO 40 I = J, N
199               X( I, J ) = 0.0
200   40       CONTINUE
201   50    CONTINUE
202         N5 = N / 5
203         N5 = N5*5
204*
205         DO 60 I = 1, N5, 5
206            A = ALPHA3*CLARND( 5, ISEED )
207            B = CLARND( 5, ISEED ) / ALPHA
208            C = A - 2.*B*EYE
209            R = C / BETA
210            X( I, I ) = A
211            X( I+2, I ) = B
212            X( I+2, I+1 ) = R
213            X( I+2, I+2 ) = C
214            X( I+1, I+1 ) = CLARND( 2, ISEED )
215            X( I+3, I+3 ) = CLARND( 2, ISEED )
216            X( I+4, I+4 ) = CLARND( 2, ISEED )
217            IF( ABS( X( I+3, I+3 ) ).GT.ABS( X( I+4, I+4 ) ) ) THEN
218               X( I+4, I+3 ) = 2.0*X( I+3, I+3 )
219            ELSE
220               X( I+4, I+3 ) = 2.0*X( I+4, I+4 )
221            END IF
222   60    CONTINUE
223*
224*        Clean-up for N not a multiple of 5.
225*
226         I = N5 + 1
227         IF( I.LT.N-1 ) THEN
228            A = ALPHA3*CLARND( 5, ISEED )
229            B = CLARND( 5, ISEED ) / ALPHA
230            C = A - 2.*B*EYE
231            R = C / BETA
232            X( I, I ) = A
233            X( I+2, I ) = B
234            X( I+2, I+1 ) = R
235            X( I+2, I+2 ) = C
236            X( I+1, I+1 ) = CLARND( 2, ISEED )
237            I = I + 3
238         END IF
239         IF( I.LT.N ) THEN
240            X( I, I ) = CLARND( 2, ISEED )
241            X( I+1, I+1 ) = CLARND( 2, ISEED )
242            IF( ABS( X( I, I ) ).GT.ABS( X( I+1, I+1 ) ) ) THEN
243               X( I+1, I ) = 2.0*X( I, I )
244            ELSE
245               X( I+1, I ) = 2.0*X( I+1, I+1 )
246            END IF
247            I = I + 2
248         ELSE IF( I.EQ.N ) THEN
249            X( I, I ) = CLARND( 2, ISEED )
250            I = I + 1
251         END IF
252      END IF
253*
254      RETURN
255*
256*     End of CLATSY
257*
258      END
259