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 "common.h"
9 #include "cblas_test.h"
10
F77_cgemv(int * order,char * transp,int * m,int * n,const void * alpha,CBLAS_TEST_COMPLEX * a,int * lda,const void * x,int * incx,const void * beta,void * y,int * incy)11 void F77_cgemv(int *order, char *transp, int *m, int *n,
12 const void *alpha,
13 CBLAS_TEST_COMPLEX *a, int *lda, const void *x, int *incx,
14 const void *beta, void *y, int *incy) {
15
16 CBLAS_TEST_COMPLEX *A;
17 int i,j,LDA;
18 enum CBLAS_TRANSPOSE trans;
19
20 get_transpose_type(transp, &trans);
21 if (*order == 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 (*order == 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
F77_cgbmv(int * order,char * transp,int * m,int * n,int * kl,int * ku,CBLAS_TEST_COMPLEX * alpha,CBLAS_TEST_COMPLEX * a,int * lda,CBLAS_TEST_COMPLEX * x,int * incx,CBLAS_TEST_COMPLEX * beta,CBLAS_TEST_COMPLEX * y,int * incy)41 void F77_cgbmv(int *order, char *transp, int *m, int *n, int *kl, int *ku,
42 CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda,
43 CBLAS_TEST_COMPLEX *x, int *incx,
44 CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, int *incy) {
45
46 CBLAS_TEST_COMPLEX *A;
47 int i,j,irow,jcol,LDA;
48 enum CBLAS_TRANSPOSE trans;
49
50 get_transpose_type(transp, &trans);
51 if (*order == 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 (*order == 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
F77_cgeru(int * order,int * m,int * n,CBLAS_TEST_COMPLEX * alpha,CBLAS_TEST_COMPLEX * x,int * incx,CBLAS_TEST_COMPLEX * y,int * incy,CBLAS_TEST_COMPLEX * a,int * lda)88 void F77_cgeru(int *order, int *m, int *n, CBLAS_TEST_COMPLEX *alpha,
89 CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *y, int *incy,
90 CBLAS_TEST_COMPLEX *a, int *lda){
91
92 CBLAS_TEST_COMPLEX *A;
93 int i,j,LDA;
94
95 if (*order == 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 (*order == 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
F77_cgerc(int * order,int * m,int * n,CBLAS_TEST_COMPLEX * alpha,CBLAS_TEST_COMPLEX * x,int * incx,CBLAS_TEST_COMPLEX * y,int * incy,CBLAS_TEST_COMPLEX * a,int * lda)117 void F77_cgerc(int *order, int *m, int *n, CBLAS_TEST_COMPLEX *alpha,
118 CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *y, int *incy,
119 CBLAS_TEST_COMPLEX *a, int *lda) {
120 CBLAS_TEST_COMPLEX *A;
121 int i,j,LDA;
122
123 if (*order == 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 (*order == 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
F77_chemv(int * order,char * uplow,int * n,CBLAS_TEST_COMPLEX * alpha,CBLAS_TEST_COMPLEX * a,int * lda,CBLAS_TEST_COMPLEX * x,int * incx,CBLAS_TEST_COMPLEX * beta,CBLAS_TEST_COMPLEX * y,int * incy)145 void F77_chemv(int *order, char *uplow, int *n, CBLAS_TEST_COMPLEX *alpha,
146 CBLAS_TEST_COMPLEX *a, int *lda, CBLAS_TEST_COMPLEX *x,
147 int *incx, CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, int *incy){
148
149 CBLAS_TEST_COMPLEX *A;
150 int i,j,LDA;
151 enum CBLAS_UPLO uplo;
152
153 get_uplo_type(uplow,&uplo);
154
155 if (*order == 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 (*order == 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
F77_chbmv(int * order,char * uplow,int * n,int * k,CBLAS_TEST_COMPLEX * alpha,CBLAS_TEST_COMPLEX * a,int * lda,CBLAS_TEST_COMPLEX * x,int * incx,CBLAS_TEST_COMPLEX * beta,CBLAS_TEST_COMPLEX * y,int * incy)175 void F77_chbmv(int *order, char *uplow, int *n, int *k,
176 CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda,
177 CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *beta,
178 CBLAS_TEST_COMPLEX *y, int *incy){
179
180 CBLAS_TEST_COMPLEX *A;
181 int i,irow,j,jcol,LDA;
182
183 enum CBLAS_UPLO uplo;
184
185 get_uplo_type(uplow,&uplo);
186
187 if (*order == 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 (*order == 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
F77_chpmv(int * order,char * uplow,int * n,CBLAS_TEST_COMPLEX * alpha,CBLAS_TEST_COMPLEX * ap,CBLAS_TEST_COMPLEX * x,int * incx,CBLAS_TEST_COMPLEX * beta,CBLAS_TEST_COMPLEX * y,int * incy)239 void F77_chpmv(int *order, char *uplow, int *n, CBLAS_TEST_COMPLEX *alpha,
240 CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, int *incx,
241 CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, int *incy){
242
243 CBLAS_TEST_COMPLEX *A, *AP;
244 int i,j,k,LDA;
245 enum CBLAS_UPLO uplo;
246
247 get_uplo_type(uplow,&uplo);
248 if (*order == 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 (*order == 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
F77_ctbmv(int * order,char * uplow,char * transp,char * diagn,int * n,int * k,CBLAS_TEST_COMPLEX * a,int * lda,CBLAS_TEST_COMPLEX * x,int * incx)295 void F77_ctbmv(int *order, char *uplow, char *transp, char *diagn,
296 int *n, int *k, CBLAS_TEST_COMPLEX *a, int *lda, CBLAS_TEST_COMPLEX *x,
297 int *incx) {
298 CBLAS_TEST_COMPLEX *A;
299 int irow, jcol, i, j, LDA;
300 enum CBLAS_TRANSPOSE trans;
301 enum CBLAS_UPLO uplo;
302 enum 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 (*order == 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 (*order == 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
F77_ctbsv(int * order,char * uplow,char * transp,char * diagn,int * n,int * k,CBLAS_TEST_COMPLEX * a,int * lda,CBLAS_TEST_COMPLEX * x,int * incx)358 void F77_ctbsv(int *order, char *uplow, char *transp, char *diagn,
359 int *n, int *k, CBLAS_TEST_COMPLEX *a, int *lda, CBLAS_TEST_COMPLEX *x,
360 int *incx) {
361
362 CBLAS_TEST_COMPLEX *A;
363 int irow, jcol, i, j, LDA;
364 enum CBLAS_TRANSPOSE trans;
365 enum CBLAS_UPLO uplo;
366 enum 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 (*order == 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 (*order == 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
F77_ctpmv(int * order,char * uplow,char * transp,char * diagn,int * n,CBLAS_TEST_COMPLEX * ap,CBLAS_TEST_COMPLEX * x,int * incx)422 void F77_ctpmv(int *order, char *uplow, char *transp, char *diagn,
423 int *n, CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, int *incx) {
424 CBLAS_TEST_COMPLEX *A, *AP;
425 int i, j, k, LDA;
426 enum CBLAS_TRANSPOSE trans;
427 enum CBLAS_UPLO uplo;
428 enum 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 (*order == 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 (*order == 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
F77_ctpsv(int * order,char * uplow,char * transp,char * diagn,int * n,CBLAS_TEST_COMPLEX * ap,CBLAS_TEST_COMPLEX * x,int * incx)477 void F77_ctpsv(int *order, char *uplow, char *transp, char *diagn,
478 int *n, CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, int *incx) {
479 CBLAS_TEST_COMPLEX *A, *AP;
480 int i, j, k, LDA;
481 enum CBLAS_TRANSPOSE trans;
482 enum CBLAS_UPLO uplo;
483 enum 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 (*order == 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 (*order == 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
F77_ctrmv(int * order,char * uplow,char * transp,char * diagn,int * n,CBLAS_TEST_COMPLEX * a,int * lda,CBLAS_TEST_COMPLEX * x,int * incx)532 void F77_ctrmv(int *order, char *uplow, char *transp, char *diagn,
533 int *n, CBLAS_TEST_COMPLEX *a, int *lda, CBLAS_TEST_COMPLEX *x,
534 int *incx) {
535 CBLAS_TEST_COMPLEX *A;
536 int i,j,LDA;
537 enum CBLAS_TRANSPOSE trans;
538 enum CBLAS_UPLO uplo;
539 enum 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 (*order == 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 (*order == 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 }
F77_ctrsv(int * order,char * uplow,char * transp,char * diagn,int * n,CBLAS_TEST_COMPLEX * a,int * lda,CBLAS_TEST_COMPLEX * x,int * incx)561 void F77_ctrsv(int *order, char *uplow, char *transp, char *diagn,
562 int *n, CBLAS_TEST_COMPLEX *a, int *lda, CBLAS_TEST_COMPLEX *x,
563 int *incx) {
564 CBLAS_TEST_COMPLEX *A;
565 int i,j,LDA;
566 enum CBLAS_TRANSPOSE trans;
567 enum CBLAS_UPLO uplo;
568 enum 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 (*order == 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 (*order == 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
F77_chpr(int * order,char * uplow,int * n,float * alpha,CBLAS_TEST_COMPLEX * x,int * incx,CBLAS_TEST_COMPLEX * ap)591 void F77_chpr(int *order, char *uplow, int *n, float *alpha,
592 CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *ap) {
593 CBLAS_TEST_COMPLEX *A, *AP;
594 int i,j,k,LDA;
595 enum CBLAS_UPLO uplo;
596
597 get_uplo_type(uplow,&uplo);
598
599 if (*order == 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 (*order == 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
F77_chpr2(int * order,char * uplow,int * n,CBLAS_TEST_COMPLEX * alpha,CBLAS_TEST_COMPLEX * x,int * incx,CBLAS_TEST_COMPLEX * y,int * incy,CBLAS_TEST_COMPLEX * ap)666 void F77_chpr2(int *order, char *uplow, int *n, CBLAS_TEST_COMPLEX *alpha,
667 CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *y, int *incy,
668 CBLAS_TEST_COMPLEX *ap) {
669 CBLAS_TEST_COMPLEX *A, *AP;
670 int i,j,k,LDA;
671 enum CBLAS_UPLO uplo;
672
673 get_uplo_type(uplow,&uplo);
674
675 if (*order == 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 (*order == 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
F77_cher(int * order,char * uplow,int * n,float * alpha,CBLAS_TEST_COMPLEX * x,int * incx,CBLAS_TEST_COMPLEX * a,int * lda)743 void F77_cher(int *order, char *uplow, int *n, float *alpha,
744 CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *a, int *lda) {
745 CBLAS_TEST_COMPLEX *A;
746 int i,j,LDA;
747 enum CBLAS_UPLO uplo;
748
749 get_uplo_type(uplow,&uplo);
750
751 if (*order == 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 (*order == 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
F77_cher2(int * order,char * uplow,int * n,CBLAS_TEST_COMPLEX * alpha,CBLAS_TEST_COMPLEX * x,int * incx,CBLAS_TEST_COMPLEX * y,int * incy,CBLAS_TEST_COMPLEX * a,int * lda)775 void F77_cher2(int *order, char *uplow, int *n, CBLAS_TEST_COMPLEX *alpha,
776 CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *y, int *incy,
777 CBLAS_TEST_COMPLEX *a, int *lda) {
778
779 CBLAS_TEST_COMPLEX *A;
780 int i,j,LDA;
781 enum CBLAS_UPLO uplo;
782
783 get_uplo_type(uplow,&uplo);
784
785 if (*order == 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 (*order == 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 }
808