LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ clatsy()

subroutine clatsy ( character  UPLO,
integer  N,
complex, dimension( ldx, * )  X,
integer  LDX,
integer, dimension( * )  ISEED 
)

CLATSY

Purpose:
 CLATSY 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 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 clatsy.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 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 *
complex function clarnd(IDIST, ISEED)
CLARND
Definition: clarnd.f:75
Here is the caller graph for this function: