set_sparsity_pattern Subroutine

private subroutine set_sparsity_pattern(me, irow, icol, linear_irow, linear_icol, linear_vals, maxgrp, ngrp)

To specify the sparsity pattern directly if it is already known.

Note

If specifying the linear pattern, all three optional arguments must be present.

Type Bound

numdiff_type

Arguments

Type IntentOptional Attributes Name
class(numdiff_type), intent(inout) :: me
integer, intent(in), dimension(:) :: irow

sparsity pattern nonzero elements row indices
integer, intent(in), dimension(:) :: icol

sparsity pattern nonzero elements column indices
integer, intent(in), optional, dimension(:) :: linear_irow

linear sparsity pattern nonzero elements row indices
integer, intent(in), optional, dimension(:) :: linear_icol

linear sparsity pattern nonzero elements column indices
real(kind=wp), intent(in), optional, dimension(:) :: linear_vals

linear sparsity values (constant elements of the Jacobian)
integer, intent(in), optional :: maxgrp

DSM sparsity partition [only used if me%partition_sparsity_pattern=True]
integer, intent(in), optional, dimension(:) :: ngrp

DSM sparsity partition (size n) [only used if me%partition_sparsity_pattern=True]

Calls

proc~~set_sparsity_pattern~~CallsGraph proc~set_sparsity_pattern numerical_differentiation_module::numdiff_type%set_sparsity_pattern proc~compute_indices numerical_differentiation_module::sparsity_pattern%compute_indices proc~set_sparsity_pattern->proc~compute_indices proc~destroy_sparsity_pattern numerical_differentiation_module::numdiff_type%destroy_sparsity_pattern proc~set_sparsity_pattern->proc~destroy_sparsity_pattern proc~dsm_wrapper numerical_differentiation_module::sparsity_pattern%dsm_wrapper proc~set_sparsity_pattern->proc~dsm_wrapper proc~raise_exception numerical_differentiation_module::numdiff_type%raise_exception proc~set_sparsity_pattern->proc~raise_exception proc~destroy_sparsity numerical_differentiation_module::sparsity_pattern%destroy_sparsity proc~destroy_sparsity_pattern->proc~destroy_sparsity proc~dsm dsm_module::dsm proc~dsm_wrapper->proc~dsm proc~degr dsm_module::degr proc~dsm->proc~degr proc~ido dsm_module::ido proc~dsm->proc~ido proc~numsrt dsm_module::numsrt proc~dsm->proc~numsrt proc~seq dsm_module::seq proc~dsm->proc~seq proc~setr dsm_module::setr proc~dsm->proc~setr proc~slo dsm_module::slo proc~dsm->proc~slo proc~srtdat dsm_module::srtdat proc~dsm->proc~srtdat proc~ido->proc~numsrt

Source Code

    subroutine set_sparsity_pattern(me,irow,icol,linear_irow,linear_icol,linear_vals,maxgrp,ngrp)

    implicit none

    class(numdiff_type),intent(inout)         :: me
    integer,dimension(:),intent(in)           :: irow        !! sparsity pattern nonzero elements row indices
    integer,dimension(:),intent(in)           :: icol        !! sparsity pattern nonzero elements column indices
    integer,dimension(:),intent(in),optional  :: linear_irow !! linear sparsity pattern nonzero elements row indices
    integer,dimension(:),intent(in),optional  :: linear_icol !! linear sparsity pattern nonzero elements column indices
    real(wp),dimension(:),intent(in),optional :: linear_vals !! linear sparsity values (constant elements of the Jacobian)
    integer,intent(in),optional               :: maxgrp      !! DSM sparsity partition
                                                             !! [only used if `me%partition_sparsity_pattern=True`]
    integer,dimension(:),intent(in),optional  :: ngrp        !! DSM sparsity partition (size `n`)
                                                             !! [only used if `me%partition_sparsity_pattern=True`]

    integer :: info !! status output form [[dsm]]

    call me%destroy_sparsity_pattern()

    if (me%exception_raised) return ! check for exceptions

    if (size(irow)/=size(icol) .or. any(irow>me%m) .or. any(icol>me%n)) then
        call me%raise_exception(15,'set_sparsity_pattern',&
                                   'invalid inputs')
        return
    else

        me%sparsity%sparsity_computed = .true.
        me%sparsity%num_nonzero_elements = size(irow)
        me%sparsity%irow = irow
        me%sparsity%icol = icol

        call me%sparsity%compute_indices()
        if (me%partition_sparsity_pattern) then
            if (present(maxgrp) .and. present(ngrp)) then
                ! use the user-input partition:
                if (maxgrp>0 .and. all(ngrp>=1 .and. ngrp<=maxgrp) .and. size(ngrp)==me%n) then
                    me%sparsity%maxgrp = maxgrp
                    me%sparsity%ngrp   = ngrp
                else
                    call me%raise_exception(28,'set_sparsity_pattern',&
                                            'invalid sparsity partition inputs.')
                    return
                end if
            else
                call me%sparsity%dsm_wrapper(me%n,me%m,info)
                if (info/=1) then
                    call me%raise_exception(16,'set_sparsity_pattern',&
                                            'error partitioning sparsity pattern.')
                    return
                end if
            end if
        end if

    end if

    ! linear pattern:
    if (present(linear_irow) .and. present(linear_icol) .and. present(linear_vals)) then
        if (size(linear_irow)/=size(linear_icol) .or. &
            size(linear_vals)/=size(linear_icol) .or. &
            any(linear_irow>me%m) .or. &
            any(linear_icol>me%n)) then
            call me%raise_exception(17,'set_sparsity_pattern',&
                                       'invalid linear sparsity pattern')
            return
        else
            me%sparsity%linear_irow = linear_irow
            me%sparsity%linear_icol = linear_icol
            me%sparsity%linear_vals = linear_vals
            me%sparsity%linear_sparsity_computed = .true.
            me%sparsity%num_nonzero_linear_elements = size(linear_irow)
        end if
    end if

    end subroutine set_sparsity_pattern