![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SNRM2 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * REAL FUNCTION SNRM2(N,X,INCX) 00012 * 00013 * .. Scalar Arguments .. 00014 * INTEGER INCX,N 00015 * .. 00016 * .. Array Arguments .. 00017 * REAL X(*) 00018 * .. 00019 * 00020 * 00021 *> \par Purpose: 00022 * ============= 00023 *> 00024 *> \verbatim 00025 *> 00026 *> SNRM2 returns the euclidean norm of a vector via the function 00027 *> name, so that 00028 *> 00029 *> SNRM2 := sqrt( x'*x ). 00030 *> \endverbatim 00031 * 00032 * Authors: 00033 * ======== 00034 * 00035 *> \author Univ. of Tennessee 00036 *> \author Univ. of California Berkeley 00037 *> \author Univ. of Colorado Denver 00038 *> \author NAG Ltd. 00039 * 00040 *> \date November 2011 00041 * 00042 *> \ingroup single_blas_level1 00043 * 00044 *> \par Further Details: 00045 * ===================== 00046 *> 00047 *> \verbatim 00048 *> 00049 *> -- This version written on 25-October-1982. 00050 *> Modified on 14-October-1993 to inline the call to SLASSQ. 00051 *> Sven Hammarling, Nag Ltd. 00052 *> \endverbatim 00053 *> 00054 * ===================================================================== 00055 REAL FUNCTION SNRM2(N,X,INCX) 00056 * 00057 * -- Reference BLAS level1 routine (version 3.4.0) -- 00058 * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- 00059 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00060 * November 2011 00061 * 00062 * .. Scalar Arguments .. 00063 INTEGER INCX,N 00064 * .. 00065 * .. Array Arguments .. 00066 REAL X(*) 00067 * .. 00068 * 00069 * ===================================================================== 00070 * 00071 * .. Parameters .. 00072 REAL ONE,ZERO 00073 PARAMETER (ONE=1.0E+0,ZERO=0.0E+0) 00074 * .. 00075 * .. Local Scalars .. 00076 REAL ABSXI,NORM,SCALE,SSQ 00077 INTEGER IX 00078 * .. 00079 * .. Intrinsic Functions .. 00080 INTRINSIC ABS,SQRT 00081 * .. 00082 IF (N.LT.1 .OR. INCX.LT.1) THEN 00083 NORM = ZERO 00084 ELSE IF (N.EQ.1) THEN 00085 NORM = ABS(X(1)) 00086 ELSE 00087 SCALE = ZERO 00088 SSQ = ONE 00089 * The following loop is equivalent to this call to the LAPACK 00090 * auxiliary routine: 00091 * CALL SLASSQ( N, X, INCX, SCALE, SSQ ) 00092 * 00093 DO 10 IX = 1,1 + (N-1)*INCX,INCX 00094 IF (X(IX).NE.ZERO) THEN 00095 ABSXI = ABS(X(IX)) 00096 IF (SCALE.LT.ABSXI) THEN 00097 SSQ = ONE + SSQ* (SCALE/ABSXI)**2 00098 SCALE = ABSXI 00099 ELSE 00100 SSQ = SSQ + (ABSXI/SCALE)**2 00101 END IF 00102 END IF 00103 10 CONTINUE 00104 NORM = SCALE*SQRT(SSQ) 00105 END IF 00106 * 00107 SNRM2 = NORM 00108 RETURN 00109 * 00110 * End of SNRM2. 00111 * 00112 END