LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
snrm2.f
Go to the documentation of this file.
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
 All Files Functions