Statistiques
| Révision :

root / src / lapack / double / dlassq.f @ 10

Historique | Voir | Annoter | Télécharger (2,63 ko)

1 
      SUBROUTINE DLASSQ( N, X, INCX, SCALE, SUMSQ )
2 
*
3 
*  -- LAPACK auxiliary routine (version 3.2) --
4 
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
5 
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6 
*     November 2006
7 
*
8 
*     .. Scalar Arguments ..
9 
      INTEGER            INCX, N
10 
      DOUBLE PRECISION   SCALE, SUMSQ
11 
*     ..
12 
*     .. Array Arguments ..
13 
      DOUBLE PRECISION   X( * )
14 
*     ..
15 
*
16 
*  Purpose
17 
*  =======
18 
*
19 
*  DLASSQ  returns the values  scl  and  smsq  such that
20 
*
21 
*     ( scl**2 )*smsq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,
22 
*
23 
*  where  x( i ) = X( 1 + ( i - 1 )*INCX ). The value of  sumsq  is
24 
*  assumed to be non-negative and  scl  returns the value
25 
*
26 
*     scl = max( scale, abs( x( i ) ) ).
27 
*
28 
*  scale and sumsq must be supplied in SCALE and SUMSQ and
29 
*  scl and smsq are overwritten on SCALE and SUMSQ respectively.
30 
*
31 
*  The routine makes only one pass through the vector x.
32 
*
33 
*  Arguments
34 
*  =========
35 
*
36 
*  N       (input) INTEGER
37 
*          The number of elements to be used from the vector X.
38 
*
39 
*  X       (input) DOUBLE PRECISION array, dimension (N)
40 
*          The vector for which a scaled sum of squares is computed.
41 
*             x( i )  = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n.
42 
*
43 
*  INCX    (input) INTEGER
44 
*          The increment between successive values of the vector X.
45 
*          INCX > 0.
46 
*
47 
*  SCALE   (input/output) DOUBLE PRECISION
48 
*          On entry, the value  scale  in the equation above.
49 
*          On exit, SCALE is overwritten with  scl , the scaling factor
50 
*          for the sum of squares.
51 
*
52 
*  SUMSQ   (input/output) DOUBLE PRECISION
53 
*          On entry, the value  sumsq  in the equation above.
54 
*          On exit, SUMSQ is overwritten with  smsq , the basic sum of
55 
*          squares from which  scl  has been factored out.
56 
*
57 
* =====================================================================
58 
*
59 
*     .. Parameters ..
60 
      DOUBLE PRECISION   ZERO
61 
      PARAMETER          ( ZERO = 0.0D+0 )
62 
*     ..
63 
*     .. Local Scalars ..
64 
      INTEGER            IX
65 
      DOUBLE PRECISION   ABSXI
66 
*     ..
67 
*     .. Intrinsic Functions ..
68 
      INTRINSIC          ABS
69 
*     ..
70 
*     .. Executable Statements ..
71 
*
72 
      IF( N.GT.0 ) THEN
73 
         DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX
74 
            IF( X( IX ).NE.ZERO ) THEN
75 
               ABSXI = ABS( X( IX ) )
76 
               IF( SCALE.LT.ABSXI ) THEN
77 
                  SUMSQ = 1 + SUMSQ*( SCALE / ABSXI )**2
78 
                  SCALE = ABSXI
79 
               ELSE
80 
                  SUMSQ = SUMSQ + ( ABSXI / SCALE )**2
81 
               END IF
82 
            END IF
83 
   10    CONTINUE
84 
      END IF
85 
      RETURN
86 
*
87 
*     End of DLASSQ
88 
*
89 
      END