mo_common_MPI_tools.F90

Go to the documentation of this file.

!> \file    mo_common_mpi_tools.f90
!> \brief   \copybrief mo_common_mpi_tools
!> \details \copydetails mo_common_mpi_tools
 
!> \brief   tools for MPI communication that are mHM or mRM specific
!> \author  Maren Kaluza
!> \author  Sebastian Mueller
!> \date    2019-2021
!> \details This module contains sending and receiving subroutines for
!!          data that are specific for mHM or mRM
!> \copyright Copyright 2005-\today, the mHM Developers, Luis Samaniego, Sabine Attinger: All rights reserved.
!! mHM is released under the LGPLv3+ license \license_note
!> \ingroup f_common
MODULE mo_common_mpi_tools
 
#ifdef MPI
  use mo_kind, only : i4, dp
  use mo_message, only : message
  use mo_string_utils, only : num2str
  use mo_common_variables, only: comm
  use mpi_f08
#endif
 
  IMPLICIT NONE
 
  PRIVATE
 
#ifdef MPI
  PUBLIC :: distribute_parameterset, get_parameterset
#endif
  public :: mpi_tools_init
  public :: mpi_tools_finalize
 
  ! ------------------------------------------------------------------
 
contains
#ifdef MPI
  !> \brief Distrubute parameter set with MPI.
  subroutine distribute_parameterset(parameterset)
    use mo_common_variables, only : domainmeta
    real(dp), dimension(:),    intent(in) :: parameterset
 
    integer(i4) :: nproc, iproc, dimen
    integer(i4) :: ierror
 
    call mpi_comm_size(domainmeta%comMaster, nproc, ierror)
    dimen = size(parameterset(:))
    do iproc = 1, nproc-1
      call mpi_send(dimen, 1, &
                    mpi_integer,iproc,0,domainmeta%comMaster,ierror)
      call mpi_send(parameterset(:),dimen, &
                    mpi_double_precision,iproc,0,domainmeta%comMaster,ierror)
    end do
  end subroutine distribute_parameterset
 
  !> \brief Get distrubuted parameter set with MPI.
  subroutine get_parameterset(parameterset)
    use mpi_f08
    use mo_common_variables, only : domainmeta
    real(dp), dimension(:), allocatable, intent(inout) :: parameterset
 
    integer(i4) :: dimen
    integer(i4) :: ierror
    type(MPI_Status) :: status
 
    call mpi_recv(dimen, 1, mpi_integer, 0, 0, domainmeta%comMaster, status, ierror)
    allocate(parameterset(dimen))
    call mpi_recv(parameterset, dimen, mpi_double_precision, 0, 0, domainmeta%comMaster, status, ierror)
  end subroutine get_parameterset
#endif
 
  !> \brief Finalize the MPI run of mHM.
  subroutine mpi_tools_init()
 
    implicit none
 
#ifdef MPI
    integer             :: ierror
    integer(i4)         :: nproc, rank
 
    ! Initialize MPI
    call mpi_init(ierror)
    call mpi_comm_dup(mpi_comm_world, comm, ierror)
    ! find number of processes nproc
    call mpi_comm_size(comm, nproc, ierror)
    ! find the number the process is referred to, called rank
    call mpi_comm_rank(comm, rank, ierror)
    call message('MPI!, comm ', num2str(rank), num2str(nproc))
#endif
 
  end subroutine mpi_tools_init
 
  !> \brief Finalize the MPI run of mHM.
  subroutine mpi_tools_finalize()
 
    implicit none
 
#ifdef MPI
    integer             :: ierror
    integer(i4)         :: nproc, rank
 
    ! find number of processes nproc
    call mpi_comm_size(comm, nproc, ierror)
    call mpi_comm_rank(comm, rank, ierror)
    call message('MPI finished ', num2str(rank), num2str(nproc))
    call mpi_finalize(ierror)
#endif
 
  end subroutine mpi_tools_finalize
 
END MODULE mo_common_mpi_tools