Return to dnrm2.f CVS log

Up to [local] / rpl / lapack / blas

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