LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ F77_zhpr()

void F77_zhpr ( CBLAS_INT layout,
char *  uplow,
CBLAS_INT n,
double *  alpha,
CBLAS_TEST_ZOMPLEX x,
CBLAS_INT incx,
CBLAS_TEST_ZOMPLEX ap 
)

Definition at line 591 of file c_zblas2.c.

592 {
593 CBLAS_TEST_ZOMPLEX *A, *AP;
594 CBLAS_INT i,j,k,LDA;
595 CBLAS_UPLO uplo;
596
597 get_uplo_type(uplow,&uplo);
598
599 if (*layout == TEST_ROW_MJR) {
600 if (uplo != CblasUpper && uplo != CblasLower )
601 cblas_zhpr(CblasRowMajor, UNDEFINED, *n, *alpha, x, *incx, ap );
602 else {
603 LDA = *n;
604 A = (CBLAS_TEST_ZOMPLEX* )malloc(LDA*LDA*sizeof(CBLAS_TEST_ZOMPLEX ) );
605 AP = ( CBLAS_TEST_ZOMPLEX* )malloc( (((LDA+1)*LDA)/2)*
606 sizeof( CBLAS_TEST_ZOMPLEX ));
607 if (uplo == CblasUpper) {
608 for( j=0, k=0; j<*n; j++ )
609 for( i=0; i<j+1; i++, k++ ){
610 A[ LDA*i+j ].real=ap[ k ].real;
611 A[ LDA*i+j ].imag=ap[ k ].imag;
612 }
613 for( i=0, k=0; i<*n; i++ )
614 for( j=i; j<*n; j++, k++ ){
615 AP[ k ].real=A[ LDA*i+j ].real;
616 AP[ k ].imag=A[ LDA*i+j ].imag;
617 }
618 }
619 else {
620 for( j=0, k=0; j<*n; j++ )
621 for( i=j; i<*n; i++, k++ ){
622 A[ LDA*i+j ].real=ap[ k ].real;
623 A[ LDA*i+j ].imag=ap[ k ].imag;
624 }
625 for( i=0, k=0; i<*n; i++ )
626 for( j=0; j<i+1; j++, k++ ){
627 AP[ k ].real=A[ LDA*i+j ].real;
628 AP[ k ].imag=A[ LDA*i+j ].imag;
629 }
630 }
631 cblas_zhpr(CblasRowMajor, uplo, *n, *alpha, x, *incx, AP );
632 if (uplo == CblasUpper) {
633 for( i=0, k=0; i<*n; i++ )
634 for( j=i; j<*n; j++, k++ ){
635 A[ LDA*i+j ].real=AP[ k ].real;
636 A[ LDA*i+j ].imag=AP[ k ].imag;
637 }
638 for( j=0, k=0; j<*n; j++ )
639 for( i=0; i<j+1; i++, k++ ){
640 ap[ k ].real=A[ LDA*i+j ].real;
641 ap[ k ].imag=A[ LDA*i+j ].imag;
642 }
643 }
644 else {
645 for( i=0, k=0; i<*n; i++ )
646 for( j=0; j<i+1; j++, k++ ){
647 A[ LDA*i+j ].real=AP[ k ].real;
648 A[ LDA*i+j ].imag=AP[ k ].imag;
649 }
650 for( j=0, k=0; j<*n; j++ )
651 for( i=j; i<*n; i++, k++ ){
652 ap[ k ].real=A[ LDA*i+j ].real;
653 ap[ k ].imag=A[ LDA*i+j ].imag;
654 }
655 }
656 free(A);
657 free(AP);
658 }
659 }
660 else if (*layout == TEST_COL_MJR)
661 cblas_zhpr(CblasColMajor, uplo, *n, *alpha, x, *incx, ap );
662 else
663 cblas_zhpr(UNDEFINED, uplo, *n, *alpha, x, *incx, ap );
664}
CBLAS_UPLO
Definition cblas.h:41
@ CblasLower
Definition cblas.h:41
@ CblasUpper
Definition cblas.h:41
@ CblasColMajor
Definition cblas.h:39
@ CblasRowMajor
Definition cblas.h:39
#define CBLAS_INT
Definition cblas.h:24
void cblas_zhpr(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const CBLAS_INT N, const double alpha, const void *X, const CBLAS_INT incX, void *A)
Definition cblas_zhpr.c:12
#define UNDEFINED
Definition cblas_test.h:19
#define TEST_ROW_MJR
Definition cblas_test.h:12
#define TEST_COL_MJR
Definition cblas_test.h:16
void get_uplo_type(char *type, CBLAS_UPLO *uplo)
Definition auxiliary.c:18
Here is the call graph for this function: