compute_group_index Subroutine

private subroutine compute_group_index(me)

Computes the group index (grp_ptr, grp_cols) of the sparsity partition. Must be called whenever ngrp or maxgrp is changed.

Type Bound

sparsity_pattern

Arguments

Type IntentOptional Attributes Name
class(sparsity_pattern), intent(inout) :: me

Called by

proc~~compute_group_index~~CalledByGraph proc~compute_group_index sparsity_pattern%compute_group_index proc~dsm_wrapper sparsity_pattern%dsm_wrapper proc~dsm_wrapper->proc~compute_group_index proc~generate_dense_sparsity_partition numdiff_type%generate_dense_sparsity_partition proc~generate_dense_sparsity_partition->proc~compute_group_index proc~set_sparsity_pattern numdiff_type%set_sparsity_pattern proc~set_sparsity_pattern->proc~compute_group_index proc~set_sparsity_pattern->proc~dsm_wrapper proc~compute_sparsity_dense compute_sparsity_dense proc~compute_sparsity_dense->proc~generate_dense_sparsity_partition proc~compute_sparsity_random compute_sparsity_random proc~compute_sparsity_random->proc~dsm_wrapper proc~compute_sparsity_random_2 compute_sparsity_random_2 proc~compute_sparsity_random_2->proc~dsm_wrapper proc~compute_sparsity_random_2->proc~generate_dense_sparsity_partition

Source Code

    subroutine compute_group_index(me)

    implicit none

    class(sparsity_pattern),intent(inout) :: me

    integer :: j !! column number
    integer :: g !! group number
    integer,dimension(:),allocatable :: next !! next free position in `grp_cols` for each group

    if (allocated(me%grp_ptr))  deallocate(me%grp_ptr)
    if (allocated(me%grp_cols)) deallocate(me%grp_cols)
    if (.not. allocated(me%ngrp) .or. me%maxgrp<1) return

    allocate(me%grp_ptr(me%maxgrp+1))
    allocate(me%grp_cols(size(me%ngrp)))
    me%grp_ptr = 0
    do j = 1, size(me%ngrp)
        g = me%ngrp(j)
        me%grp_ptr(g+1) = me%grp_ptr(g+1) + 1
    end do
    me%grp_ptr(1) = 1
    do g = 1, me%maxgrp
        me%grp_ptr(g+1) = me%grp_ptr(g+1) + me%grp_ptr(g)
    end do
    next = me%grp_ptr(1:me%maxgrp)
    do j = 1, size(me%ngrp)
        g = me%ngrp(j)
        me%grp_cols(next(g)) = j
        next(g) = next(g) + 1
    end do

    end subroutine compute_group_index