LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros Modules Pages
c_dblas2.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, 1/23/98, SGI/CRAY Research.
6 */
7#include <stdlib.h>
8#include "cblas.h"
9#include "cblas_test.h"
10
11void F77_dgemv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, double *alpha,
12 double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx, double *beta,
13 double *y, CBLAS_INT *incy
15 , FORTRAN_STRLEN transp_len
16#endif
17) {
18
19 double *A;
20 CBLAS_INT i,j,LDA;
21 CBLAS_TRANSPOSE trans;
22
23 get_transpose_type(transp, &trans);
24 if (*layout == TEST_ROW_MJR) {
25 LDA = *n+1;
26 A = ( double* )malloc( (*m)*LDA*sizeof( double ) );
27 for( i=0; i<*m; i++ )
28 for( j=0; j<*n; j++ )
29 A[ LDA*i+j ]=a[ (*lda)*j+i ];
31 *m, *n, *alpha, A, LDA, x, *incx, *beta, y, *incy );
32 free(A);
33 }
34 else if (*layout == TEST_COL_MJR)
36 *m, *n, *alpha, a, *lda, x, *incx, *beta, y, *incy );
37 else
38 cblas_dgemv( UNDEFINED, trans,
39 *m, *n, *alpha, a, *lda, x, *incx, *beta, y, *incy );
40}
41
42void F77_dger(CBLAS_INT *layout, CBLAS_INT *m, CBLAS_INT *n, double *alpha, double *x, CBLAS_INT *incx,
43 double *y, CBLAS_INT *incy, double *a, CBLAS_INT *lda ) {
44
45 double *A;
46 CBLAS_INT i,j,LDA;
47
48 if (*layout == TEST_ROW_MJR) {
49 LDA = *n+1;
50 A = ( double* )malloc( (*m)*LDA*sizeof( double ) );
51
52 for( i=0; i<*m; i++ ) {
53 for( j=0; j<*n; j++ )
54 A[ LDA*i+j ]=a[ (*lda)*j+i ];
55 }
56
57 cblas_dger(CblasRowMajor, *m, *n, *alpha, x, *incx, y, *incy, A, LDA );
58 for( i=0; i<*m; i++ )
59 for( j=0; j<*n; j++ )
60 a[ (*lda)*j+i ]=A[ LDA*i+j ];
61 free(A);
62 }
63 else
64 cblas_dger( CblasColMajor, *m, *n, *alpha, x, *incx, y, *incy, a, *lda );
65}
66
67void F77_dtrmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
68 CBLAS_INT *n, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx
70 , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
71#endif
72) {
73 double *A;
74 CBLAS_INT i,j,LDA;
75 CBLAS_TRANSPOSE trans;
76 CBLAS_UPLO uplo;
77 CBLAS_DIAG diag;
78
79 get_transpose_type(transp,&trans);
80 get_uplo_type(uplow,&uplo);
81 get_diag_type(diagn,&diag);
82
83 if (*layout == TEST_ROW_MJR) {
84 LDA = *n+1;
85 A = ( double* )malloc( (*n)*LDA*sizeof( double ) );
86 for( i=0; i<*n; i++ )
87 for( j=0; j<*n; j++ )
88 A[ LDA*i+j ]=a[ (*lda)*j+i ];
89 cblas_dtrmv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx);
90 free(A);
91 }
92 else if (*layout == TEST_COL_MJR)
93 cblas_dtrmv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx);
94 else {
95 cblas_dtrmv(UNDEFINED, uplo, trans, diag, *n, a, *lda, x, *incx);
96 }
97}
98
99void F77_dtrsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
100 CBLAS_INT *n, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx
102 , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
103#endif
104) {
105 double *A;
106 CBLAS_INT i,j,LDA;
107 CBLAS_TRANSPOSE trans;
108 CBLAS_UPLO uplo;
109 CBLAS_DIAG diag;
110
111 get_transpose_type(transp,&trans);
112 get_uplo_type(uplow,&uplo);
113 get_diag_type(diagn,&diag);
114
115 if (*layout == TEST_ROW_MJR) {
116 LDA = *n+1;
117 A = ( double* )malloc( (*n)*LDA*sizeof( double ) );
118 for( i=0; i<*n; i++ )
119 for( j=0; j<*n; j++ )
120 A[ LDA*i+j ]=a[ (*lda)*j+i ];
121 cblas_dtrsv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx );
122 free(A);
123 }
124 else
125 cblas_dtrsv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx );
126}
127void F77_dsymv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, double *a,
128 CBLAS_INT *lda, double *x, CBLAS_INT *incx, double *beta, double *y,
129 CBLAS_INT *incy
131 , FORTRAN_STRLEN uplow_len
132#endif
133) {
134 double *A;
135 CBLAS_INT i,j,LDA;
136 CBLAS_UPLO uplo;
137
138 get_uplo_type(uplow,&uplo);
139
140 if (*layout == TEST_ROW_MJR) {
141 LDA = *n+1;
142 A = ( double* )malloc( (*n)*LDA*sizeof( double ) );
143 for( i=0; i<*n; i++ )
144 for( j=0; j<*n; j++ )
145 A[ LDA*i+j ]=a[ (*lda)*j+i ];
146 cblas_dsymv(CblasRowMajor, uplo, *n, *alpha, A, LDA, x, *incx,
147 *beta, y, *incy );
148 free(A);
149 }
150 else
151 cblas_dsymv(CblasColMajor, uplo, *n, *alpha, a, *lda, x, *incx,
152 *beta, y, *incy );
153}
154
155void F77_dsyr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, double *x,
156 CBLAS_INT *incx, double *a, CBLAS_INT *lda
158 , FORTRAN_STRLEN uplow_len
159#endif
160) {
161 double *A;
162 CBLAS_INT i,j,LDA;
163 CBLAS_UPLO uplo;
164
165 get_uplo_type(uplow,&uplo);
166
167 if (*layout == TEST_ROW_MJR) {
168 LDA = *n+1;
169 A = ( double* )malloc( (*n)*LDA*sizeof( double ) );
170 for( i=0; i<*n; i++ )
171 for( j=0; j<*n; j++ )
172 A[ LDA*i+j ]=a[ (*lda)*j+i ];
173 cblas_dsyr(CblasRowMajor, uplo, *n, *alpha, x, *incx, A, LDA);
174 for( i=0; i<*n; i++ )
175 for( j=0; j<*n; j++ )
176 a[ (*lda)*j+i ]=A[ LDA*i+j ];
177 free(A);
178 }
179 else
180 cblas_dsyr(CblasColMajor, uplo, *n, *alpha, x, *incx, a, *lda);
181}
182
183void F77_dsyr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, double *x,
184 CBLAS_INT *incx, double *y, CBLAS_INT *incy, double *a, CBLAS_INT *lda
186 , FORTRAN_STRLEN uplow_len
187#endif
188) {
189 double *A;
190 CBLAS_INT i,j,LDA;
191 CBLAS_UPLO uplo;
192
193 get_uplo_type(uplow,&uplo);
194
195 if (*layout == TEST_ROW_MJR) {
196 LDA = *n+1;
197 A = ( double* )malloc( (*n)*LDA*sizeof( double ) );
198 for( i=0; i<*n; i++ )
199 for( j=0; j<*n; j++ )
200 A[ LDA*i+j ]=a[ (*lda)*j+i ];
201 cblas_dsyr2(CblasRowMajor, uplo, *n, *alpha, x, *incx, y, *incy, A, LDA);
202 for( i=0; i<*n; i++ )
203 for( j=0; j<*n; j++ )
204 a[ (*lda)*j+i ]=A[ LDA*i+j ];
205 free(A);
206 }
207 else
208 cblas_dsyr2(CblasColMajor, uplo, *n, *alpha, x, *incx, y, *incy, a, *lda);
209}
210
211void F77_dgbmv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, CBLAS_INT *kl, CBLAS_INT *ku,
212 double *alpha, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx,
213 double *beta, double *y, CBLAS_INT *incy
215 , FORTRAN_STRLEN transp_len
216#endif
217) {
218
219 double *A;
220 CBLAS_INT i,irow,j,jcol,LDA;
221 CBLAS_TRANSPOSE trans;
222
223 get_transpose_type(transp, &trans);
224
225 if (*layout == TEST_ROW_MJR) {
226 LDA = *ku+*kl+2;
227 A = ( double* )malloc( (*n+*kl)*LDA*sizeof( double ) );
228 for( i=0; i<*ku; i++ ){
229 irow=*ku+*kl-i;
230 jcol=(*ku)-i;
231 for( j=jcol; j<*n; j++ )
232 A[ LDA*(j-jcol)+irow ]=a[ (*lda)*j+i ];
233 }
234 i=*ku;
235 irow=*ku+*kl-i;
236 for( j=0; j<*n; j++ )
237 A[ LDA*j+irow ]=a[ (*lda)*j+i ];
238 for( i=*ku+1; i<*ku+*kl+1; i++ ){
239 irow=*ku+*kl-i;
240 jcol=i-(*ku);
241 for( j=jcol; j<(*n+*kl); j++ )
242 A[ LDA*j+irow ]=a[ (*lda)*(j-jcol)+i ];
243 }
244 cblas_dgbmv( CblasRowMajor, trans, *m, *n, *kl, *ku, *alpha,
245 A, LDA, x, *incx, *beta, y, *incy );
246 free(A);
247 }
248 else
249 cblas_dgbmv( CblasColMajor, trans, *m, *n, *kl, *ku, *alpha,
250 a, *lda, x, *incx, *beta, y, *incy );
251}
252
253void F77_dtbmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
254 CBLAS_INT *n, CBLAS_INT *k, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx
256 , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
257#endif
258) {
259 double *A;
260 CBLAS_INT irow, jcol, i, j, LDA;
261 CBLAS_TRANSPOSE trans;
262 CBLAS_UPLO uplo;
263 CBLAS_DIAG diag;
264
265 get_transpose_type(transp,&trans);
266 get_uplo_type(uplow,&uplo);
267 get_diag_type(diagn,&diag);
268
269 if (*layout == TEST_ROW_MJR) {
270 LDA = *k+1;
271 A = ( double* )malloc( (*n+*k)*LDA*sizeof( double ) );
272 if (uplo == CblasUpper) {
273 for( i=0; i<*k; i++ ){
274 irow=*k-i;
275 jcol=(*k)-i;
276 for( j=jcol; j<*n; j++ )
277 A[ LDA*(j-jcol)+irow ]=a[ (*lda)*j+i ];
278 }
279 i=*k;
280 irow=*k-i;
281 for( j=0; j<*n; j++ )
282 A[ LDA*j+irow ]=a[ (*lda)*j+i ];
283 }
284 else {
285 i=0;
286 irow=*k-i;
287 for( j=0; j<*n; j++ )
288 A[ LDA*j+irow ]=a[ (*lda)*j+i ];
289 for( i=1; i<*k+1; i++ ){
290 irow=*k-i;
291 jcol=i;
292 for( j=jcol; j<(*n+*k); j++ )
293 A[ LDA*j+irow ]=a[ (*lda)*(j-jcol)+i ];
294 }
295 }
296 cblas_dtbmv(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, x, *incx);
297 free(A);
298 }
299 else
300 cblas_dtbmv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
301}
302
303void F77_dtbsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
304 CBLAS_INT *n, CBLAS_INT *k, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx
306 , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
307#endif
308) {
309 double *A;
310 CBLAS_INT irow, jcol, i, j, LDA;
311 CBLAS_TRANSPOSE trans;
312 CBLAS_UPLO uplo;
313 CBLAS_DIAG diag;
314
315 get_transpose_type(transp,&trans);
316 get_uplo_type(uplow,&uplo);
317 get_diag_type(diagn,&diag);
318
319 if (*layout == TEST_ROW_MJR) {
320 LDA = *k+1;
321 A = ( double* )malloc( (*n+*k)*LDA*sizeof( double ) );
322 if (uplo == CblasUpper) {
323 for( i=0; i<*k; i++ ){
324 irow=*k-i;
325 jcol=(*k)-i;
326 for( j=jcol; j<*n; j++ )
327 A[ LDA*(j-jcol)+irow ]=a[ (*lda)*j+i ];
328 }
329 i=*k;
330 irow=*k-i;
331 for( j=0; j<*n; j++ )
332 A[ LDA*j+irow ]=a[ (*lda)*j+i ];
333 }
334 else {
335 i=0;
336 irow=*k-i;
337 for( j=0; j<*n; j++ )
338 A[ LDA*j+irow ]=a[ (*lda)*j+i ];
339 for( i=1; i<*k+1; i++ ){
340 irow=*k-i;
341 jcol=i;
342 for( j=jcol; j<(*n+*k); j++ )
343 A[ LDA*j+irow ]=a[ (*lda)*(j-jcol)+i ];
344 }
345 }
346 cblas_dtbsv(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, x, *incx);
347 free(A);
348 }
349 else
350 cblas_dtbsv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
351}
352
353void F77_dsbmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_INT *k, double *alpha,
354 double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx, double *beta,
355 double *y, CBLAS_INT *incy
357 , FORTRAN_STRLEN uplow_len
358#endif
359) {
360 double *A;
361 CBLAS_INT i,j,irow,jcol,LDA;
362 CBLAS_UPLO uplo;
363
364 get_uplo_type(uplow,&uplo);
365
366 if (*layout == TEST_ROW_MJR) {
367 LDA = *k+1;
368 A = ( double* )malloc( (*n+*k)*LDA*sizeof( double ) );
369 if (uplo == CblasUpper) {
370 for( i=0; i<*k; i++ ){
371 irow=*k-i;
372 jcol=(*k)-i;
373 for( j=jcol; j<*n; j++ )
374 A[ LDA*(j-jcol)+irow ]=a[ (*lda)*j+i ];
375 }
376 i=*k;
377 irow=*k-i;
378 for( j=0; j<*n; j++ )
379 A[ LDA*j+irow ]=a[ (*lda)*j+i ];
380 }
381 else {
382 i=0;
383 irow=*k-i;
384 for( j=0; j<*n; j++ )
385 A[ LDA*j+irow ]=a[ (*lda)*j+i ];
386 for( i=1; i<*k+1; i++ ){
387 irow=*k-i;
388 jcol=i;
389 for( j=jcol; j<(*n+*k); j++ )
390 A[ LDA*j+irow ]=a[ (*lda)*(j-jcol)+i ];
391 }
392 }
393 cblas_dsbmv(CblasRowMajor, uplo, *n, *k, *alpha, A, LDA, x, *incx,
394 *beta, y, *incy );
395 free(A);
396 }
397 else
398 cblas_dsbmv(CblasColMajor, uplo, *n, *k, *alpha, a, *lda, x, *incx,
399 *beta, y, *incy );
400}
401
402void F77_dspmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, double *ap,
403 double *x, CBLAS_INT *incx, double *beta, double *y, CBLAS_INT *incy
405 , FORTRAN_STRLEN uplow_len
406#endif
407) {
408 double *A,*AP;
409 CBLAS_INT i,j,k,LDA;
410 CBLAS_UPLO uplo;
411
412 get_uplo_type(uplow,&uplo);
413
414 if (*layout == TEST_ROW_MJR) {
415 LDA = *n;
416 A = ( double* )malloc( LDA*LDA*sizeof( double ) );
417 AP = ( double* )malloc( (((LDA+1)*LDA)/2)*sizeof( double ) );
418 if (uplo == CblasUpper) {
419 for( j=0, k=0; j<*n; j++ )
420 for( i=0; i<j+1; i++, k++ )
421 A[ LDA*i+j ]=ap[ k ];
422 for( i=0, k=0; i<*n; i++ )
423 for( j=i; j<*n; j++, k++ )
424 AP[ k ]=A[ LDA*i+j ];
425 }
426 else {
427 for( j=0, k=0; j<*n; j++ )
428 for( i=j; i<*n; i++, k++ )
429 A[ LDA*i+j ]=ap[ k ];
430 for( i=0, k=0; i<*n; i++ )
431 for( j=0; j<i+1; j++, k++ )
432 AP[ k ]=A[ LDA*i+j ];
433 }
434 cblas_dspmv( CblasRowMajor, uplo, *n, *alpha, AP, x, *incx, *beta, y,
435 *incy );
436 free(A);
437 free(AP);
438 }
439 else
440 cblas_dspmv( CblasColMajor, uplo, *n, *alpha, ap, x, *incx, *beta, y,
441 *incy );
442}
443
444void F77_dtpmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
445 CBLAS_INT *n, double *ap, double *x, CBLAS_INT *incx
447 , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
448#endif
449) {
450 double *A, *AP;
451 CBLAS_INT i, j, k, LDA;
452 CBLAS_TRANSPOSE trans;
453 CBLAS_UPLO uplo;
454 CBLAS_DIAG diag;
455
456 get_transpose_type(transp,&trans);
457 get_uplo_type(uplow,&uplo);
458 get_diag_type(diagn,&diag);
459
460 if (*layout == TEST_ROW_MJR) {
461 LDA = *n;
462 A = ( double* )malloc( LDA*LDA*sizeof( double ) );
463 AP = ( double* )malloc( (((LDA+1)*LDA)/2)*sizeof( double ) );
464 if (uplo == CblasUpper) {
465 for( j=0, k=0; j<*n; j++ )
466 for( i=0; i<j+1; i++, k++ )
467 A[ LDA*i+j ]=ap[ k ];
468 for( i=0, k=0; i<*n; i++ )
469 for( j=i; j<*n; j++, k++ )
470 AP[ k ]=A[ LDA*i+j ];
471 }
472 else {
473 for( j=0, k=0; j<*n; j++ )
474 for( i=j; i<*n; i++, k++ )
475 A[ LDA*i+j ]=ap[ k ];
476 for( i=0, k=0; i<*n; i++ )
477 for( j=0; j<i+1; j++, k++ )
478 AP[ k ]=A[ LDA*i+j ];
479 }
480 cblas_dtpmv( CblasRowMajor, uplo, trans, diag, *n, AP, x, *incx );
481 free(A);
482 free(AP);
483 }
484 else
485 cblas_dtpmv( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx );
486}
487
488void F77_dtpsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn,
489 CBLAS_INT *n, double *ap, double *x, CBLAS_INT *incx
491 , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
492#endif
493) {
494 double *A, *AP;
495 CBLAS_INT i, j, k, LDA;
496 CBLAS_TRANSPOSE trans;
497 CBLAS_UPLO uplo;
498 CBLAS_DIAG diag;
499
500 get_transpose_type(transp,&trans);
501 get_uplo_type(uplow,&uplo);
502 get_diag_type(diagn,&diag);
503
504 if (*layout == TEST_ROW_MJR) {
505 LDA = *n;
506 A = ( double* )malloc( LDA*LDA*sizeof( double ) );
507 AP = ( double* )malloc( (((LDA+1)*LDA)/2)*sizeof( double ) );
508 if (uplo == CblasUpper) {
509 for( j=0, k=0; j<*n; j++ )
510 for( i=0; i<j+1; i++, k++ )
511 A[ LDA*i+j ]=ap[ k ];
512 for( i=0, k=0; i<*n; i++ )
513 for( j=i; j<*n; j++, k++ )
514 AP[ k ]=A[ LDA*i+j ];
515
516 }
517 else {
518 for( j=0, k=0; j<*n; j++ )
519 for( i=j; i<*n; i++, k++ )
520 A[ LDA*i+j ]=ap[ k ];
521 for( i=0, k=0; i<*n; i++ )
522 for( j=0; j<i+1; j++, k++ )
523 AP[ k ]=A[ LDA*i+j ];
524 }
525 cblas_dtpsv( CblasRowMajor, uplo, trans, diag, *n, AP, x, *incx );
526 free(A);
527 free(AP);
528 }
529 else
530 cblas_dtpsv( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx );
531}
532
533void F77_dspr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, double *x,
534 CBLAS_INT *incx, double *ap
536 , FORTRAN_STRLEN uplow_len
537#endif
538){
539 double *A, *AP;
540 CBLAS_INT i,j,k,LDA;
541 CBLAS_UPLO uplo;
542
543 get_uplo_type(uplow,&uplo);
544
545 if (*layout == TEST_ROW_MJR) {
546 LDA = *n;
547 A = ( double* )malloc( LDA*LDA*sizeof( double ) );
548 AP = ( double* )malloc( (((LDA+1)*LDA)/2)*sizeof( double ) );
549 if (uplo == CblasUpper) {
550 for( j=0, k=0; j<*n; j++ )
551 for( i=0; i<j+1; i++, k++ )
552 A[ LDA*i+j ]=ap[ k ];
553 for( i=0, k=0; i<*n; i++ )
554 for( j=i; j<*n; j++, k++ )
555 AP[ k ]=A[ LDA*i+j ];
556 }
557 else {
558 for( j=0, k=0; j<*n; j++ )
559 for( i=j; i<*n; i++, k++ )
560 A[ LDA*i+j ]=ap[ k ];
561 for( i=0, k=0; i<*n; i++ )
562 for( j=0; j<i+1; j++, k++ )
563 AP[ k ]=A[ LDA*i+j ];
564 }
565 cblas_dspr( CblasRowMajor, uplo, *n, *alpha, x, *incx, AP );
566 if (uplo == CblasUpper) {
567 for( i=0, k=0; i<*n; i++ )
568 for( j=i; j<*n; j++, k++ )
569 A[ LDA*i+j ]=AP[ k ];
570 for( j=0, k=0; j<*n; j++ )
571 for( i=0; i<j+1; i++, k++ )
572 ap[ k ]=A[ LDA*i+j ];
573 }
574 else {
575 for( i=0, k=0; i<*n; i++ )
576 for( j=0; j<i+1; j++, k++ )
577 A[ LDA*i+j ]=AP[ k ];
578 for( j=0, k=0; j<*n; j++ )
579 for( i=j; i<*n; i++, k++ )
580 ap[ k ]=A[ LDA*i+j ];
581 }
582 free(A);
583 free(AP);
584 }
585 else
586 cblas_dspr( CblasColMajor, uplo, *n, *alpha, x, *incx, ap );
587}
588
589void F77_dspr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, double *x,
590 CBLAS_INT *incx, double *y, CBLAS_INT *incy, double *ap
592 , FORTRAN_STRLEN uplow_len
593#endif
594){
595 double *A, *AP;
596 CBLAS_INT i,j,k,LDA;
597 CBLAS_UPLO uplo;
598
599 get_uplo_type(uplow,&uplo);
600
601 if (*layout == TEST_ROW_MJR) {
602 LDA = *n;
603 A = ( double* )malloc( LDA*LDA*sizeof( double ) );
604 AP = ( double* )malloc( (((LDA+1)*LDA)/2)*sizeof( double ) );
605 if (uplo == CblasUpper) {
606 for( j=0, k=0; j<*n; j++ )
607 for( i=0; i<j+1; i++, k++ )
608 A[ LDA*i+j ]=ap[ k ];
609 for( i=0, k=0; i<*n; i++ )
610 for( j=i; j<*n; j++, k++ )
611 AP[ k ]=A[ LDA*i+j ];
612 }
613 else {
614 for( j=0, k=0; j<*n; j++ )
615 for( i=j; i<*n; i++, k++ )
616 A[ LDA*i+j ]=ap[ k ];
617 for( i=0, k=0; i<*n; i++ )
618 for( j=0; j<i+1; j++, k++ )
619 AP[ k ]=A[ LDA*i+j ];
620 }
621 cblas_dspr2( CblasRowMajor, uplo, *n, *alpha, x, *incx, y, *incy, AP );
622 if (uplo == CblasUpper) {
623 for( i=0, k=0; i<*n; i++ )
624 for( j=i; j<*n; j++, k++ )
625 A[ LDA*i+j ]=AP[ k ];
626 for( j=0, k=0; j<*n; j++ )
627 for( i=0; i<j+1; i++, k++ )
628 ap[ k ]=A[ LDA*i+j ];
629 }
630 else {
631 for( i=0, k=0; i<*n; i++ )
632 for( j=0; j<i+1; j++, k++ )
633 A[ LDA*i+j ]=AP[ k ];
634 for( j=0, k=0; j<*n; j++ )
635 for( i=j; i<*n; i++, k++ )
636 ap[ k ]=A[ LDA*i+j ];
637 }
638 free(A);
639 free(AP);
640 }
641 else
642 cblas_dspr2( CblasColMajor, uplo, *n, *alpha, x, *incx, y, *incy, ap );
643}
void cblas_dgemv(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA, const CBLAS_INT M, const CBLAS_INT N, const double alpha, const double *A, const CBLAS_INT lda, const double *X, const CBLAS_INT incX, const double beta, double *Y, const CBLAS_INT incY)
Definition cblas_dgemv.c:11
CBLAS_UPLO
Definition cblas.h:41
@ CblasUpper
Definition cblas.h:41
void cblas_dtbmv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, const CBLAS_INT N, const CBLAS_INT K, const double *A, const CBLAS_INT lda, double *X, const CBLAS_INT incX)
Definition cblas_dtbmv.c:10
void cblas_dsyr(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const CBLAS_INT N, const double alpha, const double *X, const CBLAS_INT incX, double *A, const CBLAS_INT lda)
Definition cblas_dsyr.c:12
void cblas_dspr2(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const CBLAS_INT N, const double alpha, const double *X, const CBLAS_INT incX, const double *Y, const CBLAS_INT incY, double *A)
Definition cblas_dspr2.c:10
void cblas_dspr(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const CBLAS_INT N, const double alpha, const double *X, const CBLAS_INT incX, double *Ap)
Definition cblas_dspr.c:12
CBLAS_TRANSPOSE
Definition cblas.h:40
void cblas_dtbsv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, const CBLAS_INT N, const CBLAS_INT K, const double *A, const CBLAS_INT lda, double *X, const CBLAS_INT incX)
Definition cblas_dtbsv.c:10
void cblas_dsbmv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const CBLAS_INT N, const CBLAS_INT K, const double alpha, const double *A, const CBLAS_INT lda, const double *X, const CBLAS_INT incX, const double beta, double *Y, const CBLAS_INT incY)
Definition cblas_dsbmv.c:12
void cblas_dtrsv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, const CBLAS_INT N, const double *A, const CBLAS_INT lda, double *X, const CBLAS_INT incX)
Definition cblas_dtrsv.c:10
void cblas_dger(CBLAS_LAYOUT layout, const CBLAS_INT M, const CBLAS_INT N, const double alpha, const double *X, const CBLAS_INT incX, const double *Y, const CBLAS_INT incY, double *A, const CBLAS_INT lda)
Definition cblas_dger.c:12
@ CblasColMajor
Definition cblas.h:39
@ CblasRowMajor
Definition cblas.h:39
void cblas_dspmv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const CBLAS_INT N, const double alpha, const double *Ap, const double *X, const CBLAS_INT incX, const double beta, double *Y, const CBLAS_INT incY)
Definition cblas_dspmv.c:13
void cblas_dgbmv(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA, const CBLAS_INT M, const CBLAS_INT N, const CBLAS_INT KL, const CBLAS_INT KU, const double alpha, const double *A, const CBLAS_INT lda, const double *X, const CBLAS_INT incX, const double beta, double *Y, const CBLAS_INT incY)
Definition cblas_dgbmv.c:11
CBLAS_DIAG
Definition cblas.h:42
void cblas_dtrmv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, const CBLAS_INT N, const double *A, const CBLAS_INT lda, double *X, const CBLAS_INT incX)
Definition cblas_dtrmv.c:12
#define CBLAS_INT
Definition cblas.h:24
void cblas_dsymv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const CBLAS_INT N, const double alpha, const double *A, const CBLAS_INT lda, const double *X, const CBLAS_INT incX, const double beta, double *Y, const CBLAS_INT incY)
Definition cblas_dsymv.c:12
void cblas_dsyr2(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const CBLAS_INT N, const double alpha, const double *X, const CBLAS_INT incX, const double *Y, const CBLAS_INT incY, double *A, const CBLAS_INT lda)
Definition cblas_dsyr2.c:12
void cblas_dtpsv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, const CBLAS_INT N, const double *Ap, double *X, const CBLAS_INT incX)
Definition cblas_dtpsv.c:10
void cblas_dtpmv(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_DIAG Diag, const CBLAS_INT N, const double *Ap, double *X, const CBLAS_INT incX)
Definition cblas_dtpmv.c:10
#define F77_dger(...)
Definition cblas_f77.h:305
#define F77_dtrmv(...)
Definition cblas_f77.h:342
#define F77_dsbmv(...)
Definition cblas_f77.h:340
#define F77_dsymv(...)
Definition cblas_f77.h:339
#define BLAS_FORTRAN_STRLEN_END
Definition cblas_f77.h:18
#define FORTRAN_STRLEN
Definition cblas_f77.h:21
#define F77_dgbmv(...)
Definition cblas_f77.h:338
#define F77_dsyr2(...)
Definition cblas_f77.h:351
#define F77_dtpmv(...)
Definition cblas_f77.h:346
#define F77_dspr(...)
Definition cblas_f77.h:349
#define F77_dsyr(...)
Definition cblas_f77.h:348
#define F77_dtrsv(...)
Definition cblas_f77.h:344
#define F77_dspmv(...)
Definition cblas_f77.h:341
#define F77_dtpsv(...)
Definition cblas_f77.h:347
#define F77_dspr2(...)
Definition cblas_f77.h:350
#define F77_dgemv(...)
Definition cblas_f77.h:337
#define F77_dtbsv(...)
Definition cblas_f77.h:345
#define F77_dtbmv(...)
Definition cblas_f77.h:343
#define UNDEFINED
Definition cblas_test.h:28
void get_diag_type(char *type, CBLAS_DIAG *diag)
Definition auxiliary.c:25
#define TEST_ROW_MJR
Definition cblas_test.h:21
#define TEST_COL_MJR
Definition cblas_test.h:25
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