root / src / blas / HPL_dscal.c @ 12
Historique | Voir | Annoter | Télécharger (7,24 ko)
1 |
/*
|
---|---|
2 |
* -- High Performance Computing Linpack Benchmark (HPL)
|
3 |
* HPL - 2.0 - September 10, 2008
|
4 |
* Antoine P. Petitet
|
5 |
* University of Tennessee, Knoxville
|
6 |
* Innovative Computing Laboratory
|
7 |
* (C) Copyright 2000-2008 All Rights Reserved
|
8 |
*
|
9 |
* -- Copyright notice and Licensing terms:
|
10 |
*
|
11 |
* Redistribution and use in source and binary forms, with or without
|
12 |
* modification, are permitted provided that the following conditions
|
13 |
* are met:
|
14 |
*
|
15 |
* 1. Redistributions of source code must retain the above copyright
|
16 |
* notice, this list of conditions and the following disclaimer.
|
17 |
*
|
18 |
* 2. Redistributions in binary form must reproduce the above copyright
|
19 |
* notice, this list of conditions, and the following disclaimer in the
|
20 |
* documentation and/or other materials provided with the distribution.
|
21 |
*
|
22 |
* 3. All advertising materials mentioning features or use of this
|
23 |
* software must display the following acknowledgement:
|
24 |
* This product includes software developed at the University of
|
25 |
* Tennessee, Knoxville, Innovative Computing Laboratory.
|
26 |
*
|
27 |
* 4. The name of the University, the name of the Laboratory, or the
|
28 |
* names of its contributors may not be used to endorse or promote
|
29 |
* products derived from this software without specific written
|
30 |
* permission.
|
31 |
*
|
32 |
* -- Disclaimer:
|
33 |
*
|
34 |
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
35 |
* ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
36 |
* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
37 |
* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY
|
38 |
* OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
39 |
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
40 |
* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
41 |
* DATA OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
42 |
* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
43 |
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
44 |
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
45 |
* ---------------------------------------------------------------------
|
46 |
*/
|
47 |
/*
|
48 |
* Include files
|
49 |
*/
|
50 |
#include "hpl.h" |
51 |
|
52 |
#ifndef HPL_dscal
|
53 |
|
54 |
#ifdef STDC_HEADERS
|
55 |
void HPL_dscal
|
56 |
( |
57 |
const int N, |
58 |
const double ALPHA, |
59 |
double * X,
|
60 |
const int INCX |
61 |
) |
62 |
#else
|
63 |
void HPL_dscal
|
64 |
( N, ALPHA, X, INCX ) |
65 |
const int N; |
66 |
const double ALPHA; |
67 |
double * X;
|
68 |
const int INCX; |
69 |
#endif
|
70 |
{ |
71 |
/*
|
72 |
* Purpose
|
73 |
* =======
|
74 |
*
|
75 |
* HPL_dscal scales the vector x by alpha.
|
76 |
*
|
77 |
*
|
78 |
* Arguments
|
79 |
* =========
|
80 |
*
|
81 |
* N (local input) const int
|
82 |
* On entry, N specifies the length of the vector x. N must be
|
83 |
* at least zero.
|
84 |
*
|
85 |
* ALPHA (local input) const double
|
86 |
* On entry, ALPHA specifies the scalar alpha. When ALPHA is
|
87 |
* supplied as zero, then the entries of the incremented array X
|
88 |
* need not be set on input.
|
89 |
*
|
90 |
* X (local input/output) double *
|
91 |
* On entry, X is an incremented array of dimension at least
|
92 |
* ( 1 + ( n - 1 ) * abs( INCX ) ) that contains the vector x.
|
93 |
* On exit, the entries of the incremented array X are scaled
|
94 |
* by the scalar alpha.
|
95 |
*
|
96 |
* INCX (local input) const int
|
97 |
* On entry, INCX specifies the increment for the elements of X.
|
98 |
* INCX must not be zero.
|
99 |
*
|
100 |
* ---------------------------------------------------------------------
|
101 |
*/
|
102 |
#ifdef HPL_CALL_CBLAS
|
103 |
cblas_dscal( N, ALPHA, X, INCX ); |
104 |
#endif
|
105 |
#ifdef HPL_CALL_GSLCBLAS
|
106 |
cblas_dscal( N, ALPHA, X, INCX ); |
107 |
#endif
|
108 |
#ifdef HPL_CALL_VSIPL
|
109 |
register double x0, x1, x2, x3, x4, x5, x6, x7; |
110 |
register const double alpha = ALPHA; |
111 |
const double * StX; |
112 |
register int i; |
113 |
int nu;
|
114 |
const int incX2 = 2 * INCX, incX3 = 3 * INCX, |
115 |
incX4 = 4 * INCX, incX5 = 5 * INCX, |
116 |
incX6 = 6 * INCX, incX7 = 7 * INCX, |
117 |
incX8 = 8 * INCX;
|
118 |
|
119 |
if( ( N > 0 ) && ( alpha != HPL_rone ) ) |
120 |
{ |
121 |
if( alpha == HPL_rzero )
|
122 |
{ |
123 |
if( ( nu = ( N >> 3 ) << 3 ) != 0 ) |
124 |
{ |
125 |
StX = (double *)X + nu * INCX;
|
126 |
|
127 |
do
|
128 |
{ |
129 |
(*X) = HPL_rzero; X[incX4] = HPL_rzero; |
130 |
X[INCX ] = HPL_rzero; X[incX5] = HPL_rzero; |
131 |
X[incX2] = HPL_rzero; X[incX6] = HPL_rzero; |
132 |
X[incX3] = HPL_rzero; X[incX7] = HPL_rzero; X += incX8; |
133 |
|
134 |
} while( X != StX );
|
135 |
} |
136 |
|
137 |
for( i = N - nu; i != 0; i-- ) { *X = HPL_rzero; X += INCX; } |
138 |
} |
139 |
else
|
140 |
{ |
141 |
if( ( nu = ( N >> 3 ) << 3 ) != 0 ) |
142 |
{ |
143 |
StX = X + nu * INCX; |
144 |
|
145 |
do
|
146 |
{ |
147 |
x0 = (*X); x4 = X[incX4]; x1 = X[INCX ]; x5 = X[incX5]; |
148 |
x2 = X[incX2]; x6 = X[incX6]; x3 = X[incX3]; x7 = X[incX7]; |
149 |
|
150 |
x0 *= alpha; x4 *= alpha; x1 *= alpha; x5 *= alpha; |
151 |
x2 *= alpha; x6 *= alpha; x3 *= alpha; x7 *= alpha; |
152 |
|
153 |
(*X) = x0; X[incX4] = x4; X[INCX ] = x1; X[incX5] = x5; |
154 |
X[incX2] = x2; X[incX6] = x6; X[incX3] = x3; X[incX7] = x7; |
155 |
|
156 |
X += incX8; |
157 |
|
158 |
} while( X != StX );
|
159 |
} |
160 |
|
161 |
for( i = N - nu; i != 0; i-- ) |
162 |
{ x0 = (*X); x0 *= alpha; *X = x0; X += INCX; } |
163 |
} |
164 |
} |
165 |
#endif
|
166 |
|
167 |
#ifdef HPL_CALL_FBLAS
|
168 |
double alpha = ALPHA;
|
169 |
#ifdef HPL_USE_F77_INTEGER_DEF
|
170 |
const F77_INTEGER F77N = N, F77incx = INCX;
|
171 |
#else
|
172 |
#define F77N N
|
173 |
#define F77incx INCX
|
174 |
#endif
|
175 |
|
176 |
F77dscal( &F77N, &alpha, X, &F77incx ); |
177 |
#endif
|
178 |
|
179 |
#ifdef HPL_CALL_CUBLAS
|
180 |
double alpha = ALPHA;
|
181 |
#define CUBLASN N
|
182 |
#define CUBLASincx INCX
|
183 |
|
184 |
CUBLAS_DSCAL( &CUBLASN, &alpha, X, &CUBLASincx ); |
185 |
#endif
|
186 |
|
187 |
#ifdef HPL_CALL_ACML
|
188 |
double alpha = ALPHA;
|
189 |
#define ACMLN N
|
190 |
#define ACMLincx INCX
|
191 |
|
192 |
dscal_( &ACMLN, &alpha, X, &ACMLincx ); |
193 |
#endif
|
194 |
/*
|
195 |
* End of HPL_dscal
|
196 |
*/
|
197 |
} |
198 |
|
199 |
#endif
|