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
F77_zgemv(int * order,char * transp,int * m,int * n,const void * alpha,CBLAS_TEST_ZOMPLEX * a,int * lda,const void * x,int * incx,const void * beta,void * y,int * incy)11 void F77_zgemv(int *order, char *transp, int *m, int *n,
12 const void *alpha,
13 CBLAS_TEST_ZOMPLEX *a, int *lda, const void *x, int *incx,
14 const void *beta, void *y, int *incy) {
15
16 CBLAS_TEST_ZOMPLEX *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_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 (*order == TEST_COL_MJR)
34 cblas_zgemv( CblasColMajor, trans,
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
F77_zgbmv(int * order,char * transp,int * m,int * n,int * kl,int * ku,CBLAS_TEST_ZOMPLEX * alpha,CBLAS_TEST_ZOMPLEX * a,int * lda,CBLAS_TEST_ZOMPLEX * x,int * incx,CBLAS_TEST_ZOMPLEX * beta,CBLAS_TEST_ZOMPLEX * y,int * incy)41 void F77_zgbmv(int *order, char *transp, int *m, int *n, int *kl, int *ku,
42 CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, int *lda,
43 CBLAS_TEST_ZOMPLEX *x, int *incx,
44 CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *y, int *incy) {
45
46 CBLAS_TEST_ZOMPLEX *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_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 (*order == 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
F77_zgeru(int * order,int * m,int * n,CBLAS_TEST_ZOMPLEX * alpha,CBLAS_TEST_ZOMPLEX * x,int * incx,CBLAS_TEST_ZOMPLEX * y,int * incy,CBLAS_TEST_ZOMPLEX * a,int * lda)88 void F77_zgeru(int *order, int *m, int *n, CBLAS_TEST_ZOMPLEX *alpha,
89 CBLAS_TEST_ZOMPLEX *x, int *incx, CBLAS_TEST_ZOMPLEX *y, int *incy,
90 CBLAS_TEST_ZOMPLEX *a, int *lda){
91
92 CBLAS_TEST_ZOMPLEX *A;
93 int i,j,LDA;
94
95 if (*order == 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 (*order == 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
F77_zgerc(int * order,int * m,int * n,CBLAS_TEST_ZOMPLEX * alpha,CBLAS_TEST_ZOMPLEX * x,int * incx,CBLAS_TEST_ZOMPLEX * y,int * incy,CBLAS_TEST_ZOMPLEX * a,int * lda)117 void F77_zgerc(int *order, int *m, int *n, CBLAS_TEST_ZOMPLEX *alpha,
118 CBLAS_TEST_ZOMPLEX *x, int *incx, CBLAS_TEST_ZOMPLEX *y, int *incy,
119 CBLAS_TEST_ZOMPLEX *a, int *lda) {
120 CBLAS_TEST_ZOMPLEX *A;
121 int i,j,LDA;
122
123 if (*order == 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 (*order == 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
F77_zhemv(int * order,char * uplow,int * n,CBLAS_TEST_ZOMPLEX * alpha,CBLAS_TEST_ZOMPLEX * a,int * lda,CBLAS_TEST_ZOMPLEX * x,int * incx,CBLAS_TEST_ZOMPLEX * beta,CBLAS_TEST_ZOMPLEX * y,int * incy)145 void F77_zhemv(int *order, char *uplow, int *n, CBLAS_TEST_ZOMPLEX *alpha,
146 CBLAS_TEST_ZOMPLEX *a, int *lda, CBLAS_TEST_ZOMPLEX *x,
147 int *incx, CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *y, int *incy){
148
149 CBLAS_TEST_ZOMPLEX *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_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 (*order == 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
F77_zhbmv(int * order,char * uplow,int * n,int * k,CBLAS_TEST_ZOMPLEX * alpha,CBLAS_TEST_ZOMPLEX * a,int * lda,CBLAS_TEST_ZOMPLEX * x,int * incx,CBLAS_TEST_ZOMPLEX * beta,CBLAS_TEST_ZOMPLEX * y,int * incy)175 void F77_zhbmv(int *order, char *uplow, int *n, int *k,
176 CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, int *lda,
177 CBLAS_TEST_ZOMPLEX *x, int *incx, CBLAS_TEST_ZOMPLEX *beta,
178 CBLAS_TEST_ZOMPLEX *y, int *incy){
179
180 CBLAS_TEST_ZOMPLEX *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_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 (*order == 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
F77_zhpmv(int * order,char * uplow,int * n,CBLAS_TEST_ZOMPLEX * alpha,CBLAS_TEST_ZOMPLEX * ap,CBLAS_TEST_ZOMPLEX * x,int * incx,CBLAS_TEST_ZOMPLEX * beta,CBLAS_TEST_ZOMPLEX * y,int * incy)239 void F77_zhpmv(int *order, char *uplow, int *n, CBLAS_TEST_ZOMPLEX *alpha,
240 CBLAS_TEST_ZOMPLEX *ap, CBLAS_TEST_ZOMPLEX *x, int *incx,
241 CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *y, int *incy){
242
243 CBLAS_TEST_ZOMPLEX *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_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 (*order == 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
F77_ztbmv(int * order,char * uplow,char * transp,char * diagn,int * n,int * k,CBLAS_TEST_ZOMPLEX * a,int * lda,CBLAS_TEST_ZOMPLEX * x,int * incx)295 void F77_ztbmv(int *order, char *uplow, char *transp, char *diagn,
296 int *n, int *k, CBLAS_TEST_ZOMPLEX *a, int *lda, CBLAS_TEST_ZOMPLEX *x,
297 int *incx) {
298 CBLAS_TEST_ZOMPLEX *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_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 (*order == 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
F77_ztbsv(int * order,char * uplow,char * transp,char * diagn,int * n,int * k,CBLAS_TEST_ZOMPLEX * a,int * lda,CBLAS_TEST_ZOMPLEX * x,int * incx)358 void F77_ztbsv(int *order, char *uplow, char *transp, char *diagn,
359 int *n, int *k, CBLAS_TEST_ZOMPLEX *a, int *lda, CBLAS_TEST_ZOMPLEX *x,
360 int *incx) {
361
362 CBLAS_TEST_ZOMPLEX *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_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 (*order == 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
F77_ztpmv(int * order,char * uplow,char * transp,char * diagn,int * n,CBLAS_TEST_ZOMPLEX * ap,CBLAS_TEST_ZOMPLEX * x,int * incx)422 void F77_ztpmv(int *order, char *uplow, char *transp, char *diagn,
423 int *n, CBLAS_TEST_ZOMPLEX *ap, CBLAS_TEST_ZOMPLEX *x, int *incx) {
424 CBLAS_TEST_ZOMPLEX *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_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 (*order == 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
F77_ztpsv(int * order,char * uplow,char * transp,char * diagn,int * n,CBLAS_TEST_ZOMPLEX * ap,CBLAS_TEST_ZOMPLEX * x,int * incx)477 void F77_ztpsv(int *order, char *uplow, char *transp, char *diagn,
478 int *n, CBLAS_TEST_ZOMPLEX *ap, CBLAS_TEST_ZOMPLEX *x, int *incx) {
479 CBLAS_TEST_ZOMPLEX *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_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 (*order == 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
F77_ztrmv(int * order,char * uplow,char * transp,char * diagn,int * n,CBLAS_TEST_ZOMPLEX * a,int * lda,CBLAS_TEST_ZOMPLEX * x,int * incx)532 void F77_ztrmv(int *order, char *uplow, char *transp, char *diagn,
533 int *n, CBLAS_TEST_ZOMPLEX *a, int *lda, CBLAS_TEST_ZOMPLEX *x,
534 int *incx) {
535 CBLAS_TEST_ZOMPLEX *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_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 (*order == 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 }
F77_ztrsv(int * order,char * uplow,char * transp,char * diagn,int * n,CBLAS_TEST_ZOMPLEX * a,int * lda,CBLAS_TEST_ZOMPLEX * x,int * incx)561 void F77_ztrsv(int *order, char *uplow, char *transp, char *diagn,
562 int *n, CBLAS_TEST_ZOMPLEX *a, int *lda, CBLAS_TEST_ZOMPLEX *x,
563 int *incx) {
564 CBLAS_TEST_ZOMPLEX *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_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 (*order == 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
F77_zhpr(int * order,char * uplow,int * n,double * alpha,CBLAS_TEST_ZOMPLEX * x,int * incx,CBLAS_TEST_ZOMPLEX * ap)591 void F77_zhpr(int *order, char *uplow, int *n, double *alpha,
592 CBLAS_TEST_ZOMPLEX *x, int *incx, CBLAS_TEST_ZOMPLEX *ap) {
593 CBLAS_TEST_ZOMPLEX *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_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 (*order == 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
F77_zhpr2(int * order,char * uplow,int * n,CBLAS_TEST_ZOMPLEX * alpha,CBLAS_TEST_ZOMPLEX * x,int * incx,CBLAS_TEST_ZOMPLEX * y,int * incy,CBLAS_TEST_ZOMPLEX * ap)666 void F77_zhpr2(int *order, char *uplow, int *n, CBLAS_TEST_ZOMPLEX *alpha,
667 CBLAS_TEST_ZOMPLEX *x, int *incx, CBLAS_TEST_ZOMPLEX *y, int *incy,
668 CBLAS_TEST_ZOMPLEX *ap) {
669 CBLAS_TEST_ZOMPLEX *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_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 (*order == 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
F77_zher(int * order,char * uplow,int * n,double * alpha,CBLAS_TEST_ZOMPLEX * x,int * incx,CBLAS_TEST_ZOMPLEX * a,int * lda)743 void F77_zher(int *order, char *uplow, int *n, double *alpha,
744 CBLAS_TEST_ZOMPLEX *x, int *incx, CBLAS_TEST_ZOMPLEX *a, int *lda) {
745 CBLAS_TEST_ZOMPLEX *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_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 (*order == 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
F77_zher2(int * order,char * uplow,int * n,CBLAS_TEST_ZOMPLEX * alpha,CBLAS_TEST_ZOMPLEX * x,int * incx,CBLAS_TEST_ZOMPLEX * y,int * incy,CBLAS_TEST_ZOMPLEX * a,int * lda)775 void F77_zher2(int *order, char *uplow, int *n, CBLAS_TEST_ZOMPLEX *alpha,
776 CBLAS_TEST_ZOMPLEX *x, int *incx, CBLAS_TEST_ZOMPLEX *y, int *incy,
777 CBLAS_TEST_ZOMPLEX *a, int *lda) {
778
779 CBLAS_TEST_ZOMPLEX *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_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 (*order == 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 }
808