Return to dnrm2.f CVS log

Up to [local] / rpl / lapack / blas

Commit initial.

    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