Return to dnrm2.f CVS log

Up to [local] / rpl / lapack / blas

Annotation of rpl/lapack/blas/dnrm2.f, revision 1.4

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