1 /*
2 * Written by D.P. Manley, Digital Equipment Corporation.
3 * Prefixed "C_" to BLAS routines and their declarations.
4 *
5 * Modified by T. H. Do, 2/19/98, SGI/CRAY Research.
6 */
7 #include <stdio.h>
8 #include <stdlib.h>
9 #include "common.h"
10 #include "cblas_test.h"
11
F77_sgemm(int * order,char * transpa,char * transpb,int * m,int * n,int * k,float * alpha,float * a,int * lda,float * b,int * ldb,float * beta,float * c,int * ldc)12 void F77_sgemm(int *order, char *transpa, char *transpb, int *m, int *n,
13 int *k, float *alpha, float *a, int *lda, float *b, int *ldb,
14 float *beta, float *c, int *ldc ) {
15
16 float *A, *B, *C;
17 int i,j,LDA, LDB, LDC;
18 enum CBLAS_TRANSPOSE transa, transb;
19
20 get_transpose_type(transpa, &transa);
21 get_transpose_type(transpb, &transb);
22
23 if (*order == TEST_ROW_MJR) {
24 if (transa == CblasNoTrans) {
25 LDA = *k+1;
26 A = (float *)malloc( (*m)*LDA*sizeof( float ) );
27 for( i=0; i<*m; i++ )
28 for( j=0; j<*k; j++ )
29 A[i*LDA+j]=a[j*(*lda)+i];
30 }
31 else {
32 LDA = *m+1;
33 A = ( float* )malloc( LDA*(*k)*sizeof( float ) );
34 for( i=0; i<*k; i++ )
35 for( j=0; j<*m; j++ )
36 A[i*LDA+j]=a[j*(*lda)+i];
37 }
38 if (transb == CblasNoTrans) {
39 LDB = *n+1;
40 B = ( float* )malloc( (*k)*LDB*sizeof( float ) );
41 for( i=0; i<*k; i++ )
42 for( j=0; j<*n; j++ )
43 B[i*LDB+j]=b[j*(*ldb)+i];
44 }
45 else {
46 LDB = *k+1;
47 B = ( float* )malloc( LDB*(*n)*sizeof( float ) );
48 for( i=0; i<*n; i++ )
49 for( j=0; j<*k; j++ )
50 B[i*LDB+j]=b[j*(*ldb)+i];
51 }
52 LDC = *n+1;
53 C = ( float* )malloc( (*m)*LDC*sizeof( float ) );
54 for( j=0; j<*n; j++ )
55 for( i=0; i<*m; i++ )
56 C[i*LDC+j]=c[j*(*ldc)+i];
57 cblas_sgemm( CblasRowMajor, transa, transb, *m, *n, *k, *alpha, A, LDA,
58 B, LDB, *beta, C, LDC );
59 for( j=0; j<*n; j++ )
60 for( i=0; i<*m; i++ )
61 c[j*(*ldc)+i]=C[i*LDC+j];
62 free(A);
63 free(B);
64 free(C);
65 }
66 else if (*order == TEST_COL_MJR)
67 cblas_sgemm( CblasColMajor, transa, transb, *m, *n, *k, *alpha, a, *lda,
68 b, *ldb, *beta, c, *ldc );
69 else
70 cblas_sgemm( UNDEFINED, transa, transb, *m, *n, *k, *alpha, a, *lda,
71 b, *ldb, *beta, c, *ldc );
72 }
F77_ssymm(int * order,char * rtlf,char * uplow,int * m,int * n,float * alpha,float * a,int * lda,float * b,int * ldb,float * beta,float * c,int * ldc)73 void F77_ssymm(int *order, char *rtlf, char *uplow, int *m, int *n,
74 float *alpha, float *a, int *lda, float *b, int *ldb,
75 float *beta, float *c, int *ldc ) {
76
77 float *A, *B, *C;
78 int i,j,LDA, LDB, LDC;
79 enum CBLAS_UPLO uplo;
80 enum CBLAS_SIDE side;
81
82 get_uplo_type(uplow,&uplo);
83 get_side_type(rtlf,&side);
84
85 if (*order == TEST_ROW_MJR) {
86 if (side == CblasLeft) {
87 LDA = *m+1;
88 A = ( float* )malloc( (*m)*LDA*sizeof( float ) );
89 for( i=0; i<*m; i++ )
90 for( j=0; j<*m; j++ )
91 A[i*LDA+j]=a[j*(*lda)+i];
92 }
93 else{
94 LDA = *n+1;
95 A = ( float* )malloc( (*n)*LDA*sizeof( float ) );
96 for( i=0; i<*n; i++ )
97 for( j=0; j<*n; j++ )
98 A[i*LDA+j]=a[j*(*lda)+i];
99 }
100 LDB = *n+1;
101 B = ( float* )malloc( (*m)*LDB*sizeof( float ) );
102 for( i=0; i<*m; i++ )
103 for( j=0; j<*n; j++ )
104 B[i*LDB+j]=b[j*(*ldb)+i];
105 LDC = *n+1;
106 C = ( float* )malloc( (*m)*LDC*sizeof( float ) );
107 for( j=0; j<*n; j++ )
108 for( i=0; i<*m; i++ )
109 C[i*LDC+j]=c[j*(*ldc)+i];
110 cblas_ssymm( CblasRowMajor, side, uplo, *m, *n, *alpha, A, LDA, B, LDB,
111 *beta, C, LDC );
112 for( j=0; j<*n; j++ )
113 for( i=0; i<*m; i++ )
114 c[j*(*ldc)+i]=C[i*LDC+j];
115 free(A);
116 free(B);
117 free(C);
118 }
119 else if (*order == TEST_COL_MJR)
120 cblas_ssymm( CblasColMajor, side, uplo, *m, *n, *alpha, a, *lda, b, *ldb,
121 *beta, c, *ldc );
122 else
123 cblas_ssymm( UNDEFINED, side, uplo, *m, *n, *alpha, a, *lda, b, *ldb,
124 *beta, c, *ldc );
125 }
126
F77_ssyrk(int * order,char * uplow,char * transp,int * n,int * k,float * alpha,float * a,int * lda,float * beta,float * c,int * ldc)127 void F77_ssyrk(int *order, char *uplow, char *transp, int *n, int *k,
128 float *alpha, float *a, int *lda,
129 float *beta, float *c, int *ldc ) {
130
131 int i,j,LDA,LDC;
132 float *A, *C;
133 enum CBLAS_UPLO uplo;
134 enum CBLAS_TRANSPOSE trans;
135
136 get_uplo_type(uplow,&uplo);
137 get_transpose_type(transp,&trans);
138
139 if (*order == TEST_ROW_MJR) {
140 if (trans == CblasNoTrans) {
141 LDA = *k+1;
142 A = ( float* )malloc( (*n)*LDA*sizeof( float ) );
143 for( i=0; i<*n; i++ )
144 for( j=0; j<*k; j++ )
145 A[i*LDA+j]=a[j*(*lda)+i];
146 }
147 else{
148 LDA = *n+1;
149 A = ( float* )malloc( (*k)*LDA*sizeof( float ) );
150 for( i=0; i<*k; i++ )
151 for( j=0; j<*n; j++ )
152 A[i*LDA+j]=a[j*(*lda)+i];
153 }
154 LDC = *n+1;
155 C = ( float* )malloc( (*n)*LDC*sizeof( float ) );
156 for( i=0; i<*n; i++ )
157 for( j=0; j<*n; j++ )
158 C[i*LDC+j]=c[j*(*ldc)+i];
159 cblas_ssyrk(CblasRowMajor, uplo, trans, *n, *k, *alpha, A, LDA, *beta,
160 C, LDC );
161 for( j=0; j<*n; j++ )
162 for( i=0; i<*n; i++ )
163 c[j*(*ldc)+i]=C[i*LDC+j];
164 free(A);
165 free(C);
166 }
167 else if (*order == TEST_COL_MJR)
168 cblas_ssyrk(CblasColMajor, uplo, trans, *n, *k, *alpha, a, *lda, *beta,
169 c, *ldc );
170 else
171 cblas_ssyrk(UNDEFINED, uplo, trans, *n, *k, *alpha, a, *lda, *beta,
172 c, *ldc );
173 }
174
F77_ssyr2k(int * order,char * uplow,char * transp,int * n,int * k,float * alpha,float * a,int * lda,float * b,int * ldb,float * beta,float * c,int * ldc)175 void F77_ssyr2k(int *order, char *uplow, char *transp, int *n, int *k,
176 float *alpha, float *a, int *lda, float *b, int *ldb,
177 float *beta, float *c, int *ldc ) {
178 int i,j,LDA,LDB,LDC;
179 float *A, *B, *C;
180 enum CBLAS_UPLO uplo;
181 enum CBLAS_TRANSPOSE trans;
182
183 get_uplo_type(uplow,&uplo);
184 get_transpose_type(transp,&trans);
185
186 if (*order == TEST_ROW_MJR) {
187 if (trans == CblasNoTrans) {
188 LDA = *k+1;
189 LDB = *k+1;
190 A = ( float* )malloc( (*n)*LDA*sizeof( float ) );
191 B = ( float* )malloc( (*n)*LDB*sizeof( float ) );
192 for( i=0; i<*n; i++ )
193 for( j=0; j<*k; j++ ) {
194 A[i*LDA+j]=a[j*(*lda)+i];
195 B[i*LDB+j]=b[j*(*ldb)+i];
196 }
197 }
198 else {
199 LDA = *n+1;
200 LDB = *n+1;
201 A = ( float* )malloc( LDA*(*k)*sizeof( float ) );
202 B = ( float* )malloc( LDB*(*k)*sizeof( float ) );
203 for( i=0; i<*k; i++ )
204 for( j=0; j<*n; j++ ){
205 A[i*LDA+j]=a[j*(*lda)+i];
206 B[i*LDB+j]=b[j*(*ldb)+i];
207 }
208 }
209 LDC = *n+1;
210 C = ( float* )malloc( (*n)*LDC*sizeof( float ) );
211 for( i=0; i<*n; i++ )
212 for( j=0; j<*n; j++ )
213 C[i*LDC+j]=c[j*(*ldc)+i];
214 cblas_ssyr2k(CblasRowMajor, uplo, trans, *n, *k, *alpha, A, LDA,
215 B, LDB, *beta, C, LDC );
216 for( j=0; j<*n; j++ )
217 for( i=0; i<*n; i++ )
218 c[j*(*ldc)+i]=C[i*LDC+j];
219 free(A);
220 free(B);
221 free(C);
222 }
223 else if (*order == TEST_COL_MJR)
224 cblas_ssyr2k(CblasColMajor, uplo, trans, *n, *k, *alpha, a, *lda,
225 b, *ldb, *beta, c, *ldc );
226 else
227 cblas_ssyr2k(UNDEFINED, uplo, trans, *n, *k, *alpha, a, *lda,
228 b, *ldb, *beta, c, *ldc );
229 }
F77_strmm(int * order,char * rtlf,char * uplow,char * transp,char * diagn,int * m,int * n,float * alpha,float * a,int * lda,float * b,int * ldb)230 void F77_strmm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
231 int *m, int *n, float *alpha, float *a, int *lda, float *b,
232 int *ldb) {
233 int i,j,LDA,LDB;
234 float *A, *B;
235 enum CBLAS_SIDE side;
236 enum CBLAS_DIAG diag;
237 enum CBLAS_UPLO uplo;
238 enum CBLAS_TRANSPOSE trans;
239
240 get_uplo_type(uplow,&uplo);
241 get_transpose_type(transp,&trans);
242 get_diag_type(diagn,&diag);
243 get_side_type(rtlf,&side);
244
245 if (*order == TEST_ROW_MJR) {
246 if (side == CblasLeft) {
247 LDA = *m+1;
248 A = ( float* )malloc( (*m)*LDA*sizeof( float ) );
249 for( i=0; i<*m; i++ )
250 for( j=0; j<*m; j++ )
251 A[i*LDA+j]=a[j*(*lda)+i];
252 }
253 else{
254 LDA = *n+1;
255 A = ( float* )malloc( (*n)*LDA*sizeof( float ) );
256 for( i=0; i<*n; i++ )
257 for( j=0; j<*n; j++ )
258 A[i*LDA+j]=a[j*(*lda)+i];
259 }
260 LDB = *n+1;
261 B = ( float* )malloc( (*m)*LDB*sizeof( float ) );
262 for( i=0; i<*m; i++ )
263 for( j=0; j<*n; j++ )
264 B[i*LDB+j]=b[j*(*ldb)+i];
265 cblas_strmm(CblasRowMajor, side, uplo, trans, diag, *m, *n, *alpha,
266 A, LDA, B, LDB );
267 for( j=0; j<*n; j++ )
268 for( i=0; i<*m; i++ )
269 b[j*(*ldb)+i]=B[i*LDB+j];
270 free(A);
271 free(B);
272 }
273 else if (*order == TEST_COL_MJR)
274 cblas_strmm(CblasColMajor, side, uplo, trans, diag, *m, *n, *alpha,
275 a, *lda, b, *ldb);
276 else
277 cblas_strmm(UNDEFINED, side, uplo, trans, diag, *m, *n, *alpha,
278 a, *lda, b, *ldb);
279 }
280
F77_strsm(int * order,char * rtlf,char * uplow,char * transp,char * diagn,int * m,int * n,float * alpha,float * a,int * lda,float * b,int * ldb)281 void F77_strsm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
282 int *m, int *n, float *alpha, float *a, int *lda, float *b,
283 int *ldb) {
284 int i,j,LDA,LDB;
285 float *A, *B;
286 enum CBLAS_SIDE side;
287 enum CBLAS_DIAG diag;
288 enum CBLAS_UPLO uplo;
289 enum CBLAS_TRANSPOSE trans;
290
291 get_uplo_type(uplow,&uplo);
292 get_transpose_type(transp,&trans);
293 get_diag_type(diagn,&diag);
294 get_side_type(rtlf,&side);
295
296 if (*order == TEST_ROW_MJR) {
297 if (side == CblasLeft) {
298 LDA = *m+1;
299 A = ( float* )malloc( (*m)*LDA*sizeof( float ) );
300 for( i=0; i<*m; i++ )
301 for( j=0; j<*m; j++ )
302 A[i*LDA+j]=a[j*(*lda)+i];
303 }
304 else{
305 LDA = *n+1;
306 A = ( float* )malloc( (*n)*LDA*sizeof( float ) );
307 for( i=0; i<*n; i++ )
308 for( j=0; j<*n; j++ )
309 A[i*LDA+j]=a[j*(*lda)+i];
310 }
311 LDB = *n+1;
312 B = ( float* )malloc( (*m)*LDB*sizeof( float ) );
313 for( i=0; i<*m; i++ )
314 for( j=0; j<*n; j++ )
315 B[i*LDB+j]=b[j*(*ldb)+i];
316 cblas_strsm(CblasRowMajor, side, uplo, trans, diag, *m, *n, *alpha,
317 A, LDA, B, LDB );
318 for( j=0; j<*n; j++ )
319 for( i=0; i<*m; i++ )
320 b[j*(*ldb)+i]=B[i*LDB+j];
321 free(A);
322 free(B);
323 }
324 else if (*order == TEST_COL_MJR)
325 cblas_strsm(CblasColMajor, side, uplo, trans, diag, *m, *n, *alpha,
326 a, *lda, b, *ldb);
327 else
328 cblas_strsm(UNDEFINED, side, uplo, trans, diag, *m, *n, *alpha,
329 a, *lda, b, *ldb);
330 }
331