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