Annotation of rpl/lapack/blas/dnrm2.f, revision 1.7
1.7 ! bertrand 1: *> \brief \b DNRM2
! 2: *
! 3: * =========== DOCUMENTATION ===========
! 4: *
! 5: * Online html documentation available at
! 6: * http://www.netlib.org/lapack/explore-html/
! 7: *
! 8: * Definition:
! 9: * ===========
! 10: *
! 11: * DOUBLE PRECISION FUNCTION DNRM2(N,X,INCX)
! 12: *
! 13: * .. Scalar Arguments ..
! 14: * INTEGER INCX,N
! 15: * ..
! 16: * .. Array Arguments ..
! 17: * DOUBLE PRECISION X(*)
! 18: * ..
! 19: *
! 20: *
! 21: *> \par Purpose:
! 22: * =============
! 23: *>
! 24: *> \verbatim
! 25: *>
! 26: *> DNRM2 returns the euclidean norm of a vector via the function
! 27: *> name, so that
! 28: *>
! 29: *> DNRM2 := sqrt( x'*x )
! 30: *> \endverbatim
! 31: *
! 32: * Authors:
! 33: * ========
! 34: *
! 35: *> \author Univ. of Tennessee
! 36: *> \author Univ. of California Berkeley
! 37: *> \author Univ. of Colorado Denver
! 38: *> \author NAG Ltd.
! 39: *
! 40: *> \date November 2011
! 41: *
! 42: *> \ingroup double_blas_level1
! 43: *
! 44: *> \par Further Details:
! 45: * =====================
! 46: *>
! 47: *> \verbatim
! 48: *>
! 49: *> -- This version written on 25-October-1982.
! 50: *> Modified on 14-October-1993 to inline the call to DLASSQ.
! 51: *> Sven Hammarling, Nag Ltd.
! 52: *> \endverbatim
! 53: *>
! 54: * =====================================================================
1.1 bertrand 55: DOUBLE PRECISION FUNCTION DNRM2(N,X,INCX)
1.7 ! bertrand 56: *
! 57: * -- Reference BLAS level1 routine (version 3.4.0) --
! 58: * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
! 59: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
! 60: * November 2011
! 61: *
1.1 bertrand 62: * .. Scalar Arguments ..
63: INTEGER INCX,N
64: * ..
65: * .. Array Arguments ..
66: DOUBLE PRECISION X(*)
67: * ..
68: *
69: * =====================================================================
70: *
71: * .. Parameters ..
72: DOUBLE PRECISION ONE,ZERO
73: PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
74: * ..
75: * .. Local Scalars ..
76: DOUBLE PRECISION ABSXI,NORM,SCALE,SSQ
77: INTEGER IX
78: * ..
79: * .. Intrinsic Functions ..
80: INTRINSIC ABS,SQRT
81: * ..
82: IF (N.LT.1 .OR. INCX.LT.1) THEN
83: NORM = ZERO
84: ELSE IF (N.EQ.1) THEN
85: NORM = ABS(X(1))
86: ELSE
87: SCALE = ZERO
88: SSQ = ONE
89: * The following loop is equivalent to this call to the LAPACK
90: * auxiliary routine:
91: * CALL DLASSQ( N, X, INCX, SCALE, SSQ )
92: *
93: DO 10 IX = 1,1 + (N-1)*INCX,INCX
94: IF (X(IX).NE.ZERO) THEN
95: ABSXI = ABS(X(IX))
96: IF (SCALE.LT.ABSXI) THEN
97: SSQ = ONE + SSQ* (SCALE/ABSXI)**2
98: SCALE = ABSXI
99: ELSE
100: SSQ = SSQ + (ABSXI/SCALE)**2
101: END IF
102: END IF
103: 10 CONTINUE
104: NORM = SCALE*SQRT(SSQ)
105: END IF
106: *
107: DNRM2 = NORM
108: RETURN
109: *
110: * End of DNRM2.
111: *
112: END
CVSweb interface <joel.bertrand@systella.fr>