void cblas_zher2(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo, const int N, const void *alpha, const void *X, const int incX, const void *Y, const int incY, void *A, const int lda) { int info = 2000; void *vx, *vy; double *x0, *y0; const double *x=X, *y=Y, *alp=alpha; const double one[2]={ATL_rone, ATL_rzero}; #ifndef NoCblasErrorChecks if (Order != CblasColMajor && Order != CblasRowMajor) info = cblas_errprn(1, info, "Order must be %d or %d, but is set to %d", CblasRowMajor, CblasColMajor, Order); if (Uplo != CblasUpper && Uplo != CblasLower) info = cblas_errprn(2, info, "UPLO must be %d or %d, but is set to %d", CblasUpper, CblasLower, Uplo); if (N < 0) info = cblas_errprn(3, info, "N cannot be less than zero; is set to %d.", N); if (!incX) info = cblas_errprn(6, info, "incX cannot be zero; is set to %d.", incX); if (!incY) info = cblas_errprn(8, info, "incY cannot be zero; is set to %d.", incY); if (lda < N || lda < 1) info = cblas_errprn(10, info, "lda must be >= MAX(N,1): lda=%d N=%d", lda, N); if (info != 2000) { cblas_xerbla(info, "cblas_zher2", ""); return; } #endif if (incX < 0) x += (1-N)*incX<<1; if (incY < 0) y += (1-N)*incY<<1; if (Order == CblasColMajor) ATL_zher2(Uplo, N, alpha, x, incX, y, incY, A, lda); else if (alp[0] != ATL_rzero || alp[1] != ATL_rzero) { vx = malloc(ATL_Cachelen + ATL_MulBySize(N)); vy = malloc(ATL_Cachelen + ATL_MulBySize(N)); ATL_assert(vx != NULL && vy != NULL); x0 = ATL_AlignPtr(vx); y0 = ATL_AlignPtr(vy); ATL_zmoveConj(N, alpha, y, incY, y0, 1); ATL_zcopyConj(N, x, incX, x0, 1); ATL_zher2(( (Uplo == CblasUpper) ? CblasLower : CblasUpper ), N, one, y0, 1, x0, 1, A, lda); free(vx); free(vy); } else ATL_zher2(( (Uplo == CblasUpper) ? CblasLower : CblasUpper ), N, alpha, y, incY, x, incX, A, lda); }
void cblas_zgerc(const enum CBLAS_ORDER Order, const int M, const int N, const void *alpha, const void *X, const int incX, const void *Y, const int incY, void *A, const int lda) { int info = 2000; const double *x = X, *y = Y; void *vy; double *y0; double one[2] = {ATL_rone, ATL_rzero}; #ifndef NoCblasErrorChecks if (M < 0) info = cblas_errprn(2, info, "M cannot be less than zero; is set to %d.", M); if (N < 0) info = cblas_errprn(3, info, "N cannot be less than zero; is set to %d.", N); if (!incX) info = cblas_errprn(6, info, "incX cannot be zero; is set to %d.", incX); if (!incY) info = cblas_errprn(8, info, "incY cannot be zero; is set to %d.", incY); if (Order == CblasColMajor) { if (lda < M || lda < 1) info = cblas_errprn(10, info, "lda must be >= MAX(M,1): lda=%d M=%d", lda, M); } else if (Order == CblasRowMajor) { if (lda < N || lda < 1) info = cblas_errprn(10, info, "lda must be >= MAX(N,1): lda=%d M=%d", lda, N); } else info = cblas_errprn(1, info, "Order must be %d or %d, but is set to %d", CblasRowMajor, CblasColMajor, Order); if (info != 2000) { cblas_xerbla(info, "cblas_zgerc", ""); return; } #endif if (incX < 0) x += (1-M)*incX<<1; if (incY < 0) y += (1-N)*incY<<1; if (Order == CblasColMajor) ATL_zgerc(M, N, alpha, x, incX, y, incY, A, lda); else { vy = malloc(ATL_Cachelen + ATL_MulBySize(N)); ATL_assert(vy); y0 = ATL_AlignPtr(vy); ATL_zmoveConj(N, alpha, y, incY, y0, 1); ATL_zgeru(N, M, one, y0, 1, x, incX, A, lda); free(vy); } }
void cblas_zhpr(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo, const int N, const double alpha, const void *X, const int incX, void *A) { int info = 2000; void *vx; double one[2] = {ATL_rone, ATL_rzero}; double *x0; const double *x=X; #ifndef NoCblasErrorChecks if (Order != CblasColMajor && Order != CblasRowMajor) info = cblas_errprn(1, info, "Order must be %d or %d, but is set to %d", CblasRowMajor, CblasColMajor, Order); if (Uplo != CblasUpper && Uplo != CblasLower) info = cblas_errprn(2, info, "UPLO must be %d or %d, but is set to %d", CblasUpper, CblasLower, Uplo); if (N < 0) info = cblas_errprn(3, info, "N cannot be less than zero; is set to %d.", N); if (!incX) info = cblas_errprn(6, info, "incX cannot be zero; is set to %d.", incX); if (info != 2000) { cblas_xerbla(info, "cblas_zhpr", ""); return; } #endif if (incX < 0) x += (1-N)*incX<<1; if (Order == CblasColMajor) ATL_zhpr(Uplo, N, alpha, x, incX, A); else if (alpha != ATL_rzero) { vx = malloc(ATL_Cachelen + ATL_MulBySize(N)); ATL_assert(vx); x0 = ATL_AlignPtr(vx); ATL_zmoveConj(N, one, x, incX, x0, 1); ATL_zhpr(( (Uplo == CblasUpper) ? CblasLower : CblasUpper ), N, alpha, x0, 1, A); free(vx); } else ATL_zhpr(( (Uplo == CblasUpper) ? CblasLower : CblasUpper ), N, ATL_rzero, x, incX, A); }
void cblas_zhbmv(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo, const int N, const int K, const void *alpha, const void *A, const int lda, const void *X, const int incX, const void *beta, void *Y, const int incY) { int info = 2000; const enum CBLAS_UPLO ruplo = (Uplo == CblasUpper) ? CblasLower : CblasUpper; void *vx; double *X0, *x = (double*) X; double *y = Y; const double *alp=alpha; const double *bet=beta; double calpha[2], cbeta[2]; const double one[2] = {ATL_rone, ATL_rzero}; calpha[0] = *alp; calpha[1] = -alp[1]; cbeta[0] = *bet; cbeta[1] = -bet[1]; #ifndef NoCblasErrorChecks if (Order != CblasColMajor && Order != CblasRowMajor) info = cblas_errprn(1, info, "Order must be %d or %d, but is set to %d", CblasRowMajor, CblasColMajor, Order); if (Uplo != CblasUpper && Uplo != CblasLower) info = cblas_errprn(2, info, "Uplo must be %d or %d, but is set to %d", CblasUpper, CblasLower, Uplo); if (N < 0) info = cblas_errprn(3, info, "N cannot be less than zero; is set to %d.", N); if (K < 0) info = cblas_errprn(4, info, "Valid K: 0 < K < N; K=%d, N=%d.", K, N); if (lda < K+1) info = cblas_errprn(7, info, "lda cannot be less than K+1; K=%d, lda=%d\n", K, lda); if (!incX) info = cblas_errprn(9, info, "incX cannot be zero; is set to %d.", incX); if (!incY) info = cblas_errprn(12, info, "incY cannot be zero; is set to %d.", incY); if (info != 2000) { cblas_xerbla(info, "cblas_zhbmv", ""); return; } #endif if (incX < 0) x += (1-N)*incX<<1; if (incY < 0) y += (1-N)*incY<<1; if (Order == CblasColMajor) ATL_zhbmv(Uplo, N, K, alpha, A, lda, x, incX, beta, y, incY); else { vx = malloc(ATL_Cachelen + 2*N*sizeof(double)); ATL_assert(vx); X0 = x; x = ATL_AlignPtr(vx); ATL_zmoveConj(N, calpha, X0, incX, x, 1); if (*bet != ATL_rzero || bet[1] != ATL_rzero) { ATL_zscalConj(N, cbeta, y, incY); ATL_zhbmv(ruplo, N, K, one, A, lda, x, 1, one, y, incY); } else ATL_zhbmv(ruplo, N, K, one, A, lda, x, 1, beta, y, incY); free(vx); ATL_zscalConj(N, one, y, incY); } }