group Subroutine

private subroutine group(array, array_groups, tran_group_threshold, error, comm)

Uses

  • proc~~group~~UsesGraph proc~group group module~w90_constants w90_constants proc~group->module~w90_constants module~w90_error w90_error proc~group->module~w90_error module~w90_comms w90_comms module~w90_error->module~w90_comms module~w90_error_base w90_error_base module~w90_error->module~w90_error_base module~w90_comms->module~w90_constants module~w90_comms->module~w90_error_base

Arguments

Type IntentOptional Attributes Name
real(kind=dp), intent(in) :: array(:,:)
integer, intent(out), allocatable :: array_groups(:)
real(kind=dp), intent(in) :: tran_group_threshold
type(w90_error_type), intent(out), allocatable :: error
type(w90_comm_type), intent(in) :: comm

Calls

proc~~group~~CallsGraph proc~group group proc~set_error_alloc set_error_alloc proc~group->proc~set_error_alloc proc~set_error_dealloc set_error_dealloc proc~group->proc~set_error_dealloc proc~comms_sync_error comms_sync_error proc~set_error_alloc->proc~comms_sync_error proc~set_base_error set_base_error proc~set_error_alloc->proc~set_base_error proc~set_error_dealloc->proc~comms_sync_error proc~set_error_dealloc->proc~set_base_error

Called by

proc~~group~~CalledByGraph proc~group group proc~master_sort_and_group master_sort_and_group proc~master_sort_and_group->proc~group proc~tran_lcr_2c2_sort tran_lcr_2c2_sort proc~tran_lcr_2c2_sort->proc~group proc~tran_lcr_2c2_sort->proc~master_sort_and_group proc~tran_main tran_main proc~tran_main->proc~tran_lcr_2c2_sort proc~w90_transport w90_transport proc~w90_transport->proc~tran_main program~wannier wannier program~wannier->proc~w90_transport

Source Code

  subroutine group(array, array_groups, tran_group_threshold, error, comm)
    !================================================!

    use w90_constants, only: dp
    use w90_error, only: w90_error_type, set_error_alloc, set_error_dealloc

    implicit none

    ! arguments
    type(w90_error_type), allocatable, intent(out) :: error
    type(w90_comm_type), intent(in) :: comm
    real(kind=dp), intent(in) :: tran_group_threshold
    real(kind=dp), intent(in) :: array(:, :)
    integer, intent(out), allocatable :: array_groups(:)

    ! local variables
    integer, allocatable :: dummy_array(:)
    integer :: array_idx, i, j, group_number, array_size, ierr
    logical, allocatable :: logic(:)

    array_size = size(array, 2)

    allocate (dummy_array(array_size), stat=ierr)
    if (ierr /= 0) then
      call set_error_alloc(error, 'Error in allocating dummy_array in group', comm)
      return
    end if
    allocate (logic(array_size), stat=ierr)
    if (ierr /= 0) then
      call set_error_alloc(error, 'Error in allocating logic in group', comm)
      return
    end if

    !Initialise dummy array
    dummy_array = 0

    !Initialise logic to false
    logic = .false.

    !Define counter of number of groups
    array_idx = 1

    !Loop over columns of array (ie array_size)
    do i = 1, array_size

      !If an element of logic is true then it means the wannier function has already been grouped
      if (logic(i) .eqv. .false.) then

        !Create a group for the wannier function
        logic(i) = .true.

        !Initialise the number of wannier functions in this group to be 1
        group_number = 1

        !Loop over the rest of wannier functions in array
        do j = min(i + 1, array_size), array_size

          !Special termination cases
          if ((j .eq. 1) .or. (i .eq. array_size)) then
            dummy_array(array_idx) = group_number
            exit
          end if
          if (j .eq. array_size .and. (abs(array(2, j) - array(2, i)) .le. tran_group_threshold)) then
            group_number = group_number + 1
            dummy_array(array_idx) = group_number
            logic(j) = .true.
            exit
          end if

          !Check distance between wannier function_i and wannier function_j
          if (abs(array(2, j) - array(2, i)) .le. tran_group_threshold) then

            !Increment number of wannier functions in group

            group_number = group_number + 1

            !Assigns wannier function to the group

            logic(j) = .true.
          else

            !Group is finished and store number of wanniers in the group to dummy_array
            dummy_array(array_idx) = group_number

            !Increment number of groups
            array_idx = array_idx + 1
            exit
          end if
        end do
      end if
    end do

    !Copy elements of dummy_array to array_groups

    allocate (array_groups(array_idx), stat=ierr)
    if (ierr /= 0) then
      call set_error_alloc(error, 'Error in allocating array_groups in group', comm)
      return
    end if
    array_groups = dummy_array(:array_idx)

    deallocate (dummy_array, stat=ierr)
    if (ierr /= 0) then
      call set_error_dealloc(error, 'Error deallocating dummy_array in group', comm)
      return
    end if
    deallocate (logic, stat=ierr)
    if (ierr /= 0) then
      call set_error_dealloc(error, 'Error deallocating logic in group', comm)
      return
    end if

    return

  end subroutine group