Skip to content

Commit b681b1e

Browse files
grisuthedragongrisuthedragon
committed
Add cblas_dgemmtr test
1 parent adaf724 commit b681b1e

File tree

10 files changed

+841
-186
lines changed

10 files changed

+841
-186
lines changed

‎BLAS/SRC/dgemmtr.f

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -272,8 +272,7 @@ SUBROUTINE DGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB,
272272
*
273273
* Quick return if possible.
274274
*
275-
IF ((N.EQ.0) .OR.
276-
+ (((ALPHA.EQ.ZERO).OR. (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN
275+
IF (N.EQ.0) RETURN
277276
*
278277
* And if alpha.eq.zero.
279278
*

‎BLAS/TESTING/dblat3.f

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -37,12 +37,12 @@
3737
*> 0.0 1.0 0.7 VALUES OF ALPHA
3838
*> 3 NUMBER OF VALUES OF BETA
3939
*> 0.0 1.0 1.3 VALUES OF BETA
40-
*> DGEMM T PUT F FOR NO TEST. SAME COLUMNS.
41-
*> DSYMM T PUT F FOR NO TEST. SAME COLUMNS.
42-
*> DTRMM T PUT F FOR NO TEST. SAME COLUMNS.
43-
*> DTRSM T PUT F FOR NO TEST. SAME COLUMNS.
44-
*> DSYRK T PUT F FOR NO TEST. SAME COLUMNS.
45-
*> DSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
40+
*> DGEMM T PUT F FOR NO TEST. SAME COLUMNS.
41+
*> DSYMM T PUT F FOR NO TEST. SAME COLUMNS.
42+
*> DTRMM T PUT F FOR NO TEST. SAME COLUMNS.
43+
*> DTRSM T PUT F FOR NO TEST. SAME COLUMNS.
44+
*> DSYRK T PUT F FOR NO TEST. SAME COLUMNS.
45+
*> DSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
4646
*> DGEMMTR T PUT F FOR NO TEST. SAME COLUMNS.
4747
*>
4848
*> Further Details

‎CBLAS/src/cblas_dgemmtr.c

Lines changed: 105 additions & 92 deletions
Original file line numberDiff line numberDiff line change
@@ -10,112 +10,125 @@
1010
#include "cblas.h"
1111
#include "cblas_f77.h"
1212
void API_SUFFIX(cblas_dgemmtr)(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 double alpha, const double *A,
15-
const CBLAS_INT lda, const double *B, const CBLAS_INT ldb,
16-
const double beta, double *C, const CBLAS_INT ldc)
13+
const CBLAS_TRANSPOSE TransB, const CBLAS_INT N,
14+
const CBLAS_INT K, const double alpha, const double *A,
15+
const CBLAS_INT lda, const double *B, const CBLAS_INT ldb,
16+
const double beta, double *C, const CBLAS_INT ldc)
1717
{
18-
char TA, TB, UL;
18+
char TA, TB, UL;
1919
#ifdef F77_CHAR
20-
F77_CHAR F77_TA, F77_TB. F77_UL;
20+
F77_CHAR F77_TA, F77_TB. F77_UL;
2121
#else
22-
#define F77_TA &TA
23-
#define F77_TB &TB
24-
#define F77_UL &UL
22+
#define F77_TA &TA
23+
#define F77_TB &TB
24+
#define F77_UL &UL
2525
#endif
2626

2727
#ifdef F77_INT
28-
F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
29-
F77_INT F77_ldc=ldc;
28+
F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
29+
F77_INT F77_ldc=ldc;
3030
#else
31-
#define F77_N N
32-
#define F77_K K
33-
#define F77_lda lda
34-
#define F77_ldb ldb
35-
#define F77_ldc ldc
31+
#define F77_N N
32+
#define F77_K K
33+
#define F77_lda lda
34+
#define F77_ldb ldb
35+
#define F77_ldc ldc
3636
#endif
3737

38-
extern int CBLAS_CallFromC;
39-
extern int RowMajorStrg;
40-
RowMajorStrg = 0;
41-
CBLAS_CallFromC = 1;
38+
extern int CBLAS_CallFromC;
39+
extern int RowMajorStrg;
40+
RowMajorStrg = 0;
41+
CBLAS_CallFromC = 1;
4242

43-
if ( Uplo == CblasUpper ) UL = 'U';
44-
else if (Uplo == CblasLower) UL= 'L';
45-
else {
46-
API_SUFFIX(cblas_xerbla)(2, "cblas_dgemmtr", "Illegal Uplo setting, %d\n", Uplo);
47-
CBLAS_CallFromC = 0;
48-
RowMajorStrg = 0;
49-
return;
50-
}
5143

44+
if( layout == CblasColMajor )
45+
{
46+
if ( Uplo == CblasUpper ) UL = 'U';
47+
else if (Uplo == CblasLower) UL= 'L';
48+
else {
49+
API_SUFFIX(cblas_xerbla)(2, "cblas_dgemmtr", "Illegal Uplo setting, %d\n", Uplo);
50+
CBLAS_CallFromC = 0;
51+
RowMajorStrg = 0;
52+
return;
53+
}
5254

53-
if( layout == CblasColMajor )
54-
{
55-
if(TransA == CblasTrans) TA='T';
56-
else if ( TransA == CblasConjTrans ) TA='C';
57-
else if ( TransA == CblasNoTrans ) TA='N';
58-
else
59-
{
60-
API_SUFFIX(cblas_xerbla)(3, "cblas_dgemmtr","Illegal TransA setting, %d\n", TransA);
61-
CBLAS_CallFromC = 0;
62-
RowMajorStrg = 0;
63-
return;
64-
}
6555

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

77-
#ifdef F77_CHAR
78-
F77_TA = C2F_CHAR(&TA);
79-
F77_TB = C2F_CHAR(&TB);
80-
F77_UL = C2F_CHAR(&UL);
81-
#endif
57+
if(TransA == CblasTrans) TA='T';
58+
else if ( TransA == CblasConjTrans ) TA='C';
59+
else if ( TransA == CblasNoTrans ) TA='N';
60+
else
61+
{
62+
API_SUFFIX(cblas_xerbla)(3, "cblas_dgemmtr","Illegal TransA setting, %d\n", TransA);
63+
CBLAS_CallFromC = 0;
64+
RowMajorStrg = 0;
65+
return;
66+
}
8267

83-
F77_dgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, &alpha, A,
84-
&F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
85-
} else if (layout == CblasRowMajor)
86-
{
87-
RowMajorStrg = 1;
88-
if(TransA == CblasTrans) TB='T';
89-
else if ( TransA == CblasConjTrans ) TB='C';
90-
else if ( TransA == CblasNoTrans ) TB='N';
91-
else
92-
{
93-
API_SUFFIX(cblas_xerbla)(3, "cblas_dgemmtr","Illegal TransA setting, %d\n", TransA);
94-
CBLAS_CallFromC = 0;
95-
RowMajorStrg = 0;
96-
return;
97-
}
98-
if(TransB == CblasTrans) TA='T';
99-
else if ( TransB == CblasConjTrans ) TA='C';
100-
else if ( TransB == CblasNoTrans ) TA='N';
101-
else
102-
{
103-
API_SUFFIX(cblas_xerbla)(4, "cblas_dgemmtr","Illegal TransB setting, %d\n", TransB);
104-
CBLAS_CallFromC = 0;
105-
RowMajorStrg = 0;
106-
return;
107-
}
108-
#ifdef F77_CHAR
109-
F77_TA = C2F_CHAR(&TA);
110-
F77_TB = C2F_CHAR(&TB);
111-
F77_UL = C2F_CHAR(&UL);
112-
#endif
68+
if(TransB == CblasTrans) TB='T';
69+
else if ( TransB == CblasConjTrans ) TB='C';
70+
else if ( TransB == CblasNoTrans ) TB='N';
71+
else
72+
{
73+
API_SUFFIX(cblas_xerbla)(4, "cblas_dgemmtr","Illegal TransB setting, %d\n", TransB);
74+
CBLAS_CallFromC = 0;
75+
RowMajorStrg = 0;
76+
return;
77+
}
11378

114-
F77_dgemmtr( F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, &alpha, B,
115-
&F77_ldb, A, &F77_lda, &beta, C, &F77_ldc);
116-
}
117-
else API_SUFFIX(cblas_xerbla)(1, "cblas_dgemmtr", "Illegal layout setting, %d\n", layout);
118-
CBLAS_CallFromC = 0;
119-
RowMajorStrg = 0;
120-
return;
79+
#ifdef F77_CHAR
80+
F77_TA = C2F_CHAR(&TA);
81+
F77_TB = C2F_CHAR(&TB);
82+
F77_UL = C2F_CHAR(&UL);
83+
#endif
84+
85+
F77_dgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, &alpha, A,
86+
&F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
87+
}
88+
else if (layout == CblasRowMajor)
89+
{
90+
if ( Uplo == CblasUpper ) UL = 'L';
91+
else if (Uplo == CblasLower) UL= 'U';
92+
else {
93+
API_SUFFIX(cblas_xerbla)(2, "cblas_dgemmtr", "Illegal Uplo setting, %d\n", Uplo);
94+
CBLAS_CallFromC = 0;
95+
RowMajorStrg = 0;
96+
return;
97+
}
98+
99+
100+
RowMajorStrg = 1;
101+
if(TransA == CblasTrans) TB='T';
102+
else if ( TransA == CblasConjTrans ) TB='C';
103+
else if ( TransA == CblasNoTrans ) TB='N';
104+
else
105+
{
106+
API_SUFFIX(cblas_xerbla)(3, "cblas_dgemmtr","Illegal TransA setting, %d\n", TransA);
107+
CBLAS_CallFromC = 0;
108+
RowMajorStrg = 0;
109+
return;
110+
}
111+
if(TransB == CblasTrans) TA='T';
112+
else if ( TransB == CblasConjTrans ) TA='C';
113+
else if ( TransB == CblasNoTrans ) TA='N';
114+
else
115+
{
116+
API_SUFFIX(cblas_xerbla)(4, "cblas_dgemmtr","Illegal TransB setting, %d\n", TransB);
117+
CBLAS_CallFromC = 0;
118+
RowMajorStrg = 0;
119+
return;
120+
}
121+
#ifdef F77_CHAR
122+
F77_TA = C2F_CHAR(&TA);
123+
F77_TB = C2F_CHAR(&TB);
124+
F77_UL = C2F_CHAR(&UL);
125+
#endif
126+
127+
F77_dgemmtr( 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_dgemmtr", "Illegal layout setting, %d\n", layout);
131+
CBLAS_CallFromC = 0;
132+
RowMajorStrg = 0;
133+
return;
121134
}

‎CBLAS/testing/c_cblat2.f

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -349,13 +349,13 @@ PROGRAM CBLAT2
349349
CALL CCHK3( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
350350
$ REWI, FATAL, NIDIM, IDIM, NKB, KB, NINC, INC,
351351
$ NMAX, INCMAX, A, AA, AS, Y, YY, YS, YT, G, Z,
352-
$ 0 )
352+
$ 0 )
353353
END IF
354354
IF (RORDER) THEN
355355
CALL CCHK3( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
356356
$ REWI, FATAL, NIDIM, IDIM, NKB, KB, NINC, INC,
357357
$ NMAX, INCMAX, A, AA, AS, Y, YY, YS, YT, G, Z,
358-
$ 1 )
358+
$ 1 )
359359
END IF
360360
GO TO 200
361361
* Test CGERC, 12, CGERU, 13.

‎CBLAS/testing/c_dblas3.c

Lines changed: 79 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -77,6 +77,85 @@ void F77_dgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CB
7777
cblas_dgemm( UNDEFINED, transa, transb, *m, *n, *k, *alpha, a, *lda,
7878
b, *ldb, *beta, c, *ldc );
7979
}
80+
81+
void F77_dgemmtr(CBLAS_INT *layout, char *uplop, char *transpa, char *transpb, CBLAS_INT *n,
82+
CBLAS_INT *k, double *alpha, double *a, CBLAS_INT *lda,
83+
double *b, CBLAS_INT *ldb, double *beta,
84+
double *c, CBLAS_INT *ldc ) {
85+
86+
double *A, *B, *C;
87+
CBLAS_INT i,j,LDA, LDB, LDC;
88+
CBLAS_TRANSPOSE transa, transb;
89+
CBLAS_UPLO uplo;
90+
91+
get_transpose_type(transpa, &transa);
92+
get_transpose_type(transpb, &transb);
93+
get_uplo_type(uplop, &uplo);
94+
95+
if (*layout == TEST_ROW_MJR) {
96+
if (transa == CblasNoTrans) {
97+
LDA = *k+1;
98+
A=(double*)malloc((*n)*LDA*sizeof(double));
99+
for( i=0; i<*n; i++ )
100+
for( j=0; j<*k; j++ ) {
101+
A[i*LDA+j]=a[j*(*lda)+i];
102+
}
103+
}
104+
else {
105+
LDA = *n+1;
106+
A=(double* )malloc(LDA*(*k)*sizeof(double));
107+
for( i=0; i<*k; i++ )
108+
for( j=0; j<*n; j++ ) {
109+
A[i*LDA+j]=a[j*(*lda)+i];
110+
}
111+
}
112+
113+
if (transb == CblasNoTrans) {
114+
LDB = *n+1;
115+
B=(double* )malloc((*k)*LDB*sizeof(double) );
116+
for( i=0; i<*k; i++ )
117+
for( j=0; j<*n; j++ ) {
118+
B[i*LDB+j]=b[j*(*ldb)+i];
119+
}
120+
}
121+
else {
122+
LDB = *k+1;
123+
B=(double* )malloc(LDB*(*n)*sizeof(double));
124+
for( i=0; i<*n; i++ )
125+
for( j=0; j<*k; j++ ) {
126+
B[i*LDB+j]=b[j*(*ldb)+i];
127+
}
128+
}
129+
130+
LDC = *n+1;
131+
C=(double* )malloc((*n)*LDC*sizeof(double));
132+
for( j=0; j<*n; j++ )
133+
for( i=0; i<*n; i++ ) {
134+
C[i*LDC+j]=c[j*(*ldc)+i];
135+
}
136+
cblas_dgemmtr( CblasRowMajor, uplo, transa, transb, *n, *k, *alpha, A, LDA,
137+
B, LDB, *beta, C, LDC );
138+
for( j=0; j<*n; j++ )
139+
for( i=0; i<*n; i++ ) {
140+
c[j*(*ldc)+i]=C[i*LDC+j];
141+
}
142+
free(A);
143+
free(B);
144+
free(C);
145+
}
146+
else if (*layout == TEST_COL_MJR){
147+
cblas_dgemmtr( CblasColMajor, uplo, transa, transb, *n, *k, *alpha, a, *lda,
148+
b, *ldb, *beta, c, *ldc );
149+
}
150+
else
151+
cblas_dgemmtr( UNDEFINED, uplo, transa, transb, *n, *k, *alpha, a, *lda,
152+
b, *ldb, *beta, c, *ldc );
153+
}
154+
155+
156+
157+
158+
80159
void F77_dsymm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_INT *n,
81160
double *alpha, double *a, CBLAS_INT *lda, double *b, CBLAS_INT *ldb,
82161
double *beta, double *c, CBLAS_INT *ldc

0 commit comments

Comments
 (0)