home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / octave-1.1.1p1-src.tgz / tar.out / fsf / octave / libcruft / lapack / dlassq.f < prev    next >
Text File  |  1996-09-28  |  3KB  |  90 lines
  1.       SUBROUTINE DLASSQ( N, X, INCX, SCALE, SUMSQ )
  2. *
  3. *  -- LAPACK auxiliary routine (version 2.0) --
  4. *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
  5. *     Courant Institute, Argonne National Lab, and Rice University
  6. *     October 31, 1992
  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
  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
  90.