dnrm2 Function

public function dnrm2(n, x, incx)

euclidean norm of a vector.

Arguments

Type IntentOptional Attributes Name
integer :: n
real(kind=wp) :: x(*)
integer :: incx

Return Value real(kind=wp)


Called by

proc~~dnrm2~~CalledByGraph proc~dnrm2 lsqpblas_module::dnrm2 proc~acheck lsqr_module::lsqr_solver%acheck proc~acheck->proc~dnrm2 proc~lsqr lsqr_module::lsqr_solver%LSQR proc~lsqr->proc~dnrm2 proc~lstp lsqrtest_module::test_solver%lstp proc~lstp->proc~dnrm2 proc~test lsqrtest_module::test_solver%test proc~test->proc~dnrm2 proc~test->proc~acheck proc~test->proc~lsqr proc~test->proc~lstp proc~xcheck lsqr_module::lsqr_solver%xcheck proc~test->proc~xcheck proc~xcheck->proc~dnrm2 proc~lsqr_test lsqrtest_module::lsqr_test proc~lsqr_test->proc~test proc~solve_ez lsqr_module::lsqr_solver_ez%solve_ez proc~solve_ez->proc~lsqr proc~nlesolver_solver nlesolver_module::nlesolver_type%nlesolver_solver proc~nlesolver_solver->proc~solve_ez program~main main program~main->proc~lsqr_test program~main~3 main program~main~3->proc~solve_ez program~nlesolver_test_1 nlesolver_test_1 program~nlesolver_test_1->proc~nlesolver_solver program~sparse_test sparse_test program~sparse_test->proc~nlesolver_solver

Source Code

    real(wp) function dnrm2(n,x,incx)

    integer incx,n
    real(wp) x(*)

    real(wp) absxi,norm,scale,ssq
    integer ix

    if (n<1 .or. incx<1) then
        norm = zero
    else if (n==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 dlassq( n, x, incx, scale, ssq )

        do ix = 1,1 + (n-1)*incx,incx
            if (x(ix)/=zero) then
                absxi = abs(x(ix))
                if (scale<absxi) then
                    ssq = one + ssq* (scale/absxi)**2
                    scale = absxi
                else
                    ssq = ssq + (absxi/scale)**2
                end if
            end if
        end do
        norm = scale*sqrt(ssq)
    end if

    dnrm2 = norm

    end function dnrm2