source: trunk/SOURCES/BLAS/snrm2.f @ 22

Last change on this file since 22 was 22, checked in by roche, 9 years ago

Petites adaptations diverses du code pour compilation en gfortran. Ajout d un Makefile flexible a option pour choisir ifort ou gfortran.
File size: 1.6 KB
Line 
1      REAL FUNCTION SNRM2(N,X,INCX)
2*     .. Scalar Arguments ..
3      INTEGER INCX,N
4*     ..
5*     .. Array Arguments ..
6      REAL X(*)
7*     ..
8*
9*  Purpose
10*  =======
11*
12*  SNRM2 returns the euclidean norm of a vector via the function
13*  name, so that
14*
15*     SNRM2 := 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 SLASSQ.
22*     Sven Hammarling, Nag Ltd.
23*
24*  =====================================================================
25*
26*     .. Parameters ..
27      REAL ONE,ZERO
28      PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
29*     ..
30*     .. Local Scalars ..
31      REAL 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 SLASSQ( 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      SNRM2 = NORM
63      RETURN
64*
65*     End of SNRM2.
66*
67      END
Note: See TracBrowser for help on using the repository browser.