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