*> \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 ZGERFS
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download ZGERFS + dependencies
*>
*> [TGZ]
*>
*> [ZIP]
*>
*> [TXT]
*> \endhtmlonly
*
* Definition:
* ===========
*
* SUBROUTINE ZGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB,
* X, LDX, FERR, BERR, WORK, RWORK, INFO )
*
* .. Scalar Arguments ..
* CHARACTER TRANS
* 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
*>
*> ZGERFS improves the computed solution to a system of linear
*> equations and provides error bounds and backward error estimates for
*> the solution.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] TRANS
*> \verbatim
*> TRANS is CHARACTER*1
*> Specifies the form of the system of equations:
*> = 'N': A * X = B (No transpose)
*> = 'T': A**T * X = B (Transpose)
*> = 'C': A**H * X = B (Conjugate transpose)
*> \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 original N-by-N matrix A.
*> \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 factors L and U from the factorization A = P*L*U
*> as computed by ZGETRF.
*> \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)
*> The pivot indices from ZGETRF; for 1<=i<=N, row i of the
*> matrix was interchanged with row IPIV(i).
*> \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 ZGETRS.
*> 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 complex16GEcomputational
*
* =====================================================================
SUBROUTINE ZGERFS( TRANS, 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 TRANS
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 NOTRAN
CHARACTER TRANSN, TRANST
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 Functions ..
LOGICAL LSAME
DOUBLE PRECISION DLAMCH
EXTERNAL LSAME, DLAMCH
* ..
* .. External Subroutines ..
EXTERNAL XERBLA, ZAXPY, ZCOPY, ZGEMV, ZGETRS, ZLACN2
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, DBLE, DIMAG, MAX
* ..
* .. Statement Functions ..
DOUBLE PRECISION CABS1
* ..
* .. Statement Function definitions ..
CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) )
* ..
* .. Executable Statements ..
*
* Test the input parameters.
*
INFO = 0
NOTRAN = LSAME( TRANS, 'N' )
IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
$ LSAME( TRANS, 'C' ) ) 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( 'ZGERFS', -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
*
IF( NOTRAN ) THEN
TRANSN = 'N'
TRANST = 'C'
ELSE
TRANSN = 'C'
TRANST = 'N'
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 - op(A) * X,
* where op(A) = A, A**T, or A**H, depending on TRANS.
*
CALL ZCOPY( N, B( 1, J ), 1, WORK, 1 )
CALL ZGEMV( TRANS, N, N, -ONE, A, LDA, X( 1, J ), 1, ONE, WORK,
$ 1 )
*
* Compute componentwise relative backward error from formula
*
* max(i) ( abs(R(i)) / ( abs(op(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(op(A))*abs(X) + abs(B).
*
IF( NOTRAN ) THEN
DO 50 K = 1, N
XK = CABS1( X( K, J ) )
DO 40 I = 1, N
RWORK( I ) = RWORK( I ) + CABS1( A( I, K ) )*XK
40 CONTINUE
50 CONTINUE
ELSE
DO 70 K = 1, N
S = ZERO
DO 60 I = 1, N
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 ZGETRS( TRANS, 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(op(A)))*
* ( abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) ))) / norm(X)
*
* where
* norm(Z) is the magnitude of the largest component of Z
* inv(op(A)) is the inverse of op(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(op(A))*abs(X)+abs(B))
* is incremented by SAFE1 if the i-th component of
* abs(op(A))*abs(X) + abs(B) is less than SAFE2.
*
* Use ZLACN2 to estimate the infinity-norm of the matrix
* inv(op(A)) * diag(W),
* where W = abs(R) + NZ*EPS*( abs(op(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(op(A)**H).
*
CALL ZGETRS( TRANST, N, 1, AF, LDAF, IPIV, WORK, N,
$ INFO )
DO 110 I = 1, N
WORK( I ) = RWORK( I )*WORK( I )
110 CONTINUE
ELSE
*
* Multiply by inv(op(A))*diag(W).
*
DO 120 I = 1, N
WORK( I ) = RWORK( I )*WORK( I )
120 CONTINUE
CALL ZGETRS( TRANSN, 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 ZGERFS
*
END
*> \brief \b ZGETRS
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download ZGETRS + dependencies
*>
*> [TGZ]
*>
*> [ZIP]
*>
*> [TXT]
*> \endhtmlonly
*
* Definition:
* ===========
*
* SUBROUTINE ZGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
*
* .. Scalar Arguments ..
* CHARACTER TRANS
* INTEGER INFO, LDA, LDB, N, NRHS
* ..
* .. Array Arguments ..
* INTEGER IPIV( * )
* COMPLEX*16 A( LDA, * ), B( LDB, * )
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> ZGETRS solves a system of linear equations
*> A * X = B, A**T * X = B, or A**H * X = B
*> with a general N-by-N matrix A using the LU factorization computed
*> by ZGETRF.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] TRANS
*> \verbatim
*> TRANS is CHARACTER*1
*> Specifies the form of the system of equations:
*> = 'N': A * X = B (No transpose)
*> = 'T': A**T * X = B (Transpose)
*> = 'C': A**H * X = B (Conjugate transpose)
*> \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 factors L and U from the factorization A = P*L*U
*> as computed by ZGETRF.
*> \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)
*> The pivot indices from ZGETRF; for 1<=i<=N, row i of the
*> matrix was interchanged with row IPIV(i).
*> \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 complex16GEcomputational
*
* =====================================================================
SUBROUTINE ZGETRS( TRANS, 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 TRANS
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 NOTRAN
* ..
* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
* ..
* .. External Subroutines ..
EXTERNAL XERBLA, ZLASWP, ZTRSM
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX
* ..
* .. Executable Statements ..
*
* Test the input parameters.
*
INFO = 0
NOTRAN = LSAME( TRANS, 'N' )
IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
$ LSAME( TRANS, 'C' ) ) 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( 'ZGETRS', -INFO )
RETURN
END IF
*
* Quick return if possible
*
IF( N.EQ.0 .OR. NRHS.EQ.0 )
$ RETURN
*
IF( NOTRAN ) THEN
*
* Solve A * X = B.
*
* Apply row interchanges to the right hand sides.
*
CALL ZLASWP( NRHS, B, LDB, 1, N, IPIV, 1 )
*
* Solve L*X = B, overwriting B with X.
*
CALL ZTRSM( 'Left', 'Lower', 'No transpose', 'Unit', N, NRHS,
$ ONE, A, LDA, B, LDB )
*
* Solve U*X = B, overwriting B with X.
*
CALL ZTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N,
$ NRHS, ONE, A, LDA, B, LDB )
ELSE
*
* Solve A**T * X = B or A**H * X = B.
*
* Solve U**T *X = B or U**H *X = B, overwriting B with X.
*
CALL ZTRSM( 'Left', 'Upper', TRANS, 'Non-unit', N, NRHS, ONE,
$ A, LDA, B, LDB )
*
* Solve L**T *X = B, or L**H *X = B overwriting B with X.
*
CALL ZTRSM( 'Left', 'Lower', TRANS, 'Unit', N, NRHS, ONE, A,
$ LDA, B, LDB )
*
* Apply row interchanges to the solution vectors.
*
CALL ZLASWP( NRHS, B, LDB, 1, N, IPIV, -1 )
END IF
*
RETURN
*
* End of ZGETRS
*
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 ZLASWP performs a series of row interchanges on a general rectangular matrix.
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download ZLASWP + dependencies
*>
*> [TGZ]
*>
*> [ZIP]
*>
*> [TXT]
*> \endhtmlonly
*
* Definition:
* ===========
*
* SUBROUTINE ZLASWP( N, A, LDA, K1, K2, IPIV, INCX )
*
* .. Scalar Arguments ..
* INTEGER INCX, K1, K2, LDA, N
* ..
* .. Array Arguments ..
* INTEGER IPIV( * )
* COMPLEX*16 A( LDA, * )
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> ZLASWP performs a series of row interchanges on the matrix A.
*> One row interchange is initiated for each of rows K1 through K2 of A.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> The number of columns of the matrix A.
*> \endverbatim
*>
*> \param[in,out] A
*> \verbatim
*> A is COMPLEX*16 array, dimension (LDA,N)
*> On entry, the matrix of column dimension N to which the row
*> interchanges will be applied.
*> On exit, the permuted matrix.
*> \endverbatim
*>
*> \param[in] LDA
*> \verbatim
*> LDA is INTEGER
*> The leading dimension of the array A.
*> \endverbatim
*>
*> \param[in] K1
*> \verbatim
*> K1 is INTEGER
*> The first element of IPIV for which a row interchange will
*> be done.
*> \endverbatim
*>
*> \param[in] K2
*> \verbatim
*> K2 is INTEGER
*> (K2-K1+1) is the number of elements of IPIV for which a row
*> interchange will be done.
*> \endverbatim
*>
*> \param[in] IPIV
*> \verbatim
*> IPIV is INTEGER array, dimension (K1+(K2-K1)*abs(INCX))
*> The vector of pivot indices. Only the elements in positions
*> K1 through K1+(K2-K1)*abs(INCX) of IPIV are accessed.
*> IPIV(K1+(K-K1)*abs(INCX)) = L implies rows K and L are to be
*> interchanged.
*> \endverbatim
*>
*> \param[in] INCX
*> \verbatim
*> INCX is INTEGER
*> The increment between successive values of IPIV. If INCX
*> is negative, the pivots are applied in reverse order.
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date June 2017
*
*> \ingroup complex16OTHERauxiliary
*
*> \par Further Details:
* =====================
*>
*> \verbatim
*>
*> Modified by
*> R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA
*> \endverbatim
*>
* =====================================================================
SUBROUTINE ZLASWP( N, A, LDA, K1, K2, IPIV, INCX )
*
* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2017
*
* .. Scalar Arguments ..
INTEGER INCX, K1, K2, LDA, N
* ..
* .. Array Arguments ..
INTEGER IPIV( * )
COMPLEX*16 A( LDA, * )
* ..
*
* =====================================================================
*
* .. Local Scalars ..
INTEGER I, I1, I2, INC, IP, IX, IX0, J, K, N32
COMPLEX*16 TEMP
* ..
* .. Executable Statements ..
*
* Interchange row I with row IPIV(K1+(I-K1)*abs(INCX)) for each of rows
* K1 through K2.
*
IF( INCX.GT.0 ) THEN
IX0 = K1
I1 = K1
I2 = K2
INC = 1
ELSE IF( INCX.LT.0 ) THEN
IX0 = K1 + ( K1-K2 )*INCX
I1 = K2
I2 = K1
INC = -1
ELSE
RETURN
END IF
*
N32 = ( N / 32 )*32
IF( N32.NE.0 ) THEN
DO 30 J = 1, N32, 32
IX = IX0
DO 20 I = I1, I2, INC
IP = IPIV( IX )
IF( IP.NE.I ) THEN
DO 10 K = J, J + 31
TEMP = A( I, K )
A( I, K ) = A( IP, K )
A( IP, K ) = TEMP
10 CONTINUE
END IF
IX = IX + INCX
20 CONTINUE
30 CONTINUE
END IF
IF( N32.NE.N ) THEN
N32 = N32 + 1
IX = IX0
DO 50 I = I1, I2, INC
IP = IPIV( IX )
IF( IP.NE.I ) THEN
DO 40 K = N32, N
TEMP = A( I, K )
A( I, K ) = A( IP, K )
A( IP, K ) = TEMP
40 CONTINUE
END IF
IX = IX + INCX
50 CONTINUE
END IF
*
RETURN
*
* End of ZLASWP
*
END
*> \brief \b ZTRSM
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* SUBROUTINE ZTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
*
* .. Scalar Arguments ..
* COMPLEX*16 ALPHA
* INTEGER LDA,LDB,M,N
* CHARACTER DIAG,SIDE,TRANSA,UPLO
* ..
* .. Array Arguments ..
* COMPLEX*16 A(LDA,*),B(LDB,*)
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> ZTRSM solves one of the matrix equations
*>
*> op( A )*X = alpha*B, or X*op( A ) = alpha*B,
*>
*> where alpha is a scalar, X and B are m by n matrices, A is a unit, or
*> non-unit, upper or lower triangular matrix and op( A ) is one of
*>
*> op( A ) = A or op( A ) = A**T or op( A ) = A**H.
*>
*> The matrix X is overwritten on B.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] SIDE
*> \verbatim
*> SIDE is CHARACTER*1
*> On entry, SIDE specifies whether op( A ) appears on the left
*> or right of X as follows:
*>
*> SIDE = 'L' or 'l' op( A )*X = alpha*B.
*>
*> SIDE = 'R' or 'r' X*op( A ) = alpha*B.
*> \endverbatim
*>
*> \param[in] UPLO
*> \verbatim
*> UPLO is CHARACTER*1
*> On entry, UPLO specifies whether the matrix A is an upper or
*> lower triangular matrix as follows:
*>
*> UPLO = 'U' or 'u' A is an upper triangular matrix.
*>
*> UPLO = 'L' or 'l' A is a lower triangular matrix.
*> \endverbatim
*>
*> \param[in] TRANSA
*> \verbatim
*> TRANSA is CHARACTER*1
*> On entry, TRANSA specifies the form of op( A ) to be used in
*> the matrix multiplication as follows:
*>
*> TRANSA = 'N' or 'n' op( A ) = A.
*>
*> TRANSA = 'T' or 't' op( A ) = A**T.
*>
*> TRANSA = 'C' or 'c' op( A ) = A**H.
*> \endverbatim
*>
*> \param[in] DIAG
*> \verbatim
*> DIAG is CHARACTER*1
*> On entry, DIAG specifies whether or not A is unit triangular
*> as follows:
*>
*> DIAG = 'U' or 'u' A is assumed to be unit triangular.
*>
*> DIAG = 'N' or 'n' A is not assumed to be unit
*> triangular.
*> \endverbatim
*>
*> \param[in] M
*> \verbatim
*> M is INTEGER
*> On entry, M specifies the number of rows of B. M must be at
*> least zero.
*> \endverbatim
*>
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> On entry, N specifies the number of columns of B. N must be
*> at least zero.
*> \endverbatim
*>
*> \param[in] ALPHA
*> \verbatim
*> ALPHA is COMPLEX*16
*> On entry, ALPHA specifies the scalar alpha. When alpha is
*> zero then A is not referenced and B need not be set before
*> entry.
*> \endverbatim
*>
*> \param[in] A
*> \verbatim
*> A is COMPLEX*16 array, dimension ( LDA, k ),
*> where k is m when SIDE = 'L' or 'l'
*> and k is n when SIDE = 'R' or 'r'.
*> Before entry with UPLO = 'U' or 'u', the leading k by k
*> upper triangular part of the array A must contain the upper
*> triangular matrix and the strictly lower triangular part of
*> A is not referenced.
*> Before entry with UPLO = 'L' or 'l', the leading k by k
*> lower triangular part of the array A must contain the lower
*> triangular matrix and the strictly upper triangular part of
*> A is not referenced.
*> Note that when DIAG = 'U' or 'u', the diagonal elements of
*> A are not referenced either, but are assumed to be unity.
*> \endverbatim
*>
*> \param[in] LDA
*> \verbatim
*> LDA is INTEGER
*> On entry, LDA specifies the first dimension of A as declared
*> in the calling (sub) program. When SIDE = 'L' or 'l' then
*> LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'
*> then LDA must be at least max( 1, n ).
*> \endverbatim
*>
*> \param[in,out] B
*> \verbatim
*> B is COMPLEX*16 array, dimension ( LDB, N )
*> Before entry, the leading m by n part of the array B must
*> contain the right-hand side matrix B, and on exit is
*> overwritten by the solution matrix X.
*> \endverbatim
*>
*> \param[in] LDB
*> \verbatim
*> LDB is INTEGER
*> On entry, LDB specifies the first dimension of B as declared
*> in the calling (sub) program. LDB 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 trsm
*
*> \par Further Details:
* =====================
*>
*> \verbatim
*>
*> Level 3 Blas routine.
*>
*> -- Written on 8-February-1989.
*> Jack Dongarra, Argonne National Laboratory.
*> Iain Duff, AERE Harwell.
*> Jeremy Du Croz, Numerical Algorithms Group Ltd.
*> Sven Hammarling, Numerical Algorithms Group Ltd.
*> \endverbatim
*>
* =====================================================================
SUBROUTINE ZTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
*
* -- Reference BLAS level3 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 LDA,LDB,M,N
CHARACTER DIAG,SIDE,TRANSA,UPLO
* ..
* .. Array Arguments ..
COMPLEX*16 A(LDA,*),B(LDB,*)
* ..
*
* =====================================================================
*
* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
* ..
* .. External Subroutines ..
EXTERNAL XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC DCONJG,MAX
* ..
* .. Local Scalars ..
COMPLEX*16 TEMP
INTEGER I,INFO,J,K,NROWA
LOGICAL LSIDE,NOCONJ,NOUNIT,UPPER
* ..
* .. Parameters ..
COMPLEX*16 ONE
PARAMETER (ONE= (1.0D+0,0.0D+0))
COMPLEX*16 ZERO
PARAMETER (ZERO= (0.0D+0,0.0D+0))
* ..
*
* Test the input parameters.
*
LSIDE = LSAME(SIDE,'L')
IF (LSIDE) THEN
NROWA = M
ELSE
NROWA = N
END IF
NOCONJ = LSAME(TRANSA,'T')
NOUNIT = LSAME(DIAG,'N')
UPPER = LSAME(UPLO,'U')
*
INFO = 0
IF ((.NOT.LSIDE) .AND. (.NOT.LSAME(SIDE,'R'))) THEN
INFO = 1
ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
INFO = 2
ELSE IF ((.NOT.LSAME(TRANSA,'N')) .AND.
+ (.NOT.LSAME(TRANSA,'T')) .AND.
+ (.NOT.LSAME(TRANSA,'C'))) THEN
INFO = 3
ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND.
+ (.NOT.LSAME(DIAG,'N'))) THEN
INFO = 4
ELSE IF (M.LT.0) THEN
INFO = 5
ELSE IF (N.LT.0) THEN
INFO = 6
ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
INFO = 9
ELSE IF (LDB.LT.MAX(1,M)) THEN
INFO = 11
END IF
IF (INFO.NE.0) THEN
CALL XERBLA('ZTRSM ',INFO)
RETURN
END IF
*
* Quick return if possible.
*
IF (M.EQ.0 .OR. N.EQ.0) RETURN
*
* And when alpha.eq.zero.
*
IF (ALPHA.EQ.ZERO) THEN
DO 20 J = 1,N
DO 10 I = 1,M
B(I,J) = ZERO
10 CONTINUE
20 CONTINUE
RETURN
END IF
*
* Start the operations.
*
IF (LSIDE) THEN
IF (LSAME(TRANSA,'N')) THEN
*
* Form B := alpha*inv( A )*B.
*
IF (UPPER) THEN
DO 60 J = 1,N
IF (ALPHA.NE.ONE) THEN
DO 30 I = 1,M
B(I,J) = ALPHA*B(I,J)
30 CONTINUE
END IF
DO 50 K = M,1,-1
IF (B(K,J).NE.ZERO) THEN
IF (NOUNIT) B(K,J) = B(K,J)/A(K,K)
DO 40 I = 1,K - 1
B(I,J) = B(I,J) - B(K,J)*A(I,K)
40 CONTINUE
END IF
50 CONTINUE
60 CONTINUE
ELSE
DO 100 J = 1,N
IF (ALPHA.NE.ONE) THEN
DO 70 I = 1,M
B(I,J) = ALPHA*B(I,J)
70 CONTINUE
END IF
DO 90 K = 1,M
IF (B(K,J).NE.ZERO) THEN
IF (NOUNIT) B(K,J) = B(K,J)/A(K,K)
DO 80 I = K + 1,M
B(I,J) = B(I,J) - B(K,J)*A(I,K)
80 CONTINUE
END IF
90 CONTINUE
100 CONTINUE
END IF
ELSE
*
* Form B := alpha*inv( A**T )*B
* or B := alpha*inv( A**H )*B.
*
IF (UPPER) THEN
DO 140 J = 1,N
DO 130 I = 1,M
TEMP = ALPHA*B(I,J)
IF (NOCONJ) THEN
DO 110 K = 1,I - 1
TEMP = TEMP - A(K,I)*B(K,J)
110 CONTINUE
IF (NOUNIT) TEMP = TEMP/A(I,I)
ELSE
DO 120 K = 1,I - 1
TEMP = TEMP - DCONJG(A(K,I))*B(K,J)
120 CONTINUE
IF (NOUNIT) TEMP = TEMP/DCONJG(A(I,I))
END IF
B(I,J) = TEMP
130 CONTINUE
140 CONTINUE
ELSE
DO 180 J = 1,N
DO 170 I = M,1,-1
TEMP = ALPHA*B(I,J)
IF (NOCONJ) THEN
DO 150 K = I + 1,M
TEMP = TEMP - A(K,I)*B(K,J)
150 CONTINUE
IF (NOUNIT) TEMP = TEMP/A(I,I)
ELSE
DO 160 K = I + 1,M
TEMP = TEMP - DCONJG(A(K,I))*B(K,J)
160 CONTINUE
IF (NOUNIT) TEMP = TEMP/DCONJG(A(I,I))
END IF
B(I,J) = TEMP
170 CONTINUE
180 CONTINUE
END IF
END IF
ELSE
IF (LSAME(TRANSA,'N')) THEN
*
* Form B := alpha*B*inv( A ).
*
IF (UPPER) THEN
DO 230 J = 1,N
IF (ALPHA.NE.ONE) THEN
DO 190 I = 1,M
B(I,J) = ALPHA*B(I,J)
190 CONTINUE
END IF
DO 210 K = 1,J - 1
IF (A(K,J).NE.ZERO) THEN
DO 200 I = 1,M
B(I,J) = B(I,J) - A(K,J)*B(I,K)
200 CONTINUE
END IF
210 CONTINUE
IF (NOUNIT) THEN
TEMP = ONE/A(J,J)
DO 220 I = 1,M
B(I,J) = TEMP*B(I,J)
220 CONTINUE
END IF
230 CONTINUE
ELSE
DO 280 J = N,1,-1
IF (ALPHA.NE.ONE) THEN
DO 240 I = 1,M
B(I,J) = ALPHA*B(I,J)
240 CONTINUE
END IF
DO 260 K = J + 1,N
IF (A(K,J).NE.ZERO) THEN
DO 250 I = 1,M
B(I,J) = B(I,J) - A(K,J)*B(I,K)
250 CONTINUE
END IF
260 CONTINUE
IF (NOUNIT) THEN
TEMP = ONE/A(J,J)
DO 270 I = 1,M
B(I,J) = TEMP*B(I,J)
270 CONTINUE
END IF
280 CONTINUE
END IF
ELSE
*
* Form B := alpha*B*inv( A**T )
* or B := alpha*B*inv( A**H ).
*
IF (UPPER) THEN
DO 330 K = N,1,-1
IF (NOUNIT) THEN
IF (NOCONJ) THEN
TEMP = ONE/A(K,K)
ELSE
TEMP = ONE/DCONJG(A(K,K))
END IF
DO 290 I = 1,M
B(I,K) = TEMP*B(I,K)
290 CONTINUE
END IF
DO 310 J = 1,K - 1
IF (A(J,K).NE.ZERO) THEN
IF (NOCONJ) THEN
TEMP = A(J,K)
ELSE
TEMP = DCONJG(A(J,K))
END IF
DO 300 I = 1,M
B(I,J) = B(I,J) - TEMP*B(I,K)
300 CONTINUE
END IF
310 CONTINUE
IF (ALPHA.NE.ONE) THEN
DO 320 I = 1,M
B(I,K) = ALPHA*B(I,K)
320 CONTINUE
END IF
330 CONTINUE
ELSE
DO 380 K = 1,N
IF (NOUNIT) THEN
IF (NOCONJ) THEN
TEMP = ONE/A(K,K)
ELSE
TEMP = ONE/DCONJG(A(K,K))
END IF
DO 340 I = 1,M
B(I,K) = TEMP*B(I,K)
340 CONTINUE
END IF
DO 360 J = K + 1,N
IF (A(J,K).NE.ZERO) THEN
IF (NOCONJ) THEN
TEMP = A(J,K)
ELSE
TEMP = DCONJG(A(J,K))
END IF
DO 350 I = 1,M
B(I,J) = B(I,J) - TEMP*B(I,K)
350 CONTINUE
END IF
360 CONTINUE
IF (ALPHA.NE.ONE) THEN
DO 370 I = 1,M
B(I,K) = ALPHA*B(I,K)
370 CONTINUE
END IF
380 CONTINUE
END IF
END IF
END IF
*
RETURN
*
* End of ZTRSM
*
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
*
************************************************************************