Skip to content

Commit b721a55

Browse files
grisuthedragongrisuthedragon
committed
Working CBLAS_ZGEMMTR Test
1 parent 60d0e76 commit b721a55

File tree

7 files changed

+276
-274
lines changed

7 files changed

+276
-274
lines changed

‎BLAS/SRC/cgemmtr.f‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -278,8 +278,7 @@ SUBROUTINE CGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB,
278278
*
279279
* Quick return if possible.
280280
*
281-
IF ((N.EQ.0) .OR.
282-
+ (((ALPHA.EQ.ZERO).OR. (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN
281+
IF (N.EQ.0) RETURN
283282
*
284283
* And when alpha.eq.zero.
285284
*

‎BLAS/SRC/zgemmtr.f‎

Lines changed: 3 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -222,9 +222,9 @@ SUBROUTINE ZGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB,
222222
* ..
223223
* .. Parameters ..
224224
COMPLEX*16 ONE
225-
PARAMETER (ONE= (1.0E+0,0.0E+0))
225+
PARAMETER (ONE= (1.0D+0,0.0D+0))
226226
COMPLEX*16 ZERO
227-
PARAMETER (ZERO= (0.0E+0,0.0E+0))
227+
PARAMETER (ZERO= (0.0D+0,0.0D+0))
228228
* ..
229229
*
230230
* Set NOTA and NOTB as true if A and B respectively are not
@@ -278,8 +278,7 @@ SUBROUTINE ZGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB,
278278
*
279279
* Quick return if possible.
280280
*
281-
IF ((N.EQ.0) .OR.
282-
+ (((ALPHA.EQ.ZERO).OR. (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN
281+
IF (N.EQ.0) RETURN
283282
*
284283
* And when alpha.eq.zero.
285284
*

‎CBLAS/src/cblas_cgemmtr.c‎

Lines changed: 94 additions & 93 deletions
Original file line numberDiff line numberDiff line change
@@ -10,124 +10,125 @@
1010
#include "cblas.h"
1111
#include "cblas_f77.h"
1212
void API_SUFFIX(cblas_cgemmtr)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA,
13-
const CBLAS_TRANSPOSE TransB, const CBLAS_INT N,
14-
const CBLAS_INT K, const void *alpha, const void *A,
15-
const CBLAS_INT lda, const void *B, const CBLAS_INT ldb,
16-
const void *beta, void *C, const CBLAS_INT ldc)
13+
const CBLAS_TRANSPOSE TransB, const CBLAS_INT N,
14+
const CBLAS_INT K, const void *alpha, const void *A,
15+
const CBLAS_INT lda, const void *B, const CBLAS_INT ldb,
16+
const void *beta, void *C, const CBLAS_INT ldc)
1717
{
18-
char TA, TB;
19-
char UL;
18+
char TA, TB;
19+
char UL;
2020
#ifdef F77_CHAR
21-
F77_CHAR F77_TA, F77_TB, F77_UL;
21+
F77_CHAR F77_TA, F77_TB, F77_UL;
2222
#else
23-
#define F77_TA &TA
24-
#define F77_TB &TB
25-
#define F77_UL &UL
23+
#define F77_TA &TA
24+
#define F77_TB &TB
25+
#define F77_UL &UL
2626
#endif
2727

2828
#ifdef F77_INT
29-
F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
30-
F77_INT F77_ldc=ldc;
29+
F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
30+
F77_INT F77_ldc=ldc;
3131
#else
32-
#define F77_N N
33-
#define F77_K K
34-
#define F77_lda lda
35-
#define F77_ldb ldb
36-
#define F77_ldc ldc
32+
#define F77_N N
33+
#define F77_K K
34+
#define F77_lda lda
35+
#define F77_ldb ldb
36+
#define F77_ldc ldc
3737
#endif
3838

39-
extern int CBLAS_CallFromC;
40-
extern int RowMajorStrg;
41-
RowMajorStrg = 0;
42-
CBLAS_CallFromC = 1;
39+
extern int CBLAS_CallFromC;
40+
extern int RowMajorStrg;
41+
RowMajorStrg = 0;
42+
CBLAS_CallFromC = 1;
4343

4444

45-
if( layout == CblasColMajor )
46-
{
47-
if ( Uplo == CblasUpper ) UL = 'U';
48-
else if (Uplo == CblasLower) UL= 'L';
49-
else {
45+
if( layout == CblasColMajor )
46+
{
47+
if ( Uplo == CblasUpper ) UL = 'U';
48+
else if (Uplo == CblasLower) UL= 'L';
49+
else {
5050
API_SUFFIX(cblas_xerbla)(2, "cblas_cgemmtr", "Illegal Uplo setting, %d\n", Uplo);
5151
CBLAS_CallFromC = 0;
5252
RowMajorStrg = 0;
5353
return;
54-
}
54+
}
5555

56-
if(TransA == CblasTrans) TA='T';
57-
else if ( TransA == CblasConjTrans ) TA='C';
58-
else if ( TransA == CblasNoTrans ) TA='N';
59-
else
60-
{
61-
API_SUFFIX(cblas_xerbla)(3, "cblas_cgemmtr", "Illegal TransA setting, %d\n", TransA);
62-
CBLAS_CallFromC = 0;
63-
RowMajorStrg = 0;
64-
return;
65-
}
56+
if(TransA == CblasTrans) TA='T';
57+
else if ( TransA == CblasConjTrans ) TA='C';
58+
else if ( TransA == CblasNoTrans ) TA='N';
59+
else
60+
{
61+
API_SUFFIX(cblas_xerbla)(3, "cblas_cgemmtr", "Illegal TransA setting, %d\n", TransA);
62+
CBLAS_CallFromC = 0;
63+
RowMajorStrg = 0;
64+
return;
65+
}
6666

67-
if(TransB == CblasTrans) TB='T';
68-
else if ( TransB == CblasConjTrans ) TB='C';
69-
else if ( TransB == CblasNoTrans ) TB='N';
70-
else
71-
{
72-
API_SUFFIX(cblas_xerbla)(4, "cblas_cgemmtr", "Illegal TransB setting, %d\n", TransB);
73-
CBLAS_CallFromC = 0;
74-
RowMajorStrg = 0;
75-
return;
76-
}
67+
if(TransB == CblasTrans) TB='T';
68+
else if ( TransB == CblasConjTrans ) TB='C';
69+
else if ( TransB == CblasNoTrans ) TB='N';
70+
else
71+
{
72+
API_SUFFIX(cblas_xerbla)(4, "cblas_cgemmtr", "Illegal TransB setting, %d\n", TransB);
73+
CBLAS_CallFromC = 0;
74+
RowMajorStrg = 0;
75+
return;
76+
}
7777

78-
#ifdef F77_CHAR
79-
F77_TA = C2F_CHAR(&TA);
80-
F77_TB = C2F_CHAR(&TB);
81-
F77_UL = C2F_CHAR(&UL);
82-
#endif
78+
#ifdef F77_CHAR
79+
F77_TA = C2F_CHAR(&TA);
80+
F77_TB = C2F_CHAR(&TB);
81+
F77_UL = C2F_CHAR(&UL);
82+
#endif
8383

84-
F77_cgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, alpha, A,
85-
&F77_lda, B, &F77_ldb, beta, C, &F77_ldc);
86-
} else if (layout == CblasRowMajor)
87-
{
88-
RowMajorStrg = 1;
84+
F77_cgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, alpha, A,
85+
&F77_lda, B, &F77_ldb, beta, C, &F77_ldc);
86+
}
87+
else if (layout == CblasRowMajor)
88+
{
89+
RowMajorStrg = 1;
8990

90-
if ( Uplo == CblasUpper ) UL = 'L';
91-
else if (Uplo == CblasLower) UL= 'U';
92-
else {
91+
if ( Uplo == CblasUpper ) UL = 'L';
92+
else if (Uplo == CblasLower) UL= 'U';
93+
else {
9394
API_SUFFIX(cblas_xerbla)(2, "cblas_cgemmtr", "Illegal Uplo setting, %d\n", Uplo);
9495
CBLAS_CallFromC = 0;
9596
RowMajorStrg = 0;
9697
return;
97-
}
98+
}
9899

99-
if(TransA == CblasTrans) TB='T';
100-
else if ( TransA == CblasConjTrans ) TB='C';
101-
else if ( TransA == CblasNoTrans ) TB='N';
102-
else
103-
{
104-
API_SUFFIX(cblas_xerbla)(3, "cblas_cgemmtr", "Illegal TransA setting, %d\n", TransA);
105-
CBLAS_CallFromC = 0;
106-
RowMajorStrg = 0;
107-
return;
108-
}
109-
if(TransB == CblasTrans) TA='T';
110-
else if ( TransB == CblasConjTrans ) TA='C';
111-
else if ( TransB == CblasNoTrans ) TA='N';
112-
else
113-
{
114-
API_SUFFIX(cblas_xerbla)(4, "cblas_cgemmtr", "Illegal TransB setting, %d\n", TransB);
115-
CBLAS_CallFromC = 0;
116-
RowMajorStrg = 0;
117-
return;
118-
}
119-
#ifdef F77_CHAR
120-
F77_TA = C2F_CHAR(&TA);
121-
F77_TB = C2F_CHAR(&TB);
122-
F77_UL = C2F_CHAR(&UL);
100+
if(TransA == CblasTrans) TB='T';
101+
else if ( TransA == CblasConjTrans ) TB='C';
102+
else if ( TransA == CblasNoTrans ) TB='N';
103+
else
104+
{
105+
API_SUFFIX(cblas_xerbla)(3, "cblas_cgemmtr", "Illegal TransA setting, %d\n", TransA);
106+
CBLAS_CallFromC = 0;
107+
RowMajorStrg = 0;
108+
return;
109+
}
110+
if(TransB == CblasTrans) TA='T';
111+
else if ( TransB == CblasConjTrans ) TA='C';
112+
else if ( TransB == CblasNoTrans ) TA='N';
113+
else
114+
{
115+
API_SUFFIX(cblas_xerbla)(4, "cblas_cgemmtr", "Illegal TransB setting, %d\n", TransB);
116+
CBLAS_CallFromC = 0;
117+
RowMajorStrg = 0;
118+
return;
119+
}
120+
#ifdef F77_CHAR
121+
F77_TA = C2F_CHAR(&TA);
122+
F77_TB = C2F_CHAR(&TB);
123+
F77_UL = C2F_CHAR(&UL);
123124

124-
#endif
125+
#endif
125126

126-
F77_cgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, alpha, B,
127-
&F77_ldb, A, &F77_lda, beta, C, &F77_ldc);
128-
}
129-
else API_SUFFIX(cblas_xerbla)(1, "cblas_cgemmtr", "Illegal layout setting, %d\n", layout);
130-
CBLAS_CallFromC = 0;
131-
RowMajorStrg = 0;
132-
return;
127+
F77_cgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, alpha, B,
128+
&F77_ldb, A, &F77_lda, beta, C, &F77_ldc);
129+
}
130+
else API_SUFFIX(cblas_xerbla)(1, "cblas_cgemmtr", "Illegal layout setting, %d\n", layout);
131+
CBLAS_CallFromC = 0;
132+
RowMajorStrg = 0;
133+
return;
133134
}

0 commit comments

Comments
 (0)