Merge pull request #1762 from martin-frbg/issue1710-2
[platform/upstream/openblas.git] / interface / zgemv.c
1 /*********************************************************************/
2 /* Copyright 2009, 2010 The University of Texas at Austin.           */
3 /* All rights reserved.                                              */
4 /*                                                                   */
5 /* Redistribution and use in source and binary forms, with or        */
6 /* without modification, are permitted provided that the following   */
7 /* conditions are met:                                               */
8 /*                                                                   */
9 /*   1. Redistributions of source code must retain the above         */
10 /*      copyright notice, this list of conditions and the following  */
11 /*      disclaimer.                                                  */
12 /*                                                                   */
13 /*   2. Redistributions in binary form must reproduce the above      */
14 /*      copyright notice, this list of conditions and the following  */
15 /*      disclaimer in the documentation and/or other materials       */
16 /*      provided with the distribution.                              */
17 /*                                                                   */
18 /*    THIS  SOFTWARE IS PROVIDED  BY THE  UNIVERSITY OF  TEXAS AT    */
19 /*    AUSTIN  ``AS IS''  AND ANY  EXPRESS OR  IMPLIED WARRANTIES,    */
20 /*    INCLUDING, BUT  NOT LIMITED  TO, THE IMPLIED  WARRANTIES OF    */
21 /*    MERCHANTABILITY  AND FITNESS FOR  A PARTICULAR  PURPOSE ARE    */
22 /*    DISCLAIMED.  IN  NO EVENT SHALL THE UNIVERSITY  OF TEXAS AT    */
23 /*    AUSTIN OR CONTRIBUTORS BE  LIABLE FOR ANY DIRECT, INDIRECT,    */
24 /*    INCIDENTAL,  SPECIAL, EXEMPLARY,  OR  CONSEQUENTIAL DAMAGES    */
25 /*    (INCLUDING, BUT  NOT LIMITED TO,  PROCUREMENT OF SUBSTITUTE    */
26 /*    GOODS  OR  SERVICES; LOSS  OF  USE,  DATA,  OR PROFITS;  OR    */
27 /*    BUSINESS INTERRUPTION) HOWEVER CAUSED  AND ON ANY THEORY OF    */
28 /*    LIABILITY, WHETHER  IN CONTRACT, STRICT  LIABILITY, OR TORT    */
29 /*    (INCLUDING NEGLIGENCE OR OTHERWISE)  ARISING IN ANY WAY OUT    */
30 /*    OF  THE  USE OF  THIS  SOFTWARE,  EVEN  IF ADVISED  OF  THE    */
31 /*    POSSIBILITY OF SUCH DAMAGE.                                    */
32 /*                                                                   */
33 /* The views and conclusions contained in the software and           */
34 /* documentation are those of the authors and should not be          */
35 /* interpreted as representing official policies, either expressed   */
36 /* or implied, of The University of Texas at Austin.                 */
37 /*********************************************************************/
38
39 #include <stdio.h>
40 #include "common.h"
41 #ifdef FUNCTION_PROFILE
42 #include "functable.h"
43 #endif
44
45 #ifdef XDOUBLE
46 #define ERROR_NAME "XGEMV "
47 #elif defined(DOUBLE)
48 #define ERROR_NAME "ZGEMV "
49 #else
50 #define ERROR_NAME "CGEMV "
51 #endif
52
53 #ifdef SMP
54 static int (*gemv_thread[])(BLASLONG, BLASLONG, FLOAT *, FLOAT *, BLASLONG,  FLOAT * , BLASLONG, FLOAT *, BLASLONG, FLOAT *, int) = {
55 #ifdef XDOUBLE
56   xgemv_thread_n, xgemv_thread_t, xgemv_thread_r, xgemv_thread_c, xgemv_thread_o, xgemv_thread_u, xgemv_thread_s, xgemv_thread_d,
57 #elif defined DOUBLE
58   zgemv_thread_n, zgemv_thread_t, zgemv_thread_r, zgemv_thread_c, zgemv_thread_o, zgemv_thread_u, zgemv_thread_s, zgemv_thread_d,
59 #else
60   cgemv_thread_n, cgemv_thread_t, cgemv_thread_r, cgemv_thread_c, cgemv_thread_o, cgemv_thread_u, cgemv_thread_s, cgemv_thread_d,
61 #endif
62 };
63 #endif
64
65 #ifndef CBLAS
66
67 void NAME(char *TRANS, blasint *M, blasint *N,
68          FLOAT *ALPHA, FLOAT *a, blasint *LDA,
69          FLOAT *x, blasint *INCX,
70          FLOAT *BETA,  FLOAT *y, blasint *INCY){
71
72   char trans = *TRANS;
73   blasint m = *M;
74   blasint n = *N;
75   blasint lda = *LDA;
76   blasint incx = *INCX;
77   blasint incy = *INCY;
78
79   FLOAT *buffer;
80   int buffer_size;
81 #ifdef SMP
82   int nthreads;
83 #endif
84
85   int (*gemv[])(BLASLONG, BLASLONG, BLASLONG, FLOAT, FLOAT, FLOAT *, BLASLONG,
86                 FLOAT * , BLASLONG, FLOAT *, BLASLONG, FLOAT *) = {
87                   GEMV_N, GEMV_T, GEMV_R, GEMV_C,
88                   GEMV_O, GEMV_U, GEMV_S, GEMV_D,
89                 };
90
91   blasint    info;
92   blasint    lenx, leny;
93   blasint    i;
94
95   FLOAT alpha_r = *(ALPHA + 0);
96   FLOAT alpha_i = *(ALPHA + 1);
97
98   FLOAT beta_r  = *(BETA + 0);
99   FLOAT beta_i  = *(BETA + 1);
100
101   PRINT_DEBUG_NAME;
102
103   TOUPPER(trans);
104
105   info = 0;
106
107   i    = -1;
108
109   if (trans == 'N')  i = 0;
110   if (trans == 'T')  i = 1;
111   if (trans == 'R')  i = 2;
112   if (trans == 'C')  i = 3;
113   if (trans == 'O')  i = 4;
114   if (trans == 'U')  i = 5;
115   if (trans == 'S')  i = 6;
116   if (trans == 'D')  i = 7;
117
118   if (incy == 0)      info = 11;
119   if (incx == 0)      info = 8;
120   if (lda < MAX(1,m)) info = 6;
121   if (n < 0)          info = 3;
122   if (m < 0)          info = 2;
123   if (i < 0)          info = 1;
124
125   trans = i;
126
127   if (info != 0) {
128     BLASFUNC(xerbla)(ERROR_NAME, &info, sizeof(ERROR_NAME));
129     return;
130   }
131
132 #else
133
134 void CNAME(enum CBLAS_ORDER order,
135            enum CBLAS_TRANSPOSE TransA,
136            blasint m, blasint n,
137            void *VALPHA,
138            void  *va, blasint lda,
139            void  *vx, blasint incx,
140            void *VBETA,
141            void  *vy, blasint incy){
142
143   FLOAT *ALPHA = (FLOAT*) VALPHA;
144   FLOAT *a = (FLOAT*) va;
145   FLOAT *x = (FLOAT*) vx;
146   FLOAT *BETA = (FLOAT*) VBETA;
147   FLOAT *y = (FLOAT*) vy;
148   FLOAT *buffer;
149   blasint    lenx, leny;
150   int trans, buffer_size;
151   blasint info, t;
152 #ifdef SMP
153   int nthreads;
154 #endif
155
156   int (*gemv[])(BLASLONG, BLASLONG, BLASLONG, FLOAT, FLOAT, FLOAT *, BLASLONG,
157             FLOAT * , BLASLONG, FLOAT *, BLASLONG, FLOAT *) = {
158               GEMV_N, GEMV_T, GEMV_R, GEMV_C,
159               GEMV_O, GEMV_U, GEMV_S, GEMV_D,
160             };
161
162   FLOAT alpha_r = *(ALPHA + 0);
163   FLOAT alpha_i = *(ALPHA + 1);
164
165   FLOAT beta_r  = *(BETA + 0);
166   FLOAT beta_i  = *(BETA + 1);
167
168   PRINT_DEBUG_CNAME;
169
170   trans = -1;
171   info  =  0;
172
173   if (order == CblasColMajor) {
174     if (TransA == CblasNoTrans)     trans = 0;
175     if (TransA == CblasTrans)       trans = 1;
176     if (TransA == CblasConjNoTrans) trans = 2;
177     if (TransA == CblasConjTrans)   trans = 3;
178
179     info = -1;
180
181     if (incy == 0)        info = 11;
182     if (incx == 0)        info = 8;
183     if (lda < MAX(1, m))  info = 6;
184     if (n < 0)            info = 3;
185     if (m < 0)            info = 2;
186     if (trans < 0)        info = 1;
187
188   }
189
190   if (order == CblasRowMajor) {
191     if (TransA == CblasNoTrans)     trans = 1;
192     if (TransA == CblasTrans)       trans = 0;
193     if (TransA == CblasConjNoTrans) trans = 3;
194     if (TransA == CblasConjTrans)   trans = 2;
195
196     info = -1;
197
198     t = n;
199     n = m;
200     m = t;
201
202     if (incy == 0)        info = 11;
203     if (incx == 0)        info = 8;
204     if (lda < MAX(1, m))  info = 6;
205     if (n < 0)            info = 3;
206     if (m < 0)            info = 2;
207     if (trans < 0)        info = 1;
208
209   }
210
211   if (info >= 0) {
212     BLASFUNC(xerbla)(ERROR_NAME, &info, sizeof(ERROR_NAME));
213     return;
214   }
215
216 #endif
217
218   /*  Quick return if possible. */
219
220   if (m == 0 || n == 0) return;
221
222   lenx = n;
223   leny = m;
224
225   if (trans & 1) lenx = m;
226   if (trans & 1) leny = n;
227
228   if (beta_r != ONE || beta_i != ZERO) SCAL_K(leny, 0, 0, beta_r, beta_i, y, blasabs(incy), NULL, 0, NULL, 0);
229
230   if (alpha_r == ZERO && alpha_i == ZERO) return;
231
232   IDEBUG_START;
233
234   FUNCTION_PROFILE_START();
235
236   if (incx < 0) x -= (lenx - 1) * incx * 2;
237   if (incy < 0) y -= (leny - 1) * incy * 2;
238
239   buffer_size = 2 * (m + n) + 128 / sizeof(FLOAT);
240 #ifdef WINDOWS_ABI
241   buffer_size += 160 / sizeof(FLOAT) ;
242 #endif
243   // for alignment
244   buffer_size = (buffer_size + 3) & ~3;
245   STACK_ALLOC(buffer_size, FLOAT, buffer);
246
247 #if defined(ARCH_X86_64) && defined(MAX_STACK_ALLOC) && MAX_STACK_ALLOC > 0
248   // cgemv_t.S return NaN if there are NaN or Inf in the buffer (see bug #746)
249   if(trans && stack_alloc_size)
250     memset(buffer, 0, MIN(BUFFER_SIZE, sizeof(FLOAT) * buffer_size));
251 #endif
252
253 #ifdef SMP
254
255   if ( 1L * m * n < 1024L * GEMM_MULTITHREAD_THRESHOLD )
256     nthreads = 1;
257   else
258     nthreads = num_cpu_avail(2);
259
260   if (nthreads == 1) {
261 #endif
262
263     (gemv[(int)trans])(m, n, 0, alpha_r, alpha_i, a, lda, x, incx, y, incy, buffer);
264
265 #ifdef SMP
266
267   } else {
268
269     (gemv_thread[(int)trans])(m, n, ALPHA, a, lda, x, incx, y, incy, buffer, nthreads);
270
271   }
272 #endif
273
274   STACK_FREE(buffer);
275
276   FUNCTION_PROFILE_END(4, m * n + m + n,  2 * m * n);
277
278   IDEBUG_END;
279
280   return;
281 }