*> \brief \b DCABS1
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* DOUBLE PRECISION FUNCTION DCABS1(Z)
*
* .. Scalar Arguments ..
* COMPLEX*16 Z
* ..
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> DCABS1 computes |Re(.)| + |Im(.)| of a double complex number
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] Z
*> \verbatim
*> Z is COMPLEX*16
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup abs1
*
* =====================================================================
DOUBLE PRECISION FUNCTION DCABS1(Z)
*
* -- 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 ..
COMPLEX*16 Z
* ..
* ..
* =====================================================================
*
* .. Intrinsic Functions ..
INTRINSIC ABS,DBLE,DIMAG
*
DCABS1 = ABS(DBLE(Z)) + ABS(DIMAG(Z))
RETURN
*
* End of DCABS1
*
END
*> \brief \b DZSUM1 forms the 1-norm of the complex vector using the true absolute value.
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download DZSUM1 + dependencies
*>
*> [TGZ]
*>
*> [ZIP]
*>
*> [TXT]
*> \endhtmlonly
*
* Definition:
* ===========
*
* DOUBLE PRECISION FUNCTION DZSUM1( N, CX, INCX )
*
* .. Scalar Arguments ..
* INTEGER INCX, N
* ..
* .. Array Arguments ..
* COMPLEX*16 CX( * )
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> DZSUM1 takes the sum of the absolute values of a complex
*> vector and returns a double precision result.
*>
*> Based on DZASUM from the Level 1 BLAS.
*> The change is to use the 'genuine' absolute value.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> The number of elements in the vector CX.
*> \endverbatim
*>
*> \param[in] CX
*> \verbatim
*> CX is COMPLEX*16 array, dimension (N)
*> The vector whose elements will be summed.
*> \endverbatim
*>
*> \param[in] INCX
*> \verbatim
*> INCX is INTEGER
*> The spacing between successive values of CX. INCX > 0.
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup sum1
*
*> \par Contributors:
* ==================
*>
*> Nick Higham for use with ZLACON.
*
* =====================================================================
DOUBLE PRECISION FUNCTION DZSUM1( N, CX, INCX )
*
* -- LAPACK auxiliary routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
* .. Scalar Arguments ..
INTEGER INCX, N
* ..
* .. Array Arguments ..
COMPLEX*16 CX( * )
* ..
*
* =====================================================================
*
* .. Local Scalars ..
INTEGER I, NINCX
DOUBLE PRECISION STEMP
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS
* ..
* .. Executable Statements ..
*
DZSUM1 = 0.0D0
STEMP = 0.0D0
IF( N.LE.0 )
$ RETURN
IF( INCX.EQ.1 )
$ GO TO 20
*
* CODE FOR INCREMENT NOT EQUAL TO 1
*
NINCX = N*INCX
DO 10 I = 1, NINCX, INCX
*
* NEXT LINE MODIFIED.
*
STEMP = STEMP + ABS( CX( I ) )
10 CONTINUE
DZSUM1 = STEMP
RETURN
*
* CODE FOR INCREMENT EQUAL TO 1
*
20 CONTINUE
DO 30 I = 1, N
*
* NEXT LINE MODIFIED.
*
STEMP = STEMP + ABS( CX( I ) )
30 CONTINUE
DZSUM1 = STEMP
RETURN
*
* End of DZSUM1
*
END
*> \brief \b IZMAX1 finds the index of the first vector element of maximum absolute value.
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download IZMAX1 + dependencies
*>
*> [TGZ]
*>
*> [ZIP]
*>
*> [TXT]
*> \endhtmlonly
*
* Definition:
* ===========
*
* INTEGER FUNCTION IZMAX1( N, ZX, INCX )
*
* .. Scalar Arguments ..
* INTEGER INCX, N
* ..
* .. Array Arguments ..
* COMPLEX*16 ZX( * )
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> IZMAX1 finds the index of the first vector element of maximum absolute value.
*>
*> Based on IZAMAX from Level 1 BLAS.
*> The change is to use the 'genuine' absolute value.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> The number of elements in the vector ZX.
*> \endverbatim
*>
*> \param[in] ZX
*> \verbatim
*> ZX is COMPLEX*16 array, dimension (N)
*> The vector ZX. The IZMAX1 function returns the index of its first
*> element of maximum absolute value.
*> \endverbatim
*>
*> \param[in] INCX
*> \verbatim
*> INCX is INTEGER
*> The spacing between successive values of ZX. INCX >= 1.
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup imax1
*
*> \par Contributors:
* ==================
*>
*> Nick Higham for use with ZLACON.
*
* =====================================================================
INTEGER FUNCTION IZMAX1( N, ZX, INCX )
*
* -- LAPACK auxiliary routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
* .. Scalar Arguments ..
INTEGER INCX, N
* ..
* .. Array Arguments ..
COMPLEX*16 ZX(*)
* ..
*
* =====================================================================
*
* .. Local Scalars ..
DOUBLE PRECISION DMAX
INTEGER I, IX
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS
* ..
* .. Executable Statements ..
*
IZMAX1 = 0
IF (N.LT.1 .OR. INCX.LE.0) RETURN
IZMAX1 = 1
IF (N.EQ.1) RETURN
IF (INCX.EQ.1) THEN
*
* code for increment equal to 1
*
DMAX = ABS(ZX(1))
DO I = 2,N
IF (ABS(ZX(I)).GT.DMAX) THEN
IZMAX1 = I
DMAX = ABS(ZX(I))
END IF
END DO
ELSE
*
* code for increment not equal to 1
*
IX = 1
DMAX = ABS(ZX(1))
IX = IX + INCX
DO I = 2,N
IF (ABS(ZX(IX)).GT.DMAX) THEN
IZMAX1 = I
DMAX = ABS(ZX(IX))
END IF
IX = IX + INCX
END DO
END IF
RETURN
*
* End of IZMAX1
*
END
*> \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 ZAXPY
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* SUBROUTINE ZAXPY(N,ZA,ZX,INCX,ZY,INCY)
*
* .. Scalar Arguments ..
* COMPLEX*16 ZA
* INTEGER INCX,INCY,N
* ..
* .. Array Arguments ..
* COMPLEX*16 ZX(*),ZY(*)
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> ZAXPY constant times a vector plus a vector.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> number of elements in input vector(s)
*> \endverbatim
*>
*> \param[in] ZA
*> \verbatim
*> ZA is COMPLEX*16
*> On entry, ZA specifies the scalar alpha.
*> \endverbatim
*>
*> \param[in] ZX
*> \verbatim
*> ZX is COMPLEX*16 array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
*> \endverbatim
*>
*> \param[in] INCX
*> \verbatim
*> INCX is INTEGER
*> storage spacing between elements of ZX
*> \endverbatim
*>
*> \param[in,out] ZY
*> \verbatim
*> ZY is COMPLEX*16 array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
*> \endverbatim
*>
*> \param[in] INCY
*> \verbatim
*> INCY is INTEGER
*> storage spacing between elements of ZY
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup axpy
*
*> \par Further Details:
* =====================
*>
*> \verbatim
*>
*> jack dongarra, 3/11/78.
*> modified 12/3/93, array(1) declarations changed to array(*)
*> \endverbatim
*>
* =====================================================================
SUBROUTINE ZAXPY(N,ZA,ZX,INCX,ZY,INCY)
*
* -- 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 ..
COMPLEX*16 ZA
INTEGER INCX,INCY,N
* ..
* .. Array Arguments ..
COMPLEX*16 ZX(*),ZY(*)
* ..
*
* =====================================================================
*
* .. Local Scalars ..
INTEGER I,IX,IY
* ..
* .. External Functions ..
DOUBLE PRECISION DCABS1
EXTERNAL DCABS1
* ..
IF (N.LE.0) RETURN
IF (DCABS1(ZA).EQ.0.0d0) RETURN
IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
*
* code for both increments equal to 1
*
DO I = 1,N
ZY(I) = ZY(I) + ZA*ZX(I)
END DO
ELSE
*
* code for unequal increments or equal increments
* not equal to 1
*
IX = 1
IY = 1
IF (INCX.LT.0) IX = (-N+1)*INCX + 1
IF (INCY.LT.0) IY = (-N+1)*INCY + 1
DO I = 1,N
ZY(IY) = ZY(IY) + ZA*ZX(IX)
IX = IX + INCX
IY = IY + INCY
END DO
END IF
*
RETURN
*
* End of ZAXPY
*
END
*> \brief \b ZCOPY
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* SUBROUTINE ZCOPY(N,ZX,INCX,ZY,INCY)
*
* .. Scalar Arguments ..
* INTEGER INCX,INCY,N
* ..
* .. Array Arguments ..
* COMPLEX*16 ZX(*),ZY(*)
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> ZCOPY copies a vector, x, to a vector, y.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> number of elements in input vector(s)
*> \endverbatim
*>
*> \param[in] ZX
*> \verbatim
*> ZX is COMPLEX*16 array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
*> \endverbatim
*>
*> \param[in] INCX
*> \verbatim
*> INCX is INTEGER
*> storage spacing between elements of ZX
*> \endverbatim
*>
*> \param[out] ZY
*> \verbatim
*> ZY is COMPLEX*16 array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
*> \endverbatim
*>
*> \param[in] INCY
*> \verbatim
*> INCY is INTEGER
*> storage spacing between elements of ZY
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup copy
*
*> \par Further Details:
* =====================
*>
*> \verbatim
*>
*> jack dongarra, linpack, 4/11/78.
*> modified 12/3/93, array(1) declarations changed to array(*)
*> \endverbatim
*>
* =====================================================================
SUBROUTINE ZCOPY(N,ZX,INCX,ZY,INCY)
*
* -- 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 ..
INTEGER INCX,INCY,N
* ..
* .. Array Arguments ..
COMPLEX*16 ZX(*),ZY(*)
* ..
*
* =====================================================================
*
* .. Local Scalars ..
INTEGER I,IX,IY
* ..
IF (N.LE.0) RETURN
IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
*
* code for both increments equal to 1
*
DO I = 1,N
ZY(I) = ZX(I)
END DO
ELSE
*
* code for unequal increments or equal increments
* not equal to 1
*
IX = 1
IY = 1
IF (INCX.LT.0) IX = (-N+1)*INCX + 1
IF (INCY.LT.0) IY = (-N+1)*INCY + 1
DO I = 1,N
ZY(IY) = ZX(IX)
IX = IX + INCX
IY = IY + INCY
END DO
END IF
RETURN
*
* End of ZCOPY
*
END
*> \brief \b ZGEMV
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* SUBROUTINE ZGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
*
* .. Scalar Arguments ..
* COMPLEX*16 ALPHA,BETA
* INTEGER INCX,INCY,LDA,M,N
* CHARACTER TRANS
* ..
* .. Array Arguments ..
* COMPLEX*16 A(LDA,*),X(*),Y(*)
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> ZGEMV performs one of the matrix-vector operations
*>
*> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, or
*>
*> y := alpha*A**H*x + beta*y,
*>
*> where alpha and beta are scalars, x and y are vectors and A is an
*> m by n matrix.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] TRANS
*> \verbatim
*> TRANS is CHARACTER*1
*> On entry, TRANS specifies the operation to be performed as
*> follows:
*>
*> TRANS = 'N' or 'n' y := alpha*A*x + beta*y.
*>
*> TRANS = 'T' or 't' y := alpha*A**T*x + beta*y.
*>
*> TRANS = 'C' or 'c' y := alpha*A**H*x + beta*y.
*> \endverbatim
*>
*> \param[in] M
*> \verbatim
*> M is INTEGER
*> On entry, M specifies the number of rows of the matrix A.
*> M must be at least zero.
*> \endverbatim
*>
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> On entry, N specifies the number of columns of the matrix A.
*> N must be at least zero.
*> \endverbatim
*>
*> \param[in] ALPHA
*> \verbatim
*> ALPHA is COMPLEX*16
*> On entry, ALPHA specifies the scalar alpha.
*> \endverbatim
*>
*> \param[in] A
*> \verbatim
*> A is COMPLEX*16 array, dimension ( LDA, N )
*> Before entry, the leading m by n part of the array A must
*> contain the matrix of coefficients.
*> \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, m ).
*> \endverbatim
*>
*> \param[in] X
*> \verbatim
*> X is COMPLEX*16 array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
*> and at least
*> ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
*> Before entry, the incremented array X must contain the
*> vector x.
*> \endverbatim
*>
*> \param[in] INCX
*> \verbatim
*> INCX is INTEGER
*> On entry, INCX specifies the increment for the elements of
*> X. INCX must not be zero.
*> \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.
*> \endverbatim
*>
*> \param[in,out] Y
*> \verbatim
*> Y is COMPLEX*16 array, dimension at least
*> ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
*> and at least
*> ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
*> Before entry with BETA non-zero, the incremented array Y
*> must contain the vector y. On exit, Y is overwritten by the
*> updated vector y.
*> If either m or n is zero, then Y not referenced and the function
*> performs a quick return.
*> \endverbatim
*>
*> \param[in] INCY
*> \verbatim
*> INCY is INTEGER
*> On entry, INCY specifies the increment for the elements of
*> Y. INCY must not be zero.
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup gemv
*
*> \par Further Details:
* =====================
*>
*> \verbatim
*>
*> Level 2 Blas routine.
*> The vector and matrix arguments are not referenced when N = 0, or M = 0
*>
*> -- Written on 22-October-1986.
*> Jack Dongarra, Argonne National Lab.
*> Jeremy Du Croz, Nag Central Office.
*> Sven Hammarling, Nag Central Office.
*> Richard Hanson, Sandia National Labs.
*> \endverbatim
*>
* =====================================================================
SUBROUTINE ZGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
*
* -- Reference BLAS level2 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 ..
COMPLEX*16 ALPHA,BETA
INTEGER INCX,INCY,LDA,M,N
CHARACTER TRANS
* ..
* .. 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 ..
COMPLEX*16 TEMP
INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY,LENX,LENY
LOGICAL NOCONJ
* ..
* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
* ..
* .. External Subroutines ..
EXTERNAL XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC DCONJG,MAX
* ..
*
* Test the input parameters.
*
INFO = 0
IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
+ .NOT.LSAME(TRANS,'C')) THEN
INFO = 1
ELSE IF (M.LT.0) THEN
INFO = 2
ELSE IF (N.LT.0) THEN
INFO = 3
ELSE IF (LDA.LT.MAX(1,M)) THEN
INFO = 6
ELSE IF (INCX.EQ.0) THEN
INFO = 8
ELSE IF (INCY.EQ.0) THEN
INFO = 11
END IF
IF (INFO.NE.0) THEN
CALL XERBLA('ZGEMV ',INFO)
RETURN
END IF
*
* Quick return if possible.
*
IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
+ ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
*
NOCONJ = LSAME(TRANS,'T')
*
* Set LENX and LENY, the lengths of the vectors x and y, and set
* up the start points in X and Y.
*
IF (LSAME(TRANS,'N')) THEN
LENX = N
LENY = M
ELSE
LENX = M
LENY = N
END IF
IF (INCX.GT.0) THEN
KX = 1
ELSE
KX = 1 - (LENX-1)*INCX
END IF
IF (INCY.GT.0) THEN
KY = 1
ELSE
KY = 1 - (LENY-1)*INCY
END IF
*
* Start the operations. In this version the elements of A are
* accessed sequentially with one pass through 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,LENY
Y(I) = ZERO
10 CONTINUE
ELSE
DO 20 I = 1,LENY
Y(I) = BETA*Y(I)
20 CONTINUE
END IF
ELSE
IY = KY
IF (BETA.EQ.ZERO) THEN
DO 30 I = 1,LENY
Y(IY) = ZERO
IY = IY + INCY
30 CONTINUE
ELSE
DO 40 I = 1,LENY
Y(IY) = BETA*Y(IY)
IY = IY + INCY
40 CONTINUE
END IF
END IF
END IF
IF (ALPHA.EQ.ZERO) RETURN
IF (LSAME(TRANS,'N')) THEN
*
* Form y := alpha*A*x + y.
*
JX = KX
IF (INCY.EQ.1) THEN
DO 60 J = 1,N
TEMP = ALPHA*X(JX)
DO 50 I = 1,M
Y(I) = Y(I) + TEMP*A(I,J)
50 CONTINUE
JX = JX + INCX
60 CONTINUE
ELSE
DO 80 J = 1,N
TEMP = ALPHA*X(JX)
IY = KY
DO 70 I = 1,M
Y(IY) = Y(IY) + TEMP*A(I,J)
IY = IY + INCY
70 CONTINUE
JX = JX + INCX
80 CONTINUE
END IF
ELSE
*
* Form y := alpha*A**T*x + y or y := alpha*A**H*x + y.
*
JY = KY
IF (INCX.EQ.1) THEN
DO 110 J = 1,N
TEMP = ZERO
IF (NOCONJ) THEN
DO 90 I = 1,M
TEMP = TEMP + A(I,J)*X(I)
90 CONTINUE
ELSE
DO 100 I = 1,M
TEMP = TEMP + DCONJG(A(I,J))*X(I)
100 CONTINUE
END IF
Y(JY) = Y(JY) + ALPHA*TEMP
JY = JY + INCY
110 CONTINUE
ELSE
DO 140 J = 1,N
TEMP = ZERO
IX = KX
IF (NOCONJ) THEN
DO 120 I = 1,M
TEMP = TEMP + A(I,J)*X(IX)
IX = IX + INCX
120 CONTINUE
ELSE
DO 130 I = 1,M
TEMP = TEMP + DCONJG(A(I,J))*X(IX)
IX = IX + INCX
130 CONTINUE
END IF
Y(JY) = Y(JY) + ALPHA*TEMP
JY = JY + INCY
140 CONTINUE
END IF
END IF
*
RETURN
*
* End of ZGEMV
*
END
*> \brief \b ZGERU
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* SUBROUTINE ZGERU(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
*
* .. Scalar Arguments ..
* COMPLEX*16 ALPHA
* INTEGER INCX,INCY,LDA,M,N
* ..
* .. Array Arguments ..
* COMPLEX*16 A(LDA,*),X(*),Y(*)
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> ZGERU performs the rank 1 operation
*>
*> A := alpha*x*y**T + A,
*>
*> where alpha is a scalar, x is an m element vector, y is an n element
*> vector and A is an m by n matrix.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] M
*> \verbatim
*> M is INTEGER
*> On entry, M specifies the number of rows of the matrix A.
*> M must be at least zero.
*> \endverbatim
*>
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> On entry, N specifies the number of columns of the matrix A.
*> N must be at least zero.
*> \endverbatim
*>
*> \param[in] ALPHA
*> \verbatim
*> ALPHA is COMPLEX*16
*> On entry, ALPHA specifies the scalar alpha.
*> \endverbatim
*>
*> \param[in] X
*> \verbatim
*> X is COMPLEX*16 array, dimension at least
*> ( 1 + ( m - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the m
*> element vector x.
*> \endverbatim
*>
*> \param[in] INCX
*> \verbatim
*> INCX is INTEGER
*> On entry, INCX specifies the increment for the elements of
*> X. INCX must not be zero.
*> \endverbatim
*>
*> \param[in] 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.
*> \endverbatim
*>
*> \param[in] INCY
*> \verbatim
*> INCY is INTEGER
*> On entry, INCY specifies the increment for the elements of
*> Y. INCY must not be zero.
*> \endverbatim
*>
*> \param[in,out] A
*> \verbatim
*> A is COMPLEX*16 array, dimension ( LDA, N )
*> Before entry, the leading m by n part of the array A must
*> contain the matrix of coefficients. On exit, A is
*> overwritten by the updated matrix.
*> \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, m ).
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup ger
*
*> \par Further Details:
* =====================
*>
*> \verbatim
*>
*> Level 2 Blas routine.
*>
*> -- Written on 22-October-1986.
*> Jack Dongarra, Argonne National Lab.
*> Jeremy Du Croz, Nag Central Office.
*> Sven Hammarling, Nag Central Office.
*> Richard Hanson, Sandia National Labs.
*> \endverbatim
*>
* =====================================================================
SUBROUTINE ZGERU(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
*
* -- Reference BLAS level2 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 ..
COMPLEX*16 ALPHA
INTEGER INCX,INCY,LDA,M,N
* ..
* .. Array Arguments ..
COMPLEX*16 A(LDA,*),X(*),Y(*)
* ..
*
* =====================================================================
*
* .. Parameters ..
COMPLEX*16 ZERO
PARAMETER (ZERO= (0.0D+0,0.0D+0))
* ..
* .. Local Scalars ..
COMPLEX*16 TEMP
INTEGER I,INFO,IX,J,JY,KX
* ..
* .. External Subroutines ..
EXTERNAL XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX
* ..
*
* Test the input parameters.
*
INFO = 0
IF (M.LT.0) THEN
INFO = 1
ELSE IF (N.LT.0) THEN
INFO = 2
ELSE IF (INCX.EQ.0) THEN
INFO = 5
ELSE IF (INCY.EQ.0) THEN
INFO = 7
ELSE IF (LDA.LT.MAX(1,M)) THEN
INFO = 9
END IF
IF (INFO.NE.0) THEN
CALL XERBLA('ZGERU ',INFO)
RETURN
END IF
*
* Quick return if possible.
*
IF ((M.EQ.0) .OR. (N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
*
* Start the operations. In this version the elements of A are
* accessed sequentially with one pass through A.
*
IF (INCY.GT.0) THEN
JY = 1
ELSE
JY = 1 - (N-1)*INCY
END IF
IF (INCX.EQ.1) THEN
DO 20 J = 1,N
IF (Y(JY).NE.ZERO) THEN
TEMP = ALPHA*Y(JY)
DO 10 I = 1,M
A(I,J) = A(I,J) + X(I)*TEMP
10 CONTINUE
END IF
JY = JY + INCY
20 CONTINUE
ELSE
IF (INCX.GT.0) THEN
KX = 1
ELSE
KX = 1 - (M-1)*INCX
END IF
DO 40 J = 1,N
IF (Y(JY).NE.ZERO) THEN
TEMP = ALPHA*Y(JY)
IX = KX
DO 30 I = 1,M
A(I,J) = A(I,J) + X(IX)*TEMP
IX = IX + INCX
30 CONTINUE
END IF
JY = JY + INCY
40 CONTINUE
END IF
*
RETURN
*
* End of ZGERU
*
END
*> \brief \b ZLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vector products.
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download ZLACN2 + dependencies
*>
*> [TGZ]
*>
*> [ZIP]
*>
*> [TXT]
*> \endhtmlonly
*
* Definition:
* ===========
*
* SUBROUTINE ZLACN2( N, V, X, EST, KASE, ISAVE )
*
* .. Scalar Arguments ..
* INTEGER KASE, N
* DOUBLE PRECISION EST
* ..
* .. Array Arguments ..
* INTEGER ISAVE( 3 )
* COMPLEX*16 V( * ), X( * )
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> ZLACN2 estimates the 1-norm of a square, complex matrix A.
*> Reverse communication is used for evaluating matrix-vector products.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> The order of the matrix. N >= 1.
*> \endverbatim
*>
*> \param[out] V
*> \verbatim
*> V is COMPLEX*16 array, dimension (N)
*> On the final return, V = A*W, where EST = norm(V)/norm(W)
*> (W is not returned).
*> \endverbatim
*>
*> \param[in,out] X
*> \verbatim
*> X is COMPLEX*16 array, dimension (N)
*> On an intermediate return, X should be overwritten by
*> A * X, if KASE=1,
*> A**H * X, if KASE=2,
*> where A**H is the conjugate transpose of A, and ZLACN2 must be
*> re-called with all the other parameters unchanged.
*> \endverbatim
*>
*> \param[in,out] EST
*> \verbatim
*> EST is DOUBLE PRECISION
*> On entry with KASE = 1 or 2 and ISAVE(1) = 3, EST should be
*> unchanged from the previous call to ZLACN2.
*> On exit, EST is an estimate (a lower bound) for norm(A).
*> \endverbatim
*>
*> \param[in,out] KASE
*> \verbatim
*> KASE is INTEGER
*> On the initial call to ZLACN2, KASE should be 0.
*> On an intermediate return, KASE will be 1 or 2, indicating
*> whether X should be overwritten by A * X or A**H * X.
*> On the final return from ZLACN2, KASE will again be 0.
*> \endverbatim
*>
*> \param[in,out] ISAVE
*> \verbatim
*> ISAVE is INTEGER array, dimension (3)
*> ISAVE is used to save variables between calls to ZLACN2
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date December 2016
*
*> \ingroup complex16OTHERauxiliary
*
*> \par Further Details:
* =====================
*>
*> \verbatim
*>
*> Originally named CONEST, dated March 16, 1988.
*>
*> Last modified: April, 1999
*>
*> This is a thread safe version of ZLACON, which uses the array ISAVE
*> in place of a SAVE statement, as follows:
*>
*> ZLACON ZLACN2
*> JUMP ISAVE(1)
*> J ISAVE(2)
*> ITER ISAVE(3)
*> \endverbatim
*
*> \par Contributors:
* ==================
*>
*> Nick Higham, University of Manchester
*
*> \par References:
* ================
*>
*> N.J. Higham, "FORTRAN codes for estimating the one-norm of
*> a real or complex matrix, with applications to condition estimation",
*> ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988.
*>
* =====================================================================
SUBROUTINE ZLACN2( N, V, X, EST, KASE, ISAVE )
*
* -- 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 ..
INTEGER KASE, N
DOUBLE PRECISION EST
* ..
* .. Array Arguments ..
INTEGER ISAVE( 3 )
COMPLEX*16 V( * ), X( * )
* ..
*
* =====================================================================
*
* .. Parameters ..
INTEGER ITMAX
PARAMETER ( ITMAX = 5 )
DOUBLE PRECISION ONE, TWO
PARAMETER ( ONE = 1.0D0, TWO = 2.0D0 )
COMPLEX*16 CZERO, CONE
PARAMETER ( CZERO = ( 0.0D0, 0.0D0 ),
$ CONE = ( 1.0D0, 0.0D0 ) )
* ..
* .. Local Scalars ..
INTEGER I, JLAST
DOUBLE PRECISION ABSXI, ALTSGN, ESTOLD, SAFMIN, TEMP
* ..
* .. External Functions ..
INTEGER IZMAX1
DOUBLE PRECISION DLAMCH, DZSUM1
EXTERNAL IZMAX1, DLAMCH, DZSUM1
* ..
* .. External Subroutines ..
EXTERNAL ZCOPY
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, DBLE, DCMPLX, DIMAG
* ..
* .. Executable Statements ..
*
SAFMIN = DLAMCH( 'Safe minimum' )
IF( KASE.EQ.0 ) THEN
DO 10 I = 1, N
X( I ) = DCMPLX( ONE / DBLE( N ) )
10 CONTINUE
KASE = 1
ISAVE( 1 ) = 1
RETURN
END IF
*
GO TO ( 20, 40, 70, 90, 120 )ISAVE( 1 )
*
* ................ ENTRY (ISAVE( 1 ) = 1)
* FIRST ITERATION. X HAS BEEN OVERWRITTEN BY A*X.
*
20 CONTINUE
IF( N.EQ.1 ) THEN
V( 1 ) = X( 1 )
EST = ABS( V( 1 ) )
* ... QUIT
GO TO 130
END IF
EST = DZSUM1( N, X, 1 )
*
DO 30 I = 1, N
ABSXI = ABS( X( I ) )
IF( ABSXI.GT.SAFMIN ) THEN
X( I ) = DCMPLX( DBLE( X( I ) ) / ABSXI,
$ DIMAG( X( I ) ) / ABSXI )
ELSE
X( I ) = CONE
END IF
30 CONTINUE
KASE = 2
ISAVE( 1 ) = 2
RETURN
*
* ................ ENTRY (ISAVE( 1 ) = 2)
* FIRST ITERATION. X HAS BEEN OVERWRITTEN BY CTRANS(A)*X.
*
40 CONTINUE
ISAVE( 2 ) = IZMAX1( N, X, 1 )
ISAVE( 3 ) = 2
*
* MAIN LOOP - ITERATIONS 2,3,...,ITMAX.
*
50 CONTINUE
DO 60 I = 1, N
X( I ) = CZERO
60 CONTINUE
X( ISAVE( 2 ) ) = CONE
KASE = 1
ISAVE( 1 ) = 3
RETURN
*
* ................ ENTRY (ISAVE( 1 ) = 3)
* X HAS BEEN OVERWRITTEN BY A*X.
*
70 CONTINUE
CALL ZCOPY( N, X, 1, V, 1 )
ESTOLD = EST
EST = DZSUM1( N, V, 1 )
*
* TEST FOR CYCLING.
IF( EST.LE.ESTOLD )
$ GO TO 100
*
DO 80 I = 1, N
ABSXI = ABS( X( I ) )
IF( ABSXI.GT.SAFMIN ) THEN
X( I ) = DCMPLX( DBLE( X( I ) ) / ABSXI,
$ DIMAG( X( I ) ) / ABSXI )
ELSE
X( I ) = CONE
END IF
80 CONTINUE
KASE = 2
ISAVE( 1 ) = 4
RETURN
*
* ................ ENTRY (ISAVE( 1 ) = 4)
* X HAS BEEN OVERWRITTEN BY CTRANS(A)*X.
*
90 CONTINUE
JLAST = ISAVE( 2 )
ISAVE( 2 ) = IZMAX1( N, X, 1 )
IF( ( ABS( X( JLAST ) ).NE.ABS( X( ISAVE( 2 ) ) ) ) .AND.
$ ( ISAVE( 3 ).LT.ITMAX ) ) THEN
ISAVE( 3 ) = ISAVE( 3 ) + 1
GO TO 50
END IF
*
* ITERATION COMPLETE. FINAL STAGE.
*
100 CONTINUE
ALTSGN = ONE
DO 110 I = 1, N
X( I ) = DCMPLX( ALTSGN*( ONE+DBLE( I-1 ) / DBLE( N-1 ) ) )
ALTSGN = -ALTSGN
110 CONTINUE
KASE = 1
ISAVE( 1 ) = 5
RETURN
*
* ................ ENTRY (ISAVE( 1 ) = 5)
* X HAS BEEN OVERWRITTEN BY A*X.
*
120 CONTINUE
TEMP = TWO*( DZSUM1( N, X, 1 ) / DBLE( 3*N ) )
IF( TEMP.GT.EST ) THEN
CALL ZCOPY( N, X, 1, V, 1 )
EST = TEMP
END IF
*
130 CONTINUE
KASE = 0
RETURN
*
* End of ZLACN2
*
END
*> \brief \b ZSCAL
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* SUBROUTINE ZSCAL(N,ZA,ZX,INCX)
*
* .. Scalar Arguments ..
* COMPLEX*16 ZA
* INTEGER INCX,N
* ..
* .. Array Arguments ..
* COMPLEX*16 ZX(*)
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> ZSCAL scales a vector by a constant.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> number of elements in input vector(s)
*> \endverbatim
*>
*> \param[in] ZA
*> \verbatim
*> ZA is COMPLEX*16
*> On entry, ZA specifies the scalar alpha.
*> \endverbatim
*>
*> \param[in,out] ZX
*> \verbatim
*> ZX is COMPLEX*16 array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
*> \endverbatim
*>
*> \param[in] INCX
*> \verbatim
*> INCX is INTEGER
*> storage spacing between elements of ZX
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup scal
*
*> \par Further Details:
* =====================
*>
*> \verbatim
*>
*> jack dongarra, 3/11/78.
*> modified 3/93 to return if incx .le. 0.
*> modified 12/3/93, array(1) declarations changed to array(*)
*> \endverbatim
*>
* =====================================================================
SUBROUTINE ZSCAL(N,ZA,ZX,INCX)
*
* -- 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 ..
COMPLEX*16 ZA
INTEGER INCX,N
* ..
* .. Array Arguments ..
COMPLEX*16 ZX(*)
* ..
*
* =====================================================================
*
* .. Local Scalars ..
INTEGER I,NINCX
* ..
* .. Parameters ..
COMPLEX*16 ONE
PARAMETER (ONE= (1.0D+0,0.0D+0))
* ..
IF (N.LE.0 .OR. INCX.LE.0 .OR. ZA.EQ.ONE) RETURN
IF (INCX.EQ.1) THEN
*
* code for increment equal to 1
*
DO I = 1,N
ZX(I) = ZA*ZX(I)
END DO
ELSE
*
* code for increment not equal to 1
*
NINCX = N*INCX
DO I = 1,NINCX,INCX
ZX(I) = ZA*ZX(I)
END DO
END IF
RETURN
*
* End of ZSCAL
*
END
*> \brief \b ZSWAP
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* SUBROUTINE ZSWAP(N,ZX,INCX,ZY,INCY)
*
* .. Scalar Arguments ..
* INTEGER INCX,INCY,N
* ..
* .. Array Arguments ..
* COMPLEX*16 ZX(*),ZY(*)
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> ZSWAP interchanges two vectors.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> number of elements in input vector(s)
*> \endverbatim
*>
*> \param[in,out] ZX
*> \verbatim
*> ZX is COMPLEX*16 array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
*> \endverbatim
*>
*> \param[in] INCX
*> \verbatim
*> INCX is INTEGER
*> storage spacing between elements of ZX
*> \endverbatim
*>
*> \param[in,out] ZY
*> \verbatim
*> ZY is COMPLEX*16 array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
*> \endverbatim
*>
*> \param[in] INCY
*> \verbatim
*> INCY is INTEGER
*> storage spacing between elements of ZY
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup swap
*
*> \par Further Details:
* =====================
*>
*> \verbatim
*>
*> jack dongarra, 3/11/78.
*> modified 12/3/93, array(1) declarations changed to array(*)
*> \endverbatim
*>
* =====================================================================
SUBROUTINE ZSWAP(N,ZX,INCX,ZY,INCY)
*
* -- 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 ..
INTEGER INCX,INCY,N
* ..
* .. Array Arguments ..
COMPLEX*16 ZX(*),ZY(*)
* ..
*
* =====================================================================
*
* .. Local Scalars ..
COMPLEX*16 ZTEMP
INTEGER I,IX,IY
* ..
IF (N.LE.0) RETURN
IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
*
* code for both increments equal to 1
DO I = 1,N
ZTEMP = ZX(I)
ZX(I) = ZY(I)
ZY(I) = ZTEMP
END DO
ELSE
*
* code for unequal increments or equal increments not equal
* to 1
*
IX = 1
IY = 1
IF (INCX.LT.0) IX = (-N+1)*INCX + 1
IF (INCY.LT.0) IY = (-N+1)*INCY + 1
DO I = 1,N
ZTEMP = ZX(IX)
ZX(IX) = ZY(IY)
ZY(IY) = ZTEMP
IX = IX + INCX
IY = IY + INCY
END DO
END IF
RETURN
*
* End of ZSWAP
*
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
*> \brief \b ZSYRFS
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download ZSYRFS + dependencies
*>
*> [TGZ]
*>
*> [ZIP]
*>
*> [TXT]
*> \endhtmlonly
*
* Definition:
* ===========
*
* SUBROUTINE ZSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB,
* X, LDX, FERR, BERR, WORK, RWORK, INFO )
*
* .. Scalar Arguments ..
* CHARACTER UPLO
* INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
* ..
* .. Array Arguments ..
* INTEGER IPIV( * )
* DOUBLE PRECISION BERR( * ), FERR( * ), RWORK( * )
* COMPLEX*16 A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
* $ WORK( * ), X( LDX, * )
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> ZSYRFS improves the computed solution to a system of linear
*> equations when the coefficient matrix is symmetric indefinite, and
*> provides error bounds and backward error estimates for the solution.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] UPLO
*> \verbatim
*> UPLO is CHARACTER*1
*> = 'U': Upper triangle of A is stored;
*> = 'L': Lower triangle of A is stored.
*> \endverbatim
*>
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> The order of the matrix A. N >= 0.
*> \endverbatim
*>
*> \param[in] NRHS
*> \verbatim
*> NRHS is INTEGER
*> The number of right hand sides, i.e., the number of columns
*> of the matrices B and X. NRHS >= 0.
*> \endverbatim
*>
*> \param[in] A
*> \verbatim
*> A is COMPLEX*16 array, dimension (LDA,N)
*> The symmetric matrix A. If UPLO = 'U', the leading N-by-N
*> upper triangular part of A contains the upper triangular part
*> of the matrix A, and the strictly lower triangular part of A
*> is not referenced. If UPLO = 'L', the leading N-by-N lower
*> triangular part of A contains the lower triangular part of
*> the matrix A, and the strictly upper triangular part of A is
*> not referenced.
*> \endverbatim
*>
*> \param[in] LDA
*> \verbatim
*> LDA is INTEGER
*> The leading dimension of the array A. LDA >= max(1,N).
*> \endverbatim
*>
*> \param[in] AF
*> \verbatim
*> AF is COMPLEX*16 array, dimension (LDAF,N)
*> The factored form of the matrix A. AF contains the block
*> diagonal matrix D and the multipliers used to obtain the
*> factor U or L from the factorization A = U*D*U**T or
*> A = L*D*L**T as computed by ZSYTRF.
*> \endverbatim
*>
*> \param[in] LDAF
*> \verbatim
*> LDAF is INTEGER
*> The leading dimension of the array AF. LDAF >= max(1,N).
*> \endverbatim
*>
*> \param[in] IPIV
*> \verbatim
*> IPIV is INTEGER array, dimension (N)
*> Details of the interchanges and the block structure of D
*> as determined by ZSYTRF.
*> \endverbatim
*>
*> \param[in] B
*> \verbatim
*> B is COMPLEX*16 array, dimension (LDB,NRHS)
*> The right hand side matrix B.
*> \endverbatim
*>
*> \param[in] LDB
*> \verbatim
*> LDB is INTEGER
*> The leading dimension of the array B. LDB >= max(1,N).
*> \endverbatim
*>
*> \param[in,out] X
*> \verbatim
*> X is COMPLEX*16 array, dimension (LDX,NRHS)
*> On entry, the solution matrix X, as computed by ZSYTRS.
*> On exit, the improved solution matrix X.
*> \endverbatim
*>
*> \param[in] LDX
*> \verbatim
*> LDX is INTEGER
*> The leading dimension of the array X. LDX >= max(1,N).
*> \endverbatim
*>
*> \param[out] FERR
*> \verbatim
*> FERR is DOUBLE PRECISION array, dimension (NRHS)
*> The estimated forward error bound for each solution vector
*> X(j) (the j-th column of the solution matrix X).
*> If XTRUE is the true solution corresponding to X(j), FERR(j)
*> is an estimated upper bound for the magnitude of the largest
*> element in (X(j) - XTRUE) divided by the magnitude of the
*> largest element in X(j). The estimate is as reliable as
*> the estimate for RCOND, and is almost always a slight
*> overestimate of the true error.
*> \endverbatim
*>
*> \param[out] BERR
*> \verbatim
*> BERR is DOUBLE PRECISION array, dimension (NRHS)
*> The componentwise relative backward error of each solution
*> vector X(j) (i.e., the smallest relative change in
*> any element of A or B that makes X(j) an exact solution).
*> \endverbatim
*>
*> \param[out] WORK
*> \verbatim
*> WORK is COMPLEX*16 array, dimension (2*N)
*> \endverbatim
*>
*> \param[out] RWORK
*> \verbatim
*> RWORK is DOUBLE PRECISION array, dimension (N)
*> \endverbatim
*>
*> \param[out] INFO
*> \verbatim
*> INFO is INTEGER
*> = 0: successful exit
*> < 0: if INFO = -i, the i-th argument had an illegal value
*> \endverbatim
*
*> \par Internal Parameters:
* =========================
*>
*> \verbatim
*> ITMAX is the maximum number of steps of iterative refinement.
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date December 2016
*
*> \ingroup complex16SYcomputational
*
* =====================================================================
SUBROUTINE ZSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB,
$ X, LDX, FERR, BERR, WORK, RWORK, INFO )
*
* -- LAPACK computational 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 INFO, LDA, LDAF, LDB, LDX, N, NRHS
* ..
* .. Array Arguments ..
INTEGER IPIV( * )
DOUBLE PRECISION BERR( * ), FERR( * ), RWORK( * )
COMPLEX*16 A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
$ WORK( * ), X( LDX, * )
* ..
*
* =====================================================================
*
* .. Parameters ..
INTEGER ITMAX
PARAMETER ( ITMAX = 5 )
DOUBLE PRECISION ZERO
PARAMETER ( ZERO = 0.0D+0 )
COMPLEX*16 ONE
PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) )
DOUBLE PRECISION TWO
PARAMETER ( TWO = 2.0D+0 )
DOUBLE PRECISION THREE
PARAMETER ( THREE = 3.0D+0 )
* ..
* .. Local Scalars ..
LOGICAL UPPER
INTEGER COUNT, I, J, K, KASE, NZ
DOUBLE PRECISION EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
COMPLEX*16 ZDUM
* ..
* .. Local Arrays ..
INTEGER ISAVE( 3 )
* ..
* .. External Subroutines ..
EXTERNAL XERBLA, ZAXPY, ZCOPY, ZLACN2, ZSYMV, ZSYTRS
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, DBLE, DIMAG, MAX
* ..
* .. External Functions ..
LOGICAL LSAME
DOUBLE PRECISION DLAMCH
EXTERNAL LSAME, DLAMCH
* ..
* .. Statement Functions ..
DOUBLE PRECISION CABS1
* ..
* .. Statement Function definitions ..
CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) )
* ..
* .. Executable Statements ..
*
* Test the input parameters.
*
INFO = 0
UPPER = LSAME( UPLO, 'U' )
IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
INFO = -1
ELSE IF( N.LT.0 ) THEN
INFO = -2
ELSE IF( NRHS.LT.0 ) THEN
INFO = -3
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
INFO = -5
ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN
INFO = -7
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
INFO = -10
ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
INFO = -12
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZSYRFS', -INFO )
RETURN
END IF
*
* Quick return if possible
*
IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN
DO 10 J = 1, NRHS
FERR( J ) = ZERO
BERR( J ) = ZERO
10 CONTINUE
RETURN
END IF
*
* NZ = maximum number of nonzero elements in each row of A, plus 1
*
NZ = N + 1
EPS = DLAMCH( 'Epsilon' )
SAFMIN = DLAMCH( 'Safe minimum' )
SAFE1 = NZ*SAFMIN
SAFE2 = SAFE1 / EPS
*
* Do for each right hand side
*
DO 140 J = 1, NRHS
*
COUNT = 1
LSTRES = THREE
20 CONTINUE
*
* Loop until stopping criterion is satisfied.
*
* Compute residual R = B - A * X
*
CALL ZCOPY( N, B( 1, J ), 1, WORK, 1 )
CALL ZSYMV( UPLO, N, -ONE, A, LDA, X( 1, J ), 1, ONE, WORK, 1 )
*
* Compute componentwise relative backward error from formula
*
* max(i) ( abs(R(i)) / ( abs(A)*abs(X) + abs(B) )(i) )
*
* where abs(Z) is the componentwise absolute value of the matrix
* or vector Z. If the i-th component of the denominator is less
* than SAFE2, then SAFE1 is added to the i-th components of the
* numerator and denominator before dividing.
*
DO 30 I = 1, N
RWORK( I ) = CABS1( B( I, J ) )
30 CONTINUE
*
* Compute abs(A)*abs(X) + abs(B).
*
IF( UPPER ) THEN
DO 50 K = 1, N
S = ZERO
XK = CABS1( X( K, J ) )
DO 40 I = 1, K - 1
RWORK( I ) = RWORK( I ) + CABS1( A( I, K ) )*XK
S = S + CABS1( A( I, K ) )*CABS1( X( I, J ) )
40 CONTINUE
RWORK( K ) = RWORK( K ) + CABS1( A( K, K ) )*XK + S
50 CONTINUE
ELSE
DO 70 K = 1, N
S = ZERO
XK = CABS1( X( K, J ) )
RWORK( K ) = RWORK( K ) + CABS1( A( K, K ) )*XK
DO 60 I = K + 1, N
RWORK( I ) = RWORK( I ) + CABS1( A( I, K ) )*XK
S = S + CABS1( A( I, K ) )*CABS1( X( I, J ) )
60 CONTINUE
RWORK( K ) = RWORK( K ) + S
70 CONTINUE
END IF
S = ZERO
DO 80 I = 1, N
IF( RWORK( I ).GT.SAFE2 ) THEN
S = MAX( S, CABS1( WORK( I ) ) / RWORK( I ) )
ELSE
S = MAX( S, ( CABS1( WORK( I ) )+SAFE1 ) /
$ ( RWORK( I )+SAFE1 ) )
END IF
80 CONTINUE
BERR( J ) = S
*
* Test stopping criterion. Continue iterating if
* 1) The residual BERR(J) is larger than machine epsilon, and
* 2) BERR(J) decreased by at least a factor of 2 during the
* last iteration, and
* 3) At most ITMAX iterations tried.
*
IF( BERR( J ).GT.EPS .AND. TWO*BERR( J ).LE.LSTRES .AND.
$ COUNT.LE.ITMAX ) THEN
*
* Update solution and try again.
*
CALL ZSYTRS( UPLO, N, 1, AF, LDAF, IPIV, WORK, N, INFO )
CALL ZAXPY( N, ONE, WORK, 1, X( 1, J ), 1 )
LSTRES = BERR( J )
COUNT = COUNT + 1
GO TO 20
END IF
*
* Bound error from formula
*
* norm(X - XTRUE) / norm(X) .le. FERR =
* norm( abs(inv(A))*
* ( abs(R) + NZ*EPS*( abs(A)*abs(X)+abs(B) ))) / norm(X)
*
* where
* norm(Z) is the magnitude of the largest component of Z
* inv(A) is the inverse of A
* abs(Z) is the componentwise absolute value of the matrix or
* vector Z
* NZ is the maximum number of nonzeros in any row of A, plus 1
* EPS is machine epsilon
*
* The i-th component of abs(R)+NZ*EPS*(abs(A)*abs(X)+abs(B))
* is incremented by SAFE1 if the i-th component of
* abs(A)*abs(X) + abs(B) is less than SAFE2.
*
* Use ZLACN2 to estimate the infinity-norm of the matrix
* inv(A) * diag(W),
* where W = abs(R) + NZ*EPS*( abs(A)*abs(X)+abs(B) )))
*
DO 90 I = 1, N
IF( RWORK( I ).GT.SAFE2 ) THEN
RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I )
ELSE
RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) +
$ SAFE1
END IF
90 CONTINUE
*
KASE = 0
100 CONTINUE
CALL ZLACN2( N, WORK( N+1 ), WORK, FERR( J ), KASE, ISAVE )
IF( KASE.NE.0 ) THEN
IF( KASE.EQ.1 ) THEN
*
* Multiply by diag(W)*inv(A**T).
*
CALL ZSYTRS( UPLO, N, 1, AF, LDAF, IPIV, WORK, N, INFO )
DO 110 I = 1, N
WORK( I ) = RWORK( I )*WORK( I )
110 CONTINUE
ELSE IF( KASE.EQ.2 ) THEN
*
* Multiply by inv(A)*diag(W).
*
DO 120 I = 1, N
WORK( I ) = RWORK( I )*WORK( I )
120 CONTINUE
CALL ZSYTRS( UPLO, N, 1, AF, LDAF, IPIV, WORK, N, INFO )
END IF
GO TO 100
END IF
*
* Normalize error.
*
LSTRES = ZERO
DO 130 I = 1, N
LSTRES = MAX( LSTRES, CABS1( X( I, J ) ) )
130 CONTINUE
IF( LSTRES.NE.ZERO )
$ FERR( J ) = FERR( J ) / LSTRES
*
140 CONTINUE
*
RETURN
*
* End of ZSYRFS
*
END
*> \brief \b ZSYTRS
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download ZSYTRS + dependencies
*>
*> [TGZ]
*>
*> [ZIP]
*>
*> [TXT]
*> \endhtmlonly
*
* Definition:
* ===========
*
* SUBROUTINE ZSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
*
* .. Scalar Arguments ..
* CHARACTER UPLO
* INTEGER INFO, LDA, LDB, N, NRHS
* ..
* .. Array Arguments ..
* INTEGER IPIV( * )
* COMPLEX*16 A( LDA, * ), B( LDB, * )
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> ZSYTRS solves a system of linear equations A*X = B with a complex
*> symmetric matrix A using the factorization A = U*D*U**T or
*> A = L*D*L**T computed by ZSYTRF.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] UPLO
*> \verbatim
*> UPLO is CHARACTER*1
*> Specifies whether the details of the factorization are stored
*> as an upper or lower triangular matrix.
*> = 'U': Upper triangular, form is A = U*D*U**T;
*> = 'L': Lower triangular, form is A = L*D*L**T.
*> \endverbatim
*>
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> The order of the matrix A. N >= 0.
*> \endverbatim
*>
*> \param[in] NRHS
*> \verbatim
*> NRHS is INTEGER
*> The number of right hand sides, i.e., the number of columns
*> of the matrix B. NRHS >= 0.
*> \endverbatim
*>
*> \param[in] A
*> \verbatim
*> A is COMPLEX*16 array, dimension (LDA,N)
*> The block diagonal matrix D and the multipliers used to
*> obtain the factor U or L as computed by ZSYTRF.
*> \endverbatim
*>
*> \param[in] LDA
*> \verbatim
*> LDA is INTEGER
*> The leading dimension of the array A. LDA >= max(1,N).
*> \endverbatim
*>
*> \param[in] IPIV
*> \verbatim
*> IPIV is INTEGER array, dimension (N)
*> Details of the interchanges and the block structure of D
*> as determined by ZSYTRF.
*> \endverbatim
*>
*> \param[in,out] B
*> \verbatim
*> B is COMPLEX*16 array, dimension (LDB,NRHS)
*> On entry, the right hand side matrix B.
*> On exit, the solution matrix X.
*> \endverbatim
*>
*> \param[in] LDB
*> \verbatim
*> LDB is INTEGER
*> The leading dimension of the array B. LDB >= max(1,N).
*> \endverbatim
*>
*> \param[out] INFO
*> \verbatim
*> INFO is INTEGER
*> = 0: successful exit
*> < 0: if INFO = -i, the i-th argument had an illegal value
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date December 2016
*
*> \ingroup complex16SYcomputational
*
* =====================================================================
SUBROUTINE ZSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
*
* -- LAPACK computational 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 INFO, LDA, LDB, N, NRHS
* ..
* .. Array Arguments ..
INTEGER IPIV( * )
COMPLEX*16 A( LDA, * ), B( LDB, * )
* ..
*
* =====================================================================
*
* .. Parameters ..
COMPLEX*16 ONE
PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) )
* ..
* .. Local Scalars ..
LOGICAL UPPER
INTEGER J, K, KP
COMPLEX*16 AK, AKM1, AKM1K, BK, BKM1, DENOM
* ..
* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
* ..
* .. External Subroutines ..
EXTERNAL XERBLA, ZGEMV, ZGERU, ZSCAL, ZSWAP
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX
* ..
* .. Executable Statements ..
*
INFO = 0
UPPER = LSAME( UPLO, 'U' )
IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
INFO = -1
ELSE IF( N.LT.0 ) THEN
INFO = -2
ELSE IF( NRHS.LT.0 ) THEN
INFO = -3
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
INFO = -5
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
INFO = -8
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZSYTRS', -INFO )
RETURN
END IF
*
* Quick return if possible
*
IF( N.EQ.0 .OR. NRHS.EQ.0 )
$ RETURN
*
IF( UPPER ) THEN
*
* Solve A*X = B, where A = U*D*U**T.
*
* First solve U*D*X = B, overwriting B with X.
*
* K is the main loop index, decreasing from N to 1 in steps of
* 1 or 2, depending on the size of the diagonal blocks.
*
K = N
10 CONTINUE
*
* If K < 1, exit from loop.
*
IF( K.LT.1 )
$ GO TO 30
*
IF( IPIV( K ).GT.0 ) THEN
*
* 1 x 1 diagonal block
*
* Interchange rows K and IPIV(K).
*
KP = IPIV( K )
IF( KP.NE.K )
$ CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
*
* Multiply by inv(U(K)), where U(K) is the transformation
* stored in column K of A.
*
CALL ZGERU( K-1, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), LDB,
$ B( 1, 1 ), LDB )
*
* Multiply by the inverse of the diagonal block.
*
CALL ZSCAL( NRHS, ONE / A( K, K ), B( K, 1 ), LDB )
K = K - 1
ELSE
*
* 2 x 2 diagonal block
*
* Interchange rows K-1 and -IPIV(K).
*
KP = -IPIV( K )
IF( KP.NE.K-1 )
$ CALL ZSWAP( NRHS, B( K-1, 1 ), LDB, B( KP, 1 ), LDB )
*
* Multiply by inv(U(K)), where U(K) is the transformation
* stored in columns K-1 and K of A.
*
CALL ZGERU( K-2, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), LDB,
$ B( 1, 1 ), LDB )
CALL ZGERU( K-2, NRHS, -ONE, A( 1, K-1 ), 1, B( K-1, 1 ),
$ LDB, B( 1, 1 ), LDB )
*
* Multiply by the inverse of the diagonal block.
*
AKM1K = A( K-1, K )
AKM1 = A( K-1, K-1 ) / AKM1K
AK = A( K, K ) / AKM1K
DENOM = AKM1*AK - ONE
DO 20 J = 1, NRHS
BKM1 = B( K-1, J ) / AKM1K
BK = B( K, J ) / AKM1K
B( K-1, J ) = ( AK*BKM1-BK ) / DENOM
B( K, J ) = ( AKM1*BK-BKM1 ) / DENOM
20 CONTINUE
K = K - 2
END IF
*
GO TO 10
30 CONTINUE
*
* Next solve U**T *X = B, overwriting B with X.
*
* K is the main loop index, increasing from 1 to N in steps of
* 1 or 2, depending on the size of the diagonal blocks.
*
K = 1
40 CONTINUE
*
* If K > N, exit from loop.
*
IF( K.GT.N )
$ GO TO 50
*
IF( IPIV( K ).GT.0 ) THEN
*
* 1 x 1 diagonal block
*
* Multiply by inv(U**T(K)), where U(K) is the transformation
* stored in column K of A.
*
CALL ZGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, A( 1, K ),
$ 1, ONE, B( K, 1 ), LDB )
*
* Interchange rows K and IPIV(K).
*
KP = IPIV( K )
IF( KP.NE.K )
$ CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
K = K + 1
ELSE
*
* 2 x 2 diagonal block
*
* Multiply by inv(U**T(K+1)), where U(K+1) is the transformation
* stored in columns K and K+1 of A.
*
CALL ZGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, A( 1, K ),
$ 1, ONE, B( K, 1 ), LDB )
CALL ZGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB,
$ A( 1, K+1 ), 1, ONE, B( K+1, 1 ), LDB )
*
* Interchange rows K and -IPIV(K).
*
KP = -IPIV( K )
IF( KP.NE.K )
$ CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
K = K + 2
END IF
*
GO TO 40
50 CONTINUE
*
ELSE
*
* Solve A*X = B, where A = L*D*L**T.
*
* First solve L*D*X = B, overwriting B with X.
*
* K is the main loop index, increasing from 1 to N in steps of
* 1 or 2, depending on the size of the diagonal blocks.
*
K = 1
60 CONTINUE
*
* If K > N, exit from loop.
*
IF( K.GT.N )
$ GO TO 80
*
IF( IPIV( K ).GT.0 ) THEN
*
* 1 x 1 diagonal block
*
* Interchange rows K and IPIV(K).
*
KP = IPIV( K )
IF( KP.NE.K )
$ CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
*
* Multiply by inv(L(K)), where L(K) is the transformation
* stored in column K of A.
*
IF( K.LT.N )
$ CALL ZGERU( N-K, NRHS, -ONE, A( K+1, K ), 1, B( K, 1 ),
$ LDB, B( K+1, 1 ), LDB )
*
* Multiply by the inverse of the diagonal block.
*
CALL ZSCAL( NRHS, ONE / A( K, K ), B( K, 1 ), LDB )
K = K + 1
ELSE
*
* 2 x 2 diagonal block
*
* Interchange rows K+1 and -IPIV(K).
*
KP = -IPIV( K )
IF( KP.NE.K+1 )
$ CALL ZSWAP( NRHS, B( K+1, 1 ), LDB, B( KP, 1 ), LDB )
*
* Multiply by inv(L(K)), where L(K) is the transformation
* stored in columns K and K+1 of A.
*
IF( K.LT.N-1 ) THEN
CALL ZGERU( N-K-1, NRHS, -ONE, A( K+2, K ), 1, B( K, 1 ),
$ LDB, B( K+2, 1 ), LDB )
CALL ZGERU( N-K-1, NRHS, -ONE, A( K+2, K+1 ), 1,
$ B( K+1, 1 ), LDB, B( K+2, 1 ), LDB )
END IF
*
* Multiply by the inverse of the diagonal block.
*
AKM1K = A( K+1, K )
AKM1 = A( K, K ) / AKM1K
AK = A( K+1, K+1 ) / AKM1K
DENOM = AKM1*AK - ONE
DO 70 J = 1, NRHS
BKM1 = B( K, J ) / AKM1K
BK = B( K+1, J ) / AKM1K
B( K, J ) = ( AK*BKM1-BK ) / DENOM
B( K+1, J ) = ( AKM1*BK-BKM1 ) / DENOM
70 CONTINUE
K = K + 2
END IF
*
GO TO 60
80 CONTINUE
*
* Next solve L**T *X = B, overwriting B with X.
*
* K is the main loop index, decreasing from N to 1 in steps of
* 1 or 2, depending on the size of the diagonal blocks.
*
K = N
90 CONTINUE
*
* If K < 1, exit from loop.
*
IF( K.LT.1 )
$ GO TO 100
*
IF( IPIV( K ).GT.0 ) THEN
*
* 1 x 1 diagonal block
*
* Multiply by inv(L**T(K)), where L(K) is the transformation
* stored in column K of A.
*
IF( K.LT.N )
$ CALL ZGEMV( 'Transpose', N-K, NRHS, -ONE, B( K+1, 1 ),
$ LDB, A( K+1, K ), 1, ONE, B( K, 1 ), LDB )
*
* Interchange rows K and IPIV(K).
*
KP = IPIV( K )
IF( KP.NE.K )
$ CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
K = K - 1
ELSE
*
* 2 x 2 diagonal block
*
* Multiply by inv(L**T(K-1)), where L(K-1) is the transformation
* stored in columns K-1 and K of A.
*
IF( K.LT.N ) THEN
CALL ZGEMV( 'Transpose', N-K, NRHS, -ONE, B( K+1, 1 ),
$ LDB, A( K+1, K ), 1, ONE, B( K, 1 ), LDB )
CALL ZGEMV( 'Transpose', N-K, NRHS, -ONE, B( K+1, 1 ),
$ LDB, A( K+1, K-1 ), 1, ONE, B( K-1, 1 ),
$ LDB )
END IF
*
* Interchange rows K and -IPIV(K).
*
KP = -IPIV( K )
IF( KP.NE.K )
$ CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
K = K - 2
END IF
*
GO TO 90
100 CONTINUE
END IF
*
RETURN
*
* End of ZSYTRS
*
END
*> \brief \b DLAMCH
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* DOUBLE PRECISION FUNCTION DLAMCH( CMACH )
*
* .. Scalar Arguments ..
* CHARACTER CMACH
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> DLAMCH determines double precision machine parameters.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] CMACH
*> \verbatim
*> CMACH is CHARACTER*1
*> Specifies the value to be returned by DLAMCH:
*> = 'E' or 'e', DLAMCH := eps
*> = 'S' or 's , DLAMCH := sfmin
*> = 'B' or 'b', DLAMCH := base
*> = 'P' or 'p', DLAMCH := eps*base
*> = 'N' or 'n', DLAMCH := t
*> = 'R' or 'r', DLAMCH := rnd
*> = 'M' or 'm', DLAMCH := emin
*> = 'U' or 'u', DLAMCH := rmin
*> = 'L' or 'l', DLAMCH := emax
*> = 'O' or 'o', DLAMCH := rmax
*> where
*> eps = relative machine precision
*> sfmin = safe minimum, such that 1/sfmin does not overflow
*> base = base of the machine
*> prec = eps*base
*> t = number of (base) digits in the mantissa
*> rnd = 1.0 when rounding occurs in addition, 0.0 otherwise
*> emin = minimum exponent before (gradual) underflow
*> rmin = underflow threshold - base**(emin-1)
*> emax = largest exponent before overflow
*> rmax = overflow threshold - (base**emax)*(1-eps)
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date December 2016
*
*> \ingroup auxOTHERauxiliary
*
* =====================================================================
DOUBLE PRECISION FUNCTION DLAMCH( CMACH )
*
* -- 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 CMACH
* ..
*
* =====================================================================
*
* .. Parameters ..
DOUBLE PRECISION ONE, ZERO
PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
* ..
* .. Local Scalars ..
DOUBLE PRECISION RND, EPS, SFMIN, SMALL, RMACH
* ..
* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
* ..
* .. Intrinsic Functions ..
INTRINSIC DIGITS, EPSILON, HUGE, MAXEXPONENT,
$ MINEXPONENT, RADIX, TINY
* ..
* .. Executable Statements ..
*
*
* Assume rounding, not chopping. Always.
*
RND = ONE
*
IF( ONE.EQ.RND ) THEN
EPS = EPSILON(ZERO) * 0.5
ELSE
EPS = EPSILON(ZERO)
END IF
*
IF( LSAME( CMACH, 'E' ) ) THEN
RMACH = EPS
ELSE IF( LSAME( CMACH, 'S' ) ) THEN
SFMIN = TINY(ZERO)
SMALL = ONE / HUGE(ZERO)
IF( SMALL.GE.SFMIN ) THEN
*
* Use SMALL plus a bit, to avoid the possibility of rounding
* causing overflow when computing 1/sfmin.
*
SFMIN = SMALL*( ONE+EPS )
END IF
RMACH = SFMIN
ELSE IF( LSAME( CMACH, 'B' ) ) THEN
RMACH = RADIX(ZERO)
ELSE IF( LSAME( CMACH, 'P' ) ) THEN
RMACH = EPS * RADIX(ZERO)
ELSE IF( LSAME( CMACH, 'N' ) ) THEN
RMACH = DIGITS(ZERO)
ELSE IF( LSAME( CMACH, 'R' ) ) THEN
RMACH = RND
ELSE IF( LSAME( CMACH, 'M' ) ) THEN
RMACH = MINEXPONENT(ZERO)
ELSE IF( LSAME( CMACH, 'U' ) ) THEN
RMACH = tiny(zero)
ELSE IF( LSAME( CMACH, 'L' ) ) THEN
RMACH = MAXEXPONENT(ZERO)
ELSE IF( LSAME( CMACH, 'O' ) ) THEN
RMACH = HUGE(ZERO)
ELSE
RMACH = ZERO
END IF
*
DLAMCH = RMACH
RETURN
*
* End of DLAMCH
*
END
************************************************************************
*> \brief \b DLAMC3
*> \details
*> \b Purpose:
*> \verbatim
*> DLAMC3 is intended to force A and B to be stored prior to doing
*> the addition of A and B , for use in situations where optimizers
*> might hold one of these in a register.
*> \endverbatim
*> \author LAPACK is a software package provided by Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..
*> \date December 2016
*> \ingroup auxOTHERauxiliary
*>
*> \param[in] A
*> \verbatim
*> A is a DOUBLE PRECISION
*> \endverbatim
*>
*> \param[in] B
*> \verbatim
*> B is a DOUBLE PRECISION
*> The values A and B.
*> \endverbatim
*>
DOUBLE PRECISION FUNCTION DLAMC3( A, B )
*
* -- LAPACK auxiliary routine (version 3.7.0) --
* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
* November 2010
*
* .. Scalar Arguments ..
DOUBLE PRECISION A, B
* ..
* =====================================================================
*
* .. Executable Statements ..
*
DLAMC3 = A + B
*
RETURN
*
* End of DLAMC3
*
END
*
************************************************************************