group Subroutine

private subroutine group(array, array_groups)

Uses

  • proc~~group~~UsesGraph proc~group group module~w90_constants w90_constants proc~group->module~w90_constants module~w90_parameters w90_parameters proc~group->module~w90_parameters module~w90_io w90_io proc~group->module~w90_io module~w90_parameters->module~w90_constants module~w90_parameters->module~w90_io module~w90_io->module~w90_constants

Arguments

Type IntentOptional AttributesName
real(kind=dp), intent(in), dimension(:, :):: array
integer, intent(out), allocatable, dimension(:):: array_groups

Called by

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

Contents

Source Code


Source Code

  subroutine group(array, array_groups)
    !========================================!

    use w90_constants, only: dp
    use w90_io, only: io_error

    use w90_parameters, only: tran_group_threshold

    implicit none

    real(dp), intent(in), dimension(:, :)           :: array
    integer, intent(out), allocatable, dimension(:) :: array_groups

    integer, allocatable, dimension(:)             :: dummy_array
    logical, allocatable, dimension(:)             :: logic
    integer                                      :: array_idx, i, j, group_number, array_size, ierr

    array_size = size(array, 2)

    allocate (dummy_array(array_size), stat=ierr)
    if (ierr /= 0) call io_error('Error in allocating dummy_array in group')
    allocate (logic(array_size), stat=ierr)
    if (ierr /= 0) call io_error('Error in allocating logic in group')
    !
    !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
          endif
          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
          endif
          !
          !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
          endif
        enddo
      endif
    enddo
    !
    !Copy elements of dummy_array to array_groups
    !
    allocate (array_groups(array_idx), stat=ierr)
    if (ierr /= 0) call io_error('Error in allocating array_groups in group')
    array_groups = dummy_array(:array_idx)

    deallocate (dummy_array, stat=ierr)
    if (ierr /= 0) call io_error('Error deallocating dummy_array in group')
    deallocate (logic, stat=ierr)
    if (ierr /= 0) call io_error('Error deallocating logic in group')

    return

  end subroutine group