Annotation of rpl/lapack/blas/dnrm2.f, revision 1.1
1.1 ! bertrand 1: DOUBLE PRECISION FUNCTION DNRM2(N,X,INCX)
! 2: * .. Scalar Arguments ..
! 3: INTEGER INCX,N
! 4: * ..
! 5: * .. Array Arguments ..
! 6: DOUBLE PRECISION X(*)
! 7: * ..
! 8: *
! 9: * Purpose
! 10: * =======
! 11: *
! 12: * DNRM2 returns the euclidean norm of a vector via the function
! 13: * name, so that
! 14: *
! 15: * DNRM2 := sqrt( x'*x )
! 16: *
! 17: * Further Details
! 18: * ===============
! 19: *
! 20: * -- This version written on 25-October-1982.
! 21: * Modified on 14-October-1993 to inline the call to DLASSQ.
! 22: * Sven Hammarling, Nag Ltd.
! 23: *
! 24: * =====================================================================
! 25: *
! 26: * .. Parameters ..
! 27: DOUBLE PRECISION ONE,ZERO
! 28: PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
! 29: * ..
! 30: * .. Local Scalars ..
! 31: DOUBLE PRECISION ABSXI,NORM,SCALE,SSQ
! 32: INTEGER IX
! 33: * ..
! 34: * .. Intrinsic Functions ..
! 35: INTRINSIC ABS,SQRT
! 36: * ..
! 37: IF (N.LT.1 .OR. INCX.LT.1) THEN
! 38: NORM = ZERO
! 39: ELSE IF (N.EQ.1) THEN
! 40: NORM = ABS(X(1))
! 41: ELSE
! 42: SCALE = ZERO
! 43: SSQ = ONE
! 44: * The following loop is equivalent to this call to the LAPACK
! 45: * auxiliary routine:
! 46: * CALL DLASSQ( N, X, INCX, SCALE, SSQ )
! 47: *
! 48: DO 10 IX = 1,1 + (N-1)*INCX,INCX
! 49: IF (X(IX).NE.ZERO) THEN
! 50: ABSXI = ABS(X(IX))
! 51: IF (SCALE.LT.ABSXI) THEN
! 52: SSQ = ONE + SSQ* (SCALE/ABSXI)**2
! 53: SCALE = ABSXI
! 54: ELSE
! 55: SSQ = SSQ + (ABSXI/SCALE)**2
! 56: END IF
! 57: END IF
! 58: 10 CONTINUE
! 59: NORM = SCALE*SQRT(SSQ)
! 60: END IF
! 61: *
! 62: DNRM2 = NORM
! 63: RETURN
! 64: *
! 65: * End of DNRM2.
! 66: *
! 67: END
CVSweb interface <joel.bertrand@systella.fr>