LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
c_cblas2.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/08/98, SGI/CRAY Research.
6 */
7#include <stdlib.h>
8#include "cblas.h"
9#include "cblas_test.h"
10
11void F77_cgemv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n,
12 const void *alpha,
13 CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, const void *x, CBLAS_INT *incx,
14 const void *beta, void *y, CBLAS_INT *incy
16 , FORTRAN_STRLEN transp_len
17#endif
18) {
19
21 CBLAS_INT i,j,LDA;
22 CBLAS_TRANSPOSE trans;
23
24 get_transpose_type(transp, &trans);
25 if (*layout == TEST_ROW_MJR) {
26 LDA = *n+1;
27 A = (CBLAS_TEST_COMPLEX *)malloc( (*m)*LDA*sizeof( CBLAS_TEST_COMPLEX) );
28 for( i=0; i<*m; i++ )
29 for( j=0; j<*n; j++ ){
30 A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
31 A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
32 }
33 cblas_cgemv( CblasRowMajor, trans, *m, *n, alpha, A, LDA, x, *incx,
34 beta, y, *incy );
35 free(A);
36 }
37 else if (*layout == TEST_COL_MJR)
39 *m, *n, alpha, a, *lda, x, *incx, beta, y, *incy );
40 else
41 cblas_cgemv( UNDEFINED, trans,
42 *m, *n, alpha, a, *lda, x, *incx, beta, y, *incy );
43}
44
45void F77_cgbmv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, CBLAS_INT *kl, CBLAS_INT *ku,
50 , FORTRAN_STRLEN transp_len
51#endif
52) {
53
55 CBLAS_INT i,j,irow,jcol,LDA;
56 CBLAS_TRANSPOSE trans;
57
58 get_transpose_type(transp, &trans);
59 if (*layout == TEST_ROW_MJR) {
60 LDA = *ku+*kl+2;
61 A=( CBLAS_TEST_COMPLEX* )malloc((*n+*kl)*LDA*sizeof(CBLAS_TEST_COMPLEX));
62 for( i=0; i<*ku; i++ ){
63 irow=*ku+*kl-i;
64 jcol=(*ku)-i;
65 for( j=jcol; j<*n; j++ ){
66 A[ LDA*(j-jcol)+irow ].real=a[ (*lda)*j+i ].real;
67 A[ LDA*(j-jcol)+irow ].imag=a[ (*lda)*j+i ].imag;
68 }
69 }
70 i=*ku;
71 irow=*ku+*kl-i;
72 for( j=0; j<*n; j++ ){
73 A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
74 A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
75 }
76 for( i=*ku+1; i<*ku+*kl+1; i++ ){
77 irow=*ku+*kl-i;
78 jcol=i-(*ku);
79 for( j=jcol; j<(*n+*kl); j++ ){
80 A[ LDA*j+irow ].real=a[ (*lda)*(j-jcol)+i ].real;
81 A[ LDA*j+irow ].imag=a[ (*lda)*(j-jcol)+i ].imag;
82 }
83 }
84 cblas_cgbmv( CblasRowMajor, trans, *m, *n, *kl, *ku, alpha, A, LDA, x,
85 *incx, beta, y, *incy );
86 free(A);
87 }
88 else if (*layout == TEST_COL_MJR)
89 cblas_cgbmv( CblasColMajor, trans, *m, *n, *kl, *ku, alpha, a, *lda, x,
90 *incx, beta, y, *incy );
91 else
92 cblas_cgbmv( UNDEFINED, trans, *m, *n, *kl, *ku, alpha, a, *lda, x,
93 *incx, beta, y, *incy );
94}
95
99
101 CBLAS_INT i,j,LDA;
102
103 if (*layout == TEST_ROW_MJR) {
104 LDA = *n+1;
105 A=(CBLAS_TEST_COMPLEX*)malloc((*m)*LDA*sizeof(CBLAS_TEST_COMPLEX));
106 for( i=0; i<*m; i++ )
107 for( j=0; j<*n; j++ ){
108 A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
109 A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
110 }
111 cblas_cgeru( CblasRowMajor, *m, *n, alpha, x, *incx, y, *incy, A, LDA );
112 for( i=0; i<*m; i++ )
113 for( j=0; j<*n; j++ ){
114 a[ (*lda)*j+i ].real=A[ LDA*i+j ].real;
115 a[ (*lda)*j+i ].imag=A[ LDA*i+j ].imag;
116 }
117 free(A);
118 }
119 else if (*layout == TEST_COL_MJR)
120 cblas_cgeru( CblasColMajor, *m, *n, alpha, x, *incx, y, *incy, a, *lda );
121 else
122 cblas_cgeru( UNDEFINED, *m, *n, alpha, x, *incx, y, *incy, a, *lda );
123}
124
127 CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda) {
129 CBLAS_INT i,j,LDA;
130
131 if (*layout == TEST_ROW_MJR) {
132 LDA = *n+1;
133 A=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
134 for( i=0; i<*m; i++ )
135 for( j=0; j<*n; j++ ){
136 A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
137 A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
138 }
139 cblas_cgerc( CblasRowMajor, *m, *n, alpha, x, *incx, y, *incy, A, LDA );
140 for( i=0; i<*m; i++ )
141 for( j=0; j<*n; j++ ){
142 a[ (*lda)*j+i ].real=A[ LDA*i+j ].real;
143 a[ (*lda)*j+i ].imag=A[ LDA*i+j ].imag;
144 }
145 free(A);
146 }
147 else if (*layout == TEST_COL_MJR)
148 cblas_cgerc( CblasColMajor, *m, *n, alpha, x, *incx, y, *incy, a, *lda );
149 else
150 cblas_cgerc( UNDEFINED, *m, *n, alpha, x, *incx, y, *incy, a, *lda );
151}
152
153void F77_chemv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha,
157 , FORTRAN_STRLEN uplow_len
158#endif
159){
160
162 CBLAS_INT i,j,LDA;
163 CBLAS_UPLO uplo;
164
165 get_uplo_type(uplow,&uplo);
166
167 if (*layout == TEST_ROW_MJR) {
168 LDA = *n+1;
169 A = (CBLAS_TEST_COMPLEX *)malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX));
170 for( i=0; i<*n; i++ )
171 for( j=0; j<*n; j++ ){
172 A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
173 A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
174 }
175 cblas_chemv( CblasRowMajor, uplo, *n, alpha, A, LDA, x, *incx,
176 beta, y, *incy );
177 free(A);
178 }
179 else if (*layout == TEST_COL_MJR)
180 cblas_chemv( CblasColMajor, uplo, *n, alpha, a, *lda, x, *incx,
181 beta, y, *incy );
182 else
183 cblas_chemv( UNDEFINED, uplo, *n, alpha, a, *lda, x, *incx,
184 beta, y, *incy );
185}
186
187void F77_chbmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_INT *k,
192 , FORTRAN_STRLEN uplow_len
193#endif
194){
195
197CBLAS_INT i,irow,j,jcol,LDA;
198
199 CBLAS_UPLO uplo;
200
201 get_uplo_type(uplow,&uplo);
202
203 if (*layout == TEST_ROW_MJR) {
204 if (uplo != CblasUpper && uplo != CblasLower )
205 cblas_chbmv(CblasRowMajor, UNDEFINED, *n, *k, alpha, a, *lda, x,
206 *incx, beta, y, *incy );
207 else {
208 LDA = *k+2;
209 A =(CBLAS_TEST_COMPLEX*)malloc((*n+*k)*LDA*sizeof(CBLAS_TEST_COMPLEX));
210 if (uplo == CblasUpper) {
211 for( i=0; i<*k; i++ ){
212 irow=*k-i;
213 jcol=(*k)-i;
214 for( j=jcol; j<*n; j++ ) {
215 A[ LDA*(j-jcol)+irow ].real=a[ (*lda)*j+i ].real;
216 A[ LDA*(j-jcol)+irow ].imag=a[ (*lda)*j+i ].imag;
217 }
218 }
219 i=*k;
220 irow=*k-i;
221 for( j=0; j<*n; j++ ) {
222 A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
223 A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
224 }
225 }
226 else {
227 i=0;
228 irow=*k-i;
229 for( j=0; j<*n; j++ ) {
230 A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
231 A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
232 }
233 for( i=1; i<*k+1; i++ ){
234 irow=*k-i;
235 jcol=i;
236 for( j=jcol; j<(*n+*k); j++ ) {
237 A[ LDA*j+irow ].real=a[ (*lda)*(j-jcol)+i ].real;
238 A[ LDA*j+irow ].imag=a[ (*lda)*(j-jcol)+i ].imag;
239 }
240 }
241 }
242 cblas_chbmv( CblasRowMajor, uplo, *n, *k, alpha, A, LDA, x, *incx,
243 beta, y, *incy );
244 free(A);
245 }
246 }
247 else if (*layout == TEST_COL_MJR)
248 cblas_chbmv(CblasColMajor, uplo, *n, *k, alpha, a, *lda, x, *incx,
249 beta, y, *incy );
250 else
251 cblas_chbmv(UNDEFINED, uplo, *n, *k, alpha, a, *lda, x, *incx,
252 beta, y, *incy );
253}
254
255void F77_chpmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha,
259 , FORTRAN_STRLEN uplow_len
260#endif
261){
262
263 CBLAS_TEST_COMPLEX *A, *AP;
264 CBLAS_INT i,j,k,LDA;
265 CBLAS_UPLO uplo;
266
267 get_uplo_type(uplow,&uplo);
268 if (*layout == TEST_ROW_MJR) {
269 if (uplo != CblasUpper && uplo != CblasLower )
270 cblas_chpmv(CblasRowMajor, UNDEFINED, *n, alpha, ap, x, *incx,
271 beta, y, *incy);
272 else {
273 LDA = *n;
274 A = (CBLAS_TEST_COMPLEX* )malloc(LDA*LDA*sizeof(CBLAS_TEST_COMPLEX ));
275 AP = (CBLAS_TEST_COMPLEX* )malloc( (((LDA+1)*LDA)/2)*
276 sizeof( CBLAS_TEST_COMPLEX ));
277 if (uplo == CblasUpper) {
278 for( j=0, k=0; j<*n; j++ )
279 for( i=0; i<j+1; i++, k++ ) {
280 A[ LDA*i+j ].real=ap[ k ].real;
281 A[ LDA*i+j ].imag=ap[ k ].imag;
282 }
283 for( i=0, k=0; i<*n; i++ )
284 for( j=i; j<*n; j++, k++ ) {
285 AP[ k ].real=A[ LDA*i+j ].real;
286 AP[ k ].imag=A[ LDA*i+j ].imag;
287 }
288 }
289 else {
290 for( j=0, k=0; j<*n; j++ )
291 for( i=j; i<*n; i++, k++ ) {
292 A[ LDA*i+j ].real=ap[ k ].real;
293 A[ LDA*i+j ].imag=ap[ k ].imag;
294 }
295 for( i=0, k=0; i<*n; i++ )
296 for( j=0; j<i+1; j++, k++ ) {
297 AP[ k ].real=A[ LDA*i+j ].real;
298 AP[ k ].imag=A[ LDA*i+j ].imag;
299 }
300 }
301 cblas_chpmv( CblasRowMajor, uplo, *n, alpha, AP, x, *incx, beta, y,
302 *incy );
303 free(A);
304 free(AP);
305 }
306 }
307 else if (*layout == TEST_COL_MJR)
308 cblas_chpmv( CblasColMajor, uplo, *n, alpha, ap, x, *incx, beta, y,
309 *incy );
310 else
311 cblas_chpmv( UNDEFINED, uplo, *n, alpha, ap, x, *incx, beta, y,
312 *incy );
313}
314
315void F77_ctbmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
317 CBLAS_INT *incx
319 , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
320#endif
321) {
323 CBLAS_INT irow, jcol, i, j, LDA;
324 CBLAS_TRANSPOSE trans;
325 CBLAS_UPLO uplo;
326 CBLAS_DIAG diag;
327
328 get_transpose_type(transp,&trans);
329 get_uplo_type(uplow,&uplo);
330 get_diag_type(diagn,&diag);
331
332 if (*layout == TEST_ROW_MJR) {
333 if (uplo != CblasUpper && uplo != CblasLower )
334 cblas_ctbmv(CblasRowMajor, UNDEFINED, trans, diag, *n, *k, a, *lda,
335 x, *incx);
336 else {
337 LDA = *k+2;
338 A=(CBLAS_TEST_COMPLEX *)malloc((*n+*k)*LDA*sizeof(CBLAS_TEST_COMPLEX));
339 if (uplo == CblasUpper) {
340 for( i=0; i<*k; i++ ){
341 irow=*k-i;
342 jcol=(*k)-i;
343 for( j=jcol; j<*n; j++ ) {
344 A[ LDA*(j-jcol)+irow ].real=a[ (*lda)*j+i ].real;
345 A[ LDA*(j-jcol)+irow ].imag=a[ (*lda)*j+i ].imag;
346 }
347 }
348 i=*k;
349 irow=*k-i;
350 for( j=0; j<*n; j++ ) {
351 A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
352 A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
353 }
354 }
355 else {
356 i=0;
357 irow=*k-i;
358 for( j=0; j<*n; j++ ) {
359 A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
360 A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
361 }
362 for( i=1; i<*k+1; i++ ){
363 irow=*k-i;
364 jcol=i;
365 for( j=jcol; j<(*n+*k); j++ ) {
366 A[ LDA*j+irow ].real=a[ (*lda)*(j-jcol)+i ].real;
367 A[ LDA*j+irow ].imag=a[ (*lda)*(j-jcol)+i ].imag;
368 }
369 }
370 }
371 cblas_ctbmv(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, x,
372 *incx);
373 free(A);
374 }
375 }
376 else if (*layout == TEST_COL_MJR)
377 cblas_ctbmv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
378 else
379 cblas_ctbmv(UNDEFINED, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
380}
381
382void F77_ctbsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
384 CBLAS_INT *incx
386 , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
387#endif
388) {
389
391 CBLAS_INT irow, jcol, i, j, LDA;
392 CBLAS_TRANSPOSE trans;
393 CBLAS_UPLO uplo;
394 CBLAS_DIAG diag;
395
396 get_transpose_type(transp,&trans);
397 get_uplo_type(uplow,&uplo);
398 get_diag_type(diagn,&diag);
399
400 if (*layout == TEST_ROW_MJR) {
401 if (uplo != CblasUpper && uplo != CblasLower )
402 cblas_ctbsv(CblasRowMajor, UNDEFINED, trans, diag, *n, *k, a, *lda, x,
403 *incx);
404 else {
405 LDA = *k+2;
406 A=(CBLAS_TEST_COMPLEX*)malloc((*n+*k)*LDA*sizeof(CBLAS_TEST_COMPLEX ));
407 if (uplo == CblasUpper) {
408 for( i=0; i<*k; i++ ){
409 irow=*k-i;
410 jcol=(*k)-i;
411 for( j=jcol; j<*n; j++ ) {
412 A[ LDA*(j-jcol)+irow ].real=a[ (*lda)*j+i ].real;
413 A[ LDA*(j-jcol)+irow ].imag=a[ (*lda)*j+i ].imag;
414 }
415 }
416 i=*k;
417 irow=*k-i;
418 for( j=0; j<*n; j++ ) {
419 A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
420 A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
421 }
422 }
423 else {
424 i=0;
425 irow=*k-i;
426 for( j=0; j<*n; j++ ) {
427 A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
428 A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
429 }
430 for( i=1; i<*k+1; i++ ){
431 irow=*k-i;
432 jcol=i;
433 for( j=jcol; j<(*n+*k); j++ ) {
434 A[ LDA*j+irow ].real=a[ (*lda)*(j-jcol)+i ].real;
435 A[ LDA*j+irow ].imag=a[ (*lda)*(j-jcol)+i ].imag;
436 }
437 }
438 }
439 cblas_ctbsv(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA,
440 x, *incx);
441 free(A);
442 }
443 }
444 else if (*layout == TEST_COL_MJR)
445 cblas_ctbsv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
446 else
447 cblas_ctbsv(UNDEFINED, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
448}
449
450void F77_ctpmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
453 , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len , FORTRAN_STRLEN diagn_len
454#endif
455) {
456 CBLAS_TEST_COMPLEX *A, *AP;
457 CBLAS_INT i, j, k, LDA;
458 CBLAS_TRANSPOSE trans;
459 CBLAS_UPLO uplo;
460 CBLAS_DIAG diag;
461
462 get_transpose_type(transp,&trans);
463 get_uplo_type(uplow,&uplo);
464 get_diag_type(diagn,&diag);
465
466 if (*layout == TEST_ROW_MJR) {
467 if (uplo != CblasUpper && uplo != CblasLower )
468 cblas_ctpmv( CblasRowMajor, UNDEFINED, trans, diag, *n, ap, x, *incx );
469 else {
470 LDA = *n;
471 A=(CBLAS_TEST_COMPLEX*)malloc(LDA*LDA*sizeof(CBLAS_TEST_COMPLEX));
472 AP=(CBLAS_TEST_COMPLEX*)malloc((((LDA+1)*LDA)/2)*
473 sizeof(CBLAS_TEST_COMPLEX));
474 if (uplo == CblasUpper) {
475 for( j=0, k=0; j<*n; j++ )
476 for( i=0; i<j+1; i++, k++ ) {
477 A[ LDA*i+j ].real=ap[ k ].real;
478 A[ LDA*i+j ].imag=ap[ k ].imag;
479 }
480 for( i=0, k=0; i<*n; i++ )
481 for( j=i; j<*n; j++, k++ ) {
482 AP[ k ].real=A[ LDA*i+j ].real;
483 AP[ k ].imag=A[ LDA*i+j ].imag;
484 }
485 }
486 else {
487 for( j=0, k=0; j<*n; j++ )
488 for( i=j; i<*n; i++, k++ ) {
489 A[ LDA*i+j ].real=ap[ k ].real;
490 A[ LDA*i+j ].imag=ap[ k ].imag;
491 }
492 for( i=0, k=0; i<*n; i++ )
493 for( j=0; j<i+1; j++, k++ ) {
494 AP[ k ].real=A[ LDA*i+j ].real;
495 AP[ k ].imag=A[ LDA*i+j ].imag;
496 }
497 }
498 cblas_ctpmv( CblasRowMajor, uplo, trans, diag, *n, AP, x, *incx );
499 free(A);
500 free(AP);
501 }
502 }
503 else if (*layout == TEST_COL_MJR)
504 cblas_ctpmv( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx );
505 else
506 cblas_ctpmv( UNDEFINED, uplo, trans, diag, *n, ap, x, *incx );
507}
508
509void F77_ctpsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
512 , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
513#endif
514) {
515 CBLAS_TEST_COMPLEX *A, *AP;
516 CBLAS_INT i, j, k, LDA;
517 CBLAS_TRANSPOSE trans;
518 CBLAS_UPLO uplo;
519 CBLAS_DIAG diag;
520
521 get_transpose_type(transp,&trans);
522 get_uplo_type(uplow,&uplo);
523 get_diag_type(diagn,&diag);
524
525 if (*layout == TEST_ROW_MJR) {
526 if (uplo != CblasUpper && uplo != CblasLower )
527 cblas_ctpsv( CblasRowMajor, UNDEFINED, trans, diag, *n, ap, x, *incx );
528 else {
529 LDA = *n;
530 A=(CBLAS_TEST_COMPLEX*)malloc(LDA*LDA*sizeof(CBLAS_TEST_COMPLEX));
531 AP=(CBLAS_TEST_COMPLEX*)malloc((((LDA+1)*LDA)/2)*
532 sizeof(CBLAS_TEST_COMPLEX));
533 if (uplo == CblasUpper) {
534 for( j=0, k=0; j<*n; j++ )
535 for( i=0; i<j+1; i++, k++ ) {
536 A[ LDA*i+j ].real=ap[ k ].real;
537 A[ LDA*i+j ].imag=ap[ k ].imag;
538 }
539 for( i=0, k=0; i<*n; i++ )
540 for( j=i; j<*n; j++, k++ ) {
541 AP[ k ].real=A[ LDA*i+j ].real;
542 AP[ k ].imag=A[ LDA*i+j ].imag;
543 }
544 }
545 else {
546 for( j=0, k=0; j<*n; j++ )
547 for( i=j; i<*n; i++, k++ ) {
548 A[ LDA*i+j ].real=ap[ k ].real;
549 A[ LDA*i+j ].imag=ap[ k ].imag;
550 }
551 for( i=0, k=0; i<*n; i++ )
552 for( j=0; j<i+1; j++, k++ ) {
553 AP[ k ].real=A[ LDA*i+j ].real;
554 AP[ k ].imag=A[ LDA*i+j ].imag;
555 }
556 }
557 cblas_ctpsv( CblasRowMajor, uplo, trans, diag, *n, AP, x, *incx );
558 free(A);
559 free(AP);
560 }
561 }
562 else if (*layout == TEST_COL_MJR)
563 cblas_ctpsv( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx );
564 else
565 cblas_ctpsv( UNDEFINED, uplo, trans, diag, *n, ap, x, *incx );
566}
567
568void F77_ctrmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
570 CBLAS_INT *incx
572 , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
573#endif
574) {
576 CBLAS_INT i,j,LDA;
577 CBLAS_TRANSPOSE trans;
578 CBLAS_UPLO uplo;
579 CBLAS_DIAG diag;
580
581 get_transpose_type(transp,&trans);
582 get_uplo_type(uplow,&uplo);
583 get_diag_type(diagn,&diag);
584
585 if (*layout == TEST_ROW_MJR) {
586 LDA=*n+1;
587 A=(CBLAS_TEST_COMPLEX*)malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX));
588 for( i=0; i<*n; i++ )
589 for( j=0; j<*n; j++ ) {
590 A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
591 A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
592 }
593 cblas_ctrmv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx);
594 free(A);
595 }
596 else if (*layout == TEST_COL_MJR)
597 cblas_ctrmv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx);
598 else
599 cblas_ctrmv(UNDEFINED, uplo, trans, diag, *n, a, *lda, x, *incx);
600}
601void F77_ctrsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
603 CBLAS_INT *incx
605 , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
606#endif
607) {
609 CBLAS_INT i,j,LDA;
610 CBLAS_TRANSPOSE trans;
611 CBLAS_UPLO uplo;
612 CBLAS_DIAG diag;
613
614 get_transpose_type(transp,&trans);
615 get_uplo_type(uplow,&uplo);
616 get_diag_type(diagn,&diag);
617
618 if (*layout == TEST_ROW_MJR) {
619 LDA = *n+1;
620 A =(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
621 for( i=0; i<*n; i++ )
622 for( j=0; j<*n; j++ ) {
623 A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
624 A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
625 }
626 cblas_ctrsv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx );
627 free(A);
628 }
629 else if (*layout == TEST_COL_MJR)
630 cblas_ctrsv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx );
631 else
632 cblas_ctrsv(UNDEFINED, uplo, trans, diag, *n, a, *lda, x, *incx );
633}
634
635void F77_chpr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha,
638 , FORTRAN_STRLEN uplow_len
639#endif
640) {
641 CBLAS_TEST_COMPLEX *A, *AP;
642 CBLAS_INT i,j,k,LDA;
643 CBLAS_UPLO uplo;
644
645 get_uplo_type(uplow,&uplo);
646
647 if (*layout == TEST_ROW_MJR) {
648 if (uplo != CblasUpper && uplo != CblasLower )
649 cblas_chpr(CblasRowMajor, UNDEFINED, *n, *alpha, x, *incx, ap );
650 else {
651 LDA = *n;
652 A = (CBLAS_TEST_COMPLEX* )malloc(LDA*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
653 AP = ( CBLAS_TEST_COMPLEX* )malloc( (((LDA+1)*LDA)/2)*
654 sizeof( CBLAS_TEST_COMPLEX ));
655 if (uplo == CblasUpper) {
656 for( j=0, k=0; j<*n; j++ )
657 for( i=0; i<j+1; i++, k++ ){
658 A[ LDA*i+j ].real=ap[ k ].real;
659 A[ LDA*i+j ].imag=ap[ k ].imag;
660 }
661 for( i=0, k=0; i<*n; i++ )
662 for( j=i; j<*n; j++, k++ ){
663 AP[ k ].real=A[ LDA*i+j ].real;
664 AP[ k ].imag=A[ LDA*i+j ].imag;
665 }
666 }
667 else {
668 for( j=0, k=0; j<*n; j++ )
669 for( i=j; i<*n; i++, k++ ){
670 A[ LDA*i+j ].real=ap[ k ].real;
671 A[ LDA*i+j ].imag=ap[ k ].imag;
672 }
673 for( i=0, k=0; i<*n; i++ )
674 for( j=0; j<i+1; j++, k++ ){
675 AP[ k ].real=A[ LDA*i+j ].real;
676 AP[ k ].imag=A[ LDA*i+j ].imag;
677 }
678 }
679 cblas_chpr(CblasRowMajor, uplo, *n, *alpha, x, *incx, AP );
680 if (uplo == CblasUpper) {
681 for( i=0, k=0; i<*n; i++ )
682 for( j=i; j<*n; j++, k++ ){
683 A[ LDA*i+j ].real=AP[ k ].real;
684 A[ LDA*i+j ].imag=AP[ k ].imag;
685 }
686 for( j=0, k=0; j<*n; j++ )
687 for( i=0; i<j+1; i++, k++ ){
688 ap[ k ].real=A[ LDA*i+j ].real;
689 ap[ k ].imag=A[ LDA*i+j ].imag;
690 }
691 }
692 else {
693 for( i=0, k=0; i<*n; i++ )
694 for( j=0; j<i+1; j++, k++ ){
695 A[ LDA*i+j ].real=AP[ k ].real;
696 A[ LDA*i+j ].imag=AP[ k ].imag;
697 }
698 for( j=0, k=0; j<*n; j++ )
699 for( i=j; i<*n; i++, k++ ){
700 ap[ k ].real=A[ LDA*i+j ].real;
701 ap[ k ].imag=A[ LDA*i+j ].imag;
702 }
703 }
704 free(A);
705 free(AP);
706 }
707 }
708 else if (*layout == TEST_COL_MJR)
709 cblas_chpr(CblasColMajor, uplo, *n, *alpha, x, *incx, ap );
710 else
711 cblas_chpr(UNDEFINED, uplo, *n, *alpha, x, *incx, ap );
712}
713
714void F77_chpr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha,
718 , FORTRAN_STRLEN uplow_len
719#endif
720) {
721 CBLAS_TEST_COMPLEX *A, *AP;
722 CBLAS_INT i,j,k,LDA;
723 CBLAS_UPLO uplo;
724
725 get_uplo_type(uplow,&uplo);
726
727 if (*layout == TEST_ROW_MJR) {
728 if (uplo != CblasUpper && uplo != CblasLower )
729 cblas_chpr2( CblasRowMajor, UNDEFINED, *n, alpha, x, *incx, y,
730 *incy, ap );
731 else {
732 LDA = *n;
733 A=(CBLAS_TEST_COMPLEX*)malloc( LDA*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
734 AP=(CBLAS_TEST_COMPLEX*)malloc( (((LDA+1)*LDA)/2)*
735 sizeof( CBLAS_TEST_COMPLEX ));
736 if (uplo == CblasUpper) {
737 for( j=0, k=0; j<*n; j++ )
738 for( i=0; i<j+1; i++, k++ ) {
739 A[ LDA*i+j ].real=ap[ k ].real;
740 A[ LDA*i+j ].imag=ap[ k ].imag;
741 }
742 for( i=0, k=0; i<*n; i++ )
743 for( j=i; j<*n; j++, k++ ) {
744 AP[ k ].real=A[ LDA*i+j ].real;
745 AP[ k ].imag=A[ LDA*i+j ].imag;
746 }
747 }
748 else {
749 for( j=0, k=0; j<*n; j++ )
750 for( i=j; i<*n; i++, k++ ) {
751 A[ LDA*i+j ].real=ap[ k ].real;
752 A[ LDA*i+j ].imag=ap[ k ].imag;
753 }
754 for( i=0, k=0; i<*n; i++ )
755 for( j=0; j<i+1; j++, k++ ) {
756 AP[ k ].real=A[ LDA*i+j ].real;
757 AP[ k ].imag=A[ LDA*i+j ].imag;
758 }
759 }
760 cblas_chpr2( CblasRowMajor, uplo, *n, alpha, x, *incx, y, *incy, AP );
761 if (uplo == CblasUpper) {
762 for( i=0, k=0; i<*n; i++ )
763 for( j=i; j<*n; j++, k++ ) {
764 A[ LDA*i+j ].real=AP[ k ].real;
765 A[ LDA*i+j ].imag=AP[ k ].imag;
766 }
767 for( j=0, k=0; j<*n; j++ )
768 for( i=0; i<j+1; i++, k++ ) {
769 ap[ k ].real=A[ LDA*i+j ].real;
770 ap[ k ].imag=A[ LDA*i+j ].imag;
771 }
772 }
773 else {
774 for( i=0, k=0; i<*n; i++ )
775 for( j=0; j<i+1; j++, k++ ) {
776 A[ LDA*i+j ].real=AP[ k ].real;
777 A[ LDA*i+j ].imag=AP[ k ].imag;
778 }
779 for( j=0, k=0; j<*n; j++ )
780 for( i=j; i<*n; i++, k++ ) {
781 ap[ k ].real=A[ LDA*i+j ].real;
782 ap[ k ].imag=A[ LDA*i+j ].imag;
783 }
784 }
785 free(A);
786 free(AP);
787 }
788 }
789 else if (*layout == TEST_COL_MJR)
790 cblas_chpr2( CblasColMajor, uplo, *n, alpha, x, *incx, y, *incy, ap );
791 else
792 cblas_chpr2( UNDEFINED, uplo, *n, alpha, x, *incx, y, *incy, ap );
793}
794
795void F77_cher(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha,
798 , FORTRAN_STRLEN uplow_len
799#endif
800) {
802 CBLAS_INT i,j,LDA;
803 CBLAS_UPLO uplo;
804
805 get_uplo_type(uplow,&uplo);
806
807 if (*layout == TEST_ROW_MJR) {
808 LDA = *n+1;
809 A=(CBLAS_TEST_COMPLEX*)malloc((*n)*LDA*sizeof( CBLAS_TEST_COMPLEX ));
810
811 for( i=0; i<*n; i++ )
812 for( j=0; j<*n; j++ ) {
813 A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
814 A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
815 }
816
817 cblas_cher(CblasRowMajor, uplo, *n, *alpha, x, *incx, A, LDA );
818 for( i=0; i<*n; i++ )
819 for( j=0; j<*n; j++ ) {
820 a[ (*lda)*j+i ].real=A[ LDA*i+j ].real;
821 a[ (*lda)*j+i ].imag=A[ LDA*i+j ].imag;
822 }
823 free(A);
824 }
825 else if (*layout == TEST_COL_MJR)
826 cblas_cher( CblasColMajor, uplo, *n, *alpha, x, *incx, a, *lda );
827 else
828 cblas_cher( UNDEFINED, uplo, *n, *alpha, x, *incx, a, *lda );
829}
830
831void F77_cher2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha,
835 , FORTRAN_STRLEN uplow_len
836#endif
837) {
838
840 CBLAS_INT i,j,LDA;
841 CBLAS_UPLO uplo;
842
843 get_uplo_type(uplow,&uplo);
844
845 if (*layout == TEST_ROW_MJR) {
846 LDA = *n+1;
847 A= ( CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
848
849 for( i=0; i<*n; i++ )
850 for( j=0; j<*n; j++ ) {
851 A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
852 A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
853 }
854
855 cblas_cher2(CblasRowMajor, uplo, *n, alpha, x, *incx, y, *incy, A, LDA );
856 for( i=0; i<*n; i++ )
857 for( j=0; j<*n; j++ ) {
858 a[ (*lda)*j+i ].real=A[ LDA*i+j ].real;
859 a[ (*lda)*j+i ].imag=A[ LDA*i+j ].imag;
860 }
861 free(A);
862 }
863 else if (*layout == TEST_COL_MJR)
864 cblas_cher2( CblasColMajor, uplo, *n, alpha, x, *incx, y, *incy, a, *lda);
865 else
866 cblas_cher2( UNDEFINED, uplo, *n, alpha, x, *incx, y, *incy, a, *lda);
867}
void cblas_cher(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const CBLAS_INT N, const float alpha, const void *X, const CBLAS_INT incX, void *A, const CBLAS_INT lda)
Definition cblas_cher.c:12
void cblas_chpr(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const CBLAS_INT N, const float alpha, const void *X, const CBLAS_INT incX, void *A)
Definition cblas_chpr.c:12
CBLAS_UPLO
Definition cblas.h:41
@ CblasLower
Definition cblas.h:41
@ CblasUpper
Definition cblas.h:41
void cblas_ctbsv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, const CBLAS_INT N, const CBLAS_INT K, const void *A, const CBLAS_INT lda, void *X, const CBLAS_INT incX)
Definition cblas_ctbsv.c:10
void cblas_cgeru(CBLAS_LAYOUT layout, const CBLAS_INT M, const CBLAS_INT N, const void *alpha, const void *X, const CBLAS_INT incX, const void *Y, const CBLAS_INT incY, void *A, const CBLAS_INT lda)
Definition cblas_cgeru.c:10
void cblas_ctrmv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, const CBLAS_INT N, const void *A, const CBLAS_INT lda, void *X, const CBLAS_INT incX)
Definition cblas_ctrmv.c:10
void cblas_ctpmv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, const CBLAS_INT N, const void *Ap, void *X, const CBLAS_INT incX)
Definition cblas_ctpmv.c:10
CBLAS_TRANSPOSE
Definition cblas.h:40
void cblas_ctrsv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, const CBLAS_INT N, const void *A, const CBLAS_INT lda, void *X, const CBLAS_INT incX)
Definition cblas_ctrsv.c:10
void cblas_chbmv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const CBLAS_INT N, const CBLAS_INT K, const void *alpha, const void *A, const CBLAS_INT lda, const void *X, const CBLAS_INT incX, const void *beta, void *Y, const CBLAS_INT incY)
Definition cblas_chbmv.c:12
void cblas_chpmv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const CBLAS_INT N, const void *alpha, const void *Ap, const void *X, const CBLAS_INT incX, const void *beta, void *Y, const CBLAS_INT incY)
Definition cblas_chpmv.c:12
void cblas_ctbmv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, const CBLAS_INT N, const CBLAS_INT K, const void *A, const CBLAS_INT lda, void *X, const CBLAS_INT incX)
Definition cblas_ctbmv.c:10
@ CblasColMajor
Definition cblas.h:39
@ CblasRowMajor
Definition cblas.h:39
void cblas_cgbmv(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA, const CBLAS_INT M, const CBLAS_INT N, const CBLAS_INT KL, const CBLAS_INT KU, const void *alpha, const void *A, const CBLAS_INT lda, const void *X, const CBLAS_INT incX, const void *beta, void *Y, const CBLAS_INT incY)
Definition cblas_cgbmv.c:12
void cblas_cgerc(CBLAS_LAYOUT layout, const CBLAS_INT M, const CBLAS_INT N, const void *alpha, const void *X, const CBLAS_INT incX, const void *Y, const CBLAS_INT incY, void *A, const CBLAS_INT lda)
Definition cblas_cgerc.c:12
CBLAS_DIAG
Definition cblas.h:42
void cblas_chpr2(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const CBLAS_INT N, const void *alpha, const void *X, const CBLAS_INT incX, const void *Y, const CBLAS_INT incY, void *Ap)
Definition cblas_chpr2.c:12
#define CBLAS_INT
Definition cblas.h:24
void cblas_ctpsv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, const CBLAS_INT N, const void *Ap, void *X, const CBLAS_INT incX)
Definition cblas_ctpsv.c:10
void cblas_chemv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const CBLAS_INT N, const void *alpha, const void *A, const CBLAS_INT lda, const void *X, const CBLAS_INT incX, const void *beta, void *Y, const CBLAS_INT incY)
Definition cblas_chemv.c:12
void cblas_cher2(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const CBLAS_INT N, const void *alpha, const void *X, const CBLAS_INT incX, const void *Y, const CBLAS_INT incY, void *A, const CBLAS_INT lda)
Definition cblas_cher2.c:12
void cblas_cgemv(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA, const CBLAS_INT M, const CBLAS_INT N, const void *alpha, const void *A, const CBLAS_INT lda, const void *X, const CBLAS_INT incX, const void *beta, void *Y, const CBLAS_INT incY)
Definition cblas_cgemv.c:12
#define F77_chpr(...)
Definition cblas_f77.h:368
#define BLAS_FORTRAN_STRLEN_END
Definition cblas_f77.h:18
#define FORTRAN_STRLEN
Definition cblas_f77.h:21
#define F77_cgeru(...)
Definition cblas_f77.h:307
#define F77_ctpmv(...)
Definition cblas_f77.h:362
#define F77_ctrmv(...)
Definition cblas_f77.h:360
#define F77_ctrsv(...)
Definition cblas_f77.h:363
#define F77_cgemv(...)
Definition cblas_f77.h:355
#define F77_cgerc(...)
Definition cblas_f77.h:306
#define F77_ctpsv(...)
Definition cblas_f77.h:365
#define F77_cher2(...)
Definition cblas_f77.h:367
#define F77_chemv(...)
Definition cblas_f77.h:357
#define F77_ctbsv(...)
Definition cblas_f77.h:364
#define F77_chpr2(...)
Definition cblas_f77.h:369
#define F77_cher(...)
Definition cblas_f77.h:366
#define F77_chpmv(...)
Definition cblas_f77.h:359
#define F77_cgbmv(...)
Definition cblas_f77.h:356
#define F77_chbmv(...)
Definition cblas_f77.h:358
#define F77_ctbmv(...)
Definition cblas_f77.h:361
#define UNDEFINED
Definition cblas_test.h:28
void get_diag_type(char *type, CBLAS_DIAG *diag)
Definition auxiliary.c:25
#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