pw90common_wanint_get_kpoint_file Subroutine

public subroutine pw90common_wanint_get_kpoint_file(kpoint_dist, error, comm)

Uses

  • proc~~pw90common_wanint_get_kpoint_file~~UsesGraph proc~pw90common_wanint_get_kpoint_file pw90common_wanint_get_kpoint_file module~w90_comms w90_comms proc~pw90common_wanint_get_kpoint_file->module~w90_comms module~w90_constants w90_constants proc~pw90common_wanint_get_kpoint_file->module~w90_constants module~w90_io w90_io proc~pw90common_wanint_get_kpoint_file->module~w90_io module~w90_postw90_types w90_postw90_types proc~pw90common_wanint_get_kpoint_file->module~w90_postw90_types 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

read kpoints from kpoint.dat and distribute

  print*,'rsum',sum

Arguments

Type IntentOptional Attributes Name
type(kpoint_dist_type), intent(inout) :: kpoint_dist
type(w90_error_type), intent(out), allocatable :: error
type(w90_comm_type), intent(in) :: comm

Calls

proc~~pw90common_wanint_get_kpoint_file~~CallsGraph proc~pw90common_wanint_get_kpoint_file pw90common_wanint_get_kpoint_file dcopy dcopy proc~pw90common_wanint_get_kpoint_file->dcopy interface~comms_bcast comms_bcast proc~pw90common_wanint_get_kpoint_file->interface~comms_bcast proc~mpirank mpirank proc~pw90common_wanint_get_kpoint_file->proc~mpirank proc~mpisize mpisize proc~pw90common_wanint_get_kpoint_file->proc~mpisize proc~set_error_alloc set_error_alloc proc~pw90common_wanint_get_kpoint_file->proc~set_error_alloc proc~set_error_file set_error_file proc~pw90common_wanint_get_kpoint_file->proc~set_error_file 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_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_file->proc~comms_sync_error proc~set_error_file->proc~set_base_error 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

Called by

proc~~pw90common_wanint_get_kpoint_file~~CalledByGraph proc~pw90common_wanint_get_kpoint_file pw90common_wanint_get_kpoint_file program~postw90 postw90 program~postw90->proc~pw90common_wanint_get_kpoint_file

Source Code

  subroutine pw90common_wanint_get_kpoint_file(kpoint_dist, error, comm)
    !================================================!
    !
    !! read kpoints from kpoint.dat and distribute
    !
    !================================================!

    use w90_constants, only: dp
    use w90_io, only: io_date, io_time
    use w90_comms, only: mpirank, mpisize, w90_comm_type, comms_bcast
    use w90_postw90_types, only: kpoint_dist_type

    ! arguments
    type(kpoint_dist_type), intent(inout) :: kpoint_dist
    type(w90_comm_type), intent(in) :: comm
    type(w90_error_type), allocatable, intent(out) :: error

    ! local variables
    integer :: i, ierr, my_node_id, num_nodes, k_unit
    !real(kind=dp) :: sum
    logical :: on_root = .false.
    real(kind=dp), allocatable :: kt(:, :), wt(:) !temp for read/dist
    integer :: ik, nk, ir, nkloc, off

    my_node_id = mpirank(comm)
    num_nodes = mpisize(comm)

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

    if (on_root) then
      open (newunit=k_unit, file='kpoint.dat', status='old', form='formatted', err=106)
      read (k_unit, *) kpoint_dist%num_int_kpts
    end if
    call comms_bcast(kpoint_dist%num_int_kpts, 1, error, comm)
    if (allocated(error)) return

    allocate (kpoint_dist%num_int_kpts_on_node(0:num_nodes - 1))
    kpoint_dist%num_int_kpts_on_node(:) = kpoint_dist%num_int_kpts/num_nodes
    kpoint_dist%max_int_kpts_on_node = kpoint_dist%num_int_kpts &
                                       - (num_nodes - 1)*(kpoint_dist%num_int_kpts/num_nodes)
    kpoint_dist%num_int_kpts_on_node(0) = kpoint_dist%max_int_kpts_on_node
!   if(my_node_id < num_int_kpts- num_int_kpts_on_node*num_nodes)  num_int_kpts_on_node= num_int_kpts_on_node+1

    allocate (kpoint_dist%int_kpts(3, kpoint_dist%max_int_kpts_on_node), stat=ierr)
    if (ierr /= 0) then
      call set_error_alloc(error, 'Error allocating max_int_kpts_on_node in w90_wannier90_readwrite_read_um', comm)
      return
    end if
    kpoint_dist%int_kpts = 0.0_dp
    allocate (kpoint_dist%weight(kpoint_dist%max_int_kpts_on_node), stat=ierr)
    if (ierr /= 0) then
      call set_error_alloc(error, 'Error allocating weight in w90_wannier90_readwrite_read_um', comm)
      return
    end if
    kpoint_dist%weight = 0.0_dp

    !sum = 0.0_dp

    nk = kpoint_dist%num_int_kpts
    allocate (kt(3, nk))
    allocate (wt(nk))
    if (on_root) then
      do ik = 1, nk
        read (k_unit, *) (kt(i, ik), i=1, 3), wt(ik)
      end do
    end if
    call comms_bcast(kt(1, 1), 3*nk, error, comm)
    if (allocated(error)) return
    call comms_bcast(wt(1), nk, error, comm)
    if (allocated(error)) return

    nkloc = kpoint_dist%num_int_kpts_on_node(my_node_id)
    off = 1
    do ir = 0, my_node_id - 1
      off = off + kpoint_dist%num_int_kpts_on_node(ir)
    end do
    call dcopy(3*nkloc, kt(1, off), 1, kpoint_dist%int_kpts, 1)
    call dcopy(nkloc, wt(off), 1, kpoint_dist%weight, 1)
    deallocate (kt)
    deallocate (wt)

!    if (on_root) then
!      do loop_nodes = 1, num_nodes - 1
!        do loop_kpt = 1, kpoint_dist%num_int_kpts_on_node(loop_nodes)
!          read (k_unit, *) (kpoint_dist%int_kpts(i, loop_kpt), i=1, 3), kpoint_dist%weight(loop_kpt)
!          sum = sum + kpoint_dist%weight(loop_kpt)
!        end do
!
!        call comms_no_sync_send(kpoint_dist%int_kpts(1, 1), 3*kpoint_dist%num_int_kpts_on_node(loop_nodes), loop_nodes, error, comm)
!        if (allocated(error)) return
!        call comms_no_sync_send(kpoint_dist%weight(1), kpoint_dist%num_int_kpts_on_node(loop_nodes), loop_nodes, error, comm)
!        if (allocated(error)) return
!      end do
!      do loop_kpt = 1, kpoint_dist%num_int_kpts_on_node(0)
!        read (k_unit, *) (kpoint_dist%int_kpts(i, loop_kpt), i=1, 3), kpoint_dist%weight(loop_kpt)
!        sum = sum + kpoint_dist%weight(loop_kpt)
!      end do
!!       print*,'rsum',sum
!    end if
!
!    if (.not. on_root) then
!      call comms_no_sync_recv(kpoint_dist%int_kpts(1, 1), 3*kpoint_dist%num_int_kpts_on_node(my_node_id), 0, error, comm)
!      if (allocated(error)) return
!      call comms_no_sync_recv(kpoint_dist%weight(1), kpoint_dist%num_int_kpts_on_node(my_node_id), 0, error, comm)
!      if (allocated(error)) return
!    end if

    return

106 call set_error_file(error, 'Error: Problem opening file kpoint.dat in pw90common_wanint_get_kpoint_file', comm)
    return

  end subroutine pw90common_wanint_get_kpoint_file