Line data Source code
1 : !------------------------------------------------------------------------
2 : ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS
3 : !------------------------------------------------------------------------
4 : MODULE ghostmodule
5 : !BOP
6 : !
7 : ! !MODULE: ghostmodule
8 : !
9 : ! !USES:
10 : USE decompmodule, ONLY : DecompType
11 : #include "debug.h"
12 : #include "pilgrim.h"
13 : IMPLICIT NONE
14 :
15 : !
16 : ! !DESCRIPTION:
17 : !
18 : ! This module provides the basic support for "ghost regions". In
19 : ! reality the ghost region just subset of the global domain
20 : ! described by a decomposition (pro memoria: a decomposition
21 : ! describes a partition of a global index space over a number
22 : ! of PEs; this is inherently non-overlapping).
23 : !
24 : ! It contains the following public types and routines.
25 : ! \begin{center}
26 : ! \begin{tabular}{|l|l|} \hline \hline
27 : ! GhostType & Type to describe ghosted local vector \\ \hline
28 : ! GhostFree & Destroy a ghost definition \\ \hline
29 : ! GhostCreate & Copy ghost definition to newly created one\\ \hline
30 : ! GhostInfo & Returns some information about the region \\ \hline
31 : ! \hline \hline
32 : ! \end{tabular}
33 : ! \end{center}
34 : !
35 : ! GhostCreate is overloaded to support different types of domains:
36 : !
37 : ! \begin{center}
38 : ! \begin{tabular}{|l|l|} \hline \hline
39 : ! GhostCopy & Copy a ghost region \\ \hline
40 : ! GhostRegular1D & Define a subset of a 1D domain \\ \hline
41 : ! GhostRegular2D & Define a subset of a 2D domain \\ \hline
42 : ! GhostRegular3D & Define a subset of a 3D domain \\ \hline
43 : ! GhostRegular4D & Define a subset of a 4D domain \\ \hline
44 : ! GhostIrregular & Define a subset of an irregular domain \\ \hline
45 : ! \hline \hline
46 : ! \end{tabular}
47 : ! \end{center}
48 : !
49 : ! Generally one will use the GhostCreate routine which corresponds
50 : ! to the underlying decomposition; e.g., if the decomposition was
51 : ! defined with DecompRegular3D you would probably use GhostRegular3D
52 : ! to define the ghost region. But since decompositions and ghost
53 : ! regions are generic, i.e., one-size-fits-all, this is not a requirement.
54 : ! Be very careful if you use non-corresponding routines!
55 : !
56 : ! The ghost type contains a decomposition which describes the
57 : ! {\it non-overlapping} distribution of the global domain
58 : ! (this is a replicated data structure with complete information
59 : ! about all data structures on all PEs). Its other components are
60 : ! a list of the global indices of the on the boundary
61 : ! (not replicated), and a description of the mapping of the ghosted
62 : ! local region to global indices.
63 : !
64 : ! This module is communication-free and is a foundation
65 : ! for ParUtilitiesModule. Since GhostType is local to the
66 : ! PE, the modules routines can and should be called with
67 : ! non-replicated data structures. Before boundary communication
68 : ! takes place, the communication pattern derived from the ghost regions
69 : ! must be created (see ParUtilitiesModule).
70 : !
71 : ! !REVISION HISTORY:
72 : ! 00.11.10 Sawyer Creation
73 : ! 01.02.07 Sawyer Improvements; added Border to GhostType
74 : ! 01.02.12 Sawyer Converted to free format
75 : ! 02.08.27 Zaslavsky Changed intent from OUT to INOUT for objects of
76 : ! GhostType
77 : ! 02.12.23 Sawyer Added GhostRegular4D
78 : !
79 : ! !PUBLIC TYPES:
80 : PUBLIC GhostType
81 : PUBLIC GhostFree
82 : PUBLIC GhostCreate
83 : PUBLIC GhostInfo
84 :
85 : INTERFACE GhostCreate
86 : MODULE PROCEDURE GhostCopy
87 : MODULE PROCEDURE GhostIrregular
88 : MODULE PROCEDURE GhostRegular1D
89 : MODULE PROCEDURE GhostRegular2D
90 : MODULE PROCEDURE GhostRegular3D
91 : MODULE PROCEDURE GhostRegular4D
92 : END INTERFACE
93 :
94 : ! Decomposition info
95 :
96 : TYPE GhostType
97 : LOGICAL :: Defined! Is it defined?
98 : TYPE(DecompType) :: Decomp ! Decomposition of global partition
99 : TYPE(DecompType) :: Local ! Decomposition of local region
100 : TYPE(DecompType) :: Border ! Decomposition of local segment
101 : END TYPE GhostType
102 :
103 : !EOP
104 : CONTAINS
105 :
106 : !-----------------------------------------------------------------------
107 : !BOP
108 : ! !IROUTINE: GhostFree --- Free a ghosted region
109 : !
110 : ! !INTERFACE:
111 7680 : SUBROUTINE GhostFree ( Ghost )
112 : ! !USES:
113 : USE decompmodule, ONLY : DecompFree
114 : IMPLICIT NONE
115 :
116 : ! !INPUT/OUTPUT PARAMETERS:
117 : TYPE(GhostType), INTENT( INOUT ):: Ghost ! Ghost information
118 :
119 : !
120 : ! !DESCRIPTION:
121 : ! Free the ghost decomposition -- deallocate the data structures.
122 : !
123 : ! !SYSTEM ROUTINES:
124 : ! ASSOCIATED, DEALLOCATE
125 : !
126 : ! !REVISION HISTORY:
127 : ! 00.11.12 Sawyer Creation
128 : !
129 : !EOP
130 : !-----------------------------------------------------------------------
131 : !BOC
132 : !
133 : !
134 : CPP_ENTER_PROCEDURE( "GHOSTFREE" )
135 :
136 7680 : IF ( Ghost%Defined ) THEN
137 7680 : CALL DecompFree( Ghost%Border )
138 7680 : CALL DecompFree( Ghost%Local )
139 7680 : CALL DecompFree( Ghost%Decomp )
140 7680 : Ghost%Defined = .FALSE.
141 : ENDIF
142 :
143 : CPP_LEAVE_PROCEDURE( "GHOSTFREE" )
144 7680 : RETURN
145 : !EOC
146 : END SUBROUTINE GhostFree
147 : !-----------------------------------------------------------------------
148 :
149 :
150 : !-----------------------------------------------------------------------
151 : !BOP
152 : ! !IROUTINE: GhostDefined --- Is the ghost type de
153 : !
154 : ! !INTERFACE:
155 0 : LOGICAL FUNCTION GhostDefined ( Ghost )
156 : ! !USES:
157 : IMPLICIT NONE
158 :
159 : ! !INPUT PARAMETERS:
160 : TYPE(GhostType), INTENT( IN ):: Ghost ! Ghost information
161 :
162 : !
163 : ! !DESCRIPTION:
164 : ! Returns true if Ghost has been created but not yet destroyed
165 : !
166 : ! !REVISION HISTORY:
167 : ! 02.07.18 Sawyer Creation
168 : !
169 : !EOP
170 : !-----------------------------------------------------------------------
171 : !BOC
172 : !
173 : !
174 : CPP_ENTER_PROCEDURE( "GHOSTDEFINED" )
175 0 : GhostDefined = Ghost%Defined
176 : CPP_LEAVE_PROCEDURE( "GHOSTDEFINED" )
177 :
178 : RETURN
179 : !EOC
180 : END FUNCTION GhostDefined
181 : !-----------------------------------------------------------------------
182 :
183 :
184 : !-----------------------------------------------------------------------
185 : !BOP
186 : ! !IROUTINE: GhostCopy --- Copy one decomposition to another
187 : !
188 : ! !INTERFACE:
189 0 : SUBROUTINE GhostCopy ( GhostIn, GhostOut )
190 : ! !USES:
191 : USE decompmodule, ONLY : DecompCopy
192 : IMPLICIT NONE
193 : !
194 : ! !INPUT PARAMETERS:
195 : TYPE(GhostType), INTENT( IN ) :: GhostIn ! Ghost information
196 : !
197 : ! !OUTPUT PARAMETERS:
198 : TYPE(GhostType), INTENT( INOUT ) :: GhostOut ! Ghost information
199 : !
200 : ! !DESCRIPTION:
201 : !
202 : ! Creates an output ghost definition and copies GhostIn to it
203 : !
204 : ! !SYSTEM ROUTINES:
205 : ! ALLOCATE
206 : !
207 : ! !REVISION HISTORY:
208 : ! 00.11.12 Sawyer Creation
209 : !
210 : !EOP
211 : !-----------------------------------------------------------------------
212 : !BOC
213 : ! !LOCAL VARIABLES:
214 : INTEGER :: I, Nsize
215 :
216 : CPP_ENTER_PROCEDURE( "GHOSTCOPY" )
217 :
218 0 : CALL DecompCopy( GhostIn%Decomp, GhostOut%Decomp )
219 0 : CALL DecompCopy( GhostIn%Local, GhostOut%Local )
220 0 : CALL DecompCopy( GhostIn%Border, GhostOut%Border )
221 0 : GhostOut%Defined = .TRUE.
222 :
223 : CPP_LEAVE_PROCEDURE( "GHOSTCOPY" )
224 0 : RETURN
225 : !EOC
226 : END SUBROUTINE GhostCopy
227 : !-----------------------------------------------------------------------
228 :
229 :
230 : !-----------------------------------------------------------------------
231 : !BOP
232 : ! !IROUTINE: GhostIrregular --- Create a ghost definition for 1-D grid
233 : !
234 : ! !INTERFACE:
235 0 : SUBROUTINE GhostIrregular( Decomp, Id, LocalSize, Tags, Ghost )
236 : ! !USES:
237 : USE decompmodule, ONLY : DecompCreate, DecompCopy, &
238 : DecompGlobalToLocal, DecompInfo
239 : IMPLICIT NONE
240 : !
241 : ! !INPUT PARAMETERS:
242 : TYPE(DecompType), INTENT( IN ) :: Decomp ! Decomp information
243 : INTEGER, INTENT( IN ) :: Id ! Local PE identifer
244 : INTEGER, INTENT( IN ) :: LocalSize ! Size of local segment
245 : INTEGER, INTENT( IN ) :: Tags(:) ! Global tags
246 : !
247 : ! !OUTPUT PARAMETERS:
248 : TYPE(GhostType), INTENT( INOUT ) :: Ghost ! Ghost definition
249 : !
250 : !
251 : ! !DESCRIPTION:
252 : ! Creates a ghost definition for a ghosted array given by
253 : ! the PEs and Tags of the local points. Note that none of the
254 : ! array bounds can be outside the global domain!
255 : !
256 : ! !SYSTEM ROUTINES:
257 : ! ALLOCATE, DEALLOCATE
258 : !
259 : ! !REVISION HISTORY:
260 : ! 00.11.12 Sawyer Creation
261 : !
262 : ! !BUGS:
263 : ! None of the array bounds can be outside of the global domain!
264 : ! This is significant if the local region is on the edge of the
265 : ! domain, and, in other words, the ghost region cannot cover
266 : ! empty space. This limitation may be relaxed in the future.
267 : !
268 : !EOP
269 : !-----------------------------------------------------------------------
270 : !BOC
271 : ! !LOCAL VARIABLES:
272 : INTEGER :: I, NPEs, GlobalSize, Local, Cnt, Ipe
273 0 : INTEGER, ALLOCATABLE :: Pe(:), Other(:)
274 : !
275 : !
276 : CPP_ENTER_PROCEDURE( "GHOSTIRREGULAR" )
277 : !
278 : ! Allocate the basic data structures
279 : !
280 0 : CALL DecompInfo( Decomp, Npes, GlobalSize )
281 :
282 0 : ALLOCATE( Pe( LocalSize ) )
283 0 : ALLOCATE( Other( LocalSize ) )
284 :
285 : !
286 : ! Use decompmodule to create global and local portions of Ghost
287 : ! The local version is only on the local processor "0"
288 :
289 0 : Other = Id
290 0 : CALL DecompCreate( Npes, Other, LocalSize, Tags, Ghost%Local )
291 :
292 : !
293 : ! Perform over all points local segment
294 : !
295 0 : Cnt = 0
296 0 : DO I= 1, LocalSize
297 0 : CALL DecompGlobalToLocal( Decomp, Tags(I), Local, Ipe )
298 : CPP_ASSERT_F90( (Local .GT. 0) .AND. (ipe .GE. 0) )
299 0 : IF ( Ipe .ne. id ) THEN
300 0 : Cnt = Cnt + 1
301 0 : Other( Cnt ) = Tags(I)
302 0 : Pe( Cnt ) = Ipe
303 : ENDIF
304 : ENDDO
305 :
306 : !
307 : ! Define the border regions. Presumably Cnt << LocalSize
308 : !
309 :
310 0 : CALL DecompCreate( Npes, Pe, Cnt, Other, Ghost%Border )
311 :
312 : !
313 : ! Copy the decomposition too
314 : !
315 0 : CALL DecompCopy( Decomp, Ghost%Decomp )
316 :
317 : ! Clean up
318 :
319 0 : DEALLOCATE( Pe )
320 0 : DEALLOCATE( Other )
321 0 : Ghost%Defined = .TRUE.
322 :
323 : CPP_LEAVE_PROCEDURE( "GHOSTIRREGULAR" )
324 0 : RETURN
325 : !EOC
326 0 : END SUBROUTINE GhostIrregular
327 : !-----------------------------------------------------------------------
328 :
329 :
330 : !-----------------------------------------------------------------------
331 : !BOP
332 : ! !IROUTINE: GhostRegular1D --- Create a ghost definition for 1-D grid
333 : !
334 : ! !INTERFACE:
335 0 : SUBROUTINE GhostRegular1D( Decomp, Id, Xglobal, Xfrom, Xto, Xwrap, &
336 : Ghost )
337 : ! !USES:
338 : USE decompmodule, ONLY : DecompCreate, DecompCopy, &
339 : DecompGlobalToLocal, DecompInfo
340 : IMPLICIT NONE
341 : !
342 : ! !INPUT PARAMETERS:
343 : TYPE(DecompType), INTENT( IN ) :: Decomp ! Decomp information
344 : INTEGER, INTENT( IN ) :: Id ! Local PE identifer
345 : INTEGER, INTENT( IN ) :: Xglobal! Total in X
346 : INTEGER, INTENT( IN ) :: Xfrom ! Low index in X
347 : INTEGER, INTENT( IN ) :: Xto ! High index in X
348 : LOGICAL, INTENT( IN ) :: Xwrap ! Wrap in X?
349 : !
350 : ! !OUTPUT PARAMETERS:p
351 : TYPE(GhostType), INTENT( INOUT ) :: Ghost ! Ghost definition
352 : !
353 : !
354 : ! !DESCRIPTION:
355 : ! Creates a ghost definition for a regular 1-D array with the
356 : ! array bounds Xfrom:Xto.
357 : !
358 : ! If the array bounds are outside of the global domain they may
359 : ! be wrapped around back into the global domain (variable Xwrap).
360 : ! If the region is not wrapped, it is advisable that the ghost
361 : ! region end at the boundary (which usually requires
362 : ! special case treatment depending on the PE number). If
363 : ! it does not end at the boundary, undefined points are
364 : ! introduced.
365 : !
366 : ! !SYSTEM ROUTINES:
367 : ! ALLOCATE, DEALLOCATE
368 : !
369 : ! !REVISION HISTORY:
370 : ! 00.11.12 Sawyer Creation
371 : !
372 : ! !BUGS:
373 : !
374 : ! There are certain limitations to ghost regions which can be
375 : ! avoided by clean programming practices. If the ghosted region
376 : ! wraps back onto core regions of the same PE, problems can arise.
377 : ! The simple case -- a ghosted region on 1 PE -- is supported in
378 : ! most cases. However, if it wraps back onto the local PE
379 : ! in such a way that more than one ghost points is mapped to
380 : ! one core domain global index, then the code may fail. Note
381 : ! that this is rarely the case if the ghost regions are small
382 : ! and enough processors are used to avoid wrapping back on the
383 : ! local one.
384 : !
385 : !EOP
386 : !-----------------------------------------------------------------------
387 : !BOC
388 : ! !LOCAL VARIABLES:
389 : INTEGER :: I, L, NPEs, GlobalSize, LocalSize, Cnt, Local, Ipe
390 : INTEGER :: Global
391 0 : INTEGER, ALLOCATABLE :: Pe(:), Tags(:), Other(:)
392 : !
393 : !
394 : CPP_ENTER_PROCEDURE( "GHOSTREGULAR1D" )
395 :
396 : !
397 : ! Allocate the basic data structures
398 : !
399 0 : CALL DecompInfo( Decomp, NPEs, GlobalSize )
400 : CPP_ASSERT_F90( GlobalSize .EQ. Xglobal )
401 :
402 0 : LocalSize = Xto - Xfrom + 1
403 : CPP_ASSERT_F90( LocalSize .GE. 0 )
404 :
405 0 : ALLOCATE( Pe( LocalSize ) )
406 0 : ALLOCATE( Tags( LocalSize ) )
407 0 : ALLOCATE( Other( LocalSize ) )
408 :
409 : !
410 : ! Perform over all points local segment
411 : !
412 0 : Cnt = 0
413 0 : L = 0
414 0 : DO I = Xfrom, Xto
415 0 : L = L + 1
416 0 : Global = MODULO(I-1,Xglobal)+1 ! Wrap around condition
417 0 : IF (Xwrap .OR. Global==I) THEN
418 0 : Tags(L) = Global ! Global Tags
419 0 : CALL DecompGlobalToLocal( Decomp, Global, Local, Ipe )
420 0 : IF ( Ipe .ne. Id .AND. Ipe .GE. 0 ) THEN
421 0 : Cnt = Cnt + 1
422 0 : Other( Cnt ) = Global ! Local Tags
423 0 : Pe( Cnt ) = Ipe
424 : ENDIF
425 : !
426 : ! Special case: the domain wraps-around onto the same PE. This is
427 : ! very tricky: the ghost points are distinguished from their true
428 : ! local core domain counterparts by a minus sign. This makes the
429 : ! address space in both Ghost%Border and Ghost%Local unique
430 : !
431 0 : IF ( Ipe .eq. Id .AND. I .ne. Global ) THEN
432 0 : Cnt = Cnt + 1
433 0 : Other( Cnt ) = -Global ! Local Tags
434 0 : Pe( Cnt ) = Ipe
435 0 : Tags(L) = -Global ! Global Tags (mark ghost region!)
436 : ENDIF
437 : ELSE
438 0 : Tags(L) = 0
439 : ENDIF
440 : ENDDO
441 :
442 : !
443 : ! Perform over all points local segment
444 : !
445 0 : CALL DecompCreate( Npes, Pe, Cnt, Other, Ghost%Border )
446 :
447 : !
448 : ! Use decompmodule to create global and local portions of Ghost
449 : ! The local version is only on the local PE
450 : !
451 0 : Other = Id
452 0 : CALL DecompCreate( Npes, Other, LocalSize, Tags, Ghost%Local )
453 :
454 : !
455 : ! Copy the decomposition too
456 : !
457 0 : CALL DecompCopy( Decomp, Ghost%Decomp )
458 :
459 : ! Clean up
460 :
461 0 : DEALLOCATE( Other )
462 0 : DEALLOCATE( Tags )
463 0 : DEALLOCATE( Pe )
464 :
465 0 : Ghost%Defined = .TRUE.
466 :
467 : CPP_LEAVE_PROCEDURE( "GHOSTREGULAR1D" )
468 0 : RETURN
469 : !EOC
470 0 : END SUBROUTINE GhostRegular1D
471 : !-----------------------------------------------------------------------
472 :
473 :
474 : !-----------------------------------------------------------------------
475 : !BOP
476 : ! !IROUTINE: GhostRegular2D --- Create a ghost definition for 2-D grid
477 : !
478 : ! !INTERFACE:
479 0 : SUBROUTINE GhostRegular2D( Decomp, Id, Xglobal, Xfrom, Xto, Xwrap, &
480 : Yglobal, Yfrom, Yto, Ywrap, Ghost )
481 : ! !USES:
482 : USE decompmodule, ONLY : DecompCreate, DecompCopy, &
483 : DecompGlobalToLocal, DecompInfo
484 : IMPLICIT NONE
485 : !
486 : ! !INPUT PARAMETERS:
487 : TYPE(DecompType), INTENT( IN ) :: Decomp ! Decomp information
488 : INTEGER, INTENT( IN ) :: Id ! Local PE identifer
489 : INTEGER, INTENT( IN ) :: Xglobal! Total in X
490 : INTEGER, INTENT( IN ) :: Xfrom ! Low index in X
491 : INTEGER, INTENT( IN ) :: Xto ! High index in X
492 : LOGICAL, INTENT( IN ) :: Xwrap ! Wrap in X?
493 : INTEGER, INTENT( IN ) :: Yglobal! Total in X
494 : INTEGER, INTENT( IN ) :: Yfrom ! Distribution in X
495 : INTEGER, INTENT( IN ) :: Yto ! Distribution in Y
496 : LOGICAL, INTENT( IN ) :: Ywrap ! Wrap in Y?
497 :
498 : !
499 : ! !OUTPUT PARAMETERS:
500 : TYPE(GhostType), INTENT( INOUT ) :: Ghost ! Ghost definition
501 : !
502 : !
503 : ! !DESCRIPTION:
504 : ! Creates a ghost definition for a regular 2-D array with the
505 : ! array bounds Xfrom:Xto,Yfrom:Yto.
506 : !
507 : ! If the array bounds are outside of the global domain they may
508 : ! be wrapped around back into the global domain (Xwrap, Ywrap).
509 : ! If the region is not wrapped, it is advisable that the ghost
510 : ! region end at the boundary (which usually requires
511 : ! special case treatment depending on the PE number). If
512 : ! it does not end at the boundary, undefined points are
513 : ! introduced.
514 : !
515 : ! !SYSTEM ROUTINES:
516 : ! ALLOCATE, DEALLOCATE
517 : !
518 : ! !REVISION HISTORY:
519 : ! 00.11.12 Sawyer Creation
520 : !
521 : ! !BUGS:
522 : !
523 : ! There are certain limitations to ghost regions which can be
524 : ! avoided by clean programming practices. If the ghosted region
525 : ! wraps back onto core regions of the same PE, problems can arise.
526 : ! The simple case -- a ghosted region on 1 PE -- is supported in
527 : ! most cases. However, if it wraps back onto the local PE
528 : ! in such a way that more than one ghost points is mapped to
529 : ! one core domain global index, then the code may fail. Note
530 : ! that this is rarely the case if the ghost regions are small
531 : ! and enough processors are used to avoid wrapping back on the
532 : ! local one.
533 : !
534 : ! WARNING: If the domain wraps around in both X and Y there is a
535 : ! the code should be run with at least 2 PEs so that in one of the
536 : ! two dimensions there is no wrap-around onto the same PE.
537 : !
538 : !EOP
539 : !-----------------------------------------------------------------------
540 : !BOC
541 : ! !LOCAL VARIABLES:
542 : INTEGER :: I, J, L, Ipe, Npes, GlobalSize, LocalSize
543 : INTEGER :: Global, Cnt, Local, Xtrue, Ytrue
544 0 : INTEGER, ALLOCATABLE :: Pe(:), Tags(:), Other(:)
545 : !
546 : !
547 : CPP_ENTER_PROCEDURE( "GHOSTREGULAR2D" )
548 :
549 : !
550 : ! Allocate the basic data structures
551 : !
552 0 : CALL DecompInfo( Decomp, Npes, GlobalSize )
553 : CPP_ASSERT_F90( GlobalSize .EQ. Xglobal*Yglobal )
554 :
555 0 : LocalSize = (Xto - Xfrom + 1)*(Yto - Yfrom + 1)
556 : CPP_ASSERT_F90( LocalSize .GE. 0 )
557 0 : ALLOCATE( Pe( LocalSize ) )
558 0 : ALLOCATE( Tags( LocalSize ) )
559 0 : ALLOCATE( Other( LocalSize ) )
560 : !
561 : ! Perform over all points local segment
562 : !
563 0 : Cnt = 0
564 0 : L = 0
565 0 : DO J= Yfrom, Yto
566 0 : Ytrue = MODULO(J-1,Yglobal) + 1
567 0 : DO I= Xfrom, Xto
568 0 : Xtrue = MODULO(I-1,Xglobal) + 1
569 0 : L = L + 1
570 0 : Global = (Ytrue-1)*Xglobal + Xtrue
571 0 : IF ( (Xwrap.OR.(Xtrue==I)) .AND. (Ywrap.OR.(Ytrue==J)) ) THEN
572 0 : Tags( L ) = Global
573 0 : CALL DecompGlobalToLocal( Decomp, Global, Local, Ipe )
574 0 : IF ( Ipe .ne. Id .AND. Ipe .GE. 0 ) THEN
575 0 : Cnt = Cnt + 1
576 0 : Other( Cnt ) = Global ! Local Tags
577 0 : Pe( Cnt ) = Ipe
578 : ENDIF
579 : !
580 : ! Special case: the domain wraps-around onto the same PE. This is
581 : ! very tricky: the ghost points are distinguished from their true
582 : ! local core domain counterparts by a minus sign. This makes the
583 : ! address space in both Ghost%Border and Ghost%Local unique
584 : !
585 0 : IF ( Ipe.EQ.Id .AND. ( I.NE.Xtrue .OR. J.NE.Ytrue ) ) THEN
586 0 : Cnt = Cnt + 1
587 0 : Other( Cnt ) = -Global ! Local Tags
588 0 : Pe( Cnt ) = Ipe
589 0 : Tags(L) = -Global ! Global Tags (mark ghost region!)
590 : ENDIF
591 : ELSE
592 0 : Tags(L) = 0
593 : ENDIF
594 : ENDDO
595 : ENDDO
596 :
597 : !
598 : ! Perform over all points local segment
599 : !
600 0 : CALL DecompCreate( Npes, Pe, Cnt, Other, Ghost%Border )
601 :
602 : !
603 : ! Use decompmodule to create global and local portions of Ghost
604 : ! The local version is only on the local PE
605 : !
606 0 : Other = Id
607 0 : CALL DecompCreate( Npes, Other, LocalSize, Tags, Ghost%Local )
608 :
609 : !
610 : ! Copy the decomposition too
611 : !
612 0 : CALL DecompCopy( Decomp, Ghost%Decomp )
613 :
614 : ! Clean up
615 :
616 0 : DEALLOCATE( Other )
617 0 : DEALLOCATE( Tags )
618 0 : DEALLOCATE( Pe )
619 :
620 0 : Ghost%Defined = .TRUE.
621 :
622 : CPP_LEAVE_PROCEDURE( "GHOSTREGULAR2D" )
623 0 : RETURN
624 : !EOC
625 0 : END SUBROUTINE GhostRegular2D
626 : !-----------------------------------------------------------------------
627 :
628 :
629 : !-----------------------------------------------------------------------
630 : !BOP
631 : ! !IROUTINE: GhostRegular3D --- Create a ghost definition for 3-D grid
632 : !
633 : ! !INTERFACE:
634 7680 : SUBROUTINE GhostRegular3D( Decomp, Id, Xglobal, Xfrom, Xto, Xwrap, &
635 : Yglobal, Yfrom, Yto, Ywrap, &
636 : Zglobal, Zfrom, Zto, Zwrap, Ghost )
637 : ! !USES:
638 : USE decompmodule, ONLY : DecompCreate, DecompCopy, &
639 : DecompGlobalToLocal, DecompInfo
640 : IMPLICIT NONE
641 : !
642 : ! !INPUT PARAMETERS:
643 : TYPE(DecompType), INTENT( IN ) :: Decomp ! Decomp information
644 : INTEGER, INTENT( IN ) :: Id ! Local PE identifer
645 : INTEGER, INTENT( IN ) :: Xglobal! Total in X
646 : INTEGER, INTENT( IN ) :: Xfrom ! Low index in X
647 : INTEGER, INTENT( IN ) :: Xto ! High index in X
648 : LOGICAL, INTENT( IN ) :: Xwrap ! Wrap in X?
649 : INTEGER, INTENT( IN ) :: Yglobal! Total in Y
650 : INTEGER, INTENT( IN ) :: Yfrom ! Distribution in Y
651 : INTEGER, INTENT( IN ) :: Yto ! Distribution in Y
652 : LOGICAL, INTENT( IN ) :: Ywrap ! Wrap in Y?
653 : INTEGER, INTENT( IN ) :: Zglobal! Total in Z
654 : INTEGER, INTENT( IN ) :: Zfrom ! Distribution in Z
655 : INTEGER, INTENT( IN ) :: Zto ! Distribution in Z
656 : LOGICAL, INTENT( IN ) :: Zwrap ! Wrap in Z?
657 : !
658 : ! !OUTPUT PARAMETERS:
659 : TYPE(GhostType), INTENT( INOUT ) :: Ghost ! Ghost definition
660 : !
661 : !
662 : ! !DESCRIPTION:
663 : ! Creates a ghost definition for a regular 3-D array with the
664 : ! array bounds Xfrom:Xto,Yfrom:Yto,Zfrom:Zto.
665 : !
666 : ! If the array bounds are outside of the global domain they may
667 : ! be wrapped around back into the global domain (Xwrap, Ywrap).
668 : ! If the region is not wrapped, it is advisable that the ghost
669 : ! region end at the boundary (which usually requires
670 : ! special case treatment depending on the PE number). If
671 : ! it does not end at the boundary, undefined points are
672 : ! introduced.
673 : !
674 : !
675 : ! !SYSTEM ROUTINES:
676 : ! ALLOCATE, DEALLOCATE
677 : !
678 : ! !REVISION HISTORY:
679 : ! 00.11.12 Sawyer Creation
680 : !
681 : ! !BUGS:
682 : ! There are certain limitations to ghost regions which can be
683 : ! avoided by clean programming practices. If the ghosted region
684 : ! wraps back onto core regions of the same PE, problems can arise.
685 : ! The simple case -- a ghosted region on 1 PE -- is supported in
686 : ! most cases. However, if it wraps back onto the local PE
687 : ! in such a way that more than one ghost points is mapped to
688 : ! one core domain global index, then the code may fail. Note
689 : ! that this is rarely the case if the ghost regions are small
690 : ! and enough processors are used to avoid wrapping back on the
691 : ! local one.
692 : !
693 : ! WARNING: If the domain wraps around in two of the three dims
694 : ! the code should be run with at least 2 PEs so that in one of the
695 : ! two dimensions there is no wrap-around onto the same PE. If it
696 : ! wraps around in all three dimensions it should be run on at least
697 : ! 4 PEs. Note these are extremely rare toriodal cases.
698 : !
699 : !EOP
700 : !-----------------------------------------------------------------------
701 : !BOC
702 : ! !LOCAL VARIABLES:
703 : INTEGER :: I, J, K, L, Ipe, Npes, GlobalSize, LocalSize
704 : INTEGER :: Global, Cnt, Local, Xtrue, Ytrue, Ztrue
705 : LOGICAL :: IsX, IsY, IsZ
706 7680 : INTEGER, ALLOCATABLE :: Pe(:), Tags(:), Other(:)
707 : !
708 : !
709 : CPP_ENTER_PROCEDURE( "GHOSTREGULAR3D" )
710 :
711 : !
712 : ! Allocate the basic data structures
713 : !
714 7680 : CALL DecompInfo( Decomp, Npes, GlobalSize )
715 : CPP_ASSERT_F90( GlobalSize .EQ. Xglobal*Yglobal*Zglobal )
716 :
717 7680 : LocalSize = (Xto-Xfrom+1) * (Yto-Yfrom+1) * (Zto-Zfrom+1)
718 :
719 : CPP_ASSERT_F90( LocalSize .GE. 0 )
720 23040 : ALLOCATE( Pe( LocalSize ) )
721 15360 : ALLOCATE( Tags( LocalSize ) )
722 15360 : ALLOCATE( Other( LocalSize ) )
723 : !
724 : ! Perform over all points local segment
725 : !
726 7680 : Cnt = 0
727 7680 : L = 0
728 30208 : DO K = Zfrom, Zto
729 22528 : Ztrue = MODULO(K-1,Zglobal) + 1
730 174592 : DO J = Yfrom, Yto
731 144384 : Ytrue = MODULO(J-1,Yglobal) + 1
732 41749504 : DO I = Xfrom, Xto
733 41582592 : Xtrue = MODULO(I-1,Xglobal) + 1
734 41582592 : L = L + 1
735 41582592 : Global = ((Ztrue-1)*Yglobal+(Ytrue-1))*Xglobal+Xtrue
736 : !
737 : ! Check to see if this is an defined global index
738 : !
739 41582592 : CALL DecompGlobalToLocal( Decomp, Global, Local, Ipe )
740 : CPP_ASSERT_F90( (Local .GT. 0) .AND. (Ipe .GE. 0) )
741 : !
742 : ! The wrapping case: mark as undefined
743 :
744 41582592 : IsX = Xtrue/=I
745 41582592 : IsY = Ytrue/=J
746 41582592 : IsZ = Ztrue/=K
747 : IF ( (.NOT.Xwrap.AND.IsX) .OR. (.NOT.Ywrap.AND.IsY) &
748 41726976 : .OR. (.NOT.Zwrap.AND.IsZ) ) THEN
749 331776 : Cnt = Cnt + 1
750 331776 : Other( Cnt ) = 0 ! Local Tags
751 331776 : Pe( Cnt ) = Ipe
752 331776 : Tags( L ) = 0
753 41250816 : ELSE IF ( Ipe .ne. Id ) THEN
754 : !
755 : ! Boundary case: Global is in a ghost region not belonging
756 : ! to this PE. Mark it in the border data structure (Arrays Other and Pe)
757 : !
758 23334912 : Cnt = Cnt + 1
759 23334912 : Other( Cnt ) = Global ! Local Tags
760 23334912 : Pe( Cnt ) = Ipe
761 23334912 : Tags( L ) = Global
762 17915904 : ELSE IF ( Ipe==Id .AND. (IsX.OR.IsY.OR.IsZ) ) THEN
763 : !
764 : ! Special case: the domain wraps-around onto the same PE. This is
765 : ! very tricky: the ghost points are distinguished from their true
766 : ! local core domain counterparts by a minus sign. This makes the
767 : ! address space in both Ghost%Border and Ghost%Local unique
768 : !
769 0 : Cnt = Cnt + 1
770 0 : Other( Cnt ) = -Global ! Local Tags
771 0 : Pe( Cnt ) = Ipe
772 0 : Tags(L) = -Global ! Global Tags (mark ghost region!)
773 : ELSE
774 17915904 : Tags( L ) = Global
775 : ENDIF
776 : ENDDO
777 : ENDDO
778 : ENDDO
779 : CPP_ASSERT_F90( LocalSize==L )
780 : !
781 : ! Perform over all points local segment
782 : !
783 7680 : CALL DecompCreate( Npes, Pe, Cnt, Other, Ghost%Border )
784 :
785 : !
786 : ! Use decompmodule to create global and local portions of Ghost
787 : ! The local version is only on the local PE
788 : !
789 41590272 : Other = Id
790 7680 : CALL DecompCreate( Npes, Other, LocalSize, Tags, Ghost%Local )
791 :
792 : !
793 : ! Copy the decomposition too
794 : !
795 7680 : CALL DecompCopy( Decomp, Ghost%Decomp )
796 :
797 : ! Clean up
798 :
799 7680 : DEALLOCATE( Other )
800 7680 : DEALLOCATE( Tags )
801 7680 : DEALLOCATE( Pe )
802 :
803 7680 : Ghost%Defined = .TRUE.
804 :
805 : CPP_LEAVE_PROCEDURE( "GHOSTREGULAR3D" )
806 7680 : RETURN
807 : !EOC
808 15360 : END SUBROUTINE GhostRegular3D
809 : !-----------------------------------------------------------------------
810 :
811 :
812 : !-----------------------------------------------------------------------
813 : !BOP
814 : ! !IROUTINE: GhostRegular4D --- Create a ghost definition for 4-D grid
815 : !
816 : ! !INTERFACE:
817 0 : SUBROUTINE GhostRegular4D( Decomp, Id, Xglobal, Xfrom, Xto, Xwrap, &
818 : Yglobal, Yfrom, Yto, Ywrap, &
819 : Zglobal, Zfrom, Zto, Zwrap, &
820 : Tglobal, Tfrom, Tto, Twrap, Ghost )
821 : ! !USES:
822 : USE decompmodule, ONLY : DecompCreate, DecompCopy, &
823 : DecompGlobalToLocal, DecompInfo
824 : IMPLICIT NONE
825 : !
826 : ! !INPUT PARAMETERS:
827 : TYPE(DecompType), INTENT( IN ) :: Decomp ! Decomp information
828 : INTEGER, INTENT( IN ) :: Id ! Local PE identifer
829 : INTEGER, INTENT( IN ) :: Xglobal! Total in X
830 : INTEGER, INTENT( IN ) :: Xfrom ! Low index in X
831 : INTEGER, INTENT( IN ) :: Xto ! High index in X
832 : LOGICAL, INTENT( IN ) :: Xwrap ! Wrap in X?
833 : INTEGER, INTENT( IN ) :: Yglobal! Total in Y
834 : INTEGER, INTENT( IN ) :: Yfrom ! Distribution in Y
835 : INTEGER, INTENT( IN ) :: Yto ! Distribution in Y
836 : LOGICAL, INTENT( IN ) :: Ywrap ! Wrap in Y?
837 : INTEGER, INTENT( IN ) :: Zglobal! Total in Z
838 : INTEGER, INTENT( IN ) :: Zfrom ! Distribution in Z
839 : INTEGER, INTENT( IN ) :: Zto ! Distribution in Z
840 : LOGICAL, INTENT( IN ) :: Zwrap ! Wrap in Z?
841 : INTEGER, INTENT( IN ) :: Tglobal! Total in T
842 : INTEGER, INTENT( IN ) :: Tfrom ! Distribution in T
843 : INTEGER, INTENT( IN ) :: Tto ! Distribution in T
844 : LOGICAL, INTENT( IN ) :: Twrap ! Wrap in T?
845 : !
846 : ! !OUTPUT PARAMETERS:
847 : TYPE(GhostType), INTENT( INOUT ) :: Ghost ! Ghost definition
848 : !
849 : !
850 : ! !DESCRIPTION:
851 : ! Creates a ghost definition for a regular 3-D array with the
852 : ! array bounds Xfrom:Xto,Yfrom:Yto,Zfrom:Zto,Tfrom:Tto.
853 : !
854 : ! If the array bounds are outside of the global domain they may
855 : ! be wrapped around back into the global domain (Xwrap, Ywrap).
856 : ! If the region is not wrapped, it is advisable that the ghost
857 : ! region end at the boundary (which usually requires
858 : ! special case treatment depending on the PE number). If
859 : ! it does not end at the boundary, undefined points are
860 : ! introduced.
861 : !
862 : ! !SYSTEM ROUTINES:
863 : ! ALLOCATE, DEALLOCATE
864 : !
865 : ! !REVISION HISTORY:
866 : ! 02.12.23 Sawyer Creation from GhostRegular3D
867 : !
868 : ! !BUGS:
869 : ! There are certain limitations to ghost regions which can be
870 : ! avoided by clean programming practices. If the ghosted region
871 : ! wraps back onto core regions of the same PE, problems can arise.
872 : ! The simple case -- a ghosted region on 1 PE -- is supported in
873 : ! most cases. However, if it wraps back onto the local PE
874 : ! in such a way that more than one ghost points is mapped to
875 : ! one core domain global index, then the code may fail. Note
876 : ! that this is rarely the case if the ghost regions are small
877 : ! and enough processors are used to avoid wrapping back on the
878 : ! local one.
879 : !
880 : ! WARNING: If the domain wraps around in two of the three dims
881 : ! the code should be run with at least 2 PEs so that in one of the
882 : ! two dimensions there is no wrap-around onto the same PE. If it
883 : ! wraps around in all three dimensions it should be run on at least
884 : ! 4 PEs. Note these are extremely rare toriodal cases.
885 : !
886 : !EOP
887 : !-----------------------------------------------------------------------
888 : !BOC
889 : ! !LOCAL VARIABLES:
890 : INTEGER :: I, J, K, L, M, Ipe, Npes, GlobalSize, LocalSize
891 : INTEGER :: Global, Cnt, Local, Xtrue, Ytrue, Ztrue, Ttrue
892 : LOGICAL :: IsX, IsY, IsZ, IsT
893 0 : INTEGER, ALLOCATABLE :: Pe(:), Tags(:), Other(:)
894 : !
895 : !
896 : CPP_ENTER_PROCEDURE( "GHOSTREGULAR4D" )
897 :
898 : !
899 : ! Allocate the basic data structures
900 : !
901 0 : CALL DecompInfo( Decomp, Npes, GlobalSize )
902 : CPP_ASSERT_F90( GlobalSize .EQ. Xglobal*Yglobal*Zglobal*Tglobal )
903 :
904 0 : LocalSize = (Xto-Xfrom+1)*(Yto-Yfrom+1)*(Zto-Zfrom+1)*(Tto-Tfrom+1)
905 :
906 : CPP_ASSERT_F90( LocalSize .GE. 0 )
907 0 : ALLOCATE( Pe( LocalSize ) )
908 0 : ALLOCATE( Tags( LocalSize ) )
909 0 : ALLOCATE( Other( LocalSize ) )
910 : !
911 : ! Perform over all points local segment
912 : !
913 0 : Cnt = 0
914 0 : M = 0
915 0 : DO L = Tfrom, Tto
916 0 : Ttrue = MODULO(L-1,Tglobal) + 1
917 0 : DO K = Zfrom, Zto
918 0 : Ztrue = MODULO(K-1,Zglobal) + 1
919 0 : DO J = Yfrom, Yto
920 0 : Ytrue = MODULO(J-1,Yglobal) + 1
921 0 : DO I = Xfrom, Xto
922 0 : Xtrue = MODULO(I-1,Xglobal) + 1
923 0 : M = M + 1
924 : Global = (((Ttrue-1)*Zglobal+(Ztrue-1))*Yglobal+(Ytrue-1)) &
925 0 : *Xglobal+Xtrue
926 : !
927 : ! Check to see if this is an defined global index
928 : !
929 0 : CALL DecompGlobalToLocal( Decomp, Global, Local, Ipe )
930 : CPP_ASSERT_F90( (Local .GT. 0) .AND. (Ipe .GE. 0) )
931 : !
932 : ! The wrapping case: mark as undefined
933 :
934 0 : IsX = Xtrue/=I
935 0 : IsY = Ytrue/=J
936 0 : IsZ = Ztrue/=K
937 0 : IsT = Ttrue/=L
938 : IF ( (.NOT.Xwrap.AND.IsX) .OR. (.NOT.Ywrap.AND.IsY) &
939 0 : .OR. (.NOT.Zwrap.AND.IsZ) .OR. (.NOT.Twrap.AND.IsT) ) THEN
940 0 : Cnt = Cnt + 1
941 0 : Other( Cnt ) = 0 ! Local Tags
942 0 : Pe( Cnt ) = Ipe
943 0 : Tags(M) = 0
944 0 : ELSE IF ( Ipe .ne. Id ) THEN
945 : !
946 : ! Boundary case: Global is in a ghost region not belonging
947 : ! to this PE. Mark it in the border data structure (Arrays Other and Pe)
948 : !
949 0 : Cnt = Cnt + 1
950 0 : Other( Cnt ) = Global ! Local Tags
951 0 : Pe( Cnt ) = Ipe
952 0 : Tags(M) = Global
953 0 : ELSE IF ( Ipe==Id .AND. (IsX.OR.IsY.OR.IsZ.OR.IsT) ) THEN
954 : !
955 : ! Special case: the domain wraps-around onto the same PE. This is
956 : ! very tricky: the ghost points are distinguished from their true
957 : ! local core domain counterparts by a minus sign. This makes the
958 : ! address space in both Ghost%Border and Ghost%Local unique
959 : !
960 0 : Cnt = Cnt + 1
961 0 : Other( Cnt ) = -Global ! Local Tags
962 0 : Pe( Cnt ) = Ipe
963 0 : Tags(M) = -Global ! Global Tags (mark ghost region!)
964 : ELSE
965 0 : Tags(M) = Global
966 : ENDIF
967 : ENDDO
968 : ENDDO
969 : ENDDO
970 : ENDDO
971 : CPP_ASSERT_F90( LocalSize==M )
972 : !
973 : ! Perform over all points local segment
974 : !
975 0 : CALL DecompCreate( Npes, Pe, Cnt, Other, Ghost%Border )
976 :
977 : !
978 : ! Use decompmodule to create global and local portions of Ghost
979 : ! The local version is only on the local PE
980 : !
981 0 : Other = Id
982 0 : CALL DecompCreate( Npes, Other, LocalSize, Tags, Ghost%Local )
983 :
984 : !
985 : ! Copy the decomposition too
986 : !
987 0 : CALL DecompCopy( Decomp, Ghost%Decomp )
988 :
989 : ! Clean up
990 :
991 0 : DEALLOCATE( Other )
992 0 : DEALLOCATE( Tags )
993 0 : DEALLOCATE( Pe )
994 :
995 0 : Ghost%Defined = .TRUE.
996 :
997 : CPP_LEAVE_PROCEDURE( "GHOSTREGULAR4D" )
998 0 : RETURN
999 : !EOC
1000 0 : END SUBROUTINE GhostRegular4D
1001 : !-----------------------------------------------------------------------
1002 :
1003 :
1004 : !-----------------------------------------------------------------------
1005 : !BOP
1006 : ! !IROUTINE: GhostInfo --- Information about ghosted decompostion
1007 : !
1008 : ! !INTERFACE:
1009 27648 : SUBROUTINE GhostInfo( Ghost, Npes, &
1010 : GlobalSize, LocalSize, BorderSize )
1011 : ! !USES:
1012 : USE decompmodule, ONLY : DecompInfo
1013 : IMPLICIT NONE
1014 :
1015 : ! !INPUT PARAMETERS:
1016 : TYPE(GhostType), INTENT( IN ):: Ghost ! Ghost information
1017 :
1018 : ! !INPUT PARAMETERS:
1019 : INTEGER, INTENT( OUT ) :: Npes ! Number of Pes
1020 : INTEGER, INTENT( OUT ) :: GlobalSize ! Size of global domain
1021 : INTEGER, INTENT( OUT ) :: LocalSize ! Size of ghosted local region
1022 : INTEGER, INTENT( OUT ) :: BorderSize ! Size of border
1023 : !
1024 : ! !DESCRIPTION:
1025 : ! Return information about the ghosted region
1026 : !
1027 : ! !SYSTEM ROUTINES:
1028 : !
1029 : ! !REVISION HISTORY:
1030 : ! 00.11.12 Sawyer Creation
1031 : !
1032 : !EOP
1033 : !-----------------------------------------------------------------------
1034 : !BOC
1035 : !
1036 : !
1037 : CPP_ENTER_PROCEDURE( "GHOSTINFO" )
1038 :
1039 27648 : CALL DecompInfo( Ghost%Decomp, Npes, GlobalSize )
1040 27648 : CALL DecompInfo( Ghost%Local, Npes, LocalSize )
1041 27648 : CALL DecompInfo( Ghost%Border, Npes, BorderSize )
1042 :
1043 : CPP_LEAVE_PROCEDURE( "GHOSTINFO" )
1044 27648 : RETURN
1045 : !EOC
1046 : END SUBROUTINE GhostInfo
1047 : !-----------------------------------------------------------------------
1048 :
1049 0 : END MODULE ghostmodule
|
