LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
c_zblas2.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_zgemv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n,
12 const void *alpha,
13 CBLAS_TEST_ZOMPLEX *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_ZOMPLEX *)malloc( (*m)*LDA*sizeof( CBLAS_TEST_ZOMPLEX) );
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_zgemv( 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_zgemv( UNDEFINED, trans,
38 *m, *n, alpha, a, *lda, x, *incx, beta, y, *incy );
39}
40
41void F77_zgbmv(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_ZOMPLEX* )malloc((*n+*kl)*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
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_zgbmv( 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_zgbmv( CblasColMajor, trans, *m, *n, *kl, *ku, alpha, a, *lda, x,
82 *incx, beta, y, *incy );
83 else
84 cblas_zgbmv( 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_ZOMPLEX*)malloc((*m)*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
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_zgeru( 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_zgeru( CblasColMajor, *m, *n, alpha, x, *incx, y, *incy, a, *lda );
113 else
114 cblas_zgeru( UNDEFINED, *m, *n, alpha, x, *incx, y, *incy, a, *lda );
115}
116
119 CBLAS_TEST_ZOMPLEX *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_ZOMPLEX* )malloc((*m)*LDA*sizeof(CBLAS_TEST_ZOMPLEX ) );
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_zgerc( 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_zgerc( CblasColMajor, *m, *n, alpha, x, *incx, y, *incy, a, *lda );
141 else
142 cblas_zgerc( UNDEFINED, *m, *n, alpha, x, *incx, y, *incy, a, *lda );
143}
144
145void F77_zhemv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *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_ZOMPLEX *)malloc((*n)*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
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_zhemv( 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_zhemv( CblasColMajor, uplo, *n, alpha, a, *lda, x, *incx,
169 beta, y, *incy );
170 else
171 cblas_zhemv( UNDEFINED, uplo, *n, alpha, a, *lda, x, *incx,
172 beta, y, *incy );
173}
174
175void F77_zhbmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_INT *k,
178 CBLAS_TEST_ZOMPLEX *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_zhbmv(CblasRowMajor, UNDEFINED, *n, *k, alpha, a, *lda, x,
190 *incx, beta, y, *incy );
191 else {
192 LDA = *k+2;
193 A =(CBLAS_TEST_ZOMPLEX*)malloc((*n+*k)*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
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_zhbmv( 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_zhbmv(CblasColMajor, uplo, *n, *k, alpha, a, *lda, x, *incx,
233 beta, y, *incy );
234 else
235 cblas_zhbmv(UNDEFINED, uplo, *n, *k, alpha, a, *lda, x, *incx,
236 beta, y, *incy );
237}
238
239void F77_zhpmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *alpha,
242
243 CBLAS_TEST_ZOMPLEX *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_zhpmv(CblasRowMajor, UNDEFINED, *n, alpha, ap, x, *incx,
251 beta, y, *incy);
252 else {
253 LDA = *n;
254 A = (CBLAS_TEST_ZOMPLEX* )malloc(LDA*LDA*sizeof(CBLAS_TEST_ZOMPLEX ));
255 AP = (CBLAS_TEST_ZOMPLEX* )malloc( (((LDA+1)*LDA)/2)*
256 sizeof( CBLAS_TEST_ZOMPLEX ));
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_zhpmv( 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_zhpmv( CblasColMajor, uplo, *n, alpha, ap, x, *incx, beta, y,
289 *incy );
290 else
291 cblas_zhpmv( UNDEFINED, uplo, *n, alpha, ap, x, *incx, beta, y,
292 *incy );
293}
294
295void F77_ztbmv(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_ztbmv(CblasRowMajor, UNDEFINED, trans, diag, *n, *k, a, *lda,
311 x, *incx);
312 else {
313 LDA = *k+2;
314 A=(CBLAS_TEST_ZOMPLEX *)malloc((*n+*k)*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
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_ztbmv(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_ztbmv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
354 else
355 cblas_ztbmv(UNDEFINED, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
356}
357
358void F77_ztbsv(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_ztbsv(CblasRowMajor, UNDEFINED, trans, diag, *n, *k, a, *lda, x,
375 *incx);
376 else {
377 LDA = *k+2;
378 A=(CBLAS_TEST_ZOMPLEX*)malloc((*n+*k)*LDA*sizeof(CBLAS_TEST_ZOMPLEX ));
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_ztbsv(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_ztbsv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
418 else
419 cblas_ztbsv(UNDEFINED, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
420}
421
422void F77_ztpmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
424 CBLAS_TEST_ZOMPLEX *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_ztpmv( CblasRowMajor, UNDEFINED, trans, diag, *n, ap, x, *incx );
437 else {
438 LDA = *n;
439 A=(CBLAS_TEST_ZOMPLEX*)malloc(LDA*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
440 AP=(CBLAS_TEST_ZOMPLEX*)malloc((((LDA+1)*LDA)/2)*
441 sizeof(CBLAS_TEST_ZOMPLEX));
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_ztpmv( 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_ztpmv( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx );
473 else
474 cblas_ztpmv( UNDEFINED, uplo, trans, diag, *n, ap, x, *incx );
475}
476
477void F77_ztpsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
479 CBLAS_TEST_ZOMPLEX *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_ztpsv( CblasRowMajor, UNDEFINED, trans, diag, *n, ap, x, *incx );
492 else {
493 LDA = *n;
494 A=(CBLAS_TEST_ZOMPLEX*)malloc(LDA*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
495 AP=(CBLAS_TEST_ZOMPLEX*)malloc((((LDA+1)*LDA)/2)*
496 sizeof(CBLAS_TEST_ZOMPLEX));
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_ztpsv( 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_ztpsv( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx );
528 else
529 cblas_ztpsv( UNDEFINED, uplo, trans, diag, *n, ap, x, *incx );
530}
531
532void F77_ztrmv(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_ZOMPLEX*)malloc((*n)*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
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_ztrmv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx);
554 free(A);
555 }
556 else if (*layout == TEST_COL_MJR)
557 cblas_ztrmv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx);
558 else
559 cblas_ztrmv(UNDEFINED, uplo, trans, diag, *n, a, *lda, x, *incx);
560}
561void F77_ztrsv(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_ZOMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_ZOMPLEX ) );
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_ztrsv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx );
583 free(A);
584 }
585 else if (*layout == TEST_COL_MJR)
586 cblas_ztrsv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx );
587 else
588 cblas_ztrsv(UNDEFINED, uplo, trans, diag, *n, a, *lda, x, *incx );
589}
590
591void F77_zhpr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha,
593 CBLAS_TEST_ZOMPLEX *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_zhpr(CblasRowMajor, UNDEFINED, *n, *alpha, x, *incx, ap );
602 else {
603 LDA = *n;
604 A = (CBLAS_TEST_ZOMPLEX* )malloc(LDA*LDA*sizeof(CBLAS_TEST_ZOMPLEX ) );
605 AP = ( CBLAS_TEST_ZOMPLEX* )malloc( (((LDA+1)*LDA)/2)*
606 sizeof( CBLAS_TEST_ZOMPLEX ));
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_zhpr(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_zhpr(CblasColMajor, uplo, *n, *alpha, x, *incx, ap );
662 else
663 cblas_zhpr(UNDEFINED, uplo, *n, *alpha, x, *incx, ap );
664}
665
666void F77_zhpr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *alpha,
668 CBLAS_TEST_ZOMPLEX *ap) {
669 CBLAS_TEST_ZOMPLEX *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_zhpr2( CblasRowMajor, UNDEFINED, *n, alpha, x, *incx, y,
678 *incy, ap );
679 else {
680 LDA = *n;
681 A=(CBLAS_TEST_ZOMPLEX*)malloc( LDA*LDA*sizeof(CBLAS_TEST_ZOMPLEX ) );
682 AP=(CBLAS_TEST_ZOMPLEX*)malloc( (((LDA+1)*LDA)/2)*
683 sizeof( CBLAS_TEST_ZOMPLEX ));
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_zhpr2( 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_zhpr2( CblasColMajor, uplo, *n, alpha, x, *incx, y, *incy, ap );
739 else
740 cblas_zhpr2( UNDEFINED, uplo, *n, alpha, x, *incx, y, *incy, ap );
741}
742
743void F77_zher(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *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_ZOMPLEX*)malloc((*n)*LDA*sizeof( CBLAS_TEST_ZOMPLEX ));
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_zher(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_zher( CblasColMajor, uplo, *n, *alpha, x, *incx, a, *lda );
771 else
772 cblas_zher( UNDEFINED, uplo, *n, *alpha, x, *incx, a, *lda );
773}
774
775void F77_zher2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *alpha,
777 CBLAS_TEST_ZOMPLEX *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_ZOMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_ZOMPLEX ) );
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_zher2(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_zher2( CblasColMajor, uplo, *n, alpha, x, *incx, y, *incy, a, *lda);
805 else
806 cblas_zher2( UNDEFINED, uplo, *n, alpha, x, *incx, y, *incy, a, *lda);
807}
void cblas_ztbmv(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_ztbmv.c:10
CBLAS_UPLO
Definition cblas.h:41
@ CblasLower
Definition cblas.h:41
@ CblasUpper
Definition cblas.h:41
void cblas_ztpmv(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_ztpmv.c:10
void cblas_ztpsv(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_ztpsv.c:10
void cblas_zgbmv(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_zgbmv.c:12
CBLAS_TRANSPOSE
Definition cblas.h:40
void cblas_zher(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const CBLAS_INT N, const double alpha, const void *X, const CBLAS_INT incX, void *A, const CBLAS_INT lda)
Definition cblas_zher.c:12
void cblas_ztbsv(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_ztbsv.c:10
void cblas_zgeru(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_zgeru.c:10
void cblas_zhpr2(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_zhpr2.c:12
void cblas_zhpmv(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_zhpmv.c:12
@ CblasColMajor
Definition cblas.h:39
@ CblasRowMajor
Definition cblas.h:39
void cblas_zgemv(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_zgemv.c:12
void cblas_zher2(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_zher2.c:12
CBLAS_DIAG
Definition cblas.h:42
void cblas_zgerc(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_zgerc.c:12
void cblas_ztrsv(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_ztrsv.c:10
#define CBLAS_INT
Definition cblas.h:24
void cblas_ztrmv(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_ztrmv.c:10
void cblas_zhpr(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const CBLAS_INT N, const double alpha, const void *X, const CBLAS_INT incX, void *A)
Definition cblas_zhpr.c:12
void cblas_zhbmv(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_zhbmv.c:12
void cblas_zhemv(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_zhemv.c:12
#define F77_ztbsv(...)
Definition cblas_f77.h:374
#define F77_ztpmv(...)
Definition cblas_f77.h:372
#define F77_ztrsv(...)
Definition cblas_f77.h:373
#define F77_zgbmv(...)
Definition cblas_f77.h:366
#define F77_zgemv(...)
Definition cblas_f77.h:365
#define F77_ztpsv(...)
Definition cblas_f77.h:375
#define F77_zhpmv(...)
Definition cblas_f77.h:369
#define F77_ztbmv(...)
Definition cblas_f77.h:371
#define F77_zgeru(...)
Definition cblas_f77.h:301
#define F77_ztrmv(...)
Definition cblas_f77.h:370
#define F77_zhpr(...)
Definition cblas_f77.h:378
#define F77_zher(...)
Definition cblas_f77.h:376
#define F77_zhpr2(...)
Definition cblas_f77.h:379
#define F77_zhbmv(...)
Definition cblas_f77.h:368
#define F77_zher2(...)
Definition cblas_f77.h:377
#define F77_zhemv(...)
Definition cblas_f77.h:367
#define F77_zgerc(...)
Definition cblas_f77.h:300
#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