1 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
2 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
3 | !----------------------------------------------------------------------- |
---|
4 | ! CVS m_GlobalMap.F90,v 1.11 2004-04-21 22:47:09 jacob Exp |
---|
5 | ! CVS MCT_2_8_0 |
---|
6 | !BOP ------------------------------------------------------------------- |
---|
7 | ! |
---|
8 | ! !MODULE: m_GlobalMap - One-Dimensional Domain Decomposition Descriptor |
---|
9 | ! |
---|
10 | ! !DESCRIPTION: |
---|
11 | ! The {\tt GlobalMap} is a datatype used to store descriptors of a |
---|
12 | ! one-dimensional domain decomposition for a vector on an MPI communicator. |
---|
13 | ! It is defined with three assumptions: |
---|
14 | ! \begin{enumerate} |
---|
15 | ! \item Each process ID owns only one segment; |
---|
16 | ! \item No two segments in the decomposition overlap; and |
---|
17 | ! \item The segments are laid out in identical order to the MPI rank of |
---|
18 | ! each process participating in the decomposition. |
---|
19 | ! \end{enumerate} |
---|
20 | ! per process ID). It is the simpler of the two domain decomposition |
---|
21 | ! descriptors offerd by MCT (the other being the {\tt GlobalSegMap}). |
---|
22 | ! It consists of the following components: |
---|
23 | ! \begin{itemize} |
---|
24 | ! \item The MCT component identification number (see the module |
---|
25 | ! {\tt m\_MCTWorld} for more information about MCT's component model |
---|
26 | ! registry); |
---|
27 | ! \item The {\em global} number of elements in the distributed vector; |
---|
28 | ! \item The number of elements {\em stored locally}; |
---|
29 | ! \item The number of elements {\em stored on each process} on the |
---|
30 | ! communicator over which the vector is distributed; and |
---|
31 | ! \item The index of the elemnent {\em immediately before} the starting |
---|
32 | ! element of each local segment (this choice allows for direct use of |
---|
33 | ! this information with MPI's scatter and gather operations). We refer |
---|
34 | ! to this quantity as the {\em displacement} of the segment, a term used |
---|
35 | ! both here and in the definition of the MCT {\tt Navigator} datatype. |
---|
36 | ! \end{itemize} |
---|
37 | ! |
---|
38 | ! Both the segment displacement and length data are stored in arrays |
---|
39 | ! whose indices run from zero to $N-1$, where $N$ is the number of MPI |
---|
40 | ! processes on the communicator on which the {\tt GlobalMap} is defined. |
---|
41 | ! This is done so this information corresponds directly to the MPI process |
---|
42 | ! ID's on whihc the segments reside. |
---|
43 | ! |
---|
44 | ! This module contains the definition of the {\tt GlobalMap} datatype, |
---|
45 | ! all-processor and an on-root creation methods (both of which can be |
---|
46 | ! used to create a {\tt GlobalMap} on the local communicator), a creation |
---|
47 | ! method to create/propagate a {\tt GlobalMap} native to a remote |
---|
48 | ! communicator, a destruction method, and a variety of query methods. |
---|
49 | ! |
---|
50 | ! !INTERFACE: |
---|
51 | |
---|
52 | module m_GlobalMap |
---|
53 | |
---|
54 | ! !USES |
---|
55 | ! No external modules are used in the declaration section of this module. |
---|
56 | |
---|
57 | implicit none |
---|
58 | |
---|
59 | private ! except |
---|
60 | |
---|
61 | ! !PUBLIC TYPES: |
---|
62 | |
---|
63 | public :: GlobalMap ! The class data structure |
---|
64 | |
---|
65 | Type GlobalMap |
---|
66 | integer :: comp_id ! Component ID number |
---|
67 | integer :: gsize ! the Global size |
---|
68 | integer :: lsize ! my local size |
---|
69 | integer,dimension(:),pointer :: counts ! all local sizes |
---|
70 | integer,dimension(:),pointer :: displs ! PE ordered locations |
---|
71 | End Type GlobalMap |
---|
72 | |
---|
73 | ! !PUBLIC MEMBER FUNCTIONS: |
---|
74 | |
---|
75 | public :: gsize |
---|
76 | public :: lsize |
---|
77 | public :: init |
---|
78 | public :: init_remote |
---|
79 | public :: clean |
---|
80 | public :: rank |
---|
81 | public :: bounds |
---|
82 | public :: comp_id |
---|
83 | |
---|
84 | interface gsize; module procedure gsize_; end interface |
---|
85 | interface lsize; module procedure lsize_; end interface |
---|
86 | interface init ; module procedure & |
---|
87 | initd_, & ! initialize from all PEs |
---|
88 | initr_ ! initialize from the root |
---|
89 | end interface |
---|
90 | interface init_remote; module procedure init_remote_; end interface |
---|
91 | interface clean; module procedure clean_; end interface |
---|
92 | interface rank ; module procedure rank_ ; end interface |
---|
93 | interface bounds; module procedure bounds_; end interface |
---|
94 | interface comp_id ; module procedure comp_id_ ; end interface |
---|
95 | |
---|
96 | ! !SEE ALSO: |
---|
97 | ! The MCT module m_MCTWorld for more information regarding component |
---|
98 | ! ID numbers. |
---|
99 | ! |
---|
100 | ! !REVISION HISTORY: |
---|
101 | ! 21Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code |
---|
102 | ! 9Nov00 - J.W. Larson <larson@mcs.anl.gov> - added init_remote |
---|
103 | ! interface. |
---|
104 | ! 26Jan01 - J.W. Larson <larson@mcs.anl.gov> - added storage for |
---|
105 | ! component ID number GlobalMap%comp_id, and associated |
---|
106 | ! method comp_id_() |
---|
107 | !EOP ___________________________________________________________________ |
---|
108 | |
---|
109 | character(len=*),parameter :: myname='MCT::m_GlobalMap' |
---|
110 | |
---|
111 | contains |
---|
112 | |
---|
113 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
114 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
115 | !BOP ------------------------------------------------------------------- |
---|
116 | ! |
---|
117 | ! !IROUTINE: initd_ - Collective Creation on the Local Communicator |
---|
118 | ! |
---|
119 | ! !DESCRIPTION: |
---|
120 | ! This routine creates the {\tt GlobalMap} {\tt GMap} from distributed |
---|
121 | ! data spread across the MPI communicatior associated with the input |
---|
122 | ! {\tt INTEGER} handle {\tt comm}. The {\tt INTEGER} input argument |
---|
123 | ! {\tt comp\_id} is used to define the MCT component ID for {\tt GMap}. |
---|
124 | ! The input {\tt INTEGER} argument {\tt ln} is the number of elements |
---|
125 | ! in the local vector segment. |
---|
126 | ! |
---|
127 | ! !INTERFACE: |
---|
128 | |
---|
129 | subroutine initd_(GMap, comp_id, ln, comm) |
---|
130 | |
---|
131 | ! !USES: |
---|
132 | |
---|
133 | use m_mpif90 |
---|
134 | use m_die |
---|
135 | |
---|
136 | implicit none |
---|
137 | |
---|
138 | ! !INPUT PARAMETERS: |
---|
139 | |
---|
140 | integer, intent(in) :: comp_id ! Component ID |
---|
141 | integer, intent(in) :: ln ! the local size |
---|
142 | integer, intent(in) :: comm ! f90 MPI communicator |
---|
143 | ! handle |
---|
144 | |
---|
145 | ! !OUTPUT PARAMETERS: |
---|
146 | |
---|
147 | type(GlobalMap), intent(out) :: GMap |
---|
148 | |
---|
149 | ! !SEE ALSO: |
---|
150 | ! The MCT module m_MCTWorld for more information regarding component |
---|
151 | ! ID numbers. |
---|
152 | ! |
---|
153 | ! !REVISION HISTORY: |
---|
154 | ! 21Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code |
---|
155 | !EOP ___________________________________________________________________ |
---|
156 | |
---|
157 | character(len=*),parameter :: myname_=myname//'::initd_' |
---|
158 | integer :: nPEs,myID,ier,l,i |
---|
159 | |
---|
160 | call MP_comm_size(comm,nPEs,ier) |
---|
161 | if(ier /= 0) call MP_perr_die(myname_,'MP_comm_size()',ier) |
---|
162 | |
---|
163 | call MP_comm_rank(comm,myID,ier) |
---|
164 | if(ier /= 0) call MP_perr_die(myname_,'MP_comm_rank()',ier) |
---|
165 | |
---|
166 | allocate(GMap%counts(0:nPEs-1),GMap%displs(0:nPEs-1),stat=ier) |
---|
167 | if(ier /= 0) call die(myname_,'allocate()',ier) |
---|
168 | |
---|
169 | #ifdef MALL_ON |
---|
170 | call mall_ci(size(transfer(GMap%counts,(/1/))),myname_) |
---|
171 | call mall_ci(size(transfer(GMap%displs,(/1/))),myname_) |
---|
172 | #endif |
---|
173 | |
---|
174 | call MPI_allgather(ln,1,MP_INTEGER,GMap%counts,1,MP_INTEGER,comm,ier) |
---|
175 | if(ier/=0) call MP_perr_die(myname_,'MPI_allgather()',ier) |
---|
176 | |
---|
177 | l=0 |
---|
178 | do i=0,nPEs-1 |
---|
179 | GMap%displs(i)=l |
---|
180 | l=l+GMap%counts(i) |
---|
181 | end do |
---|
182 | |
---|
183 | GMap%lsize=GMap%counts(myID) ! the local size |
---|
184 | GMap%gsize=l ! the global size |
---|
185 | GMap%comp_id = comp_id ! the component ID number |
---|
186 | |
---|
187 | end subroutine initd_ |
---|
188 | |
---|
189 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
190 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
191 | !BOP ------------------------------------------------------------------- |
---|
192 | ! |
---|
193 | ! !IROUTINE: initr_ Create a GlobalMap from the Root Process |
---|
194 | ! |
---|
195 | ! !DESCRIPTION: |
---|
196 | ! This routine creates the {\tt GlobalMap} {\tt GMap}, and propagates |
---|
197 | ! it to all processes on the communicator associated with the MPI |
---|
198 | ! {\tt INTEGER} handle {\tt comm}. The input {\tt INTEGER} arguments |
---|
199 | ! {\tt comp\_id} (the MCT component ID number) and {\tt lns(:)} need |
---|
200 | ! only be valid on the process whose rank is equal to {\tt root} on |
---|
201 | ! {\tt comm}. The array {\tt lns(:)} should have length equal to the |
---|
202 | ! number of processes on {\tt comm}, and contains the length of each |
---|
203 | ! local segment. |
---|
204 | ! |
---|
205 | ! !INTERFACE: |
---|
206 | |
---|
207 | subroutine initr_(GMap, comp_id, lns, root, comm) |
---|
208 | |
---|
209 | ! !USES: |
---|
210 | |
---|
211 | use m_mpif90 |
---|
212 | use m_die |
---|
213 | use m_stdio |
---|
214 | |
---|
215 | implicit none |
---|
216 | |
---|
217 | ! !INPUT PARAMETERS: |
---|
218 | |
---|
219 | integer, intent(in) :: comp_id ! component ID number |
---|
220 | integer, dimension(:), intent(in) :: lns ! segment lengths |
---|
221 | integer, intent(in) :: root ! root process ID |
---|
222 | integer, intent(in) :: comm ! communicator ID |
---|
223 | |
---|
224 | ! !OUTPUT PARAMETERS: |
---|
225 | |
---|
226 | type(GlobalMap), intent(out) :: GMap |
---|
227 | |
---|
228 | ! !SEE ALSO: |
---|
229 | ! The MCT module m_MCTWorld for more information regarding component |
---|
230 | ! ID numbers. |
---|
231 | ! |
---|
232 | ! !REVISION HISTORY: |
---|
233 | ! 29May98 - Jing Guo <guo@thunder> - initial prototype/prolog/code |
---|
234 | !EOP ___________________________________________________________________ |
---|
235 | |
---|
236 | character(len=*),parameter :: myname_=myname//'::initr_' |
---|
237 | integer :: nPEs,myID,ier,l,i |
---|
238 | |
---|
239 | call MP_comm_size(comm,nPEs,ier) |
---|
240 | if(ier /= 0) call MP_perr_die(myname_,'MP_comm_size()',ier) |
---|
241 | |
---|
242 | call MP_comm_rank(comm,myID,ier) |
---|
243 | if(ier /= 0) call MP_perr_die(myname_,'MP_comm_rank()',ier) |
---|
244 | |
---|
245 | allocate(GMap%counts(0:nPEs-1),GMap%displs(0:nPEs-1),stat=ier) |
---|
246 | if(ier /= 0) call die(myname_,'allocate()',ier) |
---|
247 | |
---|
248 | #ifdef MALL_ON |
---|
249 | call mall_ci(size(transfer(GMap%counts,(/1/))),myname_) |
---|
250 | call mall_ci(size(transfer(GMap%displs,(/1/))),myname_) |
---|
251 | #endif |
---|
252 | |
---|
253 | if(myID == root) then |
---|
254 | if(size(lns(:)) /= nPEs) then |
---|
255 | write(stderr,'(2a,2(a,i4))') myname_, & |
---|
256 | ': _root_ argument error', & |
---|
257 | ', size(lns) =',size(lns), & |
---|
258 | ', nPEs =',nPEs |
---|
259 | call die(myname_) |
---|
260 | endif |
---|
261 | |
---|
262 | GMap%counts(:)=lns(:) |
---|
263 | endif |
---|
264 | |
---|
265 | call MPI_bcast(GMap%counts, nPEs, MP_INTEGER, root, comm, ier) |
---|
266 | if(ier/=0) call MP_perr_die(myname_,'MPI_bcast()',ier) |
---|
267 | |
---|
268 | ! on each process, use GMap%counts(:) to compute GMap%displs(:) |
---|
269 | |
---|
270 | l=0 |
---|
271 | do i=0,nPEs-1 |
---|
272 | GMap%displs(i)=l |
---|
273 | l=l+GMap%counts(i) |
---|
274 | end do |
---|
275 | |
---|
276 | GMap%lsize=GMap%counts(myID) ! the local size |
---|
277 | GMap%gsize=l ! the global size |
---|
278 | |
---|
279 | ! finally, set and broadcast the component ID number GMap%comp_id |
---|
280 | |
---|
281 | if(myID == root) GMap%comp_id = comp_id |
---|
282 | |
---|
283 | call MPI_bcast(GMap%comp_id,1,MP_INTEGER,root,comm,ier) |
---|
284 | if(ier/=0) call MP_perr_die(myname_,'MPI_bcast()',ier) |
---|
285 | |
---|
286 | end subroutine initr_ |
---|
287 | |
---|
288 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
289 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
290 | !BOP ------------------------------------------------------------------- |
---|
291 | ! |
---|
292 | ! !IROUTINE: init_remote_ Initialize Remote GlobalMap from the Root |
---|
293 | ! |
---|
294 | ! !DESCRIPTION: |
---|
295 | ! This routine creates and propagates across the local communicator a |
---|
296 | ! {\tt GlobalMap} associated with a remote component. The controlling |
---|
297 | ! process in this operation has MPI process ID defined by the input |
---|
298 | ! {\tt INTEGER} argument {\tt my\_root}, and its MPI communinicator |
---|
299 | ! is defined by the input {\tt INTEGER} argument {\tt my\_comm}. The |
---|
300 | ! input {\tt INTEGER} argument {\tt remote\_npes} is the number of MPI |
---|
301 | ! processes on the remote component's communicator (which need be valid |
---|
302 | ! only on the process {\tt my\_root}). The input the {\tt INTEGER} |
---|
303 | ! array {\tt remote\_lns(:)}, and the {\tt INTEGER} argument |
---|
304 | ! {\tt remote\_comp\_id} need only be valid on the process |
---|
305 | ! whose rank on the communicator {\tt my\_comm} is {\tt my\_root}. The |
---|
306 | ! argument {\tt remote\_lns(:)} defines the vector segment length on each |
---|
307 | ! process of the remote component's communicator, and the argument |
---|
308 | ! {\tt remote\_comp\_id} defines the remote component's ID number in |
---|
309 | ! the MCT component registry {\tt MCTWorld}. |
---|
310 | ! |
---|
311 | ! !INTERFACE: |
---|
312 | |
---|
313 | subroutine init_remote_(GMap, remote_lns, remote_npes, my_root, & |
---|
314 | my_comm, remote_comp_id) |
---|
315 | ! !USES: |
---|
316 | |
---|
317 | use m_mpif90 |
---|
318 | use m_die |
---|
319 | use m_stdio |
---|
320 | |
---|
321 | implicit none |
---|
322 | |
---|
323 | ! !INPUT PARAMETERS: |
---|
324 | |
---|
325 | integer, dimension(:), intent(in) :: remote_lns |
---|
326 | integer, intent(in) :: remote_npes |
---|
327 | integer, intent(in) :: my_root |
---|
328 | integer, intent(in) :: my_comm |
---|
329 | integer, intent(in) :: remote_comp_id |
---|
330 | |
---|
331 | ! !OUTPUT PARAMETERS: |
---|
332 | |
---|
333 | type(GlobalMap), intent(out) :: GMap |
---|
334 | |
---|
335 | ! !SEE ALSO: |
---|
336 | ! The MCT module m_MCTWorld for more information regarding component |
---|
337 | ! ID numbers. |
---|
338 | ! |
---|
339 | ! !REVISION HISTORY: |
---|
340 | ! 8Nov00 - J.W. Larson <larson@mcs.anl.gov> - initial prototype |
---|
341 | ! 26Jan01 - J.W. Larson <larson@mcs.anl.gov> - slight change--remote |
---|
342 | ! communicator is replaced by remote component ID number |
---|
343 | ! in argument remote_comp_id. |
---|
344 | !EOP ___________________________________________________________________ |
---|
345 | |
---|
346 | character(len=*),parameter :: myname_=myname//'::init_remote_' |
---|
347 | integer :: nPEs,myID,ier,l,i |
---|
348 | |
---|
349 | |
---|
350 | ! Which processor am I on communicator my_comm? Store |
---|
351 | ! the answer in myID: |
---|
352 | |
---|
353 | call MP_comm_rank(my_comm, myID, ier) |
---|
354 | if(ier /= 0) call MP_perr_die(myname_,'MP_comm_rank()',ier) |
---|
355 | |
---|
356 | ! allocate counts and displacements component arrays |
---|
357 | ! for the sake of compactness, store the value of remote_npes |
---|
358 | ! in the more tersely named variable nPEs. |
---|
359 | |
---|
360 | if(myID == my_root) nPEs = remote_npes |
---|
361 | |
---|
362 | call MPI_bcast(nPEs, 1, MP_INTEGER, my_root, my_comm, ier) |
---|
363 | if(ier/=0) call MP_perr_die(myname_,'MPI_bcast(nPEs...)',ier) |
---|
364 | |
---|
365 | allocate(GMap%counts(0:nPEs-1),GMap%displs(0:nPEs-1),stat=ier) |
---|
366 | if(ier /= 0) call die(myname_,'allocate()',ier) |
---|
367 | |
---|
368 | #ifdef MALL_ON |
---|
369 | call mall_ci(size(transfer(GMap%counts,(/1/))),myname_) |
---|
370 | call mall_ci(size(transfer(GMap%displs,(/1/))),myname_) |
---|
371 | #endif |
---|
372 | |
---|
373 | ! On the Root processor, check the size of remote_lns(:) |
---|
374 | ! to see it is equal to nPEs, the number of remote processes, |
---|
375 | ! then store it as GMap%counts and broadcast it. |
---|
376 | |
---|
377 | if(myID == my_root) then |
---|
378 | if(size(remote_lns(:)) /= nPEs) then |
---|
379 | write(stderr,'(2a,2(a,i4))') myname_, & |
---|
380 | ': _root_ argument error', & |
---|
381 | ', size(remote_lns) =',size(remote_lns), & |
---|
382 | ', nPEs =',nPEs |
---|
383 | call die(myname_) |
---|
384 | endif |
---|
385 | |
---|
386 | GMap%counts(:)=remote_lns(:) |
---|
387 | endif |
---|
388 | |
---|
389 | call MPI_bcast(GMap%counts, nPEs, MP_INTEGER, my_root, my_comm, ier) |
---|
390 | if(ier/=0) call MP_perr_die(myname_,'MPI_bcast()',ier) |
---|
391 | |
---|
392 | ! Now, on each processor of my_comm, compute from |
---|
393 | ! GMap%counts(:) the entries of GMap%displs(:) |
---|
394 | |
---|
395 | l=0 |
---|
396 | do i=0,nPEs-1 |
---|
397 | GMap%displs(i)=l |
---|
398 | l=l+GMap%counts(i) |
---|
399 | end do |
---|
400 | |
---|
401 | GMap%lsize = -1 ! In this case, the local size is invalid!!! |
---|
402 | GMap%gsize = l ! the global size |
---|
403 | |
---|
404 | ! Finally, set GMap's component ID (recall only the value on |
---|
405 | ! process my_root is valid). |
---|
406 | |
---|
407 | if(myID == my_root) GMap%comp_id = remote_comp_id |
---|
408 | call MPI_bcast(GMap%comp_id, 1, MP_INTEGER, my_root, my_comm,ier) |
---|
409 | if(ier/=0) call MP_perr_die(myname_,'MPI_bcast(GMap%comp_id...)',ier) |
---|
410 | |
---|
411 | end subroutine init_remote_ |
---|
412 | |
---|
413 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
414 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
415 | !BOP ------------------------------------------------------------------- |
---|
416 | ! |
---|
417 | ! !IROUTINE: clean_ - Destroy a GlobalMap |
---|
418 | ! |
---|
419 | ! !DESCRIPTION: |
---|
420 | ! This routine deallocates all allocated memory associated with the |
---|
421 | ! input/output {\tt GlobalMap} argument {\tt GMap}, and sets to zero |
---|
422 | ! all of its statically defined components. The success (failure) of |
---|
423 | ! this operation is signified by the zero (non-zero) value of the |
---|
424 | ! optional output {\tt INTEGER} argument {\tt stat}. |
---|
425 | ! |
---|
426 | ! !INTERFACE: |
---|
427 | |
---|
428 | subroutine clean_(GMap, stat) |
---|
429 | |
---|
430 | ! !USES: |
---|
431 | |
---|
432 | use m_die |
---|
433 | |
---|
434 | implicit none |
---|
435 | |
---|
436 | ! !INPUT/OUTPUT PARAMETERS: |
---|
437 | |
---|
438 | type(GlobalMap), intent(inout) :: GMap |
---|
439 | |
---|
440 | ! !OUTPUT PARAMETERS: |
---|
441 | |
---|
442 | integer, optional, intent(out) :: stat |
---|
443 | |
---|
444 | ! !REVISION HISTORY: |
---|
445 | ! 21Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code |
---|
446 | ! 26Jan01 - J. Larson <larson@mcs.anl.gov> incorporated comp_id. |
---|
447 | ! 1Mar02 - E.T. Ong <eong@mcs.anl.gov> removed the die to prevent |
---|
448 | ! crashes and added stat argument. |
---|
449 | !EOP ___________________________________________________________________ |
---|
450 | |
---|
451 | character(len=*),parameter :: myname_=myname//'::clean_' |
---|
452 | integer :: ier |
---|
453 | |
---|
454 | deallocate(GMap%counts,GMap%displs,stat=ier) |
---|
455 | |
---|
456 | if(present(stat)) then |
---|
457 | stat=ier |
---|
458 | else |
---|
459 | if(ier /= 0) call warn(myname_,'deallocate(GMap%...)',ier) |
---|
460 | endif |
---|
461 | |
---|
462 | if(ier == 0) then |
---|
463 | |
---|
464 | #ifdef MALL_ON |
---|
465 | call mall_co(size(transfer(GMap%counts,(/1/))),myname_) |
---|
466 | call mall_co(size(transfer(GMap%displs,(/1/))),myname_) |
---|
467 | #endif |
---|
468 | |
---|
469 | endif |
---|
470 | |
---|
471 | GMap%lsize = 0 |
---|
472 | GMap%gsize = 0 |
---|
473 | GMap%comp_id = 0 |
---|
474 | |
---|
475 | end subroutine clean_ |
---|
476 | |
---|
477 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
478 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
479 | !BOP ------------------------------------------------------------------- |
---|
480 | ! |
---|
481 | ! !IROUTINE: lsize_ - Return Local Segment Length |
---|
482 | ! |
---|
483 | ! !DESCRIPTION: |
---|
484 | ! This {\tt INTEGER} function returns the length of the local vector |
---|
485 | ! segment as defined by the input {\tt GlobalMap} argument {\tt GMap}. |
---|
486 | |
---|
487 | ! !INTERFACE: |
---|
488 | |
---|
489 | integer function lsize_(GMap) |
---|
490 | |
---|
491 | ! !USES: |
---|
492 | |
---|
493 | implicit none |
---|
494 | |
---|
495 | ! !INPUT PARAMETERS: |
---|
496 | |
---|
497 | type(GlobalMap), intent(in) :: GMap |
---|
498 | |
---|
499 | ! !REVISION HISTORY: |
---|
500 | ! 21Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code |
---|
501 | !EOP ___________________________________________________________________ |
---|
502 | |
---|
503 | character(len=*),parameter :: myname_=myname//'::lsize_' |
---|
504 | |
---|
505 | lsize_=GMap%lsize |
---|
506 | |
---|
507 | end function lsize_ |
---|
508 | |
---|
509 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
510 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
511 | !BOP ------------------------------------------------------------------- |
---|
512 | ! |
---|
513 | ! !IROUTINE: gsize_ - Return Global Vector Length |
---|
514 | ! |
---|
515 | ! !DESCRIPTION: |
---|
516 | ! This {\tt INTEGER} function returns the global length of a vector |
---|
517 | ! that is decomposed according to the input {\tt GlobalMap} argument |
---|
518 | ! {\tt GMap}. |
---|
519 | ! |
---|
520 | ! !INTERFACE: |
---|
521 | |
---|
522 | integer function gsize_(GMap) |
---|
523 | |
---|
524 | ! !USES: |
---|
525 | |
---|
526 | implicit none |
---|
527 | |
---|
528 | ! !INPUT PARAMETERS: |
---|
529 | |
---|
530 | type(GlobalMap), intent(in) :: GMap |
---|
531 | |
---|
532 | |
---|
533 | ! !REVISION HISTORY: |
---|
534 | ! 21Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code |
---|
535 | !EOP ___________________________________________________________________ |
---|
536 | |
---|
537 | character(len=*),parameter :: myname_=myname//'::gsize_' |
---|
538 | |
---|
539 | gsize_=GMap%gsize |
---|
540 | |
---|
541 | end function gsize_ |
---|
542 | |
---|
543 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
544 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
545 | !BOP ------------------------------------------------------------------- |
---|
546 | ! |
---|
547 | ! !IROUTINE: rank_ - Process ID Location of a Given Vector Element |
---|
548 | ! |
---|
549 | ! !DESCRIPTION: |
---|
550 | ! This routine uses the input {\tt GlobalMap} argument {\tt GMap} to |
---|
551 | ! determine the process ID (on the communicator on which {\tt GMap} was |
---|
552 | ! defined) of the vector element with global index {\tt i\_g}. This |
---|
553 | ! process ID is returned in the output {\tt INTEGER} argument {\tt rank}. |
---|
554 | ! |
---|
555 | ! !INTERFACE: |
---|
556 | |
---|
557 | subroutine rank_(GMap, i_g, rank) |
---|
558 | |
---|
559 | ! !USES: |
---|
560 | |
---|
561 | implicit none |
---|
562 | |
---|
563 | ! !INPUT PARAMETERS: |
---|
564 | |
---|
565 | type(GlobalMap), intent(in) :: GMap |
---|
566 | integer, intent(in) :: i_g |
---|
567 | |
---|
568 | ! !OUTPUT PARAMETERS: |
---|
569 | |
---|
570 | integer, intent(out) :: rank |
---|
571 | |
---|
572 | ! !REVISION HISTORY: |
---|
573 | ! 5May98 - Jing Guo <guo@thunder> - initial prototype/prolog/code |
---|
574 | !EOP ___________________________________________________________________ |
---|
575 | |
---|
576 | character(len=*),parameter :: myname_=myname//'::rank_' |
---|
577 | integer :: i,ilc,ile |
---|
578 | |
---|
579 | rank=-1 ! if nowhere fits |
---|
580 | do i=0,size(GMap%displs)-1 |
---|
581 | ilc=GMap%displs(i) |
---|
582 | ile=ilc+GMap%counts(i) |
---|
583 | |
---|
584 | ! If i_g in (ilc,ile]. Note that i_g := [1:..] |
---|
585 | |
---|
586 | if(ilc < i_g .and. i_g <= ile) then |
---|
587 | rank=i |
---|
588 | return |
---|
589 | endif |
---|
590 | end do |
---|
591 | |
---|
592 | end subroutine rank_ |
---|
593 | |
---|
594 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
595 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
596 | !BOP ------------------------------------------------------------------- |
---|
597 | ! |
---|
598 | ! !IROUTINE: bounds_ - First/Last Global Indicies for a Process' Segment |
---|
599 | ! |
---|
600 | ! !DESCRIPTION: |
---|
601 | ! This routine takes as input a process ID (defined by the input |
---|
602 | ! {\tt INTEGER} argument {\tt pe\_no}), examines the input {\tt GlobalMap} |
---|
603 | ! argument {\tt GMap}, and returns the global indices for the first and |
---|
604 | ! last elements of the segment owned by this process in the output |
---|
605 | ! {\tt INTEGER} arguments {\tt lbnd} and {\tt ubnd}, respectively. |
---|
606 | ! |
---|
607 | ! !INTERFACE: |
---|
608 | |
---|
609 | subroutine bounds_(GMap, pe_no, lbnd, ubnd) |
---|
610 | |
---|
611 | ! !USES: |
---|
612 | |
---|
613 | implicit none |
---|
614 | |
---|
615 | ! !INPUT PARAMETERS: |
---|
616 | |
---|
617 | type(GlobalMap), intent(in) :: GMap |
---|
618 | integer, intent(in) :: pe_no |
---|
619 | |
---|
620 | ! !OUTPUT PARAMETERS: |
---|
621 | |
---|
622 | integer, intent(out) :: lbnd |
---|
623 | integer, intent(out) :: ubnd |
---|
624 | |
---|
625 | ! !REVISION HISTORY: |
---|
626 | ! 30Jan01 - J. Larson <larson@mcs.anl.gov> - initial code |
---|
627 | !EOP ___________________________________________________________________ |
---|
628 | |
---|
629 | character(len=*),parameter :: myname_=myname//'::bounds_' |
---|
630 | |
---|
631 | lbnd = GMap%displs(pe_no) + 1 |
---|
632 | ubnd = lbnd + GMap%counts(pe_no) - 1 |
---|
633 | |
---|
634 | end subroutine bounds_ |
---|
635 | |
---|
636 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
637 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
638 | !BOP ------------------------------------------------------------------- |
---|
639 | ! |
---|
640 | ! !IROUTINE: comp_id_ - Return the Component ID Number |
---|
641 | ! |
---|
642 | ! !DESCRIPTION: |
---|
643 | ! This {\tt INTEGER} query function returns the MCT component ID number |
---|
644 | ! stored in the input {\tt GlobalMap} argument {\tt GMap}. |
---|
645 | ! |
---|
646 | ! !INTERFACE: |
---|
647 | |
---|
648 | integer function comp_id_(GMap) |
---|
649 | |
---|
650 | ! !USES: |
---|
651 | |
---|
652 | implicit none |
---|
653 | |
---|
654 | ! !INPUT PARAMETERS: |
---|
655 | |
---|
656 | type(GlobalMap), intent(in) :: GMap |
---|
657 | |
---|
658 | ! !SEE ALSO: |
---|
659 | ! The MCT module m_MCTWorld for more information regarding component |
---|
660 | ! ID numbers. |
---|
661 | ! |
---|
662 | ! !REVISION HISTORY: |
---|
663 | ! 25Jan02 - J. Larson <larson@mcs.anl.gov> - initial version |
---|
664 | !EOP ___________________________________________________________________ |
---|
665 | |
---|
666 | character(len=*),parameter :: myname_=myname//'::comp_id_' |
---|
667 | |
---|
668 | comp_id_ = GMap%comp_id |
---|
669 | |
---|
670 | end function comp_id_ |
---|
671 | |
---|
672 | end module m_GlobalMap |
---|