w90_wannier90_readwrite_read_explicit_kpts Subroutine

private subroutine w90_wannier90_readwrite_read_explicit_kpts(settings, w90_calculation, kmesh_info, num_kpts, bohr, error, comm)

Uses

  • proc~~w90_wannier90_readwrite_read_explicit_kpts~~UsesGraph proc~w90_wannier90_readwrite_read_explicit_kpts w90_wannier90_readwrite_read_explicit_kpts module~w90_error w90_error proc~w90_wannier90_readwrite_read_explicit_kpts->module~w90_error module~w90_utility w90_utility proc~w90_wannier90_readwrite_read_explicit_kpts->module~w90_utility 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_utility->module~w90_comms module~w90_constants w90_constants module~w90_utility->module~w90_constants module~w90_comms->module~w90_constants module~w90_comms->module~w90_error_base

Arguments

Type IntentOptional Attributes Name
type(settings_type), intent(inout) :: settings
type(w90_calculation_type), intent(in) :: w90_calculation
type(kmesh_info_type), intent(inout) :: kmesh_info
integer, intent(in) :: num_kpts
real(kind=dp), intent(in) :: bohr
type(w90_error_type), intent(out), allocatable :: error
type(w90_comm_type), intent(in) :: comm

Calls

proc~~w90_wannier90_readwrite_read_explicit_kpts~~CallsGraph proc~w90_wannier90_readwrite_read_explicit_kpts w90_wannier90_readwrite_read_explicit_kpts proc~set_error_alloc set_error_alloc proc~w90_wannier90_readwrite_read_explicit_kpts->proc~set_error_alloc proc~set_error_dealloc set_error_dealloc proc~w90_wannier90_readwrite_read_explicit_kpts->proc~set_error_dealloc proc~set_error_input set_error_input proc~w90_wannier90_readwrite_read_explicit_kpts->proc~set_error_input proc~w90_readwrite_get_block_length w90_readwrite_get_block_length proc~w90_wannier90_readwrite_read_explicit_kpts->proc~w90_readwrite_get_block_length proc~w90_readwrite_get_keyword_block w90_readwrite_get_keyword_block proc~w90_wannier90_readwrite_read_explicit_kpts->proc~w90_readwrite_get_keyword_block 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 proc~set_error_input->proc~comms_sync_error proc~set_error_input->proc~set_base_error proc~w90_readwrite_get_block_length->proc~set_error_input proc~w90_readwrite_get_keyword_block->proc~set_error_input proc~set_error_fatal set_error_fatal proc~w90_readwrite_get_keyword_block->proc~set_error_fatal proc~set_error_fatal->proc~comms_sync_error proc~set_error_fatal->proc~set_base_error

Called by

proc~~w90_wannier90_readwrite_read_explicit_kpts~~CalledByGraph proc~w90_wannier90_readwrite_read_explicit_kpts w90_wannier90_readwrite_read_explicit_kpts proc~w90_wannier90_readwrite_read_special w90_wannier90_readwrite_read_special proc~w90_wannier90_readwrite_read_special->proc~w90_wannier90_readwrite_read_explicit_kpts proc~input_reader_special input_reader_special proc~input_reader_special->proc~w90_wannier90_readwrite_read_special proc~w90_input_setopt w90_input_setopt proc~w90_input_setopt->proc~w90_wannier90_readwrite_read_special proc~w90_input_setopt_f w90_input_setopt_f proc~w90_input_setopt_f->proc~w90_input_setopt program~wannier wannier program~wannier->proc~input_reader_special

Source Code

  subroutine w90_wannier90_readwrite_read_explicit_kpts(settings, w90_calculation, kmesh_info, &
                                                        num_kpts, bohr, error, comm)
    !================================================!

    use w90_error, only: w90_error_type
    use w90_utility, only: utility_recip_lattice

    implicit none

    ! arguments
    integer, intent(in) :: num_kpts
    real(kind=dp), intent(in) :: bohr
    type(kmesh_info_type), intent(inout) :: kmesh_info
    type(settings_type), intent(inout) :: settings
    type(w90_calculation_type), intent(in) :: w90_calculation
    type(w90_comm_type), intent(in) :: comm
    type(w90_error_type), allocatable, intent(out) :: error

    ! local variables
    integer, allocatable :: nnkpts_block(:, :)
    integer, allocatable :: nnkpts_idx(:)
    integer :: i, k, ierr, rows
    logical :: found

    call w90_readwrite_get_block_length(settings, 'nnkpts', kmesh_info%explicit_nnkpts, rows, error, comm)
    if (allocated(error)) return

    if (kmesh_info%explicit_nnkpts) then
      if (modulo(rows, num_kpts) /= 0) then
        call set_error_input(error, 'The number of rows in nnkpts must be a multiple of num_kpts', comm)
        return
      end if
      kmesh_info%nntot = rows/num_kpts

      if (allocated(nnkpts_block)) then
        deallocate (nnkpts_block, stat=ierr)
        if (ierr /= 0) then
          call set_error_dealloc(error, 'Error deallocating nnkpts_block in &
          & w90_wannier90_readwrite_read_explicit_kpts', comm)
          return
        end if
      end if
      allocate (nnkpts_block(5, rows), stat=ierr)
      if (ierr /= 0) then
        call set_error_alloc(error, 'Error allocating nnkpts_block in w90_wannier90_readwrite_read_explicit_kpts', comm)
        return
      end if
      call w90_readwrite_get_keyword_block(settings, 'nnkpts', found, rows, 5, bohr, error, comm, &
                                           i_value=nnkpts_block)
      if (allocated(error)) return

      ! check that postproc_setup is true
      if (.not. w90_calculation%postproc_setup) then
        call set_error_input(error, 'Input parameter nnkpts_block is allowed only if postproc_setup = .true.', comm)
        return
      end if

      ! assign the values in nnkpts_block to nnlist and nncell
      ! this keeps track of how many neighbours have been seen for each k-point
      if (allocated(nnkpts_idx)) then
        deallocate (nnkpts_idx, stat=ierr)
        if (ierr /= 0) then
          call set_error_dealloc(error, 'Error deallocating nnkpts_idx in w90_wannier90_readwrite_read_explicit_kpts', comm)
          return
        end if
      end if
      allocate (nnkpts_idx(num_kpts), stat=ierr)
      if (ierr /= 0) then
        call set_error_alloc(error, 'Error allocating nnkpts_idx in w90_wannier90_readwrite_read_explicit_kpts', comm)
        return
      end if
      nnkpts_idx = 1
      ! allocating "global" nnlist & nncell
      ! These are deallocated in kmesh_dealloc
      if (allocated(kmesh_info%nnlist)) then
        deallocate (kmesh_info%nnlist, stat=ierr)
        if (ierr /= 0) then
          call set_error_dealloc(error, 'Error deallocating nnlist in w90_wannier90_readwrite_read_explicit_kpts', comm)
          return
        end if
      end if
      allocate (kmesh_info%nnlist(num_kpts, kmesh_info%nntot), stat=ierr)
      if (ierr /= 0) then
        call set_error_alloc(error, 'Error allocating nnlist in w90_wannier90_readwrite_read_explicit_kpts', comm)
        return
      end if
      if (allocated(kmesh_info%nncell)) then
        deallocate (kmesh_info%nncell, stat=ierr)
        if (ierr /= 0) then
          call set_error_dealloc(error, 'Error deallocating nncell in w90_wannier90_readwrite_read_explicit_kpts', comm)
          return
        end if
      end if
      allocate (kmesh_info%nncell(3, num_kpts, kmesh_info%nntot), stat=ierr)
      if (ierr /= 0) then
        call set_error_alloc(error, 'Error allocating nncell in w90_wannier90_readwrite_read_explicit_kpts', comm)
        return
      end if
      do i = 1, num_kpts*kmesh_info%nntot
        k = nnkpts_block(1, i)
        kmesh_info%nnlist(k, nnkpts_idx(k)) = nnkpts_block(2, i)
        kmesh_info%nncell(:, k, nnkpts_idx(k)) = nnkpts_block(3:, i)
        nnkpts_idx(k) = nnkpts_idx(k) + 1
      end do
      ! check that all k-points have the same number of neighbours
      if (any(nnkpts_idx /= (/(kmesh_info%nntot + 1, i=1, num_kpts)/))) then
        call set_error_input(error, 'Inconsistent number of nearest neighbours.', comm)
        return
      end if
      deallocate (nnkpts_idx, stat=ierr)
      if (ierr /= 0) then
        call set_error_dealloc(error, 'Error deallocating nnkpts_idx in w90_wannier90_readwrite_read_explicit_kpts', comm)
        return
      end if
      deallocate (nnkpts_block, stat=ierr)
      if (ierr /= 0) then
        call set_error_dealloc(error, 'Error deallocating nnkpts_block in w90_wannier90_readwrite_read_explicit_kpts', comm)
        return
      end if
    end if

  end subroutine w90_wannier90_readwrite_read_explicit_kpts