def chpr(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 .. # REAL ALPHA # INTEGER INCX,N # CHARACTER UPLO # .. # .. Array Arguments .. # COMPLEX 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("CHPR ", 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. if lsame(UPLO, "U"): # Form A when upper triangle is stored in AP. if INCX == 1: KK = 1 for J in range(N): JM1 = J - 1 if X[J] != 0: TEMP = ALPHA * (X[J]).conjugate() AP[KK:KK + JM1] += X[:JM1] * TEMP # Diagonal term AP[KK + JM1] = AP[KK + JM1].real + (X[J] * TEMP).real else: AP[KK + JM1] = AP[KK + JM1].real KK += J else: KK = 1 JX = KX for J in range(N): JM1 = J - 1 if X[JX] != 0: TEMP = ALPHA * (X[JX]).conjugate() IX = KX for K in range(KK - 1, KK + JM1 - 1): AP[K] += X[IX] * TEMP IX += INCX AP[KK + JM1] = AP[KK + JM11].real + (X[JX] * TEMP).real else: AP[KK + JM1] = AP[KK + JM1].real JX += INCX KK += J else: # Form A when lower triangle is stored in AP. if INCX == 1: KK = 1 for J in range(N): if X[J] != 0: TEMP = ALPHA * (X[J]).conjugate() AP[KK] = (AP[KK]).real + (TEMP * X[J]).real K = KK + 1 for I in range(J, N): AP[K] += X[I] * TEMP K += 1 else: AP[KK] = (AP[KK]).real KK += N - J + 1 else: KK = 1 JX = KX for J in range(N): if X[JX] != 0: TEMP = ALPHA * (X[JX]).conjugate() AP[KK] = (AP[KK]).real + (TEMP * X[JX]).real IX = JX for K in range(KK, KK + N - J): IX += INCX AP[K] += X[IX] * TEMP else: AP[KK] = (AP[KK]).real 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 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 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 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 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 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 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 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 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 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 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 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 ZHER2K(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 # DOUBLE PRECISION BETA # INTEGER K,LDA,LDB,LDC,N # CHARACTER TRANS,UPLO # .. # .. Array Arguments .. # COMPLEX*16 A(LDA,*),B(LDB,*),C(LDC,*) # .. # # ===================================================================== # # .. External Functions .. # LOGICAL LSAME # EXTERNAL LSAME # .. # .. External Subroutines .. # EXTERNAL XERBLA # .. # .. Intrinsic Functions .. # INTRINSIC DBLE,DCONJG,MAX # .. # .. Local Scalars .. # COMPLEX*16 TEMP1,TEMP2 # INTEGER I,INFO,J,L,NROWA # LOGICAL UPPER # .. # .. Parameters .. # DOUBLE PRECISION ONE # PARAMETER (ONE=1.0D+0) # COMPLEX*16 ZERO # PARAMETER (ZERO= (0.0D+0,0.0D+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, "C")): 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("ZHER2K", 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*B**H + conjg( alpha )*B*A**H + # 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) or (B[J, L] != 0): TEMP1 = ALPHA * B[J, L].conjugate() TEMP2 = (ALPHA * A[J, L]).conjugate() for I in range(J - 1): C[I, J] += A[I, L] * TEMP1 + B[I, L] * TEMP2 C[J, J] = (C[J, J].real + (A[J, L] * TEMP1 + B[J, L] * TEMP2).real) 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, N): 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) or (B[J, L] != 0): TEMP1 = ALPHA * B[J, L].conjugate() TEMP2 = (ALPHA * A[J, L]).conjugate() for I in range(J, N): C[I, J] += A[I, L] * TEMP1 + B[I, L] * TEMP2 C[J, J] = (C[J, J].real + (A[J, L] * TEMP1 + B[J, L] * TEMP2).real) else: # # Form C := alpha*A**H*B + conjg( alpha )*B**H*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].conjugate() * B[L, J] TEMP2 += (B[L, I]).conjugate() * A[L, J] if I == J: if BETA == 0: C[J, J] = (ALPHA * TEMP1 + (ALPHA).conjugate() * TEMP2).real else: C[J, J] = (BETA * C[J, J].real + (ALPHA * TEMP1 + (ALPHA).conjugate() * TEMP2).real) else: if BETA == 0: C[I, J] = ALPHA * TEMP1 + (ALPHA).conjugate() * TEMP2 else: C[I, J] = (BETA * C[I, J] + ALPHA * TEMP1 + (ALPHA).conjugate() * 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].conjugate() * B[L, J] TEMP2 += (B[L, I]).conjugate() * A[L, J] if I == J: if BETA == 0: C[J, J] = (ALPHA * TEMP1 + (ALPHA).conjugate() * TEMP2).real else: C[J, J] = (BETA * C[J, J].real + (ALPHA * TEMP1 + (ALPHA).conjugate() * TEMP2).real) else: if BETA == 0: C[I, J] = ALPHA * TEMP1 + (ALPHA).conjugate() * TEMP2 else: C[I, J] = (BETA * C[I, J] + ALPHA * TEMP1 + (ALPHA).conjugate() * TEMP2)
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 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 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]
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 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 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 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 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 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 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 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 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 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 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 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 STPMV(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 .. # REAL AP(*),X(*) # .. # # ===================================================================== # # .. Parameters .. # REAL ZERO # PARAMETER (ZERO=0.0E+0) # .. # .. Local Scalars .. # REAL TEMP # INTEGER I,INFO,IX,J,JX,K,KK,KX # LOGICAL NOUNIT # .. # .. 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 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("STPMV ", 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 AP are # accessed sequentially with one pass through AP. # if lsame(TRANS, "N"): # Form x:= A*x. if lsame(UPLO, "U"): KK = 1 if INCX == 1: for J in range(N): if X[J] != 0: TEMP = X[J] K = KK for I in range(J - 1): X[I] += TEMP * AP[K] K += 1 if NOUNIT: X[J] *= AP[KK + J - 1] KK += J else: JX = KX for J in range(N): if X[JX] != 0: TEMP = X[JX] IX = KX for K in range(KK - 1, KK + J - 2): X[IX] += TEMP * AP[K] IX += INCX if NOUNIT: X[JX] *= AP[KK + J - 1] JX += INCX KK += J else: KK = (N * (N + 1)) / 2 if INCX == 1: for J in range(N - 1, -1, -1): if X[J] != 0: TEMP = X[J] K = KK for I in range(N - 1, J - 1, -1): X[I] += TEMP * AP[K] K -= 1 if NOUNIT: X[J] *= AP[KK - N + J] KK -= N - J + 1 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 K in range(KK - 1, KK - (N - (J + 1)) - 2, -1): X[IX] += TEMP * AP[K] IX -= INCX if NOUNIT: X[JX] *= AP[KK - N + J] JX -= INCX KK -= N - J + 1 else: # # Form x := A**T*x. # if lsame(UPLO, "U"): KK = (N * (N + 1)) / 2 if INCX == 1: for J in range(N - 1, -1, -1): TEMP = X[J] if NOUNIT: TEMP = TEMP * AP[KK] K = KK - 1 for I in range(J - 2, -1, -1): TEMP += AP[K] * X[I] K -= 1 X[J] = TEMP KK -= J else: JX = KX + (N - 1) * INCX for J in range(N - 1, -1, -1): TEMP = X[JX] IX = JX if NOUNIT: TEMP = TEMP * AP[KK] for K in range(KK - 2, KK - J - 2, -1): IX -= INCX TEMP += AP[K] * X[IX] X[JX] = TEMP JX -= INCX KK -= J else: KK = 1 if INCX == 1: for J in range(N): TEMP = X[J] if NOUNIT: TEMP = TEMP * AP[KK] K = KK + 1 for I in range(J, N): TEMP += AP[K] * X[I] K += 1 X[J] = TEMP KK += N - J + 1 else: JX = KX for J in range(N): TEMP = X[JX] IX = JX if NOUNIT: TEMP = TEMP * AP[KK] for K in range(KK, KK + N - J): IX += INCX TEMP += AP[K] * X[IX] X[JX] = TEMP JX += INCX KK += N - J + 1