Return to dznrm2.f CVS log

Up to [local] / rpl / lapack / blas

Annotation of rpl/lapack/blas/dznrm2.f, revision 1.1.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