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

◆ clatsp()

subroutine clatsp ( character uplo,
integer n,
complex, dimension( * ) x,
integer, dimension( * ) iseed )

CLATSP

Purpose:
!>
!> CLATSP generates a special test matrix for the complex symmetric
!> (indefinite) factorization for packed matrices.  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 array, dimension (N*(N+1)/2)
!>          The generated matrix in packed storage format.  The matrix
!>          consists of 3x3 and 2x2 diagonal blocks which result in the
!>          pivot sequence given above.  The matrix outside these
!>          diagonal blocks is zero.
!>
[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 83 of file clatsp.f.

84*
85* -- LAPACK test routine --
86* -- LAPACK is a software package provided by Univ. of Tennessee, --
87* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
88*
89* .. Scalar Arguments ..
90 CHARACTER UPLO
91 INTEGER N
92* ..
93* .. Array Arguments ..
94 INTEGER ISEED( * )
95 COMPLEX X( * )
96* ..
97*
98* =====================================================================
99*
100* .. Parameters ..
101 COMPLEX EYE
102 parameter( eye = ( 0.0, 1.0 ) )
103* ..
104* .. Local Scalars ..
105 INTEGER J, JJ, N5
106 REAL ALPHA, ALPHA3, BETA
107 COMPLEX A, B, C, R
108* ..
109* .. External Functions ..
110 COMPLEX CLARND
111 EXTERNAL clarnd
112* ..
113* .. Intrinsic Functions ..
114 INTRINSIC abs, sqrt
115* ..
116* .. Executable Statements ..
117*
118* Initialize constants
119*
120 alpha = ( 1.+sqrt( 17. ) ) / 8.
121 beta = alpha - 1. / 1000.
122 alpha3 = alpha*alpha*alpha
123*
124* Fill the matrix with zeros.
125*
126 DO 10 j = 1, n*( n+1 ) / 2
127 x( j ) = 0.0
128 10 CONTINUE
129*
130* UPLO = 'U': Upper triangular storage
131*
132 IF( uplo.EQ.'U' ) THEN
133 n5 = n / 5
134 n5 = n - 5*n5 + 1
135*
136 jj = n*( n+1 ) / 2
137 DO 20 j = n, n5, -5
138 a = alpha3*clarnd( 5, iseed )
139 b = clarnd( 5, iseed ) / alpha
140 c = a - 2.*b*eye
141 r = c / beta
142 x( jj ) = a
143 x( jj-2 ) = b
144 jj = jj - j
145 x( jj ) = clarnd( 2, iseed )
146 x( jj-1 ) = r
147 jj = jj - ( j-1 )
148 x( jj ) = c
149 jj = jj - ( j-2 )
150 x( jj ) = clarnd( 2, iseed )
151 jj = jj - ( j-3 )
152 x( jj ) = clarnd( 2, iseed )
153 IF( abs( x( jj+( j-3 ) ) ).GT.abs( x( jj ) ) ) THEN
154 x( jj+( j-4 ) ) = 2.0*x( jj+( j-3 ) )
155 ELSE
156 x( jj+( j-4 ) ) = 2.0*x( jj )
157 END IF
158 jj = jj - ( j-4 )
159 20 CONTINUE
160*
161* Clean-up for N not a multiple of 5.
162*
163 j = n5 - 1
164 IF( j.GT.2 ) THEN
165 a = alpha3*clarnd( 5, iseed )
166 b = clarnd( 5, iseed ) / alpha
167 c = a - 2.*b*eye
168 r = c / beta
169 x( jj ) = a
170 x( jj-2 ) = b
171 jj = jj - j
172 x( jj ) = clarnd( 2, iseed )
173 x( jj-1 ) = r
174 jj = jj - ( j-1 )
175 x( jj ) = c
176 jj = jj - ( j-2 )
177 j = j - 3
178 END IF
179 IF( j.GT.1 ) THEN
180 x( jj ) = clarnd( 2, iseed )
181 x( jj-j ) = clarnd( 2, iseed )
182 IF( abs( x( jj ) ).GT.abs( x( jj-j ) ) ) THEN
183 x( jj-1 ) = 2.0*x( jj )
184 ELSE
185 x( jj-1 ) = 2.0*x( jj-j )
186 END IF
187 jj = jj - j - ( j-1 )
188 j = j - 2
189 ELSE IF( j.EQ.1 ) THEN
190 x( jj ) = clarnd( 2, iseed )
191 j = j - 1
192 END IF
193*
194* UPLO = 'L': Lower triangular storage
195*
196 ELSE
197 n5 = n / 5
198 n5 = n5*5
199*
200 jj = 1
201 DO 30 j = 1, n5, 5
202 a = alpha3*clarnd( 5, iseed )
203 b = clarnd( 5, iseed ) / alpha
204 c = a - 2.*b*eye
205 r = c / beta
206 x( jj ) = a
207 x( jj+2 ) = b
208 jj = jj + ( n-j+1 )
209 x( jj ) = clarnd( 2, iseed )
210 x( jj+1 ) = r
211 jj = jj + ( n-j )
212 x( jj ) = c
213 jj = jj + ( n-j-1 )
214 x( jj ) = clarnd( 2, iseed )
215 jj = jj + ( n-j-2 )
216 x( jj ) = clarnd( 2, iseed )
217 IF( abs( x( jj-( n-j-2 ) ) ).GT.abs( x( jj ) ) ) THEN
218 x( jj-( n-j-2 )+1 ) = 2.0*x( jj-( n-j-2 ) )
219 ELSE
220 x( jj-( n-j-2 )+1 ) = 2.0*x( jj )
221 END IF
222 jj = jj + ( n-j-3 )
223 30 CONTINUE
224*
225* Clean-up for N not a multiple of 5.
226*
227 j = n5 + 1
228 IF( j.LT.n-1 ) THEN
229 a = alpha3*clarnd( 5, iseed )
230 b = clarnd( 5, iseed ) / alpha
231 c = a - 2.*b*eye
232 r = c / beta
233 x( jj ) = a
234 x( jj+2 ) = b
235 jj = jj + ( n-j+1 )
236 x( jj ) = clarnd( 2, iseed )
237 x( jj+1 ) = r
238 jj = jj + ( n-j )
239 x( jj ) = c
240 jj = jj + ( n-j-1 )
241 j = j + 3
242 END IF
243 IF( j.LT.n ) THEN
244 x( jj ) = clarnd( 2, iseed )
245 x( jj+( n-j+1 ) ) = clarnd( 2, iseed )
246 IF( abs( x( jj ) ).GT.abs( x( jj+( n-j+1 ) ) ) ) THEN
247 x( jj+1 ) = 2.0*x( jj )
248 ELSE
249 x( jj+1 ) = 2.0*x( jj+( n-j+1 ) )
250 END IF
251 jj = jj + ( n-j+1 ) + ( n-j )
252 j = j + 2
253 ELSE IF( j.EQ.n ) THEN
254 x( jj ) = clarnd( 2, iseed )
255 jj = jj + ( n-j+1 )
256 j = j + 1
257 END IF
258 END IF
259*
260 RETURN
261*
262* End of CLATSP
263*
clarnd
complex function clarnd(idist, iseed)
CLARND
Definition clarnd.f:75
Here is the caller graph for this function: