LAPACK  3.11.0
LAPACK: Linear Algebra PACKage
c_cblas2.c
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 
11 void 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 
16  CBLAS_TEST_COMPLEX *A;
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)
34  cblas_cgemv( CblasColMajor, trans,
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 
41 void F77_cgbmv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, CBLAS_INT *kl, CBLAS_INT *ku,
42  CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda,
43  CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx,
44  CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy) {
45 
46  CBLAS_TEST_COMPLEX *A;
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 
88 void F77_cgeru(CBLAS_INT *layout, CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha,
89  CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy,
90  CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda){
91 
92  CBLAS_TEST_COMPLEX *A;
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 
117 void F77_cgerc(CBLAS_INT *layout, CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha,
118  CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy,
119  CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda) {
120  CBLAS_TEST_COMPLEX *A;
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 
145 void F77_chemv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha,
146  CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *x,
147  CBLAS_INT *incx, CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy){
148 
149  CBLAS_TEST_COMPLEX *A;
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 
175 void F77_chbmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_INT *k,
176  CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda,
177  CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *beta,
178  CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy){
179 
180 CBLAS_TEST_COMPLEX *A;
181 CBLAS_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 
239 void F77_chpmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha,
240  CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx,
241  CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy){
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 
295 void F77_ctbmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
296  CBLAS_INT *n, CBLAS_INT *k, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *x,
297  CBLAS_INT *incx) {
298  CBLAS_TEST_COMPLEX *A;
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 
358 void F77_ctbsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
359  CBLAS_INT *n, CBLAS_INT *k, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *x,
360  CBLAS_INT *incx) {
361 
362  CBLAS_TEST_COMPLEX *A;
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 
422 void F77_ctpmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
423  CBLAS_INT *n, CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx) {
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 
477 void F77_ctpsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
478  CBLAS_INT *n, CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx) {
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 
532 void F77_ctrmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
533  CBLAS_INT *n, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *x,
534  CBLAS_INT *incx) {
535  CBLAS_TEST_COMPLEX *A;
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 }
561 void F77_ctrsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
562  CBLAS_INT *n, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *x,
563  CBLAS_INT *incx) {
564  CBLAS_TEST_COMPLEX *A;
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 
591 void F77_chpr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha,
592  CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *ap) {
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 
666 void F77_chpr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha,
667  CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy,
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 
743 void F77_cher(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha,
744  CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda) {
745  CBLAS_TEST_COMPLEX *A;
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 
775 void F77_cher2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha,
776  CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy,
777  CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda) {
778 
779  CBLAS_TEST_COMPLEX *A;
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 }
CBLAS_TEST_COMPLEX::imag
float imag
Definition: cblas_test.h:21
CBLAS_TEST_COMPLEX
Definition: cblas_test.h:21
CBLAS_TEST_COMPLEX::real
float real
Definition: cblas_test.h:21