1 /* blas/source_nrm2_r.h 2 * 3 * Copyright (C) 1996, 1997, 1998, 1999, 2000 Gerard Jungman 4 * 5 * This program is free software; you can redistribute it and/or modify 6 * it under the terms of the GNU General Public License as published by 7 * the Free Software Foundation; either version 3 of the License, or (at 8 * your option) any later version. 9 * 10 * This program is distributed in the hope that it will be useful, but 11 * WITHOUT ANY WARRANTY; without even the implied warranty of 12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 * General Public License for more details. 14 * 15 * You should have received a copy of the GNU General Public License 16 * along with this program; if not, write to the Free Software 17 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. 18 */ 19 20 { 21 BASE scale = 0.0; 22 BASE ssq = 1.0; 23 INDEX i; 24 INDEX ix = 0; 25 26 if (N <= 0 || incX <= 0) { 27 return 0; 28 } else if (N == 1) { 29 return fabs(X[0]); 30 } 31 32 for (i = 0; i < N; i++) { 33 const BASE x = X[ix]; 34 35 if (x != 0.0) { 36 const BASE ax = fabs(x); 37 38 if (scale < ax) { 39 ssq = 1.0 + ssq * (scale / ax) * (scale / ax); 40 scale = ax; 41 } else { 42 ssq += (ax / scale) * (ax / scale); 43 } 44 } 45 46 ix += incX; 47 } 48 49 return scale * sqrt(ssq); 50 } 51