/root/doris/contrib/openblas/interface/nrm2.c
Line | Count | Source |
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 | | #ifndef CBLAS |
46 | | |
47 | 0 | FLOATRET NAME(blasint *N, FLOAT *x, blasint *INCX){ |
48 | |
|
49 | 0 | BLASLONG n = *N; |
50 | 0 | BLASLONG incx = *INCX; |
51 | 0 | FLOATRET ret; |
52 | |
|
53 | 0 | PRINT_DEBUG_NAME; |
54 | |
|
55 | 0 | if (n <= 0) return 0.; |
56 | | |
57 | 0 | #ifndef COMPLEX |
58 | 0 | if (n == 1) |
59 | | #ifdef DOUBLE |
60 | 0 | return fabs(x[0]); |
61 | | #else |
62 | 0 | return fabsf(x[0]); |
63 | 0 | #endif |
64 | 0 | #endif |
65 | | |
66 | 0 | if (incx == 0) |
67 | 0 | #ifndef COMPLEX |
68 | | #ifdef DOUBLE |
69 | 0 | return (sqrt((double)n)*fabs(x[0])); |
70 | | #else |
71 | 0 | return (sqrt((float)n)*fabsf(x[0])); |
72 | 0 | #endif |
73 | | #else |
74 | | #ifdef DOUBLE |
75 | | { |
76 | | double fr=fabs(x[0]); |
77 | | double fi=fabs(x[1]); |
78 | | double fmin=MIN(fr,fi); |
79 | | double fmax=MAX(fr,fi); |
80 | | if (fmax==0.) return(fmax); |
81 | | if (fmax==fmin) return(sqrt((double)n)*sqrt(2.)*fmax); |
82 | | return (sqrt((double)n) * fmax * sqrt (1. + (fmin/fmax)*(fmin/fmax))); |
83 | | } |
84 | | #else |
85 | | { |
86 | | float fr=fabs(x[0]); |
87 | | float fi=fabs(x[1]); |
88 | | float fmin=MIN(fr,fi); |
89 | | float fmax=MAX(fr,fi); |
90 | | if (fmax==0.) return(fmax); |
91 | | if (fmax==fmin) return(sqrt((float)n)*sqrt(2.)*fmax); |
92 | | return (sqrt((float)n) * fmax * sqrt (1. + (fmin/fmax)*(fmin/fmax))); |
93 | | } |
94 | | #endif |
95 | | #endif |
96 | | |
97 | 0 | if (incx < 0) |
98 | | #ifdef COMPLEX |
99 | | x -= (n - 1) * incx * 2; |
100 | | #else |
101 | 0 | x -= (n - 1) * incx; |
102 | 0 | #endif |
103 | 0 | IDEBUG_START; |
104 | |
|
105 | 0 | FUNCTION_PROFILE_START(); |
106 | |
|
107 | 0 | ret = (FLOATRET)NRM2_K(n, x, incx); |
108 | |
|
109 | 0 | FUNCTION_PROFILE_END(COMPSIZE, n, 2 * n); |
110 | |
|
111 | 0 | IDEBUG_END; |
112 | |
|
113 | 0 | return ret; |
114 | 0 | } Unexecuted instantiation: snrm2_ Unexecuted instantiation: dnrm2_ |
115 | | |
116 | | #else |
117 | | |
118 | | #ifdef COMPLEX |
119 | | FLOAT CNAME(blasint n, void *vx, blasint incx){ |
120 | | FLOAT *x = (FLOAT*) vx; |
121 | | #else |
122 | | FLOAT CNAME(blasint n, FLOAT *x, blasint incx){ |
123 | | #endif |
124 | | |
125 | | FLOAT ret; |
126 | | |
127 | | PRINT_DEBUG_CNAME; |
128 | | |
129 | | if (n <= 0) return 0.; |
130 | | |
131 | | #ifndef COMPLEX |
132 | | if (n == 1) |
133 | | #ifdef DOUBLE |
134 | | return fabs(x[0]); |
135 | | #else |
136 | | return fabsf(x[0]); |
137 | | #endif |
138 | | #endif |
139 | | |
140 | | if (incx == 0) |
141 | | #ifndef COMPLEX |
142 | | #ifdef DOUBLE |
143 | | return (sqrt((double)n)*fabs(x[0])); |
144 | | #else |
145 | | return (sqrt((float)n)*fabsf(x[0])); |
146 | | #endif |
147 | | #else |
148 | | #ifdef DOUBLE |
149 | | { |
150 | | double fr=fabs(x[0]); |
151 | | double fi=fabs(x[1]); |
152 | | double fmin=MIN(fr,fi); |
153 | | double fmax=MAX(fr,fi); |
154 | | if (fmax==0.) return(fmax); |
155 | | if (fmax==fmin) return(sqrt((double)n)*sqrt(2.)*fmax); |
156 | | return (sqrt((double)n) * fmax * sqrt (1. + (fmin/fmax)*(fmin/fmax))); |
157 | | } |
158 | | #else |
159 | | { |
160 | | float fr=fabs(x[0]); |
161 | | float fi=fabs(x[1]); |
162 | | float fmin=MIN(fr,fi); |
163 | | float fmax=MAX(fr,fi); |
164 | | if (fmax==0.) return(fmax); |
165 | | if (fmax==fmin) return(sqrt((float)n)*sqrt(2.)*fmax); |
166 | | return (sqrt((float)n) * fmax * sqrt (1. + (fmin/fmax)*(fmin/fmax))); |
167 | | } |
168 | | #endif |
169 | | #endif |
170 | | |
171 | | if (incx < 0) |
172 | | #ifdef COMPLEX |
173 | | x -= (n - 1) * incx * 2; |
174 | | #else |
175 | | x -= (n - 1) * incx; |
176 | | #endif |
177 | | |
178 | | IDEBUG_START; |
179 | | |
180 | | FUNCTION_PROFILE_START(); |
181 | | |
182 | | ret = NRM2_K(n, x, incx); |
183 | | |
184 | | FUNCTION_PROFILE_END(COMPSIZE, n, 2 * n); |
185 | | |
186 | | IDEBUG_END; |
187 | | |
188 | | return ret; |
189 | | } |
190 | | |
191 | | #endif |