Mercurial > octave-nkf

diff libcruft/blas/scnrm2.f @ 7789:82be108cc558

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/libcruft/blas/scnrm2.f	Sun Apr 27 22:34:17 2008 +0200
@@ -0,0 +1,72 @@
+      REAL FUNCTION SCNRM2(N,X,INCX)
+*     .. Scalar Arguments ..
+      INTEGER INCX,N
+*     ..
+*     .. Array Arguments ..
+      COMPLEX X(*)
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  SCNRM2 returns the euclidean norm of a vector via the function
+*  name, so that
+*
+*     SCNRM2 := sqrt( conjg( x' )*x )
+*
+*
+*
+*  -- This version written on 25-October-1982.
+*     Modified on 14-October-1993 to inline the call to CLASSQ.
+*     Sven Hammarling, Nag Ltd.
+*
+*
+*     .. Parameters ..
+      REAL ONE,ZERO
+      PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
+*     ..
+*     .. Local Scalars ..
+      REAL NORM,SCALE,SSQ,TEMP
+      INTEGER IX
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC ABS,AIMAG,REAL,SQRT
+*     ..
+      IF (N.LT.1 .OR. INCX.LT.1) THEN
+          NORM = ZERO
+      ELSE
+          SCALE = ZERO
+          SSQ = ONE
+*        The following loop is equivalent to this call to the LAPACK
+*        auxiliary routine:
+*        CALL CLASSQ( N, X, INCX, SCALE, SSQ )
+*
+          DO 10 IX = 1,1 + (N-1)*INCX,INCX
+              IF (REAL(X(IX)).NE.ZERO) THEN
+                  TEMP = ABS(REAL(X(IX)))
+                  IF (SCALE.LT.TEMP) THEN
+                      SSQ = ONE + SSQ* (SCALE/TEMP)**2
+                      SCALE = TEMP
+                  ELSE
+                      SSQ = SSQ + (TEMP/SCALE)**2
+                  END IF
+              END IF
+              IF (AIMAG(X(IX)).NE.ZERO) THEN
+                  TEMP = ABS(AIMAG(X(IX)))
+                  IF (SCALE.LT.TEMP) THEN
+                      SSQ = ONE + SSQ* (SCALE/TEMP)**2
+                      SCALE = TEMP
+                  ELSE
+                      SSQ = SSQ + (TEMP/SCALE)**2
+                  END IF
+              END IF
+   10     CONTINUE
+          NORM = SCALE*SQRT(SSQ)
+      END IF
+*
+      SCNRM2 = NORM
+      RETURN
+*
+*     End of SCNRM2.
+*
+      END