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

     1  *> \brief \b DNRM2
     2  *
     3  *  =========== DOCUMENTATION ===========
     4  *
     5  * Online html documentation available at 
     6  *            http://www.netlib.org/lapack/explore-html/ 
     7  *
     8  *  Definition:
     9  *  ===========
    10  *
    11  *       DOUBLE PRECISION FUNCTION DNRM2(N,X,INCX)
    12  * 
    13  *       .. Scalar Arguments ..
    14  *       INTEGER INCX,N
    15  *       ..
    16  *       .. Array Arguments ..
    17  *       DOUBLE PRECISION X(*)
    18  *       ..
    19  *  
    20  *
    21  *> \par Purpose:
    22  *  =============
    23  *>
    24  *> \verbatim
    25  *>
    26  *> DNRM2 returns the euclidean norm of a vector via the function
    27  *> name, so that
    28  *>
    29  *>    DNRM2 := sqrt( x'*x )
    30  *> \endverbatim
    31  *
    32  *  Authors:
    33  *  ========
    34  *
    35  *> \author Univ. of Tennessee 
    36  *> \author Univ. of California Berkeley 
    37  *> \author Univ. of Colorado Denver 
    38  *> \author NAG Ltd. 
    39  *
    40  *> \date November 2011
    41  *
    42  *> \ingroup double_blas_level1
    43  *
    44  *> \par Further Details:
    45  *  =====================
    46  *>
    47  *> \verbatim
    48  *>
    49  *>  -- This version written on 25-October-1982.
    50  *>     Modified on 14-October-1993 to inline the call to DLASSQ.
    51  *>     Sven Hammarling, Nag Ltd.
    52  *> \endverbatim
    53  *>
    54  *  =====================================================================
    55        DOUBLE PRECISION FUNCTION DNRM2(N,X,INCX)
    56  *
    57  *  -- Reference BLAS level1 routine (version 3.4.0) --
    58  *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
    59  *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
    60  *     November 2011
    61  *
    62  *     .. Scalar Arguments ..
    63        INTEGER INCX,N
    64  *     ..
    65  *     .. Array Arguments ..
    66        DOUBLE PRECISION X(*)
    67  *     ..
    68  *
    69  *  =====================================================================
    70  *
    71  *     .. Parameters ..
    72        DOUBLE PRECISION ONE,ZERO
    73        PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
    74  *     ..
    75  *     .. Local Scalars ..
    76        DOUBLE PRECISION ABSXI,NORM,SCALE,SSQ
    77        INTEGER IX
    78  *     ..
    79  *     .. Intrinsic Functions ..
    80        INTRINSIC ABS,SQRT
    81  *     ..
    82        IF (N.LT.1 .OR. INCX.LT.1) THEN
    83            NORM = ZERO
    84        ELSE IF (N.EQ.1) THEN
    85            NORM = ABS(X(1))
    86        ELSE
    87            SCALE = ZERO
    88            SSQ = ONE
    89  *        The following loop is equivalent to this call to the LAPACK
    90  *        auxiliary routine:
    91  *        CALL DLASSQ( N, X, INCX, SCALE, SSQ )
    92  *
    93            DO 10 IX = 1,1 + (N-1)*INCX,INCX
    94                IF (X(IX).NE.ZERO) THEN
    95                    ABSXI = ABS(X(IX))
    96                    IF (SCALE.LT.ABSXI) THEN
    97                        SSQ = ONE + SSQ* (SCALE/ABSXI)**2
    98                        SCALE = ABSXI
    99                    ELSE
   100                        SSQ = SSQ + (ABSXI/SCALE)**2
   101                    END IF
   102                END IF
   103     10     CONTINUE
   104            NORM = SCALE*SQRT(SSQ)
   105        END IF
   106  *
   107        DNRM2 = NORM
   108        RETURN
   109  *
   110  *     End of DNRM2.
   111  *
   112        END