| @@ -98,7 +98,7 @@ void CNAME(blasint n, FLOAT alpha_r, void *vx, blasint incx){ | |||
| if (nthreads == 1) { | |||
| #endif | |||
| SCAL_K(n, 0, 0, alpha[0], alpha[1], x, incx, NULL, 0, NULL, 0); | |||
| SCAL_K(n, 0, 0, alpha[0], alpha[1], x, incx, NULL, 0, NULL, 1); | |||
| #ifdef SMP | |||
| } else { | |||
| @@ -108,7 +108,7 @@ void CNAME(blasint n, FLOAT alpha_r, void *vx, blasint incx){ | |||
| mode = BLAS_SINGLE | BLAS_COMPLEX; | |||
| #endif | |||
| blas_level1_thread(mode, n, 0, 0, alpha, x, incx, NULL, 0, NULL, 0, (int (*)(void))SCAL_K, nthreads); | |||
| blas_level1_thread(mode, n, 0, 0, alpha, x, incx, NULL, 0, NULL, 1, (int (*)(void))SCAL_K, nthreads); | |||
| } | |||
| #endif | |||
| @@ -27,65 +27,56 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. | |||
| /************************************************************************************** | |||
| * 2013/09/14 Saar | |||
| * BLASTEST float : OK | |||
| * BLASTEST double : OK | |||
| * CTEST : OK | |||
| * TEST : OK | |||
| * BLASTEST float : OK | |||
| * BLASTEST double : OK | |||
| * CTEST : OK | |||
| * TEST : OK | |||
| * | |||
| **************************************************************************************/ | |||
| #include "common.h" | |||
| // The c/zscal_k function is called not only by cblas_c/zscal but also by other upper-level interfaces. | |||
| // In certain cases, the expected return values for cblas_s/zscal differ from those of other upper-level interfaces. | |||
| // To handle this, we use the dummy2 parameter to differentiate between them. | |||
| int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r,FLOAT da_i, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *dummy, BLASLONG dummy2) | |||
| { | |||
| BLASLONG i=0; | |||
| BLASLONG inc_x2; | |||
| BLASLONG ip = 0; | |||
| FLOAT temp; | |||
| BLASLONG i = 0; | |||
| BLASLONG inc_x2; | |||
| BLASLONG ip = 0; | |||
| FLOAT temp; | |||
| if ( (n <= 0) || (inc_x <= 0)) | |||
| return(0); | |||
| if ((n <= 0) || (inc_x <= 0)) | |||
| return(0); | |||
| inc_x2 = 2 * inc_x; | |||
| if (dummy2 == 0) { | |||
| for (i = 0; i < n; i++) | |||
| { | |||
| if (da_r == 0.0 && da_i == 0.0) | |||
| { | |||
| x[ip] = 0.0; | |||
| x[ip+1] = 0.0; | |||
| } | |||
| else | |||
| { | |||
| temp = da_r * x[ip] - da_i * x[ip+1]; | |||
| x[ip+1] = da_r * x[ip+1] + da_i * x[ip] ; | |||
| x[ip] = temp; | |||
| } | |||
| inc_x2 = 2 * inc_x; | |||
| for ( i=0; i<n; i++ ) | |||
| { | |||
| if ( da_r == 0.0 ) | |||
| { | |||
| if ( da_i == 0.0 ) | |||
| { | |||
| temp = 0.0; | |||
| x[ip+1] = 0.0 ; | |||
| } | |||
| else | |||
| { | |||
| temp = - da_i * x[ip+1] ; | |||
| if (isnan(x[ip]) || isinf(x[ip])) temp = NAN; | |||
| if (!isinf(x[ip+1])) | |||
| x[ip+1] = da_i * x[ip] ; | |||
| else x[ip+1] = NAN; | |||
| } | |||
| } | |||
| else | |||
| { | |||
| if ( da_i == 0.0 ) | |||
| { | |||
| temp = da_r * x[ip] ; | |||
| x[ip+1] = da_r * x[ip+1]; | |||
| } | |||
| else | |||
| { | |||
| temp = da_r * x[ip] - da_i * x[ip+1] ; | |||
| x[ip+1] = da_r * x[ip+1] + da_i * x[ip] ; | |||
| } | |||
| } | |||
| x[ip] = temp; | |||
| ip += inc_x2; | |||
| } | |||
| return(0); | |||
| } | |||
| for (i = 0; i < n; i++) | |||
| { | |||
| temp = da_r * x[ip] - da_i * x[ip+1]; | |||
| x[ip+1] = da_r * x[ip+1] + da_i * x[ip] ; | |||
| ip += inc_x2; | |||
| } | |||
| return(0); | |||
| x[ip] = temp; | |||
| ip += inc_x2; | |||
| } | |||
| return(0); | |||
| } | |||