spin_get_moment Subroutine

public subroutine spin_get_moment(dis_manifold, fermi_energy_list, kpoint_dist, kpt_latt, pw90_oper_read, pw90_spin, ws_region, print_output, wannier_data, ws_distance, wigner_seitz, HH_R, SS_R, u_matrix, v_matrix, eigval, real_lattice, scissors_shift, mp_grid, num_wann, num_bands, num_kpts, num_valence_bands, effective_model, have_disentangled, wanint_kpoint_file, seedname, stdout, timer, error, comm)

Uses

  • proc~~spin_get_moment~~UsesGraph proc~spin_get_moment spin_get_moment module~w90_comms w90_comms proc~spin_get_moment->module~w90_comms module~w90_constants w90_constants proc~spin_get_moment->module~w90_constants module~w90_get_oper w90_get_oper proc~spin_get_moment->module~w90_get_oper module~w90_postw90_types w90_postw90_types proc~spin_get_moment->module~w90_postw90_types module~w90_types w90_types proc~spin_get_moment->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_get_oper->module~w90_comms module~w90_get_oper->module~w90_constants module~w90_error w90_error module~w90_get_oper->module~w90_error module~w90_io w90_io module~w90_get_oper->module~w90_io module~w90_postw90_types->module~w90_comms module~w90_postw90_types->module~w90_constants module~w90_types->module~w90_constants module~w90_error->module~w90_comms module~w90_error->module~w90_error_base module~w90_io->module~w90_constants

Computes the spin magnetic moment by Wannier interpolation

Arguments

Type IntentOptional Attributes Name
type(dis_manifold_type), intent(in) :: dis_manifold
real(kind=dp), intent(in), allocatable :: fermi_energy_list(:)
type(kpoint_dist_type), intent(in) :: kpoint_dist
real(kind=dp), intent(in) :: kpt_latt(:,:)
type(pw90_oper_read_type), intent(in) :: pw90_oper_read
type(pw90_spin_mod_type), intent(in) :: pw90_spin
type(ws_region_type), intent(in) :: ws_region
type(print_output_type), intent(in) :: print_output
type(wannier_data_type), intent(in) :: wannier_data
type(ws_distance_type), intent(inout) :: ws_distance
type(wigner_seitz_type), intent(inout) :: wigner_seitz
complex(kind=dp), intent(inout), allocatable :: HH_R(:,:,:)
complex(kind=dp), intent(inout), allocatable :: SS_R(:,:,:,:)
complex(kind=dp), intent(in) :: u_matrix(:,:,:)
complex(kind=dp), intent(in) :: v_matrix(:,:,:)
real(kind=dp), intent(in) :: eigval(:,:)
real(kind=dp), intent(in) :: real_lattice(3,3)
real(kind=dp), intent(in) :: scissors_shift
integer, intent(in) :: mp_grid(3)
integer, intent(in) :: num_wann
integer, intent(in) :: num_bands
integer, intent(in) :: num_kpts
integer, intent(in) :: num_valence_bands
logical, intent(in) :: effective_model
logical, intent(in) :: have_disentangled
logical, intent(in) :: wanint_kpoint_file
character(len=50), intent(in) :: seedname
integer, intent(in) :: stdout
type(timer_list_type), intent(inout) :: timer
type(w90_error_type), intent(out), allocatable :: error
type(w90_comm_type), intent(in) :: comm

Calls

proc~~spin_get_moment~~CallsGraph proc~spin_get_moment spin_get_moment interface~comms_reduce comms_reduce proc~spin_get_moment->interface~comms_reduce proc~get_hh_r get_HH_R proc~spin_get_moment->proc~get_hh_r proc~get_ss_r get_SS_R proc~spin_get_moment->proc~get_ss_r proc~mpirank mpirank proc~spin_get_moment->proc~mpirank proc~mpisize mpisize proc~spin_get_moment->proc~mpisize proc~set_error_input set_error_input proc~spin_get_moment->proc~set_error_input proc~spin_get_moment_k spin_get_moment_k proc~spin_get_moment->proc~spin_get_moment_k 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~get_hh_r->proc~mpirank proc~get_hh_r->proc~set_error_input interface~comms_bcast comms_bcast proc~get_hh_r->interface~comms_bcast proc~fourier_q_to_r fourier_q_to_R proc~get_hh_r->proc~fourier_q_to_r proc~get_win_min get_win_min proc~get_hh_r->proc~get_win_min proc~io_stopwatch_start io_stopwatch_start proc~get_hh_r->proc~io_stopwatch_start proc~io_stopwatch_stop io_stopwatch_stop proc~get_hh_r->proc~io_stopwatch_stop proc~operator_wigner_setup operator_wigner_setup proc~get_hh_r->proc~operator_wigner_setup proc~set_error_fatal set_error_fatal proc~get_hh_r->proc~set_error_fatal proc~set_error_file set_error_file proc~get_hh_r->proc~set_error_file proc~get_ss_r->proc~mpirank proc~get_ss_r->interface~comms_bcast proc~get_ss_r->proc~fourier_q_to_r proc~get_gauge_overlap_matrix get_gauge_overlap_matrix proc~get_ss_r->proc~get_gauge_overlap_matrix proc~get_ss_r->proc~io_stopwatch_start proc~get_ss_r->proc~io_stopwatch_stop proc~get_ss_r->proc~operator_wigner_setup proc~set_error_alloc set_error_alloc proc~get_ss_r->proc~set_error_alloc proc~set_error_dealloc set_error_dealloc proc~get_ss_r->proc~set_error_dealloc proc~get_ss_r->proc~set_error_fatal proc~get_ss_r->proc~set_error_file proc~comms_sync_error comms_sync_error proc~set_error_input->proc~comms_sync_error proc~set_base_error set_base_error proc~set_error_input->proc~set_base_error proc~pw90common_fourier_r_to_k pw90common_fourier_R_to_k proc~spin_get_moment_k->proc~pw90common_fourier_r_to_k proc~pw90common_get_occ pw90common_get_occ proc~spin_get_moment_k->proc~pw90common_get_occ proc~utility_diagonalize utility_diagonalize proc~spin_get_moment_k->proc~utility_diagonalize proc~utility_rotate_diag utility_rotate_diag proc~spin_get_moment_k->proc~utility_rotate_diag proc~comms_bcast_char comms_bcast_char interface~comms_bcast->proc~comms_bcast_char proc~comms_bcast_cmplx comms_bcast_cmplx interface~comms_bcast->proc~comms_bcast_cmplx proc~comms_bcast_int comms_bcast_int interface~comms_bcast->proc~comms_bcast_int proc~comms_bcast_logical comms_bcast_logical interface~comms_bcast->proc~comms_bcast_logical proc~comms_bcast_real comms_bcast_real interface~comms_bcast->proc~comms_bcast_real 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 proc~get_gauge_overlap_matrix->proc~get_win_min proc~utility_zgemmm utility_zgemmm proc~get_gauge_overlap_matrix->proc~utility_zgemmm proc~set_error_alloc->proc~comms_sync_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 proc~set_error_file->proc~comms_sync_error proc~set_error_file->proc~set_base_error proc~utility_diagonalize->proc~set_error_fatal zhpevx zhpevx proc~utility_diagonalize->zhpevx proc~utility_matmul_diag utility_matmul_diag proc~utility_rotate_diag->proc~utility_matmul_diag proc~utility_zgemm_new utility_zgemm_new proc~utility_rotate_diag->proc~utility_zgemm_new proc~comms_bcast_char->proc~comms_sync_error proc~comms_no_sync_bcast_char comms_no_sync_bcast_char proc~comms_bcast_char->proc~comms_no_sync_bcast_char proc~comms_bcast_cmplx->proc~comms_sync_error proc~comms_no_sync_bcast_cmplx comms_no_sync_bcast_cmplx proc~comms_bcast_cmplx->proc~comms_no_sync_bcast_cmplx proc~comms_bcast_int->proc~comms_sync_error proc~comms_no_sync_bcast_int comms_no_sync_bcast_int proc~comms_bcast_int->proc~comms_no_sync_bcast_int proc~comms_bcast_logical->proc~comms_sync_error proc~comms_no_sync_bcast_logical comms_no_sync_bcast_logical proc~comms_bcast_logical->proc~comms_no_sync_bcast_logical proc~comms_bcast_real->proc~comms_sync_error proc~comms_no_sync_bcast_real comms_no_sync_bcast_real proc~comms_bcast_real->proc~comms_no_sync_bcast_real zgemm zgemm proc~utility_zgemm_new->zgemm proc~utility_zgemmm->proc~utility_zgemm_new

Called by

proc~~spin_get_moment~~CalledByGraph proc~spin_get_moment spin_get_moment program~postw90 postw90 program~postw90->proc~spin_get_moment

Source Code

  subroutine spin_get_moment(dis_manifold, fermi_energy_list, kpoint_dist, kpt_latt, &
                             pw90_oper_read, pw90_spin, ws_region, print_output, wannier_data, &
                             ws_distance, wigner_seitz, HH_R, SS_R, u_matrix, v_matrix, eigval, &
                             real_lattice, scissors_shift, mp_grid, num_wann, num_bands, num_kpts, &
                             num_valence_bands, effective_model, have_disentangled, &
                             wanint_kpoint_file, seedname, stdout, timer, error, comm)
    !================================================!
    !
    !! Computes the spin magnetic moment by Wannier interpolation
    !
    !================================================!

    use w90_constants, only: dp, pi
    use w90_comms, only: comms_reduce, w90_comm_type, mpirank, mpisize
    use w90_postw90_types, only: pw90_spin_mod_type, pw90_oper_read_type, wigner_seitz_type, &
                                 kpoint_dist_type
    use w90_types, only: print_output_type, wannier_data_type, &
                         dis_manifold_type, ws_region_type, ws_distance_type, timer_list_type
    use w90_get_oper, only: get_HH_R, get_SS_R

    implicit none

    ! arguments
    type(dis_manifold_type), intent(in) :: dis_manifold
    type(kpoint_dist_type), intent(in) :: kpoint_dist
    type(pw90_oper_read_type), intent(in) :: pw90_oper_read
    type(pw90_spin_mod_type), intent(in) :: pw90_spin
    type(print_output_type), intent(in) :: print_output
    type(ws_region_type), intent(in) :: ws_region
    type(w90_comm_type), intent(in) :: comm
    type(wannier_data_type), intent(in) :: wannier_data
    type(wigner_seitz_type), intent(inout) :: wigner_seitz
    type(ws_distance_type), intent(inout) :: ws_distance
    type(timer_list_type), intent(inout) :: timer
    type(w90_error_type), allocatable, intent(out) :: error

    complex(kind=dp), allocatable, intent(inout) :: HH_R(:, :, :) !  <0n|r|Rm>
    complex(kind=dp), allocatable, intent(inout) :: SS_R(:, :, :, :) ! <0n|sigma_x,y,z|Rm>
    complex(kind=dp), intent(in) :: u_matrix(:, :, :), v_matrix(:, :, :)

    real(kind=dp), intent(in) :: eigval(:, :)
    real(kind=dp), intent(in) :: real_lattice(3, 3)
    real(kind=dp), intent(in) :: scissors_shift
    real(kind=dp), allocatable, intent(in) :: fermi_energy_list(:)
    real(kind=dp), intent(in) :: kpt_latt(:, :)

    integer, intent(in) :: mp_grid(3)
    integer, intent(in) :: num_wann, num_bands, num_kpts, num_valence_bands
    integer, intent(in) :: stdout

    logical, intent(in) :: wanint_kpoint_file

    character(len=50), intent(in)  :: seedname
    logical, intent(in) :: have_disentangled
    logical, intent(in) :: effective_model

    ! local variables
    integer       :: loop_x, loop_y, loop_z, loop_tot
    integer       :: fermi_n
    real(kind=dp) :: kweight, kpt(3), spn_k(3), spn_all(3), &
                     spn_mom(3), magnitude, theta, phi, conv

    integer :: my_node_id, num_nodes

    my_node_id = mpirank(comm)
    num_nodes = mpisize(comm)
    fermi_n = 0
    if (allocated(fermi_energy_list)) fermi_n = size(fermi_energy_list)
    if (fermi_n > 1) then
      call set_error_input(error, 'Routine spin_get_moment requires nfermi=1', comm)
      return
    end if

    call get_HH_R(dis_manifold, kpt_latt, print_output, wigner_seitz, HH_R, u_matrix, v_matrix, &
                  eigval, real_lattice, scissors_shift, num_bands, num_kpts, num_wann, &
                  num_valence_bands, effective_model, have_disentangled, seedname, ws_distance, ws_region, &
                  stdout, timer, error, comm)
    if (allocated(error)) return

    call get_SS_R(dis_manifold, kpt_latt, print_output, pw90_oper_read, SS_R, v_matrix, eigval, &
                  wigner_seitz, ws_distance, ws_region, num_bands, num_kpts, num_wann, &
                  have_disentangled, seedname, stdout, timer, error, comm)
    if (allocated(error)) return

    if (print_output%iprint > 0) then
      write (stdout, '(/,/,1x,a)') '------------'
      write (stdout, '(1x,a)') 'Calculating:'
      write (stdout, '(1x,a)') '------------'
      write (stdout, '(/,3x,a)') '* Spin magnetic moment'
    end if

    spn_all = 0.0_dp
    if (wanint_kpoint_file) then

      if (print_output%iprint > 0) then
        write (stdout, '(/,1x,a)') 'Sampling the irreducible BZ only'
        write (stdout, '(5x,a)') &
          'WARNING: - IBZ implementation is currently limited to simple cases:'
        write (stdout, '(5x,a)') &
          '               Check results against a full BZ calculation!'
      end if

      ! Loop over k-points on the irreducible wedge of the Brillouin zone,
      ! read from file 'kpoint.dat'

      do loop_tot = 1, kpoint_dist%num_int_kpts_on_node(my_node_id)
        kpt(:) = kpoint_dist%int_kpts(:, loop_tot)
        kweight = kpoint_dist%weight(loop_tot)
        call spin_get_moment_k(kpt, fermi_energy_list(1), spn_k, num_wann, ws_region, &
                               wannier_data, real_lattice, mp_grid, ws_distance, HH_R, SS_R, &
                               wigner_seitz, error, comm)
        if (allocated(error)) return

        spn_all = spn_all + spn_k*kweight
      end do

    else

      if (print_output%iprint > 0) &
        write (stdout, '(/,1x,a)') 'Sampling the full BZ (not using symmetry)'
      kweight = 1.0_dp/real(PRODUCT(pw90_spin%kmesh%mesh), kind=dp)
      do loop_tot = my_node_id, PRODUCT(pw90_spin%kmesh%mesh) - 1, num_nodes
        loop_x = loop_tot/(pw90_spin%kmesh%mesh(2)*pw90_spin%kmesh%mesh(3))
        loop_y = (loop_tot - loop_x*(pw90_spin%kmesh%mesh(2)*pw90_spin%kmesh%mesh(3)))/pw90_spin%kmesh%mesh(3)
        loop_z = loop_tot - loop_x*(pw90_spin%kmesh%mesh(2)*pw90_spin%kmesh%mesh(3)) &
                 - loop_y*pw90_spin%kmesh%mesh(3)
        kpt(1) = (real(loop_x, dp)/real(pw90_spin%kmesh%mesh(1), dp))
        kpt(2) = (real(loop_y, dp)/real(pw90_spin%kmesh%mesh(2), dp))
        kpt(3) = (real(loop_z, dp)/real(pw90_spin%kmesh%mesh(3), dp))
        call spin_get_moment_k(kpt, fermi_energy_list(1), spn_k, num_wann, ws_region, &
                               wannier_data, real_lattice, mp_grid, ws_distance, HH_R, SS_R, &
                               wigner_seitz, error, comm)
        if (allocated(error)) return

        spn_all = spn_all + spn_k*kweight
      end do

    end if

    ! Collect contributions from all nodes

    call comms_reduce(spn_all(1), 3, 'SUM', error, comm)
    if (allocated(error)) return

    ! No factor of g=2 because the spin variable spans [-1,1], not
    ! [-1/2,1/2] (i.e., it is really the Pauli matrix sigma, not S)

    spn_mom(1:3) = -spn_all(1:3)

    if (print_output%iprint > 0) then
      write (stdout, '(/,1x,a)') 'Spin magnetic moment (Bohr magn./cell)'
      write (stdout, '(1x,a,/)') '===================='
      write (stdout, '(1x,a18,f11.6)') 'x component:', spn_mom(1)
      write (stdout, '(1x,a18,f11.6)') 'y component:', spn_mom(2)
      write (stdout, '(1x,a18,f11.6)') 'z component:', spn_mom(3)

      ! Polar and azimuthal angles of the magnetization (defined as in pwscf)

      conv = 180.0_dp/pi
      magnitude = sqrt(spn_mom(1)**2 + spn_mom(2)**2 + spn_mom(3)**2)
      theta = acos(spn_mom(3)/magnitude)*conv
      phi = atan(spn_mom(2)/spn_mom(1))*conv
      write (stdout, '(/,1x,a18,f11.6)') 'Polar theta (deg):', theta
      write (stdout, '(1x,a18,f11.6)') 'Azim. phi (deg):', phi
    end if

  end subroutine spin_get_moment