1 SUBROUTINE CLATSY( UPLO, N, X, LDX, ISEED )
2 *
3 * -- LAPACK auxiliary test routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 CHARACTER UPLO
9 INTEGER LDX, N
10 * ..
11 * .. Array Arguments ..
12 INTEGER ISEED( * )
13 COMPLEX X( LDX, * )
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * CLATSY generates a special test matrix for the complex symmetric
20 * (indefinite) factorization. The pivot blocks of the generated matrix
21 * will be in the following order:
22 * 2x2 pivot block, non diagonalizable
23 * 1x1 pivot block
24 * 2x2 pivot block, diagonalizable
25 * (cycle repeats)
26 * A row interchange is required for each non-diagonalizable 2x2 block.
27 *
28 * Arguments
29 * =========
30 *
31 * UPLO (input) CHARACTER
32 * Specifies whether the generated matrix is to be upper or
33 * lower triangular.
34 * = 'U': Upper triangular
35 * = 'L': Lower triangular
36 *
37 * N (input) INTEGER
38 * The dimension of the matrix to be generated.
39 *
40 * X (output) COMPLEX array, dimension (LDX,N)
41 * The generated matrix, consisting of 3x3 and 2x2 diagonal
42 * blocks which result in the pivot sequence given above.
43 * The matrix outside of these diagonal blocks is zero.
44 *
45 * LDX (input) INTEGER
46 * The leading dimension of the array X.
47 *
48 * ISEED (input/output) INTEGER array, dimension (4)
49 * On entry, the seed for the random number generator. The last
50 * of the four integers must be odd. (modified on exit)
51 *
52 * =====================================================================
53 *
54 * .. Parameters ..
55 COMPLEX EYE
56 PARAMETER ( EYE = ( 0.0, 1.0 ) )
57 * ..
58 * .. Local Scalars ..
59 INTEGER I, J, N5
60 REAL ALPHA, ALPHA3, BETA
61 COMPLEX A, B, C, R
62 * ..
63 * .. External Functions ..
64 COMPLEX CLARND
65 EXTERNAL CLARND
66 * ..
67 * .. Intrinsic Functions ..
68 INTRINSIC ABS, SQRT
69 * ..
70 * .. Executable Statements ..
71 *
72 * Initialize constants
73 *
74 ALPHA = ( 1.+SQRT( 17. ) ) / 8.
75 BETA = ALPHA - 1. / 1000.
76 ALPHA3 = ALPHA*ALPHA*ALPHA
77 *
78 * UPLO = 'U': Upper triangular storage
79 *
80 IF( UPLO.EQ.'U' ) THEN
81 *
82 * Fill the upper triangle of the matrix with zeros.
83 *
84 DO 20 J = 1, N
85 DO 10 I = 1, J
86 X( I, J ) = 0.0
87 10 CONTINUE
88 20 CONTINUE
89 N5 = N / 5
90 N5 = N - 5*N5 + 1
91 *
92 DO 30 I = N, N5, -5
93 A = ALPHA3*CLARND( 5, ISEED )
94 B = CLARND( 5, ISEED ) / ALPHA
95 C = A - 2.*B*EYE
96 R = C / BETA
97 X( I, I ) = A
98 X( I-2, I ) = B
99 X( I-2, I-1 ) = R
100 X( I-2, I-2 ) = C
101 X( I-1, I-1 ) = CLARND( 2, ISEED )
102 X( I-3, I-3 ) = CLARND( 2, ISEED )
103 X( I-4, I-4 ) = CLARND( 2, ISEED )
104 IF( ABS( X( I-3, I-3 ) ).GT.ABS( X( I-4, I-4 ) ) ) THEN
105 X( I-4, I-3 ) = 2.0*X( I-3, I-3 )
106 ELSE
107 X( I-4, I-3 ) = 2.0*X( I-4, I-4 )
108 END IF
109 30 CONTINUE
110 *
111 * Clean-up for N not a multiple of 5.
112 *
113 I = N5 - 1
114 IF( I.GT.2 ) THEN
115 A = ALPHA3*CLARND( 5, ISEED )
116 B = CLARND( 5, ISEED ) / ALPHA
117 C = A - 2.*B*EYE
118 R = C / BETA
119 X( I, I ) = A
120 X( I-2, I ) = B
121 X( I-2, I-1 ) = R
122 X( I-2, I-2 ) = C
123 X( I-1, I-1 ) = CLARND( 2, ISEED )
124 I = I - 3
125 END IF
126 IF( I.GT.1 ) THEN
127 X( I, I ) = CLARND( 2, ISEED )
128 X( I-1, I-1 ) = CLARND( 2, ISEED )
129 IF( ABS( X( I, I ) ).GT.ABS( X( I-1, I-1 ) ) ) THEN
130 X( I-1, I ) = 2.0*X( I, I )
131 ELSE
132 X( I-1, I ) = 2.0*X( I-1, I-1 )
133 END IF
134 I = I - 2
135 ELSE IF( I.EQ.1 ) THEN
136 X( I, I ) = CLARND( 2, ISEED )
137 I = I - 1
138 END IF
139 *
140 * UPLO = 'L': Lower triangular storage
141 *
142 ELSE
143 *
144 * Fill the lower triangle of the matrix with zeros.
145 *
146 DO 50 J = 1, N
147 DO 40 I = J, N
148 X( I, J ) = 0.0
149 40 CONTINUE
150 50 CONTINUE
151 N5 = N / 5
152 N5 = N5*5
153 *
154 DO 60 I = 1, N5, 5
155 A = ALPHA3*CLARND( 5, ISEED )
156 B = CLARND( 5, ISEED ) / ALPHA
157 C = A - 2.*B*EYE
158 R = C / BETA
159 X( I, I ) = A
160 X( I+2, I ) = B
161 X( I+2, I+1 ) = R
162 X( I+2, I+2 ) = C
163 X( I+1, I+1 ) = CLARND( 2, ISEED )
164 X( I+3, I+3 ) = CLARND( 2, ISEED )
165 X( I+4, I+4 ) = CLARND( 2, ISEED )
166 IF( ABS( X( I+3, I+3 ) ).GT.ABS( X( I+4, I+4 ) ) ) THEN
167 X( I+4, I+3 ) = 2.0*X( I+3, I+3 )
168 ELSE
169 X( I+4, I+3 ) = 2.0*X( I+4, I+4 )
170 END IF
171 60 CONTINUE
172 *
173 * Clean-up for N not a multiple of 5.
174 *
175 I = N5 + 1
176 IF( I.LT.N-1 ) THEN
177 A = ALPHA3*CLARND( 5, ISEED )
178 B = CLARND( 5, ISEED ) / ALPHA
179 C = A - 2.*B*EYE
180 R = C / BETA
181 X( I, I ) = A
182 X( I+2, I ) = B
183 X( I+2, I+1 ) = R
184 X( I+2, I+2 ) = C
185 X( I+1, I+1 ) = CLARND( 2, ISEED )
186 I = I + 3
187 END IF
188 IF( I.LT.N ) THEN
189 X( I, I ) = CLARND( 2, ISEED )
190 X( I+1, I+1 ) = CLARND( 2, ISEED )
191 IF( ABS( X( I, I ) ).GT.ABS( X( I+1, I+1 ) ) ) THEN
192 X( I+1, I ) = 2.0*X( I, I )
193 ELSE
194 X( I+1, I ) = 2.0*X( I+1, I+1 )
195 END IF
196 I = I + 2
197 ELSE IF( I.EQ.N ) THEN
198 X( I, I ) = CLARND( 2, ISEED )
199 I = I + 1
200 END IF
201 END IF
202 *
203 RETURN
204 *
205 * End of CLATSY
206 *
207 END
2 *
3 * -- LAPACK auxiliary test routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 CHARACTER UPLO
9 INTEGER LDX, N
10 * ..
11 * .. Array Arguments ..
12 INTEGER ISEED( * )
13 COMPLEX X( LDX, * )
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * CLATSY generates a special test matrix for the complex symmetric
20 * (indefinite) factorization. The pivot blocks of the generated matrix
21 * will be in the following order:
22 * 2x2 pivot block, non diagonalizable
23 * 1x1 pivot block
24 * 2x2 pivot block, diagonalizable
25 * (cycle repeats)
26 * A row interchange is required for each non-diagonalizable 2x2 block.
27 *
28 * Arguments
29 * =========
30 *
31 * UPLO (input) CHARACTER
32 * Specifies whether the generated matrix is to be upper or
33 * lower triangular.
34 * = 'U': Upper triangular
35 * = 'L': Lower triangular
36 *
37 * N (input) INTEGER
38 * The dimension of the matrix to be generated.
39 *
40 * X (output) COMPLEX array, dimension (LDX,N)
41 * The generated matrix, consisting of 3x3 and 2x2 diagonal
42 * blocks which result in the pivot sequence given above.
43 * The matrix outside of these diagonal blocks is zero.
44 *
45 * LDX (input) INTEGER
46 * The leading dimension of the array X.
47 *
48 * ISEED (input/output) INTEGER array, dimension (4)
49 * On entry, the seed for the random number generator. The last
50 * of the four integers must be odd. (modified on exit)
51 *
52 * =====================================================================
53 *
54 * .. Parameters ..
55 COMPLEX EYE
56 PARAMETER ( EYE = ( 0.0, 1.0 ) )
57 * ..
58 * .. Local Scalars ..
59 INTEGER I, J, N5
60 REAL ALPHA, ALPHA3, BETA
61 COMPLEX A, B, C, R
62 * ..
63 * .. External Functions ..
64 COMPLEX CLARND
65 EXTERNAL CLARND
66 * ..
67 * .. Intrinsic Functions ..
68 INTRINSIC ABS, SQRT
69 * ..
70 * .. Executable Statements ..
71 *
72 * Initialize constants
73 *
74 ALPHA = ( 1.+SQRT( 17. ) ) / 8.
75 BETA = ALPHA - 1. / 1000.
76 ALPHA3 = ALPHA*ALPHA*ALPHA
77 *
78 * UPLO = 'U': Upper triangular storage
79 *
80 IF( UPLO.EQ.'U' ) THEN
81 *
82 * Fill the upper triangle of the matrix with zeros.
83 *
84 DO 20 J = 1, N
85 DO 10 I = 1, J
86 X( I, J ) = 0.0
87 10 CONTINUE
88 20 CONTINUE
89 N5 = N / 5
90 N5 = N - 5*N5 + 1
91 *
92 DO 30 I = N, N5, -5
93 A = ALPHA3*CLARND( 5, ISEED )
94 B = CLARND( 5, ISEED ) / ALPHA
95 C = A - 2.*B*EYE
96 R = C / BETA
97 X( I, I ) = A
98 X( I-2, I ) = B
99 X( I-2, I-1 ) = R
100 X( I-2, I-2 ) = C
101 X( I-1, I-1 ) = CLARND( 2, ISEED )
102 X( I-3, I-3 ) = CLARND( 2, ISEED )
103 X( I-4, I-4 ) = CLARND( 2, ISEED )
104 IF( ABS( X( I-3, I-3 ) ).GT.ABS( X( I-4, I-4 ) ) ) THEN
105 X( I-4, I-3 ) = 2.0*X( I-3, I-3 )
106 ELSE
107 X( I-4, I-3 ) = 2.0*X( I-4, I-4 )
108 END IF
109 30 CONTINUE
110 *
111 * Clean-up for N not a multiple of 5.
112 *
113 I = N5 - 1
114 IF( I.GT.2 ) THEN
115 A = ALPHA3*CLARND( 5, ISEED )
116 B = CLARND( 5, ISEED ) / ALPHA
117 C = A - 2.*B*EYE
118 R = C / BETA
119 X( I, I ) = A
120 X( I-2, I ) = B
121 X( I-2, I-1 ) = R
122 X( I-2, I-2 ) = C
123 X( I-1, I-1 ) = CLARND( 2, ISEED )
124 I = I - 3
125 END IF
126 IF( I.GT.1 ) THEN
127 X( I, I ) = CLARND( 2, ISEED )
128 X( I-1, I-1 ) = CLARND( 2, ISEED )
129 IF( ABS( X( I, I ) ).GT.ABS( X( I-1, I-1 ) ) ) THEN
130 X( I-1, I ) = 2.0*X( I, I )
131 ELSE
132 X( I-1, I ) = 2.0*X( I-1, I-1 )
133 END IF
134 I = I - 2
135 ELSE IF( I.EQ.1 ) THEN
136 X( I, I ) = CLARND( 2, ISEED )
137 I = I - 1
138 END IF
139 *
140 * UPLO = 'L': Lower triangular storage
141 *
142 ELSE
143 *
144 * Fill the lower triangle of the matrix with zeros.
145 *
146 DO 50 J = 1, N
147 DO 40 I = J, N
148 X( I, J ) = 0.0
149 40 CONTINUE
150 50 CONTINUE
151 N5 = N / 5
152 N5 = N5*5
153 *
154 DO 60 I = 1, N5, 5
155 A = ALPHA3*CLARND( 5, ISEED )
156 B = CLARND( 5, ISEED ) / ALPHA
157 C = A - 2.*B*EYE
158 R = C / BETA
159 X( I, I ) = A
160 X( I+2, I ) = B
161 X( I+2, I+1 ) = R
162 X( I+2, I+2 ) = C
163 X( I+1, I+1 ) = CLARND( 2, ISEED )
164 X( I+3, I+3 ) = CLARND( 2, ISEED )
165 X( I+4, I+4 ) = CLARND( 2, ISEED )
166 IF( ABS( X( I+3, I+3 ) ).GT.ABS( X( I+4, I+4 ) ) ) THEN
167 X( I+4, I+3 ) = 2.0*X( I+3, I+3 )
168 ELSE
169 X( I+4, I+3 ) = 2.0*X( I+4, I+4 )
170 END IF
171 60 CONTINUE
172 *
173 * Clean-up for N not a multiple of 5.
174 *
175 I = N5 + 1
176 IF( I.LT.N-1 ) THEN
177 A = ALPHA3*CLARND( 5, ISEED )
178 B = CLARND( 5, ISEED ) / ALPHA
179 C = A - 2.*B*EYE
180 R = C / BETA
181 X( I, I ) = A
182 X( I+2, I ) = B
183 X( I+2, I+1 ) = R
184 X( I+2, I+2 ) = C
185 X( I+1, I+1 ) = CLARND( 2, ISEED )
186 I = I + 3
187 END IF
188 IF( I.LT.N ) THEN
189 X( I, I ) = CLARND( 2, ISEED )
190 X( I+1, I+1 ) = CLARND( 2, ISEED )
191 IF( ABS( X( I, I ) ).GT.ABS( X( I+1, I+1 ) ) ) THEN
192 X( I+1, I ) = 2.0*X( I, I )
193 ELSE
194 X( I+1, I ) = 2.0*X( I+1, I+1 )
195 END IF
196 I = I + 2
197 ELSE IF( I.EQ.N ) THEN
198 X( I, I ) = CLARND( 2, ISEED )
199 I = I + 1
200 END IF
201 END IF
202 *
203 RETURN
204 *
205 * End of CLATSY
206 *
207 END