comms_no_sync_reduce_real Subroutine

private subroutine comms_no_sync_reduce_real(array, size, op, error, comm)

Reduce real data to root node

Arguments

Type IntentOptional Attributes Name
real(kind=dp), intent(inout) :: array
integer, intent(in) :: size
character(len=*), intent(in) :: op
type(w90_error_type), intent(out), allocatable :: error
type(w90_comm_type), intent(in) :: comm

Called by

proc~~comms_no_sync_reduce_real~~CalledByGraph proc~comms_no_sync_reduce_real comms_no_sync_reduce_real interface~comms_no_sync_reduce comms_no_sync_reduce interface~comms_no_sync_reduce->proc~comms_no_sync_reduce_real proc~comms_reduce_real comms_reduce_real proc~comms_reduce_real->proc~comms_no_sync_reduce_real interface~comms_reduce comms_reduce interface~comms_reduce->proc~comms_reduce_real proc~berry_main berry_main proc~berry_main->interface~comms_reduce proc~get_aa_r get_AA_R proc~berry_main->proc~get_aa_r proc~get_bb_r get_BB_R proc~berry_main->proc~get_bb_r proc~get_cc_r get_CC_R proc~berry_main->proc~get_cc_r proc~get_saa_r get_SAA_R proc~berry_main->proc~get_saa_r proc~get_sbb_r get_SBB_R proc~berry_main->proc~get_sbb_r proc~berry_get_sc_klist berry_get_sc_klist proc~berry_main->proc~berry_get_sc_klist proc~boltzwann_main boltzwann_main proc~boltzwann_main->interface~comms_reduce proc~calctdfanddos calcTDFandDOS proc~boltzwann_main->proc~calctdfanddos proc~calctdfanddos->interface~comms_reduce proc~dos_main dos_main proc~dos_main->interface~comms_reduce proc~get_aa_r->interface~comms_reduce proc~get_bb_r->interface~comms_reduce proc~get_cc_r->interface~comms_reduce proc~get_saa_r->interface~comms_reduce proc~get_sbb_r->interface~comms_reduce proc~gyrotropic_main gyrotropic_main proc~gyrotropic_main->interface~comms_reduce proc~gyrotropic_main->proc~get_aa_r proc~gyrotropic_main->proc~get_bb_r proc~gyrotropic_main->proc~get_cc_r proc~hamiltonian_write_tb hamiltonian_write_tb proc~hamiltonian_write_tb->interface~comms_reduce proc~plot_interpolate_bands plot_interpolate_bands proc~plot_interpolate_bands->interface~comms_reduce proc~plot_wannier plot_wannier proc~plot_wannier->interface~comms_reduce proc~plot_write_r2mn plot_write_r2mn proc~plot_write_r2mn->interface~comms_reduce proc~plot_write_rmn plot_write_rmn proc~plot_write_rmn->interface~comms_reduce proc~spin_get_moment spin_get_moment proc~spin_get_moment->interface~comms_reduce proc~write_chkpt write_chkpt proc~write_chkpt->interface~comms_reduce proc~k_path k_path proc~k_path->proc~get_aa_r proc~k_path->proc~get_bb_r proc~k_path->proc~get_cc_r proc~k_slice k_slice proc~k_slice->proc~get_aa_r proc~k_slice->proc~get_bb_r proc~k_slice->proc~get_cc_r proc~plot_main plot_main proc~plot_main->proc~hamiltonian_write_tb proc~plot_main->proc~plot_interpolate_bands proc~plot_main->proc~plot_wannier proc~plot_main->proc~plot_write_r2mn proc~plot_main->proc~plot_write_rmn proc~wham_get_eig_uu_hh_aa_sc_tb_conv wham_get_eig_UU_HH_AA_sc_TB_conv proc~wham_get_eig_uu_hh_aa_sc_tb_conv->proc~get_aa_r program~postw90 postw90 program~postw90->proc~berry_main program~postw90->proc~boltzwann_main program~postw90->proc~dos_main program~postw90->proc~gyrotropic_main program~postw90->proc~spin_get_moment program~postw90->proc~k_path program~postw90->proc~k_slice program~wannier wannier program~wannier->proc~write_chkpt proc~w90_plot w90_plot program~wannier->proc~w90_plot proc~berry_get_sc_klist->proc~wham_get_eig_uu_hh_aa_sc_tb_conv proc~w90_plot->proc~plot_main

Source Code

  subroutine comms_no_sync_reduce_real(array, size, op, error, comm)
    !! Reduce real data to root node

    implicit none

    real(kind=dp), intent(inout) :: array
    integer, intent(in) :: size
    character(len=*), intent(in) :: op
    type(w90_comm_type), intent(in) :: comm
    type(w90_error_type), allocatable, intent(out) :: error

#ifdef W90_MPI
    integer :: ierr
    integer :: rank
    rank = mpirank(comm)

    select case (op)

    case ('SUM')
      if (rank == root_id) then
        call mpi_reduce(MPI_IN_PLACE, array, size, MPI_DOUBLE_PRECISION, MPI_SUM, root_id, &
                        comm%comm, ierr)
      else
        call mpi_reduce(array, array, size, MPI_DOUBLE_PRECISION, MPI_SUM, root_id, comm%comm, &
                        ierr)
      end if
    case ('PRD')
      if (rank == root_id) then
        call mpi_reduce(MPI_IN_PLACE, array, size, MPI_DOUBLE_PRECISION, MPI_PROD, root_id, &
                        comm%comm, ierr)
      else
        call mpi_reduce(array, array, size, MPI_DOUBLE_PRECISION, MPI_PROD, root_id, comm%comm, &
                        ierr)
      end if
    case ('MIN')
      if (rank == root_id) then
        call mpi_reduce(MPI_IN_PLACE, array, size, MPI_DOUBLE_PRECISION, MPI_MIN, root_id, &
                        comm%comm, ierr)
      else
        call mpi_reduce(array, array, size, MPI_DOUBLE_PRECISION, MPI_MIN, root_id, comm%comm, &
                        ierr)
      end if
    case ('MAX')
      if (rank == root_id) then
        call mpi_reduce(MPI_IN_PLACE, array, size, MPI_DOUBLE_PRECISION, MPI_MAX, root_id, &
                        comm%comm, ierr)
      else
        call mpi_reduce(array, array, size, MPI_DOUBLE_PRECISION, MPI_MAX, root_id, comm%comm, &
                        ierr)
      end if
    case default
      call set_base_error(error, 'Unknown operation in comms_reduce_real', code_mpi)
      return

    end select

    if (ierr .ne. MPI_SUCCESS) then
      call set_base_error(error, 'Error in comms_reduce_real', code_mpi)
      return
    end if
#endif

  end subroutine comms_no_sync_reduce_real