compute_jacobian_with_diff Subroutine

private subroutine compute_jacobian_with_diff(me, x, dx, jac)

Compute the Jacobian one element at a time using the Neville's process algorithm diff. This takes a very large number of function evaluations, but should give a very accurate answer.

Arguments

Type IntentOptional Attributes Name
class(numdiff_type), intent(inout) :: me
real(kind=wp), intent(in), dimension(:) :: x

vector of variables (size n)

real(kind=wp), intent(in), dimension(me%n) :: dx

absolute perturbation (>0) for each variable

real(kind=wp), intent(out), dimension(:) :: jac

sparse jacobian vector (size num_nonzero_elements)


Calls

proc~~compute_jacobian_with_diff~~CallsGraph proc~compute_jacobian_with_diff numerical_differentiation_module::compute_jacobian_with_diff proc~diff diff_module::diff_func%diff proc~compute_jacobian_with_diff->proc~diff proc~raise_exception numerical_differentiation_module::numdiff_type%raise_exception proc~compute_jacobian_with_diff->proc~raise_exception proc~set_function diff_module::diff_func%set_function proc~compute_jacobian_with_diff->proc~set_function proc~faccur diff_module::diff_func%faccur proc~diff->proc~faccur

Source Code

    subroutine compute_jacobian_with_diff(me,x,dx,jac)

    implicit none

    class(numdiff_type),intent(inout)   :: me
    real(wp),dimension(:),intent(in)    :: x    !! vector of variables (size `n`)
    real(wp),dimension(me%n),intent(in) :: dx   !! absolute perturbation (>0)
                                                !! for each variable
    real(wp),dimension(:),intent(out)   :: jac  !! sparse jacobian vector (size
                                                !! `num_nonzero_elements`)

    integer,parameter  :: iord  = 1  !! tells [[diff]] to compute first derivative

    integer                  :: i      !! counter for nonzero elements of jacobian
    type(diff_func)          :: d      !! the [[diff]] class to use
    real(wp)                 :: x0     !! value of ith variable for [[diff]]
    real(wp)                 :: xmin   !! ith variable lower bound
    real(wp)                 :: xmax   !! ith variable upper bound
    real(wp)                 :: deriv  !! derivative value df/dx from [[diff]]
    real(wp)                 :: error  !! estimated error from [[diff]]
    integer                  :: ifail  !! [[diff]] error flag
    real(wp),dimension(me%n) :: xp     !! used by [[dfunc]].
    real(wp),dimension(me%m) :: fvec   !! used by [[dfunc]].
    integer                  :: ir     !! row index of next non-zero element
    integer                  :: ic     !! column index of next non-zero element

    integer :: ic_prev  !! previous column perturbed
    integer :: icount   !! count of number of times a column has been perturbed
    logical :: use_info !! if we are reporting to the user

    if (me%exception_raised) return ! check for exceptions

    ! initialize:
    jac = zero
    use_info = associated(me%info_function)
    if (use_info) ic_prev = -1

    ! set the function for diff:
    call d%set_function(dfunc)

    ! each element is computed one by one
    do i = 1, me%sparsity%num_nonzero_elements

        ir   = me%sparsity%irow(i)
        ic   = me%sparsity%icol(i)
        x0   = x(ic)
        xmin = me%xlow(ic)
        xmax = me%xhigh(ic)

        ! if reporting to the user, have to keep track
        ! of which column is being perturbed, and how
        ! many times:
        if (use_info) then
            if (ic/=ic_prev) icount = 0
        end if

        call d%compute_derivative(iord,x0,xmin,xmax,me%eps,me%acc,deriv,error,ifail)

        if (ifail==0 .or. ifail==1) then
            jac(i) = deriv
        else if (ifail == -1) then
            ! this indicates an exception was
            ! already raised, so just return.
            return
        else
            call me%raise_exception(24, 'compute_jacobian_with_diff',&
                                        'error computing derivative with DIFF.')
            return
        end if

        if (use_info) ic_prev = ic

    end do

    contains

        function dfunc(this,xval) result(fx)

        !! interface to user function for [[diff]] routine.

        implicit none

        class(diff_func),intent(inout)  :: this
        real(wp),intent(in)             :: xval  !! input variable (`ic` variable)
        real(wp)                        :: fx    !! derivative of `ir` function
                                                 !! w.r.t. `xval` variable

        if (use_info) then
            icount = icount + 1
            call me%info_function([ic],icount,x)
        end if

        xp = x
        xp(ic) = xval
        call me%compute_function(xp,fvec,funcs_to_compute=[ir])

        if (me%exception_raised) then ! check for exceptions
            fx = 0.0_wp
            call me%terminate()
        else
            fx = fvec(ir)
        end if

        end function dfunc

    end subroutine compute_jacobian_with_diff