wignerseitz Subroutine

private subroutine wignerseitz(print_output, real_lattice, mp_grid, ws_region, wigner_seitz, stdout, count_pts, timer, error, comm)

Uses

  • proc~~wignerseitz~~UsesGraph proc~wignerseitz wignerseitz module~w90_comms w90_comms proc~wignerseitz->module~w90_comms module~w90_constants w90_constants proc~wignerseitz->module~w90_constants module~w90_io w90_io proc~wignerseitz->module~w90_io module~w90_postw90_types w90_postw90_types proc~wignerseitz->module~w90_postw90_types module~w90_types w90_types proc~wignerseitz->module~w90_types module~w90_utility w90_utility proc~wignerseitz->module~w90_utility module~w90_comms->module~w90_constants module~w90_error_base w90_error_base module~w90_comms->module~w90_error_base module~w90_io->module~w90_constants module~w90_postw90_types->module~w90_comms module~w90_postw90_types->module~w90_constants module~w90_types->module~w90_constants module~w90_utility->module~w90_comms module~w90_utility->module~w90_constants

Calculates a grid of lattice vectors r that fall inside (and eventually on the surface of) the Wigner-Seitz supercell centered on the origin of the Bravais superlattice with primitive translations mp_grid(1)a_1, mp_grid(2)a_2, and mp_grid(3)*a_3

Arguments

Type IntentOptional Attributes Name
type(print_output_type), intent(in) :: print_output
real(kind=dp), intent(in) :: real_lattice(3,3)
integer, intent(in) :: mp_grid(3)
type(ws_region_type), intent(in) :: ws_region
type(wigner_seitz_type), intent(inout) :: wigner_seitz
integer, intent(in) :: stdout
logical, intent(in) :: count_pts
type(timer_list_type), intent(inout) :: timer
type(w90_error_type), intent(out), allocatable :: error
type(w90_comm_type), intent(in) :: comm

Calls

proc~~wignerseitz~~CallsGraph proc~wignerseitz wignerseitz proc~io_stopwatch_start io_stopwatch_start proc~wignerseitz->proc~io_stopwatch_start proc~io_stopwatch_stop io_stopwatch_stop proc~wignerseitz->proc~io_stopwatch_stop proc~mpirank mpirank proc~wignerseitz->proc~mpirank proc~set_error_alloc set_error_alloc proc~wignerseitz->proc~set_error_alloc proc~set_error_dealloc set_error_dealloc proc~wignerseitz->proc~set_error_dealloc proc~set_error_fatal set_error_fatal proc~wignerseitz->proc~set_error_fatal proc~utility_metric utility_metric proc~wignerseitz->proc~utility_metric 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_fatal->proc~comms_sync_error proc~set_error_fatal->proc~set_base_error

Called by

proc~~wignerseitz~~CalledByGraph proc~wignerseitz wignerseitz proc~pw90common_wanint_setup pw90common_wanint_setup proc~pw90common_wanint_setup->proc~wignerseitz program~postw90 postw90 program~postw90->proc~pw90common_wanint_setup

Source Code

  subroutine wignerseitz(print_output, real_lattice, mp_grid, ws_region, wigner_seitz, stdout, &
                         count_pts, timer, error, comm)
    !================================================!
    !! Calculates a grid of lattice vectors r that fall inside (and eventually
    !! on the surface of) the Wigner-Seitz supercell centered on the
    !! origin of the Bravais superlattice with primitive translations
    !! mp_grid(1)*a_1, mp_grid(2)*a_2, and mp_grid(3)*a_3
    !================================================!

    use w90_constants, only: eps8, dp
    use w90_io, only: io_stopwatch_start, io_stopwatch_stop
    use w90_types, only: print_output_type, timer_list_type, ws_region_type
    use w90_utility, only: utility_metric
    use w90_comms, only: w90_comm_type, mpirank
    use w90_postw90_types, only: wigner_seitz_type

    ! irvec(i,irpt)     The irpt-th Wigner-Seitz grid point has components
    !                   irvec(1:3,irpt) in the basis of the lattice vectors
    ! ndegen(irpt)      Weight of the irpt-th point is 1/ndegen(irpt)
    ! nrpts             number of Wigner-Seitz grid points

    implicit none
    ! arguments
    type(ws_region_type), intent(in)    :: ws_region
    type(print_output_type), intent(in) :: print_output
    type(timer_list_type), intent(inout) :: timer
    type(w90_comm_type), intent(in) :: comm
    type(wigner_seitz_type), intent(inout) :: wigner_seitz
    type(w90_error_type), allocatable, intent(out) :: error

    integer, intent(in) :: mp_grid(3)
    integer, intent(in) :: stdout
    logical, intent(in) :: count_pts
    real(kind=dp), intent(in) :: real_lattice(3, 3)

    ! local variables
    integer       :: ierr, dist_dim
    integer       :: n1, n2, n3, i1, i2, i3, icnt, i, j, ir
    integer       :: ndiff(3)
    logical :: on_root = .false.
    real(kind=dp), allocatable :: dist(:)
    real(kind=dp) :: real_metric(3, 3)
    real(kind=dp) :: tot, dist_min

    if (mpirank(comm) == 0) on_root = .true.

    if (print_output%timing_level > 1 .and. on_root) &
      call io_stopwatch_start('postw90_common: wigner_seitz', timer)

    call utility_metric(real_lattice, real_metric)

    dist_dim = 1
    do i = 1, 3
      dist_dim = dist_dim*((ws_region%ws_search_size(i) + 1)*2 + 1)
    end do
    allocate (dist(dist_dim), stat=ierr)
    if (ierr /= 0) then
      call set_error_alloc(error, 'Error in allocating dist in wigner_seitz', comm)
      return
    end if

    ! The Wannier functions live in a periodic supercell of the real space unit
    ! cell. This supercell is mp_grid(i) unit cells long along each primitive
    ! translation vector a_i of the unit cell
    !
    ! We loop over grid points r on a unit cell that is (2*ws_search_size+1)**3 times
    ! larger than this primitive supercell.
    !
    ! One of these points is in the W-S supercell if it is closer to R=0 than any
    ! of the other points R (where R are the translation vectors of the
    ! supercell).

    ! In the end, nrpts contains the total number of grid points that have been
    ! found in the Wigner-Seitz cell

    wigner_seitz%nrpts = 0
    ! Loop over the lattice vectors of the primitive cell
    ! that live in a supercell which is (2*ws_search_size+1)**2
    ! larger than the Born-von Karman supercell.
    ! We need to find which among these live in the Wigner-Seitz cell
    do n1 = -ws_region%ws_search_size(1)*mp_grid(1), ws_region%ws_search_size(1)*mp_grid(1)
      do n2 = -ws_region%ws_search_size(2)*mp_grid(2), ws_region%ws_search_size(2)*mp_grid(2)
        do n3 = -ws_region%ws_search_size(3)*mp_grid(3), ws_region%ws_search_size(3)*mp_grid(3)
          ! Loop over the lattice vectors R of the Born-von Karman supercell
          ! that contains all the points of the previous loop.
          ! There are (2*(ws_search_size+1)+1)**3 points R. R=0 corresponds to
          ! i1=i2=i3=0, or icnt=((2*(ws_search_size+1)+1)**3 + 1)/2
          icnt = 0
          do i1 = -ws_region%ws_search_size(1) - 1, ws_region%ws_search_size(1) + 1
            do i2 = -ws_region%ws_search_size(2) - 1, ws_region%ws_search_size(2) + 1
              do i3 = -ws_region%ws_search_size(3) - 1, ws_region%ws_search_size(3) + 1
                icnt = icnt + 1
                ! Calculate distance squared |r-R|^2
                ndiff(1) = n1 - i1*mp_grid(1)
                ndiff(2) = n2 - i2*mp_grid(2)
                ndiff(3) = n3 - i3*mp_grid(3)
                dist(icnt) = 0.0_dp
                do i = 1, 3
                  do j = 1, 3
                    dist(icnt) = dist(icnt) + &
                                 real(ndiff(i), dp)*real_metric(i, j)*real(ndiff(j), dp)
                  end do
                end do
              end do
            end do
          end do
          dist_min = minval(dist)
          if (abs(dist((dist_dim + 1)/2) - dist_min) .lt. ws_region%ws_distance_tol**2) then
            wigner_seitz%nrpts = wigner_seitz%nrpts + 1
            if (.not. count_pts) then
              wigner_seitz%ndegen(wigner_seitz%nrpts) = 0
              do i = 1, dist_dim
                if (abs(dist(i) - dist_min) .lt. ws_region%ws_distance_tol**2) &
                  wigner_seitz%ndegen(wigner_seitz%nrpts) = &
                  wigner_seitz%ndegen(wigner_seitz%nrpts) + 1
              end do
              wigner_seitz%irvec(1, wigner_seitz%nrpts) = n1
              wigner_seitz%irvec(2, wigner_seitz%nrpts) = n2
              wigner_seitz%irvec(3, wigner_seitz%nrpts) = n3

              ! Remember which grid point r is at the origin

              if (n1 == 0 .and. n2 == 0 .and. n3 == 0) wigner_seitz%rpt_origin = wigner_seitz%nrpts
            end if
          end if

          !n3
        end do
        !n2
      end do
      !n1
    end do
    !
    deallocate (dist, stat=ierr)
    if (ierr /= 0) then
      call set_error_dealloc(error, 'Error in deallocating dist wigner_seitz', comm)
      return
    end if

    if (count_pts) then
      if (print_output%timing_level > 1 .and. on_root) &
        call io_stopwatch_stop('postw90_common: wigner_seitz', timer)
      return
    end if

    if (print_output%iprint >= 3 .and. on_root) then
      write (stdout, '(1x,i4,a,/)') wigner_seitz%nrpts, &
        ' lattice points in Wigner-Seitz supercell:'
      do ir = 1, wigner_seitz%nrpts
        write (stdout, '(4x,a,3(i3,1x),a,i2)') '  vector ', wigner_seitz%irvec(1, ir), &
          wigner_seitz%irvec(2, ir), wigner_seitz%irvec(3, ir), '  degeneracy: ', &
          wigner_seitz%ndegen(ir)
      end do
      !write (stdout, '(1x,a,f12.3)') ' tot = ', tot !not yet computed
      write (stdout, '(1x,a,i12)') ' mp_grid product = ', mp_grid(1)*mp_grid(2)*mp_grid(3)
    end if
    ! Check the "sum rule"
    tot = 0.0_dp
    do ir = 1, wigner_seitz%nrpts
      !
      ! Corrects weights in Fourier sums for R-vectors on the boundary of the
      ! W-S supercell
      !
      tot = tot + 1.0_dp/real(wigner_seitz%ndegen(ir), dp)
    end do
    if (abs(tot - real(mp_grid(1)*mp_grid(2)*mp_grid(3), dp)) > eps8) then
      call set_error_fatal(error, 'ERROR in wigner_seitz: error in finding Wigner-Seitz points', comm)
      return
    end if
    if (print_output%timing_level > 1 .and. on_root) &
      call io_stopwatch_stop('postw90_common: wigner_seitz', timer)
    return
  end subroutine wignerseitz