Télécharger dlassq.eso

Retour à la liste

Numérotation des lignes :

  1. C DLASSQ SOURCE BP208322 15/10/13 21:15:40 8670
  2. *> \brief \b DLASSQ updates a sum of squares represented in scaled form.
  3. *
  4. * =========== DOCUMENTATION ===========
  5. *
  6. * Online html documentation available at
  7. * http://www.netlib.org/lapack/explore-html/
  8. *
  9. *> \htmlonly
  10. *> Download DLASSQ + dependencies
  11. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlassq.f">
  12. *> [TGZ]</a>
  13. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlassq.f">
  14. *> [ZIP]</a>
  15. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlassq.f">
  16. *> [TXT]</a>
  17. *> \endhtmlonly
  18. *
  19. * Definition:
  20. * ===========
  21. *
  22. * SUBROUTINE DLASSQ( N, X, INCX, SCALE, SUMSQ )
  23. *
  24. * .. Scalar Arguments ..
  25. * INTEGER INCX, N
  26. * REAL*8 SCALE, SUMSQ
  27. * ..
  28. * .. Array Arguments ..
  29. * REAL*8 X( * )
  30. * ..
  31. *
  32. *
  33. *> \par Purpose:
  34. * =============
  35. *>
  36. *> \verbatim
  37. *>
  38. *> DLASSQ returns the values scl and smsq such that
  39. *>
  40. *> ( scl**2 )*smsq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,
  41. *>
  42. *> where x( i ) = X( 1 + ( i - 1 )*INCX ). The value of sumsq is
  43. *> assumed to be non-negative and scl returns the value
  44. *>
  45. *> scl = max( scale, abs( x( i ) ) ).
  46. *>
  47. *> scale and sumsq must be supplied in SCALE and SUMSQ and
  48. *> scl and smsq are overwritten on SCALE and SUMSQ respectively.
  49. *>
  50. *> The routine makes only one pass through the vector x.
  51. *> \endverbatim
  52. *
  53. * Arguments:
  54. * ==========
  55. *
  56. *> \param[in] N
  57. *> \verbatim
  58. *> N is INTEGER
  59. *> The number of elements to be used from the vector X.
  60. *> \endverbatim
  61. *>
  62. *> \param[in] X
  63. *> \verbatim
  64. *> X is DOUBLE PRECISION array, dimension (N)
  65. *> The vector for which a scaled sum of squares is computed.
  66. *> x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n.
  67. *> \endverbatim
  68. *>
  69. *> \param[in] INCX
  70. *> \verbatim
  71. *> INCX is INTEGER
  72. *> The increment between successive values of the vector X.
  73. *> INCX > 0.
  74. *> \endverbatim
  75. *>
  76. *> \param[in,out] SCALE
  77. *> \verbatim
  78. *> SCALE is DOUBLE PRECISION
  79. *> On entry, the value scale in the equation above.
  80. *> On exit, SCALE is overwritten with scl , the scaling factor
  81. *> for the sum of squares.
  82. *> \endverbatim
  83. *>
  84. *> \param[in,out] SUMSQ
  85. *> \verbatim
  86. *> SUMSQ is DOUBLE PRECISION
  87. *> On entry, the value sumsq in the equation above.
  88. *> On exit, SUMSQ is overwritten with smsq , the basic sum of
  89. *> squares from which scl has been factored out.
  90. *> \endverbatim
  91. *
  92. * Authors:
  93. * ========
  94. *
  95. *> \author Univ. of Tennessee
  96. *> \author Univ. of California Berkeley
  97. *> \author Univ. of Colorado Denver
  98. *> \author NAG Ltd.
  99. *
  100. *> \date September 2012
  101. *
  102. *> \ingroup auxOTHERauxiliary
  103. *
  104. * =====================================================================
  105. SUBROUTINE DLASSQ( N, X, INCX, SCALE, SUMSQ )
  106. *
  107. * -- LAPACK auxiliary routine (version 3.4.2) --
  108. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  109. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  110. * September 2012
  111. *
  112. * .. Scalar Arguments ..
  113. INTEGER INCX, N
  114. REAL*8 SCALE, SUMSQ
  115. * ..
  116. * .. Array Arguments ..
  117. REAL*8 X( * )
  118. * ..
  119. *
  120. * =====================================================================
  121. *
  122. * .. Parameters ..
  123. REAL*8 ZERO
  124. PARAMETER ( ZERO = 0.0D+0 )
  125. * ..
  126. * .. Local Scalars ..
  127. INTEGER IX
  128. REAL*8 ABSXI
  129. * ..
  130. * .. External Functions ..
  131. LOGICAL DISNAN
  132. EXTERNAL DISNAN
  133. * ..
  134. ** .. Intrinsic Functions ..
  135. * INTRINSIC ABS
  136. ** ..
  137. ** .. Executable Statements ..
  138. *
  139. IF( N.GT.0 ) THEN
  140. DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX
  141. ABSXI = ABS( X( IX ) )
  142. IF( ABSXI.GT.ZERO.OR.DISNAN( ABSXI ) ) THEN
  143. IF( SCALE.LT.ABSXI ) THEN
  144. SUMSQ = 1 + SUMSQ*( SCALE / ABSXI )**2
  145. SCALE = ABSXI
  146. ELSE
  147. SUMSQ = SUMSQ + ( ABSXI / SCALE )**2
  148. END IF
  149. END IF
  150. 10 CONTINUE
  151. END IF
  152. RETURN
  153. *
  154. * End of DLASSQ
  155. *
  156. END
  157.  
  158.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales