plot_write_rmn Subroutine

private subroutine plot_write_rmn(kmesh_info, m_matrix, kpt_latt, irvec, nrpts, num_kpts, num_wann, seedname, dist_k, error, comm)

Uses

  • proc~~plot_write_rmn~~UsesGraph proc~plot_write_rmn plot_write_rmn module~w90_comms w90_comms proc~plot_write_rmn->module~w90_comms module~w90_constants w90_constants proc~plot_write_rmn->module~w90_constants module~w90_error w90_error proc~plot_write_rmn->module~w90_error module~w90_io w90_io proc~plot_write_rmn->module~w90_io module~w90_types w90_types proc~plot_write_rmn->module~w90_types module~w90_comms->module~w90_constants module~w90_error_base w90_error_base module~w90_comms->module~w90_error_base module~w90_error->module~w90_comms module~w90_error->module~w90_error_base module~w90_io->module~w90_constants module~w90_types->module~w90_constants

Write out the matrix elements of r

Arguments

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

Calls

proc~~plot_write_rmn~~CallsGraph proc~plot_write_rmn plot_write_rmn interface~comms_reduce comms_reduce proc~plot_write_rmn->interface~comms_reduce proc~io_date io_date proc~plot_write_rmn->proc~io_date proc~mpirank mpirank proc~plot_write_rmn->proc~mpirank proc~set_error_file set_error_file proc~plot_write_rmn->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~~plot_write_rmn~~CalledByGraph proc~plot_write_rmn plot_write_rmn proc~plot_main plot_main proc~plot_main->proc~plot_write_rmn proc~w90_plot w90_plot proc~w90_plot->proc~plot_main program~wannier wannier program~wannier->proc~w90_plot

Source Code

  subroutine plot_write_rmn(kmesh_info, m_matrix, kpt_latt, irvec, nrpts, num_kpts, &
                            num_wann, seedname, dist_k, error, comm)
    !================================================!
    !
    !! Write out the matrix elements of r
    !
    !================================================!

    use w90_comms, only: comms_reduce, w90_comm_type, mpisize, mpirank
    use w90_constants, only: twopi, cmplx_i, dp
    use w90_error, only: w90_error_type, set_error_file
    use w90_io, only: io_date
    use w90_types, only: kmesh_info_type

    implicit none

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

    integer, intent(in) :: nrpts
    integer, intent(in) :: irvec(:, :)
    integer, intent(in) :: num_wann
    integer, intent(in) :: num_kpts
    integer, intent(in) :: dist_k(:) ! MPI k-point distribution
    real(kind=dp), intent(in)     :: kpt_latt(:, :)
    complex(kind=dp), intent(in)  :: m_matrix(:, :, :, :)
    character(len=50), intent(in) :: seedname

    ! local variables
    integer :: loop_rpt, m, n, nkp, ind, nn, file_unit, ierr
    integer :: my_node_id, nkp_rank
    ! nkp_rank is the rank-local kpoint index for m_matrix decomposition
    real(kind=dp) :: rdotk
    complex(kind=dp) :: fac
    complex(kind=dp) :: position(3)
    character(len=33) :: header
    character(len=9)  :: cdate, ctime
    logical :: on_root = .false.

    my_node_id = mpirank(comm)

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

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

      call io_date(cdate, ctime)
      header = 'written on '//cdate//' at '//ctime
      write (file_unit, *) header ! Date and time
      write (file_unit, *) num_wann
      write (file_unit, *) nrpts
    end if

    do loop_rpt = 1, nrpts
      do m = 1, num_wann
        do n = 1, num_wann

          position(:) = 0._dp
          nkp_rank = 1
          do nkp = 1, num_kpts
            if (dist_k(nkp) /= my_node_id) cycle

            rdotk = twopi*dot_product(kpt_latt(:, nkp), real(irvec(:, loop_rpt), dp))
            fac = exp(-cmplx_i*rdotk)/real(num_kpts, dp)
            do ind = 1, 3
              do nn = 1, kmesh_info%nntot
                if (m .eq. n) then
                  ! For loop_rpt==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
                  position(ind) = position(ind) - kmesh_info%wb(nn)*kmesh_info%bk(ind, nn, nkp) &
                                  *aimag(log(m_matrix(n, m, nn, nkp_rank)))*fac
                else
                  ! Eq.(44) Wang, Yates, Souza and Vanderbilt PRB 74, 195118 (2006)
                  position(ind) = position(ind) + cmplx_i*kmesh_info%wb(nn) &
                                  *kmesh_info%bk(ind, nn, nkp)*m_matrix(n, m, nn, nkp_rank)*fac
                end if
              end do
            end do
            nkp_rank = nkp_rank + 1
          end do ! global k list
          call comms_reduce(position(1), 3, 'SUM', error, comm)
          if (on_root) write (file_unit, '(5I5,6F12.6)') irvec(:, loop_rpt), n, m, position(:)
        end do
      end do
    end do

    if (on_root) close (file_unit)
  end subroutine plot_write_rmn