/* performs y = beta*y + alpha*A*x */ #include "cblas.h" #define MAX(a,b) (((a) > (b)) ? (a) : (b)) #define MIN(a,b) (((a) < (b)) ? (a) : (b)) void c_ssymv(enum blas_order_type order, enum blas_uplo_type uplo,x int n, float alpha, float* a, int lda, float* x, int incx, float beta, float* y, int incy) { { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; float *y_i = y; const float *a_i = a; const float *x_i = x; float alpha_i = alpha; float beta_i = beta; float y_ii; float y_jj; float aij; float x_ii; float prod1; /* case y = beta * y */ float prod; float sum; float tmp1; float tmp2; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i == 0.0 && (beta_i == 1.0)))){ return; } /* Set up start points in x and y */ ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i == 0.0){ if(beta_i == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii = y_i[iy]; prod1 = y_ii * beta_i; /* prod1 = beta*y[iy]*/ y_i[iy] = prod1; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmp1 = sum * alpha_i; /* tmp1 = sum*alpha */ y_jj = y_i[jy]; tmp2 = beta_i * y_jj; /* tmp2 = y[jy]*beta */ tmp1 = tmp1 + tmp2; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } tmp1 = sum * alpha_i; /* tmp1 = sum*alpha */ y_jj = y_i[jy]; tmp2 = beta_i * y_jj; /* tmp2 = y[jy]*beta */ tmp1 = tmp1 + tmp2; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1; /* y[jy] = tmp1 */ jy = jy + incy; } } } } } /* end c_ssymv */ void c_dsymv(enum blas_order_type order, enum blas_uplo_type uplo,x int n, double alpha, double* a, int lda, double* x, int incx, double beta, double* y, int incy) { { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = y; const double *a_i = a; const double *x_i = x; double alpha_i = alpha; double beta_i = beta; double y_ii; double y_jj; double aij; double x_ii; double prod1; /* case y = beta * y */ double prod; double sum; double tmp1; double tmp2; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i == 0.0 && (beta_i == 1.0)))){ return; } /* Set up start points in x and y */ ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i == 0.0){ if(beta_i == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii = y_i[iy]; prod1 = y_ii * beta_i; /* prod1 = beta*y[iy]*/ y_i[iy] = prod1; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmp1 = sum * alpha_i; /* tmp1 = sum*alpha */ y_jj = y_i[jy]; tmp2 = beta_i * y_jj; /* tmp2 = y[jy]*beta */ tmp1 = tmp1 + tmp2; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } tmp1 = sum * alpha_i; /* tmp1 = sum*alpha */ y_jj = y_i[jy]; tmp2 = beta_i * y_jj; /* tmp2 = y[jy]*beta */ tmp1 = tmp1 + tmp2; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1; /* y[jy] = tmp1 */ jy = jy + incy; } } } } } /* end c_dsymv */ void c_zsymv(enum blas_order_type order, enum blas_uplo_type uplo,x int n, void* alpha, void* a, int lda, void* x, int incx, void* beta, void* y, int incy) { { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = (double*) y; const double *a_i = (double*) a; const double *x_i = (double*) x; double *alpha_i = (double*) alpha; double *beta_i = (double*) beta; double y_ii[2]; double y_jj[2]; double aij[2]; double x_ii[2]; double prod1[2]; /* case y = beta * y */ double prod[2]; double sum[2]; double tmp1[2]; double tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incx *= 2; incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum[0] = sum[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum[0] = sum[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } } /* end c_zsymv */ void c_csymv(enum blas_order_type order, enum blas_uplo_type uplo,x int n, void* alpha, void* a, int lda, void* x, int incx, void* beta, void* y, int incy) { { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; float *y_i = (float*) y; const float *a_i = (float*) a; const float *x_i = (float*) x; float *alpha_i = (float*) alpha; float *beta_i = (float*) beta; float y_ii[2]; float y_jj[2]; float aij[2]; float x_ii[2]; float prod1[2]; /* case y = beta * y */ float prod[2]; float sum[2]; float tmp1[2]; float tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incx *= 2; incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum[0] = sum[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum[0] = sum[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } } /* end c_csymv */ void c_dsymv_s_s(enum blas_order_type order, enum blas_uplo_type uplo, int n, double alpha, float* a[], int lda, float* x, int incx, double beta, double* y, int incy) { { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = y; const float *a_i = a; const float *x_i = x; double alpha_i = alpha; double beta_i = beta; double y_ii; double y_jj; float aij; float x_ii; double prod1; /* case y = beta * y */ double prod; double sum; double tmp1; double tmp2; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i == 0.0 && (beta_i == 1.0)))){ return; } /* Set up start points in x and y */ ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i == 0.0){ if(beta_i == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii = y_i[iy]; prod1 = y_ii * beta_i; /* prod1 = beta*y[iy]*/ y_i[iy] = prod1; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = (double) x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = (double) x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmp1 = sum * alpha_i; /* tmp1 = sum*alpha */ y_jj = y_i[jy]; tmp2 = beta_i * y_jj; /* tmp2 = y[jy]*beta */ tmp1 = tmp1 + tmp2; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = (double) x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = (double) x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } tmp1 = sum * alpha_i; /* tmp1 = sum*alpha */ y_jj = y_i[jy]; tmp2 = beta_i * y_jj; /* tmp2 = y[jy]*beta */ tmp1 = tmp1 + tmp2; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1; /* y[jy] = tmp1 */ jy = jy + incy; } } } }; } /* end c_dsymv_s_s */ void c_dsymv_s_d(enum blas_order_type order, enum blas_uplo_type uplo, int n, double alpha, float* a[], int lda, double* x, int incx, double beta, double* y, int incy) { { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = y; const float *a_i = a; const double *x_i = x; double alpha_i = alpha; double beta_i = beta; double y_ii; double y_jj; float aij; double x_ii; double prod1; /* case y = beta * y */ double prod; double sum; double tmp1; double tmp2; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i == 0.0 && (beta_i == 1.0)))){ return; } /* Set up start points in x and y */ ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i == 0.0){ if(beta_i == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii = y_i[iy]; prod1 = y_ii * beta_i; /* prod1 = beta*y[iy]*/ y_i[iy] = prod1; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmp1 = sum * alpha_i; /* tmp1 = sum*alpha */ y_jj = y_i[jy]; tmp2 = beta_i * y_jj; /* tmp2 = y[jy]*beta */ tmp1 = tmp1 + tmp2; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } tmp1 = sum * alpha_i; /* tmp1 = sum*alpha */ y_jj = y_i[jy]; tmp2 = beta_i * y_jj; /* tmp2 = y[jy]*beta */ tmp1 = tmp1 + tmp2; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1; /* y[jy] = tmp1 */ jy = jy + incy; } } } }; } /* end c_dsymv_s_d */ void c_dsymv_d_s(enum blas_order_type order, enum blas_uplo_type uplo, int n, double alpha, double* a[], int lda, float* x, int incx, double beta, double* y, int incy) { { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = y; const double *a_i = a; const float *x_i = x; double alpha_i = alpha; double beta_i = beta; double y_ii; double y_jj; double aij; float x_ii; double prod1; /* case y = beta * y */ double prod; double sum; double tmp1; double tmp2; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i == 0.0 && (beta_i == 1.0)))){ return; } /* Set up start points in x and y */ ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i == 0.0){ if(beta_i == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii = y_i[iy]; prod1 = y_ii * beta_i; /* prod1 = beta*y[iy]*/ y_i[iy] = prod1; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmp1 = sum * alpha_i; /* tmp1 = sum*alpha */ y_jj = y_i[jy]; tmp2 = beta_i * y_jj; /* tmp2 = y[jy]*beta */ tmp1 = tmp1 + tmp2; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } tmp1 = sum * alpha_i; /* tmp1 = sum*alpha */ y_jj = y_i[jy]; tmp2 = beta_i * y_jj; /* tmp2 = y[jy]*beta */ tmp1 = tmp1 + tmp2; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1; /* y[jy] = tmp1 */ jy = jy + incy; } } } }; } /* end c_dsymv_d_s */ void c_zsymv_c_c(enum blas_order_type order, enum blas_uplo_type uplo, int n, void* alpha, void* a[], int lda, void* x, int incx, void* beta, void* y, int incy) { { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = (double*) y; const float *a_i = (float*) a; const float *x_i = (float*) x; double *alpha_i = (double*) alpha; double *beta_i = (double*) beta; double y_ii[2]; double y_jj[2]; float aij[2]; float x_ii[2]; double prod1[2]; /* case y = beta * y */ double prod[2]; double sum[2]; double tmp1[2]; double tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incx *= 2; incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum[0] = sum[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum[0] = sum[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } }; } /* end c_zsymv_c_c */ void c_zsymv_c_z(enum blas_order_type order, enum blas_uplo_type uplo, int n, void* alpha, void* a[], int lda, void* x, int incx, void* beta, void* y, int incy) { { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = (double*) y; const float *a_i = (float*) a; const double *x_i = (double*) x; double *alpha_i = (double*) alpha; double *beta_i = (double*) beta; double y_ii[2]; double y_jj[2]; float aij[2]; double x_ii[2]; double prod1[2]; /* case y = beta * y */ double prod[2]; double sum[2]; double tmp1[2]; double tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incx *= 2; incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum[0] = sum[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum[0] = sum[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } }; } /* end c_zsymv_c_z */ void c_zsymv_z_c(enum blas_order_type order, enum blas_uplo_type uplo, int n, void* alpha, void* a[], int lda, void* x, int incx, void* beta, void* y, int incy) { { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = (double*) y; const double *a_i = (double*) a; const float *x_i = (float*) x; double *alpha_i = (double*) alpha; double *beta_i = (double*) beta; double y_ii[2]; double y_jj[2]; double aij[2]; float x_ii[2]; double prod1[2]; /* case y = beta * y */ double prod[2]; double sum[2]; double tmp1[2]; double tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incx *= 2; incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum[0] = sum[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum[0] = sum[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } }; } /* end c_zsymv_z_c */ void c_csymv_s_s(enum blas_order_type order, enum blas_uplo_type uplo, int n, void* alpha, float* a[], int lda, float* x, int incx, void* beta, void* y, int incy) { { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; float *y_i = (float*) y; const float *a_i = a; const float *x_i = x; float *alpha_i = (float*) alpha; float *beta_i = (float*) beta; float y_ii[2]; float y_jj[2]; float aij; float x_ii; float prod1[2]; /* case y = beta * y */ float prod[2]; float sum[2]; float tmp1[2]; float tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum[0] = sum[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum[0] = sum[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } }; } /* end c_csymv_s_s */ void c_csymv_s_c(enum blas_order_type order, enum blas_uplo_type uplo, int n, void* alpha, float* a[], int lda, void* x, int incx, void* beta, void* y, int incy) { { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; float *y_i = (float*) y; const float *a_i = a; const float *x_i = (float*) x; float *alpha_i = (float*) alpha; float *beta_i = (float*) beta; float y_ii[2]; float y_jj[2]; float aij; float x_ii[2]; float prod1[2]; /* case y = beta * y */ float prod[2]; float sum[2]; float tmp1[2]; float tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incx *= 2; incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum[0] = sum[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij = a_i[tmpind]; { prod[0] = x_ii[0] * aij; prod[1] = x_ii[1] * aij; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij = a_i[tmpind]; { prod[0] = x_ii[0] * aij; prod[1] = x_ii[1] * aij; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum[0] = sum[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij = a_i[tmpind]; { prod[0] = x_ii[0] * aij; prod[1] = x_ii[1] * aij; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij = a_i[tmpind]; { prod[0] = x_ii[0] * aij; prod[1] = x_ii[1] * aij; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } }; } /* end c_csymv_s_c */ void c_csymv_c_s(enum blas_order_type order, enum blas_uplo_type uplo, int n, void* alpha, void* a[], int lda, float* x, int incx, void* beta, void* y, int incy) { { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; float *y_i = (float*) y; const float *a_i = (float*) a; const float *x_i = x; float *alpha_i = (float*) alpha; float *beta_i = (float*) beta; float y_ii[2]; float y_jj[2]; float aij[2]; float x_ii; float prod1[2]; /* case y = beta * y */ float prod[2]; float sum[2]; float tmp1[2]; float tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum[0] = sum[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = aij[0] * x_ii; prod[1] = aij[1] * x_ii; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = aij[0] * x_ii; prod[1] = aij[1] * x_ii; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum[0] = sum[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = aij[0] * x_ii; prod[1] = aij[1] * x_ii; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = aij[0] * x_ii; prod[1] = aij[1] * x_ii; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } }; } /* end c_csymv_c_s */ void c_zsymv_d_d(enum blas_order_type order, enum blas_uplo_type uplo, int n, void* alpha, double* a[], int lda, double* x, int incx, void* beta, void* y, int incy) { { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = (double*) y; const double *a_i = a; const double *x_i = x; double *alpha_i = (double*) alpha; double *beta_i = (double*) beta; double y_ii[2]; double y_jj[2]; double aij; double x_ii; double prod1[2]; /* case y = beta * y */ double prod[2]; double sum[2]; double tmp1[2]; double tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum[0] = sum[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum[0] = sum[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } }; } /* end c_zsymv_d_d */ void c_zsymv_d_z(enum blas_order_type order, enum blas_uplo_type uplo, int n, void* alpha, double* a[], int lda, void* x, int incx, void* beta, void* y, int incy) { { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = (double*) y; const double *a_i = a; const double *x_i = (double*) x; double *alpha_i = (double*) alpha; double *beta_i = (double*) beta; double y_ii[2]; double y_jj[2]; double aij; double x_ii[2]; double prod1[2]; /* case y = beta * y */ double prod[2]; double sum[2]; double tmp1[2]; double tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incx *= 2; incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum[0] = sum[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij = a_i[tmpind]; { prod[0] = x_ii[0] * aij; prod[1] = x_ii[1] * aij; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij = a_i[tmpind]; { prod[0] = x_ii[0] * aij; prod[1] = x_ii[1] * aij; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum[0] = sum[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij = a_i[tmpind]; { prod[0] = x_ii[0] * aij; prod[1] = x_ii[1] * aij; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij = a_i[tmpind]; { prod[0] = x_ii[0] * aij; prod[1] = x_ii[1] * aij; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } }; } /* end c_zsymv_d_z */ void c_zsymv_z_d(enum blas_order_type order, enum blas_uplo_type uplo, int n, void* alpha, void* a[], int lda, double* x, int incx, void* beta, void* y, int incy) { { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = (double*) y; const double *a_i = (double*) a; const double *x_i = x; double *alpha_i = (double*) alpha; double *beta_i = (double*) beta; double y_ii[2]; double y_jj[2]; double aij[2]; double x_ii; double prod1[2]; /* case y = beta * y */ double prod[2]; double sum[2]; double tmp1[2]; double tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum[0] = sum[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = aij[0] * x_ii; prod[1] = aij[1] * x_ii; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = aij[0] * x_ii; prod[1] = aij[1] * x_ii; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum[0] = sum[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = aij[0] * x_ii; prod[1] = aij[1] * x_ii; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = aij[0] * x_ii; prod[1] = aij[1] * x_ii; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } }; } /* end c_zsymv_z_d */ void c_sSYMV_x(enum blas_order_type order, enum blas_uplo_type uplo, int n, float alpha, float* a, int lda, float* x, int incx, float beta, float* y, int incy, enum blas_prec_type prec) { switch ( prec ) { case blas_prec_single: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; float *y_i = y; const float *a_i = a; const float *x_i = x; float alpha_i = alpha; float beta_i = beta; float y_ii; float y_jj; float aij; float x_ii; float prod1; /* case y = beta * y */ float prod; float sum; float tmp1; float tmp2; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i == 0.0 && (beta_i == 1.0)))){ return; } /* Set up start points in x and y */ ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i == 0.0){ if(beta_i == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii = y_i[iy]; prod1 = y_ii * beta_i; /* prod1 = beta*y[iy]*/ y_i[iy] = prod1; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmp1 = sum * alpha_i; /* tmp1 = sum*alpha */ y_jj = y_i[jy]; tmp2 = beta_i * y_jj; /* tmp2 = y[jy]*beta */ tmp1 = tmp1 + tmp2; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } tmp1 = sum * alpha_i; /* tmp1 = sum*alpha */ y_jj = y_i[jy]; tmp2 = beta_i * y_jj; /* tmp2 = y[jy]*beta */ tmp1 = tmp1 + tmp2; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; case blas_prec_double: case blas_prec_indigenous: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; float *y_i = y; const float *a_i = a; const float *x_i = x; float alpha_i = alpha; float beta_i = beta; float y_ii; float y_jj; float aij; float x_ii; float prod1; /* case y = beta * y */ double prod; double sum; double tmp1; double tmp2; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i == 0.0 && (beta_i == 1.0)))){ return; } /* Set up start points in x and y */ ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i == 0.0){ if(beta_i == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii = y_i[iy]; prod1 = y_ii * beta_i; /* prod1 = beta*y[iy]*/ y_i[iy] = prod1; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = (double) x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = (double) x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmp1 = sum * alpha_i; /* tmp1 = sum*alpha */ y_jj = y_i[jy]; tmp2 = (double) beta_i * y_jj; /* tmp2 = y[jy]*beta */ tmp1 = tmp1 + tmp2; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = (double) x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = (double) x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } tmp1 = sum * alpha_i; /* tmp1 = sum*alpha */ y_jj = y_i[jy]; tmp2 = (double) beta_i * y_jj; /* tmp2 = y[jy]*beta */ tmp1 = tmp1 + tmp2; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; case blas_prec_extra: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; float *y_i = y; const float *a_i = a; const float *x_i = x; float alpha_i = alpha; float beta_i = beta; float y_ii; float y_jj; float aij; float x_ii; float prod1; /* case y = beta * y */ double prod_l, prod_t; double sum_l, sum_t; double tmp1_l, tmp1_t; double tmp2_l, tmp2_t; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i == 0.0 && (beta_i == 1.0)))){ return; } /* Set up start points in x and y */ ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i == 0.0){ if(beta_i == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii = y_i[iy]; prod1 = y_ii * beta_i; /* prod1 = beta*y[iy]*/ y_i[iy] = prod1; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum_l = sum_t = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod_l = x_ii * aij; prod_t = 0.0; /* prod = a[tmpind]*x[i] */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = sum_l + prod_l; e = t1 - sum_l; t2 = ((prod_l - e) + (sum_l - (t1 - e))) + sum_t + prod_t; /* The result is t1 + t2, after normalization. */ sum_l = t1 + t2; sum_t = t2 - (sum_l - t1); } /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod_l = x_ii * aij; prod_t = 0.0; /* prod = a[tmpind]*x[i] */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = sum_l + prod_l; e = t1 - sum_l; t2 = ((prod_l - e) + (sum_l - (t1 - e))) + sum_t + prod_t; /* The result is t1 + t2, after normalization. */ sum_l = t1 + t2; sum_t = t2 - (sum_l - t1); } /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { double dt = (double) alpha_i; { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = sum_l * split; a11 = con - sum_l; a11 = con - a11; a21 = sum_l - a11; con = dt * split; b1 = con - dt; b1 = con - b1; b2 = dt - b1; c11 = sum_l * dt; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = sum_t * dt; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; tmp1_l = t1 + t2; tmp1_t = t2 - (tmp1_l - t1); } } /* tmp1 = sum*alpha */ y_jj = y_i[jy]; tmp2_l = beta_i * y_jj; tmp2_t = 0.0; /* tmp2 = y[jy]*beta */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = tmp1_l + tmp2_l; e = t1 - tmp1_l; t2 = ((tmp2_l - e) + (tmp1_l - (t1 - e))) + tmp1_t + tmp2_t; /* The result is t1 + t2, after normalization. */ tmp1_l = t1 + t2; tmp1_t = t2 - (tmp1_l - t1); } /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1_l; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum_l = sum_t = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod_l = x_ii * aij; prod_t = 0.0; /* prod = a[tmpind]*x[i] */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = sum_l + prod_l; e = t1 - sum_l; t2 = ((prod_l - e) + (sum_l - (t1 - e))) + sum_t + prod_t; /* The result is t1 + t2, after normalization. */ sum_l = t1 + t2; sum_t = t2 - (sum_l - t1); } /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod_l = x_ii * aij; prod_t = 0.0; /* prod = a[tmpind]*x[i] */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = sum_l + prod_l; e = t1 - sum_l; t2 = ((prod_l - e) + (sum_l - (t1 - e))) + sum_t + prod_t; /* The result is t1 + t2, after normalization. */ sum_l = t1 + t2; sum_t = t2 - (sum_l - t1); } /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { double dt = (double) alpha_i; { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = sum_l * split; a11 = con - sum_l; a11 = con - a11; a21 = sum_l - a11; con = dt * split; b1 = con - dt; b1 = con - b1; b2 = dt - b1; c11 = sum_l * dt; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = sum_t * dt; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; tmp1_l = t1 + t2; tmp1_t = t2 - (tmp1_l - t1); } } /* tmp1 = sum*alpha */ y_jj = y_i[jy]; tmp2_l = beta_i * y_jj; tmp2_t = 0.0; /* tmp2 = y[jy]*beta */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = tmp1_l + tmp2_l; e = t1 - tmp1_l; t2 = ((tmp2_l - e) + (tmp1_l - (t1 - e))) + tmp1_t + tmp2_t; /* The result is t1 + t2, after normalization. */ tmp1_l = t1 + t2; tmp1_t = t2 - (tmp1_l - t1); } /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1_l; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; } } /* end c_sSYMV_x */ void c_dSYMV_x(enum blas_order_type order, enum blas_uplo_type uplo, int n, double alpha, double* a, int lda, double* x, int incx, double beta, double* y, int incy, enum blas_prec_type prec) { switch ( prec ) { case blas_prec_single: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = y; const double *a_i = a; const double *x_i = x; double alpha_i = alpha; double beta_i = beta; double y_ii; double y_jj; double aij; double x_ii; double prod1; /* case y = beta * y */ double prod; double sum; double tmp1; double tmp2; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i == 0.0 && (beta_i == 1.0)))){ return; } /* Set up start points in x and y */ ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i == 0.0){ if(beta_i == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii = y_i[iy]; prod1 = y_ii * beta_i; /* prod1 = beta*y[iy]*/ y_i[iy] = prod1; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmp1 = sum * alpha_i; /* tmp1 = sum*alpha */ y_jj = y_i[jy]; tmp2 = beta_i * y_jj; /* tmp2 = y[jy]*beta */ tmp1 = tmp1 + tmp2; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } tmp1 = sum * alpha_i; /* tmp1 = sum*alpha */ y_jj = y_i[jy]; tmp2 = beta_i * y_jj; /* tmp2 = y[jy]*beta */ tmp1 = tmp1 + tmp2; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; case blas_prec_double: case blas_prec_indigenous: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = y; const double *a_i = a; const double *x_i = x; double alpha_i = alpha; double beta_i = beta; double y_ii; double y_jj; double aij; double x_ii; double prod1; /* case y = beta * y */ double prod; double sum; double tmp1; double tmp2; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i == 0.0 && (beta_i == 1.0)))){ return; } /* Set up start points in x and y */ ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i == 0.0){ if(beta_i == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii = y_i[iy]; prod1 = y_ii * beta_i; /* prod1 = beta*y[iy]*/ y_i[iy] = prod1; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmp1 = sum * alpha_i; /* tmp1 = sum*alpha */ y_jj = y_i[jy]; tmp2 = beta_i * y_jj; /* tmp2 = y[jy]*beta */ tmp1 = tmp1 + tmp2; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } tmp1 = sum * alpha_i; /* tmp1 = sum*alpha */ y_jj = y_i[jy]; tmp2 = beta_i * y_jj; /* tmp2 = y[jy]*beta */ tmp1 = tmp1 + tmp2; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; case blas_prec_extra: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = y; const double *a_i = a; const double *x_i = x; double alpha_i = alpha; double beta_i = beta; double y_ii; double y_jj; double aij; double x_ii; double prod1; /* case y = beta * y */ double prod_l, prod_t; double sum_l, sum_t; double tmp1_l, tmp1_t; double tmp2_l, tmp2_t; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i == 0.0 && (beta_i == 1.0)))){ return; } /* Set up start points in x and y */ ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i == 0.0){ if(beta_i == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii = y_i[iy]; prod1 = y_ii * beta_i; /* prod1 = beta*y[iy]*/ y_i[iy] = prod1; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum_l = sum_t = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii * split; a1 = con - x_ii; a1 = con - a1; a2 = x_ii - a1; con = aij * split; b1 = con - aij; b1 = con - b1; b2 = aij - b1; prod_l = x_ii * aij; prod_t = (((a1 * b1 - prod_l) + a1 * b2) + a2 * b1) + a2 * b2; } /* prod = a[tmpind]*x[i] */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = sum_l + prod_l; e = t1 - sum_l; t2 = ((prod_l - e) + (sum_l - (t1 - e))) + sum_t + prod_t; /* The result is t1 + t2, after normalization. */ sum_l = t1 + t2; sum_t = t2 - (sum_l - t1); } /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii * split; a1 = con - x_ii; a1 = con - a1; a2 = x_ii - a1; con = aij * split; b1 = con - aij; b1 = con - b1; b2 = aij - b1; prod_l = x_ii * aij; prod_t = (((a1 * b1 - prod_l) + a1 * b2) + a2 * b1) + a2 * b2; } /* prod = a[tmpind]*x[i] */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = sum_l + prod_l; e = t1 - sum_l; t2 = ((prod_l - e) + (sum_l - (t1 - e))) + sum_t + prod_t; /* The result is t1 + t2, after normalization. */ sum_l = t1 + t2; sum_t = t2 - (sum_l - t1); } /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = sum_l * split; a11 = con - sum_l; a11 = con - a11; a21 = sum_l - a11; con = alpha_i * split; b1 = con - alpha_i; b1 = con - b1; b2 = alpha_i - b1; c11 = sum_l * alpha_i; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = sum_t * alpha_i; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; tmp1_l = t1 + t2; tmp1_t = t2 - (tmp1_l - t1); } /* tmp1 = sum*alpha */ y_jj = y_i[jy]; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i * split; a1 = con - beta_i; a1 = con - a1; a2 = beta_i - a1; con = y_jj * split; b1 = con - y_jj; b1 = con - b1; b2 = y_jj - b1; tmp2_l = beta_i * y_jj; tmp2_t = (((a1 * b1 - tmp2_l) + a1 * b2) + a2 * b1) + a2 * b2; } /* tmp2 = y[jy]*beta */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = tmp1_l + tmp2_l; e = t1 - tmp1_l; t2 = ((tmp2_l - e) + (tmp1_l - (t1 - e))) + tmp1_t + tmp2_t; /* The result is t1 + t2, after normalization. */ tmp1_l = t1 + t2; tmp1_t = t2 - (tmp1_l - t1); } /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1_l; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum_l = sum_t = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii * split; a1 = con - x_ii; a1 = con - a1; a2 = x_ii - a1; con = aij * split; b1 = con - aij; b1 = con - b1; b2 = aij - b1; prod_l = x_ii * aij; prod_t = (((a1 * b1 - prod_l) + a1 * b2) + a2 * b1) + a2 * b2; } /* prod = a[tmpind]*x[i] */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = sum_l + prod_l; e = t1 - sum_l; t2 = ((prod_l - e) + (sum_l - (t1 - e))) + sum_t + prod_t; /* The result is t1 + t2, after normalization. */ sum_l = t1 + t2; sum_t = t2 - (sum_l - t1); } /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii * split; a1 = con - x_ii; a1 = con - a1; a2 = x_ii - a1; con = aij * split; b1 = con - aij; b1 = con - b1; b2 = aij - b1; prod_l = x_ii * aij; prod_t = (((a1 * b1 - prod_l) + a1 * b2) + a2 * b1) + a2 * b2; } /* prod = a[tmpind]*x[i] */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = sum_l + prod_l; e = t1 - sum_l; t2 = ((prod_l - e) + (sum_l - (t1 - e))) + sum_t + prod_t; /* The result is t1 + t2, after normalization. */ sum_l = t1 + t2; sum_t = t2 - (sum_l - t1); } /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = sum_l * split; a11 = con - sum_l; a11 = con - a11; a21 = sum_l - a11; con = alpha_i * split; b1 = con - alpha_i; b1 = con - b1; b2 = alpha_i - b1; c11 = sum_l * alpha_i; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = sum_t * alpha_i; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; tmp1_l = t1 + t2; tmp1_t = t2 - (tmp1_l - t1); } /* tmp1 = sum*alpha */ y_jj = y_i[jy]; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i * split; a1 = con - beta_i; a1 = con - a1; a2 = beta_i - a1; con = y_jj * split; b1 = con - y_jj; b1 = con - b1; b2 = y_jj - b1; tmp2_l = beta_i * y_jj; tmp2_t = (((a1 * b1 - tmp2_l) + a1 * b2) + a2 * b1) + a2 * b2; } /* tmp2 = y[jy]*beta */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = tmp1_l + tmp2_l; e = t1 - tmp1_l; t2 = ((tmp2_l - e) + (tmp1_l - (t1 - e))) + tmp1_t + tmp2_t; /* The result is t1 + t2, after normalization. */ tmp1_l = t1 + t2; tmp1_t = t2 - (tmp1_l - t1); } /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1_l; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; } } /* end c_dSYMV_x */ void c_zSYMV_x(enum blas_order_type order, enum blas_uplo_type uplo, int n, void* alpha, void* a, int lda, void* x, int incx, void* beta, void* y, int incy, enum blas_prec_type prec) { switch ( prec ) { case blas_prec_single: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = (double*) y; const double *a_i = (double*) a; const double *x_i = (double*) x; double *alpha_i = (double*) alpha; double *beta_i = (double*) beta; double y_ii[2]; double y_jj[2]; double aij[2]; double x_ii[2]; double prod1[2]; /* case y = beta * y */ double prod[2]; double sum[2]; double tmp1[2]; double tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incx *= 2; incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum[0] = sum[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum[0] = sum[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; case blas_prec_double: case blas_prec_indigenous: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = (double*) y; const double *a_i = (double*) a; const double *x_i = (double*) x; double *alpha_i = (double*) alpha; double *beta_i = (double*) beta; double y_ii[2]; double y_jj[2]; double aij[2]; double x_ii[2]; double prod1[2]; /* case y = beta * y */ double prod[2]; double sum[2]; double tmp1[2]; double tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incx *= 2; incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum[0] = sum[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum[0] = sum[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; case blas_prec_extra: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = (double*) y; const double *a_i = (double*) a; const double *x_i = (double*) x; double *alpha_i = (double*) alpha; double *beta_i = (double*) beta; double y_ii[2]; double y_jj[2]; double aij[2]; double x_ii[2]; double prod1[2]; /* case y = beta * y */ double prod_l[2], prod_t[2]; double sum_l[2], sum_t[2]; double tmp1_l[2], tmp1_t[2]; double tmp2_l[2], tmp2_t[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incx *= 2; incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum_l[0] = sum_l[1] = sum_t[0] = sum_t[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { /* Compute complex-extra = complex-double * complex-double. */ double t1_l, t1_t; double t2_l, t2_t; /* Real part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii[0] * split; a1 = con - x_ii[0]; a1 = con - a1; a2 = x_ii[0] - a1; con = aij[0] * split; b1 = con - aij[0]; b1 = con - b1; b2 = aij[0] - b1; t1_l = x_ii[0] * aij[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii[1] * split; a1 = con - x_ii[1]; a1 = con - a1; a2 = x_ii[1] - a1; con = aij[1] * split; b1 = con - aij[1]; b1 = con - b1; b2 = aij[1] - b1; t2_l = x_ii[1] * aij[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } prod_l[0] = t1_l; prod_t[0] = t1_t; /* Imaginary part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii[1] * split; a1 = con - x_ii[1]; a1 = con - a1; a2 = x_ii[1] - a1; con = aij[0] * split; b1 = con - aij[0]; b1 = con - b1; b2 = aij[0] - b1; t1_l = x_ii[1] * aij[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii[0] * split; a1 = con - x_ii[0]; a1 = con - a1; a2 = x_ii[0] - a1; con = aij[1] * split; b1 = con - aij[1]; b1 = con - b1; b2 = aij[1] - b1; t2_l = x_ii[0] * aij[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } prod_l[1] = t1_l; prod_t[1] = t1_t; } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { /* Compute complex-extra = complex-double * complex-double. */ double t1_l, t1_t; double t2_l, t2_t; /* Real part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii[0] * split; a1 = con - x_ii[0]; a1 = con - a1; a2 = x_ii[0] - a1; con = aij[0] * split; b1 = con - aij[0]; b1 = con - b1; b2 = aij[0] - b1; t1_l = x_ii[0] * aij[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii[1] * split; a1 = con - x_ii[1]; a1 = con - a1; a2 = x_ii[1] - a1; con = aij[1] * split; b1 = con - aij[1]; b1 = con - b1; b2 = aij[1] - b1; t2_l = x_ii[1] * aij[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } prod_l[0] = t1_l; prod_t[0] = t1_t; /* Imaginary part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii[1] * split; a1 = con - x_ii[1]; a1 = con - a1; a2 = x_ii[1] - a1; con = aij[0] * split; b1 = con - aij[0]; b1 = con - b1; b2 = aij[0] - b1; t1_l = x_ii[1] * aij[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii[0] * split; a1 = con - x_ii[0]; a1 = con - a1; a2 = x_ii[0] - a1; con = aij[1] * split; b1 = con - aij[1]; b1 = con - b1; b2 = aij[1] - b1; t2_l = x_ii[0] * aij[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } prod_l[1] = t1_l; prod_t[1] = t1_t; } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { /* Compute complex-extra = complex-extra * complex-double. */ double a0_l, a0_t; double a1_l, a1_t; double t1_l, t1_t; double t2_l, t2_t; a0_l = sum_l[0]; a0_t = sum_t[0]; a1_l = sum_l[1]; a1_t = sum_t[1]; /* Real part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = alpha_i[0] * split; b1 = con - alpha_i[0]; b1 = con - b1; b2 = alpha_i[0] - b1; c11 = a0_l * alpha_i[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * alpha_i[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = alpha_i[1] * split; b1 = con - alpha_i[1]; b1 = con - b1; b2 = alpha_i[1] - b1; c11 = a1_l * alpha_i[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * alpha_i[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[0] = t1_l; tmp1_t[0] = t1_t; /* Imaginary part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = alpha_i[0] * split; b1 = con - alpha_i[0]; b1 = con - b1; b2 = alpha_i[0] - b1; c11 = a1_l * alpha_i[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * alpha_i[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = alpha_i[1] * split; b1 = con - alpha_i[1]; b1 = con - b1; b2 = alpha_i[1] - b1; c11 = a0_l * alpha_i[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * alpha_i[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[1] = t1_l; tmp1_t[1] = t1_t; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { /* Compute complex-extra = complex-double * complex-double. */ double t1_l, t1_t; double t2_l, t2_t; /* Real part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[0] * split; a1 = con - beta_i[0]; a1 = con - a1; a2 = beta_i[0] - a1; con = y_jj[0] * split; b1 = con - y_jj[0]; b1 = con - b1; b2 = y_jj[0] - b1; t1_l = beta_i[0] * y_jj[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[1] * split; a1 = con - beta_i[1]; a1 = con - a1; a2 = beta_i[1] - a1; con = y_jj[1] * split; b1 = con - y_jj[1]; b1 = con - b1; b2 = y_jj[1] - b1; t2_l = beta_i[1] * y_jj[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp2_l[0] = t1_l; tmp2_t[0] = t1_t; /* Imaginary part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[1] * split; a1 = con - beta_i[1]; a1 = con - a1; a2 = beta_i[1] - a1; con = y_jj[0] * split; b1 = con - y_jj[0]; b1 = con - b1; b2 = y_jj[0] - b1; t1_l = beta_i[1] * y_jj[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[0] * split; a1 = con - beta_i[0]; a1 = con - a1; a2 = beta_i[0] - a1; con = y_jj[1] * split; b1 = con - y_jj[1]; b1 = con - b1; b2 = y_jj[1] - b1; t2_l = beta_i[0] * y_jj[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp2_l[1] = t1_l; tmp2_t[1] = t1_t; } /* tmp2 = y[jy]*beta */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = tmp1_l[0]; a_t = tmp1_t[0]; b_l = tmp2_l[0]; b_t = tmp2_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[0] = t_l; tmp1_t[0] = t_t; /* Imaginary part */ a_l = tmp1_l[1]; a_t = tmp1_t[1]; b_l = tmp2_l[1]; b_t = tmp2_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[1] = t_l; tmp1_t[1] = t_t; } /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1_l[0]; y_i[jy+1] = tmp1_l[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum_l[0] = sum_l[1] = sum_t[0] = sum_t[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { /* Compute complex-extra = complex-double * complex-double. */ double t1_l, t1_t; double t2_l, t2_t; /* Real part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii[0] * split; a1 = con - x_ii[0]; a1 = con - a1; a2 = x_ii[0] - a1; con = aij[0] * split; b1 = con - aij[0]; b1 = con - b1; b2 = aij[0] - b1; t1_l = x_ii[0] * aij[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii[1] * split; a1 = con - x_ii[1]; a1 = con - a1; a2 = x_ii[1] - a1; con = aij[1] * split; b1 = con - aij[1]; b1 = con - b1; b2 = aij[1] - b1; t2_l = x_ii[1] * aij[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } prod_l[0] = t1_l; prod_t[0] = t1_t; /* Imaginary part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii[1] * split; a1 = con - x_ii[1]; a1 = con - a1; a2 = x_ii[1] - a1; con = aij[0] * split; b1 = con - aij[0]; b1 = con - b1; b2 = aij[0] - b1; t1_l = x_ii[1] * aij[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii[0] * split; a1 = con - x_ii[0]; a1 = con - a1; a2 = x_ii[0] - a1; con = aij[1] * split; b1 = con - aij[1]; b1 = con - b1; b2 = aij[1] - b1; t2_l = x_ii[0] * aij[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } prod_l[1] = t1_l; prod_t[1] = t1_t; } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { /* Compute complex-extra = complex-double * complex-double. */ double t1_l, t1_t; double t2_l, t2_t; /* Real part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii[0] * split; a1 = con - x_ii[0]; a1 = con - a1; a2 = x_ii[0] - a1; con = aij[0] * split; b1 = con - aij[0]; b1 = con - b1; b2 = aij[0] - b1; t1_l = x_ii[0] * aij[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii[1] * split; a1 = con - x_ii[1]; a1 = con - a1; a2 = x_ii[1] - a1; con = aij[1] * split; b1 = con - aij[1]; b1 = con - b1; b2 = aij[1] - b1; t2_l = x_ii[1] * aij[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } prod_l[0] = t1_l; prod_t[0] = t1_t; /* Imaginary part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii[1] * split; a1 = con - x_ii[1]; a1 = con - a1; a2 = x_ii[1] - a1; con = aij[0] * split; b1 = con - aij[0]; b1 = con - b1; b2 = aij[0] - b1; t1_l = x_ii[1] * aij[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii[0] * split; a1 = con - x_ii[0]; a1 = con - a1; a2 = x_ii[0] - a1; con = aij[1] * split; b1 = con - aij[1]; b1 = con - b1; b2 = aij[1] - b1; t2_l = x_ii[0] * aij[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } prod_l[1] = t1_l; prod_t[1] = t1_t; } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { /* Compute complex-extra = complex-extra * complex-double. */ double a0_l, a0_t; double a1_l, a1_t; double t1_l, t1_t; double t2_l, t2_t; a0_l = sum_l[0]; a0_t = sum_t[0]; a1_l = sum_l[1]; a1_t = sum_t[1]; /* Real part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = alpha_i[0] * split; b1 = con - alpha_i[0]; b1 = con - b1; b2 = alpha_i[0] - b1; c11 = a0_l * alpha_i[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * alpha_i[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = alpha_i[1] * split; b1 = con - alpha_i[1]; b1 = con - b1; b2 = alpha_i[1] - b1; c11 = a1_l * alpha_i[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * alpha_i[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[0] = t1_l; tmp1_t[0] = t1_t; /* Imaginary part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = alpha_i[0] * split; b1 = con - alpha_i[0]; b1 = con - b1; b2 = alpha_i[0] - b1; c11 = a1_l * alpha_i[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * alpha_i[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = alpha_i[1] * split; b1 = con - alpha_i[1]; b1 = con - b1; b2 = alpha_i[1] - b1; c11 = a0_l * alpha_i[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * alpha_i[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[1] = t1_l; tmp1_t[1] = t1_t; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { /* Compute complex-extra = complex-double * complex-double. */ double t1_l, t1_t; double t2_l, t2_t; /* Real part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[0] * split; a1 = con - beta_i[0]; a1 = con - a1; a2 = beta_i[0] - a1; con = y_jj[0] * split; b1 = con - y_jj[0]; b1 = con - b1; b2 = y_jj[0] - b1; t1_l = beta_i[0] * y_jj[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[1] * split; a1 = con - beta_i[1]; a1 = con - a1; a2 = beta_i[1] - a1; con = y_jj[1] * split; b1 = con - y_jj[1]; b1 = con - b1; b2 = y_jj[1] - b1; t2_l = beta_i[1] * y_jj[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp2_l[0] = t1_l; tmp2_t[0] = t1_t; /* Imaginary part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[1] * split; a1 = con - beta_i[1]; a1 = con - a1; a2 = beta_i[1] - a1; con = y_jj[0] * split; b1 = con - y_jj[0]; b1 = con - b1; b2 = y_jj[0] - b1; t1_l = beta_i[1] * y_jj[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[0] * split; a1 = con - beta_i[0]; a1 = con - a1; a2 = beta_i[0] - a1; con = y_jj[1] * split; b1 = con - y_jj[1]; b1 = con - b1; b2 = y_jj[1] - b1; t2_l = beta_i[0] * y_jj[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp2_l[1] = t1_l; tmp2_t[1] = t1_t; } /* tmp2 = y[jy]*beta */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = tmp1_l[0]; a_t = tmp1_t[0]; b_l = tmp2_l[0]; b_t = tmp2_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[0] = t_l; tmp1_t[0] = t_t; /* Imaginary part */ a_l = tmp1_l[1]; a_t = tmp1_t[1]; b_l = tmp2_l[1]; b_t = tmp2_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[1] = t_l; tmp1_t[1] = t_t; } /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1_l[0]; y_i[jy+1] = tmp1_l[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; } } /* end c_zSYMV_x */ void c_cSYMV_x(enum blas_order_type order, enum blas_uplo_type uplo, int n, void* alpha, void* a, int lda, void* x, int incx, void* beta, void* y, int incy, enum blas_prec_type prec) { switch ( prec ) { case blas_prec_single: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; float *y_i = (float*) y; const float *a_i = (float*) a; const float *x_i = (float*) x; float *alpha_i = (float*) alpha; float *beta_i = (float*) beta; float y_ii[2]; float y_jj[2]; float aij[2]; float x_ii[2]; float prod1[2]; /* case y = beta * y */ float prod[2]; float sum[2]; float tmp1[2]; float tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incx *= 2; incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum[0] = sum[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum[0] = sum[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; case blas_prec_double: case blas_prec_indigenous: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; float *y_i = (float*) y; const float *a_i = (float*) a; const float *x_i = (float*) x; float *alpha_i = (float*) alpha; float *beta_i = (float*) beta; float y_ii[2]; float y_jj[2]; float aij[2]; float x_ii[2]; float prod1[2]; /* case y = beta * y */ double prod[2]; double sum[2]; double tmp1[2]; double tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incx *= 2; incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum[0] = sum[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum[0] = sum[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; case blas_prec_extra: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; float *y_i = (float*) y; const float *a_i = (float*) a; const float *x_i = (float*) x; float *alpha_i = (float*) alpha; float *beta_i = (float*) beta; float y_ii[2]; float y_jj[2]; float aij[2]; float x_ii[2]; float prod1[2]; /* case y = beta * y */ double prod_l[2], prod_t[2]; double sum_l[2], sum_t[2]; double tmp1_l[2], tmp1_t[2]; double tmp2_l[2], tmp2_t[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incx *= 2; incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum_l[0] = sum_l[1] = sum_t[0] = sum_t[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { double e1_l, e1_t; double d1; double d2; /* Real part */ d1 = x_ii[0] * aij[0]; d2 = -x_ii[1] * aij[1]; { /* Compute double-double = double + double. */ double e, t1, t2; /* Knuth trick. */ t1 = d1 + d2; e = t1 - d1; t2 = ((d2 - e) + (d1 - (t1 - e))); /* The result is t1 + t2, after normalization. */ e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } prod_l[0] = e1_l; prod_t[0] = e1_t; /* imaginary part */ d1 = x_ii[0] * aij[1]; d2 = x_ii[1] * aij[0]; { /* Compute double-double = double + double. */ double e, t1, t2; /* Knuth trick. */ t1 = d1 + d2; e = t1 - d1; t2 = ((d2 - e) + (d1 - (t1 - e))); /* The result is t1 + t2, after normalization. */ e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } prod_l[1] = e1_l; prod_t[1] = e1_t; } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { double e1_l, e1_t; double d1; double d2; /* Real part */ d1 = x_ii[0] * aij[0]; d2 = -x_ii[1] * aij[1]; { /* Compute double-double = double + double. */ double e, t1, t2; /* Knuth trick. */ t1 = d1 + d2; e = t1 - d1; t2 = ((d2 - e) + (d1 - (t1 - e))); /* The result is t1 + t2, after normalization. */ e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } prod_l[0] = e1_l; prod_t[0] = e1_t; /* imaginary part */ d1 = x_ii[0] * aij[1]; d2 = x_ii[1] * aij[0]; { /* Compute double-double = double + double. */ double e, t1, t2; /* Knuth trick. */ t1 = d1 + d2; e = t1 - d1; t2 = ((d2 - e) + (d1 - (t1 - e))); /* The result is t1 + t2, after normalization. */ e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } prod_l[1] = e1_l; prod_t[1] = e1_t; } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { double cd[2]; cd[0] = (double) alpha_i[0]; cd[1] = (double) alpha_i[1]; { /* Compute complex-extra = complex-extra * complex-double. */ double a0_l, a0_t; double a1_l, a1_t; double t1_l, t1_t; double t2_l, t2_t; a0_l = sum_l[0]; a0_t = sum_t[0]; a1_l = sum_l[1]; a1_t = sum_t[1]; /* Real part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = cd[0] * split; b1 = con - cd[0]; b1 = con - b1; b2 = cd[0] - b1; c11 = a0_l * cd[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * cd[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = cd[1] * split; b1 = con - cd[1]; b1 = con - b1; b2 = cd[1] - b1; c11 = a1_l * cd[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * cd[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[0] = t1_l; tmp1_t[0] = t1_t; /* Imaginary part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = cd[0] * split; b1 = con - cd[0]; b1 = con - b1; b2 = cd[0] - b1; c11 = a1_l * cd[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * cd[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = cd[1] * split; b1 = con - cd[1]; b1 = con - b1; b2 = cd[1] - b1; c11 = a0_l * cd[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * cd[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[1] = t1_l; tmp1_t[1] = t1_t; } } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { double e1_l, e1_t; double d1; double d2; /* Real part */ d1 = beta_i[0] * y_jj[0]; d2 = -beta_i[1] * y_jj[1]; { /* Compute double-double = double + double. */ double e, t1, t2; /* Knuth trick. */ t1 = d1 + d2; e = t1 - d1; t2 = ((d2 - e) + (d1 - (t1 - e))); /* The result is t1 + t2, after normalization. */ e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } tmp2_l[0] = e1_l; tmp2_t[0] = e1_t; /* imaginary part */ d1 = beta_i[0] * y_jj[1]; d2 = beta_i[1] * y_jj[0]; { /* Compute double-double = double + double. */ double e, t1, t2; /* Knuth trick. */ t1 = d1 + d2; e = t1 - d1; t2 = ((d2 - e) + (d1 - (t1 - e))); /* The result is t1 + t2, after normalization. */ e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } tmp2_l[1] = e1_l; tmp2_t[1] = e1_t; } /* tmp2 = y[jy]*beta */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = tmp1_l[0]; a_t = tmp1_t[0]; b_l = tmp2_l[0]; b_t = tmp2_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[0] = t_l; tmp1_t[0] = t_t; /* Imaginary part */ a_l = tmp1_l[1]; a_t = tmp1_t[1]; b_l = tmp2_l[1]; b_t = tmp2_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[1] = t_l; tmp1_t[1] = t_t; } /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1_l[0]; y_i[jy+1] = tmp1_l[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum_l[0] = sum_l[1] = sum_t[0] = sum_t[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { double e1_l, e1_t; double d1; double d2; /* Real part */ d1 = x_ii[0] * aij[0]; d2 = -x_ii[1] * aij[1]; { /* Compute double-double = double + double. */ double e, t1, t2; /* Knuth trick. */ t1 = d1 + d2; e = t1 - d1; t2 = ((d2 - e) + (d1 - (t1 - e))); /* The result is t1 + t2, after normalization. */ e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } prod_l[0] = e1_l; prod_t[0] = e1_t; /* imaginary part */ d1 = x_ii[0] * aij[1]; d2 = x_ii[1] * aij[0]; { /* Compute double-double = double + double. */ double e, t1, t2; /* Knuth trick. */ t1 = d1 + d2; e = t1 - d1; t2 = ((d2 - e) + (d1 - (t1 - e))); /* The result is t1 + t2, after normalization. */ e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } prod_l[1] = e1_l; prod_t[1] = e1_t; } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { double e1_l, e1_t; double d1; double d2; /* Real part */ d1 = x_ii[0] * aij[0]; d2 = -x_ii[1] * aij[1]; { /* Compute double-double = double + double. */ double e, t1, t2; /* Knuth trick. */ t1 = d1 + d2; e = t1 - d1; t2 = ((d2 - e) + (d1 - (t1 - e))); /* The result is t1 + t2, after normalization. */ e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } prod_l[0] = e1_l; prod_t[0] = e1_t; /* imaginary part */ d1 = x_ii[0] * aij[1]; d2 = x_ii[1] * aij[0]; { /* Compute double-double = double + double. */ double e, t1, t2; /* Knuth trick. */ t1 = d1 + d2; e = t1 - d1; t2 = ((d2 - e) + (d1 - (t1 - e))); /* The result is t1 + t2, after normalization. */ e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } prod_l[1] = e1_l; prod_t[1] = e1_t; } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { double cd[2]; cd[0] = (double) alpha_i[0]; cd[1] = (double) alpha_i[1]; { /* Compute complex-extra = complex-extra * complex-double. */ double a0_l, a0_t; double a1_l, a1_t; double t1_l, t1_t; double t2_l, t2_t; a0_l = sum_l[0]; a0_t = sum_t[0]; a1_l = sum_l[1]; a1_t = sum_t[1]; /* Real part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = cd[0] * split; b1 = con - cd[0]; b1 = con - b1; b2 = cd[0] - b1; c11 = a0_l * cd[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * cd[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = cd[1] * split; b1 = con - cd[1]; b1 = con - b1; b2 = cd[1] - b1; c11 = a1_l * cd[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * cd[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[0] = t1_l; tmp1_t[0] = t1_t; /* Imaginary part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = cd[0] * split; b1 = con - cd[0]; b1 = con - b1; b2 = cd[0] - b1; c11 = a1_l * cd[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * cd[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = cd[1] * split; b1 = con - cd[1]; b1 = con - b1; b2 = cd[1] - b1; c11 = a0_l * cd[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * cd[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[1] = t1_l; tmp1_t[1] = t1_t; } } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { double e1_l, e1_t; double d1; double d2; /* Real part */ d1 = beta_i[0] * y_jj[0]; d2 = -beta_i[1] * y_jj[1]; { /* Compute double-double = double + double. */ double e, t1, t2; /* Knuth trick. */ t1 = d1 + d2; e = t1 - d1; t2 = ((d2 - e) + (d1 - (t1 - e))); /* The result is t1 + t2, after normalization. */ e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } tmp2_l[0] = e1_l; tmp2_t[0] = e1_t; /* imaginary part */ d1 = beta_i[0] * y_jj[1]; d2 = beta_i[1] * y_jj[0]; { /* Compute double-double = double + double. */ double e, t1, t2; /* Knuth trick. */ t1 = d1 + d2; e = t1 - d1; t2 = ((d2 - e) + (d1 - (t1 - e))); /* The result is t1 + t2, after normalization. */ e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } tmp2_l[1] = e1_l; tmp2_t[1] = e1_t; } /* tmp2 = y[jy]*beta */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = tmp1_l[0]; a_t = tmp1_t[0]; b_l = tmp2_l[0]; b_t = tmp2_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[0] = t_l; tmp1_t[0] = t_t; /* Imaginary part */ a_l = tmp1_l[1]; a_t = tmp1_t[1]; b_l = tmp2_l[1]; b_t = tmp2_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[1] = t_l; tmp1_t[1] = t_t; } /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1_l[0]; y_i[jy+1] = tmp1_l[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; } } /* end c_cSYMV_x */ void c_dSYMV_s_s_x(enum blas_order_type order, enum blas_uplo_type uplo, int n, double alpha, float* a, int lda, float* x, int incx, double beta, double* y, int incy, enum blas_prec_type prec) { switch ( prec ) { case blas_prec_single: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = y; const float *a_i = a; const float *x_i = x; double alpha_i = alpha; double beta_i = beta; double y_ii; double y_jj; float aij; float x_ii; double prod1; /* case y = beta * y */ float prod; float sum; double tmp1; double tmp2; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i == 0.0 && (beta_i == 1.0)))){ return; } /* Set up start points in x and y */ ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i == 0.0){ if(beta_i == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii = y_i[iy]; prod1 = y_ii * beta_i; /* prod1 = beta*y[iy]*/ y_i[iy] = prod1; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmp1 = sum * alpha_i; /* tmp1 = sum*alpha */ y_jj = y_i[jy]; tmp2 = beta_i * y_jj; /* tmp2 = y[jy]*beta */ tmp1 = tmp1 + tmp2; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } tmp1 = sum * alpha_i; /* tmp1 = sum*alpha */ y_jj = y_i[jy]; tmp2 = beta_i * y_jj; /* tmp2 = y[jy]*beta */ tmp1 = tmp1 + tmp2; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; case blas_prec_double: case blas_prec_indigenous: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = y; const float *a_i = a; const float *x_i = x; double alpha_i = alpha; double beta_i = beta; double y_ii; double y_jj; float aij; float x_ii; double prod1; /* case y = beta * y */ double prod; double sum; double tmp1; double tmp2; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i == 0.0 && (beta_i == 1.0)))){ return; } /* Set up start points in x and y */ ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i == 0.0){ if(beta_i == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii = y_i[iy]; prod1 = y_ii * beta_i; /* prod1 = beta*y[iy]*/ y_i[iy] = prod1; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = (double) x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = (double) x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmp1 = sum * alpha_i; /* tmp1 = sum*alpha */ y_jj = y_i[jy]; tmp2 = beta_i * y_jj; /* tmp2 = y[jy]*beta */ tmp1 = tmp1 + tmp2; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = (double) x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = (double) x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } tmp1 = sum * alpha_i; /* tmp1 = sum*alpha */ y_jj = y_i[jy]; tmp2 = beta_i * y_jj; /* tmp2 = y[jy]*beta */ tmp1 = tmp1 + tmp2; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; case blas_prec_extra: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = y; const float *a_i = a; const float *x_i = x; double alpha_i = alpha; double beta_i = beta; double y_ii; double y_jj; float aij; float x_ii; double prod1; /* case y = beta * y */ double prod_l, prod_t; double sum_l, sum_t; double tmp1_l, tmp1_t; double tmp2_l, tmp2_t; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i == 0.0 && (beta_i == 1.0)))){ return; } /* Set up start points in x and y */ ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i == 0.0){ if(beta_i == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii = y_i[iy]; prod1 = y_ii * beta_i; /* prod1 = beta*y[iy]*/ y_i[iy] = prod1; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum_l = sum_t = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod_l = x_ii * aij; prod_t = 0.0; /* prod = a[tmpind]*x[i] */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = sum_l + prod_l; e = t1 - sum_l; t2 = ((prod_l - e) + (sum_l - (t1 - e))) + sum_t + prod_t; /* The result is t1 + t2, after normalization. */ sum_l = t1 + t2; sum_t = t2 - (sum_l - t1); } /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod_l = x_ii * aij; prod_t = 0.0; /* prod = a[tmpind]*x[i] */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = sum_l + prod_l; e = t1 - sum_l; t2 = ((prod_l - e) + (sum_l - (t1 - e))) + sum_t + prod_t; /* The result is t1 + t2, after normalization. */ sum_l = t1 + t2; sum_t = t2 - (sum_l - t1); } /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = sum_l * split; a11 = con - sum_l; a11 = con - a11; a21 = sum_l - a11; con = alpha_i * split; b1 = con - alpha_i; b1 = con - b1; b2 = alpha_i - b1; c11 = sum_l * alpha_i; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = sum_t * alpha_i; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; tmp1_l = t1 + t2; tmp1_t = t2 - (tmp1_l - t1); } /* tmp1 = sum*alpha */ y_jj = y_i[jy]; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i * split; a1 = con - beta_i; a1 = con - a1; a2 = beta_i - a1; con = y_jj * split; b1 = con - y_jj; b1 = con - b1; b2 = y_jj - b1; tmp2_l = beta_i * y_jj; tmp2_t = (((a1 * b1 - tmp2_l) + a1 * b2) + a2 * b1) + a2 * b2; } /* tmp2 = y[jy]*beta */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = tmp1_l + tmp2_l; e = t1 - tmp1_l; t2 = ((tmp2_l - e) + (tmp1_l - (t1 - e))) + tmp1_t + tmp2_t; /* The result is t1 + t2, after normalization. */ tmp1_l = t1 + t2; tmp1_t = t2 - (tmp1_l - t1); } /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1_l; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum_l = sum_t = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod_l = x_ii * aij; prod_t = 0.0; /* prod = a[tmpind]*x[i] */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = sum_l + prod_l; e = t1 - sum_l; t2 = ((prod_l - e) + (sum_l - (t1 - e))) + sum_t + prod_t; /* The result is t1 + t2, after normalization. */ sum_l = t1 + t2; sum_t = t2 - (sum_l - t1); } /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod_l = x_ii * aij; prod_t = 0.0; /* prod = a[tmpind]*x[i] */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = sum_l + prod_l; e = t1 - sum_l; t2 = ((prod_l - e) + (sum_l - (t1 - e))) + sum_t + prod_t; /* The result is t1 + t2, after normalization. */ sum_l = t1 + t2; sum_t = t2 - (sum_l - t1); } /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = sum_l * split; a11 = con - sum_l; a11 = con - a11; a21 = sum_l - a11; con = alpha_i * split; b1 = con - alpha_i; b1 = con - b1; b2 = alpha_i - b1; c11 = sum_l * alpha_i; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = sum_t * alpha_i; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; tmp1_l = t1 + t2; tmp1_t = t2 - (tmp1_l - t1); } /* tmp1 = sum*alpha */ y_jj = y_i[jy]; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i * split; a1 = con - beta_i; a1 = con - a1; a2 = beta_i - a1; con = y_jj * split; b1 = con - y_jj; b1 = con - b1; b2 = y_jj - b1; tmp2_l = beta_i * y_jj; tmp2_t = (((a1 * b1 - tmp2_l) + a1 * b2) + a2 * b1) + a2 * b2; } /* tmp2 = y[jy]*beta */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = tmp1_l + tmp2_l; e = t1 - tmp1_l; t2 = ((tmp2_l - e) + (tmp1_l - (t1 - e))) + tmp1_t + tmp2_t; /* The result is t1 + t2, after normalization. */ tmp1_l = t1 + t2; tmp1_t = t2 - (tmp1_l - t1); } /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1_l; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; } } /* end c_dSYMV_s_s_x */ void c_dSYMV_s_d_x(enum blas_order_type order, enum blas_uplo_type uplo, int n, double alpha, float* a, int lda, double* x, int incx, double beta, double* y, int incy, enum blas_prec_type prec) { switch ( prec ) { case blas_prec_single: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = y; const float *a_i = a; const double *x_i = x; double alpha_i = alpha; double beta_i = beta; double y_ii; double y_jj; float aij; double x_ii; double prod1; /* case y = beta * y */ double prod; double sum; double tmp1; double tmp2; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i == 0.0 && (beta_i == 1.0)))){ return; } /* Set up start points in x and y */ ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i == 0.0){ if(beta_i == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii = y_i[iy]; prod1 = y_ii * beta_i; /* prod1 = beta*y[iy]*/ y_i[iy] = prod1; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmp1 = sum * alpha_i; /* tmp1 = sum*alpha */ y_jj = y_i[jy]; tmp2 = beta_i * y_jj; /* tmp2 = y[jy]*beta */ tmp1 = tmp1 + tmp2; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } tmp1 = sum * alpha_i; /* tmp1 = sum*alpha */ y_jj = y_i[jy]; tmp2 = beta_i * y_jj; /* tmp2 = y[jy]*beta */ tmp1 = tmp1 + tmp2; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; case blas_prec_double: case blas_prec_indigenous: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = y; const float *a_i = a; const double *x_i = x; double alpha_i = alpha; double beta_i = beta; double y_ii; double y_jj; float aij; double x_ii; double prod1; /* case y = beta * y */ double prod; double sum; double tmp1; double tmp2; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i == 0.0 && (beta_i == 1.0)))){ return; } /* Set up start points in x and y */ ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i == 0.0){ if(beta_i == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii = y_i[iy]; prod1 = y_ii * beta_i; /* prod1 = beta*y[iy]*/ y_i[iy] = prod1; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmp1 = sum * alpha_i; /* tmp1 = sum*alpha */ y_jj = y_i[jy]; tmp2 = beta_i * y_jj; /* tmp2 = y[jy]*beta */ tmp1 = tmp1 + tmp2; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } tmp1 = sum * alpha_i; /* tmp1 = sum*alpha */ y_jj = y_i[jy]; tmp2 = beta_i * y_jj; /* tmp2 = y[jy]*beta */ tmp1 = tmp1 + tmp2; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; case blas_prec_extra: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = y; const float *a_i = a; const double *x_i = x; double alpha_i = alpha; double beta_i = beta; double y_ii; double y_jj; float aij; double x_ii; double prod1; /* case y = beta * y */ double prod_l, prod_t; double sum_l, sum_t; double tmp1_l, tmp1_t; double tmp2_l, tmp2_t; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i == 0.0 && (beta_i == 1.0)))){ return; } /* Set up start points in x and y */ ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i == 0.0){ if(beta_i == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii = y_i[iy]; prod1 = y_ii * beta_i; /* prod1 = beta*y[iy]*/ y_i[iy] = prod1; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum_l = sum_t = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; { double dt = (double) aij; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii * split; a1 = con - x_ii; a1 = con - a1; a2 = x_ii - a1; con = dt * split; b1 = con - dt; b1 = con - b1; b2 = dt - b1; prod_l = x_ii * dt; prod_t = (((a1 * b1 - prod_l) + a1 * b2) + a2 * b1) + a2 * b2; } } /* prod = a[tmpind]*x[i] */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = sum_l + prod_l; e = t1 - sum_l; t2 = ((prod_l - e) + (sum_l - (t1 - e))) + sum_t + prod_t; /* The result is t1 + t2, after normalization. */ sum_l = t1 + t2; sum_t = t2 - (sum_l - t1); } /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; { double dt = (double) aij; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii * split; a1 = con - x_ii; a1 = con - a1; a2 = x_ii - a1; con = dt * split; b1 = con - dt; b1 = con - b1; b2 = dt - b1; prod_l = x_ii * dt; prod_t = (((a1 * b1 - prod_l) + a1 * b2) + a2 * b1) + a2 * b2; } } /* prod = a[tmpind]*x[i] */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = sum_l + prod_l; e = t1 - sum_l; t2 = ((prod_l - e) + (sum_l - (t1 - e))) + sum_t + prod_t; /* The result is t1 + t2, after normalization. */ sum_l = t1 + t2; sum_t = t2 - (sum_l - t1); } /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = sum_l * split; a11 = con - sum_l; a11 = con - a11; a21 = sum_l - a11; con = alpha_i * split; b1 = con - alpha_i; b1 = con - b1; b2 = alpha_i - b1; c11 = sum_l * alpha_i; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = sum_t * alpha_i; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; tmp1_l = t1 + t2; tmp1_t = t2 - (tmp1_l - t1); } /* tmp1 = sum*alpha */ y_jj = y_i[jy]; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i * split; a1 = con - beta_i; a1 = con - a1; a2 = beta_i - a1; con = y_jj * split; b1 = con - y_jj; b1 = con - b1; b2 = y_jj - b1; tmp2_l = beta_i * y_jj; tmp2_t = (((a1 * b1 - tmp2_l) + a1 * b2) + a2 * b1) + a2 * b2; } /* tmp2 = y[jy]*beta */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = tmp1_l + tmp2_l; e = t1 - tmp1_l; t2 = ((tmp2_l - e) + (tmp1_l - (t1 - e))) + tmp1_t + tmp2_t; /* The result is t1 + t2, after normalization. */ tmp1_l = t1 + t2; tmp1_t = t2 - (tmp1_l - t1); } /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1_l; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum_l = sum_t = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; { double dt = (double) aij; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii * split; a1 = con - x_ii; a1 = con - a1; a2 = x_ii - a1; con = dt * split; b1 = con - dt; b1 = con - b1; b2 = dt - b1; prod_l = x_ii * dt; prod_t = (((a1 * b1 - prod_l) + a1 * b2) + a2 * b1) + a2 * b2; } } /* prod = a[tmpind]*x[i] */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = sum_l + prod_l; e = t1 - sum_l; t2 = ((prod_l - e) + (sum_l - (t1 - e))) + sum_t + prod_t; /* The result is t1 + t2, after normalization. */ sum_l = t1 + t2; sum_t = t2 - (sum_l - t1); } /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; { double dt = (double) aij; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii * split; a1 = con - x_ii; a1 = con - a1; a2 = x_ii - a1; con = dt * split; b1 = con - dt; b1 = con - b1; b2 = dt - b1; prod_l = x_ii * dt; prod_t = (((a1 * b1 - prod_l) + a1 * b2) + a2 * b1) + a2 * b2; } } /* prod = a[tmpind]*x[i] */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = sum_l + prod_l; e = t1 - sum_l; t2 = ((prod_l - e) + (sum_l - (t1 - e))) + sum_t + prod_t; /* The result is t1 + t2, after normalization. */ sum_l = t1 + t2; sum_t = t2 - (sum_l - t1); } /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = sum_l * split; a11 = con - sum_l; a11 = con - a11; a21 = sum_l - a11; con = alpha_i * split; b1 = con - alpha_i; b1 = con - b1; b2 = alpha_i - b1; c11 = sum_l * alpha_i; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = sum_t * alpha_i; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; tmp1_l = t1 + t2; tmp1_t = t2 - (tmp1_l - t1); } /* tmp1 = sum*alpha */ y_jj = y_i[jy]; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i * split; a1 = con - beta_i; a1 = con - a1; a2 = beta_i - a1; con = y_jj * split; b1 = con - y_jj; b1 = con - b1; b2 = y_jj - b1; tmp2_l = beta_i * y_jj; tmp2_t = (((a1 * b1 - tmp2_l) + a1 * b2) + a2 * b1) + a2 * b2; } /* tmp2 = y[jy]*beta */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = tmp1_l + tmp2_l; e = t1 - tmp1_l; t2 = ((tmp2_l - e) + (tmp1_l - (t1 - e))) + tmp1_t + tmp2_t; /* The result is t1 + t2, after normalization. */ tmp1_l = t1 + t2; tmp1_t = t2 - (tmp1_l - t1); } /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1_l; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; } } /* end c_dSYMV_s_d_x */ void c_dSYMV_d_s_x(enum blas_order_type order, enum blas_uplo_type uplo, int n, double alpha, double* a, int lda, float* x, int incx, double beta, double* y, int incy, enum blas_prec_type prec) { switch ( prec ) { case blas_prec_single: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = y; const double *a_i = a; const float *x_i = x; double alpha_i = alpha; double beta_i = beta; double y_ii; double y_jj; double aij; float x_ii; double prod1; /* case y = beta * y */ double prod; double sum; double tmp1; double tmp2; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i == 0.0 && (beta_i == 1.0)))){ return; } /* Set up start points in x and y */ ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i == 0.0){ if(beta_i == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii = y_i[iy]; prod1 = y_ii * beta_i; /* prod1 = beta*y[iy]*/ y_i[iy] = prod1; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmp1 = sum * alpha_i; /* tmp1 = sum*alpha */ y_jj = y_i[jy]; tmp2 = beta_i * y_jj; /* tmp2 = y[jy]*beta */ tmp1 = tmp1 + tmp2; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } tmp1 = sum * alpha_i; /* tmp1 = sum*alpha */ y_jj = y_i[jy]; tmp2 = beta_i * y_jj; /* tmp2 = y[jy]*beta */ tmp1 = tmp1 + tmp2; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; case blas_prec_double: case blas_prec_indigenous: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = y; const double *a_i = a; const float *x_i = x; double alpha_i = alpha; double beta_i = beta; double y_ii; double y_jj; double aij; float x_ii; double prod1; /* case y = beta * y */ double prod; double sum; double tmp1; double tmp2; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i == 0.0 && (beta_i == 1.0)))){ return; } /* Set up start points in x and y */ ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i == 0.0){ if(beta_i == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii = y_i[iy]; prod1 = y_ii * beta_i; /* prod1 = beta*y[iy]*/ y_i[iy] = prod1; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmp1 = sum * alpha_i; /* tmp1 = sum*alpha */ y_jj = y_i[jy]; tmp2 = beta_i * y_jj; /* tmp2 = y[jy]*beta */ tmp1 = tmp1 + tmp2; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } tmp1 = sum * alpha_i; /* tmp1 = sum*alpha */ y_jj = y_i[jy]; tmp2 = beta_i * y_jj; /* tmp2 = y[jy]*beta */ tmp1 = tmp1 + tmp2; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; case blas_prec_extra: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = y; const double *a_i = a; const float *x_i = x; double alpha_i = alpha; double beta_i = beta; double y_ii; double y_jj; double aij; float x_ii; double prod1; /* case y = beta * y */ double prod_l, prod_t; double sum_l, sum_t; double tmp1_l, tmp1_t; double tmp2_l, tmp2_t; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i == 0.0 && (beta_i == 1.0)))){ return; } /* Set up start points in x and y */ ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i == 0.0){ if(beta_i == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii = y_i[iy]; prod1 = y_ii * beta_i; /* prod1 = beta*y[iy]*/ y_i[iy] = prod1; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum_l = sum_t = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; { double dt = (double) x_ii; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = dt * split; a1 = con - dt; a1 = con - a1; a2 = dt - a1; con = aij * split; b1 = con - aij; b1 = con - b1; b2 = aij - b1; prod_l = dt * aij; prod_t = (((a1 * b1 - prod_l) + a1 * b2) + a2 * b1) + a2 * b2; } } /* prod = a[tmpind]*x[i] */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = sum_l + prod_l; e = t1 - sum_l; t2 = ((prod_l - e) + (sum_l - (t1 - e))) + sum_t + prod_t; /* The result is t1 + t2, after normalization. */ sum_l = t1 + t2; sum_t = t2 - (sum_l - t1); } /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; { double dt = (double) x_ii; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = dt * split; a1 = con - dt; a1 = con - a1; a2 = dt - a1; con = aij * split; b1 = con - aij; b1 = con - b1; b2 = aij - b1; prod_l = dt * aij; prod_t = (((a1 * b1 - prod_l) + a1 * b2) + a2 * b1) + a2 * b2; } } /* prod = a[tmpind]*x[i] */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = sum_l + prod_l; e = t1 - sum_l; t2 = ((prod_l - e) + (sum_l - (t1 - e))) + sum_t + prod_t; /* The result is t1 + t2, after normalization. */ sum_l = t1 + t2; sum_t = t2 - (sum_l - t1); } /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = sum_l * split; a11 = con - sum_l; a11 = con - a11; a21 = sum_l - a11; con = alpha_i * split; b1 = con - alpha_i; b1 = con - b1; b2 = alpha_i - b1; c11 = sum_l * alpha_i; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = sum_t * alpha_i; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; tmp1_l = t1 + t2; tmp1_t = t2 - (tmp1_l - t1); } /* tmp1 = sum*alpha */ y_jj = y_i[jy]; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i * split; a1 = con - beta_i; a1 = con - a1; a2 = beta_i - a1; con = y_jj * split; b1 = con - y_jj; b1 = con - b1; b2 = y_jj - b1; tmp2_l = beta_i * y_jj; tmp2_t = (((a1 * b1 - tmp2_l) + a1 * b2) + a2 * b1) + a2 * b2; } /* tmp2 = y[jy]*beta */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = tmp1_l + tmp2_l; e = t1 - tmp1_l; t2 = ((tmp2_l - e) + (tmp1_l - (t1 - e))) + tmp1_t + tmp2_t; /* The result is t1 + t2, after normalization. */ tmp1_l = t1 + t2; tmp1_t = t2 - (tmp1_l - t1); } /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1_l; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum_l = sum_t = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; { double dt = (double) x_ii; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = dt * split; a1 = con - dt; a1 = con - a1; a2 = dt - a1; con = aij * split; b1 = con - aij; b1 = con - b1; b2 = aij - b1; prod_l = dt * aij; prod_t = (((a1 * b1 - prod_l) + a1 * b2) + a2 * b1) + a2 * b2; } } /* prod = a[tmpind]*x[i] */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = sum_l + prod_l; e = t1 - sum_l; t2 = ((prod_l - e) + (sum_l - (t1 - e))) + sum_t + prod_t; /* The result is t1 + t2, after normalization. */ sum_l = t1 + t2; sum_t = t2 - (sum_l - t1); } /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; { double dt = (double) x_ii; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = dt * split; a1 = con - dt; a1 = con - a1; a2 = dt - a1; con = aij * split; b1 = con - aij; b1 = con - b1; b2 = aij - b1; prod_l = dt * aij; prod_t = (((a1 * b1 - prod_l) + a1 * b2) + a2 * b1) + a2 * b2; } } /* prod = a[tmpind]*x[i] */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = sum_l + prod_l; e = t1 - sum_l; t2 = ((prod_l - e) + (sum_l - (t1 - e))) + sum_t + prod_t; /* The result is t1 + t2, after normalization. */ sum_l = t1 + t2; sum_t = t2 - (sum_l - t1); } /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = sum_l * split; a11 = con - sum_l; a11 = con - a11; a21 = sum_l - a11; con = alpha_i * split; b1 = con - alpha_i; b1 = con - b1; b2 = alpha_i - b1; c11 = sum_l * alpha_i; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = sum_t * alpha_i; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; tmp1_l = t1 + t2; tmp1_t = t2 - (tmp1_l - t1); } /* tmp1 = sum*alpha */ y_jj = y_i[jy]; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i * split; a1 = con - beta_i; a1 = con - a1; a2 = beta_i - a1; con = y_jj * split; b1 = con - y_jj; b1 = con - b1; b2 = y_jj - b1; tmp2_l = beta_i * y_jj; tmp2_t = (((a1 * b1 - tmp2_l) + a1 * b2) + a2 * b1) + a2 * b2; } /* tmp2 = y[jy]*beta */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = tmp1_l + tmp2_l; e = t1 - tmp1_l; t2 = ((tmp2_l - e) + (tmp1_l - (t1 - e))) + tmp1_t + tmp2_t; /* The result is t1 + t2, after normalization. */ tmp1_l = t1 + t2; tmp1_t = t2 - (tmp1_l - t1); } /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1_l; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; } } /* end c_dSYMV_d_s_x */ void c_zSYMV_c_c_x(enum blas_order_type order, enum blas_uplo_type uplo, int n, void* alpha, void* a, int lda, void* x, int incx, void* beta, void* y, int incy, enum blas_prec_type prec) { switch ( prec ) { case blas_prec_single: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = (double*) y; const float *a_i = (float*) a; const float *x_i = (float*) x; double *alpha_i = (double*) alpha; double *beta_i = (double*) beta; double y_ii[2]; double y_jj[2]; float aij[2]; float x_ii[2]; double prod1[2]; /* case y = beta * y */ float prod[2]; float sum[2]; double tmp1[2]; double tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incx *= 2; incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum[0] = sum[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum[0] = sum[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; case blas_prec_double: case blas_prec_indigenous: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = (double*) y; const float *a_i = (float*) a; const float *x_i = (float*) x; double *alpha_i = (double*) alpha; double *beta_i = (double*) beta; double y_ii[2]; double y_jj[2]; float aij[2]; float x_ii[2]; double prod1[2]; /* case y = beta * y */ double prod[2]; double sum[2]; double tmp1[2]; double tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incx *= 2; incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum[0] = sum[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum[0] = sum[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; case blas_prec_extra: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = (double*) y; const float *a_i = (float*) a; const float *x_i = (float*) x; double *alpha_i = (double*) alpha; double *beta_i = (double*) beta; double y_ii[2]; double y_jj[2]; float aij[2]; float x_ii[2]; double prod1[2]; /* case y = beta * y */ double prod_l[2], prod_t[2]; double sum_l[2], sum_t[2]; double tmp1_l[2], tmp1_t[2]; double tmp2_l[2], tmp2_t[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incx *= 2; incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum_l[0] = sum_l[1] = sum_t[0] = sum_t[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { double e1_l, e1_t; double d1; double d2; /* Real part */ d1 = x_ii[0] * aij[0]; d2 = -x_ii[1] * aij[1]; { /* Compute double-double = double + double. */ double e, t1, t2; /* Knuth trick. */ t1 = d1 + d2; e = t1 - d1; t2 = ((d2 - e) + (d1 - (t1 - e))); /* The result is t1 + t2, after normalization. */ e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } prod_l[0] = e1_l; prod_t[0] = e1_t; /* imaginary part */ d1 = x_ii[0] * aij[1]; d2 = x_ii[1] * aij[0]; { /* Compute double-double = double + double. */ double e, t1, t2; /* Knuth trick. */ t1 = d1 + d2; e = t1 - d1; t2 = ((d2 - e) + (d1 - (t1 - e))); /* The result is t1 + t2, after normalization. */ e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } prod_l[1] = e1_l; prod_t[1] = e1_t; } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { double e1_l, e1_t; double d1; double d2; /* Real part */ d1 = x_ii[0] * aij[0]; d2 = -x_ii[1] * aij[1]; { /* Compute double-double = double + double. */ double e, t1, t2; /* Knuth trick. */ t1 = d1 + d2; e = t1 - d1; t2 = ((d2 - e) + (d1 - (t1 - e))); /* The result is t1 + t2, after normalization. */ e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } prod_l[0] = e1_l; prod_t[0] = e1_t; /* imaginary part */ d1 = x_ii[0] * aij[1]; d2 = x_ii[1] * aij[0]; { /* Compute double-double = double + double. */ double e, t1, t2; /* Knuth trick. */ t1 = d1 + d2; e = t1 - d1; t2 = ((d2 - e) + (d1 - (t1 - e))); /* The result is t1 + t2, after normalization. */ e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } prod_l[1] = e1_l; prod_t[1] = e1_t; } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { /* Compute complex-extra = complex-extra * complex-double. */ double a0_l, a0_t; double a1_l, a1_t; double t1_l, t1_t; double t2_l, t2_t; a0_l = sum_l[0]; a0_t = sum_t[0]; a1_l = sum_l[1]; a1_t = sum_t[1]; /* Real part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = alpha_i[0] * split; b1 = con - alpha_i[0]; b1 = con - b1; b2 = alpha_i[0] - b1; c11 = a0_l * alpha_i[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * alpha_i[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = alpha_i[1] * split; b1 = con - alpha_i[1]; b1 = con - b1; b2 = alpha_i[1] - b1; c11 = a1_l * alpha_i[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * alpha_i[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[0] = t1_l; tmp1_t[0] = t1_t; /* Imaginary part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = alpha_i[0] * split; b1 = con - alpha_i[0]; b1 = con - b1; b2 = alpha_i[0] - b1; c11 = a1_l * alpha_i[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * alpha_i[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = alpha_i[1] * split; b1 = con - alpha_i[1]; b1 = con - b1; b2 = alpha_i[1] - b1; c11 = a0_l * alpha_i[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * alpha_i[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[1] = t1_l; tmp1_t[1] = t1_t; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { /* Compute complex-extra = complex-double * complex-double. */ double t1_l, t1_t; double t2_l, t2_t; /* Real part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[0] * split; a1 = con - beta_i[0]; a1 = con - a1; a2 = beta_i[0] - a1; con = y_jj[0] * split; b1 = con - y_jj[0]; b1 = con - b1; b2 = y_jj[0] - b1; t1_l = beta_i[0] * y_jj[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[1] * split; a1 = con - beta_i[1]; a1 = con - a1; a2 = beta_i[1] - a1; con = y_jj[1] * split; b1 = con - y_jj[1]; b1 = con - b1; b2 = y_jj[1] - b1; t2_l = beta_i[1] * y_jj[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp2_l[0] = t1_l; tmp2_t[0] = t1_t; /* Imaginary part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[1] * split; a1 = con - beta_i[1]; a1 = con - a1; a2 = beta_i[1] - a1; con = y_jj[0] * split; b1 = con - y_jj[0]; b1 = con - b1; b2 = y_jj[0] - b1; t1_l = beta_i[1] * y_jj[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[0] * split; a1 = con - beta_i[0]; a1 = con - a1; a2 = beta_i[0] - a1; con = y_jj[1] * split; b1 = con - y_jj[1]; b1 = con - b1; b2 = y_jj[1] - b1; t2_l = beta_i[0] * y_jj[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp2_l[1] = t1_l; tmp2_t[1] = t1_t; } /* tmp2 = y[jy]*beta */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = tmp1_l[0]; a_t = tmp1_t[0]; b_l = tmp2_l[0]; b_t = tmp2_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[0] = t_l; tmp1_t[0] = t_t; /* Imaginary part */ a_l = tmp1_l[1]; a_t = tmp1_t[1]; b_l = tmp2_l[1]; b_t = tmp2_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[1] = t_l; tmp1_t[1] = t_t; } /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1_l[0]; y_i[jy+1] = tmp1_l[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum_l[0] = sum_l[1] = sum_t[0] = sum_t[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { double e1_l, e1_t; double d1; double d2; /* Real part */ d1 = x_ii[0] * aij[0]; d2 = -x_ii[1] * aij[1]; { /* Compute double-double = double + double. */ double e, t1, t2; /* Knuth trick. */ t1 = d1 + d2; e = t1 - d1; t2 = ((d2 - e) + (d1 - (t1 - e))); /* The result is t1 + t2, after normalization. */ e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } prod_l[0] = e1_l; prod_t[0] = e1_t; /* imaginary part */ d1 = x_ii[0] * aij[1]; d2 = x_ii[1] * aij[0]; { /* Compute double-double = double + double. */ double e, t1, t2; /* Knuth trick. */ t1 = d1 + d2; e = t1 - d1; t2 = ((d2 - e) + (d1 - (t1 - e))); /* The result is t1 + t2, after normalization. */ e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } prod_l[1] = e1_l; prod_t[1] = e1_t; } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { double e1_l, e1_t; double d1; double d2; /* Real part */ d1 = x_ii[0] * aij[0]; d2 = -x_ii[1] * aij[1]; { /* Compute double-double = double + double. */ double e, t1, t2; /* Knuth trick. */ t1 = d1 + d2; e = t1 - d1; t2 = ((d2 - e) + (d1 - (t1 - e))); /* The result is t1 + t2, after normalization. */ e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } prod_l[0] = e1_l; prod_t[0] = e1_t; /* imaginary part */ d1 = x_ii[0] * aij[1]; d2 = x_ii[1] * aij[0]; { /* Compute double-double = double + double. */ double e, t1, t2; /* Knuth trick. */ t1 = d1 + d2; e = t1 - d1; t2 = ((d2 - e) + (d1 - (t1 - e))); /* The result is t1 + t2, after normalization. */ e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } prod_l[1] = e1_l; prod_t[1] = e1_t; } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { /* Compute complex-extra = complex-extra * complex-double. */ double a0_l, a0_t; double a1_l, a1_t; double t1_l, t1_t; double t2_l, t2_t; a0_l = sum_l[0]; a0_t = sum_t[0]; a1_l = sum_l[1]; a1_t = sum_t[1]; /* Real part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = alpha_i[0] * split; b1 = con - alpha_i[0]; b1 = con - b1; b2 = alpha_i[0] - b1; c11 = a0_l * alpha_i[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * alpha_i[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = alpha_i[1] * split; b1 = con - alpha_i[1]; b1 = con - b1; b2 = alpha_i[1] - b1; c11 = a1_l * alpha_i[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * alpha_i[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[0] = t1_l; tmp1_t[0] = t1_t; /* Imaginary part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = alpha_i[0] * split; b1 = con - alpha_i[0]; b1 = con - b1; b2 = alpha_i[0] - b1; c11 = a1_l * alpha_i[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * alpha_i[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = alpha_i[1] * split; b1 = con - alpha_i[1]; b1 = con - b1; b2 = alpha_i[1] - b1; c11 = a0_l * alpha_i[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * alpha_i[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[1] = t1_l; tmp1_t[1] = t1_t; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { /* Compute complex-extra = complex-double * complex-double. */ double t1_l, t1_t; double t2_l, t2_t; /* Real part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[0] * split; a1 = con - beta_i[0]; a1 = con - a1; a2 = beta_i[0] - a1; con = y_jj[0] * split; b1 = con - y_jj[0]; b1 = con - b1; b2 = y_jj[0] - b1; t1_l = beta_i[0] * y_jj[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[1] * split; a1 = con - beta_i[1]; a1 = con - a1; a2 = beta_i[1] - a1; con = y_jj[1] * split; b1 = con - y_jj[1]; b1 = con - b1; b2 = y_jj[1] - b1; t2_l = beta_i[1] * y_jj[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp2_l[0] = t1_l; tmp2_t[0] = t1_t; /* Imaginary part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[1] * split; a1 = con - beta_i[1]; a1 = con - a1; a2 = beta_i[1] - a1; con = y_jj[0] * split; b1 = con - y_jj[0]; b1 = con - b1; b2 = y_jj[0] - b1; t1_l = beta_i[1] * y_jj[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[0] * split; a1 = con - beta_i[0]; a1 = con - a1; a2 = beta_i[0] - a1; con = y_jj[1] * split; b1 = con - y_jj[1]; b1 = con - b1; b2 = y_jj[1] - b1; t2_l = beta_i[0] * y_jj[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp2_l[1] = t1_l; tmp2_t[1] = t1_t; } /* tmp2 = y[jy]*beta */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = tmp1_l[0]; a_t = tmp1_t[0]; b_l = tmp2_l[0]; b_t = tmp2_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[0] = t_l; tmp1_t[0] = t_t; /* Imaginary part */ a_l = tmp1_l[1]; a_t = tmp1_t[1]; b_l = tmp2_l[1]; b_t = tmp2_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[1] = t_l; tmp1_t[1] = t_t; } /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1_l[0]; y_i[jy+1] = tmp1_l[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; } } /* end c_zSYMV_c_c_x */ void c_zSYMV_c_z_x(enum blas_order_type order, enum blas_uplo_type uplo, int n, void* alpha, void* a, int lda, void* x, int incx, void* beta, void* y, int incy, enum blas_prec_type prec) { switch ( prec ) { case blas_prec_single: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = (double*) y; const float *a_i = (float*) a; const double *x_i = (double*) x; double *alpha_i = (double*) alpha; double *beta_i = (double*) beta; double y_ii[2]; double y_jj[2]; float aij[2]; double x_ii[2]; double prod1[2]; /* case y = beta * y */ double prod[2]; double sum[2]; double tmp1[2]; double tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incx *= 2; incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum[0] = sum[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum[0] = sum[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; case blas_prec_double: case blas_prec_indigenous: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = (double*) y; const float *a_i = (float*) a; const double *x_i = (double*) x; double *alpha_i = (double*) alpha; double *beta_i = (double*) beta; double y_ii[2]; double y_jj[2]; float aij[2]; double x_ii[2]; double prod1[2]; /* case y = beta * y */ double prod[2]; double sum[2]; double tmp1[2]; double tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incx *= 2; incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum[0] = sum[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum[0] = sum[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; case blas_prec_extra: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = (double*) y; const float *a_i = (float*) a; const double *x_i = (double*) x; double *alpha_i = (double*) alpha; double *beta_i = (double*) beta; double y_ii[2]; double y_jj[2]; float aij[2]; double x_ii[2]; double prod1[2]; /* case y = beta * y */ double prod_l[2], prod_t[2]; double sum_l[2], sum_t[2]; double tmp1_l[2], tmp1_t[2]; double tmp2_l[2], tmp2_t[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incx *= 2; incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum_l[0] = sum_l[1] = sum_t[0] = sum_t[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { double cd[2]; cd[0] = (double) aij[0]; cd[1] = (double) aij[1]; { /* Compute complex-extra = complex-double * complex-double. */ double t1_l, t1_t; double t2_l, t2_t; /* Real part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii[0] * split; a1 = con - x_ii[0]; a1 = con - a1; a2 = x_ii[0] - a1; con = cd[0] * split; b1 = con - cd[0]; b1 = con - b1; b2 = cd[0] - b1; t1_l = x_ii[0] * cd[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii[1] * split; a1 = con - x_ii[1]; a1 = con - a1; a2 = x_ii[1] - a1; con = cd[1] * split; b1 = con - cd[1]; b1 = con - b1; b2 = cd[1] - b1; t2_l = x_ii[1] * cd[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } prod_l[0] = t1_l; prod_t[0] = t1_t; /* Imaginary part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii[1] * split; a1 = con - x_ii[1]; a1 = con - a1; a2 = x_ii[1] - a1; con = cd[0] * split; b1 = con - cd[0]; b1 = con - b1; b2 = cd[0] - b1; t1_l = x_ii[1] * cd[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii[0] * split; a1 = con - x_ii[0]; a1 = con - a1; a2 = x_ii[0] - a1; con = cd[1] * split; b1 = con - cd[1]; b1 = con - b1; b2 = cd[1] - b1; t2_l = x_ii[0] * cd[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } prod_l[1] = t1_l; prod_t[1] = t1_t; } } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { double cd[2]; cd[0] = (double) aij[0]; cd[1] = (double) aij[1]; { /* Compute complex-extra = complex-double * complex-double. */ double t1_l, t1_t; double t2_l, t2_t; /* Real part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii[0] * split; a1 = con - x_ii[0]; a1 = con - a1; a2 = x_ii[0] - a1; con = cd[0] * split; b1 = con - cd[0]; b1 = con - b1; b2 = cd[0] - b1; t1_l = x_ii[0] * cd[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii[1] * split; a1 = con - x_ii[1]; a1 = con - a1; a2 = x_ii[1] - a1; con = cd[1] * split; b1 = con - cd[1]; b1 = con - b1; b2 = cd[1] - b1; t2_l = x_ii[1] * cd[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } prod_l[0] = t1_l; prod_t[0] = t1_t; /* Imaginary part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii[1] * split; a1 = con - x_ii[1]; a1 = con - a1; a2 = x_ii[1] - a1; con = cd[0] * split; b1 = con - cd[0]; b1 = con - b1; b2 = cd[0] - b1; t1_l = x_ii[1] * cd[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii[0] * split; a1 = con - x_ii[0]; a1 = con - a1; a2 = x_ii[0] - a1; con = cd[1] * split; b1 = con - cd[1]; b1 = con - b1; b2 = cd[1] - b1; t2_l = x_ii[0] * cd[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } prod_l[1] = t1_l; prod_t[1] = t1_t; } } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { /* Compute complex-extra = complex-extra * complex-double. */ double a0_l, a0_t; double a1_l, a1_t; double t1_l, t1_t; double t2_l, t2_t; a0_l = sum_l[0]; a0_t = sum_t[0]; a1_l = sum_l[1]; a1_t = sum_t[1]; /* Real part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = alpha_i[0] * split; b1 = con - alpha_i[0]; b1 = con - b1; b2 = alpha_i[0] - b1; c11 = a0_l * alpha_i[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * alpha_i[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = alpha_i[1] * split; b1 = con - alpha_i[1]; b1 = con - b1; b2 = alpha_i[1] - b1; c11 = a1_l * alpha_i[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * alpha_i[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[0] = t1_l; tmp1_t[0] = t1_t; /* Imaginary part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = alpha_i[0] * split; b1 = con - alpha_i[0]; b1 = con - b1; b2 = alpha_i[0] - b1; c11 = a1_l * alpha_i[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * alpha_i[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = alpha_i[1] * split; b1 = con - alpha_i[1]; b1 = con - b1; b2 = alpha_i[1] - b1; c11 = a0_l * alpha_i[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * alpha_i[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[1] = t1_l; tmp1_t[1] = t1_t; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { /* Compute complex-extra = complex-double * complex-double. */ double t1_l, t1_t; double t2_l, t2_t; /* Real part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[0] * split; a1 = con - beta_i[0]; a1 = con - a1; a2 = beta_i[0] - a1; con = y_jj[0] * split; b1 = con - y_jj[0]; b1 = con - b1; b2 = y_jj[0] - b1; t1_l = beta_i[0] * y_jj[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[1] * split; a1 = con - beta_i[1]; a1 = con - a1; a2 = beta_i[1] - a1; con = y_jj[1] * split; b1 = con - y_jj[1]; b1 = con - b1; b2 = y_jj[1] - b1; t2_l = beta_i[1] * y_jj[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp2_l[0] = t1_l; tmp2_t[0] = t1_t; /* Imaginary part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[1] * split; a1 = con - beta_i[1]; a1 = con - a1; a2 = beta_i[1] - a1; con = y_jj[0] * split; b1 = con - y_jj[0]; b1 = con - b1; b2 = y_jj[0] - b1; t1_l = beta_i[1] * y_jj[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[0] * split; a1 = con - beta_i[0]; a1 = con - a1; a2 = beta_i[0] - a1; con = y_jj[1] * split; b1 = con - y_jj[1]; b1 = con - b1; b2 = y_jj[1] - b1; t2_l = beta_i[0] * y_jj[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp2_l[1] = t1_l; tmp2_t[1] = t1_t; } /* tmp2 = y[jy]*beta */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = tmp1_l[0]; a_t = tmp1_t[0]; b_l = tmp2_l[0]; b_t = tmp2_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[0] = t_l; tmp1_t[0] = t_t; /* Imaginary part */ a_l = tmp1_l[1]; a_t = tmp1_t[1]; b_l = tmp2_l[1]; b_t = tmp2_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[1] = t_l; tmp1_t[1] = t_t; } /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1_l[0]; y_i[jy+1] = tmp1_l[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum_l[0] = sum_l[1] = sum_t[0] = sum_t[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { double cd[2]; cd[0] = (double) aij[0]; cd[1] = (double) aij[1]; { /* Compute complex-extra = complex-double * complex-double. */ double t1_l, t1_t; double t2_l, t2_t; /* Real part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii[0] * split; a1 = con - x_ii[0]; a1 = con - a1; a2 = x_ii[0] - a1; con = cd[0] * split; b1 = con - cd[0]; b1 = con - b1; b2 = cd[0] - b1; t1_l = x_ii[0] * cd[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii[1] * split; a1 = con - x_ii[1]; a1 = con - a1; a2 = x_ii[1] - a1; con = cd[1] * split; b1 = con - cd[1]; b1 = con - b1; b2 = cd[1] - b1; t2_l = x_ii[1] * cd[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } prod_l[0] = t1_l; prod_t[0] = t1_t; /* Imaginary part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii[1] * split; a1 = con - x_ii[1]; a1 = con - a1; a2 = x_ii[1] - a1; con = cd[0] * split; b1 = con - cd[0]; b1 = con - b1; b2 = cd[0] - b1; t1_l = x_ii[1] * cd[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii[0] * split; a1 = con - x_ii[0]; a1 = con - a1; a2 = x_ii[0] - a1; con = cd[1] * split; b1 = con - cd[1]; b1 = con - b1; b2 = cd[1] - b1; t2_l = x_ii[0] * cd[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } prod_l[1] = t1_l; prod_t[1] = t1_t; } } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { double cd[2]; cd[0] = (double) aij[0]; cd[1] = (double) aij[1]; { /* Compute complex-extra = complex-double * complex-double. */ double t1_l, t1_t; double t2_l, t2_t; /* Real part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii[0] * split; a1 = con - x_ii[0]; a1 = con - a1; a2 = x_ii[0] - a1; con = cd[0] * split; b1 = con - cd[0]; b1 = con - b1; b2 = cd[0] - b1; t1_l = x_ii[0] * cd[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii[1] * split; a1 = con - x_ii[1]; a1 = con - a1; a2 = x_ii[1] - a1; con = cd[1] * split; b1 = con - cd[1]; b1 = con - b1; b2 = cd[1] - b1; t2_l = x_ii[1] * cd[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } prod_l[0] = t1_l; prod_t[0] = t1_t; /* Imaginary part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii[1] * split; a1 = con - x_ii[1]; a1 = con - a1; a2 = x_ii[1] - a1; con = cd[0] * split; b1 = con - cd[0]; b1 = con - b1; b2 = cd[0] - b1; t1_l = x_ii[1] * cd[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii[0] * split; a1 = con - x_ii[0]; a1 = con - a1; a2 = x_ii[0] - a1; con = cd[1] * split; b1 = con - cd[1]; b1 = con - b1; b2 = cd[1] - b1; t2_l = x_ii[0] * cd[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } prod_l[1] = t1_l; prod_t[1] = t1_t; } } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { /* Compute complex-extra = complex-extra * complex-double. */ double a0_l, a0_t; double a1_l, a1_t; double t1_l, t1_t; double t2_l, t2_t; a0_l = sum_l[0]; a0_t = sum_t[0]; a1_l = sum_l[1]; a1_t = sum_t[1]; /* Real part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = alpha_i[0] * split; b1 = con - alpha_i[0]; b1 = con - b1; b2 = alpha_i[0] - b1; c11 = a0_l * alpha_i[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * alpha_i[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = alpha_i[1] * split; b1 = con - alpha_i[1]; b1 = con - b1; b2 = alpha_i[1] - b1; c11 = a1_l * alpha_i[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * alpha_i[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[0] = t1_l; tmp1_t[0] = t1_t; /* Imaginary part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = alpha_i[0] * split; b1 = con - alpha_i[0]; b1 = con - b1; b2 = alpha_i[0] - b1; c11 = a1_l * alpha_i[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * alpha_i[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = alpha_i[1] * split; b1 = con - alpha_i[1]; b1 = con - b1; b2 = alpha_i[1] - b1; c11 = a0_l * alpha_i[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * alpha_i[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[1] = t1_l; tmp1_t[1] = t1_t; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { /* Compute complex-extra = complex-double * complex-double. */ double t1_l, t1_t; double t2_l, t2_t; /* Real part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[0] * split; a1 = con - beta_i[0]; a1 = con - a1; a2 = beta_i[0] - a1; con = y_jj[0] * split; b1 = con - y_jj[0]; b1 = con - b1; b2 = y_jj[0] - b1; t1_l = beta_i[0] * y_jj[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[1] * split; a1 = con - beta_i[1]; a1 = con - a1; a2 = beta_i[1] - a1; con = y_jj[1] * split; b1 = con - y_jj[1]; b1 = con - b1; b2 = y_jj[1] - b1; t2_l = beta_i[1] * y_jj[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp2_l[0] = t1_l; tmp2_t[0] = t1_t; /* Imaginary part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[1] * split; a1 = con - beta_i[1]; a1 = con - a1; a2 = beta_i[1] - a1; con = y_jj[0] * split; b1 = con - y_jj[0]; b1 = con - b1; b2 = y_jj[0] - b1; t1_l = beta_i[1] * y_jj[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[0] * split; a1 = con - beta_i[0]; a1 = con - a1; a2 = beta_i[0] - a1; con = y_jj[1] * split; b1 = con - y_jj[1]; b1 = con - b1; b2 = y_jj[1] - b1; t2_l = beta_i[0] * y_jj[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp2_l[1] = t1_l; tmp2_t[1] = t1_t; } /* tmp2 = y[jy]*beta */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = tmp1_l[0]; a_t = tmp1_t[0]; b_l = tmp2_l[0]; b_t = tmp2_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[0] = t_l; tmp1_t[0] = t_t; /* Imaginary part */ a_l = tmp1_l[1]; a_t = tmp1_t[1]; b_l = tmp2_l[1]; b_t = tmp2_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[1] = t_l; tmp1_t[1] = t_t; } /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1_l[0]; y_i[jy+1] = tmp1_l[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; } } /* end c_zSYMV_c_z_x */ void c_zSYMV_z_c_x(enum blas_order_type order, enum blas_uplo_type uplo, int n, void* alpha, void* a, int lda, void* x, int incx, void* beta, void* y, int incy, enum blas_prec_type prec) { switch ( prec ) { case blas_prec_single: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = (double*) y; const double *a_i = (double*) a; const float *x_i = (float*) x; double *alpha_i = (double*) alpha; double *beta_i = (double*) beta; double y_ii[2]; double y_jj[2]; double aij[2]; float x_ii[2]; double prod1[2]; /* case y = beta * y */ double prod[2]; double sum[2]; double tmp1[2]; double tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incx *= 2; incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum[0] = sum[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum[0] = sum[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; case blas_prec_double: case blas_prec_indigenous: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = (double*) y; const double *a_i = (double*) a; const float *x_i = (float*) x; double *alpha_i = (double*) alpha; double *beta_i = (double*) beta; double y_ii[2]; double y_jj[2]; double aij[2]; float x_ii[2]; double prod1[2]; /* case y = beta * y */ double prod[2]; double sum[2]; double tmp1[2]; double tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incx *= 2; incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum[0] = sum[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum[0] = sum[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = x_ii[0] * aij[0] - x_ii[1] * aij[1]; prod[1] = x_ii[0] * aij[1] + x_ii[1] * aij[0]; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; case blas_prec_extra: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = (double*) y; const double *a_i = (double*) a; const float *x_i = (float*) x; double *alpha_i = (double*) alpha; double *beta_i = (double*) beta; double y_ii[2]; double y_jj[2]; double aij[2]; float x_ii[2]; double prod1[2]; /* case y = beta * y */ double prod_l[2], prod_t[2]; double sum_l[2], sum_t[2]; double tmp1_l[2], tmp1_t[2]; double tmp2_l[2], tmp2_t[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incx *= 2; incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum_l[0] = sum_l[1] = sum_t[0] = sum_t[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { double cd[2]; cd[0] = (double) x_ii[0]; cd[1] = (double) x_ii[1]; { /* Compute complex-extra = complex-double * complex-double. */ double t1_l, t1_t; double t2_l, t2_t; /* Real part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = aij[0] * split; a1 = con - aij[0]; a1 = con - a1; a2 = aij[0] - a1; con = cd[0] * split; b1 = con - cd[0]; b1 = con - b1; b2 = cd[0] - b1; t1_l = aij[0] * cd[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = aij[1] * split; a1 = con - aij[1]; a1 = con - a1; a2 = aij[1] - a1; con = cd[1] * split; b1 = con - cd[1]; b1 = con - b1; b2 = cd[1] - b1; t2_l = aij[1] * cd[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } prod_l[0] = t1_l; prod_t[0] = t1_t; /* Imaginary part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = aij[1] * split; a1 = con - aij[1]; a1 = con - a1; a2 = aij[1] - a1; con = cd[0] * split; b1 = con - cd[0]; b1 = con - b1; b2 = cd[0] - b1; t1_l = aij[1] * cd[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = aij[0] * split; a1 = con - aij[0]; a1 = con - a1; a2 = aij[0] - a1; con = cd[1] * split; b1 = con - cd[1]; b1 = con - b1; b2 = cd[1] - b1; t2_l = aij[0] * cd[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } prod_l[1] = t1_l; prod_t[1] = t1_t; } } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { double cd[2]; cd[0] = (double) x_ii[0]; cd[1] = (double) x_ii[1]; { /* Compute complex-extra = complex-double * complex-double. */ double t1_l, t1_t; double t2_l, t2_t; /* Real part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = aij[0] * split; a1 = con - aij[0]; a1 = con - a1; a2 = aij[0] - a1; con = cd[0] * split; b1 = con - cd[0]; b1 = con - b1; b2 = cd[0] - b1; t1_l = aij[0] * cd[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = aij[1] * split; a1 = con - aij[1]; a1 = con - a1; a2 = aij[1] - a1; con = cd[1] * split; b1 = con - cd[1]; b1 = con - b1; b2 = cd[1] - b1; t2_l = aij[1] * cd[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } prod_l[0] = t1_l; prod_t[0] = t1_t; /* Imaginary part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = aij[1] * split; a1 = con - aij[1]; a1 = con - a1; a2 = aij[1] - a1; con = cd[0] * split; b1 = con - cd[0]; b1 = con - b1; b2 = cd[0] - b1; t1_l = aij[1] * cd[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = aij[0] * split; a1 = con - aij[0]; a1 = con - a1; a2 = aij[0] - a1; con = cd[1] * split; b1 = con - cd[1]; b1 = con - b1; b2 = cd[1] - b1; t2_l = aij[0] * cd[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } prod_l[1] = t1_l; prod_t[1] = t1_t; } } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { /* Compute complex-extra = complex-extra * complex-double. */ double a0_l, a0_t; double a1_l, a1_t; double t1_l, t1_t; double t2_l, t2_t; a0_l = sum_l[0]; a0_t = sum_t[0]; a1_l = sum_l[1]; a1_t = sum_t[1]; /* Real part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = alpha_i[0] * split; b1 = con - alpha_i[0]; b1 = con - b1; b2 = alpha_i[0] - b1; c11 = a0_l * alpha_i[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * alpha_i[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = alpha_i[1] * split; b1 = con - alpha_i[1]; b1 = con - b1; b2 = alpha_i[1] - b1; c11 = a1_l * alpha_i[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * alpha_i[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[0] = t1_l; tmp1_t[0] = t1_t; /* Imaginary part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = alpha_i[0] * split; b1 = con - alpha_i[0]; b1 = con - b1; b2 = alpha_i[0] - b1; c11 = a1_l * alpha_i[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * alpha_i[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = alpha_i[1] * split; b1 = con - alpha_i[1]; b1 = con - b1; b2 = alpha_i[1] - b1; c11 = a0_l * alpha_i[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * alpha_i[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[1] = t1_l; tmp1_t[1] = t1_t; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { /* Compute complex-extra = complex-double * complex-double. */ double t1_l, t1_t; double t2_l, t2_t; /* Real part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[0] * split; a1 = con - beta_i[0]; a1 = con - a1; a2 = beta_i[0] - a1; con = y_jj[0] * split; b1 = con - y_jj[0]; b1 = con - b1; b2 = y_jj[0] - b1; t1_l = beta_i[0] * y_jj[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[1] * split; a1 = con - beta_i[1]; a1 = con - a1; a2 = beta_i[1] - a1; con = y_jj[1] * split; b1 = con - y_jj[1]; b1 = con - b1; b2 = y_jj[1] - b1; t2_l = beta_i[1] * y_jj[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp2_l[0] = t1_l; tmp2_t[0] = t1_t; /* Imaginary part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[1] * split; a1 = con - beta_i[1]; a1 = con - a1; a2 = beta_i[1] - a1; con = y_jj[0] * split; b1 = con - y_jj[0]; b1 = con - b1; b2 = y_jj[0] - b1; t1_l = beta_i[1] * y_jj[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[0] * split; a1 = con - beta_i[0]; a1 = con - a1; a2 = beta_i[0] - a1; con = y_jj[1] * split; b1 = con - y_jj[1]; b1 = con - b1; b2 = y_jj[1] - b1; t2_l = beta_i[0] * y_jj[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp2_l[1] = t1_l; tmp2_t[1] = t1_t; } /* tmp2 = y[jy]*beta */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = tmp1_l[0]; a_t = tmp1_t[0]; b_l = tmp2_l[0]; b_t = tmp2_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[0] = t_l; tmp1_t[0] = t_t; /* Imaginary part */ a_l = tmp1_l[1]; a_t = tmp1_t[1]; b_l = tmp2_l[1]; b_t = tmp2_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[1] = t_l; tmp1_t[1] = t_t; } /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1_l[0]; y_i[jy+1] = tmp1_l[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum_l[0] = sum_l[1] = sum_t[0] = sum_t[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { double cd[2]; cd[0] = (double) x_ii[0]; cd[1] = (double) x_ii[1]; { /* Compute complex-extra = complex-double * complex-double. */ double t1_l, t1_t; double t2_l, t2_t; /* Real part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = aij[0] * split; a1 = con - aij[0]; a1 = con - a1; a2 = aij[0] - a1; con = cd[0] * split; b1 = con - cd[0]; b1 = con - b1; b2 = cd[0] - b1; t1_l = aij[0] * cd[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = aij[1] * split; a1 = con - aij[1]; a1 = con - a1; a2 = aij[1] - a1; con = cd[1] * split; b1 = con - cd[1]; b1 = con - b1; b2 = cd[1] - b1; t2_l = aij[1] * cd[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } prod_l[0] = t1_l; prod_t[0] = t1_t; /* Imaginary part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = aij[1] * split; a1 = con - aij[1]; a1 = con - a1; a2 = aij[1] - a1; con = cd[0] * split; b1 = con - cd[0]; b1 = con - b1; b2 = cd[0] - b1; t1_l = aij[1] * cd[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = aij[0] * split; a1 = con - aij[0]; a1 = con - a1; a2 = aij[0] - a1; con = cd[1] * split; b1 = con - cd[1]; b1 = con - b1; b2 = cd[1] - b1; t2_l = aij[0] * cd[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } prod_l[1] = t1_l; prod_t[1] = t1_t; } } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { double cd[2]; cd[0] = (double) x_ii[0]; cd[1] = (double) x_ii[1]; { /* Compute complex-extra = complex-double * complex-double. */ double t1_l, t1_t; double t2_l, t2_t; /* Real part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = aij[0] * split; a1 = con - aij[0]; a1 = con - a1; a2 = aij[0] - a1; con = cd[0] * split; b1 = con - cd[0]; b1 = con - b1; b2 = cd[0] - b1; t1_l = aij[0] * cd[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = aij[1] * split; a1 = con - aij[1]; a1 = con - a1; a2 = aij[1] - a1; con = cd[1] * split; b1 = con - cd[1]; b1 = con - b1; b2 = cd[1] - b1; t2_l = aij[1] * cd[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } prod_l[0] = t1_l; prod_t[0] = t1_t; /* Imaginary part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = aij[1] * split; a1 = con - aij[1]; a1 = con - a1; a2 = aij[1] - a1; con = cd[0] * split; b1 = con - cd[0]; b1 = con - b1; b2 = cd[0] - b1; t1_l = aij[1] * cd[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = aij[0] * split; a1 = con - aij[0]; a1 = con - a1; a2 = aij[0] - a1; con = cd[1] * split; b1 = con - cd[1]; b1 = con - b1; b2 = cd[1] - b1; t2_l = aij[0] * cd[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } prod_l[1] = t1_l; prod_t[1] = t1_t; } } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { /* Compute complex-extra = complex-extra * complex-double. */ double a0_l, a0_t; double a1_l, a1_t; double t1_l, t1_t; double t2_l, t2_t; a0_l = sum_l[0]; a0_t = sum_t[0]; a1_l = sum_l[1]; a1_t = sum_t[1]; /* Real part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = alpha_i[0] * split; b1 = con - alpha_i[0]; b1 = con - b1; b2 = alpha_i[0] - b1; c11 = a0_l * alpha_i[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * alpha_i[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = alpha_i[1] * split; b1 = con - alpha_i[1]; b1 = con - b1; b2 = alpha_i[1] - b1; c11 = a1_l * alpha_i[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * alpha_i[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[0] = t1_l; tmp1_t[0] = t1_t; /* Imaginary part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = alpha_i[0] * split; b1 = con - alpha_i[0]; b1 = con - b1; b2 = alpha_i[0] - b1; c11 = a1_l * alpha_i[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * alpha_i[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = alpha_i[1] * split; b1 = con - alpha_i[1]; b1 = con - b1; b2 = alpha_i[1] - b1; c11 = a0_l * alpha_i[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * alpha_i[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[1] = t1_l; tmp1_t[1] = t1_t; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { /* Compute complex-extra = complex-double * complex-double. */ double t1_l, t1_t; double t2_l, t2_t; /* Real part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[0] * split; a1 = con - beta_i[0]; a1 = con - a1; a2 = beta_i[0] - a1; con = y_jj[0] * split; b1 = con - y_jj[0]; b1 = con - b1; b2 = y_jj[0] - b1; t1_l = beta_i[0] * y_jj[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[1] * split; a1 = con - beta_i[1]; a1 = con - a1; a2 = beta_i[1] - a1; con = y_jj[1] * split; b1 = con - y_jj[1]; b1 = con - b1; b2 = y_jj[1] - b1; t2_l = beta_i[1] * y_jj[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp2_l[0] = t1_l; tmp2_t[0] = t1_t; /* Imaginary part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[1] * split; a1 = con - beta_i[1]; a1 = con - a1; a2 = beta_i[1] - a1; con = y_jj[0] * split; b1 = con - y_jj[0]; b1 = con - b1; b2 = y_jj[0] - b1; t1_l = beta_i[1] * y_jj[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[0] * split; a1 = con - beta_i[0]; a1 = con - a1; a2 = beta_i[0] - a1; con = y_jj[1] * split; b1 = con - y_jj[1]; b1 = con - b1; b2 = y_jj[1] - b1; t2_l = beta_i[0] * y_jj[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp2_l[1] = t1_l; tmp2_t[1] = t1_t; } /* tmp2 = y[jy]*beta */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = tmp1_l[0]; a_t = tmp1_t[0]; b_l = tmp2_l[0]; b_t = tmp2_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[0] = t_l; tmp1_t[0] = t_t; /* Imaginary part */ a_l = tmp1_l[1]; a_t = tmp1_t[1]; b_l = tmp2_l[1]; b_t = tmp2_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[1] = t_l; tmp1_t[1] = t_t; } /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1_l[0]; y_i[jy+1] = tmp1_l[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; } } /* end c_zSYMV_z_c_x */ void c_cSYMV_s_s_x(enum blas_order_type order, enum blas_uplo_type uplo, int n, void* alpha, float* a, int lda, float* x, int incx, void* beta, void* y, int incy, enum blas_prec_type prec) { switch ( prec ) { case blas_prec_single: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; float *y_i = (float*) y; const float *a_i = a; const float *x_i = x; float *alpha_i = (float*) alpha; float *beta_i = (float*) beta; float y_ii[2]; float y_jj[2]; float aij; float x_ii; float prod1[2]; /* case y = beta * y */ float prod; float sum; float tmp1[2]; float tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = alpha_i[0] * sum; tmp1[1] = alpha_i[1] * sum; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = alpha_i[0] * sum; tmp1[1] = alpha_i[1] * sum; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; case blas_prec_double: case blas_prec_indigenous: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; float *y_i = (float*) y; const float *a_i = a; const float *x_i = x; float *alpha_i = (float*) alpha; float *beta_i = (float*) beta; float y_ii[2]; float y_jj[2]; float aij; float x_ii; float prod1[2]; /* case y = beta * y */ double prod; double sum; double tmp1[2]; double tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = (double) x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = (double) x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = alpha_i[0] * sum; tmp1[1] = alpha_i[1] * sum; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = (double) x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = (double) x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = alpha_i[0] * sum; tmp1[1] = alpha_i[1] * sum; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; case blas_prec_extra: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; float *y_i = (float*) y; const float *a_i = a; const float *x_i = x; float *alpha_i = (float*) alpha; float *beta_i = (float*) beta; float y_ii[2]; float y_jj[2]; float aij; float x_ii; float prod1[2]; /* case y = beta * y */ double prod_l, prod_t; double sum_l, sum_t; double tmp1_l[2], tmp1_t[2]; double tmp2_l[2], tmp2_t[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum_l = sum_t = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod_l = x_ii * aij; prod_t = 0.0; /* prod = a[tmpind]*x[i] */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = sum_l + prod_l; e = t1 - sum_l; t2 = ((prod_l - e) + (sum_l - (t1 - e))) + sum_t + prod_t; /* The result is t1 + t2, after normalization. */ sum_l = t1 + t2; sum_t = t2 - (sum_l - t1); } /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod_l = x_ii * aij; prod_t = 0.0; /* prod = a[tmpind]*x[i] */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = sum_l + prod_l; e = t1 - sum_l; t2 = ((prod_l - e) + (sum_l - (t1 - e))) + sum_t + prod_t; /* The result is t1 + t2, after normalization. */ sum_l = t1 + t2; sum_t = t2 - (sum_l - t1); } /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { double e1_l, e1_t; double dt; dt = (double) alpha_i[0]; { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = sum_l * split; a11 = con - sum_l; a11 = con - a11; a21 = sum_l - a11; con = dt * split; b1 = con - dt; b1 = con - b1; b2 = dt - b1; c11 = sum_l * dt; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = sum_t * dt; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } tmp1_l[0] = e1_l; tmp1_t[0] = e1_t; dt = (double) alpha_i[1]; { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = sum_l * split; a11 = con - sum_l; a11 = con - a11; a21 = sum_l - a11; con = dt * split; b1 = con - dt; b1 = con - b1; b2 = dt - b1; c11 = sum_l * dt; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = sum_t * dt; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } tmp1_l[1] = e1_l; tmp1_t[1] = e1_t; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { double e1_l, e1_t; double d1; double d2; /* Real part */ d1 = beta_i[0] * y_jj[0]; d2 = -beta_i[1] * y_jj[1]; { /* Compute double-double = double + double. */ double e, t1, t2; /* Knuth trick. */ t1 = d1 + d2; e = t1 - d1; t2 = ((d2 - e) + (d1 - (t1 - e))); /* The result is t1 + t2, after normalization. */ e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } tmp2_l[0] = e1_l; tmp2_t[0] = e1_t; /* imaginary part */ d1 = beta_i[0] * y_jj[1]; d2 = beta_i[1] * y_jj[0]; { /* Compute double-double = double + double. */ double e, t1, t2; /* Knuth trick. */ t1 = d1 + d2; e = t1 - d1; t2 = ((d2 - e) + (d1 - (t1 - e))); /* The result is t1 + t2, after normalization. */ e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } tmp2_l[1] = e1_l; tmp2_t[1] = e1_t; } /* tmp2 = y[jy]*beta */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = tmp1_l[0]; a_t = tmp1_t[0]; b_l = tmp2_l[0]; b_t = tmp2_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[0] = t_l; tmp1_t[0] = t_t; /* Imaginary part */ a_l = tmp1_l[1]; a_t = tmp1_t[1]; b_l = tmp2_l[1]; b_t = tmp2_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[1] = t_l; tmp1_t[1] = t_t; } /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1_l[0]; y_i[jy+1] = tmp1_l[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum_l = sum_t = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod_l = x_ii * aij; prod_t = 0.0; /* prod = a[tmpind]*x[i] */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = sum_l + prod_l; e = t1 - sum_l; t2 = ((prod_l - e) + (sum_l - (t1 - e))) + sum_t + prod_t; /* The result is t1 + t2, after normalization. */ sum_l = t1 + t2; sum_t = t2 - (sum_l - t1); } /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod_l = x_ii * aij; prod_t = 0.0; /* prod = a[tmpind]*x[i] */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = sum_l + prod_l; e = t1 - sum_l; t2 = ((prod_l - e) + (sum_l - (t1 - e))) + sum_t + prod_t; /* The result is t1 + t2, after normalization. */ sum_l = t1 + t2; sum_t = t2 - (sum_l - t1); } /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { double e1_l, e1_t; double dt; dt = (double) alpha_i[0]; { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = sum_l * split; a11 = con - sum_l; a11 = con - a11; a21 = sum_l - a11; con = dt * split; b1 = con - dt; b1 = con - b1; b2 = dt - b1; c11 = sum_l * dt; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = sum_t * dt; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } tmp1_l[0] = e1_l; tmp1_t[0] = e1_t; dt = (double) alpha_i[1]; { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = sum_l * split; a11 = con - sum_l; a11 = con - a11; a21 = sum_l - a11; con = dt * split; b1 = con - dt; b1 = con - b1; b2 = dt - b1; c11 = sum_l * dt; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = sum_t * dt; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } tmp1_l[1] = e1_l; tmp1_t[1] = e1_t; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { double e1_l, e1_t; double d1; double d2; /* Real part */ d1 = beta_i[0] * y_jj[0]; d2 = -beta_i[1] * y_jj[1]; { /* Compute double-double = double + double. */ double e, t1, t2; /* Knuth trick. */ t1 = d1 + d2; e = t1 - d1; t2 = ((d2 - e) + (d1 - (t1 - e))); /* The result is t1 + t2, after normalization. */ e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } tmp2_l[0] = e1_l; tmp2_t[0] = e1_t; /* imaginary part */ d1 = beta_i[0] * y_jj[1]; d2 = beta_i[1] * y_jj[0]; { /* Compute double-double = double + double. */ double e, t1, t2; /* Knuth trick. */ t1 = d1 + d2; e = t1 - d1; t2 = ((d2 - e) + (d1 - (t1 - e))); /* The result is t1 + t2, after normalization. */ e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } tmp2_l[1] = e1_l; tmp2_t[1] = e1_t; } /* tmp2 = y[jy]*beta */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = tmp1_l[0]; a_t = tmp1_t[0]; b_l = tmp2_l[0]; b_t = tmp2_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[0] = t_l; tmp1_t[0] = t_t; /* Imaginary part */ a_l = tmp1_l[1]; a_t = tmp1_t[1]; b_l = tmp2_l[1]; b_t = tmp2_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[1] = t_l; tmp1_t[1] = t_t; } /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1_l[0]; y_i[jy+1] = tmp1_l[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; } } /* end c_cSYMV_s_s_x */ void c_cSYMV_s_c_x(enum blas_order_type order, enum blas_uplo_type uplo, int n, void* alpha, float* a, int lda, void* x, int incx, void* beta, void* y, int incy, enum blas_prec_type prec) { switch ( prec ) { case blas_prec_single: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; float *y_i = (float*) y; const float *a_i = a; const float *x_i = (float*) x; float *alpha_i = (float*) alpha; float *beta_i = (float*) beta; float y_ii[2]; float y_jj[2]; float aij; float x_ii[2]; float prod1[2]; /* case y = beta * y */ float prod[2]; float sum[2]; float tmp1[2]; float tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incx *= 2; incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum[0] = sum[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij = a_i[tmpind]; { prod[0] = x_ii[0] * aij; prod[1] = x_ii[1] * aij; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij = a_i[tmpind]; { prod[0] = x_ii[0] * aij; prod[1] = x_ii[1] * aij; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum[0] = sum[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij = a_i[tmpind]; { prod[0] = x_ii[0] * aij; prod[1] = x_ii[1] * aij; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij = a_i[tmpind]; { prod[0] = x_ii[0] * aij; prod[1] = x_ii[1] * aij; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; case blas_prec_double: case blas_prec_indigenous: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; float *y_i = (float*) y; const float *a_i = a; const float *x_i = (float*) x; float *alpha_i = (float*) alpha; float *beta_i = (float*) beta; float y_ii[2]; float y_jj[2]; float aij; float x_ii[2]; float prod1[2]; /* case y = beta * y */ double prod[2]; double sum[2]; double tmp1[2]; double tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incx *= 2; incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum[0] = sum[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij = a_i[tmpind]; { prod[0] = x_ii[0] * aij; prod[1] = x_ii[1] * aij; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij = a_i[tmpind]; { prod[0] = x_ii[0] * aij; prod[1] = x_ii[1] * aij; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum[0] = sum[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij = a_i[tmpind]; { prod[0] = x_ii[0] * aij; prod[1] = x_ii[1] * aij; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij = a_i[tmpind]; { prod[0] = x_ii[0] * aij; prod[1] = x_ii[1] * aij; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; case blas_prec_extra: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; float *y_i = (float*) y; const float *a_i = a; const float *x_i = (float*) x; float *alpha_i = (float*) alpha; float *beta_i = (float*) beta; float y_ii[2]; float y_jj[2]; float aij; float x_ii[2]; float prod1[2]; /* case y = beta * y */ double prod_l[2], prod_t[2]; double sum_l[2], sum_t[2]; double tmp1_l[2], tmp1_t[2]; double tmp2_l[2], tmp2_t[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incx *= 2; incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum_l[0] = sum_l[1] = sum_t[0] = sum_t[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij = a_i[tmpind]; { prod_l[0] = x_ii[0] * aij; prod_t[0] = 0.0; prod_l[1] = x_ii[1] * aij; prod_t[1] = 0.0; } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij = a_i[tmpind]; { prod_l[0] = x_ii[0] * aij; prod_t[0] = 0.0; prod_l[1] = x_ii[1] * aij; prod_t[1] = 0.0; } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { double cd[2]; cd[0] = (double) alpha_i[0]; cd[1] = (double) alpha_i[1]; { /* Compute complex-extra = complex-extra * complex-double. */ double a0_l, a0_t; double a1_l, a1_t; double t1_l, t1_t; double t2_l, t2_t; a0_l = sum_l[0]; a0_t = sum_t[0]; a1_l = sum_l[1]; a1_t = sum_t[1]; /* Real part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = cd[0] * split; b1 = con - cd[0]; b1 = con - b1; b2 = cd[0] - b1; c11 = a0_l * cd[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * cd[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = cd[1] * split; b1 = con - cd[1]; b1 = con - b1; b2 = cd[1] - b1; c11 = a1_l * cd[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * cd[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[0] = t1_l; tmp1_t[0] = t1_t; /* Imaginary part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = cd[0] * split; b1 = con - cd[0]; b1 = con - b1; b2 = cd[0] - b1; c11 = a1_l * cd[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * cd[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = cd[1] * split; b1 = con - cd[1]; b1 = con - b1; b2 = cd[1] - b1; c11 = a0_l * cd[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * cd[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[1] = t1_l; tmp1_t[1] = t1_t; } } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { double e1_l, e1_t; double d1; double d2; /* Real part */ d1 = beta_i[0] * y_jj[0]; d2 = -beta_i[1] * y_jj[1]; { /* Compute double-double = double + double. */ double e, t1, t2; /* Knuth trick. */ t1 = d1 + d2; e = t1 - d1; t2 = ((d2 - e) + (d1 - (t1 - e))); /* The result is t1 + t2, after normalization. */ e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } tmp2_l[0] = e1_l; tmp2_t[0] = e1_t; /* imaginary part */ d1 = beta_i[0] * y_jj[1]; d2 = beta_i[1] * y_jj[0]; { /* Compute double-double = double + double. */ double e, t1, t2; /* Knuth trick. */ t1 = d1 + d2; e = t1 - d1; t2 = ((d2 - e) + (d1 - (t1 - e))); /* The result is t1 + t2, after normalization. */ e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } tmp2_l[1] = e1_l; tmp2_t[1] = e1_t; } /* tmp2 = y[jy]*beta */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = tmp1_l[0]; a_t = tmp1_t[0]; b_l = tmp2_l[0]; b_t = tmp2_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[0] = t_l; tmp1_t[0] = t_t; /* Imaginary part */ a_l = tmp1_l[1]; a_t = tmp1_t[1]; b_l = tmp2_l[1]; b_t = tmp2_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[1] = t_l; tmp1_t[1] = t_t; } /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1_l[0]; y_i[jy+1] = tmp1_l[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum_l[0] = sum_l[1] = sum_t[0] = sum_t[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij = a_i[tmpind]; { prod_l[0] = x_ii[0] * aij; prod_t[0] = 0.0; prod_l[1] = x_ii[1] * aij; prod_t[1] = 0.0; } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij = a_i[tmpind]; { prod_l[0] = x_ii[0] * aij; prod_t[0] = 0.0; prod_l[1] = x_ii[1] * aij; prod_t[1] = 0.0; } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { double cd[2]; cd[0] = (double) alpha_i[0]; cd[1] = (double) alpha_i[1]; { /* Compute complex-extra = complex-extra * complex-double. */ double a0_l, a0_t; double a1_l, a1_t; double t1_l, t1_t; double t2_l, t2_t; a0_l = sum_l[0]; a0_t = sum_t[0]; a1_l = sum_l[1]; a1_t = sum_t[1]; /* Real part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = cd[0] * split; b1 = con - cd[0]; b1 = con - b1; b2 = cd[0] - b1; c11 = a0_l * cd[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * cd[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = cd[1] * split; b1 = con - cd[1]; b1 = con - b1; b2 = cd[1] - b1; c11 = a1_l * cd[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * cd[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[0] = t1_l; tmp1_t[0] = t1_t; /* Imaginary part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = cd[0] * split; b1 = con - cd[0]; b1 = con - b1; b2 = cd[0] - b1; c11 = a1_l * cd[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * cd[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = cd[1] * split; b1 = con - cd[1]; b1 = con - b1; b2 = cd[1] - b1; c11 = a0_l * cd[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * cd[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[1] = t1_l; tmp1_t[1] = t1_t; } } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { double e1_l, e1_t; double d1; double d2; /* Real part */ d1 = beta_i[0] * y_jj[0]; d2 = -beta_i[1] * y_jj[1]; { /* Compute double-double = double + double. */ double e, t1, t2; /* Knuth trick. */ t1 = d1 + d2; e = t1 - d1; t2 = ((d2 - e) + (d1 - (t1 - e))); /* The result is t1 + t2, after normalization. */ e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } tmp2_l[0] = e1_l; tmp2_t[0] = e1_t; /* imaginary part */ d1 = beta_i[0] * y_jj[1]; d2 = beta_i[1] * y_jj[0]; { /* Compute double-double = double + double. */ double e, t1, t2; /* Knuth trick. */ t1 = d1 + d2; e = t1 - d1; t2 = ((d2 - e) + (d1 - (t1 - e))); /* The result is t1 + t2, after normalization. */ e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } tmp2_l[1] = e1_l; tmp2_t[1] = e1_t; } /* tmp2 = y[jy]*beta */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = tmp1_l[0]; a_t = tmp1_t[0]; b_l = tmp2_l[0]; b_t = tmp2_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[0] = t_l; tmp1_t[0] = t_t; /* Imaginary part */ a_l = tmp1_l[1]; a_t = tmp1_t[1]; b_l = tmp2_l[1]; b_t = tmp2_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[1] = t_l; tmp1_t[1] = t_t; } /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1_l[0]; y_i[jy+1] = tmp1_l[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; } } /* end c_cSYMV_s_c_x */ void c_cSYMV_c_s_x(enum blas_order_type order, enum blas_uplo_type uplo, int n, void* alpha, void* a, int lda, float* x, int incx, void* beta, void* y, int incy, enum blas_prec_type prec) { switch ( prec ) { case blas_prec_single: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; float *y_i = (float*) y; const float *a_i = (float*) a; const float *x_i = x; float *alpha_i = (float*) alpha; float *beta_i = (float*) beta; float y_ii[2]; float y_jj[2]; float aij[2]; float x_ii; float prod1[2]; /* case y = beta * y */ float prod[2]; float sum[2]; float tmp1[2]; float tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum[0] = sum[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = aij[0] * x_ii; prod[1] = aij[1] * x_ii; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = aij[0] * x_ii; prod[1] = aij[1] * x_ii; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum[0] = sum[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = aij[0] * x_ii; prod[1] = aij[1] * x_ii; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = aij[0] * x_ii; prod[1] = aij[1] * x_ii; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; case blas_prec_double: case blas_prec_indigenous: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; float *y_i = (float*) y; const float *a_i = (float*) a; const float *x_i = x; float *alpha_i = (float*) alpha; float *beta_i = (float*) beta; float y_ii[2]; float y_jj[2]; float aij[2]; float x_ii; float prod1[2]; /* case y = beta * y */ double prod[2]; double sum[2]; double tmp1[2]; double tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum[0] = sum[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = aij[0] * x_ii; prod[1] = aij[1] * x_ii; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = aij[0] * x_ii; prod[1] = aij[1] * x_ii; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum[0] = sum[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = aij[0] * x_ii; prod[1] = aij[1] * x_ii; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = aij[0] * x_ii; prod[1] = aij[1] * x_ii; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; case blas_prec_extra: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; float *y_i = (float*) y; const float *a_i = (float*) a; const float *x_i = x; float *alpha_i = (float*) alpha; float *beta_i = (float*) beta; float y_ii[2]; float y_jj[2]; float aij[2]; float x_ii; float prod1[2]; /* case y = beta * y */ double prod_l[2], prod_t[2]; double sum_l[2], sum_t[2]; double tmp1_l[2], tmp1_t[2]; double tmp2_l[2], tmp2_t[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum_l[0] = sum_l[1] = sum_t[0] = sum_t[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod_l[0] = aij[0] * x_ii; prod_t[0] = 0.0; prod_l[1] = aij[1] * x_ii; prod_t[1] = 0.0; } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod_l[0] = aij[0] * x_ii; prod_t[0] = 0.0; prod_l[1] = aij[1] * x_ii; prod_t[1] = 0.0; } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { double cd[2]; cd[0] = (double) alpha_i[0]; cd[1] = (double) alpha_i[1]; { /* Compute complex-extra = complex-extra * complex-double. */ double a0_l, a0_t; double a1_l, a1_t; double t1_l, t1_t; double t2_l, t2_t; a0_l = sum_l[0]; a0_t = sum_t[0]; a1_l = sum_l[1]; a1_t = sum_t[1]; /* Real part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = cd[0] * split; b1 = con - cd[0]; b1 = con - b1; b2 = cd[0] - b1; c11 = a0_l * cd[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * cd[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = cd[1] * split; b1 = con - cd[1]; b1 = con - b1; b2 = cd[1] - b1; c11 = a1_l * cd[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * cd[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[0] = t1_l; tmp1_t[0] = t1_t; /* Imaginary part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = cd[0] * split; b1 = con - cd[0]; b1 = con - b1; b2 = cd[0] - b1; c11 = a1_l * cd[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * cd[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = cd[1] * split; b1 = con - cd[1]; b1 = con - b1; b2 = cd[1] - b1; c11 = a0_l * cd[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * cd[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[1] = t1_l; tmp1_t[1] = t1_t; } } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { double e1_l, e1_t; double d1; double d2; /* Real part */ d1 = beta_i[0] * y_jj[0]; d2 = -beta_i[1] * y_jj[1]; { /* Compute double-double = double + double. */ double e, t1, t2; /* Knuth trick. */ t1 = d1 + d2; e = t1 - d1; t2 = ((d2 - e) + (d1 - (t1 - e))); /* The result is t1 + t2, after normalization. */ e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } tmp2_l[0] = e1_l; tmp2_t[0] = e1_t; /* imaginary part */ d1 = beta_i[0] * y_jj[1]; d2 = beta_i[1] * y_jj[0]; { /* Compute double-double = double + double. */ double e, t1, t2; /* Knuth trick. */ t1 = d1 + d2; e = t1 - d1; t2 = ((d2 - e) + (d1 - (t1 - e))); /* The result is t1 + t2, after normalization. */ e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } tmp2_l[1] = e1_l; tmp2_t[1] = e1_t; } /* tmp2 = y[jy]*beta */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = tmp1_l[0]; a_t = tmp1_t[0]; b_l = tmp2_l[0]; b_t = tmp2_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[0] = t_l; tmp1_t[0] = t_t; /* Imaginary part */ a_l = tmp1_l[1]; a_t = tmp1_t[1]; b_l = tmp2_l[1]; b_t = tmp2_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[1] = t_l; tmp1_t[1] = t_t; } /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1_l[0]; y_i[jy+1] = tmp1_l[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum_l[0] = sum_l[1] = sum_t[0] = sum_t[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod_l[0] = aij[0] * x_ii; prod_t[0] = 0.0; prod_l[1] = aij[1] * x_ii; prod_t[1] = 0.0; } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod_l[0] = aij[0] * x_ii; prod_t[0] = 0.0; prod_l[1] = aij[1] * x_ii; prod_t[1] = 0.0; } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { double cd[2]; cd[0] = (double) alpha_i[0]; cd[1] = (double) alpha_i[1]; { /* Compute complex-extra = complex-extra * complex-double. */ double a0_l, a0_t; double a1_l, a1_t; double t1_l, t1_t; double t2_l, t2_t; a0_l = sum_l[0]; a0_t = sum_t[0]; a1_l = sum_l[1]; a1_t = sum_t[1]; /* Real part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = cd[0] * split; b1 = con - cd[0]; b1 = con - b1; b2 = cd[0] - b1; c11 = a0_l * cd[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * cd[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = cd[1] * split; b1 = con - cd[1]; b1 = con - b1; b2 = cd[1] - b1; c11 = a1_l * cd[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * cd[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[0] = t1_l; tmp1_t[0] = t1_t; /* Imaginary part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = cd[0] * split; b1 = con - cd[0]; b1 = con - b1; b2 = cd[0] - b1; c11 = a1_l * cd[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * cd[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = cd[1] * split; b1 = con - cd[1]; b1 = con - b1; b2 = cd[1] - b1; c11 = a0_l * cd[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * cd[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[1] = t1_l; tmp1_t[1] = t1_t; } } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { double e1_l, e1_t; double d1; double d2; /* Real part */ d1 = beta_i[0] * y_jj[0]; d2 = -beta_i[1] * y_jj[1]; { /* Compute double-double = double + double. */ double e, t1, t2; /* Knuth trick. */ t1 = d1 + d2; e = t1 - d1; t2 = ((d2 - e) + (d1 - (t1 - e))); /* The result is t1 + t2, after normalization. */ e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } tmp2_l[0] = e1_l; tmp2_t[0] = e1_t; /* imaginary part */ d1 = beta_i[0] * y_jj[1]; d2 = beta_i[1] * y_jj[0]; { /* Compute double-double = double + double. */ double e, t1, t2; /* Knuth trick. */ t1 = d1 + d2; e = t1 - d1; t2 = ((d2 - e) + (d1 - (t1 - e))); /* The result is t1 + t2, after normalization. */ e1_l = t1 + t2; e1_t = t2 - (e1_l - t1); } tmp2_l[1] = e1_l; tmp2_t[1] = e1_t; } /* tmp2 = y[jy]*beta */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = tmp1_l[0]; a_t = tmp1_t[0]; b_l = tmp2_l[0]; b_t = tmp2_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[0] = t_l; tmp1_t[0] = t_t; /* Imaginary part */ a_l = tmp1_l[1]; a_t = tmp1_t[1]; b_l = tmp2_l[1]; b_t = tmp2_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[1] = t_l; tmp1_t[1] = t_t; } /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1_l[0]; y_i[jy+1] = tmp1_l[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; } } /* end c_cSYMV_c_s_x */ void c_zSYMV_d_d_x(enum blas_order_type order, enum blas_uplo_type uplo, int n, void* alpha, double* a, int lda, double* x, int incx, void* beta, void* y, int incy, enum blas_prec_type prec) { switch ( prec ) { case blas_prec_single: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = (double*) y; const double *a_i = a; const double *x_i = x; double *alpha_i = (double*) alpha; double *beta_i = (double*) beta; double y_ii[2]; double y_jj[2]; double aij; double x_ii; double prod1[2]; /* case y = beta * y */ double prod; double sum; double tmp1[2]; double tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = alpha_i[0] * sum; tmp1[1] = alpha_i[1] * sum; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = alpha_i[0] * sum; tmp1[1] = alpha_i[1] * sum; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; case blas_prec_double: case blas_prec_indigenous: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = (double*) y; const double *a_i = a; const double *x_i = x; double *alpha_i = (double*) alpha; double *beta_i = (double*) beta; double y_ii[2]; double y_jj[2]; double aij; double x_ii; double prod1[2]; /* case y = beta * y */ double prod; double sum; double tmp1[2]; double tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = alpha_i[0] * sum; tmp1[1] = alpha_i[1] * sum; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; prod = x_ii * aij; /* prod = a[tmpind]*x[i] */ sum = sum + prod; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = alpha_i[0] * sum; tmp1[1] = alpha_i[1] * sum; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; case blas_prec_extra: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = (double*) y; const double *a_i = a; const double *x_i = x; double *alpha_i = (double*) alpha; double *beta_i = (double*) beta; double y_ii[2]; double y_jj[2]; double aij; double x_ii; double prod1[2]; /* case y = beta * y */ double prod_l, prod_t; double sum_l, sum_t; double tmp1_l[2], tmp1_t[2]; double tmp2_l[2], tmp2_t[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum_l = sum_t = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii * split; a1 = con - x_ii; a1 = con - a1; a2 = x_ii - a1; con = aij * split; b1 = con - aij; b1 = con - b1; b2 = aij - b1; prod_l = x_ii * aij; prod_t = (((a1 * b1 - prod_l) + a1 * b2) + a2 * b1) + a2 * b2; } /* prod = a[tmpind]*x[i] */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = sum_l + prod_l; e = t1 - sum_l; t2 = ((prod_l - e) + (sum_l - (t1 - e))) + sum_t + prod_t; /* The result is t1 + t2, after normalization. */ sum_l = t1 + t2; sum_t = t2 - (sum_l - t1); } /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii * split; a1 = con - x_ii; a1 = con - a1; a2 = x_ii - a1; con = aij * split; b1 = con - aij; b1 = con - b1; b2 = aij - b1; prod_l = x_ii * aij; prod_t = (((a1 * b1 - prod_l) + a1 * b2) + a2 * b1) + a2 * b2; } /* prod = a[tmpind]*x[i] */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = sum_l + prod_l; e = t1 - sum_l; t2 = ((prod_l - e) + (sum_l - (t1 - e))) + sum_t + prod_t; /* The result is t1 + t2, after normalization. */ sum_l = t1 + t2; sum_t = t2 - (sum_l - t1); } /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { /* Compute complex-extra = complex-double * real. */ double t_l, t_t; { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = sum_l * split; a11 = con - sum_l; a11 = con - a11; a21 = sum_l - a11; con = alpha_i[0] * split; b1 = con - alpha_i[0]; b1 = con - b1; b2 = alpha_i[0] - b1; c11 = sum_l * alpha_i[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = sum_t * alpha_i[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[0] = t_l; tmp1_t[0] = t_t; { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = sum_l * split; a11 = con - sum_l; a11 = con - a11; a21 = sum_l - a11; con = alpha_i[1] * split; b1 = con - alpha_i[1]; b1 = con - b1; b2 = alpha_i[1] - b1; c11 = sum_l * alpha_i[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = sum_t * alpha_i[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[1] = t_l; tmp1_t[1] = t_t; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { /* Compute complex-extra = complex-double * complex-double. */ double t1_l, t1_t; double t2_l, t2_t; /* Real part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[0] * split; a1 = con - beta_i[0]; a1 = con - a1; a2 = beta_i[0] - a1; con = y_jj[0] * split; b1 = con - y_jj[0]; b1 = con - b1; b2 = y_jj[0] - b1; t1_l = beta_i[0] * y_jj[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[1] * split; a1 = con - beta_i[1]; a1 = con - a1; a2 = beta_i[1] - a1; con = y_jj[1] * split; b1 = con - y_jj[1]; b1 = con - b1; b2 = y_jj[1] - b1; t2_l = beta_i[1] * y_jj[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp2_l[0] = t1_l; tmp2_t[0] = t1_t; /* Imaginary part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[1] * split; a1 = con - beta_i[1]; a1 = con - a1; a2 = beta_i[1] - a1; con = y_jj[0] * split; b1 = con - y_jj[0]; b1 = con - b1; b2 = y_jj[0] - b1; t1_l = beta_i[1] * y_jj[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[0] * split; a1 = con - beta_i[0]; a1 = con - a1; a2 = beta_i[0] - a1; con = y_jj[1] * split; b1 = con - y_jj[1]; b1 = con - b1; b2 = y_jj[1] - b1; t2_l = beta_i[0] * y_jj[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp2_l[1] = t1_l; tmp2_t[1] = t1_t; } /* tmp2 = y[jy]*beta */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = tmp1_l[0]; a_t = tmp1_t[0]; b_l = tmp2_l[0]; b_t = tmp2_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[0] = t_l; tmp1_t[0] = t_t; /* Imaginary part */ a_l = tmp1_l[1]; a_t = tmp1_t[1]; b_l = tmp2_l[1]; b_t = tmp2_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[1] = t_l; tmp1_t[1] = t_t; } /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1_l[0]; y_i[jy+1] = tmp1_l[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum_l = sum_t = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij = a_i[tmpind]; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii * split; a1 = con - x_ii; a1 = con - a1; a2 = x_ii - a1; con = aij * split; b1 = con - aij; b1 = con - b1; b2 = aij - b1; prod_l = x_ii * aij; prod_t = (((a1 * b1 - prod_l) + a1 * b2) + a2 * b1) + a2 * b2; } /* prod = a[tmpind]*x[i] */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = sum_l + prod_l; e = t1 - sum_l; t2 = ((prod_l - e) + (sum_l - (t1 - e))) + sum_t + prod_t; /* The result is t1 + t2, after normalization. */ sum_l = t1 + t2; sum_t = t2 - (sum_l - t1); } /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij = a_i[tmpind]; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii * split; a1 = con - x_ii; a1 = con - a1; a2 = x_ii - a1; con = aij * split; b1 = con - aij; b1 = con - b1; b2 = aij - b1; prod_l = x_ii * aij; prod_t = (((a1 * b1 - prod_l) + a1 * b2) + a2 * b1) + a2 * b2; } /* prod = a[tmpind]*x[i] */ { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = sum_l + prod_l; e = t1 - sum_l; t2 = ((prod_l - e) + (sum_l - (t1 - e))) + sum_t + prod_t; /* The result is t1 + t2, after normalization. */ sum_l = t1 + t2; sum_t = t2 - (sum_l - t1); } /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { /* Compute complex-extra = complex-double * real. */ double t_l, t_t; { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = sum_l * split; a11 = con - sum_l; a11 = con - a11; a21 = sum_l - a11; con = alpha_i[0] * split; b1 = con - alpha_i[0]; b1 = con - b1; b2 = alpha_i[0] - b1; c11 = sum_l * alpha_i[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = sum_t * alpha_i[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[0] = t_l; tmp1_t[0] = t_t; { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = sum_l * split; a11 = con - sum_l; a11 = con - a11; a21 = sum_l - a11; con = alpha_i[1] * split; b1 = con - alpha_i[1]; b1 = con - b1; b2 = alpha_i[1] - b1; c11 = sum_l * alpha_i[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = sum_t * alpha_i[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[1] = t_l; tmp1_t[1] = t_t; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { /* Compute complex-extra = complex-double * complex-double. */ double t1_l, t1_t; double t2_l, t2_t; /* Real part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[0] * split; a1 = con - beta_i[0]; a1 = con - a1; a2 = beta_i[0] - a1; con = y_jj[0] * split; b1 = con - y_jj[0]; b1 = con - b1; b2 = y_jj[0] - b1; t1_l = beta_i[0] * y_jj[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[1] * split; a1 = con - beta_i[1]; a1 = con - a1; a2 = beta_i[1] - a1; con = y_jj[1] * split; b1 = con - y_jj[1]; b1 = con - b1; b2 = y_jj[1] - b1; t2_l = beta_i[1] * y_jj[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp2_l[0] = t1_l; tmp2_t[0] = t1_t; /* Imaginary part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[1] * split; a1 = con - beta_i[1]; a1 = con - a1; a2 = beta_i[1] - a1; con = y_jj[0] * split; b1 = con - y_jj[0]; b1 = con - b1; b2 = y_jj[0] - b1; t1_l = beta_i[1] * y_jj[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[0] * split; a1 = con - beta_i[0]; a1 = con - a1; a2 = beta_i[0] - a1; con = y_jj[1] * split; b1 = con - y_jj[1]; b1 = con - b1; b2 = y_jj[1] - b1; t2_l = beta_i[0] * y_jj[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp2_l[1] = t1_l; tmp2_t[1] = t1_t; } /* tmp2 = y[jy]*beta */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = tmp1_l[0]; a_t = tmp1_t[0]; b_l = tmp2_l[0]; b_t = tmp2_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[0] = t_l; tmp1_t[0] = t_t; /* Imaginary part */ a_l = tmp1_l[1]; a_t = tmp1_t[1]; b_l = tmp2_l[1]; b_t = tmp2_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[1] = t_l; tmp1_t[1] = t_t; } /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1_l[0]; y_i[jy+1] = tmp1_l[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; } } /* end c_zSYMV_d_d_x */ void c_zSYMV_d_z_x(enum blas_order_type order, enum blas_uplo_type uplo, int n, void* alpha, double* a, int lda, void* x, int incx, void* beta, void* y, int incy, enum blas_prec_type prec) { switch ( prec ) { case blas_prec_single: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = (double*) y; const double *a_i = a; const double *x_i = (double*) x; double *alpha_i = (double*) alpha; double *beta_i = (double*) beta; double y_ii[2]; double y_jj[2]; double aij; double x_ii[2]; double prod1[2]; /* case y = beta * y */ double prod[2]; double sum[2]; double tmp1[2]; double tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incx *= 2; incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum[0] = sum[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij = a_i[tmpind]; { prod[0] = x_ii[0] * aij; prod[1] = x_ii[1] * aij; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij = a_i[tmpind]; { prod[0] = x_ii[0] * aij; prod[1] = x_ii[1] * aij; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum[0] = sum[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij = a_i[tmpind]; { prod[0] = x_ii[0] * aij; prod[1] = x_ii[1] * aij; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij = a_i[tmpind]; { prod[0] = x_ii[0] * aij; prod[1] = x_ii[1] * aij; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; case blas_prec_double: case blas_prec_indigenous: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = (double*) y; const double *a_i = a; const double *x_i = (double*) x; double *alpha_i = (double*) alpha; double *beta_i = (double*) beta; double y_ii[2]; double y_jj[2]; double aij; double x_ii[2]; double prod1[2]; /* case y = beta * y */ double prod[2]; double sum[2]; double tmp1[2]; double tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incx *= 2; incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum[0] = sum[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij = a_i[tmpind]; { prod[0] = x_ii[0] * aij; prod[1] = x_ii[1] * aij; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij = a_i[tmpind]; { prod[0] = x_ii[0] * aij; prod[1] = x_ii[1] * aij; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum[0] = sum[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij = a_i[tmpind]; { prod[0] = x_ii[0] * aij; prod[1] = x_ii[1] * aij; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij = a_i[tmpind]; { prod[0] = x_ii[0] * aij; prod[1] = x_ii[1] * aij; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; case blas_prec_extra: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = (double*) y; const double *a_i = a; const double *x_i = (double*) x; double *alpha_i = (double*) alpha; double *beta_i = (double*) beta; double y_ii[2]; double y_jj[2]; double aij; double x_ii[2]; double prod1[2]; /* case y = beta * y */ double prod_l[2], prod_t[2]; double sum_l[2], sum_t[2]; double tmp1_l[2], tmp1_t[2]; double tmp2_l[2], tmp2_t[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incx *= 2; incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum_l[0] = sum_l[1] = sum_t[0] = sum_t[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij = a_i[tmpind]; { /* Compute complex-extra = complex-double * real. */ double t_l, t_t; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = aij * split; a1 = con - aij; a1 = con - a1; a2 = aij - a1; con = x_ii[0] * split; b1 = con - x_ii[0]; b1 = con - b1; b2 = x_ii[0] - b1; t_l = aij * x_ii[0]; t_t = (((a1 * b1 - t_l) + a1 * b2) + a2 * b1) + a2 * b2; } prod_l[0] = t_l; prod_t[0] = t_t; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = aij * split; a1 = con - aij; a1 = con - a1; a2 = aij - a1; con = x_ii[1] * split; b1 = con - x_ii[1]; b1 = con - b1; b2 = x_ii[1] - b1; t_l = aij * x_ii[1]; t_t = (((a1 * b1 - t_l) + a1 * b2) + a2 * b1) + a2 * b2; } prod_l[1] = t_l; prod_t[1] = t_t; } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij = a_i[tmpind]; { /* Compute complex-extra = complex-double * real. */ double t_l, t_t; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = aij * split; a1 = con - aij; a1 = con - a1; a2 = aij - a1; con = x_ii[0] * split; b1 = con - x_ii[0]; b1 = con - b1; b2 = x_ii[0] - b1; t_l = aij * x_ii[0]; t_t = (((a1 * b1 - t_l) + a1 * b2) + a2 * b1) + a2 * b2; } prod_l[0] = t_l; prod_t[0] = t_t; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = aij * split; a1 = con - aij; a1 = con - a1; a2 = aij - a1; con = x_ii[1] * split; b1 = con - x_ii[1]; b1 = con - b1; b2 = x_ii[1] - b1; t_l = aij * x_ii[1]; t_t = (((a1 * b1 - t_l) + a1 * b2) + a2 * b1) + a2 * b2; } prod_l[1] = t_l; prod_t[1] = t_t; } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { /* Compute complex-extra = complex-extra * complex-double. */ double a0_l, a0_t; double a1_l, a1_t; double t1_l, t1_t; double t2_l, t2_t; a0_l = sum_l[0]; a0_t = sum_t[0]; a1_l = sum_l[1]; a1_t = sum_t[1]; /* Real part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = alpha_i[0] * split; b1 = con - alpha_i[0]; b1 = con - b1; b2 = alpha_i[0] - b1; c11 = a0_l * alpha_i[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * alpha_i[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = alpha_i[1] * split; b1 = con - alpha_i[1]; b1 = con - b1; b2 = alpha_i[1] - b1; c11 = a1_l * alpha_i[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * alpha_i[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[0] = t1_l; tmp1_t[0] = t1_t; /* Imaginary part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = alpha_i[0] * split; b1 = con - alpha_i[0]; b1 = con - b1; b2 = alpha_i[0] - b1; c11 = a1_l * alpha_i[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * alpha_i[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = alpha_i[1] * split; b1 = con - alpha_i[1]; b1 = con - b1; b2 = alpha_i[1] - b1; c11 = a0_l * alpha_i[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * alpha_i[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[1] = t1_l; tmp1_t[1] = t1_t; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { /* Compute complex-extra = complex-double * complex-double. */ double t1_l, t1_t; double t2_l, t2_t; /* Real part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[0] * split; a1 = con - beta_i[0]; a1 = con - a1; a2 = beta_i[0] - a1; con = y_jj[0] * split; b1 = con - y_jj[0]; b1 = con - b1; b2 = y_jj[0] - b1; t1_l = beta_i[0] * y_jj[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[1] * split; a1 = con - beta_i[1]; a1 = con - a1; a2 = beta_i[1] - a1; con = y_jj[1] * split; b1 = con - y_jj[1]; b1 = con - b1; b2 = y_jj[1] - b1; t2_l = beta_i[1] * y_jj[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp2_l[0] = t1_l; tmp2_t[0] = t1_t; /* Imaginary part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[1] * split; a1 = con - beta_i[1]; a1 = con - a1; a2 = beta_i[1] - a1; con = y_jj[0] * split; b1 = con - y_jj[0]; b1 = con - b1; b2 = y_jj[0] - b1; t1_l = beta_i[1] * y_jj[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[0] * split; a1 = con - beta_i[0]; a1 = con - a1; a2 = beta_i[0] - a1; con = y_jj[1] * split; b1 = con - y_jj[1]; b1 = con - b1; b2 = y_jj[1] - b1; t2_l = beta_i[0] * y_jj[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp2_l[1] = t1_l; tmp2_t[1] = t1_t; } /* tmp2 = y[jy]*beta */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = tmp1_l[0]; a_t = tmp1_t[0]; b_l = tmp2_l[0]; b_t = tmp2_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[0] = t_l; tmp1_t[0] = t_t; /* Imaginary part */ a_l = tmp1_l[1]; a_t = tmp1_t[1]; b_l = tmp2_l[1]; b_t = tmp2_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[1] = t_l; tmp1_t[1] = t_t; } /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1_l[0]; y_i[jy+1] = tmp1_l[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum_l[0] = sum_l[1] = sum_t[0] = sum_t[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij = a_i[tmpind]; { /* Compute complex-extra = complex-double * real. */ double t_l, t_t; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = aij * split; a1 = con - aij; a1 = con - a1; a2 = aij - a1; con = x_ii[0] * split; b1 = con - x_ii[0]; b1 = con - b1; b2 = x_ii[0] - b1; t_l = aij * x_ii[0]; t_t = (((a1 * b1 - t_l) + a1 * b2) + a2 * b1) + a2 * b2; } prod_l[0] = t_l; prod_t[0] = t_t; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = aij * split; a1 = con - aij; a1 = con - a1; a2 = aij - a1; con = x_ii[1] * split; b1 = con - x_ii[1]; b1 = con - b1; b2 = x_ii[1] - b1; t_l = aij * x_ii[1]; t_t = (((a1 * b1 - t_l) + a1 * b2) + a2 * b1) + a2 * b2; } prod_l[1] = t_l; prod_t[1] = t_t; } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii[0] = x_i[ix]; x_ii[1] = x_i[ix+1]; aij = a_i[tmpind]; { /* Compute complex-extra = complex-double * real. */ double t_l, t_t; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = aij * split; a1 = con - aij; a1 = con - a1; a2 = aij - a1; con = x_ii[0] * split; b1 = con - x_ii[0]; b1 = con - b1; b2 = x_ii[0] - b1; t_l = aij * x_ii[0]; t_t = (((a1 * b1 - t_l) + a1 * b2) + a2 * b1) + a2 * b2; } prod_l[0] = t_l; prod_t[0] = t_t; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = aij * split; a1 = con - aij; a1 = con - a1; a2 = aij - a1; con = x_ii[1] * split; b1 = con - x_ii[1]; b1 = con - b1; b2 = x_ii[1] - b1; t_l = aij * x_ii[1]; t_t = (((a1 * b1 - t_l) + a1 * b2) + a2 * b1) + a2 * b2; } prod_l[1] = t_l; prod_t[1] = t_t; } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { /* Compute complex-extra = complex-extra * complex-double. */ double a0_l, a0_t; double a1_l, a1_t; double t1_l, t1_t; double t2_l, t2_t; a0_l = sum_l[0]; a0_t = sum_t[0]; a1_l = sum_l[1]; a1_t = sum_t[1]; /* Real part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = alpha_i[0] * split; b1 = con - alpha_i[0]; b1 = con - b1; b2 = alpha_i[0] - b1; c11 = a0_l * alpha_i[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * alpha_i[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = alpha_i[1] * split; b1 = con - alpha_i[1]; b1 = con - b1; b2 = alpha_i[1] - b1; c11 = a1_l * alpha_i[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * alpha_i[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[0] = t1_l; tmp1_t[0] = t1_t; /* Imaginary part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = alpha_i[0] * split; b1 = con - alpha_i[0]; b1 = con - b1; b2 = alpha_i[0] - b1; c11 = a1_l * alpha_i[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * alpha_i[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = alpha_i[1] * split; b1 = con - alpha_i[1]; b1 = con - b1; b2 = alpha_i[1] - b1; c11 = a0_l * alpha_i[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * alpha_i[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[1] = t1_l; tmp1_t[1] = t1_t; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { /* Compute complex-extra = complex-double * complex-double. */ double t1_l, t1_t; double t2_l, t2_t; /* Real part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[0] * split; a1 = con - beta_i[0]; a1 = con - a1; a2 = beta_i[0] - a1; con = y_jj[0] * split; b1 = con - y_jj[0]; b1 = con - b1; b2 = y_jj[0] - b1; t1_l = beta_i[0] * y_jj[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[1] * split; a1 = con - beta_i[1]; a1 = con - a1; a2 = beta_i[1] - a1; con = y_jj[1] * split; b1 = con - y_jj[1]; b1 = con - b1; b2 = y_jj[1] - b1; t2_l = beta_i[1] * y_jj[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp2_l[0] = t1_l; tmp2_t[0] = t1_t; /* Imaginary part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[1] * split; a1 = con - beta_i[1]; a1 = con - a1; a2 = beta_i[1] - a1; con = y_jj[0] * split; b1 = con - y_jj[0]; b1 = con - b1; b2 = y_jj[0] - b1; t1_l = beta_i[1] * y_jj[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[0] * split; a1 = con - beta_i[0]; a1 = con - a1; a2 = beta_i[0] - a1; con = y_jj[1] * split; b1 = con - y_jj[1]; b1 = con - b1; b2 = y_jj[1] - b1; t2_l = beta_i[0] * y_jj[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp2_l[1] = t1_l; tmp2_t[1] = t1_t; } /* tmp2 = y[jy]*beta */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = tmp1_l[0]; a_t = tmp1_t[0]; b_l = tmp2_l[0]; b_t = tmp2_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[0] = t_l; tmp1_t[0] = t_t; /* Imaginary part */ a_l = tmp1_l[1]; a_t = tmp1_t[1]; b_l = tmp2_l[1]; b_t = tmp2_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[1] = t_l; tmp1_t[1] = t_t; } /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1_l[0]; y_i[jy+1] = tmp1_l[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; } } /* end c_zSYMV_d_z_x */ void c_zSYMV_z_d_x(enum blas_order_type order, enum blas_uplo_type uplo, int n, void* alpha, void* a, int lda, double* x, int incx, void* beta, void* y, int incy, enum blas_prec_type prec) { switch ( prec ) { case blas_prec_single: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = (double*) y; const double *a_i = (double*) a; const double *x_i = x; double *alpha_i = (double*) alpha; double *beta_i = (double*) beta; double y_ii[2]; double y_jj[2]; double aij[2]; double x_ii; double prod1[2]; /* case y = beta * y */ double prod[2]; double sum[2]; double tmp1[2]; double tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum[0] = sum[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = aij[0] * x_ii; prod[1] = aij[1] * x_ii; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = aij[0] * x_ii; prod[1] = aij[1] * x_ii; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum[0] = sum[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = aij[0] * x_ii; prod[1] = aij[1] * x_ii; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = aij[0] * x_ii; prod[1] = aij[1] * x_ii; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; case blas_prec_double: case blas_prec_indigenous: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = (double*) y; const double *a_i = (double*) a; const double *x_i = x; double *alpha_i = (double*) alpha; double *beta_i = (double*) beta; double y_ii[2]; double y_jj[2]; double aij[2]; double x_ii; double prod1[2]; /* case y = beta * y */ double prod[2]; double sum[2]; double tmp1[2]; double tmp2[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum[0] = sum[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = aij[0] * x_ii; prod[1] = aij[1] * x_ii; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = aij[0] * x_ii; prod[1] = aij[1] * x_ii; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum[0] = sum[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = aij[0] * x_ii; prod[1] = aij[1] * x_ii; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { prod[0] = aij[0] * x_ii; prod[1] = aij[1] * x_ii; } /* prod = a[tmpind]*x[i] */ sum[0] = sum[0] + prod[0]; sum[1] = sum[1] + prod[1]; /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { tmp1[0] = sum[0] * alpha_i[0] - sum[1] * alpha_i[1]; tmp1[1] = sum[0] * alpha_i[1] + sum[1] * alpha_i[0]; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { tmp2[0] = beta_i[0] * y_jj[0] - beta_i[1] * y_jj[1]; tmp2[1] = beta_i[0] * y_jj[1] + beta_i[1] * y_jj[0]; } /* tmp2 = y[jy]*beta */ tmp1[0] = tmp1[0] + tmp2[0]; tmp1[1] = tmp1[1] + tmp2[1]; /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1[0]; y_i[jy+1] = tmp1[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; case blas_prec_extra: { int i, j, ky, kx, jy, jx, ix, iy, tmpind = 0; double *y_i = (double*) y; const double *a_i = (double*) a; const double *x_i = x; double *alpha_i = (double*) alpha; double *beta_i = (double*) beta; double y_ii[2]; double y_jj[2]; double aij[2]; double x_ii; double prod1[2]; /* case y = beta * y */ double prod_l[2], prod_t[2]; double sum_l[2], sum_t[2]; double tmp1_l[2], tmp1_t[2]; double tmp2_l[2], tmp2_t[2]; /* checks to see if any of arguments are wrong */ if ((n <=0) || (incy ==0) || (incx ==0) || (uplo != blas_upper && uplo != blas_lower) || (lda < MAX(1, n))) { printf("there is an error in symv"); return; } /* checks to see if we can return y with no calcs */ if ((n == 0) || ((alpha_i[0] == 0.0 && alpha_i[1] == 0.0 && ((beta_i[0] == 1.0 && beta_i[1] == 0.0))))){ return; } /* Set up start points in x and y */ incy *= 2; ky = 0; kx = 0; if(incx < 0) kx = 0- (n - 1) * incx; if(incy < 0) ky = 0- (n - 1) * incy; /* if alpha equals 0, multiply y = y*beta*/ if(alpha_i[0] == 0.0 && alpha_i[1] == 0.0){ if(beta_i[0] == 0.0 && beta_i[1] == 0.0){ iy = ky; for (i = 0; i < n; ++i){ y_i[iy] = 0.0; y_i[iy+1] = 0.0; /* y[iy] = 0.0 */ iy = iy + incy; } } else{ for(i = 0; i < n; i++){ y_ii[0] = y_i[iy]; y_ii[1] = y_i[iy+1]; { prod1[0] = y_ii[0] * beta_i[0] - y_ii[1] * beta_i[1]; prod1[1] = y_ii[0] * beta_i[1] + y_ii[1] * beta_i[0]; } /* prod1 = beta*y[iy]*/ y_i[iy] = prod1[0]; y_i[iy+1] = prod1[1]; /* y[iy] = prod1 */ iy = iy + incy; } } return; } else{ if((order == blas_colmajor) && (uplo == blas_upper) || (order == blas_rowmajor) && (uplo == blas_lower)){ /* case where a is stored as col-major and upper or row-major and lower */ jy = ky; for(j = 0; j < n; ++j){ sum_l[0] = sum_l[1] = sum_t[0] = sum_t[1] = 0.0; tmpind = j*lda; /* set tmpind to appropriate row */ ix = kx; for(i = 0; i <= j; i++){ /* gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { /* Compute complex-extra = complex-double * real. */ double t_l, t_t; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii * split; a1 = con - x_ii; a1 = con - a1; a2 = x_ii - a1; con = aij[0] * split; b1 = con - aij[0]; b1 = con - b1; b2 = aij[0] - b1; t_l = x_ii * aij[0]; t_t = (((a1 * b1 - t_l) + a1 * b2) + a2 * b1) + a2 * b2; } prod_l[0] = t_l; prod_t[0] = t_t; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii * split; a1 = con - x_ii; a1 = con - a1; a2 = x_ii - a1; con = aij[1] * split; b1 = con - aij[1]; b1 = con - b1; b2 = aij[1] - b1; t_l = x_ii * aij[1]; t_t = (((a1 * b1 - t_l) + a1 * b2) + a2 * b1) + a2 * b2; } prod_l[1] = t_l; prod_t[1] = t_t; } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to next element */ } tmpind = j+(j+1)*lda; /* set tmpind to appropriate column */ for(i= j+1; i < n; i++){ /* gets the elements of a from diagonal to end */ x_ii = x_i[ix]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { /* Compute complex-extra = complex-double * real. */ double t_l, t_t; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii * split; a1 = con - x_ii; a1 = con - a1; a2 = x_ii - a1; con = aij[0] * split; b1 = con - aij[0]; b1 = con - b1; b2 = aij[0] - b1; t_l = x_ii * aij[0]; t_t = (((a1 * b1 - t_l) + a1 * b2) + a2 * b1) + a2 * b2; } prod_l[0] = t_l; prod_t[0] = t_t; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii * split; a1 = con - x_ii; a1 = con - a1; a2 = x_ii - a1; con = aij[1] * split; b1 = con - aij[1]; b1 = con - b1; b2 = aij[1] - b1; t_l = x_ii * aij[1]; t_t = (((a1 * b1 - t_l) + a1 * b2) + a2 * b1) + a2 * b2; } prod_l[1] = t_l; prod_t[1] = t_t; } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } { /* Compute complex-extra = complex-extra * complex-double. */ double a0_l, a0_t; double a1_l, a1_t; double t1_l, t1_t; double t2_l, t2_t; a0_l = sum_l[0]; a0_t = sum_t[0]; a1_l = sum_l[1]; a1_t = sum_t[1]; /* Real part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = alpha_i[0] * split; b1 = con - alpha_i[0]; b1 = con - b1; b2 = alpha_i[0] - b1; c11 = a0_l * alpha_i[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * alpha_i[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = alpha_i[1] * split; b1 = con - alpha_i[1]; b1 = con - b1; b2 = alpha_i[1] - b1; c11 = a1_l * alpha_i[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * alpha_i[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[0] = t1_l; tmp1_t[0] = t1_t; /* Imaginary part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = alpha_i[0] * split; b1 = con - alpha_i[0]; b1 = con - b1; b2 = alpha_i[0] - b1; c11 = a1_l * alpha_i[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * alpha_i[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = alpha_i[1] * split; b1 = con - alpha_i[1]; b1 = con - b1; b2 = alpha_i[1] - b1; c11 = a0_l * alpha_i[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * alpha_i[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[1] = t1_l; tmp1_t[1] = t1_t; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { /* Compute complex-extra = complex-double * complex-double. */ double t1_l, t1_t; double t2_l, t2_t; /* Real part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[0] * split; a1 = con - beta_i[0]; a1 = con - a1; a2 = beta_i[0] - a1; con = y_jj[0] * split; b1 = con - y_jj[0]; b1 = con - b1; b2 = y_jj[0] - b1; t1_l = beta_i[0] * y_jj[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[1] * split; a1 = con - beta_i[1]; a1 = con - a1; a2 = beta_i[1] - a1; con = y_jj[1] * split; b1 = con - y_jj[1]; b1 = con - b1; b2 = y_jj[1] - b1; t2_l = beta_i[1] * y_jj[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp2_l[0] = t1_l; tmp2_t[0] = t1_t; /* Imaginary part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[1] * split; a1 = con - beta_i[1]; a1 = con - a1; a2 = beta_i[1] - a1; con = y_jj[0] * split; b1 = con - y_jj[0]; b1 = con - b1; b2 = y_jj[0] - b1; t1_l = beta_i[1] * y_jj[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[0] * split; a1 = con - beta_i[0]; a1 = con - a1; a2 = beta_i[0] - a1; con = y_jj[1] * split; b1 = con - y_jj[1]; b1 = con - b1; b2 = y_jj[1] - b1; t2_l = beta_i[0] * y_jj[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp2_l[1] = t1_l; tmp2_t[1] = t1_t; } /* tmp2 = y[jy]*beta */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = tmp1_l[0]; a_t = tmp1_t[0]; b_l = tmp2_l[0]; b_t = tmp2_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[0] = t_l; tmp1_t[0] = t_t; /* Imaginary part */ a_l = tmp1_l[1]; a_t = tmp1_t[1]; b_l = tmp2_l[1]; b_t = tmp2_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[1] = t_l; tmp1_t[1] = t_t; } /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1_l[0]; y_i[jy+1] = tmp1_l[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } /* case where a is col-major and lower or row-major and upper */ else{ jy = ky; for(j = 0; j < n; j++){ sum_l[0] = sum_l[1] = sum_t[0] = sum_t[1] = 0.0; ix = kx; tmpind = j; /* set tmpind to initial row */ for(i = 0; i <= j; i++){ /*gets the elements of a from start of row to diag */ x_ii = x_i[ix]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { /* Compute complex-extra = complex-double * real. */ double t_l, t_t; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii * split; a1 = con - x_ii; a1 = con - a1; a2 = x_ii - a1; con = aij[0] * split; b1 = con - aij[0]; b1 = con - b1; b2 = aij[0] - b1; t_l = x_ii * aij[0]; t_t = (((a1 * b1 - t_l) + a1 * b2) + a2 * b1) + a2 * b2; } prod_l[0] = t_l; prod_t[0] = t_t; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii * split; a1 = con - x_ii; a1 = con - a1; a2 = x_ii - a1; con = aij[1] * split; b1 = con - aij[1]; b1 = con - b1; b2 = aij[1] - b1; t_l = x_ii * aij[1]; t_t = (((a1 * b1 - t_l) + a1 * b2) + a2 * b1) + a2 * b2; } prod_l[1] = t_l; prod_t[1] = t_t; } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind += lda; /* set tmpind to get next element */ } tmpind = (j+1) + j*lda; /* set tmpind to initial element */ for(i= j+1; i < n; i++){ /* gets the elements of a from diag to end */ x_ii = x_i[ix]; aij[0] = a_i[tmpind]; aij[1] = a_i[tmpind+1]; { /* Compute complex-extra = complex-double * real. */ double t_l, t_t; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii * split; a1 = con - x_ii; a1 = con - a1; a2 = x_ii - a1; con = aij[0] * split; b1 = con - aij[0]; b1 = con - b1; b2 = aij[0] - b1; t_l = x_ii * aij[0]; t_t = (((a1 * b1 - t_l) + a1 * b2) + a2 * b1) + a2 * b2; } prod_l[0] = t_l; prod_t[0] = t_t; { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = x_ii * split; a1 = con - x_ii; a1 = con - a1; a2 = x_ii - a1; con = aij[1] * split; b1 = con - aij[1]; b1 = con - b1; b2 = aij[1] - b1; t_l = x_ii * aij[1]; t_t = (((a1 * b1 - t_l) + a1 * b2) + a2 * b1) + a2 * b2; } prod_l[1] = t_l; prod_t[1] = t_t; } /* prod = a[tmpind]*x[i] */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = sum_l[0]; a_t = sum_t[0]; b_l = prod_l[0]; b_t = prod_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[0] = t_l; sum_t[0] = t_t; /* Imaginary part */ a_l = sum_l[1]; a_t = sum_t[1]; b_l = prod_l[1]; b_t = prod_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } sum_l[1] = t_l; sum_t[1] = t_t; } /* sum = sum+prod */ ix = ix+incx; tmpind++; /* set tmpind to get next element */ } { /* Compute complex-extra = complex-extra * complex-double. */ double a0_l, a0_t; double a1_l, a1_t; double t1_l, t1_t; double t2_l, t2_t; a0_l = sum_l[0]; a0_t = sum_t[0]; a1_l = sum_l[1]; a1_t = sum_t[1]; /* Real part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = alpha_i[0] * split; b1 = con - alpha_i[0]; b1 = con - b1; b2 = alpha_i[0] - b1; c11 = a0_l * alpha_i[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * alpha_i[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = alpha_i[1] * split; b1 = con - alpha_i[1]; b1 = con - b1; b2 = alpha_i[1] - b1; c11 = a1_l * alpha_i[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * alpha_i[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[0] = t1_l; tmp1_t[0] = t1_t; /* Imaginary part */ { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a1_l * split; a11 = con - a1_l; a11 = con - a11; a21 = a1_l - a11; con = alpha_i[0] * split; b1 = con - alpha_i[0]; b1 = con - b1; b2 = alpha_i[0] - b1; c11 = a1_l * alpha_i[0]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a1_t * alpha_i[0]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } { /* Compute double-double = double-double * double. */ double a11, a21, b1, b2, c11, c21, c2, con, e, t1, t2; con = a0_l * split; a11 = con - a0_l; a11 = con - a11; a21 = a0_l - a11; con = alpha_i[1] * split; b1 = con - alpha_i[1]; b1 = con - b1; b2 = alpha_i[1] - b1; c11 = a0_l * alpha_i[1]; c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2; c2 = a0_t * alpha_i[1]; t1 = c11 + c2; e = t1 - c11; t2 = ((c2 - e) + (c11 - (t1 - e))) + c21; t2_l = t1 + t2; t2_t = t2 - (t2_l - t1); } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp1_l[1] = t1_l; tmp1_t[1] = t1_t; } /* tmp1 = sum*alpha */ y_jj[0] = y_i[jy]; y_jj[1] = y_i[jy+1]; { /* Compute complex-extra = complex-double * complex-double. */ double t1_l, t1_t; double t2_l, t2_t; /* Real part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[0] * split; a1 = con - beta_i[0]; a1 = con - a1; a2 = beta_i[0] - a1; con = y_jj[0] * split; b1 = con - y_jj[0]; b1 = con - b1; b2 = y_jj[0] - b1; t1_l = beta_i[0] * y_jj[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[1] * split; a1 = con - beta_i[1]; a1 = con - a1; a2 = beta_i[1] - a1; con = y_jj[1] * split; b1 = con - y_jj[1]; b1 = con - b1; b2 = y_jj[1] - b1; t2_l = beta_i[1] * y_jj[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } t2_l = -t2_l; t2_t = -t2_t; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp2_l[0] = t1_l; tmp2_t[0] = t1_t; /* Imaginary part */ { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[1] * split; a1 = con - beta_i[1]; a1 = con - a1; a2 = beta_i[1] - a1; con = y_jj[0] * split; b1 = con - y_jj[0]; b1 = con - b1; b2 = y_jj[0] - b1; t1_l = beta_i[1] * y_jj[0]; t1_t = (((a1 * b1 - t1_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double_double = double * double. */ double a1, a2, b1, b2, con; con = beta_i[0] * split; a1 = con - beta_i[0]; a1 = con - a1; a2 = beta_i[0] - a1; con = y_jj[1] * split; b1 = con - y_jj[1]; b1 = con - b1; b2 = y_jj[1] - b1; t2_l = beta_i[0] * y_jj[1]; t2_t = (((a1 * b1 - t2_l) + a1 * b2) + a2 * b1) + a2 * b2; } { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = t1_l + t2_l; e = t1 - t1_l; t2 = ((t2_l - e) + (t1_l - (t1 - e))) + t1_t + t2_t; /* The result is t1 + t2, after normalization. */ t1_l = t1 + t2; t1_t = t2 - (t1_l - t1); } tmp2_l[1] = t1_l; tmp2_t[1] = t1_t; } /* tmp2 = y[jy]*beta */ { double t_l, t_t; double a_l, a_t; double b_l, b_t; /* Real part */ a_l = tmp1_l[0]; a_t = tmp1_t[0]; b_l = tmp2_l[0]; b_t = tmp2_t[0]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[0] = t_l; tmp1_t[0] = t_t; /* Imaginary part */ a_l = tmp1_l[1]; a_t = tmp1_t[1]; b_l = tmp2_l[1]; b_t = tmp2_t[1]; { /* Compute double-double = double-double + double-double. */ double e, t1, t2; /* Knuth trick. */ t1 = a_l + b_l; e = t1 - a_l; t2 = ((b_l - e) + (a_l - (t1 - e))) + a_t + b_t; /* The result is t1 + t2, after normalization. */ t_l = t1 + t2; t_t = t2 - (t_l - t1); } tmp1_l[1] = t_l; tmp1_t[1] = t_t; } /* tmp1 = tmp1+tmp2 */ y_i[jy] = tmp1_l[0]; y_i[jy+1] = tmp1_l[1]; /* y[jy] = tmp1 */ jy = jy + incy; } } } } break; } } /* end c_zSYMV_z_d_x */