def ZGERU(M, N, ALPHA, X, INCX, Y, INCY, A, LDA):
#
# -- Reference BLAS level2 routine (version 3.7.0) --
# -- Reference BLAS is a software package provided by Univ. of Tennessee, --
# -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
# December 2016
#
# .. Scalar Arguments ..
# COMPLEX*16 ALPHA
# INTEGER INCX,INCY,LDA,M,N
# ..
# .. Array Arguments ..
# COMPLEX*16 A(LDA,*),X(*),Y(*)
# ..
#
# =====================================================================
# Test the input parameters.
INFO = 0
if M < 0:
INFO = 1
elif N < 0:
INFO = 2
elif INCX == 0:
INFO = 5
elif INCY == 0:
INFO = 7
elif LDA < max(1, M):
INFO = 9
if INFO != 0:
xerbla("ZGERU ", INFO)
return
for J, JY in enumerate(range_(N, INCY)):
A[:M, J] += X[slice_(M, INCX)] * ALPHA * Y[JY]
def SGER(M, N, ALPHA, X, INCX, Y, INCY, A, LDA):
#
# -- Reference BLAS level2 routine (version 3.7.0) --
# -- Reference BLAS is a software package provided by Univ. of Tennessee, --
# -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
# December 2016
#
# .. Scalar Arguments ..
# REAL ALPHA
# INTEGER INCX,INCY,LDA,M,N
# ..
# .. Array Arguments ..
# REAL A(LDA,*),X(*),Y(*)
# ..
#
# =====================================================================
#
# .. Parameters ..
# REAL ZERO
# PARAMETER (ZERO=0.0E+0)
# ..
# .. Local Scalars ..
# REAL TEMP
# INTEGER I,INFO,IX,J,JY,KX
# ..
# .. External Subroutines ..
# EXTERNAL XERBLA
# ..
# .. Intrinsic Functions ..
# INTRINSIC MAX
# ..
# Test the input parameters.
INFO = 0
if M < 0:
INFO = 1
elif N < 0:
INFO = 2
elif INCX == 0:
INFO = 5
elif INCY == 0:
INFO = 7
elif LDA < max(1, M):
INFO = 9
if INFO != 0:
xerbla("SGER ", INFO)
for J, JY in enumerate(range_(N, INCY)):
A[:M, J] += ALPHA * X[slice_(M, INCX)] * Y[JY]
def XERBLA_ARRAY(SRNAME_ARRAY, SRNAME_LEN, INFO):
#
# -- Reference BLAS level1 routine (version 3.7.0) --
# -- Reference BLAS 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 SRNAME_LEN, INFO
# ..
# .. Array Arguments ..
# CHARACTER(1) SRNAME_ARRAY(SRNAME_LEN)
# ..
#
# =====================================================================
SRNAME = ""
for I in range(SRNAME_LEN, len(SRNAME)):
SRNAME += SRNAME_ARRAY[I]
xerbla(SRNAME, INFO)
def CTBSV(UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX):
#
# -- Reference BLAS level2 routine (version 3.7.0) --
# -- Reference BLAS 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 INCX,K,LDA,N
# CHARACTER DIAG,TRANS,UPLO
# ..
# .. Array Arguments ..
# COMPLEX A(LDA,*),X(*)
# ..
#
# =====================================================================
# Test the input parameters.
INFO = 0
if not lsame(UPLO, "U") and not lsame(UPLO, "L"):
INFO = 1
elif not lsame(TRANS, "N") and not lsame(TRANS, "T") and not lsame(
TRANS, "C"):
INFO = 2
elif not lsame(DIAG, "U") and not lsame(DIAG, "N"):
INFO = 3
elif N < 0:
INFO = 4
elif K < 0:
INFO = 5
elif LDA < (K + 1):
INFO = 7
elif INCX == 0:
INFO = 9
if INFO != 0:
xerbla("CTBSV ", INFO)
# Quick return if possible.
if N == 0:
return
#
NOCONJ = lsame(TRANS, "T")
NOUNIT = lsame(DIAG, "N")
#
# Set up the start point in X if the increment is not unity. This
# will be ( N - 1 )*INCX too small for descending loops.
#
if INCX <= 0:
KX = 1 - (N - 1) * INCX
elif INCX != 1:
KX = 1
#
# Start the operations. In this version the elements of A are
# accessed by sequentially with one pass through A.
#
if lsame(TRANS, "N"):
#
# Form x := inv( A )*x.
#
if lsame(UPLO, "U"):
KPLUS1 = K + 1
if INCX == 1:
for J in range(N - 1, -1, -1):
if X[J] != 0:
L = KPLUS1 - J
if NOUNIT:
X[J] = X[J] / A[KPLUS1, J]
TEMP = X[J]
for I in range(J - 2, max(1, J - K) - 2, -1):
X[I] -= TEMP * A[L + I, J]
else:
KX += (N - 1) * INCX
JX = KX
for J in range(N - 1, -1, -1):
KX -= INCX
if X[JX] != 0:
IX = KX
L = KPLUS1 - J
if NOUNIT:
X[JX] = X[JX] / A[KPLUS1, J]
TEMP = X[JX]
for I in range(J - 2, max(1, J - K) - 2, -1):
X[IX] -= TEMP * A[L + I, J]
IX -= INCX
JX -= INCX
else:
if INCX == 1:
for J in range(N):
if X[J] != 0:
L = 1 - J
if NOUNIT:
X[J] = X[J] / A[1, J]
TEMP = X[J]
for I in range(J, min(N, J + K)):
X[I] -= TEMP * A[L + I, J]
else:
JX = KX
for J in range(N):
KX += INCX
if X[JX] != 0:
IX = KX
L = 1 - J
if NOUNIT:
X[JX] = X[JX] / A[1, J]
TEMP = X[JX]
for I in range(J, min(N, J + K)):
X[IX] -= TEMP * A[L + I, J]
IX += INCX
JX += INCX
else:
# Form x := inv( A**T )*x or x := inv( A**H )*x.
if lsame(UPLO, "U"):
KPLUS1 = K + 1
if INCX == 1:
for J in range(N):
TEMP = X[J]
L = KPLUS1 - J
if NOCONJ:
for I in range(max(1, J - K) - 1, J - 1):
TEMP -= A[L + I, J] * X[I]
if NOUNIT:
TEMP = TEMP / A[KPLUS1, J]
else:
for I in range(max(1, J - K) - 1, J - 1):
TEMP -= A[L + I, J].conjugate() * X[I]
if NOUNIT:
TEMP = TEMP / A[KPLUS1, J].conjugate()
X[J] = TEMP
else:
JX = KX
for J in range(N):
TEMP = X[JX]
IX = KX
L = KPLUS1 - J
if NOCONJ:
for I in range(max(1, J - K) - 1, J - 1):
TEMP -= A[L + I, J] * X[IX]
IX += INCX
if NOUNIT:
TEMP = TEMP / A[KPLUS1, J]
else:
for I in range(max(1, J - K) - 1, J - 1):
TEMP -= A[L + I, J].conjugate() * X[IX]
IX += INCX
if NOUNIT:
TEMP = TEMP / A[KPLUS1, J].conjugate()
X[JX] = TEMP
JX += INCX
if J > K:
KX += INCX
else:
if INCX == 1:
for J in range(N - 1, -1, -1):
TEMP = X[J]
L = 1 - J
if NOCONJ:
for I in range(min(N, J + K) - 1, J - 1, -1):
TEMP -= A[L + I, J] * X[I]
if NOUNIT:
TEMP /= A[1, J]
else:
for I in range(min(N, J + K) - 1, J - 1, -1):
TEMP -= A[L + I, J].conjugate() * X[I]
if NOUNIT:
TEMP /= A[1, J].conjugate()
X[J] = TEMP
else:
KX += (N - 1) * INCX
JX = KX
for J in range(N - 1, -1, -1):
TEMP = X[JX]
IX = KX
L = 1 - J
if NOCONJ:
for I in range(min(N, J + K) - 1, J - 1, -1):
TEMP -= A[L + I, J] * X[IX]
IX -= INCX
if NOUNIT:
TEMP /= A[1, J]
else:
for I in range(min(N, J + K) - 1, J - 1, -1):
TEMP -= A[L + I, J].conjugate() * X[IX]
IX -= INCX
if NOUNIT:
TEMP /= A[1, J].conjugate()
X[JX] = TEMP
JX -= INCX
if (N - J) >= K:
KX -= INCX
def DSPR(UPLO, N, ALPHA, X, INCX, AP):
#
# -- Reference BLAS level2 routine (version 3.7.0) --
# -- Reference BLAS is a software package provided by Univ. of Tennessee, --
# -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
# December 2016
#
# .. Scalar Arguments ..
# DOUBLE PRECISION ALPHA
# INTEGER INCX,N
# CHARACTER UPLO
# ..
# .. Array Arguments ..
# DOUBLE PRECISION AP(*),X(*)
# ..
#
# =====================================================================
# Test the input parameters.
INFO = 0
if not lsame(UPLO, "U") and not lsame(UPLO, "L"):
INFO = 1
elif N < 0:
INFO = 2
elif INCX == 0:
INFO = 5
if INFO != 0:
xerbla("DSPR ", INFO)
# Quick return if possible.
if (N == 0) or (ALPHA == 0):
return
#
# Set the start point in X if the increment is not unity.
#
if INCX <= 0:
KX = 1 - (N - 1) * INCX
elif INCX != 1:
KX = 1
#
# Start the operations. In this version the elements of the array AP
# are accessed sequentially with one pass through AP.
#
KK = 1
if lsame(UPLO, "U"):
#
# Form A when upper triangle is stored in AP.
#
if INCX == 1:
for J in range(N):
if X[J] != 0:
TEMP = ALPHA * X[J]
K = KK
for I in range(J):
AP[K] += X[I] * TEMP
K += 1
KK += J
else:
JX = KX
for J in range(N):
if X[JX] != 0:
TEMP = ALPHA * X[JX]
IX = KX
for K in range(KK - 1, KK + J - 1):
AP[K] += X[IX] * TEMP
IX += INCX
JX += INCX
KK += J
else:
#
# Form A when lower triangle is stored in AP.
#
if INCX == 1:
for J in range(N):
if X[J] != 0:
TEMP = ALPHA * X[J]
K = KK
for I in range(J - 1, N):
AP[K] += X[I] * TEMP
K += 1
KK += N - J + 1
else:
JX = KX
for J in range(N):
if X[JX] != 0:
TEMP = ALPHA * X[JX]
IX = JX
for K in range(KK - 1, KK + N - J):
AP[K] += X[IX] * TEMP
IX += INCX
JX += INCX
KK += N - J + 1
def SSYMM(SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC):
#
# -- Reference BLAS level3 routine (version 3.7.0) --
# -- Reference BLAS is a software package provided by Univ. of Tennessee, --
# -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
# December 2016
#
# .. Scalar Arguments ..
# REAL ALPHA,BETA
# INTEGER LDA,LDB,LDC,M,N
# CHARACTER SIDE,UPLO
# ..
# .. Array Arguments ..
# REAL A(LDA,*),B(LDB,*),C(LDC,*)
# ..
#
# =====================================================================
#
# .. External Functions ..
# LOGICAL LSAME
# EXTERNAL LSAME
# ..
# .. External Subroutines ..
# EXTERNAL XERBLA
# ..
# .. Intrinsic Functions ..
# INTRINSIC MAX
# ..
# .. Local Scalars ..
# REAL TEMP1,TEMP2
# INTEGER I,INFO,J,K,NROWA
# LOGICAL UPPER
# ..
# .. Parameters ..
# REAL ONE,ZERO
# PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
# ..
#
# Set NROWA as the number of rows of A.
#
if lsame(SIDE, "L"):
NROWA = M
else:
NROWA = N
UPPER = lsame(UPLO, "U")
# Test the input parameters.
INFO = 0
if (not lsame(SIDE, "L")) and (not lsame(SIDE, "R")):
INFO = 1
elif (not UPPER) and (not lsame(UPLO, "L")):
INFO = 2
elif M < 0:
INFO = 3
elif N < 0:
INFO = 4
elif LDA < max(1, NROWA):
INFO = 7
elif LDB < max(1, M):
INFO = 9
elif LDC < max(1, M):
INFO = 12
if INFO != 0:
xerbla("SSYMM ", INFO)
return
# Quick return if possible.
if (M == 0) or (N == 0) or ((ALPHA == 0) and (BETA == 1)):
return
# And when alpha==zero.
if ALPHA == 0:
if BETA == 0:
for J in range(N):
for I in range(M):
C[I, J] = 0
else:
for J in range(N):
for I in range(M):
C[I, J] *= BETA
return
# Start the operations.
if lsame(SIDE, "L"):
#
# Form C := alpha*A*B + beta*C.
#
if UPPER:
for J in range(N):
for I in range(M):
TEMP1 = ALPHA * B[I, J]
TEMP2 = 0
for K in range(I - 1):
C[K, J] = C[K, J] + TEMP1 * A[K, I]
TEMP2 += B[K, J] * A[K, I]
if BETA == 0:
C[I, J] = TEMP1 * A[I, I] + ALPHA * TEMP2
else:
C[I, J] *= BETA + TEMP1 * A[I, I] + ALPHA * TEMP2
else:
for J in range(N):
for I in range(M - 1, -1, -1):
TEMP1 = ALPHA * B[I, J]
TEMP2 = 0
for K in range(I, M):
C[K, J] = C[K, J] + TEMP1 * A[K, I]
TEMP2 += B[K, J] * A[K, I]
if BETA == 0:
C[I, J] = TEMP1 * A[I, I] + ALPHA * TEMP2
else:
C[I, J] *= BETA + TEMP1 * A[I, I] + ALPHA * TEMP2
else:
#
# Form C := alpha*B*A + beta*C.
#
for J in range(N):
TEMP1 = ALPHA * A[J, J]
if BETA == 0:
for I in range(M):
C[I, J] = TEMP1 * B[I, J]
else:
for I in range(M):
C[I, J] *= BETA + TEMP1 * B[I, J]
for K in range(J - 1):
if UPPER:
TEMP1 = ALPHA * A[K, J]
else:
TEMP1 = ALPHA * A[J, K]
for I in range(M):
C[I, J] += TEMP1 * B[I, K]
for K in range(J, N):
if UPPER:
TEMP1 = ALPHA * A[J, K]
else:
TEMP1 = ALPHA * A[K, J]
for I in range(M):
C[I, J] += TEMP1 * B[I, K]
def dsyr(UPLO, N, ALPHA, X, INCX, A, LDA):
#
# -- Reference BLAS level2 routine (version 3.7.0) --
# -- Reference BLAS is a software package provided by Univ. of Tennessee, --
# -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
# December 2016
#
# .. Scalar Arguments ..
# DOUBLE PRECISION ALPHA
# INTEGER INCX,LDA,N
# CHARACTER UPLO
# ..
# .. Array Arguments ..
# DOUBLE PRECISION A(LDA,*),X(*)
# ..
#
# =====================================================================
# Test the input parameters.
INFO = 0
if not lsame(UPLO, "U") and not lsame(UPLO, "L"):
INFO = 1
elif N < 0:
INFO = 2
elif INCX == 0:
INFO = 5
elif LDA < max(1, N):
INFO = 7
if INFO != 0:
xerbla("DSYR ", INFO)
return
# Quick return if possible.
if (N == 0) or (ALPHA == 0):
return
# Set the start point in X if the increment is not unity.
if INCX <= 0:
KX = 1 - (N - 1) * INCX
elif INCX != 1:
KX = 1
#
# Start the operations. In this version the elements of A are
# accessed sequentially with one pass through the triangular part
# of A.
#
if lsame(UPLO, "U"):
# Form A when A is stored in upper triangle.
if INCX == 1:
for J in range(N):
if X[J] != 0:
A[:J, J] += X[:J] * ALPHA * X[J]
else:
JX = KX
for J in range(N):
if X[JX] != 0:
TEMP = ALPHA * X[JX]
IX = KX
for I in range(J):
A[I, J] += X[IX] * TEMP
IX += INCX
JX += INCX
else:
# Form A when A is stored in lower triangle.
if INCX == 1:
for J in range(N):
if X[J] != 0:
TEMP = ALPHA * X[J]
for I in range(J - 1, N):
A[I, J] += X[I] * TEMP
else:
JX = KX
for J in range(N):
if X[JX] != 0:
TEMP = ALPHA * X[JX]
IX = JX
for I in range(J - 1, N):
A[I, J] += X[IX] * TEMP
IX += INCX
JX += INCX
def CTRMV(UPLO, TRANS, DIAG, N, A, LDA, X, INCX):
#
# -- Reference BLAS level2 routine (version 3.7.0) --
# -- Reference BLAS 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 INCX,LDA,N
# CHARACTER DIAG,TRANS,UPLO
# ..
# .. Array Arguments ..
# COMPLEX A(LDA,*),X(*)
# ..
#
# =====================================================================
# Test the input parameters.
INFO = 0
if not lsame(UPLO, "U") and not lsame(UPLO, "L"):
INFO = 1
elif not lsame(TRANS, "N") and not lsame(TRANS, "T") and not lsame(TRANS, "C"):
INFO = 2
elif not lsame(DIAG, "U") and not lsame(DIAG, "N"):
INFO = 3
elif N < 0:
INFO = 4
elif LDA < max(1, N):
INFO = 6
elif INCX == 0:
INFO = 8
if INFO != 0:
xerbla("CTRMV ", INFO)
# Quick return if possible.
if N == 0:
return
#
NOCONJ = lsame(TRANS, "T")
NOUNIT = lsame(DIAG, "N")
#
# Set up the start point in X if the increment is not unity. This
# will be ( N - 1 )*INCX too small for descending loops.
#
if INCX <= 0:
KX = 1 - (N - 1) * INCX
elif INCX != 1:
KX = 1
#
# Start the operations. In this version the elements of A are
# accessed sequentially with one pass through A.
#
if lsame(TRANS, "N"):
# Form x := A*x.
if lsame(UPLO, "U"):
if INCX == 1:
for J in range(N):
if X[J] != 0:
TEMP = X[J]
for I in range(J - 1):
X[I] += TEMP * A[I, J]
if NOUNIT:
X[J] = X[J] * A[J, J]
else:
JX = KX
for J in range(N):
if X[JX] != 0:
TEMP = X[JX]
IX = KX
for I in range(J - 1):
X[IX] = X[IX] + TEMP * A[I, J]
IX += INCX
if NOUNIT:
X[JX] = X[JX] * A[J, J]
JX += INCX
else:
if INCX == 1:
for J in range(N - 1, -1, -1):
if X[J] != 0:
TEMP = X[J]
for I in range(N - 1, J - 1, -1):
X[I] += TEMP * A[I, J]
if NOUNIT:
X[J] *= A[J, J]
else:
KX += (N - 1) * INCX
JX = KX
for J in range(N - 1, -1, -1):
if X[JX] != 0:
TEMP = X[JX]
IX = KX
for I in range(N - 1, J - 1, -1):
X[IX] = X[IX] + TEMP * A[I, J]
IX -= INCX
if NOUNIT:
X[JX] = X[JX] * A[J, J]
JX -= INCX
else:
# Form x := A**T*x or x := A**H*x.
if lsame(UPLO, "U"):
if INCX == 1:
for J in range(N - 1, -1, -1):
TEMP = X[J]
if NOCONJ:
if NOUNIT:
TEMP *= A[J, J]
for I in range(J - 2, -1, -1):
TEMP += A[I, J] * X[I]
else:
if NOUNIT:
TEMP *= A[J, J].conjugate()
for I in range(J - 2, -1, -1):
TEMP += A[1, J].conjugate() * X[I]
X[J] = TEMP
else:
JX = KX + (N - 1) * INCX
for J in range(N - 1, -1, -1):
TEMP = X[JX]
IX = JX
if NOCONJ:
if NOUNIT:
TEMP *= A[J, J]
for I in range(J - 2, -1, -1):
IX -= INCX
TEMP += A[I, J] * X[IX]
else:
if NOUNIT:
TEMP *= A[J, J].conjugate()
for I in range(J - 2, -1, -1):
IX -= INCX
TEMP += A[1, J].conjugate() * X[IX]
X[JX] = TEMP
JX -= INCX
else:
if INCX == 1:
for J in range(N):
TEMP = X[J]
if NOCONJ:
if NOUNIT:
TEMP *= A[J, J]
for I in range(J, N):
TEMP += A[I, J] * X[I]
else:
if NOUNIT:
TEMP *= A[J, J].conjugate()
for I in range(J, N):
TEMP += A[1, J].conjugate() * X[I]
X[J] = TEMP
else:
JX = KX
for J in range(N):
TEMP = X[JX]
IX = JX
if NOCONJ:
if NOUNIT:
TEMP *= A[J, J]
for J in range(J, N):
IX += INCX
TEMP += A[I, J] * X[IX]
else:
if NOUNIT:
TEMP *= A[J, J].conjugate()
for I in range(J, N):
IX += INCX
TEMP += A[1, J].conjugate() * X[IX]
X[JX] = TEMP
JX += INCX
def STBMV(UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX):
#
# -- Reference BLAS level2 routine (version 3.7.0) --
# -- Reference BLAS 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 INCX,K,LDA,N
# CHARACTER DIAG,TRANS,UPLO
# ..
# .. Array Arguments ..
# REAL A(LDA,*),X(*)
# ..
#
# =====================================================================
#
# .. Parameters ..
# REAL ZERO
# PARAMETER (ZERO=0.0E+0)
# ..
# .. Local Scalars ..
# REAL TEMP
# INTEGER I,INFO,IX,J,JX,KPLUS1,KX,L
# LOGICAL NOUNIT
# ..
# .. External Functions ..
# LOGICAL LSAME
# EXTERNAL LSAME
# ..
# .. External Subroutines ..
# EXTERNAL XERBLA
# ..
# .. Intrinsic Functions ..
# INTRINSIC MAX,MIN
# ..
# Test the input parameters.
INFO = 0
if not lsame(UPLO, "U") and not lsame(UPLO, "L"):
INFO = 1
elif not lsame(TRANS, "N") and not lsame(TRANS, "T") and not lsame(
TRANS, "C"):
INFO = 2
elif not lsame(DIAG, "U") and not lsame(DIAG, "N"):
INFO = 3
elif N < 0:
INFO = 4
elif K < 0:
INFO = 5
elif LDA < (K + 1):
INFO = 7
elif INCX == 0:
INFO = 9
if INFO != 0:
xerbla("STBMV ", INFO)
# Quick return if possible.
if N == 0:
return
#
NOUNIT = lsame(DIAG, "N")
#
# Set up the start point in X if the increment is not unity. This
# will be ( N - 1 )*INCX too small for descending loops.
#
if INCX <= 0:
KX = 1 - (N - 1) * INCX
elif INCX != 1:
KX = 1
#
# Start the operations. In this version the elements of A are
# accessed sequentially with one pass through A.
#
if lsame(TRANS, "N"):
# Form x := A*x.
if lsame(UPLO, "U"):
KPLUS1 = K + 1
if INCX == 1:
for J in range(N):
if X[J] != 0:
TEMP = X[J]
L = KPLUS1 - J
for I in range(max(1, J - K) - 1, J - 1):
X[I] += TEMP * A[L + I, J]
if NOUNIT:
X[J] = X[J] * A[KPLUS1, J]
else:
JX = KX
for J in range(N):
if X[JX] != 0:
TEMP = X[JX]
IX = KX
L = KPLUS1 - J
for I in range(max(1, J - K) - 1, J - 1):
X[IX] = X[IX] + TEMP * A[L + I, J]
IX += INCX
if NOUNIT:
X[JX] = X[JX] * A[KPLUS1, J]
JX += INCX
if J > K:
KX += INCX
else:
if INCX == 1:
for J in range(N - 1, -1, -1):
if X[J] != 0:
TEMP = X[J]
L = 1 - J
for I in range(min(N, J + K) - 1, J - 1, -1):
X[I] += TEMP * A[L + I, J]
if NOUNIT:
X[J] *= A[1, J]
else:
KX += (N - 1) * INCX
JX = KX
for J in range(N - 1, -1, -1):
if X[JX] != 0:
TEMP = X[JX]
IX = KX
L = 1 - J
for I in range(min(N, J + K) - 1, J - 1, -1):
X[IX] += TEMP * A[L + I, J]
IX -= INCX
if NOUNIT:
X[JX] *= A[1, J]
JX -= INCX
if (N - J) >= K:
KX -= INCX
else:
# Form x := A**T*x.
if lsame(UPLO, "U"):
KPLUS1 = K + 1
if INCX == 1:
for J in range(N - 1, -1, -1):
TEMP = X[J]
L = KPLUS1 - J
if NOUNIT:
TEMP = TEMP * A[KPLUS1, J]
for I in range(J - 2, max(1, J - K) - 2, -1):
TEMP += A[L + I, J] * X[I]
X[J] = TEMP
else:
KX += (N - 1) * INCX
JX = KX
for J in range(N - 1, -1, -1):
TEMP = X[JX]
KX -= INCX
IX = KX
L = KPLUS1 - J
if NOUNIT:
TEMP = TEMP * A[KPLUS1, J]
for I in range(J - 2, max(1, J - K) - 2, -1):
TEMP += A[L + I, J] * X[IX]
IX -= INCX
X[JX] = TEMP
JX -= INCX
else:
if INCX == 1:
for J in range(N):
TEMP = X[J]
L = 1 - J
if NOUNIT:
TEMP = TEMP * A[1, J]
for I in range(J, min(N, J + K)):
TEMP += A[L + I, J] * X[I]
X[J] = TEMP
else:
JX = KX
for J in range(N):
TEMP = X[JX]
KX += INCX
IX = KX
L = 1 - J
if NOUNIT:
TEMP = TEMP * A[1, J]
for I in range(J, min(N, J + K)):
TEMP += A[L + I, J] * X[IX]
IX += INCX
X[JX] = TEMP
JX += INCX
def DSPMV(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY):
#
# -- Reference BLAS level2 routine (version 3.7.0) --
# -- Reference BLAS is a software package provided by Univ. of Tennessee, --
# -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
# December 2016
#
# .. Scalar Arguments ..
# DOUBLE PRECISION ALPHA,BETA
# INTEGER INCX,INCY,N
# CHARACTER UPLO
# ..
# .. Array Arguments ..
# DOUBLE PRECISION AP(*),X(*),Y(*)
# ..
#
# =====================================================================
#
# .. Parameters ..
# DOUBLE PRECISION ONE,ZERO
# PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
# ..
# .. Local Scalars ..
# DOUBLE PRECISION TEMP1,TEMP2
# INTEGER I,INFO,IX,IY,J,JX,JY,K,KK,KX,KY
# ..
# .. External Functions ..
# LOGICAL LSAME
# EXTERNAL LSAME
# ..
# .. External Subroutines ..
# EXTERNAL XERBLA
# ..
# Test the input parameters.
INFO = 0
if not lsame(UPLO, "U") and not lsame(UPLO, "L"):
INFO = 1
elif N < 0:
INFO = 2
elif INCX == 0:
INFO = 6
elif INCY == 0:
INFO = 9
if INFO != 0:
xerbla("DSPMV ", INFO)
return
# Quick return if possible.
if (N == 0) or ((ALPHA == 0) and (BETA == 1)):
return
#
# Set up the start points in X and Y.
#
if INCX > 0:
KX = 1
else:
KX = 1 - (N - 1) * INCX
if INCY > 0:
KY = 1
else:
KY = 1 - (N - 1) * INCY
#
# Start the operations. In this version the elements of the array AP
# are accessed sequentially with one pass through AP.
#
# First form y := beta*y.
if INCY > 0:
Y[: N * INCY : INCY] *= BETA
else:
Y[-(N - 1) * INCY :: INCY] *= BETA
if ALPHA == 0:
return
KK = 1
if lsame(UPLO, "U"):
#
# Form y when AP contains the upper triangle.
#
if (INCX == 1) and (INCY == 1):
for J in range(N):
TEMP1 = ALPHA * X[J]
TEMP2 = 0
K = KK
for I in range(J - 1):
Y[I] += TEMP1 * AP[K]
TEMP2 += AP[K] * X[I]
K += 1
Y[J] += TEMP1 * AP[KK + J - 1] + ALPHA * TEMP2
KK += J
else:
JX = KX
JY = KY
for J in range(N):
TEMP1 = ALPHA * X[JX]
TEMP2 = 0
IX = KX
IY = KY
for K in range(KK - 1, KK + J - 2):
Y[IY] += TEMP1 * AP[K]
TEMP2 += AP[K] * X[IX]
IX += INCX
IY += INCY
Y[JY] += TEMP1 * AP[KK + J - 1] + ALPHA * TEMP2
JX += INCX
JY += INCY
KK += J
else:
#
# Form y when AP contains the lower triangle.
#
if (INCX == 1) and (INCY == 1):
for J in range(N):
TEMP1 = ALPHA * X[J]
TEMP2 = 0
Y[J] += TEMP1 * AP[KK]
K = KK + 1
for I in range(J, N):
Y[I] += TEMP1 * AP[K]
TEMP2 += AP[K] * X[I]
K += 1
Y[J] += ALPHA * TEMP2
KK += N - J + 1
else:
JX = KX
JY = KY
for J in range(N):
TEMP1 = ALPHA * X[JX]
TEMP2 = 0
Y[JY] += TEMP1 * AP[KK]
IX = JX
IY = JY
for K in range(KK, KK + N - J):
IX += INCX
IY += INCY
Y[IY] += TEMP1 * AP[K]
TEMP2 += AP[K] * X[IX]
Y[JY] += ALPHA * TEMP2
JX += INCX
JY += INCY
KK += N - J + 1
def CHER(UPLO, N, ALPHA, X, INCX, A, LDA):
#
# -- Reference BLAS level2 routine (version 3.7.0) --
# -- Reference BLAS is a software package provided by Univ. of Tennessee, --
# -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
# December 2016
#
# .. Scalar Arguments ..
# REAL ALPHA
# INTEGER INCX,LDA,N
# CHARACTER UPLO
# ..
# .. Array Arguments ..
# COMPLEX A(LDA,*),X(*)
# ..
#
# =====================================================================
#
# .. Parameters ..
# COMPLEX ZERO
# PARAMETER (ZERO= (0.0E+0,0.0E+0))
# ..
# .. Local Scalars ..
# COMPLEX TEMP
# INTEGER I,INFO,IX,J,JX,KX
# ..
# .. External Functions ..
# LOGICAL LSAME
# EXTERNAL LSAME
# ..
# .. External Subroutines ..
# EXTERNAL XERBLA
# ..
# .. Intrinsic Functions ..
# INTRINSIC CONJG,MAX,REAL
# ..
# Test the input parameters.
INFO = 0
if not lsame(UPLO, "U") and not lsame(UPLO, "L"):
INFO = 1
elif N < 0:
INFO = 2
elif INCX == 0:
INFO = 5
elif LDA < max(1, N):
INFO = 7
if INFO != 0:
xerbla("CHER ", INFO)
return
# Quick return if possible.
if (N == 0) or (ALPHA == 0):
return
#
# Set the start point in X if the increment is not unity.
#
if INCX <= 0:
KX = 1 - (N - 1) * INCX
elif INCX != 1:
KX = 1
#
# Start the operations. In this version the elements of A are
# accessed sequentially with one pass through the triangular part
# of A.
#
if lsame(UPLO, "U"):
# Form A when A is stored in upper triangle.
if INCX == 1:
for J in range(N):
if X[J] != 0:
TEMP = ALPHA * (X[J]).conjugate()
for I in range(J - 1):
A[I, J] += X[I] * TEMP
A[J, J] = A[J, J] + (X[J] * TEMP).real
else:
A[J, J] = A[J, J].real
else:
JX = KX
for J in range(N):
if X[JX] != 0:
TEMP = ALPHA * (X[JX]).conjugate()
IX = KX
for I in range(J - 1):
A[I, J] += X[IX] * TEMP
IX += INCX
A[J, J] = A[J, J].real + (X[JX] * TEMP).real
else:
A[J, J] = A[J, J].real
JX += INCX
else:
# Form A when A is stored in lower triangle.
if INCX == 1:
for J in range(N):
if X[J] != 0:
TEMP = ALPHA * (X[J]).conjugate()
A[J, J] = A[J, J].real + (TEMP * X[J]).real
for I in range(J, N):
A[I, J] += X[I] * TEMP
else:
A[J, J] = A[J, J].real
else:
JX = KX
for J in range(N):
if X[JX] != 0:
TEMP = ALPHA * (X[JX]).conjugate()
A[J, J] = A[J, J].real + (TEMP * X[JX]).real
IX = JX
for I in range(J, N):
IX += INCX
A[I, J] += X[IX] * TEMP
else:
A[J, J] = A[J, J].real
JX += INCX
def SSBMV(UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, Y, INCY):
#
# -- Reference BLAS level2 routine (version 3.7.0) --
# -- Reference BLAS is a software package provided by Univ. of Tennessee, --
# -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
# December 2016
#
# .. Scalar Arguments ..
# REAL ALPHA,BETA
# INTEGER INCX,INCY,K,LDA,N
# CHARACTER UPLO
# ..
# .. Array Arguments ..
# REAL A(LDA,*),X(*),Y(*)
# ..
#
# =====================================================================
#
# .. Parameters ..
# REAL ONE,ZERO
# PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
# ..
# .. Local Scalars ..
# REAL TEMP1,TEMP2
# INTEGER I,INFO,IX,IY,J,JX,JY,KPLUS1,KX,KY,L
# ..
# .. External Functions ..
# LOGICAL LSAME
# EXTERNAL LSAME
# ..
# .. External Subroutines ..
# EXTERNAL XERBLA
# ..
# .. Intrinsic Functions ..
# INTRINSIC MAX,MIN
# ..
# Test the input parameters.
INFO = 0
if not lsame(UPLO, "U") and not lsame(UPLO, "L"):
INFO = 1
elif N < 0:
INFO = 2
elif K < 0:
INFO = 3
elif LDA < (K + 1):
INFO = 6
elif INCX == 0:
INFO = 8
elif INCY == 0:
INFO = 11
if INFO != 0:
xerbla("SSBMV ", INFO)
return
# Quick return if possible.
if (N == 0) or ((ALPHA == 0) and (BETA == 1)):
return
#
# Set up the start points in X and Y.
#
if INCX > 0:
KX = 1
else:
KX = 1 - (N - 1) * INCX
if INCY > 0:
KY = 1
else:
KY = 1 - (N - 1) * INCY
#
# Start the operations. In this version the elements of the array A
# are accessed sequentially with one pass through A.
#
# First form y := beta*y.
Y[slice_(N, INCY)] *= BETA
if ALPHA == 0:
return
if lsame(UPLO, "U"):
# Form y when upper triangle of A is stored.
KPLUS1 = K + 1
if (INCX == 1) and (INCY == 1):
for J in range(N):
TEMP1 = ALPHA * X[J]
TEMP2 = 0
L = KPLUS1 - J
for I in range(max(1, J - K) - 1, J - 1):
Y[I] += TEMP1 * A[L + I, J]
TEMP2 += A[L + I, J] * X[I]
Y[J] += TEMP1 * A[KPLUS1, J] + ALPHA * TEMP2
else:
JX = KX
JY = KY
for J in range(N):
TEMP1 = ALPHA * X[JX]
TEMP2 = 0
IX = KX
IY = KY
L = KPLUS1 - J
for I in range(max(1, J - K) - 1, J - 1):
Y[IY] += TEMP1 * A[L + I, J]
TEMP2 += A[L + I, J] * X[IX]
IX += INCX
IY += INCY
Y[JY] += TEMP1 * A[KPLUS1, J] + ALPHA * TEMP2
JX += INCX
JY += INCY
if J > K:
KX += INCX
KY += INCY
else:
# Form y when lower triangle of A is stored.
if (INCX == 1) and (INCY == 1):
for J in range(N):
TEMP1 = ALPHA * X[J]
TEMP2 = 0
Y[J] += TEMP1 * A[1, J]
L = 1 - J
for I in range(J, min(N, J + K)):
Y[I] += TEMP1 * A[L + I, J]
TEMP2 += A[L + I, J] * X[I]
Y[J] += ALPHA * TEMP2
else:
JX = KX
JY = KY
for J in range(N):
TEMP1 = ALPHA * X[JX]
TEMP2 = 0
Y[JY] += TEMP1 * A[1, J]
L = 1 - J
IX = JX
IY = JY
for I in range(J, min(N, J + K)):
IX += INCX
IY += INCY
Y[IY] += TEMP1 * A[L + I, J]
TEMP2 += A[L + I, J] * X[IX]
Y[JY] += ALPHA * TEMP2
JX += INCX
JY += INCY
def STRSM(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB):
#
# -- Reference BLAS level3 routine (version 3.7.0) --
# -- Reference BLAS is a software package provided by Univ. of Tennessee, --
# -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
# December 2016
#
# .. Scalar Arguments ..
# REAL ALPHA
# INTEGER LDA,LDB,M,N
# CHARACTER DIAG,SIDE,TRANSA,UPLO
# ..
# .. Array Arguments ..
# REAL A(LDA,*),B(LDB,*)
# ..
#
# =====================================================================
#
# .. External Functions ..
# LOGICAL LSAME
# EXTERNAL LSAME
# ..
# .. External Subroutines ..
# EXTERNAL XERBLA
# ..
# .. Intrinsic Functions ..
# INTRINSIC MAX
# ..
# .. Local Scalars ..
# REAL TEMP
# INTEGER I,INFO,J,K,NROWA
# LOGICAL LSIDE,NOUNIT,UPPER
# ..
# .. Parameters ..
# REAL ONE,ZERO
# PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
# ..
# Test the input parameters.
LSIDE = lsame(SIDE, "L")
if LSIDE:
NROWA = M
else:
NROWA = N
NOUNIT = lsame(DIAG, "N")
UPPER = lsame(UPLO, "U")
#
INFO = 0
if (not LSIDE) and (not lsame(SIDE, "R")):
INFO = 1
elif (not UPPER) and (not lsame(UPLO, "L")):
INFO = 2
elif ((not lsame(TRANSA, "N")) and (not lsame(TRANSA, "T"))
and (not lsame(TRANSA, "C"))):
INFO = 3
elif (not lsame(DIAG, "U")) and (not lsame(DIAG, "N")):
INFO = 4
elif M < 0:
INFO = 5
elif N < 0:
INFO = 6
elif LDA < max(1, NROWA):
INFO = 9
elif LDB < max(1, M):
INFO = 11
if INFO != 0:
xerbla("STRSM ", INFO)
return
# Quick return if possible.
if M == 0 or N == 0:
return
# And when alpha==zero.
if ALPHA == 0:
for J in range(N):
for I in range(M):
B[I, J] = 0
return
# Start the operations.
if LSIDE:
if lsame(TRANSA, "N"):
#
# Form B := alpha*inv( A )*B.
#
if UPPER:
for J in range(N):
if ALPHA != 1:
for I in range(M):
B[I, J] *= ALPHA
for K in range(M - 1, -1, -1):
if B[K, J] != 0:
if NOUNIT:
B[K, J] = B[K, J] / A[K, K]
for I in range(K - 1):
B[I, J] -= B[K, J] * A[I, K]
else:
for J in range(N):
if ALPHA != 1:
for I in range(M):
B[I, J] *= ALPHA
for K in range(M):
if B[K, J] != 0:
if NOUNIT:
B[K, J] = B[K, J] / A[K, K]
for I in range(K, M):
B[I, J] -= B[K, J] * A[I, K]
else:
#
# Form B := alpha*inv( A**T )*B.
#
if UPPER:
for J in range(N):
for I in range(M):
TEMP = ALPHA * B[I, J]
for K in range(I - 1):
TEMP -= A[K, I] * B[K, J]
if NOUNIT:
TEMP = TEMP / A[I, I]
B[I, J] = TEMP
else:
for J in range(N):
for I in range(M - 1, -1, -1):
TEMP = ALPHA * B[I, J]
for K in range(I, M):
TEMP -= A[K, I] * B[K, J]
if NOUNIT:
TEMP = TEMP / A[I, I]
B[I, J] = TEMP
else:
if lsame(TRANSA, "N"):
#
# Form B := alpha*B*inv( A ).
#
if UPPER:
for J in range(N):
if ALPHA != 1:
for I in range(M):
B[I, J] *= ALPHA
for K in range(J - 1):
if A[K, J] != 0:
for I in range(M):
B[I, J] -= A[K, J] * B[I, K]
if NOUNIT:
TEMP = 1 / A[J, J]
for I in range(M):
B[I, J] = TEMP * B[I, J]
else:
for J in range(N - 1, -1, -1):
if ALPHA != 1:
for I in range(M):
B[I, J] *= ALPHA
for K in range(J, N):
if A[K, J] != 0:
for I in range(M):
B[I, J] -= A[K, J] * B[I, K]
if NOUNIT:
TEMP = 1 / A[J, J]
for I in range(M):
B[I, J] = TEMP * B[I, J]
else:
#
# Form B := alpha*B*inv( A**T ).
#
if UPPER:
for K in range(N - 1, -1, -1):
if NOUNIT:
TEMP = 1 / A[K, K]
for I in range(M):
B[I, K] = TEMP * B[I, K]
for K in range(K - 1):
if A[J, K] != 0:
TEMP = A[J, K]
for I in range(M):
B[I, J] -= TEMP * B[I, K]
if ALPHA != 1:
for I in range(M):
B[I, K] = ALPHA * B[I, K]
else:
for K in range(N):
if NOUNIT:
TEMP = 1 / A[K, K]
for I in range(M):
B[I, K] = TEMP * B[I, K]
for J in range(K, N):
if A[J, K] != 0:
TEMP = A[J, K]
for I in range(M):
B[I, J] -= TEMP * B[I, K]
if ALPHA != 1:
for I in range(M):
B[I, K] = ALPHA * B[I, K]
def ZHER2(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA):
#
# -- Reference BLAS level2 routine (version 3.7.0) --
# -- Reference BLAS is a software package provided by Univ. of Tennessee, --
# -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
# December 2016
#
# .. Scalar Arguments ..
# COMPLEX*16 ALPHA
# INTEGER INCX,INCY,LDA,N
# CHARACTER UPLO
# ..
# .. Array Arguments ..
# COMPLEX*16 A(LDA,*),X(*),Y(*)
# ..
#
# =====================================================================
# Test the input parameters.
INFO = 0
if not lsame(UPLO, "U") and not lsame(UPLO, "L"):
INFO = 1
elif N < 0:
INFO = 2
elif INCX == 0:
INFO = 5
elif INCY == 0:
INFO = 7
elif LDA < max(1, N):
INFO = 9
if INFO != 0:
xerbla("ZHER2 ", INFO)
return
# Quick return if possible.
if (N == 0) or (ALPHA == 0):
return
#
# Set up the start points in X and Y if the increments are not both
# unity.
#
if (INCX != 1) or (INCY != 1):
if INCX > 0:
KX = 1
else:
KX = 1 - (N - 1) * INCX
if INCY > 0:
KY = 1
else:
KY = 1 - (N - 1) * INCY
JX = KX
JY = KY
#
# Start the operations. In this version the elements of A are
# accessed sequentially with one pass through the triangular part
# of A.
#
if lsame(UPLO, "U"):
#
# Form A when A is stored in the upper triangle.
#
if (INCX == 1) and (INCY == 1):
for J in range(N):
if (X[J] != 0) or (Y[J] != 0):
TEMP1 = ALPHA * (Y[J]).conjugate()
TEMP2 = (ALPHA * X[J]).conjugate()
for I in range(J - 1):
A[I, J] += X[I] * TEMP1 + Y[I] * TEMP2
A[J, J] = A[J, J].real + (X[J] * TEMP1 + Y[J] * TEMP2).real
else:
A[J, J] = A[J, J].real
else:
for J in range(N):
if (X[JX] != 0) or (Y[JY] != 0):
TEMP1 = ALPHA * Y[JY].conjugate()
TEMP2 = (ALPHA * X[JX]).conjugate()
IX = KX
IY = KY
for I in range(J - 1):
A[I, J] += X[IX] * TEMP1 + Y[IY] * TEMP2
IX += INCX
IY += INCY
A[J, J] = A[J, J].real + (X[JX] * TEMP1 + Y[JY] * TEMP2).real
else:
A[J, J] = A[J, J].real
JX += INCX
JY += INCY
else:
# Form A when A is stored in the lower triangle.
if (INCX == 1) and (INCY == 1):
for J in range(N):
if (X[J] != 0) or (Y[J] != 0):
TEMP1 = ALPHA * (Y[J]).conjugate()
TEMP2 = (ALPHA * X[J]).conjugate()
A[J, J] = A[J, J].real + (X[J] * TEMP1 + Y[J] * TEMP2).real
for I in range(J, N):
A[I, J] += X[I] * TEMP1 + Y[I] * TEMP2
else:
A[J, J] = A[J, J].real
else:
for J in range(N):
if (X[JX] != 0) or (Y[JY] != 0):
TEMP1 = ALPHA * Y[JY].conjugate()
TEMP2 = (ALPHA * X[JX]).conjugate()
A[J, J] = A[J, J].real + (X[JX] * TEMP1 + Y[JY] * TEMP2).real
IX = JX
IY = JY
for I in range(J, N):
IX += INCX
IY += INCY
A[I, J] += X[IX] * TEMP1 + Y[IY] * TEMP2
else:
A[J, J] = A[J, J].real
JX += INCX
JY += INCY
def CHEMV(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY):
#
# -- Reference BLAS level2 routine (version 3.7.0) --
# -- Reference BLAS is a software package provided by Univ. of Tennessee, --
# -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
# December 2016
#
# .. Scalar Arguments ..
# COMPLEX ALPHA,BETA
# INTEGER INCX,INCY,LDA,N
# CHARACTER UPLO
# ..
# .. Array Arguments ..
# COMPLEX A(LDA,*),X(*),Y(*)
# ..
#
# =====================================================================
#
# .. Parameters ..
# COMPLEX ONE
# PARAMETER (ONE= (1.0E+0,0.0E+0))
# COMPLEX ZERO
# PARAMETER (ZERO= (0.0E+0,0.0E+0))
# ..
# .. Local Scalars ..
# COMPLEX TEMP1,TEMP2
# INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY
# ..
# .. External Functions ..
# LOGICAL LSAME
# EXTERNAL LSAME
# ..
# .. External Subroutines ..
# EXTERNAL XERBLA
# ..
# .. Intrinsic Functions ..
# INTRINSIC CONJG,MAX,REAL
# ..
# Test the input parameters.
INFO = 0
if not lsame(UPLO, "U") and not lsame(UPLO, "L"):
INFO = 1
elif N < 0:
INFO = 2
elif LDA < max(1, N):
INFO = 5
elif INCX == 0:
INFO = 7
elif INCY == 0:
INFO = 10
if INFO != 0:
xerbla("CHEMV ", INFO)
return
# Quick return if possible.
if (N == 0) or ((ALPHA == 0) and (BETA == 1)):
return
#
# Set up the start points in X and Y.
#
if INCX > 0:
KX = 1
else:
KX = 1 - (N - 1) * INCX
if INCY > 0:
KY = 1
else:
KY = 1 - (N - 1) * INCY
#
# 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.
Y[slice_(N, INCY)] *= BETA
if ALPHA == 0:
return
if lsame(UPLO, "U"):
# Form y when A is stored in upper triangle.
if (INCX == 1) and (INCY == 1):
for J in range(N):
TEMP1 = ALPHA * X[J]
TEMP2 = 0
for I in range(J - 1):
Y[I] += TEMP1 * A[I, J]
TEMP2 += A[1, J].conjugate() * X[I]
Y[J] += TEMP1 * A[J, J].real + ALPHA * TEMP2
else:
JX = KX
JY = KY
for J in range(N):
TEMP1 = ALPHA * X[JX]
TEMP2 = 0
IX = KX
IY = KY
for I in range(J - 1):
Y[IY] += TEMP1 * A[I, J]
TEMP2 += A[1, J].conjugate() * X[IX]
IX += INCX
IY += INCY
Y[JY] += TEMP1 * A[J, J].real + ALPHA * TEMP2
JX += INCX
JY += INCY
else:
# Form y when A is stored in lower triangle.
if (INCX == 1) and (INCY == 1):
for J in range(N):
TEMP1 = ALPHA * X[J]
TEMP2 = 0
Y[J] += TEMP1 * A[J, J].real
for I in range(J, N):
Y[I] += TEMP1 * A[I, J]
TEMP2 += A[1, J].conjugate() * X[I]
Y[J] += ALPHA * TEMP2
else:
JX = KX
JY = KY
for J in range(N):
TEMP1 = ALPHA * X[JX]
TEMP2 = 0
Y[JY] += TEMP1 * A[J, J].real
IX = JX
IY = JY
for I in range(J, N):
IX += INCX
IY += INCY
Y[IY] += TEMP1 * A[I, J]
TEMP2 += A[1, J].conjugate() * X[IX]
Y[JY] += ALPHA * TEMP2
JX += INCX
JY += INCY
def CHEMM(SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC):
#
# -- Reference BLAS level3 routine (version 3.7.0) --
# -- Reference BLAS is a software package provided by Univ. of Tennessee, --
# -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
# December 2016
#
# .. Scalar Arguments ..
# COMPLEX ALPHA,BETA
# INTEGER LDA,LDB,LDC,M,N
# CHARACTER SIDE,UPLO
# ..
# .. Array Arguments ..
# COMPLEX A(LDA,*),B(LDB,*),C(LDC,*)
# ..
#
# =====================================================================
#
# Set NROWA as the number of rows of A.
#
if lsame(SIDE, "L"):
NROWA = M
else:
NROWA = N
UPPER = lsame(UPLO, "U")
# Test the input parameters.
INFO = 0
if (not lsame(SIDE, "L")) and (not lsame(SIDE, "R")):
INFO = 1
elif (not UPPER) and (not lsame(UPLO, "L")):
INFO = 2
elif M < 0:
INFO = 3
elif N < 0:
INFO = 4
elif LDA < max(1, NROWA):
INFO = 7
elif LDB < max(1, M):
INFO = 9
elif LDC < max(1, M):
INFO = 12
if INFO != 0:
xerbla("CHEMM ", INFO)
return
# Quick return if possible.
if (M == 0) or (N == 0) or ((ALPHA == 0) and (BETA == 1)):
return
# And when alpha==zero.
if ALPHA == 0:
if BETA == 0:
for J in range(N):
for I in range(M):
C[I, J] = 0
else:
for J in range(N):
for I in range(M):
C[I, J] *= BETA
return
# Start the operations.
if lsame(SIDE, "L"):
#
# Form C := alpha*A*B + beta*C.
#
if UPPER:
for J in range(N):
for I in range(M):
TEMP1 = ALPHA * B[I, J]
TEMP2 = 0
for K in range(I - 1):
C[K, J] = C[K, J] + TEMP1 * A[K, I]
TEMP2 += B[K, J] * A[K, I].conjugate()
if BETA == 0:
C[I, J] = TEMP1 * A[I, I].real + ALPHA * TEMP2
else:
C[I, J] *= BETA + TEMP1 * A[I, I].real + ALPHA * TEMP2
else:
for J in range(N):
for I in range(M - 1, -1, -1):
TEMP1 = ALPHA * B[I, J]
TEMP2 = 0
for K in range(I, M):
C[K, J] = C[K, J] + TEMP1 * A[K, I]
TEMP2 += B[K, J] * A[K, I].conjugate()
if BETA == 0:
C[I, J] = TEMP1 * A[I, I].real + ALPHA * TEMP2
else:
C[I, J] *= BETA + TEMP1 * A[I, I].real + ALPHA * TEMP2
else:
#
# Form C := alpha*B*A + beta*C.
#
for J in range(N):
TEMP1 = ALPHA * A[J, J].real
if BETA == 0:
for I in range(M):
C[I, J] = TEMP1 * B[I, J]
else:
for I in range(M):
C[I, J] *= BETA + TEMP1 * B[I, J]
for K in range(J - 1):
if UPPER:
TEMP1 = ALPHA * A[K, J]
else:
TEMP1 = ALPHA * A[J, K].conjugate()
for I in range(M):
C[I, J] += TEMP1 * B[I, K]
for K in range(J, N):
if UPPER:
TEMP1 = ALPHA * A[J, K].conjugate()
else:
TEMP1 = ALPHA * A[K, J]
for I in range(M):
C[I, J] += TEMP1 * B[I, K]
def SGEMM(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC):
#
# -- Reference BLAS level3 routine (version 3.7.0) --
# -- Reference BLAS is a software package provided by Univ. of Tennessee, --
# -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
# December 2016
#
# .. Scalar Arguments ..
# REAL ALPHA,BETA
# INTEGER K,LDA,LDB,LDC,M,N
# CHARACTER TRANSA,TRANSB
# ..
# .. Array Arguments ..
# REAL A(LDA,*),B(LDB,*),C(LDC,*)
# ..
#
# =====================================================================
#
# .. External Functions ..
# LOGICAL LSAME
# EXTERNAL LSAME
# ..
# .. External Subroutines ..
# EXTERNAL XERBLA
# ..
# .. Intrinsic Functions ..
# INTRINSIC MAX
# ..
# .. Local Scalars ..
# REAL TEMP
# INTEGER I,INFO,J,L,NCOLA,NROWA,NROWB
# LOGICAL NOTA,NOTB
# ..
# .. Parameters ..
# REAL ONE,ZERO
# PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
# ..
#
# Set NOTA and NOTB as true if A and B respectively are not
# transposed and set NROWA, NCOLA and NROWB as the number of rows
# and columns of A and the number of rows of B respectively.
#
NOTA = lsame(TRANSA, "N")
NOTB = lsame(TRANSB, "N")
if NOTA:
NROWA = M
else:
NROWA = K
if NOTB:
NROWB = K
else:
NROWB = N
# Test the input parameters.
INFO = 0
if (not NOTA) and (not lsame(TRANSA, "C")) and (not lsame(TRANSA, "T")):
INFO = 1
elif (not NOTB) and (not lsame(TRANSB, "C")) and (not lsame(TRANSB, "T")):
INFO = 2
elif M < 0:
INFO = 3
elif N < 0:
INFO = 4
elif K < 0:
INFO = 5
elif LDA < max(1, NROWA):
INFO = 8
elif LDB < max(1, NROWB):
INFO = 10
elif LDC < max(1, M):
INFO = 13
if INFO != 0:
xerbla("SGEMM ", INFO)
return
# Quick return if possible.
if (M == 0) or (N == 0) or (((ALPHA == 0) or (K == 0)) and (BETA == 1)):
return
#
# And if alpha==zero.
#
if ALPHA == 0:
if BETA == 0:
for J in range(N):
for I in range(M):
C[I, J] = 0
else:
for J in range(N):
for I in range(M):
C[I, J] *= BETA
return
# Start the operations.
if NOTB:
if NOTA:
#
# Form C := alpha*A*B + beta*C.
#
for J in range(N):
if BETA == 0:
for I in range(M):
C[I, J] = 0
elif BETA != 1:
for I in range(M):
C[I, J] *= BETA
for L in range(K):
TEMP = ALPHA * B[L, J]
for I in range(M):
C[I, J] += TEMP * A[I, L]
else:
#
# Form C := alpha*A**T*B + beta*C
#
for J in range(N):
for I in range(M):
TEMP = 0
for L in range(K):
TEMP += A[L, I] * B[L, J]
if BETA == 0:
C[I, J] = ALPHA * TEMP
else:
C[I, J] = ALPHA * TEMP + BETA * C[I, J]
else:
if NOTA:
#
# Form C := alpha*A*B**T + beta*C
#
for J in range(N):
if BETA == 0:
for I in range(M):
C[I, J] = 0
elif BETA != 1:
for I in range(M):
C[I, J] *= BETA
for L in range(K):
TEMP = ALPHA * B[J, L]
for I in range(M):
C[I, J] += TEMP * A[I, L]
else:
# Form C := alpha*A**T*B**T + beta*C
for J in range(N):
for I in range(M):
TEMP = 0
for L in range(K):
TEMP += A[L, I] * B[J, L]
if BETA == 0:
C[I, J] = ALPHA * TEMP
else:
C[I, J] = ALPHA * TEMP + BETA * C[I, J]
def ZHPR2(UPLO, N, ALPHA, X, INCX, Y, INCY, AP):
#
# -- Reference BLAS level2 routine (version 3.7.0) --
# -- Reference BLAS is a software package provided by Univ. of Tennessee, --
# -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
# December 2016
#
# .. Scalar Arguments ..
# COMPLEX*16 ALPHA
# INTEGER INCX,INCY,N
# CHARACTER UPLO
# ..
# .. Array Arguments ..
# COMPLEX*16 AP(*),X(*),Y(*)
# ..
#
# =====================================================================
#
# .. Parameters ..
# COMPLEX*16 ZERO
# PARAMETER (ZERO= (0.0D+0,0.0D+0))
# ..
# .. Local Scalars ..
# COMPLEX*16 TEMP1,TEMP2
# INTEGER I,INFO,IX,IY,J,JX,JY,K,KK,KX,KY
# ..
# .. External Functions ..
# LOGICAL LSAME
# EXTERNAL LSAME
# ..
# .. External Subroutines ..
# EXTERNAL XERBLA
# ..
# .. Intrinsic Functions ..
# INTRINSIC DBLE,DCONJG
# ..
# Test the input parameters.
INFO = 0
if not lsame(UPLO, "U") and not lsame(UPLO, "L"):
INFO = 1
elif N < 0:
INFO = 2
elif INCX == 0:
INFO = 5
elif INCY == 0:
INFO = 7
if INFO != 0:
xerbla("ZHPR2 ", INFO)
# Quick return if possible.
if (N == 0) or (ALPHA == 0):
return
#
# Set up the start points in X and Y if the increments are not both
# unity.
#
if (INCX != 1) or (INCY != 1):
if INCX > 0:
KX = 1
else:
KX = 1 - (N - 1) * INCX
if INCY > 0:
KY = 1
else:
KY = 1 - (N - 1) * INCY
JX = KX
JY = KY
#
# Start the operations. In this version the elements of the array AP
# are accessed sequentially with one pass through AP.
#
KK = 1
if lsame(UPLO, "U"):
#
# Form A when upper triangle is stored in AP.
#
if (INCX == 1) and (INCY == 1):
for J in range(N):
if (X[J] != 0) or (Y[J] != 0):
TEMP1 = ALPHA * (Y[J]).conjugate()
TEMP2 = (ALPHA * X[J]).conjugate()
K = KK
for I in range(J - 1):
AP[K] += X[I] * TEMP1 + Y[I] * TEMP2
K += 1
AP[KK + J - 1] = (
AP[KK + J - 1].real + (X[J] * TEMP1 + Y[J] * TEMP2).real
)
else:
AP[KK + J - 1] = AP[KK + J - 1].real
KK += J
else:
for J in range(N):
if (X[JX] != 0) or (Y[JY] != 0):
TEMP1 = ALPHA * Y[JY].conjugate()
TEMP2 = (ALPHA * X[JX]).conjugate()
IX = KX
IY = KY
for K in range(KK - 1, KK + J - 2):
AP[K] += X[IX] * TEMP1 + Y[IY] * TEMP2
IX += INCX
IY += INCY
AP[KK + J - 1] = (
AP[KK + J - 1].real + (X[JX] * TEMP1 + Y[JY] * TEMP2).real
)
else:
AP[KK + J - 1] = AP[KK + J - 1].real
JX += INCX
JY += INCY
KK += J
else:
#
# Form A when lower triangle is stored in AP.
#
if (INCX == 1) and (INCY == 1):
for J in range(N):
if (X[J] != 0) or (Y[J] != 0):
TEMP1 = ALPHA * (Y[J]).conjugate()
TEMP2 = (ALPHA * X[J]).conjugate()
AP[KK] = (AP[KK]).real + (X[J] * TEMP1 + Y[J] * TEMP2).real
K = KK + 1
for I in range(J, N):
AP[K] += X[I] * TEMP1 + Y[I] * TEMP2
K += 1
else:
AP[KK] = (AP[KK]).real
KK += N - J + 1
else:
for J in range(N):
if (X[JX] != 0) or (Y[JY] != 0):
TEMP1 = ALPHA * Y[JY].conjugate()
TEMP2 = (ALPHA * X[JX]).conjugate()
AP[KK] = (AP[KK]).real + (X[JX] * TEMP1 + Y[JY] * TEMP2).real
IX = JX
IY = JY
for K in range(KK, KK + N - J):
IX += INCX
IY += INCY
AP[K] += X[IX] * TEMP1 + Y[IY] * TEMP2
else:
AP[KK] = (AP[KK]).real
JX += INCX
JY += INCY
KK += N - J + 1
def SGEMV(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY):
#
# -- Reference BLAS level2 routine (version 3.7.0) --
# -- Reference BLAS is a software package provided by Univ. of Tennessee, --
# -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
# December 2016
#
# .. Scalar Arguments ..
# REAL ALPHA,BETA
# INTEGER INCX,INCY,LDA,M,N
# CHARACTER TRANS
# ..
# .. Array Arguments ..
# REAL A(LDA,*),X(*),Y(*)
# ..
#
# =====================================================================
# Test the input parameters.
#
INFO = 0
if not lsame(TRANS, "N") and not lsame(TRANS, "T") and not lsame(
TRANS, "C"):
INFO = 1
elif M < 0:
INFO = 2
elif N < 0:
INFO = 3
elif LDA < max(1, M):
INFO = 6
elif INCX == 0:
INFO = 8
elif INCY == 0:
INFO = 11
if INFO != 0:
xerbla("SGEMV ", INFO)
# Quick return if possible.
if (M == 0) or (N == 0) or ((ALPHA == 0) and (BETA == 1)):
return
#
# 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"):
LENX = N
LENY = M
else:
LENX = M
LENY = N
if INCX > 0:
KX = 1
else:
KX = 1 - (LENX - 1) * INCX
if INCY > 0:
KY = 1
else:
KY = 1 - (LENY - 1) * INCY
#
# Start the operations. In this version the elements of A are
# accessed sequentially with one pass through A.
#
# First form y := beta*y.
Y[slice_(LENY, INCY)] *= BETA
if ALPHA == 0:
return
if lsame(TRANS, "N"):
# Form y := alpha*A*x + y.
for J, JX in enumerate(range(N, INCX)):
Y[slice_(M, INCY)] += ALPHA * X[JX] * A[slice_(M, INCY), J]
else:
# Form y := alpha*A**T*x + y.
JY = KY
if INCX == 1:
for J in range(N):
TEMP = 0
for I in range(M):
TEMP += A[I, J] * X[I]
Y[JY] += ALPHA * TEMP
JY += INCY
else:
for J in range(N):
TEMP = 0
IX = KX
for I in range(M):
TEMP += A[I, J] * X[IX]
IX += INCX
Y[JY] += ALPHA * TEMP
JY += INCY
def ZSYR2K(UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC):
#
# -- Reference BLAS level3 routine (version 3.7.0) --
# -- Reference BLAS is a software package provided by Univ. of Tennessee, --
# -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
# December 2016
#
# .. Scalar Arguments ..
# COMPLEX*16 ALPHA,BETA
# INTEGER K,LDA,LDB,LDC,N
# CHARACTER TRANS,UPLO
# ..
# .. Array Arguments ..
# COMPLEX*16 A(LDA,*),B(LDB,*),C(LDC,*)
# ..
#
# =====================================================================
# Test the input parameters.
if lsame(TRANS, "N"):
NROWA = N
else:
NROWA = K
UPPER = lsame(UPLO, "U")
#
INFO = 0
if (not UPPER) and (not lsame(UPLO, "L")):
INFO = 1
elif (not lsame(TRANS, "N")) and +(not lsame(TRANS, "T")):
INFO = 2
elif N < 0:
INFO = 3
elif K < 0:
INFO = 4
elif LDA < max(1, NROWA):
INFO = 7
elif LDB < max(1, NROWA):
INFO = 9
elif LDC < max(1, N):
INFO = 12
if INFO != 0:
xerbla("ZSYR2K", INFO)
# Quick return if possible.
if (N == 0) or (((ALPHA == 0) or (K == 0)) and (BETA == 1)):
return
# And when alpha==zero.
if ALPHA == 0:
if UPPER:
if BETA == 0:
for J in range(N):
for I in range(J):
C[I, J] = 0
else:
for J in range(N):
for I in range(J):
C[I, J] *= BETA
else:
if BETA == 0:
for J in range(N):
for I in range(J - 1, N):
C[I, J] = 0
else:
for J in range(N):
for I in range(J - 1, N):
C[I, J] *= BETA
return
# Start the operations.
if lsame(TRANS, "N"):
#
# Form C := alpha*A*B**T + alpha*B*A**T + C.
#
if UPPER:
for J in range(N):
if BETA == 0:
for I in range(J):
C[I, J] = 0
elif BETA != 1:
for I in range(J):
C[I, J] *= BETA
for L in range(K):
if (A[J, L] != 0) or (B[J, L] != 0):
TEMP1 = ALPHA * B[J, L]
TEMP2 = ALPHA * A[J, L]
for I in range(J):
C[I, J] += A[I, L] * TEMP1 + B[I, L] * TEMP2
else:
for J in range(N):
if BETA == 0:
for I in range(J - 1, N):
C[I, J] = 0
elif BETA != 1:
for I in range(J - 1, N):
C[I, J] *= BETA
for L in range(K):
if (A[J, L] != 0) or (B[J, L] != 0):
TEMP1 = ALPHA * B[J, L]
TEMP2 = ALPHA * A[J, L]
for I in range(J - 1, N):
C[I, J] += A[I, L] * TEMP1 + B[I, L] * TEMP2
else:
#
# Form C := alpha*A**T*B + alpha*B**T*A + C.
#
if UPPER:
for J in range(N):
for I in range(J):
TEMP1 = 0
TEMP2 = 0
for L in range(K):
TEMP1 += A[L, I] * B[L, J]
TEMP2 += B[L, I] * A[L, J]
if BETA == 0:
C[I, J] = ALPHA * TEMP1 + ALPHA * TEMP2
else:
C[I, J] *= BETA + ALPHA * TEMP1 + ALPHA * TEMP2
else:
for J in range(N):
for I in range(J - 1, N):
TEMP1 = 0
TEMP2 = 0
for L in range(K):
TEMP1 += A[L, I] * B[L, J]
TEMP2 += B[L, I] * A[L, J]
if BETA == 0:
C[I, J] = ALPHA * TEMP1 + ALPHA * TEMP2
else:
C[I, J] *= BETA + ALPHA * TEMP1 + ALPHA * TEMP2
def SGBMV(TRANS, M, N, KL, KU, ALPHA, A, LDA, X, INCX, BETA, Y, INCY):
#
# -- Reference BLAS level2 routine (version 3.7.0) --
# -- Reference BLAS is a software package provided by Univ. of Tennessee, --
# -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
# December 2016
#
# .. Scalar Arguments ..
# REAL ALPHA,BETA
# INTEGER INCX,INCY,KL,KU,LDA,M,N
# CHARACTER TRANS
# ..
# .. Array Arguments ..
# REAL A(LDA,*),X(*),Y(*)
# ..
#
# =====================================================================
# Test the input parameters.
INFO = 0
if not lsame(TRANS, "N") and not lsame(TRANS, "T") and not lsame(TRANS, "C"):
INFO = 1
elif M < 0:
INFO = 2
elif N < 0:
INFO = 3
elif KL < 0:
INFO = 4
elif KU < 0:
INFO = 5
elif LDA < (KL + KU + 1):
INFO = 8
elif INCX == 0:
INFO = 10
elif INCY == 0:
INFO = 13
if INFO != 0:
xerbla("SGBMV ", INFO)
return
# Quick return if possible.
if (M == 0) or (N == 0) or ((ALPHA == 0) and (BETA == 1)):
return
#
# 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"):
LENX = N
LENY = M
else:
LENX = M
LENY = N
if INCX > 0:
KX = 1
else:
KX = 1 - (LENX - 1) * INCX
if INCY > 0:
KY = 1
else:
KY = 1 - (LENY - 1) * INCY
#
# Start the operations. In this version the elements of A are
# accessed sequentially with one pass through the band part of A.
#
# First form y := beta*y.
Y[slice_(LENY, INCY)] *= BETA
if ALPHA == 0:
return
KUP1 = KU + 1
if lsame(TRANS, "N"):
# Form y := alpha*A*x + y.
JX = KX
if INCY == 1:
for J in range(N):
TEMP = ALPHA * X[JX]
K = KUP1 - J
for I in range(max(1, J - KU) - 1, min(M, J + KL)):
Y[I] += TEMP * A[K + I, J]
JX += INCX
else:
for J in range(N):
TEMP = ALPHA * X[JX]
IY = KY
K = KUP1 - J
for I in range(max(1, J - KU) - 1, min(M, J + KL)):
Y[IY] += TEMP * A[K + I, J]
IY += INCY
JX += INCX
if J > KU:
KY += INCY
else:
# Form y := alpha*A**T*x + y.
JY = KY
if INCX == 1:
for J in range(N):
TEMP = 0
K = KUP1 - J
for I in range(max(1, J - KU) - 1, min(M, J + KL)):
TEMP += A[K + I, J] * X[I]
Y[JY] += ALPHA * TEMP
JY += INCY
else:
for J in range(N):
TEMP = 0
IX = KX
K = KUP1 - J
for I in range(max(1, J - KU) - 1, min(M, J + KL)):
TEMP += A[K + I, J] * X[IX]
IX += INCX
Y[JY] += ALPHA * TEMP
JY += INCY
if J > KU:
KX += INCX
def chpmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY):
#
# -- Reference BLAS level2 routine (version 3.7.0) --
# -- Reference BLAS is a software package provided by Univ. of Tennessee, --
# -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
# December 2016
#
# .. Scalar Arguments ..
# COMPLEX ALPHA,BETA
# INTEGER INCX,INCY,N
# CHARACTER UPLO
# ..
# .. Array Arguments ..
# COMPLEX AP(*),X(*),Y(*)
# ..
#
# =====================================================================
# Test the input parameters.
INFO = 0
if not lsame(UPLO, "U") and not lsame(UPLO, "L"):
INFO = 1
elif N < 0:
INFO = 2
elif INCX == 0:
INFO = 6
elif INCY == 0:
INFO = 9
if INFO != 0:
xerbla("CHPMV ", INFO)
# Quick return if possible.
if (N == 0) or ((ALPHA == 0) and (BETA == 1)):
return
# Set up the start points in X and Y.
if INCX > 0:
KX = 1
else:
KX = 1 - (N - 1) * INCX
if INCY > 0:
KY = 1
else:
KY = 1 - (N - 1) * INCY
# Start the operations. In this version the elements of the array AP
# are accessed sequentially with one pass through AP.
# First form y := beta*y.
if INCY > 0:
Y[: N * INCY : INCY] *= BETA
else:
Y[-(N - 1) * INCY :: INCY] *= BETA
if ALPHA == 0:
return
KK = 1
if lsame(UPLO, "U"):
# Form y when AP contains the upper triangle.
if (INCX == 1) and (INCY == 1):
for J in range(N):
TEMP1 = ALPHA * X[J]
TEMP2 = 0
K = KK
for I in range(J - 1):
Y[I] += TEMP1 * AP[K]
TEMP2 += AP[K].conjugate() * X[I]
K += 1
Y[J] += TEMP1 * AP[KK + J - 1].real + ALPHA * TEMP2
KK += J
else:
JX = KX
JY = KY
for J in range(N):
TEMP1 = ALPHA * X[JX]
TEMP2 = 0
IX = KX
IY = KY
for K in range(KK - 1, KK + J - 2):
Y[IY] += TEMP1 * AP[K]
TEMP2 += AP[K].conjugate() * X[IX]
IX += INCX
IY += INCY
Y[JY] += TEMP1 * AP[KK + J - 1].real + ALPHA * TEMP2
JX += INCX
JY += INCY
KK += J
else:
# Form y when AP contains the lower triangle.
if (INCX == 1) and (INCY == 1):
for J in range(N):
TEMP1 = ALPHA * X[J]
TEMP2 = 0
Y[J] += TEMP1 * (AP[KK]).real
K = KK + 1
for I in range(J, N):
Y[I] += TEMP1 * AP[K]
TEMP2 += AP[K].conjugate() * X[I]
K += 1
Y[J] += ALPHA * TEMP2
KK += N - J + 1
else:
JX = KX
JY = KY
for J in range(N):
TEMP1 = ALPHA * X[JX]
TEMP2 = 0
Y[JY] += TEMP1 * (AP[KK]).real
IX = JX
IY = JY
for K in range(KK, KK + N - J):
IX += INCX
IY += INCY
Y[IY] += TEMP1 * AP[K]
TEMP2 += AP[K].conjugate() * X[IX]
Y[JY] += ALPHA * TEMP2
JX += INCX
JY += INCY
KK += N - J + 1
def DTRMM(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB):
#
# -- Reference BLAS level3 routine (version 3.7.0) --
# -- Reference BLAS is a software package provided by Univ. of Tennessee, --
# -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
# December 2016
#
# .. Scalar Arguments ..
# DOUBLE PRECISION ALPHA
# INTEGER LDA,LDB,M,N
# CHARACTER DIAG,SIDE,TRANSA,UPLO
# ..
# .. Array Arguments ..
# DOUBLE PRECISION A(LDA,*),B(LDB,*)
# ..
#
# =====================================================================
# Test the input parameters.
LSIDE = lsame(SIDE, "L")
if LSIDE:
NROWA = M
else:
NROWA = N
NOUNIT = lsame(DIAG, "N")
UPPER = lsame(UPLO, "U")
#
INFO = 0
if (not LSIDE) and (not lsame(SIDE, "R")):
INFO = 1
elif (not UPPER) and (not lsame(UPLO, "L")):
INFO = 2
elif ((not lsame(TRANSA, "N")) and (not lsame(TRANSA, "T"))
and (not lsame(TRANSA, "C"))):
INFO = 3
elif (not lsame(DIAG, "U")) and (not lsame(DIAG, "N")):
INFO = 4
elif M < 0:
INFO = 5
elif N < 0:
INFO = 6
elif LDA < max(1, NROWA):
INFO = 9
elif LDB < max(1, M):
INFO = 11
if INFO != 0:
xerbla("DTRMM ", INFO)
# Quick return if possible.
if M == 0 or N == 0:
return
# And when alpha==zero.
if ALPHA == 0:
for J in range(N):
for I in range(M):
B[I, J] = 0
return
# Start the operations.
if LSIDE:
if lsame(TRANSA, "N"):
#
# Form B := alpha*A*B.
#
if UPPER:
for J in range(N):
for K in range(M):
if B[K, J] != 0:
TEMP = ALPHA * B[K, J]
for I in range(K - 1):
B[I, J] = B[I, J] + TEMP * A[I, K]
if NOUNIT:
TEMP = TEMP * A[K, K]
B[K, J] = TEMP
else:
for J in range(N):
for K in range(M - 1, -1, -1):
if B[K, J] != 0:
TEMP = ALPHA * B[K, J]
B[K, J] = TEMP
if NOUNIT:
B[K, J] = B[K, J] * A[K, K]
for I in range(K, M):
B[I, J] = B[I, J] + TEMP * A[I, K]
else:
#
# Form B := alpha*A**T*B.
#
if UPPER:
for J in range(N):
for I in range(M - 1, -1, -1):
TEMP = B[I, J]
if NOUNIT:
TEMP = TEMP * A[I, I]
for K in range(I - 1):
TEMP += A[K, I] * B[K, J]
B[I, J] = ALPHA * TEMP
else:
for J in range(N):
for I in range(M):
TEMP = B[I, J]
if NOUNIT:
TEMP = TEMP * A[I, I]
for K in range(I, M):
TEMP += A[K, I] * B[K, J]
B[I, J] = ALPHA * TEMP
else:
if lsame(TRANSA, "N"):
#
# Form B := alpha*B*A.
#
if UPPER:
for J in range(N - 1, -1, -1):
TEMP = ALPHA
if NOUNIT:
TEMP *= A[J, J]
for I in range(M):
B[I, J] = TEMP * B[I, J]
for K in range(J - 1):
if A[K, J] != 0:
TEMP = ALPHA * A[K, J]
for I in range(M):
B[I, J] = B[I, J] + TEMP * B[I, K]
else:
for J in range(N):
TEMP = ALPHA
if NOUNIT:
TEMP *= A[J, J]
for I in range(M):
B[I, J] = TEMP * B[I, J]
for K in range(J, N):
if A[K, J] != 0:
TEMP = ALPHA * A[K, J]
for I in range(M):
B[I, J] = B[I, J] + TEMP * B[I, K]
else:
#
# Form B := alpha*B*A**T.
#
if UPPER:
for K in range(N):
for K in range(K - 1):
if A[J, K] != 0:
TEMP = ALPHA * A[J, K]
for I in range(M):
B[I, J] = B[I, J] + TEMP * B[I, K]
TEMP = ALPHA
if NOUNIT:
TEMP = TEMP * A[K, K]
if TEMP != 1:
for I in range(M):
B[I, K] = TEMP * B[I, K]
else:
for K in range(N - 1, -1, -1):
for J in range(K, N):
if A[J, K] != 0:
TEMP = ALPHA * A[J, K]
for I in range(M):
B[I, J] = B[I, J] + TEMP * B[I, K]
TEMP = ALPHA
if NOUNIT:
TEMP = TEMP * A[K, K]
if TEMP != 1:
for I in range(M):
B[I, K] = TEMP * B[I, K]
def ZTPSV(UPLO, TRANS, DIAG, N, AP, X, INCX):
#
# -- Reference BLAS level2 routine (version 3.7.0) --
# -- Reference BLAS 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 INCX,N
# CHARACTER DIAG,TRANS,UPLO
# ..
# .. Array Arguments ..
# COMPLEX*16 AP(*),X(*)
# ..
#
# =====================================================================
# Test the input parameters.
INFO = 0
if not lsame(UPLO, "U") and not lsame(UPLO, "L"):
INFO = 1
elif not lsame(TRANS, "N") and not lsame(TRANS, "T") and not lsame(
TRANS, "C"):
INFO = 2
elif not lsame(DIAG, "U") and not lsame(DIAG, "N"):
INFO = 3
elif N < 0:
INFO = 4
elif INCX == 0:
INFO = 7
if INFO != 0:
xerbla("ZTPSV ", INFO)
# Quick return if possible.
if N == 0:
return
#
NOCONJ = lsame(TRANS, "T")
NOUNIT = lsame(DIAG, "N")
#
# Set up the start point in X if the increment is not unity. This
# will be ( N - 1 )*INCX too small for descending loops.
#
if INCX <= 0:
KX = 1 - (N - 1) * INCX
elif INCX != 1:
KX = 1
#
# Start the operations. In this version the elements of AP are
# accessed sequentially with one pass through AP.
#
if lsame(TRANS, "N"):
#
# Form x := inv( A )*x.
#
if lsame(UPLO, "U"):
KK = (N * (N + 1)) / 2
if INCX == 1:
for J in range(N - 1, -1, -1):
if X[J] != 0:
if NOUNIT:
X[J] = X[J] / AP[KK]
TEMP = X[J]
K = KK - 1
for I in range(J - 2, -1, -1):
X[I] -= TEMP * AP[K]
K -= 1
KK -= J
else:
JX = KX + (N - 1) * INCX
for J in range(N - 1, -1, -1):
if X[JX] != 0:
if NOUNIT:
X[JX] = X[JX] / AP[KK]
TEMP = X[JX]
IX = JX
for K in range(KK - 2, KK - J - 2, -1):
IX -= INCX
X[IX] -= TEMP * AP[K]
JX -= INCX
KK -= J
else:
KK = 1
if INCX == 1:
for J in range(N):
if X[J] != 0:
if NOUNIT:
X[J] = X[J] / AP[KK]
TEMP = X[J]
K = KK + 1
for I in range(J, N):
X[I] -= TEMP * AP[K]
K += 1
KK += N - J + 1
else:
JX = KX
for J in range(N):
if X[JX] != 0:
if NOUNIT:
X[JX] = X[JX] / AP[KK]
TEMP = X[JX]
IX = JX
for K in range(KK, KK + N - J):
IX += INCX
X[IX] -= TEMP * AP[K]
JX += INCX
KK += N - J + 1
else:
# Form x := inv( A**T )*x or x := inv( A**H )*x.
if lsame(UPLO, "U"):
KK = 1
if INCX == 1:
for J in range(N):
TEMP = X[J]
K = KK
if NOCONJ:
for I in range(J - 1):
TEMP -= AP[K] * X[I]
K += 1
if NOUNIT:
TEMP = TEMP / AP[KK + J - 1]
else:
for I in range(J - 1):
TEMP -= AP[K].conjugate() * X[I]
K += 1
if NOUNIT:
TEMP = TEMP / AP[KK + J - 1].conjugate()
X[J] = TEMP
KK += J
else:
JX = KX
for J in range(N):
TEMP = X[JX]
IX = KX
if NOCONJ:
for K in range(KK - 1, KK + J - 2):
TEMP -= AP[K] * X[IX]
IX += INCX
if NOUNIT:
TEMP = TEMP / AP[KK + J - 1]
else:
for K in range(KK - 1, KK + J - 2):
TEMP -= AP[K].conjugate() * X[IX]
IX += INCX
if NOUNIT:
TEMP = TEMP / AP[KK + J - 1].conjugate()
X[JX] = TEMP
JX += INCX
KK += J
else:
KK = (N * (N + 1)) / 2
if INCX == 1:
for J in range(N - 1, -1, -1):
TEMP = X[J]
K = KK
if NOCONJ:
for I in range(N - 1, J - 1, -1):
TEMP -= AP[K] * X[I]
K -= 1
if NOUNIT:
TEMP = TEMP / AP[KK - N + J]
else:
for I in range(N - 1, J - 1, -1):
TEMP -= AP[K].conjugate() * X[I]
K -= 1
if NOUNIT:
TEMP = TEMP / (AP[KK - N + J]).conjugate()
X[J] = TEMP
KK -= N - J + 1
else:
KX += (N - 1) * INCX
JX = KX
for J in range(N - 1, -1, -1):
TEMP = X[JX]
IX = KX
if NOCONJ:
for K in range(KK - 1, KK - (N - (J + 1)) - 2, -1):
TEMP -= AP[K] * X[IX]
IX -= INCX
if NOUNIT:
TEMP = TEMP / AP[KK - N + J]
else:
for K in range(KK - 1, KK - (N - (J + 1)) - 2, -1):
TEMP -= AP[K].conjugate() * X[IX]
IX -= INCX
if NOUNIT:
TEMP = TEMP / (AP[KK - N + J]).conjugate()
X[JX] = TEMP
JX -= INCX
KK -= N - J + 1
def SSYRK(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC):
#
# -- Reference BLAS level3 routine (version 3.7.0) --
# -- Reference BLAS is a software package provided by Univ. of Tennessee, --
# -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
# December 2016
#
# .. Scalar Arguments ..
# REAL ALPHA,BETA
# INTEGER K,LDA,LDC,N
# CHARACTER TRANS,UPLO
# ..
# .. Array Arguments ..
# REAL A(LDA,*),C(LDC,*)
# ..
#
# =====================================================================
#
# .. External Functions ..
# LOGICAL LSAME
# EXTERNAL LSAME
# ..
# .. External Subroutines ..
# EXTERNAL XERBLA
# ..
# .. Intrinsic Functions ..
# INTRINSIC MAX
# ..
# .. Local Scalars ..
# REAL TEMP
# INTEGER I,INFO,J,L,NROWA
# LOGICAL UPPER
# ..
# .. Parameters ..
# REAL ONE,ZERO
# PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
# ..
# Test the input parameters.
if lsame(TRANS, "N"):
NROWA = N
else:
NROWA = K
UPPER = lsame(UPLO, "U")
#
INFO = 0
if (not UPPER) and (not lsame(UPLO, "L")):
INFO = 1
elif ((not lsame(TRANS, "N")) and (not lsame(TRANS, "T"))
and (not lsame(TRANS, "C"))):
INFO = 2
elif N < 0:
INFO = 3
elif K < 0:
INFO = 4
elif LDA < max(1, NROWA):
INFO = 7
elif LDC < max(1, N):
INFO = 10
if INFO != 0:
xerbla("SSYRK ", INFO)
# Quick return if possible.
if (N == 0) or (((ALPHA == 0) or (K == 0)) and (BETA == 1)):
return
# And when alpha==zero.
if ALPHA == 0:
if UPPER:
if BETA == 0:
for J in range(N):
for I in range(J):
C[I, J] = 0
else:
for J in range(N):
for I in range(J):
C[I, J] *= BETA
else:
if BETA == 0:
for J in range(N):
for I in range(J - 1, N):
C[I, J] = 0
else:
for J in range(N):
for I in range(J - 1, N):
C[I, J] *= BETA
return
# Start the operations.
if lsame(TRANS, "N"):
# Form C := alpha*A*A**T + beta*C.
if UPPER:
for J in range(N):
if BETA == 0:
for I in range(J):
C[I, J] = 0
elif BETA != 1:
for I in range(J):
C[I, J] *= BETA
for L in range(K):
if A[J, L] != 0:
TEMP = ALPHA * A[J, L]
for I in range(J):
C[I, J] += TEMP * A[I, L]
else:
for J in range(N):
if BETA == 0:
for I in range(J - 1, N):
C[I, J] = 0
elif BETA != 1:
for I in range(J - 1, N):
C[I, J] *= BETA
for L in range(K):
if A[J, L] != 0:
TEMP = ALPHA * A[J, L]
for I in range(J - 1, N):
C[I, J] += TEMP * A[I, L]
else:
# Form C := alpha*A**T*A + beta*C.
if UPPER:
for J in range(N):
for I in range(J):
TEMP = 0
for L in range(K):
TEMP += A[L, I] * A[L, J]
if BETA == 0:
C[I, J] = ALPHA * TEMP
else:
C[I, J] = ALPHA * TEMP + BETA * C[I, J]
else:
for J in range(N):
for I in range(J - 1, N):
C[I,
J] = ALPHA * (A[:K, I] * A[:K, J]).sum() + BETA * C[I, J]
def DSYMV(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY):
#
# -- Reference BLAS level2 routine (version 3.7.0) --
# -- Reference BLAS is a software package provided by Univ. of Tennessee, --
# -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
# December 2016
#
# .. Scalar Arguments ..
# DOUBLE PRECISION ALPHA,BETA
# INTEGER INCX,INCY,LDA,N
# CHARACTER UPLO
# ..
# .. Array Arguments ..
# DOUBLE PRECISION A(LDA,*),X(*),Y(*)
# ..
#
# =====================================================================
# Test the input parameters.
INFO = 0
if not lsame(UPLO, "U") and not lsame(UPLO, "L"):
INFO = 1
elif N < 0:
INFO = 2
elif LDA < max(1, N):
INFO = 5
elif INCX == 0:
INFO = 7
elif INCY == 0:
INFO = 10
if INFO != 0:
xerbla("DSYMV ", INFO)
return
# Quick return if possible.
if (N == 0) or ((ALPHA == 0) and (BETA == 1)):
return
#
# Set up the start points in X and Y.
#
if INCX > 0:
KX = 1
else:
KX = 1 - (N - 1) * INCX
if INCY > 0:
KY = 1
else:
KY = 1 - (N - 1) * INCY
#
# 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.
Y[slice_(N, INCY)] *= BETA
if ALPHA == 0:
return
if lsame(UPLO, "U"):
# Form y when A is stored in upper triangle.
if (INCX == 1) and (INCY == 1):
for J in range(N):
TEMP1 = ALPHA * X[J]
TEMP2 = 0
for I in range(J - 1):
Y[I] += TEMP1 * A[I, J]
TEMP2 += A[I, J] * X[I]
Y[J] += TEMP1 * A[J, J] + ALPHA * TEMP2
else:
JX = KX
JY = KY
for J in range(N):
TEMP1 = ALPHA * X[JX]
TEMP2 = 0
IX = KX
IY = KY
for I in range(J - 1):
Y[IY] += TEMP1 * A[I, J]
TEMP2 += A[I, J] * X[IX]
IX += INCX
IY += INCY
Y[JY] += TEMP1 * A[J, J] + ALPHA * TEMP2
JX += INCX
JY += INCY
else:
#
# Form y when A is stored in lower triangle.
#
if (INCX == 1) and (INCY == 1):
for J in range(N):
TEMP1 = ALPHA * X[J]
TEMP2 = 0
Y[J] += TEMP1 * A[J, J]
for I in range(J, N):
Y[I] += TEMP1 * A[I, J]
TEMP2 += A[I, J] * X[I]
Y[J] += ALPHA * TEMP2
else:
JX = KX
JY = KY
for J in range(N):
TEMP1 = ALPHA * X[JX]
TEMP2 = 0
Y[JY] += TEMP1 * A[J, J]
IX = JX
IY = JY
for I in range(J, N):
IX += INCX
IY += INCY
Y[IY] += TEMP1 * A[I, J]
TEMP2 += A[I, J] * X[IX]
Y[JY] += ALPHA * TEMP2
JX += INCX
JY += INCY
def DTRSV(UPLO, TRANS, DIAG, N, A, LDA, X, INCX):
#
# -- Reference BLAS level1 routine (version 3.7.0) --
# -- Reference BLAS 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 INCX,LDA,N
# CHARACTER DIAG,TRANS,UPLO
# ..
# .. Array Arguments ..
# DOUBLE PRECISION A(LDA,*),X(*)
# ..
#
# =====================================================================
#
# .. Parameters ..
# DOUBLE PRECISION ZERO
# PARAMETER (ZERO=0.0D+0)
# ..
# .. Local Scalars ..
# DOUBLE PRECISION TEMP
# INTEGER I,INFO,IX,J,JX,KX
# LOGICAL NOUNIT
# ..
# .. External Functions ..
# LOGICAL LSAME
# EXTERNAL LSAME
# ..
# .. External Subroutines ..
# EXTERNAL XERBLA
# ..
# .. Intrinsic Functions ..
# INTRINSIC MAX
# ..
# Test the input parameters.
INFO = 0
if not lsame(UPLO, "U") and not lsame(UPLO, "L"):
INFO = 1
elif not lsame(TRANS, "N") and not lsame(TRANS, "T") and not lsame(TRANS, "C"):
INFO = 2
elif not lsame(DIAG, "U") and not lsame(DIAG, "N"):
INFO = 3
elif N < 0:
INFO = 4
elif LDA < max(1, N):
INFO = 6
elif INCX == 0:
INFO = 8
if INFO != 0:
xerbla("DTRSV ", INFO)
return
# Quick return if possible.
if N == 0:
return
#
NOUNIT = lsame(DIAG, "N")
#
# Set up the start point in X if the increment is not unity. This
# will be ( N - 1 )*INCX too small for descending loops.
#
if INCX <= 0:
KX = 1 - (N - 1) * INCX
elif INCX != 1:
KX = 1
#
# Start the operations. In this version the elements of A are
# accessed sequentially with one pass through A.
#
if lsame(TRANS, "N"):
#
# Form x := inv( A )*x.
#
if lsame(UPLO, "U"):
if INCX == 1:
for J in range(N - 1, -1, -1):
if X[J] != 0:
if NOUNIT:
X[J] = X[J] / A[J, J]
TEMP = X[J]
for I in range(J - 2, -1, -1):
X[I] -= TEMP * A[I, J]
else:
JX = KX + (N - 1) * INCX
for J in range(N - 1, -1, -1):
if X[JX] != 0:
if NOUNIT:
X[JX] = X[JX] / A[J, J]
TEMP = X[JX]
IX = JX
for I in range(J - 2, -1, -1):
IX -= INCX
X[IX] -= TEMP * A[I, J]
JX -= INCX
else:
if INCX == 1:
for J in range(N):
if X[J] != 0:
if NOUNIT:
X[J] = X[J] / A[J, J]
TEMP = X[J]
for I in range(J, N):
X[I] -= TEMP * A[I, J]
else:
JX = KX
for J in range(N):
if X[JX] != 0:
if NOUNIT:
X[JX] = X[JX] / A[J, J]
TEMP = X[JX]
IX = JX
for I in range(J, N):
IX += INCX
X[IX] -= TEMP * A[I, J]
JX += INCX
else:
# Form x := inv( A**T )*x.
if lsame(UPLO, "U"):
if INCX == 1:
for J in range(N):
TEMP = X[J]
for I in range(J - 1):
TEMP -= A[I, J] * X[I]
if NOUNIT:
TEMP = TEMP / A[J, J]
X[J] = TEMP
else:
JX = KX
for J in range(N):
TEMP = X[JX]
IX = KX
for I in range(J - 1):
TEMP -= A[I, J] * X[IX]
IX += INCX
if NOUNIT:
TEMP = TEMP / A[J, J]
X[JX] = TEMP
JX += INCX
else:
if INCX == 1:
for J in range(N - 1, -1, -1):
TEMP = X[J]
for I in range(N - 1, J - 1, -1):
TEMP -= A[I, J] * X[I]
if NOUNIT:
TEMP = TEMP / A[J, J]
X[J] = TEMP
else:
KX += (N - 1) * INCX
JX = KX
for J in range(N - 1, -1, -1):
TEMP = X[JX]
IX = KX
for I in range(N - 1, J - 1, -1):
TEMP -= A[I, J] * X[IX]
IX -= INCX
if NOUNIT:
TEMP = TEMP / A[J, J]
X[JX] = TEMP
JX -= INCX
def CGEMM(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC):
#
# -- Reference BLAS level3 routine (version 3.7.0) --
# -- Reference BLAS is a software package provided by Univ. of Tennessee, --
# -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
# December 2016
#
# .. Scalar Arguments ..
# COMPLEX ALPHA,BETA
# INTEGER K,LDA,LDB,LDC,M,N
# CHARACTER TRANSA,TRANSB
# ..
# .. Array Arguments ..
# COMPLEX A(LDA,*),B(LDB,*),C(LDC,*)
# ..
#
# =====================================================================
#
# .. External Functions ..
# LOGICAL LSAME
# EXTERNAL LSAME
# ..
# .. External Subroutines ..
# EXTERNAL XERBLA
# ..
# .. Intrinsic Functions ..
# INTRINSIC CONJG,MAX
# ..
# .. Local Scalars ..
# COMPLEX TEMP
# INTEGER I,INFO,J,L,NCOLA,NROWA,NROWB
# LOGICAL CONJA,CONJB,NOTA,NOTB
# ..
# .. Parameters ..
# COMPLEX ONE
# PARAMETER (ONE= (1.0E+0,0.0E+0))
# COMPLEX ZERO
# PARAMETER (ZERO= (0.0E+0,0.0E+0))
# ..
#
# Set NOTA and NOTB as true if A and B respectively are not
# conjugated or transposed, set CONJA and CONJB as true if A and
# B respectively are to be transposed but not conjugated and set
# NROWA, NCOLA and NROWB as the number of rows and columns of A
# and the number of rows of B respectively.
#
NOTA = lsame(TRANSA, "N")
NOTB = lsame(TRANSB, "N")
CONJA = lsame(TRANSA, "C")
CONJB = lsame(TRANSB, "C")
if NOTA:
NROWA = M
else:
NROWA = K
if NOTB:
NROWB = K
else:
NROWB = N
# Test the input parameters.
INFO = 0
if (not NOTA) and (not CONJA) and (not lsame(TRANSA, "T")):
INFO = 1
elif (not NOTB) and (not CONJB) and (not lsame(TRANSB, "T")):
INFO = 2
elif M < 0:
INFO = 3
elif N < 0:
INFO = 4
elif K < 0:
INFO = 5
elif LDA < max(1, NROWA):
INFO = 8
elif LDB < max(1, NROWB):
INFO = 10
elif LDC < max(1, M):
INFO = 13
if INFO != 0:
xerbla("CGEMM ", INFO)
return
# Quick return if possible.
if (M == 0) or (N == 0) or (((ALPHA == 0) or (K == 0)) and (BETA == 1)):
return
# And when alpha==zero.
if ALPHA == 0:
C[:M, :N] *= BETA
return
# Start the operations.
if NOTB:
if NOTA:
# Form C := alpha*A*B + beta*C.
for J in range(N):
if BETA == 0:
C[:M, J] = 0
elif BETA != 1:
C[:M, J] *= BETA
for L in range(K):
TEMP = ALPHA * B[L, J]
C[:M, J] += TEMP * A[:M, L]
elif CONJA:
# Form C := alpha*A**H*B + beta*C.
for J in range(N):
for I in range(M):
TEMP = 0
for L in range(K):
TEMP += A[L, I].conjugate() * B[L, J]
if BETA == 0:
C[I, J] = ALPHA * TEMP
else:
C[I, J] = ALPHA * TEMP + BETA * C[I, J]
else:
# Form C := alpha*A**T*B + beta*C
for J in range(N):
for I in range(M):
TEMP = 0
for L in range(K):
TEMP += A[L, I] * B[L, J]
if BETA == 0:
C[I, J] = ALPHA * TEMP
else:
C[I, J] = ALPHA * TEMP + BETA * C[I, J]
elif NOTA:
if CONJB:
# Form C := alpha*A*B**H + beta*C.
for J in range(N):
if BETA == 0:
for I in range(M):
C[I, J] = 0
elif BETA != 1:
for I in range(M):
C[I, J] *= BETA
for L in range(K):
TEMP = ALPHA * B[J, L].conjugate()
for I in range(M):
C[I, J] += TEMP * A[I, L]
else:
# Form C := alpha*A*B**T + beta*C
for J in range(N):
if BETA == 0:
C[:M, J] = 0
elif BETA != 1:
C[:M, J] *= BETA
for L in range(K):
C[:M, J] += ALPHA * B[J, L] * A[:M, L]
elif CONJA:
if CONJB:
# Form C := alpha*A**H*B**H + beta*C.
for J in range(N):
for I in range(M):
C[I, J] = (
ALPHA *
(A[:K, I].conjugate() * B[J, :K].conjugate()).sum() +
BETA * C[I, J])
else:
# Form C := alpha*A**H*B**T + beta*C
for J in range(N):
for I in range(M):
C[I,
J] = (ALPHA * (A[:K, I].conjugate() * B[J, :K]).sum() +
BETA * C[I, J])
else:
if CONJB:
# Form C := alpha*A**T*B**H + beta*C
for J in range(N):
for I in range(M):
C[I,
J] = (ALPHA * (A[:K, I] * B[J, :K].conjugate()).sum() +
BETA * C[I, J])
else:
# Form C := alpha*A**T*B**T + beta*C
for J in range(N):
for I in range(M):
C[I,
J] = ALPHA * (A[:K, I] * B[J, :K]).sum() + BETA * C[I, J]
def cherk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC):
#
# -- Reference BLAS level3 routine (version 3.7.0) --
# -- Reference BLAS is a software package provided by Univ. of Tennessee, --
# -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
# December 2016
#
# .. Scalar Arguments ..
# REAL ALPHA,BETA
# INTEGER K,LDA,LDC,N
# CHARACTER TRANS,UPLO
# ..
# .. Array Arguments ..
# COMPLEX A(LDA,*),C(LDC,*)
# ..
#
# =====================================================================
# Test the input parameters.
if lsame(TRANS, "N"):
NROWA = N
else:
NROWA = K
UPPER = lsame(UPLO, "U")
INFO = 0
if (not UPPER) and (not lsame(UPLO, "L")):
INFO = 1
elif (not lsame(TRANS, "N")) and (not lsame(TRANS, "C")):
INFO = 2
elif N < 0:
INFO = 3
elif K < 0:
INFO = 4
elif LDA < max(1, NROWA):
INFO = 7
elif LDC < max(1, N):
INFO = 10
if INFO != 0:
xerbla("CHERK ", INFO)
return
# Quick return if possible.
if (N == 0) or (((ALPHA == 0) or (K == 0)) and (BETA == 1)):
return
# And when alpha==zero.
if ALPHA == 0:
if UPPER:
if BETA == 0:
for J in range(N):
for I in range(J):
C[I, J] = 0
else:
for J in range(N):
for I in range(J - 1):
C[I, J] *= BETA
C[J, J] = BETA * C[J, J].real
else:
if BETA == 0:
for J in range(N):
for I in range(J - 1, N):
C[I, J] = 0
else:
for J in range(N):
C[J, J] = BETA * C[J, J].real
for I in range(J, N):
C[I, J] *= BETA
return
# Start the operations.
if lsame(TRANS, "N"):
# Form C := alpha*A*A**H + beta*C.
if UPPER:
for J in range(N):
if BETA == 0:
for I in range(J):
C[I, J] = 0
elif BETA != 1:
for I in range(J - 1):
C[I, J] *= BETA
C[J, J] = BETA * C[J, J].real
else:
C[J, J] = C[J, J].real
for L in range(K):
if A[J, L] != 0:
TEMP = ALPHA * A[J, L].conjugate()
for I in range(J - 1):
C[I, J] += TEMP * A[I, L]
C[J, J] = C[J, J].real + (TEMP * A[I, L]).real
else:
for J in range(N):
if BETA == 0:
for I in range(J - 1, N):
C[I, J] = 0
elif BETA != 1:
C[J, J] = BETA * C[J, J].real
for I in range(J, N):
C[I, J] *= BETA
else:
C[J, J] = C[J, J].real
for L in range(K):
if A[J, L] != 0:
TEMP = ALPHA * A[J, L].conjugate()
C[J, J] = C[J, J].real + (TEMP * A[J, L]).real
for I in range(J, N):
C[I, J] += TEMP * A[I, L]
else:
# Form C := alpha*A**H*A + beta*C.
if UPPER:
for J in range(N):
for I in range(J - 1):
TEMP = 0
for L in range(K):
TEMP += A[L, I].conjugate() * A[L, J]
if BETA == 0:
C[I, J] = ALPHA * TEMP
else:
C[I, J] = ALPHA * TEMP + BETA * C[I, J]
RTEMP = 0
for L in range(K):
RTEMP = RTEMP + A[L, J].conjugate() * A[L, J]
if BETA == 0:
C[J, J] = ALPHA * RTEMP
else:
C[J, J] = ALPHA * RTEMP + BETA * C[J, J].real
else:
for J in range(N):
RTEMP = 0
for L in range(K):
RTEMP = RTEMP + A[L, J].conjugate() * A[L, J]
if BETA == 0:
C[J, J] = ALPHA * RTEMP
else:
C[J, J] = ALPHA * RTEMP + BETA * C[J, J].real
for I in range(J, N):
TEMP = 0
for L in range(K):
TEMP += A[L, I].conjugate() * A[L, J]
if BETA == 0:
C[I, J] = ALPHA * TEMP
else:
C[I, J] = ALPHA * TEMP + BETA * C[I, J]
def ZTRSM(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB):
#
# -- Reference BLAS level3 routine (version 3.7.0) --
# -- Reference BLAS is a software package provided by Univ. of Tennessee, --
# -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
# December 2016
#
# .. Scalar Arguments ..
# COMPLEX*16 ALPHA
# INTEGER LDA,LDB,M,N
# CHARACTER DIAG,SIDE,TRANSA,UPLO
# ..
# .. Array Arguments ..
# COMPLEX*16 A(LDA,*),B(LDB,*)
# ..
#
# =====================================================================
# Test the input parameters.
LSIDE = lsame(SIDE, "L")
if LSIDE:
NROWA = M
else:
NROWA = N
NOCONJ = lsame(TRANSA, "T")
NOUNIT = lsame(DIAG, "N")
UPPER = lsame(UPLO, "U")
INFO = 0
if (not LSIDE) and (not lsame(SIDE, "R")):
INFO = 1
elif (not UPPER) and (not lsame(UPLO, "L")):
INFO = 2
elif ((not lsame(TRANSA, "N")) and (not lsame(TRANSA, "T"))
and (not lsame(TRANSA, "C"))):
INFO = 3
elif (not lsame(DIAG, "U")) and (not lsame(DIAG, "N")):
INFO = 4
elif M < 0:
INFO = 5
elif N < 0:
INFO = 6
elif LDA < max(1, NROWA):
INFO = 9
elif LDB < max(1, M):
INFO = 11
if INFO != 0:
xerbla("ZTRSM ", INFO)
return
# Quick return if possible.
if M == 0 or N == 0:
return
# And when alpha==zero.
if ALPHA == 0:
for J in range(N):
for I in range(M):
B[I, J] = 0
return
# Start the operations.
if LSIDE:
if lsame(TRANSA, "N"):
#
# Form B := alpha*inv( A )*B.
#
if UPPER:
for J in range(N):
if ALPHA != 1:
for I in range(M):
B[I, J] *= ALPHA
for K in range(M - 1, -1, -1):
if B[K, J] != 0:
if NOUNIT:
B[K, J] = B[K, J] / A[K, K]
for I in range(K - 1):
B[I, J] -= B[K, J] * A[I, K]
else:
for J in range(N):
if ALPHA != 1:
for I in range(M):
B[I, J] *= ALPHA
for K in range(M):
if B[K, J] != 0:
if NOUNIT:
B[K, J] = B[K, J] / A[K, K]
for I in range(K, M):
B[I, J] -= B[K, J] * A[I, K]
else:
# Form B := alpha*inv( A**T )*B
# or B := alpha*inv( A**H )*B.
if UPPER:
for J in range(N):
for I in range(M):
TEMP = ALPHA * B[I, J]
if NOCONJ:
for K in range(I - 1):
TEMP -= A[K, I] * B[K, J]
if NOUNIT:
TEMP = TEMP / A[I, I]
else:
for K in range(I - 1):
TEMP -= A[K, I].conjugate() * B[K, J]
if NOUNIT:
TEMP = TEMP / A[I, I].conjugate()
B[I, J] = TEMP
else:
for J in range(N):
for I in range(M - 1, -1, -1):
TEMP = ALPHA * B[I, J]
if NOCONJ:
for K in range(I, M):
TEMP -= A[K, I] * B[K, J]
if NOUNIT:
TEMP = TEMP / A[I, I]
else:
for K in range(I, M):
TEMP -= A[K, I].conjugate() * B[K, J]
if NOUNIT:
TEMP = TEMP / A[I, I].conjugate()
B[I, J] = TEMP
else:
if lsame(TRANSA, "N"):
# Form B := alpha*B*inv( A ).
if UPPER:
for J in range(N):
if ALPHA != 1:
for I in range(M):
B[I, J] *= ALPHA
for K in range(J - 1):
if A[K, J] != 0:
for I in range(M):
B[I, J] -= A[K, J] * B[I, K]
if NOUNIT:
TEMP = 1 / A[J, J]
for I in range(M):
B[I, J] = TEMP * B[I, J]
else:
for J in range(N - 1, -1, -1):
if ALPHA != 1:
for I in range(M):
B[I, J] *= ALPHA
for K in range(J, N):
if A[K, J] != 0:
for I in range(M):
B[I, J] -= A[K, J] * B[I, K]
if NOUNIT:
TEMP = 1 / A[J, J]
for I in range(M):
B[I, J] = TEMP * B[I, J]
else:
# Form B := alpha*B*inv( A**T )
# or B := alpha*B*inv( A**H ).
if UPPER:
for K in range(N - 1, -1, -1):
if NOUNIT:
if NOCONJ:
TEMP = 1 / A[K, K]
else:
TEMP = 1 / A[K, K].conjugate()
for I in range(M):
B[I, K] = TEMP * B[I, K]
for K in range(K - 1):
if A[J, K] != 0:
if NOCONJ:
TEMP = A[J, K]
else:
TEMP = A[J, K].conjugate()
for I in range(M):
B[I, J] -= TEMP * B[I, K]
if ALPHA != 1:
for I in range(M):
B[I, K] = ALPHA * B[I, K]
else:
for K in range(N):
if NOUNIT:
if NOCONJ:
TEMP = 1 / A[K, K]
else:
TEMP = 1 / A[K, K].conjugate()
for I in range(M):
B[I, K] = TEMP * B[I, K]
for J in range(K, N):
if A[J, K] != 0:
if NOCONJ:
TEMP = A[J, K]
else:
TEMP = A[J, K].conjugate()
for I in range(M):
B[I, J] -= TEMP * B[I, K]
if ALPHA != 1:
for I in range(M):
B[I, K] = ALPHA * B[I, K]
