summaryrefslogtreecommitdiff log msg author committer range
path: root/BLAS/SRC/snrm2.f
blob: 17027a754c9872822573f07d22a0f52095fe5e8a (plain)
 ```1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 ``` ``````*> \brief \b SNRM2 * * =========== DOCUMENTATION =========== * * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * * Definition: * =========== * * REAL FUNCTION SNRM2(N,X,INCX) * * .. Scalar Arguments .. * INTEGER INCX,N * .. * .. Array Arguments .. * REAL X(*) * .. * * *> \par Purpose: * ============= *> *> \verbatim *> *> SNRM2 returns the euclidean norm of a vector via the function *> name, so that *> *> SNRM2 := sqrt( x'*x ). *> \endverbatim * * Arguments: * ========== * *> \param[in] N *> \verbatim *> N is INTEGER *> number of elements in input vector(s) *> \endverbatim *> *> \param[in] X *> \verbatim *> X is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) *> \endverbatim *> *> \param[in] INCX *> \verbatim *> INCX is INTEGER *> storage spacing between elements of SX *> \endverbatim * * Authors: * ======== * *> \author Univ. of Tennessee *> \author Univ. of California Berkeley *> \author Univ. of Colorado Denver *> \author NAG Ltd. * *> \date December 2016 * *> \ingroup single_blas_level1 * *> \par Further Details: * ===================== *> *> \verbatim *> *> -- This version written on 25-October-1982. *> Modified on 14-October-1993 to inline the call to SLASSQ. *> Sven Hammarling, Nag Ltd. *> \endverbatim *> * ===================================================================== REAL FUNCTION SNRM2(N,X,INCX) * * -- Reference BLAS level1 routine (version 3.7.0) -- * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * * .. Scalar Arguments .. INTEGER INCX,N * .. * .. Array Arguments .. REAL X(*) * .. * * ===================================================================== * * .. Parameters .. REAL ONE,ZERO PARAMETER (ONE=1.0E+0,ZERO=0.0E+0) * .. * .. Local Scalars .. REAL ABSXI,NORM,SCALE,SSQ INTEGER IX * .. * .. Intrinsic Functions .. INTRINSIC ABS,SQRT * .. IF (N.LT.1 .OR. INCX.LT.1) THEN NORM = ZERO ELSE IF (N.EQ.1) THEN NORM = ABS(X(1)) ELSE SCALE = ZERO SSQ = ONE * The following loop is equivalent to this call to the LAPACK * auxiliary routine: * CALL SLASSQ( N, X, INCX, SCALE, SSQ ) * DO 10 IX = 1,1 + (N-1)*INCX,INCX IF (X(IX).NE.ZERO) THEN ABSXI = ABS(X(IX)) IF (SCALE.LT.ABSXI) THEN SSQ = ONE + SSQ* (SCALE/ABSXI)**2 SCALE = ABSXI ELSE SSQ = SSQ + (ABSXI/SCALE)**2 END IF END IF 10 CONTINUE NORM = SCALE*SQRT(SSQ) END IF * SNRM2 = NORM RETURN * * End of SNRM2. * END ``````