Statistiques
| Révision :

root / src / blas / HPL_dscal.c @ 9

Historique | Voir | Annoter | Télécharger (6,99 ko)

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