create_unique_coo Subroutine

private subroutine create_unique_coo(self, temp_row, temp_col)

Arguments

Type IntentOptional Attributes Name
class(type_node_adjacency), intent(inout) :: self
integer(kind=int32), intent(in) :: temp_row(:)
integer(kind=int32), intent(in) :: temp_col(:)

Calls

proc~~create_unique_coo~~CallsGraph proc~create_unique_coo create_unique_coo interface~allocate_array allocate_array proc~create_unique_coo->interface~allocate_array interface~unique unique proc~create_unique_coo->interface~unique proc~allocate_rank1_int16 allocate_rank1_int16 interface~allocate_array->proc~allocate_rank1_int16 proc~allocate_rank1_int32 allocate_rank1_int32 interface~allocate_array->proc~allocate_rank1_int32 proc~allocate_rank1_int64 allocate_rank1_int64 interface~allocate_array->proc~allocate_rank1_int64 proc~allocate_rank1_int8 allocate_rank1_int8 interface~allocate_array->proc~allocate_rank1_int8 proc~allocate_rank1_logical1 allocate_rank1_logical1 interface~allocate_array->proc~allocate_rank1_logical1 proc~allocate_rank1_logical4 allocate_rank1_logical4 interface~allocate_array->proc~allocate_rank1_logical4 proc~allocate_rank1_logical8 allocate_rank1_logical8 interface~allocate_array->proc~allocate_rank1_logical8 proc~allocate_rank1_real128 allocate_rank1_real128 interface~allocate_array->proc~allocate_rank1_real128 proc~allocate_rank1_real32 allocate_rank1_real32 interface~allocate_array->proc~allocate_rank1_real32 proc~allocate_rank1_real64 allocate_rank1_real64 interface~allocate_array->proc~allocate_rank1_real64 proc~allocate_rank2_int16 allocate_rank2_int16 interface~allocate_array->proc~allocate_rank2_int16 proc~allocate_rank2_int32 allocate_rank2_int32 interface~allocate_array->proc~allocate_rank2_int32 proc~allocate_rank2_int64 allocate_rank2_int64 interface~allocate_array->proc~allocate_rank2_int64 proc~allocate_rank2_int8 allocate_rank2_int8 interface~allocate_array->proc~allocate_rank2_int8 proc~allocate_rank2_logical1 allocate_rank2_logical1 interface~allocate_array->proc~allocate_rank2_logical1 proc~allocate_rank2_logical4 allocate_rank2_logical4 interface~allocate_array->proc~allocate_rank2_logical4 proc~allocate_rank2_logical8 allocate_rank2_logical8 interface~allocate_array->proc~allocate_rank2_logical8 proc~allocate_rank2_real128 allocate_rank2_real128 interface~allocate_array->proc~allocate_rank2_real128 proc~allocate_rank2_real32 allocate_rank2_real32 interface~allocate_array->proc~allocate_rank2_real32 proc~allocate_rank2_real64 allocate_rank2_real64 interface~allocate_array->proc~allocate_rank2_real64 proc~unique_int16 unique_int16 interface~unique->proc~unique_int16 proc~unique_int32 unique_int32 interface~unique->proc~unique_int32 proc~unique_int64 unique_int64 interface~unique->proc~unique_int64 proc~unique_int8 unique_int8 interface~unique->proc~unique_int8 proc~error_message error_message proc~allocate_rank1_int16->proc~error_message proc~allocate_rank1_int32->proc~error_message proc~allocate_rank1_int64->proc~error_message proc~allocate_rank1_int8->proc~error_message proc~allocate_rank1_logical1->proc~error_message proc~allocate_rank1_logical4->proc~error_message proc~allocate_rank1_logical8->proc~error_message proc~allocate_rank1_real128->proc~error_message proc~allocate_rank1_real32->proc~error_message proc~allocate_rank1_real64->proc~error_message proc~allocate_rank2_int16->proc~error_message proc~allocate_rank2_int32->proc~error_message proc~allocate_rank2_int64->proc~error_message proc~allocate_rank2_int8->proc~error_message proc~allocate_rank2_logical1->proc~error_message proc~allocate_rank2_logical4->proc~error_message proc~allocate_rank2_logical8->proc~error_message proc~allocate_rank2_real128->proc~error_message proc~allocate_rank2_real32->proc~error_message proc~allocate_rank2_real64->proc~error_message proc~unique_int16->interface~allocate_array sort sort proc~unique_int16->sort proc~unique_int32->interface~allocate_array proc~unique_int32->sort proc~unique_int64->interface~allocate_array proc~unique_int64->sort proc~unique_int8->interface~allocate_array proc~unique_int8->sort log_error log_error proc~error_message->log_error

Called by

proc~~create_unique_coo~~CalledByGraph proc~create_unique_coo create_unique_coo proc~initialize_hybrid_from_mesh type_node_adjacency%initialize_hybrid_from_mesh proc~initialize_hybrid_from_mesh->proc~create_unique_coo proc~initialize_type_domain type_domain%initialize_type_domain proc~initialize_type_domain->proc~initialize_hybrid_from_mesh

Source Code

    subroutine create_unique_coo(self, temp_row, temp_col)
        implicit none
        class(type_node_adjacency), intent(inout) :: self
        integer(int32), intent(in) :: temp_row(:), temp_col(:)

        integer(int64), allocatable :: packed_edges(:), unique_packed_edges(:)
        integer(int32) :: i, n1, n2, edge_count

        if (size(temp_row) == 0) return

        ! (i,j) と (j,i) の両方を持つ対称COOリストを作成するため、2倍のサイズを確保
        allocate (packed_edges(size(temp_row) * 2))
        edge_count = 0
        do i = 1, size(temp_row)
            n1 = temp_row(i)
            n2 = temp_col(i)

            if (n1 == n2) then
                edge_count = edge_count + 1
                packed_edges(edge_count) = ishft(int(n1, int64), 32) + int(n2, int64)
            else
                edge_count = edge_count + 1
                packed_edges(edge_count) = ishft(int(n1, int64), 32) + int(n2, int64)
                edge_count = edge_count + 1
                packed_edges(edge_count) = ishft(int(n2, int64), 32) + int(n1, int64)
            end if
        end do

        ! ソートしてユニークなエッジのみを抽出し、ソート済みCOOを生成
        call unique(packed_edges(1:edge_count), unique_packed_edges)
        deallocate (packed_edges)

        self%nnz = size(unique_packed_edges)
        call allocate_array(self%row, self%nnz)
        call allocate_array(self%col, self%nnz)

        ! 結果を自身のCOOメンバに格納
        do i = 1, self%nnz
            self%row(i) = int(ishft(unique_packed_edges(i), -32), kind=int32)
            self%col(i) = int(iand(unique_packed_edges(i), int(z'FFFFFFFF', int64)), kind=int32)
        end do
        deallocate (unique_packed_edges)
    end subroutine create_unique_coo