index_unique Function

private pure function index_unique(array)

Uses

  • proc~~index_unique~~UsesGraph proc~index_unique index_unique iso_fortran_env iso_fortran_env proc~index_unique->iso_fortran_env

Return the index of unique elements in array, which can be any intrinsic data types, as an integer array. If array contains zero element or is of unsupported data types, an empty integer array is produced. For example, index_unique([1, 2, 3, 1, 2, 3, 4, 5]) returns [1, 2, 3, 7, 8]. (KCW, 2024-03-22)

Arguments

Type IntentOptional Attributes Name
class(*), intent(in) :: array(:)

Return Value integer, allocatable, (:)


Called by

proc~~index_unique~~CalledByGraph proc~index_unique index_unique proc~dyn_mpas_define_scalar mpas_dynamical_core_type%dyn_mpas_define_scalar proc~dyn_mpas_define_scalar->proc~index_unique proc~parse_stream_name parse_stream_name proc~parse_stream_name->proc~index_unique proc~dyn_init dyn_init proc~dyn_init->proc~dyn_mpas_define_scalar proc~dyn_mpas_read_write_stream mpas_dynamical_core_type%dyn_mpas_read_write_stream proc~dyn_init->proc~dyn_mpas_read_write_stream proc~dyn_mpas_init_stream_with_pool mpas_dynamical_core_type%dyn_mpas_init_stream_with_pool proc~dyn_mpas_init_stream_with_pool->proc~parse_stream_name proc~dyn_mpas_read_write_stream->proc~parse_stream_name proc~dyn_mpas_read_write_stream->proc~dyn_mpas_init_stream_with_pool proc~dyn_variable_dump dyn_variable_dump proc~dyn_variable_dump->proc~dyn_mpas_read_write_stream proc~model_grid_init model_grid_init proc~model_grid_init->proc~dyn_mpas_read_write_stream proc~dyn_final dyn_final proc~dyn_final->proc~dyn_variable_dump proc~stepon_final stepon_final proc~stepon_final->proc~dyn_final

Variables

Type Visibility Attributes Name Initial
character(len=:), private, allocatable :: array_c(:)
integer, private :: i
logical, private :: mask_unique(size(array))
integer, private :: n

Source Code

    pure function index_unique(array)
        use, intrinsic :: iso_fortran_env, only: int32, int64, real32, real64

        class(*), intent(in) :: array(:)
        integer, allocatable :: index_unique(:)

        character(:), allocatable :: array_c(:)
        integer :: i, n
        logical :: mask_unique(size(array))

        n = size(array)

        if (n == 0) then
            allocate(index_unique(0))

            return
        end if

        mask_unique = .false.

        select type (array)
            type is (character(*))
                ! Workaround for a bug in GNU Fortran >= 12. This is perhaps the manifestation of GCC Bugzilla Bug 100819.
                ! When a character string array is passed as the actual argument to an unlimited polymorphic dummy argument,
                ! its array index and length parameter are mishandled.
                allocate(character(len(array)) :: array_c(size(array)))

                array_c(:) = array(:)

                do i = 1, n
                    if (.not. any(array_c(i) == array_c .and. mask_unique)) then
                        mask_unique(i) = .true.
                    end if
                end do

                deallocate(array_c)
            type is (integer(int32))
                do i = 1, n
                    if (.not. any(array(i) == array .and. mask_unique)) then
                        mask_unique(i) = .true.
                    end if
                end do
            type is (integer(int64))
                do i = 1, n
                    if (.not. any(array(i) == array .and. mask_unique)) then
                        mask_unique(i) = .true.
                    end if
                end do
            type is (logical)
                do i = 1, n
                    if (.not. any((array(i) .eqv. array) .and. mask_unique)) then
                        mask_unique(i) = .true.
                    end if
                end do
            type is (real(real32))
                do i = 1, n
                    if (.not. any(array(i) == array .and. mask_unique)) then
                        mask_unique(i) = .true.
                    end if
                end do
            type is (real(real64))
                do i = 1, n
                    if (.not. any(array(i) == array .and. mask_unique)) then
                        mask_unique(i) = .true.
                    end if
                end do
            class default
                allocate(index_unique(0))

                return
        end select

        index_unique = pack([(i, i = 1, n)], mask_unique)
    end function index_unique