*> \brief \b LSAME
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* LOGICAL FUNCTION LSAME(CA,CB)
*
* .. Scalar Arguments ..
* CHARACTER CA,CB
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> LSAME returns .TRUE. if CA is the same letter as CB regardless of
*> case.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] CA
*> \verbatim
*> CA is CHARACTER*1
*> \endverbatim
*>
*> \param[in] CB
*> \verbatim
*> CB is CHARACTER*1
*> CA and CB specify the single characters to be compared.
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup lsame
*
* =====================================================================
LOGICAL FUNCTION LSAME(CA,CB)
*
* -- Reference BLAS level1 routine --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
* .. Scalar Arguments ..
CHARACTER CA,CB
* ..
*
* =====================================================================
*
* .. Intrinsic Functions ..
INTRINSIC ICHAR
* ..
* .. Local Scalars ..
INTEGER INTA,INTB,ZCODE
* ..
*
* Test if the characters are equal
*
LSAME = CA .EQ. CB
IF (LSAME) RETURN
*
* Now test for equivalence if both characters are alphabetic.
*
ZCODE = ICHAR('Z')
*
* Use 'Z' rather than 'A' so that ASCII can be detected on Prime
* machines, on which ICHAR returns a value with bit 8 set.
* ICHAR('A') on Prime machines returns 193 which is the same as
* ICHAR('A') on an EBCDIC machine.
*
INTA = ICHAR(CA)
INTB = ICHAR(CB)
*
IF (ZCODE.EQ.90 .OR. ZCODE.EQ.122) THEN
*
* ASCII is assumed - ZCODE is the ASCII code of either lower or
* upper case 'Z'.
*
IF (INTA.GE.97 .AND. INTA.LE.122) INTA = INTA - 32
IF (INTB.GE.97 .AND. INTB.LE.122) INTB = INTB - 32
*
ELSE IF (ZCODE.EQ.233 .OR. ZCODE.EQ.169) THEN
*
* EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or
* upper case 'Z'.
*
IF (INTA.GE.129 .AND. INTA.LE.137 .OR.
+ INTA.GE.145 .AND. INTA.LE.153 .OR.
+ INTA.GE.162 .AND. INTA.LE.169) INTA = INTA + 64
IF (INTB.GE.129 .AND. INTB.LE.137 .OR.
+ INTB.GE.145 .AND. INTB.LE.153 .OR.
+ INTB.GE.162 .AND. INTB.LE.169) INTB = INTB + 64
*
ELSE IF (ZCODE.EQ.218 .OR. ZCODE.EQ.250) THEN
*
* ASCII is assumed, on Prime machines - ZCODE is the ASCII code
* plus 128 of either lower or upper case 'Z'.
*
IF (INTA.GE.225 .AND. INTA.LE.250) INTA = INTA - 32
IF (INTB.GE.225 .AND. INTB.LE.250) INTB = INTB - 32
END IF
LSAME = INTA .EQ. INTB
*
* RETURN
*
* End of LSAME
*
END
*> \brief \b XERBLA
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* SUBROUTINE XERBLA( SRNAME, INFO )
*
* .. Scalar Arguments ..
* CHARACTER*(*) SRNAME
* INTEGER INFO
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> XERBLA is an error handler for the LAPACK routines.
*> It is called by an LAPACK routine if an input parameter has an
*> invalid value. A message is printed and execution stops.
*>
*> Installers may consider modifying the STOP statement in order to
*> call system-specific exception-handling facilities.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] SRNAME
*> \verbatim
*> SRNAME is CHARACTER*(*)
*> The name of the routine which called XERBLA.
*> \endverbatim
*>
*> \param[in] INFO
*> \verbatim
*> INFO is INTEGER
*> The position of the invalid parameter in the parameter list
*> of the calling routine.
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup xerbla
*
* =====================================================================
SUBROUTINE XERBLA( SRNAME, INFO )
*
* -- Reference BLAS level1 routine --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
* .. Scalar Arguments ..
CHARACTER*(*) SRNAME
INTEGER INFO
* ..
*
* =====================================================================
*
* .. Intrinsic Functions ..
INTRINSIC LEN_TRIM
* ..
* .. Executable Statements ..
*
WRITE( *, FMT = 9999 )SRNAME( 1:LEN_TRIM( SRNAME ) ), INFO
*
STOP
*
9999 FORMAT( ' ** On entry to ', A, ' parameter number ', I2, ' had ',
$ 'an illegal value' )
*
* End of XERBLA
*
END
*> \brief \b ZSYMV computes a matrix-vector product for a complex symmetric matrix.
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download ZSYMV + dependencies
*>
*> [TGZ]
*>
*> [ZIP]
*>
*> [TXT]
*> \endhtmlonly
*
* Definition:
* ===========
*
* SUBROUTINE ZSYMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY )
*
* .. Scalar Arguments ..
* CHARACTER UPLO
* INTEGER INCX, INCY, LDA, N
* COMPLEX*16 ALPHA, BETA
* ..
* .. Array Arguments ..
* COMPLEX*16 A( LDA, * ), X( * ), Y( * )
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> ZSYMV performs the matrix-vector operation
*>
*> y := alpha*A*x + beta*y,
*>
*> where alpha and beta are scalars, x and y are n element vectors and
*> A is an n by n symmetric matrix.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] UPLO
*> \verbatim
*> UPLO is CHARACTER*1
*> On entry, UPLO specifies whether the upper or lower
*> triangular part of the array A is to be referenced as
*> follows:
*>
*> UPLO = 'U' or 'u' Only the upper triangular part of A
*> is to be referenced.
*>
*> UPLO = 'L' or 'l' Only the lower triangular part of A
*> is to be referenced.
*>
*> Unchanged on exit.
*> \endverbatim
*>
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> On entry, N specifies the order of the matrix A.
*> N must be at least zero.
*> Unchanged on exit.
*> \endverbatim
*>
*> \param[in] ALPHA
*> \verbatim
*> ALPHA is COMPLEX*16
*> On entry, ALPHA specifies the scalar alpha.
*> Unchanged on exit.
*> \endverbatim
*>
*> \param[in] A
*> \verbatim
*> A is COMPLEX*16 array, dimension ( LDA, N )
*> Before entry, with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array A must contain the upper
*> triangular part of the symmetric matrix and the strictly
*> lower triangular part of A is not referenced.
*> Before entry, with UPLO = 'L' or 'l', the leading n by n
*> lower triangular part of the array A must contain the lower
*> triangular part of the symmetric matrix and the strictly
*> upper triangular part of A is not referenced.
*> Unchanged on exit.
*> \endverbatim
*>
*> \param[in] LDA
*> \verbatim
*> LDA is INTEGER
*> On entry, LDA specifies the first dimension of A as declared
*> in the calling (sub) program. LDA must be at least
*> max( 1, N ).
*> Unchanged on exit.
*> \endverbatim
*>
*> \param[in] X
*> \verbatim
*> X is COMPLEX*16 array, dimension at least
*> ( 1 + ( N - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the N-
*> element vector x.
*> Unchanged on exit.
*> \endverbatim
*>
*> \param[in] INCX
*> \verbatim
*> INCX is INTEGER
*> On entry, INCX specifies the increment for the elements of
*> X. INCX must not be zero.
*> Unchanged on exit.
*> \endverbatim
*>
*> \param[in] BETA
*> \verbatim
*> BETA is COMPLEX*16
*> On entry, BETA specifies the scalar beta. When BETA is
*> supplied as zero then Y need not be set on input.
*> Unchanged on exit.
*> \endverbatim
*>
*> \param[in,out] Y
*> \verbatim
*> Y is COMPLEX*16 array, dimension at least
*> ( 1 + ( N - 1 )*abs( INCY ) ).
*> Before entry, the incremented array Y must contain the n
*> element vector y. On exit, Y is overwritten by the updated
*> vector y.
*> \endverbatim
*>
*> \param[in] INCY
*> \verbatim
*> INCY is INTEGER
*> On entry, INCY specifies the increment for the elements of
*> Y. INCY must not be zero.
*> Unchanged on exit.
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date December 2016
*
*> \ingroup complex16SYauxiliary
*
* =====================================================================
SUBROUTINE ZSYMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY )
*
* -- LAPACK auxiliary routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* December 2016
*
* .. Scalar Arguments ..
CHARACTER UPLO
INTEGER INCX, INCY, LDA, N
COMPLEX*16 ALPHA, BETA
* ..
* .. Array Arguments ..
COMPLEX*16 A( LDA, * ), X( * ), Y( * )
* ..
*
* =====================================================================
*
* .. Parameters ..
COMPLEX*16 ONE
PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) )
COMPLEX*16 ZERO
PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ) )
* ..
* .. Local Scalars ..
INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY
COMPLEX*16 TEMP1, TEMP2
* ..
* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
* ..
* .. External Subroutines ..
EXTERNAL XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX
* ..
* .. Executable Statements ..
*
* Test the input parameters.
*
INFO = 0
IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
INFO = 1
ELSE IF( N.LT.0 ) THEN
INFO = 2
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
INFO = 5
ELSE IF( INCX.EQ.0 ) THEN
INFO = 7
ELSE IF( INCY.EQ.0 ) THEN
INFO = 10
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZSYMV ', INFO )
RETURN
END IF
*
* Quick return if possible.
*
IF( ( N.EQ.0 ) .OR. ( ( ALPHA.EQ.ZERO ) .AND. ( BETA.EQ.ONE ) ) )
$ RETURN
*
* Set up the start points in X and Y.
*
IF( INCX.GT.0 ) THEN
KX = 1
ELSE
KX = 1 - ( N-1 )*INCX
END IF
IF( INCY.GT.0 ) THEN
KY = 1
ELSE
KY = 1 - ( N-1 )*INCY
END IF
*
* Start the operations. In this version the elements of A are
* accessed sequentially with one pass through the triangular part
* of A.
*
* First form y := beta*y.
*
IF( BETA.NE.ONE ) THEN
IF( INCY.EQ.1 ) THEN
IF( BETA.EQ.ZERO ) THEN
DO 10 I = 1, N
Y( I ) = ZERO
10 CONTINUE
ELSE
DO 20 I = 1, N
Y( I ) = BETA*Y( I )
20 CONTINUE
END IF
ELSE
IY = KY
IF( BETA.EQ.ZERO ) THEN
DO 30 I = 1, N
Y( IY ) = ZERO
IY = IY + INCY
30 CONTINUE
ELSE
DO 40 I = 1, N
Y( IY ) = BETA*Y( IY )
IY = IY + INCY
40 CONTINUE
END IF
END IF
END IF
IF( ALPHA.EQ.ZERO )
$ RETURN
IF( LSAME( UPLO, 'U' ) ) THEN
*
* Form y when A is stored in upper triangle.
*
IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN
DO 60 J = 1, N
TEMP1 = ALPHA*X( J )
TEMP2 = ZERO
DO 50 I = 1, J - 1
Y( I ) = Y( I ) + TEMP1*A( I, J )
TEMP2 = TEMP2 + A( I, J )*X( I )
50 CONTINUE
Y( J ) = Y( J ) + TEMP1*A( J, J ) + ALPHA*TEMP2
60 CONTINUE
ELSE
JX = KX
JY = KY
DO 80 J = 1, N
TEMP1 = ALPHA*X( JX )
TEMP2 = ZERO
IX = KX
IY = KY
DO 70 I = 1, J - 1
Y( IY ) = Y( IY ) + TEMP1*A( I, J )
TEMP2 = TEMP2 + A( I, J )*X( IX )
IX = IX + INCX
IY = IY + INCY
70 CONTINUE
Y( JY ) = Y( JY ) + TEMP1*A( J, J ) + ALPHA*TEMP2
JX = JX + INCX
JY = JY + INCY
80 CONTINUE
END IF
ELSE
*
* Form y when A is stored in lower triangle.
*
IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN
DO 100 J = 1, N
TEMP1 = ALPHA*X( J )
TEMP2 = ZERO
Y( J ) = Y( J ) + TEMP1*A( J, J )
DO 90 I = J + 1, N
Y( I ) = Y( I ) + TEMP1*A( I, J )
TEMP2 = TEMP2 + A( I, J )*X( I )
90 CONTINUE
Y( J ) = Y( J ) + ALPHA*TEMP2
100 CONTINUE
ELSE
JX = KX
JY = KY
DO 120 J = 1, N
TEMP1 = ALPHA*X( JX )
TEMP2 = ZERO
Y( JY ) = Y( JY ) + TEMP1*A( J, J )
IX = JX
IY = JY
DO 110 I = J + 1, N
IX = IX + INCX
IY = IY + INCY
Y( IY ) = Y( IY ) + TEMP1*A( I, J )
TEMP2 = TEMP2 + A( I, J )*X( IX )
110 CONTINUE
Y( JY ) = Y( JY ) + ALPHA*TEMP2
JX = JX + INCX
JY = JY + INCY
120 CONTINUE
END IF
END IF
*
RETURN
*
* End of ZSYMV
*
END