1 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
2 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
3 | !----------------------------------------------------------------------- |
---|
4 | ! CVS m_ExchangeMaps.F90,v 1.19 2004-04-21 22:16:32 jacob Exp |
---|
5 | ! CVS MCT_2_8_0 |
---|
6 | !BOP ------------------------------------------------------------------- |
---|
7 | ! |
---|
8 | ! !MODULE: m_ExchangeMaps - Exchange of Global Mapping Objects. |
---|
9 | ! |
---|
10 | ! !DESCRIPTION: |
---|
11 | ! This module contains routines that support the exchange of domain |
---|
12 | ! decomposition descriptors (DDDs) between two MCT components. There is |
---|
13 | ! support for {\em handshaking} between the two components to determine |
---|
14 | ! the types of domain decomposition descriptors they employ, {\em loading} |
---|
15 | ! of data contained within domain decomposition descriptors, and {\em |
---|
16 | ! map exchange}, resulting in the creation of a remote component's domain |
---|
17 | ! decomposition descriptor for use by a local component. These routines |
---|
18 | ! are largely used by MCT's {\tt Router} to create intercomponent |
---|
19 | ! communications scheduler, and normally should not be used by an MCT |
---|
20 | ! user. |
---|
21 | ! |
---|
22 | ! Currently, the types of map exchange supported by the public routine |
---|
23 | ! {\tt ExchangeMap()} are summarized in the table below. The first column |
---|
24 | ! lists the type of DDD used locally on the component invoking |
---|
25 | ! {\tt ExchangeMap()} (i.e., the input DDD). The second comlumn lists |
---|
26 | ! the DDD type used on the remote component (i.e., the output DDD). |
---|
27 | !\begin{table}[htbp] |
---|
28 | !\begin{center} |
---|
29 | !\begin{tabular}{|c|c|} |
---|
30 | !\hline |
---|
31 | !{\bf Local DDD Type} & {\bf Remote DDD Type} \\ |
---|
32 | !\hline |
---|
33 | !{\tt GlobalMap} & {\tt GlobalSegMap} \\ |
---|
34 | !\hline |
---|
35 | !{\tt GlobalSegMap} & {\tt GlobalSegMap} \\ |
---|
36 | !\hline |
---|
37 | !\end{tabular} |
---|
38 | !\end{center} |
---|
39 | !\end{table} |
---|
40 | ! |
---|
41 | ! Currently, we do not support intercomponent map exchange where a |
---|
42 | ! {\tt GlobalMap} is output. The rationale for this is that any {\tt GlobalMap} |
---|
43 | ! may always be expressed as a {\tt GlobalSegMap}. |
---|
44 | ! |
---|
45 | ! !INTERFACE: |
---|
46 | |
---|
47 | module m_ExchangeMaps |
---|
48 | |
---|
49 | ! !USES: |
---|
50 | ! No external modules are used in the declaration section of this module. |
---|
51 | |
---|
52 | implicit none |
---|
53 | |
---|
54 | private ! except |
---|
55 | ! |
---|
56 | ! !PUBLIC MEMBER FUNCTIONS: |
---|
57 | ! |
---|
58 | public :: ExchangeMap |
---|
59 | |
---|
60 | interface ExchangeMap ; module procedure & |
---|
61 | ExGSMapGSMap_, & ! GlobalSegMap for GlobalSegMap |
---|
62 | ExGMapGSMap_ |
---|
63 | end interface |
---|
64 | |
---|
65 | ! !SEE ALSO: |
---|
66 | ! The MCT module m_ConvertMaps for more information regarding the |
---|
67 | ! relationship between the GlobalMap and GlobalSegMap types. |
---|
68 | ! The MCT module m_Router to see where these services are used to |
---|
69 | ! create intercomponent communications schedulers. |
---|
70 | ! |
---|
71 | ! !REVISION HISTORY: |
---|
72 | ! 3Feb01 - J.W. Larson <larson@mcs.anl.gov> - initial module |
---|
73 | ! 3Aug01 - E.T. Ong <eong@mcs.anl.gov> - in ExGSMapGSMap, |
---|
74 | ! call GlobalSegMap_init with actual shaped arrays |
---|
75 | ! for non-root processes to satisfy Fortran 90 standard. |
---|
76 | ! See comments in subroutine. |
---|
77 | ! 15Feb02 - R. Jacob <jacob@mcs.anl.gov> - use MCT_comm instead of |
---|
78 | ! MP_COMM_WORLD |
---|
79 | !EOP ___________________________________________________________________ |
---|
80 | ! |
---|
81 | character(len=*),parameter :: myname='MCT::m_ExchangeMaps' |
---|
82 | |
---|
83 | ! Map Handshaking Parameters: Map handshaking occurs via |
---|
84 | ! exchange of an array of INTEGER flags. |
---|
85 | |
---|
86 | ! Number of Handshaking Parameters; i.e.size of exhcanged parameters array |
---|
87 | |
---|
88 | integer, parameter :: NumHandshakePars = 4 |
---|
89 | |
---|
90 | ! ComponentIDIndex defines the storage location of the flag |
---|
91 | ! signifying the component number in MCTWorld |
---|
92 | |
---|
93 | integer, parameter :: ComponentIDIndex = 1 |
---|
94 | |
---|
95 | ! MapTypeIndex defines the storage location in the handshake array |
---|
96 | ! of the type of map offered for exchange |
---|
97 | |
---|
98 | integer, parameter :: MapTypeIndex = 2 |
---|
99 | |
---|
100 | ! NumMapTypes is the number of legitimate MapTypeIndex Values: |
---|
101 | |
---|
102 | integer, parameter :: NumMapTypes = 2 |
---|
103 | |
---|
104 | ! Recognized MapTypeIndex Values: |
---|
105 | |
---|
106 | integer, parameter :: GlobalMapFlag = 1 |
---|
107 | integer, parameter :: GlobalSegMapFlag = 2 |
---|
108 | |
---|
109 | ! GsizeIndex defines the location of the grid size (number of points) |
---|
110 | ! for the map. This size is |
---|
111 | |
---|
112 | integer, parameter :: GsizeIndex = 3 |
---|
113 | |
---|
114 | ! NumSegIndex defines the location of the number of segments in the |
---|
115 | ! map. For a GlobalMap, this is the number of processes in the map. |
---|
116 | ! For a GlobalSegMap, this is the number of global segments (ngseg). |
---|
117 | |
---|
118 | integer, parameter :: NumSegIndex = 4 |
---|
119 | |
---|
120 | contains |
---|
121 | |
---|
122 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
123 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
124 | !BOP ------------------------------------------------------------------- |
---|
125 | ! |
---|
126 | ! !IROUTINE: MapHandshake_ - Exchange Map descriptors. |
---|
127 | ! |
---|
128 | ! !DESCRIPTION: |
---|
129 | ! This routine takes input Map descriptors stored in the {\tt INTEGER} |
---|
130 | ! array {\tt LocalMapPars}, the local communicator on which this map is |
---|
131 | ! defined ({\tt LocalComm}), and the remote component ID |
---|
132 | ! {\tt RemoteCompID}, and effects an exchange of map descriptors with |
---|
133 | ! the remote component, which are returned in the {\tt INTEGER} array |
---|
134 | ! {\tt RemoteMapPars}. |
---|
135 | ! |
---|
136 | ! {\bf N.B.: } The values present in {\tt LocalMapPars} need to be valid |
---|
137 | ! only on the root of {\tt LocalComm}. Likewise, the returned values in |
---|
138 | ! {\tt RemoteMapPars} will be valid on the root of {\tt LocalComm}. |
---|
139 | ! |
---|
140 | ! !INTERFACE: |
---|
141 | |
---|
142 | subroutine MapHandshake_(LocalMapPars, LocalComm, RemoteCompID, & |
---|
143 | RemoteMapPars) |
---|
144 | |
---|
145 | ! |
---|
146 | ! !USES: |
---|
147 | ! |
---|
148 | use m_mpif90 |
---|
149 | use m_die, only : MP_perr_die |
---|
150 | use m_stdio |
---|
151 | use m_MCTWorld, only : ThisMCTWorld |
---|
152 | use m_MCTWorld, only : ComponentRootRank |
---|
153 | |
---|
154 | implicit none |
---|
155 | ! |
---|
156 | ! !INPUT PARAMETERS: |
---|
157 | ! |
---|
158 | integer, intent(in) :: LocalMapPars(NumHandshakePars) |
---|
159 | integer, intent(in) :: LocalComm |
---|
160 | integer, intent(in) :: RemoteCompID |
---|
161 | ! |
---|
162 | ! !OUTPUT PARAMETERS: |
---|
163 | ! |
---|
164 | integer, intent(out) :: RemoteMapPars(NumHandshakePars) |
---|
165 | |
---|
166 | ! !REVISION HISTORY: |
---|
167 | ! 6Feb01 - J.W. Larson <larson@mcs.anl.gov> - API specification. |
---|
168 | ! 20Apr01 - R.L. Jacob <jacob@mcs.anl.gov> - add status argument |
---|
169 | ! to MPI_RECV |
---|
170 | !EOP ___________________________________________________________________ |
---|
171 | |
---|
172 | character(len=*),parameter :: myname_=myname//'::MapHandshake_' |
---|
173 | |
---|
174 | integer :: ierr, myID, RemoteRootID, SendTag, RecvTag |
---|
175 | integer,dimension(MP_STATUS_SIZE) :: status |
---|
176 | |
---|
177 | call MP_COMM_RANK(LocalComm, myID, ierr) |
---|
178 | if(ierr /= 0) call MP_perr_die(myname_,'call MP_COMM_RANK()',ierr) |
---|
179 | |
---|
180 | RemoteRootID = ComponentRootRank(RemoteCompID, ThisMCTWorld) |
---|
181 | |
---|
182 | if(myID == 0) then ! I am the root on LocalComm |
---|
183 | |
---|
184 | ! Compute send/receive tags: |
---|
185 | |
---|
186 | SendTag = 10 * LocalMapPars(ComponentIDIndex) + RemoteCompID |
---|
187 | RecvTag = LocalMapPars(ComponentIDIndex) + 10 * RemoteCompID |
---|
188 | |
---|
189 | ! Post send to RemoteRootID: |
---|
190 | |
---|
191 | call MPI_SEND(LocalMapPars, NumHandshakePars, MP_INTEGER, & |
---|
192 | RemoteRootID, SendTag, ThisMCTWorld%MCT_comm, ierr) |
---|
193 | if(ierr /= 0) call MP_perr_die(myname_,'call MPI_SEND()',ierr) |
---|
194 | |
---|
195 | ! Post receive from RemoteRootID: |
---|
196 | |
---|
197 | call MPI_RECV(RemoteMapPars, NumHandshakePars, MP_INTEGER, & |
---|
198 | RemoteRootID, RecvTag, ThisMCTWorld%MCT_comm, status, ierr) |
---|
199 | if(ierr /= 0) call MP_perr_die(myname_,'call MPI_RECV()',ierr) |
---|
200 | |
---|
201 | endif ! if(myID == 0) |
---|
202 | |
---|
203 | end subroutine MapHandshake_ |
---|
204 | |
---|
205 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
206 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
207 | !BOP ------------------------------------------------------------------- |
---|
208 | ! |
---|
209 | ! !IROUTINE: LoadGlobalMapPars_ - Load GlobalMap descriptors. |
---|
210 | ! |
---|
211 | ! !DESCRIPTION: |
---|
212 | ! This routine takes an input {\tt GlobalMap} variable {\tt Gmap}, and |
---|
213 | ! loads its descriptors the output {\tt INTEGER} array {\tt MapPars}. |
---|
214 | ! The dimensions of this array, and loading order are all defined in |
---|
215 | ! the declaration section of this module. |
---|
216 | ! |
---|
217 | ! !INTERFACE: |
---|
218 | |
---|
219 | subroutine LoadGlobalMapPars_(GMap, MapPars) |
---|
220 | |
---|
221 | ! |
---|
222 | ! !USES: |
---|
223 | ! |
---|
224 | use m_mpif90 |
---|
225 | use m_die |
---|
226 | use m_stdio |
---|
227 | use m_GlobalMap, only : GlobalMap |
---|
228 | use m_GlobalMap, only : GlobalMap_comp_id => comp_id |
---|
229 | use m_GlobalMap, only : GlobalMap_gsize => gsize |
---|
230 | ! use m_GlobalMap, only : GlobalMap_nprocs => nprocs |
---|
231 | |
---|
232 | implicit none |
---|
233 | ! |
---|
234 | ! !INPUT PARAMETERS: |
---|
235 | ! |
---|
236 | type(GlobalMap), intent(in) :: GMap |
---|
237 | ! |
---|
238 | ! !OUTPUT PARAMETERS: |
---|
239 | ! |
---|
240 | integer, intent(out) :: MapPars(NumHandshakePars) |
---|
241 | |
---|
242 | ! !REVISION HISTORY: |
---|
243 | ! 6Feb01 - J.W. Larson <larson@mcs.anl.gov> - Initial version. |
---|
244 | !EOP ___________________________________________________________________ |
---|
245 | |
---|
246 | character(len=*),parameter :: myname_=myname//'::LoadGlobalMapPars_' |
---|
247 | |
---|
248 | MapPars(ComponentIDIndex) = GlobalMap_comp_id(GMap) |
---|
249 | MapPars(MapTypeIndex) = GlobalMapFlag |
---|
250 | MapPars(GsizeIndex) = GlobalMap_gsize(GMap) |
---|
251 | ! MapPars(NumSegIndex) = GlobalMap_nprocs(GSMap) |
---|
252 | |
---|
253 | end subroutine LoadGlobalMapPars_ |
---|
254 | |
---|
255 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
256 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
257 | !BOP ------------------------------------------------------------------- |
---|
258 | ! |
---|
259 | ! !IROUTINE: LoadGlobalSegMapPars_ - Load GlobalSegMap descriptors. |
---|
260 | ! |
---|
261 | ! !DESCRIPTION: |
---|
262 | ! This routine takes an input {\tt GlobalSegMap} variable {\tt Gmap}, and |
---|
263 | ! loads its descriptors the output {\tt INTEGER} array {\tt MapPars}. |
---|
264 | ! The dimensions of this array, and loading order are all defined in |
---|
265 | ! the declaration section of this module. |
---|
266 | ! |
---|
267 | ! !INTERFACE: |
---|
268 | |
---|
269 | subroutine LoadGlobalSegMapPars_(GSMap, MapPars) |
---|
270 | |
---|
271 | ! |
---|
272 | ! !USES: |
---|
273 | ! |
---|
274 | use m_mpif90 |
---|
275 | use m_die |
---|
276 | use m_stdio |
---|
277 | use m_GlobalSegMap, only : GlobalSegMap |
---|
278 | use m_GlobalSegMap, only : GlobalSegMap_comp_id => comp_id |
---|
279 | use m_GlobalSegMap, only : GlobalSegMap_gsize => gsize |
---|
280 | use m_GlobalSegMap, only : GlobalSegMap_ngseg => ngseg |
---|
281 | |
---|
282 | |
---|
283 | implicit none |
---|
284 | ! |
---|
285 | ! !INPUT PARAMETERS: |
---|
286 | ! |
---|
287 | type(GlobalSegMap), intent(in) :: GSMap |
---|
288 | ! |
---|
289 | ! !OUTPUT PARAMETERS: |
---|
290 | ! |
---|
291 | integer, intent(out) :: MapPars(NumHandshakePars) |
---|
292 | |
---|
293 | ! !REVISION HISTORY: |
---|
294 | ! 6Feb01 - J.W. Larson <larson@mcs.anl.gov> - Initial version. |
---|
295 | !EOP ___________________________________________________________________ |
---|
296 | |
---|
297 | character(len=*),parameter :: myname_=myname//'::LoadGlobalSegMapPars_' |
---|
298 | |
---|
299 | MapPars(ComponentIDIndex) = GlobalSegMap_comp_id(GSMap) |
---|
300 | MapPars(MapTypeIndex) = GlobalSegMapFlag |
---|
301 | MapPars(GsizeIndex) = GlobalSegMap_gsize(GSMap) |
---|
302 | MapPars(NumSegIndex) = GlobalSegMap_ngseg(GSMap) |
---|
303 | |
---|
304 | end subroutine LoadGlobalSegMapPars_ |
---|
305 | |
---|
306 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
307 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
308 | !BOP ------------------------------------------------------------------- |
---|
309 | ! |
---|
310 | ! !IROUTINE: ExGSMapGSMap_ - Trade of GlobalSegMap structures. |
---|
311 | ! |
---|
312 | ! !DESCRIPTION: |
---|
313 | ! This routine effects the exchange between two components of their |
---|
314 | ! data decomposition descriptors, each of which is a {\tt GlobalSegMap}. |
---|
315 | ! The component invoking this routine provides its domain decomposition |
---|
316 | ! in the form of the input {\tt GlobalSegMap} argument {\tt LocalGSMap}. |
---|
317 | ! The component with which map exchange takes place is specified by the |
---|
318 | ! MCT integer component identification number defined by the input |
---|
319 | ! {\tt INTEGER} argument {\tt RemoteCompID}. The |
---|
320 | ! !INTERFACE: |
---|
321 | |
---|
322 | subroutine ExGSMapGSMap_(LocalGSMap, LocalComm, RemoteGSMap, & |
---|
323 | RemoteCompID, ierr) |
---|
324 | |
---|
325 | ! |
---|
326 | ! !USES: |
---|
327 | ! |
---|
328 | use m_mpif90 |
---|
329 | use m_die |
---|
330 | use m_stdio |
---|
331 | use m_GlobalSegMap, only : GlobalSegMap |
---|
332 | use m_GlobalSegMap, only : GlobalSegMap_init => init |
---|
333 | |
---|
334 | use m_MCTWorld, only : ThisMCTWorld |
---|
335 | use m_MCTWorld, only : ComponentRootRank |
---|
336 | |
---|
337 | implicit none |
---|
338 | |
---|
339 | ! !INPUT PARAMETERS: |
---|
340 | |
---|
341 | type(GlobalSegMap), intent(in) :: LocalGSMap ! Local GlobalSegMap |
---|
342 | integer, intent(in) :: LocalComm ! Local Communicator |
---|
343 | integer , intent(in) :: RemoteCompID ! Remote component id |
---|
344 | |
---|
345 | ! !OUTPUT PARAMETERS: |
---|
346 | |
---|
347 | type(GlobalSegMap), intent(out) :: RemoteGSMap ! Remote GlobalSegMap |
---|
348 | integer, intent(out) :: ierr ! Error Flag |
---|
349 | |
---|
350 | ! !REVISION HISTORY: |
---|
351 | ! 3Feb01 - J.W. Larson <larson@mcs.anl.gov> - API specification. |
---|
352 | ! 7Feb01 - J.W. Larson <larson@mcs.anl.gov> - First full version. |
---|
353 | ! 20Apr01 - R.L. Jacob <jacob@mcs.anl.gov> - add status argument |
---|
354 | ! to MPI_RECV |
---|
355 | ! 25Apr01 - R.L. Jacob <jacob@mcs.anl.gov> - set SendTag and |
---|
356 | ! RecvTag values |
---|
357 | ! 3May01 - R.L. Jacob <jacob@mcs.anl.gov> - change MPI_SEND to |
---|
358 | ! MPI_ISEND to avoid possible buffering problems seen |
---|
359 | ! on IBM SP. |
---|
360 | !EOP ___________________________________________________________________ |
---|
361 | |
---|
362 | character(len=*),parameter :: myname_=myname//'::ExGSMapGSMap_' |
---|
363 | |
---|
364 | ! root ID on local communicator: |
---|
365 | integer, parameter :: root = 0 |
---|
366 | ! Storage for local and remote map descriptors: |
---|
367 | integer :: LocalMapPars(NumHandshakePars) |
---|
368 | integer :: RemoteMapPars(NumHandshakePars) |
---|
369 | ! Send and Receive Buffers |
---|
370 | integer, dimension(:), allocatable :: SendBuf |
---|
371 | integer, dimension(:), allocatable :: RecvBuf |
---|
372 | ! Send and Receive Tags |
---|
373 | integer :: SendTag, RecvTag |
---|
374 | ! Storage arrays for Remote GlobalSegMap data: |
---|
375 | integer, dimension(:), allocatable :: start, length, pe_loc |
---|
376 | |
---|
377 | integer :: myID, ngseg, remote_root,req |
---|
378 | integer :: local_ngseg, remote_ngseg |
---|
379 | integer,dimension(MP_STATUS_SIZE) :: status,wstatus |
---|
380 | |
---|
381 | ! Determine rank on local communicator: |
---|
382 | |
---|
383 | call MP_COMM_RANK(LocalComm, myID, ierr) |
---|
384 | if(ierr /= 0) call MP_perr_die(myname_,'call MP_COMM_RANK()',ierr) |
---|
385 | |
---|
386 | ! If the root, exchange map handshake descriptors, |
---|
387 | ! and information needed to initialize the remote map |
---|
388 | ! on the local communicator. |
---|
389 | |
---|
390 | if(myID == root) then |
---|
391 | |
---|
392 | call LoadGlobalSegMapPars_(LocalGSMap, LocalMapPars) |
---|
393 | |
---|
394 | call MapHandshake_(LocalMapPars, LocalComm, RemoteCompID, & |
---|
395 | RemoteMapPars) |
---|
396 | |
---|
397 | ! Consistency Checks between LocalMapPars and RemoteMapPars: |
---|
398 | |
---|
399 | if(LocalMapPars(MapTypeIndex) /= RemoteMapPars(MapTypeIndex)) then |
---|
400 | ierr = 2 |
---|
401 | write(stderr,*) myname_,":: MCTERROR, Map Type mismatch ", & |
---|
402 | "LocalMap Type = ",LocalMapPars(MapTypeIndex)," RemoteMap Type = ", & |
---|
403 | RemoteMapPars(MapTypeIndex) |
---|
404 | call die(myname_,'Map Type mismatch',ierr) |
---|
405 | endif |
---|
406 | |
---|
407 | if(LocalMapPars(GsizeIndex) /= RemoteMapPars(GsizeIndex)) then |
---|
408 | ierr = 3 |
---|
409 | write(stderr,*) myname_,":: MCTERROR, Grid Size mismatch ", & |
---|
410 | "LocalMap Gsize = ",LocalMapPars(GsizeIndex)," RemoteMap Gsize = ", & |
---|
411 | RemoteMapPars(GsizeIndex) |
---|
412 | call die(myname_,'Map Grid Size mismatch',ierr) |
---|
413 | endif |
---|
414 | |
---|
415 | if(RemoteCompID /= RemoteMapPars(ComponentIDIndex)) then |
---|
416 | ierr = 4 |
---|
417 | write(stderr,*) myname_,":: MCTERROR, Component ID mismatch ", & |
---|
418 | "RemoteCompID = ",RemoteCompID," RemoteMap CompID = ", & |
---|
419 | RemoteMapPars(ComponentIDIndex) |
---|
420 | call die(myname_,'Component ID mismatch',ierr) |
---|
421 | endif |
---|
422 | |
---|
423 | ! SendBuf will hold the arrays LocalGSMap%start, LocalGSMap%length, |
---|
424 | ! and LocalGSMap%pe_loc in that order. |
---|
425 | |
---|
426 | allocate(SendBuf(3*LocalMapPars(NumSegIndex)), stat=ierr) |
---|
427 | if(ierr /= 0) call die(myname_,'allocate(SendBuf...)',ierr) |
---|
428 | |
---|
429 | ! RecvBuf will hold the arrays RemoteGSMap%start, RemoteGSMap%length, |
---|
430 | ! and RemoteGSMap%pe_loc in that order. |
---|
431 | |
---|
432 | allocate(RecvBuf(3*RemoteMapPars(NumSegIndex)), stat=ierr) |
---|
433 | if(ierr /= 0) call die(myname_,'allocate(RecvBuf...)',ierr) |
---|
434 | |
---|
435 | ! Load SendBuf in the order described above: |
---|
436 | local_ngseg = LocalMapPars(NumSegIndex) |
---|
437 | SendBuf(1:local_ngseg) = & |
---|
438 | LocalGSMap%start(1:local_ngseg) |
---|
439 | SendBuf(local_ngseg+1:2*local_ngseg) = & |
---|
440 | LocalGSMap%length(1:local_ngseg) |
---|
441 | SendBuf(2*local_ngseg+1:3*local_ngseg) = & |
---|
442 | LocalGSMap%pe_loc(1:local_ngseg) |
---|
443 | |
---|
444 | ! Determine the remote component root: |
---|
445 | |
---|
446 | remote_root = ComponentRootRank(RemoteMapPars(ComponentIDIndex), & |
---|
447 | ThisMCTWorld) |
---|
448 | |
---|
449 | SendTag = 10 * LocalMapPars(ComponentIDIndex) + RemoteCompID |
---|
450 | RecvTag = LocalMapPars(ComponentIDIndex) + 10 * RemoteCompID |
---|
451 | |
---|
452 | ! Send off SendBuf to the remote component root: |
---|
453 | |
---|
454 | call MPI_ISEND(SendBuf(1), 3*LocalMapPars(NumSegIndex), MP_INTEGER, & |
---|
455 | remote_root, SendTag, ThisMCTWorld%MCT_comm, req, ierr) |
---|
456 | if(ierr /= 0) call MP_perr_die(myname_,'MPI_SEND(SendBuf...',ierr) |
---|
457 | |
---|
458 | ! Receive RecvBuf from the remote component root: |
---|
459 | |
---|
460 | call MPI_RECV(RecvBuf, 3*RemoteMapPars(NumSegIndex), MP_INTEGER, & |
---|
461 | remote_root, RecvTag, ThisMCTWorld%MCT_comm, status, ierr) |
---|
462 | if(ierr /= 0) call MP_perr_die(myname_,'MPI_Recv(RecvBuf...',ierr) |
---|
463 | |
---|
464 | call MPI_WAIT(req,wstatus,ierr) |
---|
465 | if(ierr /= 0) call MP_perr_die(myname_,'MPI_WAIT(SendBuf..',ierr) |
---|
466 | |
---|
467 | ! Allocate arrays start(:), length(:), and pe_loc(:) |
---|
468 | |
---|
469 | allocate(start(RemoteMapPars(NumSegIndex)), & |
---|
470 | length(RemoteMapPars(NumSegIndex)), & |
---|
471 | pe_loc(RemoteMapPars(NumSegIndex)), stat=ierr) |
---|
472 | if(ierr /= 0) call die(myname_,'allocate(start...',ierr) |
---|
473 | |
---|
474 | ! Unpack RecvBuf into arrays start(:), length(:), and pe_loc(:) |
---|
475 | remote_ngseg = RemoteMapPars(NumSegIndex) |
---|
476 | start(1:remote_ngseg) = RecvBuf(1:remote_ngseg) |
---|
477 | length(1:remote_ngseg) = & |
---|
478 | RecvBuf(remote_ngseg+1:2*remote_ngseg) |
---|
479 | pe_loc(1:remote_ngseg) = & |
---|
480 | RecvBuf(2*remote_ngseg+1:3*remote_ngseg) |
---|
481 | |
---|
482 | endif ! if(myID == root) |
---|
483 | |
---|
484 | ! Non-root processes call GlobalSegMap_init with start, |
---|
485 | ! length, and pe_loc, although these arguments are |
---|
486 | ! not used in the subroutine. Since these correspond to dummy |
---|
487 | ! shaped array arguments in GlobalSegMap_init, the Fortran 90 |
---|
488 | ! standard dictates that the actual arguments must contain |
---|
489 | ! complete shape information. Therefore, these array arguments |
---|
490 | ! must be allocated on all processes. |
---|
491 | |
---|
492 | if(myID /= root) then |
---|
493 | |
---|
494 | allocate(start(1), length(1), pe_loc(1), stat=ierr) |
---|
495 | if(ierr /= 0) call die(myname_,'non-root allocate(start...',ierr) |
---|
496 | |
---|
497 | endif |
---|
498 | |
---|
499 | |
---|
500 | ! Initialize the Remote GlobalSegMap RemoteGSMap |
---|
501 | |
---|
502 | call GlobalSegMap_init(RemoteGSMap, RemoteMapPars(NumSegIndex), & |
---|
503 | start, length, pe_loc, root, LocalComm, & |
---|
504 | RemoteCompID, RemoteMapPars(GsizeIndex)) |
---|
505 | |
---|
506 | |
---|
507 | ! Deallocate allocated arrays |
---|
508 | |
---|
509 | deallocate(start, length, pe_loc, stat=ierr) |
---|
510 | if(ierr /= 0) then |
---|
511 | call die(myname_,'deallocate(start...',ierr) |
---|
512 | endif |
---|
513 | |
---|
514 | ! Deallocate allocated arrays on the root: |
---|
515 | |
---|
516 | if(myID == root) then |
---|
517 | |
---|
518 | deallocate(SendBuf, RecvBuf, stat=ierr) |
---|
519 | if(ierr /= 0) then |
---|
520 | call die(myname_,'deallocate(SendBuf...',ierr) |
---|
521 | endif |
---|
522 | |
---|
523 | endif ! if(myID == root) |
---|
524 | |
---|
525 | end subroutine ExGSMapGSMap_ |
---|
526 | |
---|
527 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
528 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
529 | !BOP ------------------------------------------------------------------- |
---|
530 | ! |
---|
531 | ! !IROUTINE: ExGMapGSMap_ - Trade of GlobalMap for GlobalSegMap. |
---|
532 | ! |
---|
533 | ! !DESCRIPTION: |
---|
534 | ! This routine allows a component to report its domain decomposition |
---|
535 | ! using a {\tt GlobalMap} (the input argument {\tt LocalGMap}), and |
---|
536 | ! receive the domain decomposition of a remote component in the form |
---|
537 | ! of a {\tt GlobalSegMap} (the output argument {\tt RemoteGSMap}. The |
---|
538 | ! component with which map exchange occurs is defined by its component |
---|
539 | ! ID number (the input {\tt INTEGER} argument {\tt RemoteCompID}). |
---|
540 | ! Currently, this operation is implemented as an exchange of maps between |
---|
541 | ! the root nodes of each component's communicator, and then propagated |
---|
542 | ! across the local component's communicator. This requires the user to |
---|
543 | ! provide the local communicator (the input {\tt INTEGER} argument |
---|
544 | ! {\tt LocalComm}). The success (failure) of this operation is reported |
---|
545 | ! in the zero (nonzero) value of the output {\tt INTEGER} argument |
---|
546 | ! {\tt ierr}. |
---|
547 | ! |
---|
548 | ! !INTERFACE: |
---|
549 | |
---|
550 | subroutine ExGMapGSMap_(LocalGMap, LocalComm, RemoteGSMap, & |
---|
551 | RemoteCompID, ierr) |
---|
552 | |
---|
553 | ! |
---|
554 | ! !USES: |
---|
555 | ! |
---|
556 | use m_mpif90 |
---|
557 | use m_die |
---|
558 | use m_stdio |
---|
559 | |
---|
560 | use m_GlobalMap, only : GlobalMap |
---|
561 | |
---|
562 | use m_GlobalSegMap, only : GlobalSegMap |
---|
563 | use m_GlobalSegMap, only : GlobalSegMap_init => init |
---|
564 | use m_GlobalSegMap, only : GlobalSegMap_clean => clean |
---|
565 | |
---|
566 | use m_ConvertMaps, only : GlobalMapToGlobalSegMap |
---|
567 | |
---|
568 | implicit none |
---|
569 | |
---|
570 | ! !INPUT PARAMETERS: |
---|
571 | |
---|
572 | type(GlobalMap), intent(in) :: LocalGMap ! Local GlobalMap |
---|
573 | integer, intent(in) :: LocalComm ! Local Communicator |
---|
574 | integer, intent(in) :: RemoteCompID ! Remote component id |
---|
575 | |
---|
576 | |
---|
577 | ! !OUTPUT PARAMETERS: |
---|
578 | |
---|
579 | type(GlobalSegMap), intent(out) :: RemoteGSMap ! Remote GlobalSegMap |
---|
580 | integer, intent(out) :: ierr ! Error Flag |
---|
581 | |
---|
582 | ! !REVISION HISTORY: |
---|
583 | ! 3Feb01 - J.W. Larson <larson@mcs.anl.gov> - API specification. |
---|
584 | ! 26Sep02 - J.W. Larson <larson@mcs.anl.gov> - Implementation. |
---|
585 | !EOP ___________________________________________________________________ |
---|
586 | |
---|
587 | character(len=*),parameter :: myname_=myname//'::ExGMapGSMap_' |
---|
588 | type(GlobalSegMap) :: LocalGSMap |
---|
589 | |
---|
590 | ! Convert LocalGMap to a GlobalSegMap |
---|
591 | |
---|
592 | call GlobalMapToGlobalSegMap(LocalGMap, LocalGSMap) |
---|
593 | |
---|
594 | ! Exchange local decomposition in GlobalSegMap form with |
---|
595 | ! the remote component: |
---|
596 | |
---|
597 | call ExGSMapGSMap_(LocalGSMap, LocalComm, RemoteGSMap, & |
---|
598 | RemoteCompID, ierr) |
---|
599 | |
---|
600 | ! Destroy LocalGSMap |
---|
601 | |
---|
602 | call GlobalSegMap_clean(LocalGSMap) |
---|
603 | |
---|
604 | end subroutine ExGMapGSMap_ |
---|
605 | |
---|
606 | end module m_ExchangeMaps |
---|
607 | |
---|
608 | |
---|
609 | |
---|
610 | |
---|
611 | |
---|
612 | |
---|
613 | |
---|