github.com/gonum/lapack@v0.0.0-20181123203213-e4cdc5a0bff9/internal/testdata/dsterftest/dlassq.f (about)

     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