vendor/gonum.org/v1/gonum/lapack/internal/testdata/dsterftest/dlassq.f

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