Line data Source code
1 : !> \file mo_common_mpi_tools.f90
2 : !> \brief \copybrief mo_common_mpi_tools
3 : !> \details \copydetails mo_common_mpi_tools
4 :
5 : !> \brief tools for MPI communication that are mHM or mRM specific
6 : !> \author Maren Kaluza
7 : !> \author Sebastian Mueller
8 : !> \date 2019-2021
9 : !> \details This module contains sending and receiving subroutines for
10 : !! data that are specific for mHM or mRM
11 : !> \copyright Copyright 2005-\today, the mHM Developers, Luis Samaniego, Sabine Attinger: All rights reserved.
12 : !! mHM is released under the LGPLv3+ license \license_note
13 : !> \ingroup f_common
14 : MODULE mo_common_mpi_tools
15 :
16 : #ifdef MPI
17 : use mo_kind, only : i4, dp
18 : use mo_message, only : message
19 : use mo_string_utils, only : num2str
20 : use mo_common_variables, only: comm
21 : use mpi_f08
22 : #endif
23 :
24 : IMPLICIT NONE
25 :
26 : PRIVATE
27 :
28 : #ifdef MPI
29 : PUBLIC :: distribute_parameterset, get_parameterset
30 : #endif
31 : public :: mpi_tools_init
32 : public :: mpi_tools_finalize
33 :
34 : ! ------------------------------------------------------------------
35 :
36 : contains
37 : #ifdef MPI
38 : !> \brief Distrubute parameter set with MPI.
39 : subroutine distribute_parameterset(parameterset)
40 : use mo_common_variables, only : domainMeta
41 : real(dp), dimension(:), intent(in) :: parameterset
42 :
43 : integer(i4) :: nproc, iproc, dimen
44 : integer(i4) :: ierror
45 :
46 : call MPI_Comm_size(domainMeta%comMaster, nproc, ierror)
47 : dimen = size(parameterset(:))
48 : do iproc = 1, nproc-1
49 : call MPI_Send(dimen, 1, &
50 : MPI_INTEGER,iproc,0,domainMeta%comMaster,ierror)
51 : call MPI_Send(parameterset(:),dimen, &
52 : MPI_DOUBLE_PRECISION,iproc,0,domainMeta%comMaster,ierror)
53 : end do
54 : end subroutine distribute_parameterset
55 :
56 : !> \brief Get distrubuted parameter set with MPI.
57 : subroutine get_parameterset(parameterset)
58 : use mpi_f08
59 : use mo_common_variables, only : domainMeta
60 : real(dp), dimension(:), allocatable, intent(inout) :: parameterset
61 :
62 : integer(i4) :: dimen
63 : integer(i4) :: ierror
64 : type(MPI_Status) :: status
65 :
66 : call MPI_Recv(dimen, 1, MPI_INTEGER, 0, 0, domainMeta%comMaster, status, ierror)
67 : allocate(parameterset(dimen))
68 : call MPI_Recv(parameterset, dimen, MPI_DOUBLE_PRECISION, 0, 0, domainMeta%comMaster, status, ierror)
69 : end subroutine get_parameterset
70 : #endif
71 :
72 : !> \brief Finalize the MPI run of mHM.
73 14 : subroutine mpi_tools_init()
74 :
75 : implicit none
76 :
77 : #ifdef MPI
78 : integer :: ierror
79 : integer(i4) :: nproc, rank
80 :
81 : ! Initialize MPI
82 : call MPI_Init(ierror)
83 : call MPI_Comm_dup(MPI_COMM_WORLD, comm, ierror)
84 : ! find number of processes nproc
85 : call MPI_Comm_size(comm, nproc, ierror)
86 : ! find the number the process is referred to, called rank
87 : call MPI_Comm_rank(comm, rank, ierror)
88 : call message('MPI!, comm ', num2str(rank), num2str(nproc))
89 : #endif
90 :
91 14 : end subroutine mpi_tools_init
92 :
93 : !> \brief Finalize the MPI run of mHM.
94 14 : subroutine mpi_tools_finalize()
95 :
96 : implicit none
97 :
98 : #ifdef MPI
99 : integer :: ierror
100 : integer(i4) :: nproc, rank
101 :
102 : ! find number of processes nproc
103 : call MPI_Comm_size(comm, nproc, ierror)
104 : call MPI_Comm_rank(comm, rank, ierror)
105 : call message('MPI finished ', num2str(rank), num2str(nproc))
106 : call MPI_Finalize(ierror)
107 : #endif
108 :
109 28 : end subroutine mpi_tools_finalize
110 :
111 : END MODULE mo_common_mpi_tools
|