hamiltonian_write_tb Subroutine

public subroutine hamiltonian_write_tb(kmesh_info, ham_r, m_matrix, kpt_latt, real_lattice, irvec, ndegen, nrpts, num_kpts, num_wann, timing_level, seedname, timer, dist_k, error, comm)

Uses

  • proc~~hamiltonian_write_tb~~UsesGraph proc~hamiltonian_write_tb hamiltonian_write_tb module~w90_constants w90_constants proc~hamiltonian_write_tb->module~w90_constants module~w90_io w90_io proc~hamiltonian_write_tb->module~w90_io module~w90_types w90_types proc~hamiltonian_write_tb->module~w90_types module~w90_io->module~w90_constants module~w90_types->module~w90_constants

Write in a single file all the information that is needed to set up a Wannier-based tight-binding model: * lattice vectors * <0n|H|Rn> * <0n|r|Rn>

Arguments

Type IntentOptional Attributes Name
type(kmesh_info_type), intent(in) :: kmesh_info
complex(kind=dp), intent(in) :: ham_r(:,:,:)
complex(kind=dp), intent(in) :: m_matrix(:,:,:,:)
real(kind=dp), intent(in) :: kpt_latt(:,:)
real(kind=dp), intent(in) :: real_lattice(3,3)
integer, intent(in) :: irvec(:,:)
integer, intent(in) :: ndegen(:)
integer, intent(in) :: nrpts
integer, intent(in) :: num_kpts
integer, intent(in) :: num_wann
integer, intent(in) :: timing_level
character(len=50), intent(in) :: seedname
type(timer_list_type), intent(inout) :: timer
integer, intent(in) :: dist_k(:)
type(w90_error_type), intent(out), allocatable :: error
type(w90_comm_type), intent(in) :: comm

Calls

proc~~hamiltonian_write_tb~~CallsGraph proc~hamiltonian_write_tb hamiltonian_write_tb interface~comms_reduce comms_reduce proc~hamiltonian_write_tb->interface~comms_reduce proc~io_date io_date proc~hamiltonian_write_tb->proc~io_date proc~io_stopwatch_start io_stopwatch_start proc~hamiltonian_write_tb->proc~io_stopwatch_start proc~io_stopwatch_stop io_stopwatch_stop proc~hamiltonian_write_tb->proc~io_stopwatch_stop proc~mpirank mpirank proc~hamiltonian_write_tb->proc~mpirank proc~set_error_file set_error_file proc~hamiltonian_write_tb->proc~set_error_file proc~comms_reduce_cmplx comms_reduce_cmplx interface~comms_reduce->proc~comms_reduce_cmplx proc~comms_reduce_int comms_reduce_int interface~comms_reduce->proc~comms_reduce_int proc~comms_reduce_real comms_reduce_real interface~comms_reduce->proc~comms_reduce_real proc~comms_sync_error comms_sync_error proc~set_error_file->proc~comms_sync_error proc~set_base_error set_base_error proc~set_error_file->proc~set_base_error proc~comms_reduce_cmplx->proc~comms_sync_error proc~comms_no_sync_reduce_cmplx comms_no_sync_reduce_cmplx proc~comms_reduce_cmplx->proc~comms_no_sync_reduce_cmplx proc~comms_reduce_int->proc~comms_sync_error proc~comms_no_sync_reduce_int comms_no_sync_reduce_int proc~comms_reduce_int->proc~comms_no_sync_reduce_int proc~comms_reduce_real->proc~comms_sync_error proc~comms_no_sync_reduce_real comms_no_sync_reduce_real proc~comms_reduce_real->proc~comms_no_sync_reduce_real

Called by

proc~~hamiltonian_write_tb~~CalledByGraph proc~hamiltonian_write_tb hamiltonian_write_tb proc~plot_main plot_main proc~plot_main->proc~hamiltonian_write_tb proc~w90_plot w90_plot proc~w90_plot->proc~plot_main program~wannier wannier program~wannier->proc~w90_plot

Source Code

  subroutine hamiltonian_write_tb(kmesh_info, ham_r, m_matrix, kpt_latt, real_lattice, irvec, &
                                  ndegen, nrpts, num_kpts, num_wann, timing_level, seedname, &
                                  timer, dist_k, error, comm)
    !================================================!
    !! Write in a single file all the information
    !! that is needed to set up a Wannier-based
    !! tight-binding model:
    !! * lattice vectors
    !! * <0n|H|Rn>
    !! * <0n|r|Rn>
    !================================================!

    use w90_io, only: io_stopwatch_start, io_stopwatch_stop, io_date
    use w90_constants, only: twopi, cmplx_i
    use w90_types, only: kmesh_info_type

    ! arguments
    type(kmesh_info_type), intent(in) :: kmesh_info
    type(timer_list_type), intent(inout) :: timer
    type(w90_comm_type), intent(in) :: comm
    type(w90_error_type), allocatable, intent(out) :: error

    integer, intent(in) :: dist_k(:)
    integer, intent(in) :: ndegen(:)
    integer, intent(in) :: num_kpts
    integer, intent(in) :: num_wann
    integer, intent(in) :: irvec(:, :)
    integer, intent(in) :: nrpts
    integer, intent(in) :: timing_level

    real(kind=dp), intent(in) :: kpt_latt(:, :)
    real(kind=dp), intent(in) :: real_lattice(3, 3)

    complex(kind=dp), intent(in) :: ham_r(:, :, :)
    complex(kind=dp), intent(in) :: m_matrix(:, :, :, :)

    character(len=50), intent(in)  :: seedname

    ! local variables
    integer :: ierr
    integer :: i, j, irpt, ik, nn, idir, file_unit
    integer :: rank, ik_rank
    real(kind=dp) :: rdotk
    complex(kind=dp) :: fac, pos_r(3)
    character(len=33) :: header
    character(len=9) :: cdate, ctime
    logical :: on_root = .false.

    rank = mpirank(comm)

    if (rank == 0) on_root = .true.

    if (on_root) then
      if (timing_level > 1) call io_stopwatch_start('hamiltonian: write_tb', timer)

      open (newunit=file_unit, file=trim(seedname)//'_tb.dat', form='formatted', status='unknown', &
            iostat=ierr)
      if (ierr /= 0) then
        call set_error_file(error, 'Error: hamiltonian_write_tb: problem opening file '//trim(seedname)//'_tb.dat', comm)
        return
      end if

      call io_date(cdate, ctime)
      header = 'written on '//cdate//' at '//ctime

      write (file_unit, *) header ! Date and time
      !
      ! lattice vectors
      !
      write (file_unit, *) real_lattice(1, :) !a_1
      write (file_unit, *) real_lattice(2, :) !a_2
      write (file_unit, *) real_lattice(3, :) !a_3
      !
      write (file_unit, *) num_wann
      write (file_unit, *) nrpts
      write (file_unit, '(15I5)') (ndegen(i), i=1, nrpts)
      !
      ! <0n|H|Rm>
      !
      do irpt = 1, nrpts
        write (file_unit, '(/,3I5)') irvec(:, irpt)
        do i = 1, num_wann
          do j = 1, num_wann
            write (file_unit, '(2I5,3x,2(E15.8,1x))') j, i, ham_r(j, i, irpt)
          end do
        end do
      end do
    end if ! on_root
    !
    ! <0n|r|Rm>
    !
    do irpt = 1, nrpts
      if (on_root) write (file_unit, '(/,3I5)') irvec(:, irpt)
      do i = 1, num_wann
        do j = 1, num_wann
          pos_r(:) = 0._dp
          ik_rank = 1
          do ik = 1, num_kpts
            if (dist_k(ik) /= rank) cycle

            rdotk = twopi*dot_product(kpt_latt(:, ik), real(irvec(:, irpt), dp))
            fac = exp(-cmplx_i*rdotk)/real(num_kpts, dp)
            do idir = 1, 3
              do nn = 1, kmesh_info%nntot
                if (i == j) then
                  ! For irpt==rpt_origin, this reduces to
                  ! Eq.(32) of Marzari and Vanderbilt PRB 56,
                  ! 12847 (1997). Otherwise, is is Eq.(44)
                  ! Wang, Yates, Souza and Vanderbilt PRB 74,
                  ! 195118 (2006), modified according to
                  ! Eqs.(27,29) of Marzari and Vanderbilt
                  pos_r(idir) = pos_r(idir) - kmesh_info%wb(nn)*kmesh_info%bk(idir, nn, ik) &
                                *aimag(log(m_matrix(i, i, nn, ik_rank)))*fac
                else
                  ! Eq.(44) Wang, Yates, Souza and Vanderbilt PRB 74, 195118 (2006)
                  pos_r(idir) = pos_r(idir) + cmplx_i*kmesh_info%wb(nn) &
                                *kmesh_info%bk(idir, nn, ik)*m_matrix(j, i, nn, ik_rank)*fac
                end if
              end do
            end do
            ik_rank = ik_rank + 1
          end do
          call comms_reduce(pos_r(1), 3, 'SUM', error, comm)
          if (on_root) write (file_unit, '(2I5,3x,6(E15.8,1x))') j, i, pos_r(:)
        end do
      end do
    end do

    if (on_root) then
      close (file_unit)
      if (timing_level > 1) call io_stopwatch_stop('hamiltonian: write_tb', timer)
    end if
  end subroutine hamiltonian_write_tb