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