LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
c_cblas3.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, 4/15/98, SGI/CRAY Research.
6 */
7#include <stdlib.h>
8#include "cblas.h"
9#include "cblas_test.h"
10#define TEST_COL_MJR 0
11#define TEST_ROW_MJR 1
12#define UNDEFINED -1
13
14void F77_cgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CBLAS_INT *n,
17 CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc ) {
18
19 CBLAS_TEST_COMPLEX *A, *B, *C;
20 CBLAS_INT i,j,LDA, LDB, LDC;
21 CBLAS_TRANSPOSE transa, transb;
22
23 get_transpose_type(transpa, &transa);
24 get_transpose_type(transpb, &transb);
25
26 if (*layout == TEST_ROW_MJR) {
27 if (transa == CblasNoTrans) {
28 LDA = *k+1;
29 A=(CBLAS_TEST_COMPLEX*)malloc((*m)*LDA*sizeof(CBLAS_TEST_COMPLEX));
30 for( i=0; i<*m; i++ )
31 for( j=0; j<*k; j++ ) {
32 A[i*LDA+j].real=a[j*(*lda)+i].real;
33 A[i*LDA+j].imag=a[j*(*lda)+i].imag;
34 }
35 }
36 else {
37 LDA = *m+1;
38 A=(CBLAS_TEST_COMPLEX* )malloc(LDA*(*k)*sizeof(CBLAS_TEST_COMPLEX));
39 for( i=0; i<*k; i++ )
40 for( j=0; j<*m; j++ ) {
41 A[i*LDA+j].real=a[j*(*lda)+i].real;
42 A[i*LDA+j].imag=a[j*(*lda)+i].imag;
43 }
44 }
45
46 if (transb == CblasNoTrans) {
47 LDB = *n+1;
48 B=(CBLAS_TEST_COMPLEX* )malloc((*k)*LDB*sizeof(CBLAS_TEST_COMPLEX) );
49 for( i=0; i<*k; i++ )
50 for( j=0; j<*n; j++ ) {
51 B[i*LDB+j].real=b[j*(*ldb)+i].real;
52 B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
53 }
54 }
55 else {
56 LDB = *k+1;
57 B=(CBLAS_TEST_COMPLEX* )malloc(LDB*(*n)*sizeof(CBLAS_TEST_COMPLEX));
58 for( i=0; i<*n; i++ )
59 for( j=0; j<*k; j++ ) {
60 B[i*LDB+j].real=b[j*(*ldb)+i].real;
61 B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
62 }
63 }
64
65 LDC = *n+1;
66 C=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDC*sizeof(CBLAS_TEST_COMPLEX));
67 for( j=0; j<*n; j++ )
68 for( i=0; i<*m; i++ ) {
69 C[i*LDC+j].real=c[j*(*ldc)+i].real;
70 C[i*LDC+j].imag=c[j*(*ldc)+i].imag;
71 }
72 cblas_cgemm( CblasRowMajor, transa, transb, *m, *n, *k, alpha, A, LDA,
73 B, LDB, beta, C, LDC );
74 for( j=0; j<*n; j++ )
75 for( i=0; i<*m; i++ ) {
76 c[j*(*ldc)+i].real=C[i*LDC+j].real;
77 c[j*(*ldc)+i].imag=C[i*LDC+j].imag;
78 }
79 free(A);
80 free(B);
81 free(C);
82 }
83 else if (*layout == TEST_COL_MJR)
84 cblas_cgemm( CblasColMajor, transa, transb, *m, *n, *k, alpha, a, *lda,
85 b, *ldb, beta, c, *ldc );
86 else
87 cblas_cgemm( UNDEFINED, transa, transb, *m, *n, *k, alpha, a, *lda,
88 b, *ldb, beta, c, *ldc );
89}
90void F77_chemm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_INT *n,
93 CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc ) {
94
95 CBLAS_TEST_COMPLEX *A, *B, *C;
96 CBLAS_INT i,j,LDA, LDB, LDC;
97 CBLAS_UPLO uplo;
98 CBLAS_SIDE side;
99
100 get_uplo_type(uplow,&uplo);
101 get_side_type(rtlf,&side);
102
103 if (*layout == TEST_ROW_MJR) {
104 if (side == CblasLeft) {
105 LDA = *m+1;
106 A= (CBLAS_TEST_COMPLEX* )malloc((*m)*LDA*sizeof(CBLAS_TEST_COMPLEX));
107 for( i=0; i<*m; i++ )
108 for( j=0; j<*m; j++ ) {
109 A[i*LDA+j].real=a[j*(*lda)+i].real;
110 A[i*LDA+j].imag=a[j*(*lda)+i].imag;
111 }
112 }
113 else{
114 LDA = *n+1;
115 A=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
116 for( i=0; i<*n; i++ )
117 for( j=0; j<*n; j++ ) {
118 A[i*LDA+j].real=a[j*(*lda)+i].real;
119 A[i*LDA+j].imag=a[j*(*lda)+i].imag;
120 }
121 }
122 LDB = *n+1;
123 B=(CBLAS_TEST_COMPLEX* )malloc( (*m)*LDB*sizeof(CBLAS_TEST_COMPLEX ) );
124 for( i=0; i<*m; i++ )
125 for( j=0; j<*n; j++ ) {
126 B[i*LDB+j].real=b[j*(*ldb)+i].real;
127 B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
128 }
129 LDC = *n+1;
130 C=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDC*sizeof(CBLAS_TEST_COMPLEX ) );
131 for( j=0; j<*n; j++ )
132 for( i=0; i<*m; i++ ) {
133 C[i*LDC+j].real=c[j*(*ldc)+i].real;
134 C[i*LDC+j].imag=c[j*(*ldc)+i].imag;
135 }
136 cblas_chemm( CblasRowMajor, side, uplo, *m, *n, alpha, A, LDA, B, LDB,
137 beta, C, LDC );
138 for( j=0; j<*n; j++ )
139 for( i=0; i<*m; i++ ) {
140 c[j*(*ldc)+i].real=C[i*LDC+j].real;
141 c[j*(*ldc)+i].imag=C[i*LDC+j].imag;
142 }
143 free(A);
144 free(B);
145 free(C);
146 }
147 else if (*layout == TEST_COL_MJR)
148 cblas_chemm( CblasColMajor, side, uplo, *m, *n, alpha, a, *lda, b, *ldb,
149 beta, c, *ldc );
150 else
151 cblas_chemm( UNDEFINED, side, uplo, *m, *n, alpha, a, *lda, b, *ldb,
152 beta, c, *ldc );
153}
154void F77_csymm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_INT *n,
157 CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc ) {
158
159 CBLAS_TEST_COMPLEX *A, *B, *C;
160 CBLAS_INT i,j,LDA, LDB, LDC;
161 CBLAS_UPLO uplo;
162 CBLAS_SIDE side;
163
164 get_uplo_type(uplow,&uplo);
165 get_side_type(rtlf,&side);
166
167 if (*layout == TEST_ROW_MJR) {
168 if (side == CblasLeft) {
169 LDA = *m+1;
170 A=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDA*sizeof(CBLAS_TEST_COMPLEX));
171 for( i=0; i<*m; i++ )
172 for( j=0; j<*m; j++ )
173 A[i*LDA+j]=a[j*(*lda)+i];
174 }
175 else{
176 LDA = *n+1;
177 A=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
178 for( i=0; i<*n; i++ )
179 for( j=0; j<*n; j++ )
180 A[i*LDA+j]=a[j*(*lda)+i];
181 }
182 LDB = *n+1;
183 B=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDB*sizeof(CBLAS_TEST_COMPLEX ));
184 for( i=0; i<*m; i++ )
185 for( j=0; j<*n; j++ )
186 B[i*LDB+j]=b[j*(*ldb)+i];
187 LDC = *n+1;
188 C=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDC*sizeof(CBLAS_TEST_COMPLEX));
189 for( j=0; j<*n; j++ )
190 for( i=0; i<*m; i++ )
191 C[i*LDC+j]=c[j*(*ldc)+i];
192 cblas_csymm( CblasRowMajor, side, uplo, *m, *n, alpha, A, LDA, B, LDB,
193 beta, C, LDC );
194 for( j=0; j<*n; j++ )
195 for( i=0; i<*m; i++ )
196 c[j*(*ldc)+i]=C[i*LDC+j];
197 free(A);
198 free(B);
199 free(C);
200 }
201 else if (*layout == TEST_COL_MJR)
202 cblas_csymm( CblasColMajor, side, uplo, *m, *n, alpha, a, *lda, b, *ldb,
203 beta, c, *ldc );
204 else
205 cblas_csymm( UNDEFINED, side, uplo, *m, *n, alpha, a, *lda, b, *ldb,
206 beta, c, *ldc );
207}
208
209void F77_cherk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k,
210 float *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda,
211 float *beta, CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc ) {
212
213 CBLAS_INT i,j,LDA,LDC;
214 CBLAS_TEST_COMPLEX *A, *C;
215 CBLAS_UPLO uplo;
216 CBLAS_TRANSPOSE trans;
217
218 get_uplo_type(uplow,&uplo);
219 get_transpose_type(transp,&trans);
220
221 if (*layout == TEST_ROW_MJR) {
222 if (trans == CblasNoTrans) {
223 LDA = *k+1;
224 A=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
225 for( i=0; i<*n; i++ )
226 for( j=0; j<*k; j++ ) {
227 A[i*LDA+j].real=a[j*(*lda)+i].real;
228 A[i*LDA+j].imag=a[j*(*lda)+i].imag;
229 }
230 }
231 else{
232 LDA = *n+1;
233 A=(CBLAS_TEST_COMPLEX* )malloc((*k)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
234 for( i=0; i<*k; i++ )
235 for( j=0; j<*n; j++ ) {
236 A[i*LDA+j].real=a[j*(*lda)+i].real;
237 A[i*LDA+j].imag=a[j*(*lda)+i].imag;
238 }
239 }
240 LDC = *n+1;
241 C=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDC*sizeof(CBLAS_TEST_COMPLEX ) );
242 for( i=0; i<*n; i++ )
243 for( j=0; j<*n; j++ ) {
244 C[i*LDC+j].real=c[j*(*ldc)+i].real;
245 C[i*LDC+j].imag=c[j*(*ldc)+i].imag;
246 }
247 cblas_cherk(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].real=C[i*LDC+j].real;
252 c[j*(*ldc)+i].imag=C[i*LDC+j].imag;
253 }
254 free(A);
255 free(C);
256 }
257 else if (*layout == TEST_COL_MJR)
258 cblas_cherk(CblasColMajor, uplo, trans, *n, *k, *alpha, a, *lda, *beta,
259 c, *ldc );
260 else
261 cblas_cherk(UNDEFINED, uplo, trans, *n, *k, *alpha, a, *lda, *beta,
262 c, *ldc );
263}
264
265void F77_csyrk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k,
268
269 CBLAS_INT i,j,LDA,LDC;
270 CBLAS_TEST_COMPLEX *A, *C;
271 CBLAS_UPLO uplo;
272 CBLAS_TRANSPOSE trans;
273
274 get_uplo_type(uplow,&uplo);
275 get_transpose_type(transp,&trans);
276
277 if (*layout == TEST_ROW_MJR) {
278 if (trans == CblasNoTrans) {
279 LDA = *k+1;
280 A=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX));
281 for( i=0; i<*n; i++ )
282 for( j=0; j<*k; j++ ) {
283 A[i*LDA+j].real=a[j*(*lda)+i].real;
284 A[i*LDA+j].imag=a[j*(*lda)+i].imag;
285 }
286 }
287 else{
288 LDA = *n+1;
289 A=(CBLAS_TEST_COMPLEX* )malloc((*k)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
290 for( i=0; i<*k; i++ )
291 for( j=0; j<*n; j++ ) {
292 A[i*LDA+j].real=a[j*(*lda)+i].real;
293 A[i*LDA+j].imag=a[j*(*lda)+i].imag;
294 }
295 }
296 LDC = *n+1;
297 C=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDC*sizeof(CBLAS_TEST_COMPLEX ) );
298 for( i=0; i<*n; i++ )
299 for( j=0; j<*n; j++ ) {
300 C[i*LDC+j].real=c[j*(*ldc)+i].real;
301 C[i*LDC+j].imag=c[j*(*ldc)+i].imag;
302 }
303 cblas_csyrk(CblasRowMajor, uplo, trans, *n, *k, alpha, A, LDA, beta,
304 C, LDC );
305 for( j=0; j<*n; j++ )
306 for( i=0; i<*n; i++ ) {
307 c[j*(*ldc)+i].real=C[i*LDC+j].real;
308 c[j*(*ldc)+i].imag=C[i*LDC+j].imag;
309 }
310 free(A);
311 free(C);
312 }
313 else if (*layout == TEST_COL_MJR)
314 cblas_csyrk(CblasColMajor, uplo, trans, *n, *k, alpha, a, *lda, beta,
315 c, *ldc );
316 else
317 cblas_csyrk(UNDEFINED, uplo, trans, *n, *k, alpha, a, *lda, beta,
318 c, *ldc );
319}
320void F77_cher2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k,
322 CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb, float *beta,
323 CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc ) {
324 CBLAS_INT i,j,LDA,LDB,LDC;
325 CBLAS_TEST_COMPLEX *A, *B, *C;
326 CBLAS_UPLO uplo;
327 CBLAS_TRANSPOSE trans;
328
329 get_uplo_type(uplow,&uplo);
330 get_transpose_type(transp,&trans);
331
332 if (*layout == TEST_ROW_MJR) {
333 if (trans == CblasNoTrans) {
334 LDA = *k+1;
335 LDB = *k+1;
336 A=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX ));
337 B=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDB*sizeof(CBLAS_TEST_COMPLEX ));
338 for( i=0; i<*n; i++ )
339 for( j=0; j<*k; j++ ) {
340 A[i*LDA+j].real=a[j*(*lda)+i].real;
341 A[i*LDA+j].imag=a[j*(*lda)+i].imag;
342 B[i*LDB+j].real=b[j*(*ldb)+i].real;
343 B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
344 }
345 }
346 else {
347 LDA = *n+1;
348 LDB = *n+1;
349 A=(CBLAS_TEST_COMPLEX* )malloc( LDA*(*k)*sizeof(CBLAS_TEST_COMPLEX ) );
350 B=(CBLAS_TEST_COMPLEX* )malloc( LDB*(*k)*sizeof(CBLAS_TEST_COMPLEX ) );
351 for( i=0; i<*k; i++ )
352 for( j=0; j<*n; j++ ){
353 A[i*LDA+j].real=a[j*(*lda)+i].real;
354 A[i*LDA+j].imag=a[j*(*lda)+i].imag;
355 B[i*LDB+j].real=b[j*(*ldb)+i].real;
356 B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
357 }
358 }
359 LDC = *n+1;
360 C=(CBLAS_TEST_COMPLEX* )malloc( (*n)*LDC*sizeof(CBLAS_TEST_COMPLEX ) );
361 for( i=0; i<*n; i++ )
362 for( j=0; j<*n; j++ ) {
363 C[i*LDC+j].real=c[j*(*ldc)+i].real;
364 C[i*LDC+j].imag=c[j*(*ldc)+i].imag;
365 }
366 cblas_cher2k(CblasRowMajor, uplo, trans, *n, *k, alpha, A, LDA,
367 B, LDB, *beta, C, LDC );
368 for( j=0; j<*n; j++ )
369 for( i=0; i<*n; i++ ) {
370 c[j*(*ldc)+i].real=C[i*LDC+j].real;
371 c[j*(*ldc)+i].imag=C[i*LDC+j].imag;
372 }
373 free(A);
374 free(B);
375 free(C);
376 }
377 else if (*layout == TEST_COL_MJR)
378 cblas_cher2k(CblasColMajor, uplo, trans, *n, *k, alpha, a, *lda,
379 b, *ldb, *beta, c, *ldc );
380 else
381 cblas_cher2k(UNDEFINED, uplo, trans, *n, *k, alpha, a, *lda,
382 b, *ldb, *beta, c, *ldc );
383}
384void F77_csyr2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k,
387 CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc ) {
388 CBLAS_INT i,j,LDA,LDB,LDC;
389 CBLAS_TEST_COMPLEX *A, *B, *C;
390 CBLAS_UPLO uplo;
391 CBLAS_TRANSPOSE trans;
392
393 get_uplo_type(uplow,&uplo);
394 get_transpose_type(transp,&trans);
395
396 if (*layout == TEST_ROW_MJR) {
397 if (trans == CblasNoTrans) {
398 LDA = *k+1;
399 LDB = *k+1;
400 A=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX));
401 B=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDB*sizeof(CBLAS_TEST_COMPLEX));
402 for( i=0; i<*n; i++ )
403 for( j=0; j<*k; j++ ) {
404 A[i*LDA+j].real=a[j*(*lda)+i].real;
405 A[i*LDA+j].imag=a[j*(*lda)+i].imag;
406 B[i*LDB+j].real=b[j*(*ldb)+i].real;
407 B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
408 }
409 }
410 else {
411 LDA = *n+1;
412 LDB = *n+1;
413 A=(CBLAS_TEST_COMPLEX* )malloc(LDA*(*k)*sizeof(CBLAS_TEST_COMPLEX));
414 B=(CBLAS_TEST_COMPLEX* )malloc(LDB*(*k)*sizeof(CBLAS_TEST_COMPLEX));
415 for( i=0; i<*k; i++ )
416 for( j=0; j<*n; j++ ){
417 A[i*LDA+j].real=a[j*(*lda)+i].real;
418 A[i*LDA+j].imag=a[j*(*lda)+i].imag;
419 B[i*LDB+j].real=b[j*(*ldb)+i].real;
420 B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
421 }
422 }
423 LDC = *n+1;
424 C=(CBLAS_TEST_COMPLEX* )malloc( (*n)*LDC*sizeof(CBLAS_TEST_COMPLEX));
425 for( i=0; i<*n; i++ )
426 for( j=0; j<*n; j++ ) {
427 C[i*LDC+j].real=c[j*(*ldc)+i].real;
428 C[i*LDC+j].imag=c[j*(*ldc)+i].imag;
429 }
430 cblas_csyr2k(CblasRowMajor, uplo, trans, *n, *k, alpha, A, LDA,
431 B, LDB, beta, C, LDC );
432 for( j=0; j<*n; j++ )
433 for( i=0; i<*n; i++ ) {
434 c[j*(*ldc)+i].real=C[i*LDC+j].real;
435 c[j*(*ldc)+i].imag=C[i*LDC+j].imag;
436 }
437 free(A);
438 free(B);
439 free(C);
440 }
441 else if (*layout == TEST_COL_MJR)
442 cblas_csyr2k(CblasColMajor, uplo, trans, *n, *k, alpha, a, *lda,
443 b, *ldb, beta, c, *ldc );
444 else
445 cblas_csyr2k(UNDEFINED, uplo, trans, *n, *k, alpha, a, *lda,
446 b, *ldb, beta, c, *ldc );
447}
448void F77_ctrmm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *diagn,
450 CBLAS_INT *lda, CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb) {
451 CBLAS_INT i,j,LDA,LDB;
452 CBLAS_TEST_COMPLEX *A, *B;
453 CBLAS_SIDE side;
454 CBLAS_DIAG diag;
455 CBLAS_UPLO uplo;
456 CBLAS_TRANSPOSE trans;
457
458 get_uplo_type(uplow,&uplo);
459 get_transpose_type(transp,&trans);
460 get_diag_type(diagn,&diag);
461 get_side_type(rtlf,&side);
462
463 if (*layout == TEST_ROW_MJR) {
464 if (side == CblasLeft) {
465 LDA = *m+1;
466 A=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDA*sizeof(CBLAS_TEST_COMPLEX));
467 for( i=0; i<*m; i++ )
468 for( j=0; j<*m; j++ ) {
469 A[i*LDA+j].real=a[j*(*lda)+i].real;
470 A[i*LDA+j].imag=a[j*(*lda)+i].imag;
471 }
472 }
473 else{
474 LDA = *n+1;
475 A=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX));
476 for( i=0; i<*n; i++ )
477 for( j=0; j<*n; j++ ) {
478 A[i*LDA+j].real=a[j*(*lda)+i].real;
479 A[i*LDA+j].imag=a[j*(*lda)+i].imag;
480 }
481 }
482 LDB = *n+1;
483 B=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDB*sizeof(CBLAS_TEST_COMPLEX));
484 for( i=0; i<*m; i++ )
485 for( j=0; j<*n; j++ ) {
486 B[i*LDB+j].real=b[j*(*ldb)+i].real;
487 B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
488 }
489 cblas_ctrmm(CblasRowMajor, side, uplo, trans, diag, *m, *n, alpha,
490 A, LDA, B, LDB );
491 for( j=0; j<*n; j++ )
492 for( i=0; i<*m; i++ ) {
493 b[j*(*ldb)+i].real=B[i*LDB+j].real;
494 b[j*(*ldb)+i].imag=B[i*LDB+j].imag;
495 }
496 free(A);
497 free(B);
498 }
499 else if (*layout == TEST_COL_MJR)
500 cblas_ctrmm(CblasColMajor, side, uplo, trans, diag, *m, *n, alpha,
501 a, *lda, b, *ldb);
502 else
503 cblas_ctrmm(UNDEFINED, side, uplo, trans, diag, *m, *n, alpha,
504 a, *lda, b, *ldb);
505}
506
507void F77_ctrsm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *diagn,
509 CBLAS_INT *lda, CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb) {
510 CBLAS_INT i,j,LDA,LDB;
511 CBLAS_TEST_COMPLEX *A, *B;
512 CBLAS_SIDE side;
513 CBLAS_DIAG diag;
514 CBLAS_UPLO uplo;
515 CBLAS_TRANSPOSE trans;
516
517 get_uplo_type(uplow,&uplo);
518 get_transpose_type(transp,&trans);
519 get_diag_type(diagn,&diag);
520 get_side_type(rtlf,&side);
521
522 if (*layout == TEST_ROW_MJR) {
523 if (side == CblasLeft) {
524 LDA = *m+1;
525 A=(CBLAS_TEST_COMPLEX* )malloc( (*m)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
526 for( i=0; i<*m; i++ )
527 for( j=0; j<*m; j++ ) {
528 A[i*LDA+j].real=a[j*(*lda)+i].real;
529 A[i*LDA+j].imag=a[j*(*lda)+i].imag;
530 }
531 }
532 else{
533 LDA = *n+1;
534 A=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX));
535 for( i=0; i<*n; i++ )
536 for( j=0; j<*n; j++ ) {
537 A[i*LDA+j].real=a[j*(*lda)+i].real;
538 A[i*LDA+j].imag=a[j*(*lda)+i].imag;
539 }
540 }
541 LDB = *n+1;
542 B=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDB*sizeof(CBLAS_TEST_COMPLEX));
543 for( i=0; i<*m; i++ )
544 for( j=0; j<*n; j++ ) {
545 B[i*LDB+j].real=b[j*(*ldb)+i].real;
546 B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
547 }
548 cblas_ctrsm(CblasRowMajor, side, uplo, trans, diag, *m, *n, alpha,
549 A, LDA, B, LDB );
550 for( j=0; j<*n; j++ )
551 for( i=0; i<*m; i++ ) {
552 b[j*(*ldb)+i].real=B[i*LDB+j].real;
553 b[j*(*ldb)+i].imag=B[i*LDB+j].imag;
554 }
555 free(A);
556 free(B);
557 }
558 else if (*layout == TEST_COL_MJR)
559 cblas_ctrsm(CblasColMajor, side, uplo, trans, diag, *m, *n, alpha,
560 a, *lda, b, *ldb);
561 else
562 cblas_ctrsm(UNDEFINED, side, uplo, trans, diag, *m, *n, alpha,
563 a, *lda, b, *ldb);
564}
#define UNDEFINED
Definition c_cblas3.c:12
#define TEST_ROW_MJR
Definition c_cblas3.c:11
#define TEST_COL_MJR
Definition c_cblas3.c:10
void cblas_cherk(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE Trans, const CBLAS_INT N, const CBLAS_INT K, const float alpha, const void *A, const CBLAS_INT lda, const float beta, void *C, const CBLAS_INT ldc)
Definition cblas_cherk.c:12
void cblas_cher2k(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE Trans, 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 float beta, void *C, const CBLAS_INT ldc)
CBLAS_UPLO
Definition cblas.h:41
void cblas_csyr2k(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE Trans, 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, const void *B, const CBLAS_INT ldb, const void *beta, void *C, const CBLAS_INT ldc)
Definition cblas_csymm.c:12
CBLAS_TRANSPOSE
Definition cblas.h:40
@ CblasNoTrans
Definition cblas.h:40
CBLAS_SIDE
Definition cblas.h:43
@ CblasLeft
Definition cblas.h:43
void cblas_ctrmm(CBLAS_LAYOUT layout, CBLAS_SIDE Side, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, const CBLAS_INT M, const CBLAS_INT N, const void *alpha, const void *A, const CBLAS_INT lda, void *B, const CBLAS_INT ldb)
Definition cblas_ctrmm.c:12
@ CblasColMajor
Definition cblas.h:39
@ CblasRowMajor
Definition cblas.h:39
CBLAS_DIAG
Definition cblas.h:42
void cblas_csyrk(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE Trans, const CBLAS_INT N, const CBLAS_INT K, const void *alpha, const void *A, const CBLAS_INT lda, const void *beta, void *C, const CBLAS_INT ldc)
Definition cblas_csyrk.c:12
void cblas_chemm(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, const void *B, const CBLAS_INT ldb, const void *beta, void *C, const CBLAS_INT ldc)
Definition cblas_chemm.c:12
void cblas_cgemm(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA, CBLAS_TRANSPOSE TransB, const CBLAS_INT M, 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)
Definition cblas_cgemm.c:12
void cblas_ctrsm(CBLAS_LAYOUT layout, CBLAS_SIDE Side, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, const CBLAS_INT M, const CBLAS_INT N, const void *alpha, const void *A, const CBLAS_INT lda, void *B, const CBLAS_INT ldb)
Definition cblas_ctrsm.c:12
#define CBLAS_INT
Definition cblas.h:24
#define F77_csyrk(...)
Definition cblas_f77.h:408
#define F77_cgemm(...)
Definition cblas_f77.h:405
#define F77_csyr2k(...)
Definition cblas_f77.h:410
#define F77_cher2k(...)
Definition cblas_f77.h:411
#define F77_ctrsm(...)
Definition cblas_f77.h:413
#define F77_ctrmm(...)
Definition cblas_f77.h:412
#define F77_chemm(...)
Definition cblas_f77.h:407
#define F77_cherk(...)
Definition cblas_f77.h:409
#define F77_csymm(...)
Definition cblas_f77.h:406
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
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