Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLU_ModCommLists.F90
Go to the documentation of this file.
1 ! *********************************************************************
2 ! * Rocstar Simulation Suite *
3 ! * Copyright@2015, Illinois Rocstar LLC. All rights reserved. *
4 ! * *
5 ! * Illinois Rocstar LLC *
6 ! * Champaign, IL *
7 ! * www.illinoisrocstar.com *
8 ! * sales@illinoisrocstar.com *
9 ! * *
10 ! * License: See LICENSE file in top level of distribution package or *
11 ! * http://opensource.org/licenses/NCSA *
12 ! *********************************************************************
13 ! *********************************************************************
14 ! * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, *
15 ! * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES *
16 ! * OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND *
17 ! * NONINFRINGEMENT. IN NO EVENT SHALL THE CONTRIBUTORS OR *
18 ! * COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER *
19 ! * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, *
20 ! * Arising FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE *
21 ! * USE OR OTHER DEALINGS WITH THE SOFTWARE. *
22 ! *********************************************************************
23 ! ******************************************************************************
24 !
25 ! Purpose: Suite of routines for communication lists.
26 !
27 ! Description: None.
28 !
29 ! Notes: None.
30 !
31 ! ******************************************************************************
32 !
33 ! $Id: RFLU_ModCommLists.F90,v 1.14 2008/12/06 08:44:20 mtcampbe Exp $
34 !
35 ! Copyright: (c) 2004-2006 by the University of Illinois
36 !
37 ! ******************************************************************************
38 
39 MODULE rflu_modcommlists
40 
41  USE modglobal, ONLY: t_global
42  USE moddatatypes
43  USE modparameters
44  USE moderror
45  USE moddatastruct, ONLY: t_region
46  USE modgrid, ONLY: t_grid
47  USE modmpi
48 
49  USE modborder, ONLY: t_border
50 
51  IMPLICIT NONE
52 
53  PRIVATE
54  PUBLIC :: rflu_comm_buildcommlists, &
55  rflu_comm_checkcountborders, &
56  rflu_comm_countborders, &
57  rflu_comm_countbordersserial, &
58  rflu_comm_createbordercntr, &
59  rflu_comm_createborders, &
60  rflu_comm_createcommlists, &
61  rflu_comm_destroybordercntr, &
62  rflu_comm_destroyborders, &
63  rflu_comm_destroycommlists, &
64  rflu_comm_getproclocregids, &
65  rflu_comm_readcommlists, &
66  rflu_comm_writecommlists
67 
68 ! ******************************************************************************
69 ! Declarations and definitions
70 ! ******************************************************************************
71 
72  CHARACTER(CHRLEN) :: &
73  RCSIdentString = '$RCSfile: RFLU_ModCommLists.F90,v $ $Revision: 1.14 $'
74 
75  INTEGER, PARAMETER, PUBLIC :: CREATE_BORDERS_MODE_DIM_KNOWN = 1, &
76  CREATE_BORDERS_MODE_DIM_UNKNOWN = 2
77 
78 ! ******************************************************************************
79 ! Routines
80 ! ******************************************************************************
81 
82  CONTAINS
83 
84 
85 
86 
87 
88 
89 
90 
91 ! ******************************************************************************
92 !
93 ! Purpose: Build communication lists.
94 !
95 ! Description: None.
96 !
97 ! Input:
98 ! regions Data for regions
99 !
100 ! Output: None.
101 !
102 ! Notes: None.
103 !
104 ! ******************************************************************************
105 
106  SUBROUTINE rflu_comm_buildcommlists(regions)
107 
108 ! TEMPORARY
109  USE rflu_modsymmetryperiodic, ONLY: rflu_sype_havesypepatches
110 ! END TEMPORARY
111 
112  IMPLICIT NONE
113 
114 ! ******************************************************************************
115 ! Declarations and definitions
116 ! ******************************************************************************
117 
118 ! ==============================================================================
119 ! Arguments
120 ! ==============================================================================
121 
122  TYPE(t_region), DIMENSION(:), POINTER :: regions
123 
124 ! ==============================================================================
125 ! Local variables
126 ! ==============================================================================
127 
128  TYPE(t_global), POINTER :: global
129 
130 ! TEMPORARY
131  TYPE(t_region), POINTER :: pregionserial
132 ! END TEMPORARY
133 
134 ! ******************************************************************************
135 ! Start
136 ! ******************************************************************************
137 
138  global => regions(0)%global
139 
140  CALL registerfunction(global,'RFLU_COMM_BuildCommLists',&
141  'RFLU_ModCommLists.F90')
142 
143 ! ******************************************************************************
144 ! Call routines
145 ! ******************************************************************************
146 
147  CALL rflu_comm_buildcommlistscells(regions)
148 
149 ! TEMPORARY - At moment, vertex communication lists do not always get built
150 ! correctly. The problem appears to arise when the periodic patches
151 ! get partitioned asymmetrically. It is possible that there are
152 ! multiple bugs, as the error messages for first- and second-order
153 ! runs are not identical. (Example case for which problems occur:
154 ! tubes case.)
155  pregionserial => regions(0)
156 
157  IF ( rflu_sype_havesypepatches(pregionserial) .EQV. .false. ) THEN
158  CALL rflu_comm_buildcommlistsvert(regions)
159  END IF ! RFLU_SYPE_HaveSyPePatches
160 ! END TEMPORARY
161 
162 ! ******************************************************************************
163 ! End
164 ! ******************************************************************************
165 
166  CALL deregisterfunction(global)
167 
168  END SUBROUTINE rflu_comm_buildcommlists
169 
170 
171 
172 
173 
174 
175 
176 
177 ! ******************************************************************************
178 !
179 ! Purpose: Build cell communication lists.
180 !
181 ! Description: None.
182 !
183 ! Input:
184 ! regions Data for regions
185 !
186 ! Output: None.
187 !
188 ! Notes: None.
189 !
190 ! ******************************************************************************
191 
192  SUBROUTINE rflu_comm_buildcommlistscells(regions)
193 
194  USE modsortsearch
195 
196  USE rflu_modsymmetryperiodic, ONLY: rflu_sype_getactualserialcell
197 
198  IMPLICIT NONE
199 
200 ! ******************************************************************************
201 ! Declarations and definitions
202 ! ******************************************************************************
203 
204 ! ==============================================================================
205 ! Arguments
206 ! ==============================================================================
207 
208  TYPE(t_region), DIMENSION(:), POINTER :: regions
209 
210 ! ==============================================================================
211 ! Local variables
212 ! ==============================================================================
213 
214  CHARACTER(CHRLEN) :: errorstring
215  INTEGER :: errorflag,iborder,iborder2, &
216  icg,icgs,icgs2,icg2,icl,ict,ict2,iloc,ireg,ireg2,ireg3,nborders
217  INTEGER, DIMENSION(:,:), ALLOCATABLE :: borderinfo
218  TYPE(t_border), POINTER :: pborder,pborder2
219  TYPE(t_grid), POINTER :: pgrid,pgrid2,pgridserial
220  TYPE(t_global), POINTER :: global
221  TYPE(t_region), POINTER :: pregion,pregion2,pregionserial
222 
223 ! ******************************************************************************
224 ! Start
225 ! ******************************************************************************
226 
227  global => regions(0)%global
228 
229  CALL registerfunction(global,'RFLU_COMM_BuildCommListsCells',&
230  'RFLU_ModCommLists.F90')
231 
232  IF ( global%verbLevel >= verbose_high ) THEN
233  WRITE(stdout,'(A,1X,A)') solver_name, &
234  'Building cell communication lists...'
235  END IF ! global%verbLevel
236 
237 ! ******************************************************************************
238 ! Set pointers
239 ! ******************************************************************************
240 
241  pregionserial => regions(0)
242  pgridserial => pregionserial%grid
243 
244 ! ******************************************************************************
245 ! Determine cells to be received for each region
246 ! ******************************************************************************
247 
248  IF ( global%verbLevel >= verbose_high ) THEN
249  WRITE(stdout,'(A,3X,A)') solver_name, &
250  'Determining cells to be received...'
251  END IF ! global%verbLevel
252 
253  DO ireg = 1,global%nRegions
254  pregion => regions(ireg)
255  pgrid => pregion%grid
256 
257  IF ( global%verbLevel >= verbose_high ) THEN
258  WRITE(stdout,'(A,5X,A,1X,I5.5)') solver_name,'Global region:', &
259  pregion%iRegionGlobal
260  END IF ! global%verbLevel
261 
262 ! ==============================================================================
263 ! Allocate temporary memory and initialize
264 ! ==============================================================================
265 
266  ALLOCATE(borderinfo(2,pgrid%nBorders),stat=errorflag)
267  global%error = errorflag
268  IF ( global%error /= err_none ) THEN
269  CALL errorstop(global,err_allocate,__line__,'borderInfo')
270  END IF ! global%error
271 
272  DO iborder = 1,pgrid%nBorders
273  borderinfo(1,iborder) = pgrid%borderCntr(iborder)
274  borderinfo(2,iborder) = 0
275  END DO ! iBorder
276 
277 ! ==============================================================================
278 ! Loop over virtual cells and count number of cells to be received for each
279 ! border
280 ! ==============================================================================
281 
282  DO icg = pgrid%nCells+1,pgrid%nCellsTot
283  icgs = pgrid%pc2sc(icg)
284 
285 ! ------------------------------------------------------------------------------
286 ! Get region index of cell
287 ! ------------------------------------------------------------------------------
288 
289 ! ----- Actual cell ------------------------------------------------------------
290 
291  IF ( icgs <= pgridserial%nCells ) THEN
292  ireg2 = pgridserial%sc2r(icgs)
293 
294 ! ----- Virtual cell -----------------------------------------------------------
295 
296  ELSE
297  CALL rflu_sype_getactualserialcell(pregionserial,icgs,icgs2)
298 
299  ireg2 = pgridserial%sc2r(icgs2)
300  END IF ! icgs
301 
302 ! ------------------------------------------------------------------------------
303 ! Search for this region in data structure and increment counter
304 ! ------------------------------------------------------------------------------
305 
306  CALL binarysearchinteger(borderinfo(1:1,1:pgrid%nBorders), &
307  pgrid%nBorders,ireg2,iloc)
308 
309  IF ( iloc /= element_not_found ) THEN
310  borderinfo(2,iloc) = borderinfo(2,iloc) + 1
311  ELSE
312  CALL errorstop(global,err_region_id_not_found,__line__)
313  END IF ! iLoc
314  END DO ! icg
315 
316 ! ==============================================================================
317 ! Copy id of neighboring region and number of cells to be received into
318 ! border data structure
319 ! ==============================================================================
320 
321  DO iborder = 1,pgrid%nBorders
322  pgrid%borders(iborder)%iRegionGlobal = borderinfo(1,iborder)
323  pgrid%borders(iborder)%nCellsRecv = borderinfo(2,iborder)
324 
325  ALLOCATE(pgrid%borders(iborder)%icgRecv(borderinfo(2,iborder)), &
326  stat=errorflag)
327  global%error = errorflag
328  IF ( global%error /= err_none ) THEN
329  CALL errorstop(global,err_allocate,__line__,'pGrid%borders%icgRecv')
330  END IF ! global%error
331  END DO ! iBorder
332 
333 ! ==============================================================================
334 ! Build list of cells to be received
335 ! ==============================================================================
336 
337  DO ireg2 = 1,pgrid%nBorders
338  borderinfo(2,ireg2) = 0 ! NOTE DO NOT reinitialize borderInfo(1,:)
339  END DO ! iReg2
340 
341  DO icg = pgrid%nCells+1,pgrid%nCellsTot
342  icgs = pgrid%pc2sc(icg)
343 
344 ! ----- Actual cell ------------------------------------------------------------
345 
346  IF ( icgs <= pgridserial%nCells ) THEN
347  ireg2 = pgridserial%sc2r(icgs)
348 
349 ! ----- Virtual cell -----------------------------------------------------------
350 
351  ELSE
352  CALL rflu_sype_getactualserialcell(pregionserial,icgs,icgs2)
353 
354  ireg2 = pgridserial%sc2r(icgs2)
355  END IF ! icgs
356 
357 ! ------------------------------------------------------------------------------
358 ! Find entry of this neighboring region in border data structure
359 ! ------------------------------------------------------------------------------
360 
361  CALL binarysearchinteger(borderinfo(1:1,1:pgrid%nBorders), &
362  pgrid%nBorders,ireg2,iloc)
363 
364 ! ------------------------------------------------------------------------------
365 ! Increment counter and add cell
366 ! ------------------------------------------------------------------------------
367 
368  IF ( iloc /= element_not_found ) THEN
369  borderinfo(2,iloc) = borderinfo(2,iloc) + 1
370 
371  pgrid%borders(iloc)%icgRecv(borderinfo(2,iloc)) = icg
372  ELSE
373  CALL errorstop(global,err_cell_not_found,__line__)
374  END IF ! iLoc
375  END DO ! icg
376 
377 ! ==============================================================================
378 ! Deallocate temporary memory
379 ! ==============================================================================
380 
381  DEALLOCATE(borderinfo,stat=errorflag)
382  global%error = errorflag
383  IF ( global%error /= err_none ) THEN
384  CALL errorstop(global,err_deallocate,__line__,'borderInfo')
385  END IF ! global%error
386  END DO ! iReg
387 
388  IF ( global%verbLevel >= verbose_high ) THEN
389  WRITE(stdout,'(A,3X,A)') solver_name, &
390  'Determining cells to be received done.'
391  END IF ! global%verbLevel
392 
393 ! ******************************************************************************
394 ! Determine cells to be sent for each region and border of other region
395 ! ******************************************************************************
396 
397  IF ( global%verbLevel >= verbose_high ) THEN
398  WRITE(stdout,'(A,3X,A)') solver_name,'Determining cells to be sent...'
399  END IF ! global%verbLevel
400 
401  DO ireg = 1,global%nRegions
402  pregion => regions(ireg)
403  pgrid => pregion%grid
404 
405  IF ( global%verbLevel >= verbose_high ) THEN
406  WRITE(stdout,'(A,5X,A,1X,I5.5)') solver_name,'Global region:', &
407  pregion%iRegionGlobal
408  END IF ! global%verbLevel
409 
410 ! ==============================================================================
411 ! Loop over borders
412 ! ==============================================================================
413 
414  DO iborder = 1,pgrid%nBorders
415  pborder => pgrid%borders(iborder)
416 
417  ireg2 = pborder%iRegionGlobal
418 
419  pregion2 => regions(ireg2)
420  pgrid2 => pregion2%grid
421 
422 ! ------------------------------------------------------------------------------
423 ! Find index of border of neighboring region whose neighboring region is
424 ! equal to region currently being looped over
425 ! ------------------------------------------------------------------------------
426 
427  innerloop: DO iborder2 = 1,pgrid2%nBorders
428  IF ( pgrid2%borders(iborder2)%iRegionGlobal == ireg ) THEN
429  pborder2 => pgrid2%borders(iborder2)
430 
431 ! --------- Set number of cells to be sent and border id -----------------------
432 
433  pborder2%iBorder = iborder
434  pborder2%nCellsSend = pgrid%borders(iborder)%nCellsRecv
435 
436 ! --------- Allocate memory ----------------------------------------------------
437 
438  ALLOCATE(pborder2%icgSend(pborder2%nCellsSend),stat=errorflag)
439  global%error = errorflag
440  IF ( global%error /= err_none ) THEN
441  CALL errorstop(global,err_allocate,__line__,'pBorder%icgSend')
442  END IF ! global%error
443 
444 ! --------- Loop over cells to be sent and get global index of cell ------------
445 
446  DO icl = 1,pborder2%nCellsSend
447  icg = pborder%icgRecv(icl)
448  ict = pgrid%cellGlob2Loc(1,icg)
449  icgs = pgrid%pc2sc(icg)
450 
451  IF ( icgs > pgridserial%nCells ) THEN
452  CALL rflu_sype_getactualserialcell(pregionserial,icgs,icgs2)
453 
454  icgs = icgs2
455  END IF ! icgs
456 
457 ! ----------- Consistency check
458 
459  ireg3 = pgridserial%sc2r(icgs)
460 
461  IF ( ireg3 /= ireg2 ) THEN
462  WRITE(errorstring,'(2(1X,I7.7))') ireg3,ireg2
463  CALL errorstop(global,err_region_ids_invalid,__line__, &
464  trim(errorstring))
465  END IF ! iReg3
466 
467 ! ----------- Find index of serial cell
468 
469  CALL binarysearchinteger(pgrid2%sc2pc(1:1,1:pgrid2%nCellsTot), &
470  pgrid2%nCellsTot,icgs,iloc)
471 
472 ! ----------- Enter partitioned cell index into list of cells to be sent
473 
474  IF ( iloc /= element_not_found ) THEN
475  icg2 = pgrid2%sc2pc(2,iloc)
476  ict2 = pgrid2%cellGlob2Loc(1,icg2)
477 
478  IF ( icg2 > pgrid2%nCells ) THEN ! Not actual cell
479  CALL errorstop(global,err_cell_kind_invalid,__line__)
480  END IF ! icg2
481 
482  IF ( ict /= ict2 ) THEN
483  WRITE(errorstring,'(2(1X,I2))') ict,ict2
484  CALL errorstop(global,err_cell_type_invalid,__line__, &
485  trim(errorstring))
486  END IF ! ict
487 
488  pborder2%icgSend(icl) = icg2
489  ELSE
490  CALL errorstop(global,err_cell_not_found,__line__)
491  END IF ! iLoc
492  END DO ! icg
493 
494  EXIT innerloop
495  END IF ! pGrid2%borders
496  END DO innerloop
497  END DO ! iBorder
498  END DO ! iReg
499 
500  IF ( global%verbLevel >= verbose_high ) THEN
501  WRITE(stdout,'(A,3X,A)') solver_name,'Determining cells to be sent done.'
502  END IF ! global%verbLevel
503 
504 ! ******************************************************************************
505 ! End
506 ! ******************************************************************************
507 
508  IF ( global%verbLevel >= verbose_high ) THEN
509  WRITE(stdout,'(A,1X,A)') solver_name, &
510  'Building cell communication lists done.'
511  END IF ! global%verbLevel
512 
513  CALL deregisterfunction(global)
514 
515  END SUBROUTINE rflu_comm_buildcommlistscells
516 
517 
518 
519 
520 
521 
522 
523 
524 
525 ! ******************************************************************************
526 !
527 ! Purpose: Build vertex communication lists.
528 !
529 ! Description: None.
530 !
531 ! Input:
532 ! regions Data for regions
533 !
534 ! Output: None.
535 !
536 ! Notes: None.
537 !
538 ! ******************************************************************************
539 
540  SUBROUTINE rflu_comm_buildcommlistsvert(regions)
541 
542  USE modsortsearch
543 
544  USE rflu_modsymmetryperiodic, ONLY: rflu_sype_getrelatedvertex, &
545  rflu_sype_havesypepatches
546  USE rflu_modtopologyutils, ONLY: rflu_buildcellvertlist
547 
548  IMPLICIT NONE
549 
550 ! ******************************************************************************
551 ! Declarations and definitions
552 ! ******************************************************************************
553 
554 ! ==============================================================================
555 ! Arguments
556 ! ==============================================================================
557 
558  TYPE(t_region), DIMENSION(:), POINTER :: regions
559 
560 ! ==============================================================================
561 ! Local variables
562 ! ==============================================================================
563 
564  CHARACTER(CHRLEN) :: errorstring
565  LOGICAL :: foundflag,sypeflag
566  INTEGER :: errorflag,iborder,iborderserial,iborderserial2,iborder2,iloc, &
567  ireg,ireg2,ivg,ivgs,ivgs2,ivg2,ivl,ivl2,ivls2,nvertrecv, &
568  nvertrecvtemp,nvertrecvtempmax,nvertsend,nvertsendtemp, &
569  nvertsendtempmax,nvertshared,nvertsharedtempmax,vlistdim, &
570  vlistdimmax
571  INTEGER, DIMENSION(:), ALLOCATABLE :: ivgrecvtemp,ivgsendtemp, &
572  ivgsharedsorted,ivgsharedtemp, &
573  sortkey,vlist
574  TYPE(t_border), POINTER :: pborder,pborderserial,pborderserial2,pborder2
575  TYPE(t_grid), POINTER :: pgrid,pgrid2,pgridserial
576  TYPE(t_global), POINTER :: global
577  TYPE(t_region), POINTER :: pregion,pregion2,pregionserial
578 
579 ! ******************************************************************************
580 ! Start
581 ! ******************************************************************************
582 
583  global => regions(0)%global
584 
585  CALL registerfunction(global,'RFLU_COMM_BuildCommListsVert',&
586  'RFLU_ModCommLists.F90')
587 
588  IF ( global%verbLevel >= verbose_high ) THEN
589  WRITE(stdout,'(A,1X,A)') solver_name, &
590  'Building vertex communication lists...'
591  END IF ! global%verbLevel
592 
593  pregionserial => regions(0)
594  pgridserial => pregionserial%grid
595 
596 ! ******************************************************************************
597 ! Check whether have symmetry or periodic boundaries in serial region
598 ! ******************************************************************************
599 
600  sypeflag = rflu_sype_havesypepatches(pregionserial)
601 
602 ! ******************************************************************************
603 ! Determine vertices to be received for each region
604 ! ******************************************************************************
605 
606  IF ( global%verbLevel >= verbose_high ) THEN
607  WRITE(stdout,'(A,3X,A)') solver_name,'Determining vertices to be '// &
608  'received and shared...'
609  END IF ! global%verbLevel
610 
611  DO ireg = 1,global%nRegions
612  pregion => regions(ireg)
613  pgrid => pregion%grid
614 
615  IF ( global%verbLevel >= verbose_high ) THEN
616  WRITE(stdout,'(A,5X,A,1X,I5.5)') solver_name,'Global region:', &
617  pregion%iRegionGlobal
618  END IF ! global%verbLevel
619 
620 ! ==============================================================================
621 ! Loop over borders
622 ! ==============================================================================
623 
624  DO iborder = 1,pgrid%nBorders
625  pborder => pgrid%borders(iborder)
626 
627  IF ( global%verbLevel >= verbose_high ) THEN
628  WRITE(stdout,'(A,7X,A,1X,I3)') solver_name,'Border:',iborder
629  END IF ! global%verbLevel
630 
631 ! ------------------------------------------------------------------------------
632 ! Allocate temporary memory for vertex lists
633 ! ------------------------------------------------------------------------------
634 
635 ! TO DO
636 ! Need to find better way of estimating maximum number of vertices
637 ! from given list of cells. Usual estimates likely to be unreliable
638 ! because they assume that boundary effects are negligible, which is
639 ! almost guaranteed NOT to be the case for virtual cells.
640 ! END TO DO
641 
642  nvertsendtempmax = 8*pborder%nCellsSend
643  nvertrecvtempmax = 8*pborder%nCellsRecv
644  nvertsharedtempmax = max(nvertsendtempmax,nvertrecvtempmax)
645 
646  ALLOCATE(ivgsendtemp(nvertsendtempmax),stat=errorflag)
647  global%error = errorflag
648  IF ( global%error /= err_none ) THEN
649  CALL errorstop(global,err_allocate,__line__,'ivgSendTemp')
650  END IF ! global%error
651 
652  ALLOCATE(ivgrecvtemp(nvertrecvtempmax),stat=errorflag)
653  global%error = errorflag
654  IF ( global%error /= err_none ) THEN
655  CALL errorstop(global,err_allocate,__line__,'ivgRecvTemp')
656  END IF ! global%error
657 
658  ALLOCATE(ivgsharedtemp(nvertsharedtempmax),stat=errorflag)
659  global%error = errorflag
660  IF ( global%error /= err_none ) THEN
661  CALL errorstop(global,err_allocate,__line__,'ivgSharedTemp')
662  END IF ! global%error
663 
664 ! ------------------------------------------------------------------------------
665 ! Build list of vertices from list of cells to be sent and received. NOTE
666 ! these lists are NOT the vertices which actually need to be sent and
667 ! received
668 ! ------------------------------------------------------------------------------
669 
670  IF ( pborder%nCellsSend > 0 ) THEN
671  CALL rflu_buildcellvertlist(global,pgrid,pborder%icgSend, &
672  pborder%nCellsSend,ivgsendtemp, &
673  nvertsendtempmax,nvertsendtemp)
674  CALL quicksortinteger(ivgsendtemp(1:nvertsendtemp),nvertsendtemp)
675  ELSE
676  nvertsendtemp = 0
677  END IF ! pBorder%nCellsSend
678 
679  IF ( pborder%nCellsRecv > 0 ) THEN
680  CALL rflu_buildcellvertlist(global,pgrid,pborder%icgRecv, &
681  pborder%nCellsRecv,ivgrecvtemp, &
682  nvertrecvtempmax,nvertrecvtemp)
683  CALL quicksortinteger(ivgrecvtemp(1:nvertrecvtemp),nvertrecvtemp)
684  ELSE
685  nvertrecvtemp = 0
686  END IF ! pBorder%nCellsRecv
687 
688 ! ------------------------------------------------------------------------------
689 ! Build list of shared vertices from vertices which are shared among
690 ! lists of vertices to be sent and received and list of vertices to be
691 ! received as those vertices which are not shared. List of vertices to be
692 ! sent is built below.
693 ! ------------------------------------------------------------------------------
694 
695  IF ( nvertsendtemp > 0 .AND. nvertrecvtemp > 0 ) THEN
696  CALL removecommonsortedintegersfancy(ivgsendtemp(1:nvertsendtemp), &
697  nvertsendtemp,nvertsend, &
698  ivgrecvtemp(1:nvertrecvtemp), &
699  nvertrecvtemp,nvertrecv, &
700  ivgsharedtemp, &
701  nvertsharedtempmax, &
702  nvertshared,errorflag)
703 ! TEMPORARY
704  IF ( errorflag /= err_none ) THEN
705  WRITE(*,*) 'RemoveCommonSortedIntegersFancy returned error!'
706  stop
707  END IF ! errorFlag
708 ! END TEMPORARY
709  ELSE
710  nvertshared = 0
711 
712  IF ( nvertsendtemp > 0 ) THEN
713  nvertsend = nvertsendtemp
714  ELSE
715  nvertsend = 0
716  END IF ! nVertSendTemp
717 
718  IF ( nvertrecvtemp > 0 ) THEN
719  nvertrecv = nvertrecvtemp
720  ELSE
721  nvertrecv = 0
722  END IF ! nVertRecvTemp
723  END IF ! nVertSendTemp
724 
725 ! ------------------------------------------------------------------------------
726 ! Deallocate temporary memory and copy vertex lists
727 ! ------------------------------------------------------------------------------
728 
729  DEALLOCATE(ivgsendtemp,stat=errorflag)
730  global%error = errorflag
731  IF ( global%error /= err_none ) THEN
732  CALL errorstop(global,err_deallocate,__line__,'ivgSendTemp')
733  END IF ! global%error
734 
735  pborder%nVertRecv = nvertrecv
736  pborder%nVertShared = nvertshared
737 
738  IF ( pborder%nVertRecv > 0 ) THEN
739  ALLOCATE(pborder%ivgRecv(pborder%nVertRecv),stat=errorflag)
740  global%error = errorflag
741  IF ( global%error /= err_none ) THEN
742  CALL errorstop(global,err_allocate,__line__,'pBorder%ivgRecv')
743  END IF ! global%error
744  ELSE
745  nullify(pborder%ivgRecv)
746  END IF ! pBorder%nVertRecv
747 
748  IF ( pborder%nVertShared > 0 ) THEN
749  ALLOCATE(pborder%ivgShared(pborder%nVertShared),stat=errorflag)
750  global%error = errorflag
751  IF ( global%error /= err_none ) THEN
752  CALL errorstop(global,err_allocate,__line__,'pBorder%ivgShared')
753  END IF ! global%error
754  ELSE
755  nullify(pborder%ivgShared)
756  END IF ! pBorder%nVertShared
757 
758  DO ivl = 1,pborder%nVertRecv
759  pborder%ivgRecv(ivl) = ivgrecvtemp(ivl)
760  END DO ! ivl
761 
762  DO ivl = 1,pborder%nVertShared
763  pborder%ivgShared(ivl) = ivgsharedtemp(ivl)
764  END DO ! ivl
765 
766  DEALLOCATE(ivgrecvtemp,stat=errorflag)
767  global%error = errorflag
768  IF ( global%error /= err_none ) THEN
769  CALL errorstop(global,err_deallocate,__line__,'ivgRecvTemp')
770  END IF ! global%error
771 
772  DEALLOCATE(ivgsharedtemp,stat=errorflag)
773  global%error = errorflag
774  IF ( global%error /= err_none ) THEN
775  CALL errorstop(global,err_deallocate,__line__,'ivgSharedTemp')
776  END IF ! global%error
777  END DO ! iBorder
778  END DO ! iReg
779 
780  IF ( global%verbLevel >= verbose_high ) THEN
781  WRITE(stdout,'(A,3X,A)') solver_name,'Determining vertices to be '// &
782  'received and shared done.'
783  END IF ! global%verbLevel
784 
785 ! ******************************************************************************
786 ! Make shared vertex lists consistent
787 ! ******************************************************************************
788 
789  IF ( global%verbLevel >= verbose_high ) THEN
790  WRITE(stdout,'(A,3X,A)') solver_name, &
791  'Ensuring consistency of shared-vertex lists...'
792  END IF ! global%verbLevel
793 
794  DO ireg = 1,global%nRegions
795  pregion => regions(ireg)
796  pgrid => pregion%grid
797 
798  IF ( global%verbLevel >= verbose_high) THEN
799  WRITE(stdout,'(A,5X,A,1X,I5.5)') solver_name,'Global region:', &
800  pregion%iRegionGlobal
801  END IF ! global%verbLevel
802 
803  DO iborder = 1,pgrid%nBorders
804  pborder => pgrid%borders(iborder)
805 
806  ireg2 = pborder%iRegionGlobal
807  iborder2 = pborder%iBorder
808 
809  pregion2 => regions(ireg2)
810  pgrid2 => pregion2%grid
811  pborder2 => pgrid2%borders(iborder2)
812 
813  IF ( pborder%nVertShared /= pborder2%nVertShared ) THEN
814  CALL errorstop(global,err_nvertshared_mismatch,__line__)
815  END IF ! pBorder%nVertShared
816 
817  IF ( (ireg2 < ireg) .OR. &
818  ((ireg2 == ireg) .AND. (iborder2 < iborder)) ) THEN
819  DO ivl = 1,pborder%nVertShared
820  ivg = pborder%ivgShared(ivl)
821  ivgs = pgrid%pv2sv(ivg)
822 
823  CALL binarysearchinteger(pgrid2%sv2pv(1:1,1:pgrid2%nVertTot), &
824  pgrid2%nVertTot,ivgs,iloc)
825 
826  IF ( iloc /= element_not_found ) THEN
827  ivg2 = pgrid2%sv2pv(2,iloc)
828 
829  IF ( ivg2 > pgrid2%nVert ) THEN ! Not actual vertex
830  CALL errorstop(global,err_vertex_kind_invalid,__line__)
831  END IF ! ivg2
832 
833  pborder2%ivgShared(ivl) = ivg2
834  ELSE
835  IF ( sypeflag .EQV. .true. ) THEN
836  CALL rflu_sype_getrelatedvertex(pregionserial,pregion2,ivgs,ivg2)
837 
838  pborder2%ivgShared(ivl) = ivg2
839  ELSE
840  CALL errorstop(global,err_vertex_not_found,__line__)
841  END IF ! sypeFlag
842  END IF ! iLoc
843  END DO ! ivl
844  END IF ! iReg2
845  END DO ! iBorder
846  END DO ! iReg
847 
848  IF ( global%verbLevel >= verbose_high ) THEN
849  WRITE(stdout,'(A,3X,A)') solver_name,'Ensuring consistency of '// &
850  'shared-vertex lists done.'
851  END IF ! global%verbLevel
852 
853 ! ******************************************************************************
854 ! Determine vertices to be sent for each region and border of other region
855 ! ******************************************************************************
856 
857  IF ( global%verbLevel >= verbose_high ) THEN
858  WRITE(stdout,'(A,3X,A)') solver_name, &
859  'Determining vertices to be sent...'
860  END IF ! global%verbLevel
861 
862  DO ireg = 1,global%nRegions
863  pregion => regions(ireg)
864  pgrid => pregion%grid
865 
866  IF ( global%verbLevel >= verbose_high) THEN
867  WRITE(stdout,'(A,5X,A,1X,I5.5)') solver_name,'Global region:', &
868  pregion%iRegionGlobal
869  END IF ! global%verbLevel
870 
871 ! ==============================================================================
872 ! Loop over borders
873 ! ==============================================================================
874 
875  DO iborder = 1,pgrid%nBorders
876  pborder => pgrid%borders(iborder)
877 
878 ! ------------------------------------------------------------------------------
879 ! Find index of border of neighboring region whose neighboring region is
880 ! equal to region currently being looped over
881 ! ------------------------------------------------------------------------------
882 
883  ireg2 = pborder%iRegionGlobal
884  iborder2 = pborder%iBorder
885 
886  pregion2 => regions(ireg2)
887  pgrid2 => pregion2%grid
888  pborder2 => pgrid2%borders(iborder2)
889 
890 ! ----- Set number of vertices to be sent --------------------------------------
891 
892  pborder2%nVertSend = pborder%nVertRecv
893 
894 ! ----- Allocate memory --------------------------------------------------------
895 
896  IF ( pborder2%nVertSend > 0 ) THEN
897  ALLOCATE(pborder2%ivgSend(pborder2%nVertSend),stat=errorflag)
898  global%error = errorflag
899  IF ( global%error /= err_none ) THEN
900  CALL errorstop(global,err_allocate,__line__,'pBorder%ivgSend')
901  END IF ! global%error
902  ELSE
903  nullify(pborder2%ivgSend)
904  END IF ! pBorder2%nVertSend
905 
906 ! ----- Loop over vertices to be sent and get global index of vertex -----------
907 
908  DO ivl = 1,pborder2%nVertSend
909  ivg = pborder%ivgRecv(ivl)
910  ivgs = pgrid%pv2sv(ivg)
911 
912 ! ------- Find index of serial vertex
913 
914  CALL binarysearchinteger(pgrid2%sv2pv(1:1,1:pgrid2%nVertTot), &
915  pgrid2%nVertTot,ivgs,iloc)
916 
917 ! ------- Enter partitioned vertex index into list of vertices to be sent
918 
919  IF ( iloc /= element_not_found ) THEN
920  ivg2 = pgrid2%sv2pv(2,iloc)
921 
922  IF ( ivg2 > pgrid2%nVert ) THEN ! Not actual vertex
923  CALL errorstop(global,err_vertex_kind_invalid,__line__)
924  END IF ! ivg2
925 
926  pborder2%ivgSend(ivl) = ivg2
927  ELSE
928  IF ( sypeflag .EQV. .true. ) THEN
929  CALL rflu_sype_getrelatedvertex(pregionserial,pregion2,ivgs,ivg2)
930 
931  pborder2%ivgSend(ivl) = ivg2
932  ELSE
933  CALL errorstop(global,err_vertex_not_found,__line__)
934  END IF ! sypeFlag
935  END IF ! iLoc
936  END DO ! ivl
937  END DO ! iBorder
938  END DO ! iReg
939 
940  IF ( global%verbLevel >= verbose_high ) THEN
941  WRITE(stdout,'(A,3X,A)') solver_name, &
942  'Determining vertices to be sent done.'
943  END IF ! global%verbLevel
944 
945 ! ******************************************************************************
946 ! End
947 ! ******************************************************************************
948 
949  IF ( global%verbLevel >= verbose_high ) THEN
950  WRITE(stdout,'(A,1X,A)') solver_name, &
951  'Building vertex communication lists done.'
952  END IF ! global%verbLevel
953 
954  CALL deregisterfunction(global)
955 
956  END SUBROUTINE rflu_comm_buildcommlistsvert
957 
958 
959 
960 
961 
962 
963 
964 
965 
966 ! ******************************************************************************
967 !
968 ! Purpose: Check counting of number of borders.
969 !
970 ! Description: None.
971 !
972 ! Input:
973 ! regions Regions data
974 !
975 ! Output: None.
976 !
977 ! Notes:
978 ! 1. Needed because when have too many partitions, in particular with higher-
979 ! order scheme, can have virtual layers extend through a neighboring region
980 ! into another region. This becomes a problem because in these cases, the
981 ! communication pattern may become asymmetric, i.e., region A may need to
982 ! receive data from region B, but region B may NOT need to receive data
983 ! from region A. Because the routine which counts the number of borders
984 ! of a given region determines the number of borders by the number of
985 ! regions from which data needs to be received, the count can be
986 ! incomplete. For example, in one ACM case, region 25 needed to receive
987 ! 2 cells from region 20, but region 20 did not need to receive any data
988 ! from region 25. Then the communication pattern is wrong, because region
989 ! 25 would not send anything to 20. This routine checks whether the
990 ! communication pattern in symmetric and makes it symmetric if necessary.
991 !
992 ! ******************************************************************************
993 
994  SUBROUTINE rflu_comm_checkcountborders(regions)
995 
996  USE modsortsearch
997 
998  IMPLICIT NONE
999 
1000 ! ******************************************************************************
1001 ! Declarations and definitions
1002 ! ******************************************************************************
1003 
1004 ! ==============================================================================
1005 ! Arguments
1006 ! ==============================================================================
1007 
1008  TYPE(t_region), DIMENSION(:), POINTER :: regions
1009 
1010 ! ==============================================================================
1011 ! Locals
1012 ! ==============================================================================
1013 
1014  INTEGER :: errorflag,iborder,iborder2,iloc,ireg,ireg2
1015  INTEGER, DIMENSION(:), ALLOCATABLE :: bordercntr
1016  TYPE(t_global), POINTER :: global
1017  TYPE(t_grid), POINTER :: pgrid,pgrid2
1018  TYPE(t_region), POINTER :: pregion,pregion2
1019 
1020 ! ******************************************************************************
1021 ! Start
1022 ! ******************************************************************************
1023 
1024  global => regions(1)%global
1025 
1026  CALL registerfunction(global,'RFLU_COMM_CheckCountBorders',&
1027  'RFLU_ModCommLists.F90')
1028 
1029  IF ( global%verbLevel >= verbose_high ) THEN
1030  WRITE(stdout,'(A,1X,A)') solver_name,'Checking counting of borders...'
1031  END IF ! global%verbLevel
1032 
1033 ! ******************************************************************************
1034 !
1035 ! ******************************************************************************
1036 
1037  DO ireg = 1,global%nRegionsLocal
1038  pregion => regions(ireg)
1039  pgrid => pregion%grid
1040 
1041  IF ( global%verbLevel >= verbose_high) THEN
1042  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
1043  pregion%iRegionGlobal
1044  END IF ! global%verbLevel
1045 
1046  DO iborder = 1,pgrid%nBorders
1047  ireg2 = pgrid%borderCntr(iborder)
1048 
1049  pregion2 => regions(ireg2)
1050  pgrid2 => pregion2%grid
1051 
1052  CALL binarysearchinteger(pgrid2%borderCntr(1:pgrid2%nBorders), &
1053  pgrid2%nBorders,ireg,iloc)
1054 
1055  IF ( iloc == element_not_found ) THEN
1056  global%warnCounter = global%warnCounter + 1
1057 
1058  IF ( global%verbLevel >= verbose_none ) THEN
1059  WRITE(stdout,'(A,3X,A,2(1X,A,1X,I5),A)') solver_name, &
1060  '*** WARNING ***','Border asymmetry between regions', &
1061  ireg,'and',ireg2,'.'
1062  WRITE(stdout,'(A,19X,A,1X,I5,A)') solver_name, &
1063  'Correcting border data structure for region',ireg2,'.'
1064  END IF ! global%verbLevel
1065 
1066  IF ( pgrid2%nBorders == SIZE(pgrid2%borderCntr) ) THEN
1067  ALLOCATE(bordercntr(pgrid2%nBorders),stat=errorflag)
1068  global%error = errorflag
1069  IF ( global%error /= err_none ) THEN
1070  CALL errorstop(global,err_allocate,__line__,'borderCntr')
1071  END IF ! global%error
1072 
1073  DO iborder2 = 1,pgrid2%nBorders
1074  bordercntr(iborder2) = pgrid2%borderCntr(iborder2)
1075  END DO ! iBorder2
1076 
1077  CALL rflu_comm_destroybordercntr(pregion2)
1078  CALL rflu_comm_createbordercntr(pregion2,2*pgrid2%nBorders)
1079 
1080  DO iborder2 = 1,pgrid2%nBorders
1081  pgrid2%borderCntr(iborder2) = bordercntr(iborder2)
1082  END DO ! iBorder2
1083 
1084  DO iborder2 = pgrid2%nBorders+1,SIZE(pgrid2%borderCntr)
1085  pgrid2%borderCntr(iborder2) = 0
1086  END DO ! iBorder2
1087 
1088  DEALLOCATE(bordercntr,stat=errorflag)
1089  global%error = errorflag
1090  IF ( global%error /= err_none ) THEN
1091  CALL errorstop(global,err_deallocate,__line__,'borderCntr')
1092  END IF ! global%error
1093  END IF ! pGrid2%nBorders
1094 
1095  pgrid2%nBorders = pgrid2%nBorders + 1
1096 
1097  pgrid2%borderCntr(pgrid2%nBorders) = ireg
1098 
1099  CALL quicksortinteger(pgrid2%borderCntr(1:pgrid2%nBorders), &
1100  pgrid2%nBorders)
1101  END IF ! iLoc
1102  END DO ! iBorder
1103  END DO ! iReg
1104 
1105 ! ******************************************************************************
1106 ! End
1107 ! ******************************************************************************
1108 
1109  IF ( global%verbLevel >= verbose_high ) THEN
1110  WRITE(stdout,'(A,1X,A)') solver_name,'Checking counting of borders done.'
1111  END IF ! global%verbLevel
1112 
1113  CALL deregisterfunction(global)
1114 
1115  END SUBROUTINE rflu_comm_checkcountborders
1116 
1117 
1118 
1119 
1120 
1121 
1122 
1123 
1124 
1125 
1126 ! ******************************************************************************
1127 !
1128 ! Purpose: Count number of borders
1129 !
1130 ! Description: None.
1131 !
1132 ! Input:
1133 ! pRegion Pointer to region
1134 ! pRegionSerial Pointer to serial region
1135 !
1136 ! Output: None.
1137 !
1138 ! Notes: None.
1139 !
1140 ! ******************************************************************************
1141 
1142  SUBROUTINE rflu_comm_countborders(pRegion,pRegionSerial)
1143 
1144  USE modsortsearch
1145 
1146  USE rflu_modsymmetryperiodic, ONLY: rflu_sype_getactualserialcell, &
1147  rflu_sype_havesypepatches
1148 
1149  IMPLICIT NONE
1150 
1151 ! ******************************************************************************
1152 ! Declarations and definitions
1153 ! ******************************************************************************
1154 
1155 ! ==============================================================================
1156 ! Arguments
1157 ! ==============================================================================
1158 
1159  TYPE(t_region), POINTER :: pregion,pregionserial
1160 
1161 ! ==============================================================================
1162 ! Locals
1163 ! ==============================================================================
1164 
1165  LOGICAL :: sypeflag
1166  INTEGER :: errorflag,iborder,icg,icgs,icgs2,iloc,ireg,ireg2,nbordersmax
1167  INTEGER, DIMENSION(:), ALLOCATABLE :: bordercntr
1168  TYPE(t_global), POINTER :: global
1169  TYPE(t_grid), POINTER :: pgrid,pgridserial
1170 
1171 ! ******************************************************************************
1172 ! Start
1173 ! ******************************************************************************
1174 
1175  global => pregion%global
1176 
1177  CALL registerfunction(global,'RFLU_COMM_CountBorders',&
1178  'RFLU_ModCommLists.F90')
1179 
1180  IF ( global%verbLevel >= verbose_high ) THEN
1181  WRITE(stdout,'(A,1X,A)') solver_name,'Counting borders...'
1182  END IF ! global%verbLevel
1183 
1184  IF ( global%verbLevel >= verbose_high ) THEN
1185  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
1186  pregion%iRegionGlobal
1187  END IF ! global%verbLevel
1188 
1189 ! ******************************************************************************
1190 ! Set pointers and initialize
1191 ! ******************************************************************************
1192 
1193  pgrid => pregion%grid
1194  pgridserial => pregionserial%grid
1195 
1196 ! ******************************************************************************
1197 ! Check whether have symmetry or periodic boundaries in serial region
1198 ! ******************************************************************************
1199 
1200  sypeflag = rflu_sype_havesypepatches(pregionserial)
1201 
1202 ! ******************************************************************************
1203 ! Loop over virtual cells and increment border counter
1204 ! ******************************************************************************
1205 
1206  pgrid%nBorders = 0
1207 
1208  DO icg = pgrid%nCells+1,pgrid%nCellsTot
1209  icgs = pgrid%pc2sc(icg)
1210  ireg = pgridserial%sc2r(icgs)
1211 
1212  IF ( ireg /= pregion%iRegionGlobal ) THEN
1213  IF ( pgrid%nBorders > 0 ) THEN
1214  CALL binarysearchinteger(pgrid%borderCntr(1:pgrid%nBorders), &
1215  pgrid%nBorders,ireg,iloc)
1216  ELSE
1217  iloc = element_not_found
1218  END IF ! pGrid%nBorders
1219  ELSE
1220  IF ( sypeflag .EQV. .true. ) THEN
1221  IF ( icgs > pgridserial%nCells ) THEN
1222  CALL rflu_sype_getactualserialcell(pregionserial,icgs,icgs2)
1223 
1224  ireg = pgridserial%sc2r(icgs2)
1225 
1226  IF ( pgrid%nBorders > 0 ) THEN
1227  CALL binarysearchinteger(pgrid%borderCntr(1:pgrid%nBorders), &
1228  pgrid%nBorders,ireg,iloc)
1229  ELSE
1230  iloc = element_not_found
1231  END IF ! pGrid%nBorders
1232  ELSE
1233 ! TEMPORARY
1234  WRITE(*,*) 'ERROR!'
1235  stop
1236 ! END TEMPORARY
1237  END IF ! icgs
1238  ELSE
1239 ! TEMPORARY
1240  WRITE(*,*) 'ERROR!'
1241  stop
1242 ! END TEMPORARY
1243  END IF ! syPeFlag
1244  END IF ! pGrid%nBorders
1245 
1246  IF ( iloc == element_not_found ) THEN
1247  IF ( pgrid%nBorders == SIZE(pgrid%borderCntr) ) THEN
1248  ALLOCATE(bordercntr(pgrid%nBorders),stat=errorflag)
1249  global%error = errorflag
1250  IF ( global%error /= err_none ) THEN
1251  CALL errorstop(global,err_allocate,__line__,'borderCntr')
1252  END IF ! global%error
1253 
1254  DO iborder = 1,pgrid%nBorders
1255  bordercntr(iborder) = pgrid%borderCntr(iborder)
1256  END DO ! iBorder
1257 
1258  CALL rflu_comm_destroybordercntr(pregion)
1259  CALL rflu_comm_createbordercntr(pregion,2*pgrid%nBorders)
1260 
1261  DO iborder = 1,pgrid%nBorders
1262  pgrid%borderCntr(iborder) = bordercntr(iborder)
1263  END DO ! iBorder
1264 
1265  DO iborder = pgrid%nBorders+1,SIZE(pgrid%borderCntr)
1266  pgrid%borderCntr(iborder) = 0
1267  END DO ! iBorder
1268 
1269  DEALLOCATE(bordercntr,stat=errorflag)
1270  global%error = errorflag
1271  IF ( global%error /= err_none ) THEN
1272  CALL errorstop(global,err_deallocate,__line__,'borderCntr')
1273  END IF ! global%error
1274  END IF ! pGrid%nBorders
1275 
1276  pgrid%nBorders = pgrid%nBorders + 1
1277 
1278  pgrid%borderCntr(pgrid%nBorders) = ireg
1279 
1280  CALL quicksortinteger(pgrid%borderCntr(1:pgrid%nBorders), &
1281  pgrid%nBorders)
1282  END IF ! iLoc
1283  END DO ! icg
1284 
1285 ! ******************************************************************************
1286 ! Check that do not have any virtual cells which are mapped to own region if
1287 ! do not have any symmetry or periodic patches
1288 ! ******************************************************************************
1289 
1290  IF ( sypeflag .EQV. .false. ) THEN
1291  CALL binarysearchinteger(pgrid%borderCntr(1:pgrid%nBorders), &
1292  pgrid%nBorders,pregion%iRegionGlobal,iloc)
1293  IF ( iloc /= element_not_found ) THEN
1294  CALL errorstop(global,err_partition_invalid,__line__)
1295  END IF ! iLoc
1296  END IF ! syPeFlag
1297 
1298 ! ******************************************************************************
1299 ! Write info
1300 ! ******************************************************************************
1301 
1302  IF ( global%verbLevel >= verbose_high ) THEN
1303  WRITE(stdout,'(A,3X,A,1X,I3)') solver_name,'Number of borders:', &
1304  pgrid%nBorders
1305  END IF ! global%verbLevel
1306 
1307 ! ******************************************************************************
1308 ! End
1309 ! ******************************************************************************
1310 
1311  IF ( global%verbLevel >= verbose_high ) THEN
1312  WRITE(stdout,'(A,1X,A)') solver_name,'Counting borders done.'
1313  END IF ! global%verbLevel
1314 
1315  CALL deregisterfunction(global)
1316 
1317  END SUBROUTINE rflu_comm_countborders
1318 
1319 
1320 
1321 
1322 
1323 
1324 
1325 
1326 ! ******************************************************************************
1327 !
1328 ! Purpose: Count number of borders for serial region.
1329 !
1330 ! Description: None.
1331 !
1332 ! Input:
1333 ! pRegion Pointer to serial region
1334 !
1335 ! Output: None.
1336 !
1337 ! Notes: None.
1338 !
1339 ! ******************************************************************************
1340 
1341  SUBROUTINE rflu_comm_countbordersserial(pRegion)
1342 
1343  USE modbndpatch, ONLY: t_patch
1344 
1345  IMPLICIT NONE
1346 
1347 ! ******************************************************************************
1348 ! Declarations and definitions
1349 ! ******************************************************************************
1350 
1351 ! ==============================================================================
1352 ! Arguments
1353 ! ==============================================================================
1354 
1355  TYPE(t_region), POINTER :: pregion
1356 
1357 ! ==============================================================================
1358 ! Locals
1359 ! ==============================================================================
1360 
1361  INTEGER :: errorflag,ipatch
1362  TYPE(t_global), POINTER :: global
1363  TYPE(t_grid), POINTER :: pgrid
1364  TYPE(t_patch), POINTER :: ppatch
1365 
1366 ! ******************************************************************************
1367 ! Start
1368 ! ******************************************************************************
1369 
1370  global => pregion%global
1371 
1372  CALL registerfunction(global,'RFLU_COMM_CountBordersSerial',&
1373  'RFLU_ModCommLists.F90')
1374 
1375  IF ( global%verbLevel >= verbose_high ) THEN
1376  WRITE(stdout,'(A,1X,A)') solver_name,'Counting serial borders...'
1377  END IF ! global%verbLevel
1378 
1379  IF ( pregion%iRegionGlobal /= 0 ) THEN
1380  CALL errorstop(global,err_region_id_invalid,__line__)
1381  END IF ! pRegion%iRegionGlobal
1382 
1383 ! ******************************************************************************
1384 ! Set grid pointers
1385 ! ******************************************************************************
1386 
1387  pgrid => pregion%grid
1388 
1389 ! ******************************************************************************
1390 ! Count number of borders
1391 ! ******************************************************************************
1392 
1393  pgrid%nBorders = 0
1394 
1395  DO ipatch = 1,pgrid%nPatches
1396  ppatch => pregion%patches(ipatch)
1397 
1398  IF ( (ppatch%bcType == bc_symmetry) .OR. &
1399  (ppatch%bcType == bc_periodic) ) THEN
1400  pgrid%nBorders = pgrid%nBorders + 1
1401 
1402  ppatch%iBorder = pgrid%nBorders
1403  ELSE
1404  ppatch%iBorder = patch_iborder_default
1405  END IF ! pPatch%bcType
1406  END DO ! iPatch
1407 
1408  IF ( global%verbLevel >= verbose_high ) THEN
1409  WRITE(stdout,'(A,3X,A,1X,I3)') solver_name,'Number of borders:', &
1410  pgrid%nBorders
1411  END IF ! global%verbLevel
1412 
1413 ! ******************************************************************************
1414 ! End
1415 ! ******************************************************************************
1416 
1417  IF ( global%verbLevel >= verbose_high ) THEN
1418  WRITE(stdout,'(A,1X,A)') solver_name,'Counting serial borders done.'
1419  END IF ! global%verbLevel
1420 
1421  CALL deregisterfunction(global)
1422 
1423  END SUBROUTINE rflu_comm_countbordersserial
1424 
1425 
1426 
1427 
1428 
1429 
1430 ! ******************************************************************************
1431 !
1432 ! Purpose: Create border counter.
1433 !
1434 ! Description: None.
1435 !
1436 ! Input:
1437 ! pRegion Pointer to region
1438 ! nBordersMaxOpt Desired Size of borderCntr array
1439 !
1440 ! Output: None.
1441 !
1442 ! Notes: None.
1443 !
1444 ! ******************************************************************************
1445 
1446  SUBROUTINE rflu_comm_createbordercntr(pRegion,nBordersMaxOpt)
1447 
1448  IMPLICIT NONE
1449 
1450 ! ******************************************************************************
1451 ! Declarations and definitions
1452 ! ******************************************************************************
1453 
1454 ! ==============================================================================
1455 ! Arguments
1456 ! ==============================================================================
1457 
1458  INTEGER, INTENT(IN), OPTIONAL :: nbordersmaxopt
1459  TYPE(t_region), POINTER :: pregion
1460 
1461 ! ==============================================================================
1462 ! Locals
1463 ! ==============================================================================
1464 
1465  INTEGER :: errorflag,iborder,nborders,nbordersmax
1466  TYPE(t_global), POINTER :: global
1467  TYPE(t_grid), POINTER :: pgrid
1468 
1469 ! ******************************************************************************
1470 ! Start
1471 ! ******************************************************************************
1472 
1473  global => pregion%global
1474 
1475  CALL registerfunction(global,'RFLU_COMM_CreateBorderCntr',&
1476  'RFLU_ModCommLists.F90')
1477 
1478 ! ******************************************************************************
1479 ! Set grid pointer and variables
1480 ! ******************************************************************************
1481 
1482  pgrid => pregion%grid
1483 
1484  nbordersmax = 10 ! Nominal maximum number of borders
1485 
1486 ! ******************************************************************************
1487 ! Allocate memory
1488 ! ******************************************************************************
1489 
1490  IF ( present(nbordersmaxopt) ) THEN
1491  nborders = nbordersmaxopt
1492  ELSE
1493  nborders = nbordersmax
1494  END IF ! PRESENT
1495 
1496  ALLOCATE(pgrid%borderCntr(nborders),stat=errorflag)
1497  global%error = errorflag
1498  IF ( global%error /= err_none ) THEN
1499  CALL errorstop(global,err_allocate,__line__,'pGrid%borderCntr')
1500  END IF ! global%error
1501 
1502  DO iborder = 1,nborders
1503  pgrid%borderCntr(iborder) = 0
1504  END DO ! iBorder
1505 
1506 ! ******************************************************************************
1507 ! End
1508 ! ******************************************************************************
1509 
1510  CALL deregisterfunction(global)
1511 
1512  END SUBROUTINE rflu_comm_createbordercntr
1513 
1514 
1515 
1516 
1517 
1518 
1519 
1520 
1521 ! ******************************************************************************
1522 !
1523 ! Purpose: Create borders
1524 !
1525 ! Description: None.
1526 !
1527 ! Input:
1528 ! pRegion Pointer to region
1529 ! createMode Creation mode
1530 !
1531 ! Output: None.
1532 !
1533 ! Notes: None.
1534 !
1535 ! ******************************************************************************
1536 
1537  SUBROUTINE rflu_comm_createborders(pRegion,createMode)
1538 
1539  IMPLICIT NONE
1540 
1541 ! ******************************************************************************
1542 ! Declarations and definitions
1543 ! ******************************************************************************
1544 
1545 ! ==============================================================================
1546 ! Arguments
1547 ! ==============================================================================
1548 
1549  INTEGER, INTENT(IN), OPTIONAL :: createmode
1550  TYPE(t_region), POINTER :: pregion
1551 
1552 ! ==============================================================================
1553 ! Locals
1554 ! ==============================================================================
1555 
1556  INTEGER :: errorflag,iborder
1557  TYPE(t_global), POINTER :: global
1558  TYPE(t_border), POINTER :: pborder
1559  TYPE(t_grid), POINTER :: pgrid
1560 
1561 ! ******************************************************************************
1562 ! Start
1563 ! ******************************************************************************
1564 
1565  global => pregion%global
1566 
1567  CALL registerfunction(global,'RFLU_COMM_CreateBorders',&
1568  'RFLU_ModCommLists.F90')
1569 
1570  IF ( global%myProcid == masterproc .AND. &
1571  global%verbLevel >= verbose_high ) THEN
1572  WRITE(stdout,'(A,1X,A)') solver_name,'Creating borders...'
1573  END IF ! global%myProcid
1574 
1575  IF ( global%myProcid == masterproc .AND. &
1576  global%verbLevel >= verbose_high ) THEN
1577  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
1578  pregion%iRegionGlobal
1579  END IF ! global%myProcid
1580 
1581 ! ******************************************************************************
1582 ! Set grid pointer
1583 ! ******************************************************************************
1584 
1585  pgrid => pregion%grid
1586 
1587 ! ******************************************************************************
1588 ! Allocate memory
1589 ! ******************************************************************************
1590 
1591  IF ( pgrid%nBorders > 0 ) THEN
1592  ALLOCATE(pgrid%borders(pgrid%nBorders),stat=errorflag)
1593  global%error = errorflag
1594  IF ( global%error /= err_none ) THEN
1595  CALL errorstop(global,err_allocate,__line__,'pGrid%borders')
1596  END IF ! global%error
1597  ELSE
1598  nullify(pgrid%borders)
1599  END IF ! pGrid%nBorders
1600 
1601 ! ******************************************************************************
1602 ! Initialize. NOTE in preprocessor do not know dimensions when borders are
1603 ! created (only know the number), but in postprocessor and solver DO know
1604 ! dimensions. NOTE only initialize iProc and iRegionLocal, will be set later
1605 ! in RFLU_COMM_GetProcLocRegIds.
1606 ! ******************************************************************************
1607 
1608  IF ( present(createmode) ) THEN
1609  IF ( createmode == create_borders_mode_dim_known ) THEN
1610  DO iborder = 1,pgrid%nBorders
1611  pborder => pgrid%borders(iborder)
1612 
1613  pborder%iRegionGlobal = pgrid%borderInfo(border_info_irglob,iborder)
1614  pborder%iBorder = pgrid%borderInfo(border_info_ibord ,iborder)
1615  pborder%nCellsSend = pgrid%borderInfo(border_info_ncsend,iborder)
1616  pborder%nCellsRecv = pgrid%borderInfo(border_info_ncrecv,iborder)
1617  pborder%nVertSend = pgrid%borderInfo(border_info_nvsend,iborder)
1618  pborder%nVertRecv = pgrid%borderInfo(border_info_nvrecv,iborder)
1619  pborder%nVertShared = pgrid%borderInfo(border_info_nvshar,iborder)
1620 
1621  pborder%iProc = crazy_value_int
1622  pborder%iRegionLocal = crazy_value_int
1623  END DO ! iBorder
1624  ELSE
1625  DO iborder = 1,pgrid%nBorders
1626  pborder => pgrid%borders(iborder)
1627 
1628  pborder%iRegionGlobal = crazy_value_int
1629  pborder%iBorder = crazy_value_int
1630 
1631  pborder%nCellsSend = 0
1632  pborder%nCellsRecv = 0
1633  pborder%nVertSend = 0
1634  pborder%nVertRecv = 0
1635  pborder%nVertShared = 0
1636 
1637  pborder%iProc = crazy_value_int
1638  pborder%iRegionLocal = crazy_value_int
1639  END DO ! iBorder
1640  END IF ! createMode
1641  END IF ! PRESENT
1642 
1643 ! ******************************************************************************
1644 ! End
1645 ! ******************************************************************************
1646 
1647  IF ( global%myProcid == masterproc .AND. &
1648  global%verbLevel >= verbose_high ) THEN
1649  WRITE(stdout,'(A,1X,A)') solver_name,'Creating borders done.'
1650  END IF ! global%myProcid
1651 
1652  CALL deregisterfunction(global)
1653 
1654  END SUBROUTINE rflu_comm_createborders
1655 
1656 
1657 
1658 
1659 
1660 
1661 
1662 ! ******************************************************************************
1663 !
1664 ! Purpose: Create communication lists.
1665 !
1666 ! Description: None.
1667 !
1668 ! Input:
1669 ! pRegion Pointer to region
1670 !
1671 ! Output: None.
1672 !
1673 ! Notes: None.
1674 !
1675 ! ******************************************************************************
1676 
1677  SUBROUTINE rflu_comm_createcommlists(pRegion)
1678 
1679  IMPLICIT NONE
1680 
1681 ! ******************************************************************************
1682 ! Declarations and definitions
1683 ! ******************************************************************************
1684 
1685 ! ==============================================================================
1686 ! Arguments
1687 ! ==============================================================================
1688 
1689  TYPE(t_region), POINTER :: pregion
1690 
1691 ! ==============================================================================
1692 ! Locals
1693 ! ==============================================================================
1694 
1695  INTEGER :: errorflag,iborder
1696  TYPE(t_global), POINTER :: global
1697  TYPE(t_border), POINTER :: pborder
1698  TYPE(t_grid), POINTER :: pgrid
1699 
1700 ! ******************************************************************************
1701 ! Start
1702 ! ******************************************************************************
1703 
1704  global => pregion%global
1705 
1706  CALL registerfunction(global,'RFLU_COMM_CreateCommLists',&
1707  'RFLU_ModCommLists.F90')
1708 
1709  IF ( global%myProcid == masterproc .AND. &
1710  global%verbLevel >= verbose_high ) THEN
1711  WRITE(stdout,'(A,1X,A)') solver_name,'Creating communication lists...'
1712  END IF ! global%myProcid
1713 
1714  IF ( global%myProcid == masterproc .AND. &
1715  global%verbLevel >= verbose_high) THEN
1716  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
1717  pregion%iRegionGlobal
1718  END IF ! global%myProcid
1719 
1720 ! ******************************************************************************
1721 ! Set grid pointer
1722 ! ******************************************************************************
1723 
1724  pgrid => pregion%grid
1725 
1726 ! ******************************************************************************
1727 ! Allocate memory
1728 ! ******************************************************************************
1729 
1730  DO iborder = 1,pgrid%nBorders
1731  pborder => pgrid%borders(iborder)
1732 
1733  ALLOCATE(pborder%icgSend(pborder%nCellsSend),stat=errorflag)
1734  global%error = errorflag
1735  IF ( global%error /= err_none ) THEN
1736  CALL errorstop(global,err_allocate,__line__,'pBorder%icgSend')
1737  END IF ! global%error
1738 
1739  ALLOCATE(pborder%icgRecv(pborder%nCellsRecv),stat=errorflag)
1740  global%error = errorflag
1741  IF ( global%error /= err_none ) THEN
1742  CALL errorstop(global,err_allocate,__line__,'pBorder%icgRecv')
1743  END IF ! global%error
1744 
1745  ALLOCATE(pborder%ivgSend(pborder%nVertSend),stat=errorflag)
1746  global%error = errorflag
1747  IF ( global%error /= err_none ) THEN
1748  CALL errorstop(global,err_allocate,__line__,'pBorder%ivgSend')
1749  END IF ! global%error
1750 
1751  ALLOCATE(pborder%ivgRecv(pborder%nVertRecv),stat=errorflag)
1752  global%error = errorflag
1753  IF ( global%error /= err_none ) THEN
1754  CALL errorstop(global,err_allocate,__line__,'pBorder%ivgRecv')
1755  END IF ! global%error
1756 
1757  ALLOCATE(pborder%ivgShared(pborder%nVertShared),stat=errorflag)
1758  global%error = errorflag
1759  IF ( global%error /= err_none ) THEN
1760  CALL errorstop(global,err_allocate,__line__,'pBorder%ivgShared')
1761  END IF ! global%error
1762  END DO ! iBorder
1763 
1764 ! ******************************************************************************
1765 ! End
1766 ! ******************************************************************************
1767 
1768  IF ( global%myProcid == masterproc .AND. &
1769  global%verbLevel >= verbose_high ) THEN
1770  WRITE(stdout,'(A,1X,A)') solver_name,'Creating communication lists done.'
1771  END IF ! global%myProcid
1772 
1773  CALL deregisterfunction(global)
1774 
1775  END SUBROUTINE rflu_comm_createcommlists
1776 
1777 
1778 
1779 
1780 
1781 
1782 
1783 
1784 ! ******************************************************************************
1785 !
1786 ! Purpose: Destroy border counter.
1787 !
1788 ! Description: None.
1789 !
1790 ! Input:
1791 ! pRegion Pointer to region
1792 !
1793 ! Output: None.
1794 !
1795 ! Notes: None.
1796 !
1797 ! ******************************************************************************
1798 
1799  SUBROUTINE rflu_comm_destroybordercntr(pRegion)
1800 
1801  IMPLICIT NONE
1802 
1803 ! ******************************************************************************
1804 ! Declarations and definitions
1805 ! ******************************************************************************
1806 
1807 ! ==============================================================================
1808 ! Arguments
1809 ! ==============================================================================
1810 
1811  TYPE(t_region), POINTER :: pregion
1812 
1813 ! ==============================================================================
1814 ! Locals
1815 ! ==============================================================================
1816 
1817  INTEGER :: errorflag
1818  TYPE(t_global), POINTER :: global
1819  TYPE(t_grid), POINTER :: pgrid
1820 
1821 ! ******************************************************************************
1822 ! Start
1823 ! ******************************************************************************
1824 
1825  global => pregion%global
1826 
1827  CALL registerfunction(global,'RFLU_COMM_DestroyBorderCntr',&
1828  'RFLU_ModCommLists.F90')
1829 
1830 ! ******************************************************************************
1831 ! Set grid pointer
1832 ! ******************************************************************************
1833 
1834  pgrid => pregion%grid
1835 
1836 ! ******************************************************************************
1837 ! Deallocate memory
1838 ! ******************************************************************************
1839 
1840  DEALLOCATE(pgrid%borderCntr,stat=errorflag)
1841  global%error = errorflag
1842  IF ( global%error /= err_none ) THEN
1843  CALL errorstop(global,err_deallocate,__line__,'pGrid%borderCntr')
1844  END IF ! global%error
1845 
1846 ! ******************************************************************************
1847 ! End
1848 ! ******************************************************************************
1849 
1850  CALL deregisterfunction(global)
1851 
1852  END SUBROUTINE rflu_comm_destroybordercntr
1853 
1854 
1855 
1856 
1857 
1858 
1859 
1860 
1861 
1862 ! ******************************************************************************
1863 !
1864 ! Purpose: Destroy borders
1865 !
1866 ! Description: None.
1867 !
1868 ! Input:
1869 ! pRegion Pointer to region
1870 !
1871 ! Output: None.
1872 !
1873 ! Notes: None.
1874 !
1875 ! ******************************************************************************
1876 
1877  SUBROUTINE rflu_comm_destroyborders(pRegion)
1878 
1879  IMPLICIT NONE
1880 
1881 ! ******************************************************************************
1882 ! Declarations and definitions
1883 ! ******************************************************************************
1884 
1885 ! ==============================================================================
1886 ! Arguments
1887 ! ==============================================================================
1888 
1889  TYPE(t_region), POINTER :: pregion
1890 
1891 ! ==============================================================================
1892 ! Locals
1893 ! ==============================================================================
1894 
1895  INTEGER :: errorflag,iborder
1896  TYPE(t_global), POINTER :: global
1897  TYPE(t_border), POINTER :: pborder
1898  TYPE(t_grid), POINTER :: pgrid
1899 
1900 ! ******************************************************************************
1901 ! Start
1902 ! ******************************************************************************
1903 
1904  global => pregion%global
1905 
1906  CALL registerfunction(global,'RFLU_COMM_DestroyBorders',&
1907  'RFLU_ModCommLists.F90')
1908 
1909  IF ( global%myProcid == masterproc .AND. &
1910  global%verbLevel >= verbose_high ) THEN
1911  WRITE(stdout,'(A,1X,A)') solver_name,'Destroying borders...'
1912  END IF ! global%myProcid
1913 
1914  IF ( global%myProcid == masterproc .AND. &
1915  global%verbLevel >= verbose_high) THEN
1916  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
1917  pregion%iRegionGlobal
1918  END IF ! global%myProcid
1919 
1920 ! ******************************************************************************
1921 ! Set grid pointer
1922 ! ******************************************************************************
1923 
1924  pgrid => pregion%grid
1925 
1926 ! ******************************************************************************
1927 ! Allocate memory
1928 ! ******************************************************************************
1929 
1930  DEALLOCATE(pgrid%borders,stat=errorflag)
1931  global%error = errorflag
1932  IF ( global%error /= err_none ) THEN
1933  CALL errorstop(global,err_deallocate,__line__,'pGrid%borders')
1934  END IF ! global%error
1935 
1936 ! ******************************************************************************
1937 ! End
1938 ! ******************************************************************************
1939 
1940  IF ( global%myProcid == masterproc .AND. &
1941  global%verbLevel >= verbose_high ) THEN
1942  WRITE(stdout,'(A,1X,A)') solver_name,'Destroying borders done.'
1943  END IF ! global%myProcid
1944 
1945  CALL deregisterfunction(global)
1946 
1947  END SUBROUTINE rflu_comm_destroyborders
1948 
1949 
1950 
1951 
1952 
1953 
1954 ! ******************************************************************************
1955 !
1956 ! Purpose: Destroy communication lists.
1957 !
1958 ! Description: None.
1959 !
1960 ! Input:
1961 ! pRegion Pointer to region
1962 !
1963 ! Output: None.
1964 !
1965 ! Notes: None.
1966 !
1967 ! ******************************************************************************
1968 
1969  SUBROUTINE rflu_comm_destroycommlists(pRegion)
1970 
1971  IMPLICIT NONE
1972 
1973 ! ******************************************************************************
1974 ! Declarations and definitions
1975 ! ******************************************************************************
1976 
1977 ! ==============================================================================
1978 ! Arguments
1979 ! ==============================================================================
1980 
1981  TYPE(t_region), POINTER :: pregion
1982 
1983 ! ==============================================================================
1984 ! Locals
1985 ! ==============================================================================
1986 
1987  INTEGER :: errorflag,iborder
1988  TYPE(t_global), POINTER :: global
1989  TYPE(t_border), POINTER :: pborder
1990  TYPE(t_grid), POINTER :: pgrid
1991 
1992 ! ******************************************************************************
1993 ! Start
1994 ! ******************************************************************************
1995 
1996  global => pregion%global
1997 
1998  CALL registerfunction(global,'RFLU_COMM_DestroyCommLists',&
1999  'RFLU_ModCommLists.F90')
2000 
2001  IF ( global%myProcid == masterproc .AND. &
2002  global%verbLevel >= verbose_high ) THEN
2003  WRITE(stdout,'(A,1X,A)') solver_name,'Destroying communication lists...'
2004  END IF ! global%myProcid
2005 
2006  IF ( global%myProcid == masterproc .AND. &
2007  global%verbLevel >= verbose_high) THEN
2008  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
2009  pregion%iRegionGlobal
2010  END IF ! global%myProcid
2011 
2012 ! ******************************************************************************
2013 ! Set grid pointer
2014 ! ******************************************************************************
2015 
2016  pgrid => pregion%grid
2017 
2018 ! ******************************************************************************
2019 ! Allocate memory
2020 ! ******************************************************************************
2021 
2022  DO iborder = 1,pgrid%nBorders
2023  pborder => pgrid%borders(iborder)
2024 
2025  DEALLOCATE(pborder%icgSend,stat=errorflag)
2026  global%error = errorflag
2027  IF ( global%error /= err_none ) THEN
2028  CALL errorstop(global,err_deallocate,__line__,'pBorder%icgSend')
2029  END IF ! global%error
2030 
2031  DEALLOCATE(pborder%icgRecv,stat=errorflag)
2032  global%error = errorflag
2033  IF ( global%error /= err_none ) THEN
2034  CALL errorstop(global,err_deallocate,__line__,'pBorder%icgRecv')
2035  END IF ! global%error
2036 
2037  DEALLOCATE(pborder%ivgSend,stat=errorflag)
2038  global%error = errorflag
2039  IF ( global%error /= err_none ) THEN
2040  CALL errorstop(global,err_deallocate,__line__,'pBorder%ivgSend')
2041  END IF ! global%error
2042 
2043  DEALLOCATE(pborder%ivgRecv,stat=errorflag)
2044  global%error = errorflag
2045  IF ( global%error /= err_none ) THEN
2046  CALL errorstop(global,err_deallocate,__line__,'pBorder%ivgRecv')
2047  END IF ! global%error
2048 
2049  DEALLOCATE(pborder%ivgShared,stat=errorflag)
2050  global%error = errorflag
2051  IF ( global%error /= err_none ) THEN
2052  CALL errorstop(global,err_deallocate,__line__,'pBorder%ivgShared')
2053  END IF ! global%error
2054  END DO ! iBorder
2055 
2056 ! ******************************************************************************
2057 ! End
2058 ! ******************************************************************************
2059 
2060  IF ( global%myProcid == masterproc .AND. &
2061  global%verbLevel >= verbose_high ) THEN
2062  WRITE(stdout,'(A,1X,A)') solver_name, &
2063  'Destroying communication lists done.'
2064  END IF ! global%myProcid
2065 
2066  CALL deregisterfunction(global)
2067 
2068  END SUBROUTINE rflu_comm_destroycommlists
2069 
2070 
2071 
2072 
2073 
2074 
2075 
2076 ! ******************************************************************************
2077 !
2078 ! Purpose: Get process and local region ids for borders.
2079 !
2080 ! Description: None.
2081 !
2082 ! Input:
2083 ! pRegion Pointer to region
2084 !
2085 ! Output: None.
2086 !
2087 ! Notes:
2088 ! 1. This routine must be called after borders were created and region
2089 ! mapping was read.
2090 !
2091 ! ******************************************************************************
2092 
2093  SUBROUTINE rflu_comm_getproclocregids(pRegion)
2094 
2095  USE rflu_modregionmapping, ONLY: rflu_closeregionmappingfile, &
2096  rflu_getproclocregids, &
2097  rflu_openregionmappingfile
2098 
2099  IMPLICIT NONE
2100 
2101 ! ******************************************************************************
2102 ! Declarations and definitions
2103 ! ******************************************************************************
2104 
2105 ! ==============================================================================
2106 ! Arguments
2107 ! ==============================================================================
2108 
2109  TYPE(t_region), POINTER :: pregion
2110 
2111 ! ==============================================================================
2112 ! Locals
2113 ! ==============================================================================
2114 
2115  INTEGER :: errorflag,iborder,nregids
2116  INTEGER, DIMENSION(:), ALLOCATABLE :: locregids,procids,regids
2117  TYPE(t_global), POINTER :: global
2118  TYPE(t_border), POINTER :: pborder
2119  TYPE(t_grid), POINTER :: pgrid
2120 
2121 ! ******************************************************************************
2122 ! Start
2123 ! ******************************************************************************
2124 
2125  global => pregion%global
2126 
2127  CALL registerfunction(global,'RFLU_COMM_GetProcLocRegIds',&
2128  'RFLU_ModCommLists.F90')
2129 
2130  IF ( global%myProcid == masterproc .AND. &
2131  global%verbLevel >= verbose_high ) THEN
2132  WRITE(stdout,'(A,1X,A)') solver_name,'Getting border process ids..'
2133  END IF ! global%myProcid
2134 
2135  IF ( global%myProcid == masterproc .AND. &
2136  global%verbLevel >= verbose_high) THEN
2137  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
2138  pregion%iRegionGlobal
2139  END IF ! global%myProcid
2140 
2141 ! ******************************************************************************
2142 ! Set grid pointer
2143 ! ******************************************************************************
2144 
2145  pgrid => pregion%grid
2146 
2147 ! ******************************************************************************
2148 ! Allocate temporary memory
2149 ! ******************************************************************************
2150 
2151  ALLOCATE(regids(pgrid%nBorders),stat=errorflag)
2152  global%error = errorflag
2153  IF ( global%error /= err_none ) THEN
2154  CALL errorstop(global,err_allocate,__line__,'regIds')
2155  END IF ! global%error
2156 
2157  ALLOCATE(procids(pgrid%nBorders),stat=errorflag)
2158  global%error = errorflag
2159  IF ( global%error /= err_none ) THEN
2160  CALL errorstop(global,err_allocate,__line__,'procIds')
2161  END IF ! global%error
2162 
2163  ALLOCATE(locregids(pgrid%nBorders),stat=errorflag)
2164  global%error = errorflag
2165  IF ( global%error /= err_none ) THEN
2166  CALL errorstop(global,err_allocate,__line__,'locRegIds')
2167  END IF ! global%error
2168 
2169 ! ******************************************************************************
2170 ! Set region ids, get process ids from mapping file, and impose process ids
2171 ! ******************************************************************************
2172 
2173  DO iborder = 1,pgrid%nBorders
2174  pborder => pgrid%borders(iborder)
2175 
2176  regids(iborder) = pborder%iRegionGlobal
2177  END DO ! iBorder
2178 
2179  CALL rflu_openregionmappingfile(global)
2180  CALL rflu_getproclocregids(global,regids,pgrid%nBorders,procids,locregids)
2181  CALL rflu_closeregionmappingfile(global)
2182 
2183  DO iborder = 1,pgrid%nBorders
2184  pborder => pgrid%borders(iborder)
2185 
2186  pborder%iProc = procids(iborder) - 1 ! NOTE offset
2187  pborder%iRegionLocal = locregids(iborder)
2188  END DO ! iBorder
2189 
2190 ! ******************************************************************************
2191 ! Deallocate temporary memory
2192 ! ******************************************************************************
2193 
2194  DEALLOCATE(regids,stat=errorflag)
2195  global%error = errorflag
2196  IF ( global%error /= err_none ) THEN
2197  CALL errorstop(global,err_deallocate,__line__,'regIds')
2198  END IF ! global%error
2199 
2200  DEALLOCATE(procids,stat=errorflag)
2201  global%error = errorflag
2202  IF ( global%error /= err_none ) THEN
2203  CALL errorstop(global,err_deallocate,__line__,'procIds')
2204  END IF ! global%error
2205 
2206  DEALLOCATE(locregids,stat=errorflag)
2207  global%error = errorflag
2208  IF ( global%error /= err_none ) THEN
2209  CALL errorstop(global,err_deallocate,__line__,'locRegIds')
2210  END IF ! global%error
2211 
2212 ! ******************************************************************************
2213 ! End
2214 ! ******************************************************************************
2215 
2216  IF ( global%myProcid == masterproc .AND. &
2217  global%verbLevel >= verbose_high ) THEN
2218  WRITE(stdout,'(A,1X,A)') solver_name,'Getting border process ids done.'
2219  END IF ! global%myProcid
2220 
2221  CALL deregisterfunction(global)
2222 
2223  END SUBROUTINE rflu_comm_getproclocregids
2224 
2225 
2226 
2227 
2228 
2229 
2230 ! ******************************************************************************
2231 !
2232 ! Purpose: Read communication lists
2233 !
2234 ! Description: None.
2235 !
2236 ! Input:
2237 ! pRegion Pointer to region
2238 !
2239 ! Output: None.
2240 !
2241 ! Notes: None.
2242 !
2243 ! ******************************************************************************
2244 
2245  SUBROUTINE rflu_comm_readcommlists(pRegion)
2246 
2247  USE modbuildfilenames, ONLY: buildfilenamebasic
2248 
2249  IMPLICIT NONE
2250 
2251 ! ******************************************************************************
2252 ! Declarations and definitions
2253 ! ******************************************************************************
2254 
2255 ! ==============================================================================
2256 ! Arguments
2257 ! ==============================================================================
2258 
2259  TYPE(t_region), POINTER :: pregion
2260 
2261 ! ==============================================================================
2262 ! Local variables
2263 ! ==============================================================================
2264 
2265  INTEGER :: errorflag,iborder,icl,ifile,ivl,loopcounter,nborders, &
2266  ncellsrecv,ncellssend,nvertrecv,nvertsend,nvertshared
2267  CHARACTER(CHRLEN) :: ifilename,sectionstring
2268  TYPE(t_border), POINTER :: pborder
2269  TYPE(t_grid), POINTER :: pgrid
2270  TYPE(t_global), POINTER :: global
2271 
2272 ! ******************************************************************************
2273 ! Start
2274 ! ******************************************************************************
2275 
2276  global => pregion%global
2277 
2278  CALL registerfunction(global,'RFLU_COMM_ReadCommLists',&
2279  'RFLU_ModCommLists.F90')
2280 
2281  IF ( global%myProcid == masterproc .AND. &
2282  global%verbLevel >= verbose_high ) THEN
2283  WRITE(stdout,'(A,1X,A)') solver_name,'Reading communication lists...'
2284  END IF ! global%myProcid
2285 
2286  IF ( global%myProcid == masterproc .AND. &
2287  global%verbLevel >= verbose_high) THEN
2288  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
2289  pregion%iRegionGlobal
2290  END IF ! global%myProcid
2291 
2292 ! ******************************************************************************
2293 ! Open file
2294 ! ******************************************************************************
2295 
2296  ifile = if_comm_lists
2297 
2298  CALL buildfilenamebasic(global,filedest_indir,'.com', &
2299  pregion%iRegionGlobal,ifilename)
2300 
2301  OPEN(ifile,file=ifilename,form="FORMATTED",status="OLD", &
2302  iostat=errorflag)
2303  global%error = errorflag
2304  IF ( global%error /= err_none ) THEN
2305  CALL errorstop(global,err_file_open,__line__,ifilename)
2306  END IF ! global%error
2307 
2308 ! ******************************************************************************
2309 ! Header and general information
2310 ! ******************************************************************************
2311 
2312  IF ( global%myProcid == masterproc .AND. &
2313  global%verbLevel >= verbose_high) THEN
2314  WRITE(stdout,'(A,3X,A)') solver_name,'Header information...'
2315  END IF ! global%myProcid
2316 
2317  READ(ifile,'(A)') sectionstring
2318  IF ( trim(sectionstring) /= '# ROCFLU communication lists file' ) THEN
2319  CALL errorstop(global,err_invalid_marker,__line__,sectionstring)
2320  END IF ! TRIM
2321 
2322 ! ******************************************************************************
2323 ! Dimensions
2324 ! ******************************************************************************
2325 
2326  pgrid => pregion%grid
2327 
2328  READ(ifile,'(A)') sectionstring
2329  IF ( trim(sectionstring) /= '# Dimensions' ) THEN
2330  CALL errorstop(global,err_invalid_marker,__line__,sectionstring)
2331  END IF ! TRIM
2332 
2333  READ(ifile,'(I8)') nborders
2334 
2335 ! ==============================================================================
2336 ! Check dimensions (against those read from dimensions file)
2337 ! ==============================================================================
2338 
2339  IF ( nborders /= pgrid%nBorders ) THEN
2340  CALL errorstop(global,err_dimens_invalid,__line__)
2341  END IF ! nBorders
2342 
2343 ! ******************************************************************************
2344 ! Rest of file
2345 ! ******************************************************************************
2346 
2347  loopcounter = 0
2348 
2349 ! ==============================================================================
2350 ! Set up infinite loop
2351 ! ==============================================================================
2352 
2353  DO ! set up infinite loop
2354  loopcounter = loopcounter + 1
2355 
2356  READ(ifile,'(A)') sectionstring
2357 
2358  SELECT CASE ( trim(sectionstring) )
2359 
2360 ! ------------------------------------------------------------------------------
2361 ! Information
2362 ! ------------------------------------------------------------------------------
2363 
2364  CASE ( '# Information' )
2365  IF ( global%myProcid == masterproc .AND. &
2366  global%verbLevel >= verbose_high) THEN
2367  WRITE(stdout,'(A,3X,A)') solver_name,'Information...'
2368  END IF ! global%myProcid
2369 
2370  DO iborder = 1,pgrid%nBorders
2371  pborder => pgrid%borders(iborder)
2372 
2373  READ(ifile,'(2(I8))') pborder%iRegionGlobal,pborder%iBorder
2374  END DO ! iBorder
2375 
2376 ! ------------------------------------------------------------------------------
2377 ! Cells
2378 ! ------------------------------------------------------------------------------
2379 
2380  CASE ( '# Cells' )
2381  IF ( global%myProcid == masterproc .AND. &
2382  global%verbLevel >= verbose_high) THEN
2383  WRITE(stdout,'(A,3X,A)') solver_name,'Cells...'
2384  END IF ! global%myProcid
2385 
2386  DO iborder = 1,pgrid%nBorders
2387  pborder => pgrid%borders(iborder)
2388 
2389  READ(ifile,'(2(I8))') ncellssend,ncellsrecv
2390 
2391  IF ( ncellssend /= pborder%nCellsSend .OR. &
2392  ncellsrecv /= pborder%nCellsRecv ) THEN
2393  CALL errorstop(global,err_dimens_invalid,__line__)
2394  END IF ! nCellsSend
2395 
2396  READ(ifile,'(10(I8))') (pborder%icgSend(icl), &
2397  icl=1,pborder%nCellsSend)
2398  READ(ifile,'(10(I8))') (pborder%icgRecv(icl), &
2399  icl=1,pborder%nCellsRecv)
2400  END DO ! iBorder
2401 
2402 ! ------------------------------------------------------------------------------
2403 ! Vertices
2404 ! ------------------------------------------------------------------------------
2405 
2406  CASE ( '# Vertices' )
2407  IF ( global%myProcid == masterproc .AND. &
2408  global%verbLevel >= verbose_high) THEN
2409  WRITE(stdout,'(A,3X,A)') solver_name,'Vertices...'
2410  END IF ! global%myProcid
2411 
2412  DO iborder = 1,pgrid%nBorders
2413  pborder => pgrid%borders(iborder)
2414 
2415  READ(ifile,'(3(I8))') nvertsend,nvertrecv,nvertshared
2416 
2417  IF ( nvertsend /= pborder%nVertSend .OR. &
2418  nvertrecv /= pborder%nVertRecv .OR. &
2419  nvertshared /= pborder%nVertShared ) THEN
2420  CALL errorstop(global,err_dimens_invalid,__line__)
2421  END IF ! nVertSend
2422 
2423  READ(ifile,'(10(I8))') (pborder%ivgSend(ivl), &
2424  ivl=1,pborder%nVertSend)
2425  READ(ifile,'(10(I8))') (pborder%ivgRecv(ivl), &
2426  ivl=1,pborder%nVertRecv)
2427  READ(ifile,'(10(I8))') (pborder%ivgShared(ivl), &
2428  ivl=1,pborder%nVertShared)
2429  END DO ! iBorder
2430 
2431 ! ------------------------------------------------------------------------------
2432 ! End marker
2433 ! ------------------------------------------------------------------------------
2434 
2435  CASE ( '# End' )
2436  IF ( global%myProcid == masterproc .AND. &
2437  global%verbLevel >= verbose_high) THEN
2438  WRITE(stdout,'(A,3X,A)') solver_name,'End marker...'
2439  END IF ! global%myProcid
2440 
2441  EXIT
2442 
2443 ! ------------------------------------------------------------------------------
2444 ! Invalid section string
2445 ! ------------------------------------------------------------------------------
2446 
2447  CASE default
2448  IF ( global%myProcid == masterproc .AND. &
2449  global%verbLevel >= verbose_high) THEN
2450  WRITE(stdout,'(3X,A)') sectionstring
2451  END IF ! global%myProcid
2452 
2453  CALL errorstop(global,err_invalid_marker,__line__,sectionstring)
2454  END SELECT ! TRIM
2455 
2456 ! ==============================================================================
2457 ! Guard against infinite loop - might be unnecessary because of read errors?
2458 ! ==============================================================================
2459 
2460  IF ( loopcounter >= limit_infinite_loop ) THEN
2461  CALL errorstop(global,err_infinite_loop,__line__)
2462  END IF ! loopCounter
2463  END DO ! <empty>
2464 
2465 ! ******************************************************************************
2466 ! Close file
2467 ! ******************************************************************************
2468 
2469  CLOSE(ifile,iostat=errorflag)
2470  global%error = errorflag
2471  IF ( global%error /= err_none ) THEN
2472  CALL errorstop(global,err_file_close,__line__,ifilename)
2473  END IF ! global%error
2474 
2475 ! ******************************************************************************
2476 ! End
2477 ! ******************************************************************************
2478 
2479  IF ( global%myProcid == masterproc .AND. &
2480  global%verbLevel >= verbose_high ) THEN
2481  WRITE(stdout,'(A,1X,A)') solver_name,'Reading communication lists done.'
2482  END IF ! global%myProcid
2483 
2484  CALL deregisterfunction(global)
2485 
2486  END SUBROUTINE rflu_comm_readcommlists
2487 
2488 
2489 
2490 
2491 
2492 
2493 
2494 ! ******************************************************************************
2495 !
2496 ! Purpose: Write communication lists
2497 !
2498 ! Description: None.
2499 !
2500 ! Input:
2501 ! pRegion Pointer to region
2502 !
2503 ! Output: None.
2504 !
2505 ! Notes: None.
2506 !
2507 ! ******************************************************************************
2508 
2509  SUBROUTINE rflu_comm_writecommlists(pRegion)
2510 
2511  USE modbuildfilenames, ONLY: buildfilenamebasic
2512 
2513  IMPLICIT NONE
2514 
2515 ! ******************************************************************************
2516 ! Declarations and definitions
2517 ! ******************************************************************************
2518 
2519 ! ==============================================================================
2520 ! Arguments
2521 ! ==============================================================================
2522 
2523  TYPE(t_region), POINTER :: pregion
2524 
2525 ! ==============================================================================
2526 ! Local variables
2527 ! ==============================================================================
2528 
2529  INTEGER :: errorflag,iborder,icl,ifile,ivl
2530  CHARACTER(CHRLEN) :: ifilename,sectionstring
2531  TYPE(t_border), POINTER :: pborder
2532  TYPE(t_grid), POINTER :: pgrid
2533  TYPE(t_global), POINTER :: global
2534 
2535 ! ******************************************************************************
2536 ! Start
2537 ! ******************************************************************************
2538 
2539  global => pregion%global
2540 
2541  CALL registerfunction(global,'RFLU_COMM_WriteCommLists',&
2542  'RFLU_ModCommLists.F90')
2543 
2544  IF ( global%myProcid == masterproc .AND. &
2545  global%verbLevel >= verbose_high ) THEN
2546  WRITE(stdout,'(A,1X,A)') solver_name,'Writing communication lists...'
2547  END IF ! global%myProcid
2548 
2549  IF ( global%myProcid == masterproc .AND. &
2550  global%verbLevel >= verbose_high) THEN
2551  WRITE(stdout,'(A,3X,A,1X,I5.5)') solver_name,'Global region:', &
2552  pregion%iRegionGlobal
2553  END IF ! global%myProcid
2554 
2555 ! ******************************************************************************
2556 ! Open file
2557 ! ******************************************************************************
2558 
2559  ifile = if_comm_lists
2560 
2561  CALL buildfilenamebasic(global,filedest_indir,'.com', &
2562  pregion%iRegionGlobal,ifilename)
2563 
2564  OPEN(ifile,file=ifilename,form="FORMATTED",status="UNKNOWN", &
2565  iostat=errorflag)
2566  global%error = errorflag
2567  IF ( global%error /= err_none ) THEN
2568  CALL errorstop(global,err_file_open,__line__,ifilename)
2569  END IF ! global%error
2570 
2571 ! ******************************************************************************
2572 ! Header and general information
2573 ! ******************************************************************************
2574 
2575  IF ( global%myProcid == masterproc .AND. &
2576  global%verbLevel >= verbose_high ) THEN
2577  WRITE(stdout,'(A,3X,A)') solver_name,'Header information...'
2578  END IF ! global%myProcid
2579 
2580  sectionstring = '# ROCFLU communication lists file'
2581  WRITE(ifile,'(A)') trim(sectionstring)
2582 
2583 ! ******************************************************************************
2584 ! Dimensions
2585 ! ******************************************************************************
2586 
2587  pgrid => pregion%grid
2588 
2589  IF ( global%myProcid == masterproc .AND. &
2590  global%verbLevel >= verbose_high ) THEN
2591  WRITE(stdout,'(A,3X,A)') solver_name,'Dimensions...'
2592  END IF ! global%myProcid
2593 
2594  sectionstring = '# Dimensions'
2595  WRITE(ifile,'(A)') trim(sectionstring)
2596  WRITE(ifile,'(I8)') pgrid%nBorders
2597 
2598 ! ******************************************************************************
2599 ! Information
2600 ! ******************************************************************************
2601 
2602  IF ( global%myProcid == masterproc .AND. &
2603  global%verbLevel >= verbose_high ) THEN
2604  WRITE(stdout,'(A,3X,A)') solver_name,'Information...'
2605  END IF ! global%myProcid
2606 
2607  sectionstring = '# Information'
2608  WRITE(ifile,'(A)') trim(sectionstring)
2609 
2610  DO iborder = 1,pgrid%nBorders
2611  pborder => pgrid%borders(iborder)
2612 
2613  WRITE(ifile,'(2(I8))') pborder%iRegionGlobal,pborder%iBorder
2614  END DO ! iBorder
2615 
2616 ! ******************************************************************************
2617 ! Cells
2618 ! ******************************************************************************
2619 
2620  IF ( global%myProcid == masterproc .AND. &
2621  global%verbLevel >= verbose_high ) THEN
2622  WRITE(stdout,'(A,3X,A)') solver_name,'Cells...'
2623  END IF ! global%myProcid
2624 
2625  sectionstring = '# Cells'
2626  WRITE(ifile,'(A)') trim(sectionstring)
2627 
2628  DO iborder = 1,pgrid%nBorders
2629  pborder => pgrid%borders(iborder)
2630 
2631  WRITE(ifile,'( 2(I8))') pborder%nCellsSend,pborder%nCellsRecv
2632  WRITE(ifile,'(10(I8))') (pborder%icgSend(icl),icl=1,pborder%nCellsSend)
2633  WRITE(ifile,'(10(I8))') (pborder%icgRecv(icl),icl=1,pborder%nCellsRecv)
2634  END DO ! iBorder
2635 
2636 ! ******************************************************************************
2637 ! Vertices
2638 ! ******************************************************************************
2639 
2640  IF ( global%myProcid == masterproc .AND. &
2641  global%verbLevel >= verbose_high ) THEN
2642  WRITE(stdout,'(A,3X,A)') solver_name,'Vertices...'
2643  END IF ! global%myProcid
2644 
2645  sectionstring = '# Vertices'
2646  WRITE(ifile,'(A)') trim(sectionstring)
2647 
2648  DO iborder = 1,pgrid%nBorders
2649  pborder => pgrid%borders(iborder)
2650 
2651  WRITE(ifile,'( 3(I8))') pborder%nVertSend,pborder%nVertRecv, &
2652  pborder%nVertShared
2653  WRITE(ifile,'(10(I8))') (pborder%ivgSend(ivl),ivl=1,pborder%nVertSend)
2654  WRITE(ifile,'(10(I8))') (pborder%ivgRecv(ivl),ivl=1,pborder%nVertRecv)
2655  WRITE(ifile,'(10(I8))') (pborder%ivgShared(ivl),ivl=1,pborder%nVertShared)
2656  END DO ! iBorder
2657 
2658 ! ******************************************************************************
2659 ! End marker
2660 ! ******************************************************************************
2661 
2662  IF ( global%myProcid == masterproc .AND. &
2663  global%verbLevel >= verbose_high ) THEN
2664  WRITE(stdout,'(A,3X,A)') solver_name,'End marker...'
2665  END IF ! global%myProcid
2666 
2667  sectionstring = '# End'
2668  WRITE(ifile,'(A)') trim(sectionstring)
2669 
2670 ! ******************************************************************************
2671 ! Close file
2672 ! ******************************************************************************
2673 
2674  CLOSE(ifile,iostat=errorflag)
2675  global%error = errorflag
2676  IF ( global%error /= err_none ) THEN
2677  CALL errorstop(global,err_file_close,__line__,ifilename)
2678  END IF ! global%error
2679 
2680 ! ******************************************************************************
2681 ! End
2682 ! ******************************************************************************
2683 
2684  IF ( global%myProcid == masterproc .AND. &
2685  global%verbLevel >= verbose_high ) THEN
2686  WRITE(stdout,'(A,1X,A)') solver_name,'Writing communication lists done.'
2687  END IF ! global%myProcid
2688 
2689  CALL deregisterfunction(global)
2690 
2691  END SUBROUTINE rflu_comm_writecommlists
2692 
2693 
2694 
2695 
2696 
2697 ! ******************************************************************************
2698 ! End
2699 ! ******************************************************************************
2700 
2701 END MODULE rflu_modcommlists
2702 
2703 
2704 ! ******************************************************************************
2705 !
2706 ! RCS Revision history:
2707 !
2708 ! $Log: RFLU_ModCommLists.F90,v $
2709 ! Revision 1.14 2008/12/06 08:44:20 mtcampbe
2710 ! Updated license.
2711 !
2712 ! Revision 1.13 2008/11/19 22:17:32 mtcampbe
2713 ! Added Illinois Open Source License/Copyright
2714 !
2715 ! Revision 1.12 2007/07/08 21:45:03 gzheng
2716 ! changed the PRESENT is used for PGI compiler
2717 !
2718 ! Revision 1.11 2006/04/07 15:19:18 haselbac
2719 ! Removed tabs
2720 !
2721 ! Revision 1.10 2006/03/28 21:29:09 haselbac
2722 ! Backed out changes for read/writing comm lists
2723 !
2724 ! Revision 1.9 2006/03/25 21:51:10 haselbac
2725 ! Substantial changes because of sype patches
2726 !
2727 ! Revision 1.8 2005/09/19 18:39:59 haselbac
2728 ! Bug fix for asymmetric borders: Now use pGrid%borderCntr and check
2729 !
2730 ! Revision 1.7 2005/06/20 17:04:45 haselbac
2731 ! Bug fix: New way of building shared v lists to deal w odd virtual cell topologies
2732 !
2733 ! Revision 1.6 2005/04/18 20:25:51 haselbac
2734 ! Bug fix: pGrid used before set
2735 !
2736 ! Revision 1.5 2005/04/15 15:06:48 haselbac
2737 ! Added routines to build vertex comm lists, more extensions, clean-up
2738 !
2739 ! Revision 1.4 2005/01/17 19:53:20 haselbac
2740 ! Added proper error treatment
2741 !
2742 ! Revision 1.3 2005/01/14 21:21:31 haselbac
2743 ! Added routines, init of iProc
2744 !
2745 ! Revision 1.2 2004/12/29 21:05:04 haselbac
2746 ! Various enhancements
2747 !
2748 ! Revision 1.1 2004/12/04 03:44:14 haselbac
2749 ! Initial revision
2750 !
2751 ! ******************************************************************************
2752 
2753 
2754 
2755 
2756 
2757 
2758 
2759 
2760 
2761 
2762 
2763 
2764 
2765 
2766 
2767 
2768 
2769 
2770 
2771 
2772 
rflu_modcommlists::rflu_comm_readcommlists
subroutine, public rflu_comm_readcommlists(pRegion)
Definition: RFLU_ModCommLists.F90:2245
rflu_modcommlists::rflu_comm_countbordersserial
subroutine, public rflu_comm_countbordersserial(pRegion)
Definition: RFLU_ModCommLists.F90:1341
buildfilenamebasic
subroutine buildfilenamebasic(global, dest, ext, id, fileName)
Definition: BuildFileNameBasic.F90:49
rflu_modregionmapping::rflu_openregionmappingfile
subroutine, public rflu_openregionmappingfile(global)
Definition: RFLU_ModRegionMapping.F90:891
rflu_modcommlists
Definition: RFLU_ModCommLists.F90:39
max
Vector_n max(const Array_n_const &v1, const Array_n_const &v2)
Definition: Vector_n.h:354
rflu_modtopologyutils::rflu_buildcellvertlist
subroutine, public rflu_buildcellvertlist(global, pGrid, cList, cListDim, vList, vListDimMax, vListDim)
Definition: RFLU_ModTopologyUtils.F90:97
moderror::registerfunction
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
Attribute::status
int status() const
Obtain the status of the attribute.
Definition: Attribute.h:240
rflu_modcommlists::rflu_comm_getproclocregids
subroutine, public rflu_comm_getproclocregids(pRegion)
Definition: RFLU_ModCommLists.F90:2093
rflu_modcommlists::rflu_comm_checkcountborders
subroutine, public rflu_comm_checkcountborders(regions)
Definition: RFLU_ModCommLists.F90:994
rflu_modcommlists::rflu_comm_writecommlists
subroutine, public rflu_comm_writecommlists(pRegion)
Definition: RFLU_ModCommLists.F90:2509
rflu_modcommlists::rflu_comm_destroybordercntr
subroutine, public rflu_comm_destroybordercntr(pRegion)
Definition: RFLU_ModCommLists.F90:1799
modgrid::t_grid
Definition: ModGrid.F90:56
modsortsearch::quicksortinteger
subroutine quicksortinteger(a, n)
Definition: ModSortSearch.F90:482
modsortsearch::binarysearchinteger
subroutine binarysearchinteger(a, n, v, i, j)
Definition: ModSortSearch.F90:98
rflu_modcommlists::rflu_comm_createborders
subroutine, public rflu_comm_createborders(pRegion, createMode)
Definition: RFLU_ModCommLists.F90:1537
modsortsearch::removecommonsortedintegersfancy
subroutine removecommonsortedintegersfancy(a, na, na2, b, nb, nb2, c, ncMax, nc, errorFlag)
Definition: ModSortSearch.F90:1038
rflu_modsymmetryperiodic::rflu_sype_getactualserialcell
subroutine, public rflu_sype_getactualserialcell(pRegionSerial, icgs, icgs2)
Definition: RFLU_ModSymmetryPeriodic.F90:2566
rflu_modregionmapping::rflu_closeregionmappingfile
subroutine, public rflu_closeregionmappingfile(global)
Definition: RFLU_ModRegionMapping.F90:397
rflu_modcommlists::rflu_comm_createcommlists
subroutine, public rflu_comm_createcommlists(pRegion)
Definition: RFLU_ModCommLists.F90:1677
rflu_modcommlists::rflu_comm_createbordercntr
subroutine, public rflu_comm_createbordercntr(pRegion, nBordersMaxOpt)
Definition: RFLU_ModCommLists.F90:1446
rflu_modsymmetryperiodic::rflu_sype_getrelatedvertex
subroutine, public rflu_sype_getrelatedvertex(pRegionSerial, pRegion, ivgs, ivg)
Definition: RFLU_ModSymmetryPeriodic.F90:2690
rflu_modcommlists::rflu_comm_buildcommlistscells
subroutine rflu_comm_buildcommlistscells(regions)
Definition: RFLU_ModCommLists.F90:192
form
**********************************************************************Rocstar Simulation Suite Illinois Rocstar LLC All rights reserved ****Illinois Rocstar LLC IL **www illinoisrocstar com **sales illinoisrocstar com WITHOUT WARRANTY OF ANY **EXPRESS OR INCLUDING BUT NOT LIMITED TO THE WARRANTIES **OF FITNESS FOR A PARTICULAR PURPOSE AND **NONINFRINGEMENT IN NO EVENT SHALL THE CONTRIBUTORS OR **COPYRIGHT HOLDERS BE LIABLE FOR ANY DAMAGES OR OTHER WHETHER IN AN ACTION OF TORT OR **Arising OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE **USE OR OTHER DEALINGS WITH THE SOFTWARE **********************************************************************INTERFACE SUBROUTINE form
Definition: RFLO_ReadDataFileInt.h:26
rflu_modcommlists::rflu_comm_buildcommlistsvert
subroutine rflu_comm_buildcommlistsvert(regions)
Definition: RFLU_ModCommLists.F90:540
rflu_modregionmapping::rflu_getproclocregids
subroutine, public rflu_getproclocregids(global, regIds, nRegIds, procIds, locRegIds)
Definition: RFLU_ModRegionMapping.F90:662
modborder::t_border
Definition: ModBorder.F90:55
rflu_modcommlists::rflu_comm_destroyborders
subroutine, public rflu_comm_destroyborders(pRegion)
Definition: RFLU_ModCommLists.F90:1877
modglobal::t_global
Definition: ModGlobal.F90:50
moderror::errorstop
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
rflu_modtopologyutils
Definition: RFLU_ModTopologyUtils.F90:39
rflu_modsymmetryperiodic
Definition: RFLU_ModSymmetryPeriodic.F90:39
moderror::deregisterfunction
subroutine deregisterfunction(global)
Definition: ModError.F90:469
rflu_modregionmapping
Definition: RFLU_ModRegionMapping.F90:43
rflu_modsymmetryperiodic::rflu_sype_havesypepatches
LOGICAL function, public rflu_sype_havesypepatches(pRegion)
Definition: RFLU_ModSymmetryPeriodic.F90:2899
rflu_modcommlists::rflu_comm_countborders
subroutine, public rflu_comm_countborders(pRegion, pRegionSerial)
Definition: RFLU_ModCommLists.F90:1142
rflu_modcommlists::rflu_comm_buildcommlists
subroutine, public rflu_comm_buildcommlists(regions)
Definition: RFLU_ModCommLists.F90:106
modbndpatch::t_patch
Definition: ModBndPatch.F90:91
rflu_modcommlists::rflu_comm_destroycommlists
subroutine, public rflu_comm_destroycommlists(pRegion)
Definition: RFLU_ModCommLists.F90:1969