Annotation of rpl/lapack/blas/dznrm2.f, revision 1.8
1.8 ! bertrand 1: *> \brief \b DZNRM2
! 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 DZNRM2(N,X,INCX)
! 12: *
! 13: * .. Scalar Arguments ..
! 14: * INTEGER INCX,N
! 15: * ..
! 16: * .. Array Arguments ..
! 17: * COMPLEX*16 X(*)
! 18: * ..
! 19: *
! 20: *
! 21: *> \par Purpose:
! 22: * =============
! 23: *>
! 24: *> \verbatim
! 25: *>
! 26: *> DZNRM2 returns the euclidean norm of a vector via the function
! 27: *> name, so that
! 28: *>
! 29: *> DZNRM2 := sqrt( x**H*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 ZLASSQ.
! 51: *> Sven Hammarling, Nag Ltd.
! 52: *> \endverbatim
! 53: *>
! 54: * =====================================================================
1.1 bertrand 55: DOUBLE PRECISION FUNCTION DZNRM2(N,X,INCX)
1.8 ! 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 ..
1.8 ! bertrand 66: COMPLEX*16 X(*)
1.1 bertrand 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 NORM,SCALE,SSQ,TEMP
77: INTEGER IX
78: * ..
79: * .. Intrinsic Functions ..
80: INTRINSIC ABS,DBLE,DIMAG,SQRT
81: * ..
82: IF (N.LT.1 .OR. INCX.LT.1) THEN
83: NORM = ZERO
84: ELSE
85: SCALE = ZERO
86: SSQ = ONE
87: * The following loop is equivalent to this call to the LAPACK
88: * auxiliary routine:
89: * CALL ZLASSQ( N, X, INCX, SCALE, SSQ )
90: *
91: DO 10 IX = 1,1 + (N-1)*INCX,INCX
92: IF (DBLE(X(IX)).NE.ZERO) THEN
93: TEMP = ABS(DBLE(X(IX)))
94: IF (SCALE.LT.TEMP) THEN
95: SSQ = ONE + SSQ* (SCALE/TEMP)**2
96: SCALE = TEMP
97: ELSE
98: SSQ = SSQ + (TEMP/SCALE)**2
99: END IF
100: END IF
101: IF (DIMAG(X(IX)).NE.ZERO) THEN
102: TEMP = ABS(DIMAG(X(IX)))
103: IF (SCALE.LT.TEMP) THEN
104: SSQ = ONE + SSQ* (SCALE/TEMP)**2
105: SCALE = TEMP
106: ELSE
107: SSQ = SSQ + (TEMP/SCALE)**2
108: END IF
109: END IF
110: 10 CONTINUE
111: NORM = SCALE*SQRT(SSQ)
112: END IF
113: *
114: DZNRM2 = NORM
115: RETURN
116: *
117: * End of DZNRM2.
118: *
119: END
CVSweb interface <joel.bertrand@systella.fr>