|
- *> \brief \b CLATSP
- *
- * =========== DOCUMENTATION ===========
- *
- * Online html documentation available at
- * http://www.netlib.org/lapack/explore-html/
- *
- * Definition:
- * ===========
- *
- * SUBROUTINE CLATSP( UPLO, N, X, ISEED )
- *
- * .. Scalar Arguments ..
- * CHARACTER UPLO
- * INTEGER N
- * ..
- * .. Array Arguments ..
- * INTEGER ISEED( * )
- * COMPLEX X( * )
- * ..
- *
- *
- *> \par Purpose:
- * =============
- *>
- *> \verbatim
- *>
- *> 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.
- *> \endverbatim
- *
- * Arguments:
- * ==========
- *
- *> \param[in] UPLO
- *> \verbatim
- *> UPLO is CHARACTER
- *> Specifies whether the generated matrix is to be upper or
- *> lower triangular.
- *> = 'U': Upper triangular
- *> = 'L': Lower triangular
- *> \endverbatim
- *>
- *> \param[in] N
- *> \verbatim
- *> N is INTEGER
- *> The dimension of the matrix to be generated.
- *> \endverbatim
- *>
- *> \param[out] X
- *> \verbatim
- *> 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.
- *> \endverbatim
- *>
- *> \param[in,out] ISEED
- *> \verbatim
- *> 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)
- *> \endverbatim
- *
- * Authors:
- * ========
- *
- *> \author Univ. of Tennessee
- *> \author Univ. of California Berkeley
- *> \author Univ. of Colorado Denver
- *> \author NAG Ltd.
- *
- *> \date November 2011
- *
- *> \ingroup complex_lin
- *
- * =====================================================================
- SUBROUTINE CLATSP( UPLO, N, X, ISEED )
- *
- * -- LAPACK test routine (version 3.4.0) --
- * -- LAPACK is a software package provided by Univ. of Tennessee, --
- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
- * November 2011
- *
- * .. Scalar Arguments ..
- CHARACTER UPLO
- INTEGER N
- * ..
- * .. Array Arguments ..
- INTEGER ISEED( * )
- COMPLEX X( * )
- * ..
- *
- * =====================================================================
- *
- * .. Parameters ..
- COMPLEX EYE
- PARAMETER ( EYE = ( 0.0, 1.0 ) )
- * ..
- * .. Local Scalars ..
- INTEGER J, JJ, N5
- REAL ALPHA, ALPHA3, BETA
- COMPLEX A, B, C, R
- * ..
- * .. External Functions ..
- COMPLEX CLARND
- EXTERNAL CLARND
- * ..
- * .. Intrinsic Functions ..
- INTRINSIC ABS, SQRT
- * ..
- * .. Executable Statements ..
- *
- * Initialize constants
- *
- ALPHA = ( 1.+SQRT( 17. ) ) / 8.
- BETA = ALPHA - 1. / 1000.
- ALPHA3 = ALPHA*ALPHA*ALPHA
- *
- * Fill the matrix with zeros.
- *
- DO 10 J = 1, N*( N+1 ) / 2
- X( J ) = 0.0
- 10 CONTINUE
- *
- * UPLO = 'U': Upper triangular storage
- *
- IF( UPLO.EQ.'U' ) THEN
- N5 = N / 5
- N5 = N - 5*N5 + 1
- *
- JJ = N*( N+1 ) / 2
- DO 20 J = N, N5, -5
- A = ALPHA3*CLARND( 5, ISEED )
- B = CLARND( 5, ISEED ) / ALPHA
- C = A - 2.*B*EYE
- R = C / BETA
- X( JJ ) = A
- X( JJ-2 ) = B
- JJ = JJ - J
- X( JJ ) = CLARND( 2, ISEED )
- X( JJ-1 ) = R
- JJ = JJ - ( J-1 )
- X( JJ ) = C
- JJ = JJ - ( J-2 )
- X( JJ ) = CLARND( 2, ISEED )
- JJ = JJ - ( J-3 )
- X( JJ ) = CLARND( 2, ISEED )
- IF( ABS( X( JJ+( J-3 ) ) ).GT.ABS( X( JJ ) ) ) THEN
- X( JJ+( J-4 ) ) = 2.0*X( JJ+( J-3 ) )
- ELSE
- X( JJ+( J-4 ) ) = 2.0*X( JJ )
- END IF
- JJ = JJ - ( J-4 )
- 20 CONTINUE
- *
- * Clean-up for N not a multiple of 5.
- *
- J = N5 - 1
- IF( J.GT.2 ) THEN
- A = ALPHA3*CLARND( 5, ISEED )
- B = CLARND( 5, ISEED ) / ALPHA
- C = A - 2.*B*EYE
- R = C / BETA
- X( JJ ) = A
- X( JJ-2 ) = B
- JJ = JJ - J
- X( JJ ) = CLARND( 2, ISEED )
- X( JJ-1 ) = R
- JJ = JJ - ( J-1 )
- X( JJ ) = C
- JJ = JJ - ( J-2 )
- J = J - 3
- END IF
- IF( J.GT.1 ) THEN
- X( JJ ) = CLARND( 2, ISEED )
- X( JJ-J ) = CLARND( 2, ISEED )
- IF( ABS( X( JJ ) ).GT.ABS( X( JJ-J ) ) ) THEN
- X( JJ-1 ) = 2.0*X( JJ )
- ELSE
- X( JJ-1 ) = 2.0*X( JJ-J )
- END IF
- JJ = JJ - J - ( J-1 )
- J = J - 2
- ELSE IF( J.EQ.1 ) THEN
- X( JJ ) = CLARND( 2, ISEED )
- J = J - 1
- END IF
- *
- * UPLO = 'L': Lower triangular storage
- *
- ELSE
- N5 = N / 5
- N5 = N5*5
- *
- JJ = 1
- DO 30 J = 1, N5, 5
- A = ALPHA3*CLARND( 5, ISEED )
- B = CLARND( 5, ISEED ) / ALPHA
- C = A - 2.*B*EYE
- R = C / BETA
- X( JJ ) = A
- X( JJ+2 ) = B
- JJ = JJ + ( N-J+1 )
- X( JJ ) = CLARND( 2, ISEED )
- X( JJ+1 ) = R
- JJ = JJ + ( N-J )
- X( JJ ) = C
- JJ = JJ + ( N-J-1 )
- X( JJ ) = CLARND( 2, ISEED )
- JJ = JJ + ( N-J-2 )
- X( JJ ) = CLARND( 2, ISEED )
- IF( ABS( X( JJ-( N-J-2 ) ) ).GT.ABS( X( JJ ) ) ) THEN
- X( JJ-( N-J-2 )+1 ) = 2.0*X( JJ-( N-J-2 ) )
- ELSE
- X( JJ-( N-J-2 )+1 ) = 2.0*X( JJ )
- END IF
- JJ = JJ + ( N-J-3 )
- 30 CONTINUE
- *
- * Clean-up for N not a multiple of 5.
- *
- J = N5 + 1
- IF( J.LT.N-1 ) THEN
- A = ALPHA3*CLARND( 5, ISEED )
- B = CLARND( 5, ISEED ) / ALPHA
- C = A - 2.*B*EYE
- R = C / BETA
- X( JJ ) = A
- X( JJ+2 ) = B
- JJ = JJ + ( N-J+1 )
- X( JJ ) = CLARND( 2, ISEED )
- X( JJ+1 ) = R
- JJ = JJ + ( N-J )
- X( JJ ) = C
- JJ = JJ + ( N-J-1 )
- J = J + 3
- END IF
- IF( J.LT.N ) THEN
- X( JJ ) = CLARND( 2, ISEED )
- X( JJ+( N-J+1 ) ) = CLARND( 2, ISEED )
- IF( ABS( X( JJ ) ).GT.ABS( X( JJ+( N-J+1 ) ) ) ) THEN
- X( JJ+1 ) = 2.0*X( JJ )
- ELSE
- X( JJ+1 ) = 2.0*X( JJ+( N-J+1 ) )
- END IF
- JJ = JJ + ( N-J+1 ) + ( N-J )
- J = J + 2
- ELSE IF( J.EQ.N ) THEN
- X( JJ ) = CLARND( 2, ISEED )
- JJ = JJ + ( N-J+1 )
- J = J + 1
- END IF
- END IF
- *
- RETURN
- *
- * End of CLATSP
- *
- END
|
