Mercurial > octave-nkf
view libcruft/blas/snrm2.f @ 7789:82be108cc558
First attempt at single precision tyeps
* * *
corrections to qrupdate single precision routines
* * *
prefer demotion to single over promotion to double
* * *
Add single precision support to log2 function
* * *
Trivial PROJECT file update
* * *
Cache optimized hermitian/transpose methods
* * *
Add tests for tranpose/hermitian and ChangeLog entry for new transpose code
author | David Bateman <dbateman@free.fr> |
---|---|
date | Sun, 27 Apr 2008 22:34:17 +0200 |
parents | |
children |
line wrap: on
line source
REAL FUNCTION SNRM2(N,X,INCX) * .. Scalar Arguments .. INTEGER INCX,N * .. * .. Array Arguments .. REAL X(*) * .. * * Purpose * ======= * * SNRM2 returns the euclidean norm of a vector via the function * name, so that * * SNRM2 := sqrt( x'*x ). * * Further Details * =============== * * -- This version written on 25-October-1982. * Modified on 14-October-1993 to inline the call to SLASSQ. * Sven Hammarling, Nag Ltd. * * * .. Parameters .. REAL ONE,ZERO PARAMETER (ONE=1.0E+0,ZERO=0.0E+0) * .. * .. Local Scalars .. REAL ABSXI,NORM,SCALE,SSQ INTEGER IX * .. * .. Intrinsic Functions .. INTRINSIC ABS,SQRT * .. IF (N.LT.1 .OR. INCX.LT.1) THEN NORM = ZERO ELSE IF (N.EQ.1) THEN NORM = ABS(X(1)) ELSE SCALE = ZERO SSQ = ONE * The following loop is equivalent to this call to the LAPACK * auxiliary routine: * CALL SLASSQ( N, X, INCX, SCALE, SSQ ) * DO 10 IX = 1,1 + (N-1)*INCX,INCX IF (X(IX).NE.ZERO) THEN ABSXI = ABS(X(IX)) IF (SCALE.LT.ABSXI) THEN SSQ = ONE + SSQ* (SCALE/ABSXI)**2 SCALE = ABSXI ELSE SSQ = SSQ + (ABSXI/SCALE)**2 END IF END IF 10 CONTINUE NORM = SCALE*SQRT(SSQ) END IF * SNRM2 = NORM RETURN * * End of SNRM2. * END