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 numdiff_type%set_sparsity_pattern proc~compute_group_index sparsity_pattern%compute_group_index proc~set_sparsity_pattern->proc~compute_group_index proc~compute_indices sparsity_pattern%compute_indices proc~set_sparsity_pattern->proc~compute_indices proc~destroy_sparsity_pattern numdiff_type%destroy_sparsity_pattern proc~set_sparsity_pattern->proc~destroy_sparsity_pattern proc~dsm_wrapper sparsity_pattern%dsm_wrapper proc~set_sparsity_pattern->proc~dsm_wrapper proc~partition_is_consistent sparsity_pattern%partition_is_consistent proc~set_sparsity_pattern->proc~partition_is_consistent proc~raise_exception numdiff_type%raise_exception proc~set_sparsity_pattern->proc~raise_exception proc~destroy_sparsity sparsity_pattern%destroy_sparsity proc~destroy_sparsity_pattern->proc~destroy_sparsity proc~dsm_wrapper->proc~compute_group_index proc~dsm dsm proc~dsm_wrapper->proc~dsm proc~get_partition_pattern sparsity_pattern%get_partition_pattern proc~dsm_wrapper->proc~get_partition_pattern proc~partition_is_consistent->proc~get_partition_pattern proc~degr degr proc~dsm->proc~degr proc~ido ido proc~dsm->proc~ido proc~numsrt numsrt proc~dsm->proc~numsrt proc~seq seq proc~dsm->proc~seq proc~setr setr proc~dsm->proc~setr proc~slo slo proc~dsm->proc~slo proc~srtdat 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<1) .or. any(irow>me%m) .or. &
        any(icol<1) .or. any(icol>me%n)) then
        call me%raise_exception(15,'set_sparsity_pattern',&
                                   'invalid inputs')
        return
    end if

    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(me%n)

    ! linear pattern (this must be set before the partition is computed,
    ! since the partition must also account for the linear elements):
    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<1) .or. any(linear_irow>me%m) .or. &
            any(linear_icol<1) .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

    if (me%partition_sparsity_pattern) then
        if (present(maxgrp) .and. present(ngrp)) then
            ! use the user-input partition:
            if (maxgrp>0 .and. size(ngrp)==me%n .and. all(ngrp>=1 .and. ngrp<=maxgrp)) then
                me%sparsity%maxgrp = maxgrp
                me%sparsity%ngrp   = ngrp
                if (.not. me%sparsity%partition_is_consistent(me%m)) then
                    call me%raise_exception(33,'set_sparsity_pattern',&
                                            'the sparsity partition is not consistent with the '//&
                                            'sparsity pattern (two columns in the same group '//&
                                            'have an element in the same row).')
                    return
                end if
                call me%sparsity%compute_group_index()
            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 subroutine set_sparsity_pattern