Compare commits
10
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
 thijssteel
|
7094cb0f7c | ||
|
thijssteel
|
7a2ecc24e5 | ||
|
thijssteel
|
b44c64faef | ||
|
thijssteel
|
a4c4a4eb52 | ||
|
thijssteel
|
0d9803a29c | ||
|
thijssteel
|
81be118bcb | ||
|
thijssteel
|
f57a792304 | ||
|
thijssteel
|
2bdd724ecf | ||
|
thijssteel
|
1a95ff9b67 | ||
|
thijssteel
|
5b521e6ccc |
@@ -75,12 +75,12 @@ jobs:
|
||||
- name: Install ninja-build tool
|
||||
uses: seanmiddleditch/gha-setup-ninja@16b940825621068d98711680b6c3ff92201f8fc0 # v3
|
||||
|
||||
- name: Use GCC-14 on MacOS
|
||||
- name: Use GCC-11 on MacOS
|
||||
if: ${{ matrix.os == 'macos-latest' }}
|
||||
run: >
|
||||
cmake -B build -G Ninja
|
||||
-D CMAKE_C_COMPILER="gcc-14"
|
||||
-D CMAKE_Fortran_COMPILER="gfortran-14"
|
||||
-D CMAKE_C_COMPILER="gcc-11"
|
||||
-D CMAKE_Fortran_COMPILER="gfortran-11"
|
||||
-D USE_FLAT_NAMESPACE:BOOL=ON
|
||||
|
||||
- name: Special flags for Windows
|
||||
@@ -237,4 +237,4 @@ jobs:
|
||||
fi
|
||||
done
|
||||
exit 0
|
||||
fi
|
||||
fi
|
||||
@@ -90,8 +90,8 @@ jobs:
|
||||
echo "DOCSDIR = ${{github.workspace}}/DOCS" >> make.inc
|
||||
- name: Alias for GCC compilers
|
||||
run: |
|
||||
sudo ln -s $(which gcc-14) /usr/local/bin/gcc
|
||||
sudo ln -s $(which gfortran-14) /usr/local/bin/gfortran
|
||||
sudo ln -s $(which gcc-11) /usr/local/bin/gcc
|
||||
sudo ln -s $(which gfortran-11) /usr/local/bin/gfortran
|
||||
- name: Install
|
||||
run: |
|
||||
make -s -j2 all
|
||||
|
||||
@@ -32,12 +32,12 @@ jobs:
|
||||
|
||||
steps:
|
||||
- name: "Checkout code"
|
||||
uses: actions/checkout@d632683dd7b4114ad314bca15554477dd762a938 # tag=v4.2.0
|
||||
uses: actions/checkout@c85c95e3d7251135ab7dc9ce3241c5835cc595a9 # v3.5.3
|
||||
with:
|
||||
persist-credentials: false
|
||||
|
||||
- name: "Run analysis"
|
||||
uses: ossf/scorecard-action@62b2cac7ed8198b15735ed49ab1e5cf35480ba46 # v2.4.0
|
||||
uses: ossf/scorecard-action@08b4669551908b1024bb425080c797723083c031 # v2.2.0
|
||||
with:
|
||||
results_file: results.sarif
|
||||
results_format: sarif
|
||||
@@ -59,7 +59,7 @@ jobs:
|
||||
# Upload the results as artifacts (optional). Commenting out will disable uploads of run results in SARIF
|
||||
# format to the repository Actions tab.
|
||||
- name: "Upload artifact"
|
||||
uses: actions/upload-artifact@b4b15b8c7c6ac21ea08fcf65892d2ee8f75cf882 # v4.4.3
|
||||
uses: actions/upload-artifact@0b7f8abb1508181956e8e162db84b466c27e18ce # v3.1.2
|
||||
with:
|
||||
name: SARIF file
|
||||
path: results.sarif
|
||||
@@ -67,6 +67,6 @@ jobs:
|
||||
|
||||
# Upload the results to GitHub's code scanning dashboard.
|
||||
- name: "Upload to code-scanning"
|
||||
uses: github/codeql-action/upload-sarif@662472033e021d55d94146f66f6058822b0b39fd # v3.27.0
|
||||
uses: github/codeql-action/upload-sarif@f9a7c6738f28efb36e31d49c53a201a9c5d6a476 # v2.14.2
|
||||
with:
|
||||
sarif_file: results.sarif
|
||||
|
||||
+2
-3
@@ -44,6 +44,5 @@ DOCS/man
|
||||
DOCS/explore-html
|
||||
output_err
|
||||
|
||||
# Mod files from compilation in SRC
|
||||
SRC/la_constants.mod
|
||||
SRC/la_xisnan.mod
|
||||
# Editor config files
|
||||
.vscode/
|
||||
@@ -82,15 +82,15 @@ set(ZBLAS2 zgemv.f zgbmv.f zhemv.f zhbmv.f zhpmv.f
|
||||
#---------------------------------------------------------
|
||||
# Level 3 BLAS
|
||||
#---------------------------------------------------------
|
||||
set(SBLAS3 sgemm.f ssymm.f ssyrk.f ssyr2k.f strmm.f strsm.f sgemmtr.f)
|
||||
set(SBLAS3 sgemm.f ssymm.f ssyrk.f ssyr2k.f strmm.f strsm.f)
|
||||
|
||||
set(CBLAS3 cgemm.f csymm.f csyrk.f csyr2k.f ctrmm.f ctrsm.f
|
||||
chemm.f cherk.f cher2k.f cgemmtr.f)
|
||||
chemm.f cherk.f cher2k.f)
|
||||
|
||||
set(DBLAS3 dgemm.f dsymm.f dsyrk.f dsyr2k.f dtrmm.f dtrsm.f dgemmtr.f)
|
||||
set(DBLAS3 dgemm.f dsymm.f dsyrk.f dsyr2k.f dtrmm.f dtrsm.f)
|
||||
|
||||
set(ZBLAS3 zgemm.f zsymm.f zsyrk.f zsyr2k.f ztrmm.f ztrsm.f
|
||||
zhemm.f zherk.f zher2k.f zgemmtr.f)
|
||||
zhemm.f zherk.f zher2k.f)
|
||||
|
||||
|
||||
set(SOURCES)
|
||||
|
||||
+4
-4
@@ -127,18 +127,18 @@ $(ZBLAS2): $(FRC)
|
||||
# Comment out the next 4 definitions if you already have
|
||||
# the Level 3 BLAS.
|
||||
#---------------------------------------------------------
|
||||
SBLAS3 = sgemm.o ssymm.o ssyrk.o ssyr2k.o strmm.o strsm.o sgemmtr.o
|
||||
SBLAS3 = sgemm.o ssymm.o ssyrk.o ssyr2k.o strmm.o strsm.o
|
||||
$(SBLAS3): $(FRC)
|
||||
|
||||
CBLAS3 = cgemm.o csymm.o csyrk.o csyr2k.o ctrmm.o ctrsm.o \
|
||||
chemm.o cherk.o cher2k.o cgemmtr.o
|
||||
chemm.o cherk.o cher2k.o
|
||||
$(CBLAS3): $(FRC)
|
||||
|
||||
DBLAS3 = dgemm.o dsymm.o dsyrk.o dsyr2k.o dtrmm.o dtrsm.o dgemmtr.o
|
||||
DBLAS3 = dgemm.o dsymm.o dsyrk.o dsyr2k.o dtrmm.o dtrsm.o
|
||||
$(DBLAS3): $(FRC)
|
||||
|
||||
ZBLAS3 = zgemm.o zsymm.o zsyrk.o zsyr2k.o ztrmm.o ztrsm.o \
|
||||
zhemm.o zherk.o zher2k.o zgemmtr.o
|
||||
zhemm.o zherk.o zher2k.o
|
||||
$(ZBLAS3): $(FRC)
|
||||
|
||||
ALLOBJ = $(SBLAS1) $(SBLAS2) $(SBLAS3) $(DBLAS1) $(DBLAS2) $(DBLAS3) \
|
||||
|
||||
@@ -1,569 +0,0 @@
|
||||
*> \brief \b CGEMMTR
|
||||
*
|
||||
* =========== DOCUMENTATION ===========
|
||||
*
|
||||
* Online html documentation available at
|
||||
* http://www.netlib.org/lapack/explore-html/
|
||||
*
|
||||
* Definition:
|
||||
* ===========
|
||||
*
|
||||
* SUBROUTINE CGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB,BETA,
|
||||
* C,LDC)
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
* COMPLEX ALPHA,BETA
|
||||
* INTEGER K,LDA,LDB,LDC,N
|
||||
* CHARACTER TRANSA,TRANSB, UPLO
|
||||
* ..
|
||||
* .. Array Arguments ..
|
||||
* COMPLEX A(LDA,*),B(LDB,*),C(LDC,*)
|
||||
* ..
|
||||
*
|
||||
*
|
||||
*> \par Purpose:
|
||||
* =============
|
||||
*>
|
||||
*> \verbatim
|
||||
*>
|
||||
*> CGEMMTR performs one of the matrix-matrix operations
|
||||
*>
|
||||
*> C := alpha*op( A )*op( B ) + beta*C,
|
||||
*>
|
||||
*> where op( X ) is one of
|
||||
*>
|
||||
*> op( X ) = X or op( X ) = X**T,
|
||||
*>
|
||||
*> alpha and beta are scalars, and A, B and C are matrices, with op( A )
|
||||
*> an n by k matrix, op( B ) a k by n matrix and C an n by n matrix.
|
||||
*> Thereby, the routine only accesses and updates the upper or lower
|
||||
*> triangular part of the result matrix C. This behaviour can be used if
|
||||
*> the resulting matrix C is known to be Hermitian or symmetric.
|
||||
*> \endverbatim
|
||||
*
|
||||
* Arguments:
|
||||
* ==========
|
||||
*
|
||||
*> \param[in] UPLO
|
||||
*> \verbatim
|
||||
*> UPLO is CHARACTER*1
|
||||
*> On entry, UPLO specifies whether the lower or the upper
|
||||
*> triangular part of C is access and updated.
|
||||
*>
|
||||
*> UPLO = 'L' or 'l', the lower triangular part of C is used.
|
||||
*>
|
||||
*> UPLO = 'U' or 'u', the upper triangular part of C is used.
|
||||
*> \endverbatim
|
||||
*
|
||||
*> \param[in] TRANSA
|
||||
*> \verbatim
|
||||
*> TRANSA is CHARACTER*1
|
||||
*> On entry, TRANSA specifies the form of op( A ) to be used in
|
||||
*> the matrix multiplication as follows:
|
||||
*>
|
||||
*> TRANSA = 'N' or 'n', op( A ) = A.
|
||||
*>
|
||||
*> TRANSA = 'T' or 't', op( A ) = A**T.
|
||||
*>
|
||||
*> TRANSA = 'C' or 'c', op( A ) = A**H.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] TRANSB
|
||||
*> \verbatim
|
||||
*> TRANSB is CHARACTER*1
|
||||
*> On entry, TRANSB specifies the form of op( B ) to be used in
|
||||
*> the matrix multiplication as follows:
|
||||
*>
|
||||
*> TRANSB = 'N' or 'n', op( B ) = B.
|
||||
*>
|
||||
*> TRANSB = 'T' or 't', op( B ) = B**T.
|
||||
*>
|
||||
*> TRANSB = 'C' or 'c', op( B ) = B**H.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] N
|
||||
*> \verbatim
|
||||
*> N is INTEGER
|
||||
*> On entry, N specifies the number of rows and columns of
|
||||
*> the matrix C, the number of columns of op(B) and the number
|
||||
*> of rows of op(A). N must be at least zero.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] K
|
||||
*> \verbatim
|
||||
*> K is INTEGER
|
||||
*> On entry, K specifies the number of columns of the matrix
|
||||
*> op( A ) and the number of rows of the matrix op( B ). K must
|
||||
*> be at least zero.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] ALPHA
|
||||
*> \verbatim
|
||||
*> ALPHA is COMPLEX.
|
||||
*> On entry, ALPHA specifies the scalar alpha.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] A
|
||||
*> \verbatim
|
||||
*> A is COMPLEX array, dimension ( LDA, ka ), where ka is
|
||||
*> k when TRANSA = 'N' or 'n', and is n otherwise.
|
||||
*> Before entry with TRANSA = 'N' or 'n', the leading n by k
|
||||
*> part of the array A must contain the matrix A, otherwise
|
||||
*> the leading k by m part of the array A must contain the
|
||||
*> matrix A.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LDA
|
||||
*> \verbatim
|
||||
*> LDA is INTEGER
|
||||
*> On entry, LDA specifies the first dimension of A as declared
|
||||
*> in the calling (sub) program. When TRANSA = 'N' or 'n' then
|
||||
*> LDA must be at least max( 1, n ), otherwise LDA must be at
|
||||
*> least max( 1, k ).
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] B
|
||||
*> \verbatim
|
||||
*> B is COMPLEX array, dimension ( LDB, kb ), where kb is
|
||||
*> n when TRANSB = 'N' or 'n', and is k otherwise.
|
||||
*> Before entry with TRANSB = 'N' or 'n', the leading k by n
|
||||
*> part of the array B must contain the matrix B, otherwise
|
||||
*> the leading n by k part of the array B must contain the
|
||||
*> matrix B.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LDB
|
||||
*> \verbatim
|
||||
*> LDB is INTEGER
|
||||
*> On entry, LDB specifies the first dimension of B as declared
|
||||
*> in the calling (sub) program. When TRANSB = 'N' or 'n' then
|
||||
*> LDB must be at least max( 1, k ), otherwise LDB must be at
|
||||
*> least max( 1, n ).
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] BETA
|
||||
*> \verbatim
|
||||
*> BETA is COMPLEX.
|
||||
*> On entry, BETA specifies the scalar beta. When BETA is
|
||||
*> supplied as zero then C need not be set on input.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in,out] C
|
||||
*> \verbatim
|
||||
*> C is COMPLEX array, dimension ( LDC, N )
|
||||
*> Before entry, the leading n by n part of the array C must
|
||||
*> contain the matrix C, except when beta is zero, in which
|
||||
*> case C need not be set on entry.
|
||||
*> On exit, the upper or lower triangular part of the matrix
|
||||
*> C is overwritten by the n by n matrix
|
||||
*> ( alpha*op( A )*op( B ) + beta*C ).
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LDC
|
||||
*> \verbatim
|
||||
*> LDC is INTEGER
|
||||
*> On entry, LDC specifies the first dimension of C as declared
|
||||
*> in the calling (sub) program. LDC must be at least
|
||||
*> max( 1, n ).
|
||||
*> \endverbatim
|
||||
*
|
||||
* Authors:
|
||||
* ========
|
||||
*
|
||||
*> \author Martin Koehler
|
||||
*
|
||||
*> \ingroup gemmtr
|
||||
*
|
||||
*> \par Further Details:
|
||||
* =====================
|
||||
*>
|
||||
*> \verbatim
|
||||
*>
|
||||
*> Level 3 Blas routine.
|
||||
*>
|
||||
*> -- Written on 19-July-2023.
|
||||
*> Martin Koehler, MPI Magdeburg
|
||||
*> \endverbatim
|
||||
*>
|
||||
* =====================================================================
|
||||
SUBROUTINE CGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB,
|
||||
+ BETA,C,LDC)
|
||||
IMPLICIT NONE
|
||||
*
|
||||
* -- Reference BLAS level3 routine --
|
||||
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
|
||||
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
COMPLEX ALPHA,BETA
|
||||
INTEGER K,LDA,LDB,LDC,N
|
||||
CHARACTER TRANSA,TRANSB,UPLO
|
||||
* ..
|
||||
* .. 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,NROWA,NROWB,ISTART, ISTOP
|
||||
LOGICAL CONJA,CONJB,NOTA,NOTB,UPPER
|
||||
* ..
|
||||
* .. 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 and NROWB as the number of rows of A and B respectively.
|
||||
*
|
||||
NOTA = LSAME(TRANSA,'N')
|
||||
NOTB = LSAME(TRANSB,'N')
|
||||
CONJA = LSAME(TRANSA,'C')
|
||||
CONJB = LSAME(TRANSB,'C')
|
||||
IF (NOTA) THEN
|
||||
NROWA = N
|
||||
ELSE
|
||||
NROWA = K
|
||||
END IF
|
||||
IF (NOTB) THEN
|
||||
NROWB = K
|
||||
ELSE
|
||||
NROWB = N
|
||||
END IF
|
||||
UPPER = LSAME(UPLO, 'U')
|
||||
|
||||
*
|
||||
* Test the input parameters.
|
||||
*
|
||||
INFO = 0
|
||||
IF ((.NOT. UPPER) .AND. (.NOT. LSAME(UPLO, 'L'))) THEN
|
||||
INFO = 1
|
||||
ELSE IF ((.NOT.NOTA) .AND. (.NOT.CONJA) .AND.
|
||||
+ (.NOT.LSAME(TRANSA,'T'))) THEN
|
||||
INFO = 2
|
||||
ELSE IF ((.NOT.NOTB) .AND. (.NOT.CONJB) .AND.
|
||||
+ (.NOT.LSAME(TRANSB,'T'))) THEN
|
||||
INFO = 3
|
||||
ELSE IF (N.LT.0) THEN
|
||||
INFO = 4
|
||||
ELSE IF (K.LT.0) THEN
|
||||
INFO = 5
|
||||
ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
|
||||
INFO = 8
|
||||
ELSE IF (LDB.LT.MAX(1,NROWB)) THEN
|
||||
INFO = 10
|
||||
ELSE IF (LDC.LT.MAX(1,N)) THEN
|
||||
INFO = 13
|
||||
END IF
|
||||
IF (INFO.NE.0) THEN
|
||||
CALL XERBLA('CGEMMTR',INFO)
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
* Quick return if possible.
|
||||
*
|
||||
IF (N.EQ.0) RETURN
|
||||
*
|
||||
* And when alpha.eq.zero.
|
||||
*
|
||||
IF (ALPHA.EQ.ZERO) THEN
|
||||
IF (BETA.EQ.ZERO) THEN
|
||||
DO 20 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
|
||||
DO 10 I = ISTART, ISTOP
|
||||
C(I,J) = ZERO
|
||||
10 CONTINUE
|
||||
20 CONTINUE
|
||||
ELSE
|
||||
DO 40 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
DO 30 I = ISTART, ISTOP
|
||||
C(I,J) = BETA*C(I,J)
|
||||
30 CONTINUE
|
||||
40 CONTINUE
|
||||
END IF
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
* Start the operations.
|
||||
*
|
||||
IF (NOTB) THEN
|
||||
IF (NOTA) THEN
|
||||
*
|
||||
* Form C := alpha*A*B + beta*C.
|
||||
*
|
||||
DO 90 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
IF (BETA.EQ.ZERO) THEN
|
||||
DO 50 I = ISTART, ISTOP
|
||||
C(I,J) = ZERO
|
||||
50 CONTINUE
|
||||
ELSE IF (BETA.NE.ONE) THEN
|
||||
DO 60 I = ISTART, ISTOP
|
||||
C(I,J) = BETA*C(I,J)
|
||||
60 CONTINUE
|
||||
END IF
|
||||
DO 80 L = 1,K
|
||||
TEMP = ALPHA*B(L,J)
|
||||
DO 70 I = ISTART, ISTOP
|
||||
C(I,J) = C(I,J) + TEMP*A(I,L)
|
||||
70 CONTINUE
|
||||
80 CONTINUE
|
||||
90 CONTINUE
|
||||
ELSE IF (CONJA) THEN
|
||||
*
|
||||
* Form C := alpha*A**H*B + beta*C.
|
||||
*
|
||||
DO 120 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
|
||||
DO 110 I = ISTART, ISTOP
|
||||
TEMP = ZERO
|
||||
DO 100 L = 1,K
|
||||
TEMP = TEMP + CONJG(A(L,I))*B(L,J)
|
||||
100 CONTINUE
|
||||
IF (BETA.EQ.ZERO) THEN
|
||||
C(I,J) = ALPHA*TEMP
|
||||
ELSE
|
||||
C(I,J) = ALPHA*TEMP + BETA*C(I,J)
|
||||
END IF
|
||||
110 CONTINUE
|
||||
120 CONTINUE
|
||||
ELSE
|
||||
*
|
||||
* Form C := alpha*A**T*B + beta*C
|
||||
*
|
||||
DO 150 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
|
||||
DO 140 I = ISTART, ISTOP
|
||||
TEMP = ZERO
|
||||
DO 130 L = 1,K
|
||||
TEMP = TEMP + A(L,I)*B(L,J)
|
||||
130 CONTINUE
|
||||
IF (BETA.EQ.ZERO) THEN
|
||||
C(I,J) = ALPHA*TEMP
|
||||
ELSE
|
||||
C(I,J) = ALPHA*TEMP + BETA*C(I,J)
|
||||
END IF
|
||||
140 CONTINUE
|
||||
150 CONTINUE
|
||||
END IF
|
||||
ELSE IF (NOTA) THEN
|
||||
IF (CONJB) THEN
|
||||
*
|
||||
* Form C := alpha*A*B**H + beta*C.
|
||||
*
|
||||
DO 200 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
|
||||
IF (BETA.EQ.ZERO) THEN
|
||||
DO 160 I = ISTART,ISTOP
|
||||
C(I,J) = ZERO
|
||||
160 CONTINUE
|
||||
ELSE IF (BETA.NE.ONE) THEN
|
||||
DO 170 I = ISTART, ISTOP
|
||||
C(I,J) = BETA*C(I,J)
|
||||
170 CONTINUE
|
||||
END IF
|
||||
DO 190 L = 1,K
|
||||
TEMP = ALPHA*CONJG(B(J,L))
|
||||
DO 180 I = ISTART, ISTOP
|
||||
C(I,J) = C(I,J) + TEMP*A(I,L)
|
||||
180 CONTINUE
|
||||
190 CONTINUE
|
||||
200 CONTINUE
|
||||
ELSE
|
||||
*
|
||||
* Form C := alpha*A*B**T + beta*C
|
||||
*
|
||||
DO 250 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
|
||||
IF (BETA.EQ.ZERO) THEN
|
||||
DO 210 I = ISTART, ISTOP
|
||||
C(I,J) = ZERO
|
||||
210 CONTINUE
|
||||
ELSE IF (BETA.NE.ONE) THEN
|
||||
DO 220 I = ISTART, ISTOP
|
||||
C(I,J) = BETA*C(I,J)
|
||||
220 CONTINUE
|
||||
END IF
|
||||
DO 240 L = 1,K
|
||||
TEMP = ALPHA*B(J,L)
|
||||
DO 230 I = ISTART, ISTOP
|
||||
C(I,J) = C(I,J) + TEMP*A(I,L)
|
||||
230 CONTINUE
|
||||
240 CONTINUE
|
||||
250 CONTINUE
|
||||
END IF
|
||||
ELSE IF (CONJA) THEN
|
||||
IF (CONJB) THEN
|
||||
*
|
||||
* Form C := alpha*A**H*B**H + beta*C.
|
||||
*
|
||||
DO 280 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
|
||||
DO 270 I = ISTART, ISTOP
|
||||
TEMP = ZERO
|
||||
DO 260 L = 1,K
|
||||
TEMP = TEMP + CONJG(A(L,I))*CONJG(B(J,L))
|
||||
260 CONTINUE
|
||||
IF (BETA.EQ.ZERO) THEN
|
||||
C(I,J) = ALPHA*TEMP
|
||||
ELSE
|
||||
C(I,J) = ALPHA*TEMP + BETA*C(I,J)
|
||||
END IF
|
||||
270 CONTINUE
|
||||
280 CONTINUE
|
||||
ELSE
|
||||
*
|
||||
* Form C := alpha*A**H*B**T + beta*C
|
||||
*
|
||||
DO 310 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
|
||||
DO 300 I = ISTART, ISTOP
|
||||
TEMP = ZERO
|
||||
DO 290 L = 1,K
|
||||
TEMP = TEMP + CONJG(A(L,I))*B(J,L)
|
||||
290 CONTINUE
|
||||
IF (BETA.EQ.ZERO) THEN
|
||||
C(I,J) = ALPHA*TEMP
|
||||
ELSE
|
||||
C(I,J) = ALPHA*TEMP + BETA*C(I,J)
|
||||
END IF
|
||||
300 CONTINUE
|
||||
310 CONTINUE
|
||||
END IF
|
||||
ELSE
|
||||
IF (CONJB) THEN
|
||||
*
|
||||
* Form C := alpha*A**T*B**H + beta*C
|
||||
*
|
||||
DO 340 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
|
||||
DO 330 I = ISTART, ISTOP
|
||||
TEMP = ZERO
|
||||
DO 320 L = 1,K
|
||||
TEMP = TEMP + A(L,I)*CONJG(B(J,L))
|
||||
320 CONTINUE
|
||||
IF (BETA.EQ.ZERO) THEN
|
||||
C(I,J) = ALPHA*TEMP
|
||||
ELSE
|
||||
C(I,J) = ALPHA*TEMP + BETA*C(I,J)
|
||||
END IF
|
||||
330 CONTINUE
|
||||
340 CONTINUE
|
||||
ELSE
|
||||
*
|
||||
* Form C := alpha*A**T*B**T + beta*C
|
||||
*
|
||||
DO 370 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
|
||||
DO 360 I = ISTART, ISTOP
|
||||
TEMP = ZERO
|
||||
DO 350 L = 1,K
|
||||
TEMP = TEMP + A(L,I)*B(J,L)
|
||||
350 CONTINUE
|
||||
IF (BETA.EQ.ZERO) THEN
|
||||
C(I,J) = ALPHA*TEMP
|
||||
ELSE
|
||||
C(I,J) = ALPHA*TEMP + BETA*C(I,J)
|
||||
END IF
|
||||
360 CONTINUE
|
||||
370 CONTINUE
|
||||
END IF
|
||||
END IF
|
||||
*
|
||||
RETURN
|
||||
*
|
||||
* End of CGEMMTR
|
||||
*
|
||||
END
|
||||
@@ -1,431 +0,0 @@
|
||||
*> \brief \b DGEMMTR
|
||||
*
|
||||
* =========== DOCUMENTATION ===========
|
||||
*
|
||||
* Online html documentation available at
|
||||
* http://www.netlib.org/lapack/explore-html/
|
||||
*
|
||||
* Definition:
|
||||
* ===========
|
||||
*
|
||||
* SUBROUTINE DGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB,BETA,
|
||||
* C,LDC)
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
* DOUBLE PRECISION ALPHA,BETA
|
||||
* INTEGER K,LDA,LDB,LDC,N
|
||||
* CHARACTER TRANSA,TRANSB, UPLO
|
||||
* ..
|
||||
* .. Array Arguments ..
|
||||
* DOUBLE PRECISION A(LDA,*),B(LDB,*),C(LDC,*)
|
||||
* ..
|
||||
*
|
||||
*
|
||||
*> \par Purpose:
|
||||
* =============
|
||||
*>
|
||||
*> \verbatim
|
||||
*>
|
||||
*> DGEMMTR performs one of the matrix-matrix operations
|
||||
*>
|
||||
*> C := alpha*op( A )*op( B ) + beta*C,
|
||||
*>
|
||||
*> where op( X ) is one of
|
||||
*>
|
||||
*> op( X ) = X or op( X ) = X**T,
|
||||
*>
|
||||
*> alpha and beta are scalars, and A, B and C are matrices, with op( A )
|
||||
*> an n by k matrix, op( B ) a k by n matrix and C an n by n matrix.
|
||||
*> Thereby, the routine only accesses and updates the upper or lower
|
||||
*> triangular part of the result matrix C. This behaviour can be used if
|
||||
*> the resulting matrix C is known to be symmetric.
|
||||
*> \endverbatim
|
||||
*
|
||||
* Arguments:
|
||||
* ==========
|
||||
*
|
||||
*> \param[in] UPLO
|
||||
*> \verbatim
|
||||
*> UPLO is CHARACTER*1
|
||||
*> On entry, UPLO specifies whether the lower or the upper
|
||||
*> triangular part of C is access and updated.
|
||||
*>
|
||||
*> UPLO = 'L' or 'l', the lower triangular part of C is used.
|
||||
*>
|
||||
*> UPLO = 'U' or 'u', the upper triangular part of C is used.
|
||||
*> \endverbatim
|
||||
*
|
||||
*> \param[in] TRANSA
|
||||
*> \verbatim
|
||||
*> TRANSA is CHARACTER*1
|
||||
*> On entry, TRANSA specifies the form of op( A ) to be used in
|
||||
*> the matrix multiplication as follows:
|
||||
*>
|
||||
*> TRANSA = 'N' or 'n', op( A ) = A.
|
||||
*>
|
||||
*> TRANSA = 'T' or 't', op( A ) = A**T.
|
||||
*>
|
||||
*> TRANSA = 'C' or 'c', op( A ) = A**T.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] TRANSB
|
||||
*> \verbatim
|
||||
*> TRANSB is CHARACTER*1
|
||||
*> On entry, TRANSB specifies the form of op( B ) to be used in
|
||||
*> the matrix multiplication as follows:
|
||||
*>
|
||||
*> TRANSB = 'N' or 'n', op( B ) = B.
|
||||
*>
|
||||
*> TRANSB = 'T' or 't', op( B ) = B**T.
|
||||
*>
|
||||
*> TRANSB = 'C' or 'c', op( B ) = B**T.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] N
|
||||
*> \verbatim
|
||||
*> N is INTEGER
|
||||
*> On entry, N specifies the number of rows and columns of
|
||||
*> the matrix C, the number of columns of op(B) and the number
|
||||
*> of rows of op(A). N must be at least zero.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] K
|
||||
*> \verbatim
|
||||
*> K is INTEGER
|
||||
*> On entry, K specifies the number of columns of the matrix
|
||||
*> op( A ) and the number of rows of the matrix op( B ). K must
|
||||
*> be at least zero.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] ALPHA
|
||||
*> \verbatim
|
||||
*> ALPHA is DOUBLE PRECISION.
|
||||
*> On entry, ALPHA specifies the scalar alpha.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] A
|
||||
*> \verbatim
|
||||
*> A is DOUBLE PRECISION array, dimension ( LDA, ka ), where ka is
|
||||
*> k when TRANSA = 'N' or 'n', and is n otherwise.
|
||||
*> Before entry with TRANSA = 'N' or 'n', the leading n by k
|
||||
*> part of the array A must contain the matrix A, otherwise
|
||||
*> the leading k by m part of the array A must contain the
|
||||
*> matrix A.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LDA
|
||||
*> \verbatim
|
||||
*> LDA is INTEGER
|
||||
*> On entry, LDA specifies the first dimension of A as declared
|
||||
*> in the calling (sub) program. When TRANSA = 'N' or 'n' then
|
||||
*> LDA must be at least max( 1, n ), otherwise LDA must be at
|
||||
*> least max( 1, k ).
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] B
|
||||
*> \verbatim
|
||||
*> B is DOUBLE PRECISION array, dimension ( LDB, kb ), where kb is
|
||||
*> n when TRANSB = 'N' or 'n', and is k otherwise.
|
||||
*> Before entry with TRANSB = 'N' or 'n', the leading k by n
|
||||
*> part of the array B must contain the matrix B, otherwise
|
||||
*> the leading n by k part of the array B must contain the
|
||||
*> matrix B.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LDB
|
||||
*> \verbatim
|
||||
*> LDB is INTEGER
|
||||
*> On entry, LDB specifies the first dimension of B as declared
|
||||
*> in the calling (sub) program. When TRANSB = 'N' or 'n' then
|
||||
*> LDB must be at least max( 1, k ), otherwise LDB must be at
|
||||
*> least max( 1, n ).
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] BETA
|
||||
*> \verbatim
|
||||
*> BETA is DOUBLE PRECISION.
|
||||
*> On entry, BETA specifies the scalar beta. When BETA is
|
||||
*> supplied as zero then C need not be set on input.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in,out] C
|
||||
*> \verbatim
|
||||
*> C is DOUBLE PRECISION array, dimension ( LDC, N )
|
||||
*> Before entry, the leading n by n part of the array C must
|
||||
*> contain the matrix C, except when beta is zero, in which
|
||||
*> case C need not be set on entry.
|
||||
*> On exit, the upper or lower triangular part of the matrix
|
||||
*> C is overwritten by the n by n matrix
|
||||
*> ( alpha*op( A )*op( B ) + beta*C ).
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LDC
|
||||
*> \verbatim
|
||||
*> LDC is INTEGER
|
||||
*> On entry, LDC specifies the first dimension of C as declared
|
||||
*> in the calling (sub) program. LDC must be at least
|
||||
*> max( 1, n ).
|
||||
*> \endverbatim
|
||||
*
|
||||
* Authors:
|
||||
* ========
|
||||
*
|
||||
*> \author Martin Koehler
|
||||
*
|
||||
*> \ingroup gemmtr
|
||||
*
|
||||
*> \par Further Details:
|
||||
* =====================
|
||||
*>
|
||||
*> \verbatim
|
||||
*>
|
||||
*> Level 3 Blas routine.
|
||||
*>
|
||||
*> -- Written on 19-July-2023.
|
||||
*> Martin Koehler, MPI Magdeburg
|
||||
*> \endverbatim
|
||||
*>
|
||||
* =====================================================================
|
||||
SUBROUTINE DGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB,
|
||||
+ BETA,C,LDC)
|
||||
IMPLICIT NONE
|
||||
*
|
||||
* -- Reference BLAS level3 routine --
|
||||
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
|
||||
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
DOUBLE PRECISION ALPHA,BETA
|
||||
INTEGER K,LDA,LDB,LDC,N
|
||||
CHARACTER TRANSA,TRANSB,UPLO
|
||||
* ..
|
||||
* .. Array Arguments ..
|
||||
DOUBLE PRECISION A(LDA,*),B(LDB,*),C(LDC,*)
|
||||
* ..
|
||||
*
|
||||
* =====================================================================
|
||||
*
|
||||
* .. External Functions ..
|
||||
LOGICAL LSAME
|
||||
EXTERNAL LSAME
|
||||
* ..
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL XERBLA
|
||||
* ..
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC MAX
|
||||
* ..
|
||||
* .. Local Scalars ..
|
||||
DOUBLE PRECISION TEMP
|
||||
INTEGER I,INFO,J,L,NROWA,NROWB, ISTART, ISTOP
|
||||
LOGICAL NOTA,NOTB, UPPER
|
||||
* ..
|
||||
* .. Parameters ..
|
||||
DOUBLE PRECISION ONE,ZERO
|
||||
PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
|
||||
* ..
|
||||
*
|
||||
* Set NOTA and NOTB as true if A and B respectively are not
|
||||
* transposed and set NROWA and NROWB as the number of rows of A
|
||||
* and B respectively.
|
||||
*
|
||||
NOTA = LSAME(TRANSA,'N')
|
||||
NOTB = LSAME(TRANSB,'N')
|
||||
IF (NOTA) THEN
|
||||
NROWA = N
|
||||
ELSE
|
||||
NROWA = K
|
||||
END IF
|
||||
IF (NOTB) THEN
|
||||
NROWB = K
|
||||
ELSE
|
||||
NROWB = N
|
||||
END IF
|
||||
UPPER = LSAME(UPLO, 'U')
|
||||
*
|
||||
* Test the input parameters.
|
||||
*
|
||||
INFO = 0
|
||||
IF ((.NOT. UPPER) .AND. (.NOT. LSAME(UPLO, 'L'))) THEN
|
||||
INFO = 1
|
||||
ELSE IF ((.NOT.NOTA) .AND. (.NOT.LSAME(TRANSA,'C')) .AND.
|
||||
+ (.NOT.LSAME(TRANSA,'T'))) THEN
|
||||
INFO = 2
|
||||
ELSE IF ((.NOT.NOTB) .AND. (.NOT.LSAME(TRANSB,'C')) .AND.
|
||||
+ (.NOT.LSAME(TRANSB,'T'))) THEN
|
||||
INFO = 3
|
||||
ELSE IF (N.LT.0) THEN
|
||||
INFO = 4
|
||||
ELSE IF (K.LT.0) THEN
|
||||
INFO = 5
|
||||
ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
|
||||
INFO = 8
|
||||
ELSE IF (LDB.LT.MAX(1,NROWB)) THEN
|
||||
INFO = 10
|
||||
ELSE IF (LDC.LT.MAX(1,N)) THEN
|
||||
INFO = 13
|
||||
END IF
|
||||
IF (INFO.NE.0) THEN
|
||||
CALL XERBLA('DGEMMTR',INFO)
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
* Quick return if possible.
|
||||
*
|
||||
IF (N.EQ.0) RETURN
|
||||
*
|
||||
* And if alpha.eq.zero.
|
||||
*
|
||||
IF (ALPHA.EQ.ZERO) THEN
|
||||
IF (BETA.EQ.ZERO) THEN
|
||||
DO 20 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
|
||||
DO 10 I = ISTART, ISTOP
|
||||
C(I,J) = ZERO
|
||||
10 CONTINUE
|
||||
20 CONTINUE
|
||||
ELSE
|
||||
DO 40 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
|
||||
DO 30 I = ISTART, ISTOP
|
||||
C(I,J) = BETA*C(I,J)
|
||||
30 CONTINUE
|
||||
40 CONTINUE
|
||||
END IF
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
* Start the operations.
|
||||
*
|
||||
IF (NOTB) THEN
|
||||
IF (NOTA) THEN
|
||||
*
|
||||
* Form C := alpha*A*B + beta*C.
|
||||
*
|
||||
DO 90 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
IF (BETA.EQ.ZERO) THEN
|
||||
DO 50 I = ISTART, ISTOP
|
||||
C(I,J) = ZERO
|
||||
50 CONTINUE
|
||||
ELSE IF (BETA.NE.ONE) THEN
|
||||
DO 60 I = ISTART, ISTOP
|
||||
C(I,J) = BETA*C(I,J)
|
||||
60 CONTINUE
|
||||
END IF
|
||||
DO 80 L = 1,K
|
||||
TEMP = ALPHA*B(L,J)
|
||||
DO 70 I = ISTART, ISTOP
|
||||
C(I,J) = C(I,J) + TEMP*A(I,L)
|
||||
70 CONTINUE
|
||||
80 CONTINUE
|
||||
90 CONTINUE
|
||||
ELSE
|
||||
*
|
||||
* Form C := alpha*A**T*B + beta*C
|
||||
*
|
||||
DO 120 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
|
||||
DO 110 I = ISTART, ISTOP
|
||||
TEMP = ZERO
|
||||
DO 100 L = 1,K
|
||||
TEMP = TEMP + A(L,I)*B(L,J)
|
||||
100 CONTINUE
|
||||
IF (BETA.EQ.ZERO) THEN
|
||||
C(I,J) = ALPHA*TEMP
|
||||
ELSE
|
||||
C(I,J) = ALPHA*TEMP + BETA*C(I,J)
|
||||
END IF
|
||||
110 CONTINUE
|
||||
120 CONTINUE
|
||||
END IF
|
||||
ELSE
|
||||
IF (NOTA) THEN
|
||||
*
|
||||
* Form C := alpha*A*B**T + beta*C
|
||||
*
|
||||
DO 170 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
|
||||
IF (BETA.EQ.ZERO) THEN
|
||||
DO 130 I = ISTART,ISTOP
|
||||
C(I,J) = ZERO
|
||||
130 CONTINUE
|
||||
ELSE IF (BETA.NE.ONE) THEN
|
||||
DO 140 I = ISTART,ISTOP
|
||||
C(I,J) = BETA*C(I,J)
|
||||
140 CONTINUE
|
||||
END IF
|
||||
DO 160 L = 1,K
|
||||
TEMP = ALPHA*B(J,L)
|
||||
DO 150 I = ISTART,ISTOP
|
||||
C(I,J) = C(I,J) + TEMP*A(I,L)
|
||||
150 CONTINUE
|
||||
160 CONTINUE
|
||||
170 CONTINUE
|
||||
ELSE
|
||||
*
|
||||
* Form C := alpha*A**T*B**T + beta*C
|
||||
*
|
||||
DO 200 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
|
||||
DO 190 I = ISTART, ISTOP
|
||||
TEMP = ZERO
|
||||
DO 180 L = 1,K
|
||||
TEMP = TEMP + A(L,I)*B(J,L)
|
||||
180 CONTINUE
|
||||
IF (BETA.EQ.ZERO) THEN
|
||||
C(I,J) = ALPHA*TEMP
|
||||
ELSE
|
||||
C(I,J) = ALPHA*TEMP + BETA*C(I,J)
|
||||
END IF
|
||||
190 CONTINUE
|
||||
200 CONTINUE
|
||||
END IF
|
||||
END IF
|
||||
*
|
||||
RETURN
|
||||
*
|
||||
* End of SGEMM
|
||||
*
|
||||
END
|
||||
@@ -1,431 +0,0 @@
|
||||
*> \brief \b SGEMMTR
|
||||
*
|
||||
* =========== DOCUMENTATION ===========
|
||||
*
|
||||
* Online html documentation available at
|
||||
* http://www.netlib.org/lapack/explore-html/
|
||||
*
|
||||
* Definition:
|
||||
* ===========
|
||||
*
|
||||
* SUBROUTINE SGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB,BETA,
|
||||
* C,LDC)
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
* REAL ALPHA,BETA
|
||||
* INTEGER K,LDA,LDB,LDC,N
|
||||
* CHARACTER TRANSA,TRANSB, UPLO
|
||||
* ..
|
||||
* .. Array Arguments ..
|
||||
* REAL A(LDA,*),B(LDB,*),C(LDC,*)
|
||||
* ..
|
||||
*
|
||||
*
|
||||
*> \par Purpose:
|
||||
* =============
|
||||
*>
|
||||
*> \verbatim
|
||||
*>
|
||||
*> SGEMMTR performs one of the matrix-matrix operations
|
||||
*>
|
||||
*> C := alpha*op( A )*op( B ) + beta*C,
|
||||
*>
|
||||
*> where op( X ) is one of
|
||||
*>
|
||||
*> op( X ) = X or op( X ) = X**T,
|
||||
*>
|
||||
*> alpha and beta are scalars, and A, B and C are matrices, with op( A )
|
||||
*> an n by k matrix, op( B ) a k by n matrix and C an n by n matrix.
|
||||
*> Thereby, the routine only accesses and updates the upper or lower
|
||||
*> triangular part of the result matrix C. This behaviour can be used if
|
||||
*> the resulting matrix C is known to be symmetric.
|
||||
*> \endverbatim
|
||||
*
|
||||
* Arguments:
|
||||
* ==========
|
||||
*
|
||||
*> \param[in] UPLO
|
||||
*> \verbatim
|
||||
*> UPLO is CHARACTER*1
|
||||
*> On entry, UPLO specifies whether the lower or the upper
|
||||
*> triangular part of C is access and updated.
|
||||
*>
|
||||
*> UPLO = 'L' or 'l', the lower triangular part of C is used.
|
||||
*>
|
||||
*> UPLO = 'U' or 'u', the upper triangular part of C is used.
|
||||
*> \endverbatim
|
||||
*
|
||||
*> \param[in] TRANSA
|
||||
*> \verbatim
|
||||
*> TRANSA is CHARACTER*1
|
||||
*> On entry, TRANSA specifies the form of op( A ) to be used in
|
||||
*> the matrix multiplication as follows:
|
||||
*>
|
||||
*> TRANSA = 'N' or 'n', op( A ) = A.
|
||||
*>
|
||||
*> TRANSA = 'T' or 't', op( A ) = A**T.
|
||||
*>
|
||||
*> TRANSA = 'C' or 'c', op( A ) = A**T.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] TRANSB
|
||||
*> \verbatim
|
||||
*> TRANSB is CHARACTER*1
|
||||
*> On entry, TRANSB specifies the form of op( B ) to be used in
|
||||
*> the matrix multiplication as follows:
|
||||
*>
|
||||
*> TRANSB = 'N' or 'n', op( B ) = B.
|
||||
*>
|
||||
*> TRANSB = 'T' or 't', op( B ) = B**T.
|
||||
*>
|
||||
*> TRANSB = 'C' or 'c', op( B ) = B**T.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] N
|
||||
*> \verbatim
|
||||
*> N is INTEGER
|
||||
*> On entry, N specifies the number of rows and columns of
|
||||
*> the matrix C, the number of columns of op(B) and the number
|
||||
*> of rows of op(A). N must be at least zero.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] K
|
||||
*> \verbatim
|
||||
*> K is INTEGER
|
||||
*> On entry, K specifies the number of columns of the matrix
|
||||
*> op( A ) and the number of rows of the matrix op( B ). K must
|
||||
*> be at least zero.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] ALPHA
|
||||
*> \verbatim
|
||||
*> ALPHA is REAL.
|
||||
*> On entry, ALPHA specifies the scalar alpha.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] A
|
||||
*> \verbatim
|
||||
*> A is REAL array, dimension ( LDA, ka ), where ka is
|
||||
*> k when TRANSA = 'N' or 'n', and is n otherwise.
|
||||
*> Before entry with TRANSA = 'N' or 'n', the leading n by k
|
||||
*> part of the array A must contain the matrix A, otherwise
|
||||
*> the leading k by m part of the array A must contain the
|
||||
*> matrix A.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LDA
|
||||
*> \verbatim
|
||||
*> LDA is INTEGER
|
||||
*> On entry, LDA specifies the first dimension of A as declared
|
||||
*> in the calling (sub) program. When TRANSA = 'N' or 'n' then
|
||||
*> LDA must be at least max( 1, n ), otherwise LDA must be at
|
||||
*> least max( 1, k ).
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] B
|
||||
*> \verbatim
|
||||
*> B is REAL array, dimension ( LDB, kb ), where kb is
|
||||
*> n when TRANSB = 'N' or 'n', and is k otherwise.
|
||||
*> Before entry with TRANSB = 'N' or 'n', the leading k by n
|
||||
*> part of the array B must contain the matrix B, otherwise
|
||||
*> the leading n by k part of the array B must contain the
|
||||
*> matrix B.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LDB
|
||||
*> \verbatim
|
||||
*> LDB is INTEGER
|
||||
*> On entry, LDB specifies the first dimension of B as declared
|
||||
*> in the calling (sub) program. When TRANSB = 'N' or 'n' then
|
||||
*> LDB must be at least max( 1, k ), otherwise LDB must be at
|
||||
*> least max( 1, n ).
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] BETA
|
||||
*> \verbatim
|
||||
*> BETA is REAL.
|
||||
*> On entry, BETA specifies the scalar beta. When BETA is
|
||||
*> supplied as zero then C need not be set on input.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in,out] C
|
||||
*> \verbatim
|
||||
*> C is REAL array, dimension ( LDC, N )
|
||||
*> Before entry, the leading n by n part of the array C must
|
||||
*> contain the matrix C, except when beta is zero, in which
|
||||
*> case C need not be set on entry.
|
||||
*> On exit, the upper or lower triangular part of the matrix
|
||||
*> C is overwritten by the n by n matrix
|
||||
*> ( alpha*op( A )*op( B ) + beta*C ).
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LDC
|
||||
*> \verbatim
|
||||
*> LDC is INTEGER
|
||||
*> On entry, LDC specifies the first dimension of C as declared
|
||||
*> in the calling (sub) program. LDC must be at least
|
||||
*> max( 1, n ).
|
||||
*> \endverbatim
|
||||
*
|
||||
* Authors:
|
||||
* ========
|
||||
*
|
||||
*> \author Martin Koehler
|
||||
*
|
||||
*> \ingroup gemmtr
|
||||
*
|
||||
*> \par Further Details:
|
||||
* =====================
|
||||
*>
|
||||
*> \verbatim
|
||||
*>
|
||||
*> Level 3 Blas routine.
|
||||
*>
|
||||
*> -- Written on 19-July-2023.
|
||||
*> Martin Koehler, MPI Magdeburg
|
||||
*> \endverbatim
|
||||
*>
|
||||
* =====================================================================
|
||||
SUBROUTINE SGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB,
|
||||
+ BETA,C,LDC)
|
||||
IMPLICIT NONE
|
||||
*
|
||||
* -- Reference BLAS level3 routine --
|
||||
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
|
||||
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
REAL ALPHA,BETA
|
||||
INTEGER K,LDA,LDB,LDC,N
|
||||
CHARACTER TRANSA,TRANSB,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 TEMP
|
||||
INTEGER I,INFO,J,L,NROWA,NROWB, ISTART, ISTOP
|
||||
LOGICAL NOTA,NOTB, UPPER
|
||||
* ..
|
||||
* .. Parameters ..
|
||||
REAL ONE,ZERO
|
||||
PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
|
||||
* ..
|
||||
*
|
||||
* Set NOTA and NOTB as true if A and B respectively are not
|
||||
* transposed and set NROWA and NROWB as the number of rows of A
|
||||
* and B respectively.
|
||||
*
|
||||
NOTA = LSAME(TRANSA,'N')
|
||||
NOTB = LSAME(TRANSB,'N')
|
||||
IF (NOTA) THEN
|
||||
NROWA = N
|
||||
ELSE
|
||||
NROWA = K
|
||||
END IF
|
||||
IF (NOTB) THEN
|
||||
NROWB = K
|
||||
ELSE
|
||||
NROWB = N
|
||||
END IF
|
||||
UPPER = LSAME(UPLO, 'U')
|
||||
*
|
||||
* Test the input parameters.
|
||||
*
|
||||
INFO = 0
|
||||
IF ((.NOT. UPPER) .AND. (.NOT. LSAME(UPLO, 'L'))) THEN
|
||||
INFO = 1
|
||||
ELSE IF ((.NOT.NOTA) .AND. (.NOT.LSAME(TRANSA,'C')) .AND.
|
||||
+ (.NOT.LSAME(TRANSA,'T'))) THEN
|
||||
INFO = 2
|
||||
ELSE IF ((.NOT.NOTB) .AND. (.NOT.LSAME(TRANSB,'C')) .AND.
|
||||
+ (.NOT.LSAME(TRANSB,'T'))) THEN
|
||||
INFO = 3
|
||||
ELSE IF (N.LT.0) THEN
|
||||
INFO = 4
|
||||
ELSE IF (K.LT.0) THEN
|
||||
INFO = 5
|
||||
ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
|
||||
INFO = 8
|
||||
ELSE IF (LDB.LT.MAX(1,NROWB)) THEN
|
||||
INFO = 10
|
||||
ELSE IF (LDC.LT.MAX(1,N)) THEN
|
||||
INFO = 13
|
||||
END IF
|
||||
IF (INFO.NE.0) THEN
|
||||
CALL XERBLA('SGEMMTR',INFO)
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
* Quick return if possible.
|
||||
*
|
||||
IF (N.EQ.0) RETURN
|
||||
*
|
||||
* And if alpha.eq.zero.
|
||||
*
|
||||
IF (ALPHA.EQ.ZERO) THEN
|
||||
IF (BETA.EQ.ZERO) THEN
|
||||
DO 20 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
|
||||
DO 10 I = ISTART, ISTOP
|
||||
C(I,J) = ZERO
|
||||
10 CONTINUE
|
||||
20 CONTINUE
|
||||
ELSE
|
||||
DO 40 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
|
||||
DO 30 I = ISTART, ISTOP
|
||||
C(I,J) = BETA*C(I,J)
|
||||
30 CONTINUE
|
||||
40 CONTINUE
|
||||
END IF
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
* Start the operations.
|
||||
*
|
||||
IF (NOTB) THEN
|
||||
IF (NOTA) THEN
|
||||
*
|
||||
* Form C := alpha*A*B + beta*C.
|
||||
*
|
||||
DO 90 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
IF (BETA.EQ.ZERO) THEN
|
||||
DO 50 I = ISTART, ISTOP
|
||||
C(I,J) = ZERO
|
||||
50 CONTINUE
|
||||
ELSE IF (BETA.NE.ONE) THEN
|
||||
DO 60 I = ISTART, ISTOP
|
||||
C(I,J) = BETA*C(I,J)
|
||||
60 CONTINUE
|
||||
END IF
|
||||
DO 80 L = 1,K
|
||||
TEMP = ALPHA*B(L,J)
|
||||
DO 70 I = ISTART, ISTOP
|
||||
C(I,J) = C(I,J) + TEMP*A(I,L)
|
||||
70 CONTINUE
|
||||
80 CONTINUE
|
||||
90 CONTINUE
|
||||
ELSE
|
||||
*
|
||||
* Form C := alpha*A**T*B + beta*C
|
||||
*
|
||||
DO 120 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
|
||||
DO 110 I = ISTART, ISTOP
|
||||
TEMP = ZERO
|
||||
DO 100 L = 1,K
|
||||
TEMP = TEMP + A(L,I)*B(L,J)
|
||||
100 CONTINUE
|
||||
IF (BETA.EQ.ZERO) THEN
|
||||
C(I,J) = ALPHA*TEMP
|
||||
ELSE
|
||||
C(I,J) = ALPHA*TEMP + BETA*C(I,J)
|
||||
END IF
|
||||
110 CONTINUE
|
||||
120 CONTINUE
|
||||
END IF
|
||||
ELSE
|
||||
IF (NOTA) THEN
|
||||
*
|
||||
* Form C := alpha*A*B**T + beta*C
|
||||
*
|
||||
DO 170 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
|
||||
IF (BETA.EQ.ZERO) THEN
|
||||
DO 130 I = ISTART,ISTOP
|
||||
C(I,J) = ZERO
|
||||
130 CONTINUE
|
||||
ELSE IF (BETA.NE.ONE) THEN
|
||||
DO 140 I = ISTART,ISTOP
|
||||
C(I,J) = BETA*C(I,J)
|
||||
140 CONTINUE
|
||||
END IF
|
||||
DO 160 L = 1,K
|
||||
TEMP = ALPHA*B(J,L)
|
||||
DO 150 I = ISTART,ISTOP
|
||||
C(I,J) = C(I,J) + TEMP*A(I,L)
|
||||
150 CONTINUE
|
||||
160 CONTINUE
|
||||
170 CONTINUE
|
||||
ELSE
|
||||
*
|
||||
* Form C := alpha*A**T*B**T + beta*C
|
||||
*
|
||||
DO 200 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
|
||||
DO 190 I = ISTART, ISTOP
|
||||
TEMP = ZERO
|
||||
DO 180 L = 1,K
|
||||
TEMP = TEMP + A(L,I)*B(J,L)
|
||||
180 CONTINUE
|
||||
IF (BETA.EQ.ZERO) THEN
|
||||
C(I,J) = ALPHA*TEMP
|
||||
ELSE
|
||||
C(I,J) = ALPHA*TEMP + BETA*C(I,J)
|
||||
END IF
|
||||
190 CONTINUE
|
||||
200 CONTINUE
|
||||
END IF
|
||||
END IF
|
||||
*
|
||||
RETURN
|
||||
*
|
||||
* End of SGEMMTR
|
||||
*
|
||||
END
|
||||
@@ -1,569 +0,0 @@
|
||||
*> \brief \b ZGEMMTR
|
||||
*
|
||||
* =========== DOCUMENTATION ===========
|
||||
*
|
||||
* Online html documentation available at
|
||||
* http://www.netlib.org/lapack/explore-html/
|
||||
*
|
||||
* Definition:
|
||||
* ===========
|
||||
*
|
||||
* SUBROUTINE ZGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB,BETA,
|
||||
* C,LDC)
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
* COMPLEX*16 ALPHA,BETA
|
||||
* INTEGER K,LDA,LDB,LDC,N
|
||||
* CHARACTER TRANSA,TRANSB, UPLO
|
||||
* ..
|
||||
* .. Array Arguments ..
|
||||
* COMPLEX*16 A(LDA,*),B(LDB,*),C(LDC,*)
|
||||
* ..
|
||||
*
|
||||
*
|
||||
*> \par Purpose:
|
||||
* =============
|
||||
*>
|
||||
*> \verbatim
|
||||
*>
|
||||
*> ZGEMMTR performs one of the matrix-matrix operations
|
||||
*>
|
||||
*> C := alpha*op( A )*op( B ) + beta*C,
|
||||
*>
|
||||
*> where op( X ) is one of
|
||||
*>
|
||||
*> op( X ) = X or op( X ) = X**T,
|
||||
*>
|
||||
*> alpha and beta are scalars, and A, B and C are matrices, with op( A )
|
||||
*> an n by k matrix, op( B ) a k by n matrix and C an n by n matrix.
|
||||
*> Thereby, the routine only accesses and updates the upper or lower
|
||||
*> triangular part of the result matrix C. This behaviour can be used if
|
||||
*> the resulting matrix C is known to be Hermitian or symmetric.
|
||||
*> \endverbatim
|
||||
*
|
||||
* Arguments:
|
||||
* ==========
|
||||
*
|
||||
*> \param[in] UPLO
|
||||
*> \verbatim
|
||||
*> UPLO is CHARACTER*1
|
||||
*> On entry, UPLO specifies whether the lower or the upper
|
||||
*> triangular part of C is access and updated.
|
||||
*>
|
||||
*> UPLO = 'L' or 'l', the lower triangular part of C is used.
|
||||
*>
|
||||
*> UPLO = 'U' or 'u', the upper triangular part of C is used.
|
||||
*> \endverbatim
|
||||
*
|
||||
*> \param[in] TRANSA
|
||||
*> \verbatim
|
||||
*> TRANSA is CHARACTER*1
|
||||
*> On entry, TRANSA specifies the form of op( A ) to be used in
|
||||
*> the matrix multiplication as follows:
|
||||
*>
|
||||
*> TRANSA = 'N' or 'n', op( A ) = A.
|
||||
*>
|
||||
*> TRANSA = 'T' or 't', op( A ) = A**T.
|
||||
*>
|
||||
*> TRANSA = 'C' or 'c', op( A ) = A**H.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] TRANSB
|
||||
*> \verbatim
|
||||
*> TRANSB is CHARACTER*1
|
||||
*> On entry, TRANSB specifies the form of op( B ) to be used in
|
||||
*> the matrix multiplication as follows:
|
||||
*>
|
||||
*> TRANSB = 'N' or 'n', op( B ) = B.
|
||||
*>
|
||||
*> TRANSB = 'T' or 't', op( B ) = B**T.
|
||||
*>
|
||||
*> TRANSB = 'C' or 'c', op( B ) = B**H.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] N
|
||||
*> \verbatim
|
||||
*> N is INTEGER
|
||||
*> On entry, N specifies the number of rows and columns of
|
||||
*> the matrix C, the number of columns of op(B) and the number
|
||||
*> of rows of op(A). N must be at least zero.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] K
|
||||
*> \verbatim
|
||||
*> K is INTEGER
|
||||
*> On entry, K specifies the number of columns of the matrix
|
||||
*> op( A ) and the number of rows of the matrix op( B ). K must
|
||||
*> be at least zero.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] ALPHA
|
||||
*> \verbatim
|
||||
*> ALPHA is COMPLEX*16.
|
||||
*> On entry, ALPHA specifies the scalar alpha.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] A
|
||||
*> \verbatim
|
||||
*> A is COMPLEX*16 array, dimension ( LDA, ka ), where ka is
|
||||
*> k when TRANSA = 'N' or 'n', and is n otherwise.
|
||||
*> Before entry with TRANSA = 'N' or 'n', the leading n by k
|
||||
*> part of the array A must contain the matrix A, otherwise
|
||||
*> the leading k by m part of the array A must contain the
|
||||
*> matrix A.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LDA
|
||||
*> \verbatim
|
||||
*> LDA is INTEGER
|
||||
*> On entry, LDA specifies the first dimension of A as declared
|
||||
*> in the calling (sub) program. When TRANSA = 'N' or 'n' then
|
||||
*> LDA must be at least max( 1, n ), otherwise LDA must be at
|
||||
*> least max( 1, k ).
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] B
|
||||
*> \verbatim
|
||||
*> B is COMPLEX*16 array, dimension ( LDB, kb ), where kb is
|
||||
*> n when TRANSB = 'N' or 'n', and is k otherwise.
|
||||
*> Before entry with TRANSB = 'N' or 'n', the leading k by n
|
||||
*> part of the array B must contain the matrix B, otherwise
|
||||
*> the leading n by k part of the array B must contain the
|
||||
*> matrix B.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LDB
|
||||
*> \verbatim
|
||||
*> LDB is INTEGER
|
||||
*> On entry, LDB specifies the first dimension of B as declared
|
||||
*> in the calling (sub) program. When TRANSB = 'N' or 'n' then
|
||||
*> LDB must be at least max( 1, k ), otherwise LDB must be at
|
||||
*> least max( 1, n ).
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] BETA
|
||||
*> \verbatim
|
||||
*> BETA is COMPLEX*16.
|
||||
*> On entry, BETA specifies the scalar beta. When BETA is
|
||||
*> supplied as zero then C need not be set on input.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in,out] C
|
||||
*> \verbatim
|
||||
*> C is COMPLEX*16 array, dimension ( LDC, N )
|
||||
*> Before entry, the leading n by n part of the array C must
|
||||
*> contain the matrix C, except when beta is zero, in which
|
||||
*> case C need not be set on entry.
|
||||
*> On exit, the upper or lower triangular part of the matrix
|
||||
*> C is overwritten by the n by n matrix
|
||||
*> ( alpha*op( A )*op( B ) + beta*C ).
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LDC
|
||||
*> \verbatim
|
||||
*> LDC is INTEGER
|
||||
*> On entry, LDC specifies the first dimension of C as declared
|
||||
*> in the calling (sub) program. LDC must be at least
|
||||
*> max( 1, n ).
|
||||
*> \endverbatim
|
||||
*
|
||||
* Authors:
|
||||
* ========
|
||||
*
|
||||
*> \author Martin Koehler
|
||||
*
|
||||
*> \ingroup gemmtr
|
||||
*
|
||||
*> \par Further Details:
|
||||
* =====================
|
||||
*>
|
||||
*> \verbatim
|
||||
*>
|
||||
*> Level 3 Blas routine.
|
||||
*>
|
||||
*> -- Written on 19-July-2023.
|
||||
*> Martin Koehler, MPI Magdeburg
|
||||
*> \endverbatim
|
||||
*>
|
||||
* =====================================================================
|
||||
SUBROUTINE ZGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB,
|
||||
+ BETA,C,LDC)
|
||||
IMPLICIT NONE
|
||||
*
|
||||
* -- Reference BLAS level3 routine --
|
||||
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
|
||||
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
COMPLEX*16 ALPHA,BETA
|
||||
INTEGER K,LDA,LDB,LDC,N
|
||||
CHARACTER TRANSA,TRANSB,UPLO
|
||||
* ..
|
||||
* .. Array Arguments ..
|
||||
COMPLEX*16 A(LDA,*),B(LDB,*),C(LDC,*)
|
||||
* ..
|
||||
*
|
||||
* =====================================================================
|
||||
*
|
||||
* .. External Functions ..
|
||||
LOGICAL LSAME
|
||||
EXTERNAL LSAME
|
||||
* ..
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL XERBLA
|
||||
* ..
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC CONJG,MAX
|
||||
* ..
|
||||
* .. Local Scalars ..
|
||||
COMPLEX*16 TEMP
|
||||
INTEGER I,INFO,J,L,NROWA,NROWB,ISTART, ISTOP
|
||||
LOGICAL CONJA,CONJB,NOTA,NOTB,UPPER
|
||||
* ..
|
||||
* .. Parameters ..
|
||||
COMPLEX*16 ONE
|
||||
PARAMETER (ONE= (1.0D+0,0.0D+0))
|
||||
COMPLEX*16 ZERO
|
||||
PARAMETER (ZERO= (0.0D+0,0.0D+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 and NROWB as the number of rows of A and B respectively.
|
||||
*
|
||||
NOTA = LSAME(TRANSA,'N')
|
||||
NOTB = LSAME(TRANSB,'N')
|
||||
CONJA = LSAME(TRANSA,'C')
|
||||
CONJB = LSAME(TRANSB,'C')
|
||||
IF (NOTA) THEN
|
||||
NROWA = N
|
||||
ELSE
|
||||
NROWA = K
|
||||
END IF
|
||||
IF (NOTB) THEN
|
||||
NROWB = K
|
||||
ELSE
|
||||
NROWB = N
|
||||
END IF
|
||||
UPPER = LSAME(UPLO, 'U')
|
||||
|
||||
*
|
||||
* Test the input parameters.
|
||||
*
|
||||
INFO = 0
|
||||
IF ((.NOT. UPPER) .AND. (.NOT. LSAME(UPLO, 'L'))) THEN
|
||||
INFO = 1
|
||||
ELSE IF ((.NOT.NOTA) .AND. (.NOT.CONJA) .AND.
|
||||
+ (.NOT.LSAME(TRANSA,'T'))) THEN
|
||||
INFO = 2
|
||||
ELSE IF ((.NOT.NOTB) .AND. (.NOT.CONJB) .AND.
|
||||
+ (.NOT.LSAME(TRANSB,'T'))) THEN
|
||||
INFO = 3
|
||||
ELSE IF (N.LT.0) THEN
|
||||
INFO = 4
|
||||
ELSE IF (K.LT.0) THEN
|
||||
INFO = 5
|
||||
ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
|
||||
INFO = 8
|
||||
ELSE IF (LDB.LT.MAX(1,NROWB)) THEN
|
||||
INFO = 10
|
||||
ELSE IF (LDC.LT.MAX(1,N)) THEN
|
||||
INFO = 13
|
||||
END IF
|
||||
IF (INFO.NE.0) THEN
|
||||
CALL XERBLA('ZGEMMTR',INFO)
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
* Quick return if possible.
|
||||
*
|
||||
IF (N.EQ.0) RETURN
|
||||
*
|
||||
* And when alpha.eq.zero.
|
||||
*
|
||||
IF (ALPHA.EQ.ZERO) THEN
|
||||
IF (BETA.EQ.ZERO) THEN
|
||||
DO 20 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
|
||||
DO 10 I = ISTART, ISTOP
|
||||
C(I,J) = ZERO
|
||||
10 CONTINUE
|
||||
20 CONTINUE
|
||||
ELSE
|
||||
DO 40 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
DO 30 I = ISTART, ISTOP
|
||||
C(I,J) = BETA*C(I,J)
|
||||
30 CONTINUE
|
||||
40 CONTINUE
|
||||
END IF
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
* Start the operations.
|
||||
*
|
||||
IF (NOTB) THEN
|
||||
IF (NOTA) THEN
|
||||
*
|
||||
* Form C := alpha*A*B + beta*C.
|
||||
*
|
||||
DO 90 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
IF (BETA.EQ.ZERO) THEN
|
||||
DO 50 I = ISTART, ISTOP
|
||||
C(I,J) = ZERO
|
||||
50 CONTINUE
|
||||
ELSE IF (BETA.NE.ONE) THEN
|
||||
DO 60 I = ISTART, ISTOP
|
||||
C(I,J) = BETA*C(I,J)
|
||||
60 CONTINUE
|
||||
END IF
|
||||
DO 80 L = 1,K
|
||||
TEMP = ALPHA*B(L,J)
|
||||
DO 70 I = ISTART, ISTOP
|
||||
C(I,J) = C(I,J) + TEMP*A(I,L)
|
||||
70 CONTINUE
|
||||
80 CONTINUE
|
||||
90 CONTINUE
|
||||
ELSE IF (CONJA) THEN
|
||||
*
|
||||
* Form C := alpha*A**H*B + beta*C.
|
||||
*
|
||||
DO 120 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
|
||||
DO 110 I = ISTART, ISTOP
|
||||
TEMP = ZERO
|
||||
DO 100 L = 1,K
|
||||
TEMP = TEMP + CONJG(A(L,I))*B(L,J)
|
||||
100 CONTINUE
|
||||
IF (BETA.EQ.ZERO) THEN
|
||||
C(I,J) = ALPHA*TEMP
|
||||
ELSE
|
||||
C(I,J) = ALPHA*TEMP + BETA*C(I,J)
|
||||
END IF
|
||||
110 CONTINUE
|
||||
120 CONTINUE
|
||||
ELSE
|
||||
*
|
||||
* Form C := alpha*A**T*B + beta*C
|
||||
*
|
||||
DO 150 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
|
||||
DO 140 I = ISTART, ISTOP
|
||||
TEMP = ZERO
|
||||
DO 130 L = 1,K
|
||||
TEMP = TEMP + A(L,I)*B(L,J)
|
||||
130 CONTINUE
|
||||
IF (BETA.EQ.ZERO) THEN
|
||||
C(I,J) = ALPHA*TEMP
|
||||
ELSE
|
||||
C(I,J) = ALPHA*TEMP + BETA*C(I,J)
|
||||
END IF
|
||||
140 CONTINUE
|
||||
150 CONTINUE
|
||||
END IF
|
||||
ELSE IF (NOTA) THEN
|
||||
IF (CONJB) THEN
|
||||
*
|
||||
* Form C := alpha*A*B**H + beta*C.
|
||||
*
|
||||
DO 200 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
|
||||
IF (BETA.EQ.ZERO) THEN
|
||||
DO 160 I = ISTART,ISTOP
|
||||
C(I,J) = ZERO
|
||||
160 CONTINUE
|
||||
ELSE IF (BETA.NE.ONE) THEN
|
||||
DO 170 I = ISTART, ISTOP
|
||||
C(I,J) = BETA*C(I,J)
|
||||
170 CONTINUE
|
||||
END IF
|
||||
DO 190 L = 1,K
|
||||
TEMP = ALPHA*CONJG(B(J,L))
|
||||
DO 180 I = ISTART, ISTOP
|
||||
C(I,J) = C(I,J) + TEMP*A(I,L)
|
||||
180 CONTINUE
|
||||
190 CONTINUE
|
||||
200 CONTINUE
|
||||
ELSE
|
||||
*
|
||||
* Form C := alpha*A*B**T + beta*C
|
||||
*
|
||||
DO 250 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
|
||||
IF (BETA.EQ.ZERO) THEN
|
||||
DO 210 I = ISTART, ISTOP
|
||||
C(I,J) = ZERO
|
||||
210 CONTINUE
|
||||
ELSE IF (BETA.NE.ONE) THEN
|
||||
DO 220 I = ISTART, ISTOP
|
||||
C(I,J) = BETA*C(I,J)
|
||||
220 CONTINUE
|
||||
END IF
|
||||
DO 240 L = 1,K
|
||||
TEMP = ALPHA*B(J,L)
|
||||
DO 230 I = ISTART, ISTOP
|
||||
C(I,J) = C(I,J) + TEMP*A(I,L)
|
||||
230 CONTINUE
|
||||
240 CONTINUE
|
||||
250 CONTINUE
|
||||
END IF
|
||||
ELSE IF (CONJA) THEN
|
||||
IF (CONJB) THEN
|
||||
*
|
||||
* Form C := alpha*A**H*B**H + beta*C.
|
||||
*
|
||||
DO 280 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
|
||||
DO 270 I = ISTART, ISTOP
|
||||
TEMP = ZERO
|
||||
DO 260 L = 1,K
|
||||
TEMP = TEMP + CONJG(A(L,I))*CONJG(B(J,L))
|
||||
260 CONTINUE
|
||||
IF (BETA.EQ.ZERO) THEN
|
||||
C(I,J) = ALPHA*TEMP
|
||||
ELSE
|
||||
C(I,J) = ALPHA*TEMP + BETA*C(I,J)
|
||||
END IF
|
||||
270 CONTINUE
|
||||
280 CONTINUE
|
||||
ELSE
|
||||
*
|
||||
* Form C := alpha*A**H*B**T + beta*C
|
||||
*
|
||||
DO 310 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
|
||||
DO 300 I = ISTART, ISTOP
|
||||
TEMP = ZERO
|
||||
DO 290 L = 1,K
|
||||
TEMP = TEMP + CONJG(A(L,I))*B(J,L)
|
||||
290 CONTINUE
|
||||
IF (BETA.EQ.ZERO) THEN
|
||||
C(I,J) = ALPHA*TEMP
|
||||
ELSE
|
||||
C(I,J) = ALPHA*TEMP + BETA*C(I,J)
|
||||
END IF
|
||||
300 CONTINUE
|
||||
310 CONTINUE
|
||||
END IF
|
||||
ELSE
|
||||
IF (CONJB) THEN
|
||||
*
|
||||
* Form C := alpha*A**T*B**H + beta*C
|
||||
*
|
||||
DO 340 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
|
||||
DO 330 I = ISTART, ISTOP
|
||||
TEMP = ZERO
|
||||
DO 320 L = 1,K
|
||||
TEMP = TEMP + A(L,I)*CONJG(B(J,L))
|
||||
320 CONTINUE
|
||||
IF (BETA.EQ.ZERO) THEN
|
||||
C(I,J) = ALPHA*TEMP
|
||||
ELSE
|
||||
C(I,J) = ALPHA*TEMP + BETA*C(I,J)
|
||||
END IF
|
||||
330 CONTINUE
|
||||
340 CONTINUE
|
||||
ELSE
|
||||
*
|
||||
* Form C := alpha*A**T*B**T + beta*C
|
||||
*
|
||||
DO 370 J = 1,N
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
|
||||
DO 360 I = ISTART, ISTOP
|
||||
TEMP = ZERO
|
||||
DO 350 L = 1,K
|
||||
TEMP = TEMP + A(L,I)*B(J,L)
|
||||
350 CONTINUE
|
||||
IF (BETA.EQ.ZERO) THEN
|
||||
C(I,J) = ALPHA*TEMP
|
||||
ELSE
|
||||
C(I,J) = ALPHA*TEMP + BETA*C(I,J)
|
||||
END IF
|
||||
360 CONTINUE
|
||||
370 CONTINUE
|
||||
END IF
|
||||
END IF
|
||||
*
|
||||
RETURN
|
||||
*
|
||||
* End of ZGEMMTR
|
||||
*
|
||||
END
|
||||
@@ -994,17 +994,13 @@
|
||||
* .. Scalar Arguments ..
|
||||
REAL XX
|
||||
INTEGER K
|
||||
* .. Parameters ..
|
||||
REAL ZERO
|
||||
PARAMETER (ZERO=0.0E+0)
|
||||
* .. Local Scalars ..
|
||||
REAL X, Y, Z
|
||||
REAL X, Y, YY, Z
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC HUGE
|
||||
* .. Executable Statements ..
|
||||
X = ZERO
|
||||
Y = HUGE(XX)
|
||||
Z = Y*Y
|
||||
Z = YY
|
||||
IF (K.EQ.1) THEN
|
||||
X = -Z
|
||||
ELSE IF (K.EQ.2) THEN
|
||||
|
||||
+28
-724
@@ -19,7 +19,7 @@
|
||||
*> Test program for the COMPLEX Level 3 Blas.
|
||||
*>
|
||||
*> The program must be driven by a short data file. The first 14 records
|
||||
*> of the file are read using list-directed input, the last 10 records
|
||||
*> of the file are read using list-directed input, the last 9 records
|
||||
*> are read using the format ( A6, L2 ). An annotated example of a data
|
||||
*> file can be obtained by deleting the first 3 characters from the
|
||||
*> following 23 lines:
|
||||
@@ -46,7 +46,6 @@
|
||||
*> CSYRK T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
*> CHER2K T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
*> CSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
*> CGEMMTR T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
*>
|
||||
*> Further Details
|
||||
*> ===============
|
||||
@@ -94,7 +93,7 @@
|
||||
INTEGER NIN
|
||||
PARAMETER ( NIN = 5 )
|
||||
INTEGER NSUBS
|
||||
PARAMETER ( NSUBS = 10 )
|
||||
PARAMETER ( NSUBS = 9 )
|
||||
COMPLEX ZERO, ONE
|
||||
PARAMETER ( ZERO = ( 0.0, 0.0 ), ONE = ( 1.0, 0.0 ) )
|
||||
REAL RZERO
|
||||
@@ -109,7 +108,7 @@
|
||||
LOGICAL FATAL, LTESTT, REWI, SAME, SFATAL, TRACE,
|
||||
$ TSTERR
|
||||
CHARACTER*1 TRANSA, TRANSB
|
||||
CHARACTER*7 SNAMET
|
||||
CHARACTER*6 SNAMET
|
||||
CHARACTER*32 SNAPS, SUMMRY
|
||||
* .. Local Arrays ..
|
||||
COMPLEX AA( NMAX*NMAX ), AB( NMAX, 2*NMAX ),
|
||||
@@ -121,27 +120,26 @@
|
||||
REAL G( NMAX )
|
||||
INTEGER IDIM( NIDMAX )
|
||||
LOGICAL LTEST( NSUBS )
|
||||
CHARACTER*7 SNAMES( NSUBS )
|
||||
CHARACTER*6 SNAMES( NSUBS )
|
||||
* .. External Functions ..
|
||||
REAL SDIFF
|
||||
LOGICAL LCE
|
||||
EXTERNAL SDIFF, LCE
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL CCHK1, CCHK2, CCHK3, CCHK4, CCHK5, CCHKE, CMMCH
|
||||
EXTERNAL CCHK6
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC MAX, MIN
|
||||
* .. Scalars in Common ..
|
||||
INTEGER INFOT, NOUTC
|
||||
LOGICAL LERR, OK
|
||||
CHARACTER*7 SRNAMT
|
||||
CHARACTER*6 SRNAMT
|
||||
* .. Common blocks ..
|
||||
COMMON /INFOC/INFOT, NOUTC, OK, LERR
|
||||
COMMON /SRNAMC/SRNAMT
|
||||
* .. Data statements ..
|
||||
DATA SNAMES/'CGEMM ', 'CHEMM ', 'CSYMM ', 'CTRMM ',
|
||||
$ 'CTRSM ', 'CHERK ', 'CSYRK ', 'CHER2K',
|
||||
$ 'CSYR2K', 'CGEMMTR'/
|
||||
$ 'CSYR2K'/
|
||||
* .. Executable Statements ..
|
||||
*
|
||||
* Read name and unit number for summary output file and open file.
|
||||
@@ -319,7 +317,7 @@
|
||||
OK = .TRUE.
|
||||
FATAL = .FALSE.
|
||||
GO TO ( 140, 150, 150, 160, 160, 170, 170,
|
||||
$ 180, 180, 185 )ISNUM
|
||||
$ 180, 180 )ISNUM
|
||||
* Test CGEMM, 01.
|
||||
140 CALL CCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
|
||||
@@ -348,11 +346,6 @@
|
||||
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
|
||||
$ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W )
|
||||
GO TO 190
|
||||
185 CALL CCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
|
||||
$ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
|
||||
$ CC, CS, CT, G )
|
||||
|
||||
*
|
||||
190 IF( FATAL.AND.SFATAL )
|
||||
$ GO TO 210
|
||||
@@ -397,8 +390,8 @@
|
||||
$ 'ERR = ', F12.3, '.', /' THIS MAY BE DUE TO FAULTS IN THE ',
|
||||
$ 'ARITHMETIC OR THE COMPILER.', /' ******* TESTS ABANDONED ',
|
||||
$ '*******' )
|
||||
9988 FORMAT( A7, L2 )
|
||||
9987 FORMAT( 1X, A7, ' WAS NOT TESTED' )
|
||||
9988 FORMAT( A6, L2 )
|
||||
9987 FORMAT( 1X, A6, ' WAS NOT TESTED' )
|
||||
9986 FORMAT( /' END OF TESTS' )
|
||||
9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' )
|
||||
9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' )
|
||||
@@ -429,7 +422,7 @@
|
||||
REAL EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*7 SNAME
|
||||
CHARACTER*6 SNAME
|
||||
* .. Array Arguments ..
|
||||
COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
@@ -714,7 +707,7 @@
|
||||
REAL EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*7 SNAME
|
||||
CHARACTER*6 SNAME
|
||||
* .. Array Arguments ..
|
||||
COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
@@ -993,7 +986,7 @@
|
||||
REAL EPS, THRESH
|
||||
INTEGER NALF, NIDIM, NMAX, NOUT, NTRA
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*7 SNAME
|
||||
CHARACTER*6 SNAME
|
||||
* .. Array Arguments ..
|
||||
COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
@@ -1303,7 +1296,7 @@
|
||||
REAL EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*7 SNAME
|
||||
CHARACTER*6 SNAME
|
||||
* .. Array Arguments ..
|
||||
COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
@@ -1635,7 +1628,7 @@
|
||||
REAL EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*7 SNAME
|
||||
CHARACTER*6 SNAME
|
||||
* .. Array Arguments ..
|
||||
COMPLEX AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ),
|
||||
$ ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ),
|
||||
@@ -2005,7 +1998,7 @@
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
INTEGER ISNUM, NOUT
|
||||
CHARACTER*7 SRNAMT
|
||||
CHARACTER*6 SRNAMT
|
||||
* .. Scalars in Common ..
|
||||
INTEGER INFOT, NOUTC
|
||||
LOGICAL LERR, OK
|
||||
@@ -2038,7 +2031,7 @@
|
||||
RBETA = TWO
|
||||
*
|
||||
GO TO ( 10, 20, 30, 40, 50, 60, 70, 80,
|
||||
$ 90, 100 )ISNUM
|
||||
$ 90 )ISNUM
|
||||
10 INFOT = 1
|
||||
CALL CGEMM( '/', 'N', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
@@ -2219,7 +2212,7 @@
|
||||
INFOT = 13
|
||||
CALL CGEMM( 'T', 'T', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
GO TO 110
|
||||
GO TO 100
|
||||
20 INFOT = 1
|
||||
CALL CHEMM( '/', 'U', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
@@ -2286,7 +2279,7 @@
|
||||
INFOT = 12
|
||||
CALL CHEMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
GO TO 110
|
||||
GO TO 100
|
||||
30 INFOT = 1
|
||||
CALL CSYMM( '/', 'U', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
@@ -2353,7 +2346,7 @@
|
||||
INFOT = 12
|
||||
CALL CSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
GO TO 110
|
||||
GO TO 100
|
||||
40 INFOT = 1
|
||||
CALL CTRMM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
@@ -2510,7 +2503,7 @@
|
||||
INFOT = 11
|
||||
CALL CTRMM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
GO TO 110
|
||||
GO TO 100
|
||||
50 INFOT = 1
|
||||
CALL CTRSM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
@@ -2667,7 +2660,7 @@
|
||||
INFOT = 11
|
||||
CALL CTRSM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
GO TO 110
|
||||
GO TO 100
|
||||
60 INFOT = 1
|
||||
CALL CHERK( '/', 'N', 0, 0, RALPHA, A, 1, RBETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
@@ -2722,7 +2715,7 @@
|
||||
INFOT = 10
|
||||
CALL CHERK( 'L', 'C', 2, 0, RALPHA, A, 1, RBETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
GO TO 110
|
||||
GO TO 100
|
||||
70 INFOT = 1
|
||||
CALL CSYRK( '/', 'N', 0, 0, ALPHA, A, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
@@ -2777,7 +2770,7 @@
|
||||
INFOT = 10
|
||||
CALL CSYRK( 'L', 'T', 2, 0, ALPHA, A, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
GO TO 110
|
||||
GO TO 100
|
||||
80 INFOT = 1
|
||||
CALL CHER2K( '/', 'N', 0, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
@@ -2844,7 +2837,7 @@
|
||||
INFOT = 12
|
||||
CALL CHER2K( 'L', 'C', 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
GO TO 110
|
||||
GO TO 100
|
||||
90 INFOT = 1
|
||||
CALL CSYR2K( '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
@@ -2911,204 +2904,8 @@
|
||||
INFOT = 12
|
||||
CALL CSYR2K( 'L', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
GO TO 110
|
||||
100 INFOT = 1
|
||||
CALL CGEMMTR( '/', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 1
|
||||
CALL CGEMMTR( '/', 'N', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 1
|
||||
CALL CGEMMTR( '/', 'N', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 1
|
||||
CALL CGEMMTR( '/', 'T', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 1
|
||||
CALL CGEMMTR( '/', 'T', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 1
|
||||
CALL CGEMMTR( '/', 'T', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 1
|
||||
CALL CGEMMTR( '/', 'C', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 1
|
||||
CALL CGEMMTR( '/', 'C', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 1
|
||||
CALL CGEMMTR( '/', 'C', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
|
||||
INFOT = 2
|
||||
CALL CGEMMTR( 'U', '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 2
|
||||
CALL CGEMMTR( 'U', '/', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 2
|
||||
CALL CGEMMTR( 'U', '/', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 2
|
||||
CALL CGEMMTR( 'L', '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 2
|
||||
CALL CGEMMTR( 'L', '/', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 2
|
||||
CALL CGEMMTR( 'L', '/', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
|
||||
INFOT = 3
|
||||
CALL CGEMMTR( 'U', 'N', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 3
|
||||
CALL CGEMMTR( 'U', 'C', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 3
|
||||
CALL CGEMMTR( 'U', 'T', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL CGEMMTR( 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL CGEMMTR( 'U', 'N', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL CGEMMTR( 'U', 'N', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL CGEMMTR( 'U', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL CGEMMTR( 'U', 'C', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL CGEMMTR( 'U', 'C', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL CGEMMTR( 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL CGEMMTR( 'U', 'T', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL CGEMMTR( 'U', 'T', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 5
|
||||
CALL CGEMMTR( 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 5
|
||||
CALL CGEMMTR( 'U', 'N', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 5
|
||||
CALL CGEMMTR( 'U', 'N', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 5
|
||||
CALL CGEMMTR( 'U', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 5
|
||||
CALL CGEMMTR( 'U', 'C', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 5
|
||||
CALL CGEMMTR( 'U', 'C', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 5
|
||||
CALL CGEMMTR( 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 5
|
||||
CALL CGEMMTR( 'U', 'T', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 5
|
||||
CALL CGEMMTR( 'U', 'T', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
|
||||
INFOT = 8
|
||||
CALL CGEMMTR( 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL CGEMMTR( 'U', 'N', 'C', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL CGEMMTR( 'U', 'N', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL CGEMMTR( 'U', 'C', 'N', 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL CGEMMTR( 'U', 'C', 'C', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL CGEMMTR( 'U', 'C', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL CGEMMTR( 'U', 'T', 'N', 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL CGEMMTR( 'U', 'T', 'C', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL CGEMMTR( 'U', 'T', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
|
||||
INFOT = 10
|
||||
CALL CGEMMTR( 'U', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 10
|
||||
CALL CGEMMTR( 'U', 'C', 'N', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 10
|
||||
CALL CGEMMTR( 'U', 'T', 'N', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 13
|
||||
CALL CGEMMTR( 'U', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 13
|
||||
CALL CGEMMTR( 'U', 'N', 'C', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 13
|
||||
CALL CGEMMTR( 'U', 'N', 'T', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 13
|
||||
CALL CGEMMTR( 'U', 'C', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 13
|
||||
CALL CGEMMTR( 'U', 'C', 'C', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 13
|
||||
CALL CGEMMTR( 'U', 'C', 'T', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 13
|
||||
CALL CGEMMTR( 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 13
|
||||
CALL CGEMMTR( 'U', 'T', 'C', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 13
|
||||
CALL CGEMMTR( 'U', 'T', 'T', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
GO TO 110
|
||||
|
||||
*
|
||||
110 IF( OK )THEN
|
||||
100 IF( OK )THEN
|
||||
WRITE( NOUT, FMT = 9999 )SRNAMT
|
||||
ELSE
|
||||
WRITE( NOUT, FMT = 9998 )SRNAMT
|
||||
@@ -3619,7 +3416,7 @@
|
||||
* .. Scalar Arguments ..
|
||||
INTEGER INFOT, NOUT
|
||||
LOGICAL LERR, OK
|
||||
CHARACTER*7 SRNAMT
|
||||
CHARACTER*6 SRNAMT
|
||||
* .. Executable Statements ..
|
||||
IF( .NOT.LERR )THEN
|
||||
WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT
|
||||
@@ -3655,11 +3452,11 @@
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
INTEGER INFO
|
||||
CHARACTER*(*) SRNAME
|
||||
CHARACTER*6 SRNAME
|
||||
* .. Scalars in Common ..
|
||||
INTEGER INFOT, NOUT
|
||||
LOGICAL LERR, OK
|
||||
CHARACTER*7 SRNAMT
|
||||
CHARACTER*6 SRNAMT
|
||||
* .. Common blocks ..
|
||||
COMMON /INFOC/INFOT, NOUT, OK, LERR
|
||||
COMMON /SRNAMC/SRNAMT
|
||||
@@ -3689,496 +3486,3 @@
|
||||
* End of XERBLA
|
||||
*
|
||||
END
|
||||
|
||||
SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
|
||||
$ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
|
||||
$ A, AA, AS, B, BB, BS, C, CC, CS, CT, G )
|
||||
*
|
||||
* Tests CGEMMTR.
|
||||
*
|
||||
* Auxiliary routine for test program for Level 3 Blas.
|
||||
*
|
||||
* -- Written on 8-February-1989.
|
||||
* Jack Dongarra, Argonne National Laboratory.
|
||||
* Iain Duff, AERE Harwell.
|
||||
* Jeremy Du Croz, Numerical Algorithms Group Ltd.
|
||||
* Sven Hammarling, Numerical Algorithms Group Ltd.
|
||||
*
|
||||
* .. Parameters ..
|
||||
COMPLEX ZERO
|
||||
PARAMETER ( ZERO = ( 0.0, 0.0 ) )
|
||||
REAL RZERO
|
||||
PARAMETER ( RZERO = 0.0 )
|
||||
* .. Scalar Arguments ..
|
||||
REAL EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*7 SNAME
|
||||
* .. Array Arguments ..
|
||||
COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
$ BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
|
||||
$ C( NMAX, NMAX ), CC( NMAX*NMAX ),
|
||||
$ CS( NMAX*NMAX ), CT( NMAX )
|
||||
REAL G( NMAX )
|
||||
INTEGER IDIM( NIDIM )
|
||||
* .. Local Scalars ..
|
||||
COMPLEX ALPHA, ALS, BETA, BLS
|
||||
REAL ERR, ERRMAX
|
||||
INTEGER I, IA, IB, ICA, ICB, IK, IN, K, KS, LAA,
|
||||
$ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS,
|
||||
$ MA, MB, N, NA, NARGS, NB, NC, NS, IS
|
||||
LOGICAL NULL, RESET, SAME, TRANA, TRANB
|
||||
CHARACTER*1 TRANAS, TRANBS, TRANSA, TRANSB, UPLO, UPLOS
|
||||
CHARACTER*3 ICH
|
||||
CHARACTER*2 ISHAPE
|
||||
* .. Local Arrays ..
|
||||
LOGICAL ISAME( 13 )
|
||||
* .. External Functions ..
|
||||
LOGICAL LCE, LCERES
|
||||
EXTERNAL LCE, LCERES
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL CGEMM, CMAKE, CMMCH
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC MAX
|
||||
* .. Scalars in Common ..
|
||||
INTEGER INFOT, NOUTC
|
||||
LOGICAL LERR, OK
|
||||
* .. Common blocks ..
|
||||
COMMON /INFOC/INFOT, NOUTC, OK, LERR
|
||||
* .. Data statements ..
|
||||
DATA ICH/'NTC'/
|
||||
DATA ISHAPE/'UL'/
|
||||
|
||||
* .. Executable Statements ..
|
||||
*
|
||||
NARGS = 13
|
||||
NC = 0
|
||||
RESET = .TRUE.
|
||||
ERRMAX = RZERO
|
||||
*
|
||||
DO 100 IN = 1, NIDIM
|
||||
N = IDIM( IN )
|
||||
* Set LDC to 1 more than minimum value if room.
|
||||
LDC = N
|
||||
IF( LDC.LT.NMAX )
|
||||
$ LDC = LDC + 1
|
||||
* Skip tests if not enough room.
|
||||
IF( LDC.GT.NMAX )
|
||||
$ GO TO 100
|
||||
LCC = LDC*N
|
||||
NULL = N.LE.0
|
||||
*
|
||||
DO 90 IK = 1, NIDIM
|
||||
K = IDIM( IK )
|
||||
*
|
||||
DO 80 ICA = 1, 3
|
||||
TRANSA = ICH( ICA: ICA )
|
||||
TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C'
|
||||
*
|
||||
IF( TRANA )THEN
|
||||
MA = K
|
||||
NA = N
|
||||
ELSE
|
||||
MA = N
|
||||
NA = K
|
||||
END IF
|
||||
* Set LDA to 1 more than minimum value if room.
|
||||
LDA = MA
|
||||
IF( LDA.LT.NMAX )
|
||||
$ LDA = LDA + 1
|
||||
* Skip tests if not enough room.
|
||||
IF( LDA.GT.NMAX )
|
||||
$ GO TO 80
|
||||
LAA = LDA*NA
|
||||
*
|
||||
* Generate the matrix A.
|
||||
*
|
||||
CALL CMAKE( 'GE', ' ', ' ', MA, NA, A, NMAX, AA, LDA,
|
||||
$ RESET, ZERO )
|
||||
*
|
||||
DO 70 ICB = 1, 3
|
||||
TRANSB = ICH( ICB: ICB )
|
||||
TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C'
|
||||
*
|
||||
IF( TRANB )THEN
|
||||
MB = N
|
||||
NB = K
|
||||
ELSE
|
||||
MB = K
|
||||
NB = N
|
||||
END IF
|
||||
* Set LDB to 1 more than minimum value if room.
|
||||
LDB = MB
|
||||
IF( LDB.LT.NMAX )
|
||||
$ LDB = LDB + 1
|
||||
* Skip tests if not enough room.
|
||||
IF( LDB.GT.NMAX )
|
||||
$ GO TO 70
|
||||
LBB = LDB*NB
|
||||
*
|
||||
* Generate the matrix B.
|
||||
*
|
||||
CALL CMAKE( 'GE', ' ', ' ', MB, NB, B, NMAX, BB,
|
||||
$ LDB, RESET, ZERO )
|
||||
*
|
||||
DO 60 IA = 1, NALF
|
||||
ALPHA = ALF( IA )
|
||||
*
|
||||
DO 50 IB = 1, NBET
|
||||
BETA = BET( IB )
|
||||
DO 45 IS = 1, 2
|
||||
UPLO = ISHAPE( IS: IS )
|
||||
|
||||
*
|
||||
* Generate the matrix C.
|
||||
*
|
||||
CALL CMAKE( 'GE', UPLO, ' ', N, N, C, NMAX,
|
||||
$ CC, LDC, RESET, ZERO )
|
||||
*
|
||||
NC = NC + 1
|
||||
*
|
||||
* Save every datum before calling the
|
||||
* subroutine.
|
||||
*
|
||||
UPLOS = UPLO
|
||||
TRANAS = TRANSA
|
||||
TRANBS = TRANSB
|
||||
NS = N
|
||||
KS = K
|
||||
ALS = ALPHA
|
||||
DO 10 I = 1, LAA
|
||||
AS( I ) = AA( I )
|
||||
10 CONTINUE
|
||||
LDAS = LDA
|
||||
DO 20 I = 1, LBB
|
||||
BS( I ) = BB( I )
|
||||
20 CONTINUE
|
||||
LDBS = LDB
|
||||
BLS = BETA
|
||||
DO 30 I = 1, LCC
|
||||
CS( I ) = CC( I )
|
||||
30 CONTINUE
|
||||
LDCS = LDC
|
||||
*
|
||||
* Call the subroutine.
|
||||
*
|
||||
IF( TRACE )
|
||||
$ WRITE( NTRA, FMT = 9995 )NC, SNAME, UPLO,
|
||||
$ TRANSA, TRANSB, N, K, ALPHA, LDA, LDB,
|
||||
$ BETA, LDC
|
||||
IF( REWI )
|
||||
$ REWIND NTRA
|
||||
CALL CGEMMTR( UPLO, TRANSA, TRANSB, N, K,
|
||||
$ ALPHA, AA, LDA, BB, LDB, BETA,
|
||||
$ CC, LDC )
|
||||
*
|
||||
* Check if error-exit was taken incorrectly.
|
||||
*
|
||||
IF( .NOT.OK )THEN
|
||||
WRITE( NOUT, FMT = 9994 )
|
||||
FATAL = .TRUE.
|
||||
GO TO 120
|
||||
END IF
|
||||
*
|
||||
* See what data changed inside subroutines.
|
||||
*
|
||||
ISAME( 1 ) = UPLOS.EQ.UPLO
|
||||
ISAME( 2 ) = TRANSA.EQ.TRANAS
|
||||
ISAME( 3 ) = TRANSB.EQ.TRANBS
|
||||
ISAME( 4 ) = NS.EQ.N
|
||||
ISAME( 5 ) = KS.EQ.K
|
||||
ISAME( 6 ) = ALS.EQ.ALPHA
|
||||
ISAME( 7 ) = LCE( AS, AA, LAA )
|
||||
ISAME( 8 ) = LDAS.EQ.LDA
|
||||
ISAME( 9 ) = LCE( BS, BB, LBB )
|
||||
ISAME( 10 ) = LDBS.EQ.LDB
|
||||
ISAME( 11 ) = BLS.EQ.BETA
|
||||
IF( NULL )THEN
|
||||
ISAME( 12 ) = LCE( CS, CC, LCC )
|
||||
ELSE
|
||||
ISAME( 12 ) = LCERES( 'GE', ' ', N, N, CS,
|
||||
$ CC, LDC )
|
||||
END IF
|
||||
ISAME( 13 ) = LDCS.EQ.LDC
|
||||
*
|
||||
* If data was incorrectly changed, report
|
||||
* and return.
|
||||
*
|
||||
SAME = .TRUE.
|
||||
DO 40 I = 1, NARGS
|
||||
SAME = SAME.AND.ISAME( I )
|
||||
IF( .NOT.ISAME( I ) )
|
||||
$ WRITE( NOUT, FMT = 9998 )I
|
||||
40 CONTINUE
|
||||
IF( .NOT.SAME )THEN
|
||||
FATAL = .TRUE.
|
||||
GO TO 120
|
||||
END IF
|
||||
*
|
||||
IF( .NOT.NULL )THEN
|
||||
*
|
||||
* Check the result.
|
||||
*
|
||||
CALL CMMTCH( UPLO, TRANSA, TRANSB, N,
|
||||
$ K, ALPHA, A, NMAX, B, NMAX,
|
||||
$ BETA, C, NMAX, CT, G, CC, LDC,
|
||||
$ EPS, ERR, FATAL, NOUT, .TRUE.)
|
||||
ERRMAX = MAX( ERRMAX, ERR )
|
||||
* If got really bad answer, report and
|
||||
* return.
|
||||
IF( FATAL )
|
||||
$ GO TO 120
|
||||
END IF
|
||||
45 CONTINUE
|
||||
*
|
||||
50 CONTINUE
|
||||
*
|
||||
60 CONTINUE
|
||||
*
|
||||
70 CONTINUE
|
||||
*
|
||||
80 CONTINUE
|
||||
*
|
||||
90 CONTINUE
|
||||
*
|
||||
100 CONTINUE
|
||||
*
|
||||
*
|
||||
* Report result.
|
||||
*
|
||||
IF( ERRMAX.LT.THRESH )THEN
|
||||
WRITE( NOUT, FMT = 9999 )SNAME, NC
|
||||
ELSE
|
||||
WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
|
||||
END IF
|
||||
GO TO 130
|
||||
*
|
||||
120 CONTINUE
|
||||
WRITE( NOUT, FMT = 9996 )SNAME
|
||||
WRITE( NOUT, FMT = 9995 )NC, SNAME, TRANSA, TRANSB, N, K,
|
||||
$ ALPHA, LDA, LDB, BETA, LDC
|
||||
*
|
||||
130 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
|
||||
$ 'S)' )
|
||||
9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
|
||||
$ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
|
||||
$ ' - SUSPECT *******' )
|
||||
9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( 1X, I6, ': ', A6, '(''',A1, ''',''',A1, ''',''', A1,''',',
|
||||
$ 2( I3, ',' ), '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3,
|
||||
$ ',(', F4.1, ',', F4.1, '), C,', I3, ').' )
|
||||
9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
$ '******' )
|
||||
*
|
||||
* End of CCHK6
|
||||
*
|
||||
END
|
||||
|
||||
SUBROUTINE CMMTCH( UPLO, TRANSA, TRANSB, N, KK, ALPHA, A, LDA,
|
||||
$ B, LDB, BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR,
|
||||
$ FATAL, NOUT, MV )
|
||||
IMPLICIT NONE
|
||||
*
|
||||
* Checks the results of the computational tests.
|
||||
*
|
||||
* Auxiliary routine for test program for Level 3 Blas.
|
||||
*
|
||||
* -- Written on 8-February-1989.
|
||||
* Jack Dongarra, Argonne National Laboratory.
|
||||
* Iain Duff, AERE Harwell.
|
||||
* Jeremy Du Croz, Numerical Algorithms Group Ltd.
|
||||
* Sven Hammarling, Numerical Algorithms Group Ltd.
|
||||
*
|
||||
* .. Parameters ..
|
||||
COMPLEX ZERO
|
||||
PARAMETER ( ZERO = ( 0.0, 0.0 ) )
|
||||
REAL RZERO, RONE
|
||||
PARAMETER ( RZERO = 0.0, RONE = 1.0 )
|
||||
* .. Scalar Arguments ..
|
||||
COMPLEX ALPHA, BETA
|
||||
REAL EPS, ERR
|
||||
INTEGER KK, LDA, LDB, LDC, LDCC, N, NOUT
|
||||
LOGICAL FATAL, MV
|
||||
CHARACTER*1 TRANSA, TRANSB, UPLO
|
||||
* .. Array Arguments ..
|
||||
COMPLEX A( LDA, * ), B( LDB, * ), C( LDC, * ),
|
||||
$ CC( LDCC, * ), CT( * )
|
||||
REAL G( * )
|
||||
* .. Local Scalars ..
|
||||
COMPLEX CL
|
||||
REAL ERRI
|
||||
INTEGER I, J, K, ISTART, ISTOP
|
||||
LOGICAL CTRANA, CTRANB, TRANA, TRANB, UPPER
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC ABS, AIMAG, CONJG, MAX, REAL, SQRT
|
||||
* .. Statement Functions ..
|
||||
REAL ABS1
|
||||
* .. Statement Function definitions ..
|
||||
ABS1( CL ) = ABS( REAL( CL ) ) + ABS( AIMAG( CL ) )
|
||||
* .. Executable Statements ..
|
||||
UPPER = UPLO.EQ.'U'
|
||||
TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C'
|
||||
TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C'
|
||||
CTRANA = TRANSA.EQ.'C'
|
||||
CTRANB = TRANSB.EQ.'C'
|
||||
*
|
||||
* Compute expected result, one column at a time, in CT using data
|
||||
* in A, B and C.
|
||||
* Compute gauges in G.
|
||||
*
|
||||
ISTART = 1
|
||||
ISTOP = 1
|
||||
|
||||
DO 220 J = 1, N
|
||||
*
|
||||
IF ( UPPER ) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
|
||||
DO 10 I = ISTART, ISTOP
|
||||
CT( I ) = ZERO
|
||||
G( I ) = RZERO
|
||||
10 CONTINUE
|
||||
IF( .NOT.TRANA.AND..NOT.TRANB )THEN
|
||||
DO 30 K = 1, KK
|
||||
DO 20 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( I, K )*B( K, J )
|
||||
G( I ) = G( I ) + ABS1( A( I, K ) )*ABS1( B( K, J ) )
|
||||
20 CONTINUE
|
||||
30 CONTINUE
|
||||
ELSE IF( TRANA.AND..NOT.TRANB )THEN
|
||||
IF( CTRANA )THEN
|
||||
DO 50 K = 1, KK
|
||||
DO 40 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + CONJG( A( K, I ) )*B( K, J )
|
||||
G( I ) = G( I ) + ABS1( A( K, I ) )*
|
||||
$ ABS1( B( K, J ) )
|
||||
40 CONTINUE
|
||||
50 CONTINUE
|
||||
ELSE
|
||||
DO 70 K = 1, KK
|
||||
DO 60 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( K, I )*B( K, J )
|
||||
G( I ) = G( I ) + ABS1( A( K, I ) )*
|
||||
$ ABS1( B( K, J ) )
|
||||
60 CONTINUE
|
||||
70 CONTINUE
|
||||
END IF
|
||||
ELSE IF( .NOT.TRANA.AND.TRANB )THEN
|
||||
IF( CTRANB )THEN
|
||||
DO 90 K = 1, KK
|
||||
DO 80 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( I, K )*CONJG( B( J, K ) )
|
||||
G( I ) = G( I ) + ABS1( A( I, K ) )*
|
||||
$ ABS1( B( J, K ) )
|
||||
80 CONTINUE
|
||||
90 CONTINUE
|
||||
ELSE
|
||||
DO 110 K = 1, KK
|
||||
DO 100 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( I, K )*B( J, K )
|
||||
G( I ) = G( I ) + ABS1( A( I, K ) )*
|
||||
$ ABS1( B( J, K ) )
|
||||
100 CONTINUE
|
||||
110 CONTINUE
|
||||
END IF
|
||||
ELSE IF( TRANA.AND.TRANB )THEN
|
||||
IF( CTRANA )THEN
|
||||
IF( CTRANB )THEN
|
||||
DO 130 K = 1, KK
|
||||
DO 120 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + CONJG( A( K, I ) )*
|
||||
$ CONJG( B( J, K ) )
|
||||
G( I ) = G( I ) + ABS1( A( K, I ) )*
|
||||
$ ABS1( B( J, K ) )
|
||||
120 CONTINUE
|
||||
130 CONTINUE
|
||||
ELSE
|
||||
DO 150 K = 1, KK
|
||||
DO 140 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + CONJG( A( K, I ) )*B( J, K )
|
||||
G( I ) = G( I ) + ABS1( A( K, I ) )*
|
||||
$ ABS1( B( J, K ) )
|
||||
140 CONTINUE
|
||||
150 CONTINUE
|
||||
END IF
|
||||
ELSE
|
||||
IF( CTRANB )THEN
|
||||
DO 170 K = 1, KK
|
||||
DO 160 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( K, I )*CONJG( B( J, K ) )
|
||||
G( I ) = G( I ) + ABS1( A( K, I ) )*
|
||||
$ ABS1( B( J, K ) )
|
||||
160 CONTINUE
|
||||
170 CONTINUE
|
||||
ELSE
|
||||
DO 190 K = 1, KK
|
||||
DO 180 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( K, I )*B( J, K )
|
||||
G( I ) = G( I ) + ABS1( A( K, I ) )*
|
||||
$ ABS1( B( J, K ) )
|
||||
180 CONTINUE
|
||||
190 CONTINUE
|
||||
END IF
|
||||
END IF
|
||||
END IF
|
||||
DO 200 I = ISTART, ISTOP
|
||||
CT( I ) = ALPHA*CT( I ) + BETA*C( I, J )
|
||||
G( I ) = ABS1( ALPHA )*G( I ) +
|
||||
$ ABS1( BETA )*ABS1( C( I, J ) )
|
||||
200 CONTINUE
|
||||
*
|
||||
* Compute the error ratio for this result.
|
||||
*
|
||||
ERR = ZERO
|
||||
DO 210 I = ISTART, ISTOP
|
||||
ERRI = ABS1( CT( I ) - CC( I, J ) )/EPS
|
||||
IF( G( I ).NE.RZERO )
|
||||
$ ERRI = ERRI/G( I )
|
||||
ERR = MAX( ERR, ERRI )
|
||||
IF( ERR*SQRT( EPS ).GE.RONE )
|
||||
$ GO TO 230
|
||||
210 CONTINUE
|
||||
*
|
||||
220 CONTINUE
|
||||
*
|
||||
* If the loop completes, all results are at least half accurate.
|
||||
GO TO 250
|
||||
*
|
||||
* Report fatal error.
|
||||
*
|
||||
230 FATAL = .TRUE.
|
||||
WRITE( NOUT, FMT = 9999 )
|
||||
DO 240 I = ISTART, ISTOP
|
||||
IF( MV )THEN
|
||||
WRITE( NOUT, FMT = 9998 )I, CT( I ), CC( I, J )
|
||||
ELSE
|
||||
WRITE( NOUT, FMT = 9998 )I, CC( I, J ), CT( I )
|
||||
END IF
|
||||
240 CONTINUE
|
||||
IF( N.GT.1 )
|
||||
$ WRITE( NOUT, FMT = 9997 )J
|
||||
*
|
||||
250 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
|
||||
$ 'F ACCURATE *******', /' EXPECTED RE',
|
||||
$ 'SULT COMPUTED RESULT' )
|
||||
9998 FORMAT( 1X, I7, 2( ' (', G15.6, ',', G15.6, ')' ) )
|
||||
9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 )
|
||||
*
|
||||
* End of CMMTCH
|
||||
*
|
||||
END
|
||||
|
||||
|
||||
+9
-10
@@ -12,13 +12,12 @@ T LOGICAL FLAG, T TO TEST ERROR EXITS.
|
||||
(0.0,0.0) (1.0,0.0) (0.7,-0.9) VALUES OF ALPHA
|
||||
3 NUMBER OF VALUES OF BETA
|
||||
(0.0,0.0) (1.0,0.0) (1.3,-1.1) VALUES OF BETA
|
||||
CGEMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
CHEMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
CSYMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
CTRMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
CTRSM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
CHERK T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
CSYRK T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
CHER2K T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
CSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
CGEMMTR T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
CGEMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
CHEMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
CSYMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
CTRMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
CTRSM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
CHERK T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
CSYRK T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
CHER2K T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
CSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
|
||||
@@ -1326,17 +1326,13 @@
|
||||
* .. Scalar Arguments ..
|
||||
DOUBLE PRECISION XX
|
||||
INTEGER K
|
||||
* .. Parameters ..
|
||||
DOUBLE PRECISION ZERO
|
||||
PARAMETER (ZERO=0.0D+0)
|
||||
* .. Local Scalars ..
|
||||
DOUBLE PRECISION X, Y, Z
|
||||
DOUBLE PRECISION X, Y, YY, Z
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC HUGE
|
||||
* .. Executable Statements ..
|
||||
X = ZERO
|
||||
Y = HUGE(XX)
|
||||
Z = Y*Y
|
||||
Z = YY
|
||||
IF (K.EQ.1) THEN
|
||||
X = -Z
|
||||
ELSE IF (K.EQ.2) THEN
|
||||
|
||||
+32
-535
@@ -19,10 +19,10 @@
|
||||
*> Test program for the DOUBLE PRECISION Level 3 Blas.
|
||||
*>
|
||||
*> The program must be driven by a short data file. The first 14 records
|
||||
*> of the file are read using list-directed input, the last 7 records
|
||||
*> of the file are read using list-directed input, the last 6 records
|
||||
*> are read using the format ( A6, L2 ). An annotated example of a data
|
||||
*> file can be obtained by deleting the first 3 characters from the
|
||||
*> following 21 lines:
|
||||
*> following 20 lines:
|
||||
*> 'dblat3.out' NAME OF SUMMARY OUTPUT FILE
|
||||
*> 6 UNIT NUMBER OF SUMMARY FILE
|
||||
*> 'DBLAT3.SNAP' NAME OF SNAPSHOT OUTPUT FILE
|
||||
@@ -37,13 +37,12 @@
|
||||
*> 0.0 1.0 0.7 VALUES OF ALPHA
|
||||
*> 3 NUMBER OF VALUES OF BETA
|
||||
*> 0.0 1.0 1.3 VALUES OF BETA
|
||||
*> DGEMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
*> DSYMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
*> DTRMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
*> DTRSM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
*> DSYRK T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
*> DSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
*> DGEMMTR T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
*> DGEMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
*> DSYMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
*> DTRMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
*> DTRSM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
*> DSYRK T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
*> DSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
*>
|
||||
*> Further Details
|
||||
*> ===============
|
||||
@@ -91,7 +90,7 @@
|
||||
INTEGER NIN
|
||||
PARAMETER ( NIN = 5 )
|
||||
INTEGER NSUBS
|
||||
PARAMETER ( NSUBS = 7 )
|
||||
PARAMETER ( NSUBS = 6 )
|
||||
DOUBLE PRECISION ZERO, ONE
|
||||
PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
|
||||
INTEGER NMAX
|
||||
@@ -104,7 +103,7 @@
|
||||
LOGICAL FATAL, LTESTT, REWI, SAME, SFATAL, TRACE,
|
||||
$ TSTERR
|
||||
CHARACTER*1 TRANSA, TRANSB
|
||||
CHARACTER*7 SNAMET
|
||||
CHARACTER*6 SNAMET
|
||||
CHARACTER*32 SNAPS, SUMMRY
|
||||
* .. Local Arrays ..
|
||||
DOUBLE PRECISION AA( NMAX*NMAX ), AB( NMAX, 2*NMAX ),
|
||||
@@ -115,7 +114,7 @@
|
||||
$ G( NMAX ), W( 2*NMAX )
|
||||
INTEGER IDIM( NIDMAX )
|
||||
LOGICAL LTEST( NSUBS )
|
||||
CHARACTER*7 SNAMES( NSUBS )
|
||||
CHARACTER*6 SNAMES( NSUBS )
|
||||
* .. External Functions ..
|
||||
DOUBLE PRECISION DDIFF
|
||||
LOGICAL LDE
|
||||
@@ -127,13 +126,13 @@
|
||||
* .. Scalars in Common ..
|
||||
INTEGER INFOT, NOUTC
|
||||
LOGICAL LERR, OK
|
||||
CHARACTER*7 SRNAMT
|
||||
CHARACTER*6 SRNAMT
|
||||
* .. Common blocks ..
|
||||
COMMON /INFOC/INFOT, NOUTC, OK, LERR
|
||||
COMMON /SRNAMC/SRNAMT
|
||||
* .. Data statements ..
|
||||
DATA SNAMES/'DGEMM ', 'DSYMM ', 'DTRMM ', 'DTRSM ',
|
||||
$ 'DSYRK ', 'DSYR2K', 'DGEMMTR'/
|
||||
$ 'DSYRK ', 'DSYR2K'/
|
||||
* .. Executable Statements ..
|
||||
*
|
||||
* Read name and unit number for summary output file and open file.
|
||||
@@ -310,7 +309,7 @@
|
||||
INFOT = 0
|
||||
OK = .TRUE.
|
||||
FATAL = .FALSE.
|
||||
GO TO ( 140, 150, 160, 160, 170, 180, 185 )ISNUM
|
||||
GO TO ( 140, 150, 160, 160, 170, 180 )ISNUM
|
||||
* Test DGEMM, 01.
|
||||
140 CALL DCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
|
||||
@@ -339,12 +338,6 @@
|
||||
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
|
||||
$ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W )
|
||||
GO TO 190
|
||||
* Test DGEMMTR, 07.
|
||||
185 CALL DCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
|
||||
$ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
|
||||
$ CC, CS, CT, G )
|
||||
|
||||
*
|
||||
190 IF( FATAL.AND.SFATAL )
|
||||
$ GO TO 210
|
||||
@@ -387,8 +380,8 @@
|
||||
$ 'ERR = ', F12.3, '.', /' THIS MAY BE DUE TO FAULTS IN THE ',
|
||||
$ 'ARITHMETIC OR THE COMPILER.', /' ******* TESTS ABANDONED ',
|
||||
$ '*******' )
|
||||
9988 FORMAT( A7, L2 )
|
||||
9987 FORMAT( 1X, A7, ' WAS NOT TESTED' )
|
||||
9988 FORMAT( A6, L2 )
|
||||
9987 FORMAT( 1X, A6, ' WAS NOT TESTED' )
|
||||
9986 FORMAT( /' END OF TESTS' )
|
||||
9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' )
|
||||
9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' )
|
||||
@@ -417,7 +410,7 @@
|
||||
DOUBLE PRECISION EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*7 SNAME
|
||||
CHARACTER*6 SNAME
|
||||
* .. Array Arguments ..
|
||||
DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
@@ -698,7 +691,7 @@
|
||||
DOUBLE PRECISION EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*7 SNAME
|
||||
CHARACTER*6 SNAME
|
||||
* .. Array Arguments ..
|
||||
DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
@@ -968,7 +961,7 @@
|
||||
DOUBLE PRECISION EPS, THRESH
|
||||
INTEGER NALF, NIDIM, NMAX, NOUT, NTRA
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*7 SNAME
|
||||
CHARACTER*6 SNAME
|
||||
* .. Array Arguments ..
|
||||
DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
@@ -1273,7 +1266,7 @@
|
||||
DOUBLE PRECISION EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*7 SNAME
|
||||
CHARACTER*6 SNAME
|
||||
* .. Array Arguments ..
|
||||
DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
@@ -1548,7 +1541,7 @@
|
||||
DOUBLE PRECISION EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*7 SNAME
|
||||
CHARACTER*6 SNAME
|
||||
* .. Array Arguments ..
|
||||
DOUBLE PRECISION AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ),
|
||||
$ ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ),
|
||||
@@ -1860,7 +1853,7 @@
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
INTEGER ISNUM, NOUT
|
||||
CHARACTER*7 SRNAMT
|
||||
CHARACTER*6 SRNAMT
|
||||
* .. Scalars in Common ..
|
||||
INTEGER INFOT, NOUTC
|
||||
LOGICAL LERR, OK
|
||||
@@ -1889,7 +1882,7 @@
|
||||
ALPHA = ONE
|
||||
BETA = TWO
|
||||
*
|
||||
GO TO ( 10, 20, 30, 40, 50, 60, 70 )ISNUM
|
||||
GO TO ( 10, 20, 30, 40, 50, 60 )ISNUM
|
||||
10 INFOT = 1
|
||||
CALL DGEMM( '/', 'N', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
@@ -1974,7 +1967,7 @@
|
||||
INFOT = 13
|
||||
CALL DGEMM( 'T', 'T', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
GO TO 80
|
||||
GO TO 70
|
||||
20 INFOT = 1
|
||||
CALL DSYMM( '/', 'U', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
@@ -2041,7 +2034,7 @@
|
||||
INFOT = 12
|
||||
CALL DSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
GO TO 80
|
||||
GO TO 70
|
||||
30 INFOT = 1
|
||||
CALL DTRMM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
@@ -2150,7 +2143,7 @@
|
||||
INFOT = 11
|
||||
CALL DTRMM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
GO TO 80
|
||||
GO TO 70
|
||||
40 INFOT = 1
|
||||
CALL DTRSM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
@@ -2259,7 +2252,7 @@
|
||||
INFOT = 11
|
||||
CALL DTRSM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
GO TO 80
|
||||
GO TO 70
|
||||
50 INFOT = 1
|
||||
CALL DSYRK( '/', 'N', 0, 0, ALPHA, A, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
@@ -2314,7 +2307,7 @@
|
||||
INFOT = 10
|
||||
CALL DSYRK( 'L', 'T', 2, 0, ALPHA, A, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
GO TO 80
|
||||
GO TO 70
|
||||
60 INFOT = 1
|
||||
CALL DSYR2K( '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
@@ -2381,87 +2374,8 @@
|
||||
INFOT = 12
|
||||
CALL DSYR2K( 'L', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
GO TO 80
|
||||
70 INFOT = 1
|
||||
CALL DGEMMTR( '/', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 2
|
||||
CALL DGEMMTR( 'U', '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 2
|
||||
CALL DGEMMTR( 'U', '/', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 3
|
||||
CALL DGEMMTR( 'U', 'N', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 3
|
||||
CALL DGEMMTR( 'U', 'T', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL DGEMMTR( 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL DGEMMTR( 'U', 'N', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL DGEMMTR( 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL DGEMMTR( 'U', 'T', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 5
|
||||
CALL DGEMMTR( 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 5
|
||||
CALL DGEMMTR( 'U', 'N', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 5
|
||||
CALL DGEMMTR( 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 5
|
||||
CALL DGEMMTR( 'U', 'T', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL DGEMMTR( 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2, BETA, C,
|
||||
$ 2 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL DGEMMTR( 'U', 'N', 'T', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 10
|
||||
CALL DGEMMTR( 'U', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 10
|
||||
CALL DGEMMTR( 'U', 'T', 'N', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 10
|
||||
CALL DGEMMTR( 'U', 'N', 'T', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 10
|
||||
CALL DGEMMTR( 'U', 'T', 'T', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 13
|
||||
CALL DGEMMTR( 'U', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 13
|
||||
CALL DGEMMTR( 'U', 'N', 'T', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 13
|
||||
CALL DGEMMTR( 'U', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 13
|
||||
CALL DGEMMTR( 'U', 'T', 'T', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
*
|
||||
80 IF( OK )THEN
|
||||
70 IF( OK )THEN
|
||||
WRITE( NOUT, FMT = 9999 )SRNAMT
|
||||
ELSE
|
||||
WRITE( NOUT, FMT = 9998 )SRNAMT
|
||||
@@ -2883,7 +2797,7 @@
|
||||
* .. Scalar Arguments ..
|
||||
INTEGER INFOT, NOUT
|
||||
LOGICAL LERR, OK
|
||||
CHARACTER*7 SRNAMT
|
||||
CHARACTER*6 SRNAMT
|
||||
* .. Executable Statements ..
|
||||
IF( .NOT.LERR )THEN
|
||||
WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT
|
||||
@@ -2919,11 +2833,11 @@
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
INTEGER INFO
|
||||
CHARACTER*(*) SRNAME
|
||||
CHARACTER*6 SRNAME
|
||||
* .. Scalars in Common ..
|
||||
INTEGER INFOT, NOUT
|
||||
LOGICAL LERR, OK
|
||||
CHARACTER*7 SRNAMT
|
||||
CHARACTER*6 SRNAMT
|
||||
* .. Common blocks ..
|
||||
COMMON /INFOC/INFOT, NOUT, OK, LERR
|
||||
COMMON /SRNAMC/SRNAMT
|
||||
@@ -2953,420 +2867,3 @@
|
||||
* End of XERBLA
|
||||
*
|
||||
END
|
||||
|
||||
SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
|
||||
$ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
|
||||
$ A, AA, AS, B, BB, BS, C, CC, CS, CT, G )
|
||||
*
|
||||
* Tests DGEMMTR.
|
||||
*
|
||||
* Auxiliary routine for test program for Level 3 Blas.
|
||||
*
|
||||
* -- Written on 19-July-2023.
|
||||
* Martin Koehler, MPI Magdeburg
|
||||
*
|
||||
* .. Parameters ..
|
||||
DOUBLE PRECISION ZERO
|
||||
PARAMETER ( ZERO = 0.0D0 )
|
||||
* .. Scalar Arguments ..
|
||||
DOUBLE PRECISION EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*7 SNAME
|
||||
* .. Array Arguments ..
|
||||
DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
$ BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
|
||||
$ C( NMAX, NMAX ), CC( NMAX*NMAX ),
|
||||
$ CS( NMAX*NMAX ), CT( NMAX ), G( NMAX )
|
||||
INTEGER IDIM( NIDIM )
|
||||
* .. Local Scalars ..
|
||||
DOUBLE PRECISION ALPHA, ALS, BETA, BLS, ERR, ERRMAX
|
||||
INTEGER I, IA, IB, ICA, ICB, IK, IN, K, KS, LAA,
|
||||
$ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS,
|
||||
$ MA, MB, N, NA, NARGS, NB, NC, NS, IS
|
||||
LOGICAL NULL, RESET, SAME, TRANA, TRANB
|
||||
CHARACTER*1 TRANAS, TRANBS, TRANSA, TRANSB, UPLO, UPLOS
|
||||
CHARACTER*3 ICH
|
||||
CHARACTER*2 ISHAPE
|
||||
* .. Local Arrays ..
|
||||
LOGICAL ISAME( 13 )
|
||||
* .. External Functions ..
|
||||
LOGICAL LDE, LDERES
|
||||
EXTERNAL LDE, LDERES
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL DGEMMTR, DMAKE, DMMTCH
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC MAX
|
||||
* .. Scalars in Common ..
|
||||
INTEGER INFOT, NOUTC
|
||||
LOGICAL LERR, OK
|
||||
* .. Common blocks ..
|
||||
COMMON /INFOC/INFOT, NOUTC, OK, LERR
|
||||
* .. Data statements ..
|
||||
DATA ICH/'NTC'/
|
||||
DATA ISHAPE/'UL'/
|
||||
* .. Executable Statements ..
|
||||
*
|
||||
NARGS = 13
|
||||
NC = 0
|
||||
RESET = .TRUE.
|
||||
ERRMAX = ZERO
|
||||
*
|
||||
DO 100 IN = 1, NIDIM
|
||||
N = IDIM( IN )
|
||||
* Set LDC to 1 more than minimum value if room.
|
||||
LDC = N
|
||||
IF( LDC.LT.NMAX )
|
||||
$ LDC = LDC + 1
|
||||
* Skip tests if not enough room.
|
||||
IF( LDC.GT.NMAX )
|
||||
$ GO TO 100
|
||||
LCC = LDC*N
|
||||
NULL = N.LE.0
|
||||
*
|
||||
DO 90 IK = 1, NIDIM
|
||||
K = IDIM( IK )
|
||||
*
|
||||
DO 80 ICA = 1, 3
|
||||
TRANSA = ICH( ICA: ICA )
|
||||
TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C'
|
||||
*
|
||||
IF( TRANA )THEN
|
||||
MA = K
|
||||
NA = N
|
||||
ELSE
|
||||
MA = N
|
||||
NA = K
|
||||
END IF
|
||||
* Set LDA to 1 more than minimum value if room.
|
||||
LDA = MA
|
||||
IF( LDA.LT.NMAX )
|
||||
$ LDA = LDA + 1
|
||||
* Skip tests if not enough room.
|
||||
IF( LDA.GT.NMAX )
|
||||
$ GO TO 80
|
||||
LAA = LDA*NA
|
||||
*
|
||||
* Generate the matrix A.
|
||||
*
|
||||
CALL DMAKE( 'GE', ' ', ' ', MA, NA, A, NMAX, AA, LDA,
|
||||
$ RESET, ZERO )
|
||||
*
|
||||
DO 70 ICB = 1, 3
|
||||
TRANSB = ICH( ICB: ICB )
|
||||
TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C'
|
||||
*
|
||||
IF( TRANB )THEN
|
||||
MB = N
|
||||
NB = K
|
||||
ELSE
|
||||
MB = K
|
||||
NB = N
|
||||
END IF
|
||||
* Set LDB to 1 more than minimum value if room.
|
||||
LDB = MB
|
||||
IF( LDB.LT.NMAX )
|
||||
$ LDB = LDB + 1
|
||||
* Skip tests if not enough room.
|
||||
IF( LDB.GT.NMAX )
|
||||
$ GO TO 70
|
||||
LBB = LDB*NB
|
||||
*
|
||||
* Generate the matrix B.
|
||||
*
|
||||
CALL DMAKE( 'GE', ' ', ' ', MB, NB, B, NMAX, BB,
|
||||
$ LDB, RESET, ZERO )
|
||||
*
|
||||
DO 60 IA = 1, NALF
|
||||
ALPHA = ALF( IA )
|
||||
*
|
||||
DO 50 IB = 1, NBET
|
||||
BETA = BET( IB )
|
||||
|
||||
DO 45 IS = 1, 2
|
||||
UPLO = ISHAPE( IS: IS )
|
||||
|
||||
*
|
||||
* Generate the matrix C.
|
||||
*
|
||||
CALL DMAKE( 'GE', UPLO, ' ', N, N, C,
|
||||
$ NMAX, CC, LDC, RESET, ZERO )
|
||||
*
|
||||
NC = NC + 1
|
||||
*
|
||||
* Save every datum before calling the
|
||||
* subroutine.
|
||||
*
|
||||
UPLOS = UPLO
|
||||
TRANAS = TRANSA
|
||||
TRANBS = TRANSB
|
||||
NS = N
|
||||
KS = K
|
||||
ALS = ALPHA
|
||||
DO 10 I = 1, LAA
|
||||
AS( I ) = AA( I )
|
||||
10 CONTINUE
|
||||
LDAS = LDA
|
||||
DO 20 I = 1, LBB
|
||||
BS( I ) = BB( I )
|
||||
20 CONTINUE
|
||||
LDBS = LDB
|
||||
BLS = BETA
|
||||
DO 30 I = 1, LCC
|
||||
CS( I ) = CC( I )
|
||||
30 CONTINUE
|
||||
LDCS = LDC
|
||||
*
|
||||
* Call the subroutine.
|
||||
*
|
||||
IF( TRACE )
|
||||
$ WRITE( NTRA, FMT = 9995 )NC, SNAME,
|
||||
$ UPLO, TRANSA, TRANSB, N, K, ALPHA, LDA,
|
||||
$ LDB, BETA, LDC
|
||||
IF( REWI )
|
||||
$ REWIND NTRA
|
||||
CALL DGEMMTR( UPLO, TRANSA, TRANSB, N,
|
||||
$ K, ALPHA, AA, LDA, BB, LDB,
|
||||
$ BETA, CC, LDC )
|
||||
*
|
||||
* Check if error-exit was taken incorrectly.
|
||||
*
|
||||
IF( .NOT.OK )THEN
|
||||
WRITE( NOUT, FMT = 9994 )
|
||||
FATAL = .TRUE.
|
||||
GO TO 120
|
||||
END IF
|
||||
*
|
||||
* See what data changed inside subroutines.
|
||||
*
|
||||
ISAME( 1 ) = UPLO.EQ.UPLOS
|
||||
ISAME( 2 ) = TRANSA.EQ.TRANAS
|
||||
ISAME( 3 ) = TRANSB.EQ.TRANBS
|
||||
ISAME( 4 ) = NS.EQ.N
|
||||
ISAME( 5 ) = KS.EQ.K
|
||||
ISAME( 6 ) = ALS.EQ.ALPHA
|
||||
ISAME( 7 ) = LDE( AS, AA, LAA )
|
||||
ISAME( 8 ) = LDAS.EQ.LDA
|
||||
ISAME( 9 ) = LDE( BS, BB, LBB )
|
||||
ISAME( 10 ) = LDBS.EQ.LDB
|
||||
ISAME( 11 ) = BLS.EQ.BETA
|
||||
IF( NULL )THEN
|
||||
ISAME( 12 ) = LDE( CS, CC, LCC )
|
||||
ELSE
|
||||
ISAME( 12 ) = LDERES( 'GE', ' ', N, N,
|
||||
$ CS, CC, LDC )
|
||||
END IF
|
||||
ISAME( 13 ) = LDCS.EQ.LDC
|
||||
*
|
||||
* If data was incorrectly changed, report
|
||||
* and return.
|
||||
*
|
||||
SAME = .TRUE.
|
||||
DO 40 I = 1, NARGS
|
||||
SAME = SAME.AND.ISAME( I )
|
||||
IF( .NOT.ISAME( I ) )
|
||||
$ WRITE( NOUT, FMT = 9998 )I
|
||||
40 CONTINUE
|
||||
IF( .NOT.SAME )THEN
|
||||
FATAL = .TRUE.
|
||||
GO TO 120
|
||||
END IF
|
||||
*
|
||||
IF( .NOT.NULL )THEN
|
||||
*
|
||||
* Check the result.
|
||||
*
|
||||
CALL DMMTCH( UPLO, TRANSA, TRANSB,
|
||||
$ N, K,
|
||||
$ ALPHA, A, NMAX, B, NMAX, BETA,
|
||||
$ C, NMAX, CT, G, CC, LDC, EPS,
|
||||
$ ERR, FATAL, NOUT, .TRUE. )
|
||||
ERRMAX = MAX( ERRMAX, ERR )
|
||||
* If got really bad answer, report and
|
||||
* return.
|
||||
IF( FATAL )
|
||||
$ GO TO 120
|
||||
END IF
|
||||
*
|
||||
45 CONTINUE
|
||||
*
|
||||
50 CONTINUE
|
||||
*
|
||||
60 CONTINUE
|
||||
*
|
||||
70 CONTINUE
|
||||
*
|
||||
80 CONTINUE
|
||||
*
|
||||
90 CONTINUE
|
||||
*
|
||||
100 CONTINUE
|
||||
*
|
||||
*
|
||||
* Report result.
|
||||
*
|
||||
IF( ERRMAX.LT.THRESH )THEN
|
||||
WRITE( NOUT, FMT = 9999 )SNAME, NC
|
||||
ELSE
|
||||
WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
|
||||
END IF
|
||||
GO TO 130
|
||||
*
|
||||
120 CONTINUE
|
||||
WRITE( NOUT, FMT = 9996 )SNAME
|
||||
WRITE( NOUT, FMT = 9995 )NC, SNAME, UPLO, TRANSA, TRANSB, N, K,
|
||||
$ ALPHA, LDA, LDB, BETA, LDC
|
||||
*
|
||||
130 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
|
||||
$ 'S)' )
|
||||
9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
|
||||
$ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
|
||||
$ ' - SUSPECT *******' )
|
||||
9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( 1X, I6, ': ', A6, '(''',A1, ''',''',A1, ''',''', A1,''',',
|
||||
$ 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', ',
|
||||
$ 'C,', I3, ').' )
|
||||
9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
$ '******' )
|
||||
*
|
||||
* End of DCHK6
|
||||
*
|
||||
END
|
||||
|
||||
SUBROUTINE DMMTCH( UPLO, TRANSA, TRANSB, N, KK, ALPHA, A, LDA,
|
||||
$ B, LDB, BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR,
|
||||
$ FATAL, NOUT, MV )
|
||||
*
|
||||
* Checks the results of the computational tests.
|
||||
*
|
||||
* Auxiliary routine for test program for Level 3 Blas. (DGEMMTR)
|
||||
*
|
||||
* -- Written on 19-July-2023.
|
||||
* Martin Koehler, MPI Magdeburg
|
||||
*
|
||||
* .. Parameters ..
|
||||
DOUBLE PRECISION ZERO, ONE
|
||||
PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
|
||||
* .. Scalar Arguments ..
|
||||
DOUBLE PRECISION ALPHA, BETA, EPS, ERR
|
||||
INTEGER KK, LDA, LDB, LDC, LDCC, N, NOUT
|
||||
LOGICAL FATAL, MV
|
||||
CHARACTER*1 UPLO, TRANSA, TRANSB
|
||||
* .. Array Arguments ..
|
||||
DOUBLE PRECISION A( LDA, * ), B( LDB, * ), C( LDC, * ),
|
||||
$ CC( LDCC, * ), CT( * ), G( * )
|
||||
* .. Local Scalars ..
|
||||
DOUBLE PRECISION ERRI
|
||||
INTEGER I, J, K, ISTART, ISTOP
|
||||
LOGICAL TRANA, TRANB, UPPER
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC ABS, MAX, SQRT
|
||||
* .. Executable Statements ..
|
||||
UPPER = UPLO.EQ.'U'
|
||||
TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C'
|
||||
TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C'
|
||||
*
|
||||
* Compute expected result, one column at a time, in CT using data
|
||||
* in A, B and C.
|
||||
* Compute gauges in G.
|
||||
*
|
||||
ISTART = 1
|
||||
ISTOP = N
|
||||
|
||||
DO 120 J = 1, N
|
||||
*
|
||||
IF ( UPPER ) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
DO 10 I = ISTART, ISTOP
|
||||
CT( I ) = ZERO
|
||||
G( I ) = ZERO
|
||||
10 CONTINUE
|
||||
IF( .NOT.TRANA.AND..NOT.TRANB )THEN
|
||||
DO 30 K = 1, KK
|
||||
DO 20 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( I, K )*B( K, J )
|
||||
G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( K, J ) )
|
||||
20 CONTINUE
|
||||
30 CONTINUE
|
||||
ELSE IF( TRANA.AND..NOT.TRANB )THEN
|
||||
DO 50 K = 1, KK
|
||||
DO 40 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( K, I )*B( K, J )
|
||||
G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( K, J ) )
|
||||
40 CONTINUE
|
||||
50 CONTINUE
|
||||
ELSE IF( .NOT.TRANA.AND.TRANB )THEN
|
||||
DO 70 K = 1, KK
|
||||
DO 60 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( I, K )*B( J, K )
|
||||
G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( J, K ) )
|
||||
60 CONTINUE
|
||||
70 CONTINUE
|
||||
ELSE IF( TRANA.AND.TRANB )THEN
|
||||
DO 90 K = 1, KK
|
||||
DO 80 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( K, I )*B( J, K )
|
||||
G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( J, K ) )
|
||||
80 CONTINUE
|
||||
90 CONTINUE
|
||||
END IF
|
||||
DO 100 I = ISTART, ISTOP
|
||||
CT( I ) = ALPHA*CT( I ) + BETA*C( I, J )
|
||||
G( I ) = ABS( ALPHA )*G( I ) + ABS( BETA )*ABS( C( I, J ) )
|
||||
100 CONTINUE
|
||||
*
|
||||
* Compute the error ratio for this result.
|
||||
*
|
||||
ERR = ZERO
|
||||
DO 110 I = ISTART, ISTOP
|
||||
ERRI = ABS( CT( I ) - CC( I, J ) )/EPS
|
||||
IF( G( I ).NE.ZERO )
|
||||
$ ERRI = ERRI/G( I )
|
||||
ERR = MAX( ERR, ERRI )
|
||||
IF( ERR*SQRT( EPS ).GE.ONE )
|
||||
$ GO TO 130
|
||||
110 CONTINUE
|
||||
*
|
||||
120 CONTINUE
|
||||
*
|
||||
* If the loop completes, all results are at least half accurate.
|
||||
GO TO 150
|
||||
*
|
||||
* Report fatal error.
|
||||
*
|
||||
130 FATAL = .TRUE.
|
||||
WRITE( NOUT, FMT = 9999 )
|
||||
DO 140 I = ISTART, ISTOP
|
||||
IF( MV )THEN
|
||||
WRITE( NOUT, FMT = 9998 )I, CT( I ), CC( I, J )
|
||||
ELSE
|
||||
WRITE( NOUT, FMT = 9998 )I, CC( I, J ), CT( I )
|
||||
END IF
|
||||
140 CONTINUE
|
||||
IF( N.GT.1 )
|
||||
$ WRITE( NOUT, FMT = 9997 )J
|
||||
*
|
||||
150 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
|
||||
$ 'F ACCURATE *******', /' EXPECTED RESULT COMPU',
|
||||
$ 'TED RESULT' )
|
||||
9998 FORMAT( 1X, I7, 2G18.6 )
|
||||
9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 )
|
||||
*
|
||||
* End of DMMTCH
|
||||
*
|
||||
END
|
||||
|
||||
|
||||
@@ -12,10 +12,9 @@ T LOGICAL FLAG, T TO TEST ERROR EXITS.
|
||||
0.0 1.0 0.7 VALUES OF ALPHA
|
||||
3 NUMBER OF VALUES OF BETA
|
||||
0.0 1.0 1.3 VALUES OF BETA
|
||||
DGEMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
DSYMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
DTRMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
DTRSM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
DSYRK T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
DSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
DGEMMTR T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
DGEMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
DSYMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
DTRMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
DTRSM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
DSYRK T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
DSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
|
||||
@@ -1278,17 +1278,13 @@
|
||||
* .. Scalar Arguments ..
|
||||
REAL XX
|
||||
INTEGER K
|
||||
* .. Parameters ..
|
||||
REAL ZERO
|
||||
PARAMETER (ZERO=0.0E+0)
|
||||
* .. Local Scalars ..
|
||||
REAL X, Y, Z
|
||||
REAL X, Y, YY, Z
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC HUGE
|
||||
* .. Executable Statements ..
|
||||
X = ZERO
|
||||
Y = HUGE(XX)
|
||||
Z = Y*Y
|
||||
Z = YY
|
||||
IF (K.EQ.1) THEN
|
||||
X = -Z
|
||||
ELSE IF (K.EQ.2) THEN
|
||||
|
||||
+55
-558
@@ -19,8 +19,8 @@
|
||||
*> Test program for the REAL Level 3 Blas.
|
||||
*>
|
||||
*> The program must be driven by a short data file. The first 14 records
|
||||
*> of the file are read using list-directed input, the last 7 records
|
||||
*> are read using the format ( A7, L2 ). An annotated example of a data
|
||||
*> of the file are read using list-directed input, the last 6 records
|
||||
*> are read using the format ( A6, L2 ). An annotated example of a data
|
||||
*> file can be obtained by deleting the first 3 characters from the
|
||||
*> following 20 lines:
|
||||
*> 'sblat3.out' NAME OF SUMMARY OUTPUT FILE
|
||||
@@ -43,7 +43,6 @@
|
||||
*> STRSM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
*> SSYRK T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
*> SSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
*> SGEMMTR T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
*>
|
||||
*> Further Details
|
||||
*> ===============
|
||||
@@ -91,7 +90,7 @@
|
||||
INTEGER NIN
|
||||
PARAMETER ( NIN = 5 )
|
||||
INTEGER NSUBS
|
||||
PARAMETER ( NSUBS = 7 )
|
||||
PARAMETER ( NSUBS = 6 )
|
||||
REAL ZERO, ONE
|
||||
PARAMETER ( ZERO = 0.0, ONE = 1.0 )
|
||||
INTEGER NMAX
|
||||
@@ -104,7 +103,7 @@
|
||||
LOGICAL FATAL, LTESTT, REWI, SAME, SFATAL, TRACE,
|
||||
$ TSTERR
|
||||
CHARACTER*1 TRANSA, TRANSB
|
||||
CHARACTER*7 SNAMET
|
||||
CHARACTER*6 SNAMET
|
||||
CHARACTER*32 SNAPS, SUMMRY
|
||||
* .. Local Arrays ..
|
||||
REAL AA( NMAX*NMAX ), AB( NMAX, 2*NMAX ),
|
||||
@@ -115,7 +114,7 @@
|
||||
$ G( NMAX ), W( 2*NMAX )
|
||||
INTEGER IDIM( NIDMAX )
|
||||
LOGICAL LTEST( NSUBS )
|
||||
CHARACTER*7 SNAMES( NSUBS )
|
||||
CHARACTER*6 SNAMES( NSUBS )
|
||||
* .. External Functions ..
|
||||
REAL SDIFF
|
||||
LOGICAL LSE
|
||||
@@ -127,13 +126,13 @@
|
||||
* .. Scalars in Common ..
|
||||
INTEGER INFOT, NOUTC
|
||||
LOGICAL LERR, OK
|
||||
CHARACTER*7 SRNAMT
|
||||
CHARACTER*6 SRNAMT
|
||||
* .. Common blocks ..
|
||||
COMMON /INFOC/INFOT, NOUTC, OK, LERR
|
||||
COMMON /SRNAMC/SRNAMT
|
||||
* .. Data statements ..
|
||||
DATA SNAMES/'SGEMM', 'SSYMM ', 'STRMM ',
|
||||
$ 'STRSM ', 'SSYRK ', 'SSYR2K ', 'SGEMMTR'/
|
||||
DATA SNAMES/'SGEMM ', 'SSYMM ', 'STRMM ', 'STRSM ',
|
||||
$ 'SSYRK ', 'SSYR2K'/
|
||||
* .. Executable Statements ..
|
||||
*
|
||||
* Read name and unit number for summary output file and open file.
|
||||
@@ -310,7 +309,7 @@
|
||||
INFOT = 0
|
||||
OK = .TRUE.
|
||||
FATAL = .FALSE.
|
||||
GO TO ( 140, 150, 160, 160, 170, 180, 185 )ISNUM
|
||||
GO TO ( 140, 150, 160, 160, 170, 180 )ISNUM
|
||||
* Test SGEMM, 01.
|
||||
140 CALL SCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
|
||||
@@ -339,12 +338,6 @@
|
||||
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
|
||||
$ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W )
|
||||
GO TO 190
|
||||
* Test SGEMMTR, 07.
|
||||
185 CALL SCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
|
||||
$ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
|
||||
$ CC, CS, CT, G )
|
||||
GO TO 190
|
||||
*
|
||||
190 IF( FATAL.AND.SFATAL )
|
||||
$ GO TO 210
|
||||
@@ -379,7 +372,7 @@
|
||||
9992 FORMAT( ' FOR BETA ', 7F6.1 )
|
||||
9991 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM',
|
||||
$ /' ******* TESTS ABANDONED *******' )
|
||||
9990 FORMAT( ' SUBPROGRAM NAME ', A7, ' NOT RECOGNIZED', /' ******* T',
|
||||
9990 FORMAT( ' SUBPROGRAM NAME ', A6, ' NOT RECOGNIZED', /' ******* T',
|
||||
$ 'ESTS ABANDONED *******' )
|
||||
9989 FORMAT( ' ERROR IN SMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALU',
|
||||
$ 'ATED WRONGLY.', /' SMMCH WAS CALLED WITH TRANSA = ', A1,
|
||||
@@ -387,8 +380,8 @@
|
||||
$ 'ERR = ', F12.3, '.', /' THIS MAY BE DUE TO FAULTS IN THE ',
|
||||
$ 'ARITHMETIC OR THE COMPILER.', /' ******* TESTS ABANDONED ',
|
||||
$ '*******' )
|
||||
9988 FORMAT( A7, L2 )
|
||||
9987 FORMAT( 1X, A7, ' WAS NOT TESTED' )
|
||||
9988 FORMAT( A6, L2 )
|
||||
9987 FORMAT( 1X, A6, ' WAS NOT TESTED' )
|
||||
9986 FORMAT( /' END OF TESTS' )
|
||||
9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' )
|
||||
9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' )
|
||||
@@ -417,7 +410,7 @@
|
||||
REAL EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*7 SNAME
|
||||
CHARACTER*6 SNAME
|
||||
* .. Array Arguments ..
|
||||
REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
@@ -660,15 +653,15 @@
|
||||
130 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
|
||||
9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
|
||||
$ 'S)' )
|
||||
9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
|
||||
9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
|
||||
$ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
|
||||
$ ' - SUSPECT *******' )
|
||||
9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( 1X, I6, ': ', A7, '(''', A1, ''',''', A1, ''',',
|
||||
9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',''', A1, ''',',
|
||||
$ 3( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', ',
|
||||
$ 'C,', I3, ').' )
|
||||
9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
@@ -698,7 +691,7 @@
|
||||
REAL EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*7 SNAME
|
||||
CHARACTER*6 SNAME
|
||||
* .. Array Arguments ..
|
||||
REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
@@ -930,15 +923,15 @@
|
||||
120 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
|
||||
9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
|
||||
$ 'S)' )
|
||||
9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
|
||||
9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
|
||||
$ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
|
||||
$ ' - SUSPECT *******' )
|
||||
9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( 1X, I6, ': ', A7, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
$ F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', C,', I3, ') ',
|
||||
$ ' .' )
|
||||
9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
@@ -968,7 +961,7 @@
|
||||
REAL EPS, THRESH
|
||||
INTEGER NALF, NIDIM, NMAX, NOUT, NTRA
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*7 SNAME
|
||||
CHARACTER*6 SNAME
|
||||
* .. Array Arguments ..
|
||||
REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
@@ -1236,15 +1229,15 @@
|
||||
160 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
|
||||
9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
|
||||
$ 'S)' )
|
||||
9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
|
||||
9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
|
||||
$ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
|
||||
$ ' - SUSPECT *******' )
|
||||
9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( 1X, I6, ': ', A7, '(', 4( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( 1X, I6, ': ', A6, '(', 4( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
$ F4.1, ', A,', I3, ', B,', I3, ') .' )
|
||||
9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
$ '******' )
|
||||
@@ -1273,7 +1266,7 @@
|
||||
REAL EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*7 SNAME
|
||||
CHARACTER*6 SNAME
|
||||
* .. Array Arguments ..
|
||||
REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
@@ -1510,16 +1503,16 @@
|
||||
130 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
|
||||
9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
|
||||
$ 'S)' )
|
||||
9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
|
||||
9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
|
||||
$ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
|
||||
$ ' - SUSPECT *******' )
|
||||
9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' )
|
||||
9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 )
|
||||
9994 FORMAT( 1X, I6, ': ', A7, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
9994 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
$ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ') .' )
|
||||
9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
$ '******' )
|
||||
@@ -1548,7 +1541,7 @@
|
||||
REAL EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*7 SNAME
|
||||
CHARACTER*6 SNAME
|
||||
* .. Array Arguments ..
|
||||
REAL AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ),
|
||||
$ ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ),
|
||||
@@ -1823,16 +1816,16 @@
|
||||
160 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
|
||||
9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
|
||||
$ 'S)' )
|
||||
9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
|
||||
9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
|
||||
$ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
|
||||
$ ' - SUSPECT *******' )
|
||||
9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' )
|
||||
9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 )
|
||||
9994 FORMAT( 1X, I6, ': ', A7, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
9994 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
$ F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', C,', I3, ') ',
|
||||
$ ' .' )
|
||||
9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
@@ -1860,7 +1853,7 @@
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
INTEGER ISNUM, NOUT
|
||||
CHARACTER*7 SRNAMT
|
||||
CHARACTER*6 SRNAMT
|
||||
* .. Scalars in Common ..
|
||||
INTEGER INFOT, NOUTC
|
||||
LOGICAL LERR, OK
|
||||
@@ -1873,7 +1866,7 @@
|
||||
REAL A( 2, 1 ), B( 2, 1 ), C( 2, 1 )
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL CHKXER, SGEMM, SSYMM, SSYR2K, SSYRK, STRMM,
|
||||
$ STRSM, SGEMMTR
|
||||
$ STRSM
|
||||
* .. Common blocks ..
|
||||
COMMON /INFOC/INFOT, NOUTC, OK, LERR
|
||||
* .. Executable Statements ..
|
||||
@@ -1889,7 +1882,7 @@
|
||||
ALPHA = ONE
|
||||
BETA = TWO
|
||||
*
|
||||
GO TO ( 10, 20, 30, 40, 50, 60, 70 )ISNUM
|
||||
GO TO ( 10, 20, 30, 40, 50, 60 )ISNUM
|
||||
10 INFOT = 1
|
||||
CALL SGEMM( '/', 'N', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
@@ -1974,7 +1967,7 @@
|
||||
INFOT = 13
|
||||
CALL SGEMM( 'T', 'T', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
GO TO 80
|
||||
GO TO 70
|
||||
20 INFOT = 1
|
||||
CALL SSYMM( '/', 'U', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
@@ -2041,7 +2034,7 @@
|
||||
INFOT = 12
|
||||
CALL SSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
GO TO 80
|
||||
GO TO 70
|
||||
30 INFOT = 1
|
||||
CALL STRMM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
@@ -2150,7 +2143,7 @@
|
||||
INFOT = 11
|
||||
CALL STRMM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
GO TO 80
|
||||
GO TO 70
|
||||
40 INFOT = 1
|
||||
CALL STRSM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
@@ -2259,7 +2252,7 @@
|
||||
INFOT = 11
|
||||
CALL STRSM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
GO TO 80
|
||||
GO TO 70
|
||||
50 INFOT = 1
|
||||
CALL SSYRK( '/', 'N', 0, 0, ALPHA, A, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
@@ -2314,7 +2307,7 @@
|
||||
INFOT = 10
|
||||
CALL SSYRK( 'L', 'T', 2, 0, ALPHA, A, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
GO TO 80
|
||||
GO TO 70
|
||||
60 INFOT = 1
|
||||
CALL SSYR2K( '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
@@ -2381,95 +2374,16 @@
|
||||
INFOT = 12
|
||||
CALL SSYR2K( 'L', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
GO TO 80
|
||||
70 INFOT = 1
|
||||
CALL SGEMMTR( '/', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 2
|
||||
CALL SGEMMTR( 'U', '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 2
|
||||
CALL SGEMMTR( 'U', '/', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 3
|
||||
CALL SGEMMTR( 'U', 'N', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 3
|
||||
CALL SGEMMTR( 'U', 'T', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL SGEMMTR( 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL SGEMMTR( 'U', 'N', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL SGEMMTR( 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL SGEMMTR( 'U', 'T', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 5
|
||||
CALL SGEMMTR( 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 5
|
||||
CALL SGEMMTR( 'U', 'N', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 5
|
||||
CALL SGEMMTR( 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 5
|
||||
CALL SGEMMTR( 'U', 'T', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL SGEMMTR( 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2, BETA, C,
|
||||
$ 2 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL SGEMMTR( 'U', 'N', 'T', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 10
|
||||
CALL SGEMMTR( 'U', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 10
|
||||
CALL SGEMMTR( 'U', 'T', 'N', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 10
|
||||
CALL SGEMMTR( 'U', 'N', 'T', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 10
|
||||
CALL SGEMMTR( 'U', 'T', 'T', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 13
|
||||
CALL SGEMMTR( 'U', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 13
|
||||
CALL SGEMMTR( 'U', 'N', 'T', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 13
|
||||
CALL SGEMMTR( 'U', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 13
|
||||
CALL SGEMMTR( 'U', 'T', 'T', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
*
|
||||
80 IF( OK )THEN
|
||||
70 IF( OK )THEN
|
||||
WRITE( NOUT, FMT = 9999 )SRNAMT
|
||||
ELSE
|
||||
WRITE( NOUT, FMT = 9998 )SRNAMT
|
||||
END IF
|
||||
RETURN
|
||||
*
|
||||
9999 FORMAT( ' ', A7, ' PASSED THE TESTS OF ERROR-EXITS' )
|
||||
9998 FORMAT( ' ******* ', A7, ' FAILED THE TESTS OF ERROR-EXITS *****',
|
||||
9999 FORMAT( ' ', A6, ' PASSED THE TESTS OF ERROR-EXITS' )
|
||||
9998 FORMAT( ' ******* ', A6, ' FAILED THE TESTS OF ERROR-EXITS *****',
|
||||
$ '**' )
|
||||
*
|
||||
* End of SCHKE
|
||||
@@ -2883,7 +2797,7 @@
|
||||
* .. Scalar Arguments ..
|
||||
INTEGER INFOT, NOUT
|
||||
LOGICAL LERR, OK
|
||||
CHARACTER*7 SRNAMT
|
||||
CHARACTER*6 SRNAMT
|
||||
* .. Executable Statements ..
|
||||
IF( .NOT.LERR )THEN
|
||||
WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT
|
||||
@@ -2893,7 +2807,7 @@
|
||||
RETURN
|
||||
*
|
||||
9999 FORMAT( ' ***** ILLEGAL VALUE OF PARAMETER NUMBER ', I2, ' NOT D',
|
||||
$ 'ETECTED BY ', A7, ' *****' )
|
||||
$ 'ETECTED BY ', A6, ' *****' )
|
||||
*
|
||||
* End of CHKXER
|
||||
*
|
||||
@@ -2919,11 +2833,11 @@
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
INTEGER INFO
|
||||
CHARACTER*(*) SRNAME
|
||||
CHARACTER*6 SRNAME
|
||||
* .. Scalars in Common ..
|
||||
INTEGER INFOT, NOUT
|
||||
LOGICAL LERR, OK
|
||||
CHARACTER*7 SRNAMT
|
||||
CHARACTER*6 SRNAMT
|
||||
* .. Common blocks ..
|
||||
COMMON /INFOC/INFOT, NOUT, OK, LERR
|
||||
COMMON /SRNAMC/SRNAMT
|
||||
@@ -2937,7 +2851,7 @@
|
||||
END IF
|
||||
OK = .FALSE.
|
||||
END IF
|
||||
IF( SRNAME .NE. SRNAME ) THEN
|
||||
IF( SRNAME.NE.SRNAMT )THEN
|
||||
WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT
|
||||
OK = .FALSE.
|
||||
END IF
|
||||
@@ -2945,428 +2859,11 @@
|
||||
*
|
||||
9999 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6, ' INSTEAD',
|
||||
$ ' OF ', I2, ' *******' )
|
||||
9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A7, ' INSTE',
|
||||
$ 'AD OF ', A7, ' *******' )
|
||||
9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A6, ' INSTE',
|
||||
$ 'AD OF ', A6, ' *******' )
|
||||
9997 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6,
|
||||
$ ' *******' )
|
||||
*
|
||||
* End of XERBLA
|
||||
*
|
||||
END
|
||||
|
||||
|
||||
SUBROUTINE SCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
|
||||
$ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
|
||||
$ A, AA, AS, B, BB, BS, C, CC, CS, CT, G )
|
||||
*
|
||||
* Tests SGEMMTR.
|
||||
*
|
||||
* Auxiliary routine for test program for Level 3 Blas.
|
||||
*
|
||||
* -- Written on 19-July-2023.
|
||||
* Martin Koehler, MPI Magdeburg
|
||||
*
|
||||
* .. Parameters ..
|
||||
REAL ZERO
|
||||
PARAMETER ( ZERO = 0.0D0 )
|
||||
* .. Scalar Arguments ..
|
||||
REAL EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*7 SNAME
|
||||
* .. Array Arguments ..
|
||||
REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
$ BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
|
||||
$ C( NMAX, NMAX ), CC( NMAX*NMAX ),
|
||||
$ CS( NMAX*NMAX ), CT( NMAX ), G( NMAX )
|
||||
INTEGER IDIM( NIDIM )
|
||||
* .. Local Scalars ..
|
||||
REAL ALPHA, ALS, BETA, BLS, ERR, ERRMAX
|
||||
INTEGER I, IA, IB, ICA, ICB, IK, IN, K, KS, LAA,
|
||||
$ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS,
|
||||
$ MA, MB, N, NA, NARGS, NB, NC, NS, IS
|
||||
LOGICAL NULL, RESET, SAME, TRANA, TRANB
|
||||
CHARACTER*1 TRANAS, TRANBS, TRANSA, TRANSB, UPLO, UPLOS
|
||||
CHARACTER*3 ICH
|
||||
CHARACTER*2 ISHAPE
|
||||
* .. Local Arrays ..
|
||||
LOGICAL ISAME( 13 )
|
||||
* .. External Functions ..
|
||||
LOGICAL LSE, LSERES
|
||||
EXTERNAL LSE, LSERES
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL SGEMMTR, DMAKE, DMMTCH
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC MAX
|
||||
* .. Scalars in Common ..
|
||||
INTEGER INFOT, NOUTC
|
||||
LOGICAL LERR, OK
|
||||
* .. Common blocks ..
|
||||
COMMON /INFOC/INFOT, NOUTC, OK, LERR
|
||||
* .. Data statements ..
|
||||
DATA ICH/'NTC'/
|
||||
DATA ISHAPE/'UL'/
|
||||
* .. Executable Statements ..
|
||||
*
|
||||
NARGS = 13
|
||||
NC = 0
|
||||
RESET = .TRUE.
|
||||
ERRMAX = ZERO
|
||||
*
|
||||
DO 100 IN = 1, NIDIM
|
||||
N = IDIM( IN )
|
||||
* Set LDC to 1 more than minimum value if room.
|
||||
LDC = N
|
||||
IF( LDC.LT.NMAX )
|
||||
$ LDC = LDC + 1
|
||||
* Skip tests if not enough room.
|
||||
IF( LDC.GT.NMAX )
|
||||
$ GO TO 100
|
||||
LCC = LDC*N
|
||||
NULL = N.LE.0
|
||||
*
|
||||
DO 90 IK = 1, NIDIM
|
||||
K = IDIM( IK )
|
||||
*
|
||||
DO 80 ICA = 1, 3
|
||||
TRANSA = ICH( ICA: ICA )
|
||||
TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C'
|
||||
*
|
||||
IF( TRANA )THEN
|
||||
MA = K
|
||||
NA = N
|
||||
ELSE
|
||||
MA = N
|
||||
NA = K
|
||||
END IF
|
||||
* Set LDA to 1 more than minimum value if room.
|
||||
LDA = MA
|
||||
IF( LDA.LT.NMAX )
|
||||
$ LDA = LDA + 1
|
||||
* Skip tests if not enough room.
|
||||
IF( LDA.GT.NMAX )
|
||||
$ GO TO 80
|
||||
LAA = LDA*NA
|
||||
*
|
||||
* Generate the matrix A.
|
||||
*
|
||||
CALL SMAKE( 'GE', ' ', ' ', MA, NA, A, NMAX, AA, LDA,
|
||||
$ RESET, ZERO )
|
||||
*
|
||||
DO 70 ICB = 1, 3
|
||||
TRANSB = ICH( ICB: ICB )
|
||||
TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C'
|
||||
*
|
||||
IF( TRANB )THEN
|
||||
MB = N
|
||||
NB = K
|
||||
ELSE
|
||||
MB = K
|
||||
NB = N
|
||||
END IF
|
||||
* Set LDB to 1 more than minimum value if room.
|
||||
LDB = MB
|
||||
IF( LDB.LT.NMAX )
|
||||
$ LDB = LDB + 1
|
||||
* Skip tests if not enough room.
|
||||
IF( LDB.GT.NMAX )
|
||||
$ GO TO 70
|
||||
LBB = LDB*NB
|
||||
*
|
||||
* Generate the matrix B.
|
||||
*
|
||||
CALL SMAKE( 'GE', ' ', ' ', MB, NB, B, NMAX, BB,
|
||||
$ LDB, RESET, ZERO )
|
||||
*
|
||||
DO 60 IA = 1, NALF
|
||||
ALPHA = ALF( IA )
|
||||
*
|
||||
DO 50 IB = 1, NBET
|
||||
BETA = BET( IB )
|
||||
|
||||
DO 45 IS = 1, 2
|
||||
UPLO = ISHAPE( IS: IS )
|
||||
|
||||
*
|
||||
* Generate the matrix C.
|
||||
*
|
||||
CALL SMAKE( 'GE', UPLO, ' ', N, N, C,
|
||||
$ NMAX, CC, LDC, RESET, ZERO )
|
||||
*
|
||||
NC = NC + 1
|
||||
*
|
||||
* Save every datum before calling the
|
||||
* subroutine.
|
||||
*
|
||||
UPLOS = UPLO
|
||||
TRANAS = TRANSA
|
||||
TRANBS = TRANSB
|
||||
NS = N
|
||||
KS = K
|
||||
ALS = ALPHA
|
||||
DO 10 I = 1, LAA
|
||||
AS( I ) = AA( I )
|
||||
10 CONTINUE
|
||||
LDAS = LDA
|
||||
DO 20 I = 1, LBB
|
||||
BS( I ) = BB( I )
|
||||
20 CONTINUE
|
||||
LDBS = LDB
|
||||
BLS = BETA
|
||||
DO 30 I = 1, LCC
|
||||
CS( I ) = CC( I )
|
||||
30 CONTINUE
|
||||
LDCS = LDC
|
||||
*
|
||||
* Call the subroutine.
|
||||
*
|
||||
IF( TRACE )
|
||||
$ WRITE( NTRA, FMT = 9995 )NC, SNAME,
|
||||
$ UPLO, TRANSA, TRANSB, N, K, ALPHA, LDA,
|
||||
$ LDB, BETA, LDC
|
||||
IF( REWI )
|
||||
$ REWIND NTRA
|
||||
CALL SGEMMTR( UPLO, TRANSA, TRANSB, N,
|
||||
$ K, ALPHA, AA, LDA, BB, LDB,
|
||||
$ BETA, CC, LDC )
|
||||
*
|
||||
* Check if error-exit was taken incorrectly.
|
||||
*
|
||||
IF( .NOT.OK )THEN
|
||||
WRITE( NOUT, FMT = 9994 )
|
||||
FATAL = .TRUE.
|
||||
GO TO 120
|
||||
END IF
|
||||
*
|
||||
* See what data changed inside subroutines.
|
||||
*
|
||||
ISAME( 1 ) = UPLO.EQ.UPLOS
|
||||
ISAME( 2 ) = TRANSA.EQ.TRANAS
|
||||
ISAME( 3 ) = TRANSB.EQ.TRANBS
|
||||
ISAME( 4 ) = NS.EQ.N
|
||||
ISAME( 5 ) = KS.EQ.K
|
||||
ISAME( 6 ) = ALS.EQ.ALPHA
|
||||
ISAME( 7 ) = LSE( AS, AA, LAA )
|
||||
ISAME( 8 ) = LDAS.EQ.LDA
|
||||
ISAME( 9 ) = LSE( BS, BB, LBB )
|
||||
ISAME( 10 ) = LDBS.EQ.LDB
|
||||
ISAME( 11 ) = BLS.EQ.BETA
|
||||
IF( NULL )THEN
|
||||
ISAME( 12 ) = LSE( CS, CC, LCC )
|
||||
ELSE
|
||||
ISAME( 12 ) = LSERES( 'GE', ' ', N, N,
|
||||
$ CS, CC, LDC )
|
||||
END IF
|
||||
ISAME( 13 ) = LDCS.EQ.LDC
|
||||
*
|
||||
* If data was incorrectly changed, report
|
||||
* and return.
|
||||
*
|
||||
SAME = .TRUE.
|
||||
DO 40 I = 1, NARGS
|
||||
SAME = SAME.AND.ISAME( I )
|
||||
IF( .NOT.ISAME( I ) )
|
||||
$ WRITE( NOUT, FMT = 9998 )I
|
||||
40 CONTINUE
|
||||
IF( .NOT.SAME )THEN
|
||||
FATAL = .TRUE.
|
||||
GO TO 120
|
||||
END IF
|
||||
*
|
||||
IF( .NOT.NULL )THEN
|
||||
*
|
||||
* Check the result.
|
||||
*
|
||||
CALL SMMTCH( UPLO, TRANSA, TRANSB,
|
||||
$ N, K,
|
||||
$ ALPHA, A, NMAX, B, NMAX, BETA,
|
||||
$ C, NMAX, CT, G, CC, LDC, EPS,
|
||||
$ ERR, FATAL, NOUT, .TRUE. )
|
||||
ERRMAX = MAX( ERRMAX, ERR )
|
||||
* If got really bad answer, report and
|
||||
* return.
|
||||
IF( FATAL )
|
||||
$ GO TO 120
|
||||
END IF
|
||||
*
|
||||
45 CONTINUE
|
||||
*
|
||||
50 CONTINUE
|
||||
*
|
||||
60 CONTINUE
|
||||
*
|
||||
70 CONTINUE
|
||||
*
|
||||
80 CONTINUE
|
||||
*
|
||||
90 CONTINUE
|
||||
*
|
||||
100 CONTINUE
|
||||
*
|
||||
*
|
||||
* Report result.
|
||||
*
|
||||
IF( ERRMAX.LT.THRESH )THEN
|
||||
WRITE( NOUT, FMT = 9999 )SNAME, NC
|
||||
ELSE
|
||||
WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
|
||||
END IF
|
||||
GO TO 130
|
||||
*
|
||||
120 CONTINUE
|
||||
WRITE( NOUT, FMT = 9996 )SNAME
|
||||
WRITE( NOUT, FMT = 9995 )NC, SNAME, UPLO, TRANSA, TRANSB, N, K,
|
||||
$ ALPHA, LDA, LDB, BETA, LDC
|
||||
*
|
||||
130 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
|
||||
$ 'S)' )
|
||||
9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
|
||||
$ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
|
||||
$ ' - SUSPECT *******' )
|
||||
9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( 1X, I6, ': ', A7, '(''',A1, ''',''',A1, ''',''', A1,''',',
|
||||
$ 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', ',
|
||||
$ 'C,', I3, ').' )
|
||||
9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
$ '******' )
|
||||
*
|
||||
* End of DCHK6
|
||||
*
|
||||
END
|
||||
|
||||
SUBROUTINE SMMTCH( UPLO, TRANSA, TRANSB, N, KK, ALPHA, A, LDA,
|
||||
$ B, LDB, BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR,
|
||||
$ FATAL, NOUT, MV )
|
||||
*
|
||||
* Checks the results of the computational tests.
|
||||
*
|
||||
* Auxiliary routine for test program for Level 3 Blas. (SGEMMTR)
|
||||
*
|
||||
* -- Written on 19-July-2023.
|
||||
* Martin Koehler, MPI Magdeburg
|
||||
*
|
||||
* .. Parameters ..
|
||||
REAL ZERO, ONE
|
||||
PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
|
||||
* .. Scalar Arguments ..
|
||||
REAL ALPHA, BETA, EPS, ERR
|
||||
INTEGER KK, LDA, LDB, LDC, LDCC, N, NOUT
|
||||
LOGICAL FATAL, MV
|
||||
CHARACTER*1 UPLO, TRANSA, TRANSB
|
||||
* .. Array Arguments ..
|
||||
REAL A( LDA, * ), B( LDB, * ), C( LDC, * ),
|
||||
$ CC( LDCC, * ), CT( * ), G( * )
|
||||
* .. Local Scalars ..
|
||||
REAL ERRI
|
||||
INTEGER I, J, K, ISTART, ISTOP
|
||||
LOGICAL TRANA, TRANB, UPPER
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC ABS, MAX, SQRT
|
||||
* .. Executable Statements ..
|
||||
UPPER = UPLO.EQ.'U'
|
||||
TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C'
|
||||
TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C'
|
||||
*
|
||||
* Compute expected result, one column at a time, in CT using data
|
||||
* in A, B and C.
|
||||
* Compute gauges in G.
|
||||
*
|
||||
ISTART = 1
|
||||
ISTOP = N
|
||||
|
||||
DO 120 J = 1, N
|
||||
*
|
||||
IF ( UPPER ) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
DO 10 I = ISTART, ISTOP
|
||||
CT( I ) = ZERO
|
||||
G( I ) = ZERO
|
||||
10 CONTINUE
|
||||
IF( .NOT.TRANA.AND..NOT.TRANB )THEN
|
||||
DO 30 K = 1, KK
|
||||
DO 20 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( I, K )*B( K, J )
|
||||
G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( K, J ) )
|
||||
20 CONTINUE
|
||||
30 CONTINUE
|
||||
ELSE IF( TRANA.AND..NOT.TRANB )THEN
|
||||
DO 50 K = 1, KK
|
||||
DO 40 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( K, I )*B( K, J )
|
||||
G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( K, J ) )
|
||||
40 CONTINUE
|
||||
50 CONTINUE
|
||||
ELSE IF( .NOT.TRANA.AND.TRANB )THEN
|
||||
DO 70 K = 1, KK
|
||||
DO 60 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( I, K )*B( J, K )
|
||||
G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( J, K ) )
|
||||
60 CONTINUE
|
||||
70 CONTINUE
|
||||
ELSE IF( TRANA.AND.TRANB )THEN
|
||||
DO 90 K = 1, KK
|
||||
DO 80 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( K, I )*B( J, K )
|
||||
G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( J, K ) )
|
||||
80 CONTINUE
|
||||
90 CONTINUE
|
||||
END IF
|
||||
DO 100 I = ISTART, ISTOP
|
||||
CT( I ) = ALPHA*CT( I ) + BETA*C( I, J )
|
||||
G( I ) = ABS( ALPHA )*G( I ) + ABS( BETA )*ABS( C( I, J ) )
|
||||
100 CONTINUE
|
||||
*
|
||||
* Compute the error ratio for this result.
|
||||
*
|
||||
ERR = ZERO
|
||||
DO 110 I = ISTART, ISTOP
|
||||
ERRI = ABS( CT( I ) - CC( I, J ) )/EPS
|
||||
IF( G( I ).NE.ZERO )
|
||||
$ ERRI = ERRI/G( I )
|
||||
ERR = MAX( ERR, ERRI )
|
||||
IF( ERR*SQRT( EPS ).GE.ONE )
|
||||
$ GO TO 130
|
||||
110 CONTINUE
|
||||
*
|
||||
120 CONTINUE
|
||||
*
|
||||
* If the loop completes, all results are at least half accurate.
|
||||
GO TO 150
|
||||
*
|
||||
* Report fatal error.
|
||||
*
|
||||
130 FATAL = .TRUE.
|
||||
WRITE( NOUT, FMT = 9999 )
|
||||
DO 140 I = ISTART, ISTOP
|
||||
IF( MV )THEN
|
||||
WRITE( NOUT, FMT = 9998 )I, CT( I ), CC( I, J )
|
||||
ELSE
|
||||
WRITE( NOUT, FMT = 9998 )I, CC( I, J ), CT( I )
|
||||
END IF
|
||||
140 CONTINUE
|
||||
IF( N.GT.1 )
|
||||
$ WRITE( NOUT, FMT = 9997 )J
|
||||
*
|
||||
150 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
|
||||
$ 'F ACCURATE *******', /' EXPECTED RESULT COMPU',
|
||||
$ 'TED RESULT' )
|
||||
9998 FORMAT( 1X, I7, 2G18.6 )
|
||||
9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 )
|
||||
*
|
||||
* End of DMMTCH
|
||||
*
|
||||
END
|
||||
|
||||
@@ -12,10 +12,9 @@ T LOGICAL FLAG, T TO TEST ERROR EXITS.
|
||||
0.0 1.0 0.7 VALUES OF ALPHA
|
||||
3 NUMBER OF VALUES OF BETA
|
||||
0.0 1.0 1.3 VALUES OF BETA
|
||||
SGEMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
SSYMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
STRMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
STRSM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
SSYRK T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
SSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
SGEMMTR T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
SGEMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
SSYMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
STRMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
STRSM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
SSYRK T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
SSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
|
||||
@@ -994,17 +994,13 @@
|
||||
* .. Scalar Arguments ..
|
||||
DOUBLE PRECISION XX
|
||||
INTEGER K
|
||||
* .. Parameters ..
|
||||
DOUBLE PRECISION ZERO
|
||||
PARAMETER (ZERO=0.0D+0)
|
||||
* .. Local Scalars ..
|
||||
DOUBLE PRECISION X, Y, Z
|
||||
DOUBLE PRECISION X, Y, YY, Z
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC HUGE
|
||||
* .. Executable Statements ..
|
||||
X = ZERO
|
||||
Y = HUGE(XX)
|
||||
Z = Y*Y
|
||||
Z = YY
|
||||
IF (K.EQ.1) THEN
|
||||
X = -Z
|
||||
ELSE IF (K.EQ.2) THEN
|
||||
|
||||
+30
-730
@@ -19,7 +19,7 @@
|
||||
*> Test program for the COMPLEX*16 Level 3 Blas.
|
||||
*>
|
||||
*> The program must be driven by a short data file. The first 14 records
|
||||
*> of the file are read using list-directed input, the last 10 records
|
||||
*> of the file are read using list-directed input, the last 9 records
|
||||
*> are read using the format ( A6, L2 ). An annotated example of a data
|
||||
*> file can be obtained by deleting the first 3 characters from the
|
||||
*> following 23 lines:
|
||||
@@ -46,7 +46,6 @@
|
||||
*> ZSYRK T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
*> ZHER2K T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
*> ZSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
*> ZGEMMTR T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
*>
|
||||
*>
|
||||
*> Further Details
|
||||
@@ -95,7 +94,7 @@
|
||||
INTEGER NIN
|
||||
PARAMETER ( NIN = 5 )
|
||||
INTEGER NSUBS
|
||||
PARAMETER ( NSUBS = 10 )
|
||||
PARAMETER ( NSUBS = 9 )
|
||||
COMPLEX*16 ZERO, ONE
|
||||
PARAMETER ( ZERO = ( 0.0D0, 0.0D0 ),
|
||||
$ ONE = ( 1.0D0, 0.0D0 ) )
|
||||
@@ -111,7 +110,7 @@
|
||||
LOGICAL FATAL, LTESTT, REWI, SAME, SFATAL, TRACE,
|
||||
$ TSTERR
|
||||
CHARACTER*1 TRANSA, TRANSB
|
||||
CHARACTER*7 SNAMET
|
||||
CHARACTER*6 SNAMET
|
||||
CHARACTER*32 SNAPS, SUMMRY
|
||||
* .. Local Arrays ..
|
||||
COMPLEX*16 AA( NMAX*NMAX ), AB( NMAX, 2*NMAX ),
|
||||
@@ -123,27 +122,26 @@
|
||||
DOUBLE PRECISION G( NMAX )
|
||||
INTEGER IDIM( NIDMAX )
|
||||
LOGICAL LTEST( NSUBS )
|
||||
CHARACTER*7 SNAMES( NSUBS )
|
||||
CHARACTER*6 SNAMES( NSUBS )
|
||||
* .. External Functions ..
|
||||
DOUBLE PRECISION DDIFF
|
||||
LOGICAL LZE
|
||||
EXTERNAL DDIFF, LZE
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL ZCHK1, ZCHK2, ZCHK3, ZCHK4, ZCHK5, ZCHK6
|
||||
EXTERNAL ZCHKE, ZMMCH
|
||||
EXTERNAL ZCHK1, ZCHK2, ZCHK3, ZCHK4, ZCHK5, ZCHKE, ZMMCH
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC MAX, MIN
|
||||
* .. Scalars in Common ..
|
||||
INTEGER INFOT, NOUTC
|
||||
LOGICAL LERR, OK
|
||||
CHARACTER*7 SRNAMT
|
||||
CHARACTER*6 SRNAMT
|
||||
* .. Common blocks ..
|
||||
COMMON /INFOC/INFOT, NOUTC, OK, LERR
|
||||
COMMON /SRNAMC/SRNAMT
|
||||
* .. Data statements ..
|
||||
DATA SNAMES/'ZGEMM ', 'ZHEMM ', 'ZSYMM ', 'ZTRMM ',
|
||||
$ 'ZTRSM ', 'ZHERK ', 'ZSYRK ', 'ZHER2K',
|
||||
$ 'ZSYR2K', 'ZGEMMTR'/
|
||||
$ 'ZSYR2K'/
|
||||
* .. Executable Statements ..
|
||||
*
|
||||
* Read name and unit number for summary output file and open file.
|
||||
@@ -321,7 +319,7 @@
|
||||
OK = .TRUE.
|
||||
FATAL = .FALSE.
|
||||
GO TO ( 140, 150, 150, 160, 160, 170, 170,
|
||||
$ 180, 180, 185 )ISNUM
|
||||
$ 180, 180 )ISNUM
|
||||
* Test ZGEMM, 01.
|
||||
140 CALL ZCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
|
||||
@@ -350,13 +348,6 @@
|
||||
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
|
||||
$ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W )
|
||||
GO TO 190
|
||||
* Test ZGEMMTR, 01.
|
||||
185 CALL ZCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
|
||||
$ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
|
||||
$ CC, CS, CT, G )
|
||||
GO TO 190
|
||||
|
||||
*
|
||||
190 IF( FATAL.AND.SFATAL )
|
||||
$ GO TO 210
|
||||
@@ -401,8 +392,8 @@
|
||||
$ 'ERR = ', F12.3, '.', /' THIS MAY BE DUE TO FAULTS IN THE ',
|
||||
$ 'ARITHMETIC OR THE COMPILER.', /' ******* TESTS ABANDONED ',
|
||||
$ '*******' )
|
||||
9988 FORMAT( A7, L2 )
|
||||
9987 FORMAT( 1X, A7, ' WAS NOT TESTED' )
|
||||
9988 FORMAT( A6, L2 )
|
||||
9987 FORMAT( 1X, A6, ' WAS NOT TESTED' )
|
||||
9986 FORMAT( /' END OF TESTS' )
|
||||
9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' )
|
||||
9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' )
|
||||
@@ -433,7 +424,7 @@
|
||||
DOUBLE PRECISION EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*7 SNAME
|
||||
CHARACTER*6 SNAME
|
||||
* .. Array Arguments ..
|
||||
COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
@@ -718,7 +709,7 @@
|
||||
DOUBLE PRECISION EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*7 SNAME
|
||||
CHARACTER*6 SNAME
|
||||
* .. Array Arguments ..
|
||||
COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
@@ -998,7 +989,7 @@
|
||||
DOUBLE PRECISION EPS, THRESH
|
||||
INTEGER NALF, NIDIM, NMAX, NOUT, NTRA
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*7 SNAME
|
||||
CHARACTER*6 SNAME
|
||||
* .. Array Arguments ..
|
||||
COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
@@ -1308,7 +1299,7 @@
|
||||
DOUBLE PRECISION EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*7 SNAME
|
||||
CHARACTER*6 SNAME
|
||||
* .. Array Arguments ..
|
||||
COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
@@ -1641,7 +1632,7 @@
|
||||
DOUBLE PRECISION EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*7 SNAME
|
||||
CHARACTER*6 SNAME
|
||||
* .. Array Arguments ..
|
||||
COMPLEX*16 AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ),
|
||||
$ ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ),
|
||||
@@ -2012,12 +2003,12 @@
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
INTEGER ISNUM, NOUT
|
||||
CHARACTER*7 SRNAMT
|
||||
CHARACTER*6 SRNAMT
|
||||
* .. Scalars in Common ..
|
||||
INTEGER INFOT, NOUTC
|
||||
LOGICAL LERR, OK
|
||||
* .. Parameters ..
|
||||
DOUBLE PRECISION ONE, TWO
|
||||
REAL ONE, TWO
|
||||
PARAMETER ( ONE = 1.0D0, TWO = 2.0D0 )
|
||||
* .. Local Scalars ..
|
||||
COMPLEX*16 ALPHA, BETA
|
||||
@@ -2047,7 +2038,7 @@
|
||||
RBETA = TWO
|
||||
*
|
||||
GO TO ( 10, 20, 30, 40, 50, 60, 70, 80,
|
||||
$ 90, 100 )ISNUM
|
||||
$ 90 )ISNUM
|
||||
10 INFOT = 1
|
||||
CALL ZGEMM( '/', 'N', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
@@ -2228,7 +2219,7 @@
|
||||
INFOT = 13
|
||||
CALL ZGEMM( 'T', 'T', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
GO TO 110
|
||||
GO TO 100
|
||||
20 INFOT = 1
|
||||
CALL ZHEMM( '/', 'U', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
@@ -2295,7 +2286,7 @@
|
||||
INFOT = 12
|
||||
CALL ZHEMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
GO TO 110
|
||||
GO TO 100
|
||||
30 INFOT = 1
|
||||
CALL ZSYMM( '/', 'U', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
@@ -2362,7 +2353,7 @@
|
||||
INFOT = 12
|
||||
CALL ZSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
GO TO 110
|
||||
GO TO 100
|
||||
40 INFOT = 1
|
||||
CALL ZTRMM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
@@ -2519,7 +2510,7 @@
|
||||
INFOT = 11
|
||||
CALL ZTRMM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
GO TO 110
|
||||
GO TO 100
|
||||
50 INFOT = 1
|
||||
CALL ZTRSM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
@@ -2676,7 +2667,7 @@
|
||||
INFOT = 11
|
||||
CALL ZTRSM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
GO TO 110
|
||||
GO TO 100
|
||||
60 INFOT = 1
|
||||
CALL ZHERK( '/', 'N', 0, 0, RALPHA, A, 1, RBETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
@@ -2731,7 +2722,7 @@
|
||||
INFOT = 10
|
||||
CALL ZHERK( 'L', 'C', 2, 0, RALPHA, A, 1, RBETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
GO TO 110
|
||||
GO TO 100
|
||||
70 INFOT = 1
|
||||
CALL ZSYRK( '/', 'N', 0, 0, ALPHA, A, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
@@ -2786,7 +2777,7 @@
|
||||
INFOT = 10
|
||||
CALL ZSYRK( 'L', 'T', 2, 0, ALPHA, A, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
GO TO 110
|
||||
GO TO 100
|
||||
80 INFOT = 1
|
||||
CALL ZHER2K( '/', 'N', 0, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
@@ -2853,7 +2844,7 @@
|
||||
INFOT = 12
|
||||
CALL ZHER2K( 'L', 'C', 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
GO TO 110
|
||||
GO TO 100
|
||||
90 INFOT = 1
|
||||
CALL ZSYR2K( '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
@@ -2920,204 +2911,8 @@
|
||||
INFOT = 12
|
||||
CALL ZSYR2K( 'L', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
GO TO 110
|
||||
100 INFOT = 1
|
||||
CALL ZGEMMTR( '/', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 1
|
||||
CALL ZGEMMTR( '/', 'N', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 1
|
||||
CALL ZGEMMTR( '/', 'N', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 1
|
||||
CALL ZGEMMTR( '/', 'T', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 1
|
||||
CALL ZGEMMTR( '/', 'T', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 1
|
||||
CALL ZGEMMTR( '/', 'T', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 1
|
||||
CALL ZGEMMTR( '/', 'C', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 1
|
||||
CALL ZGEMMTR( '/', 'C', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 1
|
||||
CALL ZGEMMTR( '/', 'C', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
|
||||
INFOT = 2
|
||||
CALL ZGEMMTR( 'U', '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 2
|
||||
CALL ZGEMMTR( 'U', '/', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 2
|
||||
CALL ZGEMMTR( 'U', '/', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 2
|
||||
CALL ZGEMMTR( 'L', '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 2
|
||||
CALL ZGEMMTR( 'L', '/', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 2
|
||||
CALL ZGEMMTR( 'L', '/', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
|
||||
INFOT = 3
|
||||
CALL ZGEMMTR( 'U', 'N', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 3
|
||||
CALL ZGEMMTR( 'U', 'C', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 3
|
||||
CALL ZGEMMTR( 'U', 'T', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL ZGEMMTR( 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL ZGEMMTR( 'U', 'N', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL ZGEMMTR( 'U', 'N', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL ZGEMMTR( 'U', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL ZGEMMTR( 'U', 'C', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL ZGEMMTR( 'U', 'C', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL ZGEMMTR( 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL ZGEMMTR( 'U', 'T', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL ZGEMMTR( 'U', 'T', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 5
|
||||
CALL ZGEMMTR( 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 5
|
||||
CALL ZGEMMTR( 'U', 'N', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 5
|
||||
CALL ZGEMMTR( 'U', 'N', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 5
|
||||
CALL ZGEMMTR( 'U', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 5
|
||||
CALL ZGEMMTR( 'U', 'C', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 5
|
||||
CALL ZGEMMTR( 'U', 'C', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 5
|
||||
CALL ZGEMMTR( 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 5
|
||||
CALL ZGEMMTR( 'U', 'T', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 5
|
||||
CALL ZGEMMTR( 'U', 'T', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C,
|
||||
$ 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
|
||||
INFOT = 8
|
||||
CALL ZGEMMTR( 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL ZGEMMTR( 'U', 'N', 'C', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL ZGEMMTR( 'U', 'N', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL ZGEMMTR( 'U', 'C', 'N', 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL ZGEMMTR( 'U', 'C', 'C', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL ZGEMMTR( 'U', 'C', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL ZGEMMTR( 'U', 'T', 'N', 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL ZGEMMTR( 'U', 'T', 'C', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL ZGEMMTR( 'U', 'T', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
|
||||
INFOT = 10
|
||||
CALL ZGEMMTR( 'U', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 10
|
||||
CALL ZGEMMTR( 'U', 'C', 'N', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 10
|
||||
CALL ZGEMMTR( 'U', 'T', 'N', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 13
|
||||
CALL ZGEMMTR( 'U', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 13
|
||||
CALL ZGEMMTR( 'U', 'N', 'C', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 13
|
||||
CALL ZGEMMTR( 'U', 'N', 'T', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 13
|
||||
CALL ZGEMMTR( 'U', 'C', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 13
|
||||
CALL ZGEMMTR( 'U', 'C', 'C', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 13
|
||||
CALL ZGEMMTR( 'U', 'C', 'T', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 13
|
||||
CALL ZGEMMTR( 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 13
|
||||
CALL ZGEMMTR( 'U', 'T', 'C', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
INFOT = 13
|
||||
CALL ZGEMMTR( 'U', 'T', 'T', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
|
||||
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
|
||||
GO TO 110
|
||||
|
||||
*
|
||||
110 IF( OK )THEN
|
||||
100 IF( OK )THEN
|
||||
WRITE( NOUT, FMT = 9999 )SRNAMT
|
||||
ELSE
|
||||
WRITE( NOUT, FMT = 9998 )SRNAMT
|
||||
@@ -3631,7 +3426,7 @@
|
||||
* .. Scalar Arguments ..
|
||||
INTEGER INFOT, NOUT
|
||||
LOGICAL LERR, OK
|
||||
CHARACTER*7 SRNAMT
|
||||
CHARACTER*6 SRNAMT
|
||||
* .. Executable Statements ..
|
||||
IF( .NOT.LERR )THEN
|
||||
WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT
|
||||
@@ -3667,11 +3462,11 @@
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
INTEGER INFO
|
||||
CHARACTER*(*) SRNAME
|
||||
CHARACTER*6 SRNAME
|
||||
* .. Scalars in Common ..
|
||||
INTEGER INFOT, NOUT
|
||||
LOGICAL LERR, OK
|
||||
CHARACTER*7 SRNAMT
|
||||
CHARACTER*6 SRNAMT
|
||||
* .. Common blocks ..
|
||||
COMMON /INFOC/INFOT, NOUT, OK, LERR
|
||||
COMMON /SRNAMC/SRNAMT
|
||||
@@ -3701,498 +3496,3 @@
|
||||
* End of XERBLA
|
||||
*
|
||||
END
|
||||
|
||||
|
||||
|
||||
SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
|
||||
$ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
|
||||
$ A, AA, AS, B, BB, BS, C, CC, CS, CT, G )
|
||||
*
|
||||
* Tests ZGEMMTR.
|
||||
*
|
||||
* Auxiliary routine for test program for Level 3 Blas.
|
||||
*
|
||||
* -- Written on 8-February-1989.
|
||||
* Jack Dongarra, Argonne National Laboratory.
|
||||
* Iain Duff, AERE Harwell.
|
||||
* Jeremy Du Croz, Numerical Algorithms Group Ltd.
|
||||
* Sven Hammarling, Numerical Algorithms Group Ltd.
|
||||
*
|
||||
* .. Parameters ..
|
||||
COMPLEX*16 ZERO
|
||||
PARAMETER ( ZERO = ( 0.0, 0.0 ) )
|
||||
DOUBLE PRECISION RZERO
|
||||
PARAMETER ( RZERO = 0.0D0 )
|
||||
* .. Scalar Arguments ..
|
||||
DOUBLE PRECISION EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*7 SNAME
|
||||
* .. Array Arguments ..
|
||||
COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
$ BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
|
||||
$ C( NMAX, NMAX ), CC( NMAX*NMAX ),
|
||||
$ CS( NMAX*NMAX ), CT( NMAX )
|
||||
DOUBLE PRECISION G( NMAX )
|
||||
INTEGER IDIM( NIDIM )
|
||||
* .. Local Scalars ..
|
||||
COMPLEX*16 ALPHA, ALS, BETA, BLS
|
||||
DOUBLE PRECISION ERR, ERRMAX
|
||||
INTEGER I, IA, IB, ICA, ICB, IK, IN, K, KS, LAA,
|
||||
$ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS,
|
||||
$ MA, MB, N, NA, NARGS, NB, NC, NS, IS
|
||||
LOGICAL NULL, RESET, SAME, TRANA, TRANB
|
||||
CHARACTER*1 TRANAS, TRANBS, TRANSA, TRANSB, UPLO, UPLOS
|
||||
CHARACTER*3 ICH
|
||||
CHARACTER*2 ISHAPE
|
||||
* .. Local Arrays ..
|
||||
LOGICAL ISAME( 13 )
|
||||
* .. External Functions ..
|
||||
LOGICAL LZE, LZERES
|
||||
EXTERNAL LZE, LZERES
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL CGEMM, ZMAKE, CMMCH
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC MAX
|
||||
* .. Scalars in Common ..
|
||||
INTEGER INFOT, NOUTC
|
||||
LOGICAL LERR, OK
|
||||
* .. Common blocks ..
|
||||
COMMON /INFOC/INFOT, NOUTC, OK, LERR
|
||||
* .. Data statements ..
|
||||
DATA ICH/'NTC'/
|
||||
DATA ISHAPE/'UL'/
|
||||
|
||||
* .. Executable Statements ..
|
||||
*
|
||||
NARGS = 13
|
||||
NC = 0
|
||||
RESET = .TRUE.
|
||||
ERRMAX = RZERO
|
||||
*
|
||||
DO 100 IN = 1, NIDIM
|
||||
N = IDIM( IN )
|
||||
* Set LDC to 1 more than minimum value if room.
|
||||
LDC = N
|
||||
IF( LDC.LT.NMAX )
|
||||
$ LDC = LDC + 1
|
||||
* Skip tests if not enough room.
|
||||
IF( LDC.GT.NMAX )
|
||||
$ GO TO 100
|
||||
LCC = LDC*N
|
||||
NULL = N.LE.0
|
||||
*
|
||||
DO 90 IK = 1, NIDIM
|
||||
K = IDIM( IK )
|
||||
*
|
||||
DO 80 ICA = 1, 3
|
||||
TRANSA = ICH( ICA: ICA )
|
||||
TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C'
|
||||
*
|
||||
IF( TRANA )THEN
|
||||
MA = K
|
||||
NA = N
|
||||
ELSE
|
||||
MA = N
|
||||
NA = K
|
||||
END IF
|
||||
* Set LDA to 1 more than minimum value if room.
|
||||
LDA = MA
|
||||
IF( LDA.LT.NMAX )
|
||||
$ LDA = LDA + 1
|
||||
* Skip tests if not enough room.
|
||||
IF( LDA.GT.NMAX )
|
||||
$ GO TO 80
|
||||
LAA = LDA*NA
|
||||
*
|
||||
* Generate the matrix A.
|
||||
*
|
||||
CALL ZMAKE( 'GE', ' ', ' ', MA, NA, A, NMAX, AA, LDA,
|
||||
$ RESET, ZERO )
|
||||
*
|
||||
DO 70 ICB = 1, 3
|
||||
TRANSB = ICH( ICB: ICB )
|
||||
TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C'
|
||||
*
|
||||
IF( TRANB )THEN
|
||||
MB = N
|
||||
NB = K
|
||||
ELSE
|
||||
MB = K
|
||||
NB = N
|
||||
END IF
|
||||
* Set LDB to 1 more than minimum value if room.
|
||||
LDB = MB
|
||||
IF( LDB.LT.NMAX )
|
||||
$ LDB = LDB + 1
|
||||
* Skip tests if not enough room.
|
||||
IF( LDB.GT.NMAX )
|
||||
$ GO TO 70
|
||||
LBB = LDB*NB
|
||||
*
|
||||
* Generate the matrix B.
|
||||
*
|
||||
CALL ZMAKE( 'GE', ' ', ' ', MB, NB, B, NMAX, BB,
|
||||
$ LDB, RESET, ZERO )
|
||||
*
|
||||
DO 60 IA = 1, NALF
|
||||
ALPHA = ALF( IA )
|
||||
*
|
||||
DO 50 IB = 1, NBET
|
||||
BETA = BET( IB )
|
||||
DO 45 IS = 1, 2
|
||||
UPLO = ISHAPE( IS: IS )
|
||||
|
||||
*
|
||||
* Generate the matrix C.
|
||||
*
|
||||
CALL ZMAKE( 'GE', UPLO, ' ', N, N, C, NMAX,
|
||||
$ CC, LDC, RESET, ZERO )
|
||||
*
|
||||
NC = NC + 1
|
||||
*
|
||||
* Save every datum before calling the
|
||||
* subroutine.
|
||||
*
|
||||
UPLOS = UPLO
|
||||
TRANAS = TRANSA
|
||||
TRANBS = TRANSB
|
||||
NS = N
|
||||
KS = K
|
||||
ALS = ALPHA
|
||||
DO 10 I = 1, LAA
|
||||
AS( I ) = AA( I )
|
||||
10 CONTINUE
|
||||
LDAS = LDA
|
||||
DO 20 I = 1, LBB
|
||||
BS( I ) = BB( I )
|
||||
20 CONTINUE
|
||||
LDBS = LDB
|
||||
BLS = BETA
|
||||
DO 30 I = 1, LCC
|
||||
CS( I ) = CC( I )
|
||||
30 CONTINUE
|
||||
LDCS = LDC
|
||||
*
|
||||
* Call the subroutine.
|
||||
*
|
||||
IF( TRACE )
|
||||
$ WRITE( NTRA, FMT = 9995 )NC, SNAME, UPLO,
|
||||
$ TRANSA, TRANSB, N, K, ALPHA, LDA, LDB,
|
||||
$ BETA, LDC
|
||||
IF( REWI )
|
||||
$ REWIND NTRA
|
||||
CALL ZGEMMTR( UPLO, TRANSA, TRANSB, N, K,
|
||||
$ ALPHA, AA, LDA, BB, LDB, BETA,
|
||||
$ CC, LDC )
|
||||
*
|
||||
* Check if error-exit was taken incorrectly.
|
||||
*
|
||||
IF( .NOT.OK )THEN
|
||||
WRITE( NOUT, FMT = 9994 )
|
||||
FATAL = .TRUE.
|
||||
GO TO 120
|
||||
END IF
|
||||
*
|
||||
* See what data changed inside subroutines.
|
||||
*
|
||||
ISAME( 1 ) = UPLOS.EQ.UPLO
|
||||
ISAME( 2 ) = TRANSA.EQ.TRANAS
|
||||
ISAME( 3 ) = TRANSB.EQ.TRANBS
|
||||
ISAME( 4 ) = NS.EQ.N
|
||||
ISAME( 5 ) = KS.EQ.K
|
||||
ISAME( 6 ) = ALS.EQ.ALPHA
|
||||
ISAME( 7 ) = LZE( AS, AA, LAA )
|
||||
ISAME( 8 ) = LDAS.EQ.LDA
|
||||
ISAME( 9 ) = LZE( BS, BB, LBB )
|
||||
ISAME( 10 ) = LDBS.EQ.LDB
|
||||
ISAME( 11 ) = BLS.EQ.BETA
|
||||
IF( NULL )THEN
|
||||
ISAME( 12 ) = LZE( CS, CC, LCC )
|
||||
ELSE
|
||||
ISAME( 12 ) = LZERES( 'GE', ' ', N, N, CS,
|
||||
$ CC, LDC )
|
||||
END IF
|
||||
ISAME( 13 ) = LDCS.EQ.LDC
|
||||
*
|
||||
* If data was incorrectly changed, report
|
||||
* and return.
|
||||
*
|
||||
SAME = .TRUE.
|
||||
DO 40 I = 1, NARGS
|
||||
SAME = SAME.AND.ISAME( I )
|
||||
IF( .NOT.ISAME( I ) )
|
||||
$ WRITE( NOUT, FMT = 9998 )I
|
||||
40 CONTINUE
|
||||
IF( .NOT.SAME )THEN
|
||||
FATAL = .TRUE.
|
||||
GO TO 120
|
||||
END IF
|
||||
*
|
||||
IF( .NOT.NULL )THEN
|
||||
*
|
||||
* Check the result.
|
||||
*
|
||||
CALL ZMMTCH( UPLO, TRANSA, TRANSB, N,
|
||||
$ K, ALPHA, A, NMAX, B, NMAX,
|
||||
$ BETA, C, NMAX, CT, G, CC, LDC,
|
||||
$ EPS, ERR, FATAL, NOUT, .TRUE.)
|
||||
ERRMAX = MAX( ERRMAX, ERR )
|
||||
* If got really bad answer, report and
|
||||
* return.
|
||||
IF( FATAL )
|
||||
$ GO TO 120
|
||||
END IF
|
||||
45 CONTINUE
|
||||
*
|
||||
50 CONTINUE
|
||||
*
|
||||
60 CONTINUE
|
||||
*
|
||||
70 CONTINUE
|
||||
*
|
||||
80 CONTINUE
|
||||
*
|
||||
90 CONTINUE
|
||||
*
|
||||
100 CONTINUE
|
||||
*
|
||||
*
|
||||
* Report result.
|
||||
*
|
||||
IF( ERRMAX.LT.THRESH )THEN
|
||||
WRITE( NOUT, FMT = 9999 )SNAME, NC
|
||||
ELSE
|
||||
WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
|
||||
END IF
|
||||
GO TO 130
|
||||
*
|
||||
120 CONTINUE
|
||||
WRITE( NOUT, FMT = 9996 )SNAME
|
||||
WRITE( NOUT, FMT = 9995 )NC, SNAME, TRANSA, TRANSB, N, K,
|
||||
$ ALPHA, LDA, LDB, BETA, LDC
|
||||
*
|
||||
130 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
|
||||
$ 'S)' )
|
||||
9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
|
||||
$ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
|
||||
$ ' - SUSPECT *******' )
|
||||
9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( 1X, I6, ': ', A6, '(''',A1, ''',''',A1, ''',''', A1,''',',
|
||||
$ 2( I3, ',' ), '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3,
|
||||
$ ',(', F4.1, ',', F4.1, '), C,', I3, ').' )
|
||||
9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
$ '******' )
|
||||
*
|
||||
* End of ZCHK6
|
||||
*
|
||||
END
|
||||
|
||||
SUBROUTINE ZMMTCH( UPLO, TRANSA, TRANSB, N, KK, ALPHA, A, LDA,
|
||||
$ B, LDB, BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR,
|
||||
$ FATAL, NOUT, MV )
|
||||
IMPLICIT NONE
|
||||
*
|
||||
* Checks the results of the computational tests.
|
||||
*
|
||||
* Auxiliary routine for test program for Level 3 Blas.
|
||||
*
|
||||
* -- Written on 8-February-1989.
|
||||
* Jack Dongarra, Argonne National Laboratory.
|
||||
* Iain Duff, AERE Harwell.
|
||||
* Jeremy Du Croz, Numerical Algorithms Group Ltd.
|
||||
* Sven Hammarling, Numerical Algorithms Group Ltd.
|
||||
*
|
||||
* .. Parameters ..
|
||||
COMPLEX*16 ZERO
|
||||
PARAMETER ( ZERO = ( 0.0, 0.0 ) )
|
||||
DOUBLE PRECISION RZERO, RONE
|
||||
PARAMETER ( RZERO = 0.0D0, RONE = 1.0D0 )
|
||||
* .. Scalar Arguments ..
|
||||
COMPLEX*16 ALPHA, BETA
|
||||
DOUBLE PRECISION EPS, ERR
|
||||
INTEGER KK, LDA, LDB, LDC, LDCC, N, NOUT
|
||||
LOGICAL FATAL, MV
|
||||
CHARACTER*1 TRANSA, TRANSB, UPLO
|
||||
* .. Array Arguments ..
|
||||
COMPLEX*16 A( LDA, * ), B( LDB, * ), C( LDC, * ),
|
||||
$ CC( LDCC, * ), CT( * )
|
||||
DOUBLE PRECISION G( * )
|
||||
* .. Local Scalars ..
|
||||
COMPLEX*16 CL
|
||||
DOUBLE PRECISION ERRI
|
||||
INTEGER I, J, K, ISTART, ISTOP
|
||||
LOGICAL CTRANA, CTRANB, TRANA, TRANB, UPPER
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC ABS, AIMAG, CONJG, MAX, REAL, SQRT
|
||||
* .. Statement Functions ..
|
||||
DOUBLE PRECISION ABS1
|
||||
* .. Statement Function definitions ..
|
||||
ABS1( CL ) = ABS( DBLE( CL ) ) + ABS( DIMAG( CL ) )
|
||||
* .. Executable Statements ..
|
||||
UPPER = UPLO.EQ.'U'
|
||||
TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C'
|
||||
TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C'
|
||||
CTRANA = TRANSA.EQ.'C'
|
||||
CTRANB = TRANSB.EQ.'C'
|
||||
*
|
||||
* Compute expected result, one column at a time, in CT using data
|
||||
* in A, B and C.
|
||||
* Compute gauges in G.
|
||||
*
|
||||
ISTART = 1
|
||||
ISTOP = 1
|
||||
|
||||
DO 220 J = 1, N
|
||||
*
|
||||
IF ( UPPER ) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
|
||||
DO 10 I = ISTART, ISTOP
|
||||
CT( I ) = ZERO
|
||||
G( I ) = RZERO
|
||||
10 CONTINUE
|
||||
IF( .NOT.TRANA.AND..NOT.TRANB )THEN
|
||||
DO 30 K = 1, KK
|
||||
DO 20 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( I, K )*B( K, J )
|
||||
G( I ) = G( I ) + ABS1( A( I, K ) )*ABS1( B( K, J ) )
|
||||
20 CONTINUE
|
||||
30 CONTINUE
|
||||
ELSE IF( TRANA.AND..NOT.TRANB )THEN
|
||||
IF( CTRANA )THEN
|
||||
DO 50 K = 1, KK
|
||||
DO 40 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + CONJG( A( K, I ) )*B( K, J )
|
||||
G( I ) = G( I ) + ABS1( A( K, I ) )*
|
||||
$ ABS1( B( K, J ) )
|
||||
40 CONTINUE
|
||||
50 CONTINUE
|
||||
ELSE
|
||||
DO 70 K = 1, KK
|
||||
DO 60 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( K, I )*B( K, J )
|
||||
G( I ) = G( I ) + ABS1( A( K, I ) )*
|
||||
$ ABS1( B( K, J ) )
|
||||
60 CONTINUE
|
||||
70 CONTINUE
|
||||
END IF
|
||||
ELSE IF( .NOT.TRANA.AND.TRANB )THEN
|
||||
IF( CTRANB )THEN
|
||||
DO 90 K = 1, KK
|
||||
DO 80 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( I, K )*CONJG( B( J, K ) )
|
||||
G( I ) = G( I ) + ABS1( A( I, K ) )*
|
||||
$ ABS1( B( J, K ) )
|
||||
80 CONTINUE
|
||||
90 CONTINUE
|
||||
ELSE
|
||||
DO 110 K = 1, KK
|
||||
DO 100 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( I, K )*B( J, K )
|
||||
G( I ) = G( I ) + ABS1( A( I, K ) )*
|
||||
$ ABS1( B( J, K ) )
|
||||
100 CONTINUE
|
||||
110 CONTINUE
|
||||
END IF
|
||||
ELSE IF( TRANA.AND.TRANB )THEN
|
||||
IF( CTRANA )THEN
|
||||
IF( CTRANB )THEN
|
||||
DO 130 K = 1, KK
|
||||
DO 120 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + CONJG( A( K, I ) )*
|
||||
$ CONJG( B( J, K ) )
|
||||
G( I ) = G( I ) + ABS1( A( K, I ) )*
|
||||
$ ABS1( B( J, K ) )
|
||||
120 CONTINUE
|
||||
130 CONTINUE
|
||||
ELSE
|
||||
DO 150 K = 1, KK
|
||||
DO 140 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + CONJG( A( K, I ) )*B( J, K )
|
||||
G( I ) = G( I ) + ABS1( A( K, I ) )*
|
||||
$ ABS1( B( J, K ) )
|
||||
140 CONTINUE
|
||||
150 CONTINUE
|
||||
END IF
|
||||
ELSE
|
||||
IF( CTRANB )THEN
|
||||
DO 170 K = 1, KK
|
||||
DO 160 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( K, I )*CONJG( B( J, K ) )
|
||||
G( I ) = G( I ) + ABS1( A( K, I ) )*
|
||||
$ ABS1( B( J, K ) )
|
||||
160 CONTINUE
|
||||
170 CONTINUE
|
||||
ELSE
|
||||
DO 190 K = 1, KK
|
||||
DO 180 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( K, I )*B( J, K )
|
||||
G( I ) = G( I ) + ABS1( A( K, I ) )*
|
||||
$ ABS1( B( J, K ) )
|
||||
180 CONTINUE
|
||||
190 CONTINUE
|
||||
END IF
|
||||
END IF
|
||||
END IF
|
||||
DO 200 I = ISTART, ISTOP
|
||||
CT( I ) = ALPHA*CT( I ) + BETA*C( I, J )
|
||||
G( I ) = ABS1( ALPHA )*G( I ) +
|
||||
$ ABS1( BETA )*ABS1( C( I, J ) )
|
||||
200 CONTINUE
|
||||
*
|
||||
* Compute the error ratio for this result.
|
||||
*
|
||||
ERR = ZERO
|
||||
DO 210 I = ISTART, ISTOP
|
||||
ERRI = ABS1( CT( I ) - CC( I, J ) )/EPS
|
||||
IF( G( I ).NE.RZERO )
|
||||
$ ERRI = ERRI/G( I )
|
||||
ERR = MAX( ERR, ERRI )
|
||||
IF( ERR*SQRT( EPS ).GE.RONE )
|
||||
$ GO TO 230
|
||||
210 CONTINUE
|
||||
*
|
||||
220 CONTINUE
|
||||
*
|
||||
* If the loop completes, all results are at least half accurate.
|
||||
GO TO 250
|
||||
*
|
||||
* Report fatal error.
|
||||
*
|
||||
230 FATAL = .TRUE.
|
||||
WRITE( NOUT, FMT = 9999 )
|
||||
DO 240 I = ISTART, ISTOP
|
||||
IF( MV )THEN
|
||||
WRITE( NOUT, FMT = 9998 )I, CT( I ), CC( I, J )
|
||||
ELSE
|
||||
WRITE( NOUT, FMT = 9998 )I, CC( I, J ), CT( I )
|
||||
END IF
|
||||
240 CONTINUE
|
||||
IF( N.GT.1 )
|
||||
$ WRITE( NOUT, FMT = 9997 )J
|
||||
*
|
||||
250 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
|
||||
$ 'F ACCURATE *******', /' EXPECTED RE',
|
||||
$ 'SULT COMPUTED RESULT' )
|
||||
9998 FORMAT( 1X, I7, 2( ' (', G15.6, ',', G15.6, ')' ) )
|
||||
9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 )
|
||||
*
|
||||
* End of ZMMTCH
|
||||
*
|
||||
END
|
||||
|
||||
|
||||
+9
-10
@@ -12,13 +12,12 @@ T LOGICAL FLAG, T TO TEST ERROR EXITS.
|
||||
(0.0,0.0) (1.0,0.0) (0.7,-0.9) VALUES OF ALPHA
|
||||
3 NUMBER OF VALUES OF BETA
|
||||
(0.0,0.0) (1.0,0.0) (1.3,-1.1) VALUES OF BETA
|
||||
ZGEMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
ZHEMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
ZSYMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
ZTRMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
ZTRSM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
ZHERK T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
ZSYRK T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
ZHER2K T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
ZSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
ZGEMMTR T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
ZGEMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
ZHEMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
ZSYMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
ZTRMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
ZTRSM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
ZHERK T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
ZSYRK T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
ZHER2K T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
ZSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
|
||||
@@ -1,11 +1,10 @@
|
||||
/* cblas_example2.c */
|
||||
|
||||
#define CBLAS_API64
|
||||
#define F77_INT int64_t
|
||||
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include "cblas_64.h"
|
||||
#define CBLAS_API64
|
||||
#define F77_INT int64_t
|
||||
#include "cblas_f77.h"
|
||||
|
||||
#define INVALID -1
|
||||
|
||||
@@ -472,12 +472,6 @@ void cblas_sgemm(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA,
|
||||
const CBLAS_INT K, const float alpha, const float *A,
|
||||
const CBLAS_INT lda, const float *B, const CBLAS_INT ldb,
|
||||
const float beta, float *C, const CBLAS_INT ldc);
|
||||
void cblas_sgemmtr(CBLAS_LAYOUT layout,CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA,
|
||||
CBLAS_TRANSPOSE TransB, const CBLAS_INT N,
|
||||
const CBLAS_INT K, const float alpha, const float *A,
|
||||
const CBLAS_INT lda, const float *B, const CBLAS_INT ldb,
|
||||
const float beta, float *C, const CBLAS_INT ldc);
|
||||
|
||||
void cblas_ssymm(CBLAS_LAYOUT layout, CBLAS_SIDE Side,
|
||||
CBLAS_UPLO Uplo, const CBLAS_INT M, const CBLAS_INT N,
|
||||
const float alpha, const float *A, const CBLAS_INT lda,
|
||||
@@ -508,11 +502,6 @@ void cblas_dgemm(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA,
|
||||
const CBLAS_INT K, const double alpha, const double *A,
|
||||
const CBLAS_INT lda, const double *B, const CBLAS_INT ldb,
|
||||
const double beta, double *C, const CBLAS_INT ldc);
|
||||
void cblas_dgemmtr(CBLAS_LAYOUT layout,CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA,
|
||||
CBLAS_TRANSPOSE TransB, const CBLAS_INT N,
|
||||
const CBLAS_INT K, const double alpha, const double *A,
|
||||
const CBLAS_INT lda, const double *B, const CBLAS_INT ldb,
|
||||
const double beta, double *C, const CBLAS_INT ldc);
|
||||
void cblas_dsymm(CBLAS_LAYOUT layout, CBLAS_SIDE Side,
|
||||
CBLAS_UPLO Uplo, const CBLAS_INT M, const CBLAS_INT N,
|
||||
const double alpha, const double *A, const CBLAS_INT lda,
|
||||
@@ -543,11 +532,6 @@ void cblas_cgemm(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA,
|
||||
const CBLAS_INT K, const void *alpha, const void *A,
|
||||
const CBLAS_INT lda, const void *B, const CBLAS_INT ldb,
|
||||
const void *beta, void *C, const CBLAS_INT ldc);
|
||||
void cblas_cgemmtr(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA,
|
||||
CBLAS_TRANSPOSE TransB, const CBLAS_INT N,
|
||||
const CBLAS_INT K, const void *alpha, const void *A,
|
||||
const CBLAS_INT lda, const void *B, const CBLAS_INT ldb,
|
||||
const void *beta, void *C, const CBLAS_INT ldc);
|
||||
void cblas_csymm(CBLAS_LAYOUT layout, CBLAS_SIDE Side,
|
||||
CBLAS_UPLO Uplo, const CBLAS_INT M, const CBLAS_INT N,
|
||||
const void *alpha, const void *A, const CBLAS_INT lda,
|
||||
@@ -578,11 +562,6 @@ void cblas_zgemm(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA,
|
||||
const CBLAS_INT K, const void *alpha, const void *A,
|
||||
const CBLAS_INT lda, const void *B, const CBLAS_INT ldb,
|
||||
const void *beta, void *C, const CBLAS_INT ldc);
|
||||
void cblas_zgemmtr(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA,
|
||||
CBLAS_TRANSPOSE TransB, const CBLAS_INT N,
|
||||
const CBLAS_INT K, const void *alpha, const void *A,
|
||||
const CBLAS_INT lda, const void *B, const CBLAS_INT ldb,
|
||||
const void *beta, void *C, const CBLAS_INT ldc);
|
||||
void cblas_zsymm(CBLAS_LAYOUT layout, CBLAS_SIDE Side,
|
||||
CBLAS_UPLO Uplo, const CBLAS_INT M, const CBLAS_INT N,
|
||||
const void *alpha, const void *A, const CBLAS_INT lda,
|
||||
|
||||
@@ -423,12 +423,6 @@ void cblas_sgemm_64(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA,
|
||||
const int64_t K, const float alpha, const float *A,
|
||||
const int64_t lda, const float *B, const int64_t ldb,
|
||||
const float beta, float *C, const int64_t ldc);
|
||||
void cblas_sgemmtr_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA,
|
||||
CBLAS_TRANSPOSE TransB, const int64_t N,
|
||||
const int64_t K, const float alpha, const float *A,
|
||||
const int64_t lda, const float *B, const int64_t ldb,
|
||||
const float beta, float *C, const int64_t ldc);
|
||||
|
||||
void cblas_ssymm_64(CBLAS_LAYOUT layout, CBLAS_SIDE Side,
|
||||
CBLAS_UPLO Uplo, const int64_t M, const int64_t N,
|
||||
const float alpha, const float *A, const int64_t lda,
|
||||
@@ -459,11 +453,6 @@ void cblas_dgemm_64(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA,
|
||||
const int64_t K, const double alpha, const double *A,
|
||||
const int64_t lda, const double *B, const int64_t ldb,
|
||||
const double beta, double *C, const int64_t ldc);
|
||||
void cblas_dgemmtr_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA,
|
||||
CBLAS_TRANSPOSE TransB, const int64_t N,
|
||||
const int64_t K, const double alpha, const double *A,
|
||||
const int64_t lda, const double *B, const int64_t ldb,
|
||||
const double beta, double *C, const int64_t ldc);
|
||||
void cblas_dsymm_64(CBLAS_LAYOUT layout, CBLAS_SIDE Side,
|
||||
CBLAS_UPLO Uplo, const int64_t M, const int64_t N,
|
||||
const double alpha, const double *A, const int64_t lda,
|
||||
@@ -494,12 +483,6 @@ void cblas_cgemm_64(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA,
|
||||
const int64_t K, const void *alpha, const void *A,
|
||||
const int64_t lda, const void *B, const int64_t ldb,
|
||||
const void *beta, void *C, const int64_t ldc);
|
||||
void cblas_cgemmtr_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA,
|
||||
CBLAS_TRANSPOSE TransB, const int64_t N,
|
||||
const int64_t K, const void *alpha, const void *A,
|
||||
const int64_t lda, const void *B, const int64_t ldb,
|
||||
const void *beta, void *C, const int64_t ldc);
|
||||
|
||||
void cblas_csymm_64(CBLAS_LAYOUT layout, CBLAS_SIDE Side,
|
||||
CBLAS_UPLO Uplo, const int64_t M, const int64_t N,
|
||||
const void *alpha, const void *A, const int64_t lda,
|
||||
@@ -530,11 +513,6 @@ void cblas_zgemm_64(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA,
|
||||
const int64_t K, const void *alpha, const void *A,
|
||||
const int64_t lda, const void *B, const int64_t ldb,
|
||||
const void *beta, void *C, const int64_t ldc);
|
||||
void cblas_zgemmtr_64(CBLAS_LAYOUT layout,CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA,
|
||||
CBLAS_TRANSPOSE TransB, const int64_t N,
|
||||
const int64_t K, const void *alpha, const void *A,
|
||||
const int64_t lda, const void *B, const int64_t ldb,
|
||||
const void *beta, void *C, const int64_t ldc);
|
||||
void cblas_zsymm_64(CBLAS_LAYOUT layout, CBLAS_SIDE Side,
|
||||
CBLAS_UPLO Uplo, const int64_t M, const int64_t N,
|
||||
const void *alpha, const void *A, const int64_t lda,
|
||||
|
||||
+111
-153
@@ -17,10 +17,6 @@
|
||||
* or make the str argument into a struct. */
|
||||
#define BLAS_FORTRAN_STRLEN_END
|
||||
|
||||
#ifndef FORTRAN_STRLEN
|
||||
#define FORTRAN_STRLEN size_t
|
||||
#endif
|
||||
|
||||
#ifdef CRAY
|
||||
#include <fortran.h>
|
||||
#define F77_CHAR _fcd
|
||||
@@ -197,28 +193,24 @@
|
||||
#define F77_zherk_base F77_GLOBAL_SUFFIX(zherk,ZHERK)
|
||||
#define F77_zher2k_base F77_GLOBAL_SUFFIX(zher2k,ZHER2K)
|
||||
#define F77_sgemm_base F77_GLOBAL_SUFFIX(sgemm,SGEMM)
|
||||
#define F77_sgemmtr_base F77_GLOBAL_SUFFIX(sgemmtr,SGEMMTR)
|
||||
#define F77_ssymm_base F77_GLOBAL_SUFFIX(ssymm,SSYMM)
|
||||
#define F77_ssyrk_base F77_GLOBAL_SUFFIX(ssyrk,SSYRK)
|
||||
#define F77_ssyr2k_base F77_GLOBAL_SUFFIX(ssyr2k,SSYR2K)
|
||||
#define F77_strmm_base F77_GLOBAL_SUFFIX(strmm,STRMM)
|
||||
#define F77_strsm_base F77_GLOBAL_SUFFIX(strsm,STRSM)
|
||||
#define F77_dgemm_base F77_GLOBAL_SUFFIX(dgemm,DGEMM)
|
||||
#define F77_dgemmtr_base F77_GLOBAL_SUFFIX(dgemmtr,DGEMMTR)
|
||||
#define F77_dsymm_base F77_GLOBAL_SUFFIX(dsymm,DSYMM)
|
||||
#define F77_dsyrk_base F77_GLOBAL_SUFFIX(dsyrk,DSYRK)
|
||||
#define F77_dsyr2k_base F77_GLOBAL_SUFFIX(dsyr2k,DSYR2K)
|
||||
#define F77_dtrmm_base F77_GLOBAL_SUFFIX(dtrmm,DTRMM)
|
||||
#define F77_dtrsm_base F77_GLOBAL_SUFFIX(dtrsm,DTRSM)
|
||||
#define F77_cgemm_base F77_GLOBAL_SUFFIX(cgemm,CGEMM)
|
||||
#define F77_cgemmtr_base F77_GLOBAL_SUFFIX(cgemmtr,CGEMMTR)
|
||||
#define F77_csymm_base F77_GLOBAL_SUFFIX(csymm,CSYMM)
|
||||
#define F77_csyrk_base F77_GLOBAL_SUFFIX(csyrk,CSYRK)
|
||||
#define F77_csyr2k_base F77_GLOBAL_SUFFIX(csyr2k,CSYR2K)
|
||||
#define F77_ctrmm_base F77_GLOBAL_SUFFIX(ctrmm,CTRMM)
|
||||
#define F77_ctrsm_base F77_GLOBAL_SUFFIX(ctrsm,CTRSM)
|
||||
#define F77_zgemm_base F77_GLOBAL_SUFFIX(zgemm,ZGEMM)
|
||||
#define F77_zgemmtr_base F77_GLOBAL_SUFFIX(zgemmtr,ZGEMMTR)
|
||||
#define F77_zsymm_base F77_GLOBAL_SUFFIX(zsymm,ZSYMM)
|
||||
#define F77_zsyrk_base F77_GLOBAL_SUFFIX(zsyrk,ZSYRK)
|
||||
#define F77_zsyr2k_base F77_GLOBAL_SUFFIX(zsyr2k,ZSYR2K)
|
||||
@@ -393,7 +385,6 @@
|
||||
/* Single Precision */
|
||||
|
||||
#define F77_sgemm(...) F77_sgemm_base(__VA_ARGS__, 1, 1)
|
||||
#define F77_sgemmtr(...) F77_sgemmtr_base(__VA_ARGS__, 1, 1, 1)
|
||||
#define F77_ssymm(...) F77_ssymm_base(__VA_ARGS__, 1, 1)
|
||||
#define F77_ssyrk(...) F77_ssyrk_base(__VA_ARGS__, 1, 1)
|
||||
#define F77_ssyr2k(...) F77_ssyr2k_base(__VA_ARGS__, 1, 1)
|
||||
@@ -403,7 +394,6 @@
|
||||
/* Double Precision */
|
||||
|
||||
#define F77_dgemm(...) F77_dgemm_base(__VA_ARGS__, 1, 1)
|
||||
#define F77_dgemmtr(...) F77_dgemmtr_base(__VA_ARGS__, 1, 1, 1)
|
||||
#define F77_dsymm(...) F77_dsymm_base(__VA_ARGS__, 1, 1)
|
||||
#define F77_dsyrk(...) F77_dsyrk_base(__VA_ARGS__, 1, 1)
|
||||
#define F77_dsyr2k(...) F77_dsyr2k_base(__VA_ARGS__, 1, 1)
|
||||
@@ -413,7 +403,6 @@
|
||||
/* Single Complex Precision */
|
||||
|
||||
#define F77_cgemm(...) F77_cgemm_base(__VA_ARGS__, 1, 1)
|
||||
#define F77_cgemmtr(...) F77_cgemmtr_base(__VA_ARGS__, 1, 1, 1)
|
||||
#define F77_csymm(...) F77_csymm_base(__VA_ARGS__, 1, 1)
|
||||
#define F77_chemm(...) F77_chemm_base(__VA_ARGS__, 1, 1)
|
||||
#define F77_csyrk(...) F77_csyrk_base(__VA_ARGS__, 1, 1)
|
||||
@@ -426,7 +415,6 @@
|
||||
/* Double Complex Precision */
|
||||
|
||||
#define F77_zgemm(...) F77_zgemm_base(__VA_ARGS__, 1, 1)
|
||||
#define F77_zgemmtr(...) F77_zgemmtr_base(__VA_ARGS__, 1, 1, 1)
|
||||
#define F77_zsymm(...) F77_zsymm_base(__VA_ARGS__, 1, 1)
|
||||
#define F77_zhemm(...) F77_zhemm_base(__VA_ARGS__, 1, 1)
|
||||
#define F77_zsyrk(...) F77_zsyrk_base(__VA_ARGS__, 1, 1)
|
||||
@@ -521,7 +509,6 @@
|
||||
/* Single Precision */
|
||||
|
||||
#define F77_sgemm(...) F77_sgemm_base(__VA_ARGS__)
|
||||
#define F77_sgemmtr(...) F77_sgemmtr_base(__VA_ARGS__)
|
||||
#define F77_ssymm(...) F77_ssymm_base(__VA_ARGS__)
|
||||
#define F77_ssyrk(...) F77_ssyrk_base(__VA_ARGS__)
|
||||
#define F77_ssyr2k(...) F77_ssyr2k_base(__VA_ARGS__)
|
||||
@@ -531,7 +518,6 @@
|
||||
/* Double Precision */
|
||||
|
||||
#define F77_dgemm(...) F77_dgemm_base(__VA_ARGS__)
|
||||
#define F77_dgemmtr(...) F77_dgemmtr_base(__VA_ARGS__)
|
||||
#define F77_dsymm(...) F77_dsymm_base(__VA_ARGS__)
|
||||
#define F77_dsyrk(...) F77_dsyrk_base(__VA_ARGS__)
|
||||
#define F77_dsyr2k(...) F77_dsyr2k_base(__VA_ARGS__)
|
||||
@@ -541,7 +527,6 @@
|
||||
/* Single Complex Precision */
|
||||
|
||||
#define F77_cgemm(...) F77_cgemm_base(__VA_ARGS__)
|
||||
#define F77_cgemmtr(...) F77_cgemmtr_base(__VA_ARGS__)
|
||||
#define F77_csymm(...) F77_csymm_base(__VA_ARGS__)
|
||||
#define F77_chemm(...) F77_chemm_base(__VA_ARGS__)
|
||||
#define F77_csyrk(...) F77_csyrk_base(__VA_ARGS__)
|
||||
@@ -554,7 +539,6 @@
|
||||
/* Double Complex Precision */
|
||||
|
||||
#define F77_zgemm(...) F77_zgemm_base(__VA_ARGS__)
|
||||
#define F77_zgemmtr(...) F77_zgemmtr_base(__VA_ARGS__)
|
||||
#define F77_zsymm(...) F77_zsymm_base(__VA_ARGS__)
|
||||
#define F77_zhemm(...) F77_zhemm_base(__VA_ARGS__)
|
||||
#define F77_zsyrk(...) F77_zsyrk_base(__VA_ARGS__)
|
||||
@@ -585,7 +569,7 @@ __attribute__((weak))
|
||||
#endif
|
||||
F77_xerbla_base(FCHAR, void *
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
|
||||
@@ -668,78 +652,78 @@ void F77_dcabs1_sub_base(const void *, double *);
|
||||
|
||||
void F77_sgemv_base(FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_sgbmv_base(FCHAR, FINT, FINT, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_ssymv_base(FCHAR, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_ssbmv_base(FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_sspmv_base(FCHAR, FINT, const float *, const float *, const float *, FINT, const float *, float *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_strmv_base(FCHAR, FCHAR, FCHAR, FINT, const float *, FINT, float *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_stbmv_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, FINT, float *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_strsv_base(FCHAR, FCHAR, FCHAR, FINT, const float *, FINT, float *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_stbsv_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, FINT, float *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_stpmv_base(FCHAR, FCHAR, FCHAR, FINT, const float *, float *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_stpsv_base(FCHAR, FCHAR, FCHAR, FINT, const float *, float *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_sger_base(FINT, FINT, const float *, const float *, FINT, const float *, FINT, float *, FINT);
|
||||
void F77_ssyr_base(FCHAR, FINT, const float *, const float *, FINT, float *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_sspr_base(FCHAR, FINT, const float *, const float *, FINT, float *
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_sspr2_base(FCHAR, FINT, const float *, const float *, FINT, const float *, FINT, float *
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_ssyr2_base(FCHAR, FINT, const float *, const float *, FINT, const float *, FINT, float *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
|
||||
@@ -747,78 +731,78 @@ void F77_ssyr2_base(FCHAR, FINT, const float *, const float *, FINT, const float
|
||||
|
||||
void F77_dgemv_base(FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_dgbmv_base(FCHAR, FINT, FINT, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_dsymv_base(FCHAR, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_dsbmv_base(FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_dspmv_base(FCHAR, FINT, const double *, const double *, const double *, FINT, const double *, double *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_dtrmv_base(FCHAR, FCHAR, FCHAR, FINT, const double *, FINT, double *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_dtbmv_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, FINT, double *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_dtrsv_base(FCHAR, FCHAR, FCHAR, FINT, const double *, FINT, double *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_dtbsv_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, FINT, double *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_dtpmv_base(FCHAR, FCHAR, FCHAR, FINT, const double *, double *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_dtpsv_base(FCHAR, FCHAR, FCHAR, FINT, const double *, double *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_dger_base(FINT, FINT, const double *, const double *, FINT, const double *, FINT, double *, FINT);
|
||||
void F77_dsyr_base(FCHAR, FINT, const double *, const double *, FINT, double *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_dspr_base(FCHAR, FINT, const double *, const double *, FINT, double *
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_dspr2_base(FCHAR, FINT, const double *, const double *, FINT, const double *, FINT, double *
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_dsyr2_base(FCHAR, FINT, const double *, const double *, FINT, const double *, FINT, double *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
|
||||
@@ -826,79 +810,79 @@ void F77_dsyr2_base(FCHAR, FINT, const double *, const double *, FINT, const dou
|
||||
|
||||
void F77_cgemv_base(FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_cgbmv_base(FCHAR, FINT, FINT, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_chemv_base(FCHAR, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_chbmv_base(FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_chpmv_base(FCHAR, FINT, const void *, const void *, const void *, FINT, const void *, void *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_ctrmv_base(FCHAR, FCHAR, FCHAR, FINT, const void *, FINT, void *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_ctbmv_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, FINT, void *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_ctpmv_base(FCHAR, FCHAR, FCHAR, FINT, const void *, void *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_ctrsv_base(FCHAR, FCHAR, FCHAR, FINT, const void *, FINT, void *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_ctbsv_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, FINT, void *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_ctpsv_base(FCHAR, FCHAR, FCHAR, FINT, const void *, void *,FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_cgerc_base(FINT, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT);
|
||||
void F77_cgeru_base(FINT, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT);
|
||||
void F77_cher_base(FCHAR, FINT, const float *, const void *, FINT, void *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_cher2_base(FCHAR, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_chpr_base(FCHAR, FINT, const float *, const void *, FINT, void *
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_chpr2_base(FCHAR, FINT, const void *, const void *, FINT, const void *, FINT, void *
|
||||
void F77_chpr2_base(FCHAR, FINT, const float *, const void *, FINT, const void *, FINT, void *
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
|
||||
@@ -906,79 +890,79 @@ void F77_chpr2_base(FCHAR, FINT, const void *, const void *, FINT, const void *,
|
||||
|
||||
void F77_zgemv_base(FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_zgbmv_base(FCHAR, FINT, FINT, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_zhemv_base(FCHAR, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_zhbmv_base(FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_zhpmv_base(FCHAR, FINT, const void *, const void *, const void *, FINT, const void *, void *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_ztrmv_base(FCHAR, FCHAR, FCHAR, FINT, const void *, FINT, void *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_ztbmv_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, FINT, void *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_ztpmv_base(FCHAR, FCHAR, FCHAR, FINT, const void *, void *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_ztrsv_base(FCHAR, FCHAR, FCHAR, FINT, const void *, FINT, void *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_ztbsv_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, FINT, void *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_ztpsv_base(FCHAR, FCHAR, FCHAR, FINT, const void *, void *,FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_zgerc_base(FINT, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT);
|
||||
void F77_zgeru_base(FINT, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT);
|
||||
void F77_zher_base(FCHAR, FINT, const double *, const void *, FINT, void *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_zher2_base(FCHAR, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_zhpr_base(FCHAR, FINT, const double *, const void *, FINT, void *
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_zhpr2_base(FCHAR, FINT, const void *, const void *, FINT, const void *, FINT, void *
|
||||
void F77_zhpr2_base(FCHAR, FINT, const double *, const void *, FINT, const void *, FINT, void *
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
, size_t
|
||||
#endif
|
||||
);
|
||||
|
||||
@@ -990,38 +974,32 @@ void F77_zhpr2_base(FCHAR, FINT, const void *, const void *, FINT, const void *,
|
||||
|
||||
void F77_sgemm_base(FCHAR, FCHAR, FINT, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_sgemmtr_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
|
||||
void F77_ssymm_base(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_ssyrk_base(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, float *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_ssyr2k_base(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_strmm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, float *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_strsm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, float *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
|
||||
@@ -1029,148 +1007,128 @@ void F77_strsm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const
|
||||
|
||||
void F77_dgemm_base(FCHAR, FCHAR, FINT, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_dgemmtr_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
|
||||
void F77_dsymm_base(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_dsyrk_base(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, double *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_dsyr2k_base(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_dtrmm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, double *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_dtrsm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, double *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
|
||||
/* Single Complex Precision */
|
||||
|
||||
void F77_cgemm_base(FCHAR, FCHAR, FINT, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT
|
||||
void F77_cgemm_base(FCHAR, FCHAR, FINT, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
|
||||
void F77_cgemmtr_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT
|
||||
void F77_csymm_base(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
|
||||
void F77_csymm_base(FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT
|
||||
void F77_chemm_base(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_chemm_base(FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT
|
||||
void F77_csyrk_base(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, float *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_csyrk_base(FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, void *, FINT
|
||||
void F77_cherk_base(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, float *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_cherk_base(FCHAR, FCHAR, FINT, FINT, const float *, const void *, FINT, const float *, void *, FINT
|
||||
void F77_csyr2k_base(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_csyr2k_base(FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT
|
||||
void F77_cher2k_base(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_cher2k_base(FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const float *, void *, FINT
|
||||
void F77_ctrmm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, float *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_ctrmm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, void *, FINT
|
||||
void F77_ctrsm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, float *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
#endif
|
||||
);
|
||||
void F77_ctrsm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, void *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
|
||||
/* Double Complex Precision */
|
||||
|
||||
void F77_zgemm_base(FCHAR, FCHAR, FINT, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT
|
||||
void F77_zgemm_base(FCHAR, FCHAR, FINT, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
|
||||
void F77_zgemmtr_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT
|
||||
void F77_zsymm_base(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
|
||||
void F77_zsymm_base(FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT
|
||||
void F77_zhemm_base(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_zhemm_base(FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT
|
||||
void F77_zsyrk_base(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, double *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_zsyrk_base(FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, void *, FINT
|
||||
void F77_zherk_base(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, double *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_zherk_base(FCHAR, FCHAR, FINT, FINT, const double *, const void *, FINT, const double *, void *, FINT
|
||||
void F77_zsyr2k_base(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_zsyr2k_base(FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT
|
||||
void F77_zher2k_base(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_zher2k_base(FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const double *, void *, FINT
|
||||
void F77_ztrmm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, double *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
void F77_ztrmm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, void *, FINT
|
||||
void F77_ztrsm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, double *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
#endif
|
||||
);
|
||||
void F77_ztrsm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, void *, FINT
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN
|
||||
, size_t, size_t, size_t, size_t
|
||||
#endif
|
||||
);
|
||||
|
||||
|
||||
@@ -7,15 +7,6 @@
|
||||
#include "cblas.h"
|
||||
#include "cblas_mangling.h"
|
||||
|
||||
/* It seems all current Fortran compilers put strlen at end.
|
||||
* Some historical compilers put strlen after the str argument
|
||||
* or make the str argument into a struct. */
|
||||
#define BLAS_FORTRAN_STRLEN_END
|
||||
|
||||
#ifndef FORTRAN_STRLEN
|
||||
#define FORTRAN_STRLEN size_t
|
||||
#endif
|
||||
|
||||
#define TRUE 1
|
||||
#define PASSED 1
|
||||
#define TEST_ROW_MJR 1
|
||||
@@ -167,28 +158,24 @@ typedef struct { double real; double imag; } CBLAS_TEST_ZOMPLEX;
|
||||
#define F77_zherk F77_GLOBAL(czherk,CZHERK)
|
||||
#define F77_zher2k F77_GLOBAL(czher2k,CZHER2K)
|
||||
#define F77_sgemm F77_GLOBAL(csgemm,CSGEMM)
|
||||
#define F77_sgemmtr F77_GLOBAL(csgemmtr,CSGEMMTR)
|
||||
#define F77_ssymm F77_GLOBAL(cssymm,CSSYMM)
|
||||
#define F77_ssyrk F77_GLOBAL(cssyrk,CSSYRK)
|
||||
#define F77_ssyr2k F77_GLOBAL(cssyr2k,CSSYR2K)
|
||||
#define F77_strmm F77_GLOBAL(cstrmm,CSTRMM)
|
||||
#define F77_strsm F77_GLOBAL(cstrsm,CSTRSM)
|
||||
#define F77_dgemm F77_GLOBAL(cdgemm,CDGEMM)
|
||||
#define F77_dgemmtr F77_GLOBAL(cdgemmtr,CDGEMMTR)
|
||||
#define F77_dsymm F77_GLOBAL(cdsymm,CDSYMM)
|
||||
#define F77_dsyrk F77_GLOBAL(cdsyrk,CDSYRK)
|
||||
#define F77_dsyr2k F77_GLOBAL(cdsyr2k,CDSYR2K)
|
||||
#define F77_dtrmm F77_GLOBAL(cdtrmm,CDTRMM)
|
||||
#define F77_dtrsm F77_GLOBAL(cdtrsm,CDTRSM)
|
||||
#define F77_cgemm F77_GLOBAL(ccgemm,CCGEMM)
|
||||
#define F77_cgemmtr F77_GLOBAL(ccgemmtr,CCGEMMTR)
|
||||
#define F77_csymm F77_GLOBAL(ccsymm,CCSYMM)
|
||||
#define F77_csyrk F77_GLOBAL(ccsyrk,CCSYRK)
|
||||
#define F77_csyr2k F77_GLOBAL(ccsyr2k,CCSYR2K)
|
||||
#define F77_ctrmm F77_GLOBAL(cctrmm,CCTRMM)
|
||||
#define F77_ctrsm F77_GLOBAL(cctrsm,CCTRSM)
|
||||
#define F77_zgemm F77_GLOBAL(czgemm,CZGEMM)
|
||||
#define F77_zgemmtr F77_GLOBAL(czgemmtr,CZGEMMTR)
|
||||
#define F77_zsymm F77_GLOBAL(czsymm,CZSYMM)
|
||||
#define F77_zsyrk F77_GLOBAL(czsyrk,CZSYRK)
|
||||
#define F77_zsyr2k F77_GLOBAL(czsyr2k,CZSYR2K)
|
||||
|
||||
@@ -85,21 +85,21 @@ set(ZLEV2 cblas_zgemv.c cblas_zgbmv.c cblas_zhemv.c cblas_zhbmv.c cblas_zhpmv.c
|
||||
|
||||
# Files for level 3 single precision real
|
||||
set(SLEV3 cblas_sgemm.c cblas_ssymm.c cblas_ssyrk.c cblas_ssyr2k.c cblas_strmm.c
|
||||
cblas_strsm.c cblas_sgemmtr.c)
|
||||
cblas_strsm.c)
|
||||
|
||||
# Files for level 3 double precision real
|
||||
set(DLEV3 cblas_dgemm.c cblas_dsymm.c cblas_dsyrk.c cblas_dsyr2k.c cblas_dtrmm.c
|
||||
cblas_dtrsm.c cblas_dgemmtr.c)
|
||||
cblas_dtrsm.c)
|
||||
|
||||
# Files for level 3 single precision complex
|
||||
set(CLEV3 cblas_cgemm.c cblas_csymm.c cblas_chemm.c cblas_cherk.c
|
||||
cblas_cher2k.c cblas_ctrmm.c cblas_ctrsm.c cblas_csyrk.c
|
||||
cblas_csyr2k.c cblas_cgemmtr.c)
|
||||
cblas_csyr2k.c)
|
||||
|
||||
# Files for level 3 double precision complex
|
||||
set(ZLEV3 cblas_zgemm.c cblas_zsymm.c cblas_zhemm.c cblas_zherk.c
|
||||
cblas_zher2k.c cblas_ztrmm.c cblas_ztrsm.c cblas_zsyrk.c
|
||||
cblas_zsyr2k.c cblas_zgemmtr.c)
|
||||
cblas_zsyr2k.c)
|
||||
|
||||
|
||||
set(SOURCES)
|
||||
|
||||
+4
-4
@@ -137,21 +137,21 @@ zlib2: $(zlev2) $(errhand)
|
||||
|
||||
# Files for level 3 single precision real
|
||||
slev3 = cblas_sgemm.o cblas_ssymm.o cblas_ssyrk.o cblas_ssyr2k.o cblas_strmm.o \
|
||||
cblas_strsm.o cblas_sgemmtr.o
|
||||
cblas_strsm.o
|
||||
|
||||
# Files for level 3 double precision real
|
||||
dlev3 = cblas_dgemm.o cblas_dsymm.o cblas_dsyrk.o cblas_dsyr2k.o cblas_dtrmm.o \
|
||||
cblas_dtrsm.o cblas_dgemmtr.o
|
||||
cblas_dtrsm.o
|
||||
|
||||
# Files for level 3 single precision complex
|
||||
clev3 = cblas_cgemm.o cblas_csymm.o cblas_chemm.o cblas_cherk.o \
|
||||
cblas_cher2k.o cblas_ctrmm.o cblas_ctrsm.o cblas_csyrk.o \
|
||||
cblas_csyr2k.o cblas_cgemmtr.o
|
||||
cblas_csyr2k.o
|
||||
|
||||
# Files for level 3 double precision complex
|
||||
zlev3 = cblas_zgemm.o cblas_zsymm.o cblas_zhemm.o cblas_zherk.o \
|
||||
cblas_zher2k.o cblas_ztrmm.o cblas_ztrsm.o cblas_zsyrk.o \
|
||||
cblas_zsyr2k.o cblas_zgemmtr.o
|
||||
cblas_zsyr2k.o
|
||||
|
||||
.PHONY: slib3 dlib3 clib3 zlib3
|
||||
# Single precision real
|
||||
|
||||
@@ -1,134 +0,0 @@
|
||||
/*
|
||||
*
|
||||
* cblas_cgemmtr.c
|
||||
* This program is a C interface to cgemmtr.
|
||||
* Written by Martin Koehler, MPI Magdeburg
|
||||
* 06/24/2024
|
||||
*
|
||||
*/
|
||||
|
||||
#include "cblas.h"
|
||||
#include "cblas_f77.h"
|
||||
void API_SUFFIX(cblas_cgemmtr)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA,
|
||||
const CBLAS_TRANSPOSE TransB, const CBLAS_INT N,
|
||||
const CBLAS_INT K, const void *alpha, const void *A,
|
||||
const CBLAS_INT lda, const void *B, const CBLAS_INT ldb,
|
||||
const void *beta, void *C, const CBLAS_INT ldc)
|
||||
{
|
||||
char TA, TB;
|
||||
char UL;
|
||||
#ifdef F77_CHAR
|
||||
F77_CHAR F77_TA, F77_TB, F77_UL;
|
||||
#else
|
||||
#define F77_TA &TA
|
||||
#define F77_TB &TB
|
||||
#define F77_UL &UL
|
||||
#endif
|
||||
|
||||
#ifdef F77_INT
|
||||
F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
|
||||
F77_INT F77_ldc=ldc;
|
||||
#else
|
||||
#define F77_N N
|
||||
#define F77_K K
|
||||
#define F77_lda lda
|
||||
#define F77_ldb ldb
|
||||
#define F77_ldc ldc
|
||||
#endif
|
||||
|
||||
extern int CBLAS_CallFromC;
|
||||
extern int RowMajorStrg;
|
||||
RowMajorStrg = 0;
|
||||
CBLAS_CallFromC = 1;
|
||||
|
||||
|
||||
if( layout == CblasColMajor )
|
||||
{
|
||||
if ( Uplo == CblasUpper ) UL = 'U';
|
||||
else if (Uplo == CblasLower) UL= 'L';
|
||||
else {
|
||||
API_SUFFIX(cblas_xerbla)(2, "cblas_cgemmtr", "Illegal Uplo setting, %d\n", Uplo);
|
||||
CBLAS_CallFromC = 0;
|
||||
RowMajorStrg = 0;
|
||||
return;
|
||||
}
|
||||
|
||||
if(TransA == CblasTrans) TA='T';
|
||||
else if ( TransA == CblasConjTrans ) TA='C';
|
||||
else if ( TransA == CblasNoTrans ) TA='N';
|
||||
else
|
||||
{
|
||||
API_SUFFIX(cblas_xerbla)(3, "cblas_cgemmtr", "Illegal TransA setting, %d\n", TransA);
|
||||
CBLAS_CallFromC = 0;
|
||||
RowMajorStrg = 0;
|
||||
return;
|
||||
}
|
||||
|
||||
if(TransB == CblasTrans) TB='T';
|
||||
else if ( TransB == CblasConjTrans ) TB='C';
|
||||
else if ( TransB == CblasNoTrans ) TB='N';
|
||||
else
|
||||
{
|
||||
API_SUFFIX(cblas_xerbla)(4, "cblas_cgemmtr", "Illegal TransB setting, %d\n", TransB);
|
||||
CBLAS_CallFromC = 0;
|
||||
RowMajorStrg = 0;
|
||||
return;
|
||||
}
|
||||
|
||||
#ifdef F77_CHAR
|
||||
F77_TA = C2F_CHAR(&TA);
|
||||
F77_TB = C2F_CHAR(&TB);
|
||||
F77_UL = C2F_CHAR(&UL);
|
||||
#endif
|
||||
|
||||
F77_cgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, alpha, A,
|
||||
&F77_lda, B, &F77_ldb, beta, C, &F77_ldc);
|
||||
}
|
||||
else if (layout == CblasRowMajor)
|
||||
{
|
||||
RowMajorStrg = 1;
|
||||
|
||||
if ( Uplo == CblasUpper ) UL = 'L';
|
||||
else if (Uplo == CblasLower) UL= 'U';
|
||||
else {
|
||||
API_SUFFIX(cblas_xerbla)(2, "cblas_cgemmtr", "Illegal Uplo setting, %d\n", Uplo);
|
||||
CBLAS_CallFromC = 0;
|
||||
RowMajorStrg = 0;
|
||||
return;
|
||||
}
|
||||
|
||||
if(TransA == CblasTrans) TB='T';
|
||||
else if ( TransA == CblasConjTrans ) TB='C';
|
||||
else if ( TransA == CblasNoTrans ) TB='N';
|
||||
else
|
||||
{
|
||||
API_SUFFIX(cblas_xerbla)(3, "cblas_cgemmtr", "Illegal TransA setting, %d\n", TransA);
|
||||
CBLAS_CallFromC = 0;
|
||||
RowMajorStrg = 0;
|
||||
return;
|
||||
}
|
||||
if(TransB == CblasTrans) TA='T';
|
||||
else if ( TransB == CblasConjTrans ) TA='C';
|
||||
else if ( TransB == CblasNoTrans ) TA='N';
|
||||
else
|
||||
{
|
||||
API_SUFFIX(cblas_xerbla)(4, "cblas_cgemmtr", "Illegal TransB setting, %d\n", TransB);
|
||||
CBLAS_CallFromC = 0;
|
||||
RowMajorStrg = 0;
|
||||
return;
|
||||
}
|
||||
#ifdef F77_CHAR
|
||||
F77_TA = C2F_CHAR(&TA);
|
||||
F77_TB = C2F_CHAR(&TB);
|
||||
F77_UL = C2F_CHAR(&UL);
|
||||
|
||||
#endif
|
||||
|
||||
F77_cgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, alpha, B,
|
||||
&F77_ldb, A, &F77_lda, beta, C, &F77_ldc);
|
||||
}
|
||||
else API_SUFFIX(cblas_xerbla)(1, "cblas_cgemmtr", "Illegal layout setting, %d\n", layout);
|
||||
CBLAS_CallFromC = 0;
|
||||
RowMajorStrg = 0;
|
||||
return;
|
||||
}
|
||||
@@ -89,7 +89,7 @@ void API_SUFFIX(cblas_dgemm)(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE Tr
|
||||
else if ( TransB == CblasNoTrans ) TA='N';
|
||||
else
|
||||
{
|
||||
API_SUFFIX(cblas_xerbla)(3, "cblas_dgemm","Illegal TransB setting, %d\n", TransB);
|
||||
API_SUFFIX(cblas_xerbla)(2, "cblas_dgemm","Illegal TransB setting, %d\n", TransB);
|
||||
CBLAS_CallFromC = 0;
|
||||
RowMajorStrg = 0;
|
||||
return;
|
||||
|
||||
@@ -1,134 +0,0 @@
|
||||
/*
|
||||
*
|
||||
* cblas_dgemmtr.c
|
||||
* This program is a C interface to dgemmtr.
|
||||
* Written by Martin Koehler, MPI Magdeburg
|
||||
* 06/24/2024
|
||||
*
|
||||
*/
|
||||
|
||||
#include "cblas.h"
|
||||
#include "cblas_f77.h"
|
||||
void API_SUFFIX(cblas_dgemmtr)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA,
|
||||
const CBLAS_TRANSPOSE TransB, const CBLAS_INT N,
|
||||
const CBLAS_INT K, const double alpha, const double *A,
|
||||
const CBLAS_INT lda, const double *B, const CBLAS_INT ldb,
|
||||
const double beta, double *C, const CBLAS_INT ldc)
|
||||
{
|
||||
char TA, TB, UL;
|
||||
#ifdef F77_CHAR
|
||||
F77_CHAR F77_TA, F77_TB. F77_UL;
|
||||
#else
|
||||
#define F77_TA &TA
|
||||
#define F77_TB &TB
|
||||
#define F77_UL &UL
|
||||
#endif
|
||||
|
||||
#ifdef F77_INT
|
||||
F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
|
||||
F77_INT F77_ldc=ldc;
|
||||
#else
|
||||
#define F77_N N
|
||||
#define F77_K K
|
||||
#define F77_lda lda
|
||||
#define F77_ldb ldb
|
||||
#define F77_ldc ldc
|
||||
#endif
|
||||
|
||||
extern int CBLAS_CallFromC;
|
||||
extern int RowMajorStrg;
|
||||
RowMajorStrg = 0;
|
||||
CBLAS_CallFromC = 1;
|
||||
|
||||
|
||||
if( layout == CblasColMajor )
|
||||
{
|
||||
if ( Uplo == CblasUpper ) UL = 'U';
|
||||
else if (Uplo == CblasLower) UL= 'L';
|
||||
else {
|
||||
API_SUFFIX(cblas_xerbla)(2, "cblas_dgemmtr", "Illegal Uplo setting, %d\n", Uplo);
|
||||
CBLAS_CallFromC = 0;
|
||||
RowMajorStrg = 0;
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
|
||||
if(TransA == CblasTrans) TA='T';
|
||||
else if ( TransA == CblasConjTrans ) TA='C';
|
||||
else if ( TransA == CblasNoTrans ) TA='N';
|
||||
else
|
||||
{
|
||||
API_SUFFIX(cblas_xerbla)(3, "cblas_dgemmtr","Illegal TransA setting, %d\n", TransA);
|
||||
CBLAS_CallFromC = 0;
|
||||
RowMajorStrg = 0;
|
||||
return;
|
||||
}
|
||||
|
||||
if(TransB == CblasTrans) TB='T';
|
||||
else if ( TransB == CblasConjTrans ) TB='C';
|
||||
else if ( TransB == CblasNoTrans ) TB='N';
|
||||
else
|
||||
{
|
||||
API_SUFFIX(cblas_xerbla)(4, "cblas_dgemmtr","Illegal TransB setting, %d\n", TransB);
|
||||
CBLAS_CallFromC = 0;
|
||||
RowMajorStrg = 0;
|
||||
return;
|
||||
}
|
||||
|
||||
#ifdef F77_CHAR
|
||||
F77_TA = C2F_CHAR(&TA);
|
||||
F77_TB = C2F_CHAR(&TB);
|
||||
F77_UL = C2F_CHAR(&UL);
|
||||
#endif
|
||||
|
||||
F77_dgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, &alpha, A,
|
||||
&F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
|
||||
}
|
||||
else if (layout == CblasRowMajor)
|
||||
{
|
||||
if ( Uplo == CblasUpper ) UL = 'L';
|
||||
else if (Uplo == CblasLower) UL= 'U';
|
||||
else {
|
||||
API_SUFFIX(cblas_xerbla)(2, "cblas_dgemmtr", "Illegal Uplo setting, %d\n", Uplo);
|
||||
CBLAS_CallFromC = 0;
|
||||
RowMajorStrg = 0;
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
RowMajorStrg = 1;
|
||||
if(TransA == CblasTrans) TB='T';
|
||||
else if ( TransA == CblasConjTrans ) TB='C';
|
||||
else if ( TransA == CblasNoTrans ) TB='N';
|
||||
else
|
||||
{
|
||||
API_SUFFIX(cblas_xerbla)(3, "cblas_dgemmtr","Illegal TransA setting, %d\n", TransA);
|
||||
CBLAS_CallFromC = 0;
|
||||
RowMajorStrg = 0;
|
||||
return;
|
||||
}
|
||||
if(TransB == CblasTrans) TA='T';
|
||||
else if ( TransB == CblasConjTrans ) TA='C';
|
||||
else if ( TransB == CblasNoTrans ) TA='N';
|
||||
else
|
||||
{
|
||||
API_SUFFIX(cblas_xerbla)(4, "cblas_dgemmtr","Illegal TransB setting, %d\n", TransB);
|
||||
CBLAS_CallFromC = 0;
|
||||
RowMajorStrg = 0;
|
||||
return;
|
||||
}
|
||||
#ifdef F77_CHAR
|
||||
F77_TA = C2F_CHAR(&TA);
|
||||
F77_TB = C2F_CHAR(&TB);
|
||||
F77_UL = C2F_CHAR(&UL);
|
||||
#endif
|
||||
|
||||
F77_dgemmtr( F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, &alpha, B,
|
||||
&F77_ldb, A, &F77_lda, &beta, C, &F77_ldc);
|
||||
}
|
||||
else API_SUFFIX(cblas_xerbla)(1, "cblas_dgemmtr", "Illegal layout setting, %d\n", layout);
|
||||
CBLAS_CallFromC = 0;
|
||||
RowMajorStrg = 0;
|
||||
return;
|
||||
}
|
||||
@@ -90,7 +90,7 @@ void API_SUFFIX(cblas_sgemm)(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE Tr
|
||||
else if ( TransB == CblasNoTrans ) TA='N';
|
||||
else
|
||||
{
|
||||
API_SUFFIX(cblas_xerbla)(3, "cblas_sgemm",
|
||||
API_SUFFIX(cblas_xerbla)(2, "cblas_sgemm",
|
||||
"Illegal TransB setting, %d\n", TransB);
|
||||
CBLAS_CallFromC = 0;
|
||||
RowMajorStrg = 0;
|
||||
|
||||
@@ -1,136 +0,0 @@
|
||||
|
||||
/*
|
||||
*
|
||||
* cblas_sgemmtr.c
|
||||
* This program is a C interface to sgemmtr.
|
||||
* Written by Martin Koehler, MPI Magdeburg
|
||||
* 06/24/2024
|
||||
*
|
||||
*/
|
||||
|
||||
#include "cblas.h"
|
||||
#include "cblas_f77.h"
|
||||
void API_SUFFIX(cblas_sgemmtr)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA,
|
||||
const CBLAS_TRANSPOSE TransB, const CBLAS_INT N,
|
||||
const CBLAS_INT K, const float alpha, const float *A,
|
||||
const CBLAS_INT lda, const float *B, const CBLAS_INT ldb,
|
||||
const float beta, float *C, const CBLAS_INT ldc)
|
||||
{
|
||||
char TA, TB, UL;
|
||||
#ifdef F77_CHAR
|
||||
F77_CHAR F77_TA, F77_TB, F77_UL;
|
||||
#else
|
||||
#define F77_TA &TA
|
||||
#define F77_TB &TB
|
||||
#define F77_UL &UL
|
||||
#endif
|
||||
|
||||
#ifdef F77_INT
|
||||
F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
|
||||
F77_INT F77_ldc=ldc;
|
||||
#else
|
||||
#define F77_N N
|
||||
#define F77_K K
|
||||
#define F77_lda lda
|
||||
#define F77_ldb ldb
|
||||
#define F77_ldc ldc
|
||||
#endif
|
||||
|
||||
extern int CBLAS_CallFromC;
|
||||
extern int RowMajorStrg;
|
||||
RowMajorStrg = 0;
|
||||
CBLAS_CallFromC = 1;
|
||||
|
||||
|
||||
if( layout == CblasColMajor )
|
||||
{
|
||||
if ( Uplo == CblasUpper ) UL = 'U';
|
||||
else if (Uplo == CblasLower) UL= 'L';
|
||||
else {
|
||||
API_SUFFIX(cblas_xerbla)(2, "cblas_sgemmtr", "Illegal Uplo setting, %d\n", Uplo);
|
||||
CBLAS_CallFromC = 0;
|
||||
RowMajorStrg = 0;
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
if(TransA == CblasTrans) TA='T';
|
||||
else if ( TransA == CblasConjTrans ) TA='C';
|
||||
else if ( TransA == CblasNoTrans ) TA='N';
|
||||
else
|
||||
{
|
||||
API_SUFFIX(cblas_xerbla)(3, "cblas_sgemmtr",
|
||||
"Illegal TransA setting, %d\n", TransA);
|
||||
CBLAS_CallFromC = 0;
|
||||
RowMajorStrg = 0;
|
||||
return;
|
||||
}
|
||||
|
||||
if(TransB == CblasTrans) TB='T';
|
||||
else if ( TransB == CblasConjTrans ) TB='C';
|
||||
else if ( TransB == CblasNoTrans ) TB='N';
|
||||
else
|
||||
{
|
||||
API_SUFFIX(cblas_xerbla)(4, "cblas_sgemmtr",
|
||||
"Illegal TransB setting, %d\n", TransB);
|
||||
CBLAS_CallFromC = 0;
|
||||
RowMajorStrg = 0;
|
||||
return;
|
||||
}
|
||||
|
||||
#ifdef F77_CHAR
|
||||
F77_TA = C2F_CHAR(&TA);
|
||||
F77_TB = C2F_CHAR(&TB);
|
||||
F77_UL = C2F_CHAR(&UL);
|
||||
#endif
|
||||
|
||||
F77_sgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, &alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
|
||||
}
|
||||
else if (layout == CblasRowMajor)
|
||||
{
|
||||
if ( Uplo == CblasUpper ) UL = 'L';
|
||||
else if (Uplo == CblasLower) UL= 'U';
|
||||
else {
|
||||
API_SUFFIX(cblas_xerbla)(2, "cblas_sgemmtr", "Illegal Uplo setting, %d\n", Uplo);
|
||||
CBLAS_CallFromC = 0;
|
||||
RowMajorStrg = 0;
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
RowMajorStrg = 1;
|
||||
if(TransA == CblasTrans) TB='T';
|
||||
else if ( TransA == CblasConjTrans ) TB='C';
|
||||
else if ( TransA == CblasNoTrans ) TB='N';
|
||||
else
|
||||
{
|
||||
API_SUFFIX(cblas_xerbla)(3, "cblas_sgemmtr",
|
||||
"Illegal TransA setting, %d\n", TransA);
|
||||
CBLAS_CallFromC = 0;
|
||||
RowMajorStrg = 0;
|
||||
return;
|
||||
}
|
||||
if(TransB == CblasTrans) TA='T';
|
||||
else if ( TransB == CblasConjTrans ) TA='C';
|
||||
else if ( TransB == CblasNoTrans ) TA='N';
|
||||
else
|
||||
{
|
||||
API_SUFFIX(cblas_xerbla)(4, "cblas_sgemmtr",
|
||||
"Illegal TransB setting, %d\n", TransB);
|
||||
CBLAS_CallFromC = 0;
|
||||
RowMajorStrg = 0;
|
||||
return;
|
||||
}
|
||||
#ifdef F77_CHAR
|
||||
F77_TA = C2F_CHAR(&TA);
|
||||
F77_TB = C2F_CHAR(&TB);
|
||||
F77_UL = C2F_CHAR(&UL);
|
||||
#endif
|
||||
|
||||
F77_sgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, &alpha, B, &F77_ldb, A, &F77_lda, &beta, C, &F77_ldc);
|
||||
} else
|
||||
API_SUFFIX(cblas_xerbla)(1, "cblas_sgemmtr",
|
||||
"Illegal layout setting, %d\n", layout);
|
||||
CBLAS_CallFromC = 0;
|
||||
RowMajorStrg = 0;
|
||||
}
|
||||
@@ -89,7 +89,7 @@ void API_SUFFIX(cblas_zgemm)(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE Tr
|
||||
else if ( TransB == CblasNoTrans ) TA='N';
|
||||
else
|
||||
{
|
||||
API_SUFFIX(cblas_xerbla)(3, "cblas_zgemm","Illegal TransB setting, %d\n", TransB);
|
||||
API_SUFFIX(cblas_xerbla)(2, "cblas_zgemm","Illegal TransB setting, %d\n", TransB);
|
||||
CBLAS_CallFromC = 0;
|
||||
RowMajorStrg = 0;
|
||||
return;
|
||||
|
||||
@@ -1,135 +0,0 @@
|
||||
/*
|
||||
*
|
||||
* cblas_zgemmtr.c
|
||||
* This program is a C interface to zgemmtr.
|
||||
* Written by Martin Koehler, MPI Magdeburg
|
||||
* 06/24/2024
|
||||
*
|
||||
*/
|
||||
|
||||
#include "cblas.h"
|
||||
#include "cblas_f77.h"
|
||||
void API_SUFFIX(cblas_zgemmtr)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA,
|
||||
const CBLAS_TRANSPOSE TransB, const CBLAS_INT N,
|
||||
const CBLAS_INT K, const void *alpha, const void *A,
|
||||
const CBLAS_INT lda, const void *B, const CBLAS_INT ldb,
|
||||
const void *beta, void *C, const CBLAS_INT ldc)
|
||||
{
|
||||
char TA, TB, UL;
|
||||
#ifdef F77_CHAR
|
||||
F77_CHAR F77_TA, F77_TB, F77_UL;
|
||||
#else
|
||||
#define F77_TA &TA
|
||||
#define F77_TB &TB
|
||||
#define F77_UL &UL
|
||||
#endif
|
||||
|
||||
#ifdef F77_INT
|
||||
F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
|
||||
F77_INT F77_ldc=ldc;
|
||||
#else
|
||||
#define F77_N N
|
||||
#define F77_K K
|
||||
#define F77_lda lda
|
||||
#define F77_ldb ldb
|
||||
#define F77_ldc ldc
|
||||
#endif
|
||||
|
||||
extern int CBLAS_CallFromC;
|
||||
extern int RowMajorStrg;
|
||||
RowMajorStrg = 0;
|
||||
CBLAS_CallFromC = 1;
|
||||
|
||||
|
||||
if( layout == CblasColMajor )
|
||||
{
|
||||
if ( Uplo == CblasUpper ) UL = 'U';
|
||||
else if (Uplo == CblasLower) UL= 'L';
|
||||
else {
|
||||
API_SUFFIX(cblas_xerbla)(2, "cblas_zgemmtr", "Illegal Uplo setting, %d\n", Uplo);
|
||||
CBLAS_CallFromC = 0;
|
||||
RowMajorStrg = 0;
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
if(TransA == CblasTrans) TA='T';
|
||||
else if ( TransA == CblasConjTrans ) TA='C';
|
||||
else if ( TransA == CblasNoTrans ) TA='N';
|
||||
else
|
||||
{
|
||||
API_SUFFIX(cblas_xerbla)(3, "cblas_zgemmtr","Illegal TransA setting, %d\n", TransA);
|
||||
CBLAS_CallFromC = 0;
|
||||
RowMajorStrg = 0;
|
||||
return;
|
||||
}
|
||||
|
||||
if(TransB == CblasTrans) TB='T';
|
||||
else if ( TransB == CblasConjTrans ) TB='C';
|
||||
else if ( TransB == CblasNoTrans ) TB='N';
|
||||
else
|
||||
{
|
||||
API_SUFFIX(cblas_xerbla)(4, "cblas_zgemmtr","Illegal TransB setting, %d\n", TransB);
|
||||
CBLAS_CallFromC = 0;
|
||||
RowMajorStrg = 0;
|
||||
return;
|
||||
}
|
||||
|
||||
#ifdef F77_CHAR
|
||||
F77_TA = C2F_CHAR(&TA);
|
||||
F77_TB = C2F_CHAR(&TB);
|
||||
F77_UL = C2F_CHAR(&UL);
|
||||
#endif
|
||||
|
||||
F77_zgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, alpha, A,
|
||||
&F77_lda, B, &F77_ldb, beta, C, &F77_ldc);
|
||||
}
|
||||
else if (layout == CblasRowMajor)
|
||||
{
|
||||
RowMajorStrg = 1;
|
||||
|
||||
if ( Uplo == CblasUpper ) UL = 'L';
|
||||
else if (Uplo == CblasLower) UL= 'U';
|
||||
else {
|
||||
API_SUFFIX(cblas_xerbla)(2, "cblas_cgemmtr", "Illegal Uplo setting, %d\n", Uplo);
|
||||
CBLAS_CallFromC = 0;
|
||||
RowMajorStrg = 0;
|
||||
return;
|
||||
}
|
||||
|
||||
if(TransA == CblasTrans) TB='T';
|
||||
else if ( TransA == CblasConjTrans ) TB='C';
|
||||
else if ( TransA == CblasNoTrans ) TB='N';
|
||||
else
|
||||
{
|
||||
API_SUFFIX(cblas_xerbla)(3, "zblas_cgemmtr", "Illegal TransA setting, %d\n", TransA);
|
||||
CBLAS_CallFromC = 0;
|
||||
RowMajorStrg = 0;
|
||||
return;
|
||||
}
|
||||
if(TransB == CblasTrans) TA='T';
|
||||
else if ( TransB == CblasConjTrans ) TA='C';
|
||||
else if ( TransB == CblasNoTrans ) TA='N';
|
||||
else
|
||||
{
|
||||
API_SUFFIX(cblas_xerbla)(4, "zblas_cgemmtr", "Illegal TransB setting, %d\n", TransB);
|
||||
CBLAS_CallFromC = 0;
|
||||
RowMajorStrg = 0;
|
||||
return;
|
||||
}
|
||||
#ifdef F77_CHAR
|
||||
F77_TA = C2F_CHAR(&TA);
|
||||
F77_TB = C2F_CHAR(&TB);
|
||||
F77_UL = C2F_CHAR(&UL);
|
||||
|
||||
#endif
|
||||
|
||||
F77_zgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, alpha, B,
|
||||
&F77_ldb, A, &F77_lda, beta, C, &F77_ldc);
|
||||
}
|
||||
|
||||
else API_SUFFIX(cblas_xerbla)(1, "cblas_zgemmtr", "Illegal layout setting, %d\n", layout);
|
||||
CBLAS_CallFromC = 0;
|
||||
RowMajorStrg = 0;
|
||||
return;
|
||||
}
|
||||
+1
-1
@@ -17,7 +17,7 @@ F77_xerbla_base
|
||||
(char *srname, void *vinfo
|
||||
#endif
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN len
|
||||
, size_t len
|
||||
#endif
|
||||
)
|
||||
{
|
||||
|
||||
@@ -8,14 +8,10 @@ CBLAS_INT link_xerbla=TRUE;
|
||||
char *cblas_rout;
|
||||
|
||||
#ifdef F77_Char
|
||||
void F77_xerbla(F77_Char F77_srname, void *vinfo
|
||||
void F77_xerbla(F77_Char F77_srname, void *vinfo);
|
||||
#else
|
||||
void F77_xerbla(char *srname, void *vinfo
|
||||
void F77_xerbla(char *srname, void *vinfo);
|
||||
#endif
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN srname_len
|
||||
#endif
|
||||
);
|
||||
|
||||
void chkxer(void) {
|
||||
extern CBLAS_INT cblas_ok, cblas_lerr, cblas_info;
|
||||
@@ -28,11 +24,7 @@ void chkxer(void) {
|
||||
cblas_lerr = 1 ;
|
||||
}
|
||||
|
||||
void F77_c2chke(char *rout
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN rout_len
|
||||
#endif
|
||||
) {
|
||||
void F77_c2chke(char *rout) {
|
||||
char *sf = ( rout ) ;
|
||||
float A[2] = {0.0,0.0},
|
||||
X[2] = {0.0,0.0},
|
||||
@@ -48,7 +40,7 @@ void F77_c2chke(char *rout
|
||||
if (link_xerbla) /* call these first to link */
|
||||
{
|
||||
cblas_xerbla(cblas_info,cblas_rout,"");
|
||||
F77_xerbla(cblas_rout,&cblas_info, 1);
|
||||
F77_xerbla(cblas_rout,&cblas_info);
|
||||
}
|
||||
#endif
|
||||
|
||||
|
||||
+7
-244
@@ -8,14 +8,10 @@ CBLAS_INT link_xerbla=TRUE;
|
||||
char *cblas_rout;
|
||||
|
||||
#ifdef F77_Char
|
||||
void F77_xerbla(F77_Char F77_srname, void *vinfo
|
||||
void F77_xerbla(F77_Char F77_srname, void *vinfo);
|
||||
#else
|
||||
void F77_xerbla(char *srname, void *vinfo
|
||||
void F77_xerbla(char *srname, void *vinfo);
|
||||
#endif
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN srname_len
|
||||
#endif
|
||||
);
|
||||
|
||||
void chkxer(void) {
|
||||
extern CBLAS_INT cblas_ok, cblas_lerr, cblas_info;
|
||||
@@ -28,11 +24,7 @@ void chkxer(void) {
|
||||
cblas_lerr = 1 ;
|
||||
}
|
||||
|
||||
void F77_c3chke(char * rout
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN rout_len
|
||||
#endif
|
||||
) {
|
||||
void F77_c3chke(char * rout) {
|
||||
char *sf = ( rout ) ;
|
||||
float A[4] = {0.0,0.0,0.0,0.0},
|
||||
B[4] = {0.0,0.0,0.0,0.0},
|
||||
@@ -51,241 +43,11 @@ void F77_c3chke(char * rout
|
||||
if (link_xerbla) /* call these first to link */
|
||||
{
|
||||
cblas_xerbla(cblas_info,cblas_rout,"");
|
||||
F77_xerbla(cblas_rout,&cblas_info, 1);
|
||||
F77_xerbla(cblas_rout,&cblas_info);
|
||||
}
|
||||
#endif
|
||||
|
||||
if (strncmp( sf,"cblas_cgemmtr" ,13)==0) {
|
||||
cblas_rout = "cblas_cgemmtr" ;
|
||||
|
||||
cblas_info = 1;
|
||||
cblas_cgemmtr( INVALID, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 1;
|
||||
cblas_cgemmtr( INVALID, CblasUpper, CblasNoTrans, CblasTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 1;
|
||||
cblas_cgemmtr( INVALID, CblasUpper,CblasTrans, CblasNoTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 1;
|
||||
cblas_cgemmtr( INVALID, CblasUpper, CblasTrans, CblasTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 1;
|
||||
cblas_cgemmtr( INVALID, CblasLower, CblasNoTrans, CblasNoTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 1;
|
||||
cblas_cgemmtr( INVALID, CblasLower, CblasNoTrans, CblasTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 1;
|
||||
cblas_cgemmtr( INVALID, CblasLower,CblasTrans, CblasNoTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 1;
|
||||
cblas_cgemmtr( INVALID, CblasLower, CblasTrans, CblasTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 2; RowMajorStrg = FALSE;
|
||||
cblas_cgemmtr( CblasColMajor, INVALID, CblasNoTrans, CblasNoTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 2; RowMajorStrg = FALSE;
|
||||
cblas_cgemmtr( CblasColMajor, INVALID, CblasNoTrans, CblasTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 3; RowMajorStrg = FALSE;
|
||||
cblas_cgemmtr( CblasColMajor, CblasUpper, INVALID, CblasNoTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 3; RowMajorStrg = FALSE;
|
||||
cblas_cgemmtr( CblasColMajor, CblasUpper, INVALID, CblasTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 4; RowMajorStrg = FALSE;
|
||||
cblas_cgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, INVALID, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 4; RowMajorStrg = FALSE;
|
||||
cblas_cgemmtr( CblasColMajor, CblasUpper, CblasTrans, INVALID, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
|
||||
cblas_info = 5; RowMajorStrg = FALSE;
|
||||
cblas_cgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, INVALID, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 5; RowMajorStrg = FALSE;
|
||||
cblas_cgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, INVALID, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 5; RowMajorStrg = FALSE;
|
||||
cblas_cgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, INVALID, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 5; RowMajorStrg = FALSE;
|
||||
cblas_cgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, INVALID, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 6; RowMajorStrg = FALSE;
|
||||
cblas_cgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, INVALID,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 6; RowMajorStrg = FALSE;
|
||||
cblas_cgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, INVALID,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 6; RowMajorStrg = FALSE;
|
||||
cblas_cgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, INVALID,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 6; RowMajorStrg = FALSE;
|
||||
cblas_cgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 0, INVALID,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
|
||||
cblas_info = 9; RowMajorStrg = FALSE;
|
||||
cblas_cgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 2 );
|
||||
chkxer();
|
||||
cblas_info = 9; RowMajorStrg = FALSE;
|
||||
cblas_cgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 2 );
|
||||
chkxer();
|
||||
cblas_info = 9; RowMajorStrg = FALSE;
|
||||
cblas_cgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2,
|
||||
ALPHA, A, 1, B, 2, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 9; RowMajorStrg = FALSE;
|
||||
cblas_cgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 0, 2,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 11; RowMajorStrg = FALSE;
|
||||
cblas_cgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 11; RowMajorStrg = FALSE;
|
||||
cblas_cgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2,
|
||||
ALPHA, A, 2, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 11; RowMajorStrg = FALSE;
|
||||
cblas_cgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 14; RowMajorStrg = FALSE;
|
||||
cblas_cgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0,
|
||||
ALPHA, A, 2, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 14; RowMajorStrg = FALSE;
|
||||
cblas_cgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0,
|
||||
ALPHA, A, 2, B, 2, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 14; RowMajorStrg = FALSE;
|
||||
cblas_cgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0,
|
||||
ALPHA, A, 2, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 14; RowMajorStrg = FALSE;
|
||||
cblas_cgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0,
|
||||
ALPHA, A, 2, B, 2, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
/* Row Major */
|
||||
cblas_info = 5; RowMajorStrg = TRUE;
|
||||
cblas_cgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, INVALID, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 5; RowMajorStrg = TRUE;
|
||||
cblas_cgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, INVALID, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 5; RowMajorStrg = TRUE;
|
||||
cblas_cgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, INVALID, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 5; RowMajorStrg = TRUE;
|
||||
cblas_cgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, INVALID, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 6; RowMajorStrg = TRUE;
|
||||
cblas_cgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, INVALID,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 6; RowMajorStrg = TRUE;
|
||||
cblas_cgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, INVALID,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 6; RowMajorStrg = TRUE;
|
||||
cblas_cgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, INVALID,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 6; RowMajorStrg = TRUE;
|
||||
cblas_cgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 0, INVALID,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 9; RowMajorStrg = TRUE;
|
||||
cblas_cgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 2 );
|
||||
chkxer();
|
||||
cblas_info = 9; RowMajorStrg = TRUE;
|
||||
cblas_cgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, 2,
|
||||
ALPHA, A, 1, B, 2, BETA, C, 2 );
|
||||
chkxer();
|
||||
cblas_info = 9; RowMajorStrg = TRUE;
|
||||
cblas_cgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0,
|
||||
ALPHA, A, 1, B, 2, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 9; RowMajorStrg = TRUE;
|
||||
cblas_cgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 11; RowMajorStrg = TRUE;
|
||||
cblas_cgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 11; RowMajorStrg = TRUE;
|
||||
cblas_cgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2,
|
||||
ALPHA, A, 2, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 11; RowMajorStrg = TRUE;
|
||||
cblas_cgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 14; RowMajorStrg = TRUE;
|
||||
cblas_cgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0,
|
||||
ALPHA, A, 2, B, 2, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 14; RowMajorStrg = TRUE;
|
||||
cblas_cgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0,
|
||||
ALPHA, A, 2, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 14; RowMajorStrg = TRUE;
|
||||
cblas_cgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0,
|
||||
ALPHA, A, 2, B, 2, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 14; RowMajorStrg = TRUE;
|
||||
cblas_cgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0,
|
||||
ALPHA, A, 2, B, 2, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
} else if (strncmp( sf,"cblas_cgemm" ,11)==0) {
|
||||
if (strncmp( sf,"cblas_cgemm" ,11)==0) {
|
||||
cblas_rout = "cblas_cgemm" ;
|
||||
|
||||
cblas_info = 1;
|
||||
@@ -512,6 +274,7 @@ void F77_c3chke(char * rout
|
||||
cblas_cgemm( CblasRowMajor, CblasTrans, CblasTrans, 0, 2, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
} else if (strncmp( sf,"cblas_chemm" ,11)==0) {
|
||||
cblas_rout = "cblas_chemm" ;
|
||||
|
||||
@@ -1939,7 +1702,7 @@ void F77_c3chke(char * rout
|
||||
}
|
||||
|
||||
if (cblas_ok == 1 )
|
||||
printf(" %-13s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout);
|
||||
printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout);
|
||||
else
|
||||
printf("***** %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout);
|
||||
}
|
||||
|
||||
+15
-75
@@ -11,11 +11,7 @@
|
||||
void F77_cgemv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n,
|
||||
const void *alpha,
|
||||
CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, const void *x, CBLAS_INT *incx,
|
||||
const void *beta, void *y, CBLAS_INT *incy
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN transp_len
|
||||
#endif
|
||||
) {
|
||||
const void *beta, void *y, CBLAS_INT *incy) {
|
||||
|
||||
CBLAS_TEST_COMPLEX *A;
|
||||
CBLAS_INT i,j,LDA;
|
||||
@@ -45,11 +41,7 @@ void F77_cgemv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n,
|
||||
void F77_cgbmv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, CBLAS_INT *kl, CBLAS_INT *ku,
|
||||
CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda,
|
||||
CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx,
|
||||
CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN transp_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy) {
|
||||
|
||||
CBLAS_TEST_COMPLEX *A;
|
||||
CBLAS_INT i,j,irow,jcol,LDA;
|
||||
@@ -152,11 +144,7 @@ void F77_cgerc(CBLAS_INT *layout, CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_COMPLEX
|
||||
|
||||
void F77_chemv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha,
|
||||
CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *x,
|
||||
CBLAS_INT *incx, CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
){
|
||||
CBLAS_INT *incx, CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy){
|
||||
|
||||
CBLAS_TEST_COMPLEX *A;
|
||||
CBLAS_INT i,j,LDA;
|
||||
@@ -187,11 +175,7 @@ void F77_chemv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_COMPLEX
|
||||
void F77_chbmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_INT *k,
|
||||
CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda,
|
||||
CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *beta,
|
||||
CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
){
|
||||
CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy){
|
||||
|
||||
CBLAS_TEST_COMPLEX *A;
|
||||
CBLAS_INT i,irow,j,jcol,LDA;
|
||||
@@ -254,11 +238,7 @@ CBLAS_INT i,irow,j,jcol,LDA;
|
||||
|
||||
void F77_chpmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha,
|
||||
CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx,
|
||||
CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
){
|
||||
CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy){
|
||||
|
||||
CBLAS_TEST_COMPLEX *A, *AP;
|
||||
CBLAS_INT i,j,k,LDA;
|
||||
@@ -314,11 +294,7 @@ void F77_chpmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_COMPLEX
|
||||
|
||||
void F77_ctbmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
CBLAS_INT *n, CBLAS_INT *k, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *x,
|
||||
CBLAS_INT *incx
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *incx) {
|
||||
CBLAS_TEST_COMPLEX *A;
|
||||
CBLAS_INT irow, jcol, i, j, LDA;
|
||||
CBLAS_TRANSPOSE trans;
|
||||
@@ -381,11 +357,7 @@ void F77_ctbmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
|
||||
void F77_ctbsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
CBLAS_INT *n, CBLAS_INT *k, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *x,
|
||||
CBLAS_INT *incx
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *incx) {
|
||||
|
||||
CBLAS_TEST_COMPLEX *A;
|
||||
CBLAS_INT irow, jcol, i, j, LDA;
|
||||
@@ -448,11 +420,7 @@ void F77_ctbsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
}
|
||||
|
||||
void F77_ctpmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
CBLAS_INT *n, CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len , FORTRAN_STRLEN diagn_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *n, CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx) {
|
||||
CBLAS_TEST_COMPLEX *A, *AP;
|
||||
CBLAS_INT i, j, k, LDA;
|
||||
CBLAS_TRANSPOSE trans;
|
||||
@@ -507,11 +475,7 @@ void F77_ctpmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
}
|
||||
|
||||
void F77_ctpsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
CBLAS_INT *n, CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *n, CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx) {
|
||||
CBLAS_TEST_COMPLEX *A, *AP;
|
||||
CBLAS_INT i, j, k, LDA;
|
||||
CBLAS_TRANSPOSE trans;
|
||||
@@ -567,11 +531,7 @@ void F77_ctpsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
|
||||
void F77_ctrmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
CBLAS_INT *n, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *x,
|
||||
CBLAS_INT *incx
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *incx) {
|
||||
CBLAS_TEST_COMPLEX *A;
|
||||
CBLAS_INT i,j,LDA;
|
||||
CBLAS_TRANSPOSE trans;
|
||||
@@ -600,11 +560,7 @@ void F77_ctrmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
}
|
||||
void F77_ctrsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
CBLAS_INT *n, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *x,
|
||||
CBLAS_INT *incx
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *incx) {
|
||||
CBLAS_TEST_COMPLEX *A;
|
||||
CBLAS_INT i,j,LDA;
|
||||
CBLAS_TRANSPOSE trans;
|
||||
@@ -633,11 +589,7 @@ void F77_ctrsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
}
|
||||
|
||||
void F77_chpr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha,
|
||||
CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *ap
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *ap) {
|
||||
CBLAS_TEST_COMPLEX *A, *AP;
|
||||
CBLAS_INT i,j,k,LDA;
|
||||
CBLAS_UPLO uplo;
|
||||
@@ -713,11 +665,7 @@ void F77_chpr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha,
|
||||
|
||||
void F77_chpr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha,
|
||||
CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy,
|
||||
CBLAS_TEST_COMPLEX *ap
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_TEST_COMPLEX *ap) {
|
||||
CBLAS_TEST_COMPLEX *A, *AP;
|
||||
CBLAS_INT i,j,k,LDA;
|
||||
CBLAS_UPLO uplo;
|
||||
@@ -793,11 +741,7 @@ void F77_chpr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_COMPLEX
|
||||
}
|
||||
|
||||
void F77_cher(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha,
|
||||
CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda) {
|
||||
CBLAS_TEST_COMPLEX *A;
|
||||
CBLAS_INT i,j,LDA;
|
||||
CBLAS_UPLO uplo;
|
||||
@@ -830,11 +774,7 @@ void F77_cher(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha,
|
||||
|
||||
void F77_cher2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha,
|
||||
CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy,
|
||||
CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda) {
|
||||
|
||||
CBLAS_TEST_COMPLEX *A;
|
||||
CBLAS_INT i,j,LDA;
|
||||
|
||||
+11
-128
@@ -14,11 +14,7 @@
|
||||
void F77_cgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CBLAS_INT *n,
|
||||
CBLAS_INT *k, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda,
|
||||
CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_COMPLEX *beta,
|
||||
CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN transpa_len, FORTRAN_STRLEN transpb_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc ) {
|
||||
|
||||
CBLAS_TEST_COMPLEX *A, *B, *C;
|
||||
CBLAS_INT i,j,LDA, LDB, LDC;
|
||||
@@ -91,95 +87,10 @@ void F77_cgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CB
|
||||
cblas_cgemm( UNDEFINED, transa, transb, *m, *n, *k, alpha, a, *lda,
|
||||
b, *ldb, beta, c, *ldc );
|
||||
}
|
||||
|
||||
void F77_cgemmtr(CBLAS_INT *layout, char *uplop, char *transpa, char *transpb, CBLAS_INT *n,
|
||||
CBLAS_INT *k, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda,
|
||||
CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_COMPLEX *beta,
|
||||
CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc ) {
|
||||
|
||||
CBLAS_TEST_COMPLEX *A, *B, *C;
|
||||
CBLAS_INT i,j,LDA, LDB, LDC;
|
||||
CBLAS_TRANSPOSE transa, transb;
|
||||
CBLAS_UPLO uplo;
|
||||
|
||||
get_transpose_type(transpa, &transa);
|
||||
get_transpose_type(transpb, &transb);
|
||||
get_uplo_type(uplop, &uplo);
|
||||
|
||||
if (*layout == TEST_ROW_MJR) {
|
||||
if (transa == CblasNoTrans) {
|
||||
LDA = *k+1;
|
||||
A=(CBLAS_TEST_COMPLEX*)malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX));
|
||||
for( i=0; i<*n; i++ )
|
||||
for( j=0; j<*k; j++ ) {
|
||||
A[i*LDA+j].real=a[j*(*lda)+i].real;
|
||||
A[i*LDA+j].imag=a[j*(*lda)+i].imag;
|
||||
}
|
||||
}
|
||||
else {
|
||||
LDA = *n+1;
|
||||
A=(CBLAS_TEST_COMPLEX* )malloc(LDA*(*k)*sizeof(CBLAS_TEST_COMPLEX));
|
||||
for( i=0; i<*k; i++ )
|
||||
for( j=0; j<*n; j++ ) {
|
||||
A[i*LDA+j].real=a[j*(*lda)+i].real;
|
||||
A[i*LDA+j].imag=a[j*(*lda)+i].imag;
|
||||
}
|
||||
}
|
||||
|
||||
if (transb == CblasNoTrans) {
|
||||
LDB = *n+1;
|
||||
B=(CBLAS_TEST_COMPLEX* )malloc((*k)*LDB*sizeof(CBLAS_TEST_COMPLEX) );
|
||||
for( i=0; i<*k; i++ )
|
||||
for( j=0; j<*n; j++ ) {
|
||||
B[i*LDB+j].real=b[j*(*ldb)+i].real;
|
||||
B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
|
||||
}
|
||||
}
|
||||
else {
|
||||
LDB = *k+1;
|
||||
B=(CBLAS_TEST_COMPLEX* )malloc(LDB*(*n)*sizeof(CBLAS_TEST_COMPLEX));
|
||||
for( i=0; i<*n; i++ )
|
||||
for( j=0; j<*k; j++ ) {
|
||||
B[i*LDB+j].real=b[j*(*ldb)+i].real;
|
||||
B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
|
||||
}
|
||||
}
|
||||
|
||||
LDC = *n+1;
|
||||
C=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDC*sizeof(CBLAS_TEST_COMPLEX));
|
||||
for( j=0; j<*n; j++ )
|
||||
for( i=0; i<*n; i++ ) {
|
||||
C[i*LDC+j].real=c[j*(*ldc)+i].real;
|
||||
C[i*LDC+j].imag=c[j*(*ldc)+i].imag;
|
||||
}
|
||||
cblas_cgemmtr( CblasRowMajor, uplo, transa, transb, *n, *k, alpha, A, LDA,
|
||||
B, LDB, beta, C, LDC );
|
||||
for( j=0; j<*n; j++ )
|
||||
for( i=0; i<*n; i++ ) {
|
||||
c[j*(*ldc)+i].real=C[i*LDC+j].real;
|
||||
c[j*(*ldc)+i].imag=C[i*LDC+j].imag;
|
||||
}
|
||||
free(A);
|
||||
free(B);
|
||||
free(C);
|
||||
}
|
||||
else if (*layout == TEST_COL_MJR)
|
||||
cblas_cgemmtr( CblasColMajor, uplo, transa, transb, *n, *k, alpha, a, *lda,
|
||||
b, *ldb, beta, c, *ldc );
|
||||
else
|
||||
cblas_cgemmtr( UNDEFINED, uplo, transa, transb, *n, *k, alpha, a, *lda,
|
||||
b, *ldb, beta, c, *ldc );
|
||||
}
|
||||
|
||||
|
||||
void F77_chemm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_INT *n,
|
||||
CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda,
|
||||
CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_COMPLEX *beta,
|
||||
CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_COMPLEX *beta,
|
||||
CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc ) {
|
||||
|
||||
CBLAS_TEST_COMPLEX *A, *B, *C;
|
||||
CBLAS_INT i,j,LDA, LDB, LDC;
|
||||
@@ -242,12 +153,8 @@ void F77_chemm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_I
|
||||
}
|
||||
void F77_csymm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_INT *n,
|
||||
CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda,
|
||||
CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_COMPLEX *beta,
|
||||
CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_COMPLEX *beta,
|
||||
CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc ) {
|
||||
|
||||
CBLAS_TEST_COMPLEX *A, *B, *C;
|
||||
CBLAS_INT i,j,LDA, LDB, LDC;
|
||||
@@ -301,11 +208,7 @@ void F77_csymm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_I
|
||||
|
||||
void F77_cherk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k,
|
||||
float *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda,
|
||||
float *beta, CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len
|
||||
#endif
|
||||
) {
|
||||
float *beta, CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc ) {
|
||||
|
||||
CBLAS_INT i,j,LDA,LDC;
|
||||
CBLAS_TEST_COMPLEX *A, *C;
|
||||
@@ -361,11 +264,7 @@ void F77_cherk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS
|
||||
|
||||
void F77_csyrk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k,
|
||||
CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda,
|
||||
CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc ) {
|
||||
|
||||
CBLAS_INT i,j,LDA,LDC;
|
||||
CBLAS_TEST_COMPLEX *A, *C;
|
||||
@@ -421,11 +320,7 @@ void F77_csyrk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS
|
||||
void F77_cher2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k,
|
||||
CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda,
|
||||
CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb, float *beta,
|
||||
CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc ) {
|
||||
CBLAS_INT i,j,LDA,LDB,LDC;
|
||||
CBLAS_TEST_COMPLEX *A, *B, *C;
|
||||
CBLAS_UPLO uplo;
|
||||
@@ -489,11 +384,7 @@ void F77_cher2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLA
|
||||
void F77_csyr2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k,
|
||||
CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda,
|
||||
CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_COMPLEX *beta,
|
||||
CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc ) {
|
||||
CBLAS_INT i,j,LDA,LDB,LDC;
|
||||
CBLAS_TEST_COMPLEX *A, *B, *C;
|
||||
CBLAS_UPLO uplo;
|
||||
@@ -556,11 +447,7 @@ void F77_csyr2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLA
|
||||
}
|
||||
void F77_ctrmm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *diagn,
|
||||
CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a,
|
||||
CBLAS_INT *lda, CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *lda, CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb) {
|
||||
CBLAS_INT i,j,LDA,LDB;
|
||||
CBLAS_TEST_COMPLEX *A, *B;
|
||||
CBLAS_SIDE side;
|
||||
@@ -619,11 +506,7 @@ void F77_ctrmm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *d
|
||||
|
||||
void F77_ctrsm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *diagn,
|
||||
CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a,
|
||||
CBLAS_INT *lda, CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *lda, CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb) {
|
||||
CBLAS_INT i,j,LDA,LDB;
|
||||
CBLAS_TEST_COMPLEX *A, *B;
|
||||
CBLAS_SIDE side;
|
||||
|
||||
@@ -349,13 +349,13 @@
|
||||
CALL CCHK3( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
$ REWI, FATAL, NIDIM, IDIM, NKB, KB, NINC, INC,
|
||||
$ NMAX, INCMAX, A, AA, AS, Y, YY, YS, YT, G, Z,
|
||||
$ 0 )
|
||||
$ 0 )
|
||||
END IF
|
||||
IF (RORDER) THEN
|
||||
CALL CCHK3( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
$ REWI, FATAL, NIDIM, IDIM, NKB, KB, NINC, INC,
|
||||
$ NMAX, INCMAX, A, AA, AS, Y, YY, YS, YT, G, Z,
|
||||
$ 1 )
|
||||
$ 1 )
|
||||
END IF
|
||||
GO TO 200
|
||||
* Test CGERC, 12, CGERU, 13.
|
||||
|
||||
+77
-631
@@ -3,10 +3,10 @@
|
||||
* Test program for the COMPLEX Level 3 Blas.
|
||||
*
|
||||
* The program must be driven by a short data file. The first 13 records
|
||||
* of the file are read using list-directed input, the last 10 records
|
||||
* are read using the format ( A13, L2 ). An annotated example of a data
|
||||
* of the file are read using list-directed input, the last 9 records
|
||||
* are read using the format ( A12, L2 ). An annotated example of a data
|
||||
* file can be obtained by deleting the first 3 characters from the
|
||||
* following 23 lines:
|
||||
* following 22 lines:
|
||||
* 'CBLAT3.SNAP' NAME OF SNAPSHOT OUTPUT FILE
|
||||
* -1 UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
|
||||
* F LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
|
||||
@@ -20,16 +20,15 @@
|
||||
* (0.0,0.0) (1.0,0.0) (0.7,-0.9) VALUES OF ALPHA
|
||||
* 3 NUMBER OF VALUES OF BETA
|
||||
* (0.0,0.0) (1.0,0.0) (1.3,-1.1) VALUES OF BETA
|
||||
* cblas_cgemm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_chemm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_csymm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_ctrmm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_ctrsm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_cherk T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_csyrk T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_cher2k T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_csyr2k T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_cgemmtr T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_cgemm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_chemm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_csymm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_ctrmm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_ctrsm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_cherk T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_csyrk T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_cher2k T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_csyr2k T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
*
|
||||
* See:
|
||||
*
|
||||
@@ -50,7 +49,7 @@
|
||||
INTEGER NIN, NOUT
|
||||
PARAMETER ( NIN = 5, NOUT = 6 )
|
||||
INTEGER NSUBS
|
||||
PARAMETER ( NSUBS = 10 )
|
||||
PARAMETER ( NSUBS = 9 )
|
||||
COMPLEX ZERO, ONE
|
||||
PARAMETER ( ZERO = ( 0.0, 0.0 ), ONE = ( 1.0, 0.0 ) )
|
||||
REAL RZERO, RHALF, RONE
|
||||
@@ -66,7 +65,7 @@
|
||||
LOGICAL FATAL, LTESTT, REWI, SAME, SFATAL, TRACE,
|
||||
$ TSTERR, CORDER, RORDER
|
||||
CHARACTER*1 TRANSA, TRANSB
|
||||
CHARACTER*13 SNAMET
|
||||
CHARACTER*12 SNAMET
|
||||
CHARACTER*32 SNAPS
|
||||
* .. Local Arrays ..
|
||||
COMPLEX AA( NMAX*NMAX ), AB( NMAX, 2*NMAX ),
|
||||
@@ -78,19 +77,19 @@
|
||||
REAL G( NMAX )
|
||||
INTEGER IDIM( NIDMAX )
|
||||
LOGICAL LTEST( NSUBS )
|
||||
CHARACTER*13 SNAMES( NSUBS )
|
||||
CHARACTER*12 SNAMES( NSUBS )
|
||||
* .. External Functions ..
|
||||
REAL SDIFF
|
||||
LOGICAL LCE
|
||||
EXTERNAL SDIFF, LCE
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL CCHK1, CCHK2, CCHK3, CCHK4, CCHK5, CCHK6, CMMCH
|
||||
EXTERNAL CCHK1, CCHK2, CCHK3, CCHK4, CCHK5, CMMCH
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC MAX, MIN
|
||||
* .. Scalars in Common ..
|
||||
INTEGER INFOT, NOUTC
|
||||
LOGICAL LERR, OK
|
||||
CHARACTER*13 SRNAMT
|
||||
CHARACTER*12 SRNAMT
|
||||
* .. Common blocks ..
|
||||
COMMON /INFOC/INFOT, NOUTC, OK, LERR
|
||||
COMMON /SRNAMC/SRNAMT
|
||||
@@ -98,7 +97,7 @@
|
||||
DATA SNAMES/'cblas_cgemm ', 'cblas_chemm ',
|
||||
$ 'cblas_csymm ', 'cblas_ctrmm ', 'cblas_ctrsm ',
|
||||
$ 'cblas_cherk ', 'cblas_csyrk ', 'cblas_cher2k',
|
||||
$ 'cblas_csyr2k', 'cblas_cgemmtr' /
|
||||
$ 'cblas_csyr2k'/
|
||||
* .. Executable Statements ..
|
||||
*
|
||||
NOUTC = NOUT
|
||||
@@ -296,7 +295,7 @@
|
||||
OK = .TRUE.
|
||||
FATAL = .FALSE.
|
||||
GO TO ( 140, 150, 150, 160, 160, 170, 170,
|
||||
$ 180, 180, 185 )ISNUM
|
||||
$ 180, 180 )ISNUM
|
||||
* Test CGEMM, 01.
|
||||
140 IF (CORDER) THEN
|
||||
CALL CCHK1(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
@@ -330,13 +329,13 @@
|
||||
CALL CCHK3(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NMAX, AB,
|
||||
$ AA, AS, AB( 1, NMAX + 1 ), BB, BS, CT, G, C,
|
||||
$ 0 )
|
||||
$ 0 )
|
||||
END IF
|
||||
IF (RORDER) THEN
|
||||
CALL CCHK3(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NMAX, AB,
|
||||
$ AA, AS, AB( 1, NMAX + 1 ), BB, BS, CT, G, C,
|
||||
$ 1 )
|
||||
$ 1 )
|
||||
END IF
|
||||
GO TO 190
|
||||
* Test CHERK, 06, CSYRK, 07.
|
||||
@@ -358,30 +357,15 @@
|
||||
CALL CCHK5(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
|
||||
$ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W,
|
||||
$ 0 )
|
||||
$ 0 )
|
||||
END IF
|
||||
IF (RORDER) THEN
|
||||
CALL CCHK5(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
|
||||
$ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W,
|
||||
$ 1 )
|
||||
$ 1 )
|
||||
END IF
|
||||
GO TO 190
|
||||
* Test CGEMMTR, 10.
|
||||
185 IF (CORDER) THEN
|
||||
CALL CCHK6(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
|
||||
$ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
|
||||
$ CC, CS, CT, G, 0 )
|
||||
END IF
|
||||
IF (RORDER) THEN
|
||||
CALL CCHK6(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
|
||||
$ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
|
||||
$ CC, CS, CT, G, 1 )
|
||||
END IF
|
||||
GO TO 190
|
||||
|
||||
*
|
||||
190 IF( FATAL.AND.SFATAL )
|
||||
$ GO TO 210
|
||||
@@ -421,7 +405,7 @@
|
||||
$ 7( '(', F4.1, ',', F4.1, ') ', : ) )
|
||||
9991 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM',
|
||||
$ /' ******* TESTS ABANDONED *******' )
|
||||
9990 FORMAT(' SUBPROGRAM NAME ', A13,' NOT RECOGNIZED', /' ******* T',
|
||||
9990 FORMAT(' SUBPROGRAM NAME ', A12,' NOT RECOGNIZED', /' ******* T',
|
||||
$ 'ESTS ABANDONED *******' )
|
||||
9989 FORMAT(' ERROR IN CMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALU',
|
||||
$ 'ATED WRONGLY.', /' CMMCH WAS CALLED WITH TRANSA = ', A1,
|
||||
@@ -429,8 +413,8 @@
|
||||
$ ' ERR = ', F12.3, '.', /' THIS MAY BE DUE TO FAULTS IN THE ',
|
||||
$ 'ARITHMETIC OR THE COMPILER.', /' ******* TESTS ABANDONED ',
|
||||
$ '*******' )
|
||||
9988 FORMAT( A13,L2 )
|
||||
9987 FORMAT( 1X, A13,' WAS NOT TESTED' )
|
||||
9988 FORMAT( A12,L2 )
|
||||
9987 FORMAT( 1X, A12,' WAS NOT TESTED' )
|
||||
9986 FORMAT( /' END OF TESTS' )
|
||||
9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' )
|
||||
9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' )
|
||||
@@ -462,7 +446,7 @@
|
||||
REAL EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
* .. Array Arguments ..
|
||||
COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
@@ -710,20 +694,20 @@
|
||||
130 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(''', A1, ''',''', A1, ''',',
|
||||
9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( 1X, I6, ': ', A12,'(''', A1, ''',''', A1, ''',',
|
||||
$ 3( I3, ',' ), '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3,
|
||||
$ ',(', F4.1, ',', F4.1, '), C,', I3, ').' )
|
||||
9994 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
@@ -738,7 +722,7 @@
|
||||
INTEGER NOUT, NC, IORDER, M, N, K, LDA, LDB, LDC
|
||||
COMPLEX ALPHA, BETA
|
||||
CHARACTER*1 TRANSA, TRANSB
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
CHARACTER*14 CRC, CTA,CTB
|
||||
|
||||
IF (TRANSA.EQ.'N')THEN
|
||||
@@ -763,7 +747,7 @@
|
||||
WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CTA,CTB
|
||||
WRITE(NOUT, FMT = 9994)M, N, K, ALPHA, LDA, LDB, BETA, LDC
|
||||
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',')
|
||||
9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',')
|
||||
9994 FORMAT( 10X, 3( I3, ',' ) ,' (', F4.1,',',F4.1,') , A,',
|
||||
$ I3, ', B,', I3, ', (', F4.1,',',F4.1,') , C,', I3, ').' )
|
||||
END
|
||||
@@ -792,7 +776,7 @@
|
||||
REAL EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
* .. Array Arguments ..
|
||||
COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
@@ -1036,20 +1020,20 @@
|
||||
120 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT(1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
$ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1,
|
||||
$ ',', F4.1, '), C,', I3, ') .' )
|
||||
9994 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
@@ -1064,7 +1048,7 @@
|
||||
INTEGER NOUT, NC, IORDER, M, N, LDA, LDB, LDC
|
||||
COMPLEX ALPHA, BETA
|
||||
CHARACTER*1 SIDE, UPLO
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
CHARACTER*14 CRC, CS,CU
|
||||
|
||||
IF (SIDE.EQ.'L')THEN
|
||||
@@ -1085,7 +1069,7 @@
|
||||
WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CS,CU
|
||||
WRITE(NOUT, FMT = 9994)M, N, ALPHA, LDA, LDB, BETA, LDC
|
||||
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',')
|
||||
9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',')
|
||||
9994 FORMAT( 10X, 2( I3, ',' ),' (',F4.1,',',F4.1, '), A,', I3,
|
||||
$ ', B,', I3, ', (',F4.1,',',F4.1, '), ', 'C,', I3, ').' )
|
||||
END
|
||||
@@ -1113,7 +1097,7 @@
|
||||
REAL EPS, THRESH
|
||||
INTEGER NALF, NIDIM, NMAX, NOUT, NTRA, IORDER
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
* .. Array Arguments ..
|
||||
COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
@@ -1388,20 +1372,20 @@
|
||||
160 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9996 FORMAT(' ******* ', A13,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT(1X, I6, ': ', A13,'(', 4( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
9996 FORMAT(' ******* ', A12,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT(1X, I6, ': ', A12,'(', 4( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
$ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ') ',
|
||||
$ ' .' )
|
||||
9994 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
@@ -1416,7 +1400,7 @@
|
||||
INTEGER NOUT, NC, IORDER, M, N, LDA, LDB
|
||||
COMPLEX ALPHA
|
||||
CHARACTER*1 SIDE, UPLO, TRANSA, DIAG
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
CHARACTER*14 CRC, CS, CU, CA, CD
|
||||
|
||||
IF (SIDE.EQ.'L')THEN
|
||||
@@ -1449,7 +1433,7 @@
|
||||
WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CS,CU
|
||||
WRITE(NOUT, FMT = 9994)CA, CD, M, N, ALPHA, LDA, LDB
|
||||
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',')
|
||||
9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',')
|
||||
9994 FORMAT( 10X, 2( A14, ',') , 2( I3, ',' ), ' (', F4.1, ',',
|
||||
$ F4.1, '), A,', I3, ', B,', I3, ').' )
|
||||
END
|
||||
@@ -1478,7 +1462,7 @@
|
||||
REAL EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
* .. Array Arguments ..
|
||||
COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
@@ -1770,24 +1754,24 @@
|
||||
130 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' )
|
||||
9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 )
|
||||
9994 FORMAT(1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
9994 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
$ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ') ',
|
||||
$ ' .' )
|
||||
9993 FORMAT(1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
9993 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
$ '(', F4.1, ',', F4.1, ') , A,', I3, ',(', F4.1, ',', F4.1,
|
||||
$ '), C,', I3, ') .' )
|
||||
9992 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
@@ -1802,7 +1786,7 @@
|
||||
INTEGER NOUT, NC, IORDER, N, K, LDA, LDC
|
||||
COMPLEX ALPHA, BETA
|
||||
CHARACTER*1 UPLO, TRANSA
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
CHARACTER*14 CRC, CU, CA
|
||||
|
||||
IF (UPLO.EQ.'U')THEN
|
||||
@@ -1825,7 +1809,7 @@
|
||||
WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA
|
||||
WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, BETA, LDC
|
||||
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') )
|
||||
9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') )
|
||||
9994 FORMAT( 10X, 2( I3, ',' ), ' (', F4.1, ',', F4.1 ,'), A,',
|
||||
$ I3, ', (', F4.1,',', F4.1, '), C,', I3, ').' )
|
||||
END
|
||||
@@ -1836,7 +1820,7 @@
|
||||
INTEGER NOUT, NC, IORDER, N, K, LDA, LDC
|
||||
REAL ALPHA, BETA
|
||||
CHARACTER*1 UPLO, TRANSA
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
CHARACTER*14 CRC, CU, CA
|
||||
|
||||
IF (UPLO.EQ.'U')THEN
|
||||
@@ -1859,7 +1843,7 @@
|
||||
WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA
|
||||
WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, BETA, LDC
|
||||
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') )
|
||||
9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') )
|
||||
9994 FORMAT( 10X, 2( I3, ',' ),
|
||||
$ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ').' )
|
||||
END
|
||||
@@ -1888,7 +1872,7 @@
|
||||
REAL EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
* .. Array Arguments ..
|
||||
COMPLEX AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ),
|
||||
$ ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ),
|
||||
@@ -2223,24 +2207,24 @@
|
||||
160 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' )
|
||||
9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 )
|
||||
9994 FORMAT(1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
9994 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
$ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',', F4.1,
|
||||
$ ', C,', I3, ') .' )
|
||||
9993 FORMAT(1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
9993 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
$ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1,
|
||||
$ ',', F4.1, '), C,', I3, ') .' )
|
||||
9992 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
@@ -2255,7 +2239,7 @@
|
||||
INTEGER NOUT, NC, IORDER, N, K, LDA, LDB, LDC
|
||||
COMPLEX ALPHA, BETA
|
||||
CHARACTER*1 UPLO, TRANSA
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
CHARACTER*14 CRC, CU, CA
|
||||
|
||||
IF (UPLO.EQ.'U')THEN
|
||||
@@ -2278,7 +2262,7 @@
|
||||
WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA
|
||||
WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, LDB, BETA, LDC
|
||||
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') )
|
||||
9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') )
|
||||
9994 FORMAT( 10X, 2( I3, ',' ), ' (', F4.1, ',', F4.1, '), A,',
|
||||
$ I3, ', B', I3, ', (', F4.1, ',', F4.1, '), C,', I3, ').' )
|
||||
END
|
||||
@@ -2290,7 +2274,7 @@
|
||||
COMPLEX ALPHA
|
||||
REAL BETA
|
||||
CHARACTER*1 UPLO, TRANSA
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
CHARACTER*14 CRC, CU, CA
|
||||
|
||||
IF (UPLO.EQ.'U')THEN
|
||||
@@ -2313,7 +2297,7 @@
|
||||
WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA
|
||||
WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, LDB, BETA, LDC
|
||||
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') )
|
||||
9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') )
|
||||
9994 FORMAT( 10X, 2( I3, ',' ), ' (', F4.1, ',', F4.1, '), A,',
|
||||
$ I3, ', B', I3, ',', F4.1, ', C,', I3, ').' )
|
||||
END
|
||||
@@ -2801,541 +2785,3 @@
|
||||
* End of SDIFF.
|
||||
*
|
||||
END
|
||||
|
||||
SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
|
||||
$ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
|
||||
$ A, AA, AS, B, BB, BS, C, CC, CS, CT, G,
|
||||
$ IORDER )
|
||||
IMPLICIT NONE
|
||||
*
|
||||
* Tests CGEMMTR.
|
||||
*
|
||||
* Auxiliary routine for test program for Level 3 Blas.
|
||||
*
|
||||
* -- Written on 24-June-2024.
|
||||
* Martin Koehler, Max Planck Institute Magdeburg
|
||||
*
|
||||
* .. Parameters ..
|
||||
COMPLEX ZERO
|
||||
PARAMETER ( ZERO = ( 0.0, 0.0 ) )
|
||||
REAL RZERO
|
||||
PARAMETER ( RZERO = 0.0 )
|
||||
* .. Scalar Arguments ..
|
||||
REAL EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*13 SNAME
|
||||
* .. Array Arguments ..
|
||||
COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
$ BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
|
||||
$ C( NMAX, NMAX ), CC( NMAX*NMAX ),
|
||||
$ CS( NMAX*NMAX ), CT( NMAX )
|
||||
REAL G( NMAX )
|
||||
INTEGER IDIM( NIDIM )
|
||||
* .. Local Scalars ..
|
||||
COMPLEX ALPHA, ALS, BETA, BLS
|
||||
REAL ERR, ERRMAX
|
||||
INTEGER I, IA, IB, ICA, ICB, IK, IM, IN, K, KS, LAA,
|
||||
$ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS,
|
||||
$ MA, MB, N, NA, NARGS, NB, NC, NS, IS
|
||||
LOGICAL NULL, RESET, SAME, TRANA, TRANB
|
||||
CHARACTER*1 TRANAS, TRANBS, TRANSA, TRANSB, UPLO, UPLOS
|
||||
CHARACTER*3 ICH
|
||||
CHARACTER*2 ISHAPE
|
||||
* .. Local Arrays ..
|
||||
LOGICAL ISAME( 13 )
|
||||
* .. External Functions ..
|
||||
LOGICAL LCE, LCERES
|
||||
EXTERNAL LCE, LCERES
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL CCGEMMTR, CMAKE, CMMTCH, CPRCN8
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC MAX
|
||||
* .. Scalars in Common ..
|
||||
INTEGER INFOT, NOUTC
|
||||
LOGICAL LERR, OK
|
||||
* .. Common blocks ..
|
||||
COMMON /INFOC/INFOT, NOUTC, OK, LERR
|
||||
* .. Data statements ..
|
||||
DATA ICH/'NTC'/
|
||||
DATA ISHAPE/'UL'/
|
||||
* .. Executable Statements ..
|
||||
*
|
||||
NARGS = 13
|
||||
NC = 0
|
||||
RESET = .TRUE.
|
||||
ERRMAX = RZERO
|
||||
*
|
||||
DO 100 IN = 1, NIDIM
|
||||
N = IDIM( IN )
|
||||
* Set LDC to 1 more than minimum value if room.
|
||||
LDC = N
|
||||
IF( LDC.LT.NMAX )
|
||||
$ LDC = LDC + 1
|
||||
* Skip tests if not enough room.
|
||||
IF( LDC.GT.NMAX )
|
||||
$ GO TO 100
|
||||
LCC = LDC*N
|
||||
NULL = N.LE.0.
|
||||
*
|
||||
DO 90 IK = 1, NIDIM
|
||||
K = IDIM( IK )
|
||||
*
|
||||
DO 80 ICA = 1, 3
|
||||
TRANSA = ICH( ICA: ICA )
|
||||
TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C'
|
||||
*
|
||||
IF( TRANA )THEN
|
||||
MA = K
|
||||
NA = N
|
||||
ELSE
|
||||
MA = N
|
||||
NA = K
|
||||
END IF
|
||||
* Set LDA to 1 more than minimum value if room.
|
||||
LDA = MA
|
||||
IF( LDA.LT.NMAX )
|
||||
$ LDA = LDA + 1
|
||||
* Skip tests if not enough room.
|
||||
IF( LDA.GT.NMAX )
|
||||
$ GO TO 80
|
||||
LAA = LDA*NA
|
||||
*
|
||||
* Generate the matrix A.
|
||||
*
|
||||
CALL CMAKE( 'ge', ' ', ' ', MA, NA, A, NMAX, AA, LDA,
|
||||
$ RESET, ZERO )
|
||||
*
|
||||
DO 70 ICB = 1, 3
|
||||
TRANSB = ICH( ICB: ICB )
|
||||
TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C'
|
||||
*
|
||||
IF( TRANB )THEN
|
||||
MB = N
|
||||
NB = K
|
||||
ELSE
|
||||
MB = K
|
||||
NB = N
|
||||
END IF
|
||||
* Set LDB to 1 more than minimum value if room.
|
||||
LDB = MB
|
||||
IF( LDB.LT.NMAX )
|
||||
$ LDB = LDB + 1
|
||||
* Skip tests if not enough room.
|
||||
IF( LDB.GT.NMAX )
|
||||
$ GO TO 70
|
||||
LBB = LDB*NB
|
||||
*
|
||||
* Generate the matrix B.
|
||||
*
|
||||
CALL CMAKE( 'ge', ' ', ' ', MB, NB, B, NMAX, BB,
|
||||
$ LDB, RESET, ZERO )
|
||||
*
|
||||
DO 60 IA = 1, NALF
|
||||
ALPHA = ALF( IA )
|
||||
*
|
||||
DO 50 IB = 1, NBET
|
||||
BETA = BET( IB )
|
||||
DO 45 IS = 1, 2
|
||||
UPLO = ISHAPE(IS:IS)
|
||||
*
|
||||
* Generate the matrix C.
|
||||
*
|
||||
CALL CMAKE( 'ge', UPLO, ' ', N, N, C, NMAX,
|
||||
$ CC, LDC, RESET, ZERO )
|
||||
*
|
||||
NC = NC + 1
|
||||
*
|
||||
* Save every datum before calling the
|
||||
* subroutine.
|
||||
*
|
||||
UPLOS = UPLO
|
||||
TRANAS = TRANSA
|
||||
TRANBS = TRANSB
|
||||
NS = N
|
||||
KS = K
|
||||
ALS = ALPHA
|
||||
DO 10 I = 1, LAA
|
||||
AS( I ) = AA( I )
|
||||
10 CONTINUE
|
||||
LDAS = LDA
|
||||
DO 20 I = 1, LBB
|
||||
BS( I ) = BB( I )
|
||||
20 CONTINUE
|
||||
LDBS = LDB
|
||||
BLS = BETA
|
||||
DO 30 I = 1, LCC
|
||||
CS( I ) = CC( I )
|
||||
30 CONTINUE
|
||||
LDCS = LDC
|
||||
*
|
||||
* Call the subroutine.
|
||||
*
|
||||
IF( TRACE )
|
||||
$ CALL CPRCN8(NTRA, NC, SNAME, IORDER, UPLO,
|
||||
$ TRANSA, TRANSB, N, K, ALPHA, LDA,
|
||||
$ LDB, BETA, LDC)
|
||||
IF( REWI )
|
||||
$ REWIND NTRA
|
||||
CALL CCGEMMTR(IORDER, UPLO, TRANSA, TRANSB,
|
||||
$ N, K, ALPHA, AA, LDA, BB, LDB,
|
||||
$ BETA, CC, LDC )
|
||||
*
|
||||
* Check if error-exit was taken incorrectly.
|
||||
*
|
||||
IF( .NOT.OK )THEN
|
||||
WRITE( NOUT, FMT = 9994 )
|
||||
FATAL = .TRUE.
|
||||
GO TO 120
|
||||
END IF
|
||||
*
|
||||
* See what data changed inside subroutines.
|
||||
*
|
||||
ISAME( 1 ) = UPLO .EQ. UPLOS
|
||||
ISAME( 2 ) = TRANSA.EQ.TRANAS
|
||||
ISAME( 3 ) = TRANSB.EQ.TRANBS
|
||||
ISAME( 4 ) = NS.EQ.N
|
||||
ISAME( 5 ) = KS.EQ.K
|
||||
ISAME( 6 ) = ALS.EQ.ALPHA
|
||||
ISAME( 7 ) = LCE( AS, AA, LAA )
|
||||
ISAME( 8 ) = LDAS.EQ.LDA
|
||||
ISAME( 9 ) = LCE( BS, BB, LBB )
|
||||
ISAME( 10 ) = LDBS.EQ.LDB
|
||||
ISAME( 11 ) = BLS.EQ.BETA
|
||||
IF( NULL )THEN
|
||||
ISAME( 12 ) = LCE( CS, CC, LCC )
|
||||
ELSE
|
||||
ISAME( 12 ) = LCERES( 'ge', ' ', N, N, CS,
|
||||
$ CC, LDC )
|
||||
END IF
|
||||
ISAME( 13 ) = LDCS.EQ.LDC
|
||||
*
|
||||
* If data was incorrectly changed, report
|
||||
* and return.
|
||||
*
|
||||
SAME = .TRUE.
|
||||
DO 40 I = 1, NARGS
|
||||
SAME = SAME.AND.ISAME( I )
|
||||
IF( .NOT.ISAME( I ) )
|
||||
$ WRITE( NOUT, FMT = 9998 )I
|
||||
40 CONTINUE
|
||||
IF( .NOT.SAME )THEN
|
||||
FATAL = .TRUE.
|
||||
GO TO 120
|
||||
END IF
|
||||
*
|
||||
IF( .NOT.NULL )THEN
|
||||
*
|
||||
* Check the result.
|
||||
*
|
||||
CALL CMMTCH( UPLO, TRANSA, TRANSB, N, K,
|
||||
$ ALPHA, A, NMAX, B, NMAX, BETA,
|
||||
$ C, NMAX, CT, G, CC, LDC, EPS,
|
||||
$ ERR, FATAL, NOUT, .TRUE. )
|
||||
ERRMAX = MAX( ERRMAX, ERR )
|
||||
* If got really bad answer, report and
|
||||
* return.
|
||||
IF( FATAL )
|
||||
$ GO TO 120
|
||||
END IF
|
||||
*
|
||||
45 CONTINUE
|
||||
*
|
||||
50 CONTINUE
|
||||
*
|
||||
60 CONTINUE
|
||||
*
|
||||
70 CONTINUE
|
||||
*
|
||||
80 CONTINUE
|
||||
*
|
||||
90 CONTINUE
|
||||
*
|
||||
100 CONTINUE
|
||||
*
|
||||
*
|
||||
* Report result.
|
||||
*
|
||||
IF( ERRMAX.LT.THRESH )THEN
|
||||
IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10000 )SNAME, NC
|
||||
IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10001 )SNAME, NC
|
||||
ELSE
|
||||
IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10002 )SNAME, NC, ERRMAX
|
||||
IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10003 )SNAME, NC, ERRMAX
|
||||
END IF
|
||||
GO TO 130
|
||||
*
|
||||
120 CONTINUE
|
||||
WRITE( NOUT, FMT = 9996 )SNAME
|
||||
CALL CPRCN8(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, TRANSB,
|
||||
$ N, K, ALPHA, LDA, LDB, BETA, LDC)
|
||||
*
|
||||
130 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(''', A1, ''',''', A1, ''',',
|
||||
$ 3( I3, ',' ), '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3,
|
||||
$ ',(', F4.1, ',', F4.1, '), C,', I3, ').' )
|
||||
9994 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
$ '******' )
|
||||
*
|
||||
* End of CCHK6.
|
||||
*
|
||||
END
|
||||
|
||||
SUBROUTINE CPRCN8(NOUT, NC, SNAME, IORDER, UPLO,
|
||||
$ TRANSA, TRANSB, N,
|
||||
$ K, ALPHA, LDA, LDB, BETA, LDC)
|
||||
INTEGER NOUT, NC, IORDER, N, K, LDA, LDB, LDC
|
||||
COMPLEX ALPHA, BETA
|
||||
CHARACTER*1 TRANSA, TRANSB, UPLO
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*14 CRC, CTA,CTB,CUPLO
|
||||
|
||||
IF (UPLO.EQ.'U') THEN
|
||||
CUPLO = 'CblasUpper'
|
||||
ELSE
|
||||
CUPLO = 'CblasLower'
|
||||
END IF
|
||||
IF (TRANSA.EQ.'N')THEN
|
||||
CTA = ' CblasNoTrans'
|
||||
ELSE IF (TRANSA.EQ.'T')THEN
|
||||
CTA = ' CblasTrans'
|
||||
ELSE
|
||||
CTA = 'CblasConjTrans'
|
||||
END IF
|
||||
IF (TRANSB.EQ.'N')THEN
|
||||
CTB = ' CblasNoTrans'
|
||||
ELSE IF (TRANSB.EQ.'T')THEN
|
||||
CTB = ' CblasTrans'
|
||||
ELSE
|
||||
CTB = 'CblasConjTrans'
|
||||
END IF
|
||||
IF (IORDER.EQ.1)THEN
|
||||
CRC = ' CblasRowMajor'
|
||||
ELSE
|
||||
CRC = ' CblasColMajor'
|
||||
END IF
|
||||
WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CUPLO, CTA,CTB
|
||||
WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, LDB, BETA, LDC
|
||||
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',',
|
||||
$ A14, ',')
|
||||
9994 FORMAT( 10X, 2( I3, ',' ) ,' (', F4.1,',',F4.1,') , A,',
|
||||
$ I3, ', B,', I3, ', (', F4.1,',',F4.1,') , C,', I3, ').' )
|
||||
END
|
||||
|
||||
SUBROUTINE CMMTCH(UPLO, TRANSA, TRANSB, N, KK, ALPHA, A, LDA,
|
||||
$ B, LDB,
|
||||
$ BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, FATAL,
|
||||
$ NOUT, MV )
|
||||
IMPLICIT NONE
|
||||
*
|
||||
* Checks the results of the computational tests for GEMMTR.
|
||||
*
|
||||
* Auxiliary routine for test program for Level 3 Blas.
|
||||
*
|
||||
* -- Written on 24-June-2024.
|
||||
* Martin Koehler, Max Planck Institute, Magdeburg
|
||||
*
|
||||
* .. Parameters ..
|
||||
COMPLEX ZERO
|
||||
PARAMETER ( ZERO = ( 0.0, 0.0 ) )
|
||||
REAL RZERO, RONE
|
||||
PARAMETER ( RZERO = 0.0, RONE = 1.0 )
|
||||
* .. Scalar Arguments ..
|
||||
COMPLEX ALPHA, BETA
|
||||
REAL EPS, ERR
|
||||
INTEGER KK, LDA, LDB, LDC, LDCC, N, NOUT
|
||||
LOGICAL FATAL, MV
|
||||
CHARACTER*1 TRANSA, TRANSB, UPLO
|
||||
* .. Array Arguments ..
|
||||
COMPLEX A( LDA, * ), B( LDB, * ), C( LDC, * ),
|
||||
$ CC( LDCC, * ), CT( * )
|
||||
REAL G( * )
|
||||
* .. Local Scalars ..
|
||||
COMPLEX CL
|
||||
REAL ERRI
|
||||
INTEGER I, J, K, ISTART, ISTOP
|
||||
LOGICAL CTRANA, CTRANB, TRANA, TRANB, UPPER
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC ABS, AIMAG, CONJG, MAX, REAL, SQRT
|
||||
* .. Statement Functions ..
|
||||
REAL ABS1
|
||||
* .. Statement Function definitions ..
|
||||
ABS1( CL ) = ABS( REAL( CL ) ) + ABS( AIMAG( CL ) )
|
||||
* .. Executable Statements ..
|
||||
|
||||
UPPER = UPLO.EQ.'U'
|
||||
TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C'
|
||||
TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C'
|
||||
CTRANA = TRANSA.EQ.'C'
|
||||
CTRANB = TRANSB.EQ.'C'
|
||||
|
||||
ISTART = 1
|
||||
ISTOP = N
|
||||
*
|
||||
* Compute expected result, one column at a time, in CT using data
|
||||
* in A, B and C.
|
||||
* Compute gauges in G.
|
||||
*
|
||||
DO 220 J = 1, N
|
||||
*
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
DO 10 I = ISTART, ISTOP
|
||||
CT( I ) = ZERO
|
||||
G( I ) = RZERO
|
||||
10 CONTINUE
|
||||
IF( .NOT.TRANA.AND..NOT.TRANB )THEN
|
||||
DO 30 K = 1, KK
|
||||
DO 20 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( I, K )*B( K, J )
|
||||
G( I ) = G( I ) + ABS1( A( I, K ) )*ABS1( B( K, J ) )
|
||||
20 CONTINUE
|
||||
30 CONTINUE
|
||||
ELSE IF( TRANA.AND..NOT.TRANB )THEN
|
||||
IF( CTRANA )THEN
|
||||
DO 50 K = 1, KK
|
||||
DO 40 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + CONJG( A( K, I ) )*B( K, J )
|
||||
G( I ) = G( I ) + ABS1( A( K, I ) )*
|
||||
$ ABS1( B( K, J ) )
|
||||
40 CONTINUE
|
||||
50 CONTINUE
|
||||
ELSE
|
||||
DO 70 K = 1, KK
|
||||
DO 60 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( K, I )*B( K, J )
|
||||
G( I ) = G( I ) + ABS1( A( K, I ) )*
|
||||
$ ABS1( B( K, J ) )
|
||||
60 CONTINUE
|
||||
70 CONTINUE
|
||||
END IF
|
||||
ELSE IF( .NOT.TRANA.AND.TRANB )THEN
|
||||
IF( CTRANB )THEN
|
||||
DO 90 K = 1, KK
|
||||
DO 80 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( I, K )*CONJG( B( J, K ) )
|
||||
G( I ) = G( I ) + ABS1( A( I, K ) )*
|
||||
$ ABS1( B( J, K ) )
|
||||
80 CONTINUE
|
||||
90 CONTINUE
|
||||
ELSE
|
||||
DO 110 K = 1, KK
|
||||
DO 100 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( I, K )*B( J, K )
|
||||
G( I ) = G( I ) + ABS1( A( I, K ) )*
|
||||
$ ABS1( B( J, K ) )
|
||||
100 CONTINUE
|
||||
110 CONTINUE
|
||||
END IF
|
||||
ELSE IF( TRANA.AND.TRANB )THEN
|
||||
IF( CTRANA )THEN
|
||||
IF( CTRANB )THEN
|
||||
DO 130 K = 1, KK
|
||||
DO 120 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + CONJG( A( K, I ) )*
|
||||
$ CONJG( B( J, K ) )
|
||||
G( I ) = G( I ) + ABS1( A( K, I ) )*
|
||||
$ ABS1( B( J, K ) )
|
||||
120 CONTINUE
|
||||
130 CONTINUE
|
||||
ELSE
|
||||
DO 150 K = 1, KK
|
||||
DO 140 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + CONJG( A( K, I ) )*B( J, K )
|
||||
G( I ) = G( I ) + ABS1( A( K, I ) )*
|
||||
$ ABS1( B( J, K ) )
|
||||
140 CONTINUE
|
||||
150 CONTINUE
|
||||
END IF
|
||||
ELSE
|
||||
IF( CTRANB )THEN
|
||||
DO 170 K = 1, KK
|
||||
DO 160 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( K, I )*CONJG( B( J, K ) )
|
||||
G( I ) = G( I ) + ABS1( A( K, I ) )*
|
||||
$ ABS1( B( J, K ) )
|
||||
160 CONTINUE
|
||||
170 CONTINUE
|
||||
ELSE
|
||||
DO 190 K = 1, KK
|
||||
DO 180 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( K, I )*B( J, K )
|
||||
G( I ) = G( I ) + ABS1( A( K, I ) )*
|
||||
$ ABS1( B( J, K ) )
|
||||
180 CONTINUE
|
||||
190 CONTINUE
|
||||
END IF
|
||||
END IF
|
||||
END IF
|
||||
DO 200 I = ISTART, ISTOP
|
||||
CT( I ) = ALPHA*CT( I ) + BETA*C( I, J )
|
||||
G( I ) = ABS1( ALPHA )*G( I ) +
|
||||
$ ABS1( BETA )*ABS1( C( I, J ) )
|
||||
200 CONTINUE
|
||||
*
|
||||
* Compute the error ratio for this result.
|
||||
*
|
||||
ERR = ZERO
|
||||
DO 210 I = ISTART, ISTOP
|
||||
ERRI = ABS1( CT( I ) - CC( I, J ) )/EPS
|
||||
IF( G( I ).NE.RZERO )
|
||||
$ ERRI = ERRI/G( I )
|
||||
ERR = MAX( ERR, ERRI )
|
||||
IF( ERR*SQRT( EPS ).GE.RONE )
|
||||
$ GO TO 230
|
||||
210 CONTINUE
|
||||
*
|
||||
220 CONTINUE
|
||||
*
|
||||
* If the loop completes, all results are at least half accurate.
|
||||
GO TO 250
|
||||
*
|
||||
* Report fatal error.
|
||||
*
|
||||
230 FATAL = .TRUE.
|
||||
WRITE( NOUT, FMT = 9999 )
|
||||
DO 240 I = ISTART, ISTOP
|
||||
IF( MV )THEN
|
||||
WRITE( NOUT, FMT = 9998 )I, CT( I ), CC( I, J )
|
||||
ELSE
|
||||
WRITE( NOUT, FMT = 9998 )I, CC( I, J ), CT( I )
|
||||
END IF
|
||||
240 CONTINUE
|
||||
IF( N.GT.1 )
|
||||
$ WRITE( NOUT, FMT = 9997 )J
|
||||
*
|
||||
250 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
9999 FORMAT(' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
|
||||
$ 'F ACCURATE *******', /' EXPECTED RE',
|
||||
$ 'SULT COMPUTED RESULT' )
|
||||
9998 FORMAT( 1X, I7, 2( ' (', G15.6, ',', G15.6, ')' ) )
|
||||
9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 )
|
||||
*
|
||||
* End of CMMTCH.
|
||||
*
|
||||
END
|
||||
|
||||
|
||||
@@ -8,14 +8,10 @@ CBLAS_INT link_xerbla=TRUE;
|
||||
char *cblas_rout;
|
||||
|
||||
#ifdef F77_Char
|
||||
void F77_xerbla(F77_Char F77_srname, void *vinfo
|
||||
void F77_xerbla(F77_Char F77_srname, void *vinfo);
|
||||
#else
|
||||
void F77_xerbla(char *srname, void *vinfo
|
||||
void F77_xerbla(char *srname, void *vinfo);
|
||||
#endif
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN srname_len
|
||||
#endif
|
||||
);
|
||||
|
||||
void chkxer(void) {
|
||||
extern CBLAS_INT cblas_ok, cblas_lerr, cblas_info;
|
||||
@@ -28,11 +24,7 @@ void chkxer(void) {
|
||||
cblas_lerr = 1 ;
|
||||
}
|
||||
|
||||
void F77_d2chke(char *rout
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN rout_len
|
||||
#endif
|
||||
) {
|
||||
void F77_d2chke(char *rout) {
|
||||
char *sf = ( rout ) ;
|
||||
double A[2] = {0.0,0.0},
|
||||
X[2] = {0.0,0.0},
|
||||
@@ -46,7 +38,7 @@ void F77_d2chke(char *rout
|
||||
if (link_xerbla) /* call these first to link */
|
||||
{
|
||||
cblas_xerbla(cblas_info,cblas_rout,"");
|
||||
F77_xerbla(cblas_rout,&cblas_info, 1);
|
||||
F77_xerbla(cblas_rout,&cblas_info);
|
||||
}
|
||||
#endif
|
||||
|
||||
|
||||
+6
-244
@@ -8,14 +8,10 @@ CBLAS_INT link_xerbla=TRUE;
|
||||
char *cblas_rout;
|
||||
|
||||
#ifdef F77_Char
|
||||
void F77_xerbla(F77_Char F77_srname, void *vinfo
|
||||
void F77_xerbla(F77_Char F77_srname, void *vinfo);
|
||||
#else
|
||||
void F77_xerbla(char *srname, void *vinfo
|
||||
void F77_xerbla(char *srname, void *vinfo);
|
||||
#endif
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN srname_len
|
||||
#endif
|
||||
);
|
||||
|
||||
void chkxer(void) {
|
||||
extern CBLAS_INT cblas_ok, cblas_lerr, cblas_info;
|
||||
@@ -28,11 +24,7 @@ void chkxer(void) {
|
||||
cblas_lerr = 1 ;
|
||||
}
|
||||
|
||||
void F77_d3chke(char *rout
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN rout_len
|
||||
#endif
|
||||
) {
|
||||
void F77_d3chke(char *rout) {
|
||||
char *sf = ( rout ) ;
|
||||
double A[2] = {0.0,0.0},
|
||||
B[2] = {0.0,0.0},
|
||||
@@ -46,244 +38,14 @@ void F77_d3chke(char *rout
|
||||
if (link_xerbla) /* call these first to link */
|
||||
{
|
||||
cblas_xerbla(cblas_info,cblas_rout,"");
|
||||
F77_xerbla(cblas_rout,&cblas_info, 1);
|
||||
F77_xerbla(cblas_rout,&cblas_info);
|
||||
}
|
||||
#endif
|
||||
|
||||
cblas_ok = TRUE ;
|
||||
cblas_lerr = PASSED ;
|
||||
|
||||
if (strncmp( sf,"cblas_dgemmtr" ,13)==0) {
|
||||
cblas_rout = "cblas_dgemmtr" ;
|
||||
|
||||
cblas_info = 1;
|
||||
cblas_dgemmtr( INVALID, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 1;
|
||||
cblas_dgemmtr( INVALID, CblasUpper, CblasNoTrans, CblasTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 1;
|
||||
cblas_dgemmtr( INVALID, CblasUpper,CblasTrans, CblasNoTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 1;
|
||||
cblas_dgemmtr( INVALID, CblasUpper, CblasTrans, CblasTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 1;
|
||||
cblas_dgemmtr( INVALID, CblasLower, CblasNoTrans, CblasNoTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 1;
|
||||
cblas_dgemmtr( INVALID, CblasLower, CblasNoTrans, CblasTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 1;
|
||||
cblas_dgemmtr( INVALID, CblasLower,CblasTrans, CblasNoTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 1;
|
||||
cblas_dgemmtr( INVALID, CblasLower, CblasTrans, CblasTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 2; RowMajorStrg = FALSE;
|
||||
cblas_dgemmtr( CblasColMajor, INVALID, CblasNoTrans, CblasNoTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 2; RowMajorStrg = FALSE;
|
||||
cblas_dgemmtr( CblasColMajor, INVALID, CblasNoTrans, CblasTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 3; RowMajorStrg = FALSE;
|
||||
cblas_dgemmtr( CblasColMajor, CblasUpper, INVALID, CblasNoTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 3; RowMajorStrg = FALSE;
|
||||
cblas_dgemmtr( CblasColMajor, CblasUpper, INVALID, CblasTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 4; RowMajorStrg = FALSE;
|
||||
cblas_dgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, INVALID, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 4; RowMajorStrg = FALSE;
|
||||
cblas_dgemmtr( CblasColMajor, CblasUpper, CblasTrans, INVALID, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
|
||||
cblas_info = 5; RowMajorStrg = FALSE;
|
||||
cblas_dgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, INVALID, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 5; RowMajorStrg = FALSE;
|
||||
cblas_dgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, INVALID, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 5; RowMajorStrg = FALSE;
|
||||
cblas_dgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, INVALID, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 5; RowMajorStrg = FALSE;
|
||||
cblas_dgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, INVALID, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 6; RowMajorStrg = FALSE;
|
||||
cblas_dgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, INVALID,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 6; RowMajorStrg = FALSE;
|
||||
cblas_dgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, INVALID,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 6; RowMajorStrg = FALSE;
|
||||
cblas_dgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, INVALID,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 6; RowMajorStrg = FALSE;
|
||||
cblas_dgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 0, INVALID,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
|
||||
cblas_info = 9; RowMajorStrg = FALSE;
|
||||
cblas_dgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 2 );
|
||||
chkxer();
|
||||
cblas_info = 9; RowMajorStrg = FALSE;
|
||||
cblas_dgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 2 );
|
||||
chkxer();
|
||||
cblas_info = 9; RowMajorStrg = FALSE;
|
||||
cblas_dgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2,
|
||||
ALPHA, A, 1, B, 2, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 9; RowMajorStrg = FALSE;
|
||||
cblas_dgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 0, 2,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 11; RowMajorStrg = FALSE;
|
||||
cblas_dgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 11; RowMajorStrg = FALSE;
|
||||
cblas_dgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2,
|
||||
ALPHA, A, 2, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 11; RowMajorStrg = FALSE;
|
||||
cblas_dgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 14; RowMajorStrg = FALSE;
|
||||
cblas_dgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0,
|
||||
ALPHA, A, 2, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 14; RowMajorStrg = FALSE;
|
||||
cblas_dgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0,
|
||||
ALPHA, A, 2, B, 2, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 14; RowMajorStrg = FALSE;
|
||||
cblas_dgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0,
|
||||
ALPHA, A, 2, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 14; RowMajorStrg = FALSE;
|
||||
cblas_dgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0,
|
||||
ALPHA, A, 2, B, 2, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
/* Row Major */
|
||||
cblas_info = 5; RowMajorStrg = TRUE;
|
||||
cblas_dgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, INVALID, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 5; RowMajorStrg = TRUE;
|
||||
cblas_dgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, INVALID, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 5; RowMajorStrg = TRUE;
|
||||
cblas_dgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, INVALID, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 5; RowMajorStrg = TRUE;
|
||||
cblas_dgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, INVALID, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 6; RowMajorStrg = TRUE;
|
||||
cblas_dgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, INVALID,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 6; RowMajorStrg = TRUE;
|
||||
cblas_dgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, INVALID,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 6; RowMajorStrg = TRUE;
|
||||
cblas_dgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, INVALID,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 6; RowMajorStrg = TRUE;
|
||||
cblas_dgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 0, INVALID,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 9; RowMajorStrg = TRUE;
|
||||
cblas_dgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 2 );
|
||||
chkxer();
|
||||
cblas_info = 9; RowMajorStrg = TRUE;
|
||||
cblas_dgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, 2,
|
||||
ALPHA, A, 1, B, 2, BETA, C, 2 );
|
||||
chkxer();
|
||||
cblas_info = 9; RowMajorStrg = TRUE;
|
||||
cblas_dgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0,
|
||||
ALPHA, A, 1, B, 2, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 9; RowMajorStrg = TRUE;
|
||||
cblas_dgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 11; RowMajorStrg = TRUE;
|
||||
cblas_dgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 11; RowMajorStrg = TRUE;
|
||||
cblas_dgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2,
|
||||
ALPHA, A, 2, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 11; RowMajorStrg = TRUE;
|
||||
cblas_dgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 14; RowMajorStrg = TRUE;
|
||||
cblas_dgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0,
|
||||
ALPHA, A, 2, B, 2, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 14; RowMajorStrg = TRUE;
|
||||
cblas_dgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0,
|
||||
ALPHA, A, 2, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 14; RowMajorStrg = TRUE;
|
||||
cblas_dgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0,
|
||||
ALPHA, A, 2, B, 2, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 14; RowMajorStrg = TRUE;
|
||||
cblas_dgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0,
|
||||
ALPHA, A, 2, B, 2, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
} else if (strncmp( sf,"cblas_dgemm" ,11)==0) {
|
||||
if (strncmp( sf,"cblas_dgemm" ,11)==0) {
|
||||
cblas_rout = "cblas_dgemm" ;
|
||||
|
||||
cblas_info = 1;
|
||||
@@ -1505,7 +1267,7 @@ void F77_d3chke(char *rout
|
||||
chkxer();
|
||||
}
|
||||
if (cblas_ok == TRUE )
|
||||
printf(" %-13s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout);
|
||||
printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout);
|
||||
else
|
||||
printf("***** %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout);
|
||||
}
|
||||
|
||||
+15
-75
@@ -10,11 +10,7 @@
|
||||
|
||||
void F77_dgemv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, double *alpha,
|
||||
double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx, double *beta,
|
||||
double *y, CBLAS_INT *incy
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN transp_len
|
||||
#endif
|
||||
) {
|
||||
double *y, CBLAS_INT *incy ) {
|
||||
|
||||
double *A;
|
||||
CBLAS_INT i,j,LDA;
|
||||
@@ -65,11 +61,7 @@ void F77_dger(CBLAS_INT *layout, CBLAS_INT *m, CBLAS_INT *n, double *alpha, doub
|
||||
}
|
||||
|
||||
void F77_dtrmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
CBLAS_INT *n, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *n, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx) {
|
||||
double *A;
|
||||
CBLAS_INT i,j,LDA;
|
||||
CBLAS_TRANSPOSE trans;
|
||||
@@ -97,11 +89,7 @@ void F77_dtrmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
}
|
||||
|
||||
void F77_dtrsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
CBLAS_INT *n, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *n, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx ) {
|
||||
double *A;
|
||||
CBLAS_INT i,j,LDA;
|
||||
CBLAS_TRANSPOSE trans;
|
||||
@@ -126,11 +114,7 @@ void F77_dtrsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
}
|
||||
void F77_dsymv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, double *a,
|
||||
CBLAS_INT *lda, double *x, CBLAS_INT *incx, double *beta, double *y,
|
||||
CBLAS_INT *incy
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *incy) {
|
||||
double *A;
|
||||
CBLAS_INT i,j,LDA;
|
||||
CBLAS_UPLO uplo;
|
||||
@@ -153,11 +137,7 @@ void F77_dsymv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, doub
|
||||
}
|
||||
|
||||
void F77_dsyr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, double *x,
|
||||
CBLAS_INT *incx, double *a, CBLAS_INT *lda
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *incx, double *a, CBLAS_INT *lda) {
|
||||
double *A;
|
||||
CBLAS_INT i,j,LDA;
|
||||
CBLAS_UPLO uplo;
|
||||
@@ -181,11 +161,7 @@ void F77_dsyr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, doubl
|
||||
}
|
||||
|
||||
void F77_dsyr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, double *x,
|
||||
CBLAS_INT *incx, double *y, CBLAS_INT *incy, double *a, CBLAS_INT *lda
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *incx, double *y, CBLAS_INT *incy, double *a, CBLAS_INT *lda) {
|
||||
double *A;
|
||||
CBLAS_INT i,j,LDA;
|
||||
CBLAS_UPLO uplo;
|
||||
@@ -210,11 +186,7 @@ void F77_dsyr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, doub
|
||||
|
||||
void F77_dgbmv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, CBLAS_INT *kl, CBLAS_INT *ku,
|
||||
double *alpha, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx,
|
||||
double *beta, double *y, CBLAS_INT *incy
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN transp_len
|
||||
#endif
|
||||
) {
|
||||
double *beta, double *y, CBLAS_INT *incy ) {
|
||||
|
||||
double *A;
|
||||
CBLAS_INT i,irow,j,jcol,LDA;
|
||||
@@ -251,11 +223,7 @@ void F77_dgbmv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, CBLA
|
||||
}
|
||||
|
||||
void F77_dtbmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
CBLAS_INT *n, CBLAS_INT *k, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *n, CBLAS_INT *k, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx) {
|
||||
double *A;
|
||||
CBLAS_INT irow, jcol, i, j, LDA;
|
||||
CBLAS_TRANSPOSE trans;
|
||||
@@ -301,11 +269,7 @@ void F77_dtbmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
}
|
||||
|
||||
void F77_dtbsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
CBLAS_INT *n, CBLAS_INT *k, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *n, CBLAS_INT *k, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx) {
|
||||
double *A;
|
||||
CBLAS_INT irow, jcol, i, j, LDA;
|
||||
CBLAS_TRANSPOSE trans;
|
||||
@@ -352,11 +316,7 @@ void F77_dtbsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
|
||||
void F77_dsbmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_INT *k, double *alpha,
|
||||
double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx, double *beta,
|
||||
double *y, CBLAS_INT *incy
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
) {
|
||||
double *y, CBLAS_INT *incy) {
|
||||
double *A;
|
||||
CBLAS_INT i,j,irow,jcol,LDA;
|
||||
CBLAS_UPLO uplo;
|
||||
@@ -400,11 +360,7 @@ void F77_dsbmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_INT *k, doubl
|
||||
}
|
||||
|
||||
void F77_dspmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, double *ap,
|
||||
double *x, CBLAS_INT *incx, double *beta, double *y, CBLAS_INT *incy
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
) {
|
||||
double *x, CBLAS_INT *incx, double *beta, double *y, CBLAS_INT *incy) {
|
||||
double *A,*AP;
|
||||
CBLAS_INT i,j,k,LDA;
|
||||
CBLAS_UPLO uplo;
|
||||
@@ -442,11 +398,7 @@ void F77_dspmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, doub
|
||||
}
|
||||
|
||||
void F77_dtpmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
CBLAS_INT *n, double *ap, double *x, CBLAS_INT *incx
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *n, double *ap, double *x, CBLAS_INT *incx) {
|
||||
double *A, *AP;
|
||||
CBLAS_INT i, j, k, LDA;
|
||||
CBLAS_TRANSPOSE trans;
|
||||
@@ -486,11 +438,7 @@ void F77_dtpmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
}
|
||||
|
||||
void F77_dtpsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
CBLAS_INT *n, double *ap, double *x, CBLAS_INT *incx
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *n, double *ap, double *x, CBLAS_INT *incx) {
|
||||
double *A, *AP;
|
||||
CBLAS_INT i, j, k, LDA;
|
||||
CBLAS_TRANSPOSE trans;
|
||||
@@ -531,11 +479,7 @@ void F77_dtpsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
}
|
||||
|
||||
void F77_dspr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, double *x,
|
||||
CBLAS_INT *incx, double *ap
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
){
|
||||
CBLAS_INT *incx, double *ap ){
|
||||
double *A, *AP;
|
||||
CBLAS_INT i,j,k,LDA;
|
||||
CBLAS_UPLO uplo;
|
||||
@@ -587,11 +531,7 @@ void F77_dspr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, doubl
|
||||
}
|
||||
|
||||
void F77_dspr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, double *x,
|
||||
CBLAS_INT *incx, double *y, CBLAS_INT *incy, double *ap
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
){
|
||||
CBLAS_INT *incx, double *y, CBLAS_INT *incy, double *ap ){
|
||||
double *A, *AP;
|
||||
CBLAS_INT i,j,k,LDA;
|
||||
CBLAS_UPLO uplo;
|
||||
|
||||
+6
-109
@@ -13,11 +13,7 @@
|
||||
|
||||
void F77_dgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CBLAS_INT *n,
|
||||
CBLAS_INT *k, double *alpha, double *a, CBLAS_INT *lda, double *b, CBLAS_INT *ldb,
|
||||
double *beta, double *c, CBLAS_INT *ldc
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN transpa_len, FORTRAN_STRLEN transpb_len
|
||||
#endif
|
||||
) {
|
||||
double *beta, double *c, CBLAS_INT *ldc ) {
|
||||
|
||||
double *A, *B, *C;
|
||||
CBLAS_INT i,j,LDA, LDB, LDC;
|
||||
@@ -77,92 +73,9 @@ void F77_dgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CB
|
||||
cblas_dgemm( UNDEFINED, transa, transb, *m, *n, *k, *alpha, a, *lda,
|
||||
b, *ldb, *beta, c, *ldc );
|
||||
}
|
||||
|
||||
void F77_dgemmtr(CBLAS_INT *layout, char *uplop, char *transpa, char *transpb, CBLAS_INT *n,
|
||||
CBLAS_INT *k, double *alpha, double *a, CBLAS_INT *lda,
|
||||
double *b, CBLAS_INT *ldb, double *beta,
|
||||
double *c, CBLAS_INT *ldc ) {
|
||||
|
||||
double *A, *B, *C;
|
||||
CBLAS_INT i,j,LDA, LDB, LDC;
|
||||
CBLAS_TRANSPOSE transa, transb;
|
||||
CBLAS_UPLO uplo;
|
||||
|
||||
get_transpose_type(transpa, &transa);
|
||||
get_transpose_type(transpb, &transb);
|
||||
get_uplo_type(uplop, &uplo);
|
||||
|
||||
if (*layout == TEST_ROW_MJR) {
|
||||
if (transa == CblasNoTrans) {
|
||||
LDA = *k+1;
|
||||
A=(double*)malloc((*n)*LDA*sizeof(double));
|
||||
for( i=0; i<*n; i++ )
|
||||
for( j=0; j<*k; j++ ) {
|
||||
A[i*LDA+j]=a[j*(*lda)+i];
|
||||
}
|
||||
}
|
||||
else {
|
||||
LDA = *n+1;
|
||||
A=(double* )malloc(LDA*(*k)*sizeof(double));
|
||||
for( i=0; i<*k; i++ )
|
||||
for( j=0; j<*n; j++ ) {
|
||||
A[i*LDA+j]=a[j*(*lda)+i];
|
||||
}
|
||||
}
|
||||
|
||||
if (transb == CblasNoTrans) {
|
||||
LDB = *n+1;
|
||||
B=(double* )malloc((*k)*LDB*sizeof(double) );
|
||||
for( i=0; i<*k; i++ )
|
||||
for( j=0; j<*n; j++ ) {
|
||||
B[i*LDB+j]=b[j*(*ldb)+i];
|
||||
}
|
||||
}
|
||||
else {
|
||||
LDB = *k+1;
|
||||
B=(double* )malloc(LDB*(*n)*sizeof(double));
|
||||
for( i=0; i<*n; i++ )
|
||||
for( j=0; j<*k; j++ ) {
|
||||
B[i*LDB+j]=b[j*(*ldb)+i];
|
||||
}
|
||||
}
|
||||
|
||||
LDC = *n+1;
|
||||
C=(double* )malloc((*n)*LDC*sizeof(double));
|
||||
for( j=0; j<*n; j++ )
|
||||
for( i=0; i<*n; i++ ) {
|
||||
C[i*LDC+j]=c[j*(*ldc)+i];
|
||||
}
|
||||
cblas_dgemmtr( CblasRowMajor, uplo, transa, transb, *n, *k, *alpha, A, LDA,
|
||||
B, LDB, *beta, C, LDC );
|
||||
for( j=0; j<*n; j++ )
|
||||
for( i=0; i<*n; i++ ) {
|
||||
c[j*(*ldc)+i]=C[i*LDC+j];
|
||||
}
|
||||
free(A);
|
||||
free(B);
|
||||
free(C);
|
||||
}
|
||||
else if (*layout == TEST_COL_MJR){
|
||||
cblas_dgemmtr( CblasColMajor, uplo, transa, transb, *n, *k, *alpha, a, *lda,
|
||||
b, *ldb, *beta, c, *ldc );
|
||||
}
|
||||
else
|
||||
cblas_dgemmtr( UNDEFINED, uplo, transa, transb, *n, *k, *alpha, a, *lda,
|
||||
b, *ldb, *beta, c, *ldc );
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
void F77_dsymm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_INT *n,
|
||||
double *alpha, double *a, CBLAS_INT *lda, double *b, CBLAS_INT *ldb,
|
||||
double *beta, double *c, CBLAS_INT *ldc
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
) {
|
||||
double *beta, double *c, CBLAS_INT *ldc ) {
|
||||
|
||||
double *A, *B, *C;
|
||||
CBLAS_INT i,j,LDA, LDB, LDC;
|
||||
@@ -216,11 +129,7 @@ void F77_dsymm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_I
|
||||
|
||||
void F77_dsyrk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k,
|
||||
double *alpha, double *a, CBLAS_INT *lda,
|
||||
double *beta, double *c, CBLAS_INT *ldc
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len
|
||||
#endif
|
||||
) {
|
||||
double *beta, double *c, CBLAS_INT *ldc ) {
|
||||
|
||||
CBLAS_INT i,j,LDA,LDC;
|
||||
double *A, *C;
|
||||
@@ -268,11 +177,7 @@ void F77_dsyrk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS
|
||||
|
||||
void F77_dsyr2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k,
|
||||
double *alpha, double *a, CBLAS_INT *lda, double *b, CBLAS_INT *ldb,
|
||||
double *beta, double *c, CBLAS_INT *ldc
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len
|
||||
#endif
|
||||
) {
|
||||
double *beta, double *c, CBLAS_INT *ldc ) {
|
||||
CBLAS_INT i,j,LDA,LDB,LDC;
|
||||
double *A, *B, *C;
|
||||
CBLAS_UPLO uplo;
|
||||
@@ -327,11 +232,7 @@ void F77_dsyr2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLA
|
||||
}
|
||||
void F77_dtrmm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *diagn,
|
||||
CBLAS_INT *m, CBLAS_INT *n, double *alpha, double *a, CBLAS_INT *lda, double *b,
|
||||
CBLAS_INT *ldb
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diag_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *ldb) {
|
||||
CBLAS_INT i,j,LDA,LDB;
|
||||
double *A, *B;
|
||||
CBLAS_SIDE side;
|
||||
@@ -382,11 +283,7 @@ void F77_dtrmm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *d
|
||||
|
||||
void F77_dtrsm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *diagn,
|
||||
CBLAS_INT *m, CBLAS_INT *n, double *alpha, double *a, CBLAS_INT *lda, double *b,
|
||||
CBLAS_INT *ldb
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *ldb) {
|
||||
CBLAS_INT i,j,LDA,LDB;
|
||||
double *A, *B;
|
||||
CBLAS_SIDE side;
|
||||
|
||||
+72
-559
@@ -4,7 +4,7 @@
|
||||
*
|
||||
* The program must be driven by a short data file. The first 13 records
|
||||
* of the file are read using list-directed input, the last 6 records
|
||||
* are read using the format ( A13, L2 ). An annotated example of a data
|
||||
* are read using the format ( A12, L2 ). An annotated example of a data
|
||||
* file can be obtained by deleting the first 3 characters from the
|
||||
* following 19 lines:
|
||||
* 'DBLAT3.SNAP' NAME OF SNAPSHOT OUTPUT FILE
|
||||
@@ -20,13 +20,12 @@
|
||||
* 0.0 1.0 0.7 VALUES OF ALPHA
|
||||
* 3 NUMBER OF VALUES OF BETA
|
||||
* 0.0 1.0 1.3 VALUES OF BETA
|
||||
* cblas_dgemm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_dsymm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_dtrmm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_dtrsm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_dsyrk T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_dsyr2k T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_dgemmtr T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_dgemm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_dsymm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_dtrmm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_dtrsm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_dsyrk T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_dsyr2k T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
*
|
||||
* See:
|
||||
*
|
||||
@@ -47,7 +46,7 @@
|
||||
INTEGER NIN, NOUT
|
||||
PARAMETER ( NIN = 5, NOUT = 6 )
|
||||
INTEGER NSUBS
|
||||
PARAMETER ( NSUBS = 7 )
|
||||
PARAMETER ( NSUBS = 6 )
|
||||
DOUBLE PRECISION ZERO, HALF, ONE
|
||||
PARAMETER ( ZERO = 0.0D0, HALF = 0.5D0, ONE = 1.0D0 )
|
||||
INTEGER NMAX
|
||||
@@ -57,11 +56,11 @@
|
||||
* .. Local Scalars ..
|
||||
DOUBLE PRECISION EPS, ERR, THRESH
|
||||
INTEGER I, ISNUM, J, N, NALF, NBET, NIDIM, NTRA,
|
||||
$ LAYOUT
|
||||
$ LAYOUT
|
||||
LOGICAL FATAL, LTESTT, REWI, SAME, SFATAL, TRACE,
|
||||
$ TSTERR, CORDER, RORDER
|
||||
CHARACTER*1 TRANSA, TRANSB
|
||||
CHARACTER*13 SNAMET
|
||||
CHARACTER*12 SNAMET
|
||||
CHARACTER*32 SNAPS
|
||||
* .. Local Arrays ..
|
||||
DOUBLE PRECISION AA( NMAX*NMAX ), AB( NMAX, 2*NMAX ),
|
||||
@@ -72,27 +71,27 @@
|
||||
$ G( NMAX ), W( 2*NMAX )
|
||||
INTEGER IDIM( NIDMAX )
|
||||
LOGICAL LTEST( NSUBS )
|
||||
CHARACTER*13 SNAMES( NSUBS )
|
||||
CHARACTER*12 SNAMES( NSUBS )
|
||||
* .. External Functions ..
|
||||
DOUBLE PRECISION DDIFF
|
||||
LOGICAL LDE
|
||||
EXTERNAL DDIFF, LDE
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL DCHK1, DCHK2, DCHK3, DCHK4, DCHK5, CD3CHKE,
|
||||
$ DMMCH
|
||||
$ DMMCH
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC MAX, MIN
|
||||
* .. Scalars in Common ..
|
||||
INTEGER INFOT, NOUTC
|
||||
LOGICAL OK
|
||||
CHARACTER*13 SRNAMT
|
||||
CHARACTER*12 SRNAMT
|
||||
* .. Common blocks ..
|
||||
COMMON /INFOC/INFOT, NOUTC, OK
|
||||
COMMON /SRNAMC/SRNAMT
|
||||
* .. Data statements ..
|
||||
DATA SNAMES/'cblas_dgemm ', 'cblas_dsymm ',
|
||||
$ 'cblas_dtrmm ', 'cblas_dtrsm ','cblas_dsyrk ',
|
||||
$ 'cblas_dsyr2k', 'cblas_dgemmtr'/
|
||||
$ 'cblas_dsyr2k'/
|
||||
* .. Executable Statements ..
|
||||
*
|
||||
* Read name and unit number for summary output file and open file.
|
||||
@@ -290,7 +289,7 @@
|
||||
INFOT = 0
|
||||
OK = .TRUE.
|
||||
FATAL = .FALSE.
|
||||
GO TO ( 140, 150, 160, 160, 170, 180, 185 )ISNUM
|
||||
GO TO ( 140, 150, 160, 160, 170, 180 )ISNUM
|
||||
* Test DGEMM, 01.
|
||||
140 IF (CORDER) THEN
|
||||
CALL DCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
@@ -324,13 +323,13 @@
|
||||
CALL DCHK3( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NMAX, AB,
|
||||
$ AA, AS, AB( 1, NMAX + 1 ), BB, BS, CT, G, C,
|
||||
$ 0 )
|
||||
$ 0 )
|
||||
END IF
|
||||
IF (RORDER) THEN
|
||||
CALL DCHK3( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NMAX, AB,
|
||||
$ AA, AS, AB( 1, NMAX + 1 ), BB, BS, CT, G, C,
|
||||
$ 1 )
|
||||
$ 1 )
|
||||
END IF
|
||||
GO TO 190
|
||||
* Test DSYRK, 05.
|
||||
@@ -352,30 +351,15 @@
|
||||
CALL DCHK5( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
|
||||
$ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W,
|
||||
$ 0 )
|
||||
$ 0 )
|
||||
END IF
|
||||
IF (RORDER) THEN
|
||||
CALL DCHK5( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
|
||||
$ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W,
|
||||
$ 1 )
|
||||
$ 1 )
|
||||
END IF
|
||||
GO TO 190
|
||||
* Test DGEMMTR, 07.
|
||||
185 IF (CORDER) THEN
|
||||
CALL DCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
|
||||
$ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W,
|
||||
$ 0 )
|
||||
END IF
|
||||
IF (RORDER) THEN
|
||||
CALL DCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
|
||||
$ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W,
|
||||
$ 1 )
|
||||
END IF
|
||||
GO TO 190
|
||||
|
||||
*
|
||||
190 IF( FATAL.AND.SFATAL )
|
||||
$ GO TO 210
|
||||
@@ -413,7 +397,7 @@
|
||||
9992 FORMAT( ' FOR BETA ', 7F6.1 )
|
||||
9991 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM',
|
||||
$ /' ******* TESTS ABANDONED *******' )
|
||||
9990 FORMAT( ' SUBPROGRAM NAME ', A13,' NOT RECOGNIZED', /' ******* T',
|
||||
9990 FORMAT( ' SUBPROGRAM NAME ', A12,' NOT RECOGNIZED', /' ******* T',
|
||||
$ 'ESTS ABANDONED *******' )
|
||||
9989 FORMAT( ' ERROR IN DMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALU',
|
||||
$ 'ATED WRONGLY.', /' DMMCH WAS CALLED WITH TRANSA = ', A1,
|
||||
@@ -421,8 +405,8 @@
|
||||
$ 'ERR = ', F12.3, '.', /' THIS MAY BE DUE TO FAULTS IN THE ',
|
||||
$ 'ARITHMETIC OR THE COMPILER.', /' ******* TESTS ABANDONED ',
|
||||
$ '*******' )
|
||||
9988 FORMAT( A13,L2 )
|
||||
9987 FORMAT( 1X, A13,' WAS NOT TESTED' )
|
||||
9988 FORMAT( A12,L2 )
|
||||
9987 FORMAT( 1X, A12,' WAS NOT TESTED' )
|
||||
9986 FORMAT( /' END OF TESTS' )
|
||||
9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' )
|
||||
9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' )
|
||||
@@ -451,7 +435,7 @@
|
||||
DOUBLE PRECISION EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
* .. Array Arguments ..
|
||||
DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
@@ -604,7 +588,7 @@
|
||||
$ REWIND NTRA
|
||||
CALL CDGEMM( IORDER, TRANSA, TRANSB, M, N,
|
||||
$ K, ALPHA, AA, LDA, BB, LDB,
|
||||
$ BETA, CC, LDC )
|
||||
$ BETA, CC, LDC )
|
||||
*
|
||||
* Check if error-exit was taken incorrectly.
|
||||
*
|
||||
@@ -697,20 +681,20 @@
|
||||
130 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(''', A1, ''',''', A1, ''',',
|
||||
9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( 1X, I6, ': ', A12,'(''', A1, ''',''', A1, ''',',
|
||||
$ 3( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', ',
|
||||
$ 'C,', I3, ').' )
|
||||
9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
@@ -724,7 +708,7 @@
|
||||
INTEGER NOUT, NC, IORDER, M, N, K, LDA, LDB, LDC
|
||||
DOUBLE PRECISION ALPHA, BETA
|
||||
CHARACTER*1 TRANSA, TRANSB
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
CHARACTER*14 CRC, CTA,CTB
|
||||
|
||||
IF (TRANSA.EQ.'N')THEN
|
||||
@@ -749,7 +733,7 @@
|
||||
WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CTA,CTB
|
||||
WRITE(NOUT, FMT = 9994)M, N, K, ALPHA, LDA, LDB, BETA, LDC
|
||||
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',')
|
||||
9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',')
|
||||
9994 FORMAT( 20X, 3( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',',
|
||||
$ F4.1, ', ', 'C,', I3, ').' )
|
||||
END
|
||||
@@ -775,7 +759,7 @@
|
||||
DOUBLE PRECISION EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
* .. Array Arguments ..
|
||||
DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
@@ -1010,20 +994,20 @@
|
||||
120 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( 1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
$ F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', C,', I3, ') ',
|
||||
$ ' .' )
|
||||
9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
@@ -1038,7 +1022,7 @@
|
||||
INTEGER NOUT, NC, IORDER, M, N, LDA, LDB, LDC
|
||||
DOUBLE PRECISION ALPHA, BETA
|
||||
CHARACTER*1 SIDE, UPLO
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
CHARACTER*14 CRC, CS,CU
|
||||
|
||||
IF (SIDE.EQ.'L')THEN
|
||||
@@ -1059,7 +1043,7 @@
|
||||
WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CS,CU
|
||||
WRITE(NOUT, FMT = 9994)M, N, ALPHA, LDA, LDB, BETA, LDC
|
||||
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',')
|
||||
9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',')
|
||||
9994 FORMAT( 20X, 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',',
|
||||
$ F4.1, ', ', 'C,', I3, ').' )
|
||||
END
|
||||
@@ -1085,7 +1069,7 @@
|
||||
DOUBLE PRECISION EPS, THRESH
|
||||
INTEGER NALF, NIDIM, NMAX, NOUT, NTRA, IORDER
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
* .. Array Arguments ..
|
||||
DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
@@ -1217,7 +1201,7 @@
|
||||
$ REWIND NTRA
|
||||
CALL CDTRMM( IORDER, SIDE, UPLO, TRANSA,
|
||||
$ DIAG, M, N, ALPHA, AA, LDA,
|
||||
$ BB, LDB )
|
||||
$ BB, LDB )
|
||||
ELSE IF( SNAME( 10: 11 ).EQ.'sm' )THEN
|
||||
IF( TRACE )
|
||||
$ CALL DPRCN3( NTRA, NC, SNAME, IORDER,
|
||||
@@ -1227,7 +1211,7 @@
|
||||
$ REWIND NTRA
|
||||
CALL CDTRSM( IORDER, SIDE, UPLO, TRANSA,
|
||||
$ DIAG, M, N, ALPHA, AA, LDA,
|
||||
$ BB, LDB )
|
||||
$ BB, LDB )
|
||||
END IF
|
||||
*
|
||||
* Check if error-exit was taken incorrectly.
|
||||
@@ -1358,20 +1342,20 @@
|
||||
160 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(', 4( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( 1X, I6, ': ', A12,'(', 4( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
$ F4.1, ', A,', I3, ', B,', I3, ') .' )
|
||||
9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
$ '******' )
|
||||
@@ -1385,7 +1369,7 @@
|
||||
INTEGER NOUT, NC, IORDER, M, N, LDA, LDB
|
||||
DOUBLE PRECISION ALPHA
|
||||
CHARACTER*1 SIDE, UPLO, TRANSA, DIAG
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
CHARACTER*14 CRC, CS, CU, CA, CD
|
||||
|
||||
IF (SIDE.EQ.'L')THEN
|
||||
@@ -1418,7 +1402,7 @@
|
||||
WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CS,CU
|
||||
WRITE(NOUT, FMT = 9994)CA, CD, M, N, ALPHA, LDA, LDB
|
||||
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',')
|
||||
9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',')
|
||||
9994 FORMAT( 22X, 2( A14, ',') , 2( I3, ',' ),
|
||||
$ F4.1, ', A,', I3, ', B,', I3, ').' )
|
||||
END
|
||||
@@ -1444,7 +1428,7 @@
|
||||
DOUBLE PRECISION EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
* .. Array Arguments ..
|
||||
DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
@@ -1683,21 +1667,21 @@
|
||||
130 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' )
|
||||
9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 )
|
||||
9994 FORMAT( 1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
9994 FORMAT( 1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
$ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ') .' )
|
||||
9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
$ '******' )
|
||||
@@ -1711,7 +1695,7 @@
|
||||
INTEGER NOUT, NC, IORDER, N, K, LDA, LDC
|
||||
DOUBLE PRECISION ALPHA, BETA
|
||||
CHARACTER*1 UPLO, TRANSA
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
CHARACTER*14 CRC, CU, CA
|
||||
|
||||
IF (UPLO.EQ.'U')THEN
|
||||
@@ -1734,7 +1718,7 @@
|
||||
WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA
|
||||
WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, BETA, LDC
|
||||
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') )
|
||||
9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') )
|
||||
9994 FORMAT( 20X, 2( I3, ',' ),
|
||||
$ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ').' )
|
||||
END
|
||||
@@ -1742,7 +1726,7 @@
|
||||
SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
|
||||
$ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
|
||||
$ AB, AA, AS, BB, BS, C, CC, CS, CT, G, W,
|
||||
$ IORDER )
|
||||
$ IORDER )
|
||||
*
|
||||
* Tests DSYR2K.
|
||||
*
|
||||
@@ -1761,7 +1745,7 @@
|
||||
DOUBLE PRECISION EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
* .. Array Arguments ..
|
||||
DOUBLE PRECISION AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ),
|
||||
$ ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ),
|
||||
@@ -1904,7 +1888,7 @@
|
||||
$ REWIND NTRA
|
||||
CALL CDSYR2K( IORDER, UPLO, TRANS, N, K,
|
||||
$ ALPHA, AA, LDA, BB, LDB, BETA,
|
||||
$ CC, LDC )
|
||||
$ CC, LDC )
|
||||
*
|
||||
* Check if error-exit was taken incorrectly.
|
||||
*
|
||||
@@ -2039,21 +2023,21 @@
|
||||
160 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' )
|
||||
9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 )
|
||||
9994 FORMAT( 1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
9994 FORMAT( 1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
$ F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', C,', I3, ') ',
|
||||
$ ' .' )
|
||||
9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
@@ -2068,7 +2052,7 @@
|
||||
INTEGER NOUT, NC, IORDER, N, K, LDA, LDB, LDC
|
||||
DOUBLE PRECISION ALPHA, BETA
|
||||
CHARACTER*1 UPLO, TRANSA
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
CHARACTER*14 CRC, CU, CA
|
||||
|
||||
IF (UPLO.EQ.'U')THEN
|
||||
@@ -2091,7 +2075,7 @@
|
||||
WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA
|
||||
WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, LDB, BETA, LDC
|
||||
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') )
|
||||
9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') )
|
||||
9994 FORMAT( 20X, 2( I3, ',' ),
|
||||
$ F4.1, ', A,', I3, ', B', I3, ',', F4.1, ', C,', I3, ').' )
|
||||
END
|
||||
@@ -2490,474 +2474,3 @@
|
||||
* End of DDIFF.
|
||||
*
|
||||
END
|
||||
|
||||
SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
|
||||
$ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
|
||||
$ A, AA, AS, B, BB, BS, C, CC, CS, CT, G,
|
||||
$ IORDER)
|
||||
*
|
||||
* Tests DGEMMTR.
|
||||
*
|
||||
* Auxiliary routine for test program for Level 3 Blas.
|
||||
*
|
||||
* -- Written on 19-July-2023.
|
||||
* Martin Koehler, MPI Magdeburg
|
||||
*
|
||||
* .. Parameters ..
|
||||
DOUBLE PRECISION ZERO
|
||||
PARAMETER ( ZERO = 0.0D0 )
|
||||
* .. Scalar Arguments ..
|
||||
DOUBLE PRECISION EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*13 SNAME
|
||||
* .. Array Arguments ..
|
||||
DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
$ BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
|
||||
$ C( NMAX, NMAX ), CC( NMAX*NMAX ),
|
||||
$ CS( NMAX*NMAX ), CT( NMAX ), G( NMAX )
|
||||
INTEGER IDIM( NIDIM )
|
||||
* .. Local Scalars ..
|
||||
DOUBLE PRECISION ALPHA, ALS, BETA, BLS, ERR, ERRMAX
|
||||
INTEGER I, IA, IB, ICA, ICB, IK, IN, K, KS, LAA,
|
||||
$ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS,
|
||||
$ MA, MB, N, NA, NARGS, NB, NC, NS, IS
|
||||
LOGICAL NULL, RESET, SAME, TRANA, TRANB
|
||||
CHARACTER*1 TRANAS, TRANBS, TRANSA, TRANSB, UPLO, UPLOS
|
||||
CHARACTER*3 ICH
|
||||
CHARACTER*2 ISHAPE
|
||||
* .. Local Arrays ..
|
||||
LOGICAL ISAME( 13 )
|
||||
* .. External Functions ..
|
||||
LOGICAL LDE, LDERES
|
||||
EXTERNAL LDE, LDERES
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL CDGEMMTR, DMAKE, DMMTCH
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC MAX
|
||||
* .. Scalars in Common ..
|
||||
INTEGER INFOT, NOUTC
|
||||
LOGICAL LERR, OK
|
||||
* .. Common blocks ..
|
||||
COMMON /INFOC/INFOT, NOUTC, OK, LERR
|
||||
* .. Data statements ..
|
||||
DATA ICH/'NTC'/
|
||||
DATA ISHAPE/'UL'/
|
||||
* .. Executable Statements ..
|
||||
*
|
||||
NARGS = 13
|
||||
NC = 0
|
||||
RESET = .TRUE.
|
||||
ERRMAX = ZERO
|
||||
*
|
||||
DO 100 IN = 1, NIDIM
|
||||
N = IDIM( IN )
|
||||
* Set LDC to 1 more than minimum value if room.
|
||||
LDC = N
|
||||
IF( LDC.LT.NMAX )
|
||||
$ LDC = LDC + 1
|
||||
* Skip tests if not enough room.
|
||||
IF( LDC.GT.NMAX )
|
||||
$ GO TO 100
|
||||
LCC = LDC*N
|
||||
NULL = N.LE.0
|
||||
*
|
||||
DO 90 IK = 1, NIDIM
|
||||
K = IDIM( IK )
|
||||
*
|
||||
DO 80 ICA = 1, 3
|
||||
TRANSA = ICH( ICA: ICA )
|
||||
TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C'
|
||||
*
|
||||
IF( TRANA )THEN
|
||||
MA = K
|
||||
NA = N
|
||||
ELSE
|
||||
MA = N
|
||||
NA = K
|
||||
END IF
|
||||
* Set LDA to 1 more than minimum value if room.
|
||||
LDA = MA
|
||||
IF( LDA.LT.NMAX )
|
||||
$ LDA = LDA + 1
|
||||
* Skip tests if not enough room.
|
||||
IF( LDA.GT.NMAX )
|
||||
$ GO TO 80
|
||||
LAA = LDA*NA
|
||||
*
|
||||
* Generate the matrix A.
|
||||
*
|
||||
CALL DMAKE( 'GE', ' ', ' ', MA, NA, A, NMAX, AA, LDA,
|
||||
$ RESET, ZERO )
|
||||
*
|
||||
DO 70 ICB = 1, 3
|
||||
TRANSB = ICH( ICB: ICB )
|
||||
TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C'
|
||||
*
|
||||
IF( TRANB )THEN
|
||||
MB = N
|
||||
NB = K
|
||||
ELSE
|
||||
MB = K
|
||||
NB = N
|
||||
END IF
|
||||
* Set LDB to 1 more than minimum value if room.
|
||||
LDB = MB
|
||||
IF( LDB.LT.NMAX )
|
||||
$ LDB = LDB + 1
|
||||
* Skip tests if not enough room.
|
||||
IF( LDB.GT.NMAX )
|
||||
$ GO TO 70
|
||||
LBB = LDB*NB
|
||||
*
|
||||
* Generate the matrix B.
|
||||
*
|
||||
CALL DMAKE( 'GE', ' ', ' ', MB, NB, B, NMAX, BB,
|
||||
$ LDB, RESET, ZERO )
|
||||
*
|
||||
DO 60 IA = 1, NALF
|
||||
ALPHA = ALF( IA )
|
||||
*
|
||||
DO 50 IB = 1, NBET
|
||||
BETA = BET( IB )
|
||||
|
||||
DO 45 IS = 1, 2
|
||||
UPLO = ISHAPE( IS: IS )
|
||||
|
||||
*
|
||||
* Generate the matrix C.
|
||||
*
|
||||
CALL DMAKE( 'GE', UPLO, ' ', N, N, C,
|
||||
$ NMAX, CC, LDC, RESET, ZERO )
|
||||
*
|
||||
NC = NC + 1
|
||||
*
|
||||
* Save every datum before calling the
|
||||
* subroutine.
|
||||
*
|
||||
UPLOS = UPLO
|
||||
TRANAS = TRANSA
|
||||
TRANBS = TRANSB
|
||||
NS = N
|
||||
KS = K
|
||||
ALS = ALPHA
|
||||
DO 10 I = 1, LAA
|
||||
AS( I ) = AA( I )
|
||||
10 CONTINUE
|
||||
LDAS = LDA
|
||||
DO 20 I = 1, LBB
|
||||
BS( I ) = BB( I )
|
||||
20 CONTINUE
|
||||
LDBS = LDB
|
||||
BLS = BETA
|
||||
DO 30 I = 1, LCC
|
||||
CS( I ) = CC( I )
|
||||
30 CONTINUE
|
||||
LDCS = LDC
|
||||
*
|
||||
* Call the subroutine.
|
||||
*
|
||||
IF( TRACE )
|
||||
$ CALL DPRCN8(NTRA, NC, SNAME, IORDER, UPLO,
|
||||
$ TRANSA, TRANSB, N, K, ALPHA, LDA,
|
||||
$ LDB, BETA, LDC)
|
||||
IF( REWI )
|
||||
$ REWIND NTRA
|
||||
CALL CDGEMMTR( IORDER, UPLO, TRANSA, TRANSB,
|
||||
$ N, K, ALPHA, AA, LDA, BB, LDB,
|
||||
$ BETA, CC, LDC )
|
||||
*
|
||||
* Check if error-exit was taken incorrectly.
|
||||
*
|
||||
IF( .NOT.OK )THEN
|
||||
WRITE( NOUT, FMT = 9994 )
|
||||
FATAL = .TRUE.
|
||||
GO TO 120
|
||||
END IF
|
||||
*
|
||||
* See what data changed inside subroutines.
|
||||
*
|
||||
ISAME( 1 ) = UPLO.EQ.UPLOS
|
||||
ISAME( 2 ) = TRANSA.EQ.TRANAS
|
||||
ISAME( 3 ) = TRANSB.EQ.TRANBS
|
||||
ISAME( 4 ) = NS.EQ.N
|
||||
ISAME( 5 ) = KS.EQ.K
|
||||
ISAME( 6 ) = ALS.EQ.ALPHA
|
||||
ISAME( 7 ) = LDE( AS, AA, LAA )
|
||||
ISAME( 8 ) = LDAS.EQ.LDA
|
||||
ISAME( 9 ) = LDE( BS, BB, LBB )
|
||||
ISAME( 10 ) = LDBS.EQ.LDB
|
||||
ISAME( 11 ) = BLS.EQ.BETA
|
||||
IF( NULL )THEN
|
||||
ISAME( 12 ) = LDE( CS, CC, LCC )
|
||||
ELSE
|
||||
ISAME( 12 ) = LDERES( 'GE', ' ', N, N,
|
||||
$ CS, CC, LDC )
|
||||
END IF
|
||||
ISAME( 13 ) = LDCS.EQ.LDC
|
||||
*
|
||||
* If data was incorrectly changed, report
|
||||
* and return.
|
||||
*
|
||||
SAME = .TRUE.
|
||||
DO 40 I = 1, NARGS
|
||||
SAME = SAME.AND.ISAME( I )
|
||||
IF( .NOT.ISAME( I ) )
|
||||
$ WRITE( NOUT, FMT = 9998 )I
|
||||
40 CONTINUE
|
||||
IF( .NOT.SAME )THEN
|
||||
FATAL = .TRUE.
|
||||
GO TO 120
|
||||
END IF
|
||||
*
|
||||
IF( .NOT.NULL )THEN
|
||||
*
|
||||
* Check the result.
|
||||
*
|
||||
CALL DMMTCH( UPLO, TRANSA, TRANSB,
|
||||
$ N, K,
|
||||
$ ALPHA, A, NMAX, B, NMAX, BETA,
|
||||
$ C, NMAX, CT, G, CC, LDC, EPS,
|
||||
$ ERR, FATAL, NOUT, .TRUE. )
|
||||
ERRMAX = MAX( ERRMAX, ERR )
|
||||
* If got really bad answer, report and
|
||||
* return.
|
||||
IF( FATAL )
|
||||
$ GO TO 120
|
||||
END IF
|
||||
*
|
||||
45 CONTINUE
|
||||
*
|
||||
50 CONTINUE
|
||||
*
|
||||
60 CONTINUE
|
||||
*
|
||||
70 CONTINUE
|
||||
*
|
||||
80 CONTINUE
|
||||
*
|
||||
90 CONTINUE
|
||||
*
|
||||
100 CONTINUE
|
||||
*
|
||||
*
|
||||
* Report result.
|
||||
*
|
||||
IF( ERRMAX.LT.THRESH )THEN
|
||||
IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10000 )SNAME, NC
|
||||
IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10001 )SNAME, NC
|
||||
ELSE
|
||||
IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10002 )SNAME, NC, ERRMAX
|
||||
IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10003 )SNAME, NC, ERRMAX
|
||||
END IF
|
||||
GO TO 130
|
||||
*
|
||||
120 CONTINUE
|
||||
WRITE( NOUT, FMT = 9996 )SNAME
|
||||
CALL DPRCN8(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, TRANSB,
|
||||
$ N, K, ALPHA, LDA, LDB, BETA, LDC)
|
||||
*
|
||||
130 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9997 FORMAT( ' ', A13, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
|
||||
$ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
|
||||
$ ' - SUSPECT *******' )
|
||||
9996 FORMAT( ' ******* ', A13, ' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( 1X, I6, ': ', A13, '(''',A1, ''',''',A1, ''',''', A1,''',',
|
||||
$ 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', ',
|
||||
$ 'C,', I3, ').' )
|
||||
9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
$ '******' )
|
||||
*
|
||||
* End of DCHK6
|
||||
*
|
||||
END
|
||||
|
||||
SUBROUTINE DPRCN8(NOUT, NC, SNAME, IORDER, UPLO,
|
||||
$ TRANSA, TRANSB, N,
|
||||
$ K, ALPHA, LDA, LDB, BETA, LDC)
|
||||
INTEGER NOUT, NC, IORDER, N, K, LDA, LDB, LDC
|
||||
DOUBLE PRECISION ALPHA, BETA
|
||||
CHARACTER*1 TRANSA, TRANSB, UPLO
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*14 CRC, CTA,CTB,CUPLO
|
||||
|
||||
IF (UPLO.EQ.'U') THEN
|
||||
CUPLO = 'CblasUpper'
|
||||
ELSE
|
||||
CUPLO = 'CblasLower'
|
||||
END IF
|
||||
IF (TRANSA.EQ.'N')THEN
|
||||
CTA = ' CblasNoTrans'
|
||||
ELSE IF (TRANSA.EQ.'T')THEN
|
||||
CTA = ' CblasTrans'
|
||||
ELSE
|
||||
CTA = 'CblasConjTrans'
|
||||
END IF
|
||||
IF (TRANSB.EQ.'N')THEN
|
||||
CTB = ' CblasNoTrans'
|
||||
ELSE IF (TRANSB.EQ.'T')THEN
|
||||
CTB = ' CblasTrans'
|
||||
ELSE
|
||||
CTB = 'CblasConjTrans'
|
||||
END IF
|
||||
IF (IORDER.EQ.1)THEN
|
||||
CRC = ' CblasRowMajor'
|
||||
ELSE
|
||||
CRC = ' CblasColMajor'
|
||||
END IF
|
||||
WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CUPLO, CTA,CTB
|
||||
WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, LDB, BETA, LDC
|
||||
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',',
|
||||
$ A14, ',')
|
||||
9994 FORMAT( 10X, 2( I3, ',' ) ,' ', F4.1,' , A,',
|
||||
$ I3, ', B,', I3, ', ', F4.1,' , C,', I3, ').' )
|
||||
END
|
||||
|
||||
SUBROUTINE DMMTCH( UPLO, TRANSA, TRANSB, N, KK, ALPHA, A, LDA,
|
||||
$ B, LDB, BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR,
|
||||
$ FATAL, NOUT, MV )
|
||||
*
|
||||
* Checks the results of the computational tests.
|
||||
*
|
||||
* Auxiliary routine for test program for Level 3 Blas. (DGEMMTR)
|
||||
*
|
||||
* -- Written on 19-July-2023.
|
||||
* Martin Koehler, MPI Magdeburg
|
||||
*
|
||||
* .. Parameters ..
|
||||
DOUBLE PRECISION ZERO, ONE
|
||||
PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
|
||||
* .. Scalar Arguments ..
|
||||
DOUBLE PRECISION ALPHA, BETA, EPS, ERR
|
||||
INTEGER KK, LDA, LDB, LDC, LDCC, N, NOUT
|
||||
LOGICAL FATAL, MV
|
||||
CHARACTER*1 UPLO, TRANSA, TRANSB
|
||||
* .. Array Arguments ..
|
||||
DOUBLE PRECISION A( LDA, * ), B( LDB, * ), C( LDC, * ),
|
||||
$ CC( LDCC, * ), CT( * ), G( * )
|
||||
* .. Local Scalars ..
|
||||
DOUBLE PRECISION ERRI
|
||||
INTEGER I, J, K, ISTART, ISTOP
|
||||
LOGICAL TRANA, TRANB, UPPER
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC ABS, MAX, SQRT
|
||||
* .. Executable Statements ..
|
||||
UPPER = UPLO.EQ.'U'
|
||||
TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C'
|
||||
TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C'
|
||||
*
|
||||
* Compute expected result, one column at a time, in CT using data
|
||||
* in A, B and C.
|
||||
* Compute gauges in G.
|
||||
*
|
||||
ISTART = 1
|
||||
ISTOP = N
|
||||
|
||||
DO 120 J = 1, N
|
||||
*
|
||||
IF ( UPPER ) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
DO 10 I = ISTART, ISTOP
|
||||
CT( I ) = ZERO
|
||||
G( I ) = ZERO
|
||||
10 CONTINUE
|
||||
IF( .NOT.TRANA.AND..NOT.TRANB )THEN
|
||||
DO 30 K = 1, KK
|
||||
DO 20 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( I, K )*B( K, J )
|
||||
G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( K, J ) )
|
||||
20 CONTINUE
|
||||
30 CONTINUE
|
||||
ELSE IF( TRANA.AND..NOT.TRANB )THEN
|
||||
DO 50 K = 1, KK
|
||||
DO 40 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( K, I )*B( K, J )
|
||||
G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( K, J ) )
|
||||
40 CONTINUE
|
||||
50 CONTINUE
|
||||
ELSE IF( .NOT.TRANA.AND.TRANB )THEN
|
||||
DO 70 K = 1, KK
|
||||
DO 60 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( I, K )*B( J, K )
|
||||
G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( J, K ) )
|
||||
60 CONTINUE
|
||||
70 CONTINUE
|
||||
ELSE IF( TRANA.AND.TRANB )THEN
|
||||
DO 90 K = 1, KK
|
||||
DO 80 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( K, I )*B( J, K )
|
||||
G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( J, K ) )
|
||||
80 CONTINUE
|
||||
90 CONTINUE
|
||||
END IF
|
||||
DO 100 I = ISTART, ISTOP
|
||||
CT( I ) = ALPHA*CT( I ) + BETA*C( I, J )
|
||||
G( I ) = ABS( ALPHA )*G( I ) + ABS( BETA )*ABS( C( I, J ) )
|
||||
100 CONTINUE
|
||||
*
|
||||
* Compute the error ratio for this result.
|
||||
*
|
||||
ERR = ZERO
|
||||
DO 110 I = ISTART, ISTOP
|
||||
ERRI = ABS( CT( I ) - CC( I, J ) )/EPS
|
||||
IF( G( I ).NE.ZERO )
|
||||
$ ERRI = ERRI/G( I )
|
||||
ERR = MAX( ERR, ERRI )
|
||||
IF( ERR*SQRT( EPS ).GE.ONE )
|
||||
$ GO TO 130
|
||||
110 CONTINUE
|
||||
*
|
||||
120 CONTINUE
|
||||
*
|
||||
* If the loop completes, all results are at least half accurate.
|
||||
GO TO 150
|
||||
*
|
||||
* Report fatal error.
|
||||
*
|
||||
130 FATAL = .TRUE.
|
||||
WRITE( NOUT, FMT = 9999 )
|
||||
DO 140 I = ISTART, ISTOP
|
||||
IF( MV )THEN
|
||||
WRITE( NOUT, FMT = 9998 )I, CT( I ), CC( I, J )
|
||||
ELSE
|
||||
WRITE( NOUT, FMT = 9998 )I, CC( I, J ), CT( I )
|
||||
END IF
|
||||
140 CONTINUE
|
||||
IF( N.GT.1 )
|
||||
$ WRITE( NOUT, FMT = 9997 )J
|
||||
*
|
||||
150 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
|
||||
$ 'F ACCURATE *******', /' EXPECTED RESULT COMPU',
|
||||
$ 'TED RESULT' )
|
||||
9998 FORMAT( 1X, I7, 2G18.6 )
|
||||
9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 )
|
||||
*
|
||||
* End of DMMTCH
|
||||
*
|
||||
END
|
||||
|
||||
|
||||
|
||||
@@ -8,14 +8,10 @@ CBLAS_INT link_xerbla=TRUE;
|
||||
char *cblas_rout;
|
||||
|
||||
#ifdef F77_Char
|
||||
void F77_xerbla(F77_Char F77_srname, void *vinfo
|
||||
void F77_xerbla(F77_Char F77_srname, void *vinfo);
|
||||
#else
|
||||
void F77_xerbla(char *srname, void *vinfo
|
||||
void F77_xerbla(char *srname, void *vinfo);
|
||||
#endif
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN
|
||||
#endif
|
||||
);
|
||||
|
||||
void chkxer(void) {
|
||||
extern CBLAS_INT cblas_ok, cblas_lerr, cblas_info;
|
||||
@@ -28,11 +24,7 @@ void chkxer(void) {
|
||||
cblas_lerr = 1 ;
|
||||
}
|
||||
|
||||
void F77_s2chke(char *rout
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN rout_len
|
||||
#endif
|
||||
) {
|
||||
void F77_s2chke(char *rout) {
|
||||
char *sf = ( rout ) ;
|
||||
float A[2] = {0.0,0.0},
|
||||
X[2] = {0.0,0.0},
|
||||
@@ -46,7 +38,7 @@ void F77_s2chke(char *rout
|
||||
if (link_xerbla) /* call these first to link */
|
||||
{
|
||||
cblas_xerbla(cblas_info,cblas_rout,"");
|
||||
F77_xerbla(cblas_rout,&cblas_info, 1);
|
||||
F77_xerbla(cblas_rout,&cblas_info);
|
||||
}
|
||||
#endif
|
||||
|
||||
|
||||
+6
-244
@@ -8,14 +8,10 @@ CBLAS_INT link_xerbla=TRUE;
|
||||
char *cblas_rout;
|
||||
|
||||
#ifdef F77_Char
|
||||
void F77_xerbla(F77_Char F77_srname, void *vinfo
|
||||
void F77_xerbla(F77_Char F77_srname, void *vinfo);
|
||||
#else
|
||||
void F77_xerbla(char *srname, void *vinfo
|
||||
void F77_xerbla(char *srname, void *vinfo);
|
||||
#endif
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN srname_len
|
||||
#endif
|
||||
);
|
||||
|
||||
void chkxer(void) {
|
||||
extern CBLAS_INT cblas_ok, cblas_lerr, cblas_info;
|
||||
@@ -28,11 +24,7 @@ void chkxer(void) {
|
||||
cblas_lerr = 1 ;
|
||||
}
|
||||
|
||||
void F77_s3chke(char *rout
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN rout_len
|
||||
#endif
|
||||
) {
|
||||
void F77_s3chke(char *rout) {
|
||||
char *sf = ( rout ) ;
|
||||
float A[2] = {0.0,0.0},
|
||||
B[2] = {0.0,0.0},
|
||||
@@ -46,244 +38,14 @@ void F77_s3chke(char *rout
|
||||
if (link_xerbla) /* call these first to link */
|
||||
{
|
||||
cblas_xerbla(cblas_info,cblas_rout,"");
|
||||
F77_xerbla(cblas_rout,&cblas_info, 1);
|
||||
F77_xerbla(cblas_rout,&cblas_info);
|
||||
}
|
||||
#endif
|
||||
|
||||
cblas_ok = TRUE ;
|
||||
cblas_lerr = PASSED ;
|
||||
|
||||
if (strncmp( sf,"cblas_sgemmtr" ,13)==0) {
|
||||
cblas_rout = "cblas_sgemmtr" ;
|
||||
|
||||
cblas_info = 1;
|
||||
cblas_sgemmtr( INVALID, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 1;
|
||||
cblas_sgemmtr( INVALID, CblasUpper, CblasNoTrans, CblasTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 1;
|
||||
cblas_sgemmtr( INVALID, CblasUpper,CblasTrans, CblasNoTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 1;
|
||||
cblas_sgemmtr( INVALID, CblasUpper, CblasTrans, CblasTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 1;
|
||||
cblas_sgemmtr( INVALID, CblasLower, CblasNoTrans, CblasNoTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 1;
|
||||
cblas_sgemmtr( INVALID, CblasLower, CblasNoTrans, CblasTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 1;
|
||||
cblas_sgemmtr( INVALID, CblasLower,CblasTrans, CblasNoTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 1;
|
||||
cblas_sgemmtr( INVALID, CblasLower, CblasTrans, CblasTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 2; RowMajorStrg = FALSE;
|
||||
cblas_sgemmtr( CblasColMajor, INVALID, CblasNoTrans, CblasNoTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 2; RowMajorStrg = FALSE;
|
||||
cblas_sgemmtr( CblasColMajor, INVALID, CblasNoTrans, CblasTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 3; RowMajorStrg = FALSE;
|
||||
cblas_sgemmtr( CblasColMajor, CblasUpper, INVALID, CblasNoTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 3; RowMajorStrg = FALSE;
|
||||
cblas_sgemmtr( CblasColMajor, CblasUpper, INVALID, CblasTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 4; RowMajorStrg = FALSE;
|
||||
cblas_sgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, INVALID, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 4; RowMajorStrg = FALSE;
|
||||
cblas_sgemmtr( CblasColMajor, CblasUpper, CblasTrans, INVALID, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
|
||||
cblas_info = 5; RowMajorStrg = FALSE;
|
||||
cblas_sgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, INVALID, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 5; RowMajorStrg = FALSE;
|
||||
cblas_sgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, INVALID, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 5; RowMajorStrg = FALSE;
|
||||
cblas_sgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, INVALID, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 5; RowMajorStrg = FALSE;
|
||||
cblas_sgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, INVALID, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 6; RowMajorStrg = FALSE;
|
||||
cblas_sgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, INVALID,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 6; RowMajorStrg = FALSE;
|
||||
cblas_sgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, INVALID,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 6; RowMajorStrg = FALSE;
|
||||
cblas_sgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, INVALID,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 6; RowMajorStrg = FALSE;
|
||||
cblas_sgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 0, INVALID,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
|
||||
cblas_info = 9; RowMajorStrg = FALSE;
|
||||
cblas_sgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 2 );
|
||||
chkxer();
|
||||
cblas_info = 9; RowMajorStrg = FALSE;
|
||||
cblas_sgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 2 );
|
||||
chkxer();
|
||||
cblas_info = 9; RowMajorStrg = FALSE;
|
||||
cblas_sgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2,
|
||||
ALPHA, A, 1, B, 2, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 9; RowMajorStrg = FALSE;
|
||||
cblas_sgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 0, 2,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 11; RowMajorStrg = FALSE;
|
||||
cblas_sgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 11; RowMajorStrg = FALSE;
|
||||
cblas_sgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2,
|
||||
ALPHA, A, 2, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 11; RowMajorStrg = FALSE;
|
||||
cblas_sgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 14; RowMajorStrg = FALSE;
|
||||
cblas_sgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0,
|
||||
ALPHA, A, 2, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 14; RowMajorStrg = FALSE;
|
||||
cblas_sgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0,
|
||||
ALPHA, A, 2, B, 2, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 14; RowMajorStrg = FALSE;
|
||||
cblas_sgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0,
|
||||
ALPHA, A, 2, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 14; RowMajorStrg = FALSE;
|
||||
cblas_sgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0,
|
||||
ALPHA, A, 2, B, 2, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
/* Row Major */
|
||||
cblas_info = 5; RowMajorStrg = TRUE;
|
||||
cblas_sgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, INVALID, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 5; RowMajorStrg = TRUE;
|
||||
cblas_sgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, INVALID, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 5; RowMajorStrg = TRUE;
|
||||
cblas_sgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, INVALID, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 5; RowMajorStrg = TRUE;
|
||||
cblas_sgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, INVALID, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 6; RowMajorStrg = TRUE;
|
||||
cblas_sgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, INVALID,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 6; RowMajorStrg = TRUE;
|
||||
cblas_sgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, INVALID,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 6; RowMajorStrg = TRUE;
|
||||
cblas_sgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, INVALID,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 6; RowMajorStrg = TRUE;
|
||||
cblas_sgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 0, INVALID,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 9; RowMajorStrg = TRUE;
|
||||
cblas_sgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 2 );
|
||||
chkxer();
|
||||
cblas_info = 9; RowMajorStrg = TRUE;
|
||||
cblas_sgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, 2,
|
||||
ALPHA, A, 1, B, 2, BETA, C, 2 );
|
||||
chkxer();
|
||||
cblas_info = 9; RowMajorStrg = TRUE;
|
||||
cblas_sgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0,
|
||||
ALPHA, A, 1, B, 2, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 9; RowMajorStrg = TRUE;
|
||||
cblas_sgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 11; RowMajorStrg = TRUE;
|
||||
cblas_sgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 11; RowMajorStrg = TRUE;
|
||||
cblas_sgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2,
|
||||
ALPHA, A, 2, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 11; RowMajorStrg = TRUE;
|
||||
cblas_sgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 14; RowMajorStrg = TRUE;
|
||||
cblas_sgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0,
|
||||
ALPHA, A, 2, B, 2, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 14; RowMajorStrg = TRUE;
|
||||
cblas_sgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0,
|
||||
ALPHA, A, 2, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 14; RowMajorStrg = TRUE;
|
||||
cblas_sgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0,
|
||||
ALPHA, A, 2, B, 2, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 14; RowMajorStrg = TRUE;
|
||||
cblas_sgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0,
|
||||
ALPHA, A, 2, B, 2, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
} else if (strncmp( sf,"cblas_sgemm" ,11)==0) {
|
||||
if (strncmp( sf,"cblas_sgemm" ,11)==0) {
|
||||
cblas_rout = "cblas_sgemm" ;
|
||||
cblas_info = 1;
|
||||
cblas_sgemm( INVALID, CblasNoTrans, CblasNoTrans, 0, 0, 0,
|
||||
@@ -1507,7 +1269,7 @@ void F77_s3chke(char *rout
|
||||
chkxer();
|
||||
}
|
||||
if (cblas_ok == TRUE )
|
||||
printf(" %-13s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout);
|
||||
printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout);
|
||||
else
|
||||
printf("***** %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout);
|
||||
}
|
||||
|
||||
+15
-75
@@ -10,11 +10,7 @@
|
||||
|
||||
void F77_sgemv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, float *alpha,
|
||||
float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx, float *beta,
|
||||
float *y, CBLAS_INT *incy
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN transp_len
|
||||
#endif
|
||||
) {
|
||||
float *y, CBLAS_INT *incy ) {
|
||||
|
||||
float *A;
|
||||
CBLAS_INT i,j,LDA;
|
||||
@@ -65,11 +61,7 @@ void F77_sger(CBLAS_INT *layout, CBLAS_INT *m, CBLAS_INT *n, float *alpha, float
|
||||
}
|
||||
|
||||
void F77_strmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
CBLAS_INT *n, float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *n, float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx) {
|
||||
float *A;
|
||||
CBLAS_INT i,j,LDA;
|
||||
CBLAS_TRANSPOSE trans;
|
||||
@@ -97,11 +89,7 @@ void F77_strmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
}
|
||||
|
||||
void F77_strsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
CBLAS_INT *n, float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *n, float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx ) {
|
||||
float *A;
|
||||
CBLAS_INT i,j,LDA;
|
||||
CBLAS_TRANSPOSE trans;
|
||||
@@ -126,11 +114,7 @@ void F77_strsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
}
|
||||
void F77_ssymv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float *a,
|
||||
CBLAS_INT *lda, float *x, CBLAS_INT *incx, float *beta, float *y,
|
||||
CBLAS_INT *incy
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *incy) {
|
||||
float *A;
|
||||
CBLAS_INT i,j,LDA;
|
||||
CBLAS_UPLO uplo;
|
||||
@@ -153,11 +137,7 @@ void F77_ssymv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float
|
||||
}
|
||||
|
||||
void F77_ssyr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float *x,
|
||||
CBLAS_INT *incx, float *a, CBLAS_INT *lda
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *incx, float *a, CBLAS_INT *lda) {
|
||||
float *A;
|
||||
CBLAS_INT i,j,LDA;
|
||||
CBLAS_UPLO uplo;
|
||||
@@ -181,11 +161,7 @@ void F77_ssyr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float
|
||||
}
|
||||
|
||||
void F77_ssyr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float *x,
|
||||
CBLAS_INT *incx, float *y, CBLAS_INT *incy, float *a, CBLAS_INT *lda
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *incx, float *y, CBLAS_INT *incy, float *a, CBLAS_INT *lda) {
|
||||
float *A;
|
||||
CBLAS_INT i,j,LDA;
|
||||
CBLAS_UPLO uplo;
|
||||
@@ -210,11 +186,7 @@ void F77_ssyr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float
|
||||
|
||||
void F77_sgbmv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, CBLAS_INT *kl, CBLAS_INT *ku,
|
||||
float *alpha, float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx,
|
||||
float *beta, float *y, CBLAS_INT *incy
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN transp_len
|
||||
#endif
|
||||
) {
|
||||
float *beta, float *y, CBLAS_INT *incy ) {
|
||||
|
||||
float *A;
|
||||
CBLAS_INT i,irow,j,jcol,LDA;
|
||||
@@ -251,11 +223,7 @@ void F77_sgbmv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, CBLA
|
||||
}
|
||||
|
||||
void F77_stbmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
CBLAS_INT *n, CBLAS_INT *k, float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *n, CBLAS_INT *k, float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx) {
|
||||
float *A;
|
||||
CBLAS_INT irow, jcol, i, j, LDA;
|
||||
CBLAS_TRANSPOSE trans;
|
||||
@@ -301,11 +269,7 @@ void F77_stbmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
}
|
||||
|
||||
void F77_stbsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
CBLAS_INT *n, CBLAS_INT *k, float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *n, CBLAS_INT *k, float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx) {
|
||||
float *A;
|
||||
CBLAS_INT irow, jcol, i, j, LDA;
|
||||
CBLAS_TRANSPOSE trans;
|
||||
@@ -352,11 +316,7 @@ void F77_stbsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
|
||||
void F77_ssbmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_INT *k, float *alpha,
|
||||
float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx, float *beta,
|
||||
float *y, CBLAS_INT *incy
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
) {
|
||||
float *y, CBLAS_INT *incy) {
|
||||
float *A;
|
||||
CBLAS_INT i,j,irow,jcol,LDA;
|
||||
CBLAS_UPLO uplo;
|
||||
@@ -400,11 +360,7 @@ void F77_ssbmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_INT *k, float
|
||||
}
|
||||
|
||||
void F77_sspmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float *ap,
|
||||
float *x, CBLAS_INT *incx, float *beta, float *y, CBLAS_INT *incy
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
) {
|
||||
float *x, CBLAS_INT *incx, float *beta, float *y, CBLAS_INT *incy) {
|
||||
float *A,*AP;
|
||||
CBLAS_INT i,j,k,LDA;
|
||||
CBLAS_UPLO uplo;
|
||||
@@ -441,11 +397,7 @@ void F77_sspmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float
|
||||
}
|
||||
|
||||
void F77_stpmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
CBLAS_INT *n, float *ap, float *x, CBLAS_INT *incx
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *n, float *ap, float *x, CBLAS_INT *incx) {
|
||||
float *A, *AP;
|
||||
CBLAS_INT i, j, k, LDA;
|
||||
CBLAS_TRANSPOSE trans;
|
||||
@@ -484,11 +436,7 @@ void F77_stpmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
}
|
||||
|
||||
void F77_stpsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
CBLAS_INT *n, float *ap, float *x, CBLAS_INT *incx
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *n, float *ap, float *x, CBLAS_INT *incx) {
|
||||
float *A, *AP;
|
||||
CBLAS_INT i, j, k, LDA;
|
||||
CBLAS_TRANSPOSE trans;
|
||||
@@ -528,11 +476,7 @@ void F77_stpsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
}
|
||||
|
||||
void F77_sspr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float *x,
|
||||
CBLAS_INT *incx, float *ap
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
){
|
||||
CBLAS_INT *incx, float *ap ){
|
||||
float *A, *AP;
|
||||
CBLAS_INT i,j,k,LDA;
|
||||
CBLAS_UPLO uplo;
|
||||
@@ -583,11 +527,7 @@ void F77_sspr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float
|
||||
}
|
||||
|
||||
void F77_sspr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float *x,
|
||||
CBLAS_INT *incx, float *y, CBLAS_INT *incy, float *ap
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
){
|
||||
CBLAS_INT *incx, float *y, CBLAS_INT *incy, float *ap ){
|
||||
float *A, *AP;
|
||||
CBLAS_INT i,j,k,LDA;
|
||||
CBLAS_UPLO uplo;
|
||||
|
||||
+6
-106
@@ -11,11 +11,7 @@
|
||||
|
||||
void F77_sgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CBLAS_INT *n,
|
||||
CBLAS_INT *k, float *alpha, float *a, CBLAS_INT *lda, float *b, CBLAS_INT *ldb,
|
||||
float *beta, float *c, CBLAS_INT *ldc
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN transpa_len, FORTRAN_STRLEN transpb_len
|
||||
#endif
|
||||
) {
|
||||
float *beta, float *c, CBLAS_INT *ldc ) {
|
||||
|
||||
float *A, *B, *C;
|
||||
CBLAS_INT i,j,LDA, LDB, LDC;
|
||||
@@ -74,89 +70,9 @@ void F77_sgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CB
|
||||
cblas_sgemm( UNDEFINED, transa, transb, *m, *n, *k, *alpha, a, *lda,
|
||||
b, *ldb, *beta, c, *ldc );
|
||||
}
|
||||
|
||||
void F77_sgemmtr(CBLAS_INT *layout, char *uplop, char *transpa, char *transpb, CBLAS_INT *n,
|
||||
CBLAS_INT *k, float *alpha, float *a, CBLAS_INT *lda,
|
||||
float *b, CBLAS_INT *ldb, float *beta,
|
||||
float *c, CBLAS_INT *ldc ) {
|
||||
|
||||
float *A, *B, *C;
|
||||
CBLAS_INT i,j,LDA, LDB, LDC;
|
||||
CBLAS_TRANSPOSE transa, transb;
|
||||
CBLAS_UPLO uplo;
|
||||
|
||||
get_transpose_type(transpa, &transa);
|
||||
get_transpose_type(transpb, &transb);
|
||||
get_uplo_type(uplop, &uplo);
|
||||
|
||||
if (*layout == TEST_ROW_MJR) {
|
||||
if (transa == CblasNoTrans) {
|
||||
LDA = *k+1;
|
||||
A=(float*)malloc((*n)*LDA*sizeof(float));
|
||||
for( i=0; i<*n; i++ )
|
||||
for( j=0; j<*k; j++ ) {
|
||||
A[i*LDA+j]=a[j*(*lda)+i];
|
||||
}
|
||||
}
|
||||
else {
|
||||
LDA = *n+1;
|
||||
A=(float* )malloc(LDA*(*k)*sizeof(float));
|
||||
for( i=0; i<*k; i++ )
|
||||
for( j=0; j<*n; j++ ) {
|
||||
A[i*LDA+j]=a[j*(*lda)+i];
|
||||
}
|
||||
}
|
||||
|
||||
if (transb == CblasNoTrans) {
|
||||
LDB = *n+1;
|
||||
B=(float* )malloc((*k)*LDB*sizeof(float) );
|
||||
for( i=0; i<*k; i++ )
|
||||
for( j=0; j<*n; j++ ) {
|
||||
B[i*LDB+j]=b[j*(*ldb)+i];
|
||||
}
|
||||
}
|
||||
else {
|
||||
LDB = *k+1;
|
||||
B=(float* )malloc(LDB*(*n)*sizeof(float));
|
||||
for( i=0; i<*n; i++ )
|
||||
for( j=0; j<*k; j++ ) {
|
||||
B[i*LDB+j]=b[j*(*ldb)+i];
|
||||
}
|
||||
}
|
||||
|
||||
LDC = *n+1;
|
||||
C=(float* )malloc((*n)*LDC*sizeof(float));
|
||||
for( j=0; j<*n; j++ )
|
||||
for( i=0; i<*n; i++ ) {
|
||||
C[i*LDC+j]=c[j*(*ldc)+i];
|
||||
}
|
||||
cblas_sgemmtr( CblasRowMajor, uplo, transa, transb, *n, *k, *alpha, A, LDA,
|
||||
B, LDB, *beta, C, LDC );
|
||||
for( j=0; j<*n; j++ )
|
||||
for( i=0; i<*n; i++ ) {
|
||||
c[j*(*ldc)+i]=C[i*LDC+j];
|
||||
}
|
||||
free(A);
|
||||
free(B);
|
||||
free(C);
|
||||
}
|
||||
else if (*layout == TEST_COL_MJR)
|
||||
cblas_sgemmtr( CblasColMajor, uplo, transa, transb, *n, *k, *alpha, a, *lda,
|
||||
b, *ldb, *beta, c, *ldc );
|
||||
else
|
||||
cblas_sgemmtr( UNDEFINED, uplo, transa, transb, *n, *k, *alpha, a, *lda,
|
||||
b, *ldb, *beta, c, *ldc );
|
||||
}
|
||||
|
||||
|
||||
|
||||
void F77_ssymm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_INT *n,
|
||||
float *alpha, float *a, CBLAS_INT *lda, float *b, CBLAS_INT *ldb,
|
||||
float *beta, float *c, CBLAS_INT *ldc
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
) {
|
||||
float *beta, float *c, CBLAS_INT *ldc ) {
|
||||
|
||||
float *A, *B, *C;
|
||||
CBLAS_INT i,j,LDA, LDB, LDC;
|
||||
@@ -210,11 +126,7 @@ void F77_ssymm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_I
|
||||
|
||||
void F77_ssyrk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k,
|
||||
float *alpha, float *a, CBLAS_INT *lda,
|
||||
float *beta, float *c, CBLAS_INT *ldc
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len
|
||||
#endif
|
||||
) {
|
||||
float *beta, float *c, CBLAS_INT *ldc ) {
|
||||
|
||||
CBLAS_INT i,j,LDA,LDC;
|
||||
float *A, *C;
|
||||
@@ -262,11 +174,7 @@ void F77_ssyrk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS
|
||||
|
||||
void F77_ssyr2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k,
|
||||
float *alpha, float *a, CBLAS_INT *lda, float *b, CBLAS_INT *ldb,
|
||||
float *beta, float *c, CBLAS_INT *ldc
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len
|
||||
#endif
|
||||
) {
|
||||
float *beta, float *c, CBLAS_INT *ldc ) {
|
||||
CBLAS_INT i,j,LDA,LDB,LDC;
|
||||
float *A, *B, *C;
|
||||
CBLAS_UPLO uplo;
|
||||
@@ -321,11 +229,7 @@ void F77_ssyr2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLA
|
||||
}
|
||||
void F77_strmm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *diagn,
|
||||
CBLAS_INT *m, CBLAS_INT *n, float *alpha, float *a, CBLAS_INT *lda, float *b,
|
||||
CBLAS_INT *ldb
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *ldb) {
|
||||
CBLAS_INT i,j,LDA,LDB;
|
||||
float *A, *B;
|
||||
CBLAS_SIDE side;
|
||||
@@ -376,11 +280,7 @@ void F77_strmm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *d
|
||||
|
||||
void F77_strsm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *diagn,
|
||||
CBLAS_INT *m, CBLAS_INT *n, float *alpha, float *a, CBLAS_INT *lda, float *b,
|
||||
CBLAS_INT *ldb
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *ldb) {
|
||||
CBLAS_INT i,j,LDA,LDB;
|
||||
float *A, *B;
|
||||
CBLAS_SIDE side;
|
||||
|
||||
+63
-553
@@ -4,7 +4,7 @@
|
||||
*
|
||||
* The program must be driven by a short data file. The first 13 records
|
||||
* of the file are read using list-directed input, the last 6 records
|
||||
* are read using the format ( A13, L2 ). An annotated example of a data
|
||||
* are read using the format ( A12, L2 ). An annotated example of a data
|
||||
* file can be obtained by deleting the first 3 characters from the
|
||||
* following 19 lines:
|
||||
* 'SBLAT3.SNAP' NAME OF SNAPSHOT OUTPUT FILE
|
||||
@@ -20,14 +20,12 @@
|
||||
* 0.0 1.0 0.7 VALUES OF ALPHA
|
||||
* 3 NUMBER OF VALUES OF BETA
|
||||
* 0.0 1.0 1.3 VALUES OF BETA
|
||||
* cblas_sgemm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_ssymm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_strmm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_strsm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_ssyrk T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_ssyr2k T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_sgemmtr T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
|
||||
* cblas_sgemm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_ssymm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_strmm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_strsm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_ssyrk T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_ssyr2k T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
*
|
||||
* See:
|
||||
*
|
||||
@@ -48,7 +46,7 @@
|
||||
INTEGER NIN, NOUT
|
||||
PARAMETER ( NIN = 5, NOUT = 6 )
|
||||
INTEGER NSUBS
|
||||
PARAMETER ( NSUBS = 7 )
|
||||
PARAMETER ( NSUBS = 6 )
|
||||
REAL ZERO, HALF, ONE
|
||||
PARAMETER ( ZERO = 0.0, HALF = 0.5, ONE = 1.0 )
|
||||
INTEGER NMAX
|
||||
@@ -62,7 +60,7 @@
|
||||
LOGICAL FATAL, LTESTT, REWI, SAME, SFATAL, TRACE,
|
||||
$ TSTERR, CORDER, RORDER
|
||||
CHARACTER*1 TRANSA, TRANSB
|
||||
CHARACTER*13 SNAMET
|
||||
CHARACTER*12 SNAMET
|
||||
CHARACTER*32 SNAPS
|
||||
* .. Local Arrays ..
|
||||
REAL AA( NMAX*NMAX ), AB( NMAX, 2*NMAX ),
|
||||
@@ -73,27 +71,27 @@
|
||||
$ G( NMAX ), W( 2*NMAX )
|
||||
INTEGER IDIM( NIDMAX )
|
||||
LOGICAL LTEST( NSUBS )
|
||||
CHARACTER*13 SNAMES( NSUBS )
|
||||
CHARACTER*12 SNAMES( NSUBS )
|
||||
* .. External Functions ..
|
||||
REAL SDIFF
|
||||
LOGICAL LSE
|
||||
EXTERNAL SDIFF, LSE
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL SCHK1, SCHK2, SCHK3, SCHK4, SCHK5, CS3CHKE,
|
||||
$ SMMCH, SCHK6
|
||||
$ SMMCH
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC MAX, MIN
|
||||
* .. Scalars in Common ..
|
||||
INTEGER INFOT, NOUTC
|
||||
LOGICAL OK
|
||||
CHARACTER*13 SRNAMT
|
||||
CHARACTER*12 SRNAMT
|
||||
* .. Common blocks ..
|
||||
COMMON /INFOC/INFOT, NOUTC, OK
|
||||
COMMON /SRNAMC/SRNAMT
|
||||
* .. Data statements ..
|
||||
DATA SNAMES/'cblas_sgemm ', 'cblas_ssymm ',
|
||||
$ 'cblas_strmm ', 'cblas_strsm ','cblas_ssyrk ',
|
||||
$ 'cblas_ssyr2k', 'cblas_sgemmtr'/
|
||||
$ 'cblas_ssyr2k'/
|
||||
* .. Executable Statements ..
|
||||
*
|
||||
NOUTC = NOUT
|
||||
@@ -290,7 +288,7 @@
|
||||
INFOT = 0
|
||||
OK = .TRUE.
|
||||
FATAL = .FALSE.
|
||||
GO TO ( 140, 150, 160, 160, 170, 180, 185 )ISNUM
|
||||
GO TO ( 140, 150, 160, 160, 170, 180 )ISNUM
|
||||
* Test SGEMM, 01.
|
||||
140 IF (CORDER) THEN
|
||||
CALL SCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
@@ -361,24 +359,8 @@
|
||||
$ 1 )
|
||||
END IF
|
||||
GO TO 190
|
||||
* Test SGEMMTR, 07.
|
||||
185 IF (CORDER) THEN
|
||||
CALL SCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
|
||||
$ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W,
|
||||
$ 0 )
|
||||
|
||||
END IF
|
||||
IF (RORDER) THEN
|
||||
CALL SCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
|
||||
$ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W,
|
||||
$ 1 )
|
||||
END IF
|
||||
GO TO 190
|
||||
*
|
||||
|
||||
190 IF( FATAL.AND.SFATAL )
|
||||
190 IF( FATAL.AND.SFATAL )
|
||||
$ GO TO 210
|
||||
END IF
|
||||
200 CONTINUE
|
||||
@@ -414,7 +396,7 @@
|
||||
9992 FORMAT( ' FOR BETA ', 7F6.1 )
|
||||
9991 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM',
|
||||
$ /' ******* TESTS ABANDONED *******' )
|
||||
9990 FORMAT( ' SUBPROGRAM NAME ', A13,' NOT RECOGNIZED', /' ******* ',
|
||||
9990 FORMAT( ' SUBPROGRAM NAME ', A12,' NOT RECOGNIZED', /' ******* ',
|
||||
$ 'TESTS ABANDONED *******' )
|
||||
9989 FORMAT( ' ERROR IN SMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALU',
|
||||
$ 'ATED WRONGLY.', /' SMMCH WAS CALLED WITH TRANSA = ', A1,
|
||||
@@ -422,8 +404,8 @@
|
||||
$ 'ERR = ', F12.3, '.', /' THIS MAY BE DUE TO FAULTS IN THE ',
|
||||
$ 'ARITHMETIC OR THE COMPILER.', /' ******* TESTS ABANDONED ',
|
||||
$ '*******' )
|
||||
9988 FORMAT( A13,L2 )
|
||||
9987 FORMAT( 1X, A13,' WAS NOT TESTED' )
|
||||
9988 FORMAT( A12,L2 )
|
||||
9987 FORMAT( 1X, A12,' WAS NOT TESTED' )
|
||||
9986 FORMAT( /' END OF TESTS' )
|
||||
9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' )
|
||||
9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' )
|
||||
@@ -453,7 +435,7 @@
|
||||
REAL EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
* .. Array Arguments ..
|
||||
REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
@@ -699,20 +681,20 @@
|
||||
130 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(''', A1, ''',''', A1, ''',',
|
||||
9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( 1X, I6, ': ', A12,'(''', A1, ''',''', A1, ''',',
|
||||
$ 3( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', ',
|
||||
$ 'C,', I3, ').' )
|
||||
9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
@@ -729,7 +711,7 @@
|
||||
INTEGER NOUT, NC, IORDER, M, N, K, LDA, LDB, LDC
|
||||
REAL ALPHA, BETA
|
||||
CHARACTER*1 TRANSA, TRANSB
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
CHARACTER*14 CRC, CTA,CTB
|
||||
|
||||
IF (TRANSA.EQ.'N')THEN
|
||||
@@ -754,7 +736,7 @@
|
||||
WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CTA,CTB
|
||||
WRITE(NOUT, FMT = 9994)M, N, K, ALPHA, LDA, LDB, BETA, LDC
|
||||
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',')
|
||||
9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',')
|
||||
9994 FORMAT( 20X, 3( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',',
|
||||
$ F4.1, ', ', 'C,', I3, ').' )
|
||||
END
|
||||
@@ -781,7 +763,7 @@
|
||||
REAL EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
* .. Array Arguments ..
|
||||
REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
@@ -1016,20 +998,20 @@
|
||||
120 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( 1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
$ F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', C,', I3, ') ',
|
||||
$ ' .' )
|
||||
9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
@@ -1044,7 +1026,7 @@
|
||||
INTEGER NOUT, NC, IORDER, M, N, LDA, LDB, LDC
|
||||
REAL ALPHA, BETA
|
||||
CHARACTER*1 SIDE, UPLO
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
CHARACTER*14 CRC, CS,CU
|
||||
|
||||
IF (SIDE.EQ.'L')THEN
|
||||
@@ -1065,7 +1047,7 @@
|
||||
WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CS,CU
|
||||
WRITE(NOUT, FMT = 9994)M, N, ALPHA, LDA, LDB, BETA, LDC
|
||||
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',')
|
||||
9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',')
|
||||
9994 FORMAT( 20X, 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',',
|
||||
$ F4.1, ', ', 'C,', I3, ').' )
|
||||
END
|
||||
@@ -1091,7 +1073,7 @@
|
||||
REAL EPS, THRESH
|
||||
INTEGER NALF, NIDIM, NMAX, NOUT, NTRA, IORDER
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
* .. Array Arguments ..
|
||||
REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
@@ -1364,20 +1346,20 @@
|
||||
160 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(', 4( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( 1X, I6, ': ', A12,'(', 4( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
$ F4.1, ', A,', I3, ', B,', I3, ') .' )
|
||||
9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
$ '******' )
|
||||
@@ -1391,7 +1373,7 @@
|
||||
INTEGER NOUT, NC, IORDER, M, N, LDA, LDB
|
||||
REAL ALPHA
|
||||
CHARACTER*1 SIDE, UPLO, TRANSA, DIAG
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
CHARACTER*14 CRC, CS, CU, CA, CD
|
||||
|
||||
IF (SIDE.EQ.'L')THEN
|
||||
@@ -1424,7 +1406,7 @@
|
||||
WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CS,CU
|
||||
WRITE(NOUT, FMT = 9994)CA, CD, M, N, ALPHA, LDA, LDB
|
||||
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',')
|
||||
9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',')
|
||||
9994 FORMAT( 22X, 2( A14, ',') , 2( I3, ',' ),
|
||||
$ F4.1, ', A,', I3, ', B,', I3, ').' )
|
||||
END
|
||||
@@ -1451,7 +1433,7 @@
|
||||
REAL EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
* .. Array Arguments ..
|
||||
REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
@@ -1690,21 +1672,21 @@
|
||||
130 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' )
|
||||
9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 )
|
||||
9994 FORMAT( 1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
9994 FORMAT( 1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
$ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ') .' )
|
||||
9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
$ '******' )
|
||||
@@ -1718,7 +1700,7 @@
|
||||
INTEGER NOUT, NC, IORDER, N, K, LDA, LDC
|
||||
REAL ALPHA, BETA
|
||||
CHARACTER*1 UPLO, TRANSA
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
CHARACTER*14 CRC, CU, CA
|
||||
|
||||
IF (UPLO.EQ.'U')THEN
|
||||
@@ -1741,7 +1723,7 @@
|
||||
WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA
|
||||
WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, BETA, LDC
|
||||
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') )
|
||||
9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') )
|
||||
9994 FORMAT( 20X, 2( I3, ',' ),
|
||||
$ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ').' )
|
||||
END
|
||||
@@ -1768,7 +1750,7 @@
|
||||
REAL EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
* .. Array Arguments ..
|
||||
REAL AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ),
|
||||
$ ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ),
|
||||
@@ -2045,21 +2027,21 @@
|
||||
160 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' )
|
||||
9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 )
|
||||
9994 FORMAT( 1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
9994 FORMAT( 1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
$ F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', C,', I3, ') ',
|
||||
$ ' .' )
|
||||
9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
@@ -2074,7 +2056,7 @@
|
||||
INTEGER NOUT, NC, IORDER, N, K, LDA, LDB, LDC
|
||||
REAL ALPHA, BETA
|
||||
CHARACTER*1 UPLO, TRANSA
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
CHARACTER*14 CRC, CU, CA
|
||||
|
||||
IF (UPLO.EQ.'U')THEN
|
||||
@@ -2097,7 +2079,7 @@
|
||||
WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA
|
||||
WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, LDB, BETA, LDC
|
||||
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') )
|
||||
9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') )
|
||||
9994 FORMAT( 20X, 2( I3, ',' ),
|
||||
$ F4.1, ', A,', I3, ', B', I3, ',', F4.1, ', C,', I3, ').' )
|
||||
END
|
||||
@@ -2496,475 +2478,3 @@
|
||||
* End of SDIFF.
|
||||
*
|
||||
END
|
||||
|
||||
|
||||
SUBROUTINE SCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
|
||||
$ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
|
||||
$ A, AA, AS, B, BB, BS, C, CC, CS, CT, G,
|
||||
$ IORDER)
|
||||
*
|
||||
* Tests SGEMMTR.
|
||||
*
|
||||
* Auxiliary routine for test program for Level 3 Blas.
|
||||
*
|
||||
* -- Written on 19-July-2023.
|
||||
* Martin Koehler, MPI Magdeburg
|
||||
*
|
||||
* .. Parameters ..
|
||||
REAL ZERO
|
||||
PARAMETER ( ZERO = 0.0 )
|
||||
* .. Scalar Arguments ..
|
||||
REAL EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*13 SNAME
|
||||
* .. Array Arguments ..
|
||||
REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
$ BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
|
||||
$ C( NMAX, NMAX ), CC( NMAX*NMAX ),
|
||||
$ CS( NMAX*NMAX ), CT( NMAX ), G( NMAX )
|
||||
INTEGER IDIM( NIDIM )
|
||||
* .. Local Scalars ..
|
||||
REAL ALPHA, ALS, BETA, BLS, ERR, ERRMAX
|
||||
INTEGER I, IA, IB, ICA, ICB, IK, IN, K, KS, LAA,
|
||||
$ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS,
|
||||
$ MA, MB, N, NA, NARGS, NB, NC, NS, IS
|
||||
LOGICAL NULL, RESET, SAME, TRANA, TRANB
|
||||
CHARACTER*1 TRANAS, TRANBS, TRANSA, TRANSB, UPLO, UPLOS
|
||||
CHARACTER*3 ICH
|
||||
CHARACTER*2 ISHAPE
|
||||
* .. Local Arrays ..
|
||||
LOGICAL ISAME( 13 )
|
||||
* .. External Functions ..
|
||||
LOGICAL LSE, LSERES
|
||||
EXTERNAL LSE, LSERES
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL CSGEMMTR, SMAKE, SMMTCH, SPRCN8
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC MAX
|
||||
* .. Scalars in Common ..
|
||||
INTEGER INFOT, NOUTC
|
||||
LOGICAL LERR, OK
|
||||
* .. Common blocks ..
|
||||
COMMON /INFOC/INFOT, NOUTC, OK, LERR
|
||||
* .. Data statements ..
|
||||
DATA ICH/'NTC'/
|
||||
DATA ISHAPE/'UL'/
|
||||
* .. Executable Statements ..
|
||||
*
|
||||
NARGS = 13
|
||||
NC = 0
|
||||
RESET = .TRUE.
|
||||
ERRMAX = ZERO
|
||||
*
|
||||
DO 100 IN = 1, NIDIM
|
||||
N = IDIM( IN )
|
||||
* Set LDC to 1 more than minimum value if room.
|
||||
LDC = N
|
||||
IF( LDC.LT.NMAX )
|
||||
$ LDC = LDC + 1
|
||||
* Skip tests if not enough room.
|
||||
IF( LDC.GT.NMAX )
|
||||
$ GO TO 100
|
||||
LCC = LDC*N
|
||||
NULL = N.LE.0
|
||||
*
|
||||
DO 90 IK = 1, NIDIM
|
||||
K = IDIM( IK )
|
||||
*
|
||||
DO 80 ICA = 1, 3
|
||||
TRANSA = ICH( ICA: ICA )
|
||||
TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C'
|
||||
*
|
||||
IF( TRANA )THEN
|
||||
MA = K
|
||||
NA = N
|
||||
ELSE
|
||||
MA = N
|
||||
NA = K
|
||||
END IF
|
||||
* Set LDA to 1 more than minimum value if room.
|
||||
LDA = MA
|
||||
IF( LDA.LT.NMAX )
|
||||
$ LDA = LDA + 1
|
||||
* Skip tests if not enough room.
|
||||
IF( LDA.GT.NMAX )
|
||||
$ GO TO 80
|
||||
LAA = LDA*NA
|
||||
*
|
||||
* Generate the matrix A.
|
||||
*
|
||||
CALL SMAKE( 'GE', ' ', ' ', MA, NA, A, NMAX, AA, LDA,
|
||||
$ RESET, ZERO )
|
||||
*
|
||||
DO 70 ICB = 1, 3
|
||||
TRANSB = ICH( ICB: ICB )
|
||||
TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C'
|
||||
*
|
||||
IF( TRANB )THEN
|
||||
MB = N
|
||||
NB = K
|
||||
ELSE
|
||||
MB = K
|
||||
NB = N
|
||||
END IF
|
||||
* Set LDB to 1 more than minimum value if room.
|
||||
LDB = MB
|
||||
IF( LDB.LT.NMAX )
|
||||
$ LDB = LDB + 1
|
||||
* Skip tests if not enough room.
|
||||
IF( LDB.GT.NMAX )
|
||||
$ GO TO 70
|
||||
LBB = LDB*NB
|
||||
*
|
||||
* Generate the matrix B.
|
||||
*
|
||||
CALL SMAKE( 'GE', ' ', ' ', MB, NB, B, NMAX, BB,
|
||||
$ LDB, RESET, ZERO )
|
||||
*
|
||||
DO 60 IA = 1, NALF
|
||||
ALPHA = ALF( IA )
|
||||
*
|
||||
DO 50 IB = 1, NBET
|
||||
BETA = BET( IB )
|
||||
|
||||
DO 45 IS = 1, 2
|
||||
UPLO = ISHAPE( IS: IS )
|
||||
|
||||
*
|
||||
* Generate the matrix C.
|
||||
*
|
||||
CALL SMAKE( 'GE', UPLO, ' ', N, N, C,
|
||||
$ NMAX, CC, LDC, RESET, ZERO )
|
||||
*
|
||||
NC = NC + 1
|
||||
*
|
||||
* Save every datum before calling the
|
||||
* subroutine.
|
||||
*
|
||||
UPLOS = UPLO
|
||||
TRANAS = TRANSA
|
||||
TRANBS = TRANSB
|
||||
NS = N
|
||||
KS = K
|
||||
ALS = ALPHA
|
||||
DO 10 I = 1, LAA
|
||||
AS( I ) = AA( I )
|
||||
10 CONTINUE
|
||||
LDAS = LDA
|
||||
DO 20 I = 1, LBB
|
||||
BS( I ) = BB( I )
|
||||
20 CONTINUE
|
||||
LDBS = LDB
|
||||
BLS = BETA
|
||||
DO 30 I = 1, LCC
|
||||
CS( I ) = CC( I )
|
||||
30 CONTINUE
|
||||
LDCS = LDC
|
||||
*
|
||||
* Call the subroutine.
|
||||
*
|
||||
IF( TRACE )
|
||||
$ CALL SPRCN8(NTRA, NC, SNAME, IORDER, UPLO,
|
||||
$ TRANSA, TRANSB, N, K, ALPHA, LDA,
|
||||
$ LDB, BETA, LDC)
|
||||
IF( REWI )
|
||||
$ REWIND NTRA
|
||||
CALL CSGEMMTR( IORDER, UPLO, TRANSA, TRANSB,
|
||||
$ N, K, ALPHA, AA, LDA, BB, LDB,
|
||||
$ BETA, CC, LDC )
|
||||
*
|
||||
* Check if error-exit was taken incorrectly.
|
||||
*
|
||||
IF( .NOT.OK )THEN
|
||||
WRITE( NOUT, FMT = 9994 )
|
||||
FATAL = .TRUE.
|
||||
GO TO 120
|
||||
END IF
|
||||
*
|
||||
* See what data changed inside subroutines.
|
||||
*
|
||||
ISAME( 1 ) = UPLO.EQ.UPLOS
|
||||
ISAME( 2 ) = TRANSA.EQ.TRANAS
|
||||
ISAME( 3 ) = TRANSB.EQ.TRANBS
|
||||
ISAME( 4 ) = NS.EQ.N
|
||||
ISAME( 5 ) = KS.EQ.K
|
||||
ISAME( 6 ) = ALS.EQ.ALPHA
|
||||
ISAME( 7 ) = LSE( AS, AA, LAA )
|
||||
ISAME( 8 ) = LDAS.EQ.LDA
|
||||
ISAME( 9 ) = LSE( BS, BB, LBB )
|
||||
ISAME( 10 ) = LDBS.EQ.LDB
|
||||
ISAME( 11 ) = BLS.EQ.BETA
|
||||
IF( NULL )THEN
|
||||
ISAME( 12 ) = LSE( CS, CC, LCC )
|
||||
ELSE
|
||||
ISAME( 12 ) = LSERES( 'GE', ' ', N, N,
|
||||
$ CS, CC, LDC )
|
||||
END IF
|
||||
ISAME( 13 ) = LDCS.EQ.LDC
|
||||
*
|
||||
* If data was incorrectly changed, report
|
||||
* and return.
|
||||
*
|
||||
SAME = .TRUE.
|
||||
DO 40 I = 1, NARGS
|
||||
SAME = SAME.AND.ISAME( I )
|
||||
IF( .NOT.ISAME( I ) )
|
||||
$ WRITE( NOUT, FMT = 9998 )I
|
||||
40 CONTINUE
|
||||
IF( .NOT.SAME )THEN
|
||||
FATAL = .TRUE.
|
||||
GO TO 120
|
||||
END IF
|
||||
*
|
||||
IF( .NOT.NULL )THEN
|
||||
*
|
||||
* Check the result.
|
||||
*
|
||||
CALL SMMTCH( UPLO, TRANSA, TRANSB,
|
||||
$ N, K,
|
||||
$ ALPHA, A, NMAX, B, NMAX, BETA,
|
||||
$ C, NMAX, CT, G, CC, LDC, EPS,
|
||||
$ ERR, FATAL, NOUT, .TRUE. )
|
||||
ERRMAX = MAX( ERRMAX, ERR )
|
||||
* If got really bad answer, report and
|
||||
* return.
|
||||
IF( FATAL )
|
||||
$ GO TO 120
|
||||
END IF
|
||||
*
|
||||
45 CONTINUE
|
||||
*
|
||||
50 CONTINUE
|
||||
*
|
||||
60 CONTINUE
|
||||
*
|
||||
70 CONTINUE
|
||||
*
|
||||
80 CONTINUE
|
||||
*
|
||||
90 CONTINUE
|
||||
*
|
||||
100 CONTINUE
|
||||
*
|
||||
*
|
||||
* Report result.
|
||||
*
|
||||
IF( ERRMAX.LT.THRESH )THEN
|
||||
IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10000 )SNAME, NC
|
||||
IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10001 )SNAME, NC
|
||||
ELSE
|
||||
IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10002 )SNAME, NC, ERRMAX
|
||||
IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10003 )SNAME, NC, ERRMAX
|
||||
END IF
|
||||
GO TO 130
|
||||
*
|
||||
120 CONTINUE
|
||||
WRITE( NOUT, FMT = 9996 )SNAME
|
||||
CALL SPRCN8(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, TRANSB,
|
||||
$ N, K, ALPHA, LDA, LDB, BETA, LDC)
|
||||
*
|
||||
130 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9997 FORMAT( ' ', A13, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
|
||||
$ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
|
||||
$ ' - SUSPECT *******' )
|
||||
9996 FORMAT( ' ******* ', A13, ' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( 1X, I6, ': ', A13, '(''',A1, ''',''',A1, ''',''', A1,''',',
|
||||
$ 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', ',
|
||||
$ 'C,', I3, ').' )
|
||||
9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
$ '******' )
|
||||
*
|
||||
* End of SCHK6
|
||||
*
|
||||
END
|
||||
|
||||
SUBROUTINE SPRCN8(NOUT, NC, SNAME, IORDER, UPLO,
|
||||
$ TRANSA, TRANSB, N,
|
||||
$ K, ALPHA, LDA, LDB, BETA, LDC)
|
||||
INTEGER NOUT, NC, IORDER, N, K, LDA, LDB, LDC
|
||||
REAL ALPHA, BETA
|
||||
CHARACTER*1 TRANSA, TRANSB, UPLO
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*14 CRC, CTA,CTB,CUPLO
|
||||
|
||||
IF (UPLO.EQ.'U') THEN
|
||||
CUPLO = 'CblasUpper'
|
||||
ELSE
|
||||
CUPLO = 'CblasLower'
|
||||
END IF
|
||||
IF (TRANSA.EQ.'N')THEN
|
||||
CTA = ' CblasNoTrans'
|
||||
ELSE IF (TRANSA.EQ.'T')THEN
|
||||
CTA = ' CblasTrans'
|
||||
ELSE
|
||||
CTA = 'CblasConjTrans'
|
||||
END IF
|
||||
IF (TRANSB.EQ.'N')THEN
|
||||
CTB = ' CblasNoTrans'
|
||||
ELSE IF (TRANSB.EQ.'T')THEN
|
||||
CTB = ' CblasTrans'
|
||||
ELSE
|
||||
CTB = 'CblasConjTrans'
|
||||
END IF
|
||||
IF (IORDER.EQ.1)THEN
|
||||
CRC = ' CblasRowMajor'
|
||||
ELSE
|
||||
CRC = ' CblasColMajor'
|
||||
END IF
|
||||
WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CUPLO, CTA,CTB
|
||||
WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, LDB, BETA, LDC
|
||||
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',',
|
||||
$ A14, ',')
|
||||
9994 FORMAT( 10X, 2( I3, ',' ) ,' ', F4.1,' , A,',
|
||||
$ I3, ', B,', I3, ', ', F4.1,' , C,', I3, ').' )
|
||||
END
|
||||
|
||||
SUBROUTINE SMMTCH( UPLO, TRANSA, TRANSB, N, KK, ALPHA, A, LDA,
|
||||
$ B, LDB, BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR,
|
||||
$ FATAL, NOUT, MV )
|
||||
*
|
||||
* Checks the results of the computational tests.
|
||||
*
|
||||
* Auxiliary routine for test program for Level 3 Blas. (DGEMMTR)
|
||||
*
|
||||
* -- Written on 19-July-2023.
|
||||
* Martin Koehler, MPI Magdeburg
|
||||
*
|
||||
* .. Parameters ..
|
||||
REAL ZERO, ONE
|
||||
PARAMETER ( ZERO = 0.0, ONE = 1.0 )
|
||||
* .. Scalar Arguments ..
|
||||
REAL ALPHA, BETA, EPS, ERR
|
||||
INTEGER KK, LDA, LDB, LDC, LDCC, N, NOUT
|
||||
LOGICAL FATAL, MV
|
||||
CHARACTER*1 UPLO, TRANSA, TRANSB
|
||||
* .. Array Arguments ..
|
||||
REAL A( LDA, * ), B( LDB, * ), C( LDC, * ),
|
||||
$ CC( LDCC, * ), CT( * ), G( * )
|
||||
* .. Local Scalars ..
|
||||
REAL ERRI
|
||||
INTEGER I, J, K, ISTART, ISTOP
|
||||
LOGICAL TRANA, TRANB, UPPER
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC ABS, MAX, SQRT
|
||||
* .. Executable Statements ..
|
||||
UPPER = UPLO.EQ.'U'
|
||||
TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C'
|
||||
TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C'
|
||||
*
|
||||
* Compute expected result, one column at a time, in CT using data
|
||||
* in A, B and C.
|
||||
* Compute gauges in G.
|
||||
*
|
||||
ISTART = 1
|
||||
ISTOP = N
|
||||
|
||||
DO 120 J = 1, N
|
||||
*
|
||||
IF ( UPPER ) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
DO 10 I = ISTART, ISTOP
|
||||
CT( I ) = ZERO
|
||||
G( I ) = ZERO
|
||||
10 CONTINUE
|
||||
IF( .NOT.TRANA.AND..NOT.TRANB )THEN
|
||||
DO 30 K = 1, KK
|
||||
DO 20 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( I, K )*B( K, J )
|
||||
G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( K, J ) )
|
||||
20 CONTINUE
|
||||
30 CONTINUE
|
||||
ELSE IF( TRANA.AND..NOT.TRANB )THEN
|
||||
DO 50 K = 1, KK
|
||||
DO 40 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( K, I )*B( K, J )
|
||||
G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( K, J ) )
|
||||
40 CONTINUE
|
||||
50 CONTINUE
|
||||
ELSE IF( .NOT.TRANA.AND.TRANB )THEN
|
||||
DO 70 K = 1, KK
|
||||
DO 60 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( I, K )*B( J, K )
|
||||
G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( J, K ) )
|
||||
60 CONTINUE
|
||||
70 CONTINUE
|
||||
ELSE IF( TRANA.AND.TRANB )THEN
|
||||
DO 90 K = 1, KK
|
||||
DO 80 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( K, I )*B( J, K )
|
||||
G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( J, K ) )
|
||||
80 CONTINUE
|
||||
90 CONTINUE
|
||||
END IF
|
||||
DO 100 I = ISTART, ISTOP
|
||||
CT( I ) = ALPHA*CT( I ) + BETA*C( I, J )
|
||||
G( I ) = ABS( ALPHA )*G( I ) + ABS( BETA )*ABS( C( I, J ) )
|
||||
100 CONTINUE
|
||||
*
|
||||
* Compute the error ratio for this result.
|
||||
*
|
||||
ERR = ZERO
|
||||
DO 110 I = ISTART, ISTOP
|
||||
ERRI = ABS( CT( I ) - CC( I, J ) )/EPS
|
||||
IF( G( I ).NE.ZERO )
|
||||
$ ERRI = ERRI/G( I )
|
||||
ERR = MAX( ERR, ERRI )
|
||||
IF( ERR*SQRT( EPS ).GE.ONE )
|
||||
$ GO TO 130
|
||||
110 CONTINUE
|
||||
*
|
||||
120 CONTINUE
|
||||
*
|
||||
* If the loop completes, all results are at least half accurate.
|
||||
GO TO 150
|
||||
*
|
||||
* Report fatal error.
|
||||
*
|
||||
130 FATAL = .TRUE.
|
||||
WRITE( NOUT, FMT = 9999 )
|
||||
DO 140 I = ISTART, ISTOP
|
||||
IF( MV )THEN
|
||||
WRITE( NOUT, FMT = 9998 )I, CT( I ), CC( I, J )
|
||||
ELSE
|
||||
WRITE( NOUT, FMT = 9998 )I, CC( I, J ), CT( I )
|
||||
END IF
|
||||
140 CONTINUE
|
||||
IF( N.GT.1 )
|
||||
$ WRITE( NOUT, FMT = 9997 )J
|
||||
*
|
||||
150 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
|
||||
$ 'F ACCURATE *******', /' EXPECTED RESULT COMPU',
|
||||
$ 'TED RESULT' )
|
||||
9998 FORMAT( 1X, I7, 2G18.6 )
|
||||
9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 )
|
||||
*
|
||||
* End of SMMTCH
|
||||
*
|
||||
END
|
||||
|
||||
|
||||
|
||||
@@ -33,18 +33,13 @@ void cblas_xerbla(CBLAS_INT info, const char *rout, const char *form, ...)
|
||||
* for A and B, lda is in position 11 instead of 9, and ldb is in
|
||||
* position 9 instead of 11.
|
||||
*/
|
||||
if (strstr(rout,"gemm") != 0 && strstr(rout, "gemmtr") == 0)
|
||||
if (strstr(rout,"gemm") != 0)
|
||||
{
|
||||
if (info == 5 ) info = 4;
|
||||
else if (info == 4 ) info = 5;
|
||||
else if (info == 11) info = 9;
|
||||
else if (info == 9 ) info = 11;
|
||||
} else if (strstr(rout, "gemmtr") != 0)
|
||||
{
|
||||
if (info == 11) info = 9;
|
||||
else if (info == 9 ) info = 11;
|
||||
}
|
||||
|
||||
else if (strstr(rout,"symm") != 0 || strstr(rout,"hemm") != 0)
|
||||
{
|
||||
if (info == 5 ) info = 4;
|
||||
@@ -90,20 +85,16 @@ void cblas_xerbla(CBLAS_INT info, const char *rout, const char *form, ...)
|
||||
}
|
||||
|
||||
#ifdef F77_Char
|
||||
void F77_xerbla(F77_Char F77_srname, void *vinfo
|
||||
void F77_xerbla(F77_Char F77_srname, void *vinfo)
|
||||
#else
|
||||
void F77_xerbla(char *srname, void *vinfo
|
||||
void F77_xerbla(char *srname, void *vinfo)
|
||||
#endif
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN srname_len
|
||||
#endif
|
||||
)
|
||||
{
|
||||
#ifdef F77_Char
|
||||
char *srname;
|
||||
#endif
|
||||
|
||||
char rout[] = {'c','b','l','a','s','_','\0','\0','\0','\0','\0','\0','\0', '\0'};
|
||||
char rout[] = {'c','b','l','a','s','_','\0','\0','\0','\0','\0','\0','\0'};
|
||||
|
||||
#ifdef F77_Integer
|
||||
F77_Integer *info=vinfo;
|
||||
@@ -124,8 +115,8 @@ void F77_xerbla(char *srname, void *vinfo
|
||||
link_xerbla = 0;
|
||||
return;
|
||||
}
|
||||
for(i=0; i < 7; i++) rout[i+6] = tolower(srname[i]);
|
||||
for(i=12; i >= 9; i--) if (rout[i] == ' ') rout[i] = '\0';
|
||||
for(i=0; i < 6; i++) rout[i+6] = tolower(srname[i]);
|
||||
for(i=11; i >= 9; i--) if (rout[i] == ' ') rout[i] = '\0';
|
||||
|
||||
/* We increment *info by 1 since the CBLAS interface adds one more
|
||||
* argument to all level 2 and 3 routines.
|
||||
|
||||
@@ -8,14 +8,10 @@ CBLAS_INT link_xerbla=TRUE;
|
||||
char *cblas_rout;
|
||||
|
||||
#ifdef F77_Char
|
||||
void F77_xerbla(F77_Char F77_srname, void *vinfo
|
||||
void F77_xerbla(F77_Char F77_srname, void *vinfo);
|
||||
#else
|
||||
void F77_xerbla(char *srname, void *vinfo
|
||||
void F77_xerbla(char *srname, void *vinfo);
|
||||
#endif
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN srname_len
|
||||
#endif
|
||||
);
|
||||
|
||||
void chkxer(void) {
|
||||
extern CBLAS_INT cblas_ok, cblas_lerr, cblas_info;
|
||||
@@ -28,11 +24,7 @@ void chkxer(void) {
|
||||
cblas_lerr = 1 ;
|
||||
}
|
||||
|
||||
void F77_z2chke(char *rout
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN rout_len
|
||||
#endif
|
||||
) {
|
||||
void F77_z2chke(char *rout) {
|
||||
char *sf = ( rout ) ;
|
||||
double A[2] = {0.0,0.0},
|
||||
X[2] = {0.0,0.0},
|
||||
@@ -48,7 +40,7 @@ void F77_z2chke(char *rout
|
||||
if (link_xerbla) /* call these first to link */
|
||||
{
|
||||
cblas_xerbla(cblas_info,cblas_rout,"");
|
||||
F77_xerbla(cblas_rout,&cblas_info, 1);
|
||||
F77_xerbla(cblas_rout,&cblas_info);
|
||||
}
|
||||
#endif
|
||||
|
||||
|
||||
+6
-243
@@ -8,14 +8,10 @@ CBLAS_INT link_xerbla=TRUE;
|
||||
char *cblas_rout;
|
||||
|
||||
#ifdef F77_Char
|
||||
void F77_xerbla(F77_Char F77_srname, void *vinfo
|
||||
void F77_xerbla(F77_Char F77_srname, void *vinfo);
|
||||
#else
|
||||
void F77_xerbla(char *srname, void *vinfo
|
||||
void F77_xerbla(char *srname, void *vinfo);
|
||||
#endif
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN srname_len
|
||||
#endif
|
||||
);
|
||||
|
||||
void chkxer(void) {
|
||||
extern CBLAS_INT cblas_ok, cblas_lerr, cblas_info;
|
||||
@@ -28,11 +24,7 @@ void chkxer(void) {
|
||||
cblas_lerr = 1 ;
|
||||
}
|
||||
|
||||
void F77_z3chke(char *rout
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN rout_len
|
||||
#endif
|
||||
) {
|
||||
void F77_z3chke(char * rout) {
|
||||
char *sf = ( rout ) ;
|
||||
double A[4] = {0.0,0.0,0.0,0.0},
|
||||
B[4] = {0.0,0.0,0.0,0.0},
|
||||
@@ -51,240 +43,11 @@ void F77_z3chke(char *rout
|
||||
if (link_xerbla) /* call these first to link */
|
||||
{
|
||||
cblas_xerbla(cblas_info,cblas_rout,"");
|
||||
F77_xerbla(cblas_rout,&cblas_info, 1);
|
||||
F77_xerbla(cblas_rout,&cblas_info);
|
||||
}
|
||||
#endif
|
||||
if (strncmp( sf,"cblas_zgemmtr" ,13)==0) {
|
||||
cblas_rout = "cblas_zgemmtr" ;
|
||||
|
||||
cblas_info = 1;
|
||||
cblas_zgemmtr( INVALID, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 1;
|
||||
cblas_zgemmtr( INVALID, CblasUpper, CblasNoTrans, CblasTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 1;
|
||||
cblas_zgemmtr( INVALID, CblasUpper,CblasTrans, CblasNoTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 1;
|
||||
cblas_zgemmtr( INVALID, CblasUpper, CblasTrans, CblasTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 1;
|
||||
cblas_zgemmtr( INVALID, CblasLower, CblasNoTrans, CblasNoTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 1;
|
||||
cblas_zgemmtr( INVALID, CblasLower, CblasNoTrans, CblasTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 1;
|
||||
cblas_zgemmtr( INVALID, CblasLower,CblasTrans, CblasNoTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 1;
|
||||
cblas_zgemmtr( INVALID, CblasLower, CblasTrans, CblasTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 2; RowMajorStrg = FALSE;
|
||||
cblas_zgemmtr( CblasColMajor, INVALID, CblasNoTrans, CblasNoTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 2; RowMajorStrg = FALSE;
|
||||
cblas_zgemmtr( CblasColMajor, INVALID, CblasNoTrans, CblasTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 3; RowMajorStrg = FALSE;
|
||||
cblas_zgemmtr( CblasColMajor, CblasUpper, INVALID, CblasNoTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 3; RowMajorStrg = FALSE;
|
||||
cblas_zgemmtr( CblasColMajor, CblasUpper, INVALID, CblasTrans, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 4; RowMajorStrg = FALSE;
|
||||
cblas_zgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, INVALID, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 4; RowMajorStrg = FALSE;
|
||||
cblas_zgemmtr( CblasColMajor, CblasUpper, CblasTrans, INVALID, 0, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
|
||||
cblas_info = 5; RowMajorStrg = FALSE;
|
||||
cblas_zgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, INVALID, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 5; RowMajorStrg = FALSE;
|
||||
cblas_zgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, INVALID, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 5; RowMajorStrg = FALSE;
|
||||
cblas_zgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, INVALID, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 5; RowMajorStrg = FALSE;
|
||||
cblas_zgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, INVALID, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 6; RowMajorStrg = FALSE;
|
||||
cblas_zgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, INVALID,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 6; RowMajorStrg = FALSE;
|
||||
cblas_zgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, INVALID,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 6; RowMajorStrg = FALSE;
|
||||
cblas_zgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, INVALID,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 6; RowMajorStrg = FALSE;
|
||||
cblas_zgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 0, INVALID,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
|
||||
cblas_info = 9; RowMajorStrg = FALSE;
|
||||
cblas_zgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 2 );
|
||||
chkxer();
|
||||
cblas_info = 9; RowMajorStrg = FALSE;
|
||||
cblas_zgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 2 );
|
||||
chkxer();
|
||||
cblas_info = 9; RowMajorStrg = FALSE;
|
||||
cblas_zgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2,
|
||||
ALPHA, A, 1, B, 2, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 9; RowMajorStrg = FALSE;
|
||||
cblas_zgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 0, 2,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 11; RowMajorStrg = FALSE;
|
||||
cblas_zgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 11; RowMajorStrg = FALSE;
|
||||
cblas_zgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2,
|
||||
ALPHA, A, 2, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 11; RowMajorStrg = FALSE;
|
||||
cblas_zgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 14; RowMajorStrg = FALSE;
|
||||
cblas_zgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0,
|
||||
ALPHA, A, 2, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 14; RowMajorStrg = FALSE;
|
||||
cblas_zgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0,
|
||||
ALPHA, A, 2, B, 2, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 14; RowMajorStrg = FALSE;
|
||||
cblas_zgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0,
|
||||
ALPHA, A, 2, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 14; RowMajorStrg = FALSE;
|
||||
cblas_zgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0,
|
||||
ALPHA, A, 2, B, 2, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
/* Row Major */
|
||||
cblas_info = 5; RowMajorStrg = TRUE;
|
||||
cblas_zgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, INVALID, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 5; RowMajorStrg = TRUE;
|
||||
cblas_zgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, INVALID, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 5; RowMajorStrg = TRUE;
|
||||
cblas_zgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, INVALID, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 5; RowMajorStrg = TRUE;
|
||||
cblas_zgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, INVALID, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 6; RowMajorStrg = TRUE;
|
||||
cblas_zgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, INVALID,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 6; RowMajorStrg = TRUE;
|
||||
cblas_zgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, INVALID,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 6; RowMajorStrg = TRUE;
|
||||
cblas_zgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, INVALID,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 6; RowMajorStrg = TRUE;
|
||||
cblas_zgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 0, INVALID,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 9; RowMajorStrg = TRUE;
|
||||
cblas_zgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 2 );
|
||||
chkxer();
|
||||
cblas_info = 9; RowMajorStrg = TRUE;
|
||||
cblas_zgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, 2,
|
||||
ALPHA, A, 1, B, 2, BETA, C, 2 );
|
||||
chkxer();
|
||||
cblas_info = 9; RowMajorStrg = TRUE;
|
||||
cblas_zgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0,
|
||||
ALPHA, A, 1, B, 2, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 9; RowMajorStrg = TRUE;
|
||||
cblas_zgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 11; RowMajorStrg = TRUE;
|
||||
cblas_zgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 11; RowMajorStrg = TRUE;
|
||||
cblas_zgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2,
|
||||
ALPHA, A, 2, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 11; RowMajorStrg = TRUE;
|
||||
cblas_zgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0,
|
||||
ALPHA, A, 1, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
cblas_info = 14; RowMajorStrg = TRUE;
|
||||
cblas_zgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0,
|
||||
ALPHA, A, 2, B, 2, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 14; RowMajorStrg = TRUE;
|
||||
cblas_zgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0,
|
||||
ALPHA, A, 2, B, 1, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 14; RowMajorStrg = TRUE;
|
||||
cblas_zgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0,
|
||||
ALPHA, A, 2, B, 2, BETA, C, 1 );
|
||||
chkxer();
|
||||
cblas_info = 14; RowMajorStrg = TRUE;
|
||||
cblas_zgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0,
|
||||
ALPHA, A, 2, B, 2, BETA, C, 1 );
|
||||
chkxer();
|
||||
|
||||
} else if (strncmp( sf,"cblas_zgemm" ,11)==0) {
|
||||
if (strncmp( sf,"cblas_zgemm" ,11)==0) {
|
||||
cblas_rout = "cblas_zgemm" ;
|
||||
|
||||
cblas_info = 1;
|
||||
@@ -1939,7 +1702,7 @@ void F77_z3chke(char *rout
|
||||
}
|
||||
|
||||
if (cblas_ok == 1 )
|
||||
printf(" %-13s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout);
|
||||
printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout);
|
||||
else
|
||||
printf("***** %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout);
|
||||
}
|
||||
|
||||
+15
-75
@@ -11,11 +11,7 @@
|
||||
void F77_zgemv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n,
|
||||
const void *alpha,
|
||||
CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, const void *x, CBLAS_INT *incx,
|
||||
const void *beta, void *y, CBLAS_INT *incy
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN transp_len
|
||||
#endif
|
||||
) {
|
||||
const void *beta, void *y, CBLAS_INT *incy) {
|
||||
|
||||
CBLAS_TEST_ZOMPLEX *A;
|
||||
CBLAS_INT i,j,LDA;
|
||||
@@ -45,11 +41,7 @@ void F77_zgemv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n,
|
||||
void F77_zgbmv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, CBLAS_INT *kl, CBLAS_INT *ku,
|
||||
CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda,
|
||||
CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx,
|
||||
CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN transp_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy) {
|
||||
|
||||
CBLAS_TEST_ZOMPLEX *A;
|
||||
CBLAS_INT i,j,irow,jcol,LDA;
|
||||
@@ -152,11 +144,7 @@ void F77_zgerc(CBLAS_INT *layout, CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX
|
||||
|
||||
void F77_zhemv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *alpha,
|
||||
CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *x,
|
||||
CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
){
|
||||
CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy){
|
||||
|
||||
CBLAS_TEST_ZOMPLEX *A;
|
||||
CBLAS_INT i,j,LDA;
|
||||
@@ -187,11 +175,7 @@ void F77_zhemv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX
|
||||
void F77_zhbmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_INT *k,
|
||||
CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda,
|
||||
CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *beta,
|
||||
CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
){
|
||||
CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy){
|
||||
|
||||
CBLAS_TEST_ZOMPLEX *A;
|
||||
CBLAS_INT i,irow,j,jcol,LDA;
|
||||
@@ -254,11 +238,7 @@ CBLAS_INT i,irow,j,jcol,LDA;
|
||||
|
||||
void F77_zhpmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *alpha,
|
||||
CBLAS_TEST_ZOMPLEX *ap, CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx,
|
||||
CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
){
|
||||
CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy){
|
||||
|
||||
CBLAS_TEST_ZOMPLEX *A, *AP;
|
||||
CBLAS_INT i,j,k,LDA;
|
||||
@@ -314,11 +294,7 @@ void F77_zhpmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX
|
||||
|
||||
void F77_ztbmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
CBLAS_INT *n, CBLAS_INT *k, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *x,
|
||||
CBLAS_INT *incx
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *incx) {
|
||||
CBLAS_TEST_ZOMPLEX *A;
|
||||
CBLAS_INT irow, jcol, i, j, LDA;
|
||||
CBLAS_TRANSPOSE trans;
|
||||
@@ -381,11 +357,7 @@ void F77_ztbmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
|
||||
void F77_ztbsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
CBLAS_INT *n, CBLAS_INT *k, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *x,
|
||||
CBLAS_INT *incx
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *incx) {
|
||||
|
||||
CBLAS_TEST_ZOMPLEX *A;
|
||||
CBLAS_INT irow, jcol, i, j, LDA;
|
||||
@@ -448,11 +420,7 @@ void F77_ztbsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
}
|
||||
|
||||
void F77_ztpmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *ap, CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *ap, CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx) {
|
||||
CBLAS_TEST_ZOMPLEX *A, *AP;
|
||||
CBLAS_INT i, j, k, LDA;
|
||||
CBLAS_TRANSPOSE trans;
|
||||
@@ -507,11 +475,7 @@ void F77_ztpmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
}
|
||||
|
||||
void F77_ztpsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *ap, CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *ap, CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx) {
|
||||
CBLAS_TEST_ZOMPLEX *A, *AP;
|
||||
CBLAS_INT i, j, k, LDA;
|
||||
CBLAS_TRANSPOSE trans;
|
||||
@@ -567,11 +531,7 @@ void F77_ztpsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
|
||||
void F77_ztrmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *x,
|
||||
CBLAS_INT *incx
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *incx) {
|
||||
CBLAS_TEST_ZOMPLEX *A;
|
||||
CBLAS_INT i,j,LDA;
|
||||
CBLAS_TRANSPOSE trans;
|
||||
@@ -600,11 +560,7 @@ void F77_ztrmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
}
|
||||
void F77_ztrsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *x,
|
||||
CBLAS_INT *incx
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *incx) {
|
||||
CBLAS_TEST_ZOMPLEX *A;
|
||||
CBLAS_INT i,j,LDA;
|
||||
CBLAS_TRANSPOSE trans;
|
||||
@@ -633,11 +589,7 @@ void F77_ztrsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
|
||||
}
|
||||
|
||||
void F77_zhpr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha,
|
||||
CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *ap
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *ap) {
|
||||
CBLAS_TEST_ZOMPLEX *A, *AP;
|
||||
CBLAS_INT i,j,k,LDA;
|
||||
CBLAS_UPLO uplo;
|
||||
@@ -713,11 +665,7 @@ void F77_zhpr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha,
|
||||
|
||||
void F77_zhpr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *alpha,
|
||||
CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy,
|
||||
CBLAS_TEST_ZOMPLEX *ap
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_TEST_ZOMPLEX *ap) {
|
||||
CBLAS_TEST_ZOMPLEX *A, *AP;
|
||||
CBLAS_INT i,j,k,LDA;
|
||||
CBLAS_UPLO uplo;
|
||||
@@ -793,11 +741,7 @@ void F77_zhpr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX
|
||||
}
|
||||
|
||||
void F77_zher(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha,
|
||||
CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda) {
|
||||
CBLAS_TEST_ZOMPLEX *A;
|
||||
CBLAS_INT i,j,LDA;
|
||||
CBLAS_UPLO uplo;
|
||||
@@ -830,11 +774,7 @@ void F77_zher(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha,
|
||||
|
||||
void F77_zher2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *alpha,
|
||||
CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy,
|
||||
CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda) {
|
||||
|
||||
CBLAS_TEST_ZOMPLEX *A;
|
||||
CBLAS_INT i,j,LDA;
|
||||
|
||||
+9
-128
@@ -5,7 +5,6 @@
|
||||
* Modified by T. H. Do, 4/15/98, SGI/CRAY Research.
|
||||
*/
|
||||
#include <stdlib.h>
|
||||
#include <stdio.h>
|
||||
#include "cblas.h"
|
||||
#include "cblas_test.h"
|
||||
#define TEST_COL_MJR 0
|
||||
@@ -15,11 +14,7 @@
|
||||
void F77_zgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CBLAS_INT *n,
|
||||
CBLAS_INT *k, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda,
|
||||
CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_ZOMPLEX *beta,
|
||||
CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN transpa_len, FORTRAN_STRLEN transpb_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc ) {
|
||||
|
||||
CBLAS_TEST_ZOMPLEX *A, *B, *C;
|
||||
CBLAS_INT i,j,LDA, LDB, LDC;
|
||||
@@ -92,96 +87,10 @@ void F77_zgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CB
|
||||
cblas_zgemm( UNDEFINED, transa, transb, *m, *n, *k, alpha, a, *lda,
|
||||
b, *ldb, beta, c, *ldc );
|
||||
}
|
||||
|
||||
|
||||
void F77_zgemmtr(CBLAS_INT *layout, char *uplop, char *transpa, char *transpb, CBLAS_INT *n,
|
||||
CBLAS_INT *k, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda,
|
||||
CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_ZOMPLEX *beta,
|
||||
CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc ) {
|
||||
|
||||
CBLAS_TEST_ZOMPLEX *A, *B, *C;
|
||||
CBLAS_INT i,j,LDA, LDB, LDC;
|
||||
CBLAS_TRANSPOSE transa, transb;
|
||||
CBLAS_UPLO uplo;
|
||||
|
||||
get_transpose_type(transpa, &transa);
|
||||
get_transpose_type(transpb, &transb);
|
||||
get_uplo_type(uplop, &uplo);
|
||||
|
||||
if (*layout == TEST_ROW_MJR) {
|
||||
if (transa == CblasNoTrans) {
|
||||
LDA = *k+1;
|
||||
A=(CBLAS_TEST_ZOMPLEX*)malloc((*n)*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
|
||||
for( i=0; i<*n; i++ )
|
||||
for( j=0; j<*k; j++ ) {
|
||||
A[i*LDA+j].real=a[j*(*lda)+i].real;
|
||||
A[i*LDA+j].imag=a[j*(*lda)+i].imag;
|
||||
}
|
||||
}
|
||||
else {
|
||||
LDA = *n+1;
|
||||
A=(CBLAS_TEST_ZOMPLEX* )malloc(LDA*(*k)*sizeof(CBLAS_TEST_ZOMPLEX));
|
||||
for( i=0; i<*k; i++ )
|
||||
for( j=0; j<*n; j++ ) {
|
||||
A[i*LDA+j].real=a[j*(*lda)+i].real;
|
||||
A[i*LDA+j].imag=a[j*(*lda)+i].imag;
|
||||
}
|
||||
}
|
||||
|
||||
if (transb == CblasNoTrans) {
|
||||
LDB = *n+1;
|
||||
B=(CBLAS_TEST_ZOMPLEX* )malloc((*k)*LDB*sizeof(CBLAS_TEST_ZOMPLEX) );
|
||||
for( i=0; i<*k; i++ )
|
||||
for( j=0; j<*n; j++ ) {
|
||||
B[i*LDB+j].real=b[j*(*ldb)+i].real;
|
||||
B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
|
||||
}
|
||||
}
|
||||
else {
|
||||
LDB = *k+1;
|
||||
B=(CBLAS_TEST_ZOMPLEX* )malloc(LDB*(*n)*sizeof(CBLAS_TEST_ZOMPLEX));
|
||||
for( i=0; i<*n; i++ )
|
||||
for( j=0; j<*k; j++ ) {
|
||||
B[i*LDB+j].real=b[j*(*ldb)+i].real;
|
||||
B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
|
||||
}
|
||||
}
|
||||
|
||||
LDC = *n+1;
|
||||
C=(CBLAS_TEST_ZOMPLEX* )malloc((*n)*LDC*sizeof(CBLAS_TEST_ZOMPLEX));
|
||||
for( j=0; j<*n; j++ )
|
||||
for( i=0; i<*n; i++ ) {
|
||||
C[i*LDC+j].real=c[j*(*ldc)+i].real;
|
||||
C[i*LDC+j].imag=c[j*(*ldc)+i].imag;
|
||||
}
|
||||
cblas_zgemmtr( CblasRowMajor, uplo, transa, transb, *n, *k, alpha, A, LDA,
|
||||
B, LDB, beta, C, LDC );
|
||||
for( j=0; j<*n; j++ )
|
||||
for( i=0; i<*n; i++ ) {
|
||||
c[j*(*ldc)+i].real=C[i*LDC+j].real;
|
||||
c[j*(*ldc)+i].imag=C[i*LDC+j].imag;
|
||||
}
|
||||
free(A);
|
||||
free(B);
|
||||
free(C);
|
||||
}
|
||||
else if (*layout == TEST_COL_MJR)
|
||||
cblas_zgemmtr( CblasColMajor, uplo, transa, transb, *n, *k, alpha, a, *lda,
|
||||
b, *ldb, beta, c, *ldc );
|
||||
else
|
||||
cblas_zgemmtr( UNDEFINED, uplo, transa, transb, *n, *k, alpha, a, *lda,
|
||||
b, *ldb, beta, c, *ldc );
|
||||
}
|
||||
|
||||
|
||||
void F77_zhemm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_INT *n,
|
||||
CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda,
|
||||
CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_ZOMPLEX *beta,
|
||||
CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc ) {
|
||||
|
||||
CBLAS_TEST_ZOMPLEX *A, *B, *C;
|
||||
CBLAS_INT i,j,LDA, LDB, LDC;
|
||||
@@ -245,11 +154,7 @@ void F77_zhemm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_I
|
||||
void F77_zsymm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_INT *n,
|
||||
CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda,
|
||||
CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_ZOMPLEX *beta,
|
||||
CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc ) {
|
||||
|
||||
CBLAS_TEST_ZOMPLEX *A, *B, *C;
|
||||
CBLAS_INT i,j,LDA, LDB, LDC;
|
||||
@@ -303,11 +208,7 @@ void F77_zsymm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_I
|
||||
|
||||
void F77_zherk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k,
|
||||
double *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda,
|
||||
double *beta, CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len
|
||||
#endif
|
||||
) {
|
||||
double *beta, CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc ) {
|
||||
|
||||
CBLAS_INT i,j,LDA,LDC;
|
||||
CBLAS_TEST_ZOMPLEX *A, *C;
|
||||
@@ -363,11 +264,7 @@ void F77_zherk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS
|
||||
|
||||
void F77_zsyrk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k,
|
||||
CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda,
|
||||
CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc ) {
|
||||
|
||||
CBLAS_INT i,j,LDA,LDC;
|
||||
CBLAS_TEST_ZOMPLEX *A, *C;
|
||||
@@ -423,11 +320,7 @@ void F77_zsyrk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS
|
||||
void F77_zher2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k,
|
||||
CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda,
|
||||
CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb, double *beta,
|
||||
CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc ) {
|
||||
CBLAS_INT i,j,LDA,LDB,LDC;
|
||||
CBLAS_TEST_ZOMPLEX *A, *B, *C;
|
||||
CBLAS_UPLO uplo;
|
||||
@@ -491,11 +384,7 @@ void F77_zher2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLA
|
||||
void F77_zsyr2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k,
|
||||
CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda,
|
||||
CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_ZOMPLEX *beta,
|
||||
CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc ) {
|
||||
CBLAS_INT i,j,LDA,LDB,LDC;
|
||||
CBLAS_TEST_ZOMPLEX *A, *B, *C;
|
||||
CBLAS_UPLO uplo;
|
||||
@@ -558,11 +447,7 @@ void F77_zsyr2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLA
|
||||
}
|
||||
void F77_ztrmm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *diagn,
|
||||
CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a,
|
||||
CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb) {
|
||||
CBLAS_INT i,j,LDA,LDB;
|
||||
CBLAS_TEST_ZOMPLEX *A, *B;
|
||||
CBLAS_SIDE side;
|
||||
@@ -621,11 +506,7 @@ void F77_ztrmm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *d
|
||||
|
||||
void F77_ztrsm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *diagn,
|
||||
CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a,
|
||||
CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb
|
||||
#ifdef BLAS_FORTRAN_STRLEN_END
|
||||
, FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
|
||||
#endif
|
||||
) {
|
||||
CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb) {
|
||||
CBLAS_INT i,j,LDA,LDB;
|
||||
CBLAS_TEST_ZOMPLEX *A, *B;
|
||||
CBLAS_SIDE side;
|
||||
|
||||
@@ -349,13 +349,13 @@
|
||||
CALL ZCHK3( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
$ REWI, FATAL, NIDIM, IDIM, NKB, KB, NINC, INC,
|
||||
$ NMAX, INCMAX, A, AA, AS, Y, YY, YS, YT, G, Z,
|
||||
$ 0 )
|
||||
$ 0 )
|
||||
END IF
|
||||
IF (RORDER) THEN
|
||||
CALL ZCHK3( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
$ REWI, FATAL, NIDIM, IDIM, NKB, KB, NINC, INC,
|
||||
$ NMAX, INCMAX, A, AA, AS, Y, YY, YS, YT, G, Z,
|
||||
$ 1 )
|
||||
$ 1 )
|
||||
END IF
|
||||
GO TO 200
|
||||
* Test ZGERC, 12, ZGERU, 13.
|
||||
|
||||
+76
-628
@@ -4,7 +4,7 @@
|
||||
*
|
||||
* The program must be driven by a short data file. The first 13 records
|
||||
* of the file are read using list-directed input, the last 9 records
|
||||
* are read using the format ( A13,L2 ). An annotated example of a data
|
||||
* are read using the format ( A12,L2 ). An annotated example of a data
|
||||
* file can be obtained by deleting the first 3 characters from the
|
||||
* following 22 lines:
|
||||
* 'CBLAT3.SNAP' NAME OF SNAPSHOT OUTPUT FILE
|
||||
@@ -20,17 +20,16 @@
|
||||
* (0.0,0.0) (1.0,0.0) (0.7,-0.9) VALUES OF ALPHA
|
||||
* 3 NUMBER OF VALUES OF BETA
|
||||
* (0.0,0.0) (1.0,0.0) (1.3,-1.1) VALUES OF BETA
|
||||
* cblas_zgemm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_zhemm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_zsymm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_ztrmm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_ztrsm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_zherk T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_zsyrk T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_zher2k T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_zsyr2k T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* cblas_zgemmtr T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
|
||||
* ZGEMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* ZHEMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* ZSYMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* ZTRMM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* ZTRSM T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* ZHERK T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* ZSYRK T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* ZHER2K T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
* ZSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
*
|
||||
* See:
|
||||
*
|
||||
* Dongarra J. J., Du Croz J. J., Duff I. S. and Hammarling S.
|
||||
@@ -50,7 +49,7 @@
|
||||
INTEGER NIN, NOUT
|
||||
PARAMETER ( NIN = 5, NOUT = 6 )
|
||||
INTEGER NSUBS
|
||||
PARAMETER ( NSUBS = 10 )
|
||||
PARAMETER ( NSUBS = 9 )
|
||||
COMPLEX*16 ZERO, ONE
|
||||
PARAMETER ( ZERO = ( 0.0D0, 0.0D0 ),
|
||||
$ ONE = ( 1.0D0, 0.0D0 ) )
|
||||
@@ -67,7 +66,7 @@
|
||||
LOGICAL FATAL, LTESTT, REWI, SAME, SFATAL, TRACE,
|
||||
$ TSTERR, CORDER, RORDER
|
||||
CHARACTER*1 TRANSA, TRANSB
|
||||
CHARACTER*13 SNAMET
|
||||
CHARACTER*12 SNAMET
|
||||
CHARACTER*32 SNAPS
|
||||
* .. Local Arrays ..
|
||||
COMPLEX*16 AA( NMAX*NMAX ), AB( NMAX, 2*NMAX ),
|
||||
@@ -79,19 +78,19 @@
|
||||
DOUBLE PRECISION G( NMAX )
|
||||
INTEGER IDIM( NIDMAX )
|
||||
LOGICAL LTEST( NSUBS )
|
||||
CHARACTER*13 SNAMES( NSUBS )
|
||||
CHARACTER*12 SNAMES( NSUBS )
|
||||
* .. External Functions ..
|
||||
DOUBLE PRECISION DDIFF
|
||||
LOGICAL LZE
|
||||
EXTERNAL DDIFF, LZE
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL ZCHK1, ZCHK2, ZCHK3, ZCHK4, ZCHK5, ZCHK6, ZMMCH
|
||||
EXTERNAL ZCHK1, ZCHK2, ZCHK3, ZCHK4, ZCHK5,ZMMCH
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC MAX, MIN
|
||||
* .. Scalars in Common ..
|
||||
INTEGER INFOT, NOUTC
|
||||
LOGICAL LERR, OK
|
||||
CHARACTER*13 SRNAMT
|
||||
CHARACTER*12 SRNAMT
|
||||
* .. Common blocks ..
|
||||
COMMON /INFOC/INFOT, NOUTC, OK, LERR
|
||||
COMMON /SRNAMC/SRNAMT
|
||||
@@ -99,7 +98,7 @@
|
||||
DATA SNAMES/'cblas_zgemm ', 'cblas_zhemm ',
|
||||
$ 'cblas_zsymm ', 'cblas_ztrmm ', 'cblas_ztrsm ',
|
||||
$ 'cblas_zherk ', 'cblas_zsyrk ', 'cblas_zher2k',
|
||||
$ 'cblas_zsyr2k', 'cblas_zgemmtr'/
|
||||
$ 'cblas_zsyr2k'/
|
||||
* .. Executable Statements ..
|
||||
*
|
||||
NOUTC = NOUT
|
||||
@@ -297,7 +296,7 @@
|
||||
OK = .TRUE.
|
||||
FATAL = .FALSE.
|
||||
GO TO ( 140, 150, 150, 160, 160, 170, 170,
|
||||
$ 180, 180, 185) ISNUM
|
||||
$ 180, 180 )ISNUM
|
||||
* Test ZGEMM, 01.
|
||||
140 IF (CORDER) THEN
|
||||
CALL ZCHK1(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
@@ -331,13 +330,13 @@
|
||||
CALL ZCHK3(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NMAX, AB,
|
||||
$ AA, AS, AB( 1, NMAX + 1 ), BB, BS, CT, G, C,
|
||||
$ 0 )
|
||||
$ 0 )
|
||||
END IF
|
||||
IF (RORDER) THEN
|
||||
CALL ZCHK3(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NMAX, AB,
|
||||
$ AA, AS, AB( 1, NMAX + 1 ), BB, BS, CT, G, C,
|
||||
$ 1 )
|
||||
$ 1 )
|
||||
END IF
|
||||
GO TO 190
|
||||
* Test ZHERK, 06, ZSYRK, 07.
|
||||
@@ -359,27 +358,13 @@
|
||||
CALL ZCHK5(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
|
||||
$ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W,
|
||||
$ 0 )
|
||||
$ 0 )
|
||||
END IF
|
||||
IF (RORDER) THEN
|
||||
CALL ZCHK5(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
|
||||
$ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W,
|
||||
$ 1 )
|
||||
END IF
|
||||
GO TO 190
|
||||
* Test ZGEMMTR, 10
|
||||
185 IF (CORDER) THEN
|
||||
CALL ZCHK6(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
|
||||
$ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
|
||||
$ CC, CS, CT, G, 0 )
|
||||
END IF
|
||||
IF (RORDER) THEN
|
||||
CALL ZCHK6(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
|
||||
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
|
||||
$ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
|
||||
$ CC, CS, CT, G, 1 )
|
||||
$ 1 )
|
||||
END IF
|
||||
GO TO 190
|
||||
*
|
||||
@@ -421,7 +406,7 @@
|
||||
$ 7( '(', F4.1, ',', F4.1, ') ', : ) )
|
||||
9991 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM',
|
||||
$ /' ******* TESTS ABANDONED *******' )
|
||||
9990 FORMAT(' SUBPROGRAM NAME ', A13,' NOT RECOGNIZED', /' ******* T',
|
||||
9990 FORMAT(' SUBPROGRAM NAME ', A12,' NOT RECOGNIZED', /' ******* T',
|
||||
$ 'ESTS ABANDONED *******' )
|
||||
9989 FORMAT(' ERROR IN ZMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALU',
|
||||
$ 'ATED WRONGLY.', /' ZMMCH WAS CALLED WITH TRANSA = ', A1,
|
||||
@@ -429,8 +414,8 @@
|
||||
$ ' ERR = ', F12.3, '.', /' THIS MAY BE DUE TO FAULTS IN THE ',
|
||||
$ 'ARITHMETIC OR THE COMPILER.', /' ******* TESTS ABANDONED ',
|
||||
$ '*******' )
|
||||
9988 FORMAT( A13,L2 )
|
||||
9987 FORMAT( 1X, A13,' WAS NOT TESTED' )
|
||||
9988 FORMAT( A12,L2 )
|
||||
9987 FORMAT( 1X, A12,' WAS NOT TESTED' )
|
||||
9986 FORMAT( /' END OF TESTS' )
|
||||
9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' )
|
||||
9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' )
|
||||
@@ -462,7 +447,7 @@
|
||||
DOUBLE PRECISION EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
* .. Array Arguments ..
|
||||
COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
@@ -710,20 +695,20 @@
|
||||
130 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(''', A1, ''',''', A1, ''',',
|
||||
9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( 1X, I6, ': ', A12,'(''', A1, ''',''', A1, ''',',
|
||||
$ 3( I3, ',' ), '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3,
|
||||
$ ',(', F4.1, ',', F4.1, '), C,', I3, ').' )
|
||||
9994 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
@@ -738,7 +723,7 @@
|
||||
INTEGER NOUT, NC, IORDER, M, N, K, LDA, LDB, LDC
|
||||
DOUBLE COMPLEX ALPHA, BETA
|
||||
CHARACTER*1 TRANSA, TRANSB
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
CHARACTER*14 CRC, CTA,CTB
|
||||
|
||||
IF (TRANSA.EQ.'N')THEN
|
||||
@@ -763,7 +748,7 @@
|
||||
WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CTA,CTB
|
||||
WRITE(NOUT, FMT = 9994)M, N, K, ALPHA, LDA, LDB, BETA, LDC
|
||||
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',')
|
||||
9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',')
|
||||
9994 FORMAT( 10X, 3( I3, ',' ) ,' (', F4.1,',',F4.1,') , A,',
|
||||
$ I3, ', B,', I3, ', (', F4.1,',',F4.1,') , C,', I3, ').' )
|
||||
END
|
||||
@@ -792,7 +777,7 @@
|
||||
DOUBLE PRECISION EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
* .. Array Arguments ..
|
||||
COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
@@ -1036,20 +1021,20 @@
|
||||
120 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT(1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
$ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1,
|
||||
$ ',', F4.1, '), C,', I3, ') .' )
|
||||
9994 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
@@ -1064,7 +1049,7 @@
|
||||
INTEGER NOUT, NC, IORDER, M, N, LDA, LDB, LDC
|
||||
DOUBLE COMPLEX ALPHA, BETA
|
||||
CHARACTER*1 SIDE, UPLO
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
CHARACTER*14 CRC, CS,CU
|
||||
|
||||
IF (SIDE.EQ.'L')THEN
|
||||
@@ -1085,7 +1070,7 @@
|
||||
WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CS,CU
|
||||
WRITE(NOUT, FMT = 9994)M, N, ALPHA, LDA, LDB, BETA, LDC
|
||||
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',')
|
||||
9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',')
|
||||
9994 FORMAT( 10X, 2( I3, ',' ),' (',F4.1,',',F4.1, '), A,', I3,
|
||||
$ ', B,', I3, ', (',F4.1,',',F4.1, '), ', 'C,', I3, ').' )
|
||||
END
|
||||
@@ -1113,7 +1098,7 @@
|
||||
DOUBLE PRECISION EPS, THRESH
|
||||
INTEGER NALF, NIDIM, NMAX, NOUT, NTRA, IORDER
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
* .. Array Arguments ..
|
||||
COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
@@ -1388,20 +1373,20 @@
|
||||
160 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9996 FORMAT(' ******* ', A13,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT(1X, I6, ': ', A13,'(', 4( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
9996 FORMAT(' ******* ', A12,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT(1X, I6, ': ', A12,'(', 4( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
$ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ') ',
|
||||
$ ' .' )
|
||||
9994 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
@@ -1416,7 +1401,7 @@
|
||||
INTEGER NOUT, NC, IORDER, M, N, LDA, LDB
|
||||
DOUBLE COMPLEX ALPHA
|
||||
CHARACTER*1 SIDE, UPLO, TRANSA, DIAG
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
CHARACTER*14 CRC, CS, CU, CA, CD
|
||||
|
||||
IF (SIDE.EQ.'L')THEN
|
||||
@@ -1449,7 +1434,7 @@
|
||||
WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CS,CU
|
||||
WRITE(NOUT, FMT = 9994)CA, CD, M, N, ALPHA, LDA, LDB
|
||||
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',')
|
||||
9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',')
|
||||
9994 FORMAT( 10X, 2( A14, ',') , 2( I3, ',' ), ' (', F4.1, ',',
|
||||
$ F4.1, '), A,', I3, ', B,', I3, ').' )
|
||||
END
|
||||
@@ -1478,7 +1463,7 @@
|
||||
DOUBLE PRECISION EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
* .. Array Arguments ..
|
||||
COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
@@ -1770,24 +1755,24 @@
|
||||
130 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' )
|
||||
9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 )
|
||||
9994 FORMAT(1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
9994 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
$ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ') ',
|
||||
$ ' .' )
|
||||
9993 FORMAT(1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
9993 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
$ '(', F4.1, ',', F4.1, ') , A,', I3, ',(', F4.1, ',', F4.1,
|
||||
$ '), C,', I3, ') .' )
|
||||
9992 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
@@ -1802,7 +1787,7 @@
|
||||
INTEGER NOUT, NC, IORDER, N, K, LDA, LDC
|
||||
DOUBLE COMPLEX ALPHA, BETA
|
||||
CHARACTER*1 UPLO, TRANSA
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
CHARACTER*14 CRC, CU, CA
|
||||
|
||||
IF (UPLO.EQ.'U')THEN
|
||||
@@ -1825,7 +1810,7 @@
|
||||
WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA
|
||||
WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, BETA, LDC
|
||||
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') )
|
||||
9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') )
|
||||
9994 FORMAT( 10X, 2( I3, ',' ), ' (', F4.1, ',', F4.1 ,'), A,',
|
||||
$ I3, ', (', F4.1,',', F4.1, '), C,', I3, ').' )
|
||||
END
|
||||
@@ -1836,7 +1821,7 @@
|
||||
INTEGER NOUT, NC, IORDER, N, K, LDA, LDC
|
||||
DOUBLE PRECISION ALPHA, BETA
|
||||
CHARACTER*1 UPLO, TRANSA
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
CHARACTER*14 CRC, CU, CA
|
||||
|
||||
IF (UPLO.EQ.'U')THEN
|
||||
@@ -1859,7 +1844,7 @@
|
||||
WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA
|
||||
WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, BETA, LDC
|
||||
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') )
|
||||
9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') )
|
||||
9994 FORMAT( 10X, 2( I3, ',' ),
|
||||
$ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ').' )
|
||||
END
|
||||
@@ -1888,7 +1873,7 @@
|
||||
DOUBLE PRECISION EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
* .. Array Arguments ..
|
||||
COMPLEX*16 AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ),
|
||||
$ ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ),
|
||||
@@ -2223,24 +2208,24 @@
|
||||
160 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' )
|
||||
9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 )
|
||||
9994 FORMAT(1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
9994 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
$ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',', F4.1,
|
||||
$ ', C,', I3, ') .' )
|
||||
9993 FORMAT(1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
9993 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
|
||||
$ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1,
|
||||
$ ',', F4.1, '), C,', I3, ') .' )
|
||||
9992 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
@@ -2255,7 +2240,7 @@
|
||||
INTEGER NOUT, NC, IORDER, N, K, LDA, LDB, LDC
|
||||
DOUBLE COMPLEX ALPHA, BETA
|
||||
CHARACTER*1 UPLO, TRANSA
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
CHARACTER*14 CRC, CU, CA
|
||||
|
||||
IF (UPLO.EQ.'U')THEN
|
||||
@@ -2278,7 +2263,7 @@
|
||||
WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA
|
||||
WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, LDB, BETA, LDC
|
||||
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') )
|
||||
9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') )
|
||||
9994 FORMAT( 10X, 2( I3, ',' ), ' (', F4.1, ',', F4.1, '), A,',
|
||||
$ I3, ', B', I3, ', (', F4.1, ',', F4.1, '), C,', I3, ').' )
|
||||
END
|
||||
@@ -2290,7 +2275,7 @@
|
||||
DOUBLE COMPLEX ALPHA
|
||||
DOUBLE PRECISION BETA
|
||||
CHARACTER*1 UPLO, TRANSA
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*12 SNAME
|
||||
CHARACTER*14 CRC, CU, CA
|
||||
|
||||
IF (UPLO.EQ.'U')THEN
|
||||
@@ -2313,7 +2298,7 @@
|
||||
WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA
|
||||
WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, LDB, BETA, LDC
|
||||
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') )
|
||||
9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') )
|
||||
9994 FORMAT( 10X, 2( I3, ',' ), ' (', F4.1, ',', F4.1, '), A,',
|
||||
$ I3, ', B', I3, ',', F4.1, ', C,', I3, ').' )
|
||||
END
|
||||
@@ -2805,540 +2790,3 @@
|
||||
*
|
||||
END
|
||||
|
||||
SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
|
||||
$ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
|
||||
$ A, AA, AS, B, BB, BS, C, CC, CS, CT, G,
|
||||
$ IORDER )
|
||||
IMPLICIT NONE
|
||||
*
|
||||
* Tests CGEMMTR.
|
||||
*
|
||||
* Auxiliary routine for test program for Level 3 Blas.
|
||||
*
|
||||
* -- Written on 24-June-2024.
|
||||
* Martin Koehler, Max Planck Institute Magdeburg
|
||||
*
|
||||
* .. Parameters ..
|
||||
COMPLEX*16 ZERO
|
||||
PARAMETER ( ZERO = ( 0.0, 0.0 ) )
|
||||
DOUBLE PRECISION RZERO
|
||||
PARAMETER ( RZERO = 0.0 )
|
||||
* .. Scalar Arguments ..
|
||||
DOUBLE PRECISION EPS, THRESH
|
||||
INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER
|
||||
LOGICAL FATAL, REWI, TRACE
|
||||
CHARACTER*13 SNAME
|
||||
* .. Array Arguments ..
|
||||
COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
|
||||
$ AS( NMAX*NMAX ), B( NMAX, NMAX ),
|
||||
$ BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
|
||||
$ C( NMAX, NMAX ), CC( NMAX*NMAX ),
|
||||
$ CS( NMAX*NMAX ), CT( NMAX )
|
||||
DOUBLE PRECISION G( NMAX )
|
||||
INTEGER IDIM( NIDIM )
|
||||
* .. Local Scalars ..
|
||||
COMPLEX*16 ALPHA, ALS, BETA, BLS
|
||||
DOUBLE PRECISION ERR, ERRMAX
|
||||
INTEGER I, IA, IB, ICA, ICB, IK, IM, IN, K, KS, LAA,
|
||||
$ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS,
|
||||
$ MA, MB, N, NA, NARGS, NB, NC, NS, IS
|
||||
LOGICAL NULL, RESET, SAME, TRANA, TRANB
|
||||
CHARACTER*1 TRANAS, TRANBS, TRANSA, TRANSB, UPLO, UPLOS
|
||||
CHARACTER*3 ICH
|
||||
CHARACTER*2 ISHAPE
|
||||
* .. Local Arrays ..
|
||||
LOGICAL ISAME( 13 )
|
||||
* .. External Functions ..
|
||||
LOGICAL LZE, LZERES
|
||||
EXTERNAL LZE, LZERES
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL CZGEMMTR, ZMAKE, ZMMTCH, ZPRCN8
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC MAX
|
||||
* .. Scalars in Common ..
|
||||
INTEGER INFOT, NOUTC
|
||||
LOGICAL LERR, OK
|
||||
* .. Common blocks ..
|
||||
COMMON /INFOC/INFOT, NOUTC, OK, LERR
|
||||
* .. Data statements ..
|
||||
DATA ICH/'NTC'/
|
||||
DATA ISHAPE/'UL'/
|
||||
* .. Executable Statements ..
|
||||
*
|
||||
NARGS = 13
|
||||
NC = 0
|
||||
RESET = .TRUE.
|
||||
ERRMAX = RZERO
|
||||
*
|
||||
DO 100 IN = 1, NIDIM
|
||||
N = IDIM( IN )
|
||||
* Set LDC to 1 more than minimum value if room.
|
||||
LDC = N
|
||||
IF( LDC.LT.NMAX )
|
||||
$ LDC = LDC + 1
|
||||
* Skip tests if not enough room.
|
||||
IF( LDC.GT.NMAX )
|
||||
$ GO TO 100
|
||||
LCC = LDC*N
|
||||
NULL = N.LE.0.
|
||||
*
|
||||
DO 90 IK = 1, NIDIM
|
||||
K = IDIM( IK )
|
||||
*
|
||||
DO 80 ICA = 1, 3
|
||||
TRANSA = ICH( ICA: ICA )
|
||||
TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C'
|
||||
*
|
||||
IF( TRANA )THEN
|
||||
MA = K
|
||||
NA = N
|
||||
ELSE
|
||||
MA = N
|
||||
NA = K
|
||||
END IF
|
||||
* Set LDA to 1 more than minimum value if room.
|
||||
LDA = MA
|
||||
IF( LDA.LT.NMAX )
|
||||
$ LDA = LDA + 1
|
||||
* Skip tests if not enough room.
|
||||
IF( LDA.GT.NMAX )
|
||||
$ GO TO 80
|
||||
LAA = LDA*NA
|
||||
*
|
||||
* Generate the matrix A.
|
||||
*
|
||||
CALL ZMAKE( 'ge', ' ', ' ', MA, NA, A, NMAX, AA, LDA,
|
||||
$ RESET, ZERO )
|
||||
*
|
||||
DO 70 ICB = 1, 3
|
||||
TRANSB = ICH( ICB: ICB )
|
||||
TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C'
|
||||
*
|
||||
IF( TRANB )THEN
|
||||
MB = N
|
||||
NB = K
|
||||
ELSE
|
||||
MB = K
|
||||
NB = N
|
||||
END IF
|
||||
* Set LDB to 1 more than minimum value if room.
|
||||
LDB = MB
|
||||
IF( LDB.LT.NMAX )
|
||||
$ LDB = LDB + 1
|
||||
* Skip tests if not enough room.
|
||||
IF( LDB.GT.NMAX )
|
||||
$ GO TO 70
|
||||
LBB = LDB*NB
|
||||
*
|
||||
* Generate the matrix B.
|
||||
*
|
||||
CALL ZMAKE( 'ge', ' ', ' ', MB, NB, B, NMAX, BB,
|
||||
$ LDB, RESET, ZERO )
|
||||
*
|
||||
DO 60 IA = 1, NALF
|
||||
ALPHA = ALF( IA )
|
||||
*
|
||||
DO 50 IB = 1, NBET
|
||||
BETA = BET( IB )
|
||||
DO 45 IS = 1, 2
|
||||
UPLO = ISHAPE(IS:IS)
|
||||
*
|
||||
* Generate the matrix C.
|
||||
*
|
||||
CALL ZMAKE( 'ge', UPLO, ' ', N, N, C, NMAX,
|
||||
$ CC, LDC, RESET, ZERO )
|
||||
*
|
||||
NC = NC + 1
|
||||
*
|
||||
* Save every datum before calling the
|
||||
* subroutine.
|
||||
*
|
||||
UPLOS = UPLO
|
||||
TRANAS = TRANSA
|
||||
TRANBS = TRANSB
|
||||
NS = N
|
||||
KS = K
|
||||
ALS = ALPHA
|
||||
DO 10 I = 1, LAA
|
||||
AS( I ) = AA( I )
|
||||
10 CONTINUE
|
||||
LDAS = LDA
|
||||
DO 20 I = 1, LBB
|
||||
BS( I ) = BB( I )
|
||||
20 CONTINUE
|
||||
LDBS = LDB
|
||||
BLS = BETA
|
||||
DO 30 I = 1, LCC
|
||||
CS( I ) = CC( I )
|
||||
30 CONTINUE
|
||||
LDCS = LDC
|
||||
*
|
||||
* Call the subroutine.
|
||||
*
|
||||
IF( TRACE )
|
||||
$ CALL ZPRCN8(NTRA, NC, SNAME, IORDER, UPLO,
|
||||
$ TRANSA, TRANSB, N, K, ALPHA, LDA,
|
||||
$ LDB, BETA, LDC)
|
||||
IF( REWI )
|
||||
$ REWIND NTRA
|
||||
CALL CZGEMMTR(IORDER, UPLO, TRANSA, TRANSB,
|
||||
$ N, K, ALPHA, AA, LDA, BB, LDB,
|
||||
$ BETA, CC, LDC )
|
||||
*
|
||||
* Check if error-exit was taken incorrectly.
|
||||
*
|
||||
IF( .NOT.OK )THEN
|
||||
WRITE( NOUT, FMT = 9994 )
|
||||
FATAL = .TRUE.
|
||||
GO TO 120
|
||||
END IF
|
||||
*
|
||||
* See what data changed inside subroutines.
|
||||
*
|
||||
ISAME( 1 ) = UPLO .EQ. UPLOS
|
||||
ISAME( 2 ) = TRANSA.EQ.TRANAS
|
||||
ISAME( 3 ) = TRANSB.EQ.TRANBS
|
||||
ISAME( 4 ) = NS.EQ.N
|
||||
ISAME( 5 ) = KS.EQ.K
|
||||
ISAME( 6 ) = ALS.EQ.ALPHA
|
||||
ISAME( 7 ) = LZE( AS, AA, LAA )
|
||||
ISAME( 8 ) = LDAS.EQ.LDA
|
||||
ISAME( 9 ) = LZE( BS, BB, LBB )
|
||||
ISAME( 10 ) = LDBS.EQ.LDB
|
||||
ISAME( 11 ) = BLS.EQ.BETA
|
||||
IF( NULL )THEN
|
||||
ISAME( 12 ) = LZE( CS, CC, LCC )
|
||||
ELSE
|
||||
ISAME( 12 ) = LZERES( 'ge', ' ', N, N, CS,
|
||||
$ CC, LDC )
|
||||
END IF
|
||||
ISAME( 13 ) = LDCS.EQ.LDC
|
||||
*
|
||||
* If data was incorrectly changed, report
|
||||
* and return.
|
||||
*
|
||||
SAME = .TRUE.
|
||||
DO 40 I = 1, NARGS
|
||||
SAME = SAME.AND.ISAME( I )
|
||||
IF( .NOT.ISAME( I ) )
|
||||
$ WRITE( NOUT, FMT = 9998 )I
|
||||
40 CONTINUE
|
||||
IF( .NOT.SAME )THEN
|
||||
FATAL = .TRUE.
|
||||
GO TO 120
|
||||
END IF
|
||||
*
|
||||
IF( .NOT.NULL )THEN
|
||||
*
|
||||
* Check the result.
|
||||
*
|
||||
CALL ZMMTCH( UPLO, TRANSA, TRANSB, N, K,
|
||||
$ ALPHA, A, NMAX, B, NMAX, BETA,
|
||||
$ C, NMAX, CT, G, CC, LDC, EPS,
|
||||
$ ERR, FATAL, NOUT, .TRUE. )
|
||||
ERRMAX = MAX( ERRMAX, ERR )
|
||||
* If got really bad answer, report and
|
||||
* return.
|
||||
IF( FATAL )
|
||||
$ GO TO 120
|
||||
END IF
|
||||
*
|
||||
45 CONTINUE
|
||||
*
|
||||
50 CONTINUE
|
||||
*
|
||||
60 CONTINUE
|
||||
*
|
||||
70 CONTINUE
|
||||
*
|
||||
80 CONTINUE
|
||||
*
|
||||
90 CONTINUE
|
||||
*
|
||||
100 CONTINUE
|
||||
*
|
||||
*
|
||||
* Report result.
|
||||
*
|
||||
IF( ERRMAX.LT.THRESH )THEN
|
||||
IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10000 )SNAME, NC
|
||||
IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10001 )SNAME, NC
|
||||
ELSE
|
||||
IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10002 )SNAME, NC, ERRMAX
|
||||
IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10003 )SNAME, NC, ERRMAX
|
||||
END IF
|
||||
GO TO 130
|
||||
*
|
||||
120 CONTINUE
|
||||
WRITE( NOUT, FMT = 9996 )SNAME
|
||||
CALL ZPRCN8(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, TRANSB,
|
||||
$ N, K, ALPHA, LDA, LDB, BETA, LDC)
|
||||
*
|
||||
130 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
|
||||
$ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
|
||||
$ 'RATIO ', F8.2, ' - SUSPECT *******' )
|
||||
10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
|
||||
$ ' (', I6, ' CALL', 'S)' )
|
||||
9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
|
||||
$ 'ANGED INCORRECTLY *******' )
|
||||
9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' )
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(''', A1, ''',''', A1, ''',',
|
||||
$ 3( I3, ',' ), '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3,
|
||||
$ ',(', F4.1, ',', F4.1, '), C,', I3, ').' )
|
||||
9994 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
|
||||
$ '******' )
|
||||
*
|
||||
* End of ZCHK6.
|
||||
*
|
||||
END
|
||||
|
||||
SUBROUTINE ZPRCN8(NOUT, NC, SNAME, IORDER, UPLO,
|
||||
$ TRANSA, TRANSB, N,
|
||||
$ K, ALPHA, LDA, LDB, BETA, LDC)
|
||||
INTEGER NOUT, NC, IORDER, N, K, LDA, LDB, LDC
|
||||
COMPLEX*16 ALPHA, BETA
|
||||
CHARACTER*1 TRANSA, TRANSB, UPLO
|
||||
CHARACTER*13 SNAME
|
||||
CHARACTER*14 CRC, CTA,CTB,CUPLO
|
||||
|
||||
IF (UPLO.EQ.'U') THEN
|
||||
CUPLO = 'CblasUpper'
|
||||
ELSE
|
||||
CUPLO = 'CblasLower'
|
||||
END IF
|
||||
IF (TRANSA.EQ.'N')THEN
|
||||
CTA = ' CblasNoTrans'
|
||||
ELSE IF (TRANSA.EQ.'T')THEN
|
||||
CTA = ' CblasTrans'
|
||||
ELSE
|
||||
CTA = 'CblasConjTrans'
|
||||
END IF
|
||||
IF (TRANSB.EQ.'N')THEN
|
||||
CTB = ' CblasNoTrans'
|
||||
ELSE IF (TRANSB.EQ.'T')THEN
|
||||
CTB = ' CblasTrans'
|
||||
ELSE
|
||||
CTB = 'CblasConjTrans'
|
||||
END IF
|
||||
IF (IORDER.EQ.1)THEN
|
||||
CRC = ' CblasRowMajor'
|
||||
ELSE
|
||||
CRC = ' CblasColMajor'
|
||||
END IF
|
||||
WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CUPLO, CTA,CTB
|
||||
WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, LDB, BETA, LDC
|
||||
|
||||
9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',',
|
||||
$ A14, ',')
|
||||
9994 FORMAT( 10X, 2( I3, ',' ) ,' (', F4.1,',',F4.1,') , A,',
|
||||
$ I3, ', B,', I3, ', (', F4.1,',',F4.1,') , C,', I3, ').' )
|
||||
END
|
||||
|
||||
SUBROUTINE ZMMTCH(UPLO, TRANSA, TRANSB, N, KK, ALPHA, A, LDA,
|
||||
$ B, LDB,
|
||||
$ BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, FATAL,
|
||||
$ NOUT, MV )
|
||||
IMPLICIT NONE
|
||||
*
|
||||
* Checks the results of the computational tests for GEMMTR.
|
||||
*
|
||||
* Auxiliary routine for test program for Level 3 Blas.
|
||||
*
|
||||
* -- Written on 24-June-2024.
|
||||
* Martin Koehler, Max Planck Institute, Magdeburg
|
||||
*
|
||||
* .. Parameters ..
|
||||
COMPLEX*16 ZERO
|
||||
PARAMETER ( ZERO = ( 0.0, 0.0 ) )
|
||||
DOUBLE PRECISION RZERO, RONE
|
||||
PARAMETER ( RZERO = 0.0, RONE = 1.0 )
|
||||
* .. Scalar Arguments ..
|
||||
COMPLEX*16 ALPHA, BETA
|
||||
DOUBLE PRECISION EPS, ERR
|
||||
INTEGER KK, LDA, LDB, LDC, LDCC, N, NOUT
|
||||
LOGICAL FATAL, MV
|
||||
CHARACTER*1 TRANSA, TRANSB, UPLO
|
||||
* .. Array Arguments ..
|
||||
COMPLEX*16 A( LDA, * ), B( LDB, * ), C( LDC, * ),
|
||||
$ CC( LDCC, * ), CT( * )
|
||||
DOUBLE PRECISION G( * )
|
||||
* .. Local Scalars ..
|
||||
COMPLEX*16 CL
|
||||
DOUBLE PRECISION ERRI
|
||||
INTEGER I, J, K, ISTART, ISTOP
|
||||
LOGICAL CTRANA, CTRANB, TRANA, TRANB, UPPER
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC DABS, DIMAG, DCONJG, MAX, DBLE, DSQRT
|
||||
* .. Statement Functions ..
|
||||
DOUBLE PRECISION ABS1
|
||||
* .. Statement Function definitions ..
|
||||
ABS1( CL ) = DABS( DBLE( CL ) ) + DABS( DIMAG( CL ) )
|
||||
* .. Executable Statements ..
|
||||
|
||||
UPPER = UPLO.EQ.'U'
|
||||
TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C'
|
||||
TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C'
|
||||
CTRANA = TRANSA.EQ.'C'
|
||||
CTRANB = TRANSB.EQ.'C'
|
||||
|
||||
ISTART = 1
|
||||
ISTOP = N
|
||||
*
|
||||
* Compute expected result, one column at a time, in CT using data
|
||||
* in A, B and C.
|
||||
* Compute gauges in G.
|
||||
*
|
||||
DO 220 J = 1, N
|
||||
*
|
||||
IF (UPPER) THEN
|
||||
ISTART = 1
|
||||
ISTOP = J
|
||||
ELSE
|
||||
ISTART = J
|
||||
ISTOP = N
|
||||
END IF
|
||||
DO 10 I = ISTART, ISTOP
|
||||
CT( I ) = ZERO
|
||||
G( I ) = RZERO
|
||||
10 CONTINUE
|
||||
IF( .NOT.TRANA.AND..NOT.TRANB )THEN
|
||||
DO 30 K = 1, KK
|
||||
DO 20 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( I, K )*B( K, J )
|
||||
G( I ) = G( I ) + ABS1( A( I, K ) )*ABS1( B( K, J ) )
|
||||
20 CONTINUE
|
||||
30 CONTINUE
|
||||
ELSE IF( TRANA.AND..NOT.TRANB )THEN
|
||||
IF( CTRANA )THEN
|
||||
DO 50 K = 1, KK
|
||||
DO 40 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + DCONJG( A( K, I ) )*B( K, J )
|
||||
G( I ) = G( I ) + ABS1( A( K, I ) )*
|
||||
$ ABS1( B( K, J ) )
|
||||
40 CONTINUE
|
||||
50 CONTINUE
|
||||
ELSE
|
||||
DO 70 K = 1, KK
|
||||
DO 60 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( K, I )*B( K, J )
|
||||
G( I ) = G( I ) + ABS1( A( K, I ) )*
|
||||
$ ABS1( B( K, J ) )
|
||||
60 CONTINUE
|
||||
70 CONTINUE
|
||||
END IF
|
||||
ELSE IF( .NOT.TRANA.AND.TRANB )THEN
|
||||
IF( CTRANB )THEN
|
||||
DO 90 K = 1, KK
|
||||
DO 80 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( I, K )*DCONJG( B( J, K ) )
|
||||
G( I ) = G( I ) + ABS1( A( I, K ) )*
|
||||
$ ABS1( B( J, K ) )
|
||||
80 CONTINUE
|
||||
90 CONTINUE
|
||||
ELSE
|
||||
DO 110 K = 1, KK
|
||||
DO 100 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( I, K )*B( J, K )
|
||||
G( I ) = G( I ) + ABS1( A( I, K ) )*
|
||||
$ ABS1( B( J, K ) )
|
||||
100 CONTINUE
|
||||
110 CONTINUE
|
||||
END IF
|
||||
ELSE IF( TRANA.AND.TRANB )THEN
|
||||
IF( CTRANA )THEN
|
||||
IF( CTRANB )THEN
|
||||
DO 130 K = 1, KK
|
||||
DO 120 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + DCONJG( A( K, I ) )*
|
||||
$ DCONJG( B( J, K ) )
|
||||
G( I ) = G( I ) + ABS1( A( K, I ) )*
|
||||
$ ABS1( B( J, K ) )
|
||||
120 CONTINUE
|
||||
130 CONTINUE
|
||||
ELSE
|
||||
DO 150 K = 1, KK
|
||||
DO 140 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + DCONJG( A( K, I ) )*B( J, K )
|
||||
G( I ) = G( I ) + ABS1( A( K, I ) )*
|
||||
$ ABS1( B( J, K ) )
|
||||
140 CONTINUE
|
||||
150 CONTINUE
|
||||
END IF
|
||||
ELSE
|
||||
IF( CTRANB )THEN
|
||||
DO 170 K = 1, KK
|
||||
DO 160 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( K, I )*DCONJG( B( J, K ) )
|
||||
G( I ) = G( I ) + ABS1( A( K, I ) )*
|
||||
$ ABS1( B( J, K ) )
|
||||
160 CONTINUE
|
||||
170 CONTINUE
|
||||
ELSE
|
||||
DO 190 K = 1, KK
|
||||
DO 180 I = ISTART, ISTOP
|
||||
CT( I ) = CT( I ) + A( K, I )*B( J, K )
|
||||
G( I ) = G( I ) + ABS1( A( K, I ) )*
|
||||
$ ABS1( B( J, K ) )
|
||||
180 CONTINUE
|
||||
190 CONTINUE
|
||||
END IF
|
||||
END IF
|
||||
END IF
|
||||
DO 200 I = ISTART, ISTOP
|
||||
CT( I ) = ALPHA*CT( I ) + BETA*C( I, J )
|
||||
G( I ) = ABS1( ALPHA )*G( I ) +
|
||||
$ ABS1( BETA )*ABS1( C( I, J ) )
|
||||
200 CONTINUE
|
||||
*
|
||||
* Compute the error ratio for this result.
|
||||
*
|
||||
ERR = ZERO
|
||||
DO 210 I = ISTART, ISTOP
|
||||
ERRI = ABS1( CT( I ) - CC( I, J ) )/EPS
|
||||
IF( G( I ).NE.RZERO )
|
||||
$ ERRI = ERRI/G( I )
|
||||
ERR = MAX( ERR, ERRI )
|
||||
IF( ERR*DSQRT( EPS ).GE.RONE )
|
||||
$ GO TO 230
|
||||
210 CONTINUE
|
||||
*
|
||||
220 CONTINUE
|
||||
*
|
||||
* If the loop completes, all results are at least half accurate.
|
||||
GO TO 250
|
||||
*
|
||||
* Report fatal error.
|
||||
*
|
||||
230 FATAL = .TRUE.
|
||||
WRITE( NOUT, FMT = 9999 )
|
||||
DO 240 I = ISTART, ISTOP
|
||||
IF( MV )THEN
|
||||
WRITE( NOUT, FMT = 9998 )I, CT( I ), CC( I, J )
|
||||
ELSE
|
||||
WRITE( NOUT, FMT = 9998 )I, CC( I, J ), CT( I )
|
||||
END IF
|
||||
240 CONTINUE
|
||||
IF( N.GT.1 )
|
||||
$ WRITE( NOUT, FMT = 9997 )J
|
||||
*
|
||||
250 CONTINUE
|
||||
RETURN
|
||||
*
|
||||
9999 FORMAT(' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
|
||||
$ 'F ACCURATE *******', /' EXPECTED RE',
|
||||
$ 'SULT COMPUTED RESULT' )
|
||||
9998 FORMAT( 1X, I7, 2( ' (', G15.6, ',', G15.6, ')' ) )
|
||||
9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 )
|
||||
*
|
||||
* End of ZMMTCH.
|
||||
*
|
||||
END
|
||||
|
||||
|
||||
@@ -20,4 +20,3 @@ cblas_cherk T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_csyrk T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_cher2k T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_csyr2k T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_cgemmtr T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
|
||||
+6
-7
@@ -11,10 +11,9 @@ T LOGICAL FLAG, T TO TEST ERROR EXITS.
|
||||
0.0 1.0 0.7 VALUES OF ALPHA
|
||||
3 NUMBER OF VALUES OF BETA
|
||||
0.0 1.0 1.3 VALUES OF BETA
|
||||
cblas_dgemm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_dsymm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_dtrmm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_dtrsm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_dsyrk T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_dsyr2k T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_dgemmtr T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_dgemm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_dsymm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_dtrmm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_dtrsm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_dsyrk T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_dsyr2k T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
|
||||
+6
-7
@@ -11,10 +11,9 @@ T LOGICAL FLAG, T TO TEST ERROR EXITS.
|
||||
0.0 1.0 0.7 VALUES OF ALPHA
|
||||
3 NUMBER OF VALUES OF BETA
|
||||
0.0 1.0 1.3 VALUES OF BETA
|
||||
cblas_sgemm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_ssymm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_strmm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_strsm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_ssyrk T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_ssyr2k T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_sgemmtr T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_sgemm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_ssymm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_strmm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_strsm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_ssyrk T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_ssyr2k T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
|
||||
+9
-10
@@ -11,13 +11,12 @@ T LOGICAL FLAG, T TO TEST ERROR EXITS.
|
||||
(0.0,0.0) (1.0,0.0) (0.7,-0.9) VALUES OF ALPHA
|
||||
3 NUMBER OF VALUES OF BETA
|
||||
(0.0,0.0) (1.0,0.0) (1.3,-1.1) VALUES OF BETA
|
||||
cblas_zgemm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_zhemm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_zsymm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_ztrmm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_ztrsm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_zherk T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_zsyrk T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_zher2k T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_zsyr2k T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_zgemmtr T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_zgemm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_zhemm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_zsymm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_ztrmm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_ztrsm T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_zherk T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_zsyrk T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_zher2k T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
cblas_zsyr2k T PUT F FOR NO TEST. SAME COLUMNS.
|
||||
|
||||
@@ -10,32 +10,34 @@
|
||||
# Copyright 2011
|
||||
#=============================================================================
|
||||
|
||||
macro(CheckLAPACKCompilerFlags)
|
||||
macro( CheckLAPACKCompilerFlags )
|
||||
|
||||
# FORTRAN ILP default
|
||||
set(FOPT_ILP64)
|
||||
if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel")
|
||||
if(WIN32)
|
||||
set(FOPT_ILP64 /integer-size:64)
|
||||
else()
|
||||
set(FOPT_ILP64 "SHELL:-integer-size 64")
|
||||
set( FPE_EXIT FALSE )
|
||||
|
||||
# FORTRAN ILP default
|
||||
set(FOPT_ILP64)
|
||||
if( CMAKE_Fortran_COMPILER_ID MATCHES "Intel" )
|
||||
if ( WIN32 )
|
||||
set(FOPT_ILP64 /integer-size:64)
|
||||
else ()
|
||||
set(FOPT_ILP64 "-integer-size 64")
|
||||
endif()
|
||||
elseif((CMAKE_Fortran_COMPILER_ID STREQUAL "VisualAge") OR # CMake 2.6
|
||||
(CMAKE_Fortran_COMPILER_ID STREQUAL "XL")) # CMake 2.8
|
||||
elseif( (CMAKE_Fortran_COMPILER_ID STREQUAL "VisualAge" ) OR # CMake 2.6
|
||||
(CMAKE_Fortran_COMPILER_ID STREQUAL "XL" ) ) # CMake 2.8
|
||||
set(FOPT_ILP64 -qintsize=8)
|
||||
elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "NAG")
|
||||
if(WIN32)
|
||||
set(FOPT_ILP64 /i8)
|
||||
else()
|
||||
set(FOPT_ILP64 -i8)
|
||||
elseif( CMAKE_Fortran_COMPILER_ID STREQUAL "NAG" )
|
||||
if ( WIN32 )
|
||||
set(FOPT_ILP64 /i8)
|
||||
else ()
|
||||
set(FOPT_ILP64 -i8)
|
||||
endif()
|
||||
elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "NVHPC")
|
||||
if(WIN32)
|
||||
set(FOPT_ILP64 /i8)
|
||||
else()
|
||||
set(FOPT_ILP64 -i8)
|
||||
elseif( CMAKE_Fortran_COMPILER_ID STREQUAL "NVHPC" )
|
||||
if ( WIN32 )
|
||||
set(FOPT_ILP64 /i8)
|
||||
else ()
|
||||
set(FOPT_ILP64 -i8)
|
||||
endif()
|
||||
else()
|
||||
else()
|
||||
set(CPE_ENV $ENV{PE_ENV})
|
||||
if(CPE_ENV STREQUAL "CRAY")
|
||||
set(FOPT_ILP64 -sinteger64)
|
||||
@@ -44,166 +46,210 @@ macro(CheckLAPACKCompilerFlags)
|
||||
else()
|
||||
set(FOPT_ILP64 -fdefault-integer-8)
|
||||
endif()
|
||||
endif()
|
||||
if ( FORTRAN_ILP )
|
||||
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${FOPT_ILP64}")
|
||||
endif()
|
||||
|
||||
# GNU Fortran
|
||||
if( CMAKE_Fortran_COMPILER_ID STREQUAL "GNU" )
|
||||
if( "${CMAKE_Fortran_FLAGS}" MATCHES "-ffpe-trap=[izoupd]")
|
||||
set( FPE_EXIT TRUE )
|
||||
endif()
|
||||
if(FORTRAN_ILP)
|
||||
add_compile_options("$<$<COMPILE_LANGUAGE:Fortran>:${FOPT_ILP64}>")
|
||||
if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "-frecursive") )
|
||||
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -frecursive"
|
||||
CACHE STRING "Recursive flag must be set" FORCE)
|
||||
endif()
|
||||
|
||||
# GNU Fortran
|
||||
if(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU")
|
||||
set(FPE_EXIT_FLAG "-ffpe-trap=[izoupd]")
|
||||
# Intel Fortran
|
||||
elseif( CMAKE_Fortran_COMPILER_ID MATCHES "Intel" )
|
||||
if( "${CMAKE_Fortran_FLAGS}" MATCHES "[-/]fpe(-all=|)0" )
|
||||
set( FPE_EXIT TRUE )
|
||||
endif()
|
||||
|
||||
add_compile_options("$<$<COMPILE_LANGUAGE:Fortran>:-frecursive>")
|
||||
if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "-recursive") )
|
||||
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -recursive"
|
||||
CACHE STRING "Recursive flag must be set" FORCE)
|
||||
endif()
|
||||
|
||||
if(CMAKE_Fortran_COMPILER_VERSION VERSION_LESS "8")
|
||||
add_compile_definitions("$<$<COMPILE_LANGUAGE:C>:FORTRAN_STRLEN=int>")
|
||||
endif()
|
||||
if( UNIX AND NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "-fp-model[ \t]strict") )
|
||||
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fp-model strict")
|
||||
endif()
|
||||
|
||||
# Intel Fortran
|
||||
elseif(CMAKE_Fortran_COMPILER_ID MATCHES "Intel")
|
||||
set(FPE_EXIT_FLAG "[-/]fpe(-all=|)0")
|
||||
# SunPro F95
|
||||
elseif( CMAKE_Fortran_COMPILER_ID STREQUAL "SunPro" )
|
||||
if( ("${CMAKE_Fortran_FLAGS}" MATCHES "-ftrap=") AND
|
||||
NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "-ftrap=(%|)none") )
|
||||
set( FPE_EXIT TRUE )
|
||||
elseif( NOT (CMAKE_Fortran_FLAGS MATCHES "-ftrap=") )
|
||||
message( STATUS "Disabling FPE trap handlers with -ftrap=%none" )
|
||||
set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ftrap=%none"
|
||||
CACHE STRING "Flags for Fortran compiler." FORCE )
|
||||
endif()
|
||||
|
||||
add_compile_options("$<$<COMPILE_LANGUAGE:Fortran>:-recursive>")
|
||||
if(UNIX)
|
||||
add_compile_options("$<$<COMPILE_LANGUAGE:Fortran>:SHELL:-fp-model strict>")
|
||||
endif()
|
||||
if(UNIX)
|
||||
# Delete libmtsk in linking sequence for Sun/Oracle Fortran Compiler.
|
||||
# This library is not present in the Sun package SolarisStudio12.3-linux-x86-bin
|
||||
string(REPLACE \;mtsk\; \; CMAKE_Fortran_IMPLICIT_LINK_LIBRARIES "${CMAKE_Fortran_IMPLICIT_LINK_LIBRARIES}")
|
||||
endif()
|
||||
|
||||
# SunPro F95
|
||||
elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "SunPro")
|
||||
set(FPE_EXIT_FLAG "-ftrap=")
|
||||
set(FPE_DISABLE_FLAG "-ftrap=(%|)none")
|
||||
# IBM XL Fortran
|
||||
elseif( (CMAKE_Fortran_COMPILER_ID STREQUAL "VisualAge" ) OR # CMake 2.6
|
||||
(CMAKE_Fortran_COMPILER_ID STREQUAL "XL" ) ) # CMake 2.8
|
||||
if( "${CMAKE_Fortran_FLAGS}" MATCHES "-qflttrap=[a-zA-Z:]:enable" )
|
||||
set( FPE_EXIT TRUE )
|
||||
endif()
|
||||
|
||||
message(STATUS "Disabling FPE trap handlers with -ftrap=%none")
|
||||
add_compile_options("$<$<COMPILE_LANGUAGE:Fortran>:-ftrap=%none>")
|
||||
if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "-qrecur") )
|
||||
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -qrecur"
|
||||
CACHE STRING "Recursive flag must be set" FORCE)
|
||||
endif()
|
||||
|
||||
if(UNIX)
|
||||
# Delete libmtsk in linking sequence for Sun/Oracle Fortran Compiler.
|
||||
# This library is not present in the Sun package SolarisStudio12.3-linux-x86-bin
|
||||
string(REPLACE \;mtsk\; \; CMAKE_Fortran_IMPLICIT_LINK_LIBRARIES
|
||||
"${CMAKE_Fortran_IMPLICIT_LINK_LIBRARIES}")
|
||||
endif()
|
||||
if( UNIX AND NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "-qnosave") )
|
||||
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -qnosave")
|
||||
endif()
|
||||
|
||||
# IBM XL Fortran
|
||||
elseif((CMAKE_Fortran_COMPILER_ID STREQUAL "VisualAge") OR # CMake 2.6
|
||||
(CMAKE_Fortran_COMPILER_ID STREQUAL "XL")) # CMake 2.8
|
||||
set(FPE_EXIT_FLAG "-qflttrap=[a-zA-Z:]:enable")
|
||||
|
||||
add_compile_options("$<$<COMPILE_LANGUAGE:Fortran>:-qrecur>")
|
||||
if(UNIX)
|
||||
add_compile_options("$<$<COMPILE_LANGUAGE:Fortran>:-qnosave>")
|
||||
add_compile_options("$<$<COMPILE_LANGUAGE:Fortran>:-qstrict>")
|
||||
endif()
|
||||
if( UNIX AND NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "-qstrict") )
|
||||
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -qstrict")
|
||||
endif()
|
||||
|
||||
# HP Fortran
|
||||
elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "HP")
|
||||
set(FPE_EXIT_FLAG "\\+fp_exception")
|
||||
# HP Fortran
|
||||
elseif( CMAKE_Fortran_COMPILER_ID STREQUAL "HP" )
|
||||
if( "${CMAKE_Fortran_FLAGS}" MATCHES "\\+fp_exception" )
|
||||
set( FPE_EXIT TRUE )
|
||||
endif()
|
||||
|
||||
message(STATUS "Enabling strict float conversion with +fltconst_strict")
|
||||
add_compile_options("$<$<COMPILE_LANGUAGE:Fortran>:+fltconst_strict>")
|
||||
if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "\\+fltconst_strict") )
|
||||
message( STATUS "Enabling strict float conversion with +fltconst_strict" )
|
||||
set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} +fltconst_strict"
|
||||
CACHE STRING "Flags for Fortran compiler." FORCE )
|
||||
endif()
|
||||
|
||||
# Most versions of cmake don't have good default options for the HP compiler
|
||||
add_compile_options("$<$<AND:$<COMPILE_LANGUAGE:Fortran>,$<CONFIG:DEBUG>>:-g>")
|
||||
add_compile_options("$<$<AND:$<COMPILE_LANGUAGE:Fortran>,$<CONFIG:MINSIZEREL>>:+Osize>")
|
||||
add_compile_options("$<$<AND:$<COMPILE_LANGUAGE:Fortran>,$<CONFIG:RELEASE>>:+O2>")
|
||||
add_compile_options("$<$<AND:$<COMPILE_LANGUAGE:Fortran>,$<CONFIG:RELWITHDEBINFO>>:+O2 -g>")
|
||||
# Most versions of cmake don't have good default options for the HP compiler
|
||||
set( CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -g"
|
||||
CACHE STRING "Flags used by the compiler during debug builds" FORCE )
|
||||
set( CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_MINSIZEREL} +Osize"
|
||||
CACHE STRING "Flags used by the compiler during release minsize builds" FORCE )
|
||||
set( CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_RELEASE} +O2"
|
||||
CACHE STRING "Flags used by the compiler during release builds" FORCE )
|
||||
set( CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_RELWITHDEBINFO} +O2 -g"
|
||||
CACHE STRING "Flags used by the compiler during release with debug info builds" FORCE )
|
||||
|
||||
# NAG Fortran
|
||||
elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "NAG")
|
||||
set(FPE_EXIT_FLAG "[-/]ieee=(stop|nonstd)")
|
||||
# NAG Fortran
|
||||
elseif( CMAKE_Fortran_COMPILER_ID STREQUAL "NAG" )
|
||||
if( "${CMAKE_Fortran_FLAGS}" MATCHES "[-/]ieee=(stop|nonstd)" )
|
||||
set( FPE_EXIT TRUE )
|
||||
endif()
|
||||
|
||||
add_compile_options("$<$<COMPILE_LANGUAGE:Fortran>:-ieee=full>")
|
||||
add_compile_options("$<$<COMPILE_LANGUAGE:Fortran>:-dcfuns>")
|
||||
add_compile_options("$<$<COMPILE_LANGUAGE:Fortran>:-thread_safe>")
|
||||
add_link_options("$<$<COMPILE_LANGUAGE:Fortran>:-thread_safe>")
|
||||
add_compile_options("$<$<COMPILE_LANGUAGE:Fortran>:-recursive>")
|
||||
if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "[-/]ieee=full") )
|
||||
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ieee=full")
|
||||
endif()
|
||||
|
||||
# By default NAG Fortran uses 32bit integers as hidden STRLEN arguments
|
||||
if(UNIX)
|
||||
if(APPLE)
|
||||
add_compile_definitions("$<$<COMPILE_LANGUAGE:C>:FORTRAN_STRLEN=int>")
|
||||
else()
|
||||
# Get all flags added via `add_compile_options(...)`
|
||||
get_directory_property(COMP_OPTIONS COMPILE_OPTIONS)
|
||||
if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "[-/]dcfuns") )
|
||||
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -dcfuns")
|
||||
endif()
|
||||
|
||||
if(NOT("${CMAKE_Fortran_FLAGS};${COMP_OPTIONS}" MATCHES "-abi=64c"))
|
||||
add_compile_definitions("$<$<COMPILE_LANGUAGE:C>:FORTRAN_STRLEN=int>")
|
||||
if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "[-/]thread_safe") )
|
||||
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -thread_safe")
|
||||
endif()
|
||||
|
||||
# Disable warnings
|
||||
if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "[-/]w=obs") )
|
||||
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -w=obs")
|
||||
endif()
|
||||
|
||||
if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "[-/]w=x77") )
|
||||
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -w=x77")
|
||||
endif()
|
||||
|
||||
if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "[-/]w=ques") )
|
||||
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -w=ques")
|
||||
endif()
|
||||
|
||||
if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "[-/]w=unused") )
|
||||
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -w=unused")
|
||||
endif()
|
||||
|
||||
if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "-recursive") )
|
||||
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -recursive"
|
||||
CACHE STRING "Recursive flag must be set" FORCE)
|
||||
endif()
|
||||
|
||||
# Suppress compiler banner and summary
|
||||
include(CheckFortranCompilerFlag)
|
||||
check_fortran_compiler_flag("-quiet" _quiet)
|
||||
if( _quiet AND NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "[-/]quiet") )
|
||||
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -quiet")
|
||||
endif()
|
||||
|
||||
# NVIDIA HPC SDK
|
||||
elseif( CMAKE_Fortran_COMPILER_ID STREQUAL "NVHPC" )
|
||||
if( ("${CMAKE_Fortran_FLAGS}" MATCHES "-Ktrap=") AND
|
||||
NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "-Ktrap=none") )
|
||||
set( FPE_EXIT TRUE )
|
||||
endif()
|
||||
|
||||
if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "[-/]Kieee") )
|
||||
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -Kieee")
|
||||
endif()
|
||||
|
||||
if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "-Mrecursive") )
|
||||
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -Mrecursive"
|
||||
CACHE STRING "Recursive flag must be set" FORCE)
|
||||
endif()
|
||||
|
||||
# Flang Fortran
|
||||
elseif( CMAKE_Fortran_COMPILER_ID STREQUAL "Flang" )
|
||||
if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "-Mrecursive") )
|
||||
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -Mrecursive"
|
||||
CACHE STRING "Recursive flag must be set" FORCE)
|
||||
endif()
|
||||
|
||||
# Compaq Fortran
|
||||
elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "Compaq")
|
||||
if(WIN32)
|
||||
if(CMAKE_GENERATOR STREQUAL "NMake Makefiles")
|
||||
get_filename_component(CMAKE_Fortran_COMPILER_CMDNAM ${CMAKE_Fortran_COMPILER} NAME_WE)
|
||||
message(STATUS "Using Compaq Fortran compiler with command name ${CMAKE_Fortran_COMPILER_CMDNAM}")
|
||||
set(cmd ${CMAKE_Fortran_COMPILER_CMDNAM})
|
||||
string(TOLOWER "${cmd}" cmdlc)
|
||||
if(cmdlc STREQUAL "df")
|
||||
message(STATUS "Assume the Compaq Visual Fortran Compiler is being used")
|
||||
set(CMAKE_Fortran_USE_RESPONSE_FILE_FOR_OBJECTS 1)
|
||||
set(CMAKE_Fortran_USE_RESPONSE_FILE_FOR_INCLUDES 1)
|
||||
#This is a workaround that is needed to avoid forward-slashes in the
|
||||
#filenames listed in response files from incorrectly being interpreted as
|
||||
#introducing compiler command options
|
||||
if(${BUILD_SHARED_LIBS})
|
||||
message(FATAL_ERROR "Making of shared libraries with CVF has not been tested.")
|
||||
endif()
|
||||
set(str "NMake version 9 or later should be used. NMake version 6.0 which is\n")
|
||||
set(str "${str} included with the CVF distribution fails to build Lapack because\n")
|
||||
set(str "${str} the number of source files exceeds the limit for NMake v6.0\n")
|
||||
message(STATUS ${str})
|
||||
set(CMAKE_Fortran_LINK_EXECUTABLE "LINK /out:<TARGET> <LINK_FLAGS> <LINK_LIBRARIES> <OBJECTS>")
|
||||
endif()
|
||||
endif()
|
||||
|
||||
# Disable warnings
|
||||
add_compile_options("$<$<COMPILE_LANGUAGE:Fortran>:-w=obs>")
|
||||
add_compile_options("$<$<COMPILE_LANGUAGE:Fortran>:-w=x77>")
|
||||
add_compile_options("$<$<COMPILE_LANGUAGE:Fortran>:-w=ques>")
|
||||
add_compile_options("$<$<COMPILE_LANGUAGE:Fortran>:-w=unused>")
|
||||
|
||||
# Suppress compiler banner and summary
|
||||
include(CheckFortranCompilerFlag)
|
||||
check_fortran_compiler_flag("-quiet" _quiet)
|
||||
add_compile_options("$<$<AND:$<COMPILE_LANGUAGE:Fortran>,$<BOOL:${_quiet}>>:-quiet>")
|
||||
add_link_options("$<$<AND:$<COMPILE_LANGUAGE:Fortran>,$<BOOL:${_quiet}>>:-quiet>")
|
||||
|
||||
# NVIDIA HPC SDK
|
||||
elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "NVHPC")
|
||||
set(FPE_EXIT_FLAG "-Ktrap=")
|
||||
set(FPE_DISABLE_FLAG "-Ktrap=none")
|
||||
|
||||
add_compile_options("$<$<COMPILE_LANGUAGE:Fortran>:-Kieee>")
|
||||
add_compile_options("$<$<COMPILE_LANGUAGE:Fortran>:-Mrecursive>")
|
||||
|
||||
# Flang Fortran
|
||||
elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "Flang")
|
||||
add_compile_options("$<$<COMPILE_LANGUAGE:Fortran>:-Mrecursive>")
|
||||
|
||||
# Compaq Fortran
|
||||
elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "Compaq")
|
||||
if(WIN32)
|
||||
if(CMAKE_GENERATOR STREQUAL "NMake Makefiles")
|
||||
get_filename_component(CMAKE_Fortran_COMPILER_CMDNAM ${CMAKE_Fortran_COMPILER} NAME_WE)
|
||||
message(STATUS "Using Compaq Fortran compiler with command name ${CMAKE_Fortran_COMPILER_CMDNAM}")
|
||||
set(cmd ${CMAKE_Fortran_COMPILER_CMDNAM})
|
||||
string(TOLOWER "${cmd}" cmdlc)
|
||||
if(cmdlc STREQUAL "df")
|
||||
message(STATUS "Assume the Compaq Visual Fortran Compiler is being used")
|
||||
set(CMAKE_Fortran_USE_RESPONSE_FILE_FOR_OBJECTS 1)
|
||||
set(CMAKE_Fortran_USE_RESPONSE_FILE_FOR_INCLUDES 1)
|
||||
#This is a workaround that is needed to avoid forward-slashes in the
|
||||
#filenames listed in response files from incorrectly being interpreted as
|
||||
#introducing compiler command options
|
||||
if(${BUILD_SHARED_LIBS})
|
||||
message(FATAL_ERROR "Making of shared libraries with CVF has not been tested.")
|
||||
endif()
|
||||
set(str "NMake version 9 or later should be used. NMake version 6.0 which is\n")
|
||||
set(str "${str} included with the CVF distribution fails to build Lapack because\n")
|
||||
set(str "${str} the number of source files exceeds the limit for NMake v6.0\n")
|
||||
message(STATUS ${str})
|
||||
set(CMAKE_Fortran_LINK_EXECUTABLE "LINK /out:<TARGET> <LINK_FLAGS> <LINK_LIBRARIES> <OBJECTS>")
|
||||
endif()
|
||||
endif()
|
||||
endif()
|
||||
|
||||
else()
|
||||
message(WARNING "Fortran local arrays should be allocated on the stack."
|
||||
" Please use a compiler which guarantees that feature."
|
||||
" See https://github.com/Reference-LAPACK/lapack/pull/188 and references therein.")
|
||||
endif()
|
||||
|
||||
if("${CMAKE_Fortran_FLAGS_RELEASE}" MATCHES "O[3-9]")
|
||||
message(STATUS "Reducing RELEASE optimization level to O2")
|
||||
string(REGEX REPLACE "O[3-9]" "O2" CMAKE_Fortran_FLAGS_RELEASE
|
||||
"${CMAKE_Fortran_FLAGS_RELEASE}")
|
||||
endif()
|
||||
else()
|
||||
message(WARNING "Fortran local arrays should be allocated on the stack."
|
||||
" Please use a compiler which guarantees that feature."
|
||||
" See https://github.com/Reference-LAPACK/lapack/pull/188 and references therein.")
|
||||
endif()
|
||||
|
||||
# Get all flags added via `add_compile_options(...)`
|
||||
get_directory_property(COMP_OPTIONS COMPILE_OPTIONS)
|
||||
if( "${CMAKE_Fortran_FLAGS_RELEASE}" MATCHES "O[3-9]" )
|
||||
message( STATUS "Reducing RELEASE optimization level to O2" )
|
||||
string( REGEX REPLACE "O[3-9]" "O2" CMAKE_Fortran_FLAGS_RELEASE
|
||||
"${CMAKE_Fortran_FLAGS_RELEASE}" )
|
||||
set( CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE}"
|
||||
CACHE STRING "Flags used by the compiler during release builds" FORCE )
|
||||
endif()
|
||||
|
||||
if(("${CMAKE_Fortran_FLAGS};${COMP_OPTIONS}" MATCHES "${FPE_EXIT_FLAG}") AND NOT
|
||||
("${CMAKE_Fortran_FLAGS};${COMP_OPTIONS}" MATCHES "${FPE_DISABLE_FLAG}"))
|
||||
message( FATAL_ERROR "Floating Point Exception (FPE) trap handlers are"
|
||||
" currently explicitly enabled in the compiler flags. LAPACK is designed"
|
||||
" to check for and handle these cases internally and enabling these traps"
|
||||
" will likely cause LAPACK to crash. Please re-configure with floating"
|
||||
" point exception trapping disabled.")
|
||||
endif()
|
||||
|
||||
if( FPE_EXIT )
|
||||
message( FATAL_ERROR "Floating Point Exception (FPE) trap handlers are currently explicitly enabled in the compiler flags. LAPACK is designed to check for and handle these cases internally and enabling these traps will likely cause LAPACK to crash. Please re-configure with floating point exception trapping disabled." )
|
||||
endif()
|
||||
|
||||
endmacro()
|
||||
|
||||
+42
-26
@@ -1,6 +1,6 @@
|
||||
cmake_minimum_required(VERSION 3.13)
|
||||
cmake_minimum_required(VERSION 3.9)
|
||||
|
||||
project(LAPACK C)
|
||||
project(LAPACK)
|
||||
|
||||
set(LAPACK_MAJOR_VERSION 3)
|
||||
set(LAPACK_MINOR_VERSION 12)
|
||||
@@ -107,22 +107,28 @@ else()
|
||||
set(LAPACKELIB "lapacke")
|
||||
set(TMGLIB "tmglib")
|
||||
endif()
|
||||
|
||||
# By default build extended _64 API for supported compilers only. This needs
|
||||
# CMake >= 3.18! Let's disable it by default for CMake < 3.18.
|
||||
if(CMAKE_VERSION VERSION_LESS "3.18")
|
||||
set(INDEX64_EXT_API_DEFAULT OFF)
|
||||
else()
|
||||
set(INDEX64_EXT_API_DEFAULT ON)
|
||||
endif()
|
||||
# By default build extended _64 API for supported compilers only
|
||||
set(INDEX64_EXT_API_COMPILERS "Intel|GNU")
|
||||
option(BUILD_INDEX64_EXT_API
|
||||
"Build Index-64 API as extended API with _64 suffix (needs CMake >= 3.18)"
|
||||
${INDEX64_EXT_API_DEFAULT})
|
||||
option(BUILD_INDEX64_EXT_API "Build Index-64 API as extended API with _64 suffix" ON)
|
||||
message(STATUS "Build Index-64 API as extended API with _64 suffix: ${BUILD_INDEX64_EXT_API}")
|
||||
|
||||
include(GNUInstallDirs)
|
||||
|
||||
# Updated OSX RPATH settings
|
||||
# In response to CMake 3.0 generating warnings regarding policy CMP0042,
|
||||
# the OSX RPATH settings have been updated per recommendations found
|
||||
# in the CMake Wiki:
|
||||
# http://www.cmake.org/Wiki/CMake_RPATH_handling#Mac_OS_X_and_the_RPATH
|
||||
set(CMAKE_MACOSX_RPATH ON)
|
||||
set(CMAKE_SKIP_BUILD_RPATH FALSE)
|
||||
set(CMAKE_BUILD_WITH_INSTALL_RPATH FALSE)
|
||||
list(FIND CMAKE_PLATFORM_IMPLICIT_LINK_DIRECTORIES ${CMAKE_INSTALL_FULL_LIBDIR} isSystemDir)
|
||||
if("${isSystemDir}" STREQUAL "-1")
|
||||
set(CMAKE_INSTALL_RPATH ${CMAKE_INSTALL_FULL_LIBDIR})
|
||||
set(CMAKE_INSTALL_RPATH_USE_LINK_PATH TRUE)
|
||||
endif()
|
||||
|
||||
|
||||
# Configure the warning and code coverage suppression file
|
||||
configure_file(
|
||||
"${LAPACK_SOURCE_DIR}/CTestCustom.cmake.in"
|
||||
@@ -153,18 +159,12 @@ endif()
|
||||
# --------------------------------------------------
|
||||
set(LAPACK_INSTALL_EXPORT_NAME ${LAPACKLIB}-targets)
|
||||
|
||||
set(LAPACK_BINARY_PATH_SUFFIX "" CACHE STRING "Path suffix appended to the install path of binaries")
|
||||
|
||||
if(NOT "${LAPACK_BINARY_PATH_SUFFIX}" STREQUAL "" AND NOT "${LAPACK_BINARY_PATH_SUFFIX}" MATCHES "^/")
|
||||
set(LAPACK_BINARY_PATH_SUFFIX "/${LAPACK_BINARY_PATH_SUFFIX}")
|
||||
endif()
|
||||
|
||||
macro(lapack_install_library lib)
|
||||
install(TARGETS ${lib}
|
||||
EXPORT ${LAPACK_INSTALL_EXPORT_NAME}
|
||||
ARCHIVE DESTINATION "${CMAKE_INSTALL_LIBDIR}${LAPACK_BINARY_PATH_SUFFIX}" COMPONENT Development
|
||||
LIBRARY DESTINATION "${CMAKE_INSTALL_LIBDIR}${LAPACK_BINARY_PATH_SUFFIX}" COMPONENT RuntimeLibraries
|
||||
RUNTIME DESTINATION "${CMAKE_INSTALL_BINDIR}${LAPACK_BINARY_PATH_SUFFIX}" COMPONENT RuntimeLibraries
|
||||
ARCHIVE DESTINATION ${CMAKE_INSTALL_LIBDIR} COMPONENT Development
|
||||
LIBRARY DESTINATION ${CMAKE_INSTALL_LIBDIR} COMPONENT RuntimeLibraries
|
||||
RUNTIME DESTINATION ${CMAKE_INSTALL_BINDIR} COMPONENT RuntimeLibraries
|
||||
)
|
||||
endmacro()
|
||||
|
||||
@@ -250,7 +250,15 @@ if(NOT BLAS_FOUND)
|
||||
add_subdirectory(BLAS)
|
||||
set(BLAS_LIBRARIES ${BLASLIB})
|
||||
else()
|
||||
add_link_options(${BLAS_LINKER_FLAGS})
|
||||
set(CMAKE_EXE_LINKER_FLAGS
|
||||
"${CMAKE_EXE_LINKER_FLAGS} ${BLAS_LINKER_FLAGS}"
|
||||
CACHE STRING "Linker flags for executables" FORCE)
|
||||
set(CMAKE_MODULE_LINKER_FLAGS
|
||||
"${CMAKE_MODULE_LINKER_FLAGS} ${BLAS_LINKER_FLAGS}"
|
||||
CACHE STRING "Linker flags for modules" FORCE)
|
||||
set(CMAKE_SHARED_LINKER_FLAGS
|
||||
"${CMAKE_SHARED_LINKER_FLAGS} ${BLAS_LINKER_FLAGS}"
|
||||
CACHE STRING "Linker flags for shared libs" FORCE)
|
||||
endif()
|
||||
|
||||
|
||||
@@ -332,7 +340,15 @@ if(NOT LATESTLAPACK_FOUND)
|
||||
|
||||
add_subdirectory(SRC)
|
||||
else()
|
||||
add_link_options(${LAPACK_LINKER_FLAGS})
|
||||
set(CMAKE_EXE_LINKER_FLAGS
|
||||
"${CMAKE_EXE_LINKER_FLAGS} ${LAPACK_LINKER_FLAGS}"
|
||||
CACHE STRING "Linker flags for executables" FORCE)
|
||||
set(CMAKE_MODULE_LINKER_FLAGS
|
||||
"${CMAKE_MODULE_LINKER_FLAGS} ${LAPACK_LINKER_FLAGS}"
|
||||
CACHE STRING "Linker flags for modules" FORCE)
|
||||
set(CMAKE_SHARED_LINKER_FLAGS
|
||||
"${CMAKE_SHARED_LINKER_FLAGS} ${LAPACK_LINKER_FLAGS}"
|
||||
CACHE STRING "Linker flags for shared libs" FORCE)
|
||||
endif()
|
||||
|
||||
if(BUILD_TESTING)
|
||||
@@ -541,7 +557,7 @@ install(FILES
|
||||
if (LAPACK++)
|
||||
install(
|
||||
DIRECTORY "${LAPACK_BINARY_DIR}/lib/"
|
||||
DESTINATION "${CMAKE_INSTALL_LIBDIR}${LAPACK_BINARY_PATH_SUFFIX}"
|
||||
DESTINATION ${CMAKE_INSTALL_LIBDIR}
|
||||
FILES_MATCHING REGEX "liblapackpp.(a|so)$"
|
||||
)
|
||||
install(
|
||||
@@ -574,7 +590,7 @@ if (BLAS++)
|
||||
)
|
||||
install(
|
||||
DIRECTORY "${LAPACK_BINARY_DIR}/lib/"
|
||||
DESTINATION "${CMAKE_INSTALL_LIBDIR}${LAPACK_BINARY_PATH_SUFFIX}"
|
||||
DESTINATION ${CMAKE_INSTALL_LIBDIR}
|
||||
FILES_MATCHING REGEX "libblaspp.(a|so)$"
|
||||
)
|
||||
install(
|
||||
|
||||
@@ -961,8 +961,6 @@ https://www.netlib.org/xblas/
|
||||
@defgroup blas3_grp Level 3 BLAS: matrix-matrix ops
|
||||
@{
|
||||
@defgroup gemm gemm: general matrix-matrix multiply
|
||||
@defgroup gemmtr gemmtr: general matrix-matrix multiply with triangular output
|
||||
|
||||
|
||||
@defgroup hemm {he,sy}mm: Hermitian/symmetric matrix-matrix multiply
|
||||
@defgroup herk {he,sy}rk: Hermitian/symmetric rank-k update
|
||||
|
||||
@@ -1,13 +1,5 @@
|
||||
cmake_minimum_required(VERSION 3.13)
|
||||
cmake_minimum_required(VERSION 3.6)
|
||||
project(TIMING Fortran)
|
||||
|
||||
# Add the CMake directory for custom CMake modules
|
||||
set(CMAKE_MODULE_PATH "${TIMING_SOURCE_DIR}/../CMAKE" ${CMAKE_MODULE_PATH})
|
||||
|
||||
# Check for any necessary platform specific compiler flags
|
||||
include(CheckLAPACKCompilerFlags)
|
||||
CheckLAPACKCompilerFlags()
|
||||
|
||||
add_executable(secondtst_NONE second_NONE.f secondtst.f)
|
||||
add_executable(secondtst_EXT_ETIME second_EXT_ETIME.f secondtst.f)
|
||||
add_executable(secondtst_EXT_ETIME_ second_EXT_ETIME_.f secondtst.f)
|
||||
|
||||
+1033
-1036
File diff suppressed because it is too large
Load Diff
@@ -1,4 +1,4 @@
|
||||
cmake_minimum_required(VERSION 3.13)
|
||||
cmake_minimum_required(VERSION 3.6)
|
||||
project(MANGLING C Fortran)
|
||||
|
||||
add_executable(xintface Fintface.f Cintface.c)
|
||||
|
||||
@@ -44,11 +44,9 @@ lapack_int API_SUFFIX(LAPACKE_ctfsm)( int matrix_layout, char transr, char side,
|
||||
}
|
||||
#ifndef LAPACK_DISABLE_NAN_CHECK
|
||||
if( LAPACKE_get_nancheck() ) {
|
||||
lapack_int mn = m;
|
||||
if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) mn = n;
|
||||
/* Optionally check input matrices for NaNs */
|
||||
if( IS_C_NONZERO(alpha) ) {
|
||||
if( API_SUFFIX(LAPACKE_ctf_nancheck)( matrix_layout, transr, uplo, diag, mn, a ) ) {
|
||||
if( API_SUFFIX(LAPACKE_ctf_nancheck)( matrix_layout, transr, uplo, diag, n, a ) ) {
|
||||
return -10;
|
||||
}
|
||||
}
|
||||
|
||||
@@ -48,12 +48,10 @@ lapack_int API_SUFFIX(LAPACKE_ctfsm_work)( int matrix_layout, char transr, char
|
||||
}
|
||||
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
|
||||
lapack_int ldb_t = MAX(1,m);
|
||||
lapack_int mn = m;
|
||||
lapack_complex_float* b_t = NULL;
|
||||
lapack_complex_float* a_t = NULL;
|
||||
if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) mn = n;
|
||||
/* Check leading dimension(s) */
|
||||
if( ldb < m ) {
|
||||
if( ldb < n ) {
|
||||
info = -12;
|
||||
API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctfsm_work", info );
|
||||
return info;
|
||||
@@ -68,7 +66,7 @@ lapack_int API_SUFFIX(LAPACKE_ctfsm_work)( int matrix_layout, char transr, char
|
||||
if( IS_C_NONZERO(alpha) ) {
|
||||
a_t = (lapack_complex_float*)
|
||||
LAPACKE_malloc( sizeof(lapack_complex_float) *
|
||||
( MAX(1,mn) * MAX(2,mn+1) ) / 2 );
|
||||
( MAX(1,n) * MAX(2,n+1) ) / 2 );
|
||||
if( a_t == NULL ) {
|
||||
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
|
||||
goto exit_level_1;
|
||||
@@ -79,7 +77,7 @@ lapack_int API_SUFFIX(LAPACKE_ctfsm_work)( int matrix_layout, char transr, char
|
||||
API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t );
|
||||
}
|
||||
if( IS_C_NONZERO(alpha) ) {
|
||||
API_SUFFIX(LAPACKE_ctf_trans)( matrix_layout, transr, uplo, diag, mn, a, a_t );
|
||||
API_SUFFIX(LAPACKE_ctf_trans)( matrix_layout, transr, uplo, diag, n, a, a_t );
|
||||
}
|
||||
/* Call LAPACK function and adjust info */
|
||||
LAPACK_ctfsm( &transr, &side, &uplo, &trans, &diag, &m, &n, &alpha, a_t,
|
||||
|
||||
@@ -51,8 +51,8 @@ lapack_int API_SUFFIX(LAPACKE_ctpmqrt_work)( int matrix_layout, char side, char
|
||||
}
|
||||
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
|
||||
lapack_int nrowsA, ncolsA, nrowsV;
|
||||
if ( API_SUFFIX(LAPACKE_lsame)(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; }
|
||||
else if ( API_SUFFIX(LAPACKE_lsame)(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; }
|
||||
if ( side == API_SUFFIX(LAPACKE_lsame)(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; }
|
||||
else if ( side == API_SUFFIX(LAPACKE_lsame)(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; }
|
||||
else {
|
||||
info = -2;
|
||||
API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpmqrt_work", info );
|
||||
|
||||
@@ -44,10 +44,8 @@ lapack_int API_SUFFIX(LAPACKE_dtfsm)( int matrix_layout, char transr, char side,
|
||||
#ifndef LAPACK_DISABLE_NAN_CHECK
|
||||
if( LAPACKE_get_nancheck() ) {
|
||||
/* Optionally check input matrices for NaNs */
|
||||
lapack_int mn = m;
|
||||
if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) mn = n;
|
||||
if( IS_D_NONZERO(alpha) ) {
|
||||
if( API_SUFFIX(LAPACKE_dtf_nancheck)( matrix_layout, transr, uplo, diag, mn, a ) ) {
|
||||
if( API_SUFFIX(LAPACKE_dtf_nancheck)( matrix_layout, transr, uplo, diag, n, a ) ) {
|
||||
return -10;
|
||||
}
|
||||
}
|
||||
|
||||
@@ -47,12 +47,10 @@ lapack_int API_SUFFIX(LAPACKE_dtfsm_work)( int matrix_layout, char transr, char
|
||||
}
|
||||
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
|
||||
lapack_int ldb_t = MAX(1,m);
|
||||
lapack_int mn = m;
|
||||
double* b_t = NULL;
|
||||
double* a_t = NULL;
|
||||
if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) mn = n;
|
||||
/* Check leading dimension(s) */
|
||||
if( ldb < m ) {
|
||||
if( ldb < n ) {
|
||||
info = -12;
|
||||
API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtfsm_work", info );
|
||||
return info;
|
||||
@@ -66,7 +64,7 @@ lapack_int API_SUFFIX(LAPACKE_dtfsm_work)( int matrix_layout, char transr, char
|
||||
if( IS_D_NONZERO(alpha) ) {
|
||||
a_t = (double*)
|
||||
LAPACKE_malloc( sizeof(double) *
|
||||
( MAX(1,mn) * MAX(2,mn+1) ) / 2 );
|
||||
( MAX(1,n) * MAX(2,n+1) ) / 2 );
|
||||
if( a_t == NULL ) {
|
||||
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
|
||||
goto exit_level_1;
|
||||
@@ -77,7 +75,7 @@ lapack_int API_SUFFIX(LAPACKE_dtfsm_work)( int matrix_layout, char transr, char
|
||||
API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t );
|
||||
}
|
||||
if( IS_D_NONZERO(alpha) ) {
|
||||
API_SUFFIX(LAPACKE_dtf_trans)( matrix_layout, transr, uplo, diag, mn, a, a_t );
|
||||
API_SUFFIX(LAPACKE_dtf_trans)( matrix_layout, transr, uplo, diag, n, a, a_t );
|
||||
}
|
||||
/* Call LAPACK function and adjust info */
|
||||
LAPACK_dtfsm( &transr, &side, &uplo, &trans, &diag, &m, &n, &alpha, a_t,
|
||||
|
||||
@@ -49,8 +49,8 @@ lapack_int API_SUFFIX(LAPACKE_dtpmqrt_work)( int matrix_layout, char side, char
|
||||
}
|
||||
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
|
||||
lapack_int nrowsA, ncolsA, nrowsV;
|
||||
if ( API_SUFFIX(LAPACKE_lsame)(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; }
|
||||
else if ( API_SUFFIX(LAPACKE_lsame)(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; }
|
||||
if ( side == API_SUFFIX(LAPACKE_lsame)(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; }
|
||||
else if ( side == API_SUFFIX(LAPACKE_lsame)(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; }
|
||||
else {
|
||||
info = -2;
|
||||
API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpmqrt_work", info );
|
||||
|
||||
@@ -47,7 +47,7 @@ int LAPACKE_get_nancheck( )
|
||||
}
|
||||
|
||||
/* Check environment variable, once and only once */
|
||||
env = getenv( "LAPACKE_NANCHECK" );
|
||||
env = getenv( "API_SUFFIX(LAPACKE_)NANCHECK" );
|
||||
if ( !env ) {
|
||||
/* By default, NaN checking is enabled */
|
||||
nancheck_flag = 1;
|
||||
|
||||
@@ -43,11 +43,9 @@ lapack_int API_SUFFIX(LAPACKE_stfsm)( int matrix_layout, char transr, char side,
|
||||
}
|
||||
#ifndef LAPACK_DISABLE_NAN_CHECK
|
||||
if( LAPACKE_get_nancheck() ) {
|
||||
lapack_int mn = m;
|
||||
if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) mn = n;
|
||||
/* Optionally check input matrices for NaNs */
|
||||
if( IS_S_NONZERO(alpha) ) {
|
||||
if( API_SUFFIX(LAPACKE_stf_nancheck)( matrix_layout, transr, uplo, diag, mn, a ) ) {
|
||||
if( API_SUFFIX(LAPACKE_stf_nancheck)( matrix_layout, transr, uplo, diag, n, a ) ) {
|
||||
return -10;
|
||||
}
|
||||
}
|
||||
|
||||
@@ -47,12 +47,10 @@ lapack_int API_SUFFIX(LAPACKE_stfsm_work)( int matrix_layout, char transr, char
|
||||
}
|
||||
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
|
||||
lapack_int ldb_t = MAX(1,m);
|
||||
lapack_int mn = MAX(1,m);
|
||||
float* b_t = NULL;
|
||||
float* a_t = NULL;
|
||||
if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) mn = n;
|
||||
/* Check leading dimension(s) */
|
||||
if( ldb < m ) {
|
||||
if( ldb < n ) {
|
||||
info = -12;
|
||||
API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stfsm_work", info );
|
||||
return info;
|
||||
@@ -65,7 +63,7 @@ lapack_int API_SUFFIX(LAPACKE_stfsm_work)( int matrix_layout, char transr, char
|
||||
}
|
||||
if( IS_S_NONZERO(alpha) ) {
|
||||
a_t = (float*)
|
||||
LAPACKE_malloc( sizeof(float) * ( MAX(1,mn) * MAX(2,mn+1) ) / 2 );
|
||||
LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
|
||||
if( a_t == NULL ) {
|
||||
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
|
||||
goto exit_level_1;
|
||||
@@ -76,7 +74,7 @@ lapack_int API_SUFFIX(LAPACKE_stfsm_work)( int matrix_layout, char transr, char
|
||||
API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t );
|
||||
}
|
||||
if( IS_S_NONZERO(alpha) ) {
|
||||
API_SUFFIX(LAPACKE_stf_trans)( matrix_layout, transr, uplo, diag, mn, a, a_t );
|
||||
API_SUFFIX(LAPACKE_stf_trans)( matrix_layout, transr, uplo, diag, n, a, a_t );
|
||||
}
|
||||
/* Call LAPACK function and adjust info */
|
||||
LAPACK_stfsm( &transr, &side, &uplo, &trans, &diag, &m, &n, &alpha, a_t,
|
||||
|
||||
@@ -49,8 +49,8 @@ lapack_int API_SUFFIX(LAPACKE_stpmqrt_work)( int matrix_layout, char side, char
|
||||
}
|
||||
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
|
||||
lapack_int nrowsA, ncolsA, nrowsV;
|
||||
if ( API_SUFFIX(LAPACKE_lsame)(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; }
|
||||
else if ( API_SUFFIX(LAPACKE_lsame)(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; }
|
||||
if ( side == API_SUFFIX(LAPACKE_lsame)(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; }
|
||||
else if ( side == API_SUFFIX(LAPACKE_lsame)(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; }
|
||||
else {
|
||||
info = -2;
|
||||
API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpmqrt_work", info );
|
||||
|
||||
@@ -44,11 +44,9 @@ lapack_int API_SUFFIX(LAPACKE_ztfsm)( int matrix_layout, char transr, char side,
|
||||
}
|
||||
#ifndef LAPACK_DISABLE_NAN_CHECK
|
||||
if( LAPACKE_get_nancheck() ) {
|
||||
lapack_int mn = m;
|
||||
if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) mn = n;
|
||||
/* Optionally check input matrices for NaNs */
|
||||
if( IS_Z_NONZERO(alpha) ) {
|
||||
if( API_SUFFIX(LAPACKE_ztf_nancheck)( matrix_layout, transr, uplo, diag, mn, a ) ) {
|
||||
if( API_SUFFIX(LAPACKE_ztf_nancheck)( matrix_layout, transr, uplo, diag, n, a ) ) {
|
||||
return -10;
|
||||
}
|
||||
}
|
||||
|
||||
@@ -48,12 +48,10 @@ lapack_int API_SUFFIX(LAPACKE_ztfsm_work)( int matrix_layout, char transr, char
|
||||
}
|
||||
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
|
||||
lapack_int ldb_t = MAX(1,m);
|
||||
lapack_int mn = m;
|
||||
lapack_complex_double* b_t = NULL;
|
||||
lapack_complex_double* a_t = NULL;
|
||||
if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) mn = n;
|
||||
/* Check leading dimension(s) */
|
||||
if( ldb < m ) {
|
||||
if( ldb < n ) {
|
||||
info = -12;
|
||||
API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztfsm_work", info );
|
||||
return info;
|
||||
@@ -68,7 +66,7 @@ lapack_int API_SUFFIX(LAPACKE_ztfsm_work)( int matrix_layout, char transr, char
|
||||
if( IS_Z_NONZERO(alpha) ) {
|
||||
a_t = (lapack_complex_double*)
|
||||
LAPACKE_malloc( sizeof(lapack_complex_double) *
|
||||
( MAX(1,mn) * MAX(2,mn+1) ) / 2 );
|
||||
( MAX(1,n) * MAX(2,n+1) ) / 2 );
|
||||
if( a_t == NULL ) {
|
||||
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
|
||||
goto exit_level_1;
|
||||
@@ -79,7 +77,7 @@ lapack_int API_SUFFIX(LAPACKE_ztfsm_work)( int matrix_layout, char transr, char
|
||||
API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t );
|
||||
}
|
||||
if( IS_Z_NONZERO(alpha) ) {
|
||||
API_SUFFIX(LAPACKE_ztf_trans)( matrix_layout, transr, uplo, diag, mn, a, a_t );
|
||||
API_SUFFIX(LAPACKE_ztf_trans)( matrix_layout, transr, uplo, diag, n, a, a_t );
|
||||
}
|
||||
/* Call LAPACK function and adjust info */
|
||||
LAPACK_ztfsm( &transr, &side, &uplo, &trans, &diag, &m, &n, &alpha, a_t,
|
||||
|
||||
@@ -51,8 +51,8 @@ lapack_int API_SUFFIX(LAPACKE_ztpmqrt_work)( int matrix_layout, char side, char
|
||||
}
|
||||
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
|
||||
lapack_int nrowsA, ncolsA, nrowsV;
|
||||
if ( API_SUFFIX(LAPACKE_lsame)(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; }
|
||||
else if ( API_SUFFIX(LAPACKE_lsame)(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; }
|
||||
if ( side == API_SUFFIX(LAPACKE_lsame)(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; }
|
||||
else if ( side == API_SUFFIX(LAPACKE_lsame)(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; }
|
||||
else {
|
||||
info = -2;
|
||||
API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpmqrt_work", info );
|
||||
|
||||
@@ -34,7 +34,7 @@
|
||||
|
||||
lapack_logical API_SUFFIX(LAPACKE_lsame)( char ca, char cb )
|
||||
{
|
||||
return (lapack_logical) LAPACK_lsame( &ca, &cb );
|
||||
return (lapack_logical) LAPACK_lsame( &ca, &cb, 1, 1 );
|
||||
}
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,45 @@
|
||||
CXX=g++
|
||||
# CXXFLAGS=-std=c++17 -Wall -Wextra -pedantic -g
|
||||
CXXFLAGS=-std=c++17 -O3 -march=native -ffast-math -g -DNDEBUG
|
||||
|
||||
FC=gfortran
|
||||
FFLAGS=-Wall -Wextra -pedantic -g
|
||||
|
||||
all: ./example/test_lasr3 ./example/profile_lasr3 ./example/profile_steqr3 $(OBJFILES)
|
||||
|
||||
HEADERS = $(wildcard include/lapack_c/*.h) \
|
||||
$(wildcard include/lapack_c/*/*.h) \
|
||||
$(wildcard include/lapack_c/*/*/*.h) \
|
||||
$(wildcard include/lapack_cpp/*.hpp) \
|
||||
$(wildcard include/lapack_cpp/*/*.hpp) \
|
||||
$(wildcard include/lapack_cpp/*/*/*.hpp)
|
||||
|
||||
SRCFILES = $(wildcard src/lapack_c/*.cpp) \
|
||||
$(wildcard src/lapack_c/*.f90) \
|
||||
$(wildcard src/lapack_cpp/*.cpp) \
|
||||
$(wildcard src/lapack_fortran/*.f90)
|
||||
|
||||
OBJFILES = $(patsubst %.f90, %_f90.o ,$(patsubst %.cpp,%_cpp.o,$(SRCFILES)))
|
||||
|
||||
# Fortran files
|
||||
src/lapack_fortran/%_f90.o: src/lapack_fortran/%.f90
|
||||
$(FC) $(FFLAGS) -cpp -c -o $@ $<
|
||||
|
||||
# C files
|
||||
|
||||
src/lapack_c/%_cpp.o: src/lapack_c/%.cpp $(HEADERS)
|
||||
$(CXX) $(CXXFLAGS) -I./include -c -o $@ $<
|
||||
|
||||
src/lapack_c/%_f90.o: src/lapack_c/%.f90
|
||||
$(FC) $(FFLAGS) -cpp -c -o $@ $<
|
||||
|
||||
# C++ files
|
||||
src/lapack_cpp/%_cpp.o: src/lapack_cpp/%.cpp $(HEADERS)
|
||||
$(CXX) $(CXXFLAGS) -I./include -c -o $@ $<
|
||||
|
||||
# Test files
|
||||
example/%: example/%.cpp $(OBJFILES) $(HEADERS)
|
||||
$(CXX) $(CXXFLAGS) -o $@ $< $(OBJFILES) -I./include -lstdc++ -lgfortran -lblas -llapack
|
||||
|
||||
clean:
|
||||
find . -type f -name '*.o' -delete
|
||||
@@ -0,0 +1,3 @@
|
||||
test_lasr3
|
||||
profile_lasr3
|
||||
profile_steqr3
|
||||
@@ -0,0 +1,111 @@
|
||||
|
||||
#include <chrono> // for high_resolution_clock
|
||||
#include <complex>
|
||||
#include <iostream>
|
||||
|
||||
#include "lapack_cpp.hpp"
|
||||
|
||||
using namespace lapack_cpp;
|
||||
|
||||
template <typename T,
|
||||
Layout layout = Layout::ColMajor,
|
||||
typename idx_t = lapack_idx_t>
|
||||
void profile_lasr3(idx_t m, idx_t n, idx_t k, Side side, Direction direction)
|
||||
{
|
||||
idx_t n_rot = side == Side::Left ? m - 1 : n - 1;
|
||||
|
||||
MemoryBlock<T, idx_t> A_(m, n, layout);
|
||||
Matrix<T, layout, idx_t> A(m, n, A_);
|
||||
|
||||
MemoryBlock<real_t<T>, idx_t> C_(n_rot, k, layout);
|
||||
Matrix<real_t<T>, layout, idx_t> C(n_rot, k, C_);
|
||||
|
||||
MemoryBlock<T, idx_t> S_(n_rot, k, layout);
|
||||
Matrix<T, layout, idx_t> S(n_rot, k, S_);
|
||||
|
||||
randomize(A);
|
||||
|
||||
// Generate random, but valid rotations
|
||||
randomize(C);
|
||||
randomize(S);
|
||||
for (idx_t i = 0; i < n_rot; ++i)
|
||||
{
|
||||
for (idx_t j = 0; j < k; ++j)
|
||||
{
|
||||
T f = C(i, j);
|
||||
T g = S(i, j);
|
||||
T r;
|
||||
lartg(f, g, C(i, j), S(i, j), r);
|
||||
}
|
||||
}
|
||||
|
||||
MemoryBlock<T, idx_t> A_copy_(m, n, layout);
|
||||
Matrix<T, layout, idx_t> A_copy(m, n, A_copy_);
|
||||
|
||||
A_copy = A;
|
||||
|
||||
MemoryBlock<T, idx_t> work(
|
||||
lasr3_workquery(side, direction, C.as_const(), S.as_const(), A));
|
||||
|
||||
const idx_t n_timings = 100;
|
||||
const idx_t n_warmup = 20;
|
||||
std::vector<float> timings(n_timings);
|
||||
|
||||
for (idx_t i = 0; i < n_timings; ++i)
|
||||
{
|
||||
A = A_copy;
|
||||
auto start = std::chrono::high_resolution_clock::now();
|
||||
lasr3(side, direction, C.as_const(), S.as_const(), A, work);
|
||||
auto end = std::chrono::high_resolution_clock::now();
|
||||
timings[i] = std::chrono::duration<float>(end - start).count();
|
||||
}
|
||||
|
||||
float mean = 0;
|
||||
for (idx_t i = n_warmup; i < n_timings; ++i)
|
||||
mean += timings[i];
|
||||
mean /= n_timings - n_warmup;
|
||||
|
||||
float std_dev = 0;
|
||||
for (idx_t i = n_warmup; i < n_timings; ++i)
|
||||
std_dev += (timings[i] - mean) * (timings[i] - mean);
|
||||
std_dev = std::sqrt(std_dev / (n_timings - n_warmup - 1));
|
||||
|
||||
long nflops =
|
||||
side == Side::Left ? 6. * (m - 1) * n * k : 6. * (n - 1) * m * k;
|
||||
|
||||
std::cout << "m = " << m << ", n = " << n << ", k = " << k
|
||||
<< ", side = " << (char)side
|
||||
<< ", direction = " << (char)direction << ", mean time = " << mean
|
||||
<< " s"
|
||||
<< ", std dev = " << std_dev / mean * 100 << " %"
|
||||
<< ", flop rate = " << nflops / mean * 1.0e-9 << " GFlops"
|
||||
<< std::endl;
|
||||
}
|
||||
|
||||
int main()
|
||||
{
|
||||
typedef lapack_idx_t idx_t;
|
||||
typedef double T;
|
||||
|
||||
const idx_t nb = 1000;
|
||||
const idx_t k = 64;
|
||||
|
||||
for (int s = 0; s < 2; ++s)
|
||||
{
|
||||
Side side = s == 0 ? Side::Left : Side::Right;
|
||||
for (int d = 0; d < 2; ++d)
|
||||
{
|
||||
Direction direction =
|
||||
d == 0 ? Direction::Forward : Direction::Backward;
|
||||
for (idx_t n_rot = 99; n_rot <= 1600; n_rot += 100)
|
||||
{
|
||||
idx_t m = side == Side::Left ? n_rot + 1 : nb;
|
||||
idx_t n = side == Side::Left ? nb : n_rot + 1;
|
||||
|
||||
profile_lasr3<T, Layout::ColMajor, lapack_idx_t>(m, n, k, side,
|
||||
direction);
|
||||
}
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
@@ -0,0 +1,102 @@
|
||||
|
||||
#include <chrono> // for high_resolution_clock
|
||||
#include <complex>
|
||||
#include <iostream>
|
||||
|
||||
#include "lapack_cpp.hpp"
|
||||
|
||||
using namespace lapack_cpp;
|
||||
|
||||
template <typename T,
|
||||
Layout layout = Layout::ColMajor,
|
||||
typename idx_t = lapack_idx_t>
|
||||
void profile_steqr3(idx_t n, bool use_fortran = false)
|
||||
{
|
||||
MemoryBlock<T, idx_t> Z_(n, n, layout);
|
||||
Matrix<T, layout, idx_t> Z(n, n, Z_);
|
||||
|
||||
MemoryBlock<T, idx_t> d_(n);
|
||||
Vector<T, idx_t> d(n, d_);
|
||||
|
||||
MemoryBlock<T, idx_t> e_(n - 1);
|
||||
Vector<T, idx_t> e(n - 1, e_);
|
||||
|
||||
MemoryBlock<T, idx_t> d_copy_(n);
|
||||
Vector<T, idx_t> d_copy(n, d_copy_);
|
||||
|
||||
MemoryBlock<T, idx_t> e_copy_(n - 1);
|
||||
Vector<T, idx_t> e_copy(n - 1, e_copy_);
|
||||
|
||||
randomize(d);
|
||||
randomize(e);
|
||||
|
||||
d_copy = d;
|
||||
e_copy = e;
|
||||
|
||||
CompQ compz = CompQ::Initialize;
|
||||
|
||||
const idx_t n_timings = 100;
|
||||
const idx_t n_warmup = 50;
|
||||
std::vector<float> timings(n_timings);
|
||||
|
||||
if (use_fortran)
|
||||
{
|
||||
MemoryBlock<real_t<T>, idx_t> rwork(2 * n - 2);
|
||||
for (idx_t i = 0; i < n_timings; ++i)
|
||||
{
|
||||
d = d_copy;
|
||||
e = e_copy;
|
||||
auto start = std::chrono::high_resolution_clock::now();
|
||||
steqr(compz, d, e, Z, rwork);
|
||||
auto end = std::chrono::high_resolution_clock::now();
|
||||
timings[i] = std::chrono::duration<float>(end - start).count();
|
||||
std::cout << i << " " << timings[i] << '\r' << std::flush;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
MemoryBlock<T, idx_t> work(steqr3_workquery(compz, d, e, Z));
|
||||
MemoryBlock<real_t<T>, idx_t> rwork(steqr3_rworkquery(compz, d, e, Z));
|
||||
for (idx_t i = 0; i < n_timings; ++i)
|
||||
{
|
||||
d = d_copy;
|
||||
e = e_copy;
|
||||
auto start = std::chrono::high_resolution_clock::now();
|
||||
steqr3(compz, d, e, Z, work, rwork);
|
||||
auto end = std::chrono::high_resolution_clock::now();
|
||||
timings[i] = std::chrono::duration<float>(end - start).count();
|
||||
std::cout << i << " " << timings[i] << '\r' << std::flush;
|
||||
}
|
||||
}
|
||||
|
||||
float mean = 0;
|
||||
for (idx_t i = n_warmup; i < n_timings; ++i)
|
||||
mean += timings[i];
|
||||
mean /= n_timings - n_warmup;
|
||||
|
||||
float std_dev = 0;
|
||||
for (idx_t i = n_warmup; i < n_timings; ++i)
|
||||
std_dev += (timings[i] - mean) * (timings[i] - mean);
|
||||
std_dev = std::sqrt(std_dev / (n_timings - n_warmup - 1));
|
||||
|
||||
std::cout << "n = " << n << ", using fortran: " << use_fortran << ", mean time = " << mean
|
||||
<< " s"
|
||||
<< ", std dev = " << std_dev / mean * 100 << " %"
|
||||
<< std::endl;
|
||||
}
|
||||
|
||||
int main()
|
||||
{
|
||||
typedef lapack_idx_t idx_t;
|
||||
typedef double T;
|
||||
|
||||
for (int n = 32; n <= 2000; n *= 2)
|
||||
{
|
||||
profile_steqr3<T, Layout::ColMajor, idx_t>(n, false);
|
||||
}
|
||||
for (int n = 32; n <= 2000; n *= 2)
|
||||
{
|
||||
profile_steqr3<T, Layout::ColMajor, idx_t>(n, true);
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
@@ -0,0 +1,115 @@
|
||||
|
||||
#include <complex>
|
||||
#include <iostream>
|
||||
|
||||
#include "lapack_cpp.hpp"
|
||||
|
||||
using namespace lapack_cpp;
|
||||
|
||||
template <typename T,
|
||||
Layout layout = Layout::ColMajor,
|
||||
typename idx_t = lapack_idx_t>
|
||||
void test_lasr3(idx_t m, idx_t n, idx_t k, Side side, Direction direction)
|
||||
{
|
||||
idx_t n_rot = side == Side::Left ? m - 1 : n - 1;
|
||||
|
||||
MemoryBlock<T, idx_t> A_(m, n, layout);
|
||||
Matrix<T, layout, idx_t> A(m, n, A_);
|
||||
|
||||
MemoryBlock<real_t<T>, idx_t> C_(n_rot, k, layout);
|
||||
Matrix<real_t<T>, layout, idx_t> C(n_rot, k, C_);
|
||||
|
||||
MemoryBlock<T, idx_t> S_(n_rot, k, layout);
|
||||
Matrix<T, layout, idx_t> S(n_rot, k, S_);
|
||||
|
||||
randomize(A);
|
||||
|
||||
// Generate random, but valid rotations
|
||||
randomize(C);
|
||||
randomize(S);
|
||||
for (idx_t i = 0; i < n_rot; ++i) {
|
||||
for (idx_t j = 0; j < k; ++j) {
|
||||
T f = C(i, j);
|
||||
T g = S(i, j);
|
||||
T r;
|
||||
lartg(f, g, C(i, j), S(i, j), r);
|
||||
}
|
||||
}
|
||||
|
||||
MemoryBlock<T, idx_t> A_copy_(m, n, layout);
|
||||
Matrix<T, layout, idx_t> A_copy(m, n, A_copy_);
|
||||
|
||||
A_copy = A;
|
||||
|
||||
// Apply rotations using simple loops as test
|
||||
if (side == Side::Left) {
|
||||
if (direction == Direction::Forward) {
|
||||
for (idx_t i = 0; i < k; ++i)
|
||||
for (idx_t j = 0; j < n_rot; ++j)
|
||||
rot(A_copy.row(j), A_copy.row(j + 1), C(j, i), S(j, i));
|
||||
}
|
||||
else {
|
||||
for (idx_t i = 0; i < k; ++i)
|
||||
for (idx_t j = n_rot - 1; j >= 0; --j)
|
||||
rot(A_copy.row(j), A_copy.row(j + 1), C(j, i), S(j, i));
|
||||
}
|
||||
}
|
||||
else {
|
||||
if (direction == Direction::Forward) {
|
||||
for (idx_t i = 0; i < k; ++i)
|
||||
for (idx_t j = 0; j < n_rot; ++j)
|
||||
rot(A_copy.column(j), A_copy.column(j + 1), C(j, i),
|
||||
conj(S(j, i)));
|
||||
}
|
||||
else {
|
||||
for (idx_t i = 0; i < k; ++i)
|
||||
for (idx_t j = n_rot - 1; j >= 0; --j)
|
||||
rot(A_copy.column(j), A_copy.column(j + 1), C(j, i),
|
||||
conj(S(j, i)));
|
||||
}
|
||||
}
|
||||
|
||||
lasr3(side, direction, C.as_const(), S.as_const(), A);
|
||||
|
||||
// Check that the result is the same
|
||||
for (idx_t i = 0; i < m; ++i)
|
||||
for (idx_t j = 0; j < n; ++j)
|
||||
A_copy(i, j) -= A(i, j);
|
||||
|
||||
real_t<T> err = 0.;
|
||||
for (idx_t i = 0; i < m; ++i)
|
||||
for (idx_t j = 0; j < n; ++j)
|
||||
err = std::max(err, abs(A_copy(i, j)));
|
||||
|
||||
// This test should really be relative
|
||||
if( err > 1e-5 ){
|
||||
std::cout << "Failed test_lasr3 with parameters: " << m << ", " << n << ", " << k << ", " << (char)side << ", " << (char)direction << std::endl;
|
||||
std::cout << "Error: " << err << std::endl;
|
||||
} else {
|
||||
std::cout << "Passed test_lasr3 with parameters: " << m << ", " << n << ", " << k << ", " << (char)side << ", " << (char)direction << std::endl;
|
||||
}
|
||||
|
||||
// print(A_copy);
|
||||
}
|
||||
|
||||
int main()
|
||||
{
|
||||
typedef lapack_idx_t idx_t;
|
||||
typedef std::complex<float> T;
|
||||
|
||||
for (idx_t nb = 64; nb <= 2000; nb *= 2) {
|
||||
for (idx_t n_rot = 2; n_rot <= 2000; n_rot*=2) {
|
||||
for (idx_t k = 32; k <= 128; k+=32) {
|
||||
test_lasr3<T, Layout::ColMajor, lapack_idx_t>(
|
||||
n_rot + 1, nb, k, Side::Left, Direction::Forward);
|
||||
test_lasr3<T, Layout::ColMajor, lapack_idx_t>(
|
||||
nb, n_rot + 1, k, Side::Right, Direction::Forward);
|
||||
test_lasr3<T, Layout::ColMajor, lapack_idx_t>(
|
||||
n_rot + 1, nb, k, Side::Left, Direction::Backward);
|
||||
test_lasr3<T, Layout::ColMajor, lapack_idx_t>(
|
||||
nb, n_rot + 1, k, Side::Right, Direction::Backward);
|
||||
}
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
@@ -0,0 +1,18 @@
|
||||
#ifndef LAPACK_C_HPP
|
||||
#define LAPACK_C_HPP
|
||||
|
||||
#include "lapack_c/util.h"
|
||||
|
||||
// BLAS
|
||||
#include "lapack_c/rot.h"
|
||||
|
||||
// LAPACK
|
||||
#include "lapack_c/lartg.h"
|
||||
#include "lapack_c/lasrt.h"
|
||||
#include "lapack_c/lae2.h"
|
||||
#include "lapack_c/laev2.h"
|
||||
#include "lapack_c/lasrt.h"
|
||||
#include "lapack_c/steqr.h"
|
||||
#include "lapack_c/steqr3.h"
|
||||
|
||||
#endif
|
||||
@@ -0,0 +1,19 @@
|
||||
#ifndef LAPACK_C_LAE2_HPP
|
||||
#define LAPACK_C_LAE2_HPP
|
||||
|
||||
#include "lapack_c/util.h"
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C"
|
||||
{
|
||||
#endif // __cplusplus
|
||||
|
||||
void lapack_c_slae2(float a, float b, float c, float *rt1, float *rt2);
|
||||
|
||||
void lapack_c_dlae2(double a, double b, double c, double *rt1, double *rt2);
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif // __cplusplus
|
||||
|
||||
#endif // LAPACK_C_LAE2_HPP
|
||||
@@ -0,0 +1,19 @@
|
||||
#ifndef LAPACK_C_LAEV2_HPP
|
||||
#define LAPACK_C_LAEV2_HPP
|
||||
|
||||
#include "lapack_c/util.h"
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C"
|
||||
{
|
||||
#endif // __cplusplus
|
||||
|
||||
void lapack_c_slaev2(float a, float b, float c, float *rt1, float *rt2, float *cs1, float *sn1);
|
||||
|
||||
void lapack_c_dlaev2(double a, double b, double c, double *rt1, double *rt2, double *cs1, double *sn1);
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif // __cplusplus
|
||||
|
||||
#endif // LAPACK_C_LAEV2_HPP
|
||||
@@ -0,0 +1,22 @@
|
||||
#ifndef LAPACK_C_LARTG_HPP
|
||||
#define LAPACK_C_LARTG_HPP
|
||||
|
||||
#include "lapack_c/util.h"
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif // __cplusplus
|
||||
|
||||
void lapack_c_slartg(float f, float g, float* cs, float* sn, float* r);
|
||||
|
||||
void lapack_c_dlartg(double f, double g, double* cs, double* sn, double* r);
|
||||
|
||||
void lapack_c_clartg(lapack_float_complex f, lapack_float_complex g, float* cs, lapack_float_complex* sn, lapack_float_complex* r);
|
||||
|
||||
void lapack_c_zlartg(lapack_double_complex f, lapack_double_complex g, double* cs, lapack_double_complex* sn, lapack_double_complex* r);
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif // __cplusplus
|
||||
|
||||
#endif
|
||||
@@ -0,0 +1,99 @@
|
||||
#ifndef LAPACK_C_ROT_HPP
|
||||
#define LAPACK_C_ROT_HPP
|
||||
|
||||
#include "lapack_c/util.h"
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C"
|
||||
{
|
||||
#endif // __cplusplus
|
||||
|
||||
void lapack_c_slasr3(char side,
|
||||
char direct,
|
||||
lapack_idx m,
|
||||
lapack_idx n,
|
||||
lapack_idx k,
|
||||
const float *C,
|
||||
lapack_idx ldc,
|
||||
const float *S,
|
||||
lapack_idx lds,
|
||||
float *A,
|
||||
lapack_idx lda,
|
||||
float *work,
|
||||
lapack_idx lwork);
|
||||
|
||||
void lapack_c_dlasr3(char side,
|
||||
char direct,
|
||||
lapack_idx m,
|
||||
lapack_idx n,
|
||||
lapack_idx k,
|
||||
const double *C,
|
||||
lapack_idx ldc,
|
||||
const double *S,
|
||||
lapack_idx lds,
|
||||
double *A,
|
||||
lapack_idx lda,
|
||||
double *work,
|
||||
lapack_idx lwork);
|
||||
|
||||
void lapack_c_clasr3(char side,
|
||||
char direct,
|
||||
lapack_idx m,
|
||||
lapack_idx n,
|
||||
lapack_idx k,
|
||||
const float *C,
|
||||
lapack_idx ldc,
|
||||
const lapack_float_complex *S,
|
||||
lapack_idx lds,
|
||||
lapack_float_complex *A,
|
||||
lapack_idx lda,
|
||||
lapack_float_complex *work,
|
||||
lapack_idx lwork);
|
||||
|
||||
void lapack_c_sclasr3(char side,
|
||||
char direct,
|
||||
lapack_idx m,
|
||||
lapack_idx n,
|
||||
lapack_idx k,
|
||||
const float *C,
|
||||
lapack_idx ldc,
|
||||
const float *S,
|
||||
lapack_idx lds,
|
||||
lapack_float_complex *A,
|
||||
lapack_idx lda,
|
||||
lapack_float_complex *work,
|
||||
lapack_idx lwork);
|
||||
|
||||
void lapack_c_zlasr3(char side,
|
||||
char direct,
|
||||
lapack_idx m,
|
||||
lapack_idx n,
|
||||
lapack_idx k,
|
||||
const double *C,
|
||||
lapack_idx ldc,
|
||||
const lapack_double_complex *S,
|
||||
lapack_idx lds,
|
||||
lapack_double_complex *A,
|
||||
lapack_idx lda,
|
||||
lapack_double_complex *work,
|
||||
lapack_idx lwork);
|
||||
|
||||
void lapack_c_dzlasr3(char side,
|
||||
char direct,
|
||||
lapack_idx m,
|
||||
lapack_idx n,
|
||||
lapack_idx k,
|
||||
const double *C,
|
||||
lapack_idx ldc,
|
||||
const double *S,
|
||||
lapack_idx lds,
|
||||
lapack_double_complex *A,
|
||||
lapack_idx lda,
|
||||
lapack_double_complex *work,
|
||||
lapack_idx lwork);
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif // __cplusplus
|
||||
|
||||
#endif
|
||||
@@ -0,0 +1,19 @@
|
||||
#ifndef LAPACK_C_LASRT_HPP
|
||||
#define LAPACK_C_LASRT_HPP
|
||||
|
||||
#include "lapack_c/util.h"
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C"
|
||||
{
|
||||
#endif // __cplusplus
|
||||
|
||||
void lapack_c_slasrt(char id, lapack_idx n, float* d, lapack_idx *info);
|
||||
|
||||
void lapack_c_dlasrt(char id, lapack_idx n, double* d, lapack_idx *info);
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif // __cplusplus
|
||||
|
||||
#endif // LAPACK_C_LASRT_HPP
|
||||
@@ -0,0 +1,46 @@
|
||||
#ifndef LAPACK_C_ROT_HPP
|
||||
#define LAPACK_C_ROT_HPP
|
||||
|
||||
#include "lapack_c/util.h"
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif // __cplusplus
|
||||
|
||||
void lapack_c_drot(lapack_idx n,
|
||||
double* x,
|
||||
lapack_idx incx,
|
||||
double* y,
|
||||
lapack_idx incy,
|
||||
double c,
|
||||
double s);
|
||||
|
||||
void lapack_c_srot(lapack_idx n,
|
||||
float* x,
|
||||
lapack_idx incx,
|
||||
float* y,
|
||||
lapack_idx incy,
|
||||
float c,
|
||||
float s);
|
||||
|
||||
void lapack_c_crot(lapack_idx n,
|
||||
lapack_float_complex* x,
|
||||
lapack_idx incx,
|
||||
lapack_float_complex* y,
|
||||
lapack_idx incy,
|
||||
float c,
|
||||
lapack_float_complex s);
|
||||
|
||||
void lapack_c_zrot(lapack_idx n,
|
||||
lapack_double_complex* x,
|
||||
lapack_idx incx,
|
||||
lapack_double_complex* y,
|
||||
lapack_idx incy,
|
||||
double c,
|
||||
lapack_double_complex s);
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif // __cplusplus
|
||||
|
||||
#endif
|
||||
@@ -0,0 +1,51 @@
|
||||
#ifndef LAPACK_C_STEQR_HPP
|
||||
#define LAPACK_C_STEQR_HPP
|
||||
|
||||
#include "lapack_c/util.h"
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C"
|
||||
{
|
||||
#endif // __cplusplus
|
||||
|
||||
void lapack_c_ssteqr(char compz,
|
||||
lapack_idx n,
|
||||
float *d,
|
||||
float *e,
|
||||
float *Z,
|
||||
lapack_idx ldz,
|
||||
float *work,
|
||||
lapack_idx *info);
|
||||
|
||||
void lapack_c_dsteqr(char compz,
|
||||
lapack_idx n,
|
||||
double *d,
|
||||
double *e,
|
||||
double *Z,
|
||||
lapack_idx ldz,
|
||||
double *work,
|
||||
lapack_idx *info);
|
||||
|
||||
void lapack_c_csteqr(char compz,
|
||||
lapack_idx n,
|
||||
float *d,
|
||||
float *e,
|
||||
lapack_float_complex *Z,
|
||||
lapack_idx ldz,
|
||||
float *work,
|
||||
lapack_idx *info);
|
||||
|
||||
void lapack_c_zsteqr(char compz,
|
||||
lapack_idx n,
|
||||
double *d,
|
||||
double *e,
|
||||
lapack_double_complex *Z,
|
||||
lapack_idx ldz,
|
||||
double *work,
|
||||
lapack_idx *info);
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif // __cplusplus
|
||||
|
||||
#endif // LAPACK_C_STEQR_HPP
|
||||
@@ -0,0 +1,63 @@
|
||||
#ifndef LAPACK_C_STEQR3_HPP
|
||||
#define LAPACK_C_STEQR3_HPP
|
||||
|
||||
#include "lapack_c/util.h"
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C"
|
||||
{
|
||||
#endif // __cplusplus
|
||||
|
||||
void lapack_c_ssteqr3(char compz,
|
||||
lapack_idx n,
|
||||
float *d,
|
||||
float *e,
|
||||
float *Z,
|
||||
lapack_idx ldz,
|
||||
float *work,
|
||||
lapack_idx lwork,
|
||||
float *rwork,
|
||||
lapack_idx lrwork,
|
||||
lapack_idx *info);
|
||||
|
||||
void lapack_c_dsteqr3(char compz,
|
||||
lapack_idx n,
|
||||
double *d,
|
||||
double *e,
|
||||
double *Z,
|
||||
lapack_idx ldz,
|
||||
double *work,
|
||||
lapack_idx lwork,
|
||||
double *rwork,
|
||||
lapack_idx lrwork,
|
||||
lapack_idx *info);
|
||||
|
||||
void lapack_c_csteqr3(char compz,
|
||||
lapack_idx n,
|
||||
float *d,
|
||||
float *e,
|
||||
lapack_float_complex *Z,
|
||||
lapack_idx ldz,
|
||||
lapack_float_complex *work,
|
||||
lapack_idx lwork,
|
||||
float *rwork,
|
||||
lapack_idx lrwork,
|
||||
lapack_idx *info);
|
||||
|
||||
void lapack_c_zsteqr3(char compz,
|
||||
lapack_idx n,
|
||||
double *d,
|
||||
double *e,
|
||||
lapack_double_complex *Z,
|
||||
lapack_idx ldz,
|
||||
lapack_double_complex *work,
|
||||
lapack_idx lwork,
|
||||
double *rwork,
|
||||
lapack_idx lrwork,
|
||||
lapack_idx *info);
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif // __cplusplus
|
||||
|
||||
#endif // LAPACK_C_STEQR3_HPP
|
||||
@@ -0,0 +1,19 @@
|
||||
#ifndef LAPACK_C_UTIL_H
|
||||
#define LAPACK_C_UTIL_H
|
||||
|
||||
// Define types for complex number
|
||||
#ifdef __cplusplus
|
||||
#include <complex>
|
||||
#define lapack_float_complex std::complex<float>
|
||||
#define lapack_double_complex std::complex<double>
|
||||
#else
|
||||
#define lapack_float_complex float _Complex
|
||||
#define lapack_double_complex double _Complex
|
||||
#endif // __cplusplus
|
||||
|
||||
// Default to 32 bit integer if not yet defined
|
||||
#ifndef lapack_idx
|
||||
#define lapack_idx int
|
||||
#endif // lapack_idx
|
||||
|
||||
#endif
|
||||
@@ -0,0 +1,9 @@
|
||||
#ifndef LAPACK_CPP_HPP
|
||||
#define LAPACK_CPP_HPP
|
||||
|
||||
#include "lapack_cpp/base.hpp"
|
||||
#include "lapack_cpp/blas.hpp"
|
||||
#include "lapack_cpp/lapack.hpp"
|
||||
#include "lapack_cpp/utils.hpp"
|
||||
|
||||
#endif // LAPACK_CPP_HPP
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user