LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ zlatsy()

subroutine zlatsy ( character  uplo,
integer  n,
complex*16, dimension( ldx, * )  x,
integer  ldx,
integer, dimension( * )  iseed 
)

ZLATSY

Purpose:
 ZLATSY generates a special test matrix for the complex symmetric
 (indefinite) factorization.  The pivot blocks of the generated matrix
 will be in the following order:
    2x2 pivot block, non diagonalizable
    1x1 pivot block
    2x2 pivot block, diagonalizable
    (cycle repeats)
 A row interchange is required for each non-diagonalizable 2x2 block.
Parameters
[in]UPLO
          UPLO is CHARACTER
          Specifies whether the generated matrix is to be upper or
          lower triangular.
          = 'U':  Upper triangular
          = 'L':  Lower triangular
[in]N
          N is INTEGER
          The dimension of the matrix to be generated.
[out]X
          X is COMPLEX*16 array, dimension (LDX,N)
          The generated matrix, consisting of 3x3 and 2x2 diagonal
          blocks which result in the pivot sequence given above.
          The matrix outside of these diagonal blocks is zero.
[in]LDX
          LDX is INTEGER
          The leading dimension of the array X.
[in,out]ISEED
          ISEED is INTEGER array, dimension (4)
          On entry, the seed for the random number generator.  The last
          of the four integers must be odd.  (modified on exit)
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 88 of file zlatsy.f.

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*16 X( LDX, * )
101* ..
102*
103* =====================================================================
104*
105* .. Parameters ..
106 COMPLEX*16 EYE
107 parameter( eye = ( 0.0d0, 1.0d0 ) )
108* ..
109* .. Local Scalars ..
110 INTEGER I, J, N5
111 DOUBLE PRECISION ALPHA, ALPHA3, BETA
112 COMPLEX*16 A, B, C, R
113* ..
114* .. External Functions ..
115 COMPLEX*16 ZLARND
116 EXTERNAL zlarnd
117* ..
118* .. Intrinsic Functions ..
119 INTRINSIC abs, sqrt
120* ..
121* .. Executable Statements ..
122*
123* Initialize constants
124*
125 alpha = ( 1.d0+sqrt( 17.d0 ) ) / 8.d0
126 beta = alpha - 1.d0 / 1000.d0
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.0d0
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*zlarnd( 5, iseed )
145 b = zlarnd( 5, iseed ) / alpha
146 c = a - 2.d0*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 ) = zlarnd( 2, iseed )
153 x( i-3, i-3 ) = zlarnd( 2, iseed )
154 x( i-4, i-4 ) = zlarnd( 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.0d0*x( i-3, i-3 )
157 ELSE
158 x( i-4, i-3 ) = 2.0d0*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*zlarnd( 5, iseed )
167 b = zlarnd( 5, iseed ) / alpha
168 c = a - 2.d0*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 ) = zlarnd( 2, iseed )
175 i = i - 3
176 END IF
177 IF( i.GT.1 ) THEN
178 x( i, i ) = zlarnd( 2, iseed )
179 x( i-1, i-1 ) = zlarnd( 2, iseed )
180 IF( abs( x( i, i ) ).GT.abs( x( i-1, i-1 ) ) ) THEN
181 x( i-1, i ) = 2.0d0*x( i, i )
182 ELSE
183 x( i-1, i ) = 2.0d0*x( i-1, i-1 )
184 END IF
185 i = i - 2
186 ELSE IF( i.EQ.1 ) THEN
187 x( i, i ) = zlarnd( 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.0d0
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*zlarnd( 5, iseed )
207 b = zlarnd( 5, iseed ) / alpha
208 c = a - 2.d0*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 ) = zlarnd( 2, iseed )
215 x( i+3, i+3 ) = zlarnd( 2, iseed )
216 x( i+4, i+4 ) = zlarnd( 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.0d0*x( i+3, i+3 )
219 ELSE
220 x( i+4, i+3 ) = 2.0d0*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*zlarnd( 5, iseed )
229 b = zlarnd( 5, iseed ) / alpha
230 c = a - 2.d0*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 ) = zlarnd( 2, iseed )
237 i = i + 3
238 END IF
239 IF( i.LT.n ) THEN
240 x( i, i ) = zlarnd( 2, iseed )
241 x( i+1, i+1 ) = zlarnd( 2, iseed )
242 IF( abs( x( i, i ) ).GT.abs( x( i+1, i+1 ) ) ) THEN
243 x( i+1, i ) = 2.0d0*x( i, i )
244 ELSE
245 x( i+1, i ) = 2.0d0*x( i+1, i+1 )
246 END IF
247 i = i + 2
248 ELSE IF( i.EQ.n ) THEN
249 x( i, i ) = zlarnd( 2, iseed )
250 i = i + 1
251 END IF
252 END IF
253*
254 RETURN
255*
256* End of ZLATSY
257*
zlarnd
complex *16 function zlarnd(idist, iseed)
ZLARND
Definition zlarnd.f:75
Here is the caller graph for this function: