![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZLATSY 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE ZLATSY( UPLO, N, X, LDX, ISEED ) 00012 * 00013 * .. Scalar Arguments .. 00014 * CHARACTER UPLO 00015 * INTEGER LDX, N 00016 * .. 00017 * .. Array Arguments .. 00018 * INTEGER ISEED( * ) 00019 * COMPLEX*16 X( LDX, * ) 00020 * .. 00021 * 00022 * 00023 *> \par Purpose: 00024 * ============= 00025 *> 00026 *> \verbatim 00027 *> 00028 *> ZLATSY generates a special test matrix for the complex symmetric 00029 *> (indefinite) factorization. The pivot blocks of the generated matrix 00030 *> will be in the following order: 00031 *> 2x2 pivot block, non diagonalizable 00032 *> 1x1 pivot block 00033 *> 2x2 pivot block, diagonalizable 00034 *> (cycle repeats) 00035 *> A row interchange is required for each non-diagonalizable 2x2 block. 00036 *> \endverbatim 00037 * 00038 * Arguments: 00039 * ========== 00040 * 00041 *> \param[in] UPLO 00042 *> \verbatim 00043 *> UPLO is CHARACTER 00044 *> Specifies whether the generated matrix is to be upper or 00045 *> lower triangular. 00046 *> = 'U': Upper triangular 00047 *> = 'L': Lower triangular 00048 *> \endverbatim 00049 *> 00050 *> \param[in] N 00051 *> \verbatim 00052 *> N is INTEGER 00053 *> The dimension of the matrix to be generated. 00054 *> \endverbatim 00055 *> 00056 *> \param[out] X 00057 *> \verbatim 00058 *> X is COMPLEX*16 array, dimension (LDX,N) 00059 *> The generated matrix, consisting of 3x3 and 2x2 diagonal 00060 *> blocks which result in the pivot sequence given above. 00061 *> The matrix outside of these diagonal blocks is zero. 00062 *> \endverbatim 00063 *> 00064 *> \param[in] LDX 00065 *> \verbatim 00066 *> LDX is INTEGER 00067 *> The leading dimension of the array X. 00068 *> \endverbatim 00069 *> 00070 *> \param[in,out] ISEED 00071 *> \verbatim 00072 *> ISEED is INTEGER array, dimension (4) 00073 *> On entry, the seed for the random number generator. The last 00074 *> of the four integers must be odd. (modified on exit) 00075 *> \endverbatim 00076 * 00077 * Authors: 00078 * ======== 00079 * 00080 *> \author Univ. of Tennessee 00081 *> \author Univ. of California Berkeley 00082 *> \author Univ. of Colorado Denver 00083 *> \author NAG Ltd. 00084 * 00085 *> \date November 2011 00086 * 00087 *> \ingroup complex16_lin 00088 * 00089 * ===================================================================== 00090 SUBROUTINE ZLATSY( UPLO, N, X, LDX, ISEED ) 00091 * 00092 * -- LAPACK test routine (version 3.4.0) -- 00093 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00094 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00095 * November 2011 00096 * 00097 * .. Scalar Arguments .. 00098 CHARACTER UPLO 00099 INTEGER LDX, N 00100 * .. 00101 * .. Array Arguments .. 00102 INTEGER ISEED( * ) 00103 COMPLEX*16 X( LDX, * ) 00104 * .. 00105 * 00106 * ===================================================================== 00107 * 00108 * .. Parameters .. 00109 COMPLEX*16 EYE 00110 PARAMETER ( EYE = ( 0.0D0, 1.0D0 ) ) 00111 * .. 00112 * .. Local Scalars .. 00113 INTEGER I, J, N5 00114 DOUBLE PRECISION ALPHA, ALPHA3, BETA 00115 COMPLEX*16 A, B, C, R 00116 * .. 00117 * .. External Functions .. 00118 COMPLEX*16 ZLARND 00119 EXTERNAL ZLARND 00120 * .. 00121 * .. Intrinsic Functions .. 00122 INTRINSIC ABS, SQRT 00123 * .. 00124 * .. Executable Statements .. 00125 * 00126 * Initialize constants 00127 * 00128 ALPHA = ( 1.D0+SQRT( 17.D0 ) ) / 8.D0 00129 BETA = ALPHA - 1.D0 / 1000.D0 00130 ALPHA3 = ALPHA*ALPHA*ALPHA 00131 * 00132 * UPLO = 'U': Upper triangular storage 00133 * 00134 IF( UPLO.EQ.'U' ) THEN 00135 * 00136 * Fill the upper triangle of the matrix with zeros. 00137 * 00138 DO 20 J = 1, N 00139 DO 10 I = 1, J 00140 X( I, J ) = 0.0D0 00141 10 CONTINUE 00142 20 CONTINUE 00143 N5 = N / 5 00144 N5 = N - 5*N5 + 1 00145 * 00146 DO 30 I = N, N5, -5 00147 A = ALPHA3*ZLARND( 5, ISEED ) 00148 B = ZLARND( 5, ISEED ) / ALPHA 00149 C = A - 2.D0*B*EYE 00150 R = C / BETA 00151 X( I, I ) = A 00152 X( I-2, I ) = B 00153 X( I-2, I-1 ) = R 00154 X( I-2, I-2 ) = C 00155 X( I-1, I-1 ) = ZLARND( 2, ISEED ) 00156 X( I-3, I-3 ) = ZLARND( 2, ISEED ) 00157 X( I-4, I-4 ) = ZLARND( 2, ISEED ) 00158 IF( ABS( X( I-3, I-3 ) ).GT.ABS( X( I-4, I-4 ) ) ) THEN 00159 X( I-4, I-3 ) = 2.0D0*X( I-3, I-3 ) 00160 ELSE 00161 X( I-4, I-3 ) = 2.0D0*X( I-4, I-4 ) 00162 END IF 00163 30 CONTINUE 00164 * 00165 * Clean-up for N not a multiple of 5. 00166 * 00167 I = N5 - 1 00168 IF( I.GT.2 ) THEN 00169 A = ALPHA3*ZLARND( 5, ISEED ) 00170 B = ZLARND( 5, ISEED ) / ALPHA 00171 C = A - 2.D0*B*EYE 00172 R = C / BETA 00173 X( I, I ) = A 00174 X( I-2, I ) = B 00175 X( I-2, I-1 ) = R 00176 X( I-2, I-2 ) = C 00177 X( I-1, I-1 ) = ZLARND( 2, ISEED ) 00178 I = I - 3 00179 END IF 00180 IF( I.GT.1 ) THEN 00181 X( I, I ) = ZLARND( 2, ISEED ) 00182 X( I-1, I-1 ) = ZLARND( 2, ISEED ) 00183 IF( ABS( X( I, I ) ).GT.ABS( X( I-1, I-1 ) ) ) THEN 00184 X( I-1, I ) = 2.0D0*X( I, I ) 00185 ELSE 00186 X( I-1, I ) = 2.0D0*X( I-1, I-1 ) 00187 END IF 00188 I = I - 2 00189 ELSE IF( I.EQ.1 ) THEN 00190 X( I, I ) = ZLARND( 2, ISEED ) 00191 I = I - 1 00192 END IF 00193 * 00194 * UPLO = 'L': Lower triangular storage 00195 * 00196 ELSE 00197 * 00198 * Fill the lower triangle of the matrix with zeros. 00199 * 00200 DO 50 J = 1, N 00201 DO 40 I = J, N 00202 X( I, J ) = 0.0D0 00203 40 CONTINUE 00204 50 CONTINUE 00205 N5 = N / 5 00206 N5 = N5*5 00207 * 00208 DO 60 I = 1, N5, 5 00209 A = ALPHA3*ZLARND( 5, ISEED ) 00210 B = ZLARND( 5, ISEED ) / ALPHA 00211 C = A - 2.D0*B*EYE 00212 R = C / BETA 00213 X( I, I ) = A 00214 X( I+2, I ) = B 00215 X( I+2, I+1 ) = R 00216 X( I+2, I+2 ) = C 00217 X( I+1, I+1 ) = ZLARND( 2, ISEED ) 00218 X( I+3, I+3 ) = ZLARND( 2, ISEED ) 00219 X( I+4, I+4 ) = ZLARND( 2, ISEED ) 00220 IF( ABS( X( I+3, I+3 ) ).GT.ABS( X( I+4, I+4 ) ) ) THEN 00221 X( I+4, I+3 ) = 2.0D0*X( I+3, I+3 ) 00222 ELSE 00223 X( I+4, I+3 ) = 2.0D0*X( I+4, I+4 ) 00224 END IF 00225 60 CONTINUE 00226 * 00227 * Clean-up for N not a multiple of 5. 00228 * 00229 I = N5 + 1 00230 IF( I.LT.N-1 ) THEN 00231 A = ALPHA3*ZLARND( 5, ISEED ) 00232 B = ZLARND( 5, ISEED ) / ALPHA 00233 C = A - 2.D0*B*EYE 00234 R = C / BETA 00235 X( I, I ) = A 00236 X( I+2, I ) = B 00237 X( I+2, I+1 ) = R 00238 X( I+2, I+2 ) = C 00239 X( I+1, I+1 ) = ZLARND( 2, ISEED ) 00240 I = I + 3 00241 END IF 00242 IF( I.LT.N ) THEN 00243 X( I, I ) = ZLARND( 2, ISEED ) 00244 X( I+1, I+1 ) = ZLARND( 2, ISEED ) 00245 IF( ABS( X( I, I ) ).GT.ABS( X( I+1, I+1 ) ) ) THEN 00246 X( I+1, I ) = 2.0D0*X( I, I ) 00247 ELSE 00248 X( I+1, I ) = 2.0D0*X( I+1, I+1 ) 00249 END IF 00250 I = I + 2 00251 ELSE IF( I.EQ.N ) THEN 00252 X( I, I ) = ZLARND( 2, ISEED ) 00253 I = I + 1 00254 END IF 00255 END IF 00256 * 00257 RETURN 00258 * 00259 * End of ZLATSY 00260 * 00261 END