LAPACK 3.12.1
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: