1 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
2 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
3 | !----------------------------------------------------------------------- |
---|
4 | ! CVS m_GlobalToLocal.F90,v 1.16 2006-04-20 23:54:48 rloy Exp |
---|
5 | ! CVS MCT_2_8_0 |
---|
6 | !BOP ------------------------------------------------------------------- |
---|
7 | ! |
---|
8 | ! !MODULE: m_GlobalToLocal - Global to Local Index Translation |
---|
9 | ! |
---|
10 | ! !DESCRIPTION: |
---|
11 | ! This module contains routines for translating global array indices |
---|
12 | ! into their local counterparts (that is, the indices into the local |
---|
13 | ! data structure holding a given process' chunk of a distributed array). |
---|
14 | ! The MCT domain decomposition descriptors {\tt GlobalMap} and |
---|
15 | ! {\tt GlobalSegMap} are both supported. Indices can be translated |
---|
16 | ! one-at-a-time using the {\tt GlobalToLocalIndex} routine or many |
---|
17 | ! at once using the {\tt GlobalToLocalIndices} routine. |
---|
18 | ! |
---|
19 | ! This module also provides facilities for setting the local row and |
---|
20 | ! column indices for a {\tt SparseMatrix} through the |
---|
21 | ! {\tt GlobalToLocalMatrix} routines. |
---|
22 | ! |
---|
23 | ! !INTERFACE: |
---|
24 | |
---|
25 | module m_GlobalToLocal |
---|
26 | |
---|
27 | ! !USES: |
---|
28 | ! No external modules are used in the declaration section of this module. |
---|
29 | |
---|
30 | implicit none |
---|
31 | |
---|
32 | private ! except |
---|
33 | |
---|
34 | ! !PUBLIC MEMBER FUNCTIONS: |
---|
35 | |
---|
36 | public :: GlobalToLocalIndex ! Translate Global to Local index |
---|
37 | ! (i.e. recover local index for a |
---|
38 | ! point from its global index). |
---|
39 | |
---|
40 | public :: GlobalToLocalIndices ! Translate Global to Local indices |
---|
41 | ! (i.e. recover local starts/lengths |
---|
42 | ! of distributed data segments). |
---|
43 | |
---|
44 | public :: GlobalToLocalMatrix ! Re-indexing of row or column |
---|
45 | ! indices for a SparseMatrix |
---|
46 | |
---|
47 | interface GlobalToLocalIndices ; module procedure & |
---|
48 | GlobalSegMapToIndices_, & ! local arrays of starts/lengths |
---|
49 | GlobalSegMapToNavigator_, & ! return local indices as Navigator |
---|
50 | GlobalSegMapToIndexArr_ |
---|
51 | end interface |
---|
52 | |
---|
53 | interface GlobalToLocalIndex ; module procedure & |
---|
54 | GlobalSegMapToIndex_, & |
---|
55 | GlobalMapToIndex_ |
---|
56 | end interface |
---|
57 | |
---|
58 | interface GlobalToLocalMatrix ; module procedure & |
---|
59 | GlobalSegMapToLocalMatrix_ |
---|
60 | end interface |
---|
61 | |
---|
62 | |
---|
63 | ! !SEE ALSO: |
---|
64 | ! |
---|
65 | ! The MCT modules {\tt m\_GlobalMap} and {m\_GlobalSegMap} for more |
---|
66 | ! information regarding MCT's domain decomposition descriptors. |
---|
67 | ! |
---|
68 | ! The MCT module {\tt m\_SparseMatrix} for more information regarding |
---|
69 | ! the {\tt SparseMatrix} datatype. |
---|
70 | ! |
---|
71 | ! !REVISION HISTORY: |
---|
72 | ! 2Feb01 - J.W. Larson <larson@mcs.anl.gov> - initial prototype |
---|
73 | !EOP ___________________________________________________________________ |
---|
74 | |
---|
75 | character(len=*),parameter :: myname='MCT::m_GlobalToLocal' |
---|
76 | |
---|
77 | contains |
---|
78 | |
---|
79 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
80 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
81 | !BOP ------------------------------------------------------------------- |
---|
82 | ! |
---|
83 | ! !IROUTINE: GlobalSegMapToIndices_ - Return _local_ indices in arrays. |
---|
84 | ! |
---|
85 | ! !DESCRIPTION: {\tt GlobalSegMapToIndices\_()} takes a user-supplied |
---|
86 | ! {\tt GlobalSegMap} data type {\tt GSMap}, which desribes a decomposition |
---|
87 | ! on the input MPI communicator corresponding to the Fortran {\tt INTEGER} |
---|
88 | ! handle {\tt comm} to translate the global directory of segment locations |
---|
89 | ! into local indices for referencing the on-pe storage of the mapped |
---|
90 | ! distributed data. |
---|
91 | ! |
---|
92 | ! {\bf N.B.:} This routine returns two allocated arrays---{\tt start(:)} |
---|
93 | ! and {\tt length(:)}---which must be deallocated once the user no longer |
---|
94 | ! needs them. Failure to do this will create a memory leak. |
---|
95 | ! |
---|
96 | ! !INTERFACE: |
---|
97 | |
---|
98 | subroutine GlobalSegMapToIndices_(GSMap, comm, start, length) |
---|
99 | |
---|
100 | ! |
---|
101 | ! !USES: |
---|
102 | ! |
---|
103 | use m_mpif90 |
---|
104 | use m_die, only : MP_perr_die, die, warn |
---|
105 | use m_GlobalSegMap, only : GlobalSegMap |
---|
106 | use m_GlobalSegMap, only : GlobalSegMap_ngseg => ngseg |
---|
107 | use m_GlobalSegMap, only : GlobalSegMap_nlseg => nlseg |
---|
108 | |
---|
109 | implicit none |
---|
110 | |
---|
111 | ! !INPUT PARAMETERS: |
---|
112 | |
---|
113 | type(GlobalSegMap), intent(in) :: GSMap ! Output GlobalSegMap |
---|
114 | integer, intent(in) :: comm ! communicator handle |
---|
115 | |
---|
116 | ! !OUTPUT PARAMETERS: |
---|
117 | |
---|
118 | integer,dimension(:), pointer :: start ! local segment start indices |
---|
119 | integer,dimension(:), pointer :: length ! local segment sizes |
---|
120 | |
---|
121 | ! !REVISION HISTORY: |
---|
122 | ! 2Feb01 - J.W. Larson <larson@mcs.anl.gov> - initial version |
---|
123 | !EOP ___________________________________________________________________ |
---|
124 | |
---|
125 | character(len=*),parameter :: myname_=myname//'::GlobalSegMapToIndices_' |
---|
126 | |
---|
127 | integer :: myID, ierr, ngseg, nlseg, n, count |
---|
128 | |
---|
129 | ! determine local process id myID |
---|
130 | |
---|
131 | call MP_COMM_RANK(comm, myID, ierr) |
---|
132 | if(ierr /= 0) call MP_perr_die(myname_,'MP_COMM_RANK',ierr) |
---|
133 | |
---|
134 | ! determine number of global segments ngseg: |
---|
135 | |
---|
136 | ngseg = GlobalSegMap_ngseg(GSMap) |
---|
137 | |
---|
138 | ! determine number of local segments on process myID nlseg: |
---|
139 | |
---|
140 | nlseg = GlobalSegMap_nlseg(GSMap, myID) |
---|
141 | |
---|
142 | ! allocate arrays start(:) and length(:) to store local |
---|
143 | ! segment information. |
---|
144 | |
---|
145 | allocate(start(nlseg), length(nlseg), stat=ierr) |
---|
146 | if(ierr /= 0) call die(myname_,'allocate(start...',ierr) |
---|
147 | |
---|
148 | ! Loop over GlobalSegMap%pe_loc(:) values to isolate |
---|
149 | ! global index values of local data. Record number of |
---|
150 | ! matches in the INTEGER count. |
---|
151 | |
---|
152 | count = 0 |
---|
153 | do n=1, ngseg |
---|
154 | if(GSMap%pe_loc(n) == myID) then |
---|
155 | count = count + 1 |
---|
156 | if(count > nlseg) then |
---|
157 | ierr = 2 |
---|
158 | call die(myname_,'too many pe matches',ierr) |
---|
159 | endif |
---|
160 | start(count) = GSMap%start(n) |
---|
161 | length(count) = GSMap%length(n) |
---|
162 | endif |
---|
163 | end do |
---|
164 | |
---|
165 | if(count < nlseg) then |
---|
166 | ierr = 3 |
---|
167 | call die(myname_,'too few pe matches',ierr) |
---|
168 | endif |
---|
169 | |
---|
170 | ! translate global start indices to their local |
---|
171 | ! values, based on their storage order and number |
---|
172 | ! of elements in each segment |
---|
173 | |
---|
174 | do n=1, count |
---|
175 | if(n == 1) then |
---|
176 | start(n) = 1 |
---|
177 | else |
---|
178 | start(n) = start(n-1) + length(n-1) |
---|
179 | endif |
---|
180 | end do |
---|
181 | |
---|
182 | end subroutine GlobalSegMapToIndices_ |
---|
183 | |
---|
184 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
185 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
186 | !BOP ------------------------------------------------------------------- |
---|
187 | ! |
---|
188 | ! !IROUTINE: GlobalSegMapToIndex_ - Global to Local Index Translation |
---|
189 | ! |
---|
190 | ! !DESCRIPTION: This {\tt INTEGER} query function takes a user-supplied |
---|
191 | ! {\tt GlobalSegMap} data type {\tt GSMap}, which desribes a decomposition |
---|
192 | ! on the input MPI communicator corresponding to the Fortran {\tt INTEGER} |
---|
193 | ! handle {\tt comm}, and the input global index value {\tt i\_g}, and |
---|
194 | ! returns a positive local index value if the datum {\tt i\_g}. If |
---|
195 | ! the datum {\tt i\_g} is not stored on the local process ID, a value |
---|
196 | ! of {\tt -1} is returned. |
---|
197 | ! |
---|
198 | ! !INTERFACE: |
---|
199 | |
---|
200 | |
---|
201 | integer function GlobalSegMapToIndex_(GSMap, i_g, comm) |
---|
202 | |
---|
203 | ! |
---|
204 | ! !USES: |
---|
205 | ! |
---|
206 | use m_mpif90 |
---|
207 | use m_die, only : MP_perr_die, die, warn |
---|
208 | use m_GlobalSegMap, only : GlobalSegMap |
---|
209 | use m_GlobalSegMap, only : GlobalSegMap_ngseg => ngseg |
---|
210 | use m_GlobalSegMap, only : GlobalSegMap_nlseg => nlseg |
---|
211 | |
---|
212 | implicit none |
---|
213 | |
---|
214 | ! !INPUT PARAMETERS: |
---|
215 | |
---|
216 | type(GlobalSegMap), intent(in) :: GSMap ! Output GlobalSegMap |
---|
217 | integer, intent(in) :: i_g ! global index |
---|
218 | integer, intent(in) :: comm ! communicator handle |
---|
219 | |
---|
220 | ! !REVISION HISTORY: |
---|
221 | ! 2Feb01 - J.W. Larson <larson@mcs.anl.gov> - initial version |
---|
222 | !EOP ___________________________________________________________________ |
---|
223 | |
---|
224 | character(len=*),parameter :: myname_=myname//'::GlobalSegMapToIndex_' |
---|
225 | |
---|
226 | integer :: myID |
---|
227 | integer :: count, ierr, ngseg, nlseg, n |
---|
228 | integer :: lower_bound, upper_bound |
---|
229 | integer :: local_start, local_index |
---|
230 | logical :: found |
---|
231 | |
---|
232 | ! Determine local process id myID: |
---|
233 | |
---|
234 | call MP_COMM_RANK(comm, myID, ierr) |
---|
235 | if(ierr /= 0) call MP_perr_die(myname_,'MP_COMM_RANK()',ierr) |
---|
236 | |
---|
237 | ! Extract the global number of segments in GSMap |
---|
238 | |
---|
239 | ngseg = GlobalSegMap_ngseg(GSMap) |
---|
240 | |
---|
241 | ! Extract the global number of segments in GSMap for myID |
---|
242 | |
---|
243 | nlseg = GlobalSegMap_nlseg(GSMap, myID) |
---|
244 | |
---|
245 | ! set the counter count, which records the number of times myID |
---|
246 | ! matches entries in GSMap%pe_loc(:) |
---|
247 | |
---|
248 | count = 0 |
---|
249 | |
---|
250 | ! set local_start, which is the current local storage segment |
---|
251 | ! starting position |
---|
252 | |
---|
253 | local_start = 1 |
---|
254 | |
---|
255 | ! set logical flag found to signify we havent found i_g: |
---|
256 | |
---|
257 | found = .false. |
---|
258 | |
---|
259 | n = 0 |
---|
260 | |
---|
261 | SEARCH_LOOP: do |
---|
262 | |
---|
263 | n = n+1 |
---|
264 | if (n > ngseg) EXIT |
---|
265 | |
---|
266 | if(GSMap%pe_loc(n) == myID) then |
---|
267 | |
---|
268 | ! increment / check the pe_loc match counter |
---|
269 | |
---|
270 | count = count + 1 |
---|
271 | if(count > nlseg) then |
---|
272 | ierr = 2 |
---|
273 | call die(myname_,'too many pe matches',ierr) |
---|
274 | endif |
---|
275 | |
---|
276 | ! is i_g in this segment? |
---|
277 | |
---|
278 | lower_bound = GSMap%start(n) |
---|
279 | upper_bound = GSMap%start(n) + GSMap%length(n) - 1 |
---|
280 | |
---|
281 | if((lower_bound <= i_g) .and. (i_g <= upper_bound)) then |
---|
282 | local_index = local_start + (i_g - GSMap%start(n)) |
---|
283 | found = .true. |
---|
284 | EXIT |
---|
285 | else |
---|
286 | local_start = local_start + GSMap%length(n) |
---|
287 | endif |
---|
288 | |
---|
289 | endif |
---|
290 | end do SEARCH_LOOP |
---|
291 | |
---|
292 | ! We either found the local index, or have exhausted our options. |
---|
293 | |
---|
294 | if(found) then |
---|
295 | GlobalSegMapToIndex_ = local_index |
---|
296 | else |
---|
297 | GlobalSegMapToIndex_ = -1 |
---|
298 | endif |
---|
299 | |
---|
300 | end function GlobalSegMapToIndex_ |
---|
301 | |
---|
302 | |
---|
303 | |
---|
304 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
305 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
306 | !BOP ------------------------------------------------------------------- |
---|
307 | ! |
---|
308 | ! !IROUTINE: GlobalSegMapToIndexArr_ - Global to Local Index Array Translation |
---|
309 | ! |
---|
310 | ! !DESCRIPTION: Given a {\tt GlobalSegMap} data type {\tt GSMap} |
---|
311 | ! and MPI communicator corresponding to the Fortran {\tt INTEGER} |
---|
312 | ! handle {\tt comm}, convert an array of global index values |
---|
313 | ! {\tt i\_global()} to an array of local index values {\tt i\_local()}. If |
---|
314 | ! the datum {\tt i\_global(j)} is not stored on the local process ID, |
---|
315 | ! then {\tt i\_local(j)} will be set to {\tt -1}/ |
---|
316 | ! |
---|
317 | ! !INTERFACE: |
---|
318 | |
---|
319 | |
---|
320 | subroutine GlobalSegMapToIndexArr_(GSMap, i_global, i_local, nindex, comm) |
---|
321 | |
---|
322 | ! |
---|
323 | ! !USES: |
---|
324 | ! |
---|
325 | use m_stdio |
---|
326 | use m_mpif90 |
---|
327 | use m_die, only : MP_perr_die, die, warn |
---|
328 | use m_GlobalSegMap, only : GlobalSegMap |
---|
329 | use m_GlobalSegMap, only : GlobalSegMap_ngseg => ngseg |
---|
330 | use m_GlobalSegMap, only : GlobalSegMap_nlseg => nlseg |
---|
331 | |
---|
332 | implicit none |
---|
333 | |
---|
334 | ! !INPUT PARAMETERS: |
---|
335 | |
---|
336 | type(GlobalSegMap), intent(in) :: GSMap ! Output GlobalSegMap |
---|
337 | integer, intent(in) :: i_global(:) ! global index |
---|
338 | integer, intent(out) :: i_local(:) ! local index |
---|
339 | integer, intent(in) :: nindex ! size of i_global() |
---|
340 | integer, intent(in) :: comm ! communicator handle |
---|
341 | |
---|
342 | ! !REVISION HISTORY: |
---|
343 | ! 12-apr-2006 R. Loy <rloy@mcs.anl.gov> - initial version |
---|
344 | !EOP ___________________________________________________________________ |
---|
345 | |
---|
346 | character(len=*),parameter :: myname_=myname//'::GlobalSegMapToIndexArr_' |
---|
347 | |
---|
348 | integer :: myID |
---|
349 | integer :: count, ierr, ngseg, nlseg |
---|
350 | integer,allocatable :: mygs_lb(:),mygs_ub(:),mygs_len(:),mygs_lstart(:) |
---|
351 | |
---|
352 | integer :: i,j,n,startj |
---|
353 | |
---|
354 | ! Determine local process id myID: |
---|
355 | |
---|
356 | call MP_COMM_RANK(comm, myID, ierr) |
---|
357 | if(ierr /= 0) call MP_perr_die(myname_,'MP_COMM_RANK()',ierr) |
---|
358 | |
---|
359 | |
---|
360 | ngseg = GlobalSegMap_ngseg(GSMap) |
---|
361 | nlseg = GlobalSegMap_nlseg(GSMap, myID) |
---|
362 | |
---|
363 | if (nlseg <= 0) return; |
---|
364 | |
---|
365 | allocate( mygs_lb(nlseg), mygs_ub(nlseg), mygs_len(nlseg) ) |
---|
366 | allocate( mygs_lstart(nlseg) ) |
---|
367 | |
---|
368 | |
---|
369 | !! |
---|
370 | !! determine the global segments on this processor |
---|
371 | !! just once, so the info be used repeatedly below |
---|
372 | !! |
---|
373 | |
---|
374 | n = 0 |
---|
375 | do i=1,ngseg |
---|
376 | if (GSMap%pe_loc(i) == myID ) then |
---|
377 | n=n+1 |
---|
378 | mygs_lb(n)=GSMap%start(i) |
---|
379 | mygs_ub(n)=GSMap%start(i) + GSMap%length(i) -1 |
---|
380 | mygs_len(n)=GSMap%length(i) |
---|
381 | endif |
---|
382 | enddo |
---|
383 | |
---|
384 | if (n .ne. nlseg) then |
---|
385 | write(stderr,*) myname_,"mismatch nlseg",n,nlseg |
---|
386 | call die(myname) |
---|
387 | endif |
---|
388 | |
---|
389 | mygs_lstart(1)=1 |
---|
390 | do j=2,nlseg |
---|
391 | mygs_lstart(j)=mygs_lstart(j-1)+mygs_len(j-1) |
---|
392 | enddo |
---|
393 | |
---|
394 | |
---|
395 | !! |
---|
396 | !! this loop is optimized for the case that the indices in iglobal() |
---|
397 | !! are in the same order that they appear in the global segments, |
---|
398 | !! which seems usually (always?) to be the case. |
---|
399 | !! |
---|
400 | !! note that the j loop exit condition is only executed when the index |
---|
401 | !! is not found in the current segment, which saves a factor of 2 |
---|
402 | !! since many consecutive indices are in the same segment. |
---|
403 | !! |
---|
404 | |
---|
405 | |
---|
406 | j=1 |
---|
407 | do i=1,nindex |
---|
408 | |
---|
409 | i_local(i)= -1 |
---|
410 | |
---|
411 | startj=j |
---|
412 | SEARCH_LOOP: do |
---|
413 | |
---|
414 | if ( (mygs_lb(j) <= i_global(i)) .and. & |
---|
415 | (i_global(i) <= mygs_ub(j))) then |
---|
416 | i_local(i) = mygs_lstart(j) + (i_global(i) - mygs_lb(j)) |
---|
417 | EXIT SEARCH_LOOP |
---|
418 | else |
---|
419 | j=j+1 |
---|
420 | if (j > nlseg) j=1 ! wrap around |
---|
421 | if (j == startj) EXIT SEARCH_LOOP |
---|
422 | endif |
---|
423 | |
---|
424 | end do SEARCH_LOOP |
---|
425 | |
---|
426 | end do |
---|
427 | |
---|
428 | !!!! this version vectorizes (outer loop) |
---|
429 | !!!! performance for in-order input is slightly slower than the above |
---|
430 | !!!! but performance on out-of-order input is probably much better |
---|
431 | !!!! at the moment we are going on the assumption that caller is |
---|
432 | !!!! likely providing in-order, so we won't use this version. |
---|
433 | !! |
---|
434 | !! do i=1,nindex |
---|
435 | !! |
---|
436 | !! i_local(i)= -1 |
---|
437 | !! |
---|
438 | !! SEARCH_LOOP: do j=1,nlseg |
---|
439 | !! |
---|
440 | !! if ( (mygs_lb(j) <= i_global(i)) .and. & |
---|
441 | !! (i_global(i) <= mygs_ub(j))) then |
---|
442 | !! i_local(i) = mygs_lstart(j) + (i_global(i) - mygs_lb(j)) |
---|
443 | !! endif |
---|
444 | !! |
---|
445 | !! end do SEARCH_LOOP |
---|
446 | !! |
---|
447 | !! end do |
---|
448 | |
---|
449 | |
---|
450 | deallocate( mygs_lb, mygs_ub, mygs_len, mygs_lstart ) |
---|
451 | |
---|
452 | end subroutine GlobalSegMapToIndexArr_ |
---|
453 | |
---|
454 | |
---|
455 | |
---|
456 | |
---|
457 | |
---|
458 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
459 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
460 | !BOP ------------------------------------------------------------------- |
---|
461 | ! |
---|
462 | ! !IROUTINE: GlobalMapToIndex_ - Global to Local Index Translation |
---|
463 | ! |
---|
464 | ! !DESCRIPTION: |
---|
465 | ! This {\tt INTEGER} query function takes as its input a user-supplied |
---|
466 | ! {\tt GlobalMap} data type {\tt GMap}, which desribes a decomposition |
---|
467 | ! on the input MPI communicator corresponding to the Fortran {\tt INTEGER} |
---|
468 | ! handle {\tt comm}, and the input global index value {\tt i\_g}, and |
---|
469 | ! returns a positive local index value if the datum {\tt i\_g}. If |
---|
470 | ! the datum {\tt i\_g} is not stored on the local process ID, a value |
---|
471 | ! of {\tt -1} is returned. |
---|
472 | ! |
---|
473 | ! !INTERFACE: |
---|
474 | |
---|
475 | |
---|
476 | integer function GlobalMapToIndex_(GMap, i_g, comm) |
---|
477 | |
---|
478 | ! |
---|
479 | ! !USES: |
---|
480 | ! |
---|
481 | use m_mpif90 |
---|
482 | use m_die, only : MP_perr_die, die, warn |
---|
483 | use m_GlobalMap, only : GlobalMap |
---|
484 | |
---|
485 | implicit none |
---|
486 | |
---|
487 | ! !INPUT PARAMETERS: |
---|
488 | |
---|
489 | type(GlobalMap), intent(in) :: GMap ! Input GlobalMap |
---|
490 | integer, intent(in) :: i_g ! global index |
---|
491 | integer, intent(in) :: comm ! communicator handle |
---|
492 | |
---|
493 | ! !REVISION HISTORY: |
---|
494 | ! 2Feb01 - J.W. Larson <larson@mcs.anl.gov> - initial version |
---|
495 | !EOP ___________________________________________________________________ |
---|
496 | |
---|
497 | character(len=*),parameter :: myname_=myname//'::GlobalMapToIndex_' |
---|
498 | |
---|
499 | integer :: myID |
---|
500 | integer :: count, ierr, ngseg, nlseg, n |
---|
501 | integer :: lower_bound, upper_bound |
---|
502 | integer :: local_start, local_index |
---|
503 | logical :: found |
---|
504 | |
---|
505 | ! Determine local process id myID: |
---|
506 | |
---|
507 | call MP_COMM_RANK(comm, myID, ierr) |
---|
508 | if(ierr /= 0) call MP_perr_die(myname_,'MP_COMM_RANK()',ierr) |
---|
509 | |
---|
510 | ! Initialize logical "point located" flag found as false |
---|
511 | |
---|
512 | found = .false. |
---|
513 | |
---|
514 | lower_bound = GMap%displs(myID) + 1 |
---|
515 | upper_bound = GMap%displs(myID) + GMap%counts(myID) |
---|
516 | |
---|
517 | if((lower_bound <= i_g) .and. (i_g <= upper_bound)) then |
---|
518 | found = .true. |
---|
519 | local_index = i_g - lower_bound + 1 |
---|
520 | endif |
---|
521 | |
---|
522 | if(found) then |
---|
523 | GlobalMapToIndex_ = local_index |
---|
524 | else |
---|
525 | GlobalMapToIndex_ = -1 |
---|
526 | endif |
---|
527 | |
---|
528 | end function GlobalMapToIndex_ |
---|
529 | |
---|
530 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
531 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
532 | !BOP ------------------------------------------------------------------- |
---|
533 | ! |
---|
534 | ! !IROUTINE: GlobalSegMapToNavigator_ - Return Navigator to Local Segments |
---|
535 | ! |
---|
536 | ! !DESCRIPTION: |
---|
537 | ! This routine takes as its input takes a user-supplied |
---|
538 | ! {\tt GlobalSegMap} data type {\tt GSMap}, which desribes a decomposition |
---|
539 | ! on the input MPI communicator corresponding to the Fortran {\tt INTEGER} |
---|
540 | ! handle {\tt comm}, and returns the local segment start index and length |
---|
541 | ! information for referencing the on-pe storage of the mapped distributed |
---|
542 | ! data. These data are returned in the form of the output {\tt Navigator} |
---|
543 | ! argument {Nav}. |
---|
544 | ! |
---|
545 | ! {\bf N.B.:} This routine returns a {\tt Navigator} variable {\tt Nav}, |
---|
546 | ! which must be deallocated once the user no longer needs it. Failure to |
---|
547 | ! do this will create a memory leak. |
---|
548 | ! |
---|
549 | ! !INTERFACE: |
---|
550 | |
---|
551 | subroutine GlobalSegMapToNavigator_(GSMap, comm, oNav) |
---|
552 | |
---|
553 | ! |
---|
554 | ! !USES: |
---|
555 | ! |
---|
556 | use m_mpif90 |
---|
557 | use m_die, only : MP_perr_die, die, warn |
---|
558 | use m_GlobalSegMap, only : GlobalSegMap |
---|
559 | use m_GlobalSegMap, only : GlobalSegMap_ngseg => ngseg |
---|
560 | use m_GlobalSegMap, only : GlobalSegMap_nlseg => nlseg |
---|
561 | use m_Navigator, only : Navigator |
---|
562 | use m_Navigator, only : Navigator_init => init |
---|
563 | |
---|
564 | implicit none |
---|
565 | |
---|
566 | ! !INPUT PARAMETERS: |
---|
567 | |
---|
568 | type(GlobalSegMap), intent(in) :: GSMap ! Input GlobalSegMap |
---|
569 | integer, intent(in) :: comm ! communicator handle |
---|
570 | |
---|
571 | ! !OUTPUT PARAMETERS: |
---|
572 | |
---|
573 | type(Navigator), intent(out) :: oNav ! Output Navigator |
---|
574 | |
---|
575 | ! !REVISION HISTORY: |
---|
576 | ! 2Feb01 - J.W. Larson <larson@mcs.anl.gov> - initial version |
---|
577 | !EOP ___________________________________________________________________ |
---|
578 | |
---|
579 | character(len=*),parameter :: myname_=myname//'::GlobalSegMapToNavigator_' |
---|
580 | |
---|
581 | integer :: myID, ierr, ngseg, nlseg, n, count |
---|
582 | |
---|
583 | ! determine local process id myID |
---|
584 | |
---|
585 | call MP_COMM_RANK(comm, myID, ierr) |
---|
586 | if(ierr /= 0) call MP_perr_die(myname_,'MP_COMM_RANK',ierr) |
---|
587 | |
---|
588 | ! determine number of global segments ngseg: |
---|
589 | |
---|
590 | ngseg = GlobalSegMap_ngseg(GSMap) |
---|
591 | |
---|
592 | ! determine number of local segments on process myID nlseg: |
---|
593 | |
---|
594 | nlseg = GlobalSegMap_nlseg(GSMap, myID) |
---|
595 | |
---|
596 | ! Allocate space for the Navigator oNav: |
---|
597 | |
---|
598 | call Navigator_init(oNav, nlseg, ierr) |
---|
599 | if(ierr /= 0) call die(myname_,'Navigator_init',ierr) |
---|
600 | |
---|
601 | call GlobalSegMapToIndices_(GSMap, comm, oNav%displs, oNav%counts) |
---|
602 | |
---|
603 | end subroutine GlobalSegMapToNavigator_ |
---|
604 | |
---|
605 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
606 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
607 | !BOP ------------------------------------------------------------------- |
---|
608 | ! |
---|
609 | ! !IROUTINE: GlobalSegMapToLocalMatrix_ - Set Local SparseMatrix Indices |
---|
610 | ! |
---|
611 | ! !DESCRIPTION: |
---|
612 | ! This routine takes as its input a user-supplied {\tt GlobalSegMap} |
---|
613 | ! domain decomposition {\tt GSMap}, which describes the decomposition of |
---|
614 | ! either the rows or columns of the input/output {\tt SparseMatrix} |
---|
615 | ! argument {\tt sMat} on the communicator associated with the {\tt INTEGER} |
---|
616 | ! handle {\tt comm}, and to translate the global row or column indices |
---|
617 | ! of {\tt sMat} into their local counterparts. The choice of either row |
---|
618 | ! or column is governed by the value of the input {\tt CHARACTER} |
---|
619 | ! argument {\tt RCFlag}. One sets this variable to either {\tt 'ROW'} or |
---|
620 | ! {\tt 'row'} to specify row re-indexing (which are stored in |
---|
621 | ! {\tt sMat} and retrieved by indexing the attribute {\tt lrow}), and |
---|
622 | ! {\tt 'COLUMN'} or {\tt 'column'} to specify column re-indexing (which |
---|
623 | ! are stored in {\tt sMat} and retrieved by indexing the {\tt SparseMatrix} |
---|
624 | ! attribute {\tt lcol}). |
---|
625 | ! |
---|
626 | ! !INTERFACE: |
---|
627 | |
---|
628 | subroutine GlobalSegMapToLocalMatrix_(sMat, GSMap, RCFlag, comm) |
---|
629 | |
---|
630 | ! |
---|
631 | ! !USES: |
---|
632 | ! |
---|
633 | use m_stdio |
---|
634 | use m_die, only : die |
---|
635 | |
---|
636 | use m_SparseMatrix, only : SparseMatrix |
---|
637 | use m_SparseMatrix, only : SparseMatrix_indexIA => indexIA |
---|
638 | use m_SparseMatrix, only : SparseMatrix_lsize => lsize |
---|
639 | |
---|
640 | use m_GlobalSegMap, only : GlobalSegMap |
---|
641 | |
---|
642 | |
---|
643 | implicit none |
---|
644 | |
---|
645 | ! !INPUT PARAMETERS: |
---|
646 | |
---|
647 | type(GlobalSegMap), intent(in) :: GSMap ! Input GlobalSegMap |
---|
648 | character(len=*), intent(in) :: RCFlag ! 'row' or 'column' |
---|
649 | integer, intent(in) :: comm ! communicator handle |
---|
650 | |
---|
651 | ! !INPUT/OUTPUT PARAMETERS: |
---|
652 | |
---|
653 | type(SparseMatrix), intent(inout) :: sMat |
---|
654 | |
---|
655 | ! !SEE ALSO: |
---|
656 | ! The MCT module m_SparseMatrix for more information about the |
---|
657 | ! SparseMatrix type and its storage of global and local row-and |
---|
658 | ! column indices. |
---|
659 | ! |
---|
660 | ! !REVISION HISTORY: |
---|
661 | ! 3May01 - J.W. Larson <larson@mcs.anl.gov> - initial version, which |
---|
662 | ! is _extremely_ slow, but safe. This must be re-examined |
---|
663 | ! later. |
---|
664 | !EOP ___________________________________________________________________ |
---|
665 | |
---|
666 | character(len=*),parameter :: myname_=myname//'::GlobalSegMapToLocalMatrix_' |
---|
667 | |
---|
668 | |
---|
669 | integer :: i, GlobalIndex, gindex, lindex, lsize |
---|
670 | |
---|
671 | integer, allocatable :: temp_gindex(:) !! rml |
---|
672 | integer, allocatable :: temp_lindex(:) !! rml |
---|
673 | |
---|
674 | |
---|
675 | ! What are we re-indexing, rows or columns? |
---|
676 | |
---|
677 | select case(RCFlag) |
---|
678 | case('ROW','row') |
---|
679 | gindex = SparseMatrix_indexIA(sMat, 'grow', dieWith=myname_) |
---|
680 | lindex = SparseMatrix_indexIA(sMat,'lrow', dieWith=myname_) |
---|
681 | case('COLUMN','column') |
---|
682 | gindex = SparseMatrix_indexIA(sMat,'gcol', dieWith=myname_) |
---|
683 | lindex = SparseMatrix_indexIA(sMat,'lcol', dieWith=myname_) |
---|
684 | case default |
---|
685 | write(stderr,'(3a)') myname_,":: unrecognized value of RCFLag ",RCFlag |
---|
686 | call die(myname) |
---|
687 | end select |
---|
688 | |
---|
689 | |
---|
690 | ! How many matrix elements are there? |
---|
691 | |
---|
692 | lsize = SparseMatrix_lsize(sMat) |
---|
693 | |
---|
694 | |
---|
695 | !! rml new code from here down - do the mapping all in one |
---|
696 | !! function call which has been tuned for speed |
---|
697 | |
---|
698 | allocate( temp_gindex(lsize) ) |
---|
699 | allocate( temp_lindex(lsize) ) |
---|
700 | |
---|
701 | |
---|
702 | do i=1,lsize |
---|
703 | temp_gindex(i) = sMat%data%iAttr(gindex,i) |
---|
704 | end do |
---|
705 | |
---|
706 | call GlobalSegMapToIndexArr_(GSMap, temp_gindex, temp_lindex, lsize, comm) |
---|
707 | |
---|
708 | do i=1,lsize |
---|
709 | sMat%data%iAttr(lindex,i) = temp_lindex(i) |
---|
710 | end do |
---|
711 | |
---|
712 | |
---|
713 | deallocate(temp_gindex) ! rml |
---|
714 | deallocate(temp_lindex) ! rml |
---|
715 | |
---|
716 | |
---|
717 | end subroutine GlobalSegMapToLocalMatrix_ |
---|
718 | |
---|
719 | end module m_GlobalToLocal |
---|