reordering.F90 Source File

module domain_reordering
    use, intrinsic :: iso_fortran_env, only: int32, real64
    use :: stdlib_sorting, only:sort, sort_index
    use :: module_core, only:allocate_array, deallocate_array, error_message
    use :: module_mesh, only:holder_elements, holder_sides
    use :: domain_adjacency_adjacency_node, only:type_node_adjacency

    implicit none
    private
    public :: type_reordering

    type :: type_reordering
        private
        character(:), allocatable :: algorithm_name
        integer(int32) :: num_nodes = 0
        integer(int32), allocatable :: perm(:) ! CM/RCM indices -> original indices
        integer(int32), allocatable :: iperm(:) ! Original indices -> CM/RCM indices
        logical :: is_reordered_perm = .false.
        logical :: is_reordered_iperm = .false.
    contains
        procedure, public, pass(self) :: initialize => initialize_type_reordering

        procedure, private, pass(self) :: rcm_reorder_method
        procedure, private, pass(self) :: cm_reorder_method
        procedure, private, pass(self) :: create_inverse_permutation

        ! CM/RCM ordering -> original ordering
        procedure, private, pass(self) :: to_original_values_int32
        procedure, private, pass(self) :: to_original_values_real64
        generic, public :: to_original_value => to_original_values_int32, & !&
                                                to_original_values_real64 !&
        procedure, private, pass(self) :: to_original_index
        procedure, private, pass(self) :: to_original_indices
        generic, public :: to_original => to_original_index, & !&
                                          to_original_indices !&

        !  original ordering -> CM/RCM ordering
        procedure, private, pass(self) :: to_reordered_values_int32
        procedure, private, pass(self) :: to_reordered_values_real64
        generic, public :: to_reordered_value => to_reordered_values_int32, & !&
                                                 to_reordered_values_real64 !&
        procedure, private, pass(self) :: to_reordered_index
        procedure, private, pass(self) :: to_reordered_indices
        generic, public :: to_reordered => to_reordered_index, & !&
                                           to_reordered_indices !&

        procedure, public :: get_algorithm_name

        final :: finalize_type_reordering
    end type type_reordering

    interface
        module subroutine rcm_reorder_method(self, node_adj)
            import :: type_reordering, type_node_adjacency
            implicit none
            class(type_reordering), intent(inout) :: self
            class(type_node_adjacency), intent(in) :: node_adj
        end subroutine rcm_reorder_method

        module subroutine cm_reorder_method(self, node_adj)
            import :: type_reordering, type_node_adjacency
            implicit none
            class(type_reordering), intent(inout) :: self
            class(type_node_adjacency), intent(in) :: node_adj
        end subroutine cm_reorder_method

        module subroutine create_inverse_permutation(self)
            import :: type_reordering
            implicit none
            class(type_reordering), intent(inout) :: self
        end subroutine create_inverse_permutation
    end interface

    interface
        module subroutine to_original_values_int32(self, vector_reordered, vector_original)
            implicit none
            class(type_reordering), intent(in) :: self
            integer(int32), intent(in) :: vector_reordered(:)
            integer(int32), intent(inout) :: vector_original(:)

        end subroutine to_original_values_int32

        module subroutine to_original_values_real64(self, vector_reordered, vector_original)
            implicit none
            class(type_reordering), intent(in) :: self
            real(real64), intent(in) :: vector_reordered(:)
            real(real64), intent(inout) :: vector_original(:)

        end subroutine to_original_values_real64

        module subroutine to_original_index(self, index_reordered, index_original)
            implicit none
            class(type_reordering), intent(in) :: self
            integer(int32), intent(in) :: index_reordered
            integer(int32), intent(inout) :: index_original

        end subroutine to_original_index

        module subroutine to_original_indices(self, indices_reordered, indices_original)
            implicit none
            class(type_reordering), intent(in) :: self
            integer(int32), intent(in) :: indices_reordered(:)
            integer(int32), intent(inout) :: indices_original(:)

        end subroutine to_original_indices

    end interface

    interface
        module subroutine to_reordered_values_int32(self, vector_original, vector_reordered)
            implicit none
            class(type_reordering), intent(in) :: self
            integer(int32), intent(in) :: vector_original(:)
            integer(int32), intent(inout) :: vector_reordered(:)

        end subroutine to_reordered_values_int32

        module subroutine to_reordered_values_real64(self, vector_original, vector_reordered)
            implicit none
            class(type_reordering), intent(in) :: self
            real(real64), intent(in) :: vector_original(:)
            real(real64), intent(inout) :: vector_reordered(:)

        end subroutine to_reordered_values_real64

        module subroutine to_reordered_index(self, index_original, index_reordered)
            implicit none
            class(type_reordering), intent(in) :: self
            integer(int32), intent(in) :: index_original
            integer(int32), intent(inout) :: index_reordered

        end subroutine to_reordered_index

        module subroutine to_reordered_indices(self, indices_original, indices_reordered)
            implicit none
            class(type_reordering), intent(in) :: self
            integer(int32), intent(in) :: indices_original(:)
            integer(int32), intent(inout) :: indices_reordered(:)

        end subroutine to_reordered_indices
    end interface

contains

    subroutine initialize_type_reordering(self, algorithm_name, node_adj)
        implicit none
        class(type_reordering), intent(inout) :: self
        character(*), intent(in) :: algorithm_name
        class(type_node_adjacency), intent(in) :: node_adj

        if (allocated(self%algorithm_name)) deallocate (self%algorithm_name)
        allocate (character(len=len_trim(algorithm_name)) :: self%algorithm_name)
        self%algorithm_name = trim(adjustl(algorithm_name))

        select case (self%algorithm_name)
        case ("rcm")
            call self%rcm_reorder_method(node_adj)
            call self%create_inverse_permutation()
        case ("cm")
            call self%cm_reorder_method(node_adj)
            call self%create_inverse_permutation()
        case default
            ! No reordering
        end select
    end subroutine initialize_type_reordering

    function get_algorithm_name(self) result(name)
        implicit none
        class(type_reordering), intent(in) :: self
        character(:), allocatable :: name

        if (allocated(self%algorithm_name)) then
            name = self%algorithm_name
        else
            name = "none"
        end if

    end function get_algorithm_name

    !================================================================!
    ! finalizer
    !================================================================!
    subroutine finalize_type_reordering(self)
        implicit none
        type(type_reordering), intent(inout) :: self

        call deallocate_array(self%perm)
        call deallocate_array(self%iperm)
    end subroutine finalize_type_reordering

end module domain_reordering