LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
c_sblas3.c
Go to the documentation of this file.
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 "cblas.h"
10#include "cblas_test.h"
11
12void F77_sgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CBLAS_INT *n,
13 CBLAS_INT *k, float *alpha, float *a, CBLAS_INT *lda, float *b, CBLAS_INT *ldb,
14 float *beta, float *c, CBLAS_INT *ldc
16 , FORTRAN_STRLEN transpa_len, FORTRAN_STRLEN transpb_len
17#endif
18) {
19
20 float *A, *B, *C;
21 CBLAS_INT i,j,LDA, LDB, LDC;
22 CBLAS_TRANSPOSE transa, transb;
23
24 get_transpose_type(transpa, &transa);
25 get_transpose_type(transpb, &transb);
26
27 if (*layout == TEST_ROW_MJR) {
28 if (transa == CblasNoTrans) {
29 LDA = *k+1;
30 A = (float *)malloc( (*m)*LDA*sizeof( float ) );
31 for( i=0; i<*m; i++ )
32 for( j=0; j<*k; j++ )
33 A[i*LDA+j]=a[j*(*lda)+i];
34 }
35 else {
36 LDA = *m+1;
37 A = ( float* )malloc( LDA*(*k)*sizeof( float ) );
38 for( i=0; i<*k; i++ )
39 for( j=0; j<*m; j++ )
40 A[i*LDA+j]=a[j*(*lda)+i];
41 }
42 if (transb == CblasNoTrans) {
43 LDB = *n+1;
44 B = ( float* )malloc( (*k)*LDB*sizeof( float ) );
45 for( i=0; i<*k; i++ )
46 for( j=0; j<*n; j++ )
47 B[i*LDB+j]=b[j*(*ldb)+i];
48 }
49 else {
50 LDB = *k+1;
51 B = ( float* )malloc( LDB*(*n)*sizeof( float ) );
52 for( i=0; i<*n; i++ )
53 for( j=0; j<*k; j++ )
54 B[i*LDB+j]=b[j*(*ldb)+i];
55 }
56 LDC = *n+1;
57 C = ( float* )malloc( (*m)*LDC*sizeof( float ) );
58 for( j=0; j<*n; j++ )
59 for( i=0; i<*m; i++ )
60 C[i*LDC+j]=c[j*(*ldc)+i];
61 cblas_sgemm( CblasRowMajor, transa, transb, *m, *n, *k, *alpha, A, LDA,
62 B, LDB, *beta, C, LDC );
63 for( j=0; j<*n; j++ )
64 for( i=0; i<*m; i++ )
65 c[j*(*ldc)+i]=C[i*LDC+j];
66 free(A);
67 free(B);
68 free(C);
69 }
70 else if (*layout == TEST_COL_MJR)
71 cblas_sgemm( CblasColMajor, transa, transb, *m, *n, *k, *alpha, a, *lda,
72 b, *ldb, *beta, c, *ldc );
73 else
74 cblas_sgemm( UNDEFINED, transa, transb, *m, *n, *k, *alpha, a, *lda,
75 b, *ldb, *beta, c, *ldc );
76}
77
78void F77_sgemmtr(CBLAS_INT *layout, char *uplop, char *transpa, char *transpb, CBLAS_INT *n,
79 CBLAS_INT *k, float *alpha, float *a, CBLAS_INT *lda,
80 float *b, CBLAS_INT *ldb, float *beta,
81 float *c, CBLAS_INT *ldc ) {
82
83 float *A, *B, *C;
84 CBLAS_INT i,j,LDA, LDB, LDC;
85 CBLAS_TRANSPOSE transa, transb;
86 CBLAS_UPLO uplo;
87
88 get_transpose_type(transpa, &transa);
89 get_transpose_type(transpb, &transb);
90 get_uplo_type(uplop, &uplo);
91
92 if (*layout == TEST_ROW_MJR) {
93 if (transa == CblasNoTrans) {
94 LDA = *k+1;
95 A=(float*)malloc((*n)*LDA*sizeof(float));
96 for( i=0; i<*n; i++ )
97 for( j=0; j<*k; j++ ) {
98 A[i*LDA+j]=a[j*(*lda)+i];
99 }
100 }
101 else {
102 LDA = *n+1;
103 A=(float* )malloc(LDA*(*k)*sizeof(float));
104 for( i=0; i<*k; i++ )
105 for( j=0; j<*n; j++ ) {
106 A[i*LDA+j]=a[j*(*lda)+i];
107 }
108 }
109
110 if (transb == CblasNoTrans) {
111 LDB = *n+1;
112 B=(float* )malloc((*k)*LDB*sizeof(float) );
113 for( i=0; i<*k; i++ )
114 for( j=0; j<*n; j++ ) {
115 B[i*LDB+j]=b[j*(*ldb)+i];
116 }
117 }
118 else {
119 LDB = *k+1;
120 B=(float* )malloc(LDB*(*n)*sizeof(float));
121 for( i=0; i<*n; i++ )
122 for( j=0; j<*k; j++ ) {
123 B[i*LDB+j]=b[j*(*ldb)+i];
124 }
125 }
126
127 LDC = *n+1;
128 C=(float* )malloc((*n)*LDC*sizeof(float));
129 for( j=0; j<*n; j++ )
130 for( i=0; i<*n; i++ ) {
131 C[i*LDC+j]=c[j*(*ldc)+i];
132 }
133 cblas_sgemmtr( CblasRowMajor, uplo, transa, transb, *n, *k, *alpha, A, LDA,
134 B, LDB, *beta, C, LDC );
135 for( j=0; j<*n; j++ )
136 for( i=0; i<*n; i++ ) {
137 c[j*(*ldc)+i]=C[i*LDC+j];
138 }
139 free(A);
140 free(B);
141 free(C);
142 }
143 else if (*layout == TEST_COL_MJR)
144 cblas_sgemmtr( CblasColMajor, uplo, transa, transb, *n, *k, *alpha, a, *lda,
145 b, *ldb, *beta, c, *ldc );
146 else
147 cblas_sgemmtr( UNDEFINED, uplo, transa, transb, *n, *k, *alpha, a, *lda,
148 b, *ldb, *beta, c, *ldc );
149}
150
151
152
153void F77_ssymm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_INT *n,
154 float *alpha, float *a, CBLAS_INT *lda, float *b, CBLAS_INT *ldb,
155 float *beta, float *c, CBLAS_INT *ldc
157 , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len
158#endif
159) {
160
161 float *A, *B, *C;
162 CBLAS_INT i,j,LDA, LDB, LDC;
163 CBLAS_UPLO uplo;
164 CBLAS_SIDE side;
165
166 get_uplo_type(uplow,&uplo);
167 get_side_type(rtlf,&side);
168
169 if (*layout == TEST_ROW_MJR) {
170 if (side == CblasLeft) {
171 LDA = *m+1;
172 A = ( float* )malloc( (*m)*LDA*sizeof( float ) );
173 for( i=0; i<*m; i++ )
174 for( j=0; j<*m; j++ )
175 A[i*LDA+j]=a[j*(*lda)+i];
176 }
177 else{
178 LDA = *n+1;
179 A = ( float* )malloc( (*n)*LDA*sizeof( float ) );
180 for( i=0; i<*n; i++ )
181 for( j=0; j<*n; j++ )
182 A[i*LDA+j]=a[j*(*lda)+i];
183 }
184 LDB = *n+1;
185 B = ( float* )malloc( (*m)*LDB*sizeof( float ) );
186 for( i=0; i<*m; i++ )
187 for( j=0; j<*n; j++ )
188 B[i*LDB+j]=b[j*(*ldb)+i];
189 LDC = *n+1;
190 C = ( float* )malloc( (*m)*LDC*sizeof( float ) );
191 for( j=0; j<*n; j++ )
192 for( i=0; i<*m; i++ )
193 C[i*LDC+j]=c[j*(*ldc)+i];
194 cblas_ssymm( CblasRowMajor, side, uplo, *m, *n, *alpha, A, LDA, B, LDB,
195 *beta, C, LDC );
196 for( j=0; j<*n; j++ )
197 for( i=0; i<*m; i++ )
198 c[j*(*ldc)+i]=C[i*LDC+j];
199 free(A);
200 free(B);
201 free(C);
202 }
203 else if (*layout == TEST_COL_MJR)
204 cblas_ssymm( CblasColMajor, side, uplo, *m, *n, *alpha, a, *lda, b, *ldb,
205 *beta, c, *ldc );
206 else
207 cblas_ssymm( UNDEFINED, side, uplo, *m, *n, *alpha, a, *lda, b, *ldb,
208 *beta, c, *ldc );
209}
210
211void F77_ssyrk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k,
212 float *alpha, float *a, CBLAS_INT *lda,
213 float *beta, float *c, CBLAS_INT *ldc
215 , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len
216#endif
217) {
218
219 CBLAS_INT i,j,LDA,LDC;
220 float *A, *C;
221 CBLAS_UPLO uplo;
222 CBLAS_TRANSPOSE trans;
223
224 get_uplo_type(uplow,&uplo);
225 get_transpose_type(transp,&trans);
226
227 if (*layout == TEST_ROW_MJR) {
228 if (trans == CblasNoTrans) {
229 LDA = *k+1;
230 A = ( float* )malloc( (*n)*LDA*sizeof( float ) );
231 for( i=0; i<*n; i++ )
232 for( j=0; j<*k; j++ )
233 A[i*LDA+j]=a[j*(*lda)+i];
234 }
235 else{
236 LDA = *n+1;
237 A = ( float* )malloc( (*k)*LDA*sizeof( float ) );
238 for( i=0; i<*k; i++ )
239 for( j=0; j<*n; j++ )
240 A[i*LDA+j]=a[j*(*lda)+i];
241 }
242 LDC = *n+1;
243 C = ( float* )malloc( (*n)*LDC*sizeof( float ) );
244 for( i=0; i<*n; i++ )
245 for( j=0; j<*n; j++ )
246 C[i*LDC+j]=c[j*(*ldc)+i];
247 cblas_ssyrk(CblasRowMajor, uplo, trans, *n, *k, *alpha, A, LDA, *beta,
248 C, LDC );
249 for( j=0; j<*n; j++ )
250 for( i=0; i<*n; i++ )
251 c[j*(*ldc)+i]=C[i*LDC+j];
252 free(A);
253 free(C);
254 }
255 else if (*layout == TEST_COL_MJR)
256 cblas_ssyrk(CblasColMajor, uplo, trans, *n, *k, *alpha, a, *lda, *beta,
257 c, *ldc );
258 else
259 cblas_ssyrk(UNDEFINED, uplo, trans, *n, *k, *alpha, a, *lda, *beta,
260 c, *ldc );
261}
262
263void F77_ssyr2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k,
264 float *alpha, float *a, CBLAS_INT *lda, float *b, CBLAS_INT *ldb,
265 float *beta, float *c, CBLAS_INT *ldc
267 , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len
268#endif
269) {
270 CBLAS_INT i,j,LDA,LDB,LDC;
271 float *A, *B, *C;
272 CBLAS_UPLO uplo;
273 CBLAS_TRANSPOSE trans;
274
275 get_uplo_type(uplow,&uplo);
276 get_transpose_type(transp,&trans);
277
278 if (*layout == TEST_ROW_MJR) {
279 if (trans == CblasNoTrans) {
280 LDA = *k+1;
281 LDB = *k+1;
282 A = ( float* )malloc( (*n)*LDA*sizeof( float ) );
283 B = ( float* )malloc( (*n)*LDB*sizeof( float ) );
284 for( i=0; i<*n; i++ )
285 for( j=0; j<*k; j++ ) {
286 A[i*LDA+j]=a[j*(*lda)+i];
287 B[i*LDB+j]=b[j*(*ldb)+i];
288 }
289 }
290 else {
291 LDA = *n+1;
292 LDB = *n+1;
293 A = ( float* )malloc( LDA*(*k)*sizeof( float ) );
294 B = ( float* )malloc( LDB*(*k)*sizeof( float ) );
295 for( i=0; i<*k; i++ )
296 for( j=0; j<*n; j++ ){
297 A[i*LDA+j]=a[j*(*lda)+i];
298 B[i*LDB+j]=b[j*(*ldb)+i];
299 }
300 }
301 LDC = *n+1;
302 C = ( float* )malloc( (*n)*LDC*sizeof( float ) );
303 for( i=0; i<*n; i++ )
304 for( j=0; j<*n; j++ )
305 C[i*LDC+j]=c[j*(*ldc)+i];
306 cblas_ssyr2k(CblasRowMajor, uplo, trans, *n, *k, *alpha, A, LDA,
307 B, LDB, *beta, C, LDC );
308 for( j=0; j<*n; j++ )
309 for( i=0; i<*n; i++ )
310 c[j*(*ldc)+i]=C[i*LDC+j];
311 free(A);
312 free(B);
313 free(C);
314 }
315 else if (*layout == TEST_COL_MJR)
316 cblas_ssyr2k(CblasColMajor, uplo, trans, *n, *k, *alpha, a, *lda,
317 b, *ldb, *beta, c, *ldc );
318 else
319 cblas_ssyr2k(UNDEFINED, uplo, trans, *n, *k, *alpha, a, *lda,
320 b, *ldb, *beta, c, *ldc );
321}
322void F77_strmm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *diagn,
323 CBLAS_INT *m, CBLAS_INT *n, float *alpha, float *a, CBLAS_INT *lda, float *b,
324 CBLAS_INT *ldb
326 , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
327#endif
328) {
329 CBLAS_INT i,j,LDA,LDB;
330 float *A, *B;
331 CBLAS_SIDE side;
332 CBLAS_DIAG diag;
333 CBLAS_UPLO uplo;
334 CBLAS_TRANSPOSE trans;
335
336 get_uplo_type(uplow,&uplo);
337 get_transpose_type(transp,&trans);
338 get_diag_type(diagn,&diag);
339 get_side_type(rtlf,&side);
340
341 if (*layout == TEST_ROW_MJR) {
342 if (side == CblasLeft) {
343 LDA = *m+1;
344 A = ( float* )malloc( (*m)*LDA*sizeof( float ) );
345 for( i=0; i<*m; i++ )
346 for( j=0; j<*m; j++ )
347 A[i*LDA+j]=a[j*(*lda)+i];
348 }
349 else{
350 LDA = *n+1;
351 A = ( float* )malloc( (*n)*LDA*sizeof( float ) );
352 for( i=0; i<*n; i++ )
353 for( j=0; j<*n; j++ )
354 A[i*LDA+j]=a[j*(*lda)+i];
355 }
356 LDB = *n+1;
357 B = ( float* )malloc( (*m)*LDB*sizeof( float ) );
358 for( i=0; i<*m; i++ )
359 for( j=0; j<*n; j++ )
360 B[i*LDB+j]=b[j*(*ldb)+i];
361 cblas_strmm(CblasRowMajor, side, uplo, trans, diag, *m, *n, *alpha,
362 A, LDA, B, LDB );
363 for( j=0; j<*n; j++ )
364 for( i=0; i<*m; i++ )
365 b[j*(*ldb)+i]=B[i*LDB+j];
366 free(A);
367 free(B);
368 }
369 else if (*layout == TEST_COL_MJR)
370 cblas_strmm(CblasColMajor, side, uplo, trans, diag, *m, *n, *alpha,
371 a, *lda, b, *ldb);
372 else
373 cblas_strmm(UNDEFINED, side, uplo, trans, diag, *m, *n, *alpha,
374 a, *lda, b, *ldb);
375}
376
377void F77_strsm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *diagn,
378 CBLAS_INT *m, CBLAS_INT *n, float *alpha, float *a, CBLAS_INT *lda, float *b,
379 CBLAS_INT *ldb
381 , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
382#endif
383) {
384 CBLAS_INT i,j,LDA,LDB;
385 float *A, *B;
386 CBLAS_SIDE side;
387 CBLAS_DIAG diag;
388 CBLAS_UPLO uplo;
389 CBLAS_TRANSPOSE trans;
390
391 get_uplo_type(uplow,&uplo);
392 get_transpose_type(transp,&trans);
393 get_diag_type(diagn,&diag);
394 get_side_type(rtlf,&side);
395
396 if (*layout == TEST_ROW_MJR) {
397 if (side == CblasLeft) {
398 LDA = *m+1;
399 A = ( float* )malloc( (*m)*LDA*sizeof( float ) );
400 for( i=0; i<*m; i++ )
401 for( j=0; j<*m; j++ )
402 A[i*LDA+j]=a[j*(*lda)+i];
403 }
404 else{
405 LDA = *n+1;
406 A = ( float* )malloc( (*n)*LDA*sizeof( float ) );
407 for( i=0; i<*n; i++ )
408 for( j=0; j<*n; j++ )
409 A[i*LDA+j]=a[j*(*lda)+i];
410 }
411 LDB = *n+1;
412 B = ( float* )malloc( (*m)*LDB*sizeof( float ) );
413 for( i=0; i<*m; i++ )
414 for( j=0; j<*n; j++ )
415 B[i*LDB+j]=b[j*(*ldb)+i];
416 cblas_strsm(CblasRowMajor, side, uplo, trans, diag, *m, *n, *alpha,
417 A, LDA, B, LDB );
418 for( j=0; j<*n; j++ )
419 for( i=0; i<*m; i++ )
420 b[j*(*ldb)+i]=B[i*LDB+j];
421 free(A);
422 free(B);
423 }
424 else if (*layout == TEST_COL_MJR)
425 cblas_strsm(CblasColMajor, side, uplo, trans, diag, *m, *n, *alpha,
426 a, *lda, b, *ldb);
427 else
428 cblas_strsm(UNDEFINED, side, uplo, trans, diag, *m, *n, *alpha,
429 a, *lda, b, *ldb);
430}
void cblas_ssyrk(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE Trans, const CBLAS_INT N, const CBLAS_INT K, const float alpha, const float *A, const CBLAS_INT lda, const float beta, float *C, const CBLAS_INT ldc)
Definition cblas_ssyrk.c:12
void cblas_sgemm(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA, CBLAS_TRANSPOSE TransB, const CBLAS_INT M, 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)
Definition cblas_sgemm.c:12
void cblas_strsm(CBLAS_LAYOUT layout, CBLAS_SIDE Side, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, const CBLAS_INT M, const CBLAS_INT N, const float alpha, const float *A, const CBLAS_INT lda, float *B, const CBLAS_INT ldb)
Definition cblas_strsm.c:12
CBLAS_UPLO
Definition cblas.h:41
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)
CBLAS_TRANSPOSE
Definition cblas.h:40
@ CblasNoTrans
Definition cblas.h:40
CBLAS_SIDE
Definition cblas.h:43
@ CblasLeft
Definition cblas.h:43
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, const float *B, const CBLAS_INT ldb, const float beta, float *C, const CBLAS_INT ldc)
Definition cblas_ssymm.c:12
@ CblasColMajor
Definition cblas.h:39
@ CblasRowMajor
Definition cblas.h:39
void cblas_strmm(CBLAS_LAYOUT layout, CBLAS_SIDE Side, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, const CBLAS_INT M, const CBLAS_INT N, const float alpha, const float *A, const CBLAS_INT lda, float *B, const CBLAS_INT ldb)
Definition cblas_strmm.c:12
CBLAS_DIAG
Definition cblas.h:42
void cblas_ssyr2k(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE Trans, 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)
#define CBLAS_INT
Definition cblas.h:24
#define F77_sgemmtr(...)
Definition cblas_f77.h:396
#define BLAS_FORTRAN_STRLEN_END
Definition cblas_f77.h:18
#define FORTRAN_STRLEN
Definition cblas_f77.h:21
#define F77_sgemm(...)
Definition cblas_f77.h:395
#define F77_ssyr2k(...)
Definition cblas_f77.h:399
#define F77_strmm(...)
Definition cblas_f77.h:400
#define F77_strsm(...)
Definition cblas_f77.h:401
#define F77_ssymm(...)
Definition cblas_f77.h:397
#define F77_ssyrk(...)
Definition cblas_f77.h:398
#define UNDEFINED
Definition cblas_test.h:28
void get_diag_type(char *type, CBLAS_DIAG *diag)
Definition auxiliary.c:25
void get_side_type(char *type, CBLAS_SIDE *side)
Definition auxiliary.c:32
#define TEST_ROW_MJR
Definition cblas_test.h:21
#define TEST_COL_MJR
Definition cblas_test.h:25
void get_uplo_type(char *type, CBLAS_UPLO *uplo)
Definition auxiliary.c:18
void get_transpose_type(char *type, CBLAS_TRANSPOSE *trans)
Definition auxiliary.c:8