Browse Source

kernel/generic: Fixed cscal and zscal

tags/v0.3.30
gxw 8 months ago
parent
commit
e114880dc4
2 changed files with 42 additions and 51 deletions
  1. +2
    -2
      interface/zscal.c
  2. +40
    -49
      kernel/arm/zscal.c

+ 2
- 2
interface/zscal.c View File

@@ -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


+ 40
- 49
kernel/arm/zscal.c View File

@@ -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);
}



Loading…
Cancel
Save