partition_is_consistent Function

private function partition_is_consistent(me, m) result(consistent)

Returns true if the partition (ngrp, maxgrp) is consistent with the sparsity pattern (including the linear elements): no two columns in the same group may have an element in the same row.

Type Bound

sparsity_pattern

Arguments

Type IntentOptional Attributes Name
class(sparsity_pattern), intent(in) :: me
integer, intent(in) :: m

number of rows of the jacobian

Return Value logical


Calls

proc~~partition_is_consistent~~CallsGraph proc~partition_is_consistent sparsity_pattern%partition_is_consistent proc~get_partition_pattern sparsity_pattern%get_partition_pattern proc~partition_is_consistent->proc~get_partition_pattern

Called by

proc~~partition_is_consistent~~CalledByGraph proc~partition_is_consistent sparsity_pattern%partition_is_consistent proc~set_sparsity_pattern numdiff_type%set_sparsity_pattern proc~set_sparsity_pattern->proc~partition_is_consistent

Source Code

    function partition_is_consistent(me,m) result(consistent)

    implicit none

    class(sparsity_pattern),intent(in) :: me
    integer,intent(in) :: m  !! number of rows of the jacobian
    logical :: consistent

    integer,dimension(:),allocatable :: irow, icol  !! the pattern to check
    integer,dimension(:),allocatable :: row_ptr     !! row pointers into `by_row`
    integer,dimension(:),allocatable :: by_row      !! element indices, sorted by row
    integer,dimension(:),allocatable :: next        !! next free position for each row
    integer,dimension(:),allocatable :: group_row   !! last row in which each group was seen
    integer,dimension(:),allocatable :: group_col   !! the column in that row for each group
    integer :: k, r, j, c, g

    consistent = .false.
    if (.not. allocated(me%ngrp) .or. me%maxgrp<1) return
    call me%get_partition_pattern(irow,icol)

    ! sort the elements by row (counting sort):
    allocate(row_ptr(m+1), by_row(size(irow)))
    row_ptr = 0
    do k = 1, size(irow)
        row_ptr(irow(k)+1) = row_ptr(irow(k)+1) + 1
    end do
    row_ptr(1) = 1
    do r = 1, m
        row_ptr(r+1) = row_ptr(r+1) + row_ptr(r)
    end do
    next = row_ptr(1:m)
    do k = 1, size(irow)
        by_row(next(irow(k))) = k
        next(irow(k)) = next(irow(k)) + 1
    end do

    ! in each row, each group may only appear for one column:
    allocate(group_row(me%maxgrp), group_col(me%maxgrp))
    group_row = 0
    group_col = 0
    do r = 1, m
        do j = row_ptr(r), row_ptr(r+1)-1
            c = icol(by_row(j))
            g = me%ngrp(c)
            if (group_row(g)==r .and. group_col(g)/=c) return ! two columns of group g in row r
            group_row(g) = r
            group_col(g) = c
        end do
    end do
    consistent = .true.

    end function partition_is_consistent