1
1
/***************************************************************************
2
- Copyright (c) 2016 , The OpenBLAS Project
2
+ Copyright (c) 2013 , The OpenBLAS Project
3
3
All rights reserved.
4
4
Redistribution and use in source and binary forms, with or without
5
5
modification, are permitted provided that the following conditions are
@@ -25,61 +25,58 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
25
25
USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
26
26
*****************************************************************************/
27
27
28
+ /**************************************************************************************
29
+ * 2013/09/14 Saar
30
+ * BLASTEST float : OK
31
+ * BLASTEST double : OK
32
+ * CTEST : OK
33
+ * TEST : OK
34
+ *
35
+ **************************************************************************************/
36
+
28
37
#include "common.h"
29
38
39
+ // The c/zscal_k function is called not only by cblas_c/zscal but also by other upper-level interfaces.
40
+ // In certain cases, the expected return values for cblas_s/zscal differ from those of other upper-level interfaces.
41
+ // To handle this, we use the dummy2 parameter to differentiate between them.
30
42
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 )
31
43
{
32
- BLASLONG i = 0 ;
33
- BLASLONG inc_x2 ;
34
- BLASLONG ip = 0 ;
35
- FLOAT temp ;
44
+ BLASLONG i = 0 ;
45
+ BLASLONG inc_x2 ;
46
+ BLASLONG ip = 0 ;
47
+ FLOAT temp ;
36
48
37
- inc_x2 = 2 * inc_x ;
38
- for ( i = 0 ; i < n ; i ++ )
39
- {
40
- if ( da_r == 0.0 )
41
- {
42
- if ( da_i == 0.0 )
43
- {
44
- temp = 0.0 ;
45
- x [ip + 1 ] = 0.0 ;
46
- }
47
- else
48
- {
49
- temp = - da_i * x [ip + 1 ] ;
50
- if (isnan (x [ip ]) || isinf (x [ip ])) temp = NAN ;
51
- if (!isinf (x [ip + 1 ]))
52
- x [ip + 1 ] = da_i * x [ip ] ;
53
- else x [ip + 1 ] = NAN ;
54
- }
55
- }
56
- else
57
- {
58
- if ( da_i == 0.0 )
59
- {
60
- temp = da_r * x [ip ] ;
61
- if (!isinf (x [ip + 1 ]))
62
- x [ip + 1 ] = da_r * x [ip + 1 ];
63
- else x [ip + 1 ] = NAN ;
64
- }
65
- else
66
- {
67
- temp = da_r * x [ip ] - da_i * x [ip + 1 ] ;
68
- if (!isinf (x [ip + 1 ]))
69
- x [ip + 1 ] = da_r * x [ip + 1 ] + da_i * x [ip ] ;
70
- else x [ip + 1 ] = NAN ;
71
- }
72
- }
73
- if ( da_r != da_r )
74
- x [ip ] = da_r ;
75
- else
76
- x [ip ] = temp ;
77
-
78
- ip += inc_x2 ;
79
- }
49
+ if ((n <= 0 ) || (inc_x <= 0 ))
50
+ return (0 );
80
51
81
- return (0 );
52
+ inc_x2 = 2 * inc_x ;
53
+ if (dummy2 == 0 ) {
54
+ for (i = 0 ; i < n ; i ++ )
55
+ {
56
+ if (da_r == 0.0 && da_i == 0.0 )
57
+ {
58
+ x [ip ] = 0.0 ;
59
+ x [ip + 1 ] = 0.0 ;
60
+ }
61
+ else
62
+ {
63
+ temp = da_r * x [ip ] - da_i * x [ip + 1 ];
64
+ x [ip + 1 ] = da_r * x [ip + 1 ] + da_i * x [ip ] ;
65
+ x [ip ] = temp ;
66
+ }
82
67
83
- }
68
+ ip += inc_x2 ;
69
+ }
70
+ return (0 );
71
+ }
72
+ for (i = 0 ; i < n ; i ++ )
73
+ {
74
+ temp = da_r * x [ip ] - da_i * x [ip + 1 ];
75
+ x [ip + 1 ] = da_r * x [ip + 1 ] + da_i * x [ip ] ;
84
76
77
+ x [ip ] = temp ;
78
+ ip += inc_x2 ;
79
+ }
85
80
81
+ return (0 );
82
+ }
0 commit comments