Return to dznrm2.f CVS log

Up to [local] / rpl / lapack / blas

Annotation of rpl/lapack/blas/dznrm2.f, revision 1.1

1.1     ! bertrand    1:       DOUBLE PRECISION FUNCTION DZNRM2(N,X,INCX)
        !             2: *     .. Scalar Arguments ..
        !             3:       INTEGER INCX,N
        !             4: *     ..
        !             5: *     .. Array Arguments ..
        !             6:       DOUBLE COMPLEX X(*)
        !             7: *     ..
        !             8: *
        !             9: *  Purpose
        !            10: *  =======
        !            11: *
        !            12: *  DZNRM2 returns the euclidean norm of a vector via the function
        !            13: *  name, so that
        !            14: *
        !            15: *     DZNRM2 := sqrt( conjg( 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 ZLASSQ.
        !            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 NORM,SCALE,SSQ,TEMP
        !            32:       INTEGER IX
        !            33: *     ..
        !            34: *     .. Intrinsic Functions ..
        !            35:       INTRINSIC ABS,DBLE,DIMAG,SQRT
        !            36: *     ..
        !            37:       IF (N.LT.1 .OR. INCX.LT.1) THEN
        !            38:           NORM = ZERO
        !            39:       ELSE
        !            40:           SCALE = ZERO
        !            41:           SSQ = ONE
        !            42: *        The following loop is equivalent to this call to the LAPACK
        !            43: *        auxiliary routine:
        !            44: *        CALL ZLASSQ( N, X, INCX, SCALE, SSQ )
        !            45: *
        !            46:           DO 10 IX = 1,1 + (N-1)*INCX,INCX
        !            47:               IF (DBLE(X(IX)).NE.ZERO) THEN
        !            48:                   TEMP = ABS(DBLE(X(IX)))
        !            49:                   IF (SCALE.LT.TEMP) THEN
        !            50:                       SSQ = ONE + SSQ* (SCALE/TEMP)**2
        !            51:                       SCALE = TEMP
        !            52:                   ELSE
        !            53:                       SSQ = SSQ + (TEMP/SCALE)**2
        !            54:                   END IF
        !            55:               END IF
        !            56:               IF (DIMAG(X(IX)).NE.ZERO) THEN
        !            57:                   TEMP = ABS(DIMAG(X(IX)))
        !            58:                   IF (SCALE.LT.TEMP) THEN
        !            59:                       SSQ = ONE + SSQ* (SCALE/TEMP)**2
        !            60:                       SCALE = TEMP
        !            61:                   ELSE
        !            62:                       SSQ = SSQ + (TEMP/SCALE)**2
        !            63:                   END IF
        !            64:               END IF
        !            65:    10     CONTINUE
        !            66:           NORM = SCALE*SQRT(SSQ)
        !            67:       END IF
        !            68: *
        !            69:       DZNRM2 = NORM
        !            70:       RETURN
        !            71: *
        !            72: *     End of DZNRM2.
        !            73: *
        !            74:       END