Line data Source code
1 : !|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
2 :
3 : module ice_communicate
4 :
5 : ! This module contains the necessary routines and variables for
6 : ! communicating between processors.
7 : !
8 : ! author: Phil Jones, LANL
9 : ! Oct. 2004: Adapted from POP version by William H. Lipscomb, LANL
10 :
11 : use mpi ! MPI Fortran module
12 : use ice_kinds_mod
13 : use ice_exit, only: abort_ice
14 : use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted
15 :
16 : implicit none
17 : private
18 :
19 : public :: init_communicate, &
20 : get_num_procs, & ! LCOV_EXCL_LINE
21 : get_rank, & ! LCOV_EXCL_LINE
22 : ice_barrier, & ! LCOV_EXCL_LINE
23 : create_communicator
24 :
25 : integer (int_kind), public :: &
26 : MPI_COMM_ICE, &! MPI communicator for ice comms ! LCOV_EXCL_LINE
27 : mpiR16, &! MPI type for r16_kind ! LCOV_EXCL_LINE
28 : mpiR8, &! MPI type for dbl_kind ! LCOV_EXCL_LINE
29 : mpiR4, &! MPI type for real_kind ! LCOV_EXCL_LINE
30 : my_task, &! MPI task number for this task ! LCOV_EXCL_LINE
31 : master_task ! task number of master task
32 :
33 : integer (int_kind), parameter, public :: &
34 : mpitagHalo = 1, &! MPI tags for various ! LCOV_EXCL_LINE
35 : mpitag_gs = 1000 ! communication patterns
36 :
37 : logical (log_kind), public :: &
38 : add_mpi_barriers = .false. ! turn on mpi barriers for throttling
39 :
40 : !***********************************************************************
41 :
42 : contains
43 :
44 : !***********************************************************************
45 :
46 36 : subroutine init_communicate(mpicom)
47 :
48 : ! This routine sets up MPI environment and defines ice
49 : ! communicator.
50 :
51 : !-----------------------------------------------------------------------
52 : !
53 : ! local variables
54 : !
55 : !-----------------------------------------------------------------------
56 :
57 : integer (kind=int_kind), optional, intent(in) :: mpicom ! specified communicator
58 :
59 : integer (int_kind) :: ierr ! MPI error flag
60 : logical :: flag ! MPI logical flag
61 : integer (int_kind) :: ice_comm
62 :
63 : character(len=*), parameter :: subname = '(init_communicate)'
64 :
65 : !-----------------------------------------------------------------------
66 : !
67 : ! initiate mpi environment and create communicator for internal
68 : ! ice communications
69 : !
70 : !-----------------------------------------------------------------------
71 :
72 36 : if (present(mpicom)) then
73 0 : ice_comm = mpicom
74 : else
75 36 : ice_comm = MPI_COMM_WORLD ! Global communicator
76 : endif
77 :
78 36 : call MPI_INITIALIZED(flag,ierr)
79 36 : if (.not.flag) call MPI_INIT(ierr)
80 :
81 36 : call MPI_BARRIER (ice_comm, ierr)
82 36 : call MPI_COMM_DUP(ice_comm, MPI_COMM_ICE, ierr)
83 :
84 36 : master_task = 0
85 36 : call MPI_COMM_RANK (MPI_COMM_ICE, my_task, ierr)
86 :
87 : #if (defined NO_R16)
88 : mpiR16 = MPI_REAL8
89 : #else
90 36 : mpiR16 = MPI_REAL16
91 : #endif
92 36 : mpiR8 = MPI_REAL8
93 36 : mpiR4 = MPI_REAL4
94 :
95 : !-----------------------------------------------------------------------
96 :
97 72 : end subroutine init_communicate
98 :
99 : !***********************************************************************
100 :
101 72 : function get_num_procs()
102 :
103 : ! This function returns the number of processor assigned to
104 : ! MPI_COMM_ICE
105 :
106 : integer (int_kind) :: get_num_procs
107 :
108 : !-----------------------------------------------------------------------
109 : !
110 : ! local variables
111 : !
112 : !-----------------------------------------------------------------------
113 :
114 : integer (int_kind) :: ierr
115 : character(len=*), parameter :: subname = '(get_num_procs)'
116 :
117 : !-----------------------------------------------------------------------
118 :
119 72 : call MPI_COMM_SIZE(MPI_COMM_ICE, get_num_procs, ierr)
120 :
121 : !-----------------------------------------------------------------------
122 :
123 72 : end function get_num_procs
124 :
125 : !***********************************************************************
126 :
127 0 : function get_rank()
128 :
129 : ! This function returns the number of processor assigned to
130 : ! MPI_COMM_ICE
131 :
132 : integer (int_kind) :: get_rank
133 :
134 : !-----------------------------------------------------------------------
135 : !
136 : ! local variables
137 : !
138 : !-----------------------------------------------------------------------
139 :
140 : integer (int_kind) :: ierr
141 : character(len=*), parameter :: subname = '(get_rank)'
142 :
143 : !-----------------------------------------------------------------------
144 :
145 0 : call MPI_COMM_RANK(MPI_COMM_ICE, get_rank, ierr)
146 :
147 : !-----------------------------------------------------------------------
148 :
149 0 : end function get_rank
150 :
151 : !***********************************************************************
152 :
153 72 : subroutine ice_barrier()
154 :
155 : ! This function calls an MPI_BARRIER
156 :
157 : !-----------------------------------------------------------------------
158 : !
159 : ! local variables
160 : !
161 : !-----------------------------------------------------------------------
162 :
163 : integer (int_kind) :: ierr
164 : character(len=*), parameter :: subname = '(ice_barrier)'
165 :
166 : !-----------------------------------------------------------------------
167 :
168 72 : call MPI_BARRIER(MPI_COMM_ICE, ierr)
169 :
170 : !-----------------------------------------------------------------------
171 :
172 72 : end subroutine ice_barrier
173 :
174 : !***********************************************************************
175 :
176 36 : subroutine create_communicator(new_comm, num_procs)
177 :
178 : ! This routine creates a separate communicator for a subset of
179 : ! processors under default ice communicator.
180 : !
181 : ! this routine should be called from init_domain1 when the
182 : ! domain configuration (e.g. nprocs_btrop) has been determined
183 :
184 : integer (int_kind), intent(in) :: &
185 : num_procs ! num of procs in new distribution
186 :
187 : integer (int_kind), intent(out) :: &
188 : new_comm ! new communicator for this distribution
189 :
190 : !-----------------------------------------------------------------------
191 : !
192 : ! local variables
193 : !
194 : !-----------------------------------------------------------------------
195 :
196 : integer (int_kind) :: &
197 : MPI_GROUP_ICE, &! group of processors assigned to ice ! LCOV_EXCL_LINE
198 : MPI_GROUP_NEW ! group of processors assigned to new dist
199 :
200 : integer (int_kind) :: &
201 : ierr ! error flag for MPI comms
202 :
203 : integer (int_kind), dimension(3,1) :: &
204 : range ! range of tasks assigned to new dist
205 : ! (assumed 0,num_procs-1)
206 :
207 : character(len=*), parameter :: subname = '(create_communicator)'
208 :
209 : !-----------------------------------------------------------------------
210 : !
211 : ! determine group of processes assigned to distribution
212 : !
213 : !-----------------------------------------------------------------------
214 :
215 36 : call MPI_COMM_GROUP (MPI_COMM_ICE, MPI_GROUP_ICE, ierr)
216 :
217 36 : range(1,1) = 0
218 36 : range(2,1) = num_procs-1
219 36 : range(3,1) = 1
220 :
221 : !-----------------------------------------------------------------------
222 : !
223 : ! create subroup and communicator for new distribution
224 : ! note: MPI_COMM_CREATE must be called by all procs in MPI_COMM_ICE
225 : !
226 : !-----------------------------------------------------------------------
227 :
228 : call MPI_GROUP_RANGE_INCL(MPI_GROUP_ICE, 1, range, &
229 36 : MPI_GROUP_NEW, ierr)
230 :
231 : call MPI_COMM_CREATE (MPI_COMM_ICE, MPI_GROUP_NEW, &
232 36 : new_comm, ierr)
233 :
234 : !-----------------------------------------------------------------------
235 :
236 72 : end subroutine create_communicator
237 :
238 : !***********************************************************************
239 :
240 : end module ice_communicate
241 :
242 : !|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
