SNRM2 returns the euclidean norm of a vector via the function name, so that SNRM2 := sqrt( x'*x ).
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer(kind=ilp), | intent(in) | :: | n | |||
real(kind=sp), | intent(in) | :: | x(*) | |||
integer(kind=ilp), | intent(in) | :: | incx |
pure function stdlib_snrm2( n, x, incx ) !! SNRM2 returns the euclidean norm of a vector via the function !! name, so that !! SNRM2 := sqrt( x'*x ). real(sp) :: stdlib_snrm2 ! -- reference blas level1 routine (version 3.9.1_sp) -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- ! march 2021 ! Constants integer, parameter :: wp = kind(1._sp) real(sp), parameter :: maxn = huge(0.0_sp) ! .. blue's scaling constants .. ! Scalar Arguments integer(ilp), intent(in) :: incx, n ! Array Arguments real(sp), intent(in) :: x(*) ! Local Scalars integer(ilp) :: i, ix logical(lk) :: notbig real(sp) :: abig, amed, asml, ax, scl, sumsq, ymax, ymin ! quick return if possible stdlib_snrm2 = zero if( n <= 0 ) return scl = one sumsq = zero ! compute the sum of squares in 3 accumulators: ! abig -- sums of squares scaled down to avoid overflow ! asml -- sums of squares scaled up to avoid underflow ! amed -- sums of squares that do not require scaling ! the thresholds and multipliers are ! tbig -- values bigger than this are scaled down by sbig ! tsml -- values smaller than this are scaled up by ssml notbig = .true. asml = zero amed = zero abig = zero ix = 1 if( incx < 0 ) ix = 1 - (n-1)*incx do i = 1, n ax = abs(x(ix)) if (ax > tbig) then abig = abig + (ax*sbig)**2 notbig = .false. else if (ax < tsml) then if (notbig) asml = asml + (ax*ssml)**2 else amed = amed + ax**2 end if ix = ix + incx end do ! combine abig and amed or amed and asml if more than one ! accumulator was used. if (abig > zero) then ! combine abig and amed if abig > 0. if ( (amed > zero) .or. (amed > maxn) .or. (amed /= amed) ) then abig = abig + (amed*sbig)*sbig end if scl = one / sbig sumsq = abig else if (asml > zero) then ! combine amed and asml if asml > 0. if ( (amed > zero) .or. (amed > maxn) .or. (amed /= amed) ) then amed = sqrt(amed) asml = sqrt(asml) / ssml if (asml > amed) then ymin = amed ymax = asml else ymin = asml ymax = amed end if scl = one sumsq = ymax**2*( one + (ymin/ymax)**2 ) else scl = one / ssml sumsq = asml end if else ! otherwise all values are mid-range scl = one sumsq = amed end if stdlib_snrm2 = scl*sqrt( sumsq ) return end function stdlib_snrm2